pax_global_header00006660000000000000000000000064146062010730014511gustar00rootroot0000000000000052 comment=dc6b798d8b8ab8937e8583b813f75560c2d833d5 iris-iris-4.2.0/000077500000000000000000000000001460620107300134265ustar00rootroot00000000000000iris-iris-4.2.0/.gitattributes000066400000000000000000000002071460620107300163200ustar00rootroot00000000000000*.v gitlab-language=coq # Convert to native line endings on checkout. *.ref text # Shell scripts need Linux line endings. *.sh eol=lf iris-iris-4.2.0/.gitignore000066400000000000000000000003601460620107300154150ustar00rootroot00000000000000*.vo *.vos *.vok *.vio *.v.d .coqdeps.d *.glob *.cache *.aux \#*\# .\#* *~ *.bak .coqdeps.d .coq-native/ *.crashcoqide .env builddep/ _CoqProject.* Makefile.coq Makefile.coq.conf .Makefile.coq.d Makefile.package.* .Makefile.package.* _opam iris-iris-4.2.0/.gitlab-ci.yml000066400000000000000000000033461460620107300160700ustar00rootroot00000000000000image: ralfjung/opam-ci:opam2 stages: - build variables: CPU_CORES: "10" OCAML: "ocaml-variants.4.14.0+options ocaml-option-flambda" # Avoid needlessly increasing our TCB with native_compute COQEXTRAFLAGS: "-native-compiler no" .only_branches: &only_branches only: - /^master/@iris/iris - /^ci/@iris/iris .only_mr: &only_mr only: - merge_requests .branches_and_mr: &branches_and_mr only: - /^master/@iris/iris - /^ci/@iris/iris - merge_requests .template: &template <<: *only_branches stage: build interruptible: true tags: - fp script: - git clone https://gitlab.mpi-sws.org/iris/ci.git ci -b opam2 - ci/buildjob cache: key: "$CI_JOB_NAME" paths: - _opam/ except: - triggers - schedules - api ## Build jobs # The newest version runs with timing. build-coq.8.19.0: <<: *template variables: OPAM_PINS: "coq version 8.19.0" DENY_WARNINGS: "1" MANGLE_NAMES: "1" OPAM_PKG: "1" DOC_DIR: "coqdoc@center.mpi-sws.org:iris" DOC_OPTS: "--external https://plv.mpi-sws.org/coqdoc/stdpp/ stdpp" tags: - fp-timing interruptible: false # The newest version also runs in MRs, without timing. build-coq.8.19.0-mr: <<: *template <<: *only_mr variables: OPAM_PINS: "coq version 8.19.0" DENY_WARNINGS: "1" MANGLE_NAMES: "1" # The oldest version runs in MRs, without name mangling. build-coq.8.18.0: <<: *template <<: *branches_and_mr variables: OPAM_PINS: "coq version 8.18.0" DENY_WARNINGS: "1" trigger-stdpp.dev: <<: *template variables: STDPP_REPO: "iris/stdpp" OPAM_PINS: "coq version $NIGHTLY_COQ git+https://gitlab.mpi-sws.org/$STDPP_REPO#$STDPP_REV" CI_COQCHK: "1" except: only: - triggers - schedules - api iris-iris-4.2.0/.gitlab/000077500000000000000000000000001460620107300147465ustar00rootroot00000000000000iris-iris-4.2.0/.gitlab/issue_templates/000077500000000000000000000000001460620107300201545ustar00rootroot00000000000000iris-iris-4.2.0/.gitlab/issue_templates/Bug.md000066400000000000000000000003011460620107300212050ustar00rootroot00000000000000 iris-iris-4.2.0/CHANGELOG.md000066400000000000000000003314751460620107300152540ustar00rootroot00000000000000In this changelog, we document "large-ish" changes to Iris that affect even the way the logic is used on paper. We also document changes in the Coq development; every API-breaking change should be listed, but not every new lemma. ## Iris master **Changes in `algebra`:** * Rename `discrete` to `discrete_0`, to make room for a new lemma `discrete` that works for all `n` : `x ≡{n}≡ y → x ≡ y`. * Enable `f_equiv` and `solve_proper` to exploit the fact that `≡{n}≡` is a subrelation of `≡` and `=`. * Rename `iso_cmra_mixin_restrict` to `iso_cmra_mixin_restrict_validity`, and simplify its statement and that of `iso_cmra_mixin` by removing the `g_equiv` assumption that follows from the other assumptions. * Add `inj_cmra_mixin_restrict_validity` as a more general version of `iso_cmra_mixin_restrict_validity`. * Change statement of `Z_local_update` to be more intuitive. It now says `x - y = x' - y' → (x,y) ~l~> (x',y')`, i.e., the difference between the authoritative element and the fragment must stay the same. * Rename `cmra_discrete_update` → `cmra_discrete_total_update` and `cmra_discrete_updateP` → `cmra_discrete_total_updateP`. Repurpose original names for lemmas that only require `CmraDiscrete`, not `CmraTotal`. * Add a law for undiscarding discardable fractions, allowing one to update from `DfracDiscarded` to `DfracOwn(q)` for some fresh `q`. This formalizes the intuition that a discarded fraction is merely an "existentially quantified fraction." (by Johannes Hostert) * Add laws for un-persisting resources with a discardable fractional part, based on the undiscarding law for discardable fractions. For example, `gmap_view_frag k DfracDiscarded v ~~>: λ a, ∃ q, a = gmap_view_frag k (DfracOwn q) v` will allow recovering a fractional points-to from a discarded one. (by Johannes Hostert) * Generalize `gmap_viewUR K A` from `A : ofe` to `A : cmra`. Previously, the "agreement" camera was part of the definition, now the user can pick an arbitrary camera. All lemmas that exposed agreement properties have been generalized to expose general camera validity/composition. For porting: + Replace `gmap_viewR K V` by `gmap_viewR K (agreeR V)`. + Definitions and proofs on top of this will need to be manually adjusted. + Replace `gmap_view_update` by `gmap_view_replace`. + Proofs using `gmap_view_both_dfrac_valid_L` should instead use `gmap_view_both_dfrac_valid_discrete_total` followed by `to_agree_included_L`. **Changes in `proofmode`:** * The `iFrame` tactic has become slightly weaker for goals that contain both evars and either `∨` or `∧`. This prevents an exponential slowdown of `iFrame` on some goals. This change should be backwards compatible for almost all proofs. If you define or use custom `Frame` instances, note that the `MaybeFrame` class has become notation for `TCNoBackTrack (MaybeFrame' ...)`, which means the proofs of your instances might need a slight refactoring. * Adjust the `iFrame` proof search to use `QuickAffine` and `QuickAbsorbing` instead of `Affine` and `Absorbing`. This fixes some performance issues with large terms in non-affine logics, at the expense of a slight reduction in what `iFrame` can do in these logics. * The `iFrame` tactic has become stronger for goals that contain existential quantifiers: `iFrame` will now attempt to instantiate these. For example, framing `P x` in goal `Q ∗ ∃ y, P y ∗ R` will now succeed with remaining goal `Q ∗ R`. `iFrame` still behaves the same when no instantiation can be found: framing `R` in goal `Q ∗ ∃ y, P y ∗ R` still gives `Q ∗ ∃ y, P y`. This should simplify and potentially even speed up some proofs (MR: iris/iris!1017). Porting to this change will require manually fixing broken proofs: `iFrame` may now make more progress than your proof script expects. Proofs that look like `iFrame. iExists _. iFrame.` may need to be replaced with just `iFrame.` In some cases, you may need to be explicit in what hypotheses to `iFrame`, to prevent wrong instantiation of existential quantifiers. To temporarily fix broken proofs, you can restore `iFrame`'s old behavior with: ``` Local Instance frame_exist_instantiate_disabled : FrameInstantiateExistDisabled := {}. ``` `iFrame` will not instantiate existential quantifiers below connectives such as `-∗`, `∀`, `→` and `WP`, since this is more frequently unsafe (MR: iris/iris!1035). If you have custom recursive `Frame` instances for which you want to disable instantiating existential quantifiers, you need to replace the `Frame ...` premise of your instance with `(FrameInstantiateExistDisabled → Frame ...)`. * `iFrame` no longer loops on `[∗mset ] x ∈ X, ..` when `X` is an existential variable (MR: iris/iris!1039). (by Jan-Oliver Kaiser for BedRock Systems) **Changes in `base_logic`:** * Rename `mapsto` to `pointsto` to align with standard separation logic terminology. * Add laws for un-persisting assertions with a discardable fractional permission, for example `l ↦□ v ==∗ ∃ q, l ↦{#q} v`, using the new laws from `algebra` (see above). These laws allow one to update a persistent (discarded) assertion, like a points-to, back into a fractionally owned one, where the fraction is existentially quantified. They are useful when e.g. constructing invariants that allow exchanging fractional assertions. See !960 for more details. (by Johannes Hostert) * Add `token` library, providing a simple ghost token as a logic-level wrapper over the RA `excl unit`. * Add lemma `lc_fupd_add_laterN`. (by Thomas Somers) **Changes in `program_logic`:** * Rename `head_step` to `base_step` to avoid potential confusion with the standard term "head reduction", and also rename all associated definitions and lemmas. In particular: `head_stuck` → `base_stuck`, `head_reducible` → `base_reducible`, `head_irreducible` → `base_irreducible`, `head_redex` → `base_redex`, `head_atomc` → `base_atomic`. The sed script will rename all definitions and lemmas that come with Iris, but if you had additional definitions or lemmas with `head` in their name, you will have to rename them by hand if you want to remain consistent. **Changes in `heap_lang`:** * Replace `wp_lb_init` with a more general `steps_lb_0` lemma for creating a `steps_lb` without depending on WP. (by Thomas Somers) * Add generic lemma `twp_wp_step_lc` to derive WP with later credits from TWP. * Add Texan triples with later credits for stateful operations: `wp_alloc_lc`, `wp_alloc_lc`, `wp_free_lc`, `wp_load_lc`, `wp_store_lc`, `wp_xchg_lc`, `wp_cmpxchg_fail_lc`, `wp_cmpxchg_suc_lc`, and `wp_faa_lc`. The following `sed` script helps adjust your code to the renaming (on macOS, replace `sed` by `gsed`, installed via e.g. `brew install gnu-sed`). Note that the script is not idempotent, do not run it twice. ``` sed -i -E -f- $(find theories -name "*.v") <`/`<-` patterns by `iDestruct`, support for an arbitrary number of Coq intro patterns in the Iris proofmode tactics (`iIntros`, `iDestruct`, etc.), and support for immediately introducing the postcondition of a WP specification via `wp_apply lemma as "Hpost"`. The biggest changes and new features are: * Logically atomic triples now support private (non-atomic) postconditions, and the notation was changed to not clash with Autosubst any more. Existing users of logically atomic specifications have to update their notation, see the full CHANGELOG for more details. * The meaning of `P -∗ Q` as a Coq proposition has changed from `P ⊢ Q` to `⊢ P -∗ Q`. If you are only using the Iris proofmode, this will not make a difference, but when writing proof scripts or tactics that `rewrite` or `apply` Iris lemmas, the exact position of the `⊢ P -∗ Q` matters and this will now always be visible in lemma statements. * `iCombine` is starting to gain support for a `gives` clause, which yields persistent facts gained from combining the resources. So far, this remains mostly experimental. We support `↦` and the connectives of ghost theories in `base_logic/lib`, but support for `own` and custom cameras is minimal and will be improved in future releases. * Some initial refactoring prepares Iris for eventually supporting transfinite step-indexing. * New resources algebras have been added: `Z`, `max_Z`, `mono_Z`, and `mra` (the monotone resource algebra of https://iris-project.org/pdfs/2021-CPP-monotone-final.pdf) Iris 4.1 supports Coq 8.16-8.18. Coq 8.13-8.15 are no longer supported. This release was managed by Ralf Jung, Robbert Krebbers, and Johannes Hostert, with contributions from Amin Timany, Arthur Azevedo de Amorim, Armaël Guéneau, Benjamin Peters, Dan Frumin, Dorian Lesbre, Ike Mulder, Isaac van Bakel, Jaemin Choi, Janine Lohse, Jan-Oliver Kaiser, Jonas Kastberg Hinrichsen, Lennard Gäher, Mathias Adam Møller, Michael Sammler, Paolo Giarrusso, Pierre Roux, Rodolphe Lepigre, Simcha van Collem, Simon Friis Vindum, Simon Spies, Tej Chajed, Yixuan Chen, and Yusuke Matsushita. Thanks a lot to everyone involved! **Changes in `prelude`:** * Re-export `stdpp.options` from `iris.prelude.options`. This enables 'light' name mangling, which prefixes auto-generated names with `__`. This only affects developments that explicitly opt-in to following the Iris configuration by importing `iris.prelude.options`. **Changes in `algebra`:** * Add (basic) support for `gset` and `gset_disj` cameras to `set_solver`. * Rename `sig_{equiv,dist}_alt` into `sig_{equiv,dist}_def` and state these lemmas using `=` instead of `<->`. * Add custom entry `dfrac` that can be used for `{dq}` / `□` / `{# q}` annotation of connectives with a discardable fraction. * Add an RA on the `Z` type of integers, using addition for `⋅`. * Prepare Iris to generalize the type of step-indices. This is a large series of changes; more changes will follow later. More documentation will follow as part of [this merge request](https://gitlab.mpi-sws.org/iris/iris/-/merge_requests/888). - Change the definition of `dist_later` to an equivalent definition that is future-proof with respect to general step-indices. - Change the definition of the properties of an `ofe` to be slightly more general and future proof (i.e., change `dist_S` into `dist_lt`). - Adapt `f_contractive` to work with the new definition of `dist_later`. For backwards compatibility for existing developments, the tactic `f_contractive_fin` is provided. It uses the old definition of `dist_later`, now called `dist_later_fin`. - If you need to deal with a `dist_later`/`dist_later_fin` in a manual proof, use the tactic `dist_later_intro`/`dist_later_fin_intro` to introduce it. (by Michael Sammler, Lennard Gäher, and Simon Spies) * Add `max_Z` and `mono_Z` cameras. * Add `dfrac_valid`. * Rename `Some_included_2` to `Some_included_mono`. * Consistently use `Some x ≼ Some y` to express the reflexive closure of `x ≼ y`. This changes the statements of some lemmas: `singleton_included`, `local_update_valid0`, `local_update_valid`. Also add various new `Some_included` lemmas to help deal with these assertions. * Add hints for `a ≼ a ⋅ _` / `a ≼ _ ⋅ a` / `ε ≼ _` / `_ ≼ CsumBot` / `_ ≼ ExclBot` with cost 0, which means they are used by `done` to finish proofs. (by Ike Mulder) * Rename `singleton_mono` to `singleton_included_mono`. * Use `Strategy expand` for CMRA/UCMRA coercions and most projections to improve performance of type-checking some large CMRA/OFE types. (by Ike Mulder) * Add monotone resource algebra, `algebra/mra.v`, to enable reasoning about monotonicity with respect to an arbitrary preorder relation: the extension order of `mra R` is designed to embed the preorder relation `R`. (by Amin Timany) * Rename instances `union_with_proper` → `union_with_ne`, `map_fmap_proper` → `map_fmap_ne`, `map_zip_with_proper` → `map_zip_with_ne`. * Rename `dist_option_Forall2` → `option_dist_Forall2`. Add similar lemma `list_dist_Forall2`. * Add instances `option_fmap_dist_inj` and `list_fmap_dist_inj`. * Rename `list_dist_cons_inv_r` → `cons_dist_eq` and remove `list_dist_cons_inv_l` to be consistent with `cons_equiv_eq` in std++. (If you needed `list_dist_cons_inv_l`, you can apply `symmetry` and then use `cons_dist_eq`.) Add similar lemmas `nil_dist_eq`, `app_dist_eq`, `list_singleton_dist_eq`, `dist_Permutation`. **Changes in `bi`:** * Use `binder` in notations for big ops. This means one can write things such as `[∗ map] '(k,_) ↦ '(_,y) ∈ m, ⌜ k = y ⌝`. * Add constructions `bi_tc`/`bi_nsteps` to create the transitive/`n`-step closure of a PROP-level binary relation. (by Simcha van Collem) * Make the `unseal` tactic of `monPred` more consistent with `uPred`: + Rename `MonPred.unseal` → `monPred.unseal` + No longer unfold derived BI connectives ``, `` and `◇`. * Make `monPred.unseal` tactic more robust by using types to unfold the right BI projections. * Add `unseal` tactic for `siProp`. * Add compatibility lemmas for `big_sepL <-> big_sepL2`, `big_sepM <-> big_sepM2` with list/maps of pairs; and `big_sepM <-> big_sepL` via `list_to_map` and `map_to_list`. (by Dorian Lesbre) * Make `persistently_True` a bi-entailment; this changes the default `rewrite` direction. * Make `BiLaterContractive` a class instead of a notation. * Make projections of `Bupd`/`Fupd`/`InternalEq`/`Plainly` operational type classes `Typeclasses Opaque`. * Make BI relations (`bi_rtc`, `bi_tc`, `bi_nsteps`) typeclasses opaque (they were accidentally transparent). * Make the `P -∗ Q` notation in stdpp_scope (i.e., outside of bi_scope) a shorthand for `⊢ P -∗ Q` rather than `P ⊢ Q`. This means that any BI notation used in stdpp_scope will be sugar for adding a leading `⊢` (`bi_emp_valid`). It also means that `apply` becomes sensitive to the difference between `P ⊢ Q` and `P -∗ Q`, and `rewrite` will only work with lemmas that are explicitly written using `⊢`. When a proof breaks, there are generally 3 options: - Try to find the `-∗` that should be turned into a `⊢` so that things work like before. - Adjust the proof to use proof mode tactics rather than Coq tactics (in particular, replace `apply` by `iApply`). - Add some `apply bi.entails_wand`/`apply bi.wand_entails` to 'convert' between the old and new way of interpreting `P -∗ Q`. * Add `auto` hint to introduce the BI version of `↔`. * Change `big_sepM2_alt` to use `dom m1 = dom2 m2` instead of `∀ k, is_Some (m1 !! k) ↔ is_Some (m2 !! k)`. The old lemma is still available as `big_sepM2_alt_lookup`. * Overhaul `Fractional`/`AsFractional`: - Remove `AsFractional → Fractional` instance. - No longer use `AsFractional P Φ q` backwards, from `Φ` and `q` to `P` -- just use `Φ q` instead. - Remove multiplication instances (that also go from `AsFractional` to `Fractional`, making it very hard to reason about search termination). - Rewrite `frame_fractional` lemma using the new `FrameFractionalQp` typeclass for `Qp` reasoning. - Change statements of `fractional_split`, `fractional_half`, and `fractional_merge` to avoid using `AsFractional` backwards, and only keep the bi-directional versions (remove `fractional_split_1`, `fractional_split_2`, `fractional_half_1`, `fractional_half_2`). `iDestruct`/`iCombine`/`iSplitL`/`iSplitR` should be used instead. * Add missing transitivity, symmetry and reflexivity lemmas about the `↔`, `→`, `-∗` and `∗-∗` connectives. (by Ike Mulder) * Add `∗-∗` as notation in `stdpp_scope` similar to `-∗`. This means `P ∗-∗ Q` can be directly used as lemma statement, and is syntactic sugar for `⊢ P ∗-∗ Q`. * Add `≼` connective (`internal_included`) on the BI level. (by Ike Mulder) * Move laws of persistence modality out of `BiMixin` into `BiPersistentlyMixin`. * Provide smart constructor `bi_persistently_mixin_discrete` for `BiPersistentlyMixin`: Given a discrete BI that enjoys the existential property, a trivial definition of the persistence modality can be given. * Fix `greatest_fixpoint_ne'` accidentally being about the least fixpoint. * Add `Plain` instance for `|==> P` when `P` is plain. * Rename `bupd_plain` → `bupd_elim`. * Change notation for atomic updates and atomic accessors to use `<{ ... }>` instead of `<< ... >>`. This avoids a conflict with Autosubst. **Changes in `proofmode`:** * The proof mode introduction patterns "<-" and "->" are considered intuitionistic. This means that tactics such as `iDestruct ... as "->"` will not dispose of hypotheses to perform the rewrite. * Remove tactic `iSolveTC` in favor of `tc_solve` in std++. * The result of `iCombine` is no longer computed with the `FromSep` typeclass, but with a new `CombineSepAs` typeclass. If you provide custom `FromSep` instances and use the `iCombine` tactic, you will need to define additional `CombineSepAs` instances. This is done in preparation for making `iCombine` combine propositions in ways that are not appropriate for how `FromSep` is used. Note that `FromSep` is still used for determining the new goals when applying the `iSplitL` and `iSplitR` tactics. * The `iCombine` tactic now accepts an (optional) 'gives' clause, with which one can learn persistent facts from the combination of two hypotheses. One can register such 'gives' clauses by providing instances of the new `CombineSepGives` typeclass. The 'gives' clause is still experimental; in future versions of Iris it will combine `own` connectives based on the validity rules for cameras. * Make sure that `iStartProof` fails with a proper error message on goals with `let`. These `let`s should either be `simpl`ed or introduced into the Coq context using `intros x`, `iIntros (x)`, or `iIntros "%x"`. This can break some proofs that did `iIntros "?"` on a goal of the shape `let ... in P ⊢ Q`. * Make `iApply`/`iPoseProof`/`iDestruct` more reliable for lemmas whose statement involves `let`. * Remove `string_to_ident`; use `string_to_ident_cps` instead which is in CPS form and hence does not require awful hacks. * The `iFrame` tactic now removes some conjunctions and disjunctions with `False`, since additional `MakeOr` and `MakeAnd` instances were provided. If you use these classes, their results may have become more concise. * Support n-ary versions of `iIntros`, `iRevert`, `iExists`, `iDestruct`, `iMod`, `iFrame`, `iRevertIntros`, `iPoseProof`, `iInduction`, `iLöb`, `iInv`, and `iAssert`. (by Jan-Oliver Kaiser and Rodolphe Lepigre) * Add tactics `ltac1_list_iter` and `ltac1_list_rev_iter` to iterate over lists of `ident`s/`simple intropatterns`/`constr`/etc using Ltac1. See [proofmode/base.v](iris/proofmode/base.v) for documentation on how to use these tactics to convert your own fixed arity tactics to an n-ary variant. * Improve the `IntoPure` instance for internal equality. Whenever possible, `a ≡ b` will now be simplified to `a = b` upon introduction into the pure context. This will break but simplify some existing proofs: `iIntros (H%leibniz_equiv)` should be replaced by `iIntros (H)`. (by Ike Mulder) **Changes in `base_logic`:** * Add `mono_Z` library for monotone non-negative integers. (This has exactly the same lemmas as `mono_nat`. It is useful in cases where one wants to avoid `nat` entirely and use `Z` throughout.) * Add `IsExcept0` instance for invariants, allowing you to remove laters of timeless hypotheses when proving an invariant (without an update). * Make `uPred.unseal` tactic more robust by using types to unfold the right BI projections. * Turn `internal_eq_entails` into a bi-implication. * Add lemmas to relate internal/external non-expansiveness and contractiveness. * Refactor soundness lemmas: `bupd_plain_soundness` → `bupd_soundness`, `soundness` → `laterN_soundness` + `pure_soundness`; removed `consistency_modal`. * Strengthen `cmra_valid_elim` to `✓ a ⊢ ⌜ ✓{0} a ⌝`; make `discrete_valid` a derived law. * Remove `frac_validI`. Instead, move to the pure context (with `%` in the proof mode or `uPred.discrete_valid` in manual proofs) and use `frac_valid`. **Changes in `program_logic`:** * Change the notation for logically atomic triples: we add support for specifying private (non-atomic) postconditions, and we avoid a notation conflict with Autosubst. The new notation looks as follows: `<<{ ∀∀ x, atomic_pre x }>> code @ ∅ <<{ ∃∃ y, atomic_post x y | z, RET v, non_atomic_post x y z }>>`. To keep the notation without private postcondition consistent, the way the return value is specified changes slightly even when there is no private postcondition: `<<{ ∀∀ x, atomic_pre x }>> code @ ∅ <<{ ∃∃ y, atomic_post x y | RET v }>>`. **Changes in `heap_lang`:** * Move operations and lemmas about locations into a module `Loc`. * Extend `wp_apply` and `wp_smart_apply` to support immediately introducing the postcondition into the context via `as (x1 ... xn) "ipat1 ... ipatn"`. * Add comparison `≤` and `<` for locations. (by Arthur Azevedo de Amorim) * Make the generic `lock` interface a typeclass and make sure the lock code does not depend on `Σ`. Code that is generic about lock implementations, or that instantiates that specification, needs adjustment. See [iris_heap_lang/lib/lock.v](iris_heap_lang/lib/lock.v) for documentation on how to work with this specification. * Adjust the generic `atomic_heap` interface to follow the same pattern as `lock`. * Add a generic `rwlock` interface and a spinning implementation. (by Isaac van Bakel) **LaTeX changes:** - Rename `\Alloc` to `\AllocN` and `\Ref` to `\Alloc` for better consistency with the Coq names and to avoid clash with hyperref package. The following `sed` script helps adjust your code to the renaming (on macOS, replace `sed` by `gsed`, installed via e.g. `brew install gnu-sed`). Note that the script is not idempotent, do not run it twice. ``` sed -i -E -f- $(find theories -name "*.v") < _def s/\bsig_equiv_alt\b/sig_equiv_def/g s/\bsig_dist_alt\b/sig_dist_def/g # Loc s/\bloc_add(_assoc|_0|_inj|)\b/Loc.add\1/g s/\bfresh_locs(_fresh|)\b/Loc.fresh\1/g # unseal s/\bMonPred\.unseal\b/monPred\.unseal/g # big op s/\bbig_sepM2_alt\b/big_sepM2_alt_lookup/g s/\bbupd_plain\b/bupd_elim/g # Logical atomicity (will break Autosubst notation!) s/<<>>/\}>>/g # option and list s/\bdist_option_Forall2\b/option_dist_Forall2/g s/\blist_dist_cons_inv_r\b/cons_dist_eq/g EOF ``` The following sed script helps adjust LaTeX documents to these changes: Note that the script is not idempotent, do not run it twice. ``` sed -i -E -f- *.tex < emp ⊣⊢ True`. * Change the notation for atomic updates and atomic accessors (`AU`, `AACC`) to swap the quantifiers: the first quantifier is logically an existential, the second a universal, so let's use the appropriate notation. Also use double quantifiers (`∀∀`, `∃∃`) to make it clear that these are not normal quantifiers (the latter change was also applied to logically atomic triples). * Add some lemmas to show properties of functions defined via monotonoe fixpoints: `least_fixpoint_affine`, `least_fixpoint_absorbing`, `least_fixpoint_persistent_affine`, `least_fixpoint_persistent_absorbing`, `greatest_fixpoint_absorbing`. * Rename `laterN_plus` into `laterN_add`. * Remove `make_laterable` from atomic updates. This relies on Iris now having support for later credits (see below). * Add `Fractional` and `AsFractional` instances for `embed` such that the embedding of something fractional is also fractional. (by Simon Friis Vindum). **Changes in `proofmode`:** * Change `iAssumption` to no longer instantiate evar premises with `False`. This used to occur when the conclusion contains variables that are not in scope of the evar, thus blocking the default behavior of instantiating the premise with the conclusion. The old behavior can be emulated with`iExFalso. iExact "H".` * In `iInduction`, support induction schemes that involve `Forall` and `Forall2` (for example, for trees with finite branching). * Change `iRevert` of a pure hypothesis to generate a magic wand instead of an implication. * Change `of_envs` such that when the persistent context is empty, the persistence modality no longer appears at all. This is a step towards using the proofmode in logics without a persistence modality. The lemma `of_envs_alt` shows equivalence with the old version. * Adjust `IntoWand` instances for non-affine BIs: in many cases where `iSpecialize`/`iApply` of an implication previously failed, it will now instead add an `` modality to the newly generated goal. In some rare cases it might stop working or add an `` modality where previously none was added. **Changes in `base_logic`:** * Make the `inG` instances for `libG` fields local, so they are only used inside the library that defines the `libG`. * Add infrastructure for supporting later credits, by adding a resource `£ n` describing ownership of `n` credits that can be eliminated at fancy updates. + To retain backwards compatibility with the interaction laws of fancy updates with the plainly modality (`BiFUpdPlainly`), which are incompatible with later credits, the logic has a new parameter of type `has_lc`, which is either `HasLc` or `HasNoLc`. The parameter is an index of the `invGS_gen` typeclass; the old `invGS` is an alias for `invGS_gen HasLc` so that developments default to having later credits available. Libraries that want to be generic over whether credits are available or not, and proofs that need `BiFUpdPlainly`, need to be changed to use `invGS_gen` rather than `invGS`. + The core soundness lemma `step_fupdN_soundness_gen` similarly takes a `has_lc` parameter to control how the logic is supposed to be instantiated. The lemma always generates credits, but they cannot be used in any meaningful way unless `HasLc` is picked. * Add discardable fractions `dfrac` to `saved_anything_own`, `saved_prop_own`, and `saved_pred_own`, so they can be updated. The previous persistent versions can be recovered with the fraction `DfracDiscarded`. Allocation lemmas now take a `dq` parameter to define the initial fraction. * Remove an unused fraction argument to `dfrac_valid_discarded`. **Changes in `program_logic`:** * The definition of the weakest precondition has been changed to generate later credits (see `base_logic`) for each step: + The member `num_laters_per_step` of the `irisGS` class now also determines the number of later credits that are generated: `S (num_laters_per_step ns)` if `ns` steps have been taken. + The weakest precondition offers credits after a `prim_step` has been proven. + All lifting lemmas have been altered to provide credits. `wp_lift_step_fupdN` provides `S (num_laters_per_step ns)` credits, while all other lemmas always provide one credit. * In line with the support for later credits (see `base_logic`), `irisGS_gen` now also has a `has_lc` parameter and the adequacy statements have been changed to account for that: + The lemma `twp_total` (total adequacy) provides `irisGS_gen HasNoLc`. Clients of the adequacy proof will need to make sure to be either generic over the choice of `has_lc` or explicitly opt-out of later credits. + The adequacy lemmas for the partial WP, in particular `wp_adequacy`, `wp_strong_adequacy` and `wp_invariance`, are now available in two flavors: the old names generate `irisGS` (a short-hand for `irisGS_gen HasLc`); new lemmas with a `_gen` suffix leave the choice of `has_lc` to the user. + The parameter for the stuckness bit `s` in `wp_strong_adequacy{_lc, _no_lc}` has moved up and is now universally quantified in the lemma instead of being existentially quantified at the Iris-level. For clients that already previously quantified over `s` at the Coq level, the only required change should be to remove the instantiation of the existential quantifier. **Changes in `iris_heap_lang`:** * Change the `num_laters_per_step` of `heap_lang` to `λ n, n`, signifying that each step of the weakest precondition strips `n` laters, where `n` is the number of steps taken so far. This number is tied to ghost state in the state interpretation, which is exposed, updated, and used with new lemmas `wp_lb_init`, `wp_lb_update`, and `wp_step_fupdN_lb`. (by Jonas Kastberg Hinrichsen) * Make pattern argument of `wp_pure` tactic optional (defaults to wildcard pattern, matching all redexes). * In line with the support for later credits (see `base_logic`), the tactic `wp_pure` now takes an optional parameter `credit:"H"` which generates a hypothesis `H` for a single later credit `£ 1` that can be eliminated using `lc_fupd_elim_later`. The typeclass `heapGS_gen` now takes an additional `has_lc` parameter, and `heapGS` is a short-hand for `heapGS_gen HasLc`. The adequacy statements for HeapLang have been changed accordingly: + `heap_adequacy` provides `heapGS`, thus enabling the use of later credits. This precludes usage of the laws in `BiFUpdPlainly` in the HeapLang instance of Iris. + `heap_total` provides `heapGS_gen HasNoLc`. The following `sed` script helps adjust your code to the renaming (on macOS, replace `sed` by `gsed`, installed via e.g. `brew install gnu-sed`). Note that the script is not idempotent, do not run it twice. ``` sed -i -E -f- $(find theories -name "*.v") < `Next_inj`. * Remove `view_auth_frac_op`, `auth_auth_frac_op`, `gmap_view_auth_frac_op`; the corresponding `dfrac` lemmas can be used instead (together with `dfrac_op_own` if needed). * Equip `mono_nat` algebra with support for `dfrac`, make API more consistent, and add notation for algebra elements. See `iris/algebra/lib/mono_nat.v` for details. This affects some existing terms and lemmas: - `mono_nat_auth` now takes a `dfrac`, but the recommendation is to port to the notation. - `mono_nat_lb_op`: direction of equality is swapped. - `mono_nat_auth_frac_op`, `mono_nat_auth_frac_op_valid`, `mono_nat_auth_frac_valid`, `mono_nat_both_frac_valid`: use `dfrac` variant instead. * Add `mono_list` algebra for monotonically growing lists with an exclusive authoritative element and persistent prefix witnesses. See `iris/algebra/lib/mono_list.v` for details. **Changes in `bi`:** * Rename `least_fixpoint_ind` into `least_fixpoint_iter`, rename `greatest_fixpoint_coind` into `greatest_fixpoint_coiter`, rename `least_fixpoint_strong_ind` into `least_fixpoint_ind`, add lemmas `least_fixpoint_{ind_wf, ne', strong_mono}`, and add lemmas `greatest_fixpoint_{coind, paco, ne', strong_mono}`. * Move `persistently_forall_2` (`∀ ⊢ ∀`) out of the BI interface into a new typeclass, `BiPersistentlyForall`. The BI interface instead just demands the equivalent property for conjunction (`( P) ∧ ( Q) ⊢ (P ∧ Q)`). This enables the IPM to support logics where the persistently modality is defined with an existential quantifier. This also necessitates removing `persistently_impl_plainly` from `BiPlainly` into a new typeclass `BiPersistentlyImplPlainly`. Proofs that are generic in `PROP` might have to add those new classes as assumptions to remain compatible, and code that instantiates the BI interface needs to provide instances for the new classes. * Make `frame_fractional` not an instance any more; instead fractional propositions that want to support framing are expected to register an appropriate instance themselves. HeapLang and gen_heap `↦` still support framing, but the other fractional propositions in Iris do not. * Strenghten the `Persistent`/`Affine`/`Timeless` results for big ops. Add a `'` to the name of the weaker results, which remain to be used as instances. **Changes in `heap_lang`:** * The `is_closed_expr` predicate is formulated in terms of a set of binders (as opposed to a list of binders). The following `sed` script helps adjust your code to the renaming (on macOS, replace `sed` by `gsed`, installed via e.g. `brew install gnu-sed`). Note that the script is not idempotent, do not run it twice. ``` sed -i -E -f- $(find theories -name "*.v") <`/`→`. - Strengthen to ensure that functions for recursive calls are non-expansive. * Add `big_andM` (big conjunction on finite maps) with lemmas similar to `big_andL`. * Add transitive embedding that constructs an embedding of `PROP1` into `PROP3` by combining the embeddings of `PROP1` into `PROP2` and `PROP2` into `PROP3`. This construct is *not* declared as an instance to avoid TC search divergence. (by Hai Dang, BedRock Systems) * Improve notation printing around magic wands, view shifts, `WP`, Texan triples, and logically atomic triples. * Slight change to the `AACC` notation for atomic accessors (which is usually only printed, not parsed): added a `,` before `ABORT`, for consistency with `COMM`. * Add the lemmas `big_sepM_impl_strong` and `big_sepM_impl_dom_subseteq` that generalize the existing `big_sepM_impl` lemma. (by Simon Friis Vindum) * Add new instance `fractional_big_sepL2`. (by Paolo G. Giarrusso, BedRock Systems) **Changes in `proofmode`:** * Add support for pure names `%H` in intro patterns. This is now natively supported whereas the previous experimental support required installing https://gitlab.mpi-sws.org/iris/string-ident. (by Tej Chajed) * Add support for destructing existentials with the intro pattern `[%x ...]`. (by Tej Chajed) * `iMod`/`iModIntro` show proper error messages when they fail due to mask mismatches. To support this, the proofmode typeclass `FromModal` now takes an additional pure precondition. * Fix performance of `iFrame` in logics without `BiAffine`. To adjust your code if you use such logics and define `Frame` instances, ensure these instances to have priority at least 2: they should have either at least 2 (non-dependent) premises, or an explicit priority. References: docs for `frame_here_absorbing` in [iris/proofmode/frame_instances.v](iris/proofmode/frame_instances.v) and https://coq.inria.fr/refman/addendum/type-classes.html#coq:cmd.Instance. (by Paolo G. Giarrusso, BedRock Systems) * Rename the main entry point module for the proofmode from `iris.proofmode.tactics` to `iris.proofmode.proofmode`. Under normal circumstances, this should be the only proofmode file you need to import. * Improve performance of the `iIntoEmpValid` tactic used by `iPoseProof`, especially in the case of large goals and lemmas with many forall quantifiers. (by Armaël Guéneau) * Improve performance of the `iDestruct` tactic, by using user-provided names more eagerly in order to avoid later calls to `iRename`. (by Armaël Guéneau) **Changes in `bi`:** * Add lemmas characterizing big-ops over pure predicates (`big_sep*_pure*`). * Move `BiAffine`, `BiPositive`, `BiLöb`, and `BiPureForall` from `bi.derived_connectives` to `bi.extensions`. * Strengthen `persistent_fractional` to support propositions that are persistent and either affine or absorbing. (by Paolo G. Giarrusso, BedRock Systems) **Changes in `base_logic`:** * Add `ghost_map`, a logic-level library for a `gmap K V` with an authoritative view and per-element points-to facts written `k ↪[γ] w`. * Generalize the soundness lemma of the base logic `step_fupdN_soundness`. It applies even if invariants stay open accross an arbitrary number of laters. (by Jacques-Henri Jourdan) * Rename those `*G` typeclasses that must be global singletons to `*GS`, and their corresponding `preG` class to `GpreS`. Affects `invG`, `irisG`, `gen_heapG`, `inv_heapG`, `proph_mapG`, `ownPG`, `heapG`. **Changes in `program_logic`:** * Change definition of weakest precondition to use a variable number of laters (i.e., logical steps) for each physical step of the operational semantics, depending on the number of physical steps executed since the begining of the execution of the program. See merge request [!595](https://gitlab.mpi-sws.org/iris/iris/-/merge_requests/595). This implies several API-breaking changes, which can be easily fixed in client formalizations in a backward compatible manner as follows: - Ignore the new parameter `ns` in the state interpretation, which corresponds to a step counter. - Use the constant function "0" for the new field `num_laters_per_step` of `irisG`. - Use `fupd_intro _ _` for the new field `state_interp_mono` of `irisG`. - Some proofs using lifting lemmas and adequacy theorems need to be adapted to ignore the new step counter. (by Jacques-Henri Jourdan) * Remove `wp_frame_wand_l`; add `wp_frame_wand` as more symmetric replacement. * Swap the polarity of the mask in logically atomic triples, so that it matches regular `WP` masks. * Rename `iris_invG` to `iris_invGS`. **Changes in `heap_lang`:** * Rename `Build_loc` constructor for `loc` type to `Loc`. * Add atomic `Xchg` ("exchange"/"swap") operation. (by Simon Hudon, Google LLC) The following `sed` script helps adjust your code to the renaming (on macOS, replace `sed` by `gsed`, installed via e.g. `brew install gnu-sed`). Note that the script is not idempotent, do not run it twice. ``` sed -i -E -f- $(find theories -name "*.v") <` to get rid of the `fupd` in the goal if `E2 ⊆ E1`. The lemma `fupd_mask_weaken Enew` can be `iApply`ed to shrink the first mask to `Enew` without getting rid of the modality; the same effect can also be obtained slightly more conveniently by using `iMod` with `fupd_mask_subseteq Enew`. To make the new names work, rename some existing lemmas: `fupd_intro_mask` → `fupd_mask_intro_subseteq`, `fupd_intro_mask'` → `fupd_mask_subseteq` (implicit arguments also changed here), `fupd_mask_weaken` → `fupd_mask_intro_discard`. Remove `fupd_mask_same` since it was unused and obscure. In the `BiFUpd` axiomatization, rename `bi_fupd_mixin_fupd_intro_mask` to `bi_fupd_mixin_fupd_mask_subseteq` and weaken the lemma to be specifically about `emp` (the stronger version can be derived). * Remove `bi.tactics` with tactics that predate the proofmode (and that have not been working properly for quite some time). * Strengthen `persistent_sep_dup` to support propositions that are persistent and either affine or absorbing. * Fix the statement of the lemma `fupd_plainly_laterN`; the old lemma was a duplicate of `fupd_plain_laterN`. * Strengthen `big_sepL2_app_inv` by weakening a premise (it is sufficient for one of the two pairs of lists to have equal length). * Rename `equiv_entails` → `equiv_entails_1_1`, `equiv_entails_sym` → `equiv_entails_1_2`, and `equiv_spec` → `equiv_entails`. * Remove the laws `pure_forall_2 : (∀ a, ⌜ φ a ⌝) ⊢ ⌜ ∀ a, φ a ⌝` from the BI interface and factor it into a type class `BiPureForall`. **Changes in `proofmode`:** * The proofmode now preserves user-supplied names for existentials when using `iDestruct ... as (?) "..."`. This is backwards-incompatible if you were relying on the previous automatic names (which were always "H", possibly freshened). It also requires some changes if you were implementing `IntoExist` yourself, since the typeclass now forwards names. If your instance transforms one `IntoExist` into another, you can generally just forward the name from the premise. * The proofmode also preserves user-supplied names in `iIntros`, for example with `iIntros (?)` and `iIntros "%"`, as described for destructing existentials above. As part of this change, it now uses a base name of `H` for pure facts rather than the previous default of `a`. This also requires some changes if you were implementing `FromForall`, in order to forward names. * Make `iFrame` "less" smart w.r.t. clean up of modalities. It now consistently removes the modalities ``, ``, `` and `□` only if the result after framing is `True` or `emp`. In particular, it no longer removes `` if the result after framing is affine, and it no longer removes `□` if the result after framing is intuitionistic. * Allow framing below an `` modality if the hypothesis that is framed is affine. (Previously, framing below `` was only possible if the hypothesis that is framed resides in the intuitionistic context.) * Add Coq side-condition `φ` to class `ElimAcc` (similar to what we already had for `ElimInv` and `ElimModal`). * Add a tactic `iSelect pat tac` (similar to `select` in std++) which runs the tactic `tac H` with the name `H` of the last hypothesis of the intuitionistic or spatial context matching `pat`. The tactic `iSelect` is used to implement: + `iRename select (pat)%I into name` which renames the matching hypothesis, + `iDestruct select (pat)%I as ...` which destructs the matching hypothesis, + `iClear select (pat)%I` which clears the matching hypothesis, + `iRevert select (pat)%I` which reverts the matching hypothesis, + `iFrame select (pat)%I` which cancels the matching hypothesis. **Changes in `base_logic`:** * Add a `ghost_var` library that provides (fractional) ownership of a ghost variable of arbitrary `Type`. * Define a ghost state library on top of the `mono_nat` resource algebra. See [base_logic.lib.mono_nat](iris/base_logic/lib/mono_nat.v) for further information. * Define a ghost state library on top of the `gset_bij` resource algebra. See [base_logic.lib.gset_bij](iris/base_logic/lib/gset_bij.v) for further information. * Extend the `gen_heap` library with read-only points-to assertions using [discardable fractions](iris/algebra/dfrac.v). + The `mapsto` connective now takes a `dfrac` rather than a `frac` (i.e., positive rational number `Qp`). + The notation `l ↦{ dq } v` is generalized to discardable fractions `dq : dfrac`. + The new notation `l ↦{# q} v` is used for a concrete fraction `q : frac` (e.g., to enable writing `l ↦{# 1/2} v`). + The new notation `l ↦□ v` is used for the discarded fraction. This persistent proposition provides read-only access to `l`. + The lemma `mapsto_persist : l ↦{dq} v ==∗ l ↦□ v` is used for making the location `l` read-only. + See the [changes to HeapLang](https://gitlab.mpi-sws.org/iris/iris/-/merge_requests/554) for an indication on how to adapt your language. + See the [changes to iris-examples](https://gitlab.mpi-sws.org/iris/examples/-/commit/a8425b708ec51d918d5cf6eb3ab6fde88f4e2c2a) for an indication on how to adapt your development. In particular, instead of `∃ q, l ↦{q} v` you likely want to use `l ↦□ v`, which has the advantage of being persistent (rather than just duplicable). * Change type of some ghost state lemmas (mostly about allocation) to use `∗` instead of `∧` (consistent with our usual style). This affects the following lemmas: `own_alloc_strong_dep`, `own_alloc_cofinite_dep`, `own_alloc_strong`, `own_alloc_cofinite`, `own_updateP`, `saved_anything_alloc_strong`, `saved_anything_alloc_cofinite`, `saved_prop_alloc_strong`, `saved_prop_alloc_cofinite`, `saved_pred_alloc_strong`, `saved_pred_alloc_cofinite`, `auth_alloc_strong`, `auth_alloc_cofinite`, `auth_alloc`. * Change `uPred_mono` to only require inclusion at the smaller step-index. * Put `iProp`/`iPreProp`-isomorphism into the `own` construction. This affects clients that define higher-order ghost state constructions. Concretely, when defining an `inG`, the functor no longer needs to be applied to `iPreProp`, but should be applied to `iProp`. This avoids clients from having to push through the `iProp`/`iPreProp`-isomorphism themselves, which is now handled once and for all by the `own` construction. * Rename `gen_heap_ctx` to `gen_heap_interp`, since it is meant to be used in the state interpretation of WP and since `_ctx` is elsewhere used as a suffix indicating "this is a persistent assumption that clients should always have in their context". Likewise, rename `proph_map_ctx` to `proph_map_interp`. * Move `uPred.prod_validI`, `uPred.option_validI`, and `uPred.discrete_fun_validI` to the new `base_logic.algebra` module. That module is exported by `base_logic.base_logic` so these names are now usually available everywhere, and no longer inside the `uPred` module. * Remove the `gen_heap` notations `l ↦ -` and `l ↦{q} -`. They were barely used and looked very confusing in context: `l ↦ - ∗ P` looks like a magic wand. * Change `gen_inv_heap` notation `l ↦□ I` to `l ↦_I □`, so that `↦□` can be used by `gen_heap`. * Strengthen `mapsto_valid_2` conclusion from `✓ (q1 + q2)%Qp` to `⌜✓ (q1 + q2)%Qp ∧ v1 = v2⌝`. * Change `gen_heap_init` to also return ownership of the points-to facts for the initial heap. * Rename `mapsto_mapsto_ne` to `mapsto_frac_ne`, and add a simpler `mapsto_ne` that does not require reasoning about fractions. * Deprecate the `auth` and `sts` modules. These were logic-level wrappers around the underlying RAs; as far as we know, they are unused since they were not flexible enough for practical use. * Deprecate the `viewshift` module, which defined a binary view-shift connective with an implicit persistence modality. It was unused and too easily confused with `={_}=∗`, the binary view-shift (fancy update) *without* a persistence modality. **Changes in `program_logic`:** * `wp_strong_adequacy` now applies to an initial state with multiple threads instead of only a single thread. The derived adequacy lemmas are unchanged. * `pure_exec_fill` is no longer registered as an instance for `PureExec`, to avoid TC search attempting to apply this instance all the time. * Merge `wp_value_inv`/`wp_value_inv'` into `wp_value_fupd`/`wp_value_fupd'` by making the lemmas bidirectional. * Generalize HeapLang's `mapsto` (`↦`), `array` (`↦∗`), and atomic heap connectives to discardable fractions. See the CHANGELOG entry in the category `base_logic` for more information. * Opening an invariant or eliminating a mask-changing update modality around a non-atomic weakest precondition creates a side-condition `Atomic ...`. Before, this would fail with the unspecific error "iMod: cannot eliminate modality (|={E1,E2}=> ...) in (WP ...)". * In `Ectx_step` and `step_atomic`, mark the parameters that are determined by the goal as implicit. * Deprecate the `hoare` module to prevent accidental usage; the recommended way to write Hoare-style specifications is to use Texan triples. **Changes in `heap_lang`:** * `wp_pures` now turns goals of the form `WP v {{ Φ }}` into `Φ v`. * Fix `wp_bind` in case of a NOP (i.e., when the given expression pattern is already at the top level). * The `wp_` tactics now preserve the possibility of doing a fancy update when the expression reduces to a value. * Move `IntoVal`, `AsVal`, `Atomic`, `AsRecV`, and `PureExec` instances to their own file [heap_lang.class_instances](iris_heap_lang/class_instances.v). * Move `inv_head_step` tactic and `head_step` auto hints (now part of new hint database `head_step`) to [heap_lang.tactics](iris_heap_lang/tactics.v). * The tactic `wp_apply` no longer performs `wp_pures` before applying the given lemma. The new tactic `wp_smart_apply` repeatedly performs single `wp_pure` steps until the lemma matches the goal. The following `sed` script helps adjust your code to the renaming (on macOS, replace `sed` by `gsed`, installed via e.g. `brew install gnu-sed`). Note that the script is not idempotent, do not run it twice. ``` sed -i -E -f- $(find theories -name "*.v") < ■ (P -∗ Q) -∗ coreP P -∗ coreP Q`. * Remove notation for 3-mask step-taking updates, and made 2-mask notation less confusing by distinguishing it better from mask-changing updates. Old: `|={Eo,Ei}▷=> P`. New: `|={Eo}[Ei]▷=> P`. Here, `Eo` is the "outer mask" (used at the beginning and end) and `Ei` the "inner mask" (used around the ▷ in the middle). As part of this, the lemmas about the 3-mask variant were changed to be about the 2-mask variant instead, and `step_fupd_mask_mono` now also has a more consistent argument order for its masks. * Add a counterexample showing that sufficiently powerful cancellable invariants with a linear token subvert the linearity guarantee (see `bi.lib.counterexmples` for details). * Redefine invariants as "semantic invariants" so that they support splitting and other forms of weakening. * Add lemmas `inv_combine` and `inv_combine_dup_l` for combining invariants. * Add the type `siProp` of "plain" step-indexed propositions, together with basic proofmode support. * New ASCII versions of Iris notations. These are marked parsing only and can be made available using `Require Import iris.bi.ascii`. The new notations are (notations marked [†] are disambiguated using notation scopes): - entailment: `|-` for `⊢` and `-|-` for `⊣⊢` - logic[†]: `->` for `→`, `/\\` for `∧`, `\\/` for `∨`, and `<->` for `↔` - quantifiers[†]: `forall` for `∀` and `exists` for `∃` - separation logic: `**` for `∗`, `-*` for `-∗`, and `*-*` for `∗-∗` - step indexing: `|>` for `▷` - modalities: `<#>` for `□` and `` for `◇` - most derived notations can be computed from previous notations using the substitutions above, e.g. replace `∗` with `*` and `▷` with `|>`. Examples include the following: - `|={E1,E2}=* P` for `|={E1,E2}=∗` - `P ={E}=* Q` for `P ={E}=∗ Q` - `P ={E1,E2}=* Q` for `P ={E1,E2}=∗ Q` - `|={E1}[E2]|>=> Q` for `|={E1}[E2]▷=> Q` The full list can be found in [theories/bi/ascii.v](theories/bi/ascii.v), where the ASCII notations are defined in terms of the unicode notations. * Add affine, absorbing, persistent and timeless instances for telescopes. * Add a construction `bi_rtc` to create reflexive transitive closures of PROP-level binary relations. * Slightly strengthen the lemmas `big_sepL_nil'`, `big_sepL2_nil'`, `big_sepM_nil'` `big_sepM2_empty'`, `big_sepS_empty'`, and `big_sepMS_empty'`. They now only require that the argument `P` is affine instead of the whole BI being affine. * Add `big_sepL_insert_acc`, a variant of `big_sepL_lookup_acc` which allows updating the value. * Add many missing `Proper`/non-expansiveness lemmas for big-ops. * Add `big_*_insert_delete` lemmas to split a `<[i:=x]> m` map into `i` and the rest. * Seal the definitions of `big_opS`, `big_opMS`, `big_opM` and `big_sepM2` to prevent undesired simplification. * Fix `big_sepM2_fmap*` only working for `nat` keys. **Changes in `proofmode`:** * Make use of `notypeclasses refine` in the implementation of `iPoseProof` and `iAssumption`, see . This has two consequences: 1. Coq's "new" unification algorithm (the one in `refine`, not the "old" one in `apply`) is used more often by the proof mode tactics. 2. Due to the use of `notypeclasses refine`, TC constraints are solved less eagerly, see . In order to port your development, it is often needed to instantiate evars explicitly (since TC search is performed less eagerly), and in few cases it is needed to unfold definitions explicitly (due to new unification algorithm behaving differently). * Strengthen the tactics `iDestruct`, `iPoseProof`, and `iAssert`: - They succeed in certain cases where they used to fail. - They keep certain hypotheses in the intuitionistic context, where they were moved to the spatial context before. The latter can lead to stronger proof mode contexts, and therefore to backwards incompatibility. This can usually be fixed by manually clearing some hypotheses. A more detailed description of the changes can be found in . * Remove the long-deprecated `cofeT` alias (for `ofeT`) and `dec_agree` RA (use `agree` instead). * Add `auto` hint for `∗-∗`. * Add new tactic `iStopProof` to turn the proof mode entailment into an ordinary Coq goal `big star of context ⊢ proof mode goal`. * Add new introduction pattern `-# pat` that moves a hypothesis from the intuitionistic context to the spatial context. * The tactic `iAssumption` also recognizes assumptions `⊢ P` in the Coq context. * Better support for telescopes in the proof mode, i.e., all tactics should recognize and distribute telescopes now. * The proof mode now supports names for pure facts in intro patterns. Support requires implementing `string_to_ident`. Without this tactic such patterns will fail. We provide one implementation using Ltac2 which works with Coq 8.11 and can be installed with opam; see [iris/string-ident](https://gitlab.mpi-sws.org/iris/string-ident) for details. **Changes in `algebra`:** * Remove `Core` type class for defining the total core; it is now always defined in terms of the partial core. The only user of this type class was the STS RA. * The functions `{o,r,ur}Functor_diag` are no longer coercions, and renamed into `{o,r,ur}Functor_apply` to better match their intent. This fixes "ambiguous coercion path" warnings. * Rename `{o,r,ur}Functor_{ne,id,compose,contractive}` into `{o,r,ur}Functor_map_{ne,id,compose,contractive}`. * Move derived camera constructions (`frac_auth` and `ufrac_auth`) to the folder `algebra/lib`. * Rename `mnat` to `max_nat` and "box" it by creating a separate type for it. * Move the RAs for `nat` and `positive` and the `mnat` RA into a separate module. They must now be imported from `From iris.algebra Require Import numbers`. * Make names of `f_op`/`f_core` rewrite lemmas more consistent by always making `_core`/`_op` the suffix: `op_singleton` → `singleton_op`, `core_singleton` → `singleton_core`, `discrete_fun_op_singleton` → `discrete_fun_singleton_op`, `discrete_fun_core_singleton` → `discrete_fun_singleton_core`, `list_core_singletonM` → `list_singleton_core`, `list_op_singletonM` → `list_singleton_op`, `sts_op_auth_frag` → `sts_auth_frag_op`, `sts_op_auth_frag_up` → `sts_auth_frag_up_op`, `sts_op_frag` → `sts_frag_op`, `list_op_length` → `list_length_op`, `list_core_singletonM` → `list_singletonM_core`, `list_op_singletonM` → `list_singletonM_op`. * All list "map singleton" lemmas consistently use `singletonM` in their name: `list_singleton_valid` → `list_singletonM_valid`, `list_singleton_core_id` → `list_singletonM_core_id`, `list_singleton_snoc` → `list_singletonM_snoc`, `list_singleton_updateP` → `list_singletonM_updateP`, `list_singleton_updateP'` → `list_singletonM_updateP'`, `list_singleton_update` → `list_singletonM_update`, `list_alloc_singleton_local_update` → `list_alloc_singletonM_local_update`. * Remove `auth_both_op` and rename `auth_both_frac_op` into `auth_both_op`. * Add lemma `singleton_included : {[ i := x ]} ≼ ({[ i := y ]} ↔ x ≡ y ∨ x ≼ y`, and rename existing asymmetric lemmas (with a singleton on just the LHS): `singleton_includedN` → `singleton_includedN_l`, `singleton_included` → `singleton_included_l`, `singleton_included_exclusive` → `singleton_included_exclusive_l`. * Add notion `ofe_iso A B` that states that OFEs `A` and `B` are isomorphic. This is used in the COFE solver. * Add `{o,r,ur}Functor_oFunctor_compose` for composition of functors. * Add `pair_op_1` and `pair_op_2` to split a pair where one component is the unit. * Add derived camera construction `excl_auth A` for `auth (option (excl A))`. * Make lemma `Excl_included` a bi-implication. * Make `auth_update_core_id` work with any fraction of the authoritative element. * Add `min_nat`, an RA for natural numbers with `min` as the operation. * Add many missing `Proper`/non-expansiveness lemmas for maps and lists. * Add `list_singletonM_included` and `list_lookup_singletonM_{lt,gt}` lemmas about singletons in the list RA. * Add `list_core_id'`, a stronger version of `list_core_id` which only talks about elements that are actually in the list. The following `sed` script helps adjust your code to the renaming (on macOS, replace `sed` by `gsed`, installed via e.g. `brew install gnu-sed`). Note that the script is not idempotent, do not run it twice. ``` sed -i -E ' # functor renames s/\b(o|r|ur)Functor_(ne|id|compose|contractive)\b/\1Functor_map_\2/g # singleton_included renames s/\bsingleton_includedN\b/singleton_includedN_l/g s/\bsingleton_included\b/singleton_included_l/g s/\bsingleton_included_exclusive\b/singleton_included_exclusive_l/g # f_op/f_core renames s/\b(op|core)_singleton\b/singleton_\1/g s/\bdiscrete_fun_(op|core)_singleton\b/discrete_fun_singleton_\1/g s/\bsts_op_(auth_frag|auth_frag_up|frag)\b/sts_\1_op/g s/\blist_(op|core)_singletonM\b/list_singletonM_\1/g s/\blist_op_length\b/list_length_op/g # list "singleton map" renames s/\blist_singleton_valid\b/list_singletonM_valid/g s/\blist_singleton_core_id\b/list_singletonM_core_id/g s/\blist_singleton_snoc\b/list_singletonM_snoc/g s/\blist_singleton_updateP\b/list_singletonM_updateP/g s/\blist_singleton_update\b/list_singletonM_update/g s/\blist_alloc_singleton_local_update\b/list_alloc_singletonM_local_update/g # inv renames s/\binv_sep(|_1|_2)\b/inv_split\1/g s/\binv_acc\b/inv_alter/g s/\binv_open(|_strong|_timeless)\b/inv_acc\1/g s/\bcinv_open(|_strong)\b/cinv_acc\1/g s/\b(na_inv|auth|sts)_open\b/\1_acc/g # miscellaneous s/\bauth_both_frac_op\b/auth_both_op/g s/\bmnat\b/max_nat/g s/\bcoreP_wand\b/coreP_entails/g ' $(find theories -name "*.v") ``` ## Iris 3.2.0 (released 2019-08-29) The highlight of this release is the completely re-engineered interactive proof mode. Not only did many tactics become more powerful; the entire proof mode can now be used not just for Iris but also for other separation logics satisfying the proof mode interface (e.g., [Iron] and [GPFSL]). Also see the [accompanying paper][MoSeL]. [Iron]: https://iris-project.org/iron/ [GPFSL]: https://gitlab.mpi-sws.org/iris/gpfsl/ [MoSeL]: https://iris-project.org/mosel/ Beyond that, the Iris program logic gained the ability to reason about potentially stuck programs, and a significantly strengthened adequacy theorem that unifies the three previously separately presented theorems. There are now also Hoare triples for total program correctness (but with very limited support for invariants) and logical atomicity. And finally, our example language HeapLang was made more realistic (Compare-and-set got replaced by compare-exchange and limited to only compare values that can actually be compared atomically) and more powerful, with added support for arrays and prophecy variables. Further details are given in the changelog below. This release of Iris received contributions by Aleš Bizjak, Amin Timany, Dan Frumin, Glen Mével, Hai Dang, Hugo Herbelin, Jacques-Henri Jourdan, Jan Menz, Jan-Oliver Kaiser, Jonas Kastberg Hinrichsen, Joseph Tassarotti, Mackie Loeffel, Marianna Rapoport, Maxime Dénès, Michael Sammler, Paolo G. Giarrusso, Pierre-Marie Pédrot, Ralf Jung, Robbert Krebbers, Rodolphe Lepigre, and Tej Chajed. Thanks a lot to everyone involved! **Changes in the theory of Iris itself:** * 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". * Add weakest preconditions for total program correctness. * "(Potentially) stuck" weakest preconditions and the "plainly modality" are no longer considered experimental. * Add the notion of an "observation" to the language interface, so that every reduction step can optionally be marked with an event, and an execution trace has a matching list of events. Change WP so that it is told the entire future trace of observations from the beginning. * 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. * Add atomic updates and logically atomic triples, including tactic support. See `heap_lang/lib/increment.v` for an example. * Extend the state interpretation with a natural number that keeps track of the number of forked-off threads, and have a global fixed proposition that describes the postcondition of each forked-off thread (instead of it being `True`). * A stronger adequacy statement for weakest preconditions that involves the final state, the post-condition of forked-off threads, and also applies if the main-thread has not terminated. * The user-chosen functor used to instantiate the Iris logic now goes from COFEs to Cameras (it was OFEs to Cameras). **Changes in heap_lang:** * CAS (compare-and-set) got replaced by CmpXchg (compare-exchange). The difference is that CmpXchg returns a pair consisting of the old value and a boolean indicating whether the comparison was successful and hence the exchange happened. CAS can be obtained by simply projecting to the second component, but also providing the old value more closely models the primitive typically provided in systems languages (C, C++, Rust). The comparison by this operation also got weakened to be efficiently implementable: CmpXchg may only be used to compare "unboxed" values that can be represented in a single machine word. It is sufficient if one of the two compared values is unboxed. * For consistency, the restrictions CmpXchg imposes on comparison also apply to the `=` binary operator. This also fixes the long-standing problem that that operator allowed compared closures with each other. * Implement prophecy variables using the new support for "observations". The erasure theorem (showing that prophecy variables do not alter program behavior) can be found [in the iris/examples repository][prophecy-erasure]. * heap_lang now uses right-to-left evaluation order. This makes it significantly easier to write specifications of curried functions. * heap_lang values are now injected in heap_lang expressions via a specific constructor of the expr inductive type. This simplifies much the tactical infrastructure around the language. In particular, this allow us to get rid the reflection mechanism that was needed for proving closedness, atomicity and "valueness" of a term. The price to pay is the addition of new "administrative" reductions in the operational semantics of the language. * heap_lang now has support for allocating, accessing and reasoning about arrays (continuously allocated regions of memory). * One can now assign "meta" data to heap_lang locations. [prophecy-erasure]: https://gitlab.mpi-sws.org/iris/examples/blob/3f33781fe6e19cfdb25259c8194d34403f1134d5/theories/logatom/proph_erasure.v **Changes in Coq:** * An all-new generalized proof mode that abstracts away from Iris! 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 searching 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. * The new `iEval` tactic can be used to execute a simplification or rewriting tactic on some specific part(s) of the proofmode 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 CMRA even for an infinite domain. * Rename proof mode type classes for laters: - `IntoLaterN` → `MaybeIntoLaterN` (this one _may_ strip a later) - `IntoLaterN'` → `IntoLaterN` (this one _should_ strip a later) - `IntoLaterNEnv` → `MaybeIntoLaterNEnv` - `IntoLaterNEnvs` → `MaybeIntoLaterNEnvs` * Rename: - `frag_auth_op` → `frac_auth_frag_op` - `cmra_opM_assoc` → `cmra_op_opM_assoc` - `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. * `wp_fork` is now written in curried form. * `PureExec`/`wp_pure` now supports taking multiple steps at once. * A new tactic, `wp_pures`, executes as many pure steps as possible, excluding steps that would require unlocking subterms. Every impure wp_ tactic executes this tactic before doing anything else. * Add `big_sepM_insert_acc`. * Add big separating conjunctions that operate on pairs of lists (`big_sepL2`) and on pairs of maps (`big_sepM2`). In the former case the lists are required to have the same length, and in the latter case the maps are required to have the same domains. * The `_strong` lemmas (e.g. `own_alloc_strong`) work for all infinite sets, instead of just for cofinite sets. The versions with cofinite sets have been renamed to use the `_cofinite` suffix. * Remove locked value lambdas. The value scope notations `rec: f x := e` and `(λ: x, e)` no longer add a `locked`. Instead, we made the `wp_` tactics smarter to no longer unfold lambdas/recs that occur behind definitions. * Export the fact that `iPreProp` is a COFE. * The CMRA `auth` now can have fractional authoritative parts. So now `auth` has 3 types of elements: the fractional authoritative `●{q} a`, the full authoritative `● a ≡ ●{1} a`, and the non-authoritative `◯ a`. Updates are only possible with the full authoritative element `● a`, while fractional authoritative elements have agreement: `✓ (●{p} a ⋅ ●{q} b) ⇒ a ≡ b`. As a consequence, `auth` is no longer a COFE and does not preserve Leibniz equality. * Add a COFE construction (and functor) on dependent pairs `sigTO`, dual to `discrete_funO`. * Rename in `auth`: - Use `auth_auth_proj`/`auth_frag_proj` for the projections of `auth`: `authoritative` → `auth_auth_proj` and `auth_own` → `auth_frag_proj`. - Use `auth_auth` and `auth_frag` for the injections into authoritative elements and non-authoritative elements respectively. - Lemmas for the projections and injections are renamed accordingly. For examples: + `authoritative_validN` → `auth_auth_proj_validN` + `auth_own_validN` → `auth_frag_proj_validN` + `auth_auth_valid` was not renamed because it was already used for the authoritative injection. - `auth_both_valid` → `auth_both_valid_2` - `auth_valid_discrete_2` → `auth_both_valid` * Add the camera `ufrac` for unbounded fractions (i.e. without fractions that can be `> 1`) and the camera `ufrac_auth` for a variant of the authoritative fractional camera (`frac_auth`) with unbounded fractions. * Changed `frac_auth` notation from `●!`/`◯!` to `●F`/`◯F`. sed script: `s/◯!/◯F/g; s/●!/●F/g;`. * Lemma `prop_ext` works in both directions; its default direction is the opposite of what it used to be. * Make direction of `f_op` rewrite lemmas more consistent: Flip `pair_op`, `Cinl_op`, `Cinr_op`, `cmra_morphism_op`, `cmra_morphism_pcore`, `cmra_morphism_core`. * Rename lemmas `fupd_big_sep{L,M,S,MS}` into `big_sep{L,M,S,MS}_fupd` to be consistent with other such big op lemmas. Also add such lemmas for `bupd`. * Rename `C` suffixes into `O` since we no longer use COFEs but OFEs. Also rename `ofe_fun` into `discrete_fun` and the corresponding notation `-c>` into `-d>`. The renaming can be automatically done using the following script (on macOS, replace `sed` by `gsed`, installed via e.g. `brew install gnu-sed`): ``` sed -i ' s/\bCofeMor/OfeMor/g; s/\-c>/\-d>/g; s/\bcFunctor/oFunctor/g; s/\bCFunctor/OFunctor/g; s/\b\%CF/\%OF/g; s/\bconstCF/constOF/g; s/\bidCF/idOF/g s/\bdiscreteC/discreteO/g; s/\bleibnizC/leibnizO/g; s/\bunitC/unitO/g; s/\bprodC/prodO/g; s/\bsumC/sumO/g; s/\bboolC/boolO/g; s/\bnatC/natO/g; s/\bpositiveC/positiveO/g; s/\bNC/NO/g; s/\bZC/ZO/g; s/\boptionC/optionO/g; s/\blaterC/laterO/g; s/\bofe\_fun/discrete\_fun/g; s/\bdiscrete\_funC/discrete\_funO/g; s/\bofe\_morC/ofe\_morO/g; s/\bsigC/sigO/g; s/\buPredC/uPredO/g; s/\bcsumC/csumO/g; s/\bagreeC/agreeO/g; s/\bauthC/authO/g; s/\bnamespace_mapC/namespace\_mapO/g; s/\bcmra\_ofeC/cmra\_ofeO/g; s/\bucmra\_ofeC/ucmra\_ofeO/g; s/\bexclC/exclO/g; s/\bgmapC/gmapO/g; s/\blistC/listO/g; s/\bvecC/vecO/g; s/\bgsetC/gsetO/g; s/\bgset\_disjC/gset\_disjO/g; s/\bcoPsetC/coPsetO/g; s/\bgmultisetC/gmultisetO/g; s/\bufracC/ufracO/g s/\bfracC/fracO/g; s/\bvalidityC/validityO/g; s/\bbi\_ofeC/bi\_ofeO/g; s/\bsbi\_ofeC/sbi\_ofeO/g; s/\bmonPredC/monPredO/g; s/\bstateC/stateO/g; s/\bvalC/valO/g; s/\bexprC/exprO/g; s/\blocC/locO/g; s/\bdec\_agreeC/dec\_agreeO/g; s/\bgnameC/gnameO/g; s/\bcoPset\_disjC/coPset\_disjO/g; ' $(find theories -name "*.v") ``` ## Iris 3.1.0 (released 2017-12-19) **Changes in and extensions of the theory:** * Define `uPred` as a quotient on monotone predicates `M -> SProp`. * Get rid of some primitive laws; they can be derived: `True ⊢ □ True` and `□ (P ∧ Q) ⊢ □ (P ∗ Q)` * Camera morphisms have to be homomorphisms, not just monotone functions. * Add a proof that `f` has a fixed point if `f^k` is contractive. * Constructions for least and greatest fixed points over monotone predicates (defined in the logic of Iris using impredicative quantification). * Add a proof of the inverse of `wp_bind`. * [Experimental feature] Add new modality: ■ ("plainly"). * [Experimental feature] Support verifying code that might get stuck by distinguishing "non-stuck" vs. "(potentially) stuck" weakest preconditions. (See [Swasey et al., OOPSLA '17] for examples.) The non-stuck `WP e @ E {{ Φ }}` ensures that, as `e` runs, it does not get stuck. The stuck `WP e @ E ?{{ Φ }}` ensures that, as usual, all invariants are preserved while `e` runs, but it permits execution to get stuck. The former implies the latter. The full judgment is `WP e @ s; E {{ Φ }}`, where non-stuck WP uses *stuckness bit* `s = NotStuck` while stuck WP uses `s = MaybeStuck`. **Changes in Coq:** * Move the `prelude` folder to its own project: [coq-std++](https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp) * Some extensions/improvements of heap_lang: - Improve handling of pure (non-state-dependent) reductions. - Add fetch-and-add (`FAA`) operation. - Add syntax for all Coq's binary operations on `Z`. * Generalize `saved_prop` to let the user choose the location of the type-level later. Rename the general form to `saved_anything`. Provide `saved_prop` and `saved_pred` as special cases. * Improved big operators: + They are no longer tied to cameras, but work on any monoid + The version of big operations over lists was redefined so that it enjoys more definitional equalities. * Rename some things and change notation: - The unit of a camera: `empty` -> `unit`, `∅` -> `ε` - Disjointness: `⊥` -> `##` - A proof mode type class `IntoOp` -> `IsOp` - OFEs with all elements being discrete: `Discrete` -> `OfeDiscrete` - OFE elements whose equality is discrete: `Timeless` -> `Discrete` - Timeless propositions: `TimelessP` -> `Timeless` - Camera elements such that `core x = x`: `Persistent` -> `CoreId` - Persistent propositions: `PersistentP` -> `Persistent` - The persistent modality: `always` -> `persistently` - Adequacy for non-stuck weakestpre: `adequate_safe` -> `adequate_not_stuck` - Consistently SnakeCase identifiers: + `CMRAMixin` -> `CmraMixin` + `CMRAT` -> `CmraT` + `CMRATotal` -> `CmraTotal` + `CMRAMorphism` -> `CmraMorphism` + `CMRADiscrete` -> `CmraDiscrete` + `UCMRAMixin` -> `UcmraMixin` + `UCMRAT` -> `UcmraT` + `DRAMixin` -> `DraMixin` + `DRAT` -> `DraT` + `STS` -> `Sts` - Many lemmas also changed their name. `always_*` became `persistently_*`, and furthermore: (the following list is not complete) + `impl_wand` -> `impl_wand_1` (it only involves one direction of the equivalent) + `always_impl_wand` -> `impl_wand` + `always_and_sep_l` -> `and_sep_l` + `always_and_sep_r` -> `and_sep_r` + `always_sep_dup` -> `sep_dup` + `wand_impl_always` -> `impl_wand_persistently` (additionally, the direction of this equivalence got swapped for consistency's sake) + `always_wand_impl` -> `persistently_impl_wand` (additionally, the direction of this equivalence got swapped for consistency's sake) The following `sed` snippet should get you most of the way (on macOS you will have to replace `sed` by `gsed`, installed via e.g. `brew install gnu-sed`): ``` sed -i 's/\bPersistentP\b/Persistent/g; s/\bTimelessP\b/Timeless/g; s/\bCMRADiscrete\b/CmraDiscrete/g; s/\bCMRAT\b/CmraT/g; s/\bCMRAMixin\b/CmraMixin/g; s/\bUCMRAT\b/UcmraT/g; s/\bUCMRAMixin\b/UcmraMixin/g; s/\bSTS\b/Sts/g' $(find -name "*.v") ``` * `PersistentL` and `TimelessL` (persistence and timelessness of lists of propositions) are replaces by `TCForall` from std++. * Fix a bunch of consistency issues in the proof mode, and make it overall more usable. In particular: - All proof mode tactics start the proof mode if necessary; `iStartProof` is no longer needed and should only be used for building custom proof mode tactics. - Change in the grammar of specialization patterns: `>[...]` -> `[> ...]` - Various new specification patterns for `done` and framing. - There is common machinery for symbolic execution of pure reductions. This is provided by the type classes `PureExec` and `IntoVal`. - There is a new connective `tc_opaque`, which can be used to make definitions opaque for type classes, and thus opaque for most tactics of the proof mode. - Define Many missing type class instances for distributing connectives. - Implement the tactics `iIntros (?)` and `iIntros "!#"` (i.e. `iAlways`) using type classes. This makes them more generic, e.g., `iIntros (?)` also works when the universal quantifier is below a modality, and `iAlways` also works for the plainness modality. A breaking change, however, is that these tactics now no longer work when the universal quantifier or modality is behind a type class opaque definition. Furthermore, this can change the name of anonymous identifiers introduced with the "%" pattern. * Make `ofe_fun` dependently typed, subsuming `iprod`. The latter got removed. * Define the generic `fill` operation of the `ectxi_language` construct in terms of a left fold instead of a right fold. This gives rise to more definitional equalities. * The language hierarchy (`language`, `ectx_language`, `ectxi_language`) is now fully formalized using canonical structures instead of using a mixture of type classes and canonical structures. Also, it now uses explicit mixins. The file `program_logic/ectxi_language` contains some documentation on how to setup Iris for your language. * Restore the original, stronger notion of atomicity alongside the weaker notion. These are `Atomic a e` where the stuckness bit `s` indicates whether expression `e` is weakly (`a = WeaklyAtomic`) or strongly (`a = StronglyAtomic`) atomic. * Various improvements to `solve_ndisj`. * Use `Hint Mode` to prevent Coq from making arbitrary guesses in the presence of evars, which often led to divergence. There are a few places where type annotations are now needed. * The rules `internal_eq_rewrite` and `internal_eq_rewrite_contractive` are now stated in the logic, i.e., they are `iApply`-friendly. ## Iris 3.0.0 (released 2017-01-11) * There now is a deprecation process. The modules `*.deprecated` contain deprecated notations and definitions that are provided for backwards compatibility and will be removed in a future version of Iris. * View shifts are radically simplified to just internalize frame-preserving updates. Weakestpre is defined inside the logic, and invariants and view shifts with masks are also coded up inside Iris. Adequacy of weakestpre is proven in the logic. The old ownership of the entire physical state is replaced by a user-selected predicate over physical state that is maintained by weakestpre. * Use OFEs instead of COFEs everywhere. COFEs are only used for solving the recursive domain equation. As a consequence, CMRAs no longer need a proof of completeness. (The old `cofeT` is provided by `algebra.deprecated`.) * Implement a new agreement construction. Unlike the old one, this one preserves discreteness. dec_agree is thus no longer needed and has been moved to algebra.deprecated. * Renaming and moving things around: uPred and the rest of the base logic are in `base_logic`, while `program_logic` is for everything involving the general Iris notion of a language. * Renaming in prelude.list: Rename `prefix_of` -> `prefix` and `suffix_of` -> `suffix` in lemma names, but keep notation ``l1 `prefix_of` l2`` and ``l1 `suffix_of` l2``. `` l1 `sublist` l2`` becomes ``l1 `sublist_of` l2``. Rename `contains` -> `submseteq` and change `` l1 `contains` l2`` to ``l1 ⊆+ l2``. * Slightly weaker notion of atomicity: an expression is atomic if it reduces in one step to something that does not reduce further. * Changed notation for embedding Coq assertions into Iris. The new notation is ⌜φ⌝. Also removed `=` and `⊥` from the Iris scope. (The old notations are provided in `base_logic.deprecated`.) * Up-closure of namespaces is now a notation (↑) instead of a coercion. * With invariants and the physical state being handled in the logic, there is no longer any reason to demand the CMRA unit to be discrete. * The language can now fork off multiple threads at once. * Local Updates (for the authoritative monoid) are now a 4-way relation with syntax-directed lemmas proving them. ## Iris 2.0 * [heap_lang] No longer use dependent types for expressions. Instead, values carry a proof of closedness. Substitution, closedness and value-ness proofs are performed by computation after reflecting into a term langauge that knows about values and closed expressions. * [program_logic/language] The language does not define its own "atomic" predicate. Instead, atomicity is defined as reducing in one step to a value. * [program_logic] Due to a lack of maintenance and usefulness, lifting lemmas for Hoare triples are removed. ## Iris 2.0-rc2 This version matches the final ICFP 2016 paper. * [algebra] Make the core of an RA or CMRA a partial function. * [program_logic/lifting] Lifting lemmas no longer round-trip through a user-chosen predicate to define the configurations we can reduce to; they directly relate to the operational semantics. This is equivalent and much simpler to read. ## Iris 2.0-rc1 This is the Coq development and Iris Documentation as submitted to ICFP 2016. iris-iris-4.2.0/CONTRIBUTING.md000066400000000000000000000142151460620107300156620ustar00rootroot00000000000000# Contributing to the Iris Coq Development Here you can find some how-tos for various thing sthat might come up when doing Iris development. This is for contributing to Iris itself; see [the README](README.md#further-resources) for resources helpful for all Iris users. To work on Iris itself, you need to install its build-dependencies. Again we recommend you do that with opam (2.0.0 or newer). This requires the following two repositories: opam repo add coq-released https://coq.inria.fr/opam/released opam repo add iris-dev https://gitlab.mpi-sws.org/iris/opam.git Once you got opam set up, run `make builddep` to install the right versions of the dependencies. Run `make -jN` to build the full development, where `N` is the number of your CPU cores. To update Iris, do `git pull`. After an update, the development may fail to compile because of outdated dependencies. To fix that, please run `opam update` followed by `make builddep`. ## How to submit a merge request To contribute code, you need an MPI-SWS GitLab account as described on the [chat page](https://iris-project.org/chat.html). Then you can fork the [Iris git repository][iris], make your changes in your fork, and create a merge request. If forking fails with an error, please send your MPI-SWS GitLab username to [Ralf Jung][jung] to unlock forks for your account. Please do *not* use the master branch of your fork, that might confuse CI. Use a feature branch instead. [jung]: https://gitlab.mpi-sws.org/jung [iris]: https://gitlab.mpi-sws.org/iris/iris We prefer small and self-contained merge requests that add a single feature over merge requests that add arbitrary collections of lemmas. Small merge requests are easier to review, and will typically be merged more quickly (because it avoids blocking the whole merge request on a single discussion). Please follow the coding style laid out in our [style guide](docs/style_guide.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 `opam update iris-dev`. * In Iris, change the `opam` file to depend on the new version. (In case you do not use opam yourself, you can see recently published versions [in this repository](https://gitlab.mpi-sws.org/iris/opam/commits/master).) * Run `make builddep` (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 MAKE_REF=1` 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! Some test cases have per-Coq-version `.ref` files (e.g., `atomic.8.8.ref` is a Coq-8.8-specific `.ref` file). If you change one of these, remember to update *all* the `.ref` files. If you want to compile without tests run `make NO_TEST=1`. ## How to build/install only one package Iris is split into multiple packages that can be installed separately via opam. You can invoke the Makefile of a particular package by doing `./make-package $PACKAGE $MAKE_ARGS`, where `$MAKE_ARGS` are passed to `make` (so you can use the usual `-jN`, `install`, ...). This should only rarely be necessary. For example, if you are not using opam and you want to install only the `iris` package (without HeapLang, to avoid waiting on that part of the build), you can do `./make-package iris install`. (If you are using opam, you can achieve the same by pinning `coq-iris` to your Iris checkout.) Note that `./make-package` will never run the test suite, so please always do a regular `make -jN` before submitting an MR. ## How to test effects on reverse dependencies The `iris-bot` script makes it easy to test the effect of a branch on reverse dependencies. It can start tests ensuring they all still build, and it can do comparative timing runs. If you have suitable permissions, you can trigger these builds yourself. But first, you need to do some setup: you need to create a GitLab access token and set the `GITLAB_TOKEN` environment variable to it. Go to , pick a suitable name (such as "iris-bot"), select the "api" scope, and then click "Create personal access token". Copy the value it shows and store it in some suitable place; you will not be able to retrieve this value from GitLab in the future! For example, you could create a `.env` file in your Iris clone containing: ``` export GITLAB_TOKEN= ``` Then you can easily get the token back into the environment via `. .env`. Once that setup is done, you can now use `iris-bot`. Set at least one of `IRIS_REV` or `STDPP_REV` to control which branches of these projects to build against (they default to the default git branch). `IRIS_REPO` and `STDPP_REPO` can be used to control the repository in which the branch is situated. Setting `IRIS` to "user:branch" will use the given branch on that user's fork of Iris, and similar for `STDPP`. Supported commands: - `./iris-bot build [$filter]`: Builds all reverse dependencies against the given branches. The optional `filter` argument only builds projects whose names contains that string. - `./iris-bot time $project`: Measure the impact of this branch on the build time of the given reverse dependency. Only Iris branches are supported for now. Examples: - `IRIS_REV=myname/mybranch ./iris-bot build` builds *all* reverse dependencies against `myname/mybranch` from the main Iris repository. - `IRIS=user:branch ./iris-bot build examples` builds the [examples] against the `branch` in `user`'s fork of Iris. - `IRIS_REV=myname/mybranch ./iris-bot time examples` measures the timing impact of `myname/mybranch` from the main Iris repository on the [examples]. [examples]: https://gitlab.mpi-sws.org/iris/examples iris-iris-4.2.0/LICENSE000066400000000000000000000005401460620107300144320ustar00rootroot00000000000000The source code (i.e., everything except for files in the docs/ and tex/ folders) in this development is licensed under the terms of the BSD license, while the documentation (i.e., everything inside the docs/ and tex/ folders) is licensed under the terms of the CC-BY 4.0 license. Fur further details, see LICENSE-CODE and LICENSE-DOCS, respectively. iris-iris-4.2.0/LICENSE-CODE000066400000000000000000000033641460620107300151510ustar00rootroot00000000000000All files in this development, excluding those in docs/ and tex/, are distributed under the terms of the 3-clause BSD license (https://opensource.org/licenses/BSD-3-Clause), included below. Copyright: Iris developers and contributors ------------------------------------------------------------------------------ Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. iris-iris-4.2.0/LICENSE-DOCS000066400000000000000000000450371460620107300151720ustar00rootroot00000000000000All files in the docs/ and tex/ folders of this development are distributed under the terms of the CC-BY 4.0 license . For your convenience, a plain-text version of the license is included below. ------------------------------------------------------------------------------ Attribution 4.0 International ======================================================================= Creative Commons Corporation ("Creative Commons") is not a law firm and does not provide legal services or legal advice. Distribution of Creative Commons public licenses does not create a lawyer-client or other relationship. Creative Commons makes its licenses and related information available on an "as-is" basis. Creative Commons gives no warranties regarding its licenses, any material licensed under their terms and conditions, or any related information. Creative Commons disclaims all liability for damages resulting from their use to the fullest extent possible. Using Creative Commons Public Licenses Creative Commons public licenses provide a standard set of terms and conditions that creators and other rights holders may use to share original works of authorship and other material subject to copyright and certain other rights specified in the public license below. The following considerations are for informational purposes only, are not exhaustive, and do not form part of our licenses. Considerations for licensors: Our public licenses are intended for use by those authorized to give the public permission to use material in ways otherwise restricted by copyright and certain other rights. Our licenses are irrevocable. Licensors should read and understand the terms and conditions of the license they choose before applying it. Licensors should also secure all rights necessary before applying our licenses so that the public can reuse the material as expected. Licensors should clearly mark any material not subject to the license. This includes other CC- licensed material, or material used under an exception or limitation to copyright. More considerations for licensors: wiki.creativecommons.org/Considerations_for_licensors Considerations for the public: By using one of our public licenses, a licensor grants the public permission to use the licensed material under specified terms and conditions. If the licensor's permission is not necessary for any reason--for example, because of any applicable exception or limitation to copyright--then that use is not regulated by the license. Our licenses grant only permissions under copyright and certain other rights that a licensor has authority to grant. Use of the licensed material may still be restricted for other reasons, including because others have copyright or other rights in the material. A licensor may make special requests, such as asking that all changes be marked or described. Although not required by our licenses, you are encouraged to respect those requests where reasonable. More_considerations for the public: wiki.creativecommons.org/Considerations_for_licensees ======================================================================= Creative Commons Attribution 4.0 International Public License By exercising the Licensed Rights (defined below), You accept and agree to be bound by the terms and conditions of this Creative Commons Attribution 4.0 International Public License ("Public License"). To the extent this Public License may be interpreted as a contract, You are granted the Licensed Rights in consideration of Your acceptance of these terms and conditions, and the Licensor grants You such rights in consideration of benefits the Licensor receives from making the Licensed Material available under these terms and conditions. Section 1 -- Definitions. a. Adapted Material means material subject to Copyright and Similar Rights that is derived from or based upon the Licensed Material and in which the Licensed Material is translated, altered, arranged, transformed, or otherwise modified in a manner requiring permission under the Copyright and Similar Rights held by the Licensor. For purposes of this Public License, where the Licensed Material is a musical work, performance, or sound recording, Adapted Material is always produced where the Licensed Material is synched in timed relation with a moving image. b. Adapter's License means the license You apply to Your Copyright and Similar Rights in Your contributions to Adapted Material in accordance with the terms and conditions of this Public License. c. Copyright and Similar Rights means copyright and/or similar rights closely related to copyright including, without limitation, performance, broadcast, sound recording, and Sui Generis Database Rights, without regard to how the rights are labeled or categorized. For purposes of this Public License, the rights specified in Section 2(b)(1)-(2) are not Copyright and Similar Rights. d. Effective Technological Measures means those measures that, in the absence of proper authority, may not be circumvented under laws fulfilling obligations under Article 11 of the WIPO Copyright Treaty adopted on December 20, 1996, and/or similar international agreements. e. Exceptions and Limitations means fair use, fair dealing, and/or any other exception or limitation to Copyright and Similar Rights that applies to Your use of the Licensed Material. f. Licensed Material means the artistic or literary work, database, or other material to which the Licensor applied this Public License. g. Licensed Rights means the rights granted to You subject to the terms and conditions of this Public License, which are limited to all Copyright and Similar Rights that apply to Your use of the Licensed Material and that the Licensor has authority to license. h. Licensor means the individual(s) or entity(ies) granting rights under this Public License. i. Share means to provide material to the public by any means or process that requires permission under the Licensed Rights, such as reproduction, public display, public performance, distribution, dissemination, communication, or importation, and to make material available to the public including in ways that members of the public may access the material from a place and at a time individually chosen by them. j. Sui Generis Database Rights means rights other than copyright resulting from Directive 96/9/EC of the European Parliament and of the Council of 11 March 1996 on the legal protection of databases, as amended and/or succeeded, as well as other essentially equivalent rights anywhere in the world. k. You means the individual or entity exercising the Licensed Rights under this Public License. Your has a corresponding meaning. Section 2 -- Scope. a. License grant. 1. Subject to the terms and conditions of this Public License, the Licensor hereby grants You a worldwide, royalty-free, non-sublicensable, non-exclusive, irrevocable license to exercise the Licensed Rights in the Licensed Material to: a. reproduce and Share the Licensed Material, in whole or in part; and b. produce, reproduce, and Share Adapted Material. 2. Exceptions and Limitations. For the avoidance of doubt, where Exceptions and Limitations apply to Your use, this Public License does not apply, and You do not need to comply with its terms and conditions. 3. Term. The term of this Public License is specified in Section 6(a). 4. Media and formats; technical modifications allowed. The Licensor authorizes You to exercise the Licensed Rights in all media and formats whether now known or hereafter created, and to make technical modifications necessary to do so. The Licensor waives and/or agrees not to assert any right or authority to forbid You from making technical modifications necessary to exercise the Licensed Rights, including technical modifications necessary to circumvent Effective Technological Measures. For purposes of this Public License, simply making modifications authorized by this Section 2(a) (4) never produces Adapted Material. 5. Downstream recipients. a. Offer from the Licensor -- Licensed Material. Every recipient of the Licensed Material automatically receives an offer from the Licensor to exercise the Licensed Rights under the terms and conditions of this Public License. b. No downstream restrictions. You may not offer or impose any additional or different terms or conditions on, or apply any Effective Technological Measures to, the Licensed Material if doing so restricts exercise of the Licensed Rights by any recipient of the Licensed Material. 6. No endorsement. Nothing in this Public License constitutes or may be construed as permission to assert or imply that You are, or that Your use of the Licensed Material is, connected with, or sponsored, endorsed, or granted official status by, the Licensor or others designated to receive attribution as provided in Section 3(a)(1)(A)(i). b. Other rights. 1. Moral rights, such as the right of integrity, are not licensed under this Public License, nor are publicity, privacy, and/or other similar personality rights; however, to the extent possible, the Licensor waives and/or agrees not to assert any such rights held by the Licensor to the limited extent necessary to allow You to exercise the Licensed Rights, but not otherwise. 2. Patent and trademark rights are not licensed under this Public License. 3. To the extent possible, the Licensor waives any right to collect royalties from You for the exercise of the Licensed Rights, whether directly or through a collecting society under any voluntary or waivable statutory or compulsory licensing scheme. In all other cases the Licensor expressly reserves any right to collect such royalties. Section 3 -- License Conditions. Your exercise of the Licensed Rights is expressly made subject to the following conditions. a. Attribution. 1. If You Share the Licensed Material (including in modified form), You must: a. retain the following if it is supplied by the Licensor with the Licensed Material: i. identification of the creator(s) of the Licensed Material and any others designated to receive attribution, in any reasonable manner requested by the Licensor (including by pseudonym if designated); ii. a copyright notice; iii. a notice that refers to this Public License; iv. a notice that refers to the disclaimer of warranties; v. a URI or hyperlink to the Licensed Material to the extent reasonably practicable; b. indicate if You modified the Licensed Material and retain an indication of any previous modifications; and c. indicate the Licensed Material is licensed under this Public License, and include the text of, or the URI or hyperlink to, this Public License. 2. You may satisfy the conditions in Section 3(a)(1) in any reasonable manner based on the medium, means, and context in which You Share the Licensed Material. For example, it may be reasonable to satisfy the conditions by providing a URI or hyperlink to a resource that includes the required information. 3. If requested by the Licensor, You must remove any of the information required by Section 3(a)(1)(A) to the extent reasonably practicable. 4. If You Share Adapted Material You produce, the Adapter's License You apply must not prevent recipients of the Adapted Material from complying with this Public License. Section 4 -- Sui Generis Database Rights. Where the Licensed Rights include Sui Generis Database Rights that apply to Your use of the Licensed Material: a. for the avoidance of doubt, Section 2(a)(1) grants You the right to extract, reuse, reproduce, and Share all or a substantial portion of the contents of the database; b. if You include all or a substantial portion of the database contents in a database in which You have Sui Generis Database Rights, then the database in which You have Sui Generis Database Rights (but not its individual contents) is Adapted Material; and c. You must comply with the conditions in Section 3(a) if You Share all or a substantial portion of the contents of the database. For the avoidance of doubt, this Section 4 supplements and does not replace Your obligations under this Public License where the Licensed Rights include other Copyright and Similar Rights. Section 5 -- Disclaimer of Warranties and Limitation of Liability. a. UNLESS OTHERWISE SEPARATELY UNDERTAKEN BY THE LICENSOR, TO THE EXTENT POSSIBLE, THE LICENSOR OFFERS THE LICENSED MATERIAL AS-IS AND AS-AVAILABLE, AND MAKES NO REPRESENTATIONS OR WARRANTIES OF ANY KIND CONCERNING THE LICENSED MATERIAL, WHETHER EXPRESS, IMPLIED, STATUTORY, OR OTHER. THIS INCLUDES, WITHOUT LIMITATION, WARRANTIES OF TITLE, MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, NON-INFRINGEMENT, ABSENCE OF LATENT OR OTHER DEFECTS, ACCURACY, OR THE PRESENCE OR ABSENCE OF ERRORS, WHETHER OR NOT KNOWN OR DISCOVERABLE. WHERE DISCLAIMERS OF WARRANTIES ARE NOT ALLOWED IN FULL OR IN PART, THIS DISCLAIMER MAY NOT APPLY TO YOU. b. TO THE EXTENT POSSIBLE, IN NO EVENT WILL THE LICENSOR BE LIABLE TO YOU ON ANY LEGAL THEORY (INCLUDING, WITHOUT LIMITATION, NEGLIGENCE) OR OTHERWISE FOR ANY DIRECT, SPECIAL, INDIRECT, INCIDENTAL, CONSEQUENTIAL, PUNITIVE, EXEMPLARY, OR OTHER LOSSES, COSTS, EXPENSES, OR DAMAGES ARISING OUT OF THIS PUBLIC LICENSE OR USE OF THE LICENSED MATERIAL, EVEN IF THE LICENSOR HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH LOSSES, COSTS, EXPENSES, OR DAMAGES. WHERE A LIMITATION OF LIABILITY IS NOT ALLOWED IN FULL OR IN PART, THIS LIMITATION MAY NOT APPLY TO YOU. c. The disclaimer of warranties and limitation of liability provided above shall be interpreted in a manner that, to the extent possible, most closely approximates an absolute disclaimer and waiver of all liability. Section 6 -- Term and Termination. a. This Public License applies for the term of the Copyright and Similar Rights licensed here. However, if You fail to comply with this Public License, then Your rights under this Public License terminate automatically. b. Where Your right to use the Licensed Material has terminated under Section 6(a), it reinstates: 1. automatically as of the date the violation is cured, provided it is cured within 30 days of Your discovery of the violation; or 2. upon express reinstatement by the Licensor. For the avoidance of doubt, this Section 6(b) does not affect any right the Licensor may have to seek remedies for Your violations of this Public License. c. For the avoidance of doubt, the Licensor may also offer the Licensed Material under separate terms or conditions or stop distributing the Licensed Material at any time; however, doing so will not terminate this Public License. d. Sections 1, 5, 6, 7, and 8 survive termination of this Public License. Section 7 -- Other Terms and Conditions. a. The Licensor shall not be bound by any additional or different terms or conditions communicated by You unless expressly agreed. b. Any arrangements, understandings, or agreements regarding the Licensed Material not stated herein are separate from and independent of the terms and conditions of this Public License. Section 8 -- Interpretation. a. For the avoidance of doubt, this Public License does not, and shall not be interpreted to, reduce, limit, restrict, or impose conditions on any use of the Licensed Material that could lawfully be made without permission under this Public License. b. To the extent possible, if any provision of this Public License is deemed unenforceable, it shall be automatically reformed to the minimum extent necessary to make it enforceable. If the provision cannot be reformed, it shall be severed from this Public License without affecting the enforceability of the remaining terms and conditions. c. No term or condition of this Public License will be waived and no failure to comply consented to unless expressly agreed to by the Licensor. d. Nothing in this Public License constitutes or may be interpreted as a limitation upon, or waiver of, any privileges and immunities that apply to the Licensor or You, including from the legal processes of any jurisdiction or authority. ======================================================================= Creative Commons is not a party to its public licenses. Notwithstanding, Creative Commons may elect to apply one of its public licenses to material it publishes and in those instances will be considered the “Licensor.” The text of the Creative Commons public licenses is dedicated to the public domain under the CC0 Public Domain Dedication. Except for the limited purpose of indicating that material is shared under a Creative Commons public license or as otherwise permitted by the Creative Commons policies published at creativecommons.org/policies, Creative Commons does not authorize the use of the trademark "Creative Commons" or any other trademark or logo of Creative Commons without its prior written consent including, without limitation, in connection with any unauthorized modifications to any of its public licenses or any other arrangements, understandings, or agreements concerning use of licensed material. For the avoidance of doubt, this paragraph does not form part of the public licenses. Creative Commons may be contacted at creativecommons.org. iris-iris-4.2.0/Makefile000066400000000000000000000036211460620107300150700ustar00rootroot00000000000000# Default target all: Makefile.coq +@$(MAKE) -f Makefile.coq all .PHONY: all # Permit local customization -include Makefile.local # Forward most targets to Coq makefile (with some trick to make this phony) %: Makefile.coq phony @#echo "Forwarding $@" +@$(MAKE) -f Makefile.coq $@ phony: ; .PHONY: phony clean: Makefile.coq +@$(MAKE) -f Makefile.coq clean @# Make sure not to enter the `_opam` folder. find [a-z]*/ \( -name "*.d" -o -name "*.vo" -o -name "*.vo[sk]" -o -name "*.aux" -o -name "*.cache" -o -name "*.glob" -o -name "*.vio" \) -print -delete || true rm -f Makefile.coq .lia.cache builddep/* .PHONY: clean # Create Coq Makefile. Makefile.coq: _CoqProject Makefile "$(COQBIN)coq_makefile" -f _CoqProject -o Makefile.coq $(EXTRA_COQFILES) # Install build-dependencies OPAMFILES=$(wildcard *.opam) BUILDDEPFILES=$(addsuffix -builddep.opam, $(addprefix builddep/,$(basename $(OPAMFILES)))) builddep/%-builddep.opam: %.opam Makefile @echo "# Creating builddep package for $<." @mkdir -p builddep @sed <$< -E 's/^(build|install|remove):.*/\1: []/; s/"(.*)"(.*= *version.*)$$/"\1-builddep"\2/;' >$@ builddep-opamfiles: $(BUILDDEPFILES) .PHONY: builddep-opamfiles builddep: builddep-opamfiles @# We want opam to not just install the build-deps now, but to also keep satisfying these @# constraints. Otherwise, `opam upgrade` may well update some packages to versions @# that are incompatible with our build requirements. @# To achieve this, we create a fake opam package that has our build-dependencies as @# dependencies, but does not actually install anything itself. @echo "# Installing builddep packages." @opam install $(OPAMFLAGS) $(BUILDDEPFILES) .PHONY: builddep # Backwards compatibility target build-dep: builddep .PHONY: build-dep # Some files that do *not* need to be forwarded to Makefile.coq. # ("::" lets Makefile.local overwrite this.) Makefile Makefile.local _CoqProject $(OPAMFILES):: ; iris-iris-4.2.0/Makefile.coq.local000066400000000000000000000051161460620107300167430ustar00rootroot00000000000000# use NO_TEST=1 to skip the tests NO_TEST:= # use MAKE_REF=1 to generate new reference files MAKE_REF:= # Run tests interleaved with main build. They have to be in the same target for this. real-all: style $(if $(NO_TEST),,test) style: $(VFILES) coq-lint.sh # Make sure everything imports the options, and all Instance/Argument/Hint are qualified. $(SHOW)"COQLINT" $(HIDE)for FILE in $(VFILES); do \ if ! grep -F -q 'From iris.prelude Require Import options.' "$$FILE"; then echo "ERROR: $$FILE does not import 'options'."; echo; exit 1; fi ; \ ./coq-lint.sh "$$FILE" || exit 1; \ done # Make sure main Iris does not import other Iris packages. $(HIDE)if grep -E 'iris\.(heap_lang|deprecated|unstable)' --include "*.v" -R iris; then echo "ERROR: Iris may not import modules from other Iris packages (see above for violations)."; echo; exit 1; fi .PHONY: style # the test suite TESTFILES:=$(shell find tests -name "*.v") NORMALIZER:=test-normalizer.sed test: $(TESTFILES:.v=.vo) .PHONY: test COQ_TEST=$(COQTOP) $(COQDEBUG) -batch -test-mode # These versions of Coq are known to have different output so we don't test them. # Need to make this a lazy variable (`=` instead of `:=`) since COQ_VERSION is only set later. # Make sure to recognize both 8.$NUM.0 and 8.$NUM+alpha. COQ_NOREF=$(shell echo "$(COQ_VERSION)" | grep -E "^8\.(16|17|18)[.+]" -q && echo 1) tests/.coqdeps.d: $(TESTFILES) $(SHOW)'COQDEP TESTFILES' $(HIDE)$(COQDEP) -dyndep var $(COQMF_COQLIBS_NOML) $^ $(redir_if_ok) -include tests/.coqdeps.d # Main test script (comments out-of-line because macOS otherwise barfs?!?) # - Determine reference file (`REF`). # - Print user-visible status line. # - unset env vars that change Coq's output # - Dump Coq output into a temporary file. # - Run `sed -i` on that file in a way that works on macOS. # - Either compare the result with the reference file, or move it over the reference file. # - Cleanup, and mark as done for make. $(TESTFILES:.v=.vo): %.vo: %.v $(if $(MAKE_REF),,%.ref) $(NORMALIZER) $(HIDE)REF=$*".ref" && \ echo "COQTEST$(if $(COQ_NOREF), [ref diff ignored],$(if $(MAKE_REF), [make ref],)) $< (ref: $$REF)" && \ TMPFILE="$$(mktemp)" && \ unset OCAMLRUNPARAM && \ $(TIMER) $(COQ_TEST) $(COQFLAGS) $(COQLIBS) -load-vernac-source $< > "$$TMPFILE" && \ sed -E -f $(NORMALIZER) "$$TMPFILE" > "$$TMPFILE".new && \ mv "$$TMPFILE".new "$$TMPFILE" && \ $(if $(COQ_NOREF), (diff --strip-trailing-cr -u "$$REF" "$$TMPFILE" || true) , \ $(if $(MAKE_REF),mv "$$TMPFILE" "$$REF",diff --strip-trailing-cr -u "$$REF" "$$TMPFILE") \ ) && \ rm -f "$$TMPFILE" && \ touch $@ iris-iris-4.2.0/ProofMode.md000066400000000000000000000000531460620107300156400ustar00rootroot00000000000000This file has [moved](docs/proof_mode.md). iris-iris-4.2.0/README.md000066400000000000000000000225621460620107300147140ustar00rootroot00000000000000# Iris Coq Development [[coqdoc]](https://plv.mpi-sws.org/coqdoc/iris/) This is the Coq development of the [Iris Project](http://iris-project.org), which includes [MoSeL](http://iris-project.org/mosel/), a general proof mode for carrying out separation logic proofs in Coq. For using the Coq library, check out the [API documentation](https://plv.mpi-sws.org/coqdoc/iris/). For understanding the theory of Iris, a LaTeX version of the core logic definitions and some derived forms is available in [tex/iris.tex](tex/iris.tex). A compiled PDF version of this document is [available online](http://plv.mpi-sws.org/iris/appendix-3.4.pdf). ## Side-effects Importing Iris has some side effects as the library sets some global options. * First of all, Iris imports std++, so the [std++ side-effects](https://gitlab.mpi-sws.org/iris/stdpp/#side-effects) apply. * On top of that, Iris imports ssreflect, which replaces the default `rewrite` tactic with the ssreflect version. However, `done` is overwritten to keep using the std++ version of the tactic. We also set `SsrOldRewriteGoalsOrder` and re-open `general_if_scope` to un-do some effects of ssreflect. ## Building Iris ### Prerequisites This version is known to compile with: - Coq 8.18.0 / 8.19.0 - A development version of [std++](https://gitlab.mpi-sws.org/iris/stdpp) Generally we always aim to support the last two stable Coq releases. Support for older versions will be dropped when it is convenient. If you need to work with older versions of Coq, you can check out the [tags](https://gitlab.mpi-sws.org/iris/iris/-/tags) for old Iris releases that still support them. ### Working *with* Iris To use Iris in your own proofs, we recommend you install Iris via opam (2.0.0 or newer). To obtain the latest stable release, you have to add the Coq opam repository: opam repo add coq-released https://coq.inria.fr/opam/released To obtain a development version, also add the Iris opam repository: opam repo add iris-dev https://gitlab.mpi-sws.org/iris/opam.git Either way, you can now install Iris: - `opam install coq-iris` will install the libraries making up the Iris logic, but leave it up to you to instantiate the `program_logic.language` interface to define a programming language for Iris to reason about. - `opam install coq-iris-heap-lang` will additionally install HeapLang, the default language used by various Iris projects. To fetch updates later, run `opam update && opam upgrade`. #### Be notified of breaking changes We do not guarantee backwards-compatibility, so upgrading Iris may break your Iris-using developments. If you want to be notified of breaking changes, please let us know your account name on the [MPI-SWS GitLab](https://gitlab.mpi-sws.org/) so we can add you to the notification group. Note that this excludes the "unstable" and "deprecated" packages (see below). #### Use of Iris in submitted artifacts If you are using Iris as part of an artifact submitted for publication with a paper, we recommend you make the artifact self-contained so that it can be built in the future without relying in any other server to still exist. However, if that is for some reason not possible, and if you are using opam to obtain the right version of Iris and you used a `dev.*` version, please let us know which exact Iris version you artifact relies on so that we can [add it to this wiki page](https://gitlab.mpi-sws.org/iris/iris/-/wikis/Pinned-Iris-package-versions) and avoid removing it from our opam repository in the future. ### Working *on* Iris See the [contribution guide](CONTRIBUTING.md) for information on how to work on the Iris development itself. ## Directory Structure Iris is structured into multiple *packages*, some of which contain multiple modules in separate folders. * The [iris](iris) package contains the language-independent parts of Iris. + The folder [prelude](iris/prelude) contains modules imported everywhere in Iris. + The folder [algebra](iris/algebra) contains the COFE and CMRA constructions as well as the solver for recursive domain equations. - The subfolder [lib](iris/algebra/lib) contains some general derived RA constructions. + The folder [bi](iris/bi) contains the BI++ laws, as well as derived connectives, laws and constructions that are applicable for general BIs. - The subfolder [lib](iris/bi/lib) contains some general derived logical constructions. + The folder [proofmode](iris/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 [proof_mode.md](docs/proof_mode.md). + The folder [base_logic](iris/base_logic) defines the Iris base logic and the primitive connectives. It also contains derived constructions that are entirely independent of the choice of resources. - The subfolder [lib](iris/base_logic/lib) contains some generally useful derived constructions. Most importantly, it defines composable dynamic resources and ownership of them; the other constructions depend on this setup. + The folder [program_logic](iris/program_logic) specializes the base logic 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 [si_logic](iris/si_logic) defines a "plain" step-indexed logic and shows that it is an instance of the BI interface. * The [iris_heap_lang](iris_heap_lang) package defines the ML-like concurrent language HeapLang and provides tactic support and proof mode integration. + The subfolder [lib](iris_heap_lang/lib) contains a few derived constructions within this language, e.g., parallel composition. For more examples of using Iris and heap_lang, have a look at the [Iris Examples](https://gitlab.mpi-sws.org/iris/examples). * The [iris_unstable](iris_unstable) package contains libraries that are not yet ready for inclusion in Iris proper. For each library, there is a corresponding "tracking issue" in the Iris issue tracker (also linked from the library itself) which tracks the work that still needs to be done before moving the library to Iris. No stability guarantees whatsoever are made for this package. * The [iris_deprecated](iris_deprecated) package contains libraries that have been removed from Iris proper, but are kept around to give users some more time to switch to their intended replacements. The individual libraries come with comments explaining the deprecation and making recommendations for what to use instead. No stability guarantees whatsoever are made for this package. * The folder [tests](tests) contains modules we use to test our infrastructure. These modules are not installed by `make install`, and should not be imported. Note that the unstable and deprecated packages are not released, so they only exist in the development version of Iris. ## Case Studies The following is a (probably incomplete) list of case studies that use Iris, and that should be compatible with this version: * [Iris Examples](https://gitlab.mpi-sws.org/iris/examples) is where we collect miscellaneous case studies that do not have their own repository. * [LambdaRust](https://gitlab.mpi-sws.org/iris/lambda-rust) is a Coq formalization of the core Rust type system. * [GPFSL](https://gitlab.mpi-sws.org/iris/gpfsl) is a logic for release-acquire and relaxed memory. * [Iron](https://gitlab.mpi-sws.org/iris/iron) is a linear separation logic built on top of Iris for precise reasoning about resources (such as making sure there are no memory leaks). * [Actris](https://gitlab.mpi-sws.org/iris/actris) is a separation logic built on top of Iris for session-type based reasoning of message-passing programs. ## Further Resources Getting along with Iris in Coq: * The coding style is documented in the [style guide](docs/style_guide.md). * Iris proof patterns and conventions are documented in the [proof guide](docs/proof_guide.md). * Various notions of equality and logical entailment in Iris and their Coq interface are described in the [equality docs](docs/equalities_and_entailments.md). * The Iris tactics are described in the [the Iris Proof Mode (IPM) / MoSeL documentation](docs/proof_mode.md) as well as the [HeapLang documentation](docs/heap_lang.md). * The generated coqdoc is [available online](https://plv.mpi-sws.org/coqdoc/iris/). Contacting the developers: * Discussion about the Iris Coq development happens on the mailing list [iris-club@lists.mpi-sws.org](https://lists.mpi-sws.org/listinfo/iris-club) and in the [Iris Chat](https://iris-project.org/chat.html). This is also the right place to ask questions. * If you want to report a bug, please use the [issue tracker](https://gitlab.mpi-sws.org/iris/iris/issues), which requires an MPI-SWS GitLab account. The [chat page](https://iris-project.org/chat.html) describes how to create such an account. * To contribute to Iris itself, see the [contribution guide](CONTRIBUTING.md). Miscellaneous: * Information on how to set up your editor for unicode input and output is collected in [editor.md](docs/editor.md). * If you are writing a paper that uses Iris in one way or another, you could use the [Iris LaTeX macros](tex/iris.sty) for typesetting the various Iris connectives. iris-iris-4.2.0/_CoqProject000066400000000000000000000131701460620107300155630ustar00rootroot00000000000000# Search paths for all packages. They must all match the regex # `-Q $PACKAGE[/ ]` so that we can filter out the right ones for each package. -Q iris/prelude iris.prelude -Q iris/algebra iris.algebra -Q iris/si_logic iris.si_logic -Q iris/bi iris.bi -Q iris/proofmode iris.proofmode -Q iris/base_logic iris.base_logic -Q iris/program_logic iris.program_logic -Q iris_heap_lang iris.heap_lang -Q iris_unstable iris.unstable -Q iris_deprecated iris.deprecated # We sometimes want to locally override notation, and there is no good way to do that with scopes. -arg -w -arg -notation-overridden # Cannot use non-canonical projections as it causes massive unification failures # (https://github.com/coq/coq/issues/6294). -arg -w -arg -redundant-canonical-projection # Some warnings exist only on some Coq versions -arg -w -arg -unknown-warning # Fixing this one requires Coq 8.19 -arg -w -arg -argument-scope-delimiter iris/prelude/options.v iris/prelude/prelude.v iris/algebra/monoid.v iris/algebra/cmra.v iris/algebra/big_op.v iris/algebra/cmra_big_op.v iris/algebra/sts.v iris/algebra/numbers.v iris/algebra/view.v iris/algebra/auth.v iris/algebra/gmap.v iris/algebra/ofe.v iris/algebra/cofe_solver.v iris/algebra/agree.v iris/algebra/excl.v iris/algebra/functions.v iris/algebra/frac.v iris/algebra/dfrac.v iris/algebra/csum.v iris/algebra/list.v iris/algebra/vector.v iris/algebra/updates.v iris/algebra/local_updates.v iris/algebra/gset.v iris/algebra/gmultiset.v iris/algebra/coPset.v iris/algebra/proofmode_classes.v iris/algebra/ufrac.v iris/algebra/reservation_map.v iris/algebra/dyn_reservation_map.v iris/algebra/max_prefix_list.v iris/algebra/mra.v iris/algebra/lib/excl_auth.v iris/algebra/lib/frac_auth.v iris/algebra/lib/ufrac_auth.v iris/algebra/lib/dfrac_agree.v iris/algebra/lib/gmap_view.v iris/algebra/lib/mono_nat.v iris/algebra/lib/mono_Z.v iris/algebra/lib/mono_list.v iris/algebra/lib/gset_bij.v iris/si_logic/siprop.v iris/si_logic/bi.v iris/bi/notation.v iris/bi/interface.v iris/bi/derived_connectives.v iris/bi/extensions.v iris/bi/derived_laws.v iris/bi/derived_laws_later.v iris/bi/plainly.v iris/bi/internal_eq.v iris/bi/big_op.v iris/bi/updates.v iris/bi/ascii.v iris/bi/bi.v iris/bi/monpred.v iris/bi/embedding.v iris/bi/weakestpre.v iris/bi/telescopes.v iris/bi/lib/cmra.v iris/bi/lib/counterexamples.v iris/bi/lib/fixpoint.v iris/bi/lib/fractional.v iris/bi/lib/laterable.v iris/bi/lib/atomic.v iris/bi/lib/core.v iris/bi/lib/relations.v iris/base_logic/upred.v iris/base_logic/bi.v iris/base_logic/derived.v iris/base_logic/proofmode.v iris/base_logic/base_logic.v iris/base_logic/algebra.v iris/base_logic/bupd_alt.v iris/base_logic/lib/iprop.v iris/base_logic/lib/own.v iris/base_logic/lib/saved_prop.v iris/base_logic/lib/wsat.v iris/base_logic/lib/invariants.v iris/base_logic/lib/fancy_updates.v iris/base_logic/lib/boxes.v iris/base_logic/lib/na_invariants.v iris/base_logic/lib/cancelable_invariants.v iris/base_logic/lib/gen_heap.v iris/base_logic/lib/gen_inv_heap.v iris/base_logic/lib/fancy_updates_from_vs.v iris/base_logic/lib/proph_map.v iris/base_logic/lib/ghost_var.v iris/base_logic/lib/mono_nat.v iris/base_logic/lib/gset_bij.v iris/base_logic/lib/ghost_map.v iris/base_logic/lib/later_credits.v iris/base_logic/lib/token.v iris/program_logic/adequacy.v iris/program_logic/lifting.v iris/program_logic/weakestpre.v iris/program_logic/total_weakestpre.v iris/program_logic/total_adequacy.v iris/program_logic/language.v iris/program_logic/ectx_language.v iris/program_logic/ectxi_language.v iris/program_logic/ectx_lifting.v iris/program_logic/ownp.v iris/program_logic/total_lifting.v iris/program_logic/total_ectx_lifting.v iris/program_logic/atomic.v iris/proofmode/base.v iris/proofmode/ident_name.v iris/proofmode/string_ident.v iris/proofmode/tokens.v iris/proofmode/coq_tactics.v iris/proofmode/ltac_tactics.v iris/proofmode/environments.v iris/proofmode/reduction.v iris/proofmode/intro_patterns.v iris/proofmode/spec_patterns.v iris/proofmode/sel_patterns.v iris/proofmode/tactics.v iris/proofmode/notation.v iris/proofmode/classes.v iris/proofmode/classes_make.v iris/proofmode/class_instances.v iris/proofmode/class_instances_later.v iris/proofmode/class_instances_updates.v iris/proofmode/class_instances_embedding.v iris/proofmode/class_instances_plainly.v iris/proofmode/class_instances_internal_eq.v iris/proofmode/class_instances_frame.v iris/proofmode/class_instances_make.v iris/proofmode/monpred.v iris/proofmode/modalities.v iris/proofmode/modality_instances.v iris/proofmode/proofmode.v iris_heap_lang/locations.v iris_heap_lang/lang.v iris_heap_lang/class_instances.v iris_heap_lang/pretty.v iris_heap_lang/metatheory.v iris_heap_lang/tactics.v iris_heap_lang/primitive_laws.v iris_heap_lang/derived_laws.v iris_heap_lang/notation.v iris_heap_lang/proofmode.v iris_heap_lang/adequacy.v iris_heap_lang/total_adequacy.v iris_heap_lang/proph_erasure.v iris_heap_lang/lib/spawn.v iris_heap_lang/lib/par.v iris_heap_lang/lib/assert.v iris_heap_lang/lib/lock.v iris_heap_lang/lib/rw_lock.v iris_heap_lang/lib/spin_lock.v iris_heap_lang/lib/ticket_lock.v iris_heap_lang/lib/rw_spin_lock.v iris_heap_lang/lib/nondet_bool.v iris_heap_lang/lib/lazy_coin.v iris_heap_lang/lib/clairvoyant_coin.v iris_heap_lang/lib/counter.v iris_heap_lang/lib/atomic_heap.v iris_heap_lang/lib/increment.v iris_heap_lang/lib/diverge.v iris_heap_lang/lib/arith.v iris_heap_lang/lib/array.v iris_heap_lang/lib/logatom_lock.v iris_unstable/algebra/list.v iris_unstable/base_logic/algebra.v iris_unstable/base_logic/mono_list.v iris_unstable/heap_lang/interpreter.v iris_deprecated/base_logic/auth.v iris_deprecated/base_logic/sts.v iris_deprecated/base_logic/viewshifts.v iris_deprecated/program_logic/hoare.v iris-iris-4.2.0/coq-iris-deprecated.opam000066400000000000000000000011511460620107300201260ustar00rootroot00000000000000opam-version: "2.0" maintainer: "Ralf Jung " authors: "The Iris Team" license: "BSD-3-Clause" homepage: "https://iris-project.org/" bug-reports: "https://gitlab.mpi-sws.org/iris/iris/issues" dev-repo: "git+https://gitlab.mpi-sws.org/iris/iris.git" version: "dev" synopsis: "Deprecated Iris libraries" description: """ This package contains libraries that have been deprecated from Iris, and are planned to be entirely removed at some point. """ depends: [ "coq-iris" {= version} ] build: ["./make-package" "iris_deprecated" "-j%{jobs}%"] install: ["./make-package" "iris_deprecated" "install"] iris-iris-4.2.0/coq-iris-heap-lang.opam000066400000000000000000000012521460620107300176640ustar00rootroot00000000000000opam-version: "2.0" maintainer: "Ralf Jung " authors: "The Iris Team" license: "BSD-3-Clause" homepage: "https://iris-project.org/" bug-reports: "https://gitlab.mpi-sws.org/iris/iris/issues" dev-repo: "git+https://gitlab.mpi-sws.org/iris/iris.git" version: "dev" synopsis: "The canonical example language for Iris" description: """ This package defines HeapLang, a concurrent lambda calculus with references, and uses Iris to build a program logic for HeapLang programs. """ tags: [ "logpath:iris.heap_lang" ] depends: [ "coq-iris" {= version} ] build: ["./make-package" "iris_heap_lang" "-j%{jobs}%"] install: ["./make-package" "iris_heap_lang" "install"] iris-iris-4.2.0/coq-iris-unstable.opam000066400000000000000000000012241460620107300176440ustar00rootroot00000000000000opam-version: "2.0" maintainer: "Ralf Jung " authors: "The Iris Team" license: "BSD-3-Clause" homepage: "https://iris-project.org/" bug-reports: "https://gitlab.mpi-sws.org/iris/iris/issues" dev-repo: "git+https://gitlab.mpi-sws.org/iris/iris.git" version: "dev" synopsis: "Unfinished Iris libraries" description: """ This package contains libraries that have been proposed for inclusion in Iris, but more work is needed before they are ready for this. """ depends: [ "coq-iris" {= version} "coq-iris-heap-lang" {= version} ] build: ["./make-package" "iris_unstable" "-j%{jobs}%"] install: ["./make-package" "iris_unstable" "install"] iris-iris-4.2.0/coq-iris.opam000066400000000000000000000024021460620107300160300ustar00rootroot00000000000000opam-version: "2.0" maintainer: "Ralf Jung " authors: "The Iris Team" license: "BSD-3-Clause" homepage: "https://iris-project.org/" bug-reports: "https://gitlab.mpi-sws.org/iris/iris/issues" dev-repo: "git+https://gitlab.mpi-sws.org/iris/iris.git" version: "dev" synopsis: "A Higher-Order Concurrent Separation Logic Framework with support for interactive proofs" description: """ Iris is a framework for reasoning about the safety of concurrent programs using concurrent separation logic. It can be used to develop a program logic, for defining logical relations, and for reasoning about type systems, among other applications. This package includes the base logic, Iris Proof Mode (IPM) / MoSeL, and a general language-independent program logic; see coq-iris-heap-lang for an instantiation of the program logic to a particular programming language. """ tags: [ "logpath:iris.prelude" "logpath:iris.algebra" "logpath:iris.si_logic" "logpath:iris.bi" "logpath:iris.proofmode" "logpath:iris.base_logic" "logpath:iris.program_logic" ] depends: [ "coq" { (>= "8.18" & < "8.20~") | (= "dev") } "coq-stdpp" { (= "dev.2024-04-12.0.eb2afa52") | (= "dev") } ] build: ["./make-package" "iris" "-j%{jobs}%"] install: ["./make-package" "iris" "install"] iris-iris-4.2.0/coq-lint.sh000077500000000000000000000010451460620107300155130ustar00rootroot00000000000000#!/bin/bash set -e ## A simple shell script checking for some common Coq issues. FILE="$1" if grep -E -n '^\s*((Existing\s+|Program\s+|Declare\s+)?Instance|Arguments|Remove|Hint\s+(Extern|Constructors|Resolve|Immediate|Mode|Opaque|Transparent|Unfold|Rewrite)|(Open|Close)\s+Scope|Opaque|Transparent|Typeclasses (Opaque|Transparent))\b' "$FILE"; then echo "ERROR: $FILE contains 'Instance'/'Arguments'/'Hint' or another side-effect without locality (see above)." echo "Please add 'Global' or 'Local' as appropriate." echo exit 1 fi iris-iris-4.2.0/docs/000077500000000000000000000000001460620107300143565ustar00rootroot00000000000000iris-iris-4.2.0/docs/editor.md000066400000000000000000000314301460620107300161670ustar00rootroot00000000000000Here we collect some information on how to set up your editor to properly input and output the unicode characters used throughout Iris. If you really want to, you can also avoid having to type unicode characters by importing `iris.bi.ascii`. That enables parsing-only ASCII alternatives to many unicode notations. (Feel free to report an issue when you notice that a notation is missing.) The easiest way to learn the ASCII syntax is to [read this file](/iris/bi/ascii.v). Note however that this will make your code harder to read and work on for Iris developers that are used to our default unicode notation---generally, our recommendation is to use the unicode syntax whenever possible. In particular, Unicode syntax is required for MRs to Iris itself and other Iris-managed repositories. ## General: Unicode Fonts Most editors will just use system fonts for rendering unicode characters and do not need further configuration once the fonts are installed. Here are some combinations of fonts that are known to give readable results (i.e., each of these sets of fonts covers all the required characters): * Fira Mono, DejaVu Mono, Symbola ## Emacs ### Unicode Input First, install `math-symbol-lists` by doing `M-x package-install math-symbol-lists`. Next, add the following to your `~/.emacs` to configure an input method based on the math symbol list, and with some custom aliases for symbols used a lot in Iris: ``` ;; Input of unicode symbols (require 'math-symbol-lists) ; Automatically use math input method for Coq files (add-hook 'coq-mode-hook (lambda () (set-input-method "math"))) ; Input method for the minibuffer (defun my-inherit-input-method () "Inherit input method from `minibuffer-selected-window'." (let* ((win (minibuffer-selected-window)) (buf (and win (window-buffer win)))) (when buf (activate-input-method (buffer-local-value 'current-input-method buf))))) (add-hook 'minibuffer-setup-hook #'my-inherit-input-method) ; Define the actual input method (quail-define-package "math" "UTF-8" "Ω" t) (quail-define-rules ; add whatever extra rules you want to define here... ("\\fun" ?λ) ("\\mult" ?⋅) ("\\ent" ?⊢) ("\\valid" ?✓) ("\\diamond" ?◇) ("\\box" ?□) ("\\bbox" ?■) ("\\later" ?▷) ("\\pred" ?φ) ("\\and" ?∧) ("\\or" ?∨) ("\\comp" ?∘) ("\\ccomp" ?◎) ("\\all" ?∀) ("\\ex" ?∃) ("\\to" ?→) ("\\sep" ?∗) ("\\lc" ?⌜) ("\\rc" ?⌝) ("\\Lc" ?⎡) ("\\Rc" ?⎤) ("\\lam" ?λ) ("\\empty" ?∅) ("\\Lam" ?Λ) ("\\Sig" ?Σ) ("\\-" ?∖) ("\\aa" ?●) ("\\af" ?◯) ("\\auth" ?●) ("\\frag" ?◯) ("\\iff" ?↔) ("\\gname" ?γ) ("\\incl" ?≼) ("\\latert" ?▶) ("\\update" ?⇝) ;; accents (for iLöb) ("\\\"o" ?ö) ;; subscripts and superscripts ("^^+" ?⁺) ("__+" ?₊) ("^^-" ?⁻) ("__0" ?₀) ("__1" ?₁) ("__2" ?₂) ("__3" ?₃) ("__4" ?₄) ("__5" ?₅) ("__6" ?₆) ("__7" ?₇) ("__8" ?₈) ("__9" ?₉) ("__a" ?ₐ) ("__e" ?ₑ) ("__h" ?ₕ) ("__i" ?ᵢ) ("__k" ?ₖ) ("__l" ?ₗ) ("__m" ?ₘ) ("__n" ?ₙ) ("__o" ?ₒ) ("__p" ?ₚ) ("__r" ?ᵣ) ("__s" ?ₛ) ("__t" ?ₜ) ("__u" ?ᵤ) ("__v" ?ᵥ) ("__x" ?ₓ) ) (mapc (lambda (x) (if (cddr x) (quail-defrule (cadr x) (car (cddr x))))) ; need to reverse since different emacs packages disagree on whether ; the first or last entry should take priority... ; see for discussion (reverse (append math-symbol-list-basic math-symbol-list-extended))) ``` ### Font Configuration Even when usable fonts are installed, Emacs tends to pick bad fonts for some symbols like universal and existential quantifiers. The following configuration results in a decent choice for the symbols used in Iris: ``` ;; Fonts (set-face-attribute 'default nil :height 110) ; height is in 1/10pt (dolist (ft (fontset-list)) ; Main font (set-fontset-font ft 'unicode (font-spec :name "Monospace")) ; Fallback font ; Appending to the 'unicode list makes emacs unbearably slow. ;(set-fontset-font ft 'unicode (font-spec :name "DejaVu Sans Mono") nil 'append) (set-fontset-font ft nil (font-spec :name "DejaVu Sans Mono")) ) ; Fallback-fallback font ; If we 'append this to all fontsets, it picks Symbola even for some cases where DejaVu could ; be used. Adding it only to the "t" table makes it Do The Right Thing (TM). (set-fontset-font t nil (font-spec :name "Symbola")) ``` ### Automated Indentation The default indentation configuration of company-coq is not compatible with the Iris syntax. As a result, automatic indentation will indent lines incorrectly. To solve some of these indentation errors you can add the following line to your Emacs initialisation file: ``` (setq coq-smie-user-tokens '(("," . ":=") ("∗" . "->") ("-∗" . "->") ("∗-∗" . "->") ("==∗" . "->") ("=∗" . "->") ;; Hack to match ={E1,E2}=∗ ("|==>" . ":=") ("⊢" . "->") ("⊣⊢" . "->") ("↔" . "->") ("←" . "<-") ("→" . "->") ("=" . "->") ("==" . "->") ("/\\" . "->") ("⋅" . "->") (":>" . ":=") ("by" . "now") ("forall" . "now") ;; NB: this breaks current ∀ indentation. )) ``` This will let the indentation strategy treat the Iris symbols (e.g. `-∗`) similar to the closely related Coq symbols (e.g. `->`). Note that `->` is used in many places, as its indentation behaviour is: ``` P -> Q ``` This is the indentation behaviour is what we want, e.g. for `∗`: ``` P ∗ Q ``` Note that this configuration has some caveats. Notably, the change to `forall` (which gives good behavior to e.g. `iInduction xs as [|x xs IHxs] forall (ys).`), now gives the following indentation behavior to universal quantification: ``` ∀ x, P x ``` This is not what we want; the second line should be indented by 2 spaces. ## CoqIDE 8.9 and earlier on Linux (ibus-m17n) On Linux with old versions of CoqIDE you can use the Intelligent Input Bus (IBus) framework to input Unicode symbols. First, install `ibus-m17n` via your system's package manager. Next, create a file `~/.m17n.d/coq.mim` to configure an input method based on the math symbol list, and with some custom aliases for symbols used a lot in Iris as defined [here](ibus). To use this input method, you should: 1. Enable the "Coq" input using your system settings or using the IBus configuration tool. The Coq input method typically appears in the category "other". 2. On some systems: In CoqIDE, you have to enable the input method by performing a right click on the text area, and selecting "System (IBus)" under "input method". ## CoqIDE 8.10+ Unicode input Instead of configuring the input system-wide, you can use CoqIDE's support for inputting Unicode symbols (introduced in Coq v8.10). To input a symbol, type a LaTeX-like escape sequence, for example `\alpha` and then type `-`, which will expand it into `α`. Expansion will work on a prefix of the command as well. You can also customize the expansion keyboard shortcut, which is under Tools/LaTeX-to-unicode. This system is configurable by adding a Unicode bindings file with additional expansion sequences. On Linux this file should go in `~/.config/coq/coqide.bindings` while on macOS it should go in `~/Library/Application Support/Coq/coqide.bindings` (or under `$XDG_CONFIG_HOME` if you have that set). Here is a `coqide.bindings` file for a variety of symbols used in Iris: ``` # LaTeX-like sequences are natively supported (eg, \forall, \mapsto) # Iris-specific abbreviations \fun λ \mult ⋅ 1 \ent ⊢ 1 \valid ✓ \diamond ◇ \box □ 1 \bbox ■ \later ▷ \pred φ \and ∧ \or ∨ \comp ∘ 1 \ccomp ◎ \all ∀ \ex ∃ \to → \sep ∗ \lc ⌜ 1 \rc ⌝ 1 \Lc ⎡ 1 \Rc ⎤ 1 \lam λ \empty ∅ \Lam Λ \Sig Σ \- ∖ 1 \aa ● 1 \af ◯ 1 \auth ● \frag ◯ \iff ↔ 1 \gname γ \incl ≼ \latert ▶ \update ⇝ # accents \"o ö \Lob Löb # subscripts and superscripts \^+ ⁺ \_+ ₊ \^- ⁻ \_0 ₀ \_1 ₁ \_2 ₂ \_3 ₃ \_4 ₄ \_5 ₅ \_6 ₆ \_7 ₇ \_8 ₈ \_9 ₉ \_a ₐ \_e ₑ \_h ₕ \_i ᵢ \_k ₖ \_l ₗ \_m ₘ \_n ₙ \_o ₒ \_p ₚ \_r ᵣ \_s ₛ \_t ₜ \_u ᵤ \_v ᵥ \_x ₓ ``` ## Visual Studio Code ### VSCoq setup The recommended extension as of December 2019 is [Maxime Dénès's VSCoq](https://marketplace.visualstudio.com/items?itemName=maximedenes.vscoq). Press `Ctrl Shift P` or `Cmd Shift P` and then type "coq" to see the list of Coq commands and keyboard shortcuts. ### Font setup To use unicode you need a font that supports all the symbols, such as [Fira Code](https://github.com/tonsky/FiraCode/wiki/Installing). Download and install the font, and in VS Code press `Cmd ,` or `Ctrl ,` to go to the settings, search for "font", and use "FiraCode-Retina" on macOS or "Fira Code Retina" on Linux as the font-family and optionally enable ligatures. ### Unicode input setup Install the [Generic input method extension](https://marketplace.visualstudio.com/items?itemName=mr-konn.generic-input-method). To insert a symbol, type the code for a symbol such as `\to` and then press `Space` or `Tab`. To enable Iris unicode input support, open your user settings, press `Cmd ,` or `Ctrl ,`, type "generic-input-methods.input-methods", and then click on "Edit in settings.json" and add the contents of [this file](vscode). ## Vim The [Coqtail](https://github.com/whonore/coqtail) plugin can be used to develop Coq code in `vim` (install it with your favorite plugin manager). Follow the installation instructions in Coqtail's README to setup your keybinds and find out about its usage. ### Unicode support For Unicode support, make sure that your terminal emulator supports Unicode and configure it to use a font with Unicode support. For entering Unicode symbols, one option is the plugin [latex-unicoder](https://github.com/joom/latex-unicoder.vim). Install it with your favorite plugin manager. To enter a Unicode symbol, hit `C-l` in normal or insert mode. For more details on the usage, see its README. latex-unicoder comes with a large set of pre-configured symbols known from LaTeX, but you can also add your own by adding (and adapting) the following to your `.vimrc`: ``` let g:unicode_map = { \ "\\fun" : "λ", \ "\\mult" : "⋅", \ "\\ent" : "⊢", \ "\\valid" : "✓", \ "\\diamond" : "◇", \ "\\box" : "□", \ "\\bbox" : "■", \ "\\later" : "▷", \ "\\pred" : "φ", \ "\\and" : "∧", \ "\\or" : "∨", \ "\\comp" : "∘", \ "\\ccomp" : "◎", \ "\\all" : "∀", \ "\\ex" : "∃", \ "\\to" : "→", \ "\\sep" : "∗", \ "\\lc" : "⌜", \ "\\rc" : "⌝", \ "\\Lc" : "⎡", \ "\\Rc" : "⎤", \ "\\lam" : "λ", \ "\\empty" : "∅", \ "\\Lam" : "Λ", \ "\\Sig" : "Σ", \ "\\-" : "∖", \ "\\aa" : "●", \ "\\af" : "◯", \ "\\auth" : "●", \ "\\frag" : "◯", \ "\\iff" : "↔", \ "\\gname" : "γ", \ "\\incl" : "≼", \ "\\latert" : "▶", \ "\\update" : "⇝", \ "\\\"o" : "ö", \ "_a" : "ₐ", \ "_e" : "ₑ", \ "_h" : "ₕ", \ "_i" : "ᵢ", \ "_k" : "ₖ", \ "_l" : "ₗ", \ "_m" : "ₘ", \ "_n" : "ₙ", \ "_o" : "ₒ", \ "_p" : "ₚ", \ "_r" : "ᵣ", \ "_s" : "ₛ", \ "_t" : "ₜ", \ "_u" : "ᵤ", \ "_v" : "ᵥ", \ "_x" : "ₓ", \ } ``` Alternatively, you can use snippets using [UltiSnips](https://github.com/SirVer/ultisnips). Install it with your favorite plugin manager, and register a completion key in your configuration: ``` let g:UltiSnipsExpandTrigger="" ``` To insert a unicode character, type its trigger word, such as `\forall` or `->`, and then press `` while still in insert mode. To register most common unicode characters, put [this file](vim_ultisnips) either at `~/.vim/UltiSnips/coq_unicode.snippets` or `~/.config/nvim/UltiSnips/coq_unicode.snippets`, depending on your preferred variant of Vim. iris-iris-4.2.0/docs/equalities_and_entailments.md000066400000000000000000000256751460620107300223110ustar00rootroot00000000000000# Equalities in Iris Using std++ and Iris involves dealing with a few subtly different equivalence and equality relations, especially among propositions. This document summarizes these relations and the subtle distinctions among them. This is not a general introduction to Iris: instead, we discuss the different Iris equalities and the interface to their Coq implementation. In particular, we discuss: - Equality ("=") in the *on-paper* Iris metatheory - Coq's Leibniz equality (`=`) and std++'s setoid equivalence (`≡`); - Iris `n`-equivalence on OFEs (`≡{n}≡`); - Iris internal equality (`≡` in `bi_scope`); - Iris entailment and bi-entailment (`⊢`, `⊣⊢`). We use `code font` for Coq notation and "quotes" for paper notation. ## Leibniz equality and setoids First off, in the metalogic (Coq) we have both the usual propositional (or Leibniz) equality `=`, and setoid equality `equiv` / `≡` (defined in `stdpp`). Both of these are metalogic connectives from the perspective of Iris, and as such are declared in Coq scope `stdpp_scope`. Setoid equality for a type `A` is defined by the instance of `Equiv A`. This should be accompanied by an `Equivalence` instance which proves that the given relation indeed is an equivalence relation. The handling of setoidsis based on Coq's [generalized rewriting](https://coq.inria.fr/refman/addendum/generalized-rewriting.html) facilities. Setoid equality can coincide with Leibniz equality, which is reflected by the `LeibnizEquiv` typeclass. We say that types with this property are "Leibniz types". `equivL` provides a convenient way to define a setoid with Leibniz equality. The tactics `fold_leibniz` and `unfold_leibniz` can be used to automatically turn all equalities of Leibniz types into `≡` or `=`. Given setoids `A` and `B` and a function `f : A → B`, an instance `Proper ((≡) ==> (≡)) f` declares that `f` respects setoid equality, as usual in Coq. Such instances enable rewriting with setoid equalities. Here, stdpp adds the following facilities: - `solve_proper` for automating proofs of `Proper` instances. - `f_equiv` generalizes `f_equal` to setoids (and indeed arbitrary relations registered with Coq's generalized rewriting). It will for instance turn the goal `f a ≡ f b` into `a ≡ b` given an appropriate `Proper` instance (here, `Proper ((≡) ==> (≡)) f`). ## Defining Proper instances - For each function `f` that could be used in generalized rewriting (e.g., has setoid, ofe, ordered arguments), there should be a `Params f n` instance. This instance forces Coq's setoid rewriting mechanism not to rewrite in the first `n` arguments of the function `f`. This significantly reduces backtracking during `Proper` search and thus improves performance/avoids failing instance searches that diverge. These first arguments typically include type variables (`A : Type` or `B : A → Type`), type class parameters (`C A`), and Leibniz arguments (`i : nat` or `i : Z`), so they cannot be rewritten or do not need setoid rewriting. Examples: + For `cons : ∀ A, A → list A → list A` we have `Params (@cons) 1`, indicating that the type argument named `A` is not up to rewriting. + For `replicate : ∀ A, nat → A → list A` we have `Params (@replicate) 2` indicating that the type argument `A` is not up to rewriting and that the `nat`-typed argument also does not show up as rewriteable in the `Proper` instance (because rewriting with `=` doesn't need such an instance). + For `lookup : ∀ {Lookup K A M}, K → M → option A` we have `Params (@lookup) 5`: there are 3 Type parameters, 1 type class, and a key (which is Leibniz for all instances). - Consequenently, `Proper .. f` instances are always written in such a way that `f` is partially applied with the first `n` arguments from `Params f n`. Note that implicit arguments count here. Further note that `Proper` instances never start with `(=) ==>`. Examples: + `Proper ((≡@{A}) ==> (≡@{list A}) ==> (≡@{list A})) cons`, where `cons` is `@cons A`, matching the 1 in `Params`. + `Proper ((≡@{A}) ==> (≡@{list A})) (replicate n)`, where `replicate n` is `@replicate A n`. + `Proper ((≡@{M}) ==> (≡@{option A})) (lookup k)`, where `lookup k` is `@lookup K A M _ k`, so 5 parameters are fixed, matching the `Params` instance. - Lemmas about higher-order functions often need `Params` premises. These are also written using the convention above. Example: ```coq Lemma set_fold_ind `{FinSet A C} {B} (P : B → C → Prop) (f : A → B → B) (b : B) : (∀ x, Proper ((≡) ==> impl) (P x)) → ... ``` - For premises involving predicates (such as `P` in `set_fold_ind` above), we always write the weakest `Proper`: that is, use `impl` instead of `iff` (and in Iris, write `(⊢)` instead of `(⊣⊢)`). For "simple" `P`s, there should be instances to solve both `impl` and `iff` using `solve_proper`, and for more complicated cases where `solve_proper` fails, an `impl` is much easier to prove by hand than an `iff`. ## Equivalences on OFEs On paper, OFEs involve two relations, equality "=" and distance "=_n". In Coq, equality "=" is formalized as setoid equality, written `≡` or `equiv`, as before; distance "=_n" is formalized as relation `dist n`, also written `≡{n}≡`. Tactics `solve_proper` and `f_equiv` also support distance. There is no correspondence to Coq's `=` on paper. Some OFE constructors choose interesting equalities. - `discreteO` constructs discrete OFEs (where distance coincides with setoid equality). - `leibnizO` constructs discrete OFEs (like `discreteO`) but using `equivL`, so that both distance and setoid equality coincide with Leibniz equality. This should only be used for types that do not have a setoid equality registered. Given OFEs `A` and `B`, non-expansive functions from `A` to `B` are functions `f : A → B` with a proof of `NonExpansive f` (which is notation for `∀ n, Proper (dist n ==> dist n) f`). The type `A -n> B` packages a function with a non-expansiveness proof. This is useful because `A -n> B` is itself an OFE, but should be avoided whenever possible as it requires the caller to specifically package up function and proof (which works particularly badly for lambda expressions). When an OFE structure on a function type is required but the domain is discrete, one can use the type `A -d> B`. This has the advantage of not bundling any proofs, i.e., this is notation for a plain Coq function type. See the `discrete_fun` documentation in [`iris.algebra.ofe`](../iris/algebra/ofe.v) for further details. In both OFE function spaces (`A -n> B` and `A -d> B`), setoid equality is defined to be pointwise equality, so that functional extensionality holds for `≡`. ## Inside the Iris logic Next, we introduce notions internal to the Iris logic. Such notions often overload symbols used for external notions; however, those overloaded notations are declared in scope `bi_scope`. When writing `(P)%I`, notations in `P` are resolved in `bi_scope`; this is done implicitly for the arguments of all variants of Iris entailments. The Iris logic has an internal concept of equality: if `a` and `b` are Iris terms of type `A`, then their internal equality is written (on paper) "a =_A b"; in Coq, that's written `(a ≡@{A} b)%I` (notation for `bi_internal_eq` in scope `bi_scope`). You can leave away the `@{A}` to let Coq infer the type. As shown in the Iris appendix, an internal equality `(a ≡ b)%I` is interpreted using OFE distance at the current step-index. Many types have `_equivI` lemmas characterizing internal equality on them. For instance, if `f, g : A -d> B`, lemma `discrete_fun_equivI` shows that `(f ≡ g)%I` is equivalent to `(∀ x, f x ≡ g x)%I`. An alternative to internal equality is to embed Coq equality into the Iris logic using `⌜ _ ⌝%I`. For discrete types, `(a ≡ b)%I` is equivalent to `⌜a ≡ b⌝%I`, and the latter can be moved into the Coq context, making proofs more convenient. For types with Leibniz equality, we can even equivalently write `⌜a = b⌝%I`, so no `Proper` is needed for rewriting. Note that there is no on-paper equivalent to using these embedded Coq equalities for types that are not discrete/Leibniz. ## Relations among Iris propositions In this section, we discuss relations among internal propositions, and in particular equality/equivalence of propositions themselves. Even though some of these notes generalize to all internal logics (other `bi`s), we focus on Iris propositions (`iProp`), to discuss both their proof theory and their model. As Iris propositions form a separation logic, we assume some familiarity with separation logics, connectives such as `-∗`, `∗`, `emp` and `→`, and the idea that propositions in separation logics are interpreted with predicates over resources (see for instance Sec. 2.1 of the MoSEL paper). In the metalogic, Iris defines the entailment relation between uniform predicates: intuitively, `P` entails `Q` (written `P ⊢ Q`) means that `P` implies `Q` on _every_ resource and at all step-indices (for details see Iris appendix [Sec. 6]). Entailment `P ⊢ Q` is distinct from the magic wand, `(P -∗ Q)%I`: the former is a Coq-level statement of type `Prop`, the latter an Iris-level statement of type `iProp`. However, the two are closely related: `P ⊢ Q` is equivalent to `emp ⊢ P -∗ Q` (per Iris lemmas `entails_wand` and `wand_entails`). Iris also defines a "unary" form of entailment, `⊢ P`, which is short for `emp ⊢ P`. We can also use bi-entailment `P ⊣⊢ Q` to express that both `P ⊢ Q` and `Q ⊢ P` hold. On paper, uniform predicates are defined by quotienting by an equivalence relation ([Iris appendix, Sec. 3.3]); in Coq, that relation is chosen as the setoid equivalent for the type of Iris propositions. This equivalence is actually equivalent to bi-entailment, per lemma `equiv_spec`: ```coq Lemma equiv_spec P Q : P ≡ Q ↔ (P ⊢ Q) ∧ (Q ⊢ P). ``` Relying on this equivalence, bi-entailment `P ⊣⊢ Q` is defined as notation for `≡`. ## Internal equality of Iris propositions Inside the logic, we can use internal equality `(≡)%I` on any type, including propositions themselves. However, there is a pitfall here: internal equality `≡` is in general strictly stronger than `∗-∗` (the bidirectional version of the magic wand), because `Q1 ≡ Q2` means that `Q1` and `Q2` are equivalent _independently of the available resources_. This makes `≡` even stronger than `□ (_ ∗-∗ _)`, because `□` does permit the usage of some resources (namely, the RA core of the available resources can still be used). The two notions of internal equivalence and equality of propositions are related by the following law of propositional extensionality: ```coq Lemma prop_ext P Q : P ≡ Q ⊣⊢ ■ (P ∗-∗ Q). ``` This uses the plainly modality `■` to reflect that equality corresponds to equivalence without any resources available: `■ R` says that `R` holds independent of any resources that we might own (but still taking into account the current step-index). iris-iris-4.2.0/docs/heap_lang.md000066400000000000000000000202511460620107300166160ustar00rootroot00000000000000# HeapLang overview HeapLang is the example language that gets shipped with Iris. It is not the only language you can reason about with Iris, but meant as a reasonable demo language for simple examples. ## Language HeapLang is a lambda-calculus with operations to allocate individual locations, `load`, `store`, `CmpXchg` (compare-and-exchange) and `FAA` (fetch-and-add). Moreover, it has a `fork` construct to spawn new threads. In terms of values, we have integers, booleans, unit, heap locations, as well as (binary) sums and products. Recursive functions are the only binders, so the sum elimination (`Case`) expects both branches to be of function type and passes them the data component of the sum. For technical reasons, the only terms that are considered values are those that begin with the `Val` expression former. This means that, for example, `Pair (Val a) (Val b)` is *not* a value -- it reduces to `Val (PairV a b)`, which is. This leads to some administrative redexes, and to a distinction between "value pairs", "value sums", "value closures" and their "expression" counterparts. However, this also makes values syntactically uniform, which we exploit in the definition of substitution which just skips over `Val` terms, because values should be closed and hence not affected by substitution. As a consequence, we can entirely avoid even talking about "closed terms", that notion just does not have to come up anywhere. We also exploit this when writing specifications, because we can just write lemmas involving terms of the form `Val ?v` and Coq can determine `?v` by unification (because all values start with the `Val` constructor). ## Notation Notation for writing HeapLang terms is defined in [`notation.v`](../theories/heap_lang/notation.v). There are two scopes, `%E` for expressions and `%V` for values. For example, `(a, b)%E` is an expression pair and `(a, b)%V` a value pair. The `e` of a `WP e {{ Q }}` is implicitly in `%E` scope. We define a whole lot of short-hands, such as non-recursive functions (`λ:`), let-bindings, sequential composition, and a more conventional `match:` that has binders in both branches. The widely used `#` is a short-hand to turn a basic literal (an integer, a location, a boolean literal or a unit value) into a value. Since values coerce to expressions, `#` is widely used whenever a Coq value needs to be placed into a HeapLang term. ## Tactics HeapLang comes with a bunch of tactics that facilitate stepping through HeapLang programs as part of proving a weakest precondition. All of these tactics assume that the current goal is of the shape `WP e @ E {{ Q }}`. Tactics to take one or more pure program steps: - `wp_pure pat credit:"H"`: Perform one pure reduction step. `pat` optionally defines the pattern that the redex has to match; it defaults to `_` (any redex). The `credit:` argument is optional, too; when present, a later credit will be generated in a fresh hypothesis named `"H"`. Pure steps are defined by the `PureExec` typeclass and include beta reduction, projections, constructors, as well as unary and binary arithmetic operators. - `wp_pures`: Perform as many pure reduction steps as possible. This tactic will **not** reduce lambdas/recs that are hidden behind a definition. If the computation reaches a value, the `WP` will be entirely removed and the postcondition becomes the new goal. - `wp_rec`, `wp_lam`: Perform a beta reduction. Unlike `wp_pure`, this will also reduce lambdas that are hidden behind a definition. - `wp_let`, `wp_seq`: Reduce a let-binding or a sequential composition. - `wp_proj`: Reduce a projection. - `wp_if_true`, `wp_if_false`, `wp_if`: Reduce a conditional expression. The discriminant must already be `true` or `false`. - `wp_unop`, `wp_binop`, `wp_op`: Reduce a unary, binary or either kind of arithmetic operator. - `wp_case`, `wp_match`: Reduce `Case`/`match:` constructs. - `wp_inj`, `wp_pair`, `wp_closure`: Reduce constructors that turn expression sums/pairs/closures into their value counterpart. Tactics for the heap: - `wp_alloc l as "H"`: Reduce an allocation instruction and call the new location `l` (in the Coq context) and the points-to assertion `H` (in the spatial context). You can leave out the `as "H"` to introduce it as an anonymous assertion, which is equivalent to `as "?"`. - `wp_load`: Reduce a load operation. This automatically finds the points-to assertion in the spatial context, and fails if it cannot be found. - `wp_store`: Reduce a store operation. This automatically finds the points-to assertion in the spatial context, and fails if it cannot be found. - `wp_cmpxchg_suc`, `wp_cmpxchg_fail`: Reduce a succeeding/failing CmpXchg. This automatically finds the points-to assertion. It also automatically tries to solve the (in)equality to show that the CmpXchg succeeds/fails, and opens a new goal if it cannot prove this goal. - `wp_cmpxchg as H1 | H2`: Reduce a CmpXchg, performing a case distinction over whether it succeeds or fails. This automatically finds the points-to assertion. The proof of equality in the first new subgoal will be called `H1`, and the proof of the inequality in the second new subgoal will be called `H2`. - `wp_faa`: Reduce a FAA. This automatically finds the points-to assertion. Further tactics: - `wp_bind pat`: Apply the bind rule to "focus" the term matching `pat`. For example, `wp_bind (!_)%E` focuses a load operation. This is useful in particular when accessing invariants, which is only possible when the `WP` in the goal is for a single, atomic operation -- `wp_bind` can be used to bring the goal into the right shape. - `wp_apply pm_trm as (x1 ... xn) "ipat1 ... ipatn"`: Apply a lemma whose conclusion is a `WP`, automatically applying `wp_bind` as needed. The `as` clause is optional and can be used to introduce the postcondition; this works particularly well for Texan triples. See the [ProofMode docs](./proof_mode.md) for an explanation of `pm_trm` and `ipat`. - `wp_smart_apply pm_trm as (x1 ... xn) "ipat1 ... ipatn"`: like `wp_apply`, but also performs pure reduction steps to reveal a redex that matches `pm_trm`. To be precise, if applying the lemma fails, `wp_smart_apply` will perform a step of pure reduction (via `wp_pure`), and repeat. (This means that `wp_smart_apply` is not the same as `wp_pures; wp_apply`.) There is no tactic for `Fork`, just do `wp_apply wp_fork`. To verify a recursive function, use `iLöb`. Make sure you do `wp_pures` before running `iLöb`; otherwise the induction hypothesis will likely not be applicable when you need it. (This makes sure that all administrative redexes are reduced in your induction hypothesis, just like we state our `WP` specifications with all of the redexes reduced.) ## Notation and lemmas for derived notions involving a thunk Sometimes, it is useful to define a derived notion in HeapLang that involves thunks. For example, the parallel composition `e1 ||| e2` is definable in HeapLang, but that requires thunking `e1` and `e2` before passing them to `par`. (This is defined in [`par.v`](theories/heap_lang/lib/par.v).) However, this is somewhat subtle because of the distinction between expression lambdas and value lambdas. The normal `e1 ||| e2` notation uses expression lambdas, because clearly we want `e1` and `e2` to behave normal under substitution (which they would not in a value lambda). However, the *specification* for parallel composition should use value lambdas, because prior to applying it the term will be reduced as much as possible to achieve a normal form. To facilitate this, we define a copy of the `e1 ||| e2` notation in the value scope that uses value lambdas. This is not actually a value, but we still put it in the value scope to differentiate from the other notation that uses expression lambdas. (In the future, we might decide to add a separate scope for this.) Then, we write the canonical specification using the notation in the value scope. This works very well for non-recursive notions. For `while` loops, the situation is unfortunately more complex and proving the desired specification will likely be more involved than expected, see this [discussion]. [discussion]: https://gitlab.mpi-sws.org/iris/iris/merge_requests/210#note_32842 iris-iris-4.2.0/docs/ibus000066400000000000000000000074201460620107300152460ustar00rootroot00000000000000;; Usage: copy to ~/.m17n.d/coq.mim (input-method t coq) (description "Input method for Coq") (title "Coq") (map (trans ;; Standard LaTeX math notations ("\\forall" "∀") ("\\exists" "∃") ("\\lam" "λ") ("\\not" "¬") ("\\/" "∨") ("/\\" "∧") ("->" "→") ("<->" "↔") ("\\<-" "←") ;; we add a backslash because the plain <- is used for the rewrite tactic ("\\==" "≡") ("\\/==" "≢") ("/=" "≠") ("<=" "≤") ("\\in" "∈") ("\\notin" "∉") ("\\cup" "∪") ("\\cap" "∩") ("\\setminus" "∖") ("\\subset" "⊂") ("\\subseteq" "⊆") ("\\sqsubseteq" "⊑") ("\\sqsubseteq" "⊑") ("\\notsubseteq" "⊈") ("\\meet" "⊓") ("\\join" "⊔") ("\\top" "⊤") ("\\bottom" "⊥") ("\\vdash" "⊢") ("\\dashv" "⊣") ("\\Vdash" "⊨") ("\\infty" "∞") ("\\comp" "∘") ("\\prf" "↾") ("\\bind" "≫=") ("\\mapsto" "↦") ("\\hookrightarrow" "↪") ("\\uparrow" "↑") ;; Iris specific ("\\fun" "λ") ("\\mult" "⋅") ("\\ent" "⊢") ("\\valid" "✓") ("\\diamond" "◇") ("\\box" "□") ("\\bbox" "■") ("\\later" "▷") ("\\pred" "φ") ("\\and" "∧") ("\\or" "∨") ("\\comp" "∘") ("\\ccomp" "◎") ("\\all" "∀") ("\\ex" "∃") ("\\to" "→") ("\\sep" "∗") ("\\lc" "⌜") ("\\rc" "⌝") ("\\Lc" "⎡") ("\\Rc" "⎤") ("\\empty" "∅") ("\\Lam" "Λ") ("\\Sig" "Σ") ("\\-" "∖") ("\\aa" "●") ("\\af" "◯") ("\\auth" "●") ("\\frag" "◯") ("\\iff" "↔") ("\\gname" "γ") ("\\incl" "≼") ("\\latert" "▶") ("\\update" "⇝") ("\\bind" "≫=") ;; accents (for iLöb) ("\\\"o" "ö") ;; subscripts and superscripts ("^^+" "⁺") ("__+" "₊") ("^^-" "⁻") ("__0" "₀") ("__1" "₁") ("__2" "₂") ("__3" "₃") ("__4" "₄") ("__5" "₅") ("__6" "₆") ("__7" "₇") ("__8" "₈") ("__9" "₉") ("__a" "ₐ") ("__e" "ₑ") ("__h" "ₕ") ("__i" "ᵢ") ("__k" "ₖ") ("__l" "ₗ") ("__m" "ₘ") ("__n" "ₙ") ("__o" "ₒ") ("__p" "ₚ") ("__r" "ᵣ") ("__s" "ₛ") ("__t" "ₜ") ("__u" "ᵤ") ("__v" "ᵥ") ("__x" "ₓ") ;; Greek alphabet ("\\Alpha" "Α") ("\\alpha" "α") ("\\Beta" "Β") ("\\beta" "β") ("\\Gamma" "Γ") ("\\gamma" "γ") ("\\Delta" "Δ") ("\\delta" "δ") ("\\Epsilon" "Ε") ("\\epsilon" "ε") ("\\Zeta" "Ζ") ("\\zeta" "ζ") ("\\Eta" "Η") ("\\eta" "η") ("\\Theta" "Θ") ("\\theta" "θ") ("\\Iota" "Ι") ("\\iota" "ι") ("\\Kappa" "Κ") ("\\kappa" "κ") ("\\Lamda" "Λ") ("\\lamda" "λ") ("\\Lambda" "Λ") ("\\lambda" "λ") ("\\Mu" "Μ") ("\\mu" "μ") ("\\Nu" "Ν") ("\\nu" "ν") ("\\Xi" "Ξ") ("\\xi" "ξ") ("\\Omicron" "Ο") ("\\omicron" "ο") ("\\Pi" "Π") ("\\pi" "π") ("\\Rho" "Ρ") ("\\rho" "ρ") ("\\Sigma" "Σ") ("\\sigma" "σ") ("\\Tau" "Τ") ("\\tau" "τ") ("\\Upsilon" "Υ") ("\\upsilon" "υ") ("\\Phi" "Φ") ("\\phi" "φ") ("\\Chi" "Χ") ("\\chi" "χ") ("\\Psi" "Ψ") ("\\psi" "ψ") ("\\Omega" "Ω") ("\\omega" "ω") )) (state (init (trans))) iris-iris-4.2.0/docs/proof_guide.md000066400000000000000000000177131460620107300172130ustar00rootroot00000000000000# Iris Proof Guide This work-in-progress document serves to explain how Iris proofs are typically carried out in Coq: what are the common patterns and conventions, what are the common pitfalls. This complements the tactic documentation for the [proof mode](./proof_mode.md) and [HeapLang](./heap_lang.md). ## Order of `Requires` In Coq, declarations in modules imported later may override the previous definition. Therefore, in order to make sure the most relevant declarations and notations always take priority, we recommend importing dependencies from the furthest to the closest. In particular, when importing Iris, Stdpp and Coq stdlib modules, we recommend importing in the following order: - Coq - stdpp - iris.algebra - iris.bi - iris.proofmode - iris.base_logic - iris.program_logic - iris.heap_lang ## Resolving mask mismatches Sometimes, `fupd` masks are not exactly what they need to be to make progress. There are two situations to distinguish here. #### Eliminating a [fupd] with a mask smaller than the current one When your goal is `|={E,_}=> _` and you want to do `iMod` on an `|={E',_}=> _`, Coq will complain even if `E' ⊆ E`. To resolve this, you first need to explicitly weaken your mask from `E` to `E'` by doing: ```coq iMod (fupd_mask_subseteq E') as "Hclose". { (* Resolve subset sidecondition. *) } ``` Later, you can `iMod "Hclose" as "_"` to restore the mask back from `E'` to `E`. Notice that this will make the invariants in `E' ∖ E` unavailable until you use `Hclose`. Usually this is not a problem, but there are theoretical situations where using `fupd_mask_subseteq` like this can prevent you from proving a goal. In that case, you will have to experiment with rules like `fupd_mask_frame`, but those are not very convenient to use. #### Introducing a [fupd] when the masks are not yet the same When your goal is `|={E,E'}=> _` and you want to do `iModIntro`, Coq will complain even if `E' ⊆ E`. This arises, for example, in clients of TaDA-style logically atomic specifications. To resolve this, do: ```coq iApply fupd_mask_intro. { (* Resolve subset sidecondition. *) } iIntros "Hclose". ``` Later, you can `iMod "Hclose" as "_"` to restore the mask back from `E'` to `E`. ## Canonical structures and type classes In Iris, we use both canonical structures and type classes, and some careful tweaking is necessary to make the two work together properly. The details of this still need to be written up properly, but here is some background material: * [Type Classes for Mathematics in Type Theory](http://www.eelis.net/research/math-classes/mscs.pdf) * [Canonical Structures for the working Coq user](https://hal.inria.fr/hal-00816703v1/document) ## Implicit generalization We often use the implicit generalization feature of Coq, triggered by a backtick: `` `{!term A B}`` means that an implicit argument of type `term A B` is added, and if any of the identifiers that are used here is not yet bound, it gets added as well. Usually, `term` will be some existing type class or similar, and we use this syntax to also generalize over `A` and `B`; then the above is equivalent to `{A B} {Hterm: term A B}`. The `!` in front of the term disables an even stronger form of generalization, where if `term` is a type class then all missing arguments get implicitly generalized as well. This is sometimes useful, e.g. we can write `` `{Countable C}`` instead of `` `{!EqDecision C, !Countable C}``. However, generally it is more important to be aware of the assumptions you are making, so implicit generalization without `!` should be avoided. ## Type class resolution control When you are writing a module that exports some Iris term for others to use (e.g., `join_handle` in the [spawn module](../iris_heap_lang/lib/spawn.v)), be sure to mark these terms as opaque for type class search at the *end* of your module (and outside any section): ```coq Typeclasses Opaque join_handle. ``` This makes sure that the proof mode does not "look into" your definition when it is used by clients. ## Library type class assumptions When a parameterized library needs to make some type class assumptions about its parameters, it is convenient to add those to the `libG` class that the library will likely need anyway (see the [resource algebra docs](resource_algebras.md) for further details on `libG` classes). For example, the STS library is parameterized by an STS and assumes that the STS state space is inhabited: ```coq Class stsG Σ (sts : stsT) := { sts_inG : inG Σ (stsR sts); sts_inhabited :> Inhabited (sts.state sts); }. Local Existing Instance sts_inG. ``` In this case, the `Instance` for this `libG` class has more than just a `subG` assumption: ```coq Instance subG_stsΣ Σ sts : subG (stsΣ sts) Σ → Inhabited (sts.state sts) → stsG Σ sts. Proof. solve_inG. Qed. ``` One subtle detail here is that the `subG` assumption comes first in `subG_stsΣ`, i.e., it appears before the `Inhabited`. This is important because otherwise, `sts_inhabited` and `subG_stsΣ` form an instance cycle that makes type class search diverge. ## Notations Notations starting with `(` or `{` should be left at their default level (`0`), and inner subexpressions that are bracketed by delimiters should be left at their default level (`200`). Moreover, correct parsing of notations sometimes relies on Coq's automatic left-factoring, which can require coordinating levels of certain "conflicting" notations and their subexpressions. For instance, to disambiguate `(⊢@{ PROP })` and `(⊢@{ PROP } P)`, Coq must factor out a nonterminal for `⊢@{ PROP }`, but it can only do so if all occurrences of `⊢@{ PROP }` agree on the precedences for all subexpressions. This also requires using the same tokenization in all cases, i.e., the notation has to consistently be declared as `(⊢@{` or `('⊢@{'`, but not a mixture of the two. The latter form of using explicit tokenization with `'` is preferred to avoid relying on Coq's default. For details, consult [the Coq manual](https://coq.inria.fr/refman/user-extensions/syntax-extensions.html#simple-factorization-rules). ## Naming conventions for variables/arguments/hypotheses ### small letters * a : A = cmra or ofe * b : B = cmra or ofe * c * d * e : expr = expressions * f = some generic function * g = some generic function * h : heap * i * j * k * l * m* = prefix for option ("maybe") * n * o * p * q * r : iRes = (global) resources inside the Iris model * s = state (STSs) * s = stuckness bits * t * u * v : val = values of language * w * x * y * z ### capital letters * A : Type, cmra or ofe * B : Type, cmra or ofe * C * D * E : coPset = mask of fancy update or WP * F = a functor * G * H = hypotheses * I = indexing sets * J * K : ectx = evaluation contexts * K = keys of a map * L * M = maps / global CMRA * N : namespace * O * P : uPred, iProp or Prop * Q : uPred, iProp or Prop * R : uPred, iProp or Prop * S : set state = state sets in STSs * T : set token = token sets in STSs * U * V * W * X : sets * Y : sets * Z : sets ### small greek letters * γ : gname = name of ghost state instance * σ : state = state of language * φ : Prop = pure proposition embedded into uPred or iProp ### capital greek letters * Φ : general predicate (in uPred, iProp or Prop) * Ψ : general predicate (in uPred, iProp or Prop) ## Naming conventions for algebraic classes ### Suffixes * O: OFEs * R: cameras * UR: unital cameras or resources algebras * F: functors (can be combined with all of the above, e.g. OF is an OFE functor) * G: global camera functor management (typeclass; see the [resource algebra docs](resource_algebras.md)) * GS: global singleton (a `*G` type class with extra data that needs to be unique in a proof) * GpreS: collecting preconditions to instantiate the corresponding `*GS` * I: bunched implication logic (of type `bi`) * SI: step-indexed bunched implication logic (of type `sbi`) * T: canonical structures for algebraic classes (for example ofe for OFEs, cmra for cameras) * Σ: global camera functor management (`gFunctors`; see the [resource algebra docs](resource_algebras.md)) iris-iris-4.2.0/docs/proof_mode.md000066400000000000000000000644521460620107300170440ustar00rootroot00000000000000Tactic overview =============== This reference manual defines a few different syntaxes that are used pervasively. These are defined in dedicated sections in this manual. - An "[introduction pattern][ipat]" `ipat` like `"H"` or `"[H1 H2]"` is used to _destruct_ a hypothesis (sometimes called _eliminating_ a hypothesis). This is directly used by `iDestruct` and `iIntros`, but many tactics also integrate support for `ipat`s to combine some other work with destructing, such as `iMod`. The name "introduction pattern" comes from a similar term in Coq which is used in tactics like `destruct` and `intros`. - A "[selection pattern][selpat]" `selpat` like `"H1 H2"` or `"#"` names a collection of hypotheses. Most commonly used in `iFrame`. - A "[specialization pattern][spat]" `spat` like `H` or `[$H1 H2]` is used to specialize a wand to some hypotheses along with specifying framing. Commonly used as part of proof mode terms (described just below). - A "[proof mode term][pm-trm]" `pm_trm` like `lemma with spat` or `"H" $! x with spat` allows to specialize a wand (which can be either a Gallina lemma or a hypothesis) on the fly, as an argument to `iDestruct` for example. Many of the tactics below apply to more goals than described in this document since the behavior of these tactics can be tuned via instances of the type classes in the file [proofmode/classes](iris/proofmode/classes.v). Most notably, many of the tactics can be applied when the connective to be introduced or to be eliminated appears under a later, an update modality, or in the conclusion of a weakest precondition. [ipat]: #introduction-patterns-ipat [selpat]: #selection-patterns-selpat [spat]: #specialization-patterns-spat [pm-trm]: #proof-mode-terms-pm_trm Starting and stopping the proof mode ------------------------------------ - `iStartProof` : start the proof mode by turning a Coq goal into a proof mode entailment. This tactic is performed implicitly by all proof mode tactics described in this file, and thus should generally not be used by hand. + `iStartProof PROP` : explicitly specify which BI logic `PROP : bi` should be used. This is useful to drop down in a layered logic, e.g. to drop down from `monPred PROP` to `PROP`. - `iStopProof` : turn the proof-mode entailment into an ordinary Coq goal `big star of context ⊢ proof mode goal`. Applying hypotheses and lemmas ------------------------------ - `iExact "H"` : finish the goal if the conclusion matches the hypothesis `H` - `iAssumption` : finish the goal if the conclusion matches any hypothesis in either the proofmode or the Coq context. Only hypotheses in the Coq context that are _syntactically_ of the shape `⊢ P` are recognized by this tactic (this means that assumptions of the shape `P ⊢ Q` are not recognized). - `iApply pm_trm` : match the conclusion of the current goal against the conclusion of `pm_trm` and generates goals for the premises of `pm_trm`. See [proof mode terms][pm-trm] below. If the applied term has more premises than given specialization patterns, the pattern is extended with `[] ... []`. As a consequence, all unused spatial hypotheses move to the last premise. Context management ------------------ - `iIntros (x1 ... xn) "ipat1 ... ipatn"` : introduce universal quantifiers using Coq introduction patterns `x1 ... xn` and implications/wands using proof mode [introduction patterns][ipat] `ipat1 ... ipatn`. - `iClear (x1 ... xn) "selpat"` : clear the hypotheses given by the [selection pattern][selpat] `selpat` and the Coq level hypotheses/variables `x1 ... xn`. - `iClear select (pat)%I` : clear the last hypothesis of the intuitionistic or spatial context that matches pattern `pat`. - `iRevert (x1 ... xn) "selpat"` : revert the hypotheses given by the [selection pattern][selpat] `selpat` into wands, and the Coq level hypotheses/variables `x1 ... xn` into universal quantifiers. Intuitionistic hypotheses are wrapped into the intuitionistic modality. - `iRevert select (pat)%I` : revert the last hypothesis of the intuitionistic or spatial context that matches pattern `pat`. - `iRename "H1" into "H2"` : rename the hypothesis `H1` into `H2`. - `iRename select (pat)%I into "H"` : rename the last hypothesis of the intuitionistic or spatial context that matches pattern `pat` into `H`. This is particularly useful to give a name to an anonymous hypothesis. - `iSpecialize pm_trm` : instantiate universal quantifiers and eliminate implications/wands of a hypothesis `pm_trm`. See [proof mode terms][pm-trm] below. - `iSpecialize pm_trm as #` : instantiate universal quantifiers and eliminate implications/wands of a hypothesis `pm_trm` whose conclusion is persistent. All hypotheses can be used for proving the premises of `pm_trm`, as well as for the resulting main goal. - `iPoseProof pm_trm as (x1 ... xn) "ipat"` : put `pm_trm` into the context and destruct it using the [introduction pattern][ipat] `ipat`. This tactic is essentially the same as `iDestruct` with the difference that `pm_trm` is not thrown away if possible. - `iAssert (P)%I with "spat" as "H"` : generate a new subgoal `P` and add the hypothesis `P` to the current goal as `H`. The [specialization pattern][spat] `spat` specifies which hypotheses will be consumed by proving `P`. + `iAssert (P)%I with "spat" as "ipat"` : like the above, but immediately destruct the generated hypothesis using the [introduction pattern][ipat] `ipat`. If `ipat` is "intuitionistic" (most commonly, it starts with `#` or `%`), then all spatial hypotheses are available in both the subgoal for `P` as well as the current goal. An `ipat` is considered intuitionistic if all branches start with a `#` (which causes `P` to be moved to the intuitionistic context) or with a `%` (which causes `P` to be moved to the pure Coq context). + `iAssert (P)%I as %cpat` : assert `P` and destruct it using the Coq introduction pattern `cpat`. All hypotheses can be used for proving `P` as well as for proving the current goal. - `iSelect (pat)%I tac` : run the tactic `tac H`, where `H` is the name of the last hypothesis in the intuitionistic or spatial hypothesis context that matches pattern `pat`. There is no backtracking to select the next hypothesis in case `tac H` fails. Introduction of logical connectives ----------------------------------- - `iPureIntro` : turn a pure goal, typically of the form `⌜φ⌝`, into a Coq goal. This tactic also works for goals of the shape `a ≡ b` on discrete OFEs, and `✓ a` on discrete cameras. - `iLeft` : prove a disjunction `P ∨ Q` by proving the left side `P`. - `iRight` : prove a disjunction `P ∨ Q` by proving the right side `Q`. - `iSplitL "H1 ... Hn"` : split a conjunction `P ∗ Q` into two proofs. The hypotheses `H1 ... Hn` are used for the left conjunct, and the remaining ones for the right conjunct. Intuitionistic hypotheses are always available in both proofs. Also works on `P ∧ Q`, although in that case you can use `iSplit` and retain all the hypotheses in both goals. - `iSplitR "H0 ... Hn"` : symmetric version of the above, using the hypotheses `H1 ... Hn` for the right conjunct. Note that the goals are still ordered left-to-right; you can use `iSplitR "..."; last first` to reverse the generated goals. - `iSplit` : split a conjunction `P ∧ Q` into two goals. Also works for separating conjunction `P ∗ Q` provided one of the operands is persistent (and both proofs may use the entire spatial context). - `iExists t1, .., tn` : provide a witness for an existential quantifier `∃ x, ...`. `t1 ... tn` can also be underscores, which are turned into evars. (In fact they can be arbitrary terms with holes, or `open_constr`s, and all of the holes will be turned into evars.) Elimination of logical connectives ---------------------------------- - `iExFalso` : change the goal to proving `False`. - `iDestruct` is an important enough tactic to describe several special cases: + `iDestruct "H1" as (x1 ... xn) "H2"` : eliminate a series of existential quantifiers in hypothesis `H1` using Coq introduction patterns `x1 ... xn` and name the resulting hypothesis `H2`. The Coq introduction patterns can also be used for pure conjunctions; for example we can destruct `∃ x, ⌜v = x⌝ ∗ l ↦ x` using `iDestruct "H" as (x Heq) "H"` to immediately put `Heq: v = x` in the Coq context. This variant of the tactic will always throw away the original hypothesis `H1`. + `iDestruct pm_trm as "ipat"` : specialize the [proof-mode term][pm-trm] (see below) and destruct it using the [introduction pattern][ipat] `ipat`. If `pm_trm` starts with a hypothesis, and that hypothesis resides in the intuitionistic context, it will not be thrown away. + `iDestruct pm_trm as (x1 ... xn) "ipat"` : combine the above, first specializing `pm_trm`, then eliminating existential quantifiers (and pure conjuncts) with `x1 ... xn`, and finally destructing the resulting term using the [introduction pattern][ipat] `ipat`. + `iDestruct pm_trm as %cpat` : destruct the pure conclusion of a term `pr_trm` using the Coq introduction pattern `cpat`. When using this tactic, all hypotheses can be used for proving the premises of `pm_trm`, as well as for proving the resulting goal. + `iDestruct num as (x1 ... xn) "ipat"` / `iDestruct num as %cpat` : introduce `num : nat` hypotheses and destruct the last introduced hypothesis. + `iDestruct select (pat)%I as ...` is the same as `iDestruct "H" as ...`, where `H` is the name of the last hypothesis of the intuitionistic or spatial context matching pattern `pat`. In case all branches of `ipat` start with a `#` (which causes the hypothesis to be moved to the intuitionistic context), with an `%` (which causes the hypothesis to be moved to the pure Coq context), or with an `->`/`<-` (which performs a rewrite), then one can use all hypotheses for proving the premises of `pm_trm`, as well as for proving the resulting goal. Note that in this case the hypotheses still need to be subdivided among the spatial premises. Separation logic-specific tactics --------------------------------- - `iFrame (t1 .. tn) "selpat"` : cancel the Coq terms (or Coq hypotheses) `t1 ... tn` and Iris hypotheses given by [`selpat`][selpat] in the goal. The constructs of the selection pattern have the following meaning: + `%` : repeatedly frame hypotheses from the Coq context. + `#` : repeatedly frame hypotheses from the intuitionistic context. + `∗` : frame as much of the spatial context as possible. (N.B: this is the unicode symbol `∗`, not the regular asterisk `*`.) Notice that framing spatial hypotheses makes them disappear, but framing Coq or intuitionistic hypotheses does not make them disappear. This tactic solves the goal if everything in the conclusion has been framed. - `iFrame select (pat)%I` : cancel the last hypothesis of the intuitionistic of spatial context that matches pattern `pat`. - `iCombine "H1 H2" as "ipat"` : combine `H1 : P1` and `H2 : P2` into `H: P1 ∗ P2` or something simplified but equivalent, then `destruct` the combined hypothesis using `ipat`. Some examples of simplifications `iCombine` knows about are to combine `own γ x` and `own γ y` into `own γ (x ⋅ y)`, and to combine `l ↦{1/2} v` and `l ↦{1/2} v` into `l ↦ v`. - `iCombine "H1 H2" gives "ipat"` : from `H1 : P1` and `H2 : P2`, find persistent consequences of `P1 ∗ P2`, then `destruct` this consequence with `ipat`. Some examples of persistent consequences `iCombine` knows about are that `own γ x` and `own γ y` gives `✓ (x ⋅ y)`, and that `l ↦{#q1} v1` and `l ↦{#q2} v2` gives `⌜(q1 + q2 ≤ 1) ∧ v1 = v2⌝`. - `iCombine "H1 H2" as "ipat1" gives "ipat2"` combines the two functionalities of `iCombine` described above. - `iAccu` : solve a goal that is an evar by instantiating it with all hypotheses from the spatial context joined together with a separating conjunction (or `emp` in case the spatial context is empty). Not commonly used, but can be extremely useful when combined with automation. Modalities ---------- - `iModIntro` : introduce a modality in the goal. The type class `FromModal` is used to specify which modalities this tactic should introduce, and how introducing that modality affects the hypotheses. Instances of that type class include: later, except 0, basic update and fancy update, intuitionistically, persistently, affinely, plainly, absorbingly, objectively, and subjectively. + `iModIntro mod` (rarely used): introduce a specific modality named by `mod`, which is a term pattern (i.e., a term with holes as underscores). `iModIntro mod` will find a subterm matching `mod`, and try introducing its topmost modality. For instance, if the goal is `⎡|==> P⎤`, using `iModIntro ⎡|==> P⎤%I` or `iModIntro ⎡_⎤%I` would introduce `⎡_⎤` and produce goal `|==> P`, while `iModIntro (|==> _)%I` would introduce `|==>` and produce goal `⎡P⎤`. + `iNext` : an alias of `iModIntro (▷^_ _)` (that is, introduce the later modality). This eliminates a later in the goal, and in exchange also strips one later from all the hypotheses. + `iNext n` : an alias of `iModIntro (▷^n _)` (that is, introduce the `▷^n` modality). + `iAlways` : a deprecated alias of `iModIntro` (intended to introduce the `□` modality). - `iMod pm_trm as (x1 ... xn) "ipat"` : eliminate a modality `pm_trm` that is an instance of the `ElimModal` type class, and destruct the resulting hypothesis using `ipat`. Instances include: later, except 0, basic update `|==>` and fancy update `|={E}=>`. + `iMod "H"` : equivalent to `iMod "H" as "H"` (eliminates the modality and keeps the name of the hypothesis). + `iMod pm_trm` : equivalent to `iMod pm_term as "?"` (the resulting hypothesis will be introduced anonymously). Induction --------- - `iLöb as "IH"` : perform Löb induction by generating a hypothesis `IH : ▷ goal`. + `iLöb as "IH" forall (x1 ... xn) "selpat"` : perform Löb induction, generalizing over the Coq level variables `x1 ... xn`, the hypotheses given by the selection pattern `selpat`, and the spatial context as usual. - `iInduction x as cpat "IH" "selpat"` : perform induction on the Coq term `x`. The Coq introduction pattern `cpat` is used to name the introduced variables. The induction hypotheses are inserted into the intuitionistic context and given fresh names prefixed `IH`. + `iInduction x as cpat "IH" forall (x1 ... xn) "selpat"` : perform induction, generalizing over the Coq level variables `x1 ... xn`, the hypotheses given by the selection pattern `selpat`, and the spatial context. + `iInduction x as cpat "IH" using t` : perform induction using the induction scheme `t`. Common examples of induction schemes are `map_ind`, `set_ind_L`, and `gmultiset_ind` for `gmap`, `gset`, and `gmultiset`. + `iInduction x as cpat "IH" using t forall (x1 ... xn) "selpat"` : the above variants combined. Rewriting / simplification -------------------------- - `iRewrite pm_trm` / `iRewrite pm_trm in "H"` : rewrite using an internal equality in the proof mode goal / hypothesis `H`. - `iRewrite -pm_trm` / `iRewrite -pm_trm in "H"` : rewrite in reverse direction using an internal equality in the proof mode goal / hypothesis `H`. - `iEval (tac)` / `iEval (tac) in "selpat"` : perform a tactic `tac` on the proof mode goal / hypotheses given by the selection pattern `selpat`. Using `%` as part of the selection pattern is unsupported. The tactic `tac` should be a reduction or rewriting tactic like `simpl`, `cbv`, `lazy`, `rewrite` or `setoid_rewrite`. The `iEval` tactic is implemented by running `tac` on `?evar ⊢ P` / `P ⊢ ?evar` where `P` is the proof goal / a hypothesis given by `selpat`. After running `tac`, `?evar` is unified with the resulting `P`, which in turn becomes the new proof mode goal / a hypothesis given by `selpat`. Note that parentheses around `tac` are needed. - `iSimpl` / `iSimpl in "selpat"` : perform `simpl` on the proof mode goal / hypotheses given by the selection pattern `selpat`. This is a shorthand for `iEval (simpl)`. Iris ---- - `iInv H as (x1 ... xn) "ipat"` : open an invariant in hypothesis H. The result is destructed using the Coq intro patterns `x1 ... xn` (for existential quantifiers) and then the proof mode [introduction pattern][ipat] `ipat`. + `iInv H with "selpat" as (x1 ... xn) "ipat" "Hclose"` : generate an update for closing the invariant and put it in a hypothesis named `Hclose`. + `iInv H with "selpat" as (x1 ... xn) "ipat"` : supply a selection pattern `selpat`, which is used for any auxiliary assertions needed to open the invariant (e.g. for cancelable or non-atomic invariants). + `iInv N as (x1 ... xn) "ipat"` : identify the invariant to be opened with a namespace `N` rather than giving a specific hypothesis. + `iInv S with "selpat" as (x1 ... xn) "ipat" "Hclose"` : combine all the above, where `S` is either a proof-mode identifier or a namespace. Miscellaneous ------------- - The tactic `done` of [std++](https://gitlab.mpi-sws.org/iris/stdpp/-/blob/master/theories/tactics.v) (which solves "trivial" goals using `intros`, `reflexivity`, `symmetry`, `eassumption`, `trivial`, `split`, `discriminate`, `contradiction`, etc.) is extended so that it also, among other things: + performs `iAssumption`, + introduces `∀`, `→`, and `-∗` in the proof mode, + introduces pure goals `⌜ φ ⌝` using `iPureIntro` and calls `done` on `φ`, and, + solves other trivial proof mode goals, such as `emp`, `x ≡ x`, big operators over the empty list/map/set/multiset. (Note that ssreflect also has a `done` tactic. Although Iris uses ssreflect, it overrides ssreflect's `done` tactic with std++'s.) - The proof mode adds hints to the core `eauto` database so that `eauto` automatically introduces: conjunctions and disjunctions, universal and existential quantifiers, implications and wand, plainness, persistence, later and update modalities, and pure connectives. Selection patterns (`selpat`) ============================= Selection patterns are used to select hypotheses in the tactics `iRevert`, `iClear`, `iFrame`, `iLöb` and `iInduction`. The proof mode supports the following _selection patterns_: - `H` : select the hypothesis named `H`. - `%` : select the entire pure/Coq context. - `#` : select the entire intuitionistic context. - `∗` : select the entire spatial context. (N.B: this is the unicode symbol `∗`, not the regular asterisk `*`.) Introduction patterns (`ipat`) ============================== Introduction patterns are used to perform introductions and eliminations of multiple connectives on the fly. The proof mode supports the following _introduction patterns_: - `H` : create a hypothesis named `H`. - `?` : create an anonymous hypothesis. - `_` : clear the hypothesis. - `$` : frame the hypothesis in the goal. - `[ipat1 ipat2]` : (separating) conjunction elimination. In order to destruct conjunctions `P ∧ Q` in the spatial context, one of the following conditions should hold: + Either the proposition `P` or `Q` should be persistent. + Either `ipat1` or `ipat2` should be `_`, which results in one of the conjuncts to be thrown away. - `[%x ipat]`/`[% ipat]` : existential elimination, naming the witness `x` or keeping it anonymous. Falls back to (separating) conjunction elimination in case the hypothesis is not an existential, so this pattern also works for (separating) conjunctions with a pure left-hand side. - `(pat1 & pat2 & ... & patn)` : syntactic sugar for `[pat1 [pat2 .. patn ..]]` to destruct nested (separating) conjunctions. - `[ipat1|ipat2]` : disjunction elimination. - `[]` : false elimination. - `%H` : move the hypothesis to the pure Coq context, and name it `H`. - `%` : move the hypothesis to the pure Coq context (anonymously). Note that if `%` is followed by an identifier, and not another token, a space is needed to disambiguate from `%H` above. - `->` and `<-` : rewrite using a pure Coq equality - `# ipat` : move the hypothesis into the intuitionistic context. The tactic will fail if the hypothesis is not intuitionistic. On success, the tactic will strip any number of intuitionistic and persistence modalities. If the hypothesis is already in the intuitionistic context, the tactic will still strip intuitionistic and persistence modalities (it is a no-op if the hypothesis does not contain such modalities). - `-# ipat` (uncommon) : move the hypothesis into the spatial context. This can move a hypothesis from the intuitionistic context to the spatial context, or can explicitly specify the spatial context when the intuitionistic context could be used (e.g., because a hypothesis was proven without using spatial hypotheses). If the hypothesis is already in the spatial context, the tactic is a no-op. If the hypothesis is not affine, an `` modality is added to the hypothesis. - `> ipat` : eliminate a modality (if the goal permits); commonly used to strip a later from the hypothesis when it is timeless and the goal is either a `WP` or an update modality `|={E}=>`. Apart from this, there are the following introduction patterns that can only appear at the top level: - `{selpat}` : clear the hypotheses given by the selection pattern `selpat`. 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 a modality by calling `iModIntro`. - `!#` : introduce a modality by calling `iModIntro` (deprecated). - `/=` : perform `simpl`. - `//` : perform `try done` on all goals. - `//=` : syntactic sugar for `/= //` - `*` : introduce all universal quantifiers. (N.B.: this is the asterisk `*` and not the separating conjunction `∗`) - `**` : introduce all universal quantifiers, as well as all arrows and wands. For example, given: ∀ x, ⌜ x = 0 ⌝ ⊢ □ (P → False ∨ □ (Q ∧ ▷ R) -∗ P ∗ ▷ (R ∗ Q ∧ ⌜ x = pred 2 ⌝)). You can write iIntros (x Hx) "!> $ [[] | #[HQ HR]] /= !>". which results in: x : nat Hx : x = 0 ______________________________________(1/1) "HQ" : Q "HR" : R --------------------------------------□ R ∗ Q ∧ x = 1 Specialization patterns (`spat`) ================================ Since we are reasoning in a spatial logic, when eliminating a lemma or hypothesis of type ``P_0 -∗ ... -∗ P_n -∗ R``, one has to specify how the hypotheses are split between the premises. The proof mode supports the following _specialization patterns_ to express splitting of hypotheses: - `H` : use the hypothesis `H`, which should match the premise exactly. If `H` is spatial, it will be consumed. - `(H spat1 .. spatn)` : first recursively specialize the hypothesis `H` using the specialization patterns `spat1 .. spatn`, and finally use the result of the specialization of `H`, which should match the premise exactly. If `H` is spatial, it will be consumed. - `[H1 .. Hn]` and `[H1 .. Hn //]` : generate a goal for the premise with the (spatial) hypotheses `H1 ... Hn` and all intuitionistic hypotheses. The spatial hypotheses among `H1 ... Hn` will be consumed, and will not be available for subsequent goals. Hypotheses prefixed with a `$` will be framed in the goal for the premise. The pattern can be terminated with a `//`, which causes `done` to be called to close the goal (after framing). - `[-H1 ... Hn]` and `[-H1 ... Hn //]` : the negated forms of the above patterns, where the goal for the premise will have all spatial premises except `H1 .. Hn`. - `[> H1 ... Hn]` and `[> H1 ... Hn //]` : like the above patterns, but these patterns can only be used if the goal is a modality `M`, in which case the goal for the premise will be wrapped in the modality `M`. - `[> -H1 ... Hn]` and `[> -H1 ... Hn //]` : the negated forms of the above patterns. - `[# $H1 .. $Hn]` and `[# $H1 .. $Hn //]` : generate a goal for a persistent premise in which all hypotheses are available. This pattern does not consume any hypotheses; all hypotheses are available in the goal for the premise as well in the subsequent goal. The hypotheses `$H1 ... $Hn` will be framed in the goal for the premise. These patterns can be terminated with a `//`, which causes `done` to be called to close the goal (after framing). - `[%]` and `[% //]` : generate a Coq goal for a pure premise. This pattern does not consume any hypotheses. The pattern can be terminated with a `//` which causes `done` to be called to close the goal. - `[$]` : solve the premise by framing. It will first repeatedly frame and consume the spatial hypotheses, and then repeatedly frame the intuitionistic hypotheses. Spatial hypotheses that are not framed are carried over to the subsequent goal. - `[> $]` : like the above pattern, but this pattern can only be used if the goal is a modality `M`, in which case the goal for the premise will be wrapped in the modality `M` before framing. - `[# $]` : solve the persistent premise by framing. It will first repeatedly frame the spatial hypotheses, and then repeatedly frame the intuitionistic hypotheses. This pattern does not consume any hypotheses. For example, given: H : □ P -∗ P 2 -∗ R -∗ x = 0 -∗ Q1 ∗ Q2 One can write: iDestruct ("H" with "[#] [H1 $H2] [$] [% //]") as "[H4 H5]". Proof mode terms (`pm_trm`) =========================== Many of the proof mode tactics (such as `iDestruct`, `iApply`, `iRewrite`) can take both hypotheses and lemmas, and allow one to instantiate universal quantifiers and implications/wands of these hypotheses/lemmas on the fly. The syntax for the arguments of these tactics, called _proof mode terms_, is: (H $! t1 ... tn with "spat1 .. spatn") Here, `H` can be either a hypothesis or a Coq lemma whose conclusion is of the shape `P ⊢ Q`. In the above, `t1 ... tn` are arbitrary Coq terms used for instantiation of universal quantifiers, and `spat1 .. spatn` are [specialization patterns][spat] to eliminate implications and wands. Proof mode terms can be written down using the following shorthand syntaxes, too: (H with "spat1 .. spatn") (H $! t1 ... tn) H HeapLang tactics ================ If you came here looking for the `wp_` tactics, those are described in the [HeapLang documentation](./heap_lang.md). iris-iris-4.2.0/docs/resource_algebras.md000066400000000000000000000331751460620107300204000ustar00rootroot00000000000000## Global resource algebra management The type of Iris propositions `iProp Σ` is parameterized by a *global* list `Σ: gFunctors` of resource algebras that the proof may use. (Actually this list contains functors instead of resource algebras, but you only need to worry about that when dealing with higher-order ghost state -- see "Camera functors" below.) In our proofs, we always keep the `Σ` universally quantified to enable composition of proofs. Each proof just assumes that some particular resource algebras are contained in that global list. This is expressed via the `inG Σ R` typeclass, which roughly says that `R ∈ Σ` ("`R` is in the `G`lobal list of RAs `Σ` -- hence the `G`). Libraries typically bundle the `inG` they need in a `libG` typeclass, so they do not have to expose to clients what exactly their resource algebras are. For example, in the [one-shot example](../tests/one_shot.v), we have: ```coq Class one_shotG Σ := { one_shot_inG : inG Σ one_shotR }. Local Existing Instances one_shot_inG. ``` Here, the projection `one_shot_inG` is registered as an instance for type-class resolution. If you need several resource algebras, just add more `inG` fields. If you are using another module as part of yours, add a field like `one_shot_other : otherG Σ`. All of these fields should be added to the `Local Existing Instances` command. The code above enables these typeclass instances only in the surrounding file where they are used to define the new abstractions by the library. The interface of these abstractions will only depend on the `one_shotG` class. Since `one_shot_inG` will be hidden from clients, they will not accidentally rely on it in their code. Having defined the type class, we need to provide a way to instantiate it. This is an important step, as not every resource algebra can actually be used: if your resource algebra refers to `Σ`, the definition becomes recursive. That is actually legal under some conditions (see "Camera functors" below), but for now we will ignore that case. We have to define a list that contains all the resource algebras we need: ```coq Definition one_shotΣ : gFunctors := #[GFunctor one_shotR]. ``` This time, there is no `Σ` in the context, so we cannot accidentally introduce a bad dependency. If you are using another module as part of yours, add their `somethingΣ` to yours, as in `#[GFunctor one_shotR; somethingΣ]`. (The `#[F1; F2; ...]` syntax *appends* the functor lists `F1`, `F2`, ... to each other; together with a coercion from a single functor to a singleton list, this means lists can be nested arbitrarily.) Now we can define the one and only instance that our type class will ever need: ```coq Instance subG_one_shotΣ {Σ} : subG one_shotΣ Σ → one_shotG Σ. Proof. solve_inG. Qed. ``` The `subG` assumption here says that the list `one_shotΣ` is a sublist of the global list `Σ`. Typically, this should be the only assumption your instance needs, showing that the assumptions of the module (and all the modules it uses internally) can trivially be satisfied by picking the right `Σ`. Now you can add `one_shotG` as an assumption to all your module definitions and proofs. We typically use a section for this: ```coq Section proof. Context `{!heapGS Σ, !one_shotG Σ}. ``` Notice that besides our own assumptions `one_shotG`, we also assume `heapGS`, which are assumptions that every HeapLang proof makes (they are related to defining the `↦` connective as well as the basic Iris infrastructure for invariants and WP). For this purpose, `heapGS` contains not only assumptions about `Σ`, it also contains some ghost names to refer to particular ghost state (see "global ghost state instances" below). The backtick (`` ` ``) is used to make anonymous assumptions and to automatically generalize the `Σ`. When adding assumptions with backtick, you should most of the time also add a `!` in front of every assumption. If you do not then Coq will also automatically generalize all indices of type-classes that you are assuming. This can easily lead to making more assumptions than you are aware of, and often it leads to duplicate assumptions which breaks type class resolutions. ## Resource algebra combinators Defining a new resource algebra `one_shotR` for each new proof and verifying all the algebra laws would be quite cumbersome, so instead Iris provides a rich set of resource algebra combinators that one can use to build up the desired resource algebras. For example, `one_shotR` is defined as follows: ```coq Definition one_shotR := csumR (exclR unitO) (agreeR ZO). ``` The suffixes `R` and `O` indicate that we are not working on the level of Coq types here, but on the level of `R`esource algebras and `O`FEs, respectively. Unfortunately this means we cannot use Coq's usual type notation (such as `*` for products and `()` for the unit type); we have to spell out the underlying OFE or resource algebra names instead. ## Obtaining a closed proof To obtain a closed Iris proof, i.e., a proof that does not make assumptions like `inG`, you have to assemble a list of functors of all the involved modules, and if your proof relies on some singleton (most do, at least indirectly; also see the next section), you have to call the respective initialization or adequacy lemma. [For example](tests/one_shot.v): ```coq Section client. Context `{!heapGS Σ, !one_shotG Σ, !spawnG Σ}. Lemma client_safe : WP client {{ _, True }}%I. (* ... *) End client. (** Assemble all functors needed by the [client_safe] proof. *) Definition clientΣ : gFunctors := #[ heapΣ; one_shotΣ; spawnΣ ]. (** Apply [heap_adequacy] with this list of all functors. *) Lemma client_adequate σ : adequate NotStuck client σ (λ _ _, True). Proof. apply (heap_adequacy clientΣ)=> ?. apply client_safe. Qed. ``` ## Advanced topic: Ghost state singletons Some Iris modules involve a form of "global state". For example, defining the `↦` for HeapLang involves a piece of ghost state that matches the current physical heap. The `gname` of that ghost state must be picked once when the proof starts, and then globally known everywhere. Hence `gen_heapGS`, the type class for the generalized heap module, bundles the usual `inG` assumptions together with the `gname`: ```coq Class gen_heapGpreS (L V : Type) (Σ : gFunctors) `{Countable L} := { gen_heapGpreS_heap : ghost_mapG Σ L V; }. Local Existing Instances gen_heapGpreS_heap. Class gen_heapGS (L V : Type) (Σ : gFunctors) `{Countable L} := GenHeapGS { gen_heap_inG : gen_heapGpreS L V Σ; gen_heap_name : gname; }. Local Existing Instances gen_heap_inG. ``` The trailing `S` here is for "singleton", because the idea is that only one instance of `gen_heapGS` ever exists. This is important, since two instances might have different `gname`s, so `↦` based on these two distinct instances would be incompatible with each other. The `gen_heapGpreS` typeclass (without the singleton data) is relevant for initialization, i.e., to create an instance of `gen_heapGS`. This is happening as part of [`heap_adequacy`](iris_heap_lang/adequacy.v) using the initialization lemma for `gen_heapGS` from [`gen_heap_init`](iris/base_logic/lib/gen_heap.v): ```coq Lemma gen_heap_init `{gen_heapGpreS L V Σ} σ : (|==> ∃ _ : gen_heapGS L V Σ, gen_heap_ctx σ)%I. ``` These lemmas themselves only make assumptions the way normal modules (those without global state) do. Just like in the normal case, `somethingGpreS` type classes have an `Instance` showing that a `subG` is enough to instantiate them: ```coq Global Instance subG_gen_heapGpreS {Σ L V} `{Countable L} : subG (gen_heapΣ L V) Σ → gen_heapGpreS L V Σ. Proof. solve_inG. Qed. ``` The initialization lemma then shows that the `somethingGpreS` type class is enough to create an instance of the main `somethingGS` class *below a view shift*. This is written with an existential quantifier in the lemma because the statement after the view shift (`gen_heap_ctx σ` in this case) depends on having an instance of `gen_heapGS` in the context. Given that these global ghost state instances are singletons, they must be assumed explicitly everywhere. Bundling `heapGS` in a (non-singleton) module type class like `one_shotG` would lose track of the fact that there exists just one `heapGS` instance that is shared by everyone. ## Advanced topic: Camera functors and higher-order ghost state As we already alluded to, `Σ` actually consists of functors, not resource algebras. This enables you to use *higher-order ghost state*: ghost state that recursively refers to `iProp`. **Background: Iris Model.** To understand how this works, we have to dig a bit into the model of Iris. In Iris, the type of propositions `iProp` is described by the solution to the recursive domain equation: ```coq iProp ≅ uPred (F (iProp)) ``` Here, `uPred M` describes "propositions with resources of type `M`". The peculiar aspect of this definition is that the notion of resources can itself refer to the set propositions that we are just defining; that dependency is expressed by `F`. `F` is a user-chosen locally contractive bifunctor from COFEs to unital Cameras (a step-indexed generalization of unital resource algebras). Having just a single fixed `F` would however be rather inconvenient, so instead we have a list `Σ`, and then we define the global functor `F_global` roughly as follows: ```coq F_global X := Π_{F ∈ Σ} gmap nat (F X) ``` In other words, each functor in `Σ` is applied to the recursive argument `X`, wrapped in a finite partial function, and then we take a big product of all of that. The product ensures that all `F ∈ Σ` are available, and the `gmap` is needed to provide the proof rule `own_alloc`, which lets you create new instances of the given type of resource any time. However, this on its own would be too restrictive, as it requires all occurrences of `X` to be in positive positions (otherwise the functor laws would not hold for `F`). To mitigate this, we instead work with "bifunctors": functors that take two arguments, `X` and `X⁻`, where `X⁻` is used for negative positions. This leads us to the following domain equation: ```coq iProp ≅ uPred (F_global (iProp,iProp)) F_global (X,X⁻) := Π_{F ∈ Σ} gmap nat (F (X,X⁻)) ``` To make this equation well-defined, the bifunctors `F ∈ Σ` need to be "contractive". For further details, see §7.4 of [The Iris Documentation](http://plv.mpi-sws.org/iris/appendix-3.3.pdf); here we describe the user-side Coq aspects of this approach. Below, when we say "functor", we implicitly mean "bifunctor". **Higher-order ghost state.** To use higher-order ghost state, you need to give a functor whose "hole" will later be filled with `iProp` itself. For example, let us say you would like to have ghost state of type `gmap K (agree (nat * later iProp))`, using the "type-level" `later` operator which ensures contractivity. Then you will have to define a functor such as: ```coq F (X,X⁻) := gmap K (agree (nat * ▶ X)) ``` To make it convenient to construct such functors and prove their contractivity, we provide a number of abstractions: - [`oFunctor`](iris/algebra/ofe.v): functors from COFEs to OFEs. - [`rFunctor`](iris/algebra/cmra.v): functors from COFEs to cameras. - [`urFunctor`](iris/algebra/cmra.v): functors from COFEs to unital cameras. Besides, there are the classes `oFunctorContractive`, `rFunctorContractive`, and `urFunctorContractive` which describe the subset of the above functors that are contractive. To compose these functors, we provide a number of combinators, e.g.: - `constOF (A : ofe) : oFunctor := λ (B,B⁻), A ` - `idOF : oFunctor := λ (B,B⁻), B` - `prodOF (F1 F2 : oFunctor) : oFunctor := λ (B,B⁻), F1 (B,B⁻) * F2 (B,B⁻)` - `ofe_morOF (F1 F2 : oFunctor) : oFunctor := λ (B,B⁻), F1 (B⁻,B) -n> F2 (B,B⁻)` - `laterOF (F : oFunctor) : oFunctor := λ (B,B⁻), later (F (B,B⁻))` - `agreeRF (F : oFunctor) : rFunctor := λ (B,B⁻), agree (F (B,B⁻))` - `gmapURF K (F : rFunctor) : urFunctor := λ (B,B⁻), gmap K (F (B,B⁻))` Note in particular how the functor for the function space, `ofe_morOF`, swaps `B` and `B⁻` for the functor `F1` describing the domain. This reflects the fact that that functor is used in a negative position. Using these combinators, one can easily construct bigger functors in point-free style and automatically infer their contractivity, e.g: ```coq F := gmapURF K (agreeRF (prodOF (constOF natO) (laterOF idOF))) ``` which effectively defines the desired example functor `F := λ (B,B⁻), gmap K (agree (nat * later B))`. To make it a little bit more convenient to write down such functors, we make the constant functors (`constOF`, `constRF`, and `constURF`) a coercion, and provide the usual notation for products, etc. So the above functor can be written as follows: ```coq F := gmapRF K (agreeRF (natO * ▶ ∙)) ``` Basically, the functor can be written "as if" you were writing a resource algebra, except that there need to be extra "F" suffixes to indicate that we are working with functors, and the desired recursive `iProp` is replaced by the "hole" `∙`. Putting it all together, the `libG` typeclass and `libΣ` list of functors for your example would look as follows: ```coq Class libG Σ := { lib_inG : inG Σ (gmapR K (agreeR (prodO natO (laterO (iPropO Σ))))) }. Local Existing Instance lib_inG. Definition libΣ : gFunctors := #[GFunctor (gmapRF K (agreeRF (natO * ▶ ∙)))]. Instance subG_libΣ {Σ} : subG libΣ Σ → libG Σ. Proof. solve_inG. Qed. ``` It is instructive to remove the `▶` and see what happens: the `libG` class still works just fine, but `libΣ` complains that the functor is not contractive. This demonstrates the importance of always defining a `libΣ` alongside the `libG` and proving their relation. iris-iris-4.2.0/docs/style_guide.md000066400000000000000000000212631460620107300172210ustar00rootroot00000000000000# Iris proof style **Warning:** this document is still in development and rather incomplete. If you run across a question of style (for example, something comes up in an MR) and it's not on this list, please do reach out to us on Mattermost so we can add it. ## Basic syntax ### Binders **Good:** `(a : B)` **Bad:** `(a:B)`, `(a: B)` **TODO**: Prefer `(a : B)` to `a : B` This applies to Context, Implicit Types, and definitions ### Patterns #### Disjunctions & branches Always mark the disjuncts when destructuring a disjunctive pattern, even if you don't bind anything, to indicate that the proof branches **Good:** ```coq Lemma foo : ∀ b : bool, b = true ∨ b = false. Proof. intros [|]. ... ``` **Bad:** ```coq Lemma foo : ∀ b : bool, b = true ∨ b = false. Proof. intros []. ... ``` #### Uncategorized **TODO:** Use `"[H1 H2]"` when possible otherwise do `"(H1 & H2 & H3)"` ### Unicode Always use Unicode variants of forall, exists, ->, <=, >= **Good:** `∀ ∃ → ≤ ≥` **Bad:** `forall exists -> <= >=` ### Equivalent vernacular commands Use `Context`, never `Variable` **TODO:** Use `Implicit Types`, never `Implicit Type` Use `Lemma`, not `Theorem` (or the other variants: `Fact`, `Corollary`, `Remark`) **TODO:** Always add `Global` or `Local` to `Hint`, `Arguments`, and `Instance`. ### `Require` Never put `Require` in the middle of a file. All `Require` must be at the top. If you only want to *import* a certain module in some specific place (for instance, in a `Section` or other `Module`), you can do something like: ```coq From lib Require component. (* ... *) Import component. ``` ### Ltac We prefer `first [ t1 | fail 1 "..." ]` to `t1 || fail "..."` because the latter will fail if `t1` doesn't make progress. See https://gitlab.mpi-sws.org/iris/iris/-/issues/216. Note that `first [ t1 | fail "..."]` is simply incorrect; the failure message will never show up and will be replaced with a generic failure. ### Coqdoc comments Module-level comments (covering the entire file) go at the top of the file, before the `Require`. ### Uncategorized Indent the body of a match by one space: **Good:** ```coq match foo with | Some x => long line here using x ``` *RJ*: This is odd, usually everything is in (multiples of) 2 spaces, I think. *Tej*: https://gitlab.mpi-sws.org/iris/iris/-/blob/920bc3d97b8830139045e1780f2aff4d05b910cd/iris_heap_lang/proofmode.v#L194 Avoid using the extra square brackets around an Ltac match: **Good:** ```coq match goal with | |- ?g => idtac g end ``` **Bad:** ```coq match goal with | [ |- ?g ] => idtac g end ``` Use coqdoc syntax in comments for Coq identifiers and inline code, e.g. `[cmraT]` Put proofs either all on one line (`Proof. reflexivity. Qed.`) or split up the usual way with indentation. **Bad:** ```coq Lemma foo : 2 + 2 = 4 ∧ 1 + 2 = 3. Proof. split. - reflexivity. - done. Qed. ``` Put the entire theorem statement on one line or one premise per line, indented by 2 spaces. **Bad:** ```coq Lemma foo x y z : x < y → y < z → x < z. ``` **Good:** ```coq Lemma foo x y z : x < y → y < z → x < z. ``` **Good:** (particularly if premises are longer) ```coq Lemma foo x y z : x < y → y < z → x < z. ``` If the parameters before the `:` become too long, indent later lines by 4 spaces and always have a newline after `:`: **Bad:** ```coq Lemma foo (very_long_name : has_a_very_long_type) (even_longer_name : has_an_even_longer_type) : x < y → y < z → x < z. ``` **Good:** ```coq Lemma foo (very_long_name : has_a_very_long_type) (even_longer_name : has_an_even_longer_type) : x < y → y < z → x < z. ``` For definitions that don't fit into one line, put `:=` before the linebreak, not after. **Bad:** ```coq Definition foo (arg1 arg2 arg3 : name_of_the_type) := the body that is very long. ``` **Good:** ```coq Definition foo (arg1 arg2 arg3 : name_of_the_type) := the body that is very long. ``` For tests with output put `Check "theorem name in a string"` before it so that the output from different tests is separated. For long `t1; t2; t3` and `t; [t1 | t2 | t3]` split them like this, and indent by 2 spaces: **Good:** ```coq t; [t1 |t2 |t3]. ``` ```coq t; t1; t2. ``` **TODO:** Keep all `Require`, `Import` and `Export` at the top of the file. ## File organization theories/algebra is for primitive ofe/RA/CMRA constructions theories/algebra/lib is for derived constructions theories/base_logic/lib is for constructions in the base logic (using own) ## Naming * `*_ctx` for persistent facts (often an invariant) needed by everything in a library * `*_interp` for a function from some representation to iProp * If you have lemma `foo` which is an iff and you want single direction versions, name them `foo_1` (forward) and `foo_2` (backward) * If you have a lemma `foo` parametrized by an equivalence relation, you might want a version specialized to Leibniz equality for better rewrite support; name that version `foo_L` and state it with plain equality (e.g., `dom_empty_L` in stdpp). You might take an assumption `LeibnizEquiv A` if the original version took an equivalence (say the OFE equivalence) to assume that the provided equivalence is plain equality. * Lower-case theorem names, lower-case types, upper-case constructors * **TODO:** how should `f (g x) = f' (g' x)` be named? * `list_lookup_insert` is named by context (the type involved), then the two functions outside-in on the left-hand-side, so it has the type `lookup (insert …) = …` where the `insert` is on a list. Notations mean it doesn’t actually look like this and the insert is textually first. * Operations that "extract" from the data structure (`lookup`, `elem_of`, ...) should come before operations that "alter" the data structure (`filter`, `insert`, `union`, `fmap`). For example, use `map_lookup_filter` instead of `map_filter_lookup`. * Injectivity theorems are instances of `Inj` and then are used with `inj` * Suffixes `_l` and `_r` when we have binary `op x y` and a theorem related to the left or right. For example, `sep_mono_l` says bi_sep is monotonic in its left argument (holding the right constant). * Suffix `'` (prime) is used when `foo'` is a corollary of `foo`. Try to avoid these since the name doesn't convey how `foo'` is related to `foo`. * Given a polymorphic function/relation `f` (e.g., `eq`, `equiv`, `subseteq`), the instance of type `A` is called `A_f_instance`, and we add a lemma `A_f` that characterizes the instance. In case of many instances, this lemma is proved by unfolding the definition of the instance, e.g., `frac_op`, `frac_valid`. However, in some cases, e.g., `list_eq`, `map_eq`, `set_eq` this lemma might require non-trivial proof work. * For lemmas involving modalities, we usually follow this naming scheme: ``` 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) ``` * Monotonicity lemmas where the relation can be ambiguous are called `__mono`, e.g. `Some_included_mono`. * For lemmas `f x = g ...` that give a definition of function `f` in terms of `g`, we use `f_as_g`. For example, `map_compose_as_omap : m ∘ₘ n = omap (m !!.) n`. ### Naming algebra libraries **TODO:** describe any conclusions we came to with the `mono_nat` library ## Parameter order and implicitness for lemmas * Parameter order is usually from more higher-order to less higher-order (types, functions, plain values), and otherwise follows the order in which variables appear in the lemma statement. * In new lemmas, arguments should be marked as implicit when they can be inferred by unification in all intended usage scenarios. (If an argument can *sometimes* be inferred, we do not have a clear guideline yet -- consider on a case-by-case basis, for now.) ## Lemma statements ### Iris lemmas: `-∗` vs `⊢` * For low-level lemmas, in particular if there is a high likelyhood someone would want to rewrite with it / use them in non-proofmode goals (e.g. modality intro rules), use `⊢` * `P ⊢ |==£> P` * `(|==£> |==£> P) ⊢ |==£> P` * `▷ own γ a ⊢ ◇ ∃ b, own γ b ∧ ▷ (a ≡ b)` * `(P -∗ Q) i ⊢ (P i -∗ Q i)` * If a lemma is a Coq implication of Iris entailments (where the entailments are visible, not hidden behind e.g. `Persistent`), then use `⊢` * `(P1 ⊢ P2) → recv l P1 ⊢ recv l P2` * Else use -∗ * `a1 ⋅ a2 ~~> a' → own γ a1 -∗ own γ a2 ==∗ own γ a'` (curried and hence not rewrite-friendly) ## Metavariables **TODO:** move these to the right place * `P` `Q` for bi:PROP (or specifically `iProp Σ`) * `Φ` and `Ψ` for (?A -> iProp), like postconditions * `φ` and `ψ` for `Prop` * `A` `B` for types, ofeT, or cmraT Suffixes like O, R, UR (already documented) iris-iris-4.2.0/docs/vim_ultisnips000066400000000000000000000132411460620107300172070ustar00rootroot00000000000000snippet \forall "" i ∀ endsnippet snippet \exists "" i ∃ endsnippet snippet \lam "" i λ endsnippet snippet \not "" i ¬ endsnippet snippet \lor "" i ∨ endsnippet snippet \land "" i ∧ endsnippet snippet \/ "" i ∨ endsnippet snippet /\ "" i ∧ endsnippet snippet \rightarrow "" i → endsnippet snippet \implies "" i → endsnippet snippet -> "" i → endsnippet snippet \iff "" i ↔ endsnippet snippet <-> "" i ↔ endsnippet snippet \<- "" i ← endsnippet snippet \cong "" i ≡ endsnippet snippet \== "" i ≡ endsnippet snippet \/== "" i ≢ endsnippet snippet \neq "" i ≠ endsnippet snippet /= "" i ≠ endsnippet snippet \less "" i ≤ endsnippet snippet \le "" i ≤ endsnippet snippet <= "" i ≤ endsnippet snippet \in "" i ∈ endsnippet snippet \notin "" i ∉ endsnippet snippet \cup "" i ∪ endsnippet snippet \cap "" i ∩ endsnippet snippet \setminus "" i ∖ endsnippet snippet \subset "" i ⊂ endsnippet snippet \subseteq "" i ⊆ endsnippet snippet \sqsubseteq "" i ⊑ endsnippet snippet \sqsubseteq "" i ⊑ endsnippet snippet \notsubseteq "" i ⊈ endsnippet snippet \meet "" i ⊓ endsnippet snippet \join "" i ⊔ endsnippet snippet \true "" i ⊤ endsnippet snippet \top "" i ⊤ endsnippet snippet \false "" i ⊥ endsnippet snippet \bottom "" i ⊥ endsnippet snippet \vdash "" i ⊢ endsnippet snippet \dashv "" i ⊣ endsnippet snippet \vDash "" i ⊨ endsnippet snippet \Vdash ⊩ endsnippet snippet \infty "" i ∞ endsnippet snippet \comp "" i ∘ endsnippet snippet \prf "" i ↾ endsnippet snippet \bind "" i ≫= endsnippet snippet \mapsto "" i ↦ endsnippet snippet \hookrightarrow "" i ↪ endsnippet snippet \up "" i ↑ endsnippet snippet \uparrow "" i ↑ endsnippet snippet \fun "" i λ endsnippet snippet \mult "" i ⋅ endsnippet snippet \ent "" i ⊢ endsnippet snippet \valid "" i ✓ endsnippet snippet \diamond "" i ◇ endsnippet snippet \box "" i □ endsnippet snippet \bbox "" i ■ endsnippet snippet \eval "" i ▷ endsnippet snippet \rhd "" i ▷ endsnippet snippet \later "" i ▷ endsnippet snippet \pred "" i φ endsnippet snippet \and "" i ∧ endsnippet snippet \or "" i ∨ endsnippet snippet \circ "" i ∘ endsnippet snippet \comp "" i ∘ endsnippet snippet \ccomp "" i ◎ endsnippet snippet \pound "" i £ endsnippet snippet \all "" i ∀ endsnippet snippet \ex "" i ∃ endsnippet snippet \to "" i → endsnippet snippet \ast "" i ∗ endsnippet snippet \sep "" i ∗ endsnippet snippet \ulc "" i ⌜ endsnippet snippet \urc "" i ⌝ endsnippet snippet \lc "" i ⌜ endsnippet snippet \rc "" i ⌝ endsnippet snippet \Lc "" i ⎡ endsnippet snippet \Rc "" i ⎤ endsnippet snippet \varnothing "" i ∅ endsnippet snippet \empty "" i ∅ endsnippet snippet \Lam "" i Λ endsnippet snippet \Sig "" i Σ endsnippet snippet \- "" i ∖ endsnippet snippet \aa "" i ● endsnippet snippet \af "" i ◯ endsnippet snippet \auth "" i ● endsnippet snippet \frag "" i ◯ endsnippet snippet \iff "" i ↔ endsnippet snippet \gname "" i γ endsnippet snippet \incl "" i ≼ endsnippet snippet \latert "" i ▶ endsnippet snippet \update "" i ⇝ endsnippet snippet \bind "" i ≫= endsnippet snippet ^^+ "" i ⁺ endsnippet snippet __+ "" i ₊ endsnippet snippet ^^- "" i ⁻ endsnippet snippet __0 "" i ₀ endsnippet snippet __1 "" i ₁ endsnippet snippet __2 "" i ₂ endsnippet snippet __3 "" i ₃ endsnippet snippet __4 "" i ₄ endsnippet snippet __5 "" i ₅ endsnippet snippet __6 "" i ₆ endsnippet snippet __7 "" i ₇ endsnippet snippet __8 "" i ₈ endsnippet snippet __9 "" i ₉ endsnippet snippet __a "" i ₐ endsnippet snippet __e "" i ₑ endsnippet snippet __h "" i ₕ endsnippet snippet __i "" i ᵢ endsnippet snippet __k "" i ₖ endsnippet snippet __l "" i ₗ endsnippet snippet __m "" i ₘ endsnippet snippet __n "" i ₙ endsnippet snippet __o "" i ₒ endsnippet snippet __p "" i ₚ endsnippet snippet __r "" i ᵣ endsnippet snippet __s "" i ₛ endsnippet snippet __t "" i ₜ endsnippet snippet __u "" i ᵤ endsnippet snippet __v "" i ᵥ endsnippet snippet __x "" i ₓ endsnippet snippet \Alpha "" i Α endsnippet snippet \alpha "" i α endsnippet snippet \Beta "" i Β endsnippet snippet \beta "" i β endsnippet snippet \Gamma "" i Γ endsnippet snippet \gamma "" i γ endsnippet snippet \Delta "" i Δ endsnippet snippet \delta "" i δ endsnippet snippet \Epsilon "" i Ε endsnippet snippet \epsilon "" i ε endsnippet snippet \Zeta "" i Ζ endsnippet snippet \zeta "" i ζ endsnippet snippet \Eta "" i Η endsnippet snippet \eta "" i η endsnippet snippet \Theta "" i Θ endsnippet snippet \theta "" i θ endsnippet snippet \Iota "" i Ι endsnippet snippet \iota "" i ι endsnippet snippet \Kappa "" i Κ endsnippet snippet \kappa "" i κ endsnippet snippet \Lamda "" i Λ endsnippet snippet \lamda "" i λ endsnippet snippet \Lambda "" i Λ endsnippet snippet \lambda "" i λ endsnippet snippet \Mu "" i Μ endsnippet snippet \mu "" i μ endsnippet snippet \Nu "" i Ν endsnippet snippet \nu "" i ν endsnippet snippet \Xi "" i Ξ endsnippet snippet \xi "" i ξ endsnippet snippet \Omicron "" i Ο endsnippet snippet \omicron "" i ο endsnippet snippet \Pi "" i Π endsnippet snippet \pi "" i π endsnippet snippet \Rho "" i Ρ endsnippet snippet \rho "" i ρ endsnippet snippet \Sigma "" i Σ endsnippet snippet \sigma "" i σ endsnippet snippet \Tau "" i Τ endsnippet snippet \tau "" i τ endsnippet snippet \Upsilon "" i Υ endsnippet snippet \upsilon "" i υ endsnippet snippet \Phi "" i Φ endsnippet snippet \phi "" i ϕ endsnippet snippet \varphi "" i φ endsnippet snippet \Chi "" i Χ endsnippet snippet \chi "" i χ endsnippet snippet \Psi "" i Ψ endsnippet snippet \psi "" i ψ endsnippet snippet \Omega "" i Ω endsnippet snippet \omega "" i ω endsnippet iris-iris-4.2.0/docs/vscode000066400000000000000000000271341460620107300155730ustar00rootroot00000000000000 "generic-input-methods.input-methods": [ { "name": "Iris Math", "commandName": "text.math", "languages": [ "coq" ], "triggers": [ "\\" ], "dictionary": [ // Standard LaTeX math notations { "label": "forall", "body": "∀", "description": "∀" }, { "label": "exists", "body": "∃", "description": "∃" }, { "label": "lam", "body": "λ", "description": "λ" }, { "label": "not", "body": "¬", "description": "¬" }, { "label": "->", "body": "→", "description": "→" }, { "label": "<->", "body": "↔", "description": "↔" }, { "label": "<-", "body": "←", "description": "←" }, { "label": "==", "body": "≡", "description": "≡" }, { "label": "/==", "body": "≢", "description": "≢" }, { "label": "/=", "body": "≠", "description": "≠" }, { "label": "neq", "body": "≠", "description": "≠" }, { "label": "nequiv", "body": "≢", "description": "≢" }, { "label": "<=", "body": "≤", "description": "≤" }, { "label": "leq", "body": "≤", "description": "≤" }, { "label": "in", "body": "∈", "description": "∈" }, { "label": "notin", "body": "∉", "description": "∉" }, { "label": "cup", "body": "∪", "description": "∪" }, { "label": "cap", "body": "∩", "description": "∩" }, { "label": "setminus", "body": "∖", "description": "∖" }, { "label": "subset", "body": "⊂", "description": "⊂" }, { "label": "subseteq", "body": "⊆", "description": "⊆" }, { "label": "sqsubseteq", "body": "⊑", "description": "⊑" }, { "label": "sqsubseteq", "body": "⊑", "description": "⊑" }, { "label": "notsubseteq", "body": "⊈", "description": "⊈" }, { "label": "meet", "body": "⊓", "description": "⊓" }, { "label": "join", "body": "⊔", "description": "⊔" }, { "label": "top", "body": "⊤", "description": "⊤" }, { "label": "bottom", "body": "⊥", "description": "⊥" }, { "label": "vdash", "body": "⊢", "description": "⊢" }, { "label": "|-", "body": "⊢", "description": "⊢" }, { "label": "dashv", "body": "⊣", "description": "⊣" }, { "label": "Vdash", "body": "⊨", "description": "⊨" }, { "label": "infty", "body": "∞", "description": "∞" }, { "label": "comp", "body": "∘", "description": "∘" }, { "label": "prf", "body": "↾", "description": "↾" }, { "label": "bind", "body": "≫=", "description": "≫=" }, { "label": "mapsto", "body": "↦", "description": "↦" }, { "label": "hookrightarrow", "body": "↪", "description": "↪" }, { "label": "uparrow", "body": "↑", "description": "↑" }, // Iris specific { "label": "fun", "body": "λ", "description": "λ" }, { "label": "mult", "body": "⋅", "description": "⋅" }, { "label": "ent", "body": "⊢", "description": "⊢" }, { "label": "valid", "body": "✓", "description": "✓" }, { "label": "diamond", "body": "◇", "description": "◇" }, { "label": "box", "body": "□", "description": "□" }, { "label": "bbox", "body": "■", "description": "■" }, { "label": "later", "body": "▷", "description": "▷" }, { "label": "pred", "body": "φ", "description": "φ" }, { "label": "and", "body": "∧", "description": "∧" }, { "label": "or", "body": "∨", "description": "∨" }, { "label": "comp", "body": "∘", "description": "∘" }, { "label": "ccomp", "body": "◎", "description": "◎" }, { "label": "all", "body": "∀", "description": "∀" }, { "label": "ex", "body": "∃", "description": "∃" }, { "label": "to", "body": "→", "description": "→" }, { "label": "sep", "body": "∗", "description": "∗" }, { "label": "star", "body": "∗", "description": "∗" }, { "label": "lc", "body": "⌜", "description": "⌜" }, { "label": "rc", "body": "⌝", "description": "⌝" }, { "label": "Lc", "body": "⎡", "description": "⎡" }, { "label": "Rc", "body": "⎤", "description": "⎤" }, { "label": "empty", "body": "∅", "description": "∅" }, { "label": "Lam", "body": "Λ", "description": "Λ" }, { "label": "Sig", "body": "Σ", "description": "Σ" }, { "label": "-", "body": "∖", "description": "∖" }, { "label": "aa", "body": "●", "description": "●" }, { "label": "af", "body": "◯", "description": "◯" }, { "label": "auth", "body": "●", "description": "●" }, { "label": "frag", "body": "◯", "description": "◯" }, { "label": "iff", "body": "↔", "description": "↔" }, { "label": "gname", "body": "γ", "description": "γ" }, { "label": "incl", "body": "≼", "description": "≼" }, { "label": "latert", "body": "▶", "description": "▶" }, { "label": "update", "body": "⇝", "description": "⇝" }, { "label": "bind", "body": "≫=", "description": "≫=" }, // accents (for iLöb) { "label": "\"o", "body": "ö", "description": "ö" }, // subscripts and superscripts { "label": "^^+", "body": "⁺", "description": "⁺" }, { "label": "__+", "body": "₊", "description": "₊" }, { "label": "^^-", "body": "⁻", "description": "⁻" }, { "label": "__0", "body": "₀", "description": "₀" }, { "label": "__1", "body": "₁", "description": "₁" }, { "label": "__2", "body": "₂", "description": "₂" }, { "label": "__3", "body": "₃", "description": "₃" }, { "label": "__4", "body": "₄", "description": "₄" }, { "label": "__5", "body": "₅", "description": "₅" }, { "label": "__6", "body": "₆", "description": "₆" }, { "label": "__7", "body": "₇", "description": "₇" }, { "label": "__8", "body": "₈", "description": "₈" }, { "label": "__9", "body": "₉", "description": "₉" }, { "label": "__a", "body": "ₐ", "description": "ₐ" }, { "label": "__e", "body": "ₑ", "description": "ₑ" }, { "label": "__h", "body": "ₕ", "description": "ₕ" }, { "label": "__i", "body": "ᵢ", "description": "ᵢ" }, { "label": "__k", "body": "ₖ", "description": "ₖ" }, { "label": "__l", "body": "ₗ", "description": "ₗ" }, { "label": "__m", "body": "ₘ", "description": "ₘ" }, { "label": "__n", "body": "ₙ", "description": "ₙ" }, { "label": "__o", "body": "ₒ", "description": "ₒ" }, { "label": "__p", "body": "ₚ", "description": "ₚ" }, { "label": "__r", "body": "ᵣ", "description": "ᵣ" }, { "label": "__s", "body": "ₛ", "description": "ₛ" }, { "label": "__t", "body": "ₜ", "description": "ₜ" }, { "label": "__u", "body": "ᵤ", "description": "ᵤ" }, { "label": "__v", "body": "ᵥ", "description": "ᵥ" }, { "label": "__x", "body": "ₓ", "description": "ₓ" }, // Greek alphabet { "label": "Alpha", "body": "Α", "description": "Α" }, { "label": "alpha", "body": "α", "description": "α" }, { "label": "Beta", "body": "Β", "description": "Β" }, { "label": "beta", "body": "β", "description": "β" }, { "label": "Gamma", "body": "Γ", "description": "Γ" }, { "label": "gamma", "body": "γ", "description": "γ" }, { "label": "Delta", "body": "Δ", "description": "Δ" }, { "label": "delta", "body": "δ", "description": "δ" }, { "label": "Epsilon", "body": "Ε", "description": "Ε" }, { "label": "epsilon", "body": "ε", "description": "ε" }, { "label": "Zeta", "body": "Ζ", "description": "Ζ" }, { "label": "zeta", "body": "ζ", "description": "ζ" }, { "label": "Eta", "body": "Η", "description": "Η" }, { "label": "eta", "body": "η", "description": "η" }, { "label": "Theta", "body": "Θ", "description": "Θ" }, { "label": "theta", "body": "θ", "description": "θ" }, { "label": "Iota", "body": "Ι", "description": "Ι" }, { "label": "iota", "body": "ι", "description": "ι" }, { "label": "Kappa", "body": "Κ", "description": "Κ" }, { "label": "kappa", "body": "κ", "description": "κ" }, { "label": "Lamda", "body": "Λ", "description": "Λ" }, { "label": "lamda", "body": "λ", "description": "λ" }, { "label": "Lambda", "body": "Λ", "description": "Λ" }, { "label": "lambda", "body": "λ", "description": "λ" }, { "label": "Mu", "body": "Μ", "description": "Μ" }, { "label": "mu", "body": "μ", "description": "μ" }, { "label": "Nu", "body": "Ν", "description": "Ν" }, { "label": "nu", "body": "ν", "description": "ν" }, { "label": "Xi", "body": "Ξ", "description": "Ξ" }, { "label": "xi", "body": "ξ", "description": "ξ" }, { "label": "Omicron", "body": "Ο", "description": "Ο" }, { "label": "omicron", "body": "ο", "description": "ο" }, { "label": "Pi", "body": "Π", "description": "Π" }, { "label": "pi", "body": "π", "description": "π" }, { "label": "Rho", "body": "Ρ", "description": "Ρ" }, { "label": "rho", "body": "ρ", "description": "ρ" }, { "label": "Sigma", "body": "Σ", "description": "Σ" }, { "label": "sigma", "body": "σ", "description": "σ" }, { "label": "Tau", "body": "Τ", "description": "Τ" }, { "label": "tau", "body": "τ", "description": "τ" }, { "label": "Upsilon", "body": "Υ", "description": "Υ" }, { "label": "upsilon", "body": "υ", "description": "υ" }, { "label": "Phi", "body": "Φ", "description": "Φ" }, { "label": "phi", "body": "φ", "description": "φ" }, { "label": "Chi", "body": "Χ", "description": "Χ" }, { "label": "chi", "body": "χ", "description": "χ" }, { "label": "Psi", "body": "Ψ", "description": "Ψ" }, { "label": "psi", "body": "ψ", "description": "ψ" }, { "label": "Omega", "body": "Ω", "description": "Ω" }, { "label": "omega", "body": "ω", "description": "ω" } ] } ] iris-iris-4.2.0/iris-bot000077500000000000000000000224331460620107300151100ustar00rootroot00000000000000#!/usr/bin/python3 import sys, os, subprocess import requests, argparse from datetime import datetime, timezone from collections import namedtuple ################################################################################ # This script lets you autoamtically trigger some operations on the Iris CI to # do further test/analysis on a branch (usually an MR). # Set the GITLAB_TOKEN environment variable to a GitLab access token. # You can generate such a token at # . # Select only the "api" scope. # # Set at least one of IRIS_REV or STDPP_REV to control which branches of these # projects to build against (defaults to default git branch). IRIS_REPO and # STDPP_REPO can be used to take branches from forks. Setting IRIS to # "user:branch" will use the given branch on that user's fork of Iris, and # similar for STDPP. # # Supported commands: # - `./iris-bot build [$filter]`: Builds all reverse dependencies against the # given branches. The optional `filter` argument only builds projects whose # names contains that string. # - `./iris-bot time $project`: Measure the impact of this branch on the build # time of the given reverse dependency. Only Iris branches are supported for # now. ################################################################################ PROJECTS = { 'lambda-rust': { 'name': 'lambda-rust', 'branch': 'master', 'timing': True }, 'lambda-rust-weak': { 'name': 'lambda-rust', 'branch': 'masters/weak_mem' }, # covers GPFSL and ORC11 'examples': { 'name': 'examples', 'branch': 'master', 'timing': True }, 'gpfsl': { 'name': 'gpfsl', 'branch': 'master', 'timing': True }, # need separate entry for timing 'iron': { 'name': 'iron', 'branch': 'master', 'timing': True }, 'reloc': { 'name': 'reloc', 'branch': 'master' }, 'actris': { 'name': 'actris', 'branch': 'master' }, 'simuliris': { 'name': 'simuliris', 'branch': 'master' }, 'tutorial-popl20': { 'name': 'tutorial-popl20', 'branch': 'master' }, 'tutorial-popl21': { 'name': 'tutorial-popl21', 'branch': 'master' }, } if not "GITLAB_TOKEN" in os.environ: print("You need to set the GITLAB_TOKEN environment variable to a GitLab access token.") print("You can create such tokens at .") print("Make sure you grant access to the 'api' scope.") sys.exit(1) GITLAB_TOKEN = os.environ["GITLAB_TOKEN"] # Pre-processing for branch variables of dependency projects: you can set # 'PROJECT' to 'user:branch', or set 'PROJECT_REPO' and 'PROJECT_REV' # automatically. BUILD_BRANCHES = {} for project in ['stdpp', 'iris', 'orc11', 'gpfsl']: var = project.upper() if var in os.environ: (repo, rev) = os.environ[var].split(':') repo = repo + "/" + project else: repo = os.environ.get(var+"_REPO", "iris/"+project) rev = os.environ.get(var+"_REV") if rev is not None: BUILD_BRANCHES[project] = (repo, rev) if not "iris" in BUILD_BRANCHES: print("Please set IRIS_REV, STDPP_REV, ORC11_REV and GPFSL_REV environment variables to the branch/tag/commit of the respective project that you want to use.") print("Only IRIS_REV is mandatory, the rest defaults to the default git branch.") sys.exit(1) # Useful helpers def trigger_build(project, branch, vars): id = "iris%2F{}".format(project) url = "https://gitlab.mpi-sws.org/api/v4/projects/{}/pipeline".format(id) json = { 'ref': branch, 'variables': [{ 'key': key, 'value': val } for (key, val) in vars.items()], } r = requests.post(url, headers={'PRIVATE-TOKEN': GITLAB_TOKEN}, json=json) r.raise_for_status() return r.json() # The commands def build(args): # Convert BUILD_BRANCHES into suitable dictionary vars = {} for project in BUILD_BRANCHES.keys(): (repo, rev) = BUILD_BRANCHES[project] var = project.upper() vars[var+"_REPO"] = repo vars[var+"_REV"] = rev if args.coq: vars["NIGHTLY_COQ"] = args.coq # Loop over all projects, and trigger build. for (name, project) in PROJECTS.items(): if args.filter in name: print("Triggering build for {}...".format(name)) pipeline_url = trigger_build(project['name'], project['branch'], vars)['web_url'] print(" Pipeline running at {}".format(pipeline_url)) TimeJob = namedtuple("TimeJob", "id base_commit base_pipeline test_commit test_pipeline compare") def time_project(project, iris_repo, iris_rev, test_rev): # Obtain a unique ID for this experiment id = datetime.now(timezone.utc).strftime("%Y%m%d-%H%M%S") # Determine the branch commit to build subprocess.run(["git", "fetch", "-q", "https://gitlab.mpi-sws.org/{}".format(iris_repo), iris_rev], check=True) test_commit = subprocess.run(["git", "rev-parse", "FETCH_HEAD"], check=True, stdout=subprocess.PIPE).stdout.decode().strip() # Determine the base commit in master subprocess.run(["git", "fetch", "-q", "https://gitlab.mpi-sws.org/iris/iris.git", "master"], check=True) base_commit = subprocess.run(["git", "merge-base", test_commit, "FETCH_HEAD"], check=True, stdout=subprocess.PIPE).stdout.decode().strip() # Trigger the builds vars = { 'IRIS_REPO': iris_repo, 'IRIS_REV': base_commit, 'TIMING_AD_HOC_ID': id+"-base", } base_pipeline = trigger_build(project['name'], project['branch'], vars) vars = { 'IRIS_REPO': iris_repo, 'IRIS_REV': test_commit, 'TIMING_AD_HOC_ID': id+"-test", } if test_rev is None: # We hope that this repository did not change since the job we created just above... test_pipeline = trigger_build(project['name'], project['branch'], vars) else: test_pipeline = trigger_build(project['name'], args.test_rev, vars) compare = "https://coq-speed.mpi-sws.org/d/1QE_dqjiz/coq-compare?orgId=1&var-project={}&var-branch1=@hoc&var-commit1={}&var-config1={}&var-branch2=@hoc&var-commit2={}&var-config2={}".format(project['name'], base_pipeline['sha'], id+"-base", test_pipeline['sha'], id+"-test") return TimeJob(id, base_commit, base_pipeline['web_url'], test_commit, test_pipeline['web_url'], compare) def time(args): # Make sure only 'iris' variables are set. # One could imagine generalizing to "either Iris or std++", but then if the # ad-hoc timing jobs honor STDPP_REV, how do we make it so that particular # deterministic std++ versions are used for Iris timing? This does not # currently seem worth the effort / hacks. for project in BUILD_BRANCHES.keys(): if project != 'iris': print("'time' command only supports Iris branches") sys.exit(1) (iris_repo, iris_rev) = BUILD_BRANCHES['iris'] # Special mode: time everything if args.project == 'all': if args.test_rev is not None: print("'time all' does not support '--test-rev'") sys.exit(1) for (name, project) in PROJECTS.items(): if not project.get('timing'): continue job = time_project(project, iris_repo, iris_rev, None) print("- [{}]({})".format(name, job.compare)) return # Get project to test and ensure it supports timing project_name = args.project if project_name not in PROJECTS: print("ERROR: no such project: {}".format(project_name)) sys.exit(1) project = PROJECTS[project_name] if not project.get('timing'): print("ERROR: {} does not support timing".format(project_name)) sys.exit(1) # Run it! job = time_project(project, iris_repo, iris_rev, args.test_rev) print("Triggering timing builds for {} with Iris base commit {} and test commit {} using ad-hoc ID {}...".format(project_name, job.base_commit[:8], job.test_commit[:8], job.id)) print(" Base pipeline running at {}".format(job.base_pipeline)) if args.test_rev is None: print(" Test pipeline running at {}".format(job.test_pipeline)) else: print(" Test pipeline (on non-standard branch {}) running at {}".format(args.test_rev, job.test_pipeline)) print(" Once done, timing comparison will be available at {}".format(job.compare)) # Dispatch if __name__ == "__main__": parser = argparse.ArgumentParser(description='Iris CI utility') subparsers = parser.add_subparsers(required=True, title='iris-bot command to execute', description='see "$command -h" for help', metavar="$command") parser_build = subparsers.add_parser('build', help='Build many reverse dependencies against an Iris branch') parser_build.set_defaults(func=build) parser_build.add_argument('--coq', help='the (opam) Coq version to use for these tests') parser_build.add_argument('filter', nargs='?', default='', help='(optional) restrict build to projects matching the filter') parser_time = subparsers.add_parser('time', help='Time one reverse dependency against an Iris branch') parser_time.add_argument("project", help="the project to measure the time of, or 'all' to measure all of them") parser_time.add_argument("--test-rev", help="use different revision on project for the test build (in case the project requires changes to still build)") parser_time.set_defaults(func=time) # Parse, and dispatch to sub-command args = parser.parse_args() args.func(args) iris-iris-4.2.0/iris/000077500000000000000000000000001460620107300143745ustar00rootroot00000000000000iris-iris-4.2.0/iris/algebra/000077500000000000000000000000001460620107300157715ustar00rootroot00000000000000iris-iris-4.2.0/iris/algebra/agree.v000066400000000000000000000321441460620107300172470ustar00rootroot00000000000000From iris.algebra Require Export cmra. From iris.prelude Require Import options. Local Arguments validN _ _ _ !_ /. Local Arguments valid _ _ !_ /. Local Arguments op _ _ _ !_ /. Local Arguments pcore _ _ !_ /. (** Define an agreement construction such that Agree A is discrete when A is discrete. Notice that this construction is NOT complete. The following is due to Aleš: Proposition: Ag(T) is not necessarily complete. Proof. Let T be the set of binary streams (infinite sequences) with the usual ultrametric, measuring how far they agree. Let Aₙ be the set of all binary strings of length n. Thus for Aₙ to be a subset of T we have them continue as a stream of zeroes. Now Aₙ is a finite non-empty subset of T. Moreover {Aₙ} is a Cauchy sequence in the defined (Hausdorff) metric. However the limit (if it were to exist as an element of Ag(T)) would have to be the set of all binary streams, which is not exactly finite. Thus Ag(T) is not necessarily complete. *) (** Note that the projection [agree_car] is not non-expansive, so it cannot be used in the logic. If you need to get a witness out, you should use the lemma [to_agree_uninjN] instead. In general, [agree_car] should ONLY be used internally in this file. *) Record agree (A : Type) : Type := { agree_car : list A; agree_not_nil : bool_decide (agree_car = []) = false }. Global Arguments agree_car {_} _. Global Arguments agree_not_nil {_} _. Local Coercion agree_car : agree >-> list. Definition to_agree {A} (a : A) : agree A := {| agree_car := [a]; agree_not_nil := eq_refl |}. Lemma elem_of_agree {A} (x : agree A) : ∃ a, a ∈ agree_car x. Proof. destruct x as [[|a ?] ?]; set_solver+. Qed. Lemma agree_eq {A} (x y : agree A) : agree_car x = agree_car y → x = y. Proof. destruct x as [a ?], y as [b ?]; simpl. intros ->; f_equal. apply (proof_irrel _). Qed. Section agree. Context {A : ofe}. Implicit Types a b : A. Implicit Types x y : agree A. (* OFE *) Local Instance agree_dist : Dist (agree A) := λ n x y, (∀ a, a ∈ agree_car x → ∃ b, b ∈ agree_car y ∧ a ≡{n}≡ b) ∧ (∀ b, b ∈ agree_car y → ∃ a, a ∈ agree_car x ∧ a ≡{n}≡ b). Local Instance agree_equiv : Equiv (agree A) := λ x y, ∀ n, x ≡{n}≡ y. Definition agree_ofe_mixin : OfeMixin (agree A). Proof. split. - done. - intros n; split; rewrite /dist /agree_dist. + intros x; split; eauto. + intros x y [??]. naive_solver eauto. + intros x y z [H1 H1'] [H2 H2']; split. * intros a ?. destruct (H1 a) as (b&?&?); auto. destruct (H2 b) as (c&?&?); eauto. by exists c; split; last etrans. * intros a ?. destruct (H2' a) as (b&?&?); auto. destruct (H1' b) as (c&?&?); eauto. by exists c; split; last etrans. - intros n m x y [??] ?; split; naive_solver eauto using dist_le with si_solver. Qed. Canonical Structure agreeO := Ofe (agree A) agree_ofe_mixin. (* CMRA *) (* agree_validN is carefully written such that, when applied to a singleton, it is convertible to True. This makes working with agreement much more pleasant. *) Local Instance agree_validN_instance : ValidN (agree A) := λ n x, match agree_car x with | [a] => True | _ => ∀ a b, a ∈ agree_car x → b ∈ agree_car x → a ≡{n}≡ b end. Local Instance agree_valid_instance : Valid (agree A) := λ x, ∀ n, ✓{n} x. Local Program Instance agree_op_instance : Op (agree A) := λ x y, {| agree_car := agree_car x ++ agree_car y |}. Next Obligation. by intros [[|??]] y. Qed. Local Instance agree_pcore_instance : PCore (agree A) := Some. Lemma agree_validN_def n x : ✓{n} x ↔ ∀ a b, a ∈ agree_car x → b ∈ agree_car x → a ≡{n}≡ b. Proof. rewrite /validN /agree_validN_instance. destruct (agree_car _) as [|? [|??]]; auto. setoid_rewrite elem_of_list_singleton; naive_solver. Qed. Local Instance agree_comm : Comm (≡) (@op (agree A) _). Proof. intros x y n; split=> a /=; setoid_rewrite elem_of_app; naive_solver. Qed. Local Instance agree_assoc : Assoc (≡) (@op (agree A) _). Proof. intros x y z n; split=> a /=; repeat setoid_rewrite elem_of_app; naive_solver. Qed. Lemma agree_idemp x : x ⋅ x ≡ x. Proof. intros n; split=> a /=; setoid_rewrite elem_of_app; naive_solver. Qed. Local Instance agree_validN_ne n : Proper (dist n ==> impl) (@validN (agree A) _ n). Proof. intros x y [H H']; rewrite /impl !agree_validN_def; intros Hv a b Ha Hb. destruct (H' a) as (a'&?&<-); auto. destruct (H' b) as (b'&?&<-); auto. Qed. Local Instance agree_validN_proper n : Proper (equiv ==> iff) (@validN (agree A) _ n). Proof. move=> x y /equiv_dist H. by split; rewrite (H n). Qed. Local Instance agree_op_ne' x : NonExpansive (op x). Proof. intros n y1 y2 [H H']; split=> a /=; setoid_rewrite elem_of_app; naive_solver. Qed. Local Instance agree_op_ne : NonExpansive2 (@op (agree A) _). Proof. by intros n x1 x2 Hx y1 y2 Hy; rewrite Hy !(comm _ _ y2) Hx. Qed. Local Instance agree_op_proper : Proper ((≡) ==> (≡) ==> (≡)) (op (A := agree A)) := ne_proper_2 _. Lemma agree_included x y : x ≼ y ↔ y ≡ x ⋅ y. Proof. split; [|by intros ?; exists y]. by intros [z Hz]; rewrite Hz assoc agree_idemp. Qed. Lemma agree_op_invN n x1 x2 : ✓{n} (x1 ⋅ x2) → x1 ≡{n}≡ x2. Proof. rewrite agree_validN_def /=. setoid_rewrite elem_of_app=> Hv; split=> a Ha. - destruct (elem_of_agree x2); naive_solver. - destruct (elem_of_agree x1); naive_solver. Qed. Definition agree_cmra_mixin : CmraMixin (agree A). Proof. apply cmra_total_mixin; try apply _ || by eauto. - intros n x; rewrite !agree_validN_def; eauto using dist_le. - intros x. apply agree_idemp. - intros n x y; rewrite !agree_validN_def /=. setoid_rewrite elem_of_app; naive_solver. - intros n x y1 y2 Hval Hx; exists x, x; simpl; split. + by rewrite agree_idemp. + by move: Hval; rewrite Hx; move=> /agree_op_invN->; rewrite agree_idemp. Qed. Canonical Structure agreeR : cmra := Cmra (agree A) agree_cmra_mixin. Global Instance agree_cmra_total : CmraTotal agreeR. Proof. rewrite /CmraTotal; eauto. Qed. Global Instance agree_core_id x : CoreId x. Proof. by constructor. Qed. Global Instance agree_cmra_discrete : OfeDiscrete A → CmraDiscrete agreeR. Proof. intros HD. split. - intros x y [H H'] n; split=> a; setoid_rewrite <-(discrete_iff_0 _ _); auto. - intros x; rewrite agree_validN_def=> Hv n. apply agree_validN_def=> a b ??. apply discrete_iff_0; auto. Qed. Global Instance to_agree_ne : NonExpansive to_agree. Proof. intros n a1 a2 Hx; split=> b /=; setoid_rewrite elem_of_list_singleton; naive_solver. Qed. Global Instance to_agree_proper : Proper ((≡) ==> (≡)) to_agree := ne_proper _. Global Instance to_agree_discrete a : Discrete a → Discrete (to_agree a). Proof. intros ? y [H H'] n; split. - intros a' ->%elem_of_list_singleton. destruct (H a) as [b ?]; first by left. exists b. by rewrite -discrete_iff_0. - intros b Hb. destruct (H' b) as (b'&->%elem_of_list_singleton&?); auto. exists a. by rewrite elem_of_list_singleton -discrete_iff_0. Qed. Lemma agree_op_inv x y : ✓ (x ⋅ y) → x ≡ y. Proof. intros ?. apply equiv_dist=> n. by apply agree_op_invN, cmra_valid_validN. Qed. Global Instance to_agree_injN n : Inj (dist n) (dist n) (to_agree). Proof. move=> a b [_] /=. setoid_rewrite elem_of_list_singleton. naive_solver. Qed. Global Instance to_agree_inj : Inj (≡) (≡) (to_agree). Proof. intros a b ?. apply equiv_dist=>n. by apply (inj to_agree), equiv_dist. Qed. Lemma to_agree_uninjN n x : ✓{n} x → ∃ a, to_agree a ≡{n}≡ x. Proof. rewrite agree_validN_def=> Hv. destruct (elem_of_agree x) as [a ?]. exists a; split=> b /=; setoid_rewrite elem_of_list_singleton; naive_solver. Qed. Lemma to_agree_uninj x : ✓ x → ∃ a, to_agree a ≡ x. Proof. rewrite /valid /agree_valid_instance; setoid_rewrite agree_validN_def. destruct (elem_of_agree x) as [a ?]. exists a; split=> b /=; setoid_rewrite elem_of_list_singleton; naive_solver. Qed. Lemma agree_valid_includedN n x y : ✓{n} y → x ≼{n} y → x ≡{n}≡ y. Proof. move=> Hval [z Hy]; move: Hval; rewrite Hy. by move=> /agree_op_invN->; rewrite agree_idemp. Qed. Lemma agree_valid_included x y : ✓ y → x ≼ y → x ≡ y. Proof. move=> Hval [z Hy]; move: Hval; rewrite Hy. by move=> /agree_op_inv->; rewrite agree_idemp. Qed. Lemma to_agree_includedN n a b : to_agree a ≼{n} to_agree b ↔ a ≡{n}≡ b. Proof. split; last by intros ->. intros. by apply (inj to_agree), agree_valid_includedN. Qed. Lemma to_agree_included a b : to_agree a ≼ to_agree b ↔ a ≡ b. Proof. split; last by intros ->. intros. by apply (inj to_agree), agree_valid_included. Qed. Lemma to_agree_included_L `{!LeibnizEquiv A} a b : to_agree a ≼ to_agree b ↔ a = b. Proof. unfold_leibniz. apply to_agree_included. Qed. Global Instance agree_cancelable x : Cancelable x. Proof. intros n y z Hv Heq. destruct (to_agree_uninjN n x) as [x' EQx]; first by eapply cmra_validN_op_l. destruct (to_agree_uninjN n y) as [y' EQy]; first by eapply cmra_validN_op_r. destruct (to_agree_uninjN n z) as [z' EQz]. { eapply (cmra_validN_op_r n x z). by rewrite -Heq. } assert (Hx'y' : x' ≡{n}≡ y'). { apply (inj to_agree), agree_op_invN. by rewrite EQx EQy. } assert (Hx'z' : x' ≡{n}≡ z'). { apply (inj to_agree), agree_op_invN. by rewrite EQx EQz -Heq. } by rewrite -EQy -EQz -Hx'y' -Hx'z'. Qed. Lemma to_agree_op_invN a b n : ✓{n} (to_agree a ⋅ to_agree b) → a ≡{n}≡ b. Proof. by intros ?%agree_op_invN%(inj to_agree). Qed. Lemma to_agree_op_inv a b : ✓ (to_agree a ⋅ to_agree b) → a ≡ b. Proof. by intros ?%agree_op_inv%(inj to_agree). Qed. Lemma to_agree_op_inv_L `{!LeibnizEquiv A} a b : ✓ (to_agree a ⋅ to_agree b) → a = b. Proof. by intros ?%to_agree_op_inv%leibniz_equiv. Qed. Lemma to_agree_op_validN a b n : ✓{n} (to_agree a ⋅ to_agree b) ↔ a ≡{n}≡ b. Proof. split; first by apply to_agree_op_invN. intros ->. rewrite agree_idemp //. Qed. Lemma to_agree_op_valid a b : ✓ (to_agree a ⋅ to_agree b) ↔ a ≡ b. Proof. split; first by apply to_agree_op_inv. intros ->. rewrite agree_idemp //. Qed. Lemma to_agree_op_valid_L `{!LeibnizEquiv A} a b : ✓ (to_agree a ⋅ to_agree b) ↔ a = b. Proof. rewrite to_agree_op_valid. by fold_leibniz. Qed. End agree. Global Instance: Params (@to_agree) 1 := {}. Global Arguments agreeO : clear implicits. Global Arguments agreeR : clear implicits. Program Definition agree_map {A B} (f : A → B) (x : agree A) : agree B := {| agree_car := f <$> agree_car x |}. Next Obligation. by intros A B f [[|??] ?]. Qed. Lemma agree_map_id {A} (x : agree A) : agree_map id x = x. Proof. apply agree_eq. by rewrite /= list_fmap_id. Qed. Lemma agree_map_compose {A B C} (f : A → B) (g : B → C) (x : agree A) : agree_map (g ∘ f) x = agree_map g (agree_map f x). Proof. apply agree_eq. by rewrite /= list_fmap_compose. Qed. Lemma agree_map_to_agree {A B} (f : A → B) (x : A) : agree_map f (to_agree x) = to_agree (f x). Proof. by apply agree_eq. Qed. Section agree_map. Context {A B : ofe} (f : A → B) {Hf: NonExpansive f}. Local Instance agree_map_ne : NonExpansive (agree_map f). Proof using Type*. intros n x y [H H']; split=> b /=; setoid_rewrite elem_of_list_fmap. - intros (a&->&?). destruct (H a) as (a'&?&?); auto. naive_solver. - intros (a&->&?). destruct (H' a) as (a'&?&?); auto. naive_solver. Qed. Local Instance agree_map_proper : Proper ((≡) ==> (≡)) (agree_map f) := ne_proper _. Lemma agree_map_ext (g : A → B) x : (∀ a, f a ≡ g a) → agree_map f x ≡ agree_map g x. Proof using Hf. intros Hfg n; split=> b /=; setoid_rewrite elem_of_list_fmap. - intros (a&->&?). exists (g a). rewrite Hfg; eauto. - intros (a&->&?). exists (f a). rewrite -Hfg; eauto. Qed. Global Instance agree_map_morphism : CmraMorphism (agree_map f). Proof using Hf. split; first apply _. - intros n x. rewrite !agree_validN_def=> Hv b b' /=. intros (a&->&?)%elem_of_list_fmap (a'&->&?)%elem_of_list_fmap. apply Hf; eauto. - done. - intros x y n; split=> b /=; rewrite !fmap_app; setoid_rewrite elem_of_app; eauto. Qed. End agree_map. Definition agreeO_map {A B} (f : A -n> B) : agreeO A -n> agreeO B := OfeMor (agree_map f : agreeO A → agreeO B). Global Instance agreeO_map_ne A B : NonExpansive (@agreeO_map A B). Proof. intros n f g Hfg x; split=> b /=; setoid_rewrite elem_of_list_fmap; naive_solver. Qed. Program Definition agreeRF (F : oFunctor) : rFunctor := {| rFunctor_car A _ B _ := agreeR (oFunctor_car F A B); rFunctor_map A1 _ A2 _ B1 _ B2 _ fg := agreeO_map (oFunctor_map F fg) |}. Next Obligation. intros ? A1 ? A2 ? B1 ? B2 ? n ???; simpl. by apply agreeO_map_ne, oFunctor_map_ne. Qed. Next Obligation. intros F A ? B ? x; simpl. rewrite -{2}(agree_map_id x). apply (agree_map_ext _)=>y. by rewrite oFunctor_map_id. Qed. Next Obligation. intros F A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x; simpl. rewrite -agree_map_compose. apply (agree_map_ext _)=>y; apply oFunctor_map_compose. Qed. Global Instance agreeRF_contractive F : oFunctorContractive F → rFunctorContractive (agreeRF F). Proof. intros ? A1 ? A2 ? B1 ? B2 ? n ???; simpl. by apply agreeO_map_ne, oFunctor_map_contractive. Qed. iris-iris-4.2.0/iris/algebra/auth.v000066400000000000000000000432131460620107300171240ustar00rootroot00000000000000From iris.algebra Require Export view frac. From iris.algebra Require Import proofmode_classes big_op. From iris.prelude Require Import options. (** The authoritative camera with fractional authoritative elements *) (** The authoritative camera has 2 types of elements: the authoritative element [●{dq} a] and the fragment [◯ b] (of which there can be several). To enable sharing of the authoritative element [●{dq} a], it is equiped with a discardable fraction [dq]. Updates are only possible with the full authoritative element [● a] (syntax for [●{#1} a]]), while fractional authoritative elements have agreement, i.e., [✓ (●{dq1} a1 ⋅ ●{dq2} a2) → a1 ≡ a2]. *) (** * Definition of the view relation *) (** The authoritative camera is obtained by instantiating the view camera. *) Definition auth_view_rel_raw {A : ucmra} (n : nat) (a b : A) : Prop := b ≼{n} a ∧ ✓{n} a. Lemma auth_view_rel_raw_mono (A : ucmra) n1 n2 (a1 a2 b1 b2 : A) : auth_view_rel_raw n1 a1 b1 → a1 ≡{n2}≡ a2 → b2 ≼{n2} b1 → n2 ≤ n1 → auth_view_rel_raw n2 a2 b2. Proof. intros [??] Ha12 ??. split. - trans b1; [done|]. rewrite -Ha12. by apply cmra_includedN_le with n1. - rewrite -Ha12. by apply cmra_validN_le with n1. Qed. Lemma auth_view_rel_raw_valid (A : ucmra) n (a b : A) : auth_view_rel_raw n a b → ✓{n} b. Proof. intros [??]; eauto using cmra_validN_includedN. Qed. Lemma auth_view_rel_raw_unit (A : ucmra) n : ∃ a : A, auth_view_rel_raw n a ε. Proof. exists ε. split; [done|]. apply ucmra_unit_validN. Qed. Canonical Structure auth_view_rel {A : ucmra} : view_rel A A := ViewRel auth_view_rel_raw (auth_view_rel_raw_mono A) (auth_view_rel_raw_valid A) (auth_view_rel_raw_unit A). Lemma auth_view_rel_unit {A : ucmra} n (a : A) : auth_view_rel n a ε ↔ ✓{n} a. Proof. split; [by intros [??]|]. split; auto using ucmra_unit_leastN. Qed. Lemma auth_view_rel_exists {A : ucmra} n (b : A) : (∃ a, auth_view_rel n a b) ↔ ✓{n} b. Proof. split; [|intros; exists b; by split]. intros [a Hrel]. eapply auth_view_rel_raw_valid, Hrel. Qed. Global Instance auth_view_rel_discrete {A : ucmra} : CmraDiscrete A → ViewRelDiscrete (auth_view_rel (A:=A)). Proof. intros ? n a b [??]; split. - by apply cmra_discrete_included_iff_0. - by apply cmra_discrete_valid_iff_0. Qed. (** * Definition and operations on the authoritative camera *) (** The type [auth] is not defined as a [Definition], but as a [Notation]. This way, one can use [auth A] with [A : Type] instead of [A : ucmra], and let canonical structure search determine the corresponding camera instance. *) Notation auth A := (view (A:=A) (B:=A) auth_view_rel_raw). Definition authO (A : ucmra) : ofe := viewO (A:=A) (B:=A) auth_view_rel. Definition authR (A : ucmra) : cmra := viewR (A:=A) (B:=A) auth_view_rel. Definition authUR (A : ucmra) : ucmra := viewUR (A:=A) (B:=A) auth_view_rel. Definition auth_auth {A: ucmra} : dfrac → A → auth A := view_auth. Definition auth_frag {A: ucmra} : A → auth A := view_frag. Global Typeclasses Opaque auth_auth auth_frag. Global Instance: Params (@auth_auth) 2 := {}. Global Instance: Params (@auth_frag) 1 := {}. Notation "● dq a" := (auth_auth dq a) (at level 20, dq custom dfrac at level 1, format "● dq a"). Notation "◯ a" := (auth_frag a) (at level 20). (** * Laws of the authoritative camera *) (** We omit the usual [equivI] lemma because it is hard to state a suitably general version in terms of [●] and [◯], and because such a lemma has never been needed in practice. *) Section auth. Context {A : ucmra}. Implicit Types a b : A. Implicit Types x y : auth A. Implicit Types q : frac. Implicit Types dq : dfrac. Global Instance auth_auth_ne dq : NonExpansive (@auth_auth A dq). Proof. rewrite /auth_auth. apply _. Qed. Global Instance auth_auth_proper dq : Proper ((≡) ==> (≡)) (@auth_auth A dq). Proof. rewrite /auth_auth. apply _. Qed. Global Instance auth_frag_ne : NonExpansive (@auth_frag A). Proof. rewrite /auth_frag. apply _. Qed. Global Instance auth_frag_proper : Proper ((≡) ==> (≡)) (@auth_frag A). Proof. rewrite /auth_frag. apply _. Qed. Global Instance auth_auth_dist_inj n : Inj2 (=) (dist n) (dist n) (@auth_auth A). Proof. rewrite /auth_auth. apply _. Qed. Global Instance auth_auth_inj : Inj2 (=) (≡) (≡) (@auth_auth A). Proof. rewrite /auth_auth. apply _. Qed. Global Instance auth_frag_dist_inj n : Inj (dist n) (dist n) (@auth_frag A). Proof. rewrite /auth_frag. apply _. Qed. Global Instance auth_frag_inj : Inj (≡) (≡) (@auth_frag A). Proof. rewrite /auth_frag. apply _. Qed. Global Instance auth_ofe_discrete : OfeDiscrete A → OfeDiscrete (authO A). Proof. apply _. Qed. Global Instance auth_auth_discrete dq a : Discrete a → Discrete (ε : A) → Discrete (●{dq} a). Proof. rewrite /auth_auth. apply _. Qed. Global Instance auth_frag_discrete a : Discrete a → Discrete (◯ a). Proof. rewrite /auth_frag. apply _. Qed. Global Instance auth_cmra_discrete : CmraDiscrete A → CmraDiscrete (authR A). Proof. apply _. Qed. (** Operation *) Lemma auth_auth_dfrac_op dq1 dq2 a : ●{dq1 ⋅ dq2} a ≡ ●{dq1} a ⋅ ●{dq2} a. Proof. apply view_auth_dfrac_op. Qed. Global Instance auth_auth_dfrac_is_op dq dq1 dq2 a : IsOp dq dq1 dq2 → IsOp' (●{dq} a) (●{dq1} a) (●{dq2} a). Proof. rewrite /auth_auth. apply _. Qed. Lemma auth_frag_op a b : ◯ (a ⋅ b) = ◯ a ⋅ ◯ b. Proof. apply view_frag_op. Qed. Lemma auth_frag_mono a b : a ≼ b → ◯ a ≼ ◯ b. Proof. apply view_frag_mono. Qed. Lemma auth_frag_core a : core (◯ a) = ◯ (core a). Proof. apply view_frag_core. Qed. Lemma auth_both_core_discarded a b : core (●□ a ⋅ ◯ b) ≡ ●□ a ⋅ ◯ (core b). Proof. apply view_both_core_discarded. Qed. Lemma auth_both_core_frac q a b : core (●{#q} a ⋅ ◯ b) ≡ ◯ (core b). Proof. apply view_both_core_frac. Qed. Global Instance auth_auth_core_id a : CoreId (●□ a). Proof. rewrite /auth_auth. apply _. Qed. Global Instance auth_frag_core_id a : CoreId a → CoreId (◯ a). Proof. rewrite /auth_frag. apply _. Qed. Global Instance auth_both_core_id a1 a2 : CoreId a2 → CoreId (●□ a1 ⋅ ◯ a2). Proof. rewrite /auth_auth /auth_frag. apply _. Qed. Global Instance auth_frag_is_op a b1 b2 : IsOp a b1 b2 → IsOp' (◯ a) (◯ b1) (◯ b2). Proof. rewrite /auth_frag. apply _. Qed. Global Instance auth_frag_sep_homomorphism : MonoidHomomorphism op op (≡) (@auth_frag A). Proof. rewrite /auth_frag. apply _. Qed. Lemma big_opL_auth_frag {B} (g : nat → B → A) (l : list B) : (◯ [^op list] k↦x ∈ l, g k x) ≡ [^op list] k↦x ∈ l, ◯ (g k x). Proof. apply (big_opL_commute _). Qed. Lemma big_opM_auth_frag `{Countable K} {B} (g : K → B → A) (m : gmap K B) : (◯ [^op map] k↦x ∈ m, g k x) ≡ [^op map] k↦x ∈ m, ◯ (g k x). Proof. apply (big_opM_commute _). Qed. Lemma big_opS_auth_frag `{Countable B} (g : B → A) (X : gset B) : (◯ [^op set] x ∈ X, g x) ≡ [^op set] x ∈ X, ◯ (g x). Proof. apply (big_opS_commute _). Qed. Lemma big_opMS_auth_frag `{Countable B} (g : B → A) (X : gmultiset B) : (◯ [^op mset] x ∈ X, g x) ≡ [^op mset] x ∈ X, ◯ (g x). Proof. apply (big_opMS_commute _). Qed. (** Validity *) Lemma auth_auth_dfrac_op_invN n dq1 a dq2 b : ✓{n} (●{dq1} a ⋅ ●{dq2} b) → a ≡{n}≡ b. Proof. apply view_auth_dfrac_op_invN. Qed. Lemma auth_auth_dfrac_op_inv dq1 a dq2 b : ✓ (●{dq1} a ⋅ ●{dq2} b) → a ≡ b. Proof. apply view_auth_dfrac_op_inv. Qed. Lemma auth_auth_dfrac_op_inv_L `{!LeibnizEquiv A} dq1 a dq2 b : ✓ (●{dq1} a ⋅ ●{dq2} b) → a = b. Proof. by apply view_auth_dfrac_op_inv_L. Qed. Lemma auth_auth_dfrac_validN n dq a : ✓{n} (●{dq} a) ↔ ✓ dq ∧ ✓{n} a. Proof. by rewrite view_auth_dfrac_validN auth_view_rel_unit. Qed. Lemma auth_auth_validN n a : ✓{n} (● a) ↔ ✓{n} a. Proof. by rewrite view_auth_validN auth_view_rel_unit. Qed. Lemma auth_auth_dfrac_op_validN n dq1 dq2 a1 a2 : ✓{n} (●{dq1} a1 ⋅ ●{dq2} a2) ↔ ✓ (dq1 ⋅ dq2) ∧ a1 ≡{n}≡ a2 ∧ ✓{n} a1. Proof. by rewrite view_auth_dfrac_op_validN auth_view_rel_unit. Qed. Lemma auth_auth_op_validN n a1 a2 : ✓{n} (● a1 ⋅ ● a2) ↔ False. Proof. apply view_auth_op_validN. Qed. (** The following lemmas are also stated as implications, which can be used to force [apply] to use the lemma in the right direction. *) Lemma auth_frag_validN n b : ✓{n} (◯ b) ↔ ✓{n} b. Proof. by rewrite view_frag_validN auth_view_rel_exists. Qed. Lemma auth_frag_validN_1 n b : ✓{n} (◯ b) → ✓{n} b. Proof. apply auth_frag_validN. Qed. Lemma auth_frag_validN_2 n b : ✓{n} b → ✓{n} (◯ b). Proof. apply auth_frag_validN. Qed. Lemma auth_frag_op_validN n b1 b2 : ✓{n} (◯ b1 ⋅ ◯ b2) ↔ ✓{n} (b1 ⋅ b2). Proof. apply auth_frag_validN. Qed. Lemma auth_frag_op_validN_1 n b1 b2 : ✓{n} (◯ b1 ⋅ ◯ b2) → ✓{n} (b1 ⋅ b2). Proof. apply auth_frag_op_validN. Qed. Lemma auth_frag_op_validN_2 n b1 b2 : ✓{n} (b1 ⋅ b2) → ✓{n} (◯ b1 ⋅ ◯ b2). Proof. apply auth_frag_op_validN. Qed. Lemma auth_both_dfrac_validN n dq a b : ✓{n} (●{dq} a ⋅ ◯ b) ↔ ✓ dq ∧ b ≼{n} a ∧ ✓{n} a. Proof. apply view_both_dfrac_validN. Qed. Lemma auth_both_validN n a b : ✓{n} (● a ⋅ ◯ b) ↔ b ≼{n} a ∧ ✓{n} a. Proof. apply view_both_validN. Qed. Lemma auth_auth_dfrac_valid dq a : ✓ (●{dq} a) ↔ ✓ dq ∧ ✓ a. Proof. rewrite view_auth_dfrac_valid !cmra_valid_validN. by setoid_rewrite auth_view_rel_unit. Qed. Lemma auth_auth_valid a : ✓ (● a) ↔ ✓ a. Proof. rewrite view_auth_valid !cmra_valid_validN. by setoid_rewrite auth_view_rel_unit. Qed. Lemma auth_auth_dfrac_op_valid dq1 dq2 a1 a2 : ✓ (●{dq1} a1 ⋅ ●{dq2} a2) ↔ ✓ (dq1 ⋅ dq2) ∧ a1 ≡ a2 ∧ ✓ a1. Proof. rewrite view_auth_dfrac_op_valid !cmra_valid_validN. setoid_rewrite auth_view_rel_unit. done. Qed. Lemma auth_auth_op_valid a1 a2 : ✓ (● a1 ⋅ ● a2) ↔ False. Proof. apply view_auth_op_valid. Qed. (** The following lemmas are also stated as implications, which can be used to force [apply] to use the lemma in the right direction. *) Lemma auth_frag_valid b : ✓ (◯ b) ↔ ✓ b. Proof. rewrite view_frag_valid cmra_valid_validN. by setoid_rewrite auth_view_rel_exists. Qed. Lemma auth_frag_valid_1 b : ✓ (◯ b) → ✓ b. Proof. apply auth_frag_valid. Qed. Lemma auth_frag_valid_2 b : ✓ b → ✓ (◯ b). Proof. apply auth_frag_valid. Qed. Lemma auth_frag_op_valid b1 b2 : ✓ (◯ b1 ⋅ ◯ b2) ↔ ✓ (b1 ⋅ b2). Proof. apply auth_frag_valid. Qed. Lemma auth_frag_op_valid_1 b1 b2 : ✓ (◯ b1 ⋅ ◯ b2) → ✓ (b1 ⋅ b2). Proof. apply auth_frag_op_valid. Qed. Lemma auth_frag_op_valid_2 b1 b2 : ✓ (b1 ⋅ b2) → ✓ (◯ b1 ⋅ ◯ b2). Proof. apply auth_frag_op_valid. Qed. (** These lemma statements are a bit awkward as we cannot possibly extract a single witness for [b ≼ a] from validity, we have to make do with one witness per step-index, i.e., [∀ n, b ≼{n} a]. *) Lemma auth_both_dfrac_valid dq a b : ✓ (●{dq} a ⋅ ◯ b) ↔ ✓ dq ∧ (∀ n, b ≼{n} a) ∧ ✓ a. Proof. rewrite view_both_dfrac_valid. apply and_iff_compat_l. split. - intros Hrel. split. + intros n. by destruct (Hrel n). + apply cmra_valid_validN=> n. by destruct (Hrel n). - intros [Hincl Hval] n. split; [done|by apply cmra_valid_validN]. Qed. Lemma auth_both_valid a b : ✓ (● a ⋅ ◯ b) ↔ (∀ n, b ≼{n} a) ∧ ✓ a. Proof. rewrite auth_both_dfrac_valid. split; [naive_solver|done]. Qed. (* The reverse direction of the two lemmas below only holds if the camera is discrete. *) Lemma auth_both_dfrac_valid_2 dq a b : ✓ dq → ✓ a → b ≼ a → ✓ (●{dq} a ⋅ ◯ b). Proof. intros. apply auth_both_dfrac_valid. naive_solver eauto using cmra_included_includedN. Qed. Lemma auth_both_valid_2 a b : ✓ a → b ≼ a → ✓ (● a ⋅ ◯ b). Proof. intros ??. by apply auth_both_dfrac_valid_2. Qed. Lemma auth_both_dfrac_valid_discrete `{!CmraDiscrete A} dq a b : ✓ (●{dq} a ⋅ ◯ b) ↔ ✓ dq ∧ b ≼ a ∧ ✓ a. Proof. rewrite auth_both_dfrac_valid. setoid_rewrite <-cmra_discrete_included_iff. naive_solver eauto using O. Qed. Lemma auth_both_valid_discrete `{!CmraDiscrete A} a b : ✓ (● a ⋅ ◯ b) ↔ b ≼ a ∧ ✓ a. Proof. rewrite auth_both_dfrac_valid_discrete. split; [naive_solver|done]. Qed. (** Inclusion *) Lemma auth_auth_dfrac_includedN n dq1 dq2 a1 a2 b : ●{dq1} a1 ≼{n} ●{dq2} a2 ⋅ ◯ b ↔ (dq1 ≼ dq2 ∨ dq1 = dq2) ∧ a1 ≡{n}≡ a2. Proof. apply view_auth_dfrac_includedN. Qed. Lemma auth_auth_dfrac_included dq1 dq2 a1 a2 b : ●{dq1} a1 ≼ ●{dq2} a2 ⋅ ◯ b ↔ (dq1 ≼ dq2 ∨ dq1 = dq2) ∧ a1 ≡ a2. Proof. apply view_auth_dfrac_included. Qed. Lemma auth_auth_includedN n a1 a2 b : ● a1 ≼{n} ● a2 ⋅ ◯ b ↔ a1 ≡{n}≡ a2. Proof. apply view_auth_includedN. Qed. Lemma auth_auth_included a1 a2 b : ● a1 ≼ ● a2 ⋅ ◯ b ↔ a1 ≡ a2. Proof. apply view_auth_included. Qed. Lemma auth_frag_includedN n dq a b1 b2 : ◯ b1 ≼{n} ●{dq} a ⋅ ◯ b2 ↔ b1 ≼{n} b2. Proof. apply view_frag_includedN. Qed. Lemma auth_frag_included dq a b1 b2 : ◯ b1 ≼ ●{dq} a ⋅ ◯ b2 ↔ b1 ≼ b2. Proof. apply view_frag_included. Qed. (** The weaker [auth_both_included] lemmas below are a consequence of the [auth_auth_included] and [auth_frag_included] lemmas above. *) Lemma auth_both_dfrac_includedN n dq1 dq2 a1 a2 b1 b2 : ●{dq1} a1 ⋅ ◯ b1 ≼{n} ●{dq2} a2 ⋅ ◯ b2 ↔ (dq1 ≼ dq2 ∨ dq1 = dq2) ∧ a1 ≡{n}≡ a2 ∧ b1 ≼{n} b2. Proof. apply view_both_dfrac_includedN. Qed. Lemma auth_both_dfrac_included dq1 dq2 a1 a2 b1 b2 : ●{dq1} a1 ⋅ ◯ b1 ≼ ●{dq2} a2 ⋅ ◯ b2 ↔ (dq1 ≼ dq2 ∨ dq1 = dq2) ∧ a1 ≡ a2 ∧ b1 ≼ b2. Proof. apply view_both_dfrac_included. Qed. Lemma auth_both_includedN n a1 a2 b1 b2 : ● a1 ⋅ ◯ b1 ≼{n} ● a2 ⋅ ◯ b2 ↔ a1 ≡{n}≡ a2 ∧ b1 ≼{n} b2. Proof. apply view_both_includedN. Qed. Lemma auth_both_included a1 a2 b1 b2 : ● a1 ⋅ ◯ b1 ≼ ● a2 ⋅ ◯ b2 ↔ a1 ≡ a2 ∧ b1 ≼ b2. Proof. apply view_both_included. Qed. (** Updates *) Lemma auth_update a b a' b' : (a,b) ~l~> (a',b') → ● a ⋅ ◯ b ~~> ● a' ⋅ ◯ b'. Proof. intros Hup. apply view_update=> n bf [[bf' Haeq] Hav]. destruct (Hup n (Some (bf ⋅ bf'))); simpl in *; [done|by rewrite assoc|]. split; [|done]. exists bf'. by rewrite -assoc. Qed. Lemma auth_update_alloc a a' b' : (a,ε) ~l~> (a',b') → ● a ~~> ● a' ⋅ ◯ b'. Proof. intros. rewrite -(right_id _ _ (● a)). by apply auth_update. Qed. Lemma auth_update_dealloc a b a' : (a,b) ~l~> (a',ε) → ● a ⋅ ◯ b ~~> ● a'. Proof. intros. rewrite -(right_id _ _ (● a')). by apply auth_update. Qed. Lemma auth_update_auth a a' b' : (a,ε) ~l~> (a',b') → ● a ~~> ● a'. Proof. intros. etrans; first exact: auth_update_alloc. exact: cmra_update_op_l. Qed. Lemma auth_update_auth_persist dq a : ●{dq} a ~~> ●□ a. Proof. apply view_update_auth_persist. Qed. Lemma auth_updateP_auth_unpersist a : ●□ a ~~>: λ k, ∃ q, k = ●{#q} a. Proof. apply view_updateP_auth_unpersist. Qed. Lemma auth_updateP_both_unpersist a b : ●□ a ⋅ ◯ b ~~>: λ k, ∃ q, k = ●{#q} a ⋅ ◯ b. Proof. apply view_updateP_both_unpersist. Qed. Lemma auth_update_dfrac_alloc dq a b `{!CoreId b} : b ≼ a → ●{dq} a ~~> ●{dq} a ⋅ ◯ b. Proof. intros Ha%(core_id_extract _ _). apply view_update_dfrac_alloc=> n bf [??]. split; [|done]. rewrite Ha (comm _ a). by apply cmra_monoN_l. Qed. Lemma auth_local_update a b0 b1 a' b0' b1' : (b0, b1) ~l~> (b0', b1') → b0' ≼ a' → ✓ a' → (● a ⋅ ◯ b0, ● a ⋅ ◯ b1) ~l~> (● a' ⋅ ◯ b0', ● a' ⋅ ◯ b1'). Proof. intros. apply view_local_update; [done|]=> n [??]. split. - by apply cmra_included_includedN. - by apply cmra_valid_validN. Qed. End auth. (** * Functor *) Program Definition authURF (F : urFunctor) : urFunctor := {| urFunctor_car A _ B _ := authUR (urFunctor_car F A B); urFunctor_map A1 _ A2 _ B1 _ B2 _ fg := viewO_map (urFunctor_map F fg) (urFunctor_map F fg) |}. Next Obligation. intros F A1 ? A2 ? B1 ? B2 ? n f g Hfg. apply viewO_map_ne; by apply urFunctor_map_ne. Qed. Next Obligation. intros F A ? B ? x; simpl in *. rewrite -{2}(view_map_id x). apply (view_map_ext _ _ _ _)=> y; apply urFunctor_map_id. Qed. Next Obligation. intros F A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x; simpl in *. rewrite -view_map_compose. apply (view_map_ext _ _ _ _)=> y; apply urFunctor_map_compose. Qed. Next Obligation. intros F A1 ? A2 ? B1 ? B2 ? fg; simpl. apply view_map_cmra_morphism; [apply _..|]=> n a b [??]; split. - by apply (cmra_morphism_monotoneN _). - by apply (cmra_morphism_validN _). Qed. Global Instance authURF_contractive F : urFunctorContractive F → urFunctorContractive (authURF F). Proof. intros ? A1 ? A2 ? B1 ? B2 ? n f g Hfg. apply viewO_map_ne; by apply urFunctor_map_contractive. Qed. Program Definition authRF (F : urFunctor) : rFunctor := {| rFunctor_car A _ B _ := authR (urFunctor_car F A B); rFunctor_map A1 _ A2 _ B1 _ B2 _ fg := viewO_map (urFunctor_map F fg) (urFunctor_map F fg) |}. Solve Obligations with apply authURF. Global Instance authRF_contractive F : urFunctorContractive F → rFunctorContractive (authRF F). Proof. apply authURF_contractive. Qed. iris-iris-4.2.0/iris/algebra/big_op.v000066400000000000000000001255001460620107300174220ustar00rootroot00000000000000From stdpp Require Export functions gmap gmultiset. From iris.algebra Require Export monoid. From iris.prelude Require Import options. Local Existing Instances monoid_ne monoid_assoc monoid_comm monoid_left_id monoid_right_id monoid_proper monoid_homomorphism_rel_po monoid_homomorphism_rel_proper monoid_homomorphism_op_proper monoid_homomorphism_ne weak_monoid_homomorphism_proper. (** We define the following big operators with binders build in: - The operator [ [^o list] k ↦ x ∈ l, P ] folds over a list [l]. The binder [x] refers to each element at index [k]. - The operator [ [^o map] k ↦ x ∈ m, P ] folds over a map [m]. The binder [x] refers to each element at index [k]. - The operator [ [^o set] x ∈ X, P ] folds over a set [X]. The binder [x] refers to each element. Since these big operators are like quantifiers, they have the same precedence as [∀] and [∃]. *) (** * Big ops over lists *) Fixpoint big_opL {M : ofe} {o : M → M → M} `{!Monoid o} {A} (f : nat → A → M) (xs : list A) : M := match xs with | [] => monoid_unit | x :: xs => o (f 0 x) (big_opL (λ n, f (S n)) xs) end. Global Instance: Params (@big_opL) 4 := {}. Global Arguments big_opL {M} o {_ A} _ !_ /. Global Typeclasses Opaque big_opL. Notation "'[^' o 'list]' k ↦ x ∈ l , P" := (big_opL o (λ k x, P) l) (at level 200, o at level 1, l at level 10, k, x at level 1, right associativity, format "[^ o list] k ↦ x ∈ l , P") : stdpp_scope. Notation "'[^' o 'list]' x ∈ l , P" := (big_opL o (λ _ x, P) l) (at level 200, o at level 1, l at level 10, x at level 1, right associativity, format "[^ o list] x ∈ l , P") : stdpp_scope. Local Definition big_opM_def {M : ofe} {o : M → M → M} `{!Monoid o} `{Countable K} {A} (f : K → A → M) (m : gmap K A) : M := big_opL o (λ _, uncurry f) (map_to_list m). Local Definition big_opM_aux : seal (@big_opM_def). Proof. by eexists. Qed. Definition big_opM := big_opM_aux.(unseal). Global Arguments big_opM {M} o {_ K _ _ A} _ _. Local Definition big_opM_unseal : @big_opM = @big_opM_def := big_opM_aux.(seal_eq). Global Instance: Params (@big_opM) 7 := {}. Notation "'[^' o 'map]' k ↦ x ∈ m , P" := (big_opM o (λ k x, P) m) (at level 200, o at level 1, m at level 10, k, x at level 1, right associativity, format "[^ o map] k ↦ x ∈ m , P") : stdpp_scope. Notation "'[^' o 'map]' x ∈ m , P" := (big_opM o (λ _ x, P) m) (at level 200, o at level 1, m at level 10, x at level 1, right associativity, format "[^ o map] x ∈ m , P") : stdpp_scope. Local Definition big_opS_def {M : ofe} {o : M → M → M} `{!Monoid o} `{Countable A} (f : A → M) (X : gset A) : M := big_opL o (λ _, f) (elements X). Local Definition big_opS_aux : seal (@big_opS_def). Proof. by eexists. Qed. Definition big_opS := big_opS_aux.(unseal). Global Arguments big_opS {M} o {_ A _ _} _ _. Local Definition big_opS_unseal : @big_opS = @big_opS_def := big_opS_aux.(seal_eq). Global Instance: Params (@big_opS) 6 := {}. Notation "'[^' o 'set]' x ∈ X , P" := (big_opS o (λ x, P) X) (at level 200, o at level 1, X at level 10, x at level 1, right associativity, format "[^ o set] x ∈ X , P") : stdpp_scope. Local Definition big_opMS_def {M : ofe} {o : M → M → M} `{!Monoid o} `{Countable A} (f : A → M) (X : gmultiset A) : M := big_opL o (λ _, f) (elements X). Local Definition big_opMS_aux : seal (@big_opMS_def). Proof. by eexists. Qed. Definition big_opMS := big_opMS_aux.(unseal). Global Arguments big_opMS {M} o {_ A _ _} _ _. Local Definition big_opMS_unseal : @big_opMS = @big_opMS_def := big_opMS_aux.(seal_eq). Global Instance: Params (@big_opMS) 6 := {}. Notation "'[^' o 'mset]' x ∈ X , P" := (big_opMS o (λ x, P) X) (at level 200, o at level 1, X at level 10, x at level 1, right associativity, format "[^ o mset] x ∈ X , P") : stdpp_scope. (** * Properties about big ops *) Section big_op. Context {M : ofe} {o : M → M → M} `{!Monoid o}. Implicit Types xs : list M. Infix "`o`" := o (at level 50, left associativity). (** ** Big ops over lists *) Section list. Context {A : Type}. Implicit Types l : list A. Implicit Types f g : nat → A → M. Lemma big_opL_nil f : ([^o list] k↦y ∈ [], f k y) = monoid_unit. Proof. done. Qed. Lemma big_opL_cons f x l : ([^o list] k↦y ∈ x :: l, f k y) = f 0 x `o` [^o list] k↦y ∈ l, f (S k) y. Proof. done. Qed. Lemma big_opL_singleton f x : ([^o list] k↦y ∈ [x], f k y) ≡ f 0 x. Proof. by rewrite /= right_id. Qed. Lemma big_opL_app f l1 l2 : ([^o list] k↦y ∈ l1 ++ l2, f k y) ≡ ([^o list] k↦y ∈ l1, f k y) `o` ([^o list] k↦y ∈ l2, f (length l1 + k) y). Proof. revert f. induction l1 as [|x l1 IH]=> f /=; first by rewrite left_id. by rewrite IH assoc. Qed. Lemma big_opL_snoc f l x : ([^o list] k↦y ∈ l ++ [x], f k y) ≡ ([^o list] k↦y ∈ l, f k y) `o` f (length l) x. Proof. rewrite big_opL_app big_opL_singleton Nat.add_0_r //. Qed. Lemma big_opL_unit l : ([^o list] k↦y ∈ l, monoid_unit) ≡ (monoid_unit : M). Proof. induction l; rewrite /= ?left_id //. Qed. Lemma big_opL_take_drop Φ l n : ([^o list] k ↦ x ∈ l, Φ k x) ≡ ([^o list] k ↦ x ∈ take n l, Φ k x) `o` ([^o list] k ↦ x ∈ drop n l, Φ (n + k) x). Proof. rewrite -{1}(take_drop n l) big_opL_app take_length. destruct (decide (length l ≤ n)). - rewrite drop_ge //=. - rewrite Nat.min_l //=; lia. Qed. Lemma big_opL_gen_proper_2 {B} (R : relation M) f (g : nat → B → M) l1 (l2 : list B) : R monoid_unit monoid_unit → Proper (R ==> R ==> R) o → (∀ k, match l1 !! k, l2 !! k with | Some y1, Some y2 => R (f k y1) (g k y2) | None, None => True | _, _ => False end) → R ([^o list] k ↦ y ∈ l1, f k y) ([^o list] k ↦ y ∈ l2, g k y). Proof. intros ??. revert l2 f g. induction l1 as [|x1 l1 IH]=> -[|x2 l2] //= f g Hfg. - by specialize (Hfg 0). - by specialize (Hfg 0). - f_equiv; [apply (Hfg 0)|]. apply IH. intros k. apply (Hfg (S k)). Qed. Lemma big_opL_gen_proper R f g l : Reflexive R → Proper (R ==> R ==> R) o → (∀ k y, l !! k = Some y → R (f k y) (g k y)) → R ([^o list] k ↦ y ∈ l, f k y) ([^o list] k ↦ y ∈ l, g k y). Proof. intros. apply big_opL_gen_proper_2; [done..|]. intros k. destruct (l !! k) eqn:?; auto. Qed. Lemma big_opL_ext f g l : (∀ k y, l !! k = Some y → f k y = g k y) → ([^o list] k ↦ y ∈ l, f k y) = [^o list] k ↦ y ∈ l, g k y. Proof. apply big_opL_gen_proper; apply _. Qed. Lemma big_opL_permutation (f : A → M) l1 l2 : l1 ≡ₚ l2 → ([^o list] x ∈ l1, f x) ≡ ([^o list] x ∈ l2, f x). Proof. induction 1 as [|x xs1 xs2 ? IH|x y xs|xs1 xs2 xs3]; simpl; auto. - by rewrite IH. - by rewrite !assoc (comm _ (f x)). - by etrans. Qed. Global Instance big_opL_permutation' (f : A → M) : Proper ((≡ₚ) ==> (≡)) (big_opL o (λ _, f)). Proof. intros xs1 xs2. apply big_opL_permutation. Qed. (** The lemmas [big_opL_ne] and [big_opL_proper] are more generic than the instances as they also give [l !! k = Some y] in the premise. *) Lemma big_opL_ne f g l n : (∀ k y, l !! k = Some y → f k y ≡{n}≡ g k y) → ([^o list] k ↦ y ∈ l, f k y) ≡{n}≡ ([^o list] k ↦ y ∈ l, g k y). Proof. apply big_opL_gen_proper; apply _. Qed. Lemma big_opL_proper f g l : (∀ k y, l !! k = Some y → f k y ≡ g k y) → ([^o list] k ↦ y ∈ l, f k y) ≡ ([^o list] k ↦ y ∈ l, g k y). Proof. apply big_opL_gen_proper; apply _. Qed. (** The version [big_opL_proper_2] with [≡] for the list arguments can only be used if there is a setoid on [A]. The version for [dist n] can be found in [algebra.list]. We do not define this lemma as a [Proper] instance, since [f_equiv] will then use sometimes use this one, and other times [big_opL_proper'], depending on whether a setoid on [A] exists. *) Lemma big_opL_proper_2 `{!Equiv A} f g l1 l2 : l1 ≡ l2 → (∀ k y1 y2, l1 !! k = Some y1 → l2 !! k = Some y2 → y1 ≡ y2 → f k y1 ≡ g k y2) → ([^o list] k ↦ y ∈ l1, f k y) ≡ ([^o list] k ↦ y ∈ l2, g k y). Proof. intros Hl Hf. apply big_opL_gen_proper_2; try (apply _ || done). (* FIXME (Coq #14441) unnecessary type annotation *) intros k. assert (l1 !! k ≡@{option A} l2 !! k) as Hlk by (by f_equiv). destruct (l1 !! k) eqn:?, (l2 !! k) eqn:?; inversion Hlk; naive_solver. Qed. Global Instance big_opL_ne' n : Proper (pointwise_relation _ (pointwise_relation _ (dist n)) ==> (=) ==> dist n) (big_opL o (A:=A)). Proof. intros f f' Hf l ? <-. apply big_opL_ne; intros; apply Hf. Qed. Global Instance big_opL_proper' : Proper (pointwise_relation _ (pointwise_relation _ (≡)) ==> (=) ==> (≡)) (big_opL o (A:=A)). Proof. intros f f' Hf l ? <-. apply big_opL_proper; intros; apply Hf. Qed. Lemma big_opL_consZ_l (f : Z → A → M) x l : ([^o list] k↦y ∈ x :: l, f k y) = f 0 x `o` [^o list] k↦y ∈ l, f (1 + k)%Z y. Proof. rewrite big_opL_cons. auto using big_opL_ext with f_equal lia. Qed. Lemma big_opL_consZ_r (f : Z → A → M) x l : ([^o list] k↦y ∈ x :: l, f k y) = f 0 x `o` [^o list] k↦y ∈ l, f (k + 1)%Z y. Proof. rewrite big_opL_cons. auto using big_opL_ext with f_equal lia. Qed. Lemma big_opL_fmap {B} (h : A → B) (f : nat → B → M) l : ([^o list] k↦y ∈ h <$> l, f k y) ≡ ([^o list] k↦y ∈ l, f k (h y)). Proof. revert f. induction l as [|x l IH]=> f; csimpl=> //. by rewrite IH. Qed. Lemma big_opL_omap {B} (h : A → option B) (f : B → M) l : ([^o list] y ∈ omap h l, f y) ≡ ([^o list] y ∈ l, from_option f monoid_unit (h y)). Proof. revert f. induction l as [|x l IH]=> f //; csimpl. case_match; csimpl; by rewrite IH // left_id. Qed. Lemma big_opL_op f g l : ([^o list] k↦x ∈ l, f k x `o` g k x) ≡ ([^o list] k↦x ∈ l, f k x) `o` ([^o list] k↦x ∈ l, g k x). Proof. revert f g; induction l as [|x l IH]=> f g /=; first by rewrite left_id. by rewrite IH -!assoc (assoc _ (g _ _)) [(g _ _ `o` _)]comm -!assoc. Qed. (** Shows that some property [P] is closed under [big_opL]. Examples of [P] are [Persistent], [Affine], [Timeless]. *) Lemma big_opL_closed (P : M → Prop) f l : P monoid_unit → (∀ x y, P x → P y → P (x `o` y)) → (∀ k x, l !! k = Some x → P (f k x)) → P ([^o list] k↦x ∈ l, f k x). Proof. intros Hunit Hop. revert f. induction l as [|x l IH]=> f Hf /=; [done|]. apply Hop; first by auto. apply IH=> k. apply (Hf (S k)). Qed. End list. Lemma big_opL_bind {A B} (h : A → list B) (f : B → M) l : ([^o list] y ∈ l ≫= h, f y) ≡ ([^o list] x ∈ l, [^o list] y ∈ h x, f y). Proof. revert f. induction l as [|x l IH]=> f; csimpl=> //. by rewrite big_opL_app IH. Qed. Lemma big_opL_sep_zip_with {A B C} (f : A → B → C) (g1 : C → A) (g2 : C → B) (h1 : nat → A → M) (h2 : nat → B → M) l1 l2 : (∀ x y, g1 (f x y) = x) → (∀ x y, g2 (f x y) = y) → length l1 = length l2 → ([^o list] k↦xy ∈ zip_with f l1 l2, h1 k (g1 xy) `o` h2 k (g2 xy)) ≡ ([^o list] k↦x ∈ l1, h1 k x) `o` ([^o list] k↦y ∈ l2, h2 k y). Proof. intros Hlen Hg1 Hg2. rewrite big_opL_op. rewrite -(big_opL_fmap g1) -(big_opL_fmap g2). rewrite fmap_zip_with_r; [|auto with lia..]. by rewrite fmap_zip_with_l; [|auto with lia..]. Qed. Lemma big_opL_sep_zip {A B} (h1 : nat → A → M) (h2 : nat → B → M) l1 l2 : length l1 = length l2 → ([^o list] k↦xy ∈ zip l1 l2, h1 k xy.1 `o` h2 k xy.2) ≡ ([^o list] k↦x ∈ l1, h1 k x) `o` ([^o list] k↦y ∈ l2, h2 k y). Proof. by apply big_opL_sep_zip_with. Qed. (** ** Big ops over finite maps *) Lemma big_opM_empty `{Countable K} {B} (f : K → B → M) : ([^o map] k↦x ∈ ∅, f k x) = monoid_unit. Proof. by rewrite big_opM_unseal /big_opM_def map_to_list_empty. Qed. Lemma big_opM_insert `{Countable K} {B} (f : K → B → M) (m : gmap K B) i x : m !! i = None → ([^o map] k↦y ∈ <[i:=x]> m, f k y) ≡ f i x `o` [^o map] k↦y ∈ m, f k y. Proof. intros ?. by rewrite big_opM_unseal /big_opM_def map_to_list_insert. Qed. Lemma big_opM_delete `{Countable K} {B} (f : K → B → M) (m : gmap K B) i x : m !! i = Some x → ([^o map] k↦y ∈ m, f k y) ≡ f i x `o` [^o map] k↦y ∈ delete i m, f k y. Proof. intros. rewrite -big_opM_insert ?lookup_delete //. by rewrite insert_delete. Qed. Section gmap. Context `{Countable K} {A : Type}. Implicit Types m : gmap K A. Implicit Types f g : K → A → M. Lemma big_opM_gen_proper_2 {B} (R : relation M) f (g : K → B → M) m1 (m2 : gmap K B) : subrelation (≡) R → Equivalence R → Proper (R ==> R ==> R) o → (∀ k, match m1 !! k, m2 !! k with | Some y1, Some y2 => R (f k y1) (g k y2) | None, None => True | _, _ => False end) → R ([^o map] k ↦ x ∈ m1, f k x) ([^o map] k ↦ x ∈ m2, g k x). Proof. intros HR ??. revert m2 f g. induction m1 as [|k x1 m1 Hm1k IH] using map_ind=> m2 f g Hfg. { destruct m2 as [|k x2 m2 _ _] using map_ind. { rewrite !big_opM_empty. by apply HR. } generalize (Hfg k). by rewrite lookup_empty lookup_insert. } generalize (Hfg k). rewrite lookup_insert. destruct (m2 !! k) as [x2|] eqn:Hm2k; [intros Hk|done]. etrans; [by apply HR, big_opM_insert|]. etrans; [|by symmetry; apply HR, big_opM_delete]. f_equiv; [done|]. apply IH=> k'. destruct (decide (k = k')) as [->|?]. - by rewrite lookup_delete Hm1k. - generalize (Hfg k'). rewrite lookup_insert_ne // lookup_delete_ne //. Qed. Lemma big_opM_gen_proper R f g m : Reflexive R → Proper (R ==> R ==> R) o → (∀ k x, m !! k = Some x → R (f k x) (g k x)) → R ([^o map] k ↦ x ∈ m, f k x) ([^o map] k ↦ x ∈ m, g k x). Proof. intros ?? Hf. rewrite big_opM_unseal. apply (big_opL_gen_proper R); auto. intros k [i x] ?%elem_of_list_lookup_2. by apply Hf, elem_of_map_to_list. Qed. Lemma big_opM_ext f g m : (∀ k x, m !! k = Some x → f k x = g k x) → ([^o map] k ↦ x ∈ m, f k x) = ([^o map] k ↦ x ∈ m, g k x). Proof. apply big_opM_gen_proper; apply _. Qed. (** The lemmas [big_opM_ne] and [big_opM_proper] are more generic than the instances as they also give [m !! k = Some y] in the premise. *) Lemma big_opM_ne f g m n : (∀ k x, m !! k = Some x → f k x ≡{n}≡ g k x) → ([^o map] k ↦ x ∈ m, f k x) ≡{n}≡ ([^o map] k ↦ x ∈ m, g k x). Proof. apply big_opM_gen_proper; apply _. Qed. Lemma big_opM_proper f g m : (∀ k x, m !! k = Some x → f k x ≡ g k x) → ([^o map] k ↦ x ∈ m, f k x) ≡ ([^o map] k ↦ x ∈ m, g k x). Proof. apply big_opM_gen_proper; apply _. Qed. (** The version [big_opM_proper_2] with [≡] for the map arguments can only be used if there is a setoid on [A]. The version for [dist n] can be found in [algebra.gmap]. We do not define this lemma as a [Proper] instance, since [f_equiv] will then use sometimes use this one, and other times [big_opM_proper'], depending on whether a setoid on [A] exists. *) Lemma big_opM_proper_2 `{!Equiv A} f g m1 m2 : m1 ≡ m2 → (∀ k y1 y2, m1 !! k = Some y1 → m2 !! k = Some y2 → y1 ≡ y2 → f k y1 ≡ g k y2) → ([^o map] k ↦ y ∈ m1, f k y) ≡ ([^o map] k ↦ y ∈ m2, g k y). Proof. intros Hl Hf. apply big_opM_gen_proper_2; try (apply _ || done). (* FIXME (Coq #14441) unnecessary type annotation *) intros k. assert (m1 !! k ≡@{option A} m2 !! k) as Hlk by (by f_equiv). destruct (m1 !! k) eqn:?, (m2 !! k) eqn:?; inversion Hlk; naive_solver. Qed. Global Instance big_opM_ne' n : Proper (pointwise_relation _ (pointwise_relation _ (dist n)) ==> (=) ==> dist n) (big_opM o (K:=K) (A:=A)). Proof. intros f g Hf m ? <-. apply big_opM_ne; intros; apply Hf. Qed. Global Instance big_opM_proper' : Proper (pointwise_relation _ (pointwise_relation _ (≡)) ==> (=) ==> (≡)) (big_opM o (K:=K) (A:=A)). Proof. intros f g Hf m ? <-. apply big_opM_proper; intros; apply Hf. Qed. (* FIXME: This lemma could be generalized from [≡] to [=], but that breaks [setoid_rewrite] in the proof of [big_sepS_sepS]. See Coq issue #14349. *) Lemma big_opM_map_to_list f m : ([^o map] k↦x ∈ m, f k x) ≡ [^o list] xk ∈ map_to_list m, f (xk.1) (xk.2). Proof. rewrite big_opM_unseal. apply big_opL_proper'; [|done]. by intros ? [??]. Qed. Lemma big_opM_list_to_map f l : NoDup l.*1 → ([^o map] k↦x ∈ list_to_map l, f k x) ≡ [^o list] xk ∈ l, f (xk.1) (xk.2). Proof. intros. rewrite big_opM_map_to_list. by apply big_opL_permutation, map_to_list_to_map. Qed. Lemma big_opM_singleton f i x : ([^o map] k↦y ∈ {[i:=x]}, f k y) ≡ f i x. Proof. rewrite -insert_empty big_opM_insert/=; last eauto using lookup_empty. by rewrite big_opM_empty right_id. Qed. Lemma big_opM_unit m : ([^o map] k↦y ∈ m, monoid_unit) ≡ (monoid_unit : M). Proof. by induction m using map_ind; rewrite /= ?big_opM_insert ?left_id // big_opM_unseal. Qed. Lemma big_opM_fmap {B} (h : A → B) (f : K → B → M) m : ([^o map] k↦y ∈ h <$> m, f k y) ≡ ([^o map] k↦y ∈ m, f k (h y)). Proof. rewrite big_opM_unseal /big_opM_def map_to_list_fmap big_opL_fmap. by apply big_opL_proper=> ? [??]. Qed. Lemma big_opM_omap {B} (h : A → option B) (f : K → B → M) m : ([^o map] k↦y ∈ omap h m, f k y) ≡ [^o map] k↦y ∈ m, from_option (f k) monoid_unit (h y). Proof. revert f. induction m as [|i x m Hmi IH] using map_ind=> f. { by rewrite omap_empty !big_opM_empty. } assert (omap h m !! i = None) by (by rewrite lookup_omap Hmi). destruct (h x) as [y|] eqn:Hhx. - by rewrite omap_insert Hhx //= !big_opM_insert // IH Hhx. - rewrite omap_insert_None // delete_notin // big_opM_insert //. by rewrite Hhx /= left_id. Qed. Lemma big_opM_insert_delete `{Countable K} {B} (f : K → B → M) (m : gmap K B) i x : ([^o map] k↦y ∈ <[i:=x]> m, f k y) ≡ f i x `o` [^o map] k↦y ∈ delete i m, f k y. Proof. rewrite -insert_delete_insert big_opM_insert; first done. by rewrite lookup_delete. Qed. Lemma big_opM_insert_override (f : K → A → M) m i x x' : m !! i = Some x → f i x ≡ f i x' → ([^o map] k↦y ∈ <[i:=x']> m, f k y) ≡ ([^o map] k↦y ∈ m, f k y). Proof. intros ? Hx. rewrite -insert_delete_insert big_opM_insert ?lookup_delete //. by rewrite -Hx -big_opM_delete. Qed. Lemma big_opM_fn_insert {B} (g : K → A → B → M) (f : K → B) m i (x : A) b : m !! i = None → ([^o map] k↦y ∈ <[i:=x]> m, g k y (<[i:=b]> f k)) ≡ g i x b `o` [^o map] k↦y ∈ m, g k y (f k). Proof. intros. rewrite big_opM_insert // fn_lookup_insert. f_equiv; apply big_opM_proper; auto=> k y ?. by rewrite fn_lookup_insert_ne; last set_solver. Qed. Lemma big_opM_fn_insert' (f : K → M) m i x P : m !! i = None → ([^o map] k↦y ∈ <[i:=x]> m, <[i:=P]> f k) ≡ (P `o` [^o map] k↦y ∈ m, f k). Proof. apply (big_opM_fn_insert (λ _ _, id)). Qed. Lemma big_opM_filter' (φ : K * A → Prop) `{∀ kx, Decision (φ kx)} f m : ([^o map] k ↦ x ∈ filter φ m, f k x) ≡ ([^o map] k ↦ x ∈ m, if decide (φ (k, x)) then f k x else monoid_unit). Proof. induction m as [|k v m ? IH] using map_ind. { by rewrite map_filter_empty !big_opM_empty. } destruct (decide (φ (k, v))). - rewrite map_filter_insert_True //. assert (filter φ m !! k = None) by (apply map_lookup_filter_None; eauto). by rewrite !big_opM_insert // decide_True // IH. - rewrite map_filter_insert_not' //; last by congruence. rewrite !big_opM_insert // decide_False // IH. by rewrite left_id. Qed. Lemma big_opM_union f m1 m2 : m1 ##ₘ m2 → ([^o map] k↦y ∈ m1 ∪ m2, f k y) ≡ ([^o map] k↦y ∈ m1, f k y) `o` ([^o map] k↦y ∈ m2, f k y). Proof. intros. induction m1 as [|i x m ? IH] using map_ind. { by rewrite big_opM_empty !left_id. } decompose_map_disjoint. rewrite -insert_union_l !big_opM_insert //; last by apply lookup_union_None. rewrite -assoc IH //. Qed. Lemma big_opM_op f g m : ([^o map] k↦x ∈ m, f k x `o` g k x) ≡ ([^o map] k↦x ∈ m, f k x) `o` ([^o map] k↦x ∈ m, g k x). Proof. rewrite big_opM_unseal /big_opM_def -big_opL_op. by apply big_opL_proper=> ? [??]. Qed. (** Shows that some property [P] is closed under [big_opM]. Examples of [P] are [Persistent], [Affine], [Timeless]. *) Lemma big_opM_closed (P : M → Prop) f m : Proper ((≡) ==> iff) P → P monoid_unit → (∀ x y, P x → P y → P (x `o` y)) → (∀ k x, m !! k = Some x → P (f k x)) → P ([^o map] k↦x ∈ m, f k x). Proof. intros ?? Hop Hf. induction m as [|k x ?? IH] using map_ind. { by rewrite big_opM_empty. } rewrite big_opM_insert //. apply Hop. { apply Hf. by rewrite lookup_insert. } apply IH=> k' x' ?. apply Hf. rewrite lookup_insert_ne; naive_solver. Qed. End gmap. Lemma big_opM_sep_zip_with `{Countable K} {A B C} (f : A → B → C) (g1 : C → A) (g2 : C → B) (h1 : K → A → M) (h2 : K → B → M) m1 m2 : (∀ x y, g1 (f x y) = x) → (∀ x y, g2 (f x y) = y) → (∀ k, is_Some (m1 !! k) ↔ is_Some (m2 !! k)) → ([^o map] k↦xy ∈ map_zip_with f m1 m2, h1 k (g1 xy) `o` h2 k (g2 xy)) ≡ ([^o map] k↦x ∈ m1, h1 k x) `o` ([^o map] k↦y ∈ m2, h2 k y). Proof. intros Hdom Hg1 Hg2. rewrite big_opM_op. rewrite -(big_opM_fmap g1) -(big_opM_fmap g2). rewrite map_fmap_zip_with_r; [|naive_solver..]. by rewrite map_fmap_zip_with_l; [|naive_solver..]. Qed. Lemma big_opM_sep_zip `{Countable K} {A B} (h1 : K → A → M) (h2 : K → B → M) m1 m2 : (∀ k, is_Some (m1 !! k) ↔ is_Some (m2 !! k)) → ([^o map] k↦xy ∈ map_zip m1 m2, h1 k xy.1 `o` h2 k xy.2) ≡ ([^o map] k↦x ∈ m1, h1 k x) `o` ([^o map] k↦y ∈ m2, h2 k y). Proof. intros. by apply big_opM_sep_zip_with. Qed. (** ** Big ops over finite sets *) Section gset. Context `{Countable A}. Implicit Types X : gset A. Implicit Types f : A → M. Lemma big_opS_gen_proper R f g X : Reflexive R → Proper (R ==> R ==> R) o → (∀ x, x ∈ X → R (f x) (g x)) → R ([^o set] x ∈ X, f x) ([^o set] x ∈ X, g x). Proof. rewrite big_opS_unseal. intros ?? Hf. apply (big_opL_gen_proper R); auto. intros k x ?%elem_of_list_lookup_2. by apply Hf, elem_of_elements. Qed. Lemma big_opS_ext f g X : (∀ x, x ∈ X → f x = g x) → ([^o set] x ∈ X, f x) = ([^o set] x ∈ X, g x). Proof. apply big_opS_gen_proper; apply _. Qed. (** The lemmas [big_opS_ne] and [big_opS_proper] are more generic than the instances as they also give [x ∈ X] in the premise. *) Lemma big_opS_ne f g X n : (∀ x, x ∈ X → f x ≡{n}≡ g x) → ([^o set] x ∈ X, f x) ≡{n}≡ ([^o set] x ∈ X, g x). Proof. apply big_opS_gen_proper; apply _. Qed. Lemma big_opS_proper f g X : (∀ x, x ∈ X → f x ≡ g x) → ([^o set] x ∈ X, f x) ≡ ([^o set] x ∈ X, g x). Proof. apply big_opS_gen_proper; apply _. Qed. Global Instance big_opS_ne' n : Proper (pointwise_relation _ (dist n) ==> (=) ==> dist n) (big_opS o (A:=A)). Proof. intros f g Hf m ? <-. apply big_opS_ne; intros; apply Hf. Qed. Global Instance big_opS_proper' : Proper (pointwise_relation _ (≡) ==> (=) ==> (≡)) (big_opS o (A:=A)). Proof. intros f g Hf m ? <-. apply big_opS_proper; intros; apply Hf. Qed. (* FIXME: This lemma could be generalized from [≡] to [=], but that breaks [setoid_rewrite] in the proof of [big_sepS_sepS]. See Coq issue #14349. *) Lemma big_opS_elements f X : ([^o set] x ∈ X, f x) ≡ [^o list] x ∈ elements X, f x. Proof. by rewrite big_opS_unseal. Qed. Lemma big_opS_empty f : ([^o set] x ∈ ∅, f x) = monoid_unit. Proof. by rewrite big_opS_unseal /big_opS_def elements_empty. Qed. Lemma big_opS_insert f X x : x ∉ X → ([^o set] y ∈ {[ x ]} ∪ X, f y) ≡ (f x `o` [^o set] y ∈ X, f y). Proof. intros. by rewrite !big_opS_elements elements_union_singleton. Qed. Lemma big_opS_fn_insert {B} (f : A → B → M) h X x b : x ∉ X → ([^o set] y ∈ {[ x ]} ∪ X, f y (<[x:=b]> h y)) ≡ f x b `o` [^o set] y ∈ X, f y (h y). Proof. intros. rewrite big_opS_insert // fn_lookup_insert. f_equiv; apply big_opS_proper; auto=> y ?. by rewrite fn_lookup_insert_ne; last set_solver. Qed. Lemma big_opS_fn_insert' f X x P : x ∉ X → ([^o set] y ∈ {[ x ]} ∪ X, <[x:=P]> f y) ≡ (P `o` [^o set] y ∈ X, f y). Proof. apply (big_opS_fn_insert (λ y, id)). Qed. Lemma big_opS_union f X Y : X ## Y → ([^o set] y ∈ X ∪ Y, f y) ≡ ([^o set] y ∈ X, f y) `o` ([^o set] y ∈ Y, f y). Proof. intros. induction X as [|x X ? IH] using set_ind_L. { by rewrite left_id_L big_opS_empty left_id. } rewrite -assoc_L !big_opS_insert; [|set_solver..]. by rewrite -assoc IH; last set_solver. Qed. Lemma big_opS_delete f X x : x ∈ X → ([^o set] y ∈ X, f y) ≡ f x `o` [^o set] y ∈ X ∖ {[ x ]}, f y. Proof. intros. rewrite -big_opS_insert; last set_solver. by rewrite -union_difference_L; last set_solver. Qed. Lemma big_opS_singleton f x : ([^o set] y ∈ {[ x ]}, f y) ≡ f x. Proof. intros. by rewrite big_opS_elements elements_singleton /= right_id. Qed. Lemma big_opS_unit X : ([^o set] y ∈ X, monoid_unit) ≡ (monoid_unit : M). Proof. by induction X using set_ind_L; rewrite /= ?big_opS_insert ?left_id // big_opS_unseal. Qed. Lemma big_opS_filter' (φ : A → Prop) `{∀ x, Decision (φ x)} f X : ([^o set] y ∈ filter φ X, f y) ≡ ([^o set] y ∈ X, if decide (φ y) then f y else monoid_unit). Proof. induction X as [|x X ? IH] using set_ind_L. { by rewrite filter_empty_L !big_opS_empty. } destruct (decide (φ x)). - rewrite filter_union_L filter_singleton_L //. rewrite !big_opS_insert //; last set_solver. by rewrite decide_True // IH. - rewrite filter_union_L filter_singleton_not_L // left_id_L. by rewrite !big_opS_insert // decide_False // IH left_id. Qed. Lemma big_opS_op f g X : ([^o set] y ∈ X, f y `o` g y) ≡ ([^o set] y ∈ X, f y) `o` ([^o set] y ∈ X, g y). Proof. by rewrite !big_opS_elements -big_opL_op. Qed. Lemma big_opS_list_to_set f (l : list A) : NoDup l → ([^o set] x ∈ list_to_set l, f x) ≡ [^o list] x ∈ l, f x. Proof. induction 1 as [|x l ?? IHl]. - rewrite big_opS_empty //. - rewrite /= big_opS_union; last set_solver. by rewrite big_opS_singleton IHl. Qed. (** Shows that some property [P] is closed under [big_opS]. Examples of [P] are [Persistent], [Affine], [Timeless]. *) Lemma big_opS_closed (P : M → Prop) f X : Proper ((≡) ==> iff) P → P monoid_unit → (∀ x y, P x → P y → P (x `o` y)) → (∀ x, x ∈ X → P (f x)) → P ([^o set] x ∈ X, f x). Proof. intros ?? Hop Hf. induction X as [|x X ? IH] using set_ind_L. { by rewrite big_opS_empty. } rewrite big_opS_insert //. apply Hop. { apply Hf. set_solver. } apply IH=> x' ?. apply Hf. set_solver. Qed. End gset. Lemma big_opS_set_map `{Countable A, Countable B} (h : A → B) (X : gset A) (f : B → M) : Inj (=) (=) h → ([^o set] x ∈ set_map h X, f x) ≡ ([^o set] x ∈ X, f (h x)). Proof. intros Hinj. induction X as [|x X ? IH] using set_ind_L. { by rewrite set_map_empty !big_opS_empty. } rewrite set_map_union_L set_map_singleton_L. rewrite !big_opS_union; [|set_solver..]. rewrite !big_opS_singleton IH //. Qed. Lemma big_opM_dom `{Countable K} {A} (f : K → M) (m : gmap K A) : ([^o map] k↦_ ∈ m, f k) ≡ ([^o set] k ∈ dom m, f k). Proof. induction m as [|i x ?? IH] using map_ind. { by rewrite big_opM_unseal big_opS_unseal dom_empty_L. } by rewrite dom_insert_L big_opM_insert // IH big_opS_insert ?not_elem_of_dom. Qed. Lemma big_opM_gset_to_gmap `{Countable K} {A} (f : K → A → M) (X : gset K) c : ([^o map] k↦a ∈ gset_to_gmap c X, f k a) ≡ ([^o set] k ∈ X, f k c). Proof. rewrite -{2}(dom_gset_to_gmap X c) -big_opM_dom. apply big_opM_proper. by intros k ? [_ ->]%lookup_gset_to_gmap_Some. Qed. (** ** Big ops over finite msets *) Section gmultiset. Context `{Countable A}. Implicit Types X : gmultiset A. Implicit Types f : A → M. Lemma big_opMS_gen_proper R f g X : Reflexive R → Proper (R ==> R ==> R) o → (∀ x, x ∈ X → R (f x) (g x)) → R ([^o mset] x ∈ X, f x) ([^o mset] x ∈ X, g x). Proof. rewrite big_opMS_unseal. intros ?? Hf. apply (big_opL_gen_proper R); auto. intros k x ?%elem_of_list_lookup_2. by apply Hf, gmultiset_elem_of_elements. Qed. Lemma big_opMS_ext f g X : (∀ x, x ∈ X → f x = g x) → ([^o mset] x ∈ X, f x) = ([^o mset] x ∈ X, g x). Proof. apply big_opMS_gen_proper; apply _. Qed. (** The lemmas [big_opMS_ne] and [big_opMS_proper] are more generic than the instances as they also give [x ∈ X] in the premise. *) Lemma big_opMS_ne f g X n : (∀ x, x ∈ X → f x ≡{n}≡ g x) → ([^o mset] x ∈ X, f x) ≡{n}≡ ([^o mset] x ∈ X, g x). Proof. apply big_opMS_gen_proper; apply _. Qed. Lemma big_opMS_proper f g X : (∀ x, x ∈ X → f x ≡ g x) → ([^o mset] x ∈ X, f x) ≡ ([^o mset] x ∈ X, g x). Proof. apply big_opMS_gen_proper; apply _. Qed. Global Instance big_opMS_ne' n : Proper (pointwise_relation _ (dist n) ==> (=) ==> dist n) (big_opMS o (A:=A)). Proof. intros f g Hf m ? <-. apply big_opMS_ne; intros; apply Hf. Qed. Global Instance big_opMS_proper' : Proper (pointwise_relation _ (≡) ==> (=) ==> (≡)) (big_opMS o (A:=A)). Proof. intros f g Hf m ? <-. apply big_opMS_proper; intros; apply Hf. Qed. (* FIXME: This lemma could be generalized from [≡] to [=], but that breaks [setoid_rewrite] in the proof of [big_sepS_sepS]. See Coq issue #14349. *) Lemma big_opMS_elements f X : ([^o mset] x ∈ X, f x) ≡ [^o list] x ∈ elements X, f x. Proof. by rewrite big_opMS_unseal. Qed. Lemma big_opMS_empty f : ([^o mset] x ∈ ∅, f x) = monoid_unit. Proof. by rewrite big_opMS_unseal /big_opMS_def gmultiset_elements_empty. Qed. Lemma big_opMS_disj_union f X Y : ([^o mset] y ∈ X ⊎ Y, f y) ≡ ([^o mset] y ∈ X, f y) `o` [^o mset] y ∈ Y, f y. Proof. by rewrite big_opMS_unseal /big_opMS_def gmultiset_elements_disj_union big_opL_app. Qed. Lemma big_opMS_singleton f x : ([^o mset] y ∈ {[+ x +]}, f y) ≡ f x. Proof. intros. by rewrite big_opMS_unseal /big_opMS_def gmultiset_elements_singleton /= right_id. Qed. Lemma big_opMS_insert f X x : ([^o mset] y ∈ {[+ x +]} ⊎ X, f y) ≡ (f x `o` [^o mset] y ∈ X, f y). Proof. intros. rewrite big_opMS_disj_union big_opMS_singleton //. Qed. Lemma big_opMS_delete f X x : x ∈ X → ([^o mset] y ∈ X, f y) ≡ f x `o` [^o mset] y ∈ X ∖ {[+ x +]}, f y. Proof. intros. rewrite -big_opMS_singleton -big_opMS_disj_union. by rewrite -gmultiset_disj_union_difference'. Qed. Lemma big_opMS_unit X : ([^o mset] y ∈ X, monoid_unit) ≡ (monoid_unit : M). Proof. by induction X using gmultiset_ind; rewrite /= ?big_opMS_disj_union ?big_opMS_singleton ?left_id // big_opMS_unseal. Qed. Lemma big_opMS_op f g X : ([^o mset] y ∈ X, f y `o` g y) ≡ ([^o mset] y ∈ X, f y) `o` ([^o mset] y ∈ X, g y). Proof. by rewrite big_opMS_unseal /big_opMS_def -big_opL_op. Qed. (** Shows that some property [P] is closed under [big_opMS]. Examples of [P] are [Persistent], [Affine], [Timeless]. *) Lemma big_opMS_closed (P : M → Prop) f X : Proper ((≡) ==> iff) P → P monoid_unit → (∀ x y, P x → P y → P (x `o` y)) → (∀ x, x ∈ X → P (f x)) → P ([^o mset] x ∈ X, f x). Proof. intros ?? Hop Hf. induction X as [|x X IH] using gmultiset_ind. { by rewrite big_opMS_empty. } rewrite big_opMS_insert //. apply Hop. { apply Hf. set_solver. } apply IH=> x' ?. apply Hf. set_solver. Qed. End gmultiset. (** Commuting lemmas *) Lemma big_opL_opL {A B} (f : nat → A → nat → B → M) (l1 : list A) (l2 : list B) : ([^o list] k1↦x1 ∈ l1, [^o list] k2↦x2 ∈ l2, f k1 x1 k2 x2) ≡ ([^o list] k2↦x2 ∈ l2, [^o list] k1↦x1 ∈ l1, f k1 x1 k2 x2). Proof. revert f l2. induction l1 as [|x1 l1 IH]; simpl; intros Φ l2. { by rewrite big_opL_unit. } by rewrite IH big_opL_op. Qed. Lemma big_opL_opM {A} `{Countable K} {B} (f : nat → A → K → B → M) (l1 : list A) (m2 : gmap K B) : ([^o list] k1↦x1 ∈ l1, [^o map] k2↦x2 ∈ m2, f k1 x1 k2 x2) ≡ ([^o map] k2↦x2 ∈ m2, [^o list] k1↦x1 ∈ l1, f k1 x1 k2 x2). Proof. repeat setoid_rewrite big_opM_map_to_list. by rewrite big_opL_opL. Qed. Lemma big_opL_opS {A} `{Countable B} (f : nat → A → B → M) (l1 : list A) (X2 : gset B) : ([^o list] k1↦x1 ∈ l1, [^o set] x2 ∈ X2, f k1 x1 x2) ≡ ([^o set] x2 ∈ X2, [^o list] k1↦x1 ∈ l1, f k1 x1 x2). Proof. repeat setoid_rewrite big_opS_elements. by rewrite big_opL_opL. Qed. Lemma big_opL_opMS {A} `{Countable B} (f : nat → A → B → M) (l1 : list A) (X2 : gmultiset B) : ([^o list] k1↦x1 ∈ l1, [^o mset] x2 ∈ X2, f k1 x1 x2) ≡ ([^o mset] x2 ∈ X2, [^o list] k1↦x1 ∈ l1, f k1 x1 x2). Proof. repeat setoid_rewrite big_opMS_elements. by rewrite big_opL_opL. Qed. Lemma big_opM_opL {A} `{Countable K} {B} (f : K → A → nat → B → M) (m1 : gmap K A) (l2 : list B) : ([^o map] k1↦x1 ∈ m1, [^o list] k2↦x2 ∈ l2, f k1 x1 k2 x2) ≡ ([^o list] k2↦x2 ∈ l2, [^o map] k1↦x1 ∈ m1, f k1 x1 k2 x2). Proof. symmetry. apply big_opL_opM. Qed. Lemma big_opM_opM `{Countable K1} {A} `{Countable K2} {B} (f : K1 → A → K2 → B → M) (m1 : gmap K1 A) (m2 : gmap K2 B) : ([^o map] k1↦x1 ∈ m1, [^o map] k2↦x2 ∈ m2, f k1 x1 k2 x2) ≡ ([^o map] k2↦x2 ∈ m2, [^o map] k1↦x1 ∈ m1, f k1 x1 k2 x2). Proof. repeat setoid_rewrite big_opM_map_to_list. by rewrite big_opL_opL. Qed. Lemma big_opM_opS `{Countable K} {A} `{Countable B} (f : K → A → B → M) (m1 : gmap K A) (X2 : gset B) : ([^o map] k1↦x1 ∈ m1, [^o set] x2 ∈ X2, f k1 x1 x2) ≡ ([^o set] x2 ∈ X2, [^o map] k1↦x1 ∈ m1, f k1 x1 x2). Proof. repeat setoid_rewrite big_opM_map_to_list. repeat setoid_rewrite big_opS_elements. by rewrite big_opL_opL. Qed. Lemma big_opM_opMS `{Countable K} {A} `{Countable B} (f : K → A → B → M) (m1 : gmap K A) (X2 : gmultiset B) : ([^o map] k1↦x1 ∈ m1, [^o mset] x2 ∈ X2, f k1 x1 x2) ≡ ([^o mset] x2 ∈ X2, [^o map] k1↦x1 ∈ m1, f k1 x1 x2). Proof. repeat setoid_rewrite big_opM_map_to_list. repeat setoid_rewrite big_opMS_elements. by rewrite big_opL_opL. Qed. Lemma big_opS_opL `{Countable A} {B} (f : A → nat → B → M) (X1 : gset A) (l2 : list B) : ([^o set] x1 ∈ X1, [^o list] k2↦x2 ∈ l2, f x1 k2 x2) ≡ ([^o list] k2↦x2 ∈ l2, [^o set] x1 ∈ X1, f x1 k2 x2). Proof. symmetry. apply big_opL_opS. Qed. Lemma big_opS_opM `{Countable A} `{Countable K} {B} (f : A → K → B → M) (X1 : gset A) (m2 : gmap K B) : ([^o set] x1 ∈ X1, [^o map] k2↦x2 ∈ m2, f x1 k2 x2) ≡ ([^o map] k2↦x2 ∈ m2, [^o set] x1 ∈ X1, f x1 k2 x2). Proof. symmetry. apply big_opM_opS. Qed. Lemma big_opS_opS `{Countable A, Countable B} (X : gset A) (Y : gset B) (f : A → B → M) : ([^o set] x ∈ X, [^o set] y ∈ Y, f x y) ≡ ([^o set] y ∈ Y, [^o set] x ∈ X, f x y). Proof. repeat setoid_rewrite big_opS_elements. by rewrite big_opL_opL. Qed. Lemma big_opS_opMS `{Countable A, Countable B} (X : gset A) (Y : gmultiset B) (f : A → B → M) : ([^o set] x ∈ X, [^o mset] y ∈ Y, f x y) ≡ ([^o mset] y ∈ Y, [^o set] x ∈ X, f x y). Proof. repeat setoid_rewrite big_opS_elements. repeat setoid_rewrite big_opMS_elements. by rewrite big_opL_opL. Qed. Lemma big_opMS_opL `{Countable A} {B} (f : A → nat → B → M) (X1 : gmultiset A) (l2 : list B) : ([^o mset] x1 ∈ X1, [^o list] k2↦x2 ∈ l2, f x1 k2 x2) ≡ ([^o list] k2↦x2 ∈ l2, [^o mset] x1 ∈ X1, f x1 k2 x2). Proof. symmetry. apply big_opL_opMS. Qed. Lemma big_opMS_opM `{Countable A} `{Countable K} {B} (f : A → K → B → M) (X1 : gmultiset A) (m2 : gmap K B) : ([^o mset] x1 ∈ X1, [^o map] k2↦x2 ∈ m2, f x1 k2 x2) ≡ ([^o map] k2↦x2 ∈ m2, [^o mset] x1 ∈ X1, f x1 k2 x2). Proof. symmetry. apply big_opM_opMS. Qed. Lemma big_opMS_opS `{Countable A, Countable B} (X : gmultiset A) (Y : gset B) (f : A → B → M) : ([^o mset] x ∈ X, [^o set] y ∈ Y, f x y) ≡ ([^o set] y ∈ Y, [^o mset] x ∈ X, f x y). Proof. symmetry. apply big_opS_opMS. Qed. Lemma big_opMS_opMS `{Countable A, Countable B} (X : gmultiset A) (Y : gmultiset B) (f : A → B → M) : ([^o mset] x ∈ X, [^o mset] y ∈ Y, f x y) ≡ ([^o mset] y ∈ Y, [^o mset] x ∈ X, f x y). Proof. repeat setoid_rewrite big_opMS_elements. by rewrite big_opL_opL. Qed. End big_op. Section homomorphisms. Context {M1 M2 : ofe} {o1 : M1 → M1 → M1} {o2 : M2 → M2 → M2} `{!Monoid o1, !Monoid o2}. Infix "`o1`" := o1 (at level 50, left associativity). Infix "`o2`" := o2 (at level 50, left associativity). (** The ssreflect rewrite tactic only works for relations that have a [RewriteRelation] instance. For the purpose of this section, we want to rewrite with arbitrary relations, so we declare any relation to be a [RewriteRelation]. *) Local Instance: ∀ {A} (R : relation A), RewriteRelation R := {}. Lemma big_opL_commute {A} (h : M1 → M2) `{!MonoidHomomorphism o1 o2 R h} (f : nat → A → M1) l : R (h ([^o1 list] k↦x ∈ l, f k x)) ([^o2 list] k↦x ∈ l, h (f k x)). Proof. revert f. induction l as [|x l IH]=> f /=. - apply monoid_homomorphism_unit. - by rewrite monoid_homomorphism IH. Qed. Lemma big_opL_commute1 {A} (h : M1 → M2) `{!WeakMonoidHomomorphism o1 o2 R h} (f : nat → A → M1) l : l ≠ [] → R (h ([^o1 list] k↦x ∈ l, f k x)) ([^o2 list] k↦x ∈ l, h (f k x)). Proof. intros ?. revert f. induction l as [|x [|x' l'] IH]=> f //. - by rewrite !big_opL_singleton. - by rewrite !(big_opL_cons _ x) monoid_homomorphism IH. Qed. Lemma big_opM_commute `{Countable K} {A} (h : M1 → M2) `{!MonoidHomomorphism o1 o2 R h} (f : K → A → M1) m : R (h ([^o1 map] k↦x ∈ m, f k x)) ([^o2 map] k↦x ∈ m, h (f k x)). Proof. intros. induction m as [|i x m ? IH] using map_ind. - by rewrite !big_opM_empty monoid_homomorphism_unit. - by rewrite !big_opM_insert // monoid_homomorphism -IH. Qed. Lemma big_opM_commute1 `{Countable K} {A} (h : M1 → M2) `{!WeakMonoidHomomorphism o1 o2 R h} (f : K → A → M1) m : m ≠ ∅ → R (h ([^o1 map] k↦x ∈ m, f k x)) ([^o2 map] k↦x ∈ m, h (f k x)). Proof. intros. induction m as [|i x m ? IH] using map_ind; [done|]. destruct (decide (m = ∅)) as [->|]. - by rewrite !big_opM_insert // !big_opM_empty !right_id. - by rewrite !big_opM_insert // monoid_homomorphism -IH //. Qed. Lemma big_opS_commute `{Countable A} (h : M1 → M2) `{!MonoidHomomorphism o1 o2 R h} (f : A → M1) X : R (h ([^o1 set] x ∈ X, f x)) ([^o2 set] x ∈ X, h (f x)). Proof. intros. induction X as [|x X ? IH] using set_ind_L. - by rewrite !big_opS_empty monoid_homomorphism_unit. - by rewrite !big_opS_insert // monoid_homomorphism -IH. Qed. Lemma big_opS_commute1 `{Countable A} (h : M1 → M2) `{!WeakMonoidHomomorphism o1 o2 R h} (f : A → M1) X : X ≠ ∅ → R (h ([^o1 set] x ∈ X, f x)) ([^o2 set] x ∈ X, h (f x)). Proof. intros. induction X as [|x X ? IH] using set_ind_L; [done|]. destruct (decide (X = ∅)) as [->|]. - by rewrite !big_opS_insert // !big_opS_empty !right_id. - by rewrite !big_opS_insert // monoid_homomorphism -IH //. Qed. Lemma big_opMS_commute `{Countable A} (h : M1 → M2) `{!MonoidHomomorphism o1 o2 R h} (f : A → M1) X : R (h ([^o1 mset] x ∈ X, f x)) ([^o2 mset] x ∈ X, h (f x)). Proof. intros. induction X as [|x X IH] using gmultiset_ind. - by rewrite !big_opMS_empty monoid_homomorphism_unit. - by rewrite !big_opMS_disj_union !big_opMS_singleton monoid_homomorphism -IH. Qed. Lemma big_opMS_commute1 `{Countable A} (h : M1 → M2) `{!WeakMonoidHomomorphism o1 o2 R h} (f : A → M1) X : X ≠ ∅ → R (h ([^o1 mset] x ∈ X, f x)) ([^o2 mset] x ∈ X, h (f x)). Proof. intros. induction X as [|x X IH] using gmultiset_ind; [done|]. destruct (decide (X = ∅)) as [->|]. - by rewrite !big_opMS_disj_union !big_opMS_singleton !big_opMS_empty !right_id. - by rewrite !big_opMS_disj_union !big_opMS_singleton monoid_homomorphism -IH //. Qed. Context `{!LeibnizEquiv M2}. Lemma big_opL_commute_L {A} (h : M1 → M2) `{!MonoidHomomorphism o1 o2 (≡) h} (f : nat → A → M1) l : h ([^o1 list] k↦x ∈ l, f k x) = ([^o2 list] k↦x ∈ l, h (f k x)). Proof using Type*. unfold_leibniz. by apply big_opL_commute. Qed. Lemma big_opL_commute1_L {A} (h : M1 → M2) `{!WeakMonoidHomomorphism o1 o2 (≡) h} (f : nat → A → M1) l : l ≠ [] → h ([^o1 list] k↦x ∈ l, f k x) = ([^o2 list] k↦x ∈ l, h (f k x)). Proof using Type*. unfold_leibniz. by apply big_opL_commute1. Qed. Lemma big_opM_commute_L `{Countable K} {A} (h : M1 → M2) `{!MonoidHomomorphism o1 o2 (≡) h} (f : K → A → M1) m : h ([^o1 map] k↦x ∈ m, f k x) = ([^o2 map] k↦x ∈ m, h (f k x)). Proof using Type*. unfold_leibniz. by apply big_opM_commute. Qed. Lemma big_opM_commute1_L `{Countable K} {A} (h : M1 → M2) `{!WeakMonoidHomomorphism o1 o2 (≡) h} (f : K → A → M1) m : m ≠ ∅ → h ([^o1 map] k↦x ∈ m, f k x) = ([^o2 map] k↦x ∈ m, h (f k x)). Proof using Type*. unfold_leibniz. by apply big_opM_commute1. Qed. Lemma big_opS_commute_L `{Countable A} (h : M1 → M2) `{!MonoidHomomorphism o1 o2 (≡) h} (f : A → M1) X : h ([^o1 set] x ∈ X, f x) = ([^o2 set] x ∈ X, h (f x)). Proof using Type*. unfold_leibniz. by apply big_opS_commute. Qed. Lemma big_opS_commute1_L `{ Countable A} (h : M1 → M2) `{!WeakMonoidHomomorphism o1 o2 (≡) h} (f : A → M1) X : X ≠ ∅ → h ([^o1 set] x ∈ X, f x) = ([^o2 set] x ∈ X, h (f x)). Proof using Type*. intros. rewrite <-leibniz_equiv_iff. by apply big_opS_commute1. Qed. Lemma big_opMS_commute_L `{Countable A} (h : M1 → M2) `{!MonoidHomomorphism o1 o2 (≡) h} (f : A → M1) X : h ([^o1 mset] x ∈ X, f x) = ([^o2 mset] x ∈ X, h (f x)). Proof using Type*. unfold_leibniz. by apply big_opMS_commute. Qed. Lemma big_opMS_commute1_L `{Countable A} (h : M1 → M2) `{!WeakMonoidHomomorphism o1 o2 (≡) h} (f : A → M1) X : X ≠ ∅ → h ([^o1 mset] x ∈ X, f x) = ([^o2 mset] x ∈ X, h (f x)). Proof using Type*. intros. rewrite <-leibniz_equiv_iff. by apply big_opMS_commute1. Qed. End homomorphisms. iris-iris-4.2.0/iris/algebra/cmra.v000066400000000000000000002541531460620107300171140ustar00rootroot00000000000000From stdpp Require Import finite. From iris.algebra Require Export ofe monoid. From iris.prelude Require Import options. Local Set Primitive Projections. Class PCore (A : Type) := pcore : A → option A. Global Hint Mode PCore ! : typeclass_instances. Global Instance: Params (@pcore) 2 := {}. Class Op (A : Type) := op : A → A → A. Global Hint Mode Op ! : typeclass_instances. Global Instance: Params (@op) 2 := {}. Infix "⋅" := op (at level 50, left associativity) : stdpp_scope. Notation "(⋅)" := op (only parsing) : stdpp_scope. (* The inclusion quantifies over [A], not [option A]. This means we do not get reflexivity. However, if we used [option A], the following would no longer hold: x ≼ y ↔ x.1 ≼ y.1 ∧ x.2 ≼ y.2 If you need the reflexive closure of the inclusion relation, you can use [Some a ≼ Some b]. There are various [Some_included] lemmas that help deal with propositions of this shape. *) Definition included {A} `{!Equiv A, !Op A} (x y : A) := ∃ z, y ≡ x ⋅ z. Infix "≼" := included (at level 70) : stdpp_scope. Notation "(≼)" := included (only parsing) : stdpp_scope. Global Hint Extern 0 (_ ≼ _) => reflexivity : core. Global Instance: Params (@included) 3 := {}. (** [opM] is used in some lemma statements where [A] has not yet been shown to be a CMRA, so we define it directly in terms of [Op]. *) Definition opM `{!Op A} (x : A) (my : option A) := match my with Some y => x ⋅ y | None => x end. Infix "⋅?" := opM (at level 50, left associativity) : stdpp_scope. Class ValidN (A : Type) := validN : nat → A → Prop. Global Hint Mode ValidN ! : typeclass_instances. Global Instance: Params (@validN) 3 := {}. Notation "✓{ n } x" := (validN n x) (at level 20, n at next level, format "✓{ n } x"). Class Valid (A : Type) := valid : A → Prop. Global Hint Mode Valid ! : typeclass_instances. Global Instance: Params (@valid) 2 := {}. Notation "✓ x" := (valid x) (at level 20) : stdpp_scope. Definition includedN `{!Dist A, !Op A} (n : nat) (x y : A) := ∃ z, y ≡{n}≡ x ⋅ z. Notation "x ≼{ n } y" := (includedN n x y) (at level 70, n at next level, format "x ≼{ n } y") : stdpp_scope. Global Instance: Params (@includedN) 4 := {}. Global Hint Extern 0 (_ ≼{_} _) => reflexivity : core. Section mixin. Record CmraMixin A `{!Dist A, !Equiv A, !PCore A, !Op A, !Valid A, !ValidN A} := { (* setoids *) mixin_cmra_op_ne (x : A) : NonExpansive (op x); mixin_cmra_pcore_ne n (x y : A) cx : x ≡{n}≡ y → pcore x = Some cx → ∃ cy, pcore y = Some cy ∧ cx ≡{n}≡ cy; mixin_cmra_validN_ne n : Proper (dist (A := A) n ==> impl) (validN n); (* valid *) mixin_cmra_valid_validN (x : A) : ✓ x ↔ ∀ n, ✓{n} x; mixin_cmra_validN_S n (x : A) : ✓{S n} x → ✓{n} x; (* monoid *) mixin_cmra_assoc : Assoc (≡@{A}) (⋅); mixin_cmra_comm : Comm (≡@{A}) (⋅); mixin_cmra_pcore_l (x : A) cx : pcore x = Some cx → cx ⋅ x ≡ x; mixin_cmra_pcore_idemp (x : A) cx : pcore x = Some cx → pcore cx ≡ Some cx; mixin_cmra_pcore_mono (x y : A) cx : x ≼ y → pcore x = Some cx → ∃ cy, pcore y = Some cy ∧ cx ≼ cy; mixin_cmra_validN_op_l n (x y : A) : ✓{n} (x ⋅ y) → ✓{n} x; mixin_cmra_extend n (x y1 y2 : A) : ✓{n} x → x ≡{n}≡ y1 ⋅ y2 → { z1 : A & { z2 | x ≡ z1 ⋅ z2 ∧ z1 ≡{n}≡ y1 ∧ z2 ≡{n}≡ y2 } } }. End mixin. (** Bundled version *) #[projections(primitive=no)] (* FIXME: making this primitive leads to strange TC resolution failures in view.v *) Structure cmra := Cmra' { cmra_car :> Type; cmra_equiv : Equiv cmra_car; cmra_dist : Dist cmra_car; cmra_pcore : PCore cmra_car; cmra_op : Op cmra_car; cmra_valid : Valid cmra_car; cmra_validN : ValidN cmra_car; cmra_ofe_mixin : OfeMixin cmra_car; cmra_mixin : CmraMixin cmra_car; }. Global Arguments Cmra' _ {_ _ _ _ _ _} _ _. (* Given [m : CmraMixin A], the notation [Cmra A m] provides a smart constructor, which uses [ofe_mixin_of A] to infer the canonical OFE mixin of the type [A], so that it does not have to be given manually. *) Notation Cmra A m := (Cmra' A (ofe_mixin_of A%type) m) (only parsing). Global Arguments cmra_car : simpl never. Global Arguments cmra_equiv : simpl never. Global Arguments cmra_dist : simpl never. Global Arguments cmra_pcore : simpl never. Global Arguments cmra_op : simpl never. Global Arguments cmra_valid : simpl never. Global Arguments cmra_validN : simpl never. Global Arguments cmra_ofe_mixin : simpl never. Global Arguments cmra_mixin : simpl never. Add Printing Constructor cmra. (* FIXME(Coq #6294) : we need the new unification algorithm here. *) Global Hint Extern 0 (PCore _) => refine (cmra_pcore _); shelve : typeclass_instances. Global Hint Extern 0 (Op _) => refine (cmra_op _); shelve : typeclass_instances. Global Hint Extern 0 (Valid _) => refine (cmra_valid _); shelve : typeclass_instances. Global Hint Extern 0 (ValidN _) => refine (cmra_validN _); shelve : typeclass_instances. Coercion cmra_ofeO (A : cmra) : ofe := Ofe A (cmra_ofe_mixin A). Canonical Structure cmra_ofeO. (** As explained more thoroughly in iris#539, Coq can run into trouble when [cmra] combinators (such as [optionUR]) are stacked and combined with coercions like [cmra_ofeO]. To partially address this, we give Coq's type-checker some directions for unfolding, with the Strategy command. For these structures, we instruct Coq to eagerly _expand_ all projections, except for the coercion to type (in this case, [cmra_car]), since that causes problem with canonical structure inference. Additionally, we make Coq eagerly expand the coercions that go from one structure to another, like [cmra_ofeO] in this case. *) Global Strategy expand [cmra_ofeO cmra_equiv cmra_dist cmra_pcore cmra_op cmra_valid cmra_validN cmra_ofe_mixin cmra_mixin]. Definition cmra_mixin_of' A {Ac : cmra} (f : Ac → A) : CmraMixin Ac := cmra_mixin Ac. Notation cmra_mixin_of A := ltac:(let H := eval hnf in (cmra_mixin_of' A id) in exact H) (only parsing). (** Lifting properties from the mixin *) Section cmra_mixin. Context {A : cmra}. Implicit Types x y : A. Global Instance cmra_op_ne (x : A) : NonExpansive (op x). Proof. apply (mixin_cmra_op_ne _ (cmra_mixin A)). Qed. Lemma cmra_pcore_ne n x y cx : x ≡{n}≡ y → pcore x = Some cx → ∃ cy, pcore y = Some cy ∧ cx ≡{n}≡ cy. Proof. apply (mixin_cmra_pcore_ne _ (cmra_mixin A)). Qed. Global Instance cmra_validN_ne n : Proper (dist n ==> impl) (@validN A _ n). Proof. apply (mixin_cmra_validN_ne _ (cmra_mixin A)). Qed. Lemma cmra_valid_validN x : ✓ x ↔ ∀ n, ✓{n} x. Proof. apply (mixin_cmra_valid_validN _ (cmra_mixin A)). Qed. Lemma cmra_validN_S n x : ✓{S n} x → ✓{n} x. Proof. apply (mixin_cmra_validN_S _ (cmra_mixin A)). Qed. Global Instance cmra_assoc : Assoc (≡) (@op A _). Proof. apply (mixin_cmra_assoc _ (cmra_mixin A)). Qed. Global Instance cmra_comm : Comm (≡) (@op A _). Proof. apply (mixin_cmra_comm _ (cmra_mixin A)). Qed. Lemma cmra_pcore_l x cx : pcore x = Some cx → cx ⋅ x ≡ x. Proof. apply (mixin_cmra_pcore_l _ (cmra_mixin A)). Qed. Lemma cmra_pcore_idemp x cx : pcore x = Some cx → pcore cx ≡ Some cx. Proof. apply (mixin_cmra_pcore_idemp _ (cmra_mixin A)). Qed. Lemma cmra_pcore_mono x y cx : x ≼ y → pcore x = Some cx → ∃ cy, pcore y = Some cy ∧ cx ≼ cy. Proof. apply (mixin_cmra_pcore_mono _ (cmra_mixin A)). Qed. Lemma cmra_validN_op_l n x y : ✓{n} (x ⋅ y) → ✓{n} x. Proof. apply (mixin_cmra_validN_op_l _ (cmra_mixin A)). Qed. Lemma cmra_extend n x y1 y2 : ✓{n} x → x ≡{n}≡ y1 ⋅ y2 → { z1 : A & { z2 | x ≡ z1 ⋅ z2 ∧ z1 ≡{n}≡ y1 ∧ z2 ≡{n}≡ y2 } }. Proof. apply (mixin_cmra_extend _ (cmra_mixin A)). Qed. End cmra_mixin. (** * CoreId elements *) Class CoreId {A : cmra} (x : A) := core_id : pcore x ≡ Some x. Global Arguments core_id {_} _ {_}. Global Hint Mode CoreId + ! : typeclass_instances. Global Instance: Params (@CoreId) 1 := {}. (** * Exclusive elements (i.e., elements that cannot have a frame). *) Class Exclusive {A : cmra} (x : A) := exclusive0_l y : ✓{0} (x ⋅ y) → False. Global Arguments exclusive0_l {_} _ {_} _ _. Global Hint Mode Exclusive + ! : typeclass_instances. Global Instance: Params (@Exclusive) 1 := {}. (** * Cancelable elements. *) Class Cancelable {A : cmra} (x : A) := cancelableN n y z : ✓{n}(x ⋅ y) → x ⋅ y ≡{n}≡ x ⋅ z → y ≡{n}≡ z. Global Arguments cancelableN {_} _ {_} _ _ _ _. Global Hint Mode Cancelable + ! : typeclass_instances. Global Instance: Params (@Cancelable) 1 := {}. (** * Identity-free elements. *) Class IdFree {A : cmra} (x : A) := id_free0_r y : ✓{0}x → x ⋅ y ≡{0}≡ x → False. Global Arguments id_free0_r {_} _ {_} _ _. Global Hint Mode IdFree + ! : typeclass_instances. Global Instance: Params (@IdFree) 1 := {}. (** * CMRAs whose core is total *) Class CmraTotal (A : cmra) := cmra_total (x : A) : is_Some (pcore x). Global Hint Mode CmraTotal ! : typeclass_instances. (** The function [core] returns a dummy when used on CMRAs without total core. We only ever use this for [CmraTotal] CMRAs, but it is more convenient to not require that proof to be able to call this function. *) Definition core {A} `{!PCore A} (x : A) : A := default x (pcore x). Global Instance: Params (@core) 2 := {}. (** * CMRAs with a unit element *) Class Unit (A : Type) := ε : A. Global Hint Mode Unit ! : typeclass_instances. Global Arguments ε {_ _}. Record UcmraMixin A `{!Dist A, !Equiv A, !PCore A, !Op A, !Valid A, !Unit A} := { mixin_ucmra_unit_valid : ✓ (ε : A); mixin_ucmra_unit_left_id : LeftId (≡@{A}) ε (⋅); mixin_ucmra_pcore_unit : pcore ε ≡@{option A} Some ε }. #[projections(primitive=no)] (* FIXME: making this primitive leads to strange TC resolution failures in view.v *) Structure ucmra := Ucmra' { ucmra_car :> Type; ucmra_equiv : Equiv ucmra_car; ucmra_dist : Dist ucmra_car; ucmra_pcore : PCore ucmra_car; ucmra_op : Op ucmra_car; ucmra_valid : Valid ucmra_car; ucmra_validN : ValidN ucmra_car; ucmra_unit : Unit ucmra_car; ucmra_ofe_mixin : OfeMixin ucmra_car; ucmra_cmra_mixin : CmraMixin ucmra_car; ucmra_mixin : UcmraMixin ucmra_car; }. Global Arguments Ucmra' _ {_ _ _ _ _ _ _} _ _ _. Notation Ucmra A m := (Ucmra' A (ofe_mixin_of A%type) (cmra_mixin_of A%type) m) (only parsing). Global Arguments ucmra_car : simpl never. Global Arguments ucmra_equiv : simpl never. Global Arguments ucmra_dist : simpl never. Global Arguments ucmra_pcore : simpl never. Global Arguments ucmra_op : simpl never. Global Arguments ucmra_valid : simpl never. Global Arguments ucmra_validN : simpl never. Global Arguments ucmra_ofe_mixin : simpl never. Global Arguments ucmra_cmra_mixin : simpl never. Global Arguments ucmra_mixin : simpl never. Add Printing Constructor ucmra. (* FIXME(Coq #6294) : we need the new unification algorithm here. *) Global Hint Extern 0 (Unit _) => refine (ucmra_unit _); shelve : typeclass_instances. Coercion ucmra_ofeO (A : ucmra) : ofe := Ofe A (ucmra_ofe_mixin A). Canonical Structure ucmra_ofeO. Coercion ucmra_cmraR (A : ucmra) : cmra := Cmra' A (ucmra_ofe_mixin A) (ucmra_cmra_mixin A). Canonical Structure ucmra_cmraR. (** As for CMRAs above, we instruct Coq to eagerly _expand_ all projections, except for the coercion to type (in this case, [ucmra_car]), since that causes problem with canonical structure inference. Additionally, we make Coq eagerly expand the coercions that go from one structure to another, like [ucmra_cmraR] and [ucmra_ofeO] in this case. *) Global Strategy expand [ucmra_cmraR ucmra_ofeO ucmra_equiv ucmra_dist ucmra_pcore ucmra_op ucmra_valid ucmra_validN ucmra_unit ucmra_ofe_mixin ucmra_cmra_mixin]. (** Lifting properties from the mixin *) Section ucmra_mixin. Context {A : ucmra}. Implicit Types x y : A. Lemma ucmra_unit_valid : ✓ (ε : A). Proof. apply (mixin_ucmra_unit_valid _ (ucmra_mixin A)). Qed. Global Instance ucmra_unit_left_id : LeftId (≡) ε (@op A _). Proof. apply (mixin_ucmra_unit_left_id _ (ucmra_mixin A)). Qed. Lemma ucmra_pcore_unit : pcore (ε:A) ≡ Some ε. Proof. apply (mixin_ucmra_pcore_unit _ (ucmra_mixin A)). Qed. End ucmra_mixin. (** * Discrete CMRAs *) #[projections(primitive=no)] (* FIXME: making this primitive means we cannot use the projections with eauto any more (see https://github.com/coq/coq/issues/17561) *) Class CmraDiscrete (A : cmra) := { #[global] cmra_discrete_ofe_discrete :: OfeDiscrete A; cmra_discrete_valid (x : A) : ✓{0} x → ✓ x }. Global Hint Mode CmraDiscrete ! : typeclass_instances. (** * Morphisms *) Class CmraMorphism {A B : cmra} (f : A → B) := { #[global] cmra_morphism_ne :: NonExpansive f; cmra_morphism_validN n x : ✓{n} x → ✓{n} f x; cmra_morphism_pcore x : f <$> pcore x ≡ pcore (f x); cmra_morphism_op x y : f (x ⋅ y) ≡ f x ⋅ f y }. Global Hint Mode CmraMorphism - - ! : typeclass_instances. Global Arguments cmra_morphism_validN {_ _} _ {_} _ _ _. Global Arguments cmra_morphism_pcore {_ _} _ {_} _. Global Arguments cmra_morphism_op {_ _} _ {_} _ _. (** * Properties **) Section cmra. Context {A : cmra}. Implicit Types x y z : A. Implicit Types xs ys zs : list A. (** ** Setoids *) Global Instance cmra_pcore_ne' : NonExpansive (@pcore A _). Proof. intros n x y Hxy. destruct (pcore x) as [cx|] eqn:?. { destruct (cmra_pcore_ne n x y cx) as (cy&->&->); auto. } destruct (pcore y) as [cy|] eqn:?; auto. destruct (cmra_pcore_ne n y x cy) as (cx&?&->); simplify_eq/=; auto. Qed. Lemma cmra_pcore_proper x y cx : x ≡ y → pcore x = Some cx → ∃ cy, pcore y = Some cy ∧ cx ≡ cy. Proof. intros. destruct (cmra_pcore_ne 0 x y cx) as (cy&?&?); auto. exists cy; split; [done|apply equiv_dist=> n]. destruct (cmra_pcore_ne n x y cx) as (cy'&?&?); naive_solver. Qed. Global Instance cmra_pcore_proper' : Proper ((≡) ==> (≡)) (@pcore A _). Proof. apply (ne_proper _). Qed. Global Instance cmra_op_ne' : NonExpansive2 (@op A _). Proof. intros n x1 x2 Hx y1 y2 Hy. by rewrite Hy (comm _ x1) Hx (comm _ y2). Qed. Global Instance cmra_op_proper' : Proper ((≡) ==> (≡) ==> (≡)) (@op A _). Proof. apply (ne_proper_2 _). Qed. Global Instance cmra_validN_ne' n : Proper (dist n ==> iff) (@validN A _ n) | 1. Proof. by split; apply cmra_validN_ne. Qed. Global Instance cmra_validN_proper n : Proper ((≡) ==> iff) (@validN A _ n) | 1. Proof. by intros x1 x2 Hx; apply cmra_validN_ne', equiv_dist. Qed. Global Instance cmra_valid_proper : Proper ((≡) ==> iff) (@valid A _). Proof. intros x y Hxy; rewrite !cmra_valid_validN. by split=> ? n; [rewrite -Hxy|rewrite Hxy]. Qed. Global Instance cmra_includedN_ne n : Proper (dist n ==> dist n ==> iff) (@includedN A _ _ n) | 1. Proof. intros x x' Hx y y' Hy. by split; intros [z ?]; exists z; [rewrite -Hx -Hy|rewrite Hx Hy]. Qed. Global Instance cmra_includedN_proper n : Proper ((≡) ==> (≡) ==> iff) (@includedN A _ _ n) | 1. Proof. intros x x' Hx y y' Hy; revert Hx Hy; rewrite !equiv_dist=> Hx Hy. by rewrite (Hx n) (Hy n). Qed. Global Instance cmra_included_proper : Proper ((≡) ==> (≡) ==> iff) (@included A _ _) | 1. Proof. intros x x' Hx y y' Hy. by split; intros [z ?]; exists z; [rewrite -Hx -Hy|rewrite Hx Hy]. Qed. Global Instance cmra_opM_ne : NonExpansive2 (@opM A _). Proof. destruct 2; by ofe_subst. Qed. Global Instance cmra_opM_proper : Proper ((≡) ==> (≡) ==> (≡)) (@opM A _). Proof. destruct 2; by setoid_subst. Qed. Global Instance CoreId_proper : Proper ((≡) ==> iff) (@CoreId A). Proof. solve_proper. Qed. Global Instance Exclusive_proper : Proper ((≡) ==> iff) (@Exclusive A). Proof. intros x y Hxy. rewrite /Exclusive. by setoid_rewrite Hxy. Qed. Global Instance Cancelable_proper : Proper ((≡) ==> iff) (@Cancelable A). Proof. intros x y Hxy. rewrite /Cancelable. by setoid_rewrite Hxy. Qed. Global Instance IdFree_proper : Proper ((≡) ==> iff) (@IdFree A). Proof. intros x y Hxy. rewrite /IdFree. by setoid_rewrite Hxy. Qed. (** ** Op *) Lemma cmra_op_opM_assoc x y mz : (x ⋅ y) ⋅? mz ≡ x ⋅ (y ⋅? mz). Proof. destruct mz; by rewrite /= -?assoc. Qed. (** ** Validity *) Lemma cmra_validN_le n n' x : ✓{n} x → n' ≤ n → ✓{n'} x. Proof. induction 2; eauto using cmra_validN_S. Qed. Lemma cmra_valid_op_l x y : ✓ (x ⋅ y) → ✓ x. Proof. rewrite !cmra_valid_validN; eauto using cmra_validN_op_l. Qed. Lemma cmra_validN_op_r n x y : ✓{n} (x ⋅ y) → ✓{n} y. Proof. rewrite (comm _ x); apply cmra_validN_op_l. Qed. Lemma cmra_valid_op_r x y : ✓ (x ⋅ y) → ✓ y. Proof. rewrite !cmra_valid_validN; eauto using cmra_validN_op_r. Qed. (** ** Core *) Lemma cmra_pcore_l' x cx : pcore x ≡ Some cx → cx ⋅ x ≡ x. Proof. intros (cx'&?&<-)%Some_equiv_eq. by apply cmra_pcore_l. Qed. Lemma cmra_pcore_r x cx : pcore x = Some cx → x ⋅ cx ≡ x. Proof. intros. rewrite comm. by apply cmra_pcore_l. Qed. Lemma cmra_pcore_r' x cx : pcore x ≡ Some cx → x ⋅ cx ≡ x. Proof. intros (cx'&?&<-)%Some_equiv_eq. by apply cmra_pcore_r. Qed. Lemma cmra_pcore_idemp' x cx : pcore x ≡ Some cx → pcore cx ≡ Some cx. Proof. intros (cx'&?&<-)%Some_equiv_eq. eauto using cmra_pcore_idemp. Qed. Lemma cmra_pcore_dup x cx : pcore x = Some cx → cx ≡ cx ⋅ cx. Proof. intros; symmetry; eauto using cmra_pcore_r', cmra_pcore_idemp. Qed. Lemma cmra_pcore_dup' x cx : pcore x ≡ Some cx → cx ≡ cx ⋅ cx. Proof. intros; symmetry; eauto using cmra_pcore_r', cmra_pcore_idemp'. Qed. Lemma cmra_pcore_validN n x cx : ✓{n} x → pcore x = Some cx → ✓{n} cx. Proof. intros Hvx Hx%cmra_pcore_l. move: Hvx; rewrite -Hx. apply cmra_validN_op_l. Qed. Lemma cmra_pcore_valid x cx : ✓ x → pcore x = Some cx → ✓ cx. Proof. intros Hv Hx%cmra_pcore_l. move: Hv; rewrite -Hx. apply cmra_valid_op_l. Qed. (** ** Exclusive elements *) Lemma exclusiveN_l n x `{!Exclusive x} y : ✓{n} (x ⋅ y) → False. Proof. intros. eapply (exclusive0_l x y), cmra_validN_le; eauto with lia. Qed. Lemma exclusiveN_r n x `{!Exclusive x} y : ✓{n} (y ⋅ x) → False. Proof. rewrite comm. by apply exclusiveN_l. Qed. Lemma exclusive_l x `{!Exclusive x} y : ✓ (x ⋅ y) → False. Proof. by move /cmra_valid_validN /(_ 0) /exclusive0_l. Qed. Lemma exclusive_r x `{!Exclusive x} y : ✓ (y ⋅ x) → False. Proof. rewrite comm. by apply exclusive_l. Qed. Lemma exclusiveN_opM n x `{!Exclusive x} my : ✓{n} (x ⋅? my) → my = None. Proof. destruct my as [y|]; last done. move=> /(exclusiveN_l _ x) []. Qed. Lemma exclusive_includedN n x `{!Exclusive x} y : x ≼{n} y → ✓{n} y → False. Proof. intros [? ->]. by apply exclusiveN_l. Qed. Lemma exclusive_included x `{!Exclusive x} y : x ≼ y → ✓ y → False. Proof. intros [? ->]. by apply exclusive_l. Qed. (** ** Order *) Lemma cmra_included_includedN n x y : x ≼ y → x ≼{n} y. Proof. intros [z ->]. by exists z. Qed. Global Instance cmra_includedN_trans n : Transitive (@includedN A _ _ n). Proof. intros x y z [z1 Hy] [z2 Hz]; exists (z1 ⋅ z2). by rewrite assoc -Hy -Hz. Qed. Global Instance cmra_included_trans: Transitive (@included A _ _). Proof. intros x y z [z1 Hy] [z2 Hz]; exists (z1 ⋅ z2). by rewrite assoc -Hy -Hz. Qed. Lemma cmra_valid_included x y : ✓ y → x ≼ y → ✓ x. Proof. intros Hyv [z ?]; setoid_subst; eauto using cmra_valid_op_l. Qed. Lemma cmra_validN_includedN n x y : ✓{n} y → x ≼{n} y → ✓{n} x. Proof. intros Hyv [z ?]; ofe_subst y; eauto using cmra_validN_op_l. Qed. Lemma cmra_validN_included n x y : ✓{n} y → x ≼ y → ✓{n} x. Proof. intros Hyv [z ?]; setoid_subst; eauto using cmra_validN_op_l. Qed. Lemma cmra_includedN_le n n' x y : x ≼{n} y → n' ≤ n → x ≼{n'} y. Proof. by intros [z Hz] ?; exists z; eapply dist_le. Qed. Lemma cmra_includedN_S n x y : x ≼{S n} y → x ≼{n} y. Proof. intros ?. eapply cmra_includedN_le; [done|lia]. Qed. Lemma cmra_includedN_l n x y : x ≼{n} x ⋅ y. Proof. by exists y. Qed. Lemma cmra_included_l x y : x ≼ x ⋅ y. Proof. by exists y. Qed. Lemma cmra_includedN_r n x y : y ≼{n} x ⋅ y. Proof. rewrite (comm op); apply cmra_includedN_l. Qed. Lemma cmra_included_r x y : y ≼ x ⋅ y. Proof. rewrite (comm op); apply cmra_included_l. Qed. Lemma cmra_pcore_mono' x y cx : x ≼ y → pcore x ≡ Some cx → ∃ cy, pcore y = Some cy ∧ cx ≼ cy. Proof. intros ? (cx'&?&Hcx)%Some_equiv_eq. destruct (cmra_pcore_mono x y cx') as (cy&->&?); auto. exists cy; by rewrite -Hcx. Qed. Lemma cmra_pcore_monoN' n x y cx : x ≼{n} y → pcore x ≡{n}≡ Some cx → ∃ cy, pcore y = Some cy ∧ cx ≼{n} cy. Proof. intros [z Hy] (cx'&?&Hcx)%dist_Some_inv_r'. destruct (cmra_pcore_mono x (x ⋅ z) cx') as (cy&Hxy&?); auto using cmra_included_l. assert (pcore y ≡{n}≡ Some cy) as (cy'&?&Hcy')%dist_Some_inv_r'. { by rewrite Hy Hxy. } exists cy'; split; first done. rewrite Hcx -Hcy'; auto using cmra_included_includedN. Qed. Lemma cmra_included_pcore x cx : pcore x = Some cx → cx ≼ x. Proof. exists x. by rewrite cmra_pcore_l. Qed. Lemma cmra_monoN_l n x y z : x ≼{n} y → z ⋅ x ≼{n} z ⋅ y. Proof. by intros [z1 Hz1]; exists z1; rewrite Hz1 (assoc op). Qed. Lemma cmra_mono_l x y z : x ≼ y → z ⋅ x ≼ z ⋅ y. Proof. by intros [z1 Hz1]; exists z1; rewrite Hz1 (assoc op). Qed. Lemma cmra_monoN_r n x y z : x ≼{n} y → x ⋅ z ≼{n} y ⋅ z. Proof. by intros; rewrite -!(comm _ z); apply cmra_monoN_l. Qed. Lemma cmra_mono_r x y z : x ≼ y → x ⋅ z ≼ y ⋅ z. Proof. by intros; rewrite -!(comm _ z); apply cmra_mono_l. Qed. Lemma cmra_monoN n x1 x2 y1 y2 : x1 ≼{n} y1 → x2 ≼{n} y2 → x1 ⋅ x2 ≼{n} y1 ⋅ y2. Proof. intros; etrans; eauto using cmra_monoN_l, cmra_monoN_r. Qed. Lemma cmra_mono x1 x2 y1 y2 : x1 ≼ y1 → x2 ≼ y2 → x1 ⋅ x2 ≼ y1 ⋅ y2. Proof. intros; etrans; eauto using cmra_mono_l, cmra_mono_r. Qed. Global Instance cmra_monoN' n : Proper (includedN n ==> includedN n ==> includedN n) (@op A _). Proof. intros x1 x2 Hx y1 y2 Hy. by apply cmra_monoN. Qed. Global Instance cmra_mono' : Proper (included ==> included ==> included) (@op A _). Proof. intros x1 x2 Hx y1 y2 Hy. by apply cmra_mono. Qed. Lemma cmra_included_dist_l n x1 x2 x1' : x1 ≼ x2 → x1' ≡{n}≡ x1 → ∃ x2', x1' ≼ x2' ∧ x2' ≡{n}≡ x2. Proof. intros [z Hx2] Hx1; exists (x1' ⋅ z); split; auto using cmra_included_l. by rewrite Hx1 Hx2. Qed. (** ** CoreId elements *) Lemma core_id_dup x `{!CoreId x} : x ≡ x ⋅ x. Proof. by apply cmra_pcore_dup' with x. Qed. Lemma core_id_extract x y `{!CoreId x} : x ≼ y → y ≡ y ⋅ x. Proof. intros ?. destruct (cmra_pcore_mono' x y x) as (cy & Hcy & [x' Hx']); [done|exact: core_id|]. rewrite -(cmra_pcore_r y) //. rewrite Hx' -!assoc. f_equiv. rewrite [x' ⋅ x]comm assoc -core_id_dup. done. Qed. (** ** Total core *) Section total_core. Local Set Default Proof Using "Type*". Context `{!CmraTotal A}. Lemma cmra_pcore_core x : pcore x = Some (core x). Proof. rewrite /core. destruct (cmra_total x) as [cx ->]. done. Qed. Lemma cmra_core_l x : core x ⋅ x ≡ x. Proof. destruct (cmra_total x) as [cx Hcx]. by rewrite /core /= Hcx cmra_pcore_l. Qed. Lemma cmra_core_idemp x : core (core x) ≡ core x. Proof. destruct (cmra_total x) as [cx Hcx]. by rewrite /core /= Hcx cmra_pcore_idemp. Qed. Lemma cmra_core_mono x y : x ≼ y → core x ≼ core y. Proof. intros; destruct (cmra_total x) as [cx Hcx]. destruct (cmra_pcore_mono x y cx) as (cy&Hcy&?); auto. by rewrite /core /= Hcx Hcy. Qed. Global Instance cmra_core_ne : NonExpansive (@core A _). Proof. intros n x y Hxy. destruct (cmra_total x) as [cx Hcx]. by rewrite /core /= -Hxy Hcx. Qed. Global Instance cmra_core_proper : Proper ((≡) ==> (≡)) (@core A _). Proof. apply (ne_proper _). Qed. Lemma cmra_core_r x : x ⋅ core x ≡ x. Proof. by rewrite (comm _ x) cmra_core_l. Qed. Lemma cmra_core_dup x : core x ≡ core x ⋅ core x. Proof. by rewrite -{3}(cmra_core_idemp x) cmra_core_r. Qed. Lemma cmra_core_validN n x : ✓{n} x → ✓{n} core x. Proof. rewrite -{1}(cmra_core_l x); apply cmra_validN_op_l. Qed. Lemma cmra_core_valid x : ✓ x → ✓ core x. Proof. rewrite -{1}(cmra_core_l x); apply cmra_valid_op_l. Qed. Lemma core_id_total x : CoreId x ↔ core x ≡ x. Proof. split; [intros; by rewrite /core /= (core_id x)|]. rewrite /CoreId /core /=. destruct (cmra_total x) as [? ->]. by constructor. Qed. Lemma core_id_core x `{!CoreId x} : core x ≡ x. Proof. by apply core_id_total. Qed. (** Not an instance since TC search cannot solve the premise. *) Lemma cmra_pcore_core_id x y : pcore x = Some y → CoreId y. Proof. rewrite /CoreId. eauto using cmra_pcore_idemp. Qed. Global Instance cmra_core_core_id x : CoreId (core x). Proof. eapply cmra_pcore_core_id. rewrite cmra_pcore_core. done. Qed. Lemma cmra_included_core x : core x ≼ x. Proof. by exists x; rewrite cmra_core_l. Qed. Global Instance cmra_includedN_preorder n : PreOrder (@includedN A _ _ n). Proof. split; [|apply _]. by intros x; exists (core x); rewrite cmra_core_r. Qed. Global Instance cmra_included_preorder : PreOrder (@included A _ _). Proof. split; [|apply _]. by intros x; exists (core x); rewrite cmra_core_r. Qed. Lemma cmra_core_monoN n x y : x ≼{n} y → core x ≼{n} core y. Proof. intros [z ->]. apply cmra_included_includedN, cmra_core_mono, cmra_included_l. Qed. End total_core. (** ** Discrete *) Lemma cmra_discrete_included_l x y : Discrete x → ✓{0} y → x ≼{0} y → x ≼ y. Proof. intros ?? [x' ?]. destruct (cmra_extend 0 y x x') as (z&z'&Hy&Hz&Hz'); auto; simpl in *. by exists z'; rewrite Hy (discrete_0 x z). Qed. Lemma cmra_discrete_included_r x y : Discrete y → x ≼{0} y → x ≼ y. Proof. intros ? [x' ?]. exists x'. by apply (discrete_0 y). Qed. Lemma cmra_op_discrete x1 x2 : ✓{0} (x1 ⋅ x2) → Discrete x1 → Discrete x2 → Discrete (x1 ⋅ x2). Proof. intros ??? z Hz. destruct (cmra_extend 0 z x1 x2) as (y1&y2&Hz'&?&?); auto; simpl in *. { rewrite -?Hz. done. } by rewrite Hz' (discrete_0 x1 y1) // (discrete_0 x2 y2). Qed. (** ** Discrete *) Lemma cmra_discrete_valid_iff `{!CmraDiscrete A} n x : ✓ x ↔ ✓{n} x. Proof. split; first by rewrite cmra_valid_validN. eauto using cmra_discrete_valid, cmra_validN_le with lia. Qed. Lemma cmra_discrete_valid_iff_0 `{!CmraDiscrete A} n x : ✓{0} x ↔ ✓{n} x. Proof. by rewrite -!cmra_discrete_valid_iff. Qed. Lemma cmra_discrete_included_iff `{!OfeDiscrete A} n x y : x ≼ y ↔ x ≼{n} y. Proof. split; first by apply cmra_included_includedN. intros [z ->%(discrete_iff _ _)]; eauto using cmra_included_l. Qed. Lemma cmra_discrete_included_iff_0 `{!OfeDiscrete A} n x y : x ≼{0} y ↔ x ≼{n} y. Proof. by rewrite -!cmra_discrete_included_iff. Qed. (** Cancelable elements *) Global Instance cancelable_proper : Proper (equiv ==> iff) (@Cancelable A). Proof. unfold Cancelable. intros x x' EQ. by setoid_rewrite EQ. Qed. Lemma cancelable x `{!Cancelable x} y z : ✓(x ⋅ y) → x ⋅ y ≡ x ⋅ z → y ≡ z. Proof. rewrite !equiv_dist cmra_valid_validN. intros. by apply (cancelableN x). Qed. Lemma discrete_cancelable x `{!CmraDiscrete A}: (∀ y z, ✓(x ⋅ y) → x ⋅ y ≡ x ⋅ z → y ≡ z) → Cancelable x. Proof. intros ????. rewrite -!discrete_iff -cmra_discrete_valid_iff. auto. Qed. Global Instance cancelable_op x y : Cancelable x → Cancelable y → Cancelable (x ⋅ y). Proof. intros ?? n z z' ??. apply (cancelableN y), (cancelableN x). - eapply cmra_validN_op_r. by rewrite assoc. - by rewrite assoc. - by rewrite !assoc. Qed. Global Instance exclusive_cancelable (x : A) : Exclusive x → Cancelable x. Proof. intros ? n z z' []%(exclusiveN_l _ x). Qed. (** Id-free elements *) Global Instance id_free_ne n : Proper (dist n ==> iff) (@IdFree A). Proof. intros x x' EQ%(dist_le _ 0); last lia. rewrite /IdFree. split=> y ?; (rewrite -EQ || rewrite EQ); eauto. Qed. Global Instance id_free_proper : Proper (equiv ==> iff) (@IdFree A). Proof. by move=> P Q /equiv_dist /(_ 0)=> ->. Qed. Lemma id_freeN_r n n' x `{!IdFree x} y : ✓{n}x → x ⋅ y ≡{n'}≡ x → False. Proof. eauto using cmra_validN_le, dist_le with lia. Qed. Lemma id_freeN_l n n' x `{!IdFree x} y : ✓{n}x → y ⋅ x ≡{n'}≡ x → False. Proof. rewrite comm. eauto using id_freeN_r. Qed. Lemma id_free_r x `{!IdFree x} y : ✓x → x ⋅ y ≡ x → False. Proof. move=> /cmra_valid_validN ? /equiv_dist. eauto. Qed. Lemma id_free_l x `{!IdFree x} y : ✓x → y ⋅ x ≡ x → False. Proof. rewrite comm. eauto using id_free_r. Qed. Lemma discrete_id_free x `{!CmraDiscrete A}: (∀ y, ✓ x → x ⋅ y ≡ x → False) → IdFree x. Proof. intros Hx y ??. apply (Hx y), (discrete_0 _); eauto using cmra_discrete_valid. Qed. Global Instance id_free_op_r x y : IdFree y → Cancelable x → IdFree (x ⋅ y). Proof. intros ?? z ? Hid%symmetry. revert Hid. rewrite -assoc=>/(cancelableN x) ?. eapply (id_free0_r y); [by eapply cmra_validN_op_r |symmetry; eauto]. Qed. Global Instance id_free_op_l x y : IdFree x → Cancelable y → IdFree (x ⋅ y). Proof. intros. rewrite comm. apply _. Qed. Global Instance exclusive_id_free x : Exclusive x → IdFree x. Proof. intros ? z ? Hid. apply (exclusiveN_l 0 x z). by rewrite Hid. Qed. End cmra. (* We use a [Hint Extern] with [apply:], instead of [Hint Immediate], to invoke the new unification algorithm. The old unification algorithm sometimes gets confused by going from [ucmra]'s to [cmra]'s and back. *) Global Hint Extern 0 (?a ≼ ?a ⋅ _) => apply: cmra_included_l : core. Global Hint Extern 0 (?a ≼ _ ⋅ ?a) => apply: cmra_included_r : core. (** * Properties about CMRAs with a unit element **) Section ucmra. Context {A : ucmra}. Implicit Types x y z : A. Lemma ucmra_unit_validN n : ✓{n} (ε:A). Proof. apply cmra_valid_validN, ucmra_unit_valid. Qed. Lemma ucmra_unit_leastN n x : ε ≼{n} x. Proof. by exists x; rewrite left_id. Qed. Lemma ucmra_unit_least x : ε ≼ x. Proof. by exists x; rewrite left_id. Qed. Global Instance ucmra_unit_right_id : RightId (≡) ε (@op A _). Proof. by intros x; rewrite (comm op) left_id. Qed. Global Instance ucmra_unit_core_id : CoreId (ε:A). Proof. apply ucmra_pcore_unit. Qed. Global Instance cmra_unit_cmra_total : CmraTotal A. Proof. intros x. destruct (cmra_pcore_mono' ε x ε) as (cx&->&?); [..|by eauto]. - apply ucmra_unit_least. - apply (core_id _). Qed. Global Instance empty_cancelable : Cancelable (ε:A). Proof. intros ???. by rewrite !left_id. Qed. (* For big ops *) Global Instance cmra_monoid : Monoid (@op A _) := {| monoid_unit := ε |}. End ucmra. Global Hint Immediate cmra_unit_cmra_total : core. Global Hint Extern 0 (ε ≼ _) => apply: ucmra_unit_least : core. (** * Properties about CMRAs with Leibniz equality *) Section cmra_leibniz. Local Set Default Proof Using "Type*". Context {A : cmra} `{!LeibnizEquiv A}. Implicit Types x y : A. Global Instance cmra_assoc_L : Assoc (=) (@op A _). Proof. intros x y z. unfold_leibniz. by rewrite assoc. Qed. Global Instance cmra_comm_L : Comm (=) (@op A _). Proof. intros x y. unfold_leibniz. by rewrite comm. Qed. Lemma cmra_pcore_l_L x cx : pcore x = Some cx → cx ⋅ x = x. Proof. unfold_leibniz. apply cmra_pcore_l'. Qed. Lemma cmra_pcore_idemp_L x cx : pcore x = Some cx → pcore cx = Some cx. Proof. unfold_leibniz. apply cmra_pcore_idemp'. Qed. Lemma cmra_op_opM_assoc_L x y mz : (x ⋅ y) ⋅? mz = x ⋅ (y ⋅? mz). Proof. unfold_leibniz. apply cmra_op_opM_assoc. Qed. (** ** Core *) Lemma cmra_pcore_r_L x cx : pcore x = Some cx → x ⋅ cx = x. Proof. unfold_leibniz. apply cmra_pcore_r'. Qed. Lemma cmra_pcore_dup_L x cx : pcore x = Some cx → cx = cx ⋅ cx. Proof. unfold_leibniz. apply cmra_pcore_dup'. Qed. (** ** CoreId elements *) Lemma core_id_dup_L x `{!CoreId x} : x = x ⋅ x. Proof. unfold_leibniz. by apply core_id_dup. Qed. (** ** Total core *) Section total_core. Context `{!CmraTotal A}. Lemma cmra_core_r_L x : x ⋅ core x = x. Proof. unfold_leibniz. apply cmra_core_r. Qed. Lemma cmra_core_l_L x : core x ⋅ x = x. Proof. unfold_leibniz. apply cmra_core_l. Qed. Lemma cmra_core_idemp_L x : core (core x) = core x. Proof. unfold_leibniz. apply cmra_core_idemp. Qed. Lemma cmra_core_dup_L x : core x = core x ⋅ core x. Proof. unfold_leibniz. apply cmra_core_dup. Qed. Lemma core_id_total_L x : CoreId x ↔ core x = x. Proof. unfold_leibniz. apply core_id_total. Qed. Lemma core_id_core_L x `{!CoreId x} : core x = x. Proof. by apply core_id_total_L. Qed. End total_core. End cmra_leibniz. Section ucmra_leibniz. Local Set Default Proof Using "Type*". Context {A : ucmra} `{!LeibnizEquiv A}. Implicit Types x y z : A. Global Instance ucmra_unit_left_id_L : LeftId (=) ε (@op A _). Proof. intros x. unfold_leibniz. by rewrite left_id. Qed. Global Instance ucmra_unit_right_id_L : RightId (=) ε (@op A _). Proof. intros x. unfold_leibniz. by rewrite right_id. Qed. End ucmra_leibniz. (** * Constructing a CMRA with total core *) Section cmra_total. Context A `{!Dist A, !Equiv A, !PCore A, !Op A, !Valid A, !ValidN A}. Context (total : ∀ x : A, is_Some (pcore x)). Context (op_ne : ∀ x : A, NonExpansive (op x)). Context (core_ne : NonExpansive (@core A _)). Context (validN_ne : ∀ n, Proper (dist n ==> impl) (@validN A _ n)). Context (valid_validN : ∀ (x : A), ✓ x ↔ ∀ n, ✓{n} x). Context (validN_S : ∀ n (x : A), ✓{S n} x → ✓{n} x). Context (op_assoc : Assoc (≡) (@op A _)). Context (op_comm : Comm (≡) (@op A _)). Context (core_l : ∀ x : A, core x ⋅ x ≡ x). Context (core_idemp : ∀ x : A, core (core x) ≡ core x). Context (core_mono : ∀ x y : A, x ≼ y → core x ≼ core y). Context (validN_op_l : ∀ n (x y : A), ✓{n} (x ⋅ y) → ✓{n} x). Context (extend : ∀ n (x y1 y2 : A), ✓{n} x → x ≡{n}≡ y1 ⋅ y2 → { z1 : A & { z2 | x ≡ z1 ⋅ z2 ∧ z1 ≡{n}≡ y1 ∧ z2 ≡{n}≡ y2 } }). Lemma cmra_total_mixin : CmraMixin A. Proof using Type*. split; auto. - intros n x y ? Hcx%core_ne Hx; move: Hcx. rewrite /core /= Hx /=. case (total y)=> [cy ->]; eauto. - intros x cx Hcx. move: (core_l x). by rewrite /core /= Hcx. - intros x cx Hcx. move: (core_idemp x). rewrite /core /= Hcx /=. case (total cx)=>[ccx ->]; by constructor. - intros x y cx Hxy%core_mono Hx. move: Hxy. rewrite /core /= Hx /=. case (total y)=> [cy ->]; eauto. Qed. End cmra_total. (** * Properties about morphisms *) Global Instance cmra_morphism_id {A : cmra} : CmraMorphism (@id A). Proof. split => /=. - apply _. - done. - intros. by rewrite option_fmap_id. - done. Qed. Global Instance cmra_morphism_proper {A B : cmra} (f : A → B) `{!CmraMorphism f} : Proper ((≡) ==> (≡)) f := ne_proper _. Global Instance cmra_morphism_compose {A B C : cmra} (f : A → B) (g : B → C) : CmraMorphism f → CmraMorphism g → CmraMorphism (g ∘ f). Proof. split. - apply _. - move=> n x Hx /=. by apply cmra_morphism_validN, cmra_morphism_validN. - move=> x /=. by rewrite option_fmap_compose !cmra_morphism_pcore. - move=> x y /=. by rewrite !cmra_morphism_op. Qed. Section cmra_morphism. Local Set Default Proof Using "Type*". Context {A B : cmra} (f : A → B) `{!CmraMorphism f}. Lemma cmra_morphism_core x : f (core x) ≡ core (f x). Proof. unfold core. rewrite -cmra_morphism_pcore. by destruct (pcore x). Qed. Lemma cmra_morphism_monotone x y : x ≼ y → f x ≼ f y. Proof. intros [z ->]. exists (f z). by rewrite cmra_morphism_op. Qed. Lemma cmra_morphism_monotoneN n x y : x ≼{n} y → f x ≼{n} f y. Proof. intros [z ->]. exists (f z). by rewrite cmra_morphism_op. Qed. Lemma cmra_morphism_valid x : ✓ x → ✓ f x. Proof. rewrite !cmra_valid_validN; eauto using cmra_morphism_validN. Qed. End cmra_morphism. (** COFE → CMRA Functors *) Record rFunctor := RFunctor { rFunctor_car : ∀ A `{!Cofe A} B `{!Cofe B}, cmra; rFunctor_map `{!Cofe A1, !Cofe A2, !Cofe B1, !Cofe B2} : ((A2 -n> A1) * (B1 -n> B2)) → rFunctor_car A1 B1 -n> rFunctor_car A2 B2; rFunctor_map_ne `{!Cofe A1, !Cofe A2, !Cofe B1, !Cofe B2} : NonExpansive (@rFunctor_map A1 _ A2 _ B1 _ B2 _); rFunctor_map_id `{!Cofe A, !Cofe B} (x : rFunctor_car A B) : rFunctor_map (cid,cid) x ≡ x; rFunctor_map_compose `{!Cofe A1, !Cofe A2, !Cofe A3, !Cofe B1, !Cofe B2, !Cofe B3} (f : A2 -n> A1) (g : A3 -n> A2) (f' : B1 -n> B2) (g' : B2 -n> B3) x : rFunctor_map (f◎g, g'◎f') x ≡ rFunctor_map (g,g') (rFunctor_map (f,f') x); rFunctor_mor `{!Cofe A1, !Cofe A2, !Cofe B1, !Cofe B2} (fg : (A2 -n> A1) * (B1 -n> B2)) : CmraMorphism (rFunctor_map fg) }. Global Existing Instances rFunctor_map_ne rFunctor_mor. Global Instance: Params (@rFunctor_map) 9 := {}. Declare Scope rFunctor_scope. Delimit Scope rFunctor_scope with RF. Bind Scope rFunctor_scope with rFunctor. Class rFunctorContractive (F : rFunctor) := #[global] rFunctor_map_contractive `{!Cofe A1, !Cofe A2, !Cofe B1, !Cofe B2} :: Contractive (@rFunctor_map F A1 _ A2 _ B1 _ B2 _). Global Hint Mode rFunctorContractive ! : typeclass_instances. Definition rFunctor_apply (F: rFunctor) (A: ofe) `{!Cofe A} : cmra := rFunctor_car F A A. Program Definition rFunctor_to_oFunctor (F: rFunctor) : oFunctor := {| oFunctor_car A _ B _ := rFunctor_car F A B; oFunctor_map A1 _ A2 _ B1 _ B2 _ fg := rFunctor_map F fg |}. Next Obligation. intros F A ? B ? x. simpl in *. apply rFunctor_map_id. Qed. Next Obligation. intros F A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x. simpl in *. apply rFunctor_map_compose. Qed. Global Instance rFunctor_to_oFunctor_contractive F : rFunctorContractive F → oFunctorContractive (rFunctor_to_oFunctor F). Proof. intros ? A1 ? A2 ? B1 ? B2 ? n f g Hfg. apply rFunctor_map_contractive. done. Qed. Program Definition rFunctor_oFunctor_compose (F1 : rFunctor) (F2 : oFunctor) `{!∀ `{Cofe A, Cofe B}, Cofe (oFunctor_car F2 A B)} : rFunctor := {| rFunctor_car A _ B _ := rFunctor_car F1 (oFunctor_car F2 B A) (oFunctor_car F2 A B); rFunctor_map A1 _ A2 _ B1 _ B2 _ 'fg := rFunctor_map F1 (oFunctor_map F2 (fg.2,fg.1),oFunctor_map F2 fg) |}. Next Obligation. intros F1 F2 ? A1 ? A2 ? B1 ? B2 ? n [f1 g1] [f2 g2] [??]; simpl in *. apply rFunctor_map_ne; split; apply oFunctor_map_ne; by split. Qed. Next Obligation. intros F1 F2 ? A ? B ? x; simpl in *. rewrite -{2}(rFunctor_map_id F1 x). apply equiv_dist=> n. apply rFunctor_map_ne. split=> y /=; by rewrite !oFunctor_map_id. Qed. Next Obligation. intros F1 F2 ? A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x; simpl in *. rewrite -rFunctor_map_compose. apply equiv_dist=> n. apply rFunctor_map_ne. split=> y /=; by rewrite !oFunctor_map_compose. Qed. Global Instance rFunctor_oFunctor_compose_contractive_1 (F1 : rFunctor) (F2 : oFunctor) `{!∀ `{Cofe A, Cofe B}, Cofe (oFunctor_car F2 A B)} : rFunctorContractive F1 → rFunctorContractive (rFunctor_oFunctor_compose F1 F2). Proof. intros ? A1 ? A2 ? B1 ? B2 ? n [f1 g1] [f2 g2] Hfg; simpl in *. f_contractive; destruct Hfg; split; simpl in *; apply oFunctor_map_ne; by split. Qed. Global Instance rFunctor_oFunctor_compose_contractive_2 (F1 : rFunctor) (F2 : oFunctor) `{!∀ `{Cofe A, Cofe B}, Cofe (oFunctor_car F2 A B)} : oFunctorContractive F2 → rFunctorContractive (rFunctor_oFunctor_compose F1 F2). Proof. intros ? A1 ? A2 ? B1 ? B2 ? n [f1 g1] [f2 g2] Hfg; simpl in *. f_equiv; split; simpl in *; f_contractive; destruct Hfg; by split. Qed. Program Definition constRF (B : cmra) : rFunctor := {| rFunctor_car A1 _ A2 _ := B; rFunctor_map A1 _ A2 _ B1 _ B2 _ f := cid |}. Solve Obligations with done. Coercion constRF : cmra >-> rFunctor. Global Instance constRF_contractive B : rFunctorContractive (constRF B). Proof. rewrite /rFunctorContractive; apply _. Qed. (** COFE → UCMRA Functors *) Record urFunctor := URFunctor { urFunctor_car : ∀ A `{!Cofe A} B `{!Cofe B}, ucmra; urFunctor_map `{!Cofe A1, !Cofe A2, !Cofe B1, !Cofe B2} : ((A2 -n> A1) * (B1 -n> B2)) → urFunctor_car A1 B1 -n> urFunctor_car A2 B2; urFunctor_map_ne `{!Cofe A1, !Cofe A2, !Cofe B1, !Cofe B2} : NonExpansive (@urFunctor_map A1 _ A2 _ B1 _ B2 _); urFunctor_map_id `{!Cofe A, !Cofe B} (x : urFunctor_car A B) : urFunctor_map (cid,cid) x ≡ x; urFunctor_map_compose `{!Cofe A1, !Cofe A2, !Cofe A3, !Cofe B1, !Cofe B2, !Cofe B3} (f : A2 -n> A1) (g : A3 -n> A2) (f' : B1 -n> B2) (g' : B2 -n> B3) x : urFunctor_map (f◎g, g'◎f') x ≡ urFunctor_map (g,g') (urFunctor_map (f,f') x); urFunctor_mor `{!Cofe A1, !Cofe A2, !Cofe B1, !Cofe B2} (fg : (A2 -n> A1) * (B1 -n> B2)) : CmraMorphism (urFunctor_map fg) }. Global Existing Instances urFunctor_map_ne urFunctor_mor. Global Instance: Params (@urFunctor_map) 9 := {}. Declare Scope urFunctor_scope. Delimit Scope urFunctor_scope with URF. Bind Scope urFunctor_scope with urFunctor. Class urFunctorContractive (F : urFunctor) := #[global] urFunctor_map_contractive `{!Cofe A1, !Cofe A2, !Cofe B1, !Cofe B2} :: Contractive (@urFunctor_map F A1 _ A2 _ B1 _ B2 _). Global Hint Mode urFunctorContractive ! : typeclass_instances. Definition urFunctor_apply (F: urFunctor) (A: ofe) `{!Cofe A} : ucmra := urFunctor_car F A A. Program Definition urFunctor_to_rFunctor (F: urFunctor) : rFunctor := {| rFunctor_car A _ B _ := urFunctor_car F A B; rFunctor_map A1 _ A2 _ B1 _ B2 _ fg := urFunctor_map F fg |}. Next Obligation. intros F A ? B ? x. simpl in *. apply urFunctor_map_id. Qed. Next Obligation. intros F A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x. simpl in *. apply urFunctor_map_compose. Qed. Global Instance urFunctor_to_rFunctor_contractive F : urFunctorContractive F → rFunctorContractive (urFunctor_to_rFunctor F). Proof. intros ? A1 ? A2 ? B1 ? B2 ? n f g Hfg. apply urFunctor_map_contractive. done. Qed. Program Definition urFunctor_oFunctor_compose (F1 : urFunctor) (F2 : oFunctor) `{!∀ `{Cofe A, Cofe B}, Cofe (oFunctor_car F2 A B)} : urFunctor := {| urFunctor_car A _ B _ := urFunctor_car F1 (oFunctor_car F2 B A) (oFunctor_car F2 A B); urFunctor_map A1 _ A2 _ B1 _ B2 _ 'fg := urFunctor_map F1 (oFunctor_map F2 (fg.2,fg.1),oFunctor_map F2 fg) |}. Next Obligation. intros F1 F2 ? A1 ? A2 ? B1 ? B2 ? n [f1 g1] [f2 g2] [??]; simpl in *. apply urFunctor_map_ne; split; apply oFunctor_map_ne; by split. Qed. Next Obligation. intros F1 F2 ? A ? B ? x; simpl in *. rewrite -{2}(urFunctor_map_id F1 x). apply equiv_dist=> n. apply urFunctor_map_ne. split=> y /=; by rewrite !oFunctor_map_id. Qed. Next Obligation. intros F1 F2 ? A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x; simpl in *. rewrite -urFunctor_map_compose. apply equiv_dist=> n. apply urFunctor_map_ne. split=> y /=; by rewrite !oFunctor_map_compose. Qed. Global Instance urFunctor_oFunctor_compose_contractive_1 (F1 : urFunctor) (F2 : oFunctor) `{!∀ `{Cofe A, Cofe B}, Cofe (oFunctor_car F2 A B)} : urFunctorContractive F1 → urFunctorContractive (urFunctor_oFunctor_compose F1 F2). Proof. intros ? A1 ? A2 ? B1 ? B2 ? n [f1 g1] [f2 g2] Hfg; simpl in *. f_contractive; destruct Hfg; split; simpl in *; apply oFunctor_map_ne; by split. Qed. Global Instance urFunctor_oFunctor_compose_contractive_2 (F1 : urFunctor) (F2 : oFunctor) `{!∀ `{Cofe A, Cofe B}, Cofe (oFunctor_car F2 A B)} : oFunctorContractive F2 → urFunctorContractive (urFunctor_oFunctor_compose F1 F2). Proof. intros ? A1 ? A2 ? B1 ? B2 ? n [f1 g1] [f2 g2] Hfg; simpl in *. f_equiv; split; simpl in *; f_contractive; destruct Hfg; by split. Qed. Program Definition constURF (B : ucmra) : urFunctor := {| urFunctor_car A1 _ A2 _ := B; urFunctor_map A1 _ A2 _ B1 _ B2 _ f := cid |}. Solve Obligations with done. Coercion constURF : ucmra >-> urFunctor. Global Instance constURF_contractive B : urFunctorContractive (constURF B). Proof. rewrite /urFunctorContractive; apply _. Qed. (** * Transporting a CMRA equality *) Definition cmra_transport {A B : cmra} (H : A = B) (x : A) : B := eq_rect A id x _ H. Lemma cmra_transport_trans {A B C : cmra} (H1 : A = B) (H2 : B = C) x : cmra_transport H2 (cmra_transport H1 x) = cmra_transport (eq_trans H1 H2) x. Proof. by destruct H2. Qed. Section cmra_transport. Context {A B : cmra} (H : A = B). Notation T := (cmra_transport H). Global Instance cmra_transport_ne : NonExpansive T. Proof. by intros ???; destruct H. Qed. Global Instance cmra_transport_proper : Proper ((≡) ==> (≡)) T. Proof. by intros ???; destruct H. Qed. Lemma cmra_transport_op x y : T (x ⋅ y) = T x ⋅ T y. Proof. by destruct H. Qed. Lemma cmra_transport_core x : T (core x) = core (T x). Proof. by destruct H. Qed. Lemma cmra_transport_validN n x : ✓{n} T x ↔ ✓{n} x. Proof. by destruct H. Qed. Lemma cmra_transport_valid x : ✓ T x ↔ ✓ x. Proof. by destruct H. Qed. Global Instance cmra_transport_discrete x : Discrete x → Discrete (T x). Proof. by destruct H. Qed. Global Instance cmra_transport_core_id x : CoreId x → CoreId (T x). Proof. by destruct H. Qed. End cmra_transport. (** * Instances *) (** ** Discrete CMRA *) Record RAMixin A `{Equiv A, PCore A, Op A, Valid A} := { (* setoids *) ra_op_proper (x : A) : Proper ((≡) ==> (≡)) (op x); ra_core_proper (x y : A) cx : x ≡ y → pcore x = Some cx → ∃ cy, pcore y = Some cy ∧ cx ≡ cy; ra_validN_proper : Proper ((≡@{A}) ==> impl) valid; (* monoid *) ra_assoc : Assoc (≡@{A}) (⋅); ra_comm : Comm (≡@{A}) (⋅); ra_pcore_l (x : A) cx : pcore x = Some cx → cx ⋅ x ≡ x; ra_pcore_idemp (x : A) cx : pcore x = Some cx → pcore cx ≡ Some cx; ra_pcore_mono (x y : A) cx : x ≼ y → pcore x = Some cx → ∃ cy, pcore y = Some cy ∧ cx ≼ cy; ra_valid_op_l (x y : A) : ✓ (x ⋅ y) → ✓ x }. Section discrete. Local Set Default Proof Using "Type*". Context `{!Equiv A, !PCore A, !Op A, !Valid A} (Heq : @Equivalence A (≡)). Context (ra_mix : RAMixin A). Existing Instances discrete_dist. Local Instance discrete_validN_instance : ValidN A := λ n x, ✓ x. Definition discrete_cmra_mixin : CmraMixin A. Proof. destruct ra_mix; split; try done. - intros x; split; first done. by move=> /(_ 0). - intros n x y1 y2 ??; by exists y1, y2. Qed. Local Instance discrete_cmra_discrete : CmraDiscrete (Cmra' A (discrete_ofe_mixin Heq) discrete_cmra_mixin). Proof. split; first apply _. done. Qed. End discrete. (** A smart constructor for the discrete RA over a carrier [A]. It uses [ofe_discrete_equivalence_of A] to make sure the same [Equivalence] proof is used as when constructing the OFE. *) Notation discreteR A ra_mix := (Cmra A (discrete_cmra_mixin (discrete_ofe_equivalence_of A%type) ra_mix)) (only parsing). Section ra_total. Local Set Default Proof Using "Type*". Context A `{Equiv A, PCore A, Op A, Valid A}. Context (total : ∀ x : A, is_Some (pcore x)). Context (op_proper : ∀ x : A, Proper ((≡) ==> (≡)) (op x)). Context (core_proper: Proper ((≡) ==> (≡)) (@core A _)). Context (valid_proper : Proper ((≡) ==> impl) (@valid A _)). Context (op_assoc : Assoc (≡) (@op A _)). Context (op_comm : Comm (≡) (@op A _)). Context (core_l : ∀ x : A, core x ⋅ x ≡ x). Context (core_idemp : ∀ x : A, core (core x) ≡ core x). Context (core_mono : ∀ x y : A, x ≼ y → core x ≼ core y). Context (valid_op_l : ∀ x y : A, ✓ (x ⋅ y) → ✓ x). Lemma ra_total_mixin : RAMixin A. Proof. split; auto. - intros x y ? Hcx%core_proper Hx; move: Hcx. rewrite /core /= Hx /=. case (total y)=> [cy ->]; eauto. - intros x cx Hcx. move: (core_l x). by rewrite /core /= Hcx. - intros x cx Hcx. move: (core_idemp x). rewrite /core /= Hcx /=. case (total cx)=>[ccx ->]; by constructor. - intros x y cx Hxy%core_mono Hx. move: Hxy. rewrite /core /= Hx /=. case (total y)=> [cy ->]; eauto. Qed. End ra_total. (** ** CMRA for the unit type *) Section unit. Local Instance unit_valid_instance : Valid () := λ x, True. Local Instance unit_validN_instance : ValidN () := λ n x, True. Local Instance unit_pcore_instance : PCore () := λ x, Some x. Local Instance unit_op_instance : Op () := λ x y, (). Lemma unit_cmra_mixin : CmraMixin (). Proof. apply discrete_cmra_mixin, ra_total_mixin; by eauto. Qed. Canonical Structure unitR : cmra := Cmra unit unit_cmra_mixin. Local Instance unit_unit_instance : Unit () := (). Lemma unit_ucmra_mixin : UcmraMixin (). Proof. done. Qed. Canonical Structure unitUR : ucmra := Ucmra unit unit_ucmra_mixin. Global Instance unit_cmra_discrete : CmraDiscrete unitR. Proof. done. Qed. Global Instance unit_core_id (x : ()) : CoreId x. Proof. by constructor. Qed. Global Instance unit_cancelable (x : ()) : Cancelable x. Proof. by constructor. Qed. End unit. (** ** CMRA for the empty type *) Section empty. Local Instance Empty_set_valid_instance : Valid Empty_set := λ x, False. Local Instance Empty_set_validN_instance : ValidN Empty_set := λ n x, False. Local Instance Empty_set_pcore_instance : PCore Empty_set := λ x, Some x. Local Instance Empty_set_op_instance : Op Empty_set := λ x y, x. Lemma Empty_set_cmra_mixin : CmraMixin Empty_set. Proof. apply discrete_cmra_mixin, ra_total_mixin; by (intros [] || done). Qed. Canonical Structure Empty_setR : cmra := Cmra Empty_set Empty_set_cmra_mixin. Global Instance Empty_set_cmra_discrete : CmraDiscrete Empty_setR. Proof. done. Qed. Global Instance Empty_set_core_id (x : Empty_set) : CoreId x. Proof. by constructor. Qed. Global Instance Empty_set_cancelable (x : Empty_set) : Cancelable x. Proof. by constructor. Qed. End empty. (** ** Product *) Section prod. Context {A B : cmra}. Local Arguments pcore _ _ !_ /. Local Arguments cmra_pcore _ !_/. Local Instance prod_op_instance : Op (A * B) := λ x y, (x.1 ⋅ y.1, x.2 ⋅ y.2). Local Instance prod_pcore_instance : PCore (A * B) := λ x, c1 ← pcore (x.1); c2 ← pcore (x.2); Some (c1, c2). Local Arguments prod_pcore_instance !_ /. Local Instance prod_valid_instance : Valid (A * B) := λ x, ✓ x.1 ∧ ✓ x.2. Local Instance prod_validN_instance : ValidN (A * B) := λ n x, ✓{n} x.1 ∧ ✓{n} x.2. Lemma prod_pcore_Some (x cx : A * B) : pcore x = Some cx ↔ pcore (x.1) = Some (cx.1) ∧ pcore (x.2) = Some (cx.2). Proof. destruct x, cx; by intuition simplify_option_eq. Qed. Lemma prod_pcore_Some' (x cx : A * B) : pcore x ≡ Some cx ↔ pcore (x.1) ≡ Some (cx.1) ∧ pcore (x.2) ≡ Some (cx.2). Proof. split; [by intros (cx'&[-> ->]%prod_pcore_Some&<-)%Some_equiv_eq|]. rewrite {3}/pcore /prod_pcore_instance. (* TODO: use setoid rewrite *) intros [Hx1 Hx2]; inversion_clear Hx1; simpl; inversion_clear Hx2. by constructor. Qed. Lemma prod_included (x y : A * B) : x ≼ y ↔ x.1 ≼ y.1 ∧ x.2 ≼ y.2. Proof. split; [intros [z Hz]; split; [exists (z.1)|exists (z.2)]; apply Hz|]. intros [[z1 Hz1] [z2 Hz2]]; exists (z1,z2); split; auto. Qed. Lemma prod_includedN (x y : A * B) n : x ≼{n} y ↔ x.1 ≼{n} y.1 ∧ x.2 ≼{n} y.2. Proof. split; [intros [z Hz]; split; [exists (z.1)|exists (z.2)]; apply Hz|]. intros [[z1 Hz1] [z2 Hz2]]; exists (z1,z2); split; auto. Qed. Definition prod_cmra_mixin : CmraMixin (A * B). Proof. split; try apply _. - by intros n x y1 y2 [Hy1 Hy2]; split; rewrite /= ?Hy1 ?Hy2. - intros n x y cx; setoid_rewrite prod_pcore_Some=> -[??] [??]. destruct (cmra_pcore_ne n (x.1) (y.1) (cx.1)) as (z1&->&?); auto. destruct (cmra_pcore_ne n (x.2) (y.2) (cx.2)) as (z2&->&?); auto. exists (z1,z2); repeat constructor; auto. - by intros n y1 y2 [Hy1 Hy2] [??]; split; rewrite /= -?Hy1 -?Hy2. - intros x; split. + intros [??] n; split; by apply cmra_valid_validN. + intros Hxy; split; apply cmra_valid_validN=> n; apply Hxy. - by intros n x [??]; split; apply cmra_validN_S. - by split; rewrite /= assoc. - by split; rewrite /= comm. - intros x y [??]%prod_pcore_Some; constructor; simpl; eauto using cmra_pcore_l. - intros x y; rewrite prod_pcore_Some prod_pcore_Some'. naive_solver eauto using cmra_pcore_idemp. - intros x y cx; rewrite prod_included prod_pcore_Some=> -[??] [??]. destruct (cmra_pcore_mono (x.1) (y.1) (cx.1)) as (z1&?&?); auto. destruct (cmra_pcore_mono (x.2) (y.2) (cx.2)) as (z2&?&?); auto. exists (z1,z2). by rewrite prod_included prod_pcore_Some. - intros n x y [??]; split; simpl in *; eauto using cmra_validN_op_l. - intros n x y1 y2 [??] [??]; simpl in *. destruct (cmra_extend n (x.1) (y1.1) (y2.1)) as (z11&z12&?&?&?); auto. destruct (cmra_extend n (x.2) (y1.2) (y2.2)) as (z21&z22&?&?&?); auto. by exists (z11,z21), (z12,z22). Qed. Canonical Structure prodR := Cmra (prod A B) prod_cmra_mixin. Lemma pair_op (a a' : A) (b b' : B) : (a ⋅ a', b ⋅ b') = (a, b) ⋅ (a', b'). Proof. done. Qed. Lemma pair_valid (a : A) (b : B) : ✓ (a, b) ↔ ✓ a ∧ ✓ b. Proof. done. Qed. Lemma pair_validN (a : A) (b : B) n : ✓{n} (a, b) ↔ ✓{n} a ∧ ✓{n} b. Proof. done. Qed. Lemma pair_included (a a' : A) (b b' : B) : (a, b) ≼ (a', b') ↔ a ≼ a' ∧ b ≼ b'. Proof. apply prod_included. Qed. Lemma pair_includedN (a a' : A) (b b' : B) n : (a, b) ≼{n} (a', b') ↔ a ≼{n} a' ∧ b ≼{n} b'. Proof. apply prod_includedN. Qed. Lemma pair_pcore (a : A) (b : B) : pcore (a, b) = c1 ← pcore a; c2 ← pcore b; Some (c1, c2). Proof. done. Qed. Lemma pair_core `{!CmraTotal A, !CmraTotal B} (a : A) (b : B) : core (a, b) = (core a, core b). Proof. rewrite /core {1}/pcore /=. rewrite (cmra_pcore_core a) /= (cmra_pcore_core b). done. Qed. Global Instance prod_cmra_total : CmraTotal A → CmraTotal B → CmraTotal prodR. Proof. intros H1 H2 [a b]. destruct (H1 a) as [ca ?], (H2 b) as [cb ?]. exists (ca,cb); by simplify_option_eq. Qed. Global Instance prod_cmra_discrete : CmraDiscrete A → CmraDiscrete B → CmraDiscrete prodR. Proof. split; [apply _|]. by intros ? []; split; apply cmra_discrete_valid. Qed. (* FIXME(Coq #6294): This is not an instance because we need it to use the new unification. *) Lemma pair_core_id x y : CoreId x → CoreId y → CoreId (x,y). Proof. by rewrite /CoreId prod_pcore_Some'. Qed. Global Instance pair_exclusive_l x y : Exclusive x → Exclusive (x,y). Proof. by intros ?[][?%exclusive0_l]. Qed. Global Instance pair_exclusive_r x y : Exclusive y → Exclusive (x,y). Proof. by intros ?[][??%exclusive0_l]. Qed. Global Instance pair_cancelable x y : Cancelable x → Cancelable y → Cancelable (x,y). Proof. intros ???[][][][]. constructor; simpl in *; by eapply cancelableN. Qed. Global Instance pair_id_free_l x y : IdFree x → IdFree (x,y). Proof. move=> Hx [a b] [? _] [/=? _]. apply (Hx a); eauto. Qed. Global Instance pair_id_free_r x y : IdFree y → IdFree (x,y). Proof. move=> Hy [a b] [_ ?] [_ /=?]. apply (Hy b); eauto. Qed. End prod. (* Registering as [Hint Extern] with new unification. *) Global Hint Extern 4 (CoreId _) => notypeclasses refine (pair_core_id _ _ _ _) : typeclass_instances. Global Arguments prodR : clear implicits. Section prod_unit. Context {A B : ucmra}. Local Instance prod_unit_instance `{Unit A, Unit B} : Unit (A * B) := (ε, ε). Lemma prod_ucmra_mixin : UcmraMixin (A * B). Proof. split. - split; apply ucmra_unit_valid. - by split; rewrite /=left_id. - rewrite prod_pcore_Some'; split; apply (core_id _). Qed. Canonical Structure prodUR := Ucmra (prod A B) prod_ucmra_mixin. Lemma pair_split (a : A) (b : B) : (a, b) ≡ (a, ε) ⋅ (ε, b). Proof. by rewrite -pair_op left_id right_id. Qed. Lemma pair_split_L `{!LeibnizEquiv A, !LeibnizEquiv B} (x : A) (y : B) : (x, y) = (x, ε) ⋅ (ε, y). Proof. unfold_leibniz. apply pair_split. Qed. Lemma pair_op_1 (a a': A) : (a ⋅ a', ε) ≡@{A*B} (a, ε) ⋅ (a', ε). Proof. by rewrite -pair_op ucmra_unit_left_id. Qed. Lemma pair_op_1_L `{!LeibnizEquiv A, !LeibnizEquiv B} (a a': A) : (a ⋅ a', ε) =@{A*B} (a, ε) ⋅ (a', ε). Proof. unfold_leibniz. apply pair_op_1. Qed. Lemma pair_op_2 (b b': B) : (ε, b ⋅ b') ≡@{A*B} (ε, b) ⋅ (ε, b'). Proof. by rewrite -pair_op ucmra_unit_left_id. Qed. Lemma pair_op_2_L `{!LeibnizEquiv A, !LeibnizEquiv B} (b b': B) : (ε, b ⋅ b') =@{A*B} (ε, b) ⋅ (ε, b'). Proof. unfold_leibniz. apply pair_op_2. Qed. End prod_unit. Global Arguments prodUR : clear implicits. Global Instance prod_map_cmra_morphism {A A' B B' : cmra} (f : A → A') (g : B → B') : CmraMorphism f → CmraMorphism g → CmraMorphism (prod_map f g). Proof. split; first apply _. - by intros n x [??]; split; simpl; apply cmra_morphism_validN. - intros x. etrans; last apply (reflexivity (mbind _ _)). etrans; first apply (reflexivity (_ <$> mbind _ _)). simpl. assert (Hf := cmra_morphism_pcore f (x.1)). destruct (pcore (f (x.1))), (pcore (x.1)); inversion_clear Hf=>//=. assert (Hg := cmra_morphism_pcore g (x.2)). destruct (pcore (g (x.2))), (pcore (x.2)); inversion_clear Hg=>//=. by setoid_subst. - intros. by rewrite /prod_map /= !cmra_morphism_op. Qed. Program Definition prodRF (F1 F2 : rFunctor) : rFunctor := {| rFunctor_car A _ B _ := prodR (rFunctor_car F1 A B) (rFunctor_car F2 A B); rFunctor_map A1 _ A2 _ B1 _ B2 _ fg := prodO_map (rFunctor_map F1 fg) (rFunctor_map F2 fg) |}. Next Obligation. intros F1 F2 A1 ? A2 ? B1 ? B2 ? n ???. by apply prodO_map_ne; apply rFunctor_map_ne. Qed. Next Obligation. by intros F1 F2 A ? B ? [??]; rewrite /= !rFunctor_map_id. Qed. Next Obligation. intros F1 F2 A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' [??]; simpl. by rewrite !rFunctor_map_compose. Qed. Notation "F1 * F2" := (prodRF F1%RF F2%RF) : rFunctor_scope. Global Instance prodRF_contractive F1 F2 : rFunctorContractive F1 → rFunctorContractive F2 → rFunctorContractive (prodRF F1 F2). Proof. intros ?? A1 ? A2 ? B1 ? B2 ? n ???; by apply prodO_map_ne; apply rFunctor_map_contractive. Qed. Program Definition prodURF (F1 F2 : urFunctor) : urFunctor := {| urFunctor_car A _ B _ := prodUR (urFunctor_car F1 A B) (urFunctor_car F2 A B); urFunctor_map A1 _ A2 _ B1 _ B2 _ fg := prodO_map (urFunctor_map F1 fg) (urFunctor_map F2 fg) |}. Next Obligation. intros F1 F2 A1 ? A2 ? B1 ? B2 ? n ???. by apply prodO_map_ne; apply urFunctor_map_ne. Qed. Next Obligation. by intros F1 F2 A ? B ? [??]; rewrite /= !urFunctor_map_id. Qed. Next Obligation. intros F1 F2 A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' [??]; simpl. by rewrite !urFunctor_map_compose. Qed. Notation "F1 * F2" := (prodURF F1%URF F2%URF) : urFunctor_scope. Global Instance prodURF_contractive F1 F2 : urFunctorContractive F1 → urFunctorContractive F2 → urFunctorContractive (prodURF F1 F2). Proof. intros ?? A1 ? A2 ? B1 ? B2 ? n ???; by apply prodO_map_ne; apply urFunctor_map_contractive. Qed. (** ** CMRA for the option type *) Section option. Context {A : cmra}. Implicit Types a b : A. Implicit Types ma mb : option A. Local Arguments core _ _ !_ /. Local Arguments pcore _ _ !_ /. Local Instance option_valid_instance : Valid (option A) := λ ma, match ma with Some a => ✓ a | None => True end. Local Instance option_validN_instance : ValidN (option A) := λ n ma, match ma with Some a => ✓{n} a | None => True end. Local Instance option_pcore_instance : PCore (option A) := λ ma, Some (ma ≫= pcore). Local Arguments option_pcore_instance !_ /. Local Instance option_op_instance : Op (option A) := union_with (λ a b, Some (a ⋅ b)). Definition Some_valid a : ✓ Some a ↔ ✓ a := reflexivity _. Definition Some_validN a n : ✓{n} Some a ↔ ✓{n} a := reflexivity _. Definition Some_op a b : Some (a ⋅ b) = Some a ⋅ Some b := eq_refl. Lemma Some_core `{!CmraTotal A} a : Some (core a) = core (Some a). Proof. rewrite /core /=. by destruct (cmra_total a) as [? ->]. Qed. Lemma pcore_Some a : pcore (Some a) = Some (pcore a). Proof. done. Qed. Lemma Some_op_opM a ma : Some a ⋅ ma = Some (a ⋅? ma). Proof. by destruct ma. Qed. Lemma option_included ma mb : ma ≼ mb ↔ ma = None ∨ ∃ a b, ma = Some a ∧ mb = Some b ∧ (a ≡ b ∨ a ≼ b). Proof. split. - intros [mc Hmc]. destruct ma as [a|]; [right|by left]. destruct mb as [b|]; [exists a, b|destruct mc; inversion_clear Hmc]. destruct mc as [c|]; inversion_clear Hmc; split_and?; auto; setoid_subst; eauto. - intros [->|(a&b&->&->&[Hc|[c Hc]])]. + exists mb. by destruct mb. + exists None; by constructor. + exists (Some c); by constructor. Qed. Lemma option_included_total `{!CmraTotal A} ma mb : ma ≼ mb ↔ ma = None ∨ ∃ a b, ma = Some a ∧ mb = Some b ∧ a ≼ b. Proof. rewrite option_included. split; last naive_solver. intros [->|(a&b&->&->&[Hab|?])]; [by eauto| |by eauto 10]. right. exists a, b. by rewrite {3}Hab. Qed. Lemma option_includedN n ma mb : ma ≼{n} mb ↔ ma = None ∨ ∃ x y, ma = Some x ∧ mb = Some y ∧ (x ≡{n}≡ y ∨ x ≼{n} y). Proof. split. - intros [mc Hmc]. destruct ma as [a|]; [right|by left]. destruct mb as [b|]; [exists a, b|destruct mc; inversion_clear Hmc]. destruct mc as [c|]; inversion_clear Hmc; split_and?; auto; ofe_subst; eauto using cmra_includedN_l. - intros [->|(a&y&->&->&[Hc|[c Hc]])]. + exists mb. by destruct mb. + exists None; by constructor. + exists (Some c); by constructor. Qed. Lemma option_includedN_total `{!CmraTotal A} n ma mb : ma ≼{n} mb ↔ ma = None ∨ ∃ a b, ma = Some a ∧ mb = Some b ∧ a ≼{n} b. Proof. rewrite option_includedN. split; last naive_solver. intros [->|(a&b&->&->&[Hab|?])]; [by eauto| |by eauto 10]. right. exists a, b. by rewrite {3}Hab. Qed. (* See below for more [included] lemmas. *) Lemma option_cmra_mixin : CmraMixin (option A). Proof. apply cmra_total_mixin. - eauto. - by intros [a|] n; destruct 1; constructor; ofe_subst. - destruct 1; by ofe_subst. - by destruct 1; rewrite /validN /option_validN_instance //=; ofe_subst. - intros [a|]; [apply cmra_valid_validN|done]. - intros n [a|]; unfold validN, option_validN_instance; eauto using cmra_validN_S. - intros [a|] [b|] [c|]; constructor; rewrite ?assoc; auto. - intros [a|] [b|]; constructor; rewrite 1?comm; auto. - intros [a|]; simpl; auto. destruct (pcore a) as [ca|] eqn:?; constructor; eauto using cmra_pcore_l. - intros [a|]; simpl; auto. destruct (pcore a) as [ca|] eqn:?; simpl; eauto using cmra_pcore_idemp. - intros ma mb; setoid_rewrite option_included. intros [->|(a&b&->&->&[?|?])]; simpl; eauto. + destruct (pcore a) as [ca|] eqn:?; eauto. destruct (cmra_pcore_proper a b ca) as (?&?&?); eauto 10. + destruct (pcore a) as [ca|] eqn:?; eauto. destruct (cmra_pcore_mono a b ca) as (?&?&?); eauto 10. - intros n [a|] [b|]; rewrite /validN /option_validN_instance /=; eauto using cmra_validN_op_l. - intros n ma mb1 mb2. destruct ma as [a|], mb1 as [b1|], mb2 as [b2|]; intros Hx Hx'; (try by exfalso; inversion Hx'); (try (apply (inj Some) in Hx')). + destruct (cmra_extend n a b1 b2) as (c1&c2&?&?&?); auto. by exists (Some c1), (Some c2); repeat constructor. + by exists (Some a), None; repeat constructor. + by exists None, (Some a); repeat constructor. + exists None, None; repeat constructor. Qed. Canonical Structure optionR := Cmra (option A) option_cmra_mixin. Global Instance option_cmra_discrete : CmraDiscrete A → CmraDiscrete optionR. Proof. split; [apply _|]. by intros [a|]; [apply (cmra_discrete_valid a)|]. Qed. Local Instance option_unit_instance : Unit (option A) := None. Lemma option_ucmra_mixin : UcmraMixin optionR. Proof. split; [done| |done]. by intros []. Qed. Canonical Structure optionUR := Ucmra (option A) option_ucmra_mixin. (** Misc *) Lemma op_None ma mb : ma ⋅ mb = None ↔ ma = None ∧ mb = None. Proof. destruct ma, mb; naive_solver. Qed. Lemma op_is_Some ma mb : is_Some (ma ⋅ mb) ↔ is_Some ma ∨ is_Some mb. Proof. rewrite -!not_eq_None_Some op_None. destruct ma, mb; naive_solver. Qed. (* When the goal is already of the form [None ⋅ x], the [LeftId] instance for [ε] does not fire. *) Global Instance op_None_left_id : LeftId (=) None (@op (option A) _). Proof. intros [a|]; done. Qed. Global Instance op_None_right_id : RightId (=) None (@op (option A) _). Proof. intros [a|]; done. Qed. Lemma cmra_opM_opM_assoc a mb mc : a ⋅? mb ⋅? mc ≡ a ⋅? (mb ⋅ mc). Proof. destruct mb, mc; by rewrite /= -?assoc. Qed. Lemma cmra_opM_opM_assoc_L `{!LeibnizEquiv A} a mb mc : a ⋅? mb ⋅? mc = a ⋅? (mb ⋅ mc). Proof. unfold_leibniz. apply cmra_opM_opM_assoc. Qed. Lemma cmra_opM_opM_swap a mb mc : a ⋅? mb ⋅? mc ≡ a ⋅? mc ⋅? mb. Proof. by rewrite !cmra_opM_opM_assoc (comm _ mb). Qed. Lemma cmra_opM_opM_swap_L `{!LeibnizEquiv A} a mb mc : a ⋅? mb ⋅? mc = a ⋅? mc ⋅? mb. Proof. by rewrite !cmra_opM_opM_assoc_L (comm_L _ mb). Qed. Lemma cmra_opM_fmap_Some ma1 ma2 : ma1 ⋅? (Some <$> ma2) = ma1 ⋅ ma2. Proof. by destruct ma1, ma2. Qed. Global Instance Some_core_id a : CoreId a → CoreId (Some a). Proof. by constructor. Qed. Global Instance option_core_id ma : (∀ x : A, CoreId x) → CoreId ma. Proof. intros. destruct ma; apply _. Qed. Lemma exclusiveN_Some_l n a `{!Exclusive a} mb : ✓{n} (Some a ⋅ mb) → mb = None. Proof. destruct mb; last done. move=> /(exclusiveN_l _ a) []. Qed. Lemma exclusiveN_Some_r n a `{!Exclusive a} mb : ✓{n} (mb ⋅ Some a) → mb = None. Proof. rewrite comm. by apply exclusiveN_Some_l. Qed. Lemma exclusive_Some_l a `{!Exclusive a} mb : ✓ (Some a ⋅ mb) → mb = None. Proof. destruct mb; last done. move=> /(exclusive_l a) []. Qed. Lemma exclusive_Some_r a `{!Exclusive a} mb : ✓ (mb ⋅ Some a) → mb = None. Proof. rewrite comm. by apply exclusive_Some_l. Qed. Lemma Some_includedN n a b : Some a ≼{n} Some b ↔ a ≡{n}≡ b ∨ a ≼{n} b. Proof. rewrite option_includedN; naive_solver. Qed. Lemma Some_includedN_1 n a b : Some a ≼{n} Some b → a ≡{n}≡ b ∨ a ≼{n} b. Proof. rewrite Some_includedN. auto. Qed. Lemma Some_includedN_2 n a b : a ≡{n}≡ b ∨ a ≼{n} b → Some a ≼{n} Some b. Proof. rewrite Some_includedN. auto. Qed. Lemma Some_includedN_mono n a b : a ≼{n} b → Some a ≼{n} Some b. Proof. rewrite Some_includedN. auto. Qed. Lemma Some_includedN_refl n a b : a ≡{n}≡ b → Some a ≼{n} Some b. Proof. rewrite Some_includedN. auto. Qed. Lemma Some_includedN_is_Some n x mb : Some x ≼{n} mb → is_Some mb. Proof. rewrite option_includedN. naive_solver. Qed. Lemma Some_included a b : Some a ≼ Some b ↔ a ≡ b ∨ a ≼ b. Proof. rewrite option_included; naive_solver. Qed. Lemma Some_included_1 a b : Some a ≼ Some b → a ≡ b ∨ a ≼ b. Proof. rewrite Some_included. auto. Qed. Lemma Some_included_2 a b : a ≡ b ∨ a ≼ b → Some a ≼ Some b. Proof. rewrite Some_included. auto. Qed. Lemma Some_included_mono a b : a ≼ b → Some a ≼ Some b. Proof. rewrite Some_included. auto. Qed. Lemma Some_included_refl a b : a ≡ b → Some a ≼ Some b. Proof. rewrite Some_included. auto. Qed. Lemma Some_included_is_Some x mb : Some x ≼ mb → is_Some mb. Proof. rewrite option_included. naive_solver. Qed. Lemma Some_includedN_opM n a b : Some a ≼{n} Some b ↔ ∃ mc, b ≡{n}≡ a ⋅? mc. Proof. rewrite /includedN. f_equiv=> mc. by rewrite -(inj_iff Some b) Some_op_opM. Qed. Lemma Some_included_opM a b : Some a ≼ Some b ↔ ∃ mc, b ≡ a ⋅? mc. Proof. rewrite /included. f_equiv=> mc. by rewrite -(inj_iff Some b) Some_op_opM. Qed. Lemma cmra_validN_Some_includedN n a b : ✓{n} a → Some b ≼{n} Some a → ✓{n} b. Proof. apply: (cmra_validN_includedN _ (Some _) (Some _)). Qed. Lemma cmra_valid_Some_included a b : ✓ a → Some b ≼ Some a → ✓ b. Proof. apply: (cmra_valid_included (Some _) (Some _)). Qed. Lemma Some_includedN_total `{!CmraTotal A} n a b : Some a ≼{n} Some b ↔ a ≼{n} b. Proof. rewrite Some_includedN. split; [|by eauto]. by intros [->|?]. Qed. Lemma Some_included_total `{!CmraTotal A} a b : Some a ≼ Some b ↔ a ≼ b. Proof. rewrite Some_included. split; [|by eauto]. by intros [->|?]. Qed. Lemma Some_includedN_exclusive n a `{!Exclusive a} b : Some a ≼{n} Some b → ✓{n} b → a ≡{n}≡ b. Proof. move=> /Some_includedN [//|/exclusive_includedN]; tauto. Qed. Lemma Some_included_exclusive a `{!Exclusive a} b : Some a ≼ Some b → ✓ b → a ≡ b. Proof. move=> /Some_included [//|/exclusive_included]; tauto. Qed. Lemma is_Some_includedN n ma mb : ma ≼{n} mb → is_Some ma → is_Some mb. Proof. rewrite -!not_eq_None_Some option_includedN. naive_solver. Qed. Lemma is_Some_included ma mb : ma ≼ mb → is_Some ma → is_Some mb. Proof. rewrite -!not_eq_None_Some option_included. naive_solver. Qed. Global Instance cancelable_Some a : IdFree a → Cancelable a → Cancelable (Some a). Proof. intros Hirr ? n [b|] [c|] ? EQ; inversion_clear EQ. - constructor. by apply (cancelableN a). - destruct (Hirr b); [|eauto using dist_le with lia]. by eapply (cmra_validN_op_l 0 a b), (cmra_validN_le n); last lia. - destruct (Hirr c); [|symmetry; eauto using dist_le with lia]. by eapply (cmra_validN_le n); last lia. - done. Qed. Global Instance option_cancelable (ma : option A) : (∀ a : A, IdFree a) → (∀ a : A, Cancelable a) → Cancelable ma. Proof. destruct ma; apply _. Qed. End option. Global Arguments optionR : clear implicits. Global Arguments optionUR : clear implicits. Section option_prod. Context {A B : cmra}. Implicit Types a : A. Implicit Types b : B. Lemma Some_pair_includedN n a1 a2 b1 b2 : Some (a1,b1) ≼{n} Some (a2,b2) → Some a1 ≼{n} Some a2 ∧ Some b1 ≼{n} Some b2. Proof. rewrite !Some_includedN. intros [[??]|[??]%prod_includedN]; eauto. Qed. Lemma Some_pair_includedN_l n a1 a2 b1 b2 : Some (a1,b1) ≼{n} Some (a2,b2) → Some a1 ≼{n} Some a2. Proof. intros. eapply Some_pair_includedN. done. Qed. Lemma Some_pair_includedN_r n a1 a2 b1 b2 : Some (a1,b1) ≼{n} Some (a2,b2) → Some b1 ≼{n} Some b2. Proof. intros. eapply Some_pair_includedN. done. Qed. Lemma Some_pair_includedN_total_1 `{CmraTotal A} n a1 a2 b1 b2 : Some (a1,b1) ≼{n} Some (a2,b2) → a1 ≼{n} a2 ∧ Some b1 ≼{n} Some b2. Proof. intros ?%Some_pair_includedN. by rewrite -(Some_includedN_total _ a1). Qed. Lemma Some_pair_includedN_total_2 `{CmraTotal B} n a1 a2 b1 b2 : Some (a1,b1) ≼{n} Some (a2,b2) → Some a1 ≼{n} Some a2 ∧ b1 ≼{n} b2. Proof. intros ?%Some_pair_includedN. by rewrite -(Some_includedN_total _ b1). Qed. Lemma Some_pair_included a1 a2 b1 b2 : Some (a1,b1) ≼ Some (a2,b2) → Some a1 ≼ Some a2 ∧ Some b1 ≼ Some b2. Proof. rewrite !Some_included. intros [[??]|[??]%prod_included]; eauto. Qed. Lemma Some_pair_included_l a1 a2 b1 b2 : Some (a1,b1) ≼ Some (a2,b2) → Some a1 ≼ Some a2. Proof. intros. eapply Some_pair_included. done. Qed. Lemma Some_pair_included_r a1 a2 b1 b2 : Some (a1,b1) ≼ Some (a2,b2) → Some b1 ≼ Some b2. Proof. intros. eapply Some_pair_included. done. Qed. Lemma Some_pair_included_total_1 `{CmraTotal A} a1 a2 b1 b2 : Some (a1,b1) ≼ Some (a2,b2) → a1 ≼ a2 ∧ Some b1 ≼ Some b2. Proof. intros ?%Some_pair_included. by rewrite -(Some_included_total a1). Qed. Lemma Some_pair_included_total_2 `{CmraTotal B} a1 a2 b1 b2 : Some (a1,b1) ≼ Some (a2,b2) → Some a1 ≼ Some a2 ∧ b1 ≼ b2. Proof. intros ?%Some_pair_included. by rewrite -(Some_included_total b1). Qed. End option_prod. Lemma option_fmap_mono {A B : cmra} (f : A → B) (ma mb : option A) : Proper ((≡) ==> (≡)) f → (∀ a b, a ≼ b → f a ≼ f b) → ma ≼ mb → f <$> ma ≼ f <$> mb. Proof. intros ??. rewrite !option_included; intros [->|(a&b&->&->&?)]; naive_solver. Qed. Global Instance option_fmap_cmra_morphism {A B : cmra} (f: A → B) `{!CmraMorphism f} : CmraMorphism (fmap f : option A → option B). Proof. split; first apply _. - intros n [a|] ?; rewrite /cmra_validN //=. by apply (cmra_morphism_validN f). - move=> [a|] //. by apply Some_proper, cmra_morphism_pcore. - move=> [a|] [b|] //=. by rewrite (cmra_morphism_op f). Qed. Program Definition optionURF (F : rFunctor) : urFunctor := {| urFunctor_car A _ B _ := optionUR (rFunctor_car F A B); urFunctor_map A1 _ A2 _ B1 _ B2 _ fg := optionO_map (rFunctor_map F fg) |}. Next Obligation. intros F A1 ? A2 ? B1 ? B2 ? n f g Hfg. by apply optionO_map_ne, rFunctor_map_ne. Qed. Next Obligation. intros F A ? B ? x. rewrite /= -{2}(option_fmap_id x). apply option_fmap_equiv_ext=>y; apply rFunctor_map_id. Qed. Next Obligation. intros F A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x. rewrite /= -option_fmap_compose. apply option_fmap_equiv_ext=>y; apply rFunctor_map_compose. Qed. Global Instance optionURF_contractive F : rFunctorContractive F → urFunctorContractive (optionURF F). Proof. intros ? A1 ? A2 ? B1 ? B2 ? n f g Hfg. by apply optionO_map_ne, rFunctor_map_contractive. Qed. Program Definition optionRF (F : rFunctor) : rFunctor := {| rFunctor_car A _ B _ := optionR (rFunctor_car F A B); rFunctor_map A1 _ A2 _ B1 _ B2 _ fg := optionO_map (rFunctor_map F fg) |}. Solve Obligations with apply optionURF. Global Instance optionRF_contractive F : rFunctorContractive F → rFunctorContractive (optionRF F). Proof. apply optionURF_contractive. Qed. (* Dependently-typed functions over a discrete domain *) Section discrete_fun_cmra. Context {A : Type} {B : A → ucmra}. Implicit Types f g : discrete_fun B. Local Instance discrete_fun_op_instance : Op (discrete_fun B) := λ f g x, f x ⋅ g x. Local Instance discrete_fun_pcore_instance : PCore (discrete_fun B) := λ f, Some (λ x, core (f x)). Local Instance discrete_fun_valid_instance : Valid (discrete_fun B) := λ f, ∀ x, ✓ f x. Local Instance discrete_fun_validN_instance : ValidN (discrete_fun B) := λ n f, ∀ x, ✓{n} f x. Definition discrete_fun_lookup_op f g x : (f ⋅ g) x = f x ⋅ g x := eq_refl. Definition discrete_fun_lookup_core f x : (core f) x = core (f x) := eq_refl. Lemma discrete_fun_included_spec_1 (f g : discrete_fun B) x : f ≼ g → f x ≼ g x. Proof. by intros [h Hh]; exists (h x); rewrite /op /discrete_fun_op_instance (Hh x). Qed. Lemma discrete_fun_included_spec `{Hfin : Finite A} (f g : discrete_fun B) : f ≼ g ↔ ∀ x, f x ≼ g x. Proof. split; [by intros; apply discrete_fun_included_spec_1|]. intros [h ?]%finite_choice; by exists h. Qed. Lemma discrete_fun_cmra_mixin : CmraMixin (discrete_fun B). Proof. apply cmra_total_mixin. - eauto. - intros n f1 f2 f3 Hf x. by rewrite discrete_fun_lookup_op (Hf x). - intros n f1 f2 Hf x. by rewrite discrete_fun_lookup_core (Hf x). - intros n f1 f2 Hf ? x. by rewrite -(Hf x). - intros g; split. + intros Hg n i; apply cmra_valid_validN, Hg. + intros Hg i; apply cmra_valid_validN=> n; apply Hg. - intros n f Hf x; apply cmra_validN_S, Hf. - intros f1 f2 f3 x. by rewrite discrete_fun_lookup_op assoc. - intros f1 f2 x. by rewrite discrete_fun_lookup_op comm. - intros f x. by rewrite discrete_fun_lookup_op discrete_fun_lookup_core cmra_core_l. - intros f x. by rewrite discrete_fun_lookup_core cmra_core_idemp. - intros f1 f2 Hf12. exists (core f2)=>x. rewrite discrete_fun_lookup_op. apply (discrete_fun_included_spec_1 _ _ x), (cmra_core_mono (f1 x)) in Hf12. rewrite !discrete_fun_lookup_core. destruct Hf12 as [? ->]. rewrite assoc -cmra_core_dup //. - intros n f1 f2 Hf x. apply cmra_validN_op_l with (f2 x), Hf. - intros n f f1 f2 Hf Hf12. assert (FUN := λ x, cmra_extend n (f x) (f1 x) (f2 x) (Hf x) (Hf12 x)). exists (λ x, projT1 (FUN x)), (λ x, proj1_sig (projT2 (FUN x))). split; [|split]=>x; [rewrite discrete_fun_lookup_op| |]; by destruct (FUN x) as (?&?&?&?&?). Qed. Canonical Structure discrete_funR := Cmra (discrete_fun B) discrete_fun_cmra_mixin. Local Instance discrete_fun_unit_instance : Unit (discrete_fun B) := λ x, ε. Definition discrete_fun_lookup_empty x : ε x = ε := eq_refl. Lemma discrete_fun_ucmra_mixin : UcmraMixin (discrete_fun B). Proof. split. - intros x. apply ucmra_unit_valid. - intros f x. by rewrite discrete_fun_lookup_op left_id. - constructor=> x. apply core_id_core, _. Qed. Canonical Structure discrete_funUR := Ucmra (discrete_fun B) discrete_fun_ucmra_mixin. Global Instance discrete_fun_unit_discrete : (∀ i, Discrete (ε : B i)) → Discrete (ε : discrete_fun B). Proof. intros ? f Hf x. by apply: discrete. Qed. End discrete_fun_cmra. Global Arguments discrete_funR {_} _. Global Arguments discrete_funUR {_} _. Global Instance discrete_fun_map_cmra_morphism {A} {B1 B2 : A → ucmra} (f : ∀ x, B1 x → B2 x) : (∀ x, CmraMorphism (f x)) → CmraMorphism (discrete_fun_map f). Proof. split; first apply _. - intros n g Hg x. rewrite /discrete_fun_map. apply (cmra_morphism_validN (f _)), Hg. - intros. apply Some_proper=>i. apply (cmra_morphism_core (f i)). - intros g1 g2 i. by rewrite /discrete_fun_map discrete_fun_lookup_op cmra_morphism_op. Qed. Program Definition discrete_funURF {C} (F : C → urFunctor) : urFunctor := {| urFunctor_car A _ B _ := discrete_funUR (λ c, urFunctor_car (F c) A B); urFunctor_map A1 _ A2 _ B1 _ B2 _ fg := discrete_funO_map (λ c, urFunctor_map (F c) fg) |}. Next Obligation. intros C F A1 ? A2 ? B1 ? B2 ? n ?? g. by apply discrete_funO_map_ne=>?; apply urFunctor_map_ne. Qed. Next Obligation. intros C F A ? B ? g; simpl. rewrite -{2}(discrete_fun_map_id g). apply discrete_fun_map_ext=> y; apply urFunctor_map_id. Qed. Next Obligation. intros C F A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f1 f2 f1' f2' g. rewrite /=-discrete_fun_map_compose. apply discrete_fun_map_ext=> y; apply urFunctor_map_compose. Qed. Global Instance discrete_funURF_contractive {C} (F : C → urFunctor) : (∀ c, urFunctorContractive (F c)) → urFunctorContractive (discrete_funURF F). Proof. intros ? A1 ? A2 ? B1 ? B2 ? n ?? g. by apply discrete_funO_map_ne=> c; apply urFunctor_map_contractive. Qed. (** * Constructing a camera [B] through a mapping into [A] The mapping may restrict the domain (i.e., we have an injection from [B] to [A], not a bijection) and validity. These two restrictions work on opposite "ends" of [A] according to [≼]: domain restriction must prove that when an element is in the domain, so is its composition with other elements; validity restriction must prove that if the composition of two elements is valid, then so are both of the elements. The "domain" is the image of [g] in [A], or equivalently the part of [A] where [f] returns [Some]. *) Lemma inj_cmra_mixin_restrict_validity {A : cmra} {B : ofe} `{!PCore B, !Op B, !Valid B, !ValidN B} (f : A → option B) (g : B → A) (* [g] is proper/non-expansive and injective w.r.t. OFE equality *) (g_dist : ∀ n y1 y2, y1 ≡{n}≡ y2 ↔ g y1 ≡{n}≡ g y2) (* [g] is surjective into the part of [A] where [is_Some ∘ f] holds (and [f] its inverse) *) (gf_dist : ∀ (x : A) (y : B) n, f x ≡{n}≡ Some y ↔ g y ≡{n}≡ x) (* [g] commutes with [pcore] (on the part where it is defined) and [op] *) (g_pcore_dist : ∀ (y cy : B) n, pcore y ≡{n}≡ Some cy ↔ pcore (g y) ≡{n}≡ Some (g cy)) (g_op : ∀ (y1 y2 : B), g (y1 ⋅ y2) ≡ g y1 ⋅ g y2) (* [g] also commutes with [opM] when the right-hand side is produced by [f], and cancels the [f]. In particular this axiom implies that when taking an element in the domain ([g y]), its composition with *any* [x : A] is still in the domain, and [f] computes the preimage properly. Note that just requiring "the composition of two elements from the domain is in the domain" is insufficient for this lemma to hold. [g_op] already shows that this is the case, but the issue is that in [pcore_mono] we obtain a [g y1 ≼ g y2], and the existentially quantified "remainder" in the [≼] has no reason to be in the domain, so [g_op] is too weak to turn this into some relation between [y1] and [y2] in [B]. At the same time, [g_opM_f] does not impl [g_op] since we need [g_op] to prove that [⋅] in [B] respects [≡]. Therefore both [g_op] and [g_opM_f] are required for this lemma to work. *) (g_opM_f : ∀ (x : A) (y : B), g (y ⋅? f x) ≡ g y ⋅ x) (* The validity predicate on [B] restricts the one on [A] *) (g_validN : ∀ n y, ✓{n} y → ✓{n} (g y)) (* The validity predicate on [B] satisfies the laws of validity *) (valid_validN_ne : ∀ n, Proper (dist n ==> impl) (validN (A:=B) n)) (valid_rvalidN : ∀ y : B, ✓ y ↔ ∀ n, ✓{n} y) (validN_S : ∀ n (y : B), ✓{S n} y → ✓{n} y) (validN_op_l : ∀ n (y1 y2 : B), ✓{n} (y1 ⋅ y2) → ✓{n} y1) : CmraMixin B. Proof. (* Some general derived facts that will be useful later. *) assert (g_equiv : ∀ y1 y2, y1 ≡ y2 ↔ g y1 ≡ g y2). { intros ??. rewrite !equiv_dist. naive_solver. } assert (g_pcore : ∀ (y cy : B), pcore y ≡ Some cy ↔ pcore (g y) ≡ Some (g cy)). { intros. rewrite !equiv_dist. naive_solver. } assert (gf : ∀ x y, f x ≡ Some y ↔ g y ≡ x). { intros. rewrite !equiv_dist. naive_solver. } assert (fg : ∀ y, f (g y) ≡ Some y). { intros. apply gf. done. } assert (g_ne : NonExpansive g). { intros n ???. apply g_dist. done. } (* Some of the CMRA properties are useful in proving the others. *) assert (b_pcore_l' : ∀ y cy : B, pcore y ≡ Some cy → cy ⋅ y ≡ y). { intros y cy Hy. apply g_equiv. rewrite g_op. apply cmra_pcore_l'. apply g_pcore. done. } assert (b_pcore_idemp : ∀ y cy : B, pcore y ≡ Some cy → pcore cy ≡ Some cy). { intros y cy Hy. eapply g_pcore, cmra_pcore_idemp', g_pcore. done. } (* Now prove all the mixin laws. *) split. - intros y n z1 z2 Hz%g_dist. apply g_dist. by rewrite !g_op Hz. - intros n y1 y2 cy Hy%g_dist Hy1. assert (g <$> pcore y2 ≡{n}≡ Some (g cy)) as (cx & (cy'&->&->)%fmap_Some_1 & ?%g_dist)%dist_Some_inv_r'; [|by eauto]. assert (Hgcy : pcore (g y1) ≡ Some (g cy)). { apply g_pcore. rewrite Hy1. done. } rewrite equiv_dist in Hgcy. specialize (Hgcy n). rewrite Hy in Hgcy. apply g_pcore_dist in Hgcy. rewrite Hgcy. done. - done. - done. - done. - intros y1 y2 y3. apply g_equiv. by rewrite !g_op assoc. - intros y1 y2. apply g_equiv. by rewrite !g_op comm. - intros y cy Hcy. apply b_pcore_l'. by rewrite Hcy. - intros y cy Hcy. eapply b_pcore_idemp. by rewrite -Hcy. - intros y1 y2 cy [z Hy2] Hy1. destruct (cmra_pcore_mono' (g y1) (g y2) (g cy)) as (cx&Hcgy2&[x Hcx]). { exists (g z). rewrite -g_op. by apply g_equiv. } { apply g_pcore. rewrite Hy1 //. } apply (reflexive_eq (R:=equiv)) in Hcgy2. rewrite -g_opM_f in Hcx. rewrite Hcx in Hcgy2. apply g_pcore in Hcgy2. apply Some_equiv_eq in Hcgy2 as [cy' [-> Hcy']]. eexists. split; first done. destruct (f x) as [y|]. + exists y. done. + exists cy. apply (reflexive_eq (R:=equiv)), b_pcore_idemp, b_pcore_l' in Hy1. rewrite Hy1 //. - done. - intros n y z1 z2 ?%g_validN ?. destruct (cmra_extend n (g y) (g z1) (g z2)) as (x1&x2&Hgy&Hx1&Hx2). { done. } { rewrite -g_op. by apply g_dist. } symmetry in Hx1, Hx2. apply gf_dist in Hx1, Hx2. destruct (f x1) as [y1|] eqn:Hy1; last first. { exfalso. inversion Hx1. } destruct (f x2) as [y2|] eqn:Hy2; last first. { exfalso. inversion Hx2. } exists y1, y2. split_and!. + apply g_equiv. rewrite Hgy g_op. f_equiv; symmetry; apply gf; rewrite ?Hy1 ?Hy2 //. + apply g_dist. apply (inj Some) in Hx1. rewrite Hx1 //. + apply g_dist. apply (inj Some) in Hx2. rewrite Hx2 //. Qed. (** Constructing a CMRA through an isomorphism that may restrict validity. *) Lemma iso_cmra_mixin_restrict_validity {A : cmra} {B : ofe} `{!PCore B, !Op B, !Valid B, !ValidN B} (f : A → B) (g : B → A) (* [g] is proper/non-expansive and injective w.r.t. setoid and OFE equality *) (g_dist : ∀ n y1 y2, y1 ≡{n}≡ y2 ↔ g y1 ≡{n}≡ g y2) (* [g] is surjective (and [f] its inverse) *) (gf : ∀ x : A, g (f x) ≡ x) (* [g] commutes with [pcore] and [op] *) (g_pcore : ∀ y : B, pcore (g y) ≡ g <$> pcore y) (g_op : ∀ y1 y2, g (y1 ⋅ y2) ≡ g y1 ⋅ g y2) (* The validity predicate on [B] restricts the one on [A] *) (g_validN : ∀ n y, ✓{n} y → ✓{n} (g y)) (* The validity predicate on [B] satisfies the laws of validity *) (valid_validN_ne : ∀ n, Proper (dist n ==> impl) (validN (A:=B) n)) (valid_rvalidN : ∀ y : B, ✓ y ↔ ∀ n, ✓{n} y) (validN_S : ∀ n (y : B), ✓{S n} y → ✓{n} y) (validN_op_l : ∀ n (y1 y2 : B), ✓{n} (y1 ⋅ y2) → ✓{n} y1) : CmraMixin B. Proof. assert (g_ne : NonExpansive g). { intros n ???. apply g_dist. done. } assert (g_equiv : ∀ y1 y2, y1 ≡ y2 ↔ g y1 ≡ g y2). { intros ??. split; intros ?; apply equiv_dist; intros; apply g_dist, equiv_dist; done. } apply (inj_cmra_mixin_restrict_validity (λ x, Some (f x)) g); try done. - intros. split. + intros Hy%(inj Some). rewrite -Hy gf //. + intros ?. f_equiv. apply g_dist. rewrite gf. done. - intros. rewrite g_pcore. split. + intros ->. done. + intros (? & -> & ->%g_dist)%fmap_Some_dist. done. - intros ??. simpl. rewrite g_op gf //. Qed. (** * Constructing a camera through an isomorphism *) Lemma iso_cmra_mixin {A : cmra} {B : ofe} `{!PCore B, !Op B, !Valid B, !ValidN B} (f : A → B) (g : B → A) (* [g] is proper/non-expansive and injective w.r.t. OFE equality *) (g_dist : ∀ n y1 y2, y1 ≡{n}≡ y2 ↔ g y1 ≡{n}≡ g y2) (* [g] is surjective (and [f] its inverse) *) (gf : ∀ x : A, g (f x) ≡ x) (* [g] commutes with [pcore], [op], [valid], and [validN] *) (g_pcore : ∀ y : B, pcore (g y) ≡ g <$> pcore y) (g_op : ∀ y1 y2, g (y1 ⋅ y2) ≡ g y1 ⋅ g y2) (g_valid : ∀ y, ✓ (g y) ↔ ✓ y) (g_validN : ∀ n y, ✓{n} (g y) ↔ ✓{n} y) : CmraMixin B. Proof. apply (iso_cmra_mixin_restrict_validity f g); auto. - by intros n y ?%g_validN. - intros n y1 y2 Hy%g_dist Hy1. by rewrite -g_validN -Hy g_validN. - intros y. rewrite -g_valid cmra_valid_validN. naive_solver. - intros n y. rewrite -!g_validN. apply cmra_validN_S. - intros n y1 y2. rewrite -!g_validN g_op. apply cmra_validN_op_l. Qed. iris-iris-4.2.0/iris/algebra/cmra_big_op.v000066400000000000000000000032131460620107300204200ustar00rootroot00000000000000From stdpp Require Import gmap gmultiset. From iris.algebra Require Export big_op cmra. From iris.prelude Require Import options. (** Option *) Lemma big_opL_None {M : cmra} {A} (f : nat → A → option M) l : ([^op list] k↦x ∈ l, f k x) = None ↔ ∀ k x, l !! k = Some x → f k x = None. Proof. revert f. induction l as [|x l IH]=> f //=. rewrite op_None IH. split. - intros [??] [|k] y ?; naive_solver. - intros Hl. split; [by apply (Hl 0)|]. intros k. apply (Hl (S k)). Qed. Lemma big_opM_None {M : cmra} `{Countable K} {A} (f : K → A → option M) m : ([^op map] k↦x ∈ m, f k x) = None ↔ ∀ k x, m !! k = Some x → f k x = None. Proof. induction m as [|i x m ? IH] using map_ind=> /=. { by rewrite big_opM_empty. } rewrite -None_equiv_eq big_opM_insert // None_equiv_eq op_None IH. split. { intros [??] k y. rewrite lookup_insert_Some; naive_solver. } intros Hm; split. - apply (Hm i). by simplify_map_eq. - intros k y ?. apply (Hm k). by simplify_map_eq. Qed. Lemma big_opS_None {M : cmra} `{Countable A} (f : A → option M) X : ([^op set] x ∈ X, f x) = None ↔ ∀ x, x ∈ X → f x = None. Proof. induction X as [|x X ? IH] using set_ind_L. { by rewrite big_opS_empty. } rewrite -None_equiv_eq big_opS_insert // None_equiv_eq op_None IH. set_solver. Qed. Lemma big_opMS_None {M : cmra} `{Countable A} (f : A → option M) X : ([^op mset] x ∈ X, f x) = None ↔ ∀ x, x ∈ X → f x = None. Proof. induction X as [|x X IH] using gmultiset_ind. { rewrite big_opMS_empty. multiset_solver. } rewrite -None_equiv_eq big_opMS_disj_union big_opMS_singleton None_equiv_eq op_None IH. multiset_solver. Qed. iris-iris-4.2.0/iris/algebra/coPset.v000066400000000000000000000106531460620107300174220ustar00rootroot00000000000000From stdpp Require Export sets coPset. From iris.algebra Require Export cmra. From iris.algebra Require Import updates local_updates. From iris.prelude Require Import options. (** This is pretty much the same as algebra/gset, but I was not able to generalize the construction without breaking canonical structures. *) (* The union CMRA *) Section coPset. Implicit Types X Y : coPset. Canonical Structure coPsetO := discreteO coPset. Local Instance coPset_valid_instance : Valid coPset := λ _, True. Local Instance coPset_unit_instance : Unit coPset := (∅ : coPset). Local Instance coPset_op_instance : Op coPset := union. Local Instance coPset_pcore_instance : PCore coPset := Some. Lemma coPset_op X Y : X ⋅ Y = X ∪ Y. Proof. done. Qed. Lemma coPset_core X : core X = X. Proof. done. Qed. Lemma coPset_included X Y : X ≼ Y ↔ X ⊆ Y. Proof. split. - intros [Z ->]. rewrite coPset_op. set_solver. - intros (Z&->&?)%subseteq_disjoint_union_L. by exists Z. Qed. Lemma coPset_ra_mixin : RAMixin coPset. Proof. apply ra_total_mixin; eauto. - solve_proper. - solve_proper. - solve_proper. - intros X1 X2 X3. by rewrite !coPset_op assoc_L. - intros X1 X2. by rewrite !coPset_op comm_L. - intros X. by rewrite coPset_core idemp_L. Qed. Canonical Structure coPsetR := discreteR coPset coPset_ra_mixin. Global Instance coPset_cmra_discrete : CmraDiscrete coPsetR. Proof. apply discrete_cmra_discrete. Qed. Lemma coPset_ucmra_mixin : UcmraMixin coPset. Proof. split; [done | | done]. intros X. by rewrite coPset_op left_id_L. Qed. Canonical Structure coPsetUR := Ucmra coPset coPset_ucmra_mixin. 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. Proof. done. Qed. Lemma coPset_local_update X Y X' : X ⊆ X' → (X,Y) ~l~> (X',X'). Proof. intros (Z&->&?)%subseteq_disjoint_union_L. rewrite local_update_unital_discrete=> Z' _ /leibniz_equiv_iff->. split; first done. rewrite coPset_op. set_solver. Qed. End coPset. (* The disjoint union CMRA *) Inductive coPset_disj := | CoPset : coPset → coPset_disj | CoPsetBot : coPset_disj. Section coPset_disj. Local Arguments op _ _ !_ !_ /. Canonical Structure coPset_disjO := leibnizO coPset_disj. Local Instance coPset_disj_valid_instance : Valid coPset_disj := λ X, match X with CoPset _ => True | CoPsetBot => False end. Local Instance coPset_disj_unit_instance : Unit coPset_disj := CoPset ∅. Local Instance coPset_disj_op_instance : Op coPset_disj := λ X Y, match X, Y with | CoPset X, CoPset Y => if decide (X ## Y) then CoPset (X ∪ Y) else CoPsetBot | _, _ => CoPsetBot end. Local Instance coPset_disj_pcore_instance : PCore coPset_disj := λ _, Some ε. Ltac coPset_disj_solve := repeat (simpl || case_decide); first [apply (f_equal CoPset)|done|exfalso]; set_solver by eauto. Lemma coPset_disj_included X Y : CoPset X ≼ CoPset Y ↔ X ⊆ Y. Proof. split. - move=> [[Z|]]; simpl; try case_decide; set_solver. - intros (Z&->&?)%subseteq_disjoint_union_L. exists (CoPset Z). coPset_disj_solve. Qed. Lemma coPset_disj_valid_inv_l X Y : ✓ (CoPset X ⋅ Y) → ∃ Y', Y = CoPset Y' ∧ X ## Y'. Proof. destruct Y; repeat (simpl || case_decide); by eauto. Qed. Lemma coPset_disj_union X Y : X ## Y → CoPset X ⋅ CoPset Y = CoPset (X ∪ Y). Proof. intros. by rewrite /= decide_True. Qed. Lemma coPset_disj_valid_op X Y : ✓ (CoPset X ⋅ CoPset Y) ↔ X ## Y. Proof. simpl. case_decide; by split. Qed. Lemma coPset_disj_ra_mixin : RAMixin coPset_disj. Proof. apply ra_total_mixin; eauto. - intros [?|]; destruct 1; coPset_disj_solve. - by constructor. - by destruct 1. - intros [X1|] [X2|] [X3|]; coPset_disj_solve. - intros [X1|] [X2|]; coPset_disj_solve. - intros [X|]; coPset_disj_solve. - exists (CoPset ∅); coPset_disj_solve. - intros [X1|] [X2|]; coPset_disj_solve. Qed. Canonical Structure coPset_disjR := discreteR coPset_disj coPset_disj_ra_mixin. Global Instance coPset_disj_cmra_discrete : CmraDiscrete coPset_disjR. Proof. apply discrete_cmra_discrete. Qed. Lemma coPset_disj_ucmra_mixin : UcmraMixin coPset_disj. Proof. split; try apply _ || done. intros [X|]; coPset_disj_solve. Qed. Canonical Structure coPset_disjUR := Ucmra coPset_disj coPset_disj_ucmra_mixin. End coPset_disj. iris-iris-4.2.0/iris/algebra/cofe_solver.v000066400000000000000000000242521460620107300204730ustar00rootroot00000000000000From iris.algebra Require Export ofe. From iris.prelude Require Import options. Record solution (F : oFunctor) := Solution { solution_car :> ofe; solution_cofe : Cofe solution_car; solution_iso :> ofe_iso (oFunctor_apply F solution_car) solution_car; }. Global Existing Instance solution_cofe. Module solver. Section solver. Context (F : oFunctor) `{Fcontr : !oFunctorContractive F}. Context `{Fcofe : ∀ (T : ofe) `{!Cofe T}, Cofe (oFunctor_apply F T)}. Context `{Finh : Inhabited (oFunctor_apply F unitO)}. Notation map := (oFunctor_map F). Fixpoint A' (k : nat) : { C : ofe & Cofe C } := match k with | 0 => existT (P:=Cofe) unitO _ | S k => existT (P:=Cofe) (@oFunctor_apply F (projT1 (A' k)) (projT2 (A' k))) _ end. Notation A k := (projT1 (A' k)). Local Instance A_cofe k : Cofe (A k) := projT2 (A' k). Fixpoint f (k : nat) : A k -n> A (S k) := match k with 0 => OfeMor (λ _, inhabitant) | S k => map (g k,f k) end with g (k : nat) : A (S k) -n> A k := match k with 0 => OfeMor (λ _, ()) | S k => map (f k,g k) end. Definition f_S k (x : A (S k)) : f (S k) x = map (g k,f k) x := eq_refl. Definition g_S k (x : A (S (S k))) : g (S k) x = map (f k,g k) x := eq_refl. Global Arguments f : simpl never. Global Arguments g : simpl never. Lemma gf {k} (x : A k) : g k (f k x) ≡ x. Proof using Fcontr. induction k as [|k IH]; simpl in *; [by destruct x|]. rewrite -oFunctor_map_compose -{2}[x]oFunctor_map_id. by apply (contractive_proper map). Qed. Lemma fg {k} (x : A (S (S k))) : f (S k) (g (S k) x) ≡{k}≡ x. Proof using Fcontr. induction k as [|k IH]; simpl. - rewrite f_S g_S -{2}[x]oFunctor_map_id -oFunctor_map_compose. apply (contractive_0 map). - rewrite f_S g_S -{2}[x]oFunctor_map_id -oFunctor_map_compose. by apply (contractive_S map). Qed. Record tower := { tower_car k :> A k; g_tower k : g k (tower_car (S k)) ≡ tower_car k }. Global Instance tower_equiv : Equiv tower := λ X Y, ∀ k, X k ≡ Y k. Global Instance tower_dist : Dist tower := λ n X Y, ∀ k, X k ≡{n}≡ Y k. Definition tower_ofe_mixin : OfeMixin tower. Proof. split. - intros X Y; split; [by intros HXY n k; apply equiv_dist|]. intros HXY k; apply equiv_dist; intros n; apply HXY. - intros k; split. + by intros X n. + by intros X Y ? n. + by intros X Y Z ?? n; trans (Y n). - intros k j X Y HXY Hlt n. apply (dist_le k); [|lia]. by rewrite -(g_tower X) (HXY (S n)) g_tower. Qed. Definition T : ofe := Ofe tower tower_ofe_mixin. Program Definition tower_chain (c : chain T) (k : nat) : chain (A k) := {| chain_car i := c i k |}. Next Obligation. intros c k n i ?; apply (chain_cauchy c n); lia. Qed. Program Definition tower_compl : Compl T := λ c, {| tower_car n := compl (tower_chain c n) |}. Next Obligation. intros c k; apply equiv_dist=> n. by rewrite (conv_compl n (tower_chain c k)) (conv_compl n (tower_chain c (S k))) /= (g_tower (c _) k). Qed. Global Program Instance tower_cofe : Cofe T := { compl := tower_compl }. Next Obligation. intros n c k; rewrite /= (conv_compl n (tower_chain c k)). apply (chain_cauchy c); lia. Qed. Fixpoint ff {k} (i : nat) : A k -n> A (i + k) := match i with 0 => cid | S i => f (i + k) ◎ ff i end. Fixpoint gg {k} (i : nat) : A (i + k) -n> A k := match i with 0 => cid | S i => gg i ◎ g (i + k) end. Lemma ggff {k i} (x : A k) : gg i (ff i x) ≡ x. Proof using Fcontr. induction i as [|i IH]; simpl; [done|by rewrite (gf (ff i x)) IH]. Qed. Lemma f_tower k (X : tower) : f (S k) (X (S k)) ≡{k}≡ X (S (S k)). 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 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. Global Instance tower_car_ne k : NonExpansive (λ X, tower_car X k). Proof. by intros X Y HX. Qed. Definition project (k : nat) : T -n> A k := OfeMor (λ X : T, tower_car X k). Definition coerce {i j} (H : i = j) : A i -n> A j := eq_rect _ (λ i', A i -n> A i') cid _ H. Lemma coerce_id {i} (H : i = i) (x : A i) : coerce H x = x. Proof. unfold coerce. by rewrite (proof_irrel H (eq_refl i)). Qed. Lemma coerce_proper {i j} (x y : A i) (H1 H2 : i = j) : x = y → coerce H1 x = coerce H2 y. Proof. by destruct H1; rewrite !coerce_id. Qed. Lemma g_coerce {k j} (H : S k = S j) (x : A (S k)) : g j (coerce H x) = coerce (Nat.succ_inj _ _ H) (g k x). Proof. by assert (k = j) by lia; subst; rewrite !coerce_id. Qed. Lemma coerce_f {k j} (H : S k = S j) (x : A k) : coerce H (f k x) = f j (coerce (Nat.succ_inj _ _ H) x). Proof. by assert (k = j) by lia; subst; rewrite !coerce_id. Qed. Lemma gg_gg {k i i1 i2 j} : ∀ (H1: k = i + j) (H2: k = i2 + (i1 + j)) (x: A k), gg i (coerce H1 x) = gg i1 (gg i2 (coerce H2 x)). Proof. intros Hij -> x. assert (i = i2 + i1) as -> by lia. revert j x Hij. induction i2 as [|i2 IH]; intros j X Hij; simplify_eq/=; [by rewrite coerce_id|by rewrite g_coerce IH]. Qed. Lemma ff_ff {k i i1 i2 j} : ∀ (H1: i + k = j) (H2: i1 + (i2 + k) = j) (x: A k), coerce H1 (ff i x) = coerce H2 (ff i1 (ff i2 x)). Proof. intros ? <- x. assert (i = i1 + i2) as -> by lia. induction i1 as [|i1 IH]; simplify_eq/=; [by rewrite coerce_id|by rewrite coerce_f IH]. Qed. Definition embed_coerce {k} (i : nat) : A k -n> A i := match le_lt_dec i k with | left H => gg (k-i) ◎ coerce (eq_sym (Nat.sub_add _ _ H)) | right H => coerce (Nat.sub_add k i (Nat.lt_le_incl _ _ H)) ◎ ff (i-k) end. Lemma g_embed_coerce {k i} (x : A k) : g i (embed_coerce (S i) x) ≡ embed_coerce i x. Proof using Fcontr. unfold embed_coerce; destruct (le_lt_dec (S i) k), (le_lt_dec i k); simpl. - symmetry; by erewrite (@gg_gg _ _ 1 (k - S i)); simpl. - exfalso; lia. - assert (i = k) by lia; subst. rewrite (ff_ff _ (eq_refl (1 + (0 + k)))) /= gf. by rewrite (gg_gg _ (eq_refl (0 + (0 + k)))). - assert (H : 1 + ((i - k) + k) = S i) by lia. rewrite (ff_ff _ H) /= -{2}(gf (ff (i - k) x)) g_coerce. by erewrite coerce_proper by done. Qed. Program Definition embed (k : nat) (x : A k) : T := {| tower_car n := embed_coerce n x |}. Next Obligation. intros k x i. apply g_embed_coerce. Qed. Global Instance: Params (@embed) 1 := {}. Global Instance embed_ne k : NonExpansive (embed k). Proof. by intros n x y Hxy i; rewrite /= Hxy. Qed. Definition embed' (k : nat) : A k -n> T := OfeMor (embed k). Lemma embed_f k (x : A k) : embed (S k) (f k x) ≡ embed k x. Proof. rewrite equiv_dist=> n i; rewrite /embed /= /embed_coerce. destruct (le_lt_dec i (S k)), (le_lt_dec i k); simpl. - assert (H : S k = S (k - i) + (0 + i)) by lia; rewrite (gg_gg _ H) /=. by erewrite g_coerce, gf, coerce_proper by done. - assert (S k = 0 + (0 + i)) as H by lia. rewrite (gg_gg _ H); simplify_eq/=. by rewrite (ff_ff _ (eq_refl (1 + (0 + k)))). - exfalso; lia. - assert (H : (i - S k) + (1 + k) = i) by lia; rewrite (ff_ff _ H) /=. by erewrite coerce_proper by done. Qed. Lemma embed_tower k (X : T) : embed (S k) (X (S k)) ≡{k}≡ X. Proof. intros i; rewrite /= /embed_coerce. destruct (le_lt_dec i (S k)) as [H|H]; simpl. - rewrite -(gg_tower i (S k - i) X). apply (_ : Proper (_ ==> _) (gg _)); by destruct (eq_sym _). - rewrite (ff_tower k (i - S k) X). by destruct (Nat.sub_add _ _ _). Qed. Program Definition unfold_chain (X : T) : chain (oFunctor_apply F T) := {| chain_car n := map (project n,embed' n) (X (S n)) |}. Next Obligation. intros X n i Hi. assert (∃ k, i = k + n) as [k ?] by (exists (i - n); lia); subst; clear Hi. induction k as [|k IH]; simpl; first done. rewrite -IH -(dist_le _ _ _ _ (f_tower (k + n) _)); last lia. rewrite f_S -oFunctor_map_compose. by apply (contractive_ne map); split=> Y /=; rewrite ?g_tower ?embed_f. Qed. Definition unfold (X : T) : oFunctor_apply F T := compl (unfold_chain X). Global Instance unfold_ne : NonExpansive unfold. Proof. intros n X Y HXY. by rewrite /unfold (conv_compl n (unfold_chain X)) (conv_compl n (unfold_chain Y)) /= (HXY (S n)). Qed. Program Definition fold (X : oFunctor_apply F T) : T := {| tower_car n := g n (map (embed' n,project n) X) |}. Next Obligation. intros X k. apply (_ : Proper ((≡) ==> (≡)) (g k)). rewrite g_S -oFunctor_map_compose. apply (contractive_proper map); split=> Y; [apply embed_f|apply g_tower]. Qed. Global Instance fold_ne : NonExpansive fold. Proof. by intros n X Y HXY k; rewrite /fold /= HXY. Qed. Theorem result : solution F. Proof using Type*. refine (Solution F T _ (OfeIso (OfeMor fold) (OfeMor unfold) _ _)). - move=> X /=. rewrite equiv_dist=> n k; rewrite /unfold /fold /=. rewrite -g_tower -(gg_tower _ n); apply (_ : Proper (_ ==> _) (g _)). trans (map (ff n, gg n) (X (S (n + k)))). { rewrite /unfold (conv_compl n (unfold_chain X)). rewrite -(chain_cauchy (unfold_chain X) n (S (n + k))) /=; last lia. rewrite -(dist_le _ _ _ _ (f_tower (n + k) _)); last lia. rewrite f_S -!oFunctor_map_compose; apply (contractive_ne map); split=> Y. + rewrite /embed' /= /embed_coerce. destruct (le_lt_dec _ _); simpl; [exfalso; lia|]. by rewrite (ff_ff _ (eq_refl (S n + (0 + k)))) /= gf. + rewrite /embed' /= /embed_coerce. destruct (le_lt_dec _ _); simpl; [|exfalso; lia]. by rewrite (gg_gg _ (eq_refl (0 + (S n + k)))) /= gf. } assert (∀ i k (x : A (S i + k)) (H : S i + k = i + S k), map (ff i, gg i) x ≡ gg i (coerce H x)) as map_ff_gg. { intros i; induction i as [|i IH]; intros k' x H; simpl. { by rewrite coerce_id oFunctor_map_id. } rewrite oFunctor_map_compose g_coerce; apply IH. } assert (H: S n + k = n + S k) by lia. rewrite (map_ff_gg _ _ _ H). apply (_ : Proper (_ ==> _) (gg _)); by destruct H. - intros X; rewrite equiv_dist=> n /=. rewrite /unfold /= (conv_compl' n (unfold_chain (fold X))) /=. rewrite g_S -!oFunctor_map_compose -{2}[X]oFunctor_map_id. apply (contractive_ne map); split => Y /=. + rewrite f_tower. apply dist_S. by rewrite embed_tower. + etrans; [apply embed_ne, equiv_dist, g_tower|apply embed_tower]. Qed. End solver. End solver. iris-iris-4.2.0/iris/algebra/csum.v000066400000000000000000000403601460620107300171320ustar00rootroot00000000000000From iris.algebra Require Export cmra. From iris.algebra Require Import updates local_updates. From iris.prelude Require Import options. Local Arguments pcore _ _ !_ /. Local Arguments cmra_pcore _ !_ /. Local Arguments validN _ _ _ !_ /. Local Arguments valid _ _ !_ /. Local Arguments cmra_validN _ _ !_ /. Local Arguments cmra_valid _ !_ /. Inductive csum (A B : Type) := | Cinl : A → csum A B | Cinr : B → csum A B | CsumBot : csum A B. Global Arguments Cinl {_ _} _. Global Arguments Cinr {_ _} _. Global Arguments CsumBot {_ _}. Global Instance: Params (@Cinl) 2 := {}. Global Instance: Params (@Cinr) 2 := {}. Global Instance: Params (@CsumBot) 2 := {}. Global Instance maybe_Cinl {A B} : Maybe (@Cinl A B) := λ x, match x with Cinl a => Some a | _ => None end. Global Instance maybe_Cinr {A B} : Maybe (@Cinr A B) := λ x, match x with Cinr b => Some b | _ => None end. Section ofe. Context {A B : ofe}. Implicit Types a : A. Implicit Types b : B. (* Cofe *) Inductive csum_equiv : Equiv (csum A B) := | Cinl_equiv a a' : a ≡ a' → Cinl a ≡ Cinl a' | Cinr_equiv b b' : b ≡ b' → Cinr b ≡ Cinr b' | CsumBot_equiv : CsumBot ≡ CsumBot. Local Existing Instance csum_equiv. Inductive csum_dist : Dist (csum A B) := | Cinl_dist n a a' : a ≡{n}≡ a' → Cinl a ≡{n}≡ Cinl a' | Cinr_dist n b b' : b ≡{n}≡ b' → Cinr b ≡{n}≡ Cinr b' | CsumBot_dist n : CsumBot ≡{n}≡ CsumBot. Local Existing Instance csum_dist. Global Instance Cinl_ne : NonExpansive (@Cinl A B). Proof. by constructor. Qed. Global Instance Cinl_proper : Proper ((≡) ==> (≡)) (@Cinl A B). Proof. by constructor. Qed. Global Instance Cinl_inj : Inj (≡) (≡) (@Cinl A B). Proof. by inversion_clear 1. Qed. Global Instance Cinl_inj_dist n : Inj (dist n) (dist n) (@Cinl A B). Proof. by inversion_clear 1. Qed. Global Instance Cinr_ne : NonExpansive (@Cinr A B). Proof. by constructor. Qed. Global Instance Cinr_proper : Proper ((≡) ==> (≡)) (@Cinr A B). Proof. by constructor. Qed. Global Instance Cinr_inj : Inj (≡) (≡) (@Cinr A B). Proof. by inversion_clear 1. Qed. Global Instance Cinr_inj_dist n : Inj (dist n) (dist n) (@Cinr A B). Proof. by inversion_clear 1. Qed. Definition csum_ofe_mixin : OfeMixin (csum A B). Proof. split. - intros mx my; split. + by destruct 1; constructor; try apply equiv_dist. + intros Hxy; oinversion (Hxy 0); subst; constructor; try done; apply equiv_dist=> n; by oinversion (Hxy n). - intros n; split. + by intros [|a|]; constructor. + by destruct 1; constructor. + destruct 1; inversion_clear 1; constructor; etrans; eauto. - by inversion_clear 1; constructor; eauto using dist_le with si_solver. Qed. Canonical Structure csumO : ofe := Ofe (csum A B) csum_ofe_mixin. Program Definition csum_chain_l (c : chain csumO) (a : A) : chain A := {| chain_car n := match c n return _ with Cinl a' => a' | _ => a end |}. Next Obligation. intros c a n i ?; simpl. by destruct (chain_cauchy c n i). Qed. Program Definition csum_chain_r (c : chain csumO) (b : B) : chain B := {| chain_car n := match c n return _ with Cinr b' => b' | _ => b end |}. Next Obligation. intros c b n i ?; simpl. by destruct (chain_cauchy c n i). Qed. Definition csum_compl `{!Cofe A, !Cofe B} : Compl csumO := λ c, match c 0 with | Cinl a => Cinl (compl (csum_chain_l c a)) | Cinr b => Cinr (compl (csum_chain_r c b)) | CsumBot => CsumBot end. Global Program Instance csum_cofe `{!Cofe A, !Cofe B} : Cofe csumO := {| compl := csum_compl |}. Next Obligation. intros ?? n c; rewrite /compl /csum_compl. oinversion (chain_cauchy c 0 n); first auto with lia; constructor. + rewrite (conv_compl n (csum_chain_l c _)) /=. destruct (c n); naive_solver. + rewrite (conv_compl n (csum_chain_r c _)) /=. destruct (c n); naive_solver. Qed. Global Instance csum_ofe_discrete : OfeDiscrete A → OfeDiscrete B → OfeDiscrete csumO. Proof. by inversion_clear 3; constructor; apply (discrete_0 _). Qed. Global Instance csum_leibniz : LeibnizEquiv A → LeibnizEquiv B → LeibnizEquiv csumO. Proof. by destruct 3; f_equal; apply leibniz_equiv. Qed. Global Instance Cinl_discrete a : Discrete a → Discrete (Cinl a). Proof. by inversion_clear 2; constructor; apply (discrete_0 _). Qed. Global Instance Cinr_discrete b : Discrete b → Discrete (Cinr b). Proof. by inversion_clear 2; constructor; apply (discrete_0 _). Qed. End ofe. Global Arguments csumO : clear implicits. (* Functor on COFEs *) Definition csum_map {A A' B B'} (fA : A → A') (fB : B → B') (x : csum A B) : csum A' B' := match x with | Cinl a => Cinl (fA a) | Cinr b => Cinr (fB b) | CsumBot => CsumBot end. Global Instance: Params (@csum_map) 4 := {}. Lemma csum_map_id {A B} (x : csum A B) : csum_map id id x = x. Proof. by destruct x. Qed. Lemma csum_map_compose {A A' A'' B B' B''} (f : A → A') (f' : A' → A'') (g : B → B') (g' : B' → B'') (x : csum A B) : csum_map (f' ∘ f) (g' ∘ g) x = csum_map f' g' (csum_map f g x). Proof. by destruct x. Qed. Lemma csum_map_ext {A A' B B' : ofe} (f f' : A → A') (g g' : B → B') x : (∀ x, f x ≡ f' x) → (∀ x, g x ≡ g' x) → csum_map f g x ≡ csum_map f' g' x. Proof. by destruct x; constructor. Qed. Global Instance csum_map_cmra_ne {A A' B B' : ofe} n : Proper ((dist n ==> dist n) ==> (dist n ==> dist n) ==> dist n ==> dist n) (@csum_map A A' B B'). Proof. intros f f' Hf g g' Hg []; destruct 1; constructor; by apply Hf || apply Hg. Qed. Definition csumO_map {A A' B B'} (f : A -n> A') (g : B -n> B') : csumO A B -n> csumO A' B' := OfeMor (csum_map f g). Global Instance csumO_map_ne A A' B B' : NonExpansive2 (@csumO_map A A' B B'). Proof. by intros n f f' Hf g g' Hg []; constructor. Qed. Section cmra. Context {A B : cmra}. Implicit Types a : A. Implicit Types b : B. (* CMRA *) Local Instance csum_valid_instance : Valid (csum A B) := λ x, match x with | Cinl a => ✓ a | Cinr b => ✓ b | CsumBot => False end. Local Instance csum_validN_instance : ValidN (csum A B) := λ n x, match x with | Cinl a => ✓{n} a | Cinr b => ✓{n} b | CsumBot => False end. Local Instance csum_pcore_instance : PCore (csum A B) := λ x, match x with | Cinl a => Cinl <$> pcore a | Cinr b => Cinr <$> pcore b | CsumBot => Some CsumBot end. Local Instance csum_op_instance : Op (csum A B) := λ x y, match x, y with | Cinl a, Cinl a' => Cinl (a ⋅ a') | Cinr b, Cinr b' => Cinr (b ⋅ b') | _, _ => CsumBot end. Lemma Cinl_op a a' : Cinl (a ⋅ a') = Cinl a ⋅ Cinl a'. Proof. done. Qed. Lemma Cinr_op b b' : Cinr (b ⋅ b') = Cinr b ⋅ Cinr b'. Proof. done. Qed. Lemma Cinl_valid a : ✓ (Cinl a) ↔ ✓ a. Proof. done. Qed. Lemma Cinr_valid b : ✓ (Cinr b) ↔ ✓ b. Proof. done. Qed. Lemma csum_included x y : x ≼ y ↔ y = CsumBot ∨ (∃ a a', x = Cinl a ∧ y = Cinl a' ∧ a ≼ a') ∨ (∃ b b', x = Cinr b ∧ y = Cinr b' ∧ b ≼ b'). Proof. split. - unfold included. intros [[a'|b'|] Hy]; destruct x as [a|b|]; inversion_clear Hy; eauto 10. - intros [->|[(a&a'&->&->&c&?)|(b&b'&->&->&c&?)]]. + destruct x; exists CsumBot; constructor. + exists (Cinl c); by constructor. + exists (Cinr c); by constructor. Qed. Lemma Cinl_included a a' : Cinl a ≼ Cinl a' ↔ a ≼ a'. Proof. rewrite csum_included. naive_solver. Qed. Lemma Cinr_included b b' : Cinr b ≼ Cinr b' ↔ b ≼ b'. Proof. rewrite csum_included. naive_solver. Qed. Lemma CsumBot_included x : x ≼ CsumBot. Proof. exists CsumBot. by destruct x. Qed. (** We register a hint for [CsumBot_included] below. *) Lemma csum_includedN n x y : x ≼{n} y ↔ y = CsumBot ∨ (∃ a a', x = Cinl a ∧ y = Cinl a' ∧ a ≼{n} a') ∨ (∃ b b', x = Cinr b ∧ y = Cinr b' ∧ b ≼{n} b'). Proof. split. - unfold includedN. intros [[a'|b'|] Hy]; destruct x as [a|b|]; inversion_clear Hy; eauto 10. - intros [->|[(a&a'&->&->&c&?)|(b&b'&->&->&c&?)]]. + destruct x; exists CsumBot; constructor. + exists (Cinl c); by constructor. + exists (Cinr c); by constructor. Qed. Lemma csum_cmra_mixin : CmraMixin (csum A B). Proof. split. - intros [] n; destruct 1; constructor; by ofe_subst. - intros ???? [n a a' Ha|n b b' Hb|n] [=]; subst; eauto. + destruct (pcore a) as [ca|] eqn:?; simplify_option_eq. destruct (cmra_pcore_ne n a a' ca) as (ca'&->&?); auto. exists (Cinl ca'); by repeat constructor. + destruct (pcore b) as [cb|] eqn:?; simplify_option_eq. destruct (cmra_pcore_ne n b b' cb) as (cb'&->&?); auto. exists (Cinr cb'); by repeat constructor. - intros ? [a|b|] [a'|b'|] H; inversion_clear H; ofe_subst; done. - intros [a|b|]; rewrite /= ?cmra_valid_validN; naive_solver eauto using O. - intros n [a|b|]; simpl; auto using cmra_validN_S. - intros [a1|b1|] [a2|b2|] [a3|b3|]; constructor; by rewrite ?assoc. - intros [a1|b1|] [a2|b2|]; constructor; by rewrite 1?comm. - intros [a|b|] ? [=]; subst; auto. + destruct (pcore a) as [ca|] eqn:?; simplify_option_eq. constructor; eauto using cmra_pcore_l. + destruct (pcore b) as [cb|] eqn:?; simplify_option_eq. constructor; eauto using cmra_pcore_l. - intros [a|b|] ? [=]; subst; auto. + destruct (pcore a) as [ca|] eqn:?; simplify_option_eq. oinversion (cmra_pcore_idemp a ca); repeat constructor; auto. + destruct (pcore b) as [cb|] eqn:?; simplify_option_eq. oinversion (cmra_pcore_idemp b cb); repeat constructor; auto. - intros x y ? [->|[(a&a'&->&->&?)|(b&b'&->&->&?)]]%csum_included [=]. + exists CsumBot. rewrite csum_included; eauto. + destruct (pcore a) as [ca|] eqn:?; simplify_option_eq. destruct (cmra_pcore_mono a a' ca) as (ca'&->&?); auto. exists (Cinl ca'). rewrite csum_included; eauto 10. + destruct (pcore b) as [cb|] eqn:?; simplify_option_eq. destruct (cmra_pcore_mono b b' cb) as (cb'&->&?); auto. exists (Cinr cb'). rewrite csum_included; eauto 10. - intros n [a1|b1|] [a2|b2|]; simpl; eauto using cmra_validN_op_l; done. - intros n [a|b|] y1 y2 Hx Hx'. + destruct y1 as [a1|b1|], y2 as [a2|b2|]; try by exfalso; inversion Hx'. destruct (cmra_extend n a a1 a2) as (z1&z2&?&?&?); [done|apply (inj Cinl), Hx'|]. exists (Cinl z1), (Cinl z2). by repeat constructor. + destruct y1 as [a1|b1|], y2 as [a2|b2|]; try by exfalso; inversion Hx'. destruct (cmra_extend n b b1 b2) as (z1&z2&?&?&?); [done|apply (inj Cinr), Hx'|]. exists (Cinr z1), (Cinr z2). by repeat constructor. + by exists CsumBot, CsumBot; destruct y1, y2; inversion_clear Hx'. Qed. Canonical Structure csumR := Cmra (csum A B) csum_cmra_mixin. Global Instance csum_cmra_discrete : CmraDiscrete A → CmraDiscrete B → CmraDiscrete csumR. Proof. split; first apply _. by move=>[a|b|] HH /=; try apply cmra_discrete_valid. Qed. Global Instance Cinl_core_id a : CoreId a → CoreId (Cinl a). Proof. rewrite /CoreId /=. inversion_clear 1; by repeat constructor. Qed. Global Instance Cinr_core_id b : CoreId b → CoreId (Cinr b). Proof. rewrite /CoreId /=. inversion_clear 1; by repeat constructor. Qed. Global Instance Cinl_exclusive a : Exclusive a → Exclusive (Cinl a). Proof. by move=> H[]? =>[/H||]. Qed. Global Instance Cinr_exclusive b : Exclusive b → Exclusive (Cinr b). Proof. by move=> H[]? =>[|/H|]. Qed. Global Instance Cinl_cancelable a : Cancelable a → Cancelable (Cinl a). Proof. move=> ?? [y|y|] [z|z|] ? EQ //; inversion_clear EQ. constructor. by eapply (cancelableN a). Qed. Global Instance Cinr_cancelable b : Cancelable b → Cancelable (Cinr b). Proof. move=> ?? [y|y|] [z|z|] ? EQ //; inversion_clear EQ. constructor. by eapply (cancelableN b). Qed. Global Instance Cinl_id_free a : IdFree a → IdFree (Cinl a). Proof. intros ? [] ? EQ; inversion_clear EQ. by eapply id_free0_r. Qed. Global Instance Cinr_id_free b : IdFree b → IdFree (Cinr b). Proof. intros ? [] ? EQ; inversion_clear EQ. by eapply id_free0_r. Qed. (** Interaction with [option] *) Lemma Some_csum_includedN x y n : Some x ≼{n} Some y ↔ y = CsumBot ∨ (∃ a a', x = Cinl a ∧ y = Cinl a' ∧ Some a ≼{n} Some a') ∨ (∃ b b', x = Cinr b ∧ y = Cinr b' ∧ Some b ≼{n} Some b'). Proof. repeat setoid_rewrite Some_includedN. rewrite csum_includedN. split. - intros [Hxy|?]; [inversion Hxy|]; naive_solver. - naive_solver by f_equiv. Qed. Lemma Some_csum_included x y : Some x ≼ Some y ↔ y = CsumBot ∨ (∃ a a', x = Cinl a ∧ y = Cinl a' ∧ Some a ≼ Some a') ∨ (∃ b b', x = Cinr b ∧ y = Cinr b' ∧ Some b ≼ Some b'). Proof. repeat setoid_rewrite Some_included. rewrite csum_included. split. - intros [Hxy|?]; [inversion Hxy|]; naive_solver. - naive_solver by f_equiv. Qed. (** Updates *) Lemma csum_update_l (a1 a2 : A) : a1 ~~> a2 → Cinl a1 ~~> Cinl a2. Proof. intros Ha n [[a|b|]|] ?; simpl in *; auto. - by apply (Ha n (Some a)). - by apply (Ha n None). Qed. Lemma csum_update_r (b1 b2 : B) : b1 ~~> b2 → Cinr b1 ~~> Cinr b2. Proof. intros Hb n [[a|b|]|] ?; simpl in *; auto. - by apply (Hb n (Some b)). - by apply (Hb n None). Qed. Lemma csum_updateP_l (P : A → Prop) (Q : csum A B → Prop) a : a ~~>: P → (∀ a', P a' → Q (Cinl a')) → Cinl a ~~>: Q. Proof. intros Hx HP n mf Hm. destruct mf as [[a'|b'|]|]; try by destruct Hm. - destruct (Hx n (Some a')) as (c&?&?); naive_solver. - destruct (Hx n None) as (c&?&?); naive_solver eauto using cmra_validN_op_l. Qed. Lemma csum_updateP_r (P : B → Prop) (Q : csum A B → Prop) b : b ~~>: P → (∀ b', P b' → Q (Cinr b')) → Cinr b ~~>: Q. Proof. intros Hx HP n mf Hm. destruct mf as [[a'|b'|]|]; try by destruct Hm. - destruct (Hx n (Some b')) as (c&?&?); naive_solver. - destruct (Hx n None) as (c&?&?); naive_solver eauto using cmra_validN_op_l. Qed. Lemma csum_updateP'_l (P : A → Prop) a : a ~~>: P → Cinl a ~~>: λ m', ∃ a', m' = Cinl a' ∧ P a'. Proof. eauto using csum_updateP_l. Qed. Lemma csum_updateP'_r (P : B → Prop) b : b ~~>: P → Cinr b ~~>: λ m', ∃ b', m' = Cinr b' ∧ P b'. Proof. eauto using csum_updateP_r. Qed. Lemma csum_local_update_l (a1 a2 a1' a2' : A) : (a1,a2) ~l~> (a1',a2') → (Cinl a1,Cinl a2) ~l~> (Cinl a1',Cinl a2'). Proof. intros Hup n mf ? Ha1; simpl in *. destruct (Hup n (mf ≫= maybe Cinl)); auto. { by destruct mf as [[]|]; inversion_clear Ha1. } split; first done. by destruct mf as [[]|]; inversion_clear Ha1; constructor. Qed. Lemma csum_local_update_r (b1 b2 b1' b2' : B) : (b1,b2) ~l~> (b1',b2') → (Cinr b1,Cinr b2) ~l~> (Cinr b1',Cinr b2'). Proof. intros Hup n mf ? Ha1; simpl in *. destruct (Hup n (mf ≫= maybe Cinr)); auto. { by destruct mf as [[]|]; inversion_clear Ha1. } split; first done. by destruct mf as [[]|]; inversion_clear Ha1; constructor. Qed. End cmra. (* We use a [Hint Extern] with [apply:], instead of [Hint Immediate], to invoke the new unification algorithm. The old unification algorithm sometimes gets confused by going from [ucmra]'s to [cmra]'s and back. *) Global Hint Extern 0 (_ ≼ CsumBot) => apply: CsumBot_included : core. Global Arguments csumR : clear implicits. (* Functor *) Global Instance csum_map_cmra_morphism {A A' B B' : cmra} (f : A → A') (g : B → B') : CmraMorphism f → CmraMorphism g → CmraMorphism (csum_map f g). Proof. split; try apply _. - intros n [a|b|]; simpl; auto using cmra_morphism_validN. - move=> [a|b|]=>//=; rewrite -cmra_morphism_pcore; by destruct pcore. - intros [xa|ya|] [xb|yb|]=>//=; by rewrite cmra_morphism_op. Qed. Program Definition csumRF (Fa Fb : rFunctor) : rFunctor := {| rFunctor_car A _ B _ := csumR (rFunctor_car Fa A B) (rFunctor_car Fb A B); rFunctor_map A1 _ A2 _ B1 _ B2 _ fg := csumO_map (rFunctor_map Fa fg) (rFunctor_map Fb fg) |}. Next Obligation. by intros Fa Fb A1 ? A2 ? B1 ? B2 ? n f g Hfg; apply csumO_map_ne; try apply rFunctor_map_ne. Qed. Next Obligation. intros Fa Fb A ? B ? x. rewrite /= -{2}(csum_map_id x). apply csum_map_ext=>y; apply rFunctor_map_id. Qed. Next Obligation. intros Fa Fb A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x. rewrite /= -csum_map_compose. apply csum_map_ext=>y; apply rFunctor_map_compose. Qed. Global Instance csumRF_contractive Fa Fb : rFunctorContractive Fa → rFunctorContractive Fb → rFunctorContractive (csumRF Fa Fb). Proof. intros ?? A1 ? A2 ? B1 ? B2 ? n f g Hfg. by apply csumO_map_ne; try apply rFunctor_map_contractive. Qed. iris-iris-4.2.0/iris/algebra/dfrac.v000066400000000000000000000215341460620107300172440ustar00rootroot00000000000000(** Camera of discardable fractions. This is a generalisation of the fractional camera where elements can represent both ownership of a fraction (as in the fractional camera) and the knowledge that a fraction has been discarded. Ownership of a fraction is denoted [DfracOwn q] and behaves identically to [q] of the fractional camera. Knowledge that a fraction has been discarded is denoted [DfracDiscarded]. This elements is its own core, making ownership persistent. One can make a frame preserving update from _owning_ a fraction to _knowing_ that the fraction has been discarded. Crucially, ownership over 1 is an exclusive element just as it is in the fractional camera. Hence owning 1 implies that no fraction has been discarded. Conversely, knowing that a fraction has been discarded implies that no one can own 1. And, since discarding is an irreversible operation, it also implies that no one can own 1 in the future *) From stdpp Require Import countable. From iris.algebra Require Export cmra. From iris.algebra Require Import proofmode_classes updates frac. From iris.prelude Require Import options. (** An element of dfrac denotes ownership of a fraction, knowledge that a fraction has been discarded, or both. Note that [DfracBoth] can be written as [DfracOwn q ⋅ DfracDiscarded]. This should be used instead of [DfracBoth] which is for internal use only. *) Inductive dfrac := | DfracOwn : Qp → dfrac | DfracDiscarded : dfrac | DfracBoth : Qp → dfrac. (* This notation is intended to be used as a component in other notations that include discardable fractions. The notation provides shorthands for the constructors and the commonly used full fraction. For an example demonstrating how this can be used see the notation in [gen_heap.v]. *) Declare Custom Entry dfrac. Notation "{ dq }" := (dq) (in custom dfrac at level 1, dq constr). Notation "□" := DfracDiscarded (in custom dfrac). Notation "{# q }" := (DfracOwn q) (in custom dfrac at level 1, q constr). Notation "" := (DfracOwn 1) (in custom dfrac). Section dfrac. Canonical Structure dfracO := leibnizO dfrac. Implicit Types p q : Qp. Implicit Types dp dq : dfrac. Global Instance dfrac_inhabited : Inhabited dfrac := populate DfracDiscarded. Global Instance dfrac_eq_dec : EqDecision dfrac. Proof. solve_decision. Defined. Global Instance dfrac_countable : Countable dfrac. Proof. set (enc dq := match dq with | DfracOwn q => inl q | DfracDiscarded => inr (inl ()) | DfracBoth q => inr (inr q) end). set (dec y := Some match y with | inl q => DfracOwn q | inr (inl ()) => DfracDiscarded | inr (inr q) => DfracBoth q end). refine (inj_countable enc dec _). by intros []. Qed. Global Instance DfracOwn_inj : Inj (=) (=) DfracOwn. Proof. by injection 1. Qed. Global Instance DfracBoth_inj : Inj (=) (=) DfracBoth. Proof. by injection 1. Qed. (** An element is valid as long as the sum of its content is less than one. *) Local Instance dfrac_valid_instance : Valid dfrac := λ dq, match dq with | DfracOwn q => q ≤ 1 | DfracDiscarded => True | DfracBoth q => q < 1 end%Qp. (** As in the fractional camera the core is undefined for elements denoting ownership of a fraction. For elements denoting the knowledge that a fraction has been discarded the core is the identity function. *) Local Instance dfrac_pcore_instance : PCore dfrac := λ dq, match dq with | DfracOwn q => None | DfracDiscarded => Some DfracDiscarded | DfracBoth q => Some DfracDiscarded end. (** When elements are combined, ownership is added together and knowledge of discarded fractions is preserved. *) Local Instance dfrac_op_instance : Op dfrac := λ dq dp, match dq, dp with | DfracOwn q, DfracOwn q' => DfracOwn (q + q') | DfracOwn q, DfracDiscarded => DfracBoth q | DfracOwn q, DfracBoth q' => DfracBoth (q + q') | DfracDiscarded, DfracOwn q' => DfracBoth q' | DfracDiscarded, DfracDiscarded => DfracDiscarded | DfracDiscarded, DfracBoth q' => DfracBoth q' | DfracBoth q, DfracOwn q' => DfracBoth (q + q') | DfracBoth q, DfracDiscarded => DfracBoth q | DfracBoth q, DfracBoth q' => DfracBoth (q + q') end. Lemma dfrac_valid dq : ✓ dq ↔ match dq with | DfracOwn q => q ≤ 1 | DfracDiscarded => True | DfracBoth q => q < 1 end%Qp. Proof. done. Qed. Lemma dfrac_op_own q p : DfracOwn p ⋅ DfracOwn q = DfracOwn (p + q). Proof. done. Qed. Lemma dfrac_op_discarded : DfracDiscarded ⋅ DfracDiscarded = DfracDiscarded. Proof. done. Qed. Lemma dfrac_own_included q p : DfracOwn q ≼ DfracOwn p ↔ (q < p)%Qp. Proof. rewrite Qp.lt_sum. split. - rewrite /included /op /dfrac_op_instance. intros [[o| |?] [= ->]]. by exists o. - intros [o ->]. exists (DfracOwn o). by rewrite dfrac_op_own. Qed. (* [dfrac] does not have a unit so reflexivity is not for granted! *) Lemma dfrac_discarded_included : DfracDiscarded ≼ DfracDiscarded. Proof. exists DfracDiscarded. done. Qed. Definition dfrac_ra_mixin : RAMixin dfrac. Proof. split; try apply _. - intros [?| |?] ? dq <-; intros [= <-]; eexists _; done. - intros [?| |?] [?| |?] [?| |?]; rewrite /op /dfrac_op_instance 1?assoc_L 1?assoc_L; done. - intros [?| |?] [?| |?]; rewrite /op /dfrac_op_instance 1?(comm_L Qp.add); done. - intros [?| |?] dq; rewrite /pcore /dfrac_pcore_instance; intros [= <-]; rewrite /op /dfrac_op_instance; done. - intros [?| |?] ? [= <-]; done. - intros [?| |?] [?| |?] ? [[?| |?] [=]] [= <-]; eexists _; split; try done; apply dfrac_discarded_included. - intros [q| |q] [q'| |q']; rewrite /op /dfrac_op_instance /valid /dfrac_valid_instance //. + intros. trans (q + q')%Qp; [|done]. apply Qp.le_add_l. + apply Qp.lt_le_incl. + intros. trans (q + q')%Qp; [|by apply Qp.lt_le_incl]. apply Qp.le_add_l. + intros. trans (q + q')%Qp; [|done]. apply Qp.lt_add_l. + intros. trans (q + q')%Qp; [|done]. apply Qp.lt_add_l. Qed. Canonical Structure dfracR := discreteR dfrac dfrac_ra_mixin. Global Instance dfrac_cmra_discrete : CmraDiscrete dfracR. Proof. apply discrete_cmra_discrete. Qed. Global Instance dfrac_full_exclusive : Exclusive (DfracOwn 1). Proof. intros [q| |q]; rewrite /op /cmra_op -cmra_discrete_valid_iff /valid /cmra_valid //=. - apply Qp.not_add_le_l. - move=> /Qp.lt_le_incl. apply Qp.not_add_le_l. Qed. Global Instance dfrac_cancelable q : Cancelable (DfracOwn q). Proof. apply: discrete_cancelable. intros [q1| |q1][q2| |q2] _ [=]; simplify_eq/=; try done. - by destruct (Qp.add_id_free q q2). - by destruct (Qp.add_id_free q q1). Qed. Global Instance dfrac_own_id_free q : IdFree (DfracOwn q). Proof. intros [q'| |q'] _ [=]. by apply (Qp.add_id_free q q'). Qed. Global Instance dfrac_discarded_core_id : CoreId DfracDiscarded. Proof. by constructor. Qed. Lemma dfrac_valid_own p : ✓ DfracOwn p ↔ (p ≤ 1)%Qp. Proof. done. Qed. Lemma dfrac_valid_own_1 : ✓ DfracOwn 1. Proof. done. Qed. Lemma dfrac_valid_own_r dq q : ✓ (dq ⋅ DfracOwn q) → (q < 1)%Qp. Proof. destruct dq as [q'| |q']; [|done|]. - apply Qp.lt_le_trans, Qp.lt_add_r. - intro Hlt. etrans; last apply Hlt. apply Qp.lt_add_r. Qed. Lemma dfrac_valid_own_l dq q : ✓ (DfracOwn q ⋅ dq) → (q < 1)%Qp. Proof. rewrite comm. apply dfrac_valid_own_r. Qed. Lemma dfrac_valid_discarded : ✓ DfracDiscarded. Proof. done. Qed. Lemma dfrac_valid_own_discarded q : ✓ (DfracOwn q ⋅ DfracDiscarded) ↔ (q < 1)%Qp. Proof. done. Qed. Global Instance dfrac_is_op q q1 q2 : IsOp q q1 q2 → IsOp' (DfracOwn q) (DfracOwn q1) (DfracOwn q2). Proof. rewrite /IsOp' /IsOp dfrac_op_own=>-> //. Qed. (** Discarding a fraction is a frame preserving update. *) Lemma dfrac_discard_update dq : dq ~~> DfracDiscarded. Proof. intros n [[q'| |q']|]; rewrite -!cmra_discrete_valid_iff //=. - apply dfrac_valid_own_r. - apply cmra_valid_op_r. Qed. Lemma dfrac_undiscard_update : DfracDiscarded ~~>: λ k, ∃ q, k = DfracOwn q. Proof. apply cmra_discrete_updateP. intros [[q'| |q']|]. - intros [qd Hqd]%Qp.lt_sum. exists (DfracOwn (qd/2)%Qp). split; first by eexists. apply dfrac_valid_own. rewrite Hqd Qp.add_comm -Qp.add_le_mono_l. by apply Qp.div_le. - intros _. exists (DfracOwn (1/2)); split; first by eexists. by apply dfrac_valid_own_discarded. - intros [qd Hqd]%Qp.lt_sum. exists (DfracOwn (qd/2)%Qp). split; first by eexists. rewrite /= /op /valid /cmra_op /cmra_valid /=. rewrite Hqd Qp.add_comm -Qp.add_lt_mono_l. by apply Qp.div_lt. - intros _. exists (DfracOwn 1); split; first by eexists. by apply dfrac_valid_own. Qed. End dfrac. iris-iris-4.2.0/iris/algebra/dyn_reservation_map.v000066400000000000000000000412651460620107300222400ustar00rootroot00000000000000From iris.algebra Require Export gmap coPset local_updates. From iris.algebra Require Import reservation_map updates proofmode_classes. From iris.prelude Require Import options. (** The camera [dyn_reservation_map A] over a camera [A] extends [gmap positive A] with a notion of "reservation tokens" for a (potentially infinite) set [E : coPset] which represent the right to allocate a map entry at any position [k ∈ E]. Unlike [reservation_map], [dyn_reservation_map] supports dynamically allocating these tokens, including infinite sets of them. This is useful when syncing the keys of this map with another API that dynamically allocates names: we can first reserve a fresh infinite set [E] of tokens here, then allocate a new name *in [E]* with the other API (assuming it offers the usual "allocate a fresh name in an infinite set" API), and then use our tokens to allocate the same name here. In effect, we have performed synchronized allocation of the same name across two maps, without the other API having to have dedicated support for this. The key connectives are [dyn_reservation_map_data k a] (the "points-to" assertion of this map), which associates data [a : A] with a key [k : positive], and [dyn_reservation_map_token E] (the reservation token), which says that no data has been associated with the indices in the mask [E]. The important properties of this camera are: - The lemma [dyn_reservation_map_reserve] provides a frame-preserving update to obtain ownership of [dyn_reservation_map_token E] for some fresh infinite [E]. - The lemma [dyn_reservation_map_alloc] provides a frame preserving update to associate data to a key: [dyn_reservation_map_token E ~~> dyn_reservation_map_data k a] provided [k ∈ E] and [✓ a]. In the future, it could be interesting to generalize this map to arbitrary key types instead of hard-coding [positive]. *) Record dyn_reservation_map (A : Type) := DynReservationMap { dyn_reservation_map_data_proj : gmap positive A; dyn_reservation_map_token_proj : coPset_disj }. Add Printing Constructor dyn_reservation_map. Global Arguments DynReservationMap {_} _ _. Global Arguments dyn_reservation_map_data_proj {_} _. Global Arguments dyn_reservation_map_token_proj {_} _. Global Instance: Params (@DynReservationMap) 1 := {}. Global Instance: Params (@dyn_reservation_map_data_proj) 1 := {}. Global Instance: Params (@dyn_reservation_map_token_proj) 1 := {}. Definition dyn_reservation_map_data {A : cmra} (k : positive) (a : A) : dyn_reservation_map A := DynReservationMap {[ k := a ]} ε. Definition dyn_reservation_map_token {A : cmra} (E : coPset) : dyn_reservation_map A := DynReservationMap ∅ (CoPset E). Global Instance: Params (@dyn_reservation_map_data) 2 := {}. (** We consruct the OFE and CMRA structure via an isomorphism with [reservation_map]. *) Section ofe. Context {A : ofe}. Implicit Types x y : dyn_reservation_map A. Local Definition to_reservation_map x : reservation_map A := ReservationMap (dyn_reservation_map_data_proj x) (dyn_reservation_map_token_proj x). Local Definition from_reservation_map (x : reservation_map A) : dyn_reservation_map A := DynReservationMap (reservation_map_data_proj x) (reservation_map_token_proj x). Local Instance dyn_reservation_map_equiv : Equiv (dyn_reservation_map A) := λ x y, dyn_reservation_map_data_proj x ≡ dyn_reservation_map_data_proj y ∧ dyn_reservation_map_token_proj x = dyn_reservation_map_token_proj y. Local Instance dyn_reservation_map_dist : Dist (dyn_reservation_map A) := λ n x y, dyn_reservation_map_data_proj x ≡{n}≡ dyn_reservation_map_data_proj y ∧ dyn_reservation_map_token_proj x = dyn_reservation_map_token_proj y. Global Instance DynReservationMap_ne : NonExpansive2 (@DynReservationMap A). Proof. by split. Qed. Global Instance DynReservationMap_proper : Proper ((≡) ==> (=) ==> (≡)) (@DynReservationMap A). Proof. by split. Qed. Global Instance dyn_reservation_map_data_proj_ne : NonExpansive (@dyn_reservation_map_data_proj A). Proof. by destruct 1. Qed. Global Instance dyn_reservation_map_data_proj_proper : Proper ((≡) ==> (≡)) (@dyn_reservation_map_data_proj A). Proof. by destruct 1. Qed. Definition dyn_reservation_map_ofe_mixin : OfeMixin (dyn_reservation_map A). Proof. by apply (iso_ofe_mixin to_reservation_map). Qed. Canonical Structure dyn_reservation_mapO := Ofe (dyn_reservation_map A) dyn_reservation_map_ofe_mixin. Global Instance DynReservationMap_discrete a b : Discrete a → Discrete b → Discrete (DynReservationMap a b). Proof. intros ?? [??] [??]; split; unfold_leibniz; by eapply discrete_0. Qed. Global Instance dyn_reservation_map_ofe_discrete : OfeDiscrete A → OfeDiscrete dyn_reservation_mapO. Proof. intros ? [??]; apply _. Qed. End ofe. Global Arguments dyn_reservation_mapO : clear implicits. Section cmra. Context {A : cmra}. Implicit Types a b : A. Implicit Types x y : dyn_reservation_map A. Implicit Types k : positive. Global Instance dyn_reservation_map_data_ne i : NonExpansive (@dyn_reservation_map_data A i). Proof. intros ? ???. rewrite /dyn_reservation_map_data. solve_proper. Qed. Global Instance dyn_reservation_map_data_proper N : Proper ((≡) ==> (≡)) (@dyn_reservation_map_data A N). Proof. solve_proper. Qed. Global Instance dyn_reservation_map_data_discrete N a : Discrete a → Discrete (dyn_reservation_map_data N a). Proof. intros. apply DynReservationMap_discrete; apply _. Qed. Global Instance dyn_reservation_map_token_discrete E : Discrete (@dyn_reservation_map_token A E). Proof. intros. apply DynReservationMap_discrete; apply _. Qed. Local Instance dyn_reservation_map_valid_instance : Valid (dyn_reservation_map A) := λ x, match dyn_reservation_map_token_proj x with | CoPset E => ✓ (dyn_reservation_map_data_proj x) ∧ set_infinite (⊤ ∖ E) ∧ (* dom (dyn_reservation_map_data_proj x) ⊥ E *) (∀ i, dyn_reservation_map_data_proj x !! i = None ∨ i ∉ E) | CoPsetBot => False end. Global Arguments dyn_reservation_map_valid_instance !_ /. Local Instance dyn_reservation_map_validN_instance : ValidN (dyn_reservation_map A) := λ n x, match dyn_reservation_map_token_proj x with | CoPset E => ✓{n} (dyn_reservation_map_data_proj x) ∧ set_infinite (⊤ ∖ E) ∧ (* dom (dyn_reservation_map_data_proj x) ⊥ E *) (∀ i, dyn_reservation_map_data_proj x !! i = None ∨ i ∉ E) | CoPsetBot => False end. Global Arguments dyn_reservation_map_validN_instance !_ /. Local Instance dyn_reservation_map_pcore_instance : PCore (dyn_reservation_map A) := λ x, Some (DynReservationMap (core (dyn_reservation_map_data_proj x)) ε). Local Instance dyn_reservation_map_op_instance : Op (dyn_reservation_map A) := λ x y, DynReservationMap (dyn_reservation_map_data_proj x ⋅ dyn_reservation_map_data_proj y) (dyn_reservation_map_token_proj x ⋅ dyn_reservation_map_token_proj y). Definition dyn_reservation_map_valid_eq : valid = λ x, match dyn_reservation_map_token_proj x with | CoPset E => ✓ (dyn_reservation_map_data_proj x) ∧ set_infinite (⊤ ∖ E) ∧ (* dom (dyn_reservation_map_data_proj x) ⊥ E *) ∀ i, dyn_reservation_map_data_proj x !! i = None ∨ i ∉ E | CoPsetBot => False end := eq_refl _. Definition dyn_reservation_map_validN_eq : validN = λ n x, match dyn_reservation_map_token_proj x with | CoPset E => ✓{n} (dyn_reservation_map_data_proj x) ∧ set_infinite (⊤ ∖ E) ∧ (* dom (dyn_reservation_map_data_proj x) ⊥ E *) ∀ i, dyn_reservation_map_data_proj x !! i = None ∨ i ∉ E | CoPsetBot => False end := eq_refl _. Lemma dyn_reservation_map_included x y : x ≼ y ↔ dyn_reservation_map_data_proj x ≼ dyn_reservation_map_data_proj y ∧ dyn_reservation_map_token_proj x ≼ dyn_reservation_map_token_proj y. Proof. split; [intros [[z1 z2] Hz]; split; [exists z1|exists z2]; apply Hz|]. intros [[z1 Hz1] [z2 Hz2]]; exists (DynReservationMap z1 z2); split; auto. Qed. Lemma dyn_reservation_map_data_proj_validN n x : ✓{n} x → ✓{n} dyn_reservation_map_data_proj x. Proof. by destruct x as [? [?|]]=> // -[??]. Qed. Lemma dyn_reservation_map_token_proj_validN n x : ✓{n} x → ✓{n} dyn_reservation_map_token_proj x. Proof. by destruct x as [? [?|]]=> // -[??]. Qed. Lemma dyn_reservation_map_cmra_mixin : CmraMixin (dyn_reservation_map A). Proof. apply (iso_cmra_mixin_restrict_validity from_reservation_map to_reservation_map); try done. - intros n [m [E|]]; rewrite dyn_reservation_map_validN_eq reservation_map_validN_eq /=; naive_solver. - intros n [m1 [E1|]] [m2 [E2|]] [Hm ?]=> // -[?[??]]; split; simplify_eq/=. + by rewrite -Hm. + split; first done. intros i. by rewrite -(dist_None n) -Hm dist_None. - intros [m [E|]]; rewrite dyn_reservation_map_valid_eq dyn_reservation_map_validN_eq /= ?cmra_valid_validN; naive_solver eauto using O. - intros n [m [E|]]; rewrite dyn_reservation_map_validN_eq /=; naive_solver eauto using cmra_validN_S. - intros n [m1 [E1|]] [m2 [E2|]]=> //=; rewrite dyn_reservation_map_validN_eq /=. rewrite {1}/op /cmra_op /=. case_decide; last done. intros [Hm [Hinf Hdisj]]; split; first by eauto using cmra_validN_op_l. split. + rewrite ->difference_union_distr_r_L in Hinf. eapply set_infinite_subseteq, Hinf. set_solver. + intros i. move: (Hdisj i). rewrite lookup_op. case: (m1 !! i); case: (m2 !! i); set_solver. Qed. Canonical Structure dyn_reservation_mapR := Cmra (dyn_reservation_map A) dyn_reservation_map_cmra_mixin. Global Instance dyn_reservation_map_cmra_discrete : CmraDiscrete A → CmraDiscrete dyn_reservation_mapR. Proof. split; first apply _. intros [m [E|]]; rewrite dyn_reservation_map_validN_eq dyn_reservation_map_valid_eq //=. by intros [?%cmra_discrete_valid ?]. Qed. Local Instance dyn_reservation_map_empty_instance : Unit (dyn_reservation_map A) := DynReservationMap ε ε. Lemma dyn_reservation_map_ucmra_mixin : UcmraMixin (dyn_reservation_map A). Proof. split; simpl. - rewrite dyn_reservation_map_valid_eq /=. split; [apply ucmra_unit_valid|]. split. + rewrite difference_empty_L. apply top_infinite. + set_solver. - split; simpl; [by rewrite left_id|by rewrite left_id_L]. - do 2 constructor; [apply (core_id_core _)|done]. Qed. Canonical Structure dyn_reservation_mapUR := Ucmra (dyn_reservation_map A) dyn_reservation_map_ucmra_mixin. Global Instance dyn_reservation_map_data_core_id k a : CoreId a → CoreId (dyn_reservation_map_data k a). Proof. do 2 constructor; simpl; auto. apply core_id_core, _. Qed. Lemma dyn_reservation_map_data_valid k a : ✓ (dyn_reservation_map_data k a) ↔ ✓ a. Proof. rewrite dyn_reservation_map_valid_eq /= singleton_valid. split; first naive_solver. intros Ha. split; first done. split; last set_solver. rewrite difference_empty_L. apply top_infinite. Qed. Lemma dyn_reservation_map_token_valid E : ✓ (dyn_reservation_map_token E) ↔ set_infinite (⊤ ∖ E). Proof. rewrite dyn_reservation_map_valid_eq /=. split; first naive_solver. intros Hinf. do 2 (split; first done). by left. Qed. Lemma dyn_reservation_map_data_op k a b : dyn_reservation_map_data k (a ⋅ b) = dyn_reservation_map_data k a ⋅ dyn_reservation_map_data k b. Proof. by rewrite {2}/op /dyn_reservation_map_op_instance /dyn_reservation_map_data /= singleton_op left_id_L. Qed. Lemma dyn_reservation_map_data_mono k a b : a ≼ b → dyn_reservation_map_data k a ≼ dyn_reservation_map_data k b. Proof. intros [c ->]. by rewrite dyn_reservation_map_data_op. Qed. Global Instance dyn_reservation_map_data_is_op k a b1 b2 : IsOp a b1 b2 → IsOp' (dyn_reservation_map_data k a) (dyn_reservation_map_data k b1) (dyn_reservation_map_data k b2). Proof. rewrite /IsOp' /IsOp=> ->. by rewrite dyn_reservation_map_data_op. Qed. Lemma dyn_reservation_map_token_union E1 E2 : E1 ## E2 → dyn_reservation_map_token (E1 ∪ E2) = dyn_reservation_map_token E1 ⋅ dyn_reservation_map_token E2. Proof. intros. by rewrite /op /dyn_reservation_map_op_instance /dyn_reservation_map_token /= coPset_disj_union // left_id_L. Qed. Lemma dyn_reservation_map_token_difference E1 E2 : E1 ⊆ E2 → dyn_reservation_map_token E2 = dyn_reservation_map_token E1 ⋅ dyn_reservation_map_token (E2 ∖ E1). Proof. intros. rewrite -dyn_reservation_map_token_union; last set_solver. by rewrite -union_difference_L. Qed. Lemma dyn_reservation_map_token_valid_op E1 E2 : ✓ (dyn_reservation_map_token E1 ⋅ dyn_reservation_map_token E2) ↔ E1 ## E2 ∧ set_infinite (⊤ ∖ (E1 ∪ E2)). Proof. split. - rewrite dyn_reservation_map_valid_eq /= {1}/op /cmra_op /=. case_decide; last done. naive_solver. - intros [Hdisj Hinf]. rewrite -dyn_reservation_map_token_union //. apply dyn_reservation_map_token_valid. done. Qed. Lemma dyn_reservation_map_reserve (Q : dyn_reservation_map A → Prop) : (∀ E, set_infinite E → Q (dyn_reservation_map_token E)) → ε ~~>: Q. Proof. intros HQ. apply cmra_total_updateP=> n [mf [Ef|]]; rewrite left_id {1}dyn_reservation_map_validN_eq /=; last done. intros [Hmap [Hinf Hdisj]]. (* Pick a fresh set disjoint from the existing tokens [Ef] and map [mf], such that both that set [E1] and the remainder [E2] are infinite. *) edestruct (coPset_split_infinite (⊤ ∖ (Ef ∪ (gset_to_coPset $ dom mf)))) as (E1 & E2 & HEunion & HEdisj & HE1inf & HE2inf). { rewrite -difference_difference_l_L. by apply difference_infinite, gset_to_coPset_finite. } exists (dyn_reservation_map_token E1). split; first by apply HQ. clear HQ. rewrite dyn_reservation_map_validN_eq /=. rewrite coPset_disj_union; last set_solver. split; first by rewrite left_id_L. split. - eapply set_infinite_subseteq, HE2inf. set_solver. - intros i. rewrite left_id_L. destruct (Hdisj i) as [?|Hi]; first by left. destruct (mf !! i) as [p|] eqn:Hp; last by left. apply elem_of_dom_2, elem_of_gset_to_coPset in Hp. right. set_solver. Qed. Lemma dyn_reservation_map_reserve' : ε ~~>: λ x, ∃ E, set_infinite E ∧ x = dyn_reservation_map_token E. Proof. eauto using dyn_reservation_map_reserve. Qed. Lemma dyn_reservation_map_alloc E k a : k ∈ E → ✓ a → dyn_reservation_map_token E ~~> dyn_reservation_map_data k a. Proof. intros ??. apply cmra_total_update=> n [mf [Ef|]] //. rewrite dyn_reservation_map_validN_eq /= {1}/op {1}/cmra_op /=. case_decide; last done. rewrite !left_id_L. intros [Hmf [Hinf Hdisj]]; split; last split. - destruct (Hdisj k) as [Hmfi|]; last set_solver. intros j. rewrite lookup_op. destruct (decide (k = j)) as [<-|]. + rewrite Hmfi lookup_singleton right_id_L. by apply cmra_valid_validN. + by rewrite lookup_singleton_ne // left_id_L. - eapply set_infinite_subseteq, Hinf. set_solver. - intros j. destruct (decide (k = j)); first set_solver. rewrite lookup_op lookup_singleton_ne //. destruct (Hdisj j) as [Hmfi|?]; last set_solver. rewrite Hmfi; auto. Qed. Lemma dyn_reservation_map_updateP P (Q : dyn_reservation_map A → Prop) k a : a ~~>: P → (∀ a', P a' → Q (dyn_reservation_map_data k a')) → dyn_reservation_map_data k a ~~>: Q. Proof. intros Hup HP. apply cmra_total_updateP=> n [mf [Ef|]] //. rewrite dyn_reservation_map_validN_eq /= left_id_L. intros [Hmf [Hinf Hdisj]]. destruct (Hup n (mf !! k)) as (a'&?&?). { move: (Hmf (k)). by rewrite lookup_op lookup_singleton Some_op_opM. } exists (dyn_reservation_map_data k a'); split; first by eauto. rewrite /= left_id_L. split; last split. - intros j. destruct (decide (k = j)) as [<-|]. + by rewrite lookup_op lookup_singleton Some_op_opM. + rewrite lookup_op lookup_singleton_ne // left_id_L. move: (Hmf j). rewrite lookup_op. eauto using cmra_validN_op_r. - done. - intros j. move: (Hdisj j). rewrite !lookup_op !op_None !lookup_singleton_None. naive_solver. Qed. Lemma dyn_reservation_map_update k a b : a ~~> b → dyn_reservation_map_data k a ~~> dyn_reservation_map_data k b. Proof. rewrite !cmra_update_updateP. eauto using dyn_reservation_map_updateP with subst. Qed. End cmra. Global Arguments dyn_reservation_mapR : clear implicits. Global Arguments dyn_reservation_mapUR : clear implicits. iris-iris-4.2.0/iris/algebra/excl.v000066400000000000000000000144201460620107300171140ustar00rootroot00000000000000From iris.algebra Require Export cmra. From iris.prelude Require Import options. Local Arguments validN _ _ _ !_ /. Local Arguments valid _ _ !_ /. Inductive excl (A : Type) := | Excl : A → excl A | ExclBot : excl A. Global Arguments Excl {_} _. Global Arguments ExclBot {_}. Global Instance: Params (@Excl) 1 := {}. Global Instance: Params (@ExclBot) 1 := {}. Notation excl' A := (option (excl A)). Notation Excl' x := (Some (Excl x)). Notation ExclBot' := (Some ExclBot). Global Instance maybe_Excl {A} : Maybe (@Excl A) := λ x, match x with Excl a => Some a | _ => None end. Section excl. Context {A : ofe}. Implicit Types a b : A. Implicit Types x y : excl A. (* Cofe *) Inductive excl_equiv : Equiv (excl A) := | Excl_equiv a b : a ≡ b → Excl a ≡ Excl b | ExclBot_equiv : ExclBot ≡ ExclBot. Local Existing Instance excl_equiv. Inductive excl_dist : Dist (excl A) := | Excl_dist a b n : a ≡{n}≡ b → Excl a ≡{n}≡ Excl b | ExclBot_dist n : ExclBot ≡{n}≡ ExclBot. Local Existing Instance excl_dist. Global Instance Excl_ne : NonExpansive (@Excl A). Proof. by constructor. Qed. Global Instance Excl_proper : Proper ((≡) ==> (≡)) (@Excl A). Proof. by constructor. Qed. Global Instance Excl_inj : Inj (≡) (≡) (@Excl A). Proof. by inversion_clear 1. Qed. Global Instance Excl_dist_inj n : Inj (dist n) (dist n) (@Excl A). Proof. by inversion_clear 1. Qed. Definition excl_ofe_mixin : OfeMixin (excl A). Proof. apply (iso_ofe_mixin (maybe Excl)). - by intros [a|] [b|]; split; inversion_clear 1; constructor. - by intros n [a|] [b|]; split; inversion_clear 1; constructor. Qed. Canonical Structure exclO : ofe := Ofe (excl A) excl_ofe_mixin. Global Instance excl_cofe `{!Cofe A} : Cofe exclO. Proof. apply (iso_cofe (from_option Excl ExclBot) (maybe Excl)). - by intros n [a|] [b|]; split; inversion_clear 1; constructor. - by intros []; constructor. Qed. Global Instance excl_ofe_discrete : OfeDiscrete A → OfeDiscrete exclO. Proof. by inversion_clear 2; constructor; apply (discrete_0 _). Qed. Global Instance excl_leibniz : LeibnizEquiv A → LeibnizEquiv (excl A). Proof. by destruct 2; f_equal; apply leibniz_equiv. Qed. Global Instance Excl_discrete a : Discrete a → Discrete (Excl a). Proof. by inversion_clear 2; constructor; apply (discrete_0 _). Qed. Global Instance ExclBot_discrete : Discrete (@ExclBot A). Proof. by inversion_clear 1; constructor. Qed. (* CMRA *) Local Instance excl_valid_instance : Valid (excl A) := λ x, match x with Excl _ => True | ExclBot => False end. Local Instance excl_validN_instance : ValidN (excl A) := λ n x, match x with Excl _ => True | ExclBot => False end. Local Instance excl_pcore_instance : PCore (excl A) := λ _, None. Local Instance excl_op_instance : Op (excl A) := λ x y, ExclBot. Lemma excl_cmra_mixin : CmraMixin (excl A). Proof. split; try discriminate. - by intros n []; destruct 1; constructor. - by destruct 1; intros ?. - intros x; split; [done|]. by move=> /(_ 0). - intros n [?|]; simpl; auto with lia. - by intros [?|] [?|] [?|]; constructor. - by intros [?|] [?|]; constructor. - by intros n [?|] [?|]. - intros n x [?|] [?|] ? Hx; eexists _, _; inversion_clear Hx; eauto. Qed. Canonical Structure exclR := Cmra (excl A) excl_cmra_mixin. Global Instance excl_cmra_discrete : OfeDiscrete A → CmraDiscrete exclR. Proof. split; first apply _. by intros []. Qed. (** Exclusive *) Global Instance excl_exclusive x : Exclusive x. Proof. by destruct x; intros n []. Qed. (** Option excl *) Lemma excl_validN_inv_l n mx a : ✓{n} (Excl' a ⋅ mx) → mx = None. Proof. by destruct mx. Qed. Lemma excl_validN_inv_r n mx a : ✓{n} (mx ⋅ Excl' a) → mx = None. Proof. by destruct mx. Qed. Lemma Excl_includedN n a b : Excl' a ≼{n} Excl' b ↔ a ≡{n}≡ b. Proof. split; [|by intros ->]. by intros [[c|] Hb%(inj Some)]; inversion_clear Hb. Qed. Lemma Excl_included a b : Excl' a ≼ Excl' b ↔ a ≡ b. Proof. split; [|by intros ->]. by intros [[c|] Hb%(inj Some)]; inversion_clear Hb. Qed. Lemma ExclBot_included ea : ea ≼ ExclBot. Proof. by exists ExclBot. Qed. End excl. (* We use a [Hint Extern] with [apply:], instead of [Hint Immediate], to invoke the new unification algorithm. The old unification algorithm sometimes gets confused by going from [ucmra]'s to [cmra]'s and back. *) Global Hint Extern 0 (_ ≼ ExclBot) => apply: ExclBot_included : core. Global Arguments exclO : clear implicits. Global Arguments exclR : clear implicits. (* Functor *) Definition excl_map {A B} (f : A → B) (x : excl A) : excl B := match x with Excl a => Excl (f a) | ExclBot => ExclBot end. Lemma excl_map_id {A} (x : excl A) : excl_map id x = x. Proof. by destruct x. Qed. Lemma excl_map_compose {A B C} (f : A → B) (g : B → C) (x : excl A) : excl_map (g ∘ f) x = excl_map g (excl_map f x). Proof. by destruct x. Qed. Lemma excl_map_ext {A B : ofe} (f g : A → B) x : (∀ x, f x ≡ g x) → excl_map f x ≡ excl_map g x. Proof. by destruct x; constructor. Qed. Global Instance excl_map_ne {A B : ofe} n : Proper ((dist n ==> dist n) ==> dist n ==> dist n) (@excl_map A B). Proof. by intros f f' Hf; destruct 1; constructor; apply Hf. Qed. Global Instance excl_map_cmra_morphism {A B : ofe} (f : A → B) : NonExpansive f → CmraMorphism (excl_map f). Proof. split; try done; try apply _. by intros n [a|]. Qed. Definition exclO_map {A B} (f : A -n> B) : exclO A -n> exclO B := OfeMor (excl_map f). Global Instance exclO_map_ne A B : NonExpansive (@exclO_map A B). Proof. by intros n f f' Hf []; constructor; apply Hf. Qed. Program Definition exclRF (F : oFunctor) : rFunctor := {| rFunctor_car A _ B _ := (exclR (oFunctor_car F A B)); rFunctor_map A1 _ A2 _ B1 _ B2 _ fg := exclO_map (oFunctor_map F fg) |}. Next Obligation. intros F A1 ? A2 ? B1 ? B2 ? n x1 x2 ??. by apply exclO_map_ne, oFunctor_map_ne. Qed. Next Obligation. intros F A ? B ? x; simpl. rewrite -{2}(excl_map_id x). apply excl_map_ext=>y. by rewrite oFunctor_map_id. Qed. Next Obligation. intros F A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x; simpl. rewrite -excl_map_compose. apply excl_map_ext=>y; apply oFunctor_map_compose. Qed. Global Instance exclRF_contractive F : oFunctorContractive F → rFunctorContractive (exclRF F). Proof. intros A1 ? A2 ? B1 ? B2 ? n x1 x2 ??. by apply exclO_map_ne, oFunctor_map_contractive. Qed. iris-iris-4.2.0/iris/algebra/frac.v000066400000000000000000000043661460620107300171040ustar00rootroot00000000000000(** This file provides a version of the fractional camera whose elements are in the internal (0,1] of the rational numbers. Notice that this camera could in principle be obtained by restricting the validity of the unbounded fractional camera [ufrac]. *) From iris.algebra Require Export cmra. From iris.algebra Require Import proofmode_classes. From iris.prelude Require Import options. (** Since the standard (0,1] fractional camera is used more often, we define [frac] through a [Notation] instead of a [Definition]. That way, Coq infers the [frac] camera by default when using the [Qp] type. *) Notation frac := Qp (only parsing). Section frac. Canonical Structure fracO := leibnizO frac. Local Instance frac_valid_instance : Valid frac := λ x, (x ≤ 1)%Qp. Local Instance frac_pcore_instance : PCore frac := λ _, None. Local Instance frac_op_instance : Op frac := λ x y, (x + y)%Qp. Lemma frac_valid p : ✓ p ↔ (p ≤ 1)%Qp. Proof. done. Qed. Lemma frac_valid_1 : ✓ 1%Qp. Proof. done. Qed. Lemma frac_op p q : p ⋅ q = (p + q)%Qp. Proof. done. Qed. Lemma frac_included p q : p ≼ q ↔ (p < q)%Qp. Proof. by rewrite Qp.lt_sum. Qed. Corollary frac_included_weak p q : p ≼ q → (p ≤ q)%Qp. Proof. rewrite frac_included. apply Qp.lt_le_incl. Qed. Definition frac_ra_mixin : RAMixin frac. Proof. split; try apply _; try done. intros p q. rewrite !frac_valid frac_op=> ?. trans (p + q)%Qp; last done. apply Qp.le_add_l. Qed. Canonical Structure fracR := discreteR frac frac_ra_mixin. Global Instance frac_cmra_discrete : CmraDiscrete fracR. Proof. apply discrete_cmra_discrete. Qed. Global Instance frac_full_exclusive : Exclusive 1%Qp. Proof. intros p. apply Qp.not_add_le_l. Qed. Global Instance frac_cancelable (q : frac) : Cancelable q. Proof. intros n p1 p2 _. apply (inj (Qp.add q)). Qed. Global Instance frac_id_free (q : frac) : IdFree q. Proof. intros p _. apply Qp.add_id_free. Qed. (* This one has a higher precendence than [is_op_op] so we get a [+] instead of an [⋅]. *) Global Instance frac_is_op q1 q2 : IsOp (q1 + q2)%Qp q1 q2 | 10. Proof. done. Qed. Global Instance is_op_frac q : IsOp' q (q/2)%Qp (q/2)%Qp. Proof. by rewrite /IsOp' /IsOp frac_op Qp.div_2. Qed. End frac. iris-iris-4.2.0/iris/algebra/functions.v000066400000000000000000000165751460620107300202060ustar00rootroot00000000000000From stdpp Require Import finite. From iris.algebra Require Export cmra. From iris.algebra Require Import updates. From iris.prelude Require Import options. Definition discrete_fun_insert `{EqDecision A} {B : A → ofe} (x : A) (y : B x) (f : discrete_fun B) : discrete_fun B := λ x', match decide (x = x') with left H => eq_rect _ B y _ H | right _ => f x' end. Global Instance: Params (@discrete_fun_insert) 5 := {}. Definition discrete_fun_singleton `{EqDecision A} {B : A → ucmra} (x : A) (y : B x) : discrete_fun B := discrete_fun_insert x y ε. Global Instance: Params (@discrete_fun_singleton) 5 := {}. Section ofe. Context {A : Type} `{Heqdec : !EqDecision A} {B : A → ofe}. Implicit Types x : A. Implicit Types f g : discrete_fun B. Global Instance discrete_funO_ofe_discrete : (∀ i, OfeDiscrete (B i)) → OfeDiscrete (discrete_funO B). Proof. intros HB f f' Heq i. apply HB, Heq. Qed. (** Properties of discrete_fun_insert. *) Global Instance discrete_fun_insert_ne x : NonExpansive2 (discrete_fun_insert (B:=B) x). Proof. intros n y1 y2 ? f1 f2 ? x'; rewrite /discrete_fun_insert. by destruct (decide _) as [[]|]. Qed. Global Instance discrete_fun_insert_proper x : Proper ((≡) ==> (≡) ==> (≡)) (discrete_fun_insert (B:=B) x) := ne_proper_2 _. Lemma discrete_fun_lookup_insert f x y : (discrete_fun_insert x y f) x = y. Proof. rewrite /discrete_fun_insert; destruct (decide _) as [Hx|]; last done. by rewrite (proof_irrel Hx eq_refl). Qed. Lemma discrete_fun_lookup_insert_ne f x x' y : x ≠ x' → (discrete_fun_insert x y f) x' = f x'. Proof. by rewrite /discrete_fun_insert; destruct (decide _). Qed. Global Instance discrete_fun_insert_discrete f x y : Discrete f → Discrete y → Discrete (discrete_fun_insert x y f). Proof. intros ?? g Heq x'; destruct (decide (x = x')) as [->|]. - rewrite discrete_fun_lookup_insert. apply: discrete. by rewrite -(Heq x') discrete_fun_lookup_insert. - rewrite discrete_fun_lookup_insert_ne //. apply: discrete. by rewrite -(Heq x') discrete_fun_lookup_insert_ne. Qed. End ofe. Section cmra. Context {A : Type} `{Heqdec : !EqDecision A} {B : A → ucmra}. Implicit Types x : A. Implicit Types f g : discrete_fun B. Global Instance discrete_funR_cmra_discrete: (∀ i, CmraDiscrete (B i)) → CmraDiscrete (discrete_funR B). Proof. intros HB. split; [apply _|]. intros x Hv i. apply HB, Hv. Qed. Global Instance discrete_fun_singleton_ne x : NonExpansive (discrete_fun_singleton x : B x → _). Proof. intros n y1 y2 ?; apply discrete_fun_insert_ne; [done|]. by apply equiv_dist. Qed. Global Instance discrete_fun_singleton_proper x : Proper ((≡) ==> (≡)) (discrete_fun_singleton x) := ne_proper _. Lemma discrete_fun_lookup_singleton x (y : B x) : (discrete_fun_singleton x y) x = y. Proof. by rewrite /discrete_fun_singleton discrete_fun_lookup_insert. Qed. Lemma discrete_fun_lookup_singleton_ne x x' (y : B x) : x ≠ x' → (discrete_fun_singleton x y) x' = ε. Proof. intros; by rewrite /discrete_fun_singleton discrete_fun_lookup_insert_ne. Qed. Global Instance discrete_fun_singleton_discrete x (y : B x) : (∀ i, Discrete (ε : B i)) → Discrete y → Discrete (discrete_fun_singleton x y). Proof. apply _. Qed. Lemma discrete_fun_singleton_validN n x (y : B x) : ✓{n} discrete_fun_singleton x y ↔ ✓{n} y. Proof. split; [by move=>/(_ x); rewrite discrete_fun_lookup_singleton|]. move=>Hx x'; destruct (decide (x = x')) as [->|]; rewrite ?discrete_fun_lookup_singleton ?discrete_fun_lookup_singleton_ne //. by apply ucmra_unit_validN. Qed. Lemma discrete_fun_singleton_core x (y : B x) : core (discrete_fun_singleton x y) ≡ discrete_fun_singleton x (core y). Proof. move=>x'; destruct (decide (x = x')) as [->|]; by rewrite discrete_fun_lookup_core ?discrete_fun_lookup_singleton ?discrete_fun_lookup_singleton_ne // (core_id_core _). Qed. Global Instance discrete_fun_singleton_core_id x (y : B x) : CoreId y → CoreId (discrete_fun_singleton x y). Proof. by rewrite !core_id_total discrete_fun_singleton_core=> ->. Qed. Lemma discrete_fun_singleton_op (x : A) (y1 y2 : B x) : discrete_fun_singleton x y1 ⋅ discrete_fun_singleton x y2 ≡ discrete_fun_singleton x (y1 ⋅ y2). Proof. intros x'; destruct (decide (x' = x)) as [->|]. - by rewrite discrete_fun_lookup_op !discrete_fun_lookup_singleton. - by rewrite discrete_fun_lookup_op !discrete_fun_lookup_singleton_ne // left_id. Qed. Lemma discrete_fun_insert_updateP x (P : B x → Prop) (Q : discrete_fun B → Prop) g y1 : y1 ~~>: P → (∀ y2, P y2 → Q (discrete_fun_insert x y2 g)) → discrete_fun_insert x y1 g ~~>: Q. Proof. intros Hy1 HP; apply cmra_total_updateP. intros n gf Hg. destruct (Hy1 n (Some (gf x))) as (y2&?&?). { move: (Hg x). by rewrite discrete_fun_lookup_op discrete_fun_lookup_insert. } exists (discrete_fun_insert x y2 g); split; [auto|]. intros x'; destruct (decide (x' = x)) as [->|]; rewrite discrete_fun_lookup_op ?discrete_fun_lookup_insert //; []. move: (Hg x'). by rewrite discrete_fun_lookup_op !discrete_fun_lookup_insert_ne. Qed. Lemma discrete_fun_insert_updateP' x (P : B x → Prop) g y1 : y1 ~~>: P → discrete_fun_insert x y1 g ~~>: λ g', ∃ y2, g' = discrete_fun_insert x y2 g ∧ P y2. Proof. eauto using discrete_fun_insert_updateP. Qed. Lemma discrete_fun_insert_update g x y1 y2 : y1 ~~> y2 → discrete_fun_insert x y1 g ~~> discrete_fun_insert x y2 g. Proof. rewrite !cmra_update_updateP; eauto using discrete_fun_insert_updateP with subst. Qed. Lemma discrete_fun_singleton_updateP x (P : B x → Prop) (Q : discrete_fun B → Prop) y1 : y1 ~~>: P → (∀ y2, P y2 → Q (discrete_fun_singleton x y2)) → discrete_fun_singleton x y1 ~~>: Q. Proof. rewrite /discrete_fun_singleton; eauto using discrete_fun_insert_updateP. Qed. Lemma discrete_fun_singleton_updateP' x (P : B x → Prop) y1 : y1 ~~>: P → discrete_fun_singleton x y1 ~~>: λ g, ∃ y2, g = discrete_fun_singleton x y2 ∧ P y2. Proof. eauto using discrete_fun_singleton_updateP. Qed. Lemma discrete_fun_singleton_update x (y1 y2 : B x) : y1 ~~> y2 → discrete_fun_singleton x y1 ~~> discrete_fun_singleton x y2. Proof. eauto using discrete_fun_insert_update. Qed. Lemma discrete_fun_singleton_updateP_empty x (P : B x → Prop) (Q : discrete_fun B → Prop) : ε ~~>: P → (∀ y2, P y2 → Q (discrete_fun_singleton x y2)) → ε ~~>: Q. Proof. intros Hx HQ; apply cmra_total_updateP. intros n gf Hg. destruct (Hx n (Some (gf x))) as (y2&?&?); first apply Hg. exists (discrete_fun_singleton x y2); split; [by apply HQ|]. intros x'; destruct (decide (x' = x)) as [->|]. - by rewrite discrete_fun_lookup_op discrete_fun_lookup_singleton. - rewrite discrete_fun_lookup_op discrete_fun_lookup_singleton_ne //; by apply Hg. Qed. Lemma discrete_fun_singleton_updateP_empty' x (P : B x → Prop) : ε ~~>: P → ε ~~>: λ g, ∃ y2, g = discrete_fun_singleton x y2 ∧ P y2. Proof. eauto using discrete_fun_singleton_updateP_empty. Qed. Lemma discrete_fun_singleton_update_empty x (y : B x) : ε ~~> y → ε ~~> discrete_fun_singleton x y. Proof. rewrite !cmra_update_updateP; eauto using discrete_fun_singleton_updateP_empty with subst. Qed. End cmra. iris-iris-4.2.0/iris/algebra/gmap.v000066400000000000000000000776301460620107300171210ustar00rootroot00000000000000From stdpp Require Export list gmap. From iris.algebra Require Export list cmra. From iris.algebra Require Import gset. From iris.algebra Require Import updates local_updates proofmode_classes big_op. From iris.prelude Require Import options. Section ofe. Context `{Countable K} {A : ofe}. Implicit Types m : gmap K A. Implicit Types i : K. Local Instance gmap_dist : Dist (gmap K A) := λ n m1 m2, ∀ i, m1 !! i ≡{n}≡ m2 !! i. Definition gmap_ofe_mixin : OfeMixin (gmap K A). Proof. split. - intros m1 m2; split. + by intros Hm n k; apply equiv_dist. + intros Hm k; apply equiv_dist; intros n; apply Hm. - intros n; split. + by intros m k. + by intros m1 m2 ? k. + by intros m1 m2 m3 ?? k; trans (m2 !! k). - intros n m m1 m2 ? ? k. eauto using dist_le with si_solver. Qed. Canonical Structure gmapO : ofe := Ofe (gmap K A) gmap_ofe_mixin. Program Definition gmap_chain (c : chain gmapO) (k : K) : chain (optionO A) := {| chain_car n := c n !! k |}. Next Obligation. by intros c k n i ?; apply (chain_cauchy c). Qed. Definition gmap_compl `{Cofe A} : Compl gmapO := λ c, map_imap (λ i _, compl (gmap_chain c i)) (c 0). Global Program Instance gmap_cofe `{Cofe A} : Cofe gmapO := {| compl := gmap_compl |}. Next Obligation. intros ? n c k. rewrite /compl /gmap_compl map_lookup_imap. oinversion (λ H, chain_cauchy c 0 n H k);simplify_option_eq;auto with lia. by rewrite conv_compl /=; apply reflexive_eq. Qed. Global Instance gmap_ofe_discrete : OfeDiscrete A → OfeDiscrete gmapO. Proof. intros ? m m' ? i. by apply (discrete_0 _). Qed. (* why doesn't this go automatic? *) Global Instance gmapO_leibniz: LeibnizEquiv A → LeibnizEquiv gmapO. Proof. intros; change (LeibnizEquiv (gmap K A)); apply _. Qed. Global Instance lookup_ne k : NonExpansive (lookup k : gmap K A → option A). Proof. by intros n m1 m2. Qed. Global Instance lookup_total_ne `{!Inhabited A} k : NonExpansive (lookup_total k : gmap K A → A). Proof. intros n m1 m2. rewrite !lookup_total_alt. by intros ->. Qed. Global Instance partial_alter_ne n : Proper ((dist n ==> dist n) ==> (=) ==> dist n ==> dist n) (partial_alter (M:=gmap K A)). Proof. by intros f1 f2 Hf i ? <- m1 m2 Hm j; destruct (decide (i = j)) as [->|]; rewrite ?lookup_partial_alter ?lookup_partial_alter_ne //; try apply Hf; apply lookup_ne. Qed. Global Instance insert_ne i : NonExpansive2 (insert (M:=gmap K A) i). Proof. intros n x y ? m m' ? j; apply partial_alter_ne; by try constructor. Qed. Global Instance singleton_ne i : NonExpansive (singletonM i : A → gmap K A). Proof. by intros ????; apply insert_ne. Qed. Global Instance delete_ne i : NonExpansive (delete (M:=gmap K A) i). Proof. intros n m m' ? j; destruct (decide (i = j)); simplify_map_eq; [by constructor|by apply lookup_ne]. Qed. Global Instance alter_ne (f : A → A) (k : K) n : Proper (dist n ==> dist n) f → Proper (dist n ==> dist n) (alter (M := gmap K A) f k). Proof. intros ? m m' Hm k'. by apply partial_alter_ne; [solve_proper|..]. Qed. Global Instance gmap_empty_discrete : Discrete (∅ : gmap K A). Proof. intros m Hm i; specialize (Hm i); rewrite lookup_empty in Hm |- *. inversion_clear Hm; constructor. Qed. Global Instance gmap_lookup_discrete m i : Discrete m → Discrete (m !! i). Proof. intros ? [x|] Hx; [|by symmetry; apply: discrete]. assert (m ≡{0}≡ <[i:=x]> m) by (by symmetry in Hx; inversion Hx; ofe_subst; rewrite insert_id). by rewrite (discrete_0 m (<[i:=x]>m)) // lookup_insert. Qed. Global Instance gmap_insert_discrete m i x : Discrete x → Discrete m → Discrete (<[i:=x]>m). Proof. intros ?? m' Hm j; destruct (decide (i = j)); simplify_map_eq. { by apply: discrete; rewrite -Hm lookup_insert. } by apply: discrete; rewrite -Hm lookup_insert_ne. Qed. Global Instance gmap_singleton_discrete i x : Discrete x → Discrete ({[ i := x ]} : gmap K A). Proof. rewrite /singletonM /map_singleton. apply _. Qed. Lemma insert_idN n m i x : m !! i ≡{n}≡ Some x → <[i:=x]>m ≡{n}≡ m. Proof. intros (y'&?&->)%dist_Some_inv_r'. by rewrite insert_id. Qed. Global Instance gmap_dom_ne n : Proper ((≡{n}@{gmap K A}≡) ==> (=)) dom. Proof. intros m1 m2 Hm. apply set_eq=> k. by rewrite !elem_of_dom Hm. Qed. End ofe. Global Instance map_seq_ne {A : ofe} start : NonExpansive (map_seq (M:=gmap nat A) start). Proof. intros n l1 l2 Hl. revert start. induction Hl; intros; simpl; repeat (done || f_equiv). Qed. Global Arguments gmapO _ {_ _} _. (** Non-expansiveness of higher-order map functions and big-ops *) Global Instance merge_ne `{Countable K} {A B C : ofe} n : Proper ((dist (A:=option A) n ==> dist (A:=option B) n ==> dist (A:=option C) n) ==> dist n ==> dist n ==> dist n) (merge (M:=gmap K)). Proof. intros ?? Hf ?? Hm1 ?? Hm2 i. rewrite !lookup_merge. destruct (Hm1 i), (Hm2 i); try apply Hf; by constructor. Qed. Global Instance union_with_ne `{Countable K} {A : ofe} n : Proper ((dist n ==> dist n ==> dist n) ==> dist n ==> dist n ==> dist n) (union_with (M:=gmap K A)). Proof. intros ?? Hf ?? Hm1 ?? Hm2 i; apply (merge_ne _ _); auto. by do 2 destruct 1; first [apply Hf | constructor]. Qed. Global Instance map_fmap_ne `{Countable K} {A B : ofe} (f : A → B) n : Proper (dist n ==> dist n) f → Proper (dist n ==> dist n) (fmap (M:=gmap K) f). Proof. intros ? m m' ? k; rewrite !lookup_fmap. by repeat f_equiv. Qed. Global Instance map_zip_with_ne `{Countable K} {A B C : ofe} (f : A → B → C) n : Proper (dist n ==> dist n ==> dist n) f → Proper (dist n ==> dist n ==> dist n) (map_zip_with (M:=gmap K) f). Proof. intros Hf m1 m1' Hm1 m2 m2' Hm2. apply merge_ne; try done. destruct 1; destruct 1; repeat f_equiv; constructor || done. Qed. Global Instance gmap_union_ne `{Countable K} {A : ofe} : NonExpansive2 (union (A:=gmap K A)). Proof. intros n. apply union_with_ne. by constructor. Qed. Global Instance gmap_disjoint_ne `{Countable K} {A : ofe} n : Proper (dist n ==> dist n ==> iff) (map_disjoint (M:=gmap K) (A:=A)). Proof. intros m1 m1' Hm1 m2 m2' Hm2; split; intros Hm i; specialize (Hm i); by destruct (Hm1 i), (Hm2 i). Qed. Lemma gmap_union_dist_eq `{Countable K} {A : ofe} (m m1 m2 : gmap K A) n : m ≡{n}≡ m1 ∪ m2 ↔ ∃ m1' m2', m = m1' ∪ m2' ∧ m1' ≡{n}≡ m1 ∧ m2' ≡{n}≡ m2. Proof. split; last first. { by intros (m1'&m2'&->&<-&<-). } intros Hm. exists (filter (λ '(l,_), is_Some (m1 !! l)) m), (m2 ∩ m1 ∪ filter (λ '(l,_), is_Some (m2 !! l)) m). split_and!; [apply map_eq|..]; intros k; move: (Hm k); rewrite ?lookup_union ?lookup_intersection !map_lookup_filter; case _ : (m !! k)=> [x|] /=; case _ : (m1 !! k)=> [x1|] /=; case _ : (m2 !! k)=> [x2|] /=; by inversion 1. Qed. Lemma big_opM_ne_2 `{Monoid M o} `{Countable K} {A : ofe} (f g : K → A → M) m1 m2 n : m1 ≡{n}≡ m2 → (∀ k y1 y2, m1 !! k = Some y1 → m2 !! k = Some y2 → y1 ≡{n}≡ y2 → f k y1 ≡{n}≡ g k y2) → ([^o map] k ↦ y ∈ m1, f k y) ≡{n}≡ ([^o map] k ↦ y ∈ m2, g k y). Proof. intros Hl Hf. apply big_opM_gen_proper_2; try (apply _ || done). { by intros ?? ->. } { apply monoid_ne. } intros k. assert (m1 !! k ≡{n}≡ m2 !! k) as Hlk by (by f_equiv). destruct (m1 !! k) eqn:?, (m2 !! k) eqn:?; inversion Hlk; naive_solver. Qed. (* CMRA *) Section cmra. Context `{Countable K} {A : cmra}. Implicit Types m : gmap K A. Local Instance gmap_unit_instance : Unit (gmap K A) := (∅ : gmap K A). Local Instance gmap_op_instance : Op (gmap K A) := merge op. Local Instance gmap_pcore_instance : PCore (gmap K A) := λ m, Some (omap pcore m). Local Instance gmap_valid_instance : Valid (gmap K A) := λ m, ∀ i, ✓ (m !! i). Local Instance gmap_validN_instance : ValidN (gmap K A) := λ n m, ∀ i, ✓{n} (m !! i). Lemma gmap_op m1 m2 : m1 ⋅ m2 = merge op m1 m2. Proof. done. Qed. Lemma lookup_op m1 m2 i : (m1 ⋅ m2) !! i = m1 !! i ⋅ m2 !! i. Proof. rewrite lookup_merge. by destruct (m1 !! i), (m2 !! i). Qed. Lemma lookup_core m i : core m !! i = core (m !! i). Proof. by apply lookup_omap. Qed. Lemma lookup_includedN n (m1 m2 : gmap K A) : m1 ≼{n} m2 ↔ ∀ i, m1 !! i ≼{n} m2 !! i. Proof. split; [by intros [m Hm] i; exists (m !! i); rewrite -lookup_op Hm|]. revert m2. induction m1 as [|i x m Hi IH] using map_ind=> m2 Hm. { exists m2. by rewrite left_id. } destruct (IH (delete i m2)) as [m2' Hm2']. { intros j. move: (Hm j); destruct (decide (i = j)) as [->|]. - intros _. rewrite Hi. apply: ucmra_unit_leastN. - rewrite lookup_insert_ne // lookup_delete_ne //. } destruct (Hm i) as [my Hi']; simplify_map_eq. exists (partial_alter (λ _, my) i m2')=>j; destruct (decide (i = j)) as [->|]. - by rewrite Hi' lookup_op lookup_insert lookup_partial_alter. - move: (Hm2' j). by rewrite !lookup_op lookup_delete_ne // lookup_insert_ne // lookup_partial_alter_ne. Qed. (* [m1 ≼ m2] is not equivalent to [∀ n, m1 ≼{n} m2], so there is no good way to reuse the above proof. *) Lemma lookup_included (m1 m2 : gmap K A) : m1 ≼ m2 ↔ ∀ i, m1 !! i ≼ m2 !! i. Proof. split; [by intros [m Hm] i; exists (m !! i); rewrite -lookup_op Hm|]. revert m2. induction m1 as [|i x m Hi IH] using map_ind=> m2 Hm. { exists m2. by rewrite left_id. } destruct (IH (delete i m2)) as [m2' Hm2']. { intros j. move: (Hm j); destruct (decide (i = j)) as [->|]. - intros _. rewrite Hi. apply: ucmra_unit_least. - rewrite lookup_insert_ne // lookup_delete_ne //. } destruct (Hm i) as [my Hi']; simplify_map_eq. exists (partial_alter (λ _, my) i m2')=>j; destruct (decide (i = j)) as [->|]. - by rewrite Hi' lookup_op lookup_insert lookup_partial_alter. - move: (Hm2' j). by rewrite !lookup_op lookup_delete_ne // lookup_insert_ne // lookup_partial_alter_ne. Qed. Lemma gmap_cmra_mixin : CmraMixin (gmap K A). Proof. apply cmra_total_mixin. - eauto. - intros n m1 m2 m3 Hm i; by rewrite !lookup_op (Hm i). - intros n m1 m2 Hm i; by rewrite !lookup_core (Hm i). - intros n m1 m2 Hm ? i; by rewrite -(Hm i). - intros m; split. + by intros ? n i; apply cmra_valid_validN. + intros Hm i; apply cmra_valid_validN=> n; apply Hm. - intros n m Hm i; apply cmra_validN_S, Hm. - by intros m1 m2 m3 i; rewrite !lookup_op assoc. - by intros m1 m2 i; rewrite !lookup_op comm. - intros m i. by rewrite lookup_op lookup_core cmra_core_l. - intros m i. by rewrite !lookup_core cmra_core_idemp. - intros m1 m2; rewrite !lookup_included=> Hm i. rewrite !lookup_core. by apply cmra_core_mono. - intros n m1 m2 Hm i; apply cmra_validN_op_l with (m2 !! i). by rewrite -lookup_op. - intros n m y1 y2 Hm Heq. refine ((λ FUN, _) (λ i, cmra_extend n (m !! i) (y1 !! i) (y2 !! i) (Hm i) _)); last by rewrite -lookup_op. exists (map_imap (λ i _, projT1 (FUN i)) y1). exists (map_imap (λ i _, proj1_sig (projT2 (FUN i))) y2). split; [|split]=>i; rewrite ?lookup_op !map_lookup_imap; destruct (FUN i) as (z1i&z2i&Hmi&Hz1i&Hz2i)=>/=. + destruct (y1 !! i), (y2 !! i); inversion Hz1i; inversion Hz2i; subst=>//. + revert Hz1i. case: (y1!!i)=>[?|] //. + revert Hz2i. case: (y2!!i)=>[?|] //. Qed. Canonical Structure gmapR := Cmra (gmap K A) gmap_cmra_mixin. Global Instance gmap_cmra_discrete : CmraDiscrete A → CmraDiscrete gmapR. Proof. split; [apply _|]. intros m ? i. by apply: cmra_discrete_valid. Qed. Lemma gmap_ucmra_mixin : UcmraMixin (gmap K A). Proof. split. - by intros i; rewrite lookup_empty. - by intros m i; rewrite /= lookup_op lookup_empty (left_id_L None _). - constructor=> i. by rewrite lookup_omap lookup_empty. Qed. Canonical Structure gmapUR := Ucmra (gmap K A) gmap_ucmra_mixin. End cmra. Global Arguments gmapR _ {_ _} _. Global Arguments gmapUR _ {_ _} _. Section properties. Context `{Countable K} {A : cmra}. Implicit Types m : gmap K A. Implicit Types i : K. Implicit Types x y : A. Global Instance lookup_op_homomorphism i : MonoidHomomorphism op op (≡) (lookup i : gmap K A → option A). Proof. split; [split|]; try apply _. - intros m1 m2; by rewrite lookup_op. - done. Qed. Lemma lookup_opM m1 mm2 i : (m1 ⋅? mm2) !! i = m1 !! i ⋅ (mm2 ≫= (.!! i)). Proof. destruct mm2; by rewrite /= ?lookup_op ?right_id_L. Qed. Lemma lookup_validN_Some n m i x : ✓{n} m → m !! i ≡{n}≡ Some x → ✓{n} x. Proof. by move=> /(_ i) Hm Hi; move:Hm; rewrite Hi. Qed. Lemma lookup_valid_Some m i x : ✓ m → m !! i ≡ Some x → ✓ x. Proof. move=> Hm Hi. move:(Hm i). by rewrite Hi. Qed. Lemma insert_validN n m i x : ✓{n} x → ✓{n} m → ✓{n} <[i:=x]>m. Proof. by intros ?? j; destruct (decide (i = j)); simplify_map_eq. Qed. Lemma insert_valid m i x : ✓ x → ✓ m → ✓ <[i:=x]>m. Proof. by intros ?? j; destruct (decide (i = j)); simplify_map_eq. Qed. Lemma singleton_validN n i x : ✓{n} ({[ i := x ]} : gmap K A) ↔ ✓{n} x. Proof. split. - move=>/(_ i); by simplify_map_eq. - intros. apply insert_validN; first done. apply: ucmra_unit_validN. Qed. Lemma singleton_valid i x : ✓ ({[ i := x ]} : gmap K A) ↔ ✓ x. Proof. rewrite !cmra_valid_validN. by setoid_rewrite singleton_validN. Qed. Lemma delete_validN n m i : ✓{n} m → ✓{n} (delete i m). Proof. intros Hm j; destruct (decide (i = j)); by simplify_map_eq. Qed. Lemma delete_valid m i : ✓ m → ✓ (delete i m). Proof. intros Hm j; destruct (decide (i = j)); by simplify_map_eq. Qed. Lemma insert_singleton_op m i x : m !! i = None → <[i:=x]> m = {[ i := x ]} ⋅ m. Proof. intros Hi; apply map_eq=> j; destruct (decide (i = j)) as [->|]. - by rewrite lookup_op lookup_insert lookup_singleton Hi right_id_L. - by rewrite lookup_op lookup_insert_ne // lookup_singleton_ne // left_id_L. Qed. Lemma singleton_core (i : K) (x : A) cx : pcore x = Some cx → core {[ i := x ]} =@{gmap K A} {[ i := cx ]}. Proof. apply omap_singleton_Some. Qed. Lemma singleton_core' (i : K) (x : A) cx : pcore x ≡ Some cx → core {[ i := x ]} ≡@{gmap K A} {[ i := cx ]}. Proof. intros (cx'&?&<-)%Some_equiv_eq. by rewrite (singleton_core _ _ cx'). Qed. Lemma singleton_core_total `{!CmraTotal A} (i : K) (x : A) : core {[ i := x ]} =@{gmap K A} {[ i := core x ]}. Proof. apply singleton_core. rewrite cmra_pcore_core //. Qed. Lemma singleton_op (i : K) (x y : A) : {[ i := x ]} ⋅ {[ i := y ]} =@{gmap K A} {[ i := x ⋅ y ]}. Proof. by apply (merge_singleton _ _ _ x y). Qed. Global Instance singleton_is_op i a a1 a2 : IsOp a a1 a2 → IsOp' ({[ i := a ]} : gmap K A) {[ i := a1 ]} {[ i := a2 ]}. Proof. rewrite /IsOp' /IsOp=> ->. by rewrite -singleton_op. Qed. Lemma gmap_core_id m : (∀ i x, m !! i = Some x → CoreId x) → CoreId m. Proof. intros Hcore; apply core_id_total=> i. rewrite lookup_core. destruct (m !! i) as [x|] eqn:Hix; rewrite Hix; [|done]. by eapply Hcore. Qed. Global Instance gmap_core_id' m : (∀ x : A, CoreId x) → CoreId m. Proof. auto using gmap_core_id. Qed. Global Instance gmap_singleton_core_id i (x : A) : CoreId x → CoreId {[ i := x ]}. Proof. intros. by apply core_id_total, singleton_core'. Qed. Lemma singleton_includedN_l n m i x : {[ i := x ]} ≼{n} m ↔ ∃ y, m !! i ≡{n}≡ Some y ∧ Some x ≼{n} Some y. Proof. split. - move=> [m' /(_ i)]; rewrite lookup_op lookup_singleton=> Hi. exists (x ⋅? m' !! i). rewrite -Some_op_opM. split; first done. apply cmra_includedN_l. - intros (y&Hi&[mz Hy]). exists (partial_alter (λ _, mz) i m). intros j; destruct (decide (i = j)) as [->|]. + by rewrite lookup_op lookup_singleton lookup_partial_alter Hi. + by rewrite lookup_op lookup_singleton_ne// lookup_partial_alter_ne// left_id. Qed. (* We do not have [x ≼ y ↔ ∀ n, x ≼{n} y], so we cannot use the previous lemma *) Lemma singleton_included_l m i x : {[ i := x ]} ≼ m ↔ ∃ y, m !! i ≡ Some y ∧ Some x ≼ Some y. Proof. split. - move=> [m' /(_ i)]; rewrite lookup_op lookup_singleton. exists (x ⋅? m' !! i). by rewrite -Some_op_opM. - intros (y&Hi&[mz Hy]). exists (partial_alter (λ _, mz) i m). intros j; destruct (decide (i = j)) as [->|]. + by rewrite lookup_op lookup_singleton lookup_partial_alter Hi. + by rewrite lookup_op lookup_singleton_ne// lookup_partial_alter_ne// left_id. Qed. Lemma singleton_included_exclusive_l m i x : Exclusive x → ✓ m → {[ i := x ]} ≼ m ↔ m !! i ≡ Some x. Proof. intros ? Hm. rewrite singleton_included_l. split; last by eauto. intros (y&?&->%(Some_included_exclusive _)); eauto using lookup_valid_Some. Qed. Lemma singleton_included i x y : {[ i := x ]} ≼ ({[ i := y ]} : gmap K A) ↔ Some x ≼ Some y. Proof. rewrite singleton_included_l. split. - intros (y'&Hi&?). rewrite lookup_insert in Hi. by rewrite Hi. - intros ?. exists y. by rewrite lookup_insert. Qed. Lemma singleton_included_total `{!CmraTotal A} i x y : {[ i := x ]} ≼ ({[ i := y ]} : gmap K A) ↔ x ≼ y. Proof. rewrite singleton_included Some_included_total. done. Qed. Lemma singleton_included_mono i x y : x ≼ y → {[ i := x ]} ≼ ({[ i := y ]} : gmap K A). Proof. intros Hincl. apply singleton_included, Some_included_mono. done. Qed. Global Instance singleton_cancelable i x : Cancelable (Some x) → Cancelable {[ i := x ]}. Proof. intros ? n m1 m2 Hv EQ j. move: (Hv j) (EQ j). rewrite !lookup_op. destruct (decide (i = j)) as [->|]. - rewrite lookup_singleton. by apply cancelableN. - by rewrite lookup_singleton_ne // !(left_id None _). Qed. Global Instance gmap_cancelable (m : gmap K A) : (∀ x : A, IdFree x) → (∀ x : A, Cancelable x) → Cancelable m. Proof. intros ?? n m1 m2 ?? i. apply (cancelableN (m !! i)); by rewrite -!lookup_op. Qed. Lemma insert_op m1 m2 i x y : <[i:=x ⋅ y]>(m1 ⋅ m2) = <[i:=x]>m1 ⋅ <[i:=y]>m2. Proof. by rewrite (insert_merge (⋅) m1 m2 i (x ⋅ y) x y). Qed. Lemma insert_updateP (P : A → Prop) (Q : gmap K A → Prop) m i x : x ~~>: P → (∀ y, P y → Q (<[i:=y]>m)) → <[i:=x]>m ~~>: Q. Proof. intros Hx%option_updateP' HP; apply cmra_total_updateP=> n mf Hm. destruct (Hx n (Some (mf !! i))) as ([y|]&?&?); try done. { by generalize (Hm i); rewrite lookup_op; simplify_map_eq. } exists (<[i:=y]> m); split; first by auto. intros j; move: (Hm j)=>{Hm}; rewrite !lookup_op=>Hm. destruct (decide (i = j)); simplify_map_eq/=; auto. Qed. Lemma insert_updateP' (P : A → Prop) m i x : x ~~>: P → <[i:=x]>m ~~>: λ m', ∃ y, m' = <[i:=y]>m ∧ P y. Proof. eauto using insert_updateP. Qed. Lemma insert_update m i x y : x ~~> y → <[i:=x]>m ~~> <[i:=y]>m. Proof. rewrite !cmra_update_updateP; eauto using insert_updateP with subst. Qed. Lemma singleton_updateP (P : A → Prop) (Q : gmap K A → Prop) i x : x ~~>: P → (∀ y, P y → Q {[ i := y ]}) → {[ i := x ]} ~~>: Q. Proof. apply insert_updateP. Qed. Lemma singleton_updateP' (P : A → Prop) i x : x ~~>: P → {[ i := x ]} ~~>: λ m, ∃ y, m = {[ i := y ]} ∧ P y. Proof. apply insert_updateP'. Qed. Lemma singleton_update i (x y : A) : x ~~> y → {[ i := x ]} ~~> {[ i := y ]}. Proof. apply insert_update. Qed. Lemma delete_update m i : m ~~> delete i m. Proof. apply cmra_total_update=> n mf Hm j; destruct (decide (i = j)); subst. - move: (Hm j). rewrite !lookup_op lookup_delete left_id. apply cmra_validN_op_r. - move: (Hm j). by rewrite !lookup_op lookup_delete_ne. Qed. Lemma gmap_op_union m1 m2 : m1 ##ₘ m2 → m1 ⋅ m2 = m1 ∪ m2. Proof. intros Hm. apply map_eq=> k. specialize (Hm k). rewrite lookup_op lookup_union. by destruct (m1 !! k), (m2 !! k). Qed. Lemma gmap_op_valid0_disjoint m1 m2 : ✓{0} (m1 ⋅ m2) → (∀ k x, m1 !! k = Some x → Exclusive x) → m1 ##ₘ m2. Proof. unfold Exclusive. intros Hvalid Hexcl k. specialize (Hvalid k). rewrite lookup_op in Hvalid. specialize (Hexcl k). destruct (m1 !! k), (m2 !! k); [|done..]. rewrite -Some_op Some_validN in Hvalid. naive_solver. Qed. Lemma gmap_op_valid_disjoint m1 m2 : ✓ (m1 ⋅ m2) → (∀ k x, m1 !! k = Some x → Exclusive x) → m1 ##ₘ m2. Proof. move=> /cmra_valid_validN /(_ 0). apply gmap_op_valid0_disjoint. Qed. Lemma dom_op m1 m2 : dom (m1 ⋅ m2) = dom m1 ∪ dom m2. Proof. apply set_eq=> i; rewrite elem_of_union !elem_of_dom. unfold is_Some; setoid_rewrite lookup_op. destruct (m1 !! i), (m2 !! i); naive_solver. Qed. Lemma dom_included m1 m2 : m1 ≼ m2 → dom m1 ⊆ dom m2. Proof. rewrite lookup_included=>? i; rewrite !elem_of_dom. by apply is_Some_included. Qed. Section freshness. Local Set Default Proof Using "Type*". Context `{!Infinite K}. Lemma alloc_updateP_strong_dep (Q : gmap K A → Prop) (I : K → Prop) m (f : K → A) : pred_infinite I → (∀ i, m !! i = None → I i → ✓ (f i)) → (∀ i, m !! i = None → I i → Q (<[i:=f i]>m)) → m ~~>: Q. Proof. move=> /(pred_infinite_set I (C:=gset K)) HP ? HQ. apply cmra_total_updateP. intros n mf Hm. destruct (HP (dom (m ⋅ mf))) as [i [Hi1 Hi2]]. assert (m !! i = None). { eapply not_elem_of_dom. revert Hi2. rewrite dom_op not_elem_of_union. naive_solver. } exists (<[i:=f i]>m); split. - by apply HQ. - rewrite insert_singleton_op //. rewrite -assoc -insert_singleton_op; last by eapply not_elem_of_dom. apply insert_validN; [apply cmra_valid_validN|]; auto. Qed. Lemma alloc_updateP_strong (Q : gmap K A → Prop) (I : K → Prop) m x : pred_infinite I → ✓ x → (∀ i, m !! i = None → I i → Q (<[i:=x]>m)) → m ~~>: Q. Proof. move=> HP ? HQ. eapply (alloc_updateP_strong_dep _ _ _ (λ _, x)); eauto. Qed. Lemma alloc_updateP (Q : gmap K A → Prop) m x : ✓ x → (∀ i, m !! i = None → Q (<[i:=x]>m)) → m ~~>: Q. Proof. move=>??. eapply (alloc_updateP_strong _ (λ _, True)); eauto using pred_infinite_True. Qed. Lemma alloc_updateP_cofinite (Q : gmap K A → Prop) (J : gset K) m x : ✓ x → (∀ i, m !! i = None → i ∉ J → Q (<[i:=x]>m)) → m ~~>: Q. Proof. eapply alloc_updateP_strong. apply (pred_infinite_set (C:=gset K)). intros E. exists (fresh (J ∪ E)). apply not_elem_of_union, is_fresh. Qed. (* Variants without the universally quantified Q, for use in case that is an evar. *) Lemma alloc_updateP_strong_dep' m (f : K → A) (I : K → Prop) : pred_infinite I → (∀ i, m !! i = None → I i → ✓ (f i)) → m ~~>: λ m', ∃ i, I i ∧ m' = <[i:=f i]>m ∧ m !! i = None. Proof. eauto using alloc_updateP_strong_dep. Qed. Lemma alloc_updateP_strong' m x (I : K → Prop) : pred_infinite I → ✓ x → m ~~>: λ m', ∃ i, I i ∧ m' = <[i:=x]>m ∧ m !! i = None. Proof. eauto using alloc_updateP_strong. Qed. Lemma alloc_updateP' m x : ✓ x → m ~~>: λ m', ∃ i, m' = <[i:=x]>m ∧ m !! i = None. Proof. eauto using alloc_updateP. Qed. Lemma alloc_updateP_cofinite' m x (J : gset K) : ✓ x → m ~~>: λ m', ∃ i, i ∉ J ∧ m' = <[i:=x]>m ∧ m !! i = None. Proof. eauto using alloc_updateP_cofinite. Qed. End freshness. Lemma alloc_unit_singleton_updateP (P : A → Prop) (Q : gmap K A → Prop) u i : ✓ u → LeftId (≡) u (⋅) → u ~~>: P → (∀ y, P y → Q {[ i := y ]}) → ∅ ~~>: Q. Proof. intros ?? Hx HQ. apply cmra_total_updateP=> n gf Hg. destruct (Hx n (gf !! i)) as (y&?&Hy). { move:(Hg i). rewrite !left_id. case: (gf !! i)=>[x|]; rewrite /= ?left_id //. intros; by apply cmra_valid_validN. } exists {[ i := y ]}; split; first by auto. intros i'; destruct (decide (i' = i)) as [->|]. - rewrite lookup_op lookup_singleton. move:Hy; case: (gf !! i)=>[x|]; rewrite /= ?right_id //. - move:(Hg i'). by rewrite !lookup_op lookup_singleton_ne // !left_id. Qed. Lemma alloc_unit_singleton_updateP' (P: A → Prop) u i : ✓ u → LeftId (≡) u (⋅) → u ~~>: P → ∅ ~~>: λ m, ∃ y, m = {[ i := y ]} ∧ P y. Proof. eauto using alloc_unit_singleton_updateP. Qed. Lemma alloc_unit_singleton_update (u : A) i (y : A) : ✓ u → LeftId (≡) u (⋅) → u ~~> y → (∅:gmap K A) ~~> {[ i := y ]}. Proof. rewrite !cmra_update_updateP; eauto using alloc_unit_singleton_updateP with subst. Qed. Lemma gmap_local_update m1 m2 m1' m2' : (∀ i, (m1 !! i, m2 !! i) ~l~> (m1' !! i, m2' !! i)) → (m1, m2) ~l~> (m1', m2'). Proof. intros Hupd. apply local_update_unital=> n mf Hmv Hm. apply forall_and_distr=> i. rewrite lookup_op -cmra_opM_fmap_Some. apply Hupd; simpl; first done. by rewrite Hm lookup_op cmra_opM_fmap_Some. Qed. Lemma alloc_local_update m1 m2 i x : m1 !! i = None → ✓ x → (m1,m2) ~l~> (<[i:=x]>m1, <[i:=x]>m2). Proof. intros Hi ?. apply gmap_local_update=> j. destruct (decide (i = j)) as [->|]; last by rewrite !lookup_insert_ne. rewrite !lookup_insert Hi. by apply alloc_option_local_update. Qed. Lemma alloc_singleton_local_update m i x : m !! i = None → ✓ x → (m,∅) ~l~> (<[i:=x]>m, {[ i:=x ]}). Proof. apply alloc_local_update. Qed. Lemma insert_local_update m1 m2 i x y x' y' : m1 !! i = Some x → m2 !! i = Some y → (x, y) ~l~> (x', y') → (m1, m2) ~l~> (<[i:=x']>m1, <[i:=y']>m2). Proof. intros Hi1 Hi2 Hup. apply gmap_local_update=> j. destruct (decide (i = j)) as [->|]; last by rewrite !lookup_insert_ne. rewrite !lookup_insert Hi1 Hi2. by apply option_local_update. Qed. Lemma singleton_local_update_any m i y x' y' : (∀ x, m !! i = Some x → (x, y) ~l~> (x', y')) → (m, {[ i := y ]}) ~l~> (<[i:=x']>m, {[ i := y' ]}). Proof. intros. apply gmap_local_update=> j. destruct (decide (i = j)) as [->|]; last by rewrite !lookup_insert_ne. rewrite !lookup_singleton lookup_insert. destruct (m !! j); first by eauto using option_local_update. apply local_update_total_valid0=> _ _ /option_includedN; naive_solver. Qed. Lemma singleton_local_update m i x y x' y' : m !! i = Some x → (x, y) ~l~> (x', y') → (m, {[ i := y ]}) ~l~> (<[i:=x']>m, {[ i := y' ]}). Proof. intros Hmi ?. apply singleton_local_update_any. intros x2. rewrite Hmi=>[=<-]. done. Qed. Lemma delete_local_update m1 m2 i x `{!Exclusive x} : m2 !! i = Some x → (m1, m2) ~l~> (delete i m1, delete i m2). Proof. intros Hi. apply gmap_local_update=> j. destruct (decide (i = j)) as [->|]; last by rewrite !lookup_delete_ne. rewrite !lookup_delete Hi. by apply delete_option_local_update. Qed. Lemma delete_singleton_local_update m i x `{!Exclusive x} : (m, {[ i := x ]}) ~l~> (delete i m, ∅). Proof. rewrite -(delete_singleton i x). by eapply delete_local_update, lookup_singleton. Qed. Lemma delete_local_update_cancelable m1 m2 i mx `{!Cancelable mx} : m1 !! i ≡ mx → m2 !! i ≡ mx → (m1, m2) ~l~> (delete i m1, delete i m2). Proof. intros Hi1 Hi2. apply gmap_local_update=> j. destruct (decide (i = j)) as [->|]; last by rewrite !lookup_delete_ne. rewrite !lookup_delete Hi1 Hi2. by apply delete_option_local_update_cancelable. Qed. Lemma delete_singleton_local_update_cancelable m i x `{!Cancelable (Some x)} : m !! i ≡ Some x → (m, {[ i := x ]}) ~l~> (delete i m, ∅). Proof. intros. rewrite -(delete_singleton i x). apply (delete_local_update_cancelable m _ i (Some x)); [done|by rewrite lookup_singleton]. Qed. Lemma gmap_fmap_mono {B : cmra} (f : A → B) m1 m2 : Proper ((≡) ==> (≡)) f → (∀ x y, x ≼ y → f x ≼ f y) → m1 ≼ m2 → fmap f m1 ≼ fmap f m2. Proof. intros ??. rewrite !lookup_included=> Hm i. rewrite !lookup_fmap. by apply option_fmap_mono. Qed. Lemma big_opM_singletons m : ([^op map] k ↦ x ∈ m, {[ k := x ]}) = m. Proof. (* We are breaking the big_opM abstraction here. The reason is that [map_ind] is too weak: we need an induction principle that visits all the keys in the right order, namely the order in which they appear in map_to_list. Here, we achieve this by unfolding [big_opM] and doing induction over that list instead. *) rewrite big_op.big_opM_unseal /big_op.big_opM_def -{2}(list_to_map_to_list m). assert (NoDup (map_to_list m).*1) as Hnodup by apply NoDup_fst_map_to_list. revert Hnodup. induction (map_to_list m) as [|[k x] l IH]; csimpl; first done. intros [??]%NoDup_cons. rewrite IH //. rewrite insert_singleton_op ?not_elem_of_list_to_map_1 //. Qed. End properties. Section unital_properties. Context `{Countable K} {A : ucmra}. Implicit Types m : gmap K A. Implicit Types i : K. Implicit Types x y : A. Lemma insert_alloc_local_update m1 m2 i x x' y' : m1 !! i = Some x → m2 !! i = None → (x, ε) ~l~> (x', y') → (m1, m2) ~l~> (<[i:=x']>m1, <[i:=y']>m2). Proof. intros Hi1 Hi2 Hup. apply local_update_unital=> n mf Hm1v Hm. assert (mf !! i ≡{n}≡ Some x) as Hif. { move: (Hm i). by rewrite lookup_op Hi1 Hi2 left_id. } destruct (Hup n (mf !! i)) as [Hx'v Hx'eq]. { move: (Hm1v i). by rewrite Hi1. } { by rewrite Hif -(inj_iff Some) -Some_op_opM -Some_op left_id. } split. - by apply insert_validN. - simpl in Hx'eq. by rewrite -(insert_idN n mf i x) // -insert_op -Hm Hx'eq Hif. Qed. End unital_properties. (** Functor *) Global Instance gmap_fmap_ne `{Countable K} {A B : ofe} (f : A → B) n : Proper (dist n ==> dist n) f → Proper (dist n ==>dist n) (fmap (M:=gmap K) f). Proof. by intros ? m m' Hm k; rewrite !lookup_fmap; apply option_fmap_ne. Qed. Lemma gmap_fmap_ne_ext `{Countable K} {A : Type} {B : ofe} (f1 f2 : A → B) (m : gmap K A) n : (∀ i x, m !! i = Some x → f1 x ≡{n}≡ f2 x) → f1 <$> m ≡{n}≡ f2 <$> m. Proof. move => Hf i. rewrite !lookup_fmap. destruct (m !! i) eqn:?; constructor; by eauto. Qed. Global Instance gmap_fmap_cmra_morphism `{Countable K} {A B : cmra} (f : A → B) `{!CmraMorphism f} : CmraMorphism (fmap f : gmap K A → gmap K B). Proof. split; try apply _. - by intros n m ? i; rewrite lookup_fmap; apply (cmra_morphism_validN _). - intros m. apply Some_proper=>i. rewrite lookup_fmap !lookup_omap lookup_fmap. case: (m!!i)=>//= ?. apply cmra_morphism_pcore, _. - intros m1 m2 i. by rewrite lookup_op !lookup_fmap lookup_op cmra_morphism_op. Qed. Definition gmapO_map `{Countable K} {A B} (f: A -n> B) : gmapO K A -n> gmapO K B := OfeMor (fmap f : gmapO K A → gmapO K B). Global Instance gmapO_map_ne `{Countable K} {A B} : NonExpansive (@gmapO_map K _ _ A B). Proof. intros n f g Hf m k; rewrite /= !lookup_fmap. destruct (_ !! k) eqn:?; simpl; constructor; apply Hf. Qed. Program Definition gmapOF K `{Countable K} (F : oFunctor) : oFunctor := {| oFunctor_car A _ B _ := gmapO K (oFunctor_car F A B); oFunctor_map A1 _ A2 _ B1 _ B2 _ fg := gmapO_map (oFunctor_map F fg) |}. Next Obligation. by intros K ?? F A1 ? A2 ? B1 ? B2 ? n f g Hfg; apply gmapO_map_ne, oFunctor_map_ne. Qed. Next Obligation. intros K ?? F A ? B ? x. rewrite /= -{2}(map_fmap_id x). apply map_fmap_equiv_ext=>y ??; apply oFunctor_map_id. Qed. Next Obligation. intros K ?? F A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x. rewrite /= -map_fmap_compose. apply map_fmap_equiv_ext=>y ??; apply oFunctor_map_compose. Qed. Global Instance gmapOF_contractive K `{Countable K} F : oFunctorContractive F → oFunctorContractive (gmapOF K F). Proof. by intros ? A1 ? A2 ? B1 ? B2 ? n f g Hfg; apply gmapO_map_ne, oFunctor_map_contractive. Qed. Program Definition gmapURF K `{Countable K} (F : rFunctor) : urFunctor := {| urFunctor_car A _ B _ := gmapUR K (rFunctor_car F A B); urFunctor_map A1 _ A2 _ B1 _ B2 _ fg := gmapO_map (rFunctor_map F fg) |}. Next Obligation. by intros K ?? F A1 ? A2 ? B1 ? B2 ? n f g Hfg; apply gmapO_map_ne, rFunctor_map_ne. Qed. Next Obligation. intros K ?? F A ? B ? x. rewrite /= -{2}(map_fmap_id x). apply map_fmap_equiv_ext=>y ??; apply rFunctor_map_id. Qed. Next Obligation. intros K ?? F A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x. rewrite /= -map_fmap_compose. apply map_fmap_equiv_ext=>y ??; apply rFunctor_map_compose. Qed. Global Instance gmapURF_contractive K `{Countable K} F : rFunctorContractive F → urFunctorContractive (gmapURF K F). Proof. by intros ? A1 ? A2 ? B1 ? B2 ? n f g Hfg; apply gmapO_map_ne, rFunctor_map_contractive. Qed. Program Definition gmapRF K `{Countable K} (F : rFunctor) : rFunctor := {| rFunctor_car A _ B _ := gmapR K (rFunctor_car F A B); rFunctor_map A1 _ A2 _ B1 _ B2 _ fg := gmapO_map (rFunctor_map F fg) |}. Solve Obligations with apply gmapURF. Global Instance gmapRF_contractive K `{Countable K} F : rFunctorContractive F → rFunctorContractive (gmapRF K F). Proof. apply gmapURF_contractive. Qed. iris-iris-4.2.0/iris/algebra/gmultiset.v000066400000000000000000000071101460620107300201740ustar00rootroot00000000000000From stdpp Require Export sets gmultiset countable. From iris.algebra Require Export cmra. From iris.algebra Require Import updates local_updates big_op. From iris.prelude Require Import options. (* The multiset union CMRA *) Section gmultiset. Context `{Countable K}. Implicit Types X Y : gmultiset K. Canonical Structure gmultisetO := discreteO (gmultiset K). Local Instance gmultiset_valid_instance : Valid (gmultiset K) := λ _, True. Local Instance gmultiset_validN_instance : ValidN (gmultiset K) := λ _ _, True. Local Instance gmultiset_unit_instance : Unit (gmultiset K) := (∅ : gmultiset K). Local Instance gmultiset_op_instance : Op (gmultiset K) := disj_union. Local Instance gmultiset_pcore_instance : PCore (gmultiset K) := λ X, Some ∅. Lemma gmultiset_op X Y : X ⋅ Y = X ⊎ Y. Proof. done. Qed. Lemma gmultiset_core X : core X = ∅. Proof. done. Qed. Lemma gmultiset_included X Y : X ≼ Y ↔ X ⊆ Y. Proof. split. - intros [Z ->%leibniz_equiv]. rewrite gmultiset_op. apply gmultiset_disj_union_subseteq_l. - intros ->%gmultiset_disj_union_difference. by exists (Y ∖ X). Qed. Lemma gmultiset_ra_mixin : RAMixin (gmultiset K). Proof. apply ra_total_mixin; eauto. - by intros X Y Z ->%leibniz_equiv. - by intros X Y ->%leibniz_equiv. - solve_proper. - intros X1 X2 X3. by rewrite !gmultiset_op assoc_L. - intros X1 X2. by rewrite !gmultiset_op comm_L. - intros X. by rewrite gmultiset_core left_id. - intros X1 X2 HX. rewrite !gmultiset_core. exists ∅. by rewrite left_id. Qed. Canonical Structure gmultisetR := discreteR (gmultiset K) gmultiset_ra_mixin. Global Instance gmultiset_cmra_discrete : CmraDiscrete gmultisetR. Proof. apply discrete_cmra_discrete. Qed. Lemma gmultiset_ucmra_mixin : UcmraMixin (gmultiset K). Proof. split; [done | | done]. intros X. by rewrite gmultiset_op left_id_L. Qed. Canonical Structure gmultisetUR := Ucmra (gmultiset K) gmultiset_ucmra_mixin. Global Instance gmultiset_cancelable X : Cancelable X. Proof. apply: discrete_cancelable=> Y Z _ ?. fold_leibniz. by apply (inj (X ⊎.)). Qed. 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. Proof. done. Qed. Lemma gmultiset_local_update X Y X' Y' : X ⊎ Y' = X' ⊎ Y → (X,Y) ~l~> (X', Y'). Proof. intros HXY. rewrite local_update_unital_discrete=> Z' _. intros ->%leibniz_equiv. split; first done. apply leibniz_equiv_iff, (inj (.⊎ Y)). rewrite -HXY !gmultiset_op. by rewrite -(comm_L _ Y) (comm_L _ Y') assoc_L. Qed. Lemma gmultiset_local_update_alloc X Y X' : (X,Y) ~l~> (X ⊎ X', Y ⊎ X'). Proof. apply gmultiset_local_update. by rewrite (comm_L _ Y) assoc_L. Qed. Lemma gmultiset_local_update_dealloc X Y X' : X' ⊆ Y → (X,Y) ~l~> (X ∖ X', Y ∖ X'). Proof. intros ->%gmultiset_disj_union_difference. apply local_update_total_valid. intros _ _ ->%gmultiset_included%gmultiset_disj_union_difference. apply gmultiset_local_update. apply gmultiset_eq=> x. repeat (rewrite multiplicity_difference || rewrite multiplicity_disj_union). lia. Qed. Lemma big_opMS_singletons X : ([^op mset] x ∈ X, {[+ x +]}) = X. Proof. induction X as [|x X IH] using gmultiset_ind. - rewrite big_opMS_empty. done. - unfold_leibniz. rewrite big_opMS_disj_union // big_opMS_singleton IH //. Qed. End gmultiset. Global Arguments gmultisetO _ {_ _}. Global Arguments gmultisetR _ {_ _}. Global Arguments gmultisetUR _ {_ _}. iris-iris-4.2.0/iris/algebra/gset.v000066400000000000000000000236731460620107300171350ustar00rootroot00000000000000From stdpp Require Export sets gmap mapset. From iris.algebra Require Export cmra. From iris.algebra Require Import updates local_updates big_op. From iris.prelude Require Import options. (* The union CMRA *) Section gset. Context `{Countable K}. Implicit Types X Y : gset K. Canonical Structure gsetO := discreteO (gset K). Local Instance gset_valid_instance : Valid (gset K) := λ _, True. Local Instance gset_unit_instance : Unit (gset K) := (∅ : gset K). Local Instance gset_op_instance : Op (gset K) := union. Local Instance gset_pcore_instance : PCore (gset K) := λ X, Some X. Lemma gset_op X Y : X ⋅ Y = X ∪ Y. Proof. done. Qed. Lemma gset_core X : core X = X. Proof. done. Qed. Lemma gset_included X Y : X ≼ Y ↔ X ⊆ Y. Proof. split. - intros [Z ->]. rewrite gset_op. set_solver. - intros (Z&->&?)%subseteq_disjoint_union_L. by exists Z. Qed. Lemma gset_ra_mixin : RAMixin (gset K). Proof. apply ra_total_mixin; apply _ || eauto; []. intros X. by rewrite gset_core idemp_L. Qed. Canonical Structure gsetR := discreteR (gset K) gset_ra_mixin. Global Instance gset_cmra_discrete : CmraDiscrete gsetR. Proof. apply discrete_cmra_discrete. Qed. Lemma gset_ucmra_mixin : UcmraMixin (gset K). Proof. split; [ done | | done ]. intros X. by rewrite gset_op left_id_L. Qed. Canonical Structure gsetUR := Ucmra (gset K) gset_ucmra_mixin. 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. Proof. done. Qed. Lemma gset_local_update X Y X' : X ⊆ X' → (X,Y) ~l~> (X',X'). Proof. intros (Z&->&?)%subseteq_disjoint_union_L. rewrite local_update_unital_discrete=> Z' _ /leibniz_equiv_iff->. split; [done|]. rewrite gset_op. set_solver. Qed. Global Instance gset_core_id X : CoreId X. Proof. by apply core_id_total; rewrite gset_core. Qed. Lemma big_opS_singletons X : ([^op set] x ∈ X, {[ x ]}) = X. Proof. induction X as [|x X Hx IH] using set_ind_L. - rewrite big_opS_empty. done. - unfold_leibniz. rewrite big_opS_insert // IH //. Qed. (** Add support [X ≼ Y] to [set_solver]. (We get support for [⋅] for free because it is definitionally equal to [∪]). *) Global Instance set_unfold_gset_included X Y Q : SetUnfold (X ⊆ Y) Q → SetUnfold (X ≼ Y) Q. Proof. intros [?]; constructor. by rewrite gset_included. Qed. End gset. Global Arguments gsetO _ {_ _}. Global Arguments gsetR _ {_ _}. Global Arguments gsetUR _ {_ _}. (* The disjoint union CMRA *) Inductive gset_disj K `{Countable K} := | GSet : gset K → gset_disj K | GSetBot : gset_disj K. Global Arguments GSet {_ _ _} _. Global Arguments GSetBot {_ _ _}. Section gset_disj. Context `{Countable K}. Local Arguments op _ _ !_ !_ /. Local Arguments cmra_op _ !_ !_ /. Local Arguments ucmra_op _ !_ !_ /. Global Instance GSet_inj : Inj (=@{gset K}) (=) GSet. Proof. intros ???. naive_solver. Qed. Canonical Structure gset_disjO := leibnizO (gset_disj K). Local Instance gset_disj_valid_instance : Valid (gset_disj K) := λ X, match X with GSet _ => True | GSetBot => False end. Local Instance gset_disj_unit_instance : Unit (gset_disj K) := GSet ∅. Local Instance gset_disj_op_instance : Op (gset_disj K) := λ X Y, match X, Y with | GSet X, GSet Y => if decide (X ## Y) then GSet (X ∪ Y) else GSetBot | _, _ => GSetBot end. Local Instance gset_disj_pcore_instance : PCore (gset_disj K) := λ _, Some ε. Ltac gset_disj_solve := repeat (simpl || case_decide); first [apply (f_equal GSet)|done|exfalso]; set_solver by eauto. Lemma gset_disj_included X Y : GSet X ≼ GSet Y ↔ X ⊆ Y. Proof. split. - move=> [[Z|]]; simpl; try case_decide; set_solver. - intros (Z&->&?)%subseteq_disjoint_union_L. exists (GSet Z). gset_disj_solve. Qed. Lemma gset_disj_valid_inv_l X Y : ✓ (GSet X ⋅ Y) → ∃ Y', Y = GSet Y' ∧ X ## Y'. Proof. destruct Y; repeat (simpl || case_decide); by eauto. Qed. Lemma gset_disj_union X Y : X ## Y → GSet X ⋅ GSet Y = GSet (X ∪ Y). Proof. intros. by rewrite /= decide_True. Qed. Lemma gset_disj_valid_op X Y : ✓ (GSet X ⋅ GSet Y) ↔ X ## Y. Proof. simpl. case_decide; by split. Qed. Lemma gset_disj_ra_mixin : RAMixin (gset_disj K). Proof. apply ra_total_mixin; eauto. - intros [?|]; destruct 1; gset_disj_solve. - by constructor. - by destruct 1. - intros [X1|] [X2|] [X3|]; gset_disj_solve. - intros [X1|] [X2|]; gset_disj_solve. - intros [X|]; gset_disj_solve. - exists (GSet ∅); gset_disj_solve. - intros [X1|] [X2|]; gset_disj_solve. Qed. Canonical Structure gset_disjR := discreteR (gset_disj K) gset_disj_ra_mixin. Global Instance gset_disj_cmra_discrete : CmraDiscrete gset_disjR. Proof. apply discrete_cmra_discrete. Qed. Lemma gset_disj_ucmra_mixin : UcmraMixin (gset_disj K). Proof. split; try apply _ || done. intros [X|]; gset_disj_solve. Qed. Canonical Structure gset_disjUR := Ucmra (gset_disj K) gset_disj_ucmra_mixin. Local Arguments op _ _ _ _ : simpl never. Lemma gset_disj_alloc_updateP_strong P (Q : gset_disj K → Prop) X : (∀ Y, X ⊆ Y → ∃ j, j ∉ Y ∧ P j) → (∀ i, i ∉ X → P i → Q (GSet ({[i]} ∪ X))) → GSet X ~~>: Q. Proof. intros Hfresh HQ. apply cmra_discrete_total_updateP=> ? /gset_disj_valid_inv_l [Y [->?]]. destruct (Hfresh (X ∪ Y)) as (i&?&?); first set_solver. exists (GSet ({[ i ]} ∪ X)); split. - apply HQ; set_solver by eauto. - apply gset_disj_valid_op. set_solver by eauto. Qed. Lemma gset_disj_alloc_updateP_strong' P X : (∀ Y, X ⊆ Y → ∃ j, j ∉ Y ∧ P j) → GSet X ~~>: λ Y, ∃ i, Y = GSet ({[ i ]} ∪ X) ∧ i ∉ X ∧ P i. Proof. eauto using gset_disj_alloc_updateP_strong. Qed. Lemma gset_disj_alloc_empty_updateP_strong P (Q : gset_disj K → Prop) : (∀ Y : gset K, ∃ j, j ∉ Y ∧ P j) → (∀ i, P i → Q (GSet {[i]})) → GSet ∅ ~~>: Q. Proof. intros. apply (gset_disj_alloc_updateP_strong P); eauto. intros i; rewrite right_id_L; auto. Qed. Lemma gset_disj_alloc_empty_updateP_strong' P : (∀ Y : gset K, ∃ j, j ∉ Y ∧ P j) → GSet ∅ ~~>: λ Y, ∃ i, Y = GSet {[ i ]} ∧ P i. Proof. eauto using gset_disj_alloc_empty_updateP_strong. Qed. Section fresh_updates. Local Set Default Proof Using "Type*". Context `{!Infinite K}. Lemma gset_disj_alloc_updateP (Q : gset_disj K → Prop) X : (∀ i, i ∉ X → Q (GSet ({[i]} ∪ X))) → GSet X ~~>: Q. Proof. intro; eapply gset_disj_alloc_updateP_strong with (λ _, True); eauto. intros Y ?; exists (fresh Y). split; [|done]. apply is_fresh. Qed. Lemma gset_disj_alloc_updateP' X : GSet X ~~>: λ Y, ∃ i, Y = GSet ({[ i ]} ∪ X) ∧ i ∉ X. Proof. eauto using gset_disj_alloc_updateP. Qed. Lemma gset_disj_alloc_empty_updateP (Q : gset_disj K → Prop) : (∀ i, Q (GSet {[i]})) → GSet ∅ ~~>: Q. Proof. intro. apply gset_disj_alloc_updateP. intros i; rewrite right_id_L; auto. Qed. Lemma gset_disj_alloc_empty_updateP' : GSet ∅ ~~>: λ Y, ∃ i, Y = GSet {[ i ]}. Proof. eauto using gset_disj_alloc_empty_updateP. Qed. End fresh_updates. Lemma gset_disj_dealloc_local_update X Y : (GSet X, GSet Y) ~l~> (GSet (X ∖ Y), GSet ∅). Proof. apply local_update_total_valid=> _ _ /gset_disj_included HYX. rewrite local_update_unital_discrete=> -[Xf|] _ /leibniz_equiv_iff //=. rewrite {1}/op /=. destruct (decide _) as [HXf|]; [intros[= ->]|done]. by rewrite difference_union_distr_l_L difference_diag_L !left_id_L difference_disjoint_L. Qed. Lemma gset_disj_dealloc_empty_local_update X Z : (GSet Z ⋅ GSet X, GSet Z) ~l~> (GSet X, GSet ∅). Proof. apply local_update_total_valid=> /gset_disj_valid_op HZX _ _. assert (X = (Z ∪ X) ∖ Z) as HX by set_solver. rewrite gset_disj_union // {2}HX. apply gset_disj_dealloc_local_update. Qed. Lemma gset_disj_dealloc_op_local_update X Y Z : (GSet Z ⋅ GSet X, GSet Z ⋅ GSet Y) ~l~> (GSet X,GSet Y). Proof. rewrite -{2}(left_id ε _ (GSet Y)). apply op_local_update_frame, gset_disj_dealloc_empty_local_update. Qed. Lemma gset_disj_alloc_op_local_update X Y Z : Z ## X → (GSet X,GSet Y) ~l~> (GSet Z ⋅ GSet X, GSet Z ⋅ GSet Y). Proof. intros. apply op_local_update_discrete. by rewrite gset_disj_valid_op. Qed. Lemma gset_disj_alloc_local_update X Y Z : Z ## X → (GSet X,GSet Y) ~l~> (GSet (Z ∪ X), GSet (Z ∪ Y)). Proof. intros. apply local_update_total_valid=> _ _ /gset_disj_included ?. rewrite -!gset_disj_union //; last set_solver. auto using gset_disj_alloc_op_local_update. Qed. Lemma gset_disj_alloc_empty_local_update X Z : Z ## X → (GSet X, GSet ∅) ~l~> (GSet (Z ∪ X), GSet Z). Proof. intros. rewrite -{2}(right_id_L _ union Z). apply gset_disj_alloc_local_update; set_solver. Qed. (** Add some basic support for [GSet X = GSet Y], [GSet X ≼ GSet Y], and [✓ (GSet X ⋅ GSet Y)] to [set_solver]. There are probably more cases we could cover (e.g., involving [GSetBot], or nesting of [⋅]), but it is not clear these are useful in practice, nor how to handle them effectively. *) Global Instance set_unfold_gset_eq (X Y : gset K) Q : SetUnfold (X = Y) Q → SetUnfold (GSet X = GSet Y) Q. Proof. intros [?]; constructor. by rewrite (inj_iff _). Qed. Global Instance set_unfold_gset_disj_included (X Y : gset K) Q : SetUnfold (X ⊆ Y) Q → SetUnfold (GSet X ≼ GSet Y) Q. Proof. intros [?]; constructor. by rewrite gset_disj_included. Qed. Global Instance set_unfold_gset_disj_valid_op (X Y : gset K) Q : SetUnfold (X ## Y) Q → SetUnfold (✓ (GSet X ⋅ GSet Y)) Q. Proof. intros [?]; constructor. by rewrite gset_disj_valid_op. Qed. End gset_disj. Global Arguments gset_disjO _ {_ _}. Global Arguments gset_disjR _ {_ _}. Global Arguments gset_disjUR _ {_ _}. iris-iris-4.2.0/iris/algebra/lib/000077500000000000000000000000001460620107300165375ustar00rootroot00000000000000iris-iris-4.2.0/iris/algebra/lib/dfrac_agree.v000066400000000000000000000135671460620107300211640ustar00rootroot00000000000000From iris.algebra Require Export dfrac agree updates local_updates. From iris.algebra Require Import proofmode_classes. From iris.prelude Require Import options. Definition dfrac_agreeR (A : ofe) : cmra := prodR dfracR (agreeR A). Definition to_dfrac_agree {A : ofe} (d : dfrac) (a : A) : dfrac_agreeR A := (d, to_agree a). Global Instance: Params (@to_dfrac_agree) 2 := {}. (** To make it easier to work with the [Qp] version of this, we also provide [to_frac_agree] and appropriate lemmas. *) Definition to_frac_agree {A : ofe} (q : Qp) (a : A) : dfrac_agreeR A := to_dfrac_agree (DfracOwn q) a. Global Instance: Params (@to_frac_agree) 2 := {}. Section lemmas. Context {A : ofe}. Implicit Types (q : Qp) (d : dfrac) (a : A). Global Instance to_dfrac_agree_ne d : NonExpansive (@to_dfrac_agree A d). Proof. solve_proper. Qed. Global Instance to_dfrac_agree_proper d : Proper ((≡) ==> (≡)) (@to_dfrac_agree A d). Proof. solve_proper. Qed. Global Instance to_dfrac_agree_exclusive a : Exclusive (to_dfrac_agree (DfracOwn 1) a). Proof. apply _. Qed. Global Instance to_dfrac_agree_discrete d a : Discrete a → Discrete (to_dfrac_agree d a). Proof. apply _. Qed. Global Instance to_dfrac_agree_injN n : Inj2 (dist n) (dist n) (dist n) (@to_dfrac_agree A). Proof. by intros d1 a1 d2 a2 [??%(inj to_agree)]. Qed. Global Instance to_dfrac_agree_inj : Inj2 (≡) (≡) (≡) (@to_dfrac_agree A). Proof. by intros d1 a1 d2 a2 [??%(inj to_agree)]. Qed. Lemma dfrac_agree_op d1 d2 a : to_dfrac_agree (d1 ⋅ d2) a ≡ to_dfrac_agree d1 a ⋅ to_dfrac_agree d2 a. Proof. rewrite /to_dfrac_agree -pair_op agree_idemp //. Qed. Lemma frac_agree_op q1 q2 a : to_frac_agree (q1 + q2) a ≡ to_frac_agree q1 a ⋅ to_frac_agree q2 a. Proof. rewrite -dfrac_agree_op. done. Qed. Lemma dfrac_agree_op_valid d1 a1 d2 a2 : ✓ (to_dfrac_agree d1 a1 ⋅ to_dfrac_agree d2 a2) ↔ ✓ (d1 ⋅ d2) ∧ a1 ≡ a2. Proof. rewrite /to_dfrac_agree -pair_op pair_valid to_agree_op_valid. done. Qed. Lemma dfrac_agree_op_valid_L `{!LeibnizEquiv A} d1 a1 d2 a2 : ✓ (to_dfrac_agree d1 a1 ⋅ to_dfrac_agree d2 a2) ↔ ✓ (d1 ⋅ d2) ∧ a1 = a2. Proof. unfold_leibniz. apply dfrac_agree_op_valid. Qed. Lemma dfrac_agree_op_validN d1 a1 d2 a2 n : ✓{n} (to_dfrac_agree d1 a1 ⋅ to_dfrac_agree d2 a2) ↔ ✓ (d1 ⋅ d2) ∧ a1 ≡{n}≡ a2. Proof. rewrite /to_dfrac_agree -pair_op pair_validN to_agree_op_validN. done. Qed. Lemma frac_agree_op_valid q1 a1 q2 a2 : ✓ (to_frac_agree q1 a1 ⋅ to_frac_agree q2 a2) ↔ (q1 + q2 ≤ 1)%Qp ∧ a1 ≡ a2. Proof. apply dfrac_agree_op_valid. Qed. Lemma frac_agree_op_valid_L `{!LeibnizEquiv A} q1 a1 q2 a2 : ✓ (to_frac_agree q1 a1 ⋅ to_frac_agree q2 a2) ↔ (q1 + q2 ≤ 1)%Qp ∧ a1 = a2. Proof. apply dfrac_agree_op_valid_L. Qed. Lemma frac_agree_op_validN q1 a1 q2 a2 n : ✓{n} (to_frac_agree q1 a1 ⋅ to_frac_agree q2 a2) ↔ (q1 + q2 ≤ 1)%Qp ∧ a1 ≡{n}≡ a2. Proof. apply dfrac_agree_op_validN. Qed. Lemma dfrac_agree_included d1 a1 d2 a2 : to_dfrac_agree d1 a1 ≼ to_dfrac_agree d2 a2 ↔ (d1 ≼ d2) ∧ a1 ≡ a2. Proof. by rewrite pair_included to_agree_included. Qed. Lemma dfrac_agree_included_L `{!LeibnizEquiv A} d1 a1 d2 a2 : to_dfrac_agree d1 a1 ≼ to_dfrac_agree d2 a2 ↔ (d1 ≼ d2) ∧ a1 = a2. Proof. unfold_leibniz. apply dfrac_agree_included. Qed. Lemma dfrac_agree_includedN d1 a1 d2 a2 n : to_dfrac_agree d1 a1 ≼{n} to_dfrac_agree d2 a2 ↔ (d1 ≼ d2) ∧ a1 ≡{n}≡ a2. Proof. by rewrite pair_includedN -cmra_discrete_included_iff to_agree_includedN. Qed. Lemma frac_agree_included q1 a1 q2 a2 : to_frac_agree q1 a1 ≼ to_frac_agree q2 a2 ↔ (q1 < q2)%Qp ∧ a1 ≡ a2. Proof. by rewrite dfrac_agree_included dfrac_own_included. Qed. Lemma frac_agree_included_L `{!LeibnizEquiv A} q1 a1 q2 a2 : to_frac_agree q1 a1 ≼ to_frac_agree q2 a2 ↔ (q1 < q2)%Qp ∧ a1 = a2. Proof. by rewrite dfrac_agree_included_L dfrac_own_included. Qed. Lemma frac_agree_includedN q1 a1 q2 a2 n : to_frac_agree q1 a1 ≼{n} to_frac_agree q2 a2 ↔ (q1 < q2)%Qp ∧ a1 ≡{n}≡ a2. Proof. by rewrite dfrac_agree_includedN dfrac_own_included. Qed. (** While [cmra_update_exclusive] takes care of most updates, it is not sufficient for this one since there is no abstraction-preserving way to rewrite [to_dfrac_agree d1 v1 ⋅ to_dfrac_agree d2 v2] into something simpler. *) Lemma dfrac_agree_update_2 d1 d2 a1 a2 a' : d1 ⋅ d2 = DfracOwn 1 → to_dfrac_agree d1 a1 ⋅ to_dfrac_agree d2 a2 ~~> to_dfrac_agree d1 a' ⋅ to_dfrac_agree d2 a'. Proof. intros Hq. rewrite -pair_op Hq. apply cmra_update_exclusive. rewrite dfrac_agree_op_valid Hq //. Qed. Lemma frac_agree_update_2 q1 q2 a1 a2 a' : (q1 + q2 = 1)%Qp → to_frac_agree q1 a1 ⋅ to_frac_agree q2 a2 ~~> to_frac_agree q1 a' ⋅ to_frac_agree q2 a'. Proof. intros Hq. apply dfrac_agree_update_2. rewrite dfrac_op_own Hq //. Qed. Lemma dfrac_agree_persist d a : to_dfrac_agree d a ~~> to_dfrac_agree DfracDiscarded a. Proof. rewrite /to_dfrac_agree. apply prod_update; last done. simpl. apply dfrac_discard_update. Qed. Lemma dfrac_agree_unpersist a : to_dfrac_agree DfracDiscarded a ~~>: λ k, ∃ q, k = to_dfrac_agree (DfracOwn q) a. Proof. rewrite /to_dfrac_agree. eapply prod_updateP; first apply dfrac_undiscard_update. { by eapply cmra_update_updateP. } naive_solver. Qed. End lemmas. Definition dfrac_agreeRF (F : oFunctor) : rFunctor := prodRF (constRF dfracR) (agreeRF F). Global Instance dfrac_agreeRF_contractive F : oFunctorContractive F → rFunctorContractive (dfrac_agreeRF F). Proof. apply _. Qed. Global Typeclasses Opaque to_dfrac_agree. (* [to_frac_agree] is deliberately transparent to reuse the [to_dfrac_agree] instances *) iris-iris-4.2.0/iris/algebra/lib/excl_auth.v000066400000000000000000000070131460620107300207030ustar00rootroot00000000000000From iris.algebra Require Export auth excl updates. From iris.algebra Require Import local_updates. From iris.prelude Require Import options. (** Authoritative CMRA where the fragment is exclusively owned. This is effectively a single "ghost variable" with two views, the frament [◯E a] and the authority [●E a]. *) Definition excl_authR (A : ofe) : cmra := authR (optionUR (exclR A)). Definition excl_authUR (A : ofe) : ucmra := authUR (optionUR (exclR A)). Definition excl_auth_auth {A : ofe} (a : A) : excl_authR A := ● (Some (Excl a)). Definition excl_auth_frag {A : ofe} (a : A) : excl_authR A := ◯ (Some (Excl a)). Global Typeclasses Opaque excl_auth_auth excl_auth_frag. Global Instance: Params (@excl_auth_auth) 1 := {}. Global Instance: Params (@excl_auth_frag) 2 := {}. Notation "●E a" := (excl_auth_auth a) (at level 10). Notation "◯E a" := (excl_auth_frag a) (at level 10). Section excl_auth. Context {A : ofe}. Implicit Types a b : A. Global Instance excl_auth_auth_ne : NonExpansive (@excl_auth_auth A). Proof. solve_proper. Qed. Global Instance excl_auth_auth_proper : Proper ((≡) ==> (≡)) (@excl_auth_auth A). Proof. solve_proper. Qed. Global Instance excl_auth_frag_ne : NonExpansive (@excl_auth_frag A). Proof. solve_proper. Qed. Global Instance excl_auth_frag_proper : Proper ((≡) ==> (≡)) (@excl_auth_frag A). Proof. solve_proper. Qed. Global Instance excl_auth_auth_discrete a : Discrete a → Discrete (●E a). Proof. intros; apply auth_auth_discrete; [apply Some_discrete|]; apply _. Qed. Global Instance excl_auth_frag_discrete a : Discrete a → Discrete (◯E a). Proof. intros; apply auth_frag_discrete, Some_discrete; apply _. Qed. Lemma excl_auth_validN n a : ✓{n} (●E a ⋅ ◯E a). Proof. by rewrite auth_both_validN. Qed. Lemma excl_auth_valid a : ✓ (●E a ⋅ ◯E a). Proof. intros. by apply auth_both_valid_2. Qed. Lemma excl_auth_agreeN n a b : ✓{n} (●E a ⋅ ◯E b) → a ≡{n}≡ b. Proof. rewrite auth_both_validN /= => -[Hincl Hvalid]. move: Hincl=> /Some_includedN_exclusive /(_ I) ?. by apply (inj Excl). Qed. Lemma excl_auth_agree a b : ✓ (●E a ⋅ ◯E b) → a ≡ b. Proof. intros. apply equiv_dist=> n. by apply excl_auth_agreeN, cmra_valid_validN. Qed. Lemma excl_auth_agree_L `{!LeibnizEquiv A} a b : ✓ (●E a ⋅ ◯E b) → a = b. Proof. intros. by apply leibniz_equiv, excl_auth_agree. Qed. Lemma excl_auth_auth_op_validN n a b : ✓{n} (●E a ⋅ ●E b) ↔ False. Proof. apply auth_auth_op_validN. Qed. Lemma excl_auth_auth_op_valid a b : ✓ (●E a ⋅ ●E b) ↔ False. Proof. apply auth_auth_op_valid. Qed. Lemma excl_auth_frag_op_validN n a b : ✓{n} (◯E a ⋅ ◯E b) ↔ False. Proof. by rewrite -auth_frag_op auth_frag_validN. Qed. Lemma excl_auth_frag_op_valid a b : ✓ (◯E a ⋅ ◯E b) ↔ False. Proof. by rewrite -auth_frag_op auth_frag_valid. Qed. Lemma excl_auth_update a b a' : ●E a ⋅ ◯E b ~~> ●E a' ⋅ ◯E a'. Proof. intros. by apply auth_update, option_local_update, exclusive_local_update. Qed. End excl_auth. Definition excl_authURF (F : oFunctor) : urFunctor := authURF (optionURF (exclRF F)). Global Instance excl_authURF_contractive F : oFunctorContractive F → urFunctorContractive (excl_authURF F). Proof. apply _. Qed. Definition excl_authRF (F : oFunctor) : rFunctor := authRF (optionURF (exclRF F)). Global Instance excl_authRF_contractive F : oFunctorContractive F → rFunctorContractive (excl_authRF F). Proof. apply _. Qed. iris-iris-4.2.0/iris/algebra/lib/frac_auth.v000066400000000000000000000136431460620107300206710ustar00rootroot00000000000000From iris.algebra Require Export frac auth updates local_updates. From iris.algebra Require Import proofmode_classes. From iris.prelude Require Import options. (** Authoritative CMRA where the NON-authoritative parts can be fractional. This CMRA allows the original non-authoritative element [◯ a] to be split into fractional parts [◯F{q} a]. Using [◯F a ≡ ◯F{1} a] is in effect the same as using the original [◯ a]. Currently, however, this CMRA hides the ability to split the authoritative part into fractions. *) Definition frac_authR (A : cmra) : cmra := authR (optionUR (prodR fracR A)). Definition frac_authUR (A : cmra) : ucmra := authUR (optionUR (prodR fracR A)). Definition frac_auth_auth {A : cmra} (x : A) : frac_authR A := ● (Some (1%Qp,x)). Definition frac_auth_frag {A : cmra} (q : frac) (x : A) : frac_authR A := ◯ (Some (q,x)). Global Typeclasses Opaque frac_auth_auth frac_auth_frag. Global Instance: Params (@frac_auth_auth) 1 := {}. Global Instance: Params (@frac_auth_frag) 2 := {}. Notation "●F a" := (frac_auth_auth a) (at level 10). Notation "◯F{ q } a" := (frac_auth_frag q a) (at level 10, format "◯F{ q } a"). Notation "◯F a" := (frac_auth_frag 1 a) (at level 10). Section frac_auth. Context {A : cmra}. Implicit Types a b : A. Global Instance frac_auth_auth_ne : NonExpansive (@frac_auth_auth A). Proof. solve_proper. Qed. Global Instance frac_auth_auth_proper : Proper ((≡) ==> (≡)) (@frac_auth_auth A). Proof. solve_proper. Qed. Global Instance frac_auth_frag_ne q : NonExpansive (@frac_auth_frag A q). Proof. solve_proper. Qed. Global Instance frac_auth_frag_proper q : Proper ((≡) ==> (≡)) (@frac_auth_frag A q). Proof. solve_proper. Qed. Global Instance frac_auth_auth_discrete a : Discrete a → Discrete (●F a). Proof. intros; apply auth_auth_discrete; [apply Some_discrete|]; apply _. Qed. Global Instance frac_auth_frag_discrete q a : Discrete a → Discrete (◯F{q} a). Proof. intros; apply auth_frag_discrete, Some_discrete; apply _. Qed. Lemma frac_auth_validN n a : ✓{n} a → ✓{n} (●F a ⋅ ◯F a). Proof. by rewrite auth_both_validN. Qed. Lemma frac_auth_valid a : ✓ a → ✓ (●F a ⋅ ◯F a). Proof. intros. by apply auth_both_valid_2. Qed. Lemma frac_auth_agreeN n a b : ✓{n} (●F a ⋅ ◯F b) → a ≡{n}≡ b. Proof. rewrite auth_both_validN /= => -[Hincl Hvalid]. by move: Hincl=> /Some_includedN_exclusive /(_ Hvalid ) [??]. Qed. Lemma frac_auth_agree a b : ✓ (●F a ⋅ ◯F b) → a ≡ b. Proof. intros. apply equiv_dist=> n. by apply frac_auth_agreeN, cmra_valid_validN. Qed. Lemma frac_auth_agree_L `{!LeibnizEquiv A} a b : ✓ (●F a ⋅ ◯F b) → a = b. Proof. intros. by apply leibniz_equiv, frac_auth_agree. Qed. Lemma frac_auth_includedN n q a b : ✓{n} (●F a ⋅ ◯F{q} b) → Some b ≼{n} Some a. Proof. by rewrite auth_both_validN /= => -[/Some_pair_includedN [_ ?] _]. Qed. Lemma frac_auth_included `{!CmraDiscrete A} q a b : ✓ (●F a ⋅ ◯F{q} b) → Some b ≼ Some a. Proof. by rewrite auth_both_valid_discrete /= => -[/Some_pair_included [_ ?] _]. Qed. Lemma frac_auth_includedN_total `{!CmraTotal A} n q a b : ✓{n} (●F a ⋅ ◯F{q} b) → b ≼{n} a. Proof. intros. by eapply Some_includedN_total, frac_auth_includedN. Qed. Lemma frac_auth_included_total `{!CmraDiscrete A, !CmraTotal A} q a b : ✓ (●F a ⋅ ◯F{q} b) → b ≼ a. Proof. intros. by eapply Some_included_total, frac_auth_included. Qed. Lemma frac_auth_auth_validN n a : ✓{n} (●F a) ↔ ✓{n} a. Proof. rewrite auth_auth_dfrac_validN Some_validN. split. - by intros [?[]]. - intros. by split. Qed. Lemma frac_auth_auth_valid a : ✓ (●F a) ↔ ✓ a. Proof. rewrite !cmra_valid_validN. by setoid_rewrite frac_auth_auth_validN. Qed. Lemma frac_auth_frag_validN n q a : ✓{n} (◯F{q} a) ↔ (q ≤ 1)%Qp ∧ ✓{n} a. Proof. by rewrite /frac_auth_frag auth_frag_validN. Qed. Lemma frac_auth_frag_valid q a : ✓ (◯F{q} a) ↔ (q ≤ 1)%Qp ∧ ✓ a. Proof. by rewrite /frac_auth_frag auth_frag_valid. Qed. Lemma frac_auth_frag_op q1 q2 a1 a2 : ◯F{q1+q2} (a1 ⋅ a2) ≡ ◯F{q1} a1 ⋅ ◯F{q2} a2. Proof. done. Qed. Lemma frac_auth_frag_op_validN n q1 q2 a b : ✓{n} (◯F{q1} a ⋅ ◯F{q2} b) ↔ (q1 + q2 ≤ 1)%Qp ∧ ✓{n} (a ⋅ b). Proof. by rewrite -frac_auth_frag_op frac_auth_frag_validN. Qed. Lemma frac_auth_frag_op_valid q1 q2 a b : ✓ (◯F{q1} a ⋅ ◯F{q2} b) ↔ (q1 + q2 ≤ 1)%Qp ∧ ✓ (a ⋅ b). Proof. by rewrite -frac_auth_frag_op frac_auth_frag_valid. Qed. Global Instance frac_auth_is_op (q q1 q2 : frac) (a a1 a2 : A) : IsOp q q1 q2 → IsOp a a1 a2 → IsOp' (◯F{q} a) (◯F{q1} a1) (◯F{q2} a2). Proof. by rewrite /IsOp' /IsOp=> /leibniz_equiv_iff -> ->. Qed. Global Instance frac_auth_is_op_core_id (q q1 q2 : frac) (a : A) : CoreId a → IsOp q q1 q2 → IsOp' (◯F{q} a) (◯F{q1} a) (◯F{q2} a). Proof. rewrite /IsOp' /IsOp=> ? /leibniz_equiv_iff ->. by rewrite -frac_auth_frag_op -core_id_dup. Qed. Lemma frac_auth_update q a b a' b' : (a,b) ~l~> (a',b') → ●F a ⋅ ◯F{q} b ~~> ●F a' ⋅ ◯F{q} b'. Proof. intros. by apply auth_update, option_local_update, prod_local_update_2. Qed. Lemma frac_auth_update_1 a b a' : ✓ a' → ●F a ⋅ ◯F b ~~> ●F a' ⋅ ◯F a'. Proof. intros. by apply auth_update, option_local_update, exclusive_local_update. Qed. End frac_auth. Definition frac_authURF (F : rFunctor) : urFunctor := authURF (optionURF (prodRF (constRF fracR) F)). Global Instance frac_authURF_contractive F : rFunctorContractive F → urFunctorContractive (frac_authURF F). Proof. apply _. Qed. Definition frac_authRF (F : rFunctor) : rFunctor := authRF (optionURF (prodRF (constRF fracR) F)). Global Instance frac_authRF_contractive F : rFunctorContractive F → rFunctorContractive (frac_authRF F). Proof. apply _. Qed. iris-iris-4.2.0/iris/algebra/lib/gmap_view.v000066400000000000000000000744751460620107300207250ustar00rootroot00000000000000From Coq.QArith Require Import Qcanon. From iris.algebra Require Export view gmap frac dfrac. From iris.algebra Require Import local_updates proofmode_classes big_op. From iris.prelude Require Import options. (** * CMRA for a "view of a gmap". The authoritative element [gmap_view_auth] is any [gmap K V]. The fragments [gmap_view_frag] represent ownership of a single key in that map. Ownership is governed by a discardable fraction, which provides the possibiltiy to obtain persistent read-only ownership of a key. The key frame-preserving updates are [gmap_view_alloc] to allocate a new key, [gmap_view_update] to update a key given full ownership of the corresponding fragment, and [gmap_view_persist] to make a key read-only by discarding any fraction of the corresponding fragment. Crucially, the latter does not require owning the authoritative element. NOTE: The API surface for [gmap_view] is experimental and subject to change. We plan to add notations for authoritative elements and fragments, and hope to support arbitrary maps as fragments. *) Local Definition gmap_view_fragUR (K : Type) `{Countable K} (V : cmra) : ucmra := gmapUR K (prodR dfracR V). (** View relation. *) Section rel. Context (K : Type) `{Countable K} (V : cmra). Implicit Types (m : gmap K V) (k : K) (v : V) (n : nat). Implicit Types (f : gmap K (dfrac * V)). (* If we exactly followed [auth], we'd write something like [f ≼{n} m ∧ ✓{n} m], which is equivalent to: [map_Forall (λ k fv, ∃ v, m !! k = Some v ∧ Some fv ≼{n} Some v ∧ ✓{n} v) f]. (Note the use of [Some] in the inclusion; the elementwise RA might not have a unit and we want a reflexive relation!) However, [f] and [m] do not have the same type, so this definition does not type-check: the fractions have been erased from the authoritative [m]. So we additionally quantify over the erased fraction [dq] and [(dq, v)] becomes the authoritative value. An alternative definition one might consider is to replace the erased fraction by a hard-coded [DfracOwn 1], the biggest possible fraction. That would not work: we would end up with [Some dv ≼{n} Some (DfracOwn 1, v)] but that cannot be satisfied if [dv.1 = DfracDiscarded], a case that we definitely want to allow! It is possible that [∀ k, ∃ dq, let auth := (pair dq) <$> m !! k in ✓{n} auth ∧ f !! k ≼{n} auth] would also work, but now the proofs are all done already. ;) The two are probably equivalent, with a proof similar to [lookup_includedN]? *) Local Definition gmap_view_rel_raw n m f := map_Forall (λ k fv, ∃ v dq, m !! k = Some v ∧ ✓{n} (dq, v) ∧ (Some fv ≼{n} Some (dq, v))) f. Local Lemma gmap_view_rel_raw_mono n1 n2 m1 m2 f1 f2 : gmap_view_rel_raw n1 m1 f1 → m1 ≡{n2}≡ m2 → f2 ≼{n2} f1 → n2 ≤ n1 → gmap_view_rel_raw n2 m2 f2. Proof. intros Hrel Hm Hf Hn k [dqa va] Hk. (* For some reason applying the lemma in [Hf] does not work... *) destruct (lookup_includedN n2 f2 f1) as [Hf' _]. specialize (Hf' Hf k). clear Hf. rewrite Hk in Hf'. destruct (Some_includedN_is_Some _ _ _ Hf') as [[q' va'] Heq]. rewrite Heq in Hf'. specialize (Hrel _ _ Heq) as (v & dq & Hm1 & [Hvval Hdqval] & Hvincl). simpl in *. specialize (Hm k). edestruct (dist_Some_inv_l _ _ _ _ Hm Hm1) as (v' & Hm2 & Hv). eexists. exists dq. split; first done. split. { split; first done. simpl. rewrite -Hv. eapply cmra_validN_le; done. } rewrite -Hv. etrans; first exact Hf'. apply: cmra_includedN_le; done. Qed. Local Lemma gmap_view_rel_raw_valid n m f : gmap_view_rel_raw n m f → ✓{n} f. Proof. intros Hrel k. destruct (f !! k) as [[dqa va]|] eqn:Hf; rewrite Hf; last done. specialize (Hrel _ _ Hf) as (v & dq & Hmval & Hvval & Hvincl). simpl in *. eapply cmra_validN_includedN. 2:done. done. Qed. Local Lemma gmap_view_rel_raw_unit n : ∃ m, gmap_view_rel_raw n m ε. Proof. exists ∅. apply: map_Forall_empty. Qed. Local Canonical Structure gmap_view_rel : view_rel (gmapO K V) (gmap_view_fragUR K V) := ViewRel gmap_view_rel_raw gmap_view_rel_raw_mono gmap_view_rel_raw_valid gmap_view_rel_raw_unit. Local Lemma gmap_view_rel_exists n f : (∃ m, gmap_view_rel n m f) ↔ ✓{n} f. Proof. split. { intros [m Hrel]. eapply gmap_view_rel_raw_valid, Hrel. } intros Hf. cut (∃ m, gmap_view_rel n m f ∧ ∀ k, f !! k = None → m !! k = None). { naive_solver. } induction f as [|k [dq v] f Hk' IH] using map_ind. { exists ∅. split; [|done]. apply: map_Forall_empty. } move: (Hf k). rewrite lookup_insert=> -[/= ??]. destruct IH as (m & Hm & Hdom). { intros k'. destruct (decide (k = k')) as [->|?]; [by rewrite Hk'|]. move: (Hf k'). by rewrite lookup_insert_ne. } exists (<[k:=v]> m). rewrite /gmap_view_rel /= /gmap_view_rel_raw map_Forall_insert //=. split_and!. - exists v, dq. split; first by rewrite lookup_insert. split; first by split. done. - eapply map_Forall_impl; [apply Hm|]; simpl. intros k' [dq' ag'] (v'&?&?&?). exists v'. rewrite lookup_insert_ne; naive_solver. - intros k'. rewrite !lookup_insert_None. naive_solver. Qed. Local Lemma gmap_view_rel_unit n m : gmap_view_rel n m ε. Proof. apply: map_Forall_empty. Qed. Local Lemma gmap_view_rel_discrete : CmraDiscrete V → ViewRelDiscrete gmap_view_rel. Proof. intros ? n m f Hrel k [df va] Hk. destruct (Hrel _ _ Hk) as (v & dq & Hm & Hvval & Hvincl). exists v, dq. split; first done. split; first by apply cmra_discrete_valid_iff_0. rewrite -cmra_discrete_included_iff_0. done. Qed. End rel. Local Existing Instance gmap_view_rel_discrete. (** [gmap_view] is a notation to give canonical structure search the chance to infer the right instances (see [auth]). *) Notation gmap_view K V := (view (@gmap_view_rel_raw K _ _ V)). Definition gmap_viewO (K : Type) `{Countable K} (V : cmra) : ofe := viewO (gmap_view_rel K V). Definition gmap_viewR (K : Type) `{Countable K} (V : cmra) : cmra := viewR (gmap_view_rel K V). Definition gmap_viewUR (K : Type) `{Countable K} (V : cmra) : ucmra := viewUR (gmap_view_rel K V). Section definitions. Context {K : Type} `{Countable K} {V : cmra}. Definition gmap_view_auth (dq : dfrac) (m : gmap K V) : gmap_viewR K V := ●V{dq} m. Definition gmap_view_frag (k : K) (dq : dfrac) (v : V) : gmap_viewR K V := ◯V {[k := (dq, v)]}. End definitions. Section lemmas. Context {K : Type} `{Countable K} {V : cmra}. Implicit Types (m : gmap K V) (k : K) (q : Qp) (dq : dfrac) (v : V). Global Instance : Params (@gmap_view_auth) 5 := {}. Global Instance gmap_view_auth_ne dq : NonExpansive (gmap_view_auth (K:=K) (V:=V) dq). Proof. solve_proper. Qed. Global Instance gmap_view_auth_proper dq : Proper ((≡) ==> (≡)) (gmap_view_auth (K:=K) (V:=V) dq). Proof. apply ne_proper, _. Qed. Global Instance : Params (@gmap_view_frag) 6 := {}. Global Instance gmap_view_frag_ne k oq : NonExpansive (gmap_view_frag (V:=V) k oq). Proof. solve_proper. Qed. Global Instance gmap_view_frag_proper k oq : Proper ((≡) ==> (≡)) (gmap_view_frag (V:=V) k oq). Proof. apply ne_proper, _. Qed. (* Helper lemmas *) Local Lemma gmap_view_rel_lookup n m k dq v : gmap_view_rel K V n m {[k := (dq, v)]} ↔ ∃ v' dq', m !! k = Some v' ∧ ✓{n} (dq', v') ∧ Some (dq, v) ≼{n} Some (dq', v'). Proof. split. - intros Hrel. edestruct (Hrel k) as (v' & dq' & Hlookup & Hval & Hinc). { rewrite lookup_singleton. done. } simpl in *. eexists _, _. split_and!; done. - intros (v' & dq' & Hlookup & Hval & ?) j [df va]. destruct (decide (k = j)) as [<-|Hne]; last by rewrite lookup_singleton_ne. rewrite lookup_singleton. intros [= <- <-]. simpl. exists v', dq'. split_and!; by rewrite ?Hv'. Qed. (** Composition and validity *) Lemma gmap_view_auth_dfrac_op dp dq m : gmap_view_auth (dp ⋅ dq) m ≡ gmap_view_auth dp m ⋅ gmap_view_auth dq m. Proof. by rewrite /gmap_view_auth view_auth_dfrac_op. Qed. Global Instance gmap_view_auth_dfrac_is_op dq dq1 dq2 m : IsOp dq dq1 dq2 → IsOp' (gmap_view_auth dq m) (gmap_view_auth dq1 m) (gmap_view_auth dq2 m). Proof. rewrite /gmap_view_auth. apply _. Qed. Lemma gmap_view_auth_dfrac_op_invN n dp m1 dq m2 : ✓{n} (gmap_view_auth dp m1 ⋅ gmap_view_auth dq m2) → m1 ≡{n}≡ m2. Proof. apply view_auth_dfrac_op_invN. Qed. Lemma gmap_view_auth_dfrac_op_inv dp m1 dq m2 : ✓ (gmap_view_auth dp m1 ⋅ gmap_view_auth dq m2) → m1 ≡ m2. Proof. apply view_auth_dfrac_op_inv. Qed. Lemma gmap_view_auth_dfrac_validN m n dq : ✓{n} gmap_view_auth dq m ↔ ✓ dq. Proof. rewrite view_auth_dfrac_validN. intuition eauto using gmap_view_rel_unit. Qed. Lemma gmap_view_auth_dfrac_valid m dq : ✓ gmap_view_auth dq m ↔ ✓ dq. Proof. rewrite view_auth_dfrac_valid. intuition eauto using gmap_view_rel_unit. Qed. Lemma gmap_view_auth_valid m : ✓ gmap_view_auth (DfracOwn 1) m. Proof. rewrite gmap_view_auth_dfrac_valid. done. Qed. Lemma gmap_view_auth_dfrac_op_validN n dq1 dq2 m1 m2 : ✓{n} (gmap_view_auth dq1 m1 ⋅ gmap_view_auth dq2 m2) ↔ ✓ (dq1 ⋅ dq2) ∧ m1 ≡{n}≡ m2. Proof. rewrite view_auth_dfrac_op_validN. intuition eauto using gmap_view_rel_unit. Qed. Lemma gmap_view_auth_dfrac_op_valid dq1 dq2 m1 m2 : ✓ (gmap_view_auth dq1 m1 ⋅ gmap_view_auth dq2 m2) ↔ ✓ (dq1 ⋅ dq2) ∧ m1 ≡ m2. Proof. rewrite view_auth_dfrac_op_valid. intuition eauto using gmap_view_rel_unit. Qed. Lemma gmap_view_auth_op_validN n m1 m2 : ✓{n} (gmap_view_auth (DfracOwn 1) m1 ⋅ gmap_view_auth (DfracOwn 1) m2) ↔ False. Proof. apply view_auth_op_validN. Qed. Lemma gmap_view_auth_op_valid m1 m2 : ✓ (gmap_view_auth (DfracOwn 1) m1 ⋅ gmap_view_auth (DfracOwn 1) m2) ↔ False. Proof. apply view_auth_op_valid. Qed. Lemma gmap_view_frag_validN n k dq v : ✓{n} gmap_view_frag k dq v ↔ ✓ dq ∧ ✓{n} v. Proof. rewrite view_frag_validN gmap_view_rel_exists singleton_validN pair_validN. naive_solver. Qed. Lemma gmap_view_frag_valid k dq v : ✓ gmap_view_frag k dq v ↔ ✓ dq ∧ ✓ v. Proof. rewrite cmra_valid_validN. setoid_rewrite gmap_view_frag_validN. rewrite cmra_valid_validN. naive_solver eauto using O. Qed. Lemma gmap_view_frag_op k dq1 dq2 v1 v2 : gmap_view_frag k (dq1 ⋅ dq2) (v1 ⋅ v2) ≡ gmap_view_frag k dq1 v1 ⋅ gmap_view_frag k dq2 v2. Proof. rewrite -view_frag_op singleton_op -pair_op //. Qed. Lemma gmap_view_frag_add k q1 q2 v1 v2 : gmap_view_frag k (DfracOwn (q1 + q2)) (v1 ⋅ v2) ≡ gmap_view_frag k (DfracOwn q1) v1 ⋅ gmap_view_frag k (DfracOwn q2) v2. Proof. rewrite -gmap_view_frag_op. done. Qed. Lemma gmap_view_frag_op_validN n k dq1 dq2 v1 v2 : ✓{n} (gmap_view_frag k dq1 v1 ⋅ gmap_view_frag k dq2 v2) ↔ ✓ (dq1 ⋅ dq2) ∧ ✓{n} (v1 ⋅ v2). Proof. rewrite view_frag_validN gmap_view_rel_exists singleton_op singleton_validN. by rewrite -pair_op pair_validN. Qed. Lemma gmap_view_frag_op_valid k dq1 dq2 v1 v2 : ✓ (gmap_view_frag k dq1 v1 ⋅ gmap_view_frag k dq2 v2) ↔ ✓ (dq1 ⋅ dq2) ∧ ✓ (v1 ⋅ v2). Proof. rewrite view_frag_valid. setoid_rewrite gmap_view_rel_exists. rewrite -cmra_valid_validN singleton_op singleton_valid. by rewrite -pair_op pair_valid. Qed. Lemma gmap_view_both_dfrac_validN n dp m k dq v : ✓{n} (gmap_view_auth dp m ⋅ gmap_view_frag k dq v) ↔ ∃ v' dq', ✓ dp ∧ m !! k = Some v' ∧ ✓{n} (dq', v') ∧ Some (dq, v) ≼{n} Some (dq', v'). Proof. rewrite /gmap_view_auth /gmap_view_frag. rewrite view_both_dfrac_validN gmap_view_rel_lookup. naive_solver. Qed. Lemma gmap_view_both_validN n dp m k v : ✓{n} (gmap_view_auth dp m ⋅ gmap_view_frag k (DfracOwn 1) v) ↔ ✓ dp ∧ ✓{n} v ∧ m !! k ≡{n}≡ Some v. Proof. rewrite gmap_view_both_dfrac_validN. split. - intros [Hdp (v' & dq' & Hlookup & Hvalid & Hincl)]. split; first done. rewrite Hlookup. destruct (Some_includedN_exclusive _ _ _ Hincl Hvalid) as [_ Heq]. simpl in Heq. split. + rewrite pair_validN in Hvalid. rewrite Heq. naive_solver. + by rewrite Heq. - intros (Hdp & Hval & Hlookup). apply dist_Some_inv_r' in Hlookup as [v' [Hlookup Heq]]. exists v', (DfracOwn 1). do 2 (split; [done|]). split. + rewrite pair_validN. by rewrite -Heq. + by apply: Some_includedN_refl. Qed. (** The backwards direction here does not hold: if [dq = DfracOwn 1] but [v ≠ v'], we have to find a suitable erased fraction [dq'] to satisfy the view relation, but there is no way to satisfy [Some (DfracOwn 1, v) ≼{n} Some (dq', v')] for any [dq']. The "if and only if" version of this lemma would have to involve some extra condition like [dq = DfracOwn 1 → v = v'], or phrased more like the view relation itself: [∃ dq', ✓ dq' ∧ Some (v, dq) ≼{n} Some (v', dq')]. *) Lemma gmap_view_both_dfrac_validN_total `{!CmraTotal V} n dp m k dq v : ✓{n} (gmap_view_auth dp m ⋅ gmap_view_frag k dq v) → ∃ v', ✓ dp ∧ ✓ dq ∧ m !! k = Some v' ∧ ✓{n} v' ∧ v ≼{n} v'. Proof. rewrite gmap_view_both_dfrac_validN. intros (v' & dq' & Hdp & Hlookup & Hvalid & Hincl). exists v'. split; first done. split. - eapply (cmra_valid_Some_included dq'); first by apply Hvalid. eapply cmra_discrete_included_iff. eapply Some_pair_includedN_l. done. - split; first done. split; first apply Hvalid. move:Hincl=> /Some_pair_includedN_r /Some_includedN_total. done. Qed. (** Without [CmraDiscrete], we cannot do much better than [∀ n, ]. This is because both the [dq'] and the witness for the [≼{n}] can be different for each step-index. It is totally possible that at low step-indices, [v] has a frame (and [dq' > dq]) while at higher step-indices, [v] has no frame (and [dq' = dq]). *) Lemma gmap_view_both_dfrac_valid_discrete `{!CmraDiscrete V} dp m k dq v : ✓ (gmap_view_auth dp m ⋅ gmap_view_frag k dq v) ↔ ∃ v' dq', ✓ dp ∧ m !! k = Some v' ∧ ✓ (dq', v') ∧ Some (dq, v) ≼ Some (dq', v'). Proof. rewrite cmra_valid_validN. setoid_rewrite gmap_view_both_dfrac_validN. split. - intros Hvalid. specialize (Hvalid 0). destruct Hvalid as (v' & dq' & Hdp & Hlookup & Hvalid & Hincl). exists v', dq'. do 2 (split; first done). split; first by apply cmra_discrete_valid. by apply: cmra_discrete_included_r. - intros (v' & dq' & Hdp & Hlookup & Hvalid & Hincl) n. exists v', dq'. do 2 (split; first done). split; first by apply cmra_valid_validN. by apply: cmra_included_includedN. Qed. (** The backwards direction here does not hold: if [dq = DfracOwn 1] but [v ≠ v'], we have to find a suitable erased fraction [dq'] to satisfy the view relation, but there is no way to satisfy [Some (DfracOwn 1, v) ≼ Some (dq', v')] for any [dq']. The "if and only if" version of this lemma would have to involve some extra condition like [dq = DfracOwn 1 → v = v'], or phrased more like the view relation itself: [∃ dq', ✓ dq' ∧ Some (v, dq) ≼ Some (v', dq')]. *) Lemma gmap_view_both_dfrac_valid_discrete_total `{!CmraDiscrete V, !CmraTotal V} dp m k dq v : ✓ (gmap_view_auth dp m ⋅ gmap_view_frag k dq v) → ∃ v', ✓ dp ∧ ✓ dq ∧ m !! k = Some v' ∧ ✓ v' ∧ v ≼ v'. Proof. rewrite gmap_view_both_dfrac_valid_discrete. intros (v' & dq' & Hdp & Hlookup & Hvalid & Hincl). exists v'. split; first done. split. - eapply (cmra_valid_Some_included dq'); first by apply Hvalid. eapply Some_pair_included_l. done. - split; first done. split; first apply Hvalid. move:Hincl=> /Some_pair_included_r /Some_included_total. done. Qed. (** On the other hand, this one holds for all CMRAs, not just discrete ones. *) Lemma gmap_view_both_valid m dp k v : ✓ (gmap_view_auth dp m ⋅ gmap_view_frag k (DfracOwn 1) v) ↔ ✓ dp ∧ ✓ v ∧ m !! k ≡ Some v. Proof. rewrite cmra_valid_validN. setoid_rewrite gmap_view_both_validN. split. - intros Hvalid. split; last split. + eapply (Hvalid 0). + apply cmra_valid_validN. intros n. eapply Hvalid. + apply equiv_dist. intros n. eapply Hvalid. - intros (Hdp & Hval & Hlookup). intros n. split; first done. split. + apply cmra_valid_validN. done. + rewrite Hlookup. done. Qed. (** Frame-preserving updates *) Lemma gmap_view_alloc m k dq v : m !! k = None → ✓ dq → ✓ v → gmap_view_auth (DfracOwn 1) m ~~> gmap_view_auth (DfracOwn 1) (<[k := v]> m) ⋅ gmap_view_frag k dq v. Proof. intros Hfresh Hdq Hval. apply view_update_alloc=>n bf Hrel j [df va] /=. rewrite lookup_op. destruct (decide (j = k)) as [->|Hne]. - assert (bf !! k = None) as Hbf. { destruct (bf !! k) as [[df' va']|] eqn:Hbf; last done. specialize (Hrel _ _ Hbf). destruct Hrel as (v' & dq' & Hm & _). exfalso. rewrite Hm in Hfresh. done. } rewrite lookup_singleton Hbf right_id. intros [= <- <-]. eexists _, _. rewrite lookup_insert. split; first done. split; last by apply: Some_includedN_refl. split; first done. by eapply cmra_valid_validN. - rewrite lookup_singleton_ne; last done. rewrite left_id=>Hbf. specialize (Hrel _ _ Hbf). destruct Hrel as (v' & ? & Hm & ?). eexists _, _. split; last done. rewrite lookup_insert_ne //. Qed. Lemma gmap_view_alloc_big m m' dq : m' ##ₘ m → ✓ dq → map_Forall (λ k v, ✓ v) m' → gmap_view_auth (DfracOwn 1) m ~~> gmap_view_auth (DfracOwn 1) (m' ∪ m) ⋅ ([^op map] k↦v ∈ m', gmap_view_frag k dq v). Proof. intros ?? Hm'. induction m' as [|k v m' ? IH] using map_ind; decompose_map_disjoint. { rewrite big_opM_empty left_id_L right_id. done. } rewrite IH //. 2:{ by eapply map_Forall_insert_1_2. } rewrite big_opM_insert // assoc. apply cmra_update_op; last done. rewrite -insert_union_l. apply (gmap_view_alloc _ k dq); [|done|]. - by apply lookup_union_None. - eapply Hm'. erewrite lookup_insert. done. Qed. Lemma gmap_view_delete m k v : gmap_view_auth (DfracOwn 1) m ⋅ gmap_view_frag k (DfracOwn 1) v ~~> gmap_view_auth (DfracOwn 1) (delete k m). Proof. apply view_update_dealloc=>n bf Hrel j [df va] Hbf /=. destruct (decide (j = k)) as [->|Hne]. - edestruct (Hrel k) as (v' & dq' & ? & Hval & Hincl). { rewrite lookup_op Hbf lookup_singleton -Some_op. done. } eapply (cmra_validN_Some_includedN _ _ _ Hval) in Hincl as Hval'. exfalso. clear Hval Hincl. rewrite pair_validN /= in Hval'. apply: dfrac_full_exclusive. apply Hval'. - edestruct (Hrel j) as (v' & ? & ? & ?). { rewrite lookup_op lookup_singleton_ne // Hbf. done. } eexists v', _. split; last done. rewrite lookup_delete_ne //. Qed. Lemma gmap_view_delete_big m m' : gmap_view_auth (DfracOwn 1) m ⋅ ([^op map] k↦v ∈ m', gmap_view_frag k (DfracOwn 1) v) ~~> gmap_view_auth (DfracOwn 1) (m ∖ m'). Proof. induction m' as [|k v m' ? IH] using map_ind. { rewrite right_id_L big_opM_empty right_id //. } rewrite big_opM_insert //. rewrite [gmap_view_frag _ _ _ ⋅ _]comm assoc IH gmap_view_delete. rewrite -delete_difference. done. Qed. (** We do not use [local_update] ([~l~>]) in the premise because we also want to expose the role of the fractions. *) Lemma gmap_view_update m k dq v mv' v' dq' : (∀ n mv f, m !! k = Some mv → ✓{n} ((dq, v) ⋅? f) → mv ≡{n}≡ v ⋅? (snd <$> f) → ✓{n} ((dq', v') ⋅? f) ∧ mv' ≡{n}≡ v' ⋅? (snd <$> f)) → gmap_view_auth (DfracOwn 1) m ⋅ gmap_view_frag k dq v ~~> gmap_view_auth (DfracOwn 1) (<[k := mv']> m) ⋅ gmap_view_frag k dq' v'. Proof. intros Hup. apply view_update=> n bf Hrel j [df va]. rewrite lookup_op. destruct (decide (j = k)) as [->|Hne]; last first. { (* prove that other keys are unaffected *) simplify_map_eq. rewrite lookup_singleton_ne //. (* FIXME simplify_map_eq should have done this *) rewrite left_id. intros Hbf. edestruct (Hrel j) as (mva & mdf & Hlookup & Hval & Hincl). { rewrite lookup_op lookup_singleton_ne // left_id //. } naive_solver. } simplify_map_eq. rewrite lookup_singleton. (* FIXME simplify_map_eq should have done this *) intros Hbf. edestruct (Hrel k) as (mv & mdf & Hlookup & Hval & Hincl). { rewrite lookup_op lookup_singleton // Some_op_opM //. } rewrite Some_includedN_opM in Hincl. destruct Hincl as [f' Hincl]. rewrite cmra_opM_opM_assoc in Hincl. set f := bf !! k ⋅ f'. (* the complete frame *) change (bf !! k ⋅ f') with f in Hincl. specialize (Hup n mv f). destruct Hup as (Hval' & Hincl'). { done. } { rewrite -Hincl. done. } { destruct Hincl as [_ Hincl]. simpl in Hincl. rewrite Hincl. by destruct f. } eexists mv', (dq' ⋅? (fst <$> f)). split; first done. rewrite -Hbf. clear Hbf. split. - rewrite Hincl'. destruct Hval'. by destruct f. - rewrite Some_op_opM. rewrite Some_includedN_opM. exists f'. rewrite Hincl'. rewrite cmra_opM_opM_assoc. change (bf !! k ⋅ f') with f. by destruct f. Qed. (** This derived version cannot exploit [dq = DfracOwn 1]. *) Lemma gmap_view_update_local m k dq mv v mv' v' : m !! k = Some mv → (mv, v) ~l~> (mv', v') → gmap_view_auth (DfracOwn 1) m ⋅ gmap_view_frag k dq v ~~> gmap_view_auth (DfracOwn 1) (<[k := mv']> m) ⋅ gmap_view_frag k dq v'. Proof. intros Hlookup Hup. apply gmap_view_update. intros n mv0 f Hmv0 Hval Hincl. rewrite Hlookup in Hmv0. injection Hmv0 as [= <-]. specialize (Hup n (snd <$> f)). destruct Hup as (Hval' & Hincl'). { rewrite Hincl. destruct Hval. by destruct f. } { simpl. done. } split; last done. split. - destruct Hval. by destruct f. - simpl in *. replace (((dq, v') ⋅? f).2) with (v' ⋅? (snd <$> f)). 2:{ by destruct f. } rewrite -Hincl'. done. Qed. Lemma gmap_view_replace m k v v' : ✓ v' → gmap_view_auth (DfracOwn 1) m ⋅ gmap_view_frag k (DfracOwn 1) v ~~> gmap_view_auth (DfracOwn 1) (<[k := v']> m) ⋅ gmap_view_frag k (DfracOwn 1) v'. Proof. (* There would be a simple proof via delete-then-insert... but we use this as a sanity check to make sure the update lemma is strong enough. *) intros Hval'. apply gmap_view_update. intros n mv f Hlookup Hval Hincl. destruct f; simpl. { apply exclusiveN_l in Hval; first done. apply _. } split; last done. split; first done. simpl. apply cmra_valid_validN. done. Qed. Lemma gmap_view_replace_big m m0 m1 : dom m0 = dom m1 → map_Forall (λ k v, ✓ v) m1 → gmap_view_auth (DfracOwn 1) m ⋅ ([^op map] k↦v ∈ m0, gmap_view_frag k (DfracOwn 1) v) ~~> gmap_view_auth (DfracOwn 1) (m1 ∪ m) ⋅ ([^op map] k↦v ∈ m1, gmap_view_frag k (DfracOwn 1) v). Proof. intros Hdom%eq_sym. revert m1 Hdom. induction m0 as [|k v m0 Hnotdom IH] using map_ind; intros m1 Hdom Hval. { rewrite dom_empty_L in Hdom. apply dom_empty_iff_L in Hdom as ->. rewrite left_id_L big_opM_empty. done. } rewrite dom_insert_L in Hdom. assert (k ∈ dom m1) as Hindom by set_solver. apply elem_of_dom in Hindom as [v' Hlookup]. rewrite big_opM_insert //. rewrite [gmap_view_frag _ _ _ ⋅ _]comm assoc. rewrite (IH (delete k m1)); last first. { by apply map_Forall_delete. } { rewrite dom_delete_L Hdom. apply not_elem_of_dom in Hnotdom. set_solver -Hdom. } rewrite -assoc [_ ⋅ gmap_view_frag _ _ _]comm assoc. rewrite (gmap_view_replace _ _ _ v'). 2:{ eapply Hval. done. } rewrite (big_opM_delete _ m1 k v') // -assoc. rewrite insert_union_r; last by rewrite lookup_delete. rewrite union_delete_insert //. Qed. Lemma gmap_view_auth_persist dq m : gmap_view_auth dq m ~~> gmap_view_auth DfracDiscarded m. Proof. apply view_update_auth_persist. Qed. Lemma gmap_view_auth_unpersist m : gmap_view_auth DfracDiscarded m ~~>: λ a, ∃ q, a = gmap_view_auth (DfracOwn q) m. Proof. apply view_updateP_auth_unpersist. Qed. Local Lemma gmap_view_frag_dfrac k dq P v : dq ~~>: P → gmap_view_frag k dq v ~~>: λ a, ∃ dq', a = gmap_view_frag k dq' v ∧ P dq'. Proof. intros Hdq. eapply cmra_updateP_weaken; [apply view_updateP_frag with (P := λ b', ∃ dq', ◯V b' = gmap_view_frag k dq' v ∧ P dq') |naive_solver]. intros m n bf Hrel. destruct (Hrel k ((dq, v) ⋅? bf !! k)) as (v' & dq' & Hlookup & Hval & Hincl). { by rewrite lookup_op lookup_singleton Some_op_opM. } rewrite Some_includedN_opM in Hincl. destruct Hincl as [f' Hincl]. rewrite cmra_opM_opM_assoc in Hincl. set f := bf !! k ⋅ f'. (* the complete frame *) change (bf !! k ⋅ f') with f in Hincl. destruct (Hdq n (option_map fst f)) as (dq'' & HPdq'' & Hvdq''). { destruct Hincl as [Heq _]. simpl in Heq. rewrite Heq in Hval. destruct Hval as [Hval _]. by destruct f. } eexists. split; first by exists dq''. intros j [df va] Heq. destruct (decide (k = j)) as [->|Hne]. - rewrite lookup_op lookup_singleton in Heq. eexists v', (dq'' ⋅? (fst <$> f)). split; first done. split. + split; last by apply Hval. simpl. done. + rewrite -Heq. exists f'. rewrite -assoc. change (bf !! j ⋅ f') with f. destruct Hincl as [_ Hincl]. simpl in Hincl. rewrite Hincl. by destruct f. - rewrite lookup_op lookup_singleton_ne // left_id in Heq. eapply Hrel. rewrite lookup_op lookup_singleton_ne // left_id Heq //. Qed. Lemma gmap_view_frag_persist k dq v : gmap_view_frag k dq v ~~> gmap_view_frag k DfracDiscarded v. Proof. eapply (cmra_update_lift_updateP (λ dq, gmap_view_frag k dq v)). - intros. by apply gmap_view_frag_dfrac. - apply dfrac_discard_update. Qed. Lemma gmap_view_frag_unpersist k v : gmap_view_frag k DfracDiscarded v ~~>: λ a, ∃ q, a = gmap_view_frag k (DfracOwn q) v. Proof. eapply cmra_updateP_weaken. { apply gmap_view_frag_dfrac, dfrac_undiscard_update. } naive_solver. Qed. (** Typeclass instances *) Global Instance gmap_view_frag_core_id k dq v : CoreId dq → CoreId v → CoreId (gmap_view_frag k dq v). Proof. apply _. Qed. Global Instance gmap_view_cmra_discrete : CmraDiscrete V → CmraDiscrete (gmap_viewR K V). Proof. apply _. Qed. Global Instance gmap_view_frag_mut_is_op dq dq1 dq2 k v v1 v2 : IsOp dq dq1 dq2 → IsOp v v1 v2 → IsOp' (gmap_view_frag k dq v) (gmap_view_frag k dq1 v1) (gmap_view_frag k dq2 v2). Proof. rewrite /IsOp' /IsOp => -> ->. apply gmap_view_frag_op. Qed. End lemmas. (** Functor *) Program Definition gmap_viewURF (K : Type) `{Countable K} (F : rFunctor) : urFunctor := {| urFunctor_car A _ B _ := gmap_viewUR K (rFunctor_car F A B); urFunctor_map A1 _ A2 _ B1 _ B2 _ fg := viewO_map (rel:=gmap_view_rel K (rFunctor_car F A1 B1)) (rel':=gmap_view_rel K (rFunctor_car F A2 B2)) (gmapO_map (K:=K) (rFunctor_map F fg)) (gmapO_map (K:=K) (prodO_map cid (rFunctor_map F fg))) |}. Next Obligation. intros K ?? F A1 ? A2 ? B1 ? B2 ? n f g Hfg. apply viewO_map_ne. - apply gmapO_map_ne, rFunctor_map_ne. done. - apply gmapO_map_ne. apply prodO_map_ne; first done. apply rFunctor_map_ne. done. Qed. Next Obligation. intros K ?? F A ? B ? x; simpl in *. rewrite -{2}(view_map_id x). apply (view_map_ext _ _ _ _)=> y. - rewrite /= -{2}(map_fmap_id y). apply map_fmap_equiv_ext=>k ??. apply rFunctor_map_id. - rewrite /= -{2}(map_fmap_id y). apply map_fmap_equiv_ext=>k [df va] ?. split; first done. simpl. apply rFunctor_map_id. Qed. Next Obligation. intros K ?? F A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x; simpl in *. rewrite -view_map_compose. apply (view_map_ext _ _ _ _)=> y. - rewrite /= -map_fmap_compose. apply map_fmap_equiv_ext=>k ??. apply rFunctor_map_compose. - rewrite /= -map_fmap_compose. apply map_fmap_equiv_ext=>k [df va] ?. split; first done. simpl. apply rFunctor_map_compose. Qed. Next Obligation. intros K ?? F A1 ? A2 ? B1 ? B2 ? fg; simpl. (* [apply] does not work, probably the usual unification probem (Coq #6294) *) apply: view_map_cmra_morphism; [apply _..|]=> n m f. intros Hrel k [df va] Hf. move: Hf. rewrite !lookup_fmap. destruct (f !! k) as [[df' va']|] eqn:Hfk; rewrite Hfk; last done. simpl=>[= <- <-]. specialize (Hrel _ _ Hfk). simpl in Hrel. destruct Hrel as (v & dq & Hlookup & Hval & Hincl). eexists (rFunctor_map F fg v), dq. rewrite Hlookup. split; first done. split. - split; first by apply Hval. simpl. apply: cmra_morphism_validN. apply Hval. - destruct Hincl as [[[fdq fv]|] Hincl]. + apply: Some_includedN_mono. rewrite -Some_op in Hincl. apply (inj _) in Hincl. rewrite -pair_op in Hincl. exists (fdq, rFunctor_map F fg fv). rewrite -pair_op. split; first apply Hincl. rewrite -cmra_morphism_op. simpl. f_equiv. apply Hincl. + exists None. rewrite right_id in Hincl. apply (inj _) in Hincl. rewrite right_id. f_equiv. split; first apply Hincl. simpl. f_equiv. apply Hincl. Qed. Global Instance gmap_viewURF_contractive (K : Type) `{Countable K} F : rFunctorContractive F → urFunctorContractive (gmap_viewURF K F). Proof. intros ? A1 ? A2 ? B1 ? B2 ? n f g Hfg. apply viewO_map_ne. - apply gmapO_map_ne. apply rFunctor_map_contractive. done. - apply gmapO_map_ne. apply prodO_map_ne; first done. apply rFunctor_map_contractive. done. Qed. Program Definition gmap_viewRF (K : Type) `{Countable K} (F : rFunctor) : rFunctor := {| rFunctor_car A _ B _ := gmap_viewR K (rFunctor_car F A B); rFunctor_map A1 _ A2 _ B1 _ B2 _ fg := viewO_map (rel:=gmap_view_rel K (rFunctor_car F A1 B1)) (rel':=gmap_view_rel K (rFunctor_car F A2 B2)) (gmapO_map (K:=K) (rFunctor_map F fg)) (gmapO_map (K:=K) (prodO_map cid (rFunctor_map F fg))) |}. Solve Obligations with apply gmap_viewURF. Global Instance gmap_viewRF_contractive (K : Type) `{Countable K} F : rFunctorContractive F → rFunctorContractive (gmap_viewRF K F). Proof. apply gmap_viewURF_contractive. Qed. Global Typeclasses Opaque gmap_view_auth gmap_view_frag. iris-iris-4.2.0/iris/algebra/lib/gset_bij.v000066400000000000000000000173551460620107300205270ustar00rootroot00000000000000(** RA for monotone partial bijections. This RA is a view where the authoritative element is a partial bijection between types [A] and [B] and the fragments are subrels of the bijection. The data for the bijection is represented as a set of pairs [A * B], and the view relation enforces when an authoritative element is valid it is a bijection (that is, it is deterministic as a function from [A → option B] and [B → option A]). The fragments compose by set union, which means that fragments are their own core, ownership of a fragment is persistent, and the authoritative element can only grow (in that it can only map more pairs [(a,b)]). *) (* [algebra.view] needs to be exported for the canonical instances *) From iris.algebra Require Export view gset. From iris.algebra Require Import updates. From iris.prelude Require Import options. Section gset_bijective. Context `{Countable A, Countable B}. Implicit Types (a : A) (b : B). (** [gset_bijective] states that for a graph [L] of [(a, b)] pairs, [L] maps from [A] to [B] and back deterministically. The key property characterizing [gset_bijective] is [gset_bijective_eq_iff]. *) Definition gset_bijective (L : gset (A * B)) := ∀ a b, (a, b) ∈ L → (∀ b', (a, b') ∈ L → b' = b) ∧ (∀ a', (a', b) ∈ L → a' = a). (* Properties of [gset_bijective]. *) Lemma gset_bijective_empty : gset_bijective (∅ : gset (A * B)). Proof. by intros ?? []%not_elem_of_empty. Qed. (* a bijective graph [L] can be extended with a new mapping [(a,b)] as long as neither [a] nor [b] is currently mapped to anything. *) Lemma gset_bijective_extend L a b : gset_bijective L → (∀ b', (a, b') ∉ L) → (∀ a', (a', b) ∉ L) → gset_bijective ({[(a, b)]} ∪ L). Proof. rewrite /gset_bijective. set_solver. Qed. Lemma gset_bijective_eq_iff L (a1 a2 : A) (b1 b2 : B) : gset_bijective L → (a1, b1) ∈ L → (a2, b2) ∈ L → a1 = a2 ↔ b1 = b2. Proof. rewrite /gset_bijective. set_solver. Qed. Lemma gset_bijective_pair a1 b1 a2 b2 : gset_bijective {[(a1, b1); (a2, b2)]} → (a1 = a2 ↔ b1 = b2). Proof. rewrite /gset_bijective. set_solver. Qed. Lemma subseteq_gset_bijective L L' : gset_bijective L → L' ⊆ L → gset_bijective L'. Proof. rewrite /gset_bijective. set_solver. Qed. End gset_bijective. Section gset_bij_view_rel. Context `{Countable A, Countable B}. Implicit Types (bijL : gset (A * B)) (L : gsetUR (A * B)). Local Definition gset_bij_view_rel_raw (n : nat) bijL L: Prop := L ⊆ bijL ∧ gset_bijective bijL. Local Lemma gset_bij_view_rel_raw_mono n1 n2 bijL1 bijL2 L1 L2 : gset_bij_view_rel_raw n1 bijL1 L1 → bijL1 ≡{n2}≡ bijL2 → L2 ≼{n2} L1 → n2 ≤ n1 → gset_bij_view_rel_raw n2 bijL2 L2. Proof. intros [??] <-%(discrete_iff _ _)%leibniz_equiv ?%gset_included _. split; [|done]. by trans L1. Qed. Local Lemma gset_bij_view_rel_raw_valid n bijL L : gset_bij_view_rel_raw n bijL L → ✓{n}L. Proof. by intros _. Qed. Local Lemma gset_bij_view_rel_raw_unit n : ∃ bijL, gset_bij_view_rel_raw n bijL ε. Proof. exists ∅. split; eauto using gset_bijective_empty. Qed. Canonical Structure gset_bij_view_rel : view_rel (gsetO (A * B)) (gsetUR (A * B)) := ViewRel gset_bij_view_rel_raw gset_bij_view_rel_raw_mono gset_bij_view_rel_raw_valid gset_bij_view_rel_raw_unit. Global Instance gset_bij_view_rel_discrete : ViewRelDiscrete gset_bij_view_rel. Proof. intros n bijL L [??]. split; auto. Qed. Local Lemma gset_bij_view_rel_iff n bijL L : gset_bij_view_rel n bijL L ↔ L ⊆ bijL ∧ gset_bijective bijL. Proof. done. Qed. End gset_bij_view_rel. Definition gset_bij A B `{Countable A, Countable B} := view (gset_bij_view_rel_raw (A:=A) (B:=B)). Definition gset_bijO A B `{Countable A, Countable B} : ofe := viewO (gset_bij_view_rel (A:=A) (B:=B)). Definition gset_bijR A B `{Countable A, Countable B} : cmra := viewR (gset_bij_view_rel (A:=A) (B:=B)). Definition gset_bijUR A B `{Countable A, Countable B} : ucmra := viewUR (gset_bij_view_rel (A:=A) (B:=B)). Definition gset_bij_auth `{Countable A, Countable B} (dq : dfrac) (L : gset (A * B)) : gset_bij A B := ●V{dq} L ⋅ ◯V L. Definition gset_bij_elem `{Countable A, Countable B} (a : A) (b : B) : gset_bij A B := ◯V {[ (a, b) ]}. Section gset_bij. Context `{Countable A, Countable B}. Implicit Types (a:A) (b:B). Implicit Types (L : gset (A*B)). Implicit Types dq : dfrac. Global Instance gset_bij_elem_core_id a b : CoreId (gset_bij_elem a b). Proof. apply _. Qed. Lemma gset_bij_auth_dfrac_op dq1 dq2 L : gset_bij_auth dq1 L ⋅ gset_bij_auth dq2 L ≡ gset_bij_auth (dq1 ⋅ dq2) L. Proof. rewrite /gset_bij_auth view_auth_dfrac_op. rewrite (comm _ (●V{dq2} _)) -!assoc (assoc _ (◯V _)). by rewrite -core_id_dup (comm _ (◯V _)). Qed. Lemma gset_bij_auth_dfrac_valid dq L : ✓ gset_bij_auth dq L ↔ ✓ dq ∧ gset_bijective L. Proof. rewrite /gset_bij_auth view_both_dfrac_valid. setoid_rewrite gset_bij_view_rel_iff. naive_solver eauto using O. Qed. Lemma gset_bij_auth_valid L : ✓ gset_bij_auth (DfracOwn 1) L ↔ gset_bijective L. Proof. rewrite gset_bij_auth_dfrac_valid. naive_solver by done. Qed. Lemma gset_bij_auth_empty_dfrac_valid dq : ✓ gset_bij_auth (A:=A) (B:=B) dq ∅ ↔ ✓ dq. Proof. rewrite gset_bij_auth_dfrac_valid. naive_solver eauto using gset_bijective_empty. Qed. Lemma gset_bij_auth_empty_valid : ✓ gset_bij_auth (A:=A) (B:=B) (DfracOwn 1) ∅. Proof. by apply gset_bij_auth_empty_dfrac_valid. Qed. Lemma gset_bij_auth_dfrac_op_valid dq1 dq2 L1 L2 : ✓ (gset_bij_auth dq1 L1 ⋅ gset_bij_auth dq2 L2) ↔ ✓ (dq1 ⋅ dq2) ∧ L1 = L2 ∧ gset_bijective L1. Proof. rewrite /gset_bij_auth (comm _ (●V{dq2} _)) -!assoc (assoc _ (◯V _)). rewrite -view_frag_op (comm _ (◯V _)) assoc. split. - move=> /cmra_valid_op_l /view_auth_dfrac_op_valid. setoid_rewrite gset_bij_view_rel_iff. naive_solver eauto using 0. - intros (?&->&?). rewrite -core_id_dup -view_auth_dfrac_op. apply view_both_dfrac_valid. setoid_rewrite gset_bij_view_rel_iff. naive_solver. Qed. Lemma gset_bij_auth_op_valid L1 L2 : ✓ (gset_bij_auth (DfracOwn 1) L1 ⋅ gset_bij_auth (DfracOwn 1) L2) ↔ False. Proof. rewrite gset_bij_auth_dfrac_op_valid. naive_solver. Qed. Lemma bij_both_dfrac_valid dq L a b : ✓ (gset_bij_auth dq L ⋅ gset_bij_elem a b) ↔ ✓ dq ∧ gset_bijective L ∧ (a, b) ∈ L. Proof. rewrite /gset_bij_auth /gset_bij_elem -assoc -view_frag_op view_both_dfrac_valid. setoid_rewrite gset_bij_view_rel_iff. set_solver by eauto using O. Qed. Lemma bij_both_valid L a b : ✓ (gset_bij_auth (DfracOwn 1) L ⋅ gset_bij_elem a b) ↔ gset_bijective L ∧ (a, b) ∈ L. Proof. rewrite bij_both_dfrac_valid. naive_solver by done. Qed. Lemma gset_bij_elem_agree a1 b1 a2 b2 : ✓ (gset_bij_elem a1 b1 ⋅ gset_bij_elem a2 b2) → (a1 = a2 ↔ b1 = b2). Proof. rewrite /gset_bij_elem -view_frag_op gset_op view_frag_valid. setoid_rewrite gset_bij_view_rel_iff. intros. apply gset_bijective_pair. naive_solver eauto using subseteq_gset_bijective, O. Qed. Lemma bij_view_included dq L a b : (a,b) ∈ L → gset_bij_elem a b ≼ gset_bij_auth dq L. Proof. intros. etrans; [|apply cmra_included_r]. apply view_frag_mono, gset_included. set_solver. Qed. Lemma gset_bij_auth_extend {L} a b : (∀ b', (a, b') ∉ L) → (∀ a', (a', b) ∉ L) → gset_bij_auth (DfracOwn 1) L ~~> gset_bij_auth (DfracOwn 1) ({[(a, b)]} ∪ L). Proof. intros. apply view_update=> n bijL. rewrite !gset_bij_view_rel_iff gset_op. set_solver by eauto using gset_bijective_extend. Qed. End gset_bij. iris-iris-4.2.0/iris/algebra/lib/mono_Z.v000066400000000000000000000110511460620107300201650ustar00rootroot00000000000000From iris.algebra Require Export auth. From iris.algebra Require Import numbers updates. From iris.prelude Require Import options. (** Authoritative CMRA over [max_Z]. The authoritative element is a monotonically increasing [Z], while a fragment is a lower bound. *) Definition mono_Z := auth (option max_ZR). Definition mono_ZR := authR (optionUR max_ZR). Definition mono_ZUR := authUR (optionUR max_ZR). (** [mono_Z_auth] is the authoritative element. The definition includes the fragment at the same value so that lemma [mono_Z_included], which states that [mono_Z_lb n ≼ mono_Z_auth dq n], holds. Without this trick, a frame-preserving update lemma would be required instead. *) Definition mono_Z_auth (dq : dfrac) (n : Z) : mono_Z := ●{dq} (Some (MaxZ n)) ⋅ ◯ (Some (MaxZ n)). Definition mono_Z_lb (n : Z) : mono_Z := ◯ (Some (MaxZ n)). Notation "●MZ dq a" := (mono_Z_auth dq a) (at level 20, dq custom dfrac at level 1, format "●MZ dq a"). Notation "◯MZ a" := (mono_Z_lb a) (at level 20). Section mono_Z. Implicit Types (n : Z). Local Open Scope Z_scope. Global Instance mono_Z_lb_core_id n : CoreId (◯MZ n). Proof. apply _. Qed. Global Instance mono_Z_auth_core_id l : CoreId (●MZ□ l). Proof. apply _. Qed. Lemma mono_Z_auth_dfrac_op dq1 dq2 n : ●MZ{dq1 ⋅ dq2} n ≡ ●MZ{dq1} n ⋅ ●MZ{dq2} n. Proof. rewrite /mono_Z_auth auth_auth_dfrac_op. rewrite (comm _ (●{dq2} _)) -!assoc (assoc _ (◯ _)). by rewrite -core_id_dup (comm _ (◯ _)). Qed. Lemma mono_Z_lb_op n1 n2 : ◯MZ (n1 `max` n2) = ◯MZ n1 ⋅ ◯MZ n2. Proof. rewrite -auth_frag_op -Some_op max_Z_op //. Qed. Lemma mono_Z_auth_lb_op dq n : ●MZ{dq} n ≡ ●MZ{dq} n ⋅ ◯MZ n. Proof. rewrite /mono_Z_auth /mono_Z_lb. rewrite -!assoc -auth_frag_op -Some_op max_Z_op. rewrite Z.max_id //. Qed. Global Instance mono_Z_auth_dfrac_is_op dq dq1 dq2 n : IsOp dq dq1 dq2 → IsOp' (●MZ{dq} n) (●MZ{dq1} n) (●MZ{dq2} n). Proof. rewrite /IsOp' /IsOp=> ->. rewrite mono_Z_auth_dfrac_op //. Qed. Global Instance mono_Z_lb_max_is_op n n1 n2 : IsOp (MaxZ n) (MaxZ n1) (MaxZ n2) → IsOp' (◯MZ n) (◯MZ n1) (◯MZ n2). Proof. rewrite /IsOp' /IsOp /mono_Z_lb=> ->. done. Qed. (** rephrasing of [mono_Z_lb_op] useful for weakening a fragment to a smaller lower-bound *) Lemma mono_Z_lb_op_le_l n n' : n' ≤ n → ◯MZ n = ◯MZ n' ⋅ ◯MZ n. Proof. intros. rewrite -mono_Z_lb_op Z.max_r //. Qed. Lemma mono_Z_auth_dfrac_valid dq n : (✓ ●MZ{dq} n) ↔ ✓ dq. Proof. rewrite /mono_Z_auth auth_both_dfrac_valid_discrete /=. naive_solver. Qed. Lemma mono_Z_auth_valid n : ✓ ●MZ n. Proof. by apply auth_both_valid. Qed. Lemma mono_Z_auth_dfrac_op_valid dq1 dq2 n1 n2 : ✓ (●MZ{dq1} n1 ⋅ ●MZ{dq2} n2) ↔ ✓ (dq1 ⋅ dq2) ∧ n1 = n2. Proof. rewrite /mono_Z_auth (comm _ (●{dq2} _)) -!assoc (assoc _ (◯ _)). rewrite -auth_frag_op (comm _ (◯ _)) assoc. split. - move=> /cmra_valid_op_l /auth_auth_dfrac_op_valid. naive_solver. - intros [? ->]. rewrite -core_id_dup -auth_auth_dfrac_op. by apply auth_both_dfrac_valid_discrete. Qed. Lemma mono_Z_auth_op_valid n1 n2 : ✓ (●MZ n1 ⋅ ●MZ n2) ↔ False. Proof. rewrite mono_Z_auth_dfrac_op_valid. naive_solver. Qed. Lemma mono_Z_both_dfrac_valid dq n m : ✓ (●MZ{dq} n ⋅ ◯MZ m) ↔ ✓ dq ∧ m ≤ n. Proof. rewrite /mono_Z_auth /mono_Z_lb -assoc -auth_frag_op. rewrite auth_both_dfrac_valid_discrete Some_included_total max_Z_included /=. naive_solver lia. Qed. Lemma mono_Z_both_valid n m : ✓ (●MZ n ⋅ ◯MZ m) ↔ m ≤ n. Proof. rewrite mono_Z_both_dfrac_valid dfrac_valid_own. naive_solver. Qed. Lemma mono_Z_lb_mono n1 n2 : n1 ≤ n2 → ◯MZ n1 ≼ ◯MZ n2. Proof. intros. by apply auth_frag_mono, Some_included_total, max_Z_included. Qed. Lemma mono_Z_included dq n : ◯MZ n ≼ ●MZ{dq} n. Proof. apply: cmra_included_r. Qed. Lemma mono_Z_update {n} n' : n ≤ n' → ●MZ n ~~> ●MZ n'. Proof. intros. rewrite /mono_Z_auth /mono_Z_lb. by apply auth_update, option_local_update, max_Z_local_update. Qed. Lemma mono_Z_auth_persist n dq : ●MZ{dq} n ~~> ●MZ□ n. Proof. intros. rewrite /mono_Z_auth /mono_Z_lb. eapply cmra_update_op_proper; last done. eapply auth_update_auth_persist. Qed. Lemma mono_Z_auth_unpersist n : ●MZ□ n ~~>: λ k, ∃ q, k = ●MZ{# q} n. Proof. eapply auth_updateP_both_unpersist. Qed. End mono_Z. Global Typeclasses Opaque mono_Z_auth mono_Z_lb. iris-iris-4.2.0/iris/algebra/lib/mono_list.v000066400000000000000000000216461460620107300207420ustar00rootroot00000000000000(** Authoritative CMRA of append-only lists, where the fragment represents a snap-shot of the list, and the authoritative element can only grow by appending. *) From iris.algebra Require Export auth dfrac max_prefix_list. From iris.algebra Require Import updates local_updates proofmode_classes. From iris.prelude Require Import options. Definition mono_listR (A : ofe) : cmra := authR (max_prefix_listUR A). Definition mono_listUR (A : ofe) : ucmra := authUR (max_prefix_listUR A). Definition mono_list_auth {A : ofe} (q : dfrac) (l : list A) : mono_listR A := ●{q} (to_max_prefix_list l) ⋅ ◯ (to_max_prefix_list l). Definition mono_list_lb {A : ofe} (l : list A) : mono_listR A := ◯ (to_max_prefix_list l). Global Instance: Params (@mono_list_auth) 2 := {}. Global Instance: Params (@mono_list_lb) 1 := {}. Global Typeclasses Opaque mono_list_auth mono_list_lb. Notation "●ML dq l" := (mono_list_auth dq l) (at level 20, dq custom dfrac at level 1, format "●ML dq l"). Notation "◯ML l" := (mono_list_lb l) (at level 20). Section mono_list_props. Context {A : ofe}. Implicit Types l : list A. Implicit Types q : frac. Implicit Types dq : dfrac. (** Setoid properties *) Global Instance mono_list_auth_ne dq : NonExpansive (@mono_list_auth A dq). Proof. solve_proper. Qed. Global Instance mono_list_auth_proper dq : Proper ((≡) ==> (≡)) (@mono_list_auth A dq). Proof. solve_proper. Qed. Global Instance mono_list_lb_ne : NonExpansive (@mono_list_lb A). Proof. solve_proper. Qed. Global Instance mono_list_lb_proper : Proper ((≡) ==> (≡)) (@mono_list_lb A). Proof. solve_proper. Qed. Global Instance mono_list_lb_dist_inj n : Inj (dist n) (dist n) (@mono_list_lb A). Proof. rewrite /mono_list_lb. by intros ?? ?%(inj _)%(inj _). Qed. Global Instance mono_list_lb_inj : Inj (≡) (≡) (@mono_list_lb A). Proof. rewrite /mono_list_lb. by intros ?? ?%(inj _)%(inj _). Qed. (** * Operation *) Global Instance mono_list_lb_core_id l : CoreId (◯ML l). Proof. rewrite /mono_list_lb. apply _. Qed. Global Instance mono_list_auth_core_id l : CoreId (●ML□ l). Proof. rewrite /mono_list_auth. apply _. Qed. Lemma mono_list_auth_dfrac_op dq1 dq2 l : ●ML{dq1 ⋅ dq2} l ≡ ●ML{dq1} l ⋅ ●ML{dq2} l. Proof. rewrite /mono_list_auth auth_auth_dfrac_op. rewrite (comm _ (●{dq2} _)) -!assoc (assoc _ (◯ _)). by rewrite -core_id_dup (comm _ (◯ _)). Qed. Lemma mono_list_lb_op_l l1 l2 : l1 `prefix_of` l2 → ◯ML l1 ⋅ ◯ML l2 ≡ ◯ML l2. Proof. intros ?. by rewrite /mono_list_lb -auth_frag_op to_max_prefix_list_op_l. Qed. Lemma mono_list_lb_op_r l1 l2 : l1 `prefix_of` l2 → ◯ML l2 ⋅ ◯ML l1 ≡ ◯ML l2. Proof. intros ?. by rewrite /mono_list_lb -auth_frag_op to_max_prefix_list_op_r. Qed. Lemma mono_list_auth_lb_op dq l : ●ML{dq} l ≡ ●ML{dq} l ⋅ ◯ML l. Proof. by rewrite /mono_list_auth /mono_list_lb -!assoc -auth_frag_op -core_id_dup. Qed. Global Instance mono_list_auth_dfrac_is_op dq dq1 dq2 l : IsOp dq dq1 dq2 → IsOp' (●ML{dq} l) (●ML{dq1} l) (●ML{dq2} l). Proof. rewrite /IsOp' /IsOp=> ->. rewrite mono_list_auth_dfrac_op //. Qed. (** * Validity *) Lemma mono_list_auth_dfrac_validN n dq l : ✓{n} (●ML{dq} l) ↔ ✓ dq. Proof. rewrite /mono_list_auth auth_both_dfrac_validN. naive_solver apply to_max_prefix_list_validN. Qed. Lemma mono_list_auth_validN n l : ✓{n} (●ML l). Proof. by apply mono_list_auth_dfrac_validN. Qed. Lemma mono_list_auth_dfrac_valid dq l : ✓ (●ML{dq} l) ↔ ✓ dq. Proof. rewrite /mono_list_auth auth_both_dfrac_valid. naive_solver apply to_max_prefix_list_valid. Qed. Lemma mono_list_auth_valid l : ✓ (●ML l). Proof. by apply mono_list_auth_dfrac_valid. Qed. Lemma mono_list_auth_dfrac_op_validN n dq1 dq2 l1 l2 : ✓{n} (●ML{dq1} l1 ⋅ ●ML{dq2} l2) ↔ ✓ (dq1 ⋅ dq2) ∧ l1 ≡{n}≡ l2. Proof. rewrite /mono_list_auth (comm _ (●{dq2} _)) -!assoc (assoc _ (◯ _)). rewrite -auth_frag_op (comm _ (◯ _)) assoc. split. - move=> /cmra_validN_op_l /auth_auth_dfrac_op_validN. rewrite (inj_iff to_max_prefix_list). naive_solver. - intros [? ->]. rewrite -core_id_dup -auth_auth_dfrac_op auth_both_dfrac_validN. naive_solver apply to_max_prefix_list_validN. Qed. Lemma mono_list_auth_op_validN n l1 l2 : ✓{n} (●ML l1 ⋅ ●ML l2) ↔ False. Proof. rewrite mono_list_auth_dfrac_op_validN. naive_solver. Qed. Lemma mono_list_auth_dfrac_op_valid dq1 dq2 l1 l2 : ✓ (●ML{dq1} l1 ⋅ ●ML{dq2} l2) ↔ ✓ (dq1 ⋅ dq2) ∧ l1 ≡ l2. Proof. rewrite cmra_valid_validN equiv_dist. setoid_rewrite mono_list_auth_dfrac_op_validN. naive_solver eauto using O. Qed. Lemma mono_list_auth_op_valid l1 l2 : ✓ (●ML l1 ⋅ ●ML l2) ↔ False. Proof. rewrite mono_list_auth_dfrac_op_valid. naive_solver. Qed. Lemma mono_list_auth_dfrac_op_valid_L `{!LeibnizEquiv A} dq1 dq2 l1 l2 : ✓ (●ML{dq1} l1 ⋅ ●ML{dq2} l2) ↔ ✓ (dq1 ⋅ dq2) ∧ l1 = l2. Proof. unfold_leibniz. apply mono_list_auth_dfrac_op_valid. Qed. Lemma mono_list_both_dfrac_validN n dq l1 l2 : ✓{n} (●ML{dq} l1 ⋅ ◯ML l2) ↔ ✓ dq ∧ ∃ l, l1 ≡{n}≡ l2 ++ l. Proof. rewrite /mono_list_auth /mono_list_lb -assoc -auth_frag_op auth_both_dfrac_validN -to_max_prefix_list_includedN. f_equiv; split. - intros [Hincl _]. etrans; [apply: cmra_includedN_r|done]. - intros. split; [|by apply to_max_prefix_list_validN]. rewrite {2}(core_id_dup (to_max_prefix_list l1)). by f_equiv. Qed. Lemma mono_list_both_validN n l1 l2 : ✓{n} (●ML l1 ⋅ ◯ML l2) ↔ ∃ l, l1 ≡{n}≡ l2 ++ l. Proof. rewrite mono_list_both_dfrac_validN. split; [naive_solver|done]. Qed. Lemma mono_list_both_dfrac_valid dq l1 l2 : ✓ (●ML{dq} l1 ⋅ ◯ML l2) ↔ ✓ dq ∧ ∃ l, l1 ≡ l2 ++ l. Proof. rewrite /mono_list_auth /mono_list_lb -assoc -auth_frag_op auth_both_dfrac_valid -max_prefix_list_included_includedN -to_max_prefix_list_included. f_equiv; split. - intros [Hincl _]. etrans; [apply: cmra_included_r|done]. - intros. split; [|by apply to_max_prefix_list_valid]. rewrite {2}(core_id_dup (to_max_prefix_list l1)). by f_equiv. Qed. Lemma mono_list_both_valid l1 l2 : ✓ (●ML l1 ⋅ ◯ML l2) ↔ ∃ l, l1 ≡ l2 ++ l. Proof. rewrite mono_list_both_dfrac_valid. split; [naive_solver|done]. Qed. Lemma mono_list_both_dfrac_valid_L `{!LeibnizEquiv A} dq l1 l2 : ✓ (●ML{dq} l1 ⋅ ◯ML l2) ↔ ✓ dq ∧ l2 `prefix_of` l1. Proof. rewrite /prefix. rewrite mono_list_both_dfrac_valid. naive_solver. Qed. Lemma mono_list_both_valid_L `{!LeibnizEquiv A} l1 l2 : ✓ (●ML l1 ⋅ ◯ML l2) ↔ l2 `prefix_of` l1. Proof. rewrite /prefix. rewrite mono_list_both_valid. naive_solver. Qed. Lemma mono_list_lb_op_validN n l1 l2 : ✓{n} (◯ML l1 ⋅ ◯ML l2) ↔ (∃ l, l2 ≡{n}≡ l1 ++ l) ∨ (∃ l, l1 ≡{n}≡ l2 ++ l). Proof. by rewrite auth_frag_op_validN to_max_prefix_list_op_validN. Qed. Lemma mono_list_lb_op_valid l1 l2 : ✓ (◯ML l1 ⋅ ◯ML l2) ↔ (∃ l, l2 ≡ l1 ++ l) ∨ (∃ l, l1 ≡ l2 ++ l). Proof. by rewrite auth_frag_op_valid to_max_prefix_list_op_valid. Qed. Lemma mono_list_lb_op_valid_L `{!LeibnizEquiv A} l1 l2 : ✓ (◯ML l1 ⋅ ◯ML l2) ↔ l1 `prefix_of` l2 ∨ l2 `prefix_of` l1. Proof. rewrite mono_list_lb_op_valid / prefix. naive_solver. Qed. Lemma mono_list_lb_op_valid_1_L `{!LeibnizEquiv A} l1 l2 : ✓ (◯ML l1 ⋅ ◯ML l2) → l1 `prefix_of` l2 ∨ l2 `prefix_of` l1. Proof. by apply mono_list_lb_op_valid_L. Qed. Lemma mono_list_lb_op_valid_2_L `{!LeibnizEquiv A} l1 l2 : l1 `prefix_of` l2 ∨ l2 `prefix_of` l1 → ✓ (◯ML l1 ⋅ ◯ML l2). Proof. by apply mono_list_lb_op_valid_L. Qed. Lemma mono_list_lb_mono l1 l2 : l1 `prefix_of` l2 → ◯ML l1 ≼ ◯ML l2. Proof. intros. exists (◯ML l2). by rewrite mono_list_lb_op_l. Qed. Lemma mono_list_included dq l : ◯ML l ≼ ●ML{dq} l. Proof. apply cmra_included_r. Qed. (** * Update *) Lemma mono_list_update {l1} l2 : l1 `prefix_of` l2 → ●ML l1 ~~> ●ML l2. Proof. intros ?. by apply auth_update, max_prefix_list_local_update. Qed. Lemma mono_list_auth_persist dq l : ●ML{dq} l ~~> ●ML□ l. Proof. rewrite /mono_list_auth. apply cmra_update_op; [|done]. by apply auth_update_auth_persist. Qed. Lemma mono_list_auth_unpersist l : ●ML□ l ~~>: λ k, ∃ q, k = ●ML{#q} l. Proof. eapply auth_updateP_both_unpersist. Qed. End mono_list_props. Definition mono_listURF (F : oFunctor) : urFunctor := authURF (max_prefix_listURF F). Global Instance mono_listURF_contractive F : oFunctorContractive F → urFunctorContractive (mono_listURF F). Proof. apply _. Qed. Definition mono_listRF (F : oFunctor) : rFunctor := authRF (max_prefix_listURF F). Global Instance mono_listRF_contractive F : oFunctorContractive F → rFunctorContractive (mono_listRF F). Proof. apply _. Qed. iris-iris-4.2.0/iris/algebra/lib/mono_nat.v000066400000000000000000000110221460620107300205340ustar00rootroot00000000000000From iris.algebra Require Export auth. From iris.algebra Require Import numbers updates. From iris.prelude Require Import options. (** Authoritative CMRA over [max_nat]. The authoritative element is a monotonically increasing [nat], while a fragment is a lower bound. *) Definition mono_nat := auth max_natUR. Definition mono_natR := authR max_natUR. Definition mono_natUR := authUR max_natUR. (** [mono_nat_auth] is the authoritative element. The definition includes the fragment at the same value so that lemma [mono_nat_included], which states that [mono_nat_lb n ≼ mono_nat_auth dq n], holds. Without this trick, a frame-preserving update lemma would be required instead. *) Definition mono_nat_auth (dq : dfrac) (n : nat) : mono_nat := ●{dq} MaxNat n ⋅ ◯ MaxNat n. Definition mono_nat_lb (n : nat) : mono_nat := ◯ MaxNat n. Notation "●MN dq a" := (mono_nat_auth dq a) (at level 20, dq custom dfrac at level 1, format "●MN dq a"). Notation "◯MN a" := (mono_nat_lb a) (at level 20). Section mono_nat. Implicit Types (n : nat). Global Instance mono_nat_lb_core_id n : CoreId (◯MN n). Proof. apply _. Qed. Global Instance mono_nat_auth_core_id l : CoreId (●MN□ l). Proof. apply _. Qed. Lemma mono_nat_auth_dfrac_op dq1 dq2 n : ●MN{dq1 ⋅ dq2} n ≡ ●MN{dq1} n ⋅ ●MN{dq2} n. Proof. rewrite /mono_nat_auth auth_auth_dfrac_op. rewrite (comm _ (●{dq2} _)) -!assoc (assoc _ (◯ _)). by rewrite -core_id_dup (comm _ (◯ _)). Qed. Lemma mono_nat_lb_op n1 n2 : ◯MN (n1 `max` n2) = ◯MN n1 ⋅ ◯MN n2. Proof. rewrite -auth_frag_op max_nat_op //. Qed. Lemma mono_nat_auth_lb_op dq n : ●MN{dq} n ≡ ●MN{dq} n ⋅ ◯MN n. Proof. rewrite /mono_nat_auth /mono_nat_lb. rewrite -!assoc -auth_frag_op max_nat_op. rewrite Nat.max_id //. Qed. Global Instance mono_nat_auth_dfrac_is_op dq dq1 dq2 n : IsOp dq dq1 dq2 → IsOp' (●MN{dq} n) (●MN{dq1} n) (●MN{dq2} n). Proof. rewrite /IsOp' /IsOp=> ->. rewrite mono_nat_auth_dfrac_op //. Qed. Global Instance mono_nat_lb_max_is_op n n1 n2 : IsOp (MaxNat n) (MaxNat n1) (MaxNat n2) → IsOp' (◯MN n) (◯MN n1) (◯MN n2). Proof. rewrite /IsOp' /IsOp /mono_nat_lb=> ->. done. Qed. (** rephrasing of [mono_nat_lb_op] useful for weakening a fragment to a smaller lower-bound *) Lemma mono_nat_lb_op_le_l n n' : n' ≤ n → ◯MN n = ◯MN n' ⋅ ◯MN n. Proof. intros. rewrite -mono_nat_lb_op Nat.max_r //. Qed. Lemma mono_nat_auth_dfrac_valid dq n : (✓ ●MN{dq} n) ↔ ✓ dq. Proof. rewrite /mono_nat_auth auth_both_dfrac_valid_discrete /=. naive_solver. Qed. Lemma mono_nat_auth_valid n : ✓ ●MN n. Proof. by apply auth_both_valid. Qed. Lemma mono_nat_auth_dfrac_op_valid dq1 dq2 n1 n2 : ✓ (●MN{dq1} n1 ⋅ ●MN{dq2} n2) ↔ ✓ (dq1 ⋅ dq2) ∧ n1 = n2. Proof. rewrite /mono_nat_auth (comm _ (●{dq2} _)) -!assoc (assoc _ (◯ _)). rewrite -auth_frag_op (comm _ (◯ _)) assoc. split. - move=> /cmra_valid_op_l /auth_auth_dfrac_op_valid. naive_solver. - intros [? ->]. rewrite -core_id_dup -auth_auth_dfrac_op. by apply auth_both_dfrac_valid_discrete. Qed. Lemma mono_nat_auth_op_valid n1 n2 : ✓ (●MN n1 ⋅ ●MN n2) ↔ False. Proof. rewrite mono_nat_auth_dfrac_op_valid. naive_solver. Qed. Lemma mono_nat_both_dfrac_valid dq n m : ✓ (●MN{dq} n ⋅ ◯MN m) ↔ ✓ dq ∧ m ≤ n. Proof. rewrite /mono_nat_auth /mono_nat_lb -assoc -auth_frag_op. rewrite auth_both_dfrac_valid_discrete max_nat_included /=. naive_solver lia. Qed. Lemma mono_nat_both_valid n m : ✓ (●MN n ⋅ ◯MN m) ↔ m ≤ n. Proof. rewrite mono_nat_both_dfrac_valid dfrac_valid_own. naive_solver. Qed. Lemma mono_nat_lb_mono n1 n2 : n1 ≤ n2 → ◯MN n1 ≼ ◯MN n2. Proof. intros. by apply auth_frag_mono, max_nat_included. Qed. Lemma mono_nat_included dq n : ◯MN n ≼ ●MN{dq} n. Proof. apply cmra_included_r. Qed. Lemma mono_nat_update {n} n' : n ≤ n' → ●MN n ~~> ●MN n'. Proof. intros. rewrite /mono_nat_auth /mono_nat_lb. by apply auth_update, max_nat_local_update. Qed. Lemma mono_nat_auth_persist n dq : ●MN{dq} n ~~> ●MN□ n. Proof. intros. rewrite /mono_nat_auth /mono_nat_lb. eapply cmra_update_op_proper; last done. eapply auth_update_auth_persist. Qed. Lemma mono_nat_auth_unpersist n : ●MN□ n ~~>: λ k, ∃ q, k = ●MN{# q} n. Proof. eapply auth_updateP_both_unpersist. Qed. End mono_nat. Global Typeclasses Opaque mono_nat_auth mono_nat_lb. iris-iris-4.2.0/iris/algebra/lib/ufrac_auth.v000066400000000000000000000161741460620107300210600ustar00rootroot00000000000000(** This file provides the unbounded fractional authoritative camera: a version of the fractional authoritative camera that can be used with fractions [> 1]. Most of the reasoning principles for this version of the fractional authoritative cameras are the same as for the original version. There are two difference: - We get the additional rule that can be used to allocate a "surplus", i.e. if we have the authoritative element we can always increase its fraction and allocate a new fragment. << ✓ (a ⋅ b) → ●U_p a ~~> ●U_(p + q) (a ⋅ b) ⋅ ◯U_q b >> - We no longer have the [◯U_1 a] is an exclusive fragmental element. That is, while [◯F{1} a ⋅ ◯F{q} b] is vacuously false, [◯U_1 a ⋅ ◯U_q2 b] is not. *) From iris.algebra Require Export auth frac updates local_updates. From iris.algebra Require Import ufrac proofmode_classes. From iris.prelude Require Import options. Definition ufrac_authR (A : cmra) : cmra := authR (optionUR (prodR ufracR A)). Definition ufrac_authUR (A : cmra) : ucmra := authUR (optionUR (prodR ufracR A)). (** Note in the signature of [ufrac_auth_auth] and [ufrac_auth_frag] we use [q : Qp] instead of [q : ufrac]. This way, the API does not expose that [ufrac] is used internally. This is quite important, as there are two canonical camera instances with carrier [Qp], namely [fracR] and [ufracR]. When writing things like [ufrac_auth_auth q a ∧ ✓ q] we want Coq to infer the type of [q] as [Qp] such that the [✓] of the default [fracR] camera is used, and not the [✓] of the [ufracR] camera. *) Definition ufrac_auth_auth {A : cmra} (q : Qp) (x : A) : ufrac_authR A := ● (Some (q : ufracR,x)). Definition ufrac_auth_frag {A : cmra} (q : Qp) (x : A) : ufrac_authR A := ◯ (Some (q : ufracR,x)). Global Typeclasses Opaque ufrac_auth_auth ufrac_auth_frag. Global Instance: Params (@ufrac_auth_auth) 2 := {}. Global Instance: Params (@ufrac_auth_frag) 2 := {}. Notation "●U_ q a" := (ufrac_auth_auth q a) (at level 10, q at level 9, format "●U_ q a"). Notation "◯U_ q a" := (ufrac_auth_frag q a) (at level 10, q at level 9, format "◯U_ q a"). Section ufrac_auth. Context {A : cmra}. Implicit Types a b : A. Global Instance ufrac_auth_auth_ne q : NonExpansive (@ufrac_auth_auth A q). Proof. solve_proper. Qed. Global Instance ufrac_auth_auth_proper q : Proper ((≡) ==> (≡)) (@ufrac_auth_auth A q). Proof. solve_proper. Qed. Global Instance ufrac_auth_frag_ne q : NonExpansive (@ufrac_auth_frag A q). Proof. solve_proper. Qed. Global Instance ufrac_auth_frag_proper q : Proper ((≡) ==> (≡)) (@ufrac_auth_frag A q). Proof. solve_proper. Qed. Global Instance ufrac_auth_auth_discrete q a : Discrete a → Discrete (●U_q a). Proof. intros. apply auth_auth_discrete; [apply Some_discrete|]; apply _. Qed. Global Instance ufrac_auth_frag_discrete q a : Discrete a → Discrete (◯U_q a). Proof. intros. apply auth_frag_discrete; apply Some_discrete; apply _. Qed. Lemma ufrac_auth_validN n a p : ✓{n} a → ✓{n} (●U_p a ⋅ ◯U_p a). Proof. by rewrite auth_both_validN. Qed. Lemma ufrac_auth_valid p a : ✓ a → ✓ (●U_p a ⋅ ◯U_p a). Proof. intros. by apply auth_both_valid_2. Qed. Lemma ufrac_auth_agreeN n p a b : ✓{n} (●U_p a ⋅ ◯U_p b) → a ≡{n}≡ b. Proof. rewrite auth_both_validN=> -[/Some_includedN [[_ ? //]|Hincl] _]. move: Hincl=> /pair_includedN=> -[/ufrac_included Hincl _]. by destruct (irreflexivity (<)%Qp p). Qed. Lemma ufrac_auth_agree p a b : ✓ (●U_p a ⋅ ◯U_p b) → a ≡ b. Proof. intros. apply equiv_dist=> n. by eapply ufrac_auth_agreeN, cmra_valid_validN. Qed. Lemma ufrac_auth_agree_L `{!LeibnizEquiv A} p a b : ✓ (●U_p a ⋅ ◯U_p b) → a = b. Proof. intros. by eapply leibniz_equiv, ufrac_auth_agree. Qed. Lemma ufrac_auth_includedN n p q a b : ✓{n} (●U_p a ⋅ ◯U_q b) → Some b ≼{n} Some a. Proof. by rewrite auth_both_validN=> -[/Some_pair_includedN [_ ?] _]. Qed. Lemma ufrac_auth_included `{!CmraDiscrete A} q p a b : ✓ (●U_p a ⋅ ◯U_q b) → Some b ≼ Some a. Proof. rewrite auth_both_valid_discrete=> -[/Some_pair_included [_ ?] _] //. Qed. Lemma ufrac_auth_includedN_total `{!CmraTotal A} n q p a b : ✓{n} (●U_p a ⋅ ◯U_q b) → b ≼{n} a. Proof. intros. by eapply Some_includedN_total, ufrac_auth_includedN. Qed. Lemma ufrac_auth_included_total `{!CmraDiscrete A, !CmraTotal A} q p a b : ✓ (●U_p a ⋅ ◯U_q b) → b ≼ a. Proof. intros. by eapply Some_included_total, ufrac_auth_included. Qed. Lemma ufrac_auth_auth_validN n q a : ✓{n} (●U_q a) ↔ ✓{n} a. Proof. rewrite auth_auth_dfrac_validN Some_validN. split. - by intros [?[]]. - intros. by split. Qed. Lemma ufrac_auth_auth_valid q a : ✓ (●U_q a) ↔ ✓ a. Proof. rewrite !cmra_valid_validN. by setoid_rewrite ufrac_auth_auth_validN. Qed. Lemma ufrac_auth_frag_validN n q a : ✓{n} (◯U_q a) ↔ ✓{n} a. Proof. rewrite auth_frag_validN. split. - by intros [??]. - by split. Qed. Lemma ufrac_auth_frag_valid q a : ✓ (◯U_q a) ↔ ✓ a. Proof. rewrite auth_frag_valid. split. - by intros [??]. - by split. Qed. Lemma ufrac_auth_frag_op q1 q2 a1 a2 : ◯U_(q1+q2) (a1 ⋅ a2) ≡ ◯U_q1 a1 ⋅ ◯U_q2 a2. Proof. done. Qed. Lemma ufrac_auth_frag_op_validN n q1 q2 a b : ✓{n} (◯U_q1 a ⋅ ◯U_q2 b) ↔ ✓{n} (a ⋅ b). Proof. by rewrite -ufrac_auth_frag_op ufrac_auth_frag_validN. Qed. Lemma ufrac_auth_frag_op_valid q1 q2 a b : ✓ (◯U_q1 a ⋅ ◯U_q2 b) ↔ ✓ (a ⋅ b). Proof. by rewrite -ufrac_auth_frag_op ufrac_auth_frag_valid. Qed. Global Instance ufrac_auth_is_op q q1 q2 a a1 a2 : IsOp q q1 q2 → IsOp a a1 a2 → IsOp' (◯U_q a) (◯U_q1 a1) (◯U_q2 a2). Proof. by rewrite /IsOp' /IsOp=> /leibniz_equiv_iff -> ->. Qed. Global Instance ufrac_auth_is_op_core_id q q1 q2 a : CoreId a → IsOp q q1 q2 → IsOp' (◯U_q a) (◯U_q1 a) (◯U_q2 a). Proof. rewrite /IsOp' /IsOp=> ? /leibniz_equiv_iff ->. by rewrite -ufrac_auth_frag_op -core_id_dup. Qed. Lemma ufrac_auth_update p q a b a' b' : (a,b) ~l~> (a',b') → ●U_p a ⋅ ◯U_q b ~~> ●U_p a' ⋅ ◯U_q b'. Proof. intros. apply: auth_update. apply: option_local_update. by apply: prod_local_update_2. Qed. Lemma ufrac_auth_update_surplus p q a b : ✓ (a ⋅ b) → ●U_p a ~~> ●U_(p+q) (a ⋅ b) ⋅ ◯U_q b. Proof. intros Hconsistent. apply: auth_update_alloc. intros n m; simpl; intros [Hvalid1 Hvalid2] Heq. split. - split; by apply cmra_valid_validN. - rewrite pair_op Some_op Heq comm. destruct m; simpl; [rewrite left_id | rewrite right_id]; done. Qed. End ufrac_auth. Definition ufrac_authURF (F : rFunctor) : urFunctor := authURF (optionURF (prodRF (constRF ufracR) F)). Global Instance ufrac_authURF_contractive F : rFunctorContractive F → urFunctorContractive (ufrac_authURF F). Proof. apply _. Qed. Definition ufrac_authRF (F : rFunctor) : rFunctor := authRF (optionURF (prodRF (constRF ufracR) F)). Global Instance ufrac_authRF_contractive F : rFunctorContractive F → rFunctorContractive (ufrac_authRF F). Proof. apply _. Qed. iris-iris-4.2.0/iris/algebra/list.v000066400000000000000000000216271460620107300171430ustar00rootroot00000000000000From stdpp Require Export list. From iris.algebra Require Export ofe. From iris.algebra Require Import big_op. From iris.prelude Require Import options. Section ofe. Context {A : ofe}. Implicit Types l : list A. Local Instance list_dist : Dist (list A) := λ n, Forall2 (dist n). Lemma list_dist_Forall2 n l k : l ≡{n}≡ k ↔ Forall2 (dist n) l k. Proof. done. Qed. Lemma list_dist_lookup n l1 l2 : l1 ≡{n}≡ l2 ↔ ∀ i, l1 !! i ≡{n}≡ l2 !! i. Proof. setoid_rewrite option_dist_Forall2. apply Forall2_lookup. Qed. Global Instance cons_ne : NonExpansive2 (@cons A) := _. Global Instance app_ne : NonExpansive2 (@app A) := _. Global Instance length_ne n : Proper (dist n ==> (=)) (@length A) := _. Global Instance tail_ne : NonExpansive (@tail A) := _. Global Instance take_ne n : NonExpansive (@take A n) := _. Global Instance drop_ne n : NonExpansive (@drop A n) := _. Global Instance head_ne : NonExpansive (head (A:=A)). Proof. destruct 1; by constructor. Qed. Global Instance list_lookup_ne i : NonExpansive (lookup (M:=list A) i). Proof. intros ????. by apply option_dist_Forall2, Forall2_lookup. Qed. Global Instance list_lookup_total_ne `{!Inhabited A} i : NonExpansive (lookup_total (M:=list A) i). Proof. intros ???. rewrite !list_lookup_total_alt. by intros ->. Qed. Global Instance list_alter_ne n : Proper ((dist n ==> dist n) ==> (=) ==> dist n ==> dist n) (alter (M:=list A)) := _. Global Instance list_insert_ne i : NonExpansive2 (insert (M:=list A) i) := _. Global Instance list_inserts_ne i : NonExpansive2 (@list_inserts A i) := _. Global Instance list_delete_ne i : NonExpansive (delete (M:=list A) i) := _. Global Instance option_list_ne : NonExpansive (@option_list A). Proof. intros ????; by apply Forall2_option_list, option_dist_Forall2. Qed. Global Instance list_filter_ne n P `{∀ x, Decision (P x)} : Proper (dist n ==> iff) P → Proper (dist n ==> dist n) (filter (B:=list A) P) := _. Global Instance replicate_ne n : NonExpansive (@replicate A n) := _. Global Instance reverse_ne : NonExpansive (@reverse A) := _. Global Instance last_ne : NonExpansive (@last A). Proof. intros ????; by apply option_dist_Forall2, Forall2_last. Qed. Global Instance resize_ne n : NonExpansive2 (@resize A n) := _. Global Instance cons_dist_inj n : Inj2 (dist n) (dist n) (dist n) (@cons A). Proof. by inversion_clear 1. Qed. Lemma nil_dist_eq n l : l ≡{n}≡ [] ↔ l = []. Proof. split; by inversion 1. Qed. Lemma cons_dist_eq n l k y : l ≡{n}≡ y :: k → ∃ x l', x ≡{n}≡ y ∧ l' ≡{n}≡ k ∧ l = x :: l'. Proof. apply Forall2_cons_inv_r. Qed. Lemma app_dist_eq n l k1 k2 : l ≡{n}≡ k1 ++ k2 ↔ ∃ k1' k2', l = k1' ++ k2' ∧ k1' ≡{n}≡ k1 ∧ k2' ≡{n}≡ k2. Proof. rewrite list_dist_Forall2 Forall2_app_inv_r. naive_solver. Qed. Lemma list_singleton_dist_eq n l x : l ≡{n}≡ [x] ↔ ∃ x', l = [x'] ∧ x' ≡{n}≡ x. Proof. split; [|by intros (?&->&->)]. intros (?&?&?&->%Forall2_nil_inv_r&->)%list_dist_Forall2%Forall2_cons_inv_r. eauto. Qed. Definition list_ofe_mixin : OfeMixin (list A). Proof. split. - intros l k. rewrite list_equiv_Forall2 -Forall2_forall. split; induction 1; constructor; intros; try apply equiv_dist; auto. - apply _. - rewrite /dist /list_dist. eauto using Forall2_impl, dist_le with si_solver. Qed. Canonical Structure listO := Ofe (list A) list_ofe_mixin. (** To define [compl : chain (list A) → list A] we make use of the fact that given a given chain [c0, c1, c2, ...] of lists, the list [c0] completely determines the shape (i.e. the length) of all lists in the chain. So, the [compl] operation is defined by structural recursion on [c0], and takes the completion of the elements of all lists in the chain point-wise. We use [head] and [tail] as the inverse of [cons]. *) Fixpoint list_compl_go `{!Cofe A} (c0 : list A) (c : chain listO) : listO := match c0 with | [] => [] | x :: c0 => compl (chain_map (default x ∘ head) c) :: list_compl_go c0 (chain_map tail c) end. Global Program Instance list_cofe `{!Cofe A} : Cofe listO := {| compl c := list_compl_go (c 0) c |}. Next Obligation. intros ? n c; rewrite /compl. assert (c 0 ≡{0}≡ c n) as Hc0 by (symmetry; apply chain_cauchy; lia). revert Hc0. generalize (c 0)=> c0. revert c. induction c0 as [|x c0 IH]=> c Hc0 /=. { by inversion Hc0. } apply symmetry, cons_dist_eq in Hc0 as (x' & xs' & Hx & Hc0 & Hcn). rewrite Hcn. f_equiv. - by rewrite conv_compl /= Hcn /=. - rewrite IH /= ?Hcn //. Qed. Global Instance list_ofe_discrete : OfeDiscrete A → OfeDiscrete listO. Proof. induction 2; constructor; try apply (discrete_0 _); auto. Qed. Global Instance nil_discrete : Discrete (@nil A). Proof. inversion_clear 1; constructor. Qed. Global Instance cons_discrete x l : Discrete x → Discrete l → Discrete (x :: l). Proof. intros ??; inversion_clear 1; constructor; by apply discrete_0. Qed. Lemma dist_Permutation n l1 l2 l3 : l1 ≡{n}≡ l2 → l2 ≡ₚ l3 → ∃ l2', l1 ≡ₚ l2' ∧ l2' ≡{n}≡ l3. Proof. intros Hequiv Hperm. revert l1 Hequiv. induction Hperm as [|x l2 l3 _ IH|x y l2|l2 l3 l4 _ IH1 _ IH2]; intros l1. - intros ?. by exists l1. - intros (x'&l2'&?&(l2''&?&?)%IH&->)%cons_dist_eq. exists (x' :: l2''). by repeat constructor. - intros (y'&?&?&(x'&l2'&?&?&->)%cons_dist_eq&->)%cons_dist_eq. exists (x' :: y' :: l2'). by repeat constructor. - intros (l2'&?&(l3'&?&?)%IH2)%IH1. exists l3'. split; [by etrans|done]. Qed. End ofe. Global Arguments listO : clear implicits. (** Non-expansiveness of higher-order list functions and big-ops *) Global Instance list_fmap_ne {A B : ofe} n : Proper ((dist n ==> dist n) ==> dist n ==> dist n) (fmap (M:=list) (A:=A) (B:=B)). Proof. intros f1 f2 Hf l1 l2 Hl; by eapply Forall2_fmap, Forall2_impl; eauto. Qed. Global Instance list_omap_ne {A B : ofe} n : Proper ((dist n ==> dist n) ==> dist n ==> dist n) (omap (M:=list) (A:=A) (B:=B)). Proof. intros f1 f2 Hf. induction 1 as [|x1 x2 l1 l2 Hx Hl]; csimpl; [constructor|]. destruct (Hf _ _ Hx); [f_equiv|]; auto. Qed. Global Instance imap_ne {A B : ofe} n : Proper (pointwise_relation _ ((dist n ==> dist n)) ==> dist n ==> dist n) (imap (A:=A) (B:=B)). Proof. intros f1 f2 Hf l1 l2 Hl. revert f1 f2 Hf. induction Hl as [|x1 x2 l1 l2 ?? IH]; intros f1 f2 Hf; simpl; [constructor|]. f_equiv; [by apply Hf|]. apply IH. intros i y1 y2 Hy. by apply Hf. Qed. Global Instance list_bind_ne {A B : ofe} (f : A → list A) n : Proper ((dist n ==> dist n) ==> dist n ==> dist n) (mbind (M:=list) (A:=A) (B:=B)). Proof. intros f1 f2 Hf. induction 1; csimpl; [constructor|f_equiv; auto]. Qed. Global Instance list_join_ne {A : ofe} : NonExpansive (mjoin (M:=list) (A:=A)). Proof. induction 1; simpl; [constructor|solve_proper]. Qed. Global Instance zip_with_ne {A B C : ofe} n : Proper ((dist n ==> dist n ==> dist n) ==> dist n ==> dist n ==> dist n) (zip_with (A:=A) (B:=B) (C:=C)). Proof. intros f1 f2 Hf. induction 1; destruct 1; simpl; [constructor..|f_equiv; try apply Hf; auto]. Qed. Global Instance list_fmap_dist_inj {A B : ofe} (f : A → B) n : Inj (≡{n}≡) (≡{n}≡) f → Inj (≡{n}@{list A}≡) (≡{n}@{list B}≡) (fmap f). Proof. apply list_fmap_inj. Qed. Lemma big_opL_ne_2 {M : ofe} {o : M → M → M} `{!Monoid o} {A : ofe} (f g : nat → A → M) l1 l2 n : l1 ≡{n}≡ l2 → (∀ k y1 y2, l1 !! k = Some y1 → l2 !! k = Some y2 → y1 ≡{n}≡ y2 → f k y1 ≡{n}≡ g k y2) → ([^o list] k ↦ y ∈ l1, f k y) ≡{n}≡ ([^o list] k ↦ y ∈ l2, g k y). Proof. intros Hl Hf. apply big_opL_gen_proper_2; try (apply _ || done). { apply monoid_ne. } intros k. assert (l1 !! k ≡{n}≡ l2 !! k) as Hlk by (by f_equiv). destruct (l1 !! k) eqn:?, (l2 !! k) eqn:?; inversion Hlk; naive_solver. Qed. (** Functor *) Lemma list_fmap_ext_ne {A} {B : ofe} (f g : A → B) (l : list A) n : (∀ x, f x ≡{n}≡ g x) → f <$> l ≡{n}≡ g <$> l. Proof. intros Hf. by apply Forall2_fmap, Forall_Forall2_diag, Forall_true. Qed. Definition listO_map {A B} (f : A -n> B) : listO A -n> listO B := OfeMor (fmap f : listO A → listO B). Global Instance listO_map_ne A B : NonExpansive (@listO_map A B). Proof. intros n f g ? l. by apply list_fmap_ext_ne. Qed. Program Definition listOF (F : oFunctor) : oFunctor := {| oFunctor_car A _ B _ := listO (oFunctor_car F A B); oFunctor_map A1 _ A2 _ B1 _ B2 _ fg := listO_map (oFunctor_map F fg) |}. Next Obligation. by intros F A1 ? A2 ? B1 ? B2 ? n f g Hfg; apply listO_map_ne, oFunctor_map_ne. Qed. Next Obligation. intros F A ? B ? x. rewrite /= -{2}(list_fmap_id x). apply list_fmap_equiv_ext=>???. apply oFunctor_map_id. Qed. Next Obligation. intros F A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x. rewrite /= -list_fmap_compose. apply list_fmap_equiv_ext=>???; apply oFunctor_map_compose. Qed. Global Instance listOF_contractive F : oFunctorContractive F → oFunctorContractive (listOF F). Proof. by intros ? A1 ? A2 ? B1 ? B2 ? n f g Hfg; apply listO_map_ne, oFunctor_map_contractive. Qed. iris-iris-4.2.0/iris/algebra/local_updates.v000066400000000000000000000177411460620107300210110ustar00rootroot00000000000000From iris.algebra Require Export cmra. From iris.prelude Require Import options. (** * Local updates *) Definition local_update {A : cmra} (x y : A * A) := ∀ n mz, ✓{n} x.1 → x.1 ≡{n}≡ x.2 ⋅? mz → ✓{n} y.1 ∧ y.1 ≡{n}≡ y.2 ⋅? mz. Global Instance: Params (@local_update) 1 := {}. Infix "~l~>" := local_update (at level 70). Section updates. Context {A : cmra}. Implicit Types x y : A. Global Instance local_update_proper : Proper ((≡) ==> (≡) ==> iff) (@local_update A). Proof. unfold local_update. by repeat intro; setoid_subst. Qed. Global Instance local_update_preorder : PreOrder (@local_update A). Proof. split; unfold local_update; red; naive_solver. Qed. Lemma exclusive_local_update `{!Exclusive y} x x' : ✓ x' → (x,y) ~l~> (x',x'). Proof. intros ? n mz Hxv Hx; simpl in *. move: Hxv; rewrite Hx; move=> /exclusiveN_opM=> ->; split; auto. by apply cmra_valid_validN. Qed. Lemma op_local_update x y z : (∀ n, ✓{n} x → ✓{n} (z ⋅ x)) → (x,y) ~l~> (z ⋅ x, z ⋅ y). Proof. intros Hv n mz Hxv Hx; simpl in *; split; [by auto|]. by rewrite Hx -cmra_op_opM_assoc. Qed. Lemma op_local_update_discrete `{!CmraDiscrete A} x y z : (✓ x → ✓ (z ⋅ x)) → (x,y) ~l~> (z ⋅ x, z ⋅ y). Proof. intros; apply op_local_update=> n. by rewrite -!(cmra_discrete_valid_iff n). Qed. Lemma op_local_update_frame x y x' y' yf : (x,y) ~l~> (x',y') → (x,y ⋅ yf) ~l~> (x', y' ⋅ yf). Proof. intros Hup n mz Hxv Hx; simpl in *. destruct (Hup n (Some (yf ⋅? mz))); [done|by rewrite /= -cmra_op_opM_assoc|]. by rewrite cmra_op_opM_assoc. Qed. Lemma cancel_local_update x y z `{!Cancelable x} : (x ⋅ y, x ⋅ z) ~l~> (y, z). Proof. intros n f ? Heq. split; first by eapply cmra_validN_op_r. apply (cancelableN x); first done. by rewrite -cmra_op_opM_assoc. Qed. Lemma replace_local_update x y `{!IdFree x} : ✓ y → (x, x) ~l~> (y, y). Proof. intros ? n mz ? Heq; simpl in *; split; first by apply cmra_valid_validN. destruct mz as [z|]; [|done]. by destruct (id_freeN_r n n x z). Qed. Lemma core_id_local_update x y z `{!CoreId y} : y ≼ x → (x, z) ~l~> (x, z ⋅ y). Proof. intros Hincl n mf ? Heq; simpl in *; split; first done. rewrite [x]core_id_extract // Heq. destruct mf as [f|]; last done. simpl. rewrite -assoc [f ⋅ y]comm assoc //. Qed. Lemma local_update_discrete `{!CmraDiscrete A} (x y x' y' : A) : (x,y) ~l~> (x',y') ↔ ∀ mz, ✓ x → x ≡ y ⋅? mz → ✓ x' ∧ x' ≡ y' ⋅? mz. Proof. rewrite /local_update /=. setoid_rewrite <-cmra_discrete_valid_iff. setoid_rewrite <-(λ n, discrete_iff n x). setoid_rewrite <-(λ n, discrete_iff n x'). naive_solver eauto using O. Qed. Lemma local_update_valid0 x y x' y' : (✓{0} x → ✓{0} y → Some y ≼{0} Some x → (x,y) ~l~> (x',y')) → (x,y) ~l~> (x',y'). Proof. intros Hup n mz Hmz Hz; simpl in *. apply Hup; auto. - by apply (cmra_validN_le n); last lia. - apply (cmra_validN_le n); last lia. move: Hmz; rewrite Hz. destruct mz; simpl; eauto using cmra_validN_op_l. - eapply (cmra_includedN_le n); last lia. apply Some_includedN_opM. eauto. Qed. Lemma local_update_valid `{!CmraDiscrete A} x y x' y' : (✓ x → ✓ y → Some y ≼ Some x → (x,y) ~l~> (x',y')) → (x,y) ~l~> (x',y'). Proof. rewrite !(cmra_discrete_valid_iff 0) (cmra_discrete_included_iff 0). apply local_update_valid0. Qed. Lemma local_update_total_valid0 `{!CmraTotal A} x y x' y' : (✓{0} x → ✓{0} y → y ≼{0} x → (x,y) ~l~> (x',y')) → (x,y) ~l~> (x',y'). Proof. intros Hup. apply local_update_valid0=> ?? Hincl. apply Hup; auto. by apply Some_includedN_total. Qed. Lemma local_update_total_valid `{!CmraTotal A, !CmraDiscrete A} x y x' y' : (✓ x → ✓ y → y ≼ x → (x,y) ~l~> (x',y')) → (x,y) ~l~> (x',y'). Proof. rewrite !(cmra_discrete_valid_iff 0) (cmra_discrete_included_iff 0). apply local_update_total_valid0. Qed. End updates. Section updates_unital. Context {A : ucmra}. Implicit Types x y : A. Lemma local_update_unital x y x' y' : (x,y) ~l~> (x',y') ↔ ∀ n z, ✓{n} x → x ≡{n}≡ y ⋅ z → ✓{n} x' ∧ x' ≡{n}≡ y' ⋅ z. Proof. split. - intros Hup n z. apply (Hup _ (Some z)). - intros Hup n [z|]; simpl; [by auto|]. rewrite -(right_id ε op y) -(right_id ε op y'). auto. Qed. Lemma local_update_unital_discrete `{!CmraDiscrete A} (x y x' y' : A) : (x,y) ~l~> (x',y') ↔ ∀ z, ✓ x → x ≡ y ⋅ z → ✓ x' ∧ x' ≡ y' ⋅ z. Proof. rewrite local_update_discrete. split. - intros Hup z. apply (Hup (Some z)). - intros Hup [z|]; simpl; [by auto|]. rewrite -(right_id ε op y) -(right_id ε op y'). auto. Qed. Lemma cancel_local_update_unit x y `{!Cancelable x} : (x ⋅ y, x) ~l~> (y, ε). Proof. rewrite -{2}(right_id ε op x). by apply cancel_local_update. Qed. End updates_unital. (** * Unit *) Lemma unit_local_update (x y x' y' : unit) : (x, y) ~l~> (x', y'). Proof. destruct x,y,x',y'; reflexivity. Qed. (** * Dependently-typed functions over a discrete domain *) Lemma discrete_fun_local_update {A} {B : A → ucmra} (f g f' g' : discrete_fun B) : (∀ x : A, (f x, g x) ~l~> (f' x, g' x)) → (f, g) ~l~> (f', g'). Proof. setoid_rewrite local_update_unital. intros Hupd n h Hf Hg. split=> x; eapply Hupd, Hg; eauto. Qed. (** * Product *) Lemma prod_local_update {A B : cmra} (x y x' y' : A * B) : (x.1,y.1) ~l~> (x'.1,y'.1) → (x.2,y.2) ~l~> (x'.2,y'.2) → (x,y) ~l~> (x',y'). Proof. intros Hup1 Hup2 n mz [??] [??]; simpl in *. destruct (Hup1 n (fst <$> mz)); [done|by destruct mz|]. destruct (Hup2 n (snd <$> mz)); [done|by destruct mz|]. by destruct mz. Qed. Lemma prod_local_update' {A B : cmra} (x1 y1 x1' y1' : A) (x2 y2 x2' y2' : B) : (x1,y1) ~l~> (x1',y1') → (x2,y2) ~l~> (x2',y2') → ((x1,x2),(y1,y2)) ~l~> ((x1',x2'),(y1',y2')). Proof. intros. by apply prod_local_update. Qed. Lemma prod_local_update_1 {A B : cmra} (x1 y1 x1' y1' : A) (x2 y2 : B) : (x1,y1) ~l~> (x1',y1') → ((x1,x2),(y1,y2)) ~l~> ((x1',x2),(y1',y2)). Proof. intros. by apply prod_local_update. Qed. Lemma prod_local_update_2 {A B : cmra} (x1 y1 : A) (x2 y2 x2' y2' : B) : (x2,y2) ~l~> (x2',y2') → ((x1,x2),(y1,y2)) ~l~> ((x1,x2'),(y1,y2')). Proof. intros. by apply prod_local_update. Qed. (** * Option *) Lemma option_local_update {A : cmra} (x y x' y' : A) : (x, y) ~l~> (x',y') → (Some x, Some y) ~l~> (Some x', Some y'). Proof. intros Hup. apply local_update_unital=>n mz Hxv Hx; simpl in *. destruct (Hup n mz); first done. { destruct mz as [?|]; inversion_clear Hx; auto. } split; first done. destruct mz as [?|]; constructor; auto. Qed. Lemma option_local_update_None {A: ucmra} (x x' y': A): (x, ε) ~l~> (x', y') -> (Some x, None) ~l~> (Some x', Some y'). Proof. intros Hup. apply local_update_unital=> n mz. rewrite left_id=> ? <-. destruct (Hup n (Some x)); simpl in *; first done. - by rewrite left_id. - split; first done. rewrite -Some_op. by constructor. Qed. Lemma alloc_option_local_update {A : cmra} (x : A) y : ✓ x → (None, y) ~l~> (Some x, Some x). Proof. move=>Hx. apply local_update_unital=> n z _ /= Heq. split. { rewrite Some_validN. apply cmra_valid_validN. done. } destruct z as [z|]; last done. destruct y; inversion Heq. Qed. Lemma delete_option_local_update {A : cmra} (x : option A) (y : A) : Exclusive y → (x, Some y) ~l~> (None, None). 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; [|lia]. eapply Hy. Qed. Lemma delete_option_local_update_cancelable {A : cmra} (mx : option A) : Cancelable mx → (mx, mx) ~l~> (None, None). Proof. intros ?. apply local_update_unital=>n mf /= Hmx Heq. split; first done. rewrite left_id. eapply (cancelableN mx); by rewrite right_id_L. Qed. iris-iris-4.2.0/iris/algebra/max_prefix_list.v000066400000000000000000000200621460620107300213550ustar00rootroot00000000000000(** Defines an RA on lists whose composition is only defined when one operand is a prefix of the other. The result is the longer list. In particular, the core is the identity function for all elements. *) From iris.algebra Require Export agree list gmap updates. From iris.algebra Require Import local_updates proofmode_classes. From iris.prelude Require Import options. Definition max_prefix_list (A : Type) := gmap nat (agree A). Definition max_prefix_listR (A : ofe) := gmapUR nat (agreeR A). Definition max_prefix_listUR (A : ofe) := gmapUR nat (agreeR A). Definition to_max_prefix_list {A} (l : list A) : gmap nat (agree A) := to_agree <$> map_seq 0 l. Global Instance: Params (@to_max_prefix_list) 1 := {}. Global Typeclasses Opaque to_max_prefix_list. Section max_prefix_list. Context {A : ofe}. Implicit Types l : list A. Global Instance to_max_prefix_list_ne : NonExpansive (@to_max_prefix_list A). Proof. solve_proper. Qed. Global Instance to_max_prefix_list_proper : Proper ((≡) ==> (≡)) (@to_max_prefix_list A). Proof. solve_proper. Qed. Global Instance to_max_prefix_list_dist_inj n : Inj (dist n) (dist n) (@to_max_prefix_list A). Proof. rewrite /to_max_prefix_list. intros l1 l2 Hl. apply list_dist_lookup=> i. move: (Hl i). rewrite !lookup_fmap !lookup_map_seq Nat.sub_0_r. rewrite !option_guard_True; [|lia..]. destruct (l1 !! i), (l2 !! i); inversion_clear 1; constructor; by apply (inj to_agree). Qed. Global Instance to_max_prefix_list_inj : Inj (≡) (≡) (@to_max_prefix_list A). Proof. intros l1 l2. rewrite !equiv_dist=> ? n. by apply (inj to_max_prefix_list). Qed. Global Instance mono_list_lb_core_id (m : max_prefix_list A) : CoreId m := _. Lemma to_max_prefix_list_valid l : ✓ to_max_prefix_list l. Proof. intros i. rewrite /to_max_prefix_list lookup_fmap. by destruct (map_seq 0 l !! i). Qed. Lemma to_max_prefix_list_validN n l : ✓{n} to_max_prefix_list l. Proof. apply cmra_valid_validN, to_max_prefix_list_valid. Qed. Local Lemma to_max_prefix_list_app l1 l2 : to_max_prefix_list (l1 ++ l2) ≡ to_max_prefix_list l1 ⋅ (to_agree <$> map_seq (length l1) l2). Proof. rewrite /to_max_prefix_list map_seq_app=> i /=. rewrite lookup_op !lookup_fmap. destruct (map_seq 0 l1 !! i) as [x|] eqn:Hl1; simpl; last first. { by rewrite lookup_union_r // left_id. } rewrite (lookup_union_Some_l _ _ _ x) //=. assert (map_seq (M:=gmap nat A) (length l1) l2 !! i = None) as ->. { apply lookup_map_seq_None. apply lookup_map_seq_Some in Hl1 as [_ ?%lookup_lt_Some]. lia. } by rewrite /= right_id. Qed. Lemma to_max_prefix_list_op_l l1 l2 : l1 `prefix_of` l2 → to_max_prefix_list l1 ⋅ to_max_prefix_list l2 ≡ to_max_prefix_list l2. Proof. intros [l ->]. by rewrite to_max_prefix_list_app assoc -core_id_dup. Qed. Lemma to_max_prefix_list_op_r l1 l2 : l1 `prefix_of` l2 → to_max_prefix_list l2 ⋅ to_max_prefix_list l1 ≡ to_max_prefix_list l2. Proof. intros. by rewrite comm to_max_prefix_list_op_l. Qed. Lemma max_prefix_list_included_includedN (ml1 ml2 : max_prefix_list A) : ml1 ≼ ml2 ↔ ∀ n, ml1 ≼{n} ml2. Proof. split; [intros; by apply: cmra_included_includedN|]. intros Hincl. exists ml2. apply equiv_dist=> n. destruct (Hincl n) as [l ->]. by rewrite assoc -core_id_dup. Qed. Local Lemma to_max_prefix_list_includedN_aux n l1 l2 : to_max_prefix_list l1 ≼{n} to_max_prefix_list l2 → l2 ≡{n}≡ l1 ++ drop (length l1) l2. Proof. rewrite lookup_includedN=> Hincl. apply list_dist_lookup=> i. rewrite lookup_app. move: (Hincl i). rewrite /to_max_prefix_list !lookup_fmap !lookup_map_seq Nat.sub_0_r. rewrite !option_guard_True; [|lia..]. rewrite option_includedN_total fmap_None. intros [Hi|(?&?&(a2&->&->)%fmap_Some&(a1&->&->)%fmap_Some&Ha)]. - rewrite lookup_drop Hi. apply lookup_ge_None in Hi. f_equiv; lia. - f_equiv. symmetry. by apply to_agree_includedN. Qed. Lemma to_max_prefix_list_includedN n l1 l2 : to_max_prefix_list l1 ≼{n} to_max_prefix_list l2 ↔ ∃ l, l2 ≡{n}≡ l1 ++ l. Proof. split. - intros. eexists. by apply to_max_prefix_list_includedN_aux. - intros [l ->]. rewrite to_max_prefix_list_app. apply: cmra_includedN_l. Qed. Lemma to_max_prefix_list_included l1 l2 : to_max_prefix_list l1 ≼ to_max_prefix_list l2 ↔ ∃ l, l2 ≡ l1 ++ l. Proof. split. - intros. eexists. apply equiv_dist=> n. apply to_max_prefix_list_includedN_aux. by apply: cmra_included_includedN. - intros [l ->]. rewrite to_max_prefix_list_app. eauto. Qed. Lemma to_max_prefix_list_included_L `{!LeibnizEquiv A} l1 l2 : to_max_prefix_list l1 ≼ to_max_prefix_list l2 ↔ l1 `prefix_of` l2. Proof. rewrite to_max_prefix_list_included /prefix. naive_solver. Qed. Local Lemma to_max_prefix_list_op_validN_aux n l1 l2 : length l1 ≤ length l2 → ✓{n} (to_max_prefix_list l1 ⋅ to_max_prefix_list l2) → l2 ≡{n}≡ l1 ++ drop (length l1) l2. Proof. intros Hlen Hvalid. apply list_dist_lookup=> i. move: (Hvalid i). rewrite /to_max_prefix_list lookup_op !lookup_fmap !lookup_map_seq Nat.sub_0_r. rewrite !option_guard_True; [|lia..]. intros ?. rewrite lookup_app. destruct (l1 !! i) as [x1|] eqn:Hi1, (l2 !! i) as [x2|] eqn:Hi2; simpl in *. - f_equiv. symmetry. by apply to_agree_op_validN. - apply lookup_lt_Some in Hi1; apply lookup_ge_None in Hi2. lia. - apply lookup_ge_None in Hi1. rewrite lookup_drop -Hi2. f_equiv; lia. - apply lookup_ge_None in Hi1. rewrite lookup_drop -Hi2. f_equiv; lia. Qed. Lemma to_max_prefix_list_op_validN n l1 l2 : ✓{n} (to_max_prefix_list l1 ⋅ to_max_prefix_list l2) ↔ (∃ l, l2 ≡{n}≡ l1 ++ l) ∨ (∃ l, l1 ≡{n}≡ l2 ++ l). Proof. split. - destruct (decide (length l1 ≤ length l2)). + left. eexists. by eapply to_max_prefix_list_op_validN_aux. + right. eexists. eapply to_max_prefix_list_op_validN_aux; [lia|by rewrite comm]. - intros [[l ->]|[l ->]]. + rewrite to_max_prefix_list_op_l; last by apply prefix_app_r. apply to_max_prefix_list_validN. + rewrite to_max_prefix_list_op_r; last by apply prefix_app_r. apply to_max_prefix_list_validN. Qed. Lemma to_max_prefix_list_op_valid l1 l2 : ✓ (to_max_prefix_list l1 ⋅ to_max_prefix_list l2) ↔ (∃ l, l2 ≡ l1 ++ l) ∨ (∃ l, l1 ≡ l2 ++ l). Proof. split. - destruct (decide (length l1 ≤ length l2)). + left. eexists. apply equiv_dist=> n'. by eapply to_max_prefix_list_op_validN_aux, cmra_valid_validN. + right. eexists. apply equiv_dist=> n'. by eapply to_max_prefix_list_op_validN_aux, cmra_valid_validN; [lia|by rewrite comm]. - intros [[l ->]|[l ->]]. + rewrite to_max_prefix_list_op_l; last by apply prefix_app_r. apply to_max_prefix_list_valid. + rewrite to_max_prefix_list_op_r; last by apply prefix_app_r. apply to_max_prefix_list_valid. Qed. Lemma to_max_prefix_list_op_valid_L `{!LeibnizEquiv A} l1 l2 : ✓ (to_max_prefix_list l1 ⋅ to_max_prefix_list l2) ↔ l1 `prefix_of` l2 ∨ l2 `prefix_of` l1. Proof. rewrite to_max_prefix_list_op_valid /prefix. naive_solver. Qed. Lemma max_prefix_list_local_update l1 l2 : l1 `prefix_of` l2 → (to_max_prefix_list l1, to_max_prefix_list l1) ~l~> (to_max_prefix_list l2, to_max_prefix_list l2). Proof. intros [l ->]. rewrite to_max_prefix_list_app (comm _ (to_max_prefix_list l1)). apply op_local_update=> n _. rewrite comm -to_max_prefix_list_app. apply to_max_prefix_list_validN. Qed. End max_prefix_list. Definition max_prefix_listURF (F : oFunctor) : urFunctor := gmapURF nat (agreeRF F). Global Instance max_prefix_listURF_contractive F : oFunctorContractive F → urFunctorContractive (max_prefix_listURF F). Proof. apply _. Qed. Definition max_prefix_listRF (F : oFunctor) : rFunctor := gmapRF nat (agreeRF F). Global Instance max_prefix_listRF_contractive F : oFunctorContractive F → rFunctorContractive (max_prefix_listRF F). Proof. apply _. Qed. iris-iris-4.2.0/iris/algebra/monoid.v000066400000000000000000000052121460620107300174450ustar00rootroot00000000000000From iris.algebra Require Export ofe. From iris.prelude Require Import options. (** The Monoid class that is used for generic big operators in the file [algebra/big_op]. The operation is an argument because we want to have multiple monoids over the same type (for example, on [uPred]s we have monoids for [∗], [∧], and [∨]). However, we do bundle the unit because: - If we would not, it would appear explicitly in an argument of the big operators, which confuses rewrite. Now it is hidden in the class, and hence rewrite won't even see it. - The unit is unique. We could in principle have big ops over setoids instead of OFEs. However, since we do not have a canonical structure for setoids, we do not go that way. Note that we do not declare any of the projections as type class instances. That is because we only need them in the [big_op] file, and nowhere else. Hence, we declare these instances locally there to avoid them being used elsewhere. *) Class Monoid {M : ofe} (o : M → M → M) := { monoid_unit : M; monoid_ne : NonExpansive2 o; monoid_assoc : Assoc (≡) o; monoid_comm : Comm (≡) o; monoid_left_id : LeftId (≡) monoid_unit o; }. Lemma monoid_proper {M : ofe} {o : M → M → M} `{!Monoid o} : Proper ((≡) ==> (≡) ==> (≡)) o. Proof. apply ne_proper_2, monoid_ne. Qed. Lemma monoid_right_id {M : ofe} {o : M → M → M} `{!Monoid o} : RightId (≡) monoid_unit o. Proof. intros x. etrans; [apply monoid_comm|apply monoid_left_id]. Qed. (** The [Homomorphism] classes give rise to generic lemmas about big operators commuting with each other. We also consider a [WeakMonoidHomomorphism] which does not necessarily commute with unit; an example is the [own] connective: we only have `True ==∗ own γ ∅`, not `True ↔ own γ ∅`. *) Class WeakMonoidHomomorphism {M1 M2 : ofe} (o1 : M1 → M1 → M1) (o2 : M2 → M2 → M2) `{!Monoid o1, !Monoid o2} (R : relation M2) (f : M1 → M2) := { monoid_homomorphism_rel_po : PreOrder R; monoid_homomorphism_rel_proper : Proper ((≡) ==> (≡) ==> iff) R; monoid_homomorphism_op_proper : Proper (R ==> R ==> R) o2; monoid_homomorphism_ne : NonExpansive f; monoid_homomorphism x y : R (f (o1 x y)) (o2 (f x) (f y)) }. Class MonoidHomomorphism {M1 M2 : ofe} (o1 : M1 → M1 → M1) (o2 : M2 → M2 → M2) `{!Monoid o1, !Monoid o2} (R : relation M2) (f : M1 → M2) := { #[global] monoid_homomorphism_weak :: WeakMonoidHomomorphism o1 o2 R f; monoid_homomorphism_unit : R (f monoid_unit) monoid_unit }. Lemma weak_monoid_homomorphism_proper `{WeakMonoidHomomorphism M1 M2 o1 o2 R f} : Proper ((≡) ==> (≡)) f. Proof. apply ne_proper, monoid_homomorphism_ne. Qed. iris-iris-4.2.0/iris/algebra/mra.v000066400000000000000000000144301460620107300167410ustar00rootroot00000000000000From iris.algebra Require Export cmra. From iris.algebra Require Import updates local_updates. From iris.prelude Require Import options. (** Given a preorder [R] on a type [A] we construct the "monotone" resource algebra [mra R] and an injection [to_mra : A → mra R] such that: [R x y] iff [to_mra x ≼ to_mra y] Here, [≼] is the extension order of the [mra R] resource algebra. This is exactly what the lemma [to_mra_included] shows. This resource algebra is useful for reasoning about monotonicity. See the following paper for more details ([to_mra] is called "principal"): Reasoning About Monotonicity in Separation Logic Amin Timany and Lars Birkedal in Certified Programs and Proofs (CPP) 2021 Note that unlike most Iris algebra constructions [mra A] works on [A : Type], not on [A : ofe]. See the comment at [mraO] below for more information. If [A] has an [Equiv A] (i.e., is a setoid), there are some results at the bottom of this file. *) Record mra {A} (R : relation A) := { mra_car : list A }. Definition to_mra {A} {R : relation A} (a : A) : mra R := {| mra_car := [a] |}. Global Arguments mra_car {_ _} _. Section mra. Context {A} {R : relation A}. Implicit Types a b : A. Implicit Types x y : mra R. (** Pronounced [a] is below [x]. *) Local Definition mra_below (a : A) (x : mra R) := ∃ b, b ∈ mra_car x ∧ R a b. Local Lemma mra_below_to_mra a b : mra_below a (to_mra b) ↔ R a b. Proof. set_solver. Qed. (* OFE *) Local Instance mra_equiv : Equiv (mra R) := λ x y, ∀ a, mra_below a x ↔ mra_below a y. Local Instance mra_equiv_equiv : Equivalence mra_equiv. Proof. unfold mra_equiv; split; intros ?; naive_solver. Qed. (** Generalizing [mra A] to [A : ofe] and [R : A -n> A -n> siProp] is not obvious. It is not clear what axioms to impose on [R] for the "extension axiom" to hold: cmra_extend : x ≡{n}≡ y1 ⋅ y2 → ∃ z1 z2, x ≡ z1 ⋅ z2 ∧ y1 ≡{n}≡ z1 ∧ y2 ≡{n}≡ z2 To prove this, assume ([⋅] is defined as [++], see [mra_op]): x ≡{n}≡ y1 ++ y2 When defining [dist] as the step-indexed version of [mra_equiv], this means: ∀ n' a, n' ≤ n → mra_below a x n' ↔ mra_below a y1 n' ∨ mra_below a y2 n' From this assumption it is not clear how to obtain witnesses [z1] and [z2]. *) Canonical Structure mraO := discreteO (mra R). (* CMRA *) Local Instance mra_valid : Valid (mra R) := λ x, True. Local Instance mra_validN : ValidN (mra R) := λ n x, True. Local Program Instance mra_op : Op (mra R) := λ x y, {| mra_car := mra_car x ++ mra_car y |}. Local Instance mra_pcore : PCore (mra R) := Some. Lemma mra_cmra_mixin : CmraMixin (mra R). Proof. apply discrete_cmra_mixin; first apply _. apply ra_total_mixin; try done. - (* [Proper] of [op] *) intros x y z Hyz a. specialize (Hyz a). set_solver. - (* [Proper] of [core] *) apply _. - (* [Assoc] *) intros x y z a. set_solver. - (* [Comm] *) intros x y a. set_solver. - (* [core x ⋅ x ≡ x] *) intros x a. set_solver. Qed. Canonical Structure mraR : cmra := Cmra (mra R) mra_cmra_mixin. Global Instance mra_cmra_total : CmraTotal mraR. Proof. rewrite /CmraTotal; eauto. Qed. Global Instance mra_core_id x : CoreId x. Proof. by constructor. Qed. Global Instance mra_cmra_discrete : CmraDiscrete mraR. Proof. split; last done. intros ? ?; done. Qed. Local Instance mra_unit : Unit (mra R) := {| mra_car := [] |}. Lemma auth_ucmra_mixin : UcmraMixin (mra R). Proof. split; done. Qed. Canonical Structure mraUR := Ucmra (mra R) auth_ucmra_mixin. (* Laws *) Lemma mra_idemp x : x ⋅ x ≡ x. Proof. intros a. set_solver. Qed. Lemma mra_included x y : x ≼ y ↔ y ≡ x ⋅ y. Proof. split; [|by intros ?; exists y]. intros [z ->]; rewrite assoc mra_idemp; done. Qed. Lemma to_mra_R_op `{!Transitive R} a b : R a b → to_mra a ⋅ to_mra b ≡ to_mra b. Proof. intros Hab c. set_solver. Qed. Lemma to_mra_included `{!PreOrder R} a b : to_mra a ≼ to_mra b ↔ R a b. Proof. split. - move=> [z Hz]. specialize (Hz a). set_solver. - intros ?; exists (to_mra b). by rewrite to_mra_R_op. Qed. Lemma mra_local_update_grow `{!Transitive R} a x b: R a b → (to_mra a, x) ~l~> (to_mra b, to_mra b). Proof. intros Hana. apply local_update_unital_discrete=> z _ Habz. split; first done. intros c. specialize (Habz c). set_solver. Qed. Lemma mra_local_update_get_frag `{!PreOrder R} a b: R b a → (to_mra a, ε) ~l~> (to_mra a, to_mra b). Proof. intros Hana. apply local_update_unital_discrete=> z _. rewrite left_id. intros <-. split; first done. apply mra_included; by apply to_mra_included. Qed. End mra. Global Arguments mraO {_} _. Global Arguments mraR {_} _. Global Arguments mraUR {_} _. (** If [R] is a partial order, relative to a reflexive relation [S] on the carrier [A], then [to_mra] is proper and injective. The theory for arbitrary relations [S] is overly general, so we do not declare the results as instances. Below we provide instances for [S] being [=] and [≡]. *) Section mra_over_rel. Context {A} {R : relation A} (S : relation A). Implicit Types a b : A. Implicit Types x y : mra R. Lemma to_mra_rel_proper : Reflexive S → Proper (S ==> S ==> iff) R → Proper (S ==> (≡@{mra R})) (to_mra). Proof. intros ? HR a1 a2 Ha b. rewrite !mra_below_to_mra. by apply HR. Qed. Lemma to_mra_rel_inj : Reflexive R → AntiSymm S R → Inj S (≡@{mra R}) (to_mra). Proof. intros ?? a b Hab. move: (Hab a) (Hab b). rewrite !mra_below_to_mra. intros. apply (anti_symm R); naive_solver. Qed. End mra_over_rel. Global Instance to_mra_inj {A} {R : relation A} : Reflexive R → AntiSymm (=) R → Inj (=) (≡@{mra R}) (to_mra) | 0. (* Lower cost than [to_mra_equiv_inj] *) Proof. intros. by apply (to_mra_rel_inj (=)). Qed. Global Instance to_mra_proper `{Equiv A} {R : relation A} : Reflexive (≡@{A}) → Proper ((≡) ==> (≡) ==> iff) R → Proper ((≡) ==> (≡@{mra R})) (to_mra). Proof. intros. by apply (to_mra_rel_proper (≡)). Qed. Global Instance to_mra_equiv_inj `{Equiv A} {R : relation A} : Reflexive R → AntiSymm (≡) R → Inj (≡) (≡@{mra R}) (to_mra) | 1. Proof. intros. by apply (to_mra_rel_inj (≡)). Qed. iris-iris-4.2.0/iris/algebra/numbers.v000066400000000000000000000256361460620107300176470ustar00rootroot00000000000000From iris.algebra Require Export cmra local_updates proofmode_classes. From iris.prelude Require Import options. (** ** Natural numbers with [add] as the operation. *) Section nat. Local Instance nat_valid_instance : Valid nat := λ x, True. Local Instance nat_validN_instance : ValidN nat := λ n x, True. Local Instance nat_pcore_instance : PCore nat := λ x, Some 0. Local Instance nat_op_instance : Op nat := plus. Definition nat_op x y : x ⋅ y = x + y := eq_refl. Lemma nat_included (x y : nat) : x ≼ y ↔ x ≤ y. Proof. by rewrite Nat.le_sum. Qed. Lemma nat_ra_mixin : RAMixin nat. Proof. apply ra_total_mixin; try by eauto. - solve_proper. - intros x y z. apply Nat.add_assoc. - intros x y. apply Nat.add_comm. - by exists 0. Qed. Canonical Structure natR : cmra := discreteR nat nat_ra_mixin. Global Instance nat_cmra_discrete : CmraDiscrete natR. Proof. apply discrete_cmra_discrete. Qed. Local Instance nat_unit_instance : Unit nat := 0. Lemma nat_ucmra_mixin : UcmraMixin nat. Proof. split; apply _ || done. Qed. Canonical Structure natUR : ucmra := Ucmra nat nat_ucmra_mixin. Global Instance nat_cancelable (x : nat) : Cancelable x. Proof. by intros ???? ?%Nat.add_cancel_l. Qed. Lemma nat_local_update (x y x' y' : nat) : (** Morally [x - y = x' - y']: the difference between auth and frag must stay the same with this update. Written using [+] due to underflow. *) x + y' = x' + y → (x,y) ~l~> (x',y'). Proof. intros ??; apply local_update_unital_discrete=> z _. compute -[minus plus]; lia. Qed. (* This one has a higher precendence than [is_op_op] so we get a [+] instead of an [⋅]. *) Global Instance nat_is_op (n1 n2 : nat) : IsOp (n1 + n2) n1 n2. Proof. done. Qed. End nat. (** ** Natural numbers with [max] as the operation. *) Record max_nat := MaxNat { max_nat_car : nat }. Add Printing Constructor max_nat. Canonical Structure max_natO := leibnizO max_nat. Section max_nat. Local Instance max_nat_unit_instance : Unit max_nat := MaxNat 0. Local Instance max_nat_valid_instance : Valid max_nat := λ x, True. Local Instance max_nat_validN_instance : ValidN max_nat := λ n x, True. Local Instance max_nat_pcore_instance : PCore max_nat := Some. Local Instance max_nat_op_instance : Op max_nat := λ n m, MaxNat (max_nat_car n `max` max_nat_car m). Definition max_nat_op x y : MaxNat x ⋅ MaxNat y = MaxNat (x `max` y) := eq_refl. Lemma max_nat_included x y : x ≼ y ↔ max_nat_car x ≤ max_nat_car y. Proof. split. - intros [z ->]. simpl. lia. - exists y. rewrite /op /max_nat_op_instance. rewrite Nat.max_r; last lia. by destruct y. Qed. Lemma max_nat_ra_mixin : RAMixin max_nat. Proof. apply ra_total_mixin; apply _ || eauto. - intros [x] [y] [z]. repeat rewrite max_nat_op. by rewrite Nat.max_assoc. - intros [x] [y]. by rewrite max_nat_op Nat.max_comm. - intros [x]. by rewrite max_nat_op Nat.max_id. Qed. Canonical Structure max_natR : cmra := discreteR max_nat max_nat_ra_mixin. Global Instance max_nat_cmra_discrete : CmraDiscrete max_natR. Proof. apply discrete_cmra_discrete. Qed. Lemma max_nat_ucmra_mixin : UcmraMixin max_nat. Proof. split; try apply _ || done. intros [x]. done. Qed. Canonical Structure max_natUR : ucmra := Ucmra max_nat max_nat_ucmra_mixin. Global Instance max_nat_core_id (x : max_nat) : CoreId x. Proof. by constructor. Qed. Lemma max_nat_local_update (x y x' : max_nat) : max_nat_car x ≤ max_nat_car x' → (x,y) ~l~> (x',x'). Proof. move: x y x' => [x] [y] [y'] /= ?. rewrite local_update_unital_discrete=> [[z]] _. rewrite 2!max_nat_op. intros [= ?]. split; first done. apply f_equal. lia. Qed. Global Instance : IdemP (=@{max_nat}) (⋅). Proof. intros [x]. rewrite max_nat_op. apply f_equal. lia. Qed. Global Instance max_nat_is_op (x y : nat) : IsOp (MaxNat (x `max` y)) (MaxNat x) (MaxNat y). Proof. done. Qed. End max_nat. (** ** Natural numbers with [min] as the operation. *) Record min_nat := MinNat { min_nat_car : nat }. Add Printing Constructor min_nat. Canonical Structure min_natO := leibnizO min_nat. Section min_nat. Local Instance min_nat_valid_instance : Valid min_nat := λ x, True. Local Instance min_nat_validN_instance : ValidN min_nat := λ n x, True. Local Instance min_nat_pcore_instance : PCore min_nat := Some. Local Instance min_nat_op_instance : Op min_nat := λ n m, MinNat (min_nat_car n `min` min_nat_car m). Definition min_nat_op_min x y : MinNat x ⋅ MinNat y = MinNat (x `min` y) := eq_refl. Lemma min_nat_included (x y : min_nat) : x ≼ y ↔ min_nat_car y ≤ min_nat_car x. Proof. split. - intros [z ->]. simpl. lia. - exists y. rewrite /op /min_nat_op_instance. rewrite Nat.min_r; last lia. by destruct y. Qed. Lemma min_nat_ra_mixin : RAMixin min_nat. Proof. apply ra_total_mixin; apply _ || eauto. - intros [x] [y] [z]. repeat rewrite min_nat_op_min. by rewrite Nat.min_assoc. - intros [x] [y]. by rewrite min_nat_op_min Nat.min_comm. - intros [x]. by rewrite min_nat_op_min Nat.min_id. Qed. Canonical Structure min_natR : cmra := discreteR min_nat min_nat_ra_mixin. Global Instance min_nat_cmra_discrete : CmraDiscrete min_natR. Proof. apply discrete_cmra_discrete. Qed. Global Instance min_nat_core_id (x : min_nat) : CoreId x. Proof. by constructor. Qed. Lemma min_nat_local_update (x y x' : min_nat) : min_nat_car x' ≤ min_nat_car x → (x,y) ~l~> (x',x'). Proof. move: x y x' => [x] [y] [x'] /= ?. rewrite local_update_discrete. move=> [[z]|] _ /=; last done. rewrite 2!min_nat_op_min. intros [= ?]. split; first done. apply f_equal. lia. Qed. Global Instance : LeftAbsorb (=) (MinNat 0) (⋅). Proof. done. Qed. Global Instance : RightAbsorb (=) (MinNat 0) (⋅). Proof. intros [x]. by rewrite min_nat_op_min Nat.min_0_r. Qed. Global Instance : IdemP (=@{min_nat}) (⋅). Proof. intros [x]. rewrite min_nat_op_min. apply f_equal. lia. Qed. Global Instance min_nat_is_op (x y : nat) : IsOp (MinNat (x `min` y)) (MinNat x) (MinNat y). Proof. done. Qed. End min_nat. (** ** Positive integers with [Pos.add] as the operation. *) Section positive. Local Instance pos_valid_instance : Valid positive := λ x, True. Local Instance pos_validN_instance : ValidN positive := λ n x, True. Local Instance pos_pcore_instance : PCore positive := λ x, None. Local Instance pos_op_instance : Op positive := Pos.add. Definition pos_op_add x y : x ⋅ y = (x + y)%positive := eq_refl. Lemma pos_included (x y : positive) : x ≼ y ↔ (x < y)%positive. Proof. by rewrite Pos.lt_sum. Qed. Lemma pos_ra_mixin : RAMixin positive. Proof. split; try by eauto. - by intros ??? ->. - intros ???. apply Pos.add_assoc. - intros ??. apply Pos.add_comm. Qed. Canonical Structure positiveR : cmra := discreteR positive pos_ra_mixin. Global Instance pos_cmra_discrete : CmraDiscrete positiveR. Proof. apply discrete_cmra_discrete. Qed. Global Instance pos_cancelable (x : positive) : Cancelable x. Proof. intros n y z ??. by eapply Pos.add_reg_l, leibniz_equiv. Qed. Global Instance pos_id_free (x : positive) : IdFree x. Proof. intros y ??. apply (Pos.add_no_neutral x y). rewrite Pos.add_comm. by apply leibniz_equiv. Qed. (* This one has a higher precendence than [is_op_op] so we get a [+] instead of an [⋅]. *) Global Instance pos_is_op (x y : positive) : IsOp (x + y)%positive x y. Proof. done. Qed. End positive. (** ** Integers (positive and negative) with [Z.add] as the operation. *) Section Z. Local Open Scope Z_scope. Local Instance Z_valid_instance : Valid Z := λ x, True. Local Instance Z_validN_instance : ValidN Z := λ n x, True. Local Instance Z_pcore_instance : PCore Z := λ x, Some 0. Local Instance Z_op_instance : Op Z := Z.add. Definition Z_op x y : x ⋅ y = x + y := eq_refl. Lemma Z_ra_mixin : RAMixin Z. Proof. apply ra_total_mixin; try by eauto. - solve_proper. - intros x y z. apply Z.add_assoc. - intros x y. apply Z.add_comm. - by exists 0. Qed. Canonical Structure ZR : cmra := discreteR Z Z_ra_mixin. Global Instance Z_cmra_discrete : CmraDiscrete ZR. Proof. apply discrete_cmra_discrete. Qed. Local Instance Z_unit_instance : Unit Z := 0. Lemma Z_ucmra_mixin : UcmraMixin Z. Proof. split; apply _ || done. Qed. Canonical Structure ZUR : ucmra := Ucmra Z Z_ucmra_mixin. Global Instance Z_cancelable (x : Z) : Cancelable x. Proof. by intros ???? ?%Z.add_cancel_l. Qed. (** The difference between auth and frag must stay the same with this update. *) Lemma Z_local_update (x y x' y' : Z) : x - y = x' - y' → (x,y) ~l~> (x',y'). Proof. intros. rewrite local_update_unital_discrete=> z _. compute -[Z.sub Z.add]; lia. Qed. (* This one has a higher precendence than [is_op_op] so we get a [+] instead of an [⋅]. *) Global Instance Z_is_op (n1 n2 : Z) : IsOp (n1 + n2) n1 n2. Proof. done. Qed. End Z. (** ** Integers (positive and negative) with [Z.max] as the operation. *) Record max_Z := MaxZ { max_Z_car : Z }. Add Printing Constructor max_Z. Canonical Structure max_ZO := leibnizO max_Z. Section max_Z. Local Open Scope Z_scope. Local Instance max_Z_unit_instance : Unit max_Z := MaxZ 0. Local Instance max_Z_valid_instance : Valid max_Z := λ x, True. Local Instance max_Z_validN_instance : ValidN max_Z := λ n x, True. Local Instance max_Z_pcore_instance : PCore max_Z := Some. Local Instance max_Z_op_instance : Op max_Z := λ n m, MaxZ (max_Z_car n `max` max_Z_car m). Definition max_Z_op x y : MaxZ x ⋅ MaxZ y = MaxZ (x `max` y) := eq_refl. Lemma max_Z_included x y : x ≼ y ↔ max_Z_car x ≤ max_Z_car y. Proof. split. - intros [z ->]. simpl. lia. - exists y. rewrite /op /max_Z_op_instance. rewrite Z.max_r; last lia. by destruct y. Qed. Lemma max_Z_ra_mixin : RAMixin max_Z. Proof. apply ra_total_mixin; apply _ || eauto. - intros [x] [y] [z]. repeat rewrite max_Z_op. by rewrite Z.max_assoc. - intros [x] [y]. by rewrite max_Z_op Z.max_comm. - intros [x]. by rewrite max_Z_op Z.max_id. Qed. Canonical Structure max_ZR : cmra := discreteR max_Z max_Z_ra_mixin. Global Instance max_Z_cmra_total : CmraTotal max_ZR. Proof. intros x. eauto. Qed. Global Instance max_Z_cmra_discrete : CmraDiscrete max_ZR. Proof. apply discrete_cmra_discrete. Qed. Global Instance max_Z_core_id (x : max_Z) : CoreId x. Proof. by constructor. Qed. Lemma max_Z_local_update (x y x' : max_Z) : max_Z_car x ≤ max_Z_car x' → (x,y) ~l~> (x',x'). Proof. move: x y x' => [x] [y] [y'] /= ?. rewrite local_update_discrete=> [[[z]|]] //= _ [?]. split; first done. rewrite max_Z_op. f_equal. lia. Qed. Global Instance : IdemP (=@{max_Z}) (⋅). Proof. intros [x]. rewrite max_Z_op. apply f_equal. lia. Qed. Global Instance max_Z_is_op (x y : nat) : IsOp (MaxZ (x `max` y)) (MaxZ x) (MaxZ y). Proof. done. Qed. End max_Z. iris-iris-4.2.0/iris/algebra/ofe.v000066400000000000000000002372021460620107300167370ustar00rootroot00000000000000From iris.prelude Require Export prelude. From iris.prelude Require Import options. Local Set Primitive Projections. (** This files defines (a shallow embedding of) the category of OFEs: Complete ordered families of equivalences. This is a cartesian closed category, and mathematically speaking, the entire development lives in this category. However, we will generally prefer to work with raw Coq functions plus some registered Proper instances for non-expansiveness. This makes writing such functions much easier. It turns out that it many cases, we do not even need non-expansiveness. *) (** The tactic [si_solver] solves goals that are solely concerned with step-indices and their relations (i.e., [0], [S n], [n < m], and [n ≤ m]). Currently, this tactic is just an alias for [lia]. However, in the future, Iris will generalize over the type of step-indices, and this tactic will be able to solve step-indexing goals also in this generalized setting. The tactic can be used as part of [eauto] by using the hint database [si_solver]. *) Ltac si_solver := lia. Create HintDb si_solver. Global Hint Extern 1 => si_solver : si_solver. (** Unbundled version *) Class Dist A := dist : nat → relation A. Global Hint Mode Dist ! : typeclass_instances. Global Instance: Params (@dist) 3 := {}. Notation "x ≡{ n }≡ y" := (dist n x y) (at level 70, n at next level, format "x ≡{ n }≡ y"). Notation "x ≡{ n }@{ A }≡ y" := (dist (A:=A) n x y) (at level 70, n at next level, only parsing). Notation "(≡{ n }≡)" := (dist n) (only parsing). Notation "(≡{ n }@{ A }≡)" := (dist (A:=A) n) (only parsing). Notation "( x ≡{ n }≡.)" := (dist n x) (only parsing). Notation "(.≡{ n }≡ y )" := (λ x, x ≡{n}≡ y) (only parsing). Global Hint Extern 0 (_ ≡{_}≡ _) => reflexivity : core. Global Hint Extern 0 (_ ≡{_}≡ _) => symmetry; assumption : core. Notation NonExpansive f := (∀ n, Proper (dist n ==> dist n) f). Notation NonExpansive2 f := (∀ n, Proper (dist n ==> dist n ==> dist n) f). Notation NonExpansive3 f := (∀ n, Proper (dist n ==> dist n ==> dist n ==> dist n) f). Notation NonExpansive4 f := (∀ n, Proper (dist n ==> dist n ==> dist n ==> dist n ==> dist n) f). Tactic Notation "ofe_subst" ident(x) := repeat match goal with | _ => progress simplify_eq/= | H:@dist ?A ?d ?n x _ |- _ => setoid_subst_aux (@dist A d n) x | H:@dist ?A ?d ?n _ x |- _ => symmetry in H;setoid_subst_aux (@dist A d n) x end. Tactic Notation "ofe_subst" := repeat match goal with | _ => progress simplify_eq/= | H:@dist ?A ?d ?n ?x _ |- _ => setoid_subst_aux (@dist A d n) x | H:@dist ?A ?d ?n _ ?x |- _ => symmetry in H;setoid_subst_aux (@dist A d n) x end. Record OfeMixin A `{Equiv A, Dist A} := { mixin_equiv_dist (x y : A) : x ≡ y ↔ ∀ n, x ≡{n}≡ y; mixin_dist_equivalence n : Equivalence (@dist A _ n); mixin_dist_lt n m (x y : A) : x ≡{n}≡ y → m < n → x ≡{m}≡ y; }. (** Bundled version *) Structure ofe := Ofe { ofe_car :> Type; ofe_equiv : Equiv ofe_car; ofe_dist : Dist ofe_car; ofe_mixin : OfeMixin ofe_car }. Global Arguments Ofe _ {_ _} _. Add Printing Constructor ofe. (* FIXME(Coq #6294) : we need the new unification algorithm here. *) Global Hint Extern 0 (Equiv _) => refine (ofe_equiv _); shelve : typeclass_instances. Global Hint Extern 0 (Dist _) => refine (ofe_dist _); shelve : typeclass_instances. Global Arguments ofe_car : simpl never. Global Arguments ofe_equiv : simpl never. Global Arguments ofe_dist : simpl never. Global Arguments ofe_mixin : simpl never. (** When declaring instances of subclasses of OFE (like CMRAs and unital CMRAs) we need Coq to *infer* the canonical OFE instance of a given type and take the mixin out of it. This makes sure we do not use two different OFE instances in different places (see for example the constructors [Cmra] and [Ucmra] in the file [cmra.v].) In order to infer the OFE instance, we use the definition [ofe_mixin_of'] which is inspired by the [clone] trick in ssreflect. It works as follows, when type checking [@ofe_mixin_of' A ?Ac id] Coq faces a unification problem: ofe_car ?Ac ~ A which will resolve [?Ac] to the canonical OFE instance corresponding to [A]. The definition [@ofe_mixin_of' A ?Ac id] will then provide the corresponding mixin. Note that type checking of [ofe_mixin_of' A id] will fail when [A] does not have a canonical OFE instance. The notation [ofe_mixin_of A] that we define on top of [ofe_mixin_of' A id] hides the [id] and normalizes the mixin to head normal form. The latter is to ensure that we do not end up with redundant canonical projections to the mixin, i.e. them all being of the shape [ofe_mixin_of' A id]. *) Definition ofe_mixin_of' A {Ac : ofe} (f : Ac → A) : OfeMixin Ac := ofe_mixin Ac. Notation ofe_mixin_of A := ltac:(let H := eval hnf in (ofe_mixin_of' A id) in exact H) (only parsing). (** Lifting properties from the mixin *) Section ofe_mixin. Context {A : ofe}. Implicit Types x y : A. Lemma equiv_dist x y : x ≡ y ↔ ∀ n, x ≡{n}≡ y. Proof. apply (mixin_equiv_dist _ (ofe_mixin A)). Qed. Global Instance dist_equivalence n : Equivalence (@dist A _ n). Proof. apply (mixin_dist_equivalence _ (ofe_mixin A)). Qed. Lemma dist_lt n m x y : x ≡{n}≡ y → m < n → x ≡{m}≡ y. Proof. apply (mixin_dist_lt _ (ofe_mixin A)). Qed. End ofe_mixin. Global Hint Extern 1 (_ ≡{_}≡ _) => apply equiv_dist; assumption : core. (** Discrete OFEs and discrete OFE elements *) Class Discrete {A : ofe} (x : A) := discrete_0 y : x ≡{0}≡ y → x ≡ y. Global Arguments discrete_0 {_} _ {_} _ _. Global Hint Mode Discrete + ! : typeclass_instances. Global Instance: Params (@Discrete) 1 := {}. Class OfeDiscrete (A : ofe) := #[global] ofe_discrete_discrete (x : A) :: Discrete x. Global Hint Mode OfeDiscrete ! : typeclass_instances. (** OFEs with a completion *) Record chain (A : ofe) := { chain_car :> nat → A; chain_cauchy n i : n ≤ i → chain_car i ≡{n}≡ chain_car n }. Global Arguments chain_car {_} _ _. Global Arguments chain_cauchy {_} _ _ _ _. Program Definition chain_map {A B : ofe} (f : A → B) `{!NonExpansive f} (c : chain A) : chain B := {| chain_car n := f (c n) |}. Next Obligation. by intros A B f Hf c n i ?; apply Hf, chain_cauchy. Qed. Notation Compl A := (chain A%type → A). Class Cofe (A : ofe) := { compl : Compl A; conv_compl n c : compl c ≡{n}≡ c n; }. Global Arguments compl : simpl never. Global Hint Mode Cofe ! : typeclass_instances. Lemma compl_chain_map `{!Cofe A, !Cofe B} (f : A → B) c `(!NonExpansive f) : compl (chain_map f c) ≡ f (compl c). Proof. apply equiv_dist=>n. by rewrite !conv_compl. Qed. Program Definition chain_const {A : ofe} (a : A) : chain A := {| chain_car n := a |}. Next Obligation. by intros A a n i _. Qed. Lemma compl_chain_const {A : ofe} `{!Cofe A} (a : A) : compl (chain_const a) ≡ a. Proof. apply equiv_dist=>n. by rewrite conv_compl. Qed. (** General properties *) Section ofe. Context {A : ofe}. Implicit Types x y : A. Global Instance ofe_equivalence : Equivalence ((≡) : relation A). Proof. split. - by intros x; rewrite equiv_dist. - by intros x y; rewrite !equiv_dist. - by intros x y z; rewrite !equiv_dist; intros; trans y. Qed. Global Instance dist_ne n : Proper (dist n ==> dist n ==> iff) (@dist A _ n). Proof. intros x1 x2 ? y1 y2 ?; split; intros. - by trans x1; [|trans y1]. - by trans x2; [|trans y2]. Qed. Global Instance dist_proper n : Proper ((≡) ==> (≡) ==> iff) (@dist A _ n). Proof. by move => x1 x2 /equiv_dist Hx y1 y2 /equiv_dist Hy; rewrite (Hx n) (Hy n). Qed. Global Instance dist_proper_2 n x : Proper ((≡) ==> iff) (dist n x). Proof. by apply dist_proper. Qed. Global Instance Discrete_proper : Proper ((≡) ==> iff) (@Discrete A). Proof. intros x y Hxy. rewrite /Discrete. by setoid_rewrite Hxy. Qed. Lemma dist_le n n' x y : x ≡{n}≡ y → n' ≤ n → x ≡{n'}≡ y. Proof. intros ? [Hm | ->]%Nat.lt_eq_cases; [by eapply dist_lt | auto]. Qed. Lemma dist_le' n n' x y : n' ≤ n → x ≡{n}≡ y → x ≡{n'}≡ y. Proof. eauto using dist_le. Qed. Lemma dist_S n x y : x ≡{S n}≡ y → x ≡{n}≡ y. Proof. eauto using dist_le. Qed. (** [ne_proper] and [ne_proper_2] are not instances to improve efficiency of type class search during setoid rewriting. Local Instances of [NonExpansive{,2}] are hence accompanied by instances of [Proper] built using these lemmas. *) Lemma ne_proper {B : ofe} (f : A → B) `{!NonExpansive f} : Proper ((≡) ==> (≡)) f. Proof. by intros x1 x2; rewrite !equiv_dist; intros Hx n; rewrite (Hx n). Qed. Lemma ne_proper_2 {B C : ofe} (f : A → B → C) `{!NonExpansive2 f} : Proper ((≡) ==> (≡) ==> (≡)) f. Proof. unfold Proper, respectful; setoid_rewrite equiv_dist. by intros x1 x2 Hx y1 y2 Hy n; rewrite (Hx n) (Hy n). Qed. 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. lia. Qed. Lemma discrete_iff n (x : A) `{!Discrete x} y : x ≡ y ↔ x ≡{n}≡ y. Proof. split; intros; auto. apply (discrete_0 _), dist_le with n; auto with lia. Qed. Lemma discrete_iff_0 n (x : A) `{!Discrete x} y : x ≡{0}≡ y ↔ x ≡{n}≡ y. Proof. by rewrite -!discrete_iff. Qed. Lemma discrete n (x : A) `{!Discrete x} y : x ≡{n}≡ y → x ≡ y. Proof. intros. eapply discrete_iff; done. Qed. Global Instance ofe_discrete_subrelation `{!OfeDiscrete A} n : @SolveProperSubrelation A (dist n) (≡). Proof. intros ???. apply: discrete. done. Qed. Global Instance ofe_leibniz_subrelation `{!OfeDiscrete A, !LeibnizEquiv A} n : @SolveProperSubrelation A (dist n) (=). Proof. intros ?? EQ. unfold_leibniz. apply (is_solve_proper_subrelation EQ). Qed. End ofe. (** Contractive functions *) (** Defined as a record to avoid eager unfolding. *) Record dist_later `{!Dist A} n (x y : A) : Prop := { dist_later_lt : ∀ m, m < n → x ≡{m}≡ y }. Section dist_later. Context {A : ofe}. Implicit Types x y : A. Global Instance dist_later_equivalence n : Equivalence (@dist_later A _ n). Proof. split. - intros ?; by split. - intros ?? [Hlater]; split; intros ??; by rewrite Hlater. - intros ??? [Hlater1] [Hlater2]; split; intros ??; by rewrite Hlater1 ?Hlater2. Qed. Lemma dist_dist_later n x y : dist n x y → dist_later n x y. Proof. intros. split; eauto using dist_le. Qed. Lemma dist_later_dist_lt n m x y : m < n → dist_later n x y → dist m x y. Proof. intros ? []; eauto. Qed. Lemma dist_later_0 x y : dist_later 0 x y. Proof. split; intros ? []%Nat.nlt_0_r. Qed. Lemma dist_later_S n x y: x ≡{n}≡ y ↔ dist_later (S n) x y. Proof. split. - intros Hn; split; intros m Hm. eapply dist_le; first done. lia. - intros Hdist. apply Hdist. lia. Qed. End dist_later. (* We don't actually need this lemma (as our tactics deal with this through other means), but technically speaking, this is the reason why pre-composing a non-expansive function to a contractive function preserves contractivity. *) Lemma ne_dist_later {A B : ofe} (f : A → B) : NonExpansive f → ∀ n, Proper (dist_later n ==> dist_later n) f. Proof. intros Hf ??? Hlater; split; intros ??; by eapply Hf, Hlater. Qed. (** We define [dist_later_fin], an equivalent (see dist_later_fin_iff) version of [dist_later] that uses a [match] on the step-index instead of the quantification over smaller step-indicies. The definition of [dist_later_fin] matches how [dist_later] used to be defined (i.e., with a [match] on the step-index), so [dist_later_fin] simplifies adapting existing Iris developments that used to rely on the reduction behavior of [dist_later]. The "fin" indicates that when, in the future, the step-index is abstracted away, this equivalence will only hold for finite step-indices (as in, ordinals without "limit" steps such as natural numbers). *) Definition dist_later_fin {A : ofe} (n : nat) (x y : A) := match n with 0 => True | S n => x ≡{n}≡ y end. Lemma dist_later_fin_iff {A : ofe} (n : nat) (x y : A): dist_later n x y ↔ dist_later_fin n x y. Proof. destruct n; unfold dist_later_fin; first by split; eauto using dist_later_0. by rewrite dist_later_S. Qed. Notation Contractive f := (∀ n, Proper (dist_later n ==> dist n) f). Global Instance const_contractive {A B : ofe} (x : A) : Contractive (@const A B x). Proof. by intros n y1 y2. Qed. Section contractive. Local Set Default Proof Using "Type*". Context {A B : ofe} (f : A → B) `{!Contractive f}. Implicit Types x y : A. Lemma contractive_0 x y : f x ≡{0}≡ f y. Proof. by apply (_ : Contractive f), dist_later_0. Qed. Lemma contractive_dist_later_dist n x y : dist_later n x y → f x ≡{n}≡ f y. Proof. intros. by apply (_ : Contractive f). Qed. Lemma contractive_S n x y : x ≡{n}≡ y → f x ≡{S n}≡ f y. Proof. intros. by apply contractive_dist_later_dist, dist_later_S. Qed. Global Instance contractive_ne : NonExpansive f | 100. Proof. intros n x y ?. eapply contractive_dist_later_dist. by apply dist_dist_later. Qed. Global Instance contractive_proper : Proper ((≡) ==> (≡)) f | 100. Proof. apply (ne_proper _). Qed. End contractive. Lemma dist_pointwise_lt {A} {B: ofe} n m (f g: A → B): m < n → pointwise_relation A (dist_later n) f g → pointwise_relation A (dist m) f g. Proof. intros Hlt Hp a. by apply Hp. Qed. (** The tactic [f_contractive] can be used to prove contractiveness or non-expansiveness of a function [f]. Inside of the proof of contractiveness/non-expansiveness, if the current goal is [g x1 ... xn ≡{i}≡ g y1 ... yn] for a contractive function [g] (that is used inside of the body of [f]), then the tactic will try to find a suitable [Contractive] instance for [g] and apply it. Currently, the tactic only supports one (i.e., [n = 1]) and two (i.e., [n = 2]) arguments. As a result of applying the [Contractive] instance for [g], one of the goals will be [dist_later i xi yi] and the tactic will try to simplify or solve the goal. By simplify we mean that it will turn hypotheses [dist_later] into [dist]. For backwards compatibility, we also define the tactic [f_contractive_fin] that works with an earlier definition of [dist_later] now called [dist_later_fin]. The new version of [f_contractive] is future proof with respect to generalizing the type of step-indices, while the old tactic relies crucially on the step-indices being [nat] and the reduction behavior of [dist_later]. The tactic [f_contractive_fin] simplifies backwards compatibility of existing Iris developments (e.g., RustBelt), that define custom notions of [dist] and [dist_later] but should be avoided if possible. The tactics [f_contractive] and [f_contractive_fin] are implemented using 1. [f_contractive_prepare] which looks up a [Contractive] looks at which function is being applied on both sides of a [dist], looks up the [Contractive] instance (or the equivalent for two arguments) and applies it. 2. [dist_later_intro] and [dist_later_fin_intro] which introduces the resulting goals with [dist_later n x y]/[dist_later_fin n x y]. The tactic [dist_later_intro] works with the normal definition of [dist_later] and is future compatible with generalizing the step-index beyond natural numbers. The tactic [dist_later_fin_intro] is a special case which only works for natural numbers as step-indicies. It changes [dist_later] to [dist_later_fin], which only makes sense on natural numbers. We keep [dist_later_fin_intro] around for backwards compatibility. *) Ltac f_contractive_prepare := match goal with | |- ?f _ ≡{_}≡ ?f _ => simple apply (_ : Proper (dist_later _ ==> dist _) f) | |- ?f _ _ ≡{_}≡ ?f _ _ => simple apply (_ : Proper (dist_later _ ==> _ ==> dist _) f) | |- ?f _ _ ≡{_}≡ ?f _ _ => simple apply (_ : Proper (_ ==> dist_later _ ==> dist _) f) end. (** For the goal [dist_later n x y], the tactic [dist_later_intro as m Hm] introduces a smaller step-index [Hm : m < n] and tries to lower assumptions in the context to [m] where possible. The arguments [m] and [Hm] can be omitted, in which case a fresh identifier is used. *) Tactic Notation "dist_later_intro" "as" ident(idxName) ident(ltName) := match goal with | |- dist_later ?n ?x ?y => constructor; intros idxName ltName; repeat match goal with | H: dist_later n _ _ |- _ => destruct H as [H]; specialize (H idxName ltName) as H | H: pointwise_relation _ (dist_later n) _ _ |- _ => apply (dist_pointwise_lt _ idxName _ _ ltName) in H end end. Tactic Notation "dist_later_intro" := let m := fresh "m" in let Hlt := fresh "Hlt" in dist_later_intro as m Hlt. (** For the goal [dist_later n x y], the tactic [dist_later_fin_intro] changes the goal to [dist_later_fin] and takes care of the case where [n=0], such that we are only left with the case where [n = S n'] for some [n']. Changing [dist_later] to [dist_later_fin] enables reduction and thus works better with custom versions of [dist] as used e.g. by LambdaRust. *) Ltac dist_later_fin_intro := match goal with | |- @dist_later ?A _ ?n ?x ?y => apply dist_later_fin_iff; destruct n as [|n]; [exact I|change (@dist A _ n x y)] end. (** We combine [f_contractive_prepare] and [dist_later_intro] into the [f_contractive] tactic. For all the goals not solved by [dist_later_intro] (i.e., the ones that are not [dist_later n x y]), we try reflexivity. Since reflexivity can be very expensive when unification fails, we use [fast_reflexivity]. *) Tactic Notation "f_contractive" "as" ident(idxName) ident(ltName) := f_contractive_prepare; try dist_later_intro as idxName ltName; try fast_reflexivity. Tactic Notation "f_contractive" := let m := fresh "m" in let Hlt := fresh "Hlt" in f_contractive as m Hlt. Tactic Notation "f_contractive_fin" := f_contractive_prepare; try dist_later_fin_intro; try fast_reflexivity. Ltac solve_contractive := solve_proper_core ltac:(fun _ => first [f_contractive | f_equiv]). (** Limit preserving predicates *) Class LimitPreserving `{!Cofe A} (P : A → Prop) : Prop := limit_preserving (c : chain A) : (∀ n, P (c n)) → P (compl c). Global Hint Mode LimitPreserving + + ! : typeclass_instances. Section limit_preserving. Context {A : ofe} `{!Cofe A}. (* These are not instances as they will never fire automatically... but they can still be helpful in proving things to be limit preserving. *) Lemma limit_preserving_ext (P Q : A → Prop) : (∀ x, P x ↔ Q x) → LimitPreserving P → LimitPreserving Q. Proof. intros HP Hlimit c ?. apply HP, Hlimit=> n; by apply HP. Qed. Global Instance limit_preserving_const (P : Prop) : LimitPreserving (λ _ : A, P). Proof. intros c HP. apply (HP 0). Qed. Lemma limit_preserving_discrete (P : A → Prop) : Proper (dist 0 ==> impl) P → LimitPreserving P. Proof. intros PH c Hc. by rewrite (conv_compl 0). Qed. Lemma limit_preserving_and (P1 P2 : A → Prop) : LimitPreserving P1 → LimitPreserving P2 → LimitPreserving (λ x, P1 x ∧ P2 x). Proof. intros Hlim1 Hlim2 c Hc. split. - apply Hlim1, Hc. - apply Hlim2, Hc. Qed. Lemma limit_preserving_impl (P1 P2 : A → Prop) : Proper (dist 0 ==> impl) P1 → LimitPreserving P2 → LimitPreserving (λ x, P1 x → P2 x). Proof. intros Hlim1 Hlim2 c Hc HP1. apply Hlim2=> n; apply Hc. eapply Hlim1, HP1. apply dist_le with n; last lia. apply (conv_compl n). Qed. (** This is strictly weaker than the [_impl] variant, but sometimes automation is better at proving [Proper] for [iff] than for [impl]. *) Lemma limit_preserving_impl' (P1 P2 : A → Prop) : Proper (dist 0 ==> iff) P1 → LimitPreserving P2 → LimitPreserving (λ x, P1 x → P2 x). Proof. intros HP1. apply limit_preserving_impl. intros ???. apply iff_impl_subrelation. eapply HP1. done. Qed. Lemma limit_preserving_forall {B} (P : B → A → Prop) : (∀ y, LimitPreserving (P y)) → LimitPreserving (λ x, ∀ y, P y x). Proof. intros Hlim c Hc y. by apply Hlim. Qed. Lemma limit_preserving_equiv `{!Cofe B} (f g : A → B) : NonExpansive f → NonExpansive g → LimitPreserving (λ x, f x ≡ g x). Proof. intros Hf Hg c Hc. apply equiv_dist=> n. by rewrite -!compl_chain_map !conv_compl /= Hc. Qed. End limit_preserving. (** Fixpoint *) Program Definition fixpoint_chain {A : ofe} `{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 lia. - apply (contractive_0 f). - apply (contractive_S f), IH; auto with lia. Qed. Local Program Definition fixpoint_def `{Cofe A, Inhabited A} (f : A → A) `{!Contractive f} : A := compl (fixpoint_chain f). Local Definition fixpoint_aux : seal (@fixpoint_def). Proof. by eexists. Qed. Definition fixpoint := fixpoint_aux.(unseal). Global Arguments fixpoint {A _ _} f {_}. Local Definition fixpoint_unseal : @fixpoint = @fixpoint_def := fixpoint_aux.(seal_eq). Section fixpoint. Context `{!Cofe A, !Inhabited A} (f : A → A) `{!Contractive f}. (** This lemma does not work well with [rewrite]; we usually define a specific unfolding lemma for each fixpoint and then [apply fixpoint_unfold] in the proof of that unfolding lemma. *) Lemma fixpoint_unfold : fixpoint f ≡ f (fixpoint f). Proof. apply equiv_dist=>n. rewrite fixpoint_unseal /fixpoint_def (conv_compl n (fixpoint_chain f)) //. induction n as [|n IH]; simpl; eauto using contractive_0, contractive_S. Qed. Lemma fixpoint_unique (x : A) : x ≡ f x → x ≡ fixpoint f. Proof. rewrite !equiv_dist=> Hx n. induction n as [|n IH]; simpl in *. - rewrite Hx fixpoint_unfold; eauto using contractive_0. - rewrite Hx fixpoint_unfold. eauto using contractive_S. Qed. Lemma fixpoint_ne (g : A → A) `{!Contractive g} n : (∀ z, f z ≡{n}≡ g z) → fixpoint f ≡{n}≡ fixpoint g. Proof. intros Hfg. rewrite fixpoint_unseal /fixpoint_def (conv_compl n (fixpoint_chain f)) (conv_compl n (fixpoint_chain g)) /=. induction n as [|n IH]; simpl in *; [by rewrite !Hfg|]. rewrite Hfg; apply contractive_S, IH; eauto using dist_le with si_solver. Qed. Lemma fixpoint_proper (g : A → A) `{!Contractive g} : (∀ x, f x ≡ g x) → fixpoint f ≡ fixpoint g. Proof. setoid_rewrite equiv_dist; naive_solver eauto using fixpoint_ne. Qed. Lemma fixpoint_ind (P : A → Prop) : Proper ((≡) ==> impl) P → (∃ x, P x) → (∀ x, P x → P (f x)) → LimitPreserving P → P (fixpoint f). Proof. 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 si_solver. } set (fp2 := compl {| chain_cauchy := Hcauch |}). assert (f fp2 ≡ fp2). { apply equiv_dist=>n. rewrite /fp2 (conv_compl n) /= /chcar. induction n as [|n IH]; simpl; eauto using contractive_0, contractive_S. } rewrite -(fixpoint_unique fp2) //. apply Hlim=> n /=. by apply Nat.iter_ind. Qed. End fixpoint. (** Fixpoint of f when f^k is contractive. **) Definition fixpointK {A : ofe} `{!Cofe A, !Inhabited A} k (f : A → A) `{!Contractive (Nat.iter k f)} := fixpoint (Nat.iter k f). Section fixpointK. Local Set Default Proof Using "Type*". Context {A : ofe} `{!Cofe A, !Inhabited A} (f : A → A) (k : nat). Context {f_contractive : Contractive (Nat.iter k f)} {f_ne : NonExpansive f}. (* Note than f_ne is crucial here: there are functions f such that f^2 is contractive, but f is not non-expansive. Consider for example f: SPred → SPred (where SPred is "downclosed sets of natural numbers"). Define f (using informative excluded middle) as follows: f(N) = N (where N is the set of all natural numbers) f({0, ..., n}) = {0, ... n-1} if n is even (so n-1 is at least -1, in which case we return the empty set) f({0, ..., n}) = {0, ..., n+2} if n is odd In other words, if we consider elements of SPred as ordinals, then we decreaste odd finite ordinals by 1 and increase even finite ordinals by 2. f is not non-expansive: Consider f({0}) = ∅ and f({0,1}) = f({0,1,2,3}). The arguments are clearly 0-equal, but the results are not. Now consider g := f^2. We have g(N) = N g({0, ..., n}) = {0, ... n+1} if n is even g({0, ..., n}) = {0, ..., n+4} if n is odd g is contractive. All outputs contain 0, so they are all 0-equal. Now consider two n-equal inputs. We have to show that the outputs are n+1-equal. Either they both do not contain n in which case they have to be fully equal and hence so are the results. Or else they both contain n, so the results will both contain n+1, so the results are n+1-equal. *) Let f_proper : Proper ((≡) ==> (≡)) f := ne_proper f. Local Existing Instance f_proper. Lemma fixpointK_unfold : fixpointK k f ≡ f (fixpointK k f). Proof. symmetry. rewrite /fixpointK. apply fixpoint_unique. by rewrite -Nat.iter_succ_r Nat.iter_succ -fixpoint_unfold. Qed. Lemma fixpointK_unique (x : A) : x ≡ f x → x ≡ fixpointK k f. Proof. intros Hf. apply fixpoint_unique. clear f_contractive. induction k as [|k' IH]=> //=. by rewrite -IH. Qed. Section fixpointK_ne. Context (g : A → A) `{g_contractive : !Contractive (Nat.iter k g)}. Context {g_ne : NonExpansive g}. Lemma fixpointK_ne n : (∀ z, f z ≡{n}≡ g z) → fixpointK k f ≡{n}≡ fixpointK k g. Proof. rewrite /fixpointK=> Hfg /=. apply fixpoint_ne=> z. clear f_contractive g_contractive. induction k as [|k' IH]=> //=. by rewrite IH Hfg. Qed. Lemma fixpointK_proper : (∀ z, f z ≡ g z) → fixpointK k f ≡ fixpointK k g. Proof. setoid_rewrite equiv_dist; naive_solver eauto using fixpointK_ne. Qed. End fixpointK_ne. Lemma fixpointK_ind (P : A → Prop) : Proper ((≡) ==> impl) P → (∃ x, P x) → (∀ x, P x → P (f x)) → LimitPreserving P → P (fixpointK k f). Proof. intros. rewrite /fixpointK. apply fixpoint_ind; eauto. intros; apply Nat.iter_ind; auto. Qed. End fixpointK. (** Mutual fixpoints *) Section fixpointAB. Context {A B : ofe} `{!Cofe A, !Cofe B, !Inhabited A, !Inhabited B}. Context (fA : A → B → A). Context (fB : A → B → B). Context {fA_contractive : ∀ n, Proper (dist_later n ==> dist n ==> dist n) fA}. Context {fB_contractive : ∀ n, Proper (dist_later n ==> dist_later n ==> dist n) fB}. Local Definition fixpoint_AB (x : A) : B := fixpoint (fB x). Local Instance fixpoint_AB_contractive : Contractive fixpoint_AB. Proof. intros n x x' Hx; rewrite /fixpoint_AB. apply fixpoint_ne=> y. by f_contractive. Qed. Local Definition fixpoint_AA (x : A) : A := fA x (fixpoint_AB x). Local Instance fixpoint_AA_contractive : Contractive fixpoint_AA. Proof using fA_contractive. solve_contractive. Qed. Definition fixpoint_A : A := fixpoint fixpoint_AA. Definition fixpoint_B : B := fixpoint_AB fixpoint_A. Lemma fixpoint_A_unfold : fA fixpoint_A fixpoint_B ≡ fixpoint_A. Proof. by rewrite {2}/fixpoint_A (fixpoint_unfold _). Qed. Lemma fixpoint_B_unfold : fB fixpoint_A fixpoint_B ≡ fixpoint_B. Proof. by rewrite {2}/fixpoint_B /fixpoint_AB (fixpoint_unfold _). Qed. Local Instance: Proper ((≡) ==> (≡) ==> (≡)) fA. Proof using fA_contractive. apply ne_proper_2=> n x x' ? y y' ?. f_contractive; eauto using dist_le with si_solver. Qed. Local Instance: Proper ((≡) ==> (≡) ==> (≡)) fB. Proof using fB_contractive. apply ne_proper_2=> n x x' ? y y' ?. f_contractive; eauto using dist_le with si_solver. Qed. Lemma fixpoint_A_unique p q : fA p q ≡ p → fB p q ≡ q → p ≡ fixpoint_A. Proof. intros HfA HfB. rewrite -HfA. apply fixpoint_unique. rewrite /fixpoint_AA. f_equiv=> //. apply fixpoint_unique. by rewrite HfA HfB. Qed. Lemma fixpoint_B_unique p q : fA p q ≡ p → fB p q ≡ q → q ≡ fixpoint_B. Proof. intros. apply fixpoint_unique. by rewrite -fixpoint_A_unique. Qed. End fixpointAB. Section fixpointAB_ne. Context {A B : ofe} `{!Cofe A, !Cofe B, !Inhabited A, !Inhabited B}. Context (fA fA' : A → B → A). Context (fB fB' : A → B → B). Context `{∀ n, Proper (dist_later n ==> dist n ==> dist n) fA}. Context `{∀ n, Proper (dist_later n ==> dist n ==> dist n) fA'}. Context `{∀ n, Proper (dist_later n ==> dist_later n ==> dist n) fB}. Context `{∀ n, Proper (dist_later n ==> dist_later n ==> dist n) fB'}. Lemma fixpoint_A_ne n : (∀ x y, fA x y ≡{n}≡ fA' x y) → (∀ x y, fB x y ≡{n}≡ fB' x y) → fixpoint_A fA fB ≡{n}≡ fixpoint_A fA' fB'. Proof. intros HfA HfB. apply fixpoint_ne=> z. rewrite /fixpoint_AA /fixpoint_AB HfA. f_equiv. by apply fixpoint_ne. Qed. Lemma fixpoint_B_ne n : (∀ x y, fA x y ≡{n}≡ fA' x y) → (∀ x y, fB x y ≡{n}≡ fB' x y) → fixpoint_B fA fB ≡{n}≡ fixpoint_B fA' fB'. Proof. intros HfA HfB. apply fixpoint_ne=> z. rewrite HfB. f_contractive. apply fixpoint_A_ne; eauto using dist_le with si_solver. Qed. Lemma fixpoint_A_proper : (∀ x y, fA x y ≡ fA' x y) → (∀ x y, fB x y ≡ fB' x y) → fixpoint_A fA fB ≡ fixpoint_A fA' fB'. Proof. setoid_rewrite equiv_dist; naive_solver eauto using fixpoint_A_ne. Qed. Lemma fixpoint_B_proper : (∀ x y, fA x y ≡ fA' x y) → (∀ x y, fB x y ≡ fB' x y) → fixpoint_B fA fB ≡ fixpoint_B fA' fB'. Proof. setoid_rewrite equiv_dist; naive_solver eauto using fixpoint_B_ne. Qed. End fixpointAB_ne. (** Non-expansive function space *) Record ofe_mor (A B : ofe) : Type := OfeMor { ofe_mor_car :> A → B; ofe_mor_ne : NonExpansive ofe_mor_car }. Global Arguments OfeMor {_ _} _ {_}. Add Printing Constructor ofe_mor. Global Existing Instance ofe_mor_ne. Notation "'λne' x .. y , t" := (@OfeMor _ _ (λ x, .. (@OfeMor _ _ (λ y, t) _) ..) _) (at level 200, x binder, y binder, right associativity). Section ofe_mor. Context {A B : ofe}. Global Instance ofe_mor_proper (f : ofe_mor A B) : Proper ((≡) ==> (≡)) f. Proof. apply ne_proper, ofe_mor_ne. Qed. Local Instance ofe_mor_equiv : Equiv (ofe_mor A B) := λ f g, ∀ x, f x ≡ g x. Local Instance ofe_mor_dist : Dist (ofe_mor A B) := λ n f g, ∀ x, f x ≡{n}≡ g x. Definition ofe_mor_ofe_mixin : OfeMixin (ofe_mor A B). Proof. split. - intros f g; split; [intros Hfg n k; apply equiv_dist, Hfg|]. intros Hfg k; apply equiv_dist=> n; apply Hfg. - intros n; split. + by intros f x. + by intros f g ? x. + by intros f g h ?? x; trans (g x). - intros n m f g ? x ?; eauto using dist_le with si_solver. Qed. Canonical Structure ofe_morO := Ofe (ofe_mor A B) ofe_mor_ofe_mixin. Program Definition ofe_mor_chain (c : chain ofe_morO) (x : A) : chain B := {| chain_car n := c n x |}. Next Obligation. intros c x n i ?. by apply (chain_cauchy c). Qed. Program Definition ofe_mor_compl `{!Cofe B} : Compl ofe_morO := λ c, {| ofe_mor_car x := compl (ofe_mor_chain c x) |}. Next Obligation. intros ? c n x y Hx. by rewrite (conv_compl n (ofe_mor_chain c x)) (conv_compl n (ofe_mor_chain c y)) /= Hx. Qed. Global Program Instance ofe_mor_cofe `{!Cofe B} : Cofe ofe_morO := {| compl := ofe_mor_compl |}. Next Obligation. intros ? n c x; simpl. by rewrite (conv_compl n (ofe_mor_chain c x)) /=. Qed. Global Instance ofe_mor_car_ne : NonExpansive2 (@ofe_mor_car A B). Proof. intros n f g Hfg x y Hx; rewrite Hx; apply Hfg. Qed. Global Instance ofe_mor_car_proper : Proper ((≡) ==> (≡) ==> (≡)) (@ofe_mor_car A B) := ne_proper_2 _. Lemma ofe_mor_ext (f g : ofe_mor A B) : f ≡ g ↔ ∀ x, f x ≡ g x. Proof. done. Qed. End ofe_mor. Global Arguments ofe_morO : clear implicits. Notation "A -n> B" := (ofe_morO A B) (at level 99, B at level 200, right associativity). Global Instance ofe_mor_inhabited {A B : ofe} `{Inhabited B} : Inhabited (A -n> B) := populate (λne _, inhabitant). (** Identity and composition and constant function *) Definition cid {A} : A -n> A := OfeMor id. Global Instance: Params (@cid) 1 := {}. Definition cconst {A B : ofe} (x : B) : A -n> B := OfeMor (const x). Global Instance: Params (@cconst) 2 := {}. Definition ccompose {A B C} (f : B -n> C) (g : A -n> B) : A -n> C := OfeMor (f ∘ g). Global Instance: Params (@ccompose) 3 := {}. Infix "◎" := ccompose (at level 40, left associativity). Global Instance ccompose_ne {A B C} : NonExpansive2 (@ccompose A B C). Proof. intros n ?? Hf g1 g2 Hg x. rewrite /= (Hg x) (Hf (g2 x)) //. Qed. Global Instance ccompose_proper {A B C} : Proper ((≡) ==> (≡) ==> (≡)) (@ccompose A B C). Proof. apply ne_proper_2; apply _. Qed. (* Function space maps *) Definition ofe_mor_map {A A' B B'} (f : A' -n> A) (g : B -n> B') (h : A -n> B) : A' -n> B' := g ◎ h ◎ f. Global Instance ofe_mor_map_ne {A A' B B'} : NonExpansive3 (@ofe_mor_map A A' B B'). Proof. intros n ??? ??? ???. by repeat apply ccompose_ne. Qed. Definition ofe_morO_map {A A' B B'} (f : A' -n> A) (g : B -n> B') : (A -n> B) -n> (A' -n> B') := OfeMor (ofe_mor_map f g). Global Instance ofe_morO_map_ne {A A' B B'} : NonExpansive2 (@ofe_morO_map A A' B B'). Proof. intros n f f' Hf g g' Hg ?. rewrite /= /ofe_mor_map. by repeat apply ccompose_ne. Qed. (** * Unit type *) Section unit. Local Instance unit_dist : Dist unit := λ _ _ _, True. Definition unit_ofe_mixin : OfeMixin unit. Proof. by repeat split; try exists 0. Qed. Canonical Structure unitO : ofe := Ofe unit unit_ofe_mixin. Global Program Instance unit_cofe : Cofe unitO := { compl x := () }. Next Obligation. by repeat split; try exists 0. Qed. Global Instance unit_ofe_discrete : OfeDiscrete unitO. Proof. done. Qed. End unit. (** * Empty type *) Section empty. Local Instance Empty_set_dist : Dist Empty_set := λ _ _ _, True. Definition Empty_set_ofe_mixin : OfeMixin Empty_set. Proof. by repeat split; try exists 0. Qed. Canonical Structure Empty_setO : ofe := Ofe Empty_set Empty_set_ofe_mixin. Global Program Instance Empty_set_cofe : Cofe Empty_setO := { compl x := x 0 }. Next Obligation. by repeat split; try exists 0. Qed. Global Instance Empty_set_ofe_discrete : OfeDiscrete Empty_setO. Proof. done. Qed. End empty. (** * Product type *) Section product. Context {A B : ofe}. Local Instance prod_dist : Dist (A * B) := λ n, prod_relation (dist n) (dist n). Definition prod_ofe_mixin : OfeMixin (A * B). Proof. split. - intros x y; unfold dist, prod_dist, equiv, prod_equiv, prod_relation. rewrite !equiv_dist; naive_solver. - apply _. - by intros n m [x1 y1] [x2 y2] [??] ?; split; eauto using dist_le with si_solver. Qed. Canonical Structure prodO : ofe := Ofe (A * B) prod_ofe_mixin. Global Program Instance prod_cofe `{Cofe A, Cofe B} : Cofe prodO := { compl c := (compl (chain_map fst c), compl (chain_map snd c)) }. Next Obligation. intros ?? n c; split. - apply (conv_compl n (chain_map fst c)). - apply (conv_compl n (chain_map snd c)). Qed. Global Instance prod_discrete (x : A * B) : Discrete (x.1) → Discrete (x.2) → Discrete x. Proof. by intros ???[??]; split; apply (discrete_0 _). Qed. Global Instance prod_ofe_discrete : OfeDiscrete A → OfeDiscrete B → OfeDiscrete prodO. Proof. intros ?? [??]; apply _. Qed. Lemma pair_dist n (a1 a2 : A) (b1 b2 : B) : (a1, b1) ≡{n}≡ (a2, b2) ↔ a1 ≡{n}≡ a2 ∧ b1 ≡{n}≡ b2. Proof. reflexivity. Qed. End product. Global Arguments prodO : clear implicits. (** Below we make [prod_dist] type class opaque, so we first lift all instances *) Global Instance pair_ne {A B : ofe} : NonExpansive2 (@pair A B) := _. Global Instance pair_dist_inj {A B : ofe} n : Inj2 (≡{n}≡) (≡{n}≡) (≡{n}≡) (@pair A B) := _. Global Instance fst_ne {A B : ofe} : NonExpansive (@fst A B) := _. Global Instance snd_ne {A B : ofe} : NonExpansive (@snd A B) := _. Global Instance curry_ne {A B C : ofe} n : Proper (((≡{n}@{A*B}≡) ==> (≡{n}@{C}≡)) ==> (≡{n}≡) ==> (≡{n}≡) ==> (≡{n}≡)) curry := _. Global Instance uncurry_ne {A B C : ofe} n : Proper (((≡{n}≡) ==> (≡{n}≡) ==> (≡{n}≡)) ==> (≡{n}@{A*B}≡) ==> (≡{n}@{C}≡)) uncurry := _. Global Instance curry3_ne {A B C D : ofe} n : Proper (((≡{n}@{A*B*C}≡) ==> (≡{n}@{D}≡)) ==> (≡{n}≡) ==> (≡{n}≡) ==> (≡{n}≡) ==> (≡{n}≡)) curry3 := _. Global Instance uncurry3_ne {A B C D : ofe} n : Proper (((≡{n}≡) ==> (≡{n}≡) ==> (≡{n}≡) ==> (≡{n}≡)) ==> (≡{n}@{A*B*C}≡) ==> (≡{n}@{D}≡)) uncurry3 := _. Global Instance curry4_ne {A B C D E : ofe} n : Proper (((≡{n}@{A*B*C*D}≡) ==> (≡{n}@{E}≡)) ==> (≡{n}≡) ==> (≡{n}≡) ==> (≡{n}≡) ==> (≡{n}≡) ==> (≡{n}≡)) curry4 := _. Global Instance uncurry4_ne {A B C D E : ofe} n : Proper (((≡{n}≡) ==> (≡{n}≡) ==> (≡{n}≡) ==> (≡{n}≡) ==> (≡{n}≡)) ==> (≡{n}@{A*B*C*D}≡) ==> (≡{n}@{E}≡)) uncurry4 := _. Global Typeclasses Opaque prod_dist. Global Instance prod_map_ne {A A' B B' : ofe} n : Proper ((dist n ==> dist n) ==> (dist n ==> dist n) ==> dist n ==> dist n) (@prod_map A A' B B'). Proof. by intros f f' Hf g g' Hg ?? [??]; split; [apply Hf|apply Hg]. Qed. Definition prodO_map {A A' B B'} (f : A -n> A') (g : B -n> B') : prodO A B -n> prodO A' B' := OfeMor (prod_map f g). Global Instance prodO_map_ne {A A' B B'} : NonExpansive2 (@prodO_map A A' B B'). Proof. intros n f f' Hf g g' Hg [??]; split; [apply Hf|apply Hg]. Qed. (** * COFE → OFE Functors *) Record oFunctor := OFunctor { oFunctor_car : ∀ A `{!Cofe A} B `{!Cofe B}, ofe; oFunctor_map `{!Cofe A1, !Cofe A2, !Cofe B1, !Cofe B2} : ((A2 -n> A1) * (B1 -n> B2)) → oFunctor_car A1 B1 -n> oFunctor_car A2 B2; oFunctor_map_ne `{!Cofe A1, !Cofe A2, !Cofe B1, !Cofe B2} : NonExpansive (@oFunctor_map A1 _ A2 _ B1 _ B2 _); oFunctor_map_id `{!Cofe A, !Cofe B} (x : oFunctor_car A B) : oFunctor_map (cid,cid) x ≡ x; oFunctor_map_compose `{!Cofe A1, !Cofe A2, !Cofe A3, !Cofe B1, !Cofe B2, !Cofe B3} (f : A2 -n> A1) (g : A3 -n> A2) (f' : B1 -n> B2) (g' : B2 -n> B3) x : oFunctor_map (f◎g, g'◎f') x ≡ oFunctor_map (g,g') (oFunctor_map (f,f') x) }. Global Existing Instance oFunctor_map_ne. Global Instance: Params (@oFunctor_map) 9 := {}. Declare Scope oFunctor_scope. Delimit Scope oFunctor_scope with OF. Bind Scope oFunctor_scope with oFunctor. Class oFunctorContractive (F : oFunctor) := #[global] oFunctor_map_contractive `{!Cofe A1, !Cofe A2, !Cofe B1, !Cofe B2} :: Contractive (@oFunctor_map F A1 _ A2 _ B1 _ B2 _). Global Hint Mode oFunctorContractive ! : typeclass_instances. (** Not a coercion due to the [Cofe] type class argument, and to avoid ambiguous coercion paths, see https://gitlab.mpi-sws.org/iris/iris/issues/240. *) Definition oFunctor_apply (F: oFunctor) (A: ofe) `{!Cofe A} : ofe := oFunctor_car F A A. Program Definition oFunctor_oFunctor_compose (F1 F2 : oFunctor) `{!∀ `{Cofe A, Cofe B}, Cofe (oFunctor_car F2 A B)} : oFunctor := {| oFunctor_car A _ B _ := oFunctor_car F1 (oFunctor_car F2 B A) (oFunctor_car F2 A B); oFunctor_map A1 _ A2 _ B1 _ B2 _ 'fg := oFunctor_map F1 (oFunctor_map F2 (fg.2,fg.1),oFunctor_map F2 fg) |}. Next Obligation. intros F1 F2 ? A1 ? A2 ? B1 ? B2 ? n [f1 g1] [f2 g2] [??]; simpl in *. apply oFunctor_map_ne; split; apply oFunctor_map_ne; by split. Qed. Next Obligation. intros F1 F2 ? A ? B ? x; simpl in *. rewrite -{2}(oFunctor_map_id F1 x). apply equiv_dist=> n. apply oFunctor_map_ne. split=> y /=; by rewrite !oFunctor_map_id. Qed. Next Obligation. intros F1 F2 ? A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x; simpl in *. rewrite -oFunctor_map_compose. apply equiv_dist=> n. apply oFunctor_map_ne. split=> y /=; by rewrite !oFunctor_map_compose. Qed. Global Instance oFunctor_oFunctor_compose_contractive_1 (F1 F2 : oFunctor) `{!∀ `{Cofe A, Cofe B}, Cofe (oFunctor_car F2 A B)} : oFunctorContractive F1 → oFunctorContractive (oFunctor_oFunctor_compose F1 F2). Proof. intros ? A1 ? A2 ? B1 ? B2 ? n [f1 g1] [f2 g2] Hfg; simpl in *. f_contractive; destruct Hfg; split; simpl in *; apply oFunctor_map_ne; by split. Qed. Global Instance oFunctor_oFunctor_compose_contractive_2 (F1 F2 : oFunctor) `{!∀ `{Cofe A, Cofe B}, Cofe (oFunctor_car F2 A B)} : oFunctorContractive F2 → oFunctorContractive (oFunctor_oFunctor_compose F1 F2). Proof. intros ? A1 ? A2 ? B1 ? B2 ? n [f1 g1] [f2 g2] Hfg; simpl in *. f_equiv; split; simpl in *; f_contractive; destruct Hfg; by split. Qed. Program Definition constOF (B : ofe) : oFunctor := {| oFunctor_car A1 A2 _ _ := B; oFunctor_map A1 _ A2 _ B1 _ B2 _ f := cid |}. Solve Obligations with done. Coercion constOF : ofe >-> oFunctor. Global Instance constOF_contractive B : oFunctorContractive (constOF B). Proof. rewrite /oFunctorContractive; apply _. Qed. Program Definition idOF : oFunctor := {| oFunctor_car A1 _ A2 _ := A2; oFunctor_map A1 _ A2 _ B1 _ B2 _ f := f.2 |}. Solve Obligations with done. Notation "∙" := idOF : oFunctor_scope. Program Definition prodOF (F1 F2 : oFunctor) : oFunctor := {| oFunctor_car A _ B _ := prodO (oFunctor_car F1 A B) (oFunctor_car F2 A B); oFunctor_map A1 _ A2 _ B1 _ B2 _ fg := prodO_map (oFunctor_map F1 fg) (oFunctor_map F2 fg) |}. Next Obligation. intros ?? A1 ? A2 ? B1 ? B2 ? n ???; by apply prodO_map_ne; apply oFunctor_map_ne. Qed. Next Obligation. by intros F1 F2 A ? B ? [??]; rewrite /= !oFunctor_map_id. Qed. Next Obligation. intros F1 F2 A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' [??]; simpl. by rewrite !oFunctor_map_compose. Qed. Notation "F1 * F2" := (prodOF F1%OF F2%OF) : oFunctor_scope. Global Instance prodOF_contractive F1 F2 : oFunctorContractive F1 → oFunctorContractive F2 → oFunctorContractive (prodOF F1 F2). Proof. intros ?? A1 ? A2 ? B1 ? B2 ? n ???; by apply prodO_map_ne; apply oFunctor_map_contractive. Qed. Program Definition ofe_morOF (F1 F2 : oFunctor) : oFunctor := {| oFunctor_car A _ B _ := oFunctor_car F1 B A -n> oFunctor_car F2 A B; oFunctor_map A1 _ A2 _ B1 _ B2 _ fg := ofe_morO_map (oFunctor_map F1 (fg.2, fg.1)) (oFunctor_map F2 fg) |}. Next Obligation. intros F1 F2 A1 ? A2 ? B1 ? B2 ? n [f g] [f' g'] Hfg; simpl in *. apply ofe_morO_map_ne; apply oFunctor_map_ne; split; by apply Hfg. Qed. Next Obligation. intros F1 F2 A ? B ? [f ?] ?; simpl. rewrite /= !oFunctor_map_id. apply (ne_proper f). apply oFunctor_map_id. Qed. Next Obligation. intros F1 F2 A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' [h ?] ?; simpl in *. rewrite -!oFunctor_map_compose. do 2 apply (ne_proper _). apply oFunctor_map_compose. Qed. Notation "F1 -n> F2" := (ofe_morOF F1%OF F2%OF) : oFunctor_scope. Global Instance ofe_morOF_contractive F1 F2 : oFunctorContractive F1 → oFunctorContractive F2 → oFunctorContractive (ofe_morOF F1 F2). Proof. intros ?? A1 ? A2 ? B1 ? B2 ? n [f g] [f' g'] Hfg; simpl in *. apply ofe_morO_map_ne; apply oFunctor_map_contractive; split; intros m Hlt; split; simpl. all: destruct Hfg as [Hfg]; destruct (Hfg m); auto. Qed. (** * Sum type *) Section sum. Context {A B : ofe}. Local Instance sum_dist : Dist (A + B) := λ n, sum_relation (dist n) (dist n). Global Instance inl_ne : NonExpansive (@inl A B) := _. Global Instance inr_ne : NonExpansive (@inr A B) := _. Global Instance inl_ne_inj n : Inj (dist n) (dist n) (@inl A B) := _. Global Instance inr_ne_inj n : Inj (dist n) (dist n) (@inr A B) := _. Definition sum_ofe_mixin : OfeMixin (A + B). Proof. split. - intros x y; split=> Hx. + destruct Hx=> n; constructor; by apply equiv_dist. + destruct (Hx 0); constructor; apply equiv_dist=> n; by apply (inj _). - apply _. - destruct 1; constructor; eapply dist_lt; eauto. Qed. Canonical Structure sumO : ofe := Ofe (A + B) sum_ofe_mixin. Program Definition inl_chain (c : chain sumO) (a : A) : chain A := {| chain_car n := match c n return _ with inl a' => a' | _ => a end |}. Next Obligation. intros c a n i ?; simpl. by destruct (chain_cauchy c n i). Qed. Program Definition inr_chain (c : chain sumO) (b : B) : chain B := {| chain_car n := match c n return _ with inr b' => b' | _ => b end |}. Next Obligation. intros c b n i ?; simpl. by destruct (chain_cauchy c n i). Qed. Definition sum_compl `{!Cofe A, !Cofe B} : Compl sumO := λ c, match c 0 with | inl a => inl (compl (inl_chain c a)) | inr b => inr (compl (inr_chain c b)) end. Global Program Instance sum_cofe `{Cofe A, Cofe B} : Cofe sumO := { compl := sum_compl }. Next Obligation. intros ?? n c; rewrite /compl /sum_compl. oinversion (chain_cauchy c 0 n); first by si_solver. - rewrite (conv_compl n (inl_chain c _)) /=. destruct (c n); naive_solver. - rewrite (conv_compl n (inr_chain c _)) /=. destruct (c n); naive_solver. Qed. Global Instance inl_discrete (x : A) : Discrete x → Discrete (inl x). Proof. inversion_clear 2; constructor; by apply (discrete_0 _). Qed. Global Instance inr_discrete (y : B) : Discrete y → Discrete (inr y). Proof. inversion_clear 2; constructor; by apply (discrete_0 _). Qed. Global Instance sum_ofe_discrete : OfeDiscrete A → OfeDiscrete B → OfeDiscrete sumO. Proof. intros ?? [?|?]; apply _. Qed. End sum. Global Arguments sumO : clear implicits. Global Typeclasses Opaque sum_dist. Global Instance sum_map_ne {A A' B B' : ofe} n : Proper ((dist n ==> dist n) ==> (dist n ==> dist n) ==> dist n ==> dist n) (@sum_map A A' B B'). Proof. intros f f' Hf g g' Hg ??; destruct 1; constructor; [by apply Hf|by apply Hg]. Qed. Definition sumO_map {A A' B B'} (f : A -n> A') (g : B -n> B') : sumO A B -n> sumO A' B' := OfeMor (sum_map f g). Global Instance sumO_map_ne {A A' B B'} : NonExpansive2 (@sumO_map A A' B B'). Proof. intros n f f' Hf g g' Hg [?|?]; constructor; [apply Hf|apply Hg]. Qed. Program Definition sumOF (F1 F2 : oFunctor) : oFunctor := {| oFunctor_car A _ B _ := sumO (oFunctor_car F1 A B) (oFunctor_car F2 A B); oFunctor_map A1 _ A2 _ B1 _ B2 _ fg := sumO_map (oFunctor_map F1 fg) (oFunctor_map F2 fg) |}. Next Obligation. intros ?? A1 ? A2 ? B1 ? B2 ? n ???; by apply sumO_map_ne; apply oFunctor_map_ne. Qed. Next Obligation. by intros F1 F2 A ? B ? [?|?]; rewrite /= !oFunctor_map_id. Qed. Next Obligation. intros F1 F2 A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' [?|?]; simpl; by rewrite !oFunctor_map_compose. Qed. Notation "F1 + F2" := (sumOF F1%OF F2%OF) : oFunctor_scope. Global Instance sumOF_contractive F1 F2 : oFunctorContractive F1 → oFunctorContractive F2 → oFunctorContractive (sumOF F1 F2). Proof. intros ?? A1 ? A2 ? B1 ? B2 ? n ???; by apply sumO_map_ne; apply oFunctor_map_contractive. Qed. (** * Discrete OFEs *) Section discrete_ofe. Context {A : Type} `{!Equiv A} (Heq : @Equivalence A (≡)). Local Instance discrete_dist : Dist A := λ n x y, x ≡ y. Definition discrete_ofe_mixin : OfeMixin A. Proof using Type*. split. - intros x y; split; [done|intros Hn; apply (Hn 0)]. - done. - done. Qed. Global Instance discrete_ofe_discrete : OfeDiscrete (Ofe A discrete_ofe_mixin). Proof. by intros x y. Qed. Global Program Instance discrete_cofe : Cofe (Ofe A discrete_ofe_mixin) := { compl c := c 0 }. Next Obligation. intros n c. rewrite /compl /=; symmetry; apply (chain_cauchy c 0 n). lia. Qed. End discrete_ofe. (** The combinators [discreteO] and [leibnizO] should be used with care. There are two ways in which they can be used: 1. To define an OFE on a ground type, such as [nat], [expr], etc. The OFE instance should be defined as [Canonical Structure tyO := leibnizO ty] or [Canonical Structure tyO := discreteO ty], so not using [Definition]. See [natO] below for an example. Make sure to avoid overlapping instances, so always check if no instance has already been defined. For most of the types from Coq, std++, and Iris, instances are present in Iris. The convention is to use the name [tyO] for the OFE instance of a type [ty]. 2. As part of abstractions that are parametrized with a [Type], but where an [ofe] is needed to use (camera) combinators. See [ghost_var] as an example. In this case, the public API of the abstraction should exclusively use [Type], i.e., the use of [leibnizO] or [discreteO] should not leak. Otherwise client code can end up with overlapping instances, and thus experience odd unification failures. You should *never* use [leibnizO] or [discreteO] on compound types such as [list nat]. That creates overlapping canonical instances for the head symbol (e.g., [listO] and [leibnizO (list nat)]) and confuses unification. Instead, you have two options: - declare/use a canonical instance for the ground type, e.g., [listO natO]. - declare a newtype, e.g., [Record ty := Ty { ty_car : list nat }], and then declare a canonical instance for that type, e.g., [Canonical Structure tyO := leibnizO ty]. *) (** The combinator [discreteO A] lifts an existing [Equiv A] instance into a discrete OFE. *) Notation discreteO A := (Ofe A (discrete_ofe_mixin _)). (** The combinator [leibnizO A] lifts Leibniz equality [=] into a discrete OFE. The implementation forces the [Equivalence] proof to be [eq_equivalence] so that Coq does not accidentally use another one, like [ofe_equivalence], in the case of aliases. See also https://gitlab.mpi-sws.org/iris/iris/issues/299 *) Notation leibnizO A := (Ofe A (@discrete_ofe_mixin _ equivL eq_equivalence)). (** In order to define a discrete CMRA with carrier [A] (in the file [cmra.v]) we need to determine the [Equivalence A] proof that was used to construct the OFE instance of [A] (note that this proof is not the same as the one we obtain via [ofe_equivalence]). We obtain the proof of [Equivalence A] by inferring the canonical OFE mixin using [ofe_mixin_of A], and then check whether it is indeed a discrete OFE. This will fail if no OFE, or an OFE other than the discrete OFE, was registered. *) Notation discrete_ofe_equivalence_of A := ltac:( match constr:(ofe_mixin_of A) with | discrete_ofe_mixin ?H => exact H end) (only parsing). Global Instance leibnizO_leibniz A : LeibnizEquiv (leibnizO A). Proof. by intros x y. Qed. (** * Basic Coq types *) Canonical Structure boolO := leibnizO bool. Canonical Structure natO := leibnizO nat. Canonical Structure positiveO := leibnizO positive. Canonical Structure NO := leibnizO N. Canonical Structure ZO := leibnizO Z. Section prop. Local Instance Prop_equiv : Equiv Prop := iff. Local Instance Prop_equivalence : Equivalence (≡@{Prop}) := _. Canonical Structure PropO := discreteO Prop. End prop. (** * Option type *) Section option. Context {A : ofe}. Local Instance option_dist : Dist (option A) := λ n, option_Forall2 (dist n). Lemma option_dist_Forall2 n mx my : mx ≡{n}≡ my ↔ option_Forall2 (dist n) mx my. Proof. done. Qed. Definition option_ofe_mixin : OfeMixin (option A). Proof. split. - intros mx my; split; [by destruct 1; constructor; apply equiv_dist|]. intros Hxy; destruct (Hxy 0); constructor; apply equiv_dist. by intros n; oinversion (Hxy n). - apply _. - destruct 1; constructor; eauto using dist_le with si_solver. Qed. Canonical Structure optionO := Ofe (option A) option_ofe_mixin. Program Definition option_chain (c : chain optionO) (x : A) : chain A := {| 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 optionO := λ c, match c 0 with Some x => Some (compl (option_chain c x)) | None => None end. Global Program Instance option_cofe `{Cofe A} : Cofe optionO := { compl := option_compl }. Next Obligation. intros ? n c; rewrite /compl /option_compl. oinversion (chain_cauchy c 0 n); auto with lia; []. constructor. rewrite (conv_compl n (option_chain c _)) /=. destruct (c n); naive_solver. Qed. Global Instance option_ofe_discrete : OfeDiscrete A → OfeDiscrete optionO. Proof. destruct 2; constructor; by apply (discrete_0 _). Qed. Global Instance Some_ne : NonExpansive (@Some A). Proof. by constructor. Qed. Global Instance is_Some_ne n : Proper (dist n ==> iff) (@is_Some A). Proof. destruct 1; split; eauto. Qed. Global Instance Some_dist_inj n : Inj (dist n) (dist n) (@Some A). Proof. by inversion_clear 1. Qed. Global Instance from_option_ne {B} (R : relation B) n : Proper ((dist (A:=A) n ==> R) ==> R ==> dist n ==> R) from_option. Proof. destruct 3; simpl; auto. Qed. Global Instance None_discrete : Discrete (@None A). Proof. inversion_clear 1; constructor. Qed. Global Instance Some_discrete x : Discrete x → Discrete (Some x). Proof. by intros ?; inversion_clear 1; constructor; apply discrete_0. Qed. Lemma dist_None n mx : mx ≡{n}≡ None ↔ mx = None. Proof. split; [by inversion_clear 1|by intros ->]. Qed. Lemma dist_Some_inv_l n mx my x : mx ≡{n}≡ my → mx = Some x → ∃ y, my = Some y ∧ x ≡{n}≡ y. Proof. destruct 1; naive_solver. Qed. Lemma dist_Some_inv_r n mx my y : mx ≡{n}≡ my → my = Some y → ∃ x, mx = Some x ∧ x ≡{n}≡ y. Proof. destruct 1; naive_solver. Qed. Lemma dist_Some_inv_l' n my x : Some x ≡{n}≡ my → ∃ x', Some x' = my ∧ x ≡{n}≡ x'. Proof. intros ?%(dist_Some_inv_l _ _ _ x); naive_solver. Qed. Lemma dist_Some_inv_r' n mx y : mx ≡{n}≡ Some y → ∃ y', mx = Some y' ∧ y ≡{n}≡ y'. Proof. intros ?%(dist_Some_inv_r _ _ _ y); naive_solver. Qed. End option. Global Typeclasses Opaque option_dist. Global Arguments optionO : clear implicits. Global Instance option_fmap_ne {A B : ofe} n: Proper ((dist n ==> dist n) ==> dist n ==> dist n) (@fmap option _ A B). Proof. intros f f' Hf ?? []; constructor; auto. Qed. Global Instance option_mbind_ne {A B : ofe} n: Proper ((dist n ==> dist n) ==> dist n ==> dist n) (@mbind option _ A B). Proof. destruct 2; simpl; auto. Qed. Global Instance option_mjoin_ne {A : ofe} n: Proper (dist n ==> dist n) (@mjoin option _ A). Proof. destruct 1 as [?? []|]; simpl; by constructor. Qed. Global Instance option_fmap_dist_inj {A B : ofe} (f : A → B) n : Inj (≡{n}≡) (≡{n}≡) f → Inj (≡{n}@{option A}≡) (≡{n}@{option B}≡) (fmap f). Proof. apply option_fmap_inj. Qed. Lemma fmap_Some_dist {A B : ofe} (f : A → B) (mx : option A) (y : B) n : f <$> mx ≡{n}≡ Some y ↔ ∃ x : A, mx = Some x ∧ y ≡{n}≡ f x. Proof. split; [|by intros (x&->&->)]. intros (?&?%fmap_Some&?)%dist_Some_inv_r'; naive_solver. Qed. Definition optionO_map {A B} (f : A -n> B) : optionO A -n> optionO B := OfeMor (fmap f : optionO A → optionO B). Global Instance optionO_map_ne A B : NonExpansive (@optionO_map A B). Proof. by intros n f f' Hf []; constructor; apply Hf. Qed. Program Definition optionOF (F : oFunctor) : oFunctor := {| oFunctor_car A _ B _ := optionO (oFunctor_car F A B); oFunctor_map A1 _ A2 _ B1 _ B2 _ fg := optionO_map (oFunctor_map F fg) |}. Next Obligation. by intros F A1 ? A2 ? B1 ? B2 ? n f g Hfg; apply optionO_map_ne, oFunctor_map_ne. Qed. Next Obligation. intros F A ? B ? x. rewrite /= -{2}(option_fmap_id x). apply option_fmap_equiv_ext=>y; apply oFunctor_map_id. Qed. Next Obligation. intros F A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x. rewrite /= -option_fmap_compose. apply option_fmap_equiv_ext=>y; apply oFunctor_map_compose. Qed. Global Instance optionOF_contractive F : oFunctorContractive F → oFunctorContractive (optionOF F). Proof. by intros ? A1 ? A2 ? B1 ? B2 ? n f g Hfg; apply optionO_map_ne, oFunctor_map_contractive. Qed. (** * Later type *) (** Note that the projection [later_car] is not non-expansive (see also the lemma [later_car_anti_contractive] below), so it cannot be used in the logic. If you need to get a witness out, you should use the lemma [Next_uninj] instead. *) Record later (A : Type) : Type := Next { later_car : A }. Add Printing Constructor later. Global Arguments Next {_} _. Global Arguments later_car {_} _. Global Instance: Params (@Next) 1 := {}. Section later. Context {A : ofe}. Local Instance later_equiv : Equiv (later A) := λ x y, later_car x ≡ later_car y. Local Instance later_dist : Dist (later A) := λ n x y, dist_later n (later_car x) (later_car y). Definition later_ofe_mixin : OfeMixin (later A). Proof. split. - intros x y; unfold equiv, later_equiv; rewrite !equiv_dist. split; intros Hxy n; [done|]. eapply (Hxy (S n)). lia. - split; rewrite /dist /later_dist. + by intros [x]. + by intros [x] [y]. + by intros [x] [y] [z] ??; trans y. - intros n m [x] [y] Hdist ?; split; intros p Hp. eapply Hdist; by trans m. Qed. Canonical Structure laterO : ofe := Ofe (later A) later_ofe_mixin. Program Definition later_chain (c : chain laterO) : chain A := {| chain_car n := later_car (c (S n)) |}. Next Obligation. intros c n i ?; apply (chain_cauchy c (S n)); lia. Qed. Global Program Instance later_cofe `{Cofe A} : Cofe laterO := { compl c := Next (compl (later_chain c)) }. Next Obligation. intros ? n c. apply dist_later_fin_iff. destruct n as [|n]; [done|by apply (conv_compl n (later_chain c))]. Qed. Global Instance Next_contractive : Contractive (@Next A). Proof. by intros n x y. Qed. Global Instance Next_inj n : Inj (dist_later n) (dist n) (@Next A). Proof. by intros x y. Qed. Lemma Next_uninj x : ∃ a, x ≡ Next a. Proof. by exists (later_car x). Qed. Local Instance later_car_anti_contractive n : Proper (dist n ==> dist_later n) later_car. Proof. move=> [x] [y] /= Hxy. done. Qed. (** [f] is contractive iff it can factor into [Next] and a non-expansive function. *) Lemma contractive_alt {B : ofe} (f : A → B) : Contractive f ↔ ∃ g : later A → B, NonExpansive g ∧ ∀ x, f x ≡ g (Next x). Proof. split. - intros Hf. exists (f ∘ later_car); split=> // n x y ?. by f_equiv. - intros (g&Hg&Hf) n x y Hxy. rewrite !Hf. by apply Hg. Qed. End later. Global Arguments laterO : clear implicits. Definition later_map {A B} (f : A → B) (x : later A) : later B := Next (f (later_car x)). Global Instance later_map_ne {A B : ofe} (f : A → B) n : Proper (dist_later n ==> dist_later n) f → Proper (dist n ==> dist n) (later_map f) | 0. Proof. intros P [x] [y] Hdist; rewrite /later_map //=. split; intros m Hm; apply P, Hm. apply Hdist. Qed. Global Instance later_map_ne' {A B : ofe} (f : A → B) `{NonExpansive f} : NonExpansive (later_map f). Proof. intros ? [x] [y] Hdist. unfold later_map; simpl. split; intros ??; simpl. f_equiv. by eapply Hdist. Qed. Global Instance later_map_proper {A B : ofe} (f : A → B) : Proper ((≡) ==> (≡)) f → Proper ((≡) ==> (≡)) (later_map f). Proof. solve_proper. Qed. Lemma later_map_Next {A B : ofe} (f : A → B) x : later_map f (Next x) = Next (f x). Proof. done. Qed. Lemma later_map_id {A} (x : later A) : later_map id x = x. Proof. by destruct x. Qed. Lemma later_map_compose {A B C} (f : A → B) (g : B → C) (x : later A) : later_map (g ∘ f) x = later_map g (later_map f x). Proof. by destruct x. Qed. Lemma later_map_ext {A B : ofe} (f g : A → B) x : (∀ x, f x ≡ g x) → later_map f x ≡ later_map g x. Proof. destruct x; intros Hf; apply Hf. Qed. Definition laterO_map {A B} (f : A -n> B) : laterO A -n> laterO B := OfeMor (later_map f). Global Instance laterO_map_contractive (A B : ofe) : Contractive (@laterO_map A B). Proof. intros n f g Hlater [x]; split; intros ??; simpl. by apply Hlater. Qed. Program Definition laterOF (F : oFunctor) : oFunctor := {| oFunctor_car A _ B _ := laterO (oFunctor_car F A B); oFunctor_map A1 _ A2 _ B1 _ B2 _ fg := laterO_map (oFunctor_map F fg) |}. Next Obligation. intros F A1 ? A2 ? B1 ? B2 ? n fg fg' ?. by apply (contractive_ne laterO_map), oFunctor_map_ne. Qed. Next Obligation. intros F A ? B ? x; simpl. rewrite -{2}(later_map_id x). apply later_map_ext=>y. by rewrite oFunctor_map_id. Qed. Next Obligation. intros F A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x; simpl. rewrite -later_map_compose. apply later_map_ext=>y; apply oFunctor_map_compose. Qed. Notation "▶ F" := (laterOF F%OF) (at level 20, right associativity) : oFunctor_scope. Global Instance laterOF_contractive F : oFunctorContractive (laterOF F). Proof. intros A1 ? A2 ? B1 ? B2 ? n fg fg' Hfg. apply laterO_map_contractive. split; intros ???; simpl. by eapply oFunctor_map_ne, Hfg. Qed. (** * Dependently-typed functions over a discrete domain *) (** This separate notion is useful whenever we need dependent functions, and whenever we want to avoid the hassle of the bundled non-expansive function type. Note that non-dependent functions over a discrete domain, [A -d> B] (following the notation we introduce below) are non-expansive if they are [Proper ((≡) ==> (≡))]. In other words, since the domain is discrete, non-expansiveness and respecting [(≡)] are the same. If the domain is moreover Leibniz ([LeibnizEquiv A]), we get both for free. We make [discrete_fun] a definition so that we can register it as a canonical structure. We do not bundle the [Proper] proof to keep [discrete_fun] easier to use. It turns out all the desired OFE and functorial properties do not rely on this [Proper] instance. *) Definition discrete_fun {A} (B : A → ofe) := ∀ x : A, B x. Section discrete_fun. Context {A : Type} {B : A → ofe}. Implicit Types f g : discrete_fun B. Local Instance discrete_fun_equiv : Equiv (discrete_fun B) := λ f g, ∀ x, f x ≡ g x. Local Instance discrete_fun_dist : Dist (discrete_fun B) := λ n f g, ∀ x, f x ≡{n}≡ g x. Definition discrete_fun_ofe_mixin : OfeMixin (discrete_fun B). Proof. split. - intros f g; split; [intros Hfg n k; apply equiv_dist, Hfg|]. intros Hfg k; apply equiv_dist=> n; apply Hfg. - intros n; split. + by intros f x. + by intros f g ? x. + by intros f g h ?? x; trans (g x). - by intros n m f g ? ? x; eauto using dist_le with si_solver. Qed. Canonical Structure discrete_funO := Ofe (discrete_fun B) discrete_fun_ofe_mixin. Program Definition discrete_fun_chain `(c : chain discrete_funO) (x : A) : chain (B x) := {| chain_car n := c n x |}. Next Obligation. intros c x n i ?. by apply (chain_cauchy c). Qed. Global Program Instance discrete_fun_cofe `{∀ x, Cofe (B x)} : Cofe discrete_funO := { compl c x := compl (discrete_fun_chain c x) }. Next Obligation. intros ? n c x. apply (conv_compl n (discrete_fun_chain c x)). Qed. Global Instance discrete_fun_inhabited `{∀ x, Inhabited (B x)} : Inhabited discrete_funO := populate (λ _, inhabitant). Global Instance discrete_fun_lookup_discrete `{EqDecision A} f x : Discrete f → Discrete (f x). Proof. intros Hf y ?. set (g x' := if decide (x = x') is left H then eq_rect _ B y _ H else f x'). trans (g x). { apply Hf=> x'. unfold g. by destruct (decide _) as [[]|]. } unfold g. destruct (decide _) as [Hx|]; last done. by rewrite (proof_irrel Hx eq_refl). Qed. End discrete_fun. Global Arguments discrete_funO {_} _. Notation "A -d> B" := (@discrete_funO A (λ _, B)) (at level 99, B at level 200, right associativity). Definition discrete_fun_map {A} {B1 B2 : A → ofe} (f : ∀ x, B1 x → B2 x) (g : discrete_fun B1) : discrete_fun B2 := λ x, f _ (g x). Lemma discrete_fun_map_ext {A} {B1 B2 : A → ofe} (f1 f2 : ∀ x, B1 x → B2 x) (g : discrete_fun B1) : (∀ x, f1 x (g x) ≡ f2 x (g x)) → discrete_fun_map f1 g ≡ discrete_fun_map f2 g. Proof. done. Qed. Lemma discrete_fun_map_id {A} {B : A → ofe} (g : discrete_fun B) : discrete_fun_map (λ _, id) g = g. Proof. done. Qed. Lemma discrete_fun_map_compose {A} {B1 B2 B3 : A → ofe} (f1 : ∀ x, B1 x → B2 x) (f2 : ∀ x, B2 x → B3 x) (g : discrete_fun B1) : discrete_fun_map (λ x, f2 x ∘ f1 x) g = discrete_fun_map f2 (discrete_fun_map f1 g). Proof. done. Qed. Global Instance discrete_fun_map_ne {A} {B1 B2 : A → ofe} (f : ∀ x, B1 x → B2 x) n : (∀ x, Proper (dist n ==> dist n) (f x)) → Proper (dist n ==> dist n) (discrete_fun_map f). Proof. by intros ? y1 y2 Hy x; rewrite /discrete_fun_map (Hy x). Qed. Definition discrete_funO_map {A} {B1 B2 : A → ofe} (f : discrete_fun (λ x, B1 x -n> B2 x)) : discrete_funO B1 -n> discrete_funO B2 := OfeMor (discrete_fun_map f). Global Instance discrete_funO_map_ne {A} {B1 B2 : A → ofe} : NonExpansive (@discrete_funO_map A B1 B2). Proof. intros n f1 f2 Hf g x; apply Hf. Qed. Program Definition discrete_funOF {C} (F : C → oFunctor) : oFunctor := {| oFunctor_car A _ B _ := discrete_funO (λ c, oFunctor_car (F c) A B); oFunctor_map A1 _ A2 _ B1 _ B2 _ fg := discrete_funO_map (λ c, oFunctor_map (F c) fg) |}. Next Obligation. intros C F A1 ? A2 ? B1 ? B2 ? n ?? g. by apply discrete_funO_map_ne=>?; apply oFunctor_map_ne. Qed. Next Obligation. intros C F A ? B ? g; simpl. rewrite -{2}(discrete_fun_map_id g). apply discrete_fun_map_ext=> y; apply oFunctor_map_id. Qed. Next Obligation. intros C F A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f1 f2 f1' f2' g. rewrite /= -discrete_fun_map_compose. apply discrete_fun_map_ext=>y; apply oFunctor_map_compose. Qed. Notation "T -d> F" := (@discrete_funOF T%type (λ _, F%OF)) : oFunctor_scope. Global Instance discrete_funOF_contractive {C} (F : C → oFunctor) : (∀ c, oFunctorContractive (F c)) → oFunctorContractive (discrete_funOF F). Proof. intros ? A1 ? A2 ? B1 ? B2 ? n ?? g. by apply discrete_funO_map_ne=>c; apply oFunctor_map_contractive. Qed. (** * Constructing isomorphic OFEs *) Lemma iso_ofe_mixin {A : ofe} {B : Type} `{!Equiv B, !Dist B} (g : B → A) (g_equiv : ∀ y1 y2, y1 ≡ y2 ↔ g y1 ≡ g y2) (g_dist : ∀ n y1 y2, y1 ≡{n}≡ y2 ↔ g y1 ≡{n}≡ g y2) : OfeMixin B. Proof. split. - intros y1 y2. rewrite g_equiv. setoid_rewrite g_dist. apply equiv_dist. - split. + intros y. by apply g_dist. + intros y1 y2. by rewrite !g_dist. + intros y1 y2 y3. rewrite !g_dist. intros ??; etrans; eauto. - intros n m y1 y2. rewrite !g_dist. eauto using dist_le with si_solver. Qed. Section iso_cofe_subtype. Context {A B : ofe} `{Cofe A} (P : A → Prop) (f : ∀ x, P x → B) (g : B → A). Context (g_dist : ∀ n y1 y2, y1 ≡{n}≡ y2 ↔ g y1 ≡{n}≡ g y2). Let Hgne : NonExpansive g. Proof. intros n y1 y2. apply g_dist. Defined. Local Existing Instance Hgne. Context (gf : ∀ x Hx, g (f x Hx) ≡ x). Context (Hlimit : ∀ c : chain B, P (compl (chain_map g c))). Program Definition iso_cofe_subtype : Cofe B := {| compl c := f (compl (chain_map g c)) _ |}. Next Obligation. apply Hlimit. Qed. Next Obligation. intros n c; simpl. apply g_dist. by rewrite gf conv_compl. Qed. End iso_cofe_subtype. Lemma iso_cofe_subtype' {A B : ofe} `{Cofe A} (P : A → Prop) (f : ∀ x, P x → B) (g : B → A) (Pg : ∀ y, P (g y)) (g_dist : ∀ n y1 y2, y1 ≡{n}≡ y2 ↔ g y1 ≡{n}≡ g y2) (gf : ∀ x Hx, g (f x Hx) ≡ x) (Hlimit : LimitPreserving P) : Cofe B. Proof. apply: (iso_cofe_subtype P f g)=> // c. apply Hlimit=> ?; apply Pg. Qed. Definition iso_cofe {A B : ofe} `{Cofe A} (f : A → B) (g : B → A) (g_dist : ∀ n y1 y2, y1 ≡{n}≡ y2 ↔ g y1 ≡{n}≡ g y2) (gf : ∀ x, g (f x) ≡ x) : Cofe B. Proof. by apply (iso_cofe_subtype (λ _, True) (λ x _, f x) g). Qed. (** * Sigma type *) Section sigma. Context {A : ofe} {P : A → Prop}. Implicit Types x : sig P. (* TODO: Find a better place for this Equiv instance. It also should not depend on A being an OFE. *) Local Instance sig_equiv : Equiv (sig P) := λ x1 x2, `x1 ≡ `x2. Local Instance sig_dist : Dist (sig P) := λ n x1 x2, `x1 ≡{n}≡ `x2. Definition sig_equiv_def x y : (x ≡ y) = (`x ≡ `y) := reflexivity _. Definition sig_dist_def n x y : (x ≡{n}≡ y) = (`x ≡{n}≡ `y) := reflexivity _. Lemma exist_ne n a1 a2 (H1 : P a1) (H2 : P a2) : a1 ≡{n}≡ a2 → a1 ↾ H1 ≡{n}≡ a2 ↾ H2. Proof. done. Qed. Global Instance proj1_sig_ne : NonExpansive (@proj1_sig _ P). Proof. by intros n [a Ha] [b Hb] ?. Qed. Definition sig_ofe_mixin : OfeMixin (sig P). Proof. by apply (iso_ofe_mixin proj1_sig). Qed. Canonical Structure sigO : ofe := Ofe (sig P) sig_ofe_mixin. Global Instance sig_cofe `{!Cofe A, !LimitPreserving P} : Cofe sigO. Proof. apply (iso_cofe_subtype' P (exist P) proj1_sig)=> //. by intros []. Qed. Global Instance sig_discrete (x : sig P) : Discrete (`x) → Discrete x. Proof. intros ? y. rewrite sig_dist_def sig_equiv_def. apply (discrete_0 _). Qed. Global Instance sig_ofe_discrete : OfeDiscrete A → OfeDiscrete sigO. Proof. intros ??. apply _. Qed. End sigma. Global Arguments sigO {_} _. (** * SigmaT type *) (** Ofe for [sigT]. The first component must be discrete and use Leibniz equality, while the second component might be any OFE. *) Section sigT. Import EqNotations. Context {A : Type} {P : A → ofe}. Implicit Types x : sigT P. (** The distance for [{ a : A & P }] uses Leibniz equality on [A] to transport the second components to the same type, and then step-indexed distance on the second component. Unlike in the topos of trees, with (C)OFEs we cannot use step-indexed equality on the first component. *) Local Instance sigT_dist : Dist (sigT P) := λ n x1 x2, ∃ Heq : projT1 x1 = projT1 x2, rew Heq in projT2 x1 ≡{n}≡ projT2 x2. (** Usually we'd give a direct definition, and show it equivalent to [∀ n, x1 ≡{n}≡ x2] when proving the [equiv_dist] OFE axiom. But here the equivalence requires UIP — see [sigT_equiv_eq_alt]. By defining [equiv] in terms of [dist], we can define an OFE without assuming UIP, at the cost of complex reasoning on [equiv]. *) Local Instance sigT_equiv : Equiv (sigT P) := λ x1 x2, ∀ n, x1 ≡{n}≡ x2. (** Unfolding lemmas. Written with [↔] not [=] to avoid https://github.com/coq/coq/issues/3814. *) Definition sigT_equiv_eq x1 x2 : (x1 ≡ x2) ↔ ∀ n, x1 ≡{n}≡ x2 := reflexivity _. Definition sigT_dist_eq x1 x2 n : (x1 ≡{n}≡ x2) ↔ ∃ Heq : projT1 x1 = projT1 x2, (rew Heq in projT2 x1) ≡{n}≡ projT2 x2 := reflexivity _. Definition sigT_dist_proj1 n {x y} : x ≡{n}≡ y → projT1 x = projT1 y := proj1_ex. Definition sigT_equiv_proj1 {x y} : x ≡ y → projT1 x = projT1 y := λ H, proj1_ex (H 0). Definition sigT_ofe_mixin : OfeMixin (sigT P). Proof. split => // n. - split; hnf; setoid_rewrite sigT_dist_eq. + intros. by exists eq_refl. + move => [xa x] [ya y] /=. destruct 1 as [-> Heq]. by exists eq_refl. + move => [xa x] [ya y] [za z] /=. destruct 1 as [-> Heq1]. destruct 1 as [-> Heq2]. exists eq_refl => /=. by trans y. - setoid_rewrite sigT_dist_eq. move => m [xa x] [ya y] /=. destruct 1 as [-> Heq]. exists eq_refl. by eapply dist_dist_later. Qed. Canonical Structure sigTO : ofe := Ofe (sigT P) sigT_ofe_mixin. Lemma sigT_equiv_eq_alt `{!∀ a b : A, ProofIrrel (a = b)} x1 x2 : x1 ≡ x2 ↔ ∃ Heq : projT1 x1 = projT1 x2, rew Heq in projT2 x1 ≡ projT2 x2. Proof. setoid_rewrite equiv_dist; setoid_rewrite sigT_dist_eq; split => Heq. - move: (Heq 0) => [H0eq1 _]. exists H0eq1 => n. move: (Heq n) => [] Hneq1. by rewrite (proof_irrel H0eq1 Hneq1). - move: Heq => [Heq1 Heqn2] n. by exists Heq1. Qed. (** [projT1] is non-expansive and proper. *) Global Instance projT1_ne : NonExpansive (projT1 : sigTO → leibnizO A). Proof. solve_proper. Qed. Global Instance projT1_proper : Proper ((≡) ==> (≡)) (projT1 : sigTO → leibnizO A). Proof. apply ne_proper, projT1_ne. Qed. (** [projT2] is "non-expansive"; the properness lemma [projT2_ne] requires UIP. *) Lemma projT2_ne n (x1 x2 : sigTO) (Heq : x1 ≡{n}≡ x2) : rew (sigT_dist_proj1 n Heq) in projT2 x1 ≡{n}≡ projT2 x2. Proof. by destruct Heq. Qed. Lemma projT2_proper `{!∀ a b : A, ProofIrrel (a = b)} (x1 x2 : sigTO) (Heqs : x1 ≡ x2): rew (sigT_equiv_proj1 Heqs) in projT2 x1 ≡ projT2 x2. Proof. move: x1 x2 Heqs => [a1 x1] [a2 x2] Heqs. case: (proj1 (sigT_equiv_eq_alt _ _) Heqs) => /=. intros ->. rewrite (proof_irrel (sigT_equiv_proj1 Heqs) eq_refl) /=. done. Qed. (** [existT] is "non-expansive" — general, dependently-typed statement. *) Lemma existT_ne n {i1 i2} {v1 : P i1} {v2 : P i2} : ∀ (Heq : i1 = i2), (rew f_equal P Heq in v1 ≡{n}≡ v2) → existT i1 v1 ≡{n}≡ existT i2 v2. Proof. intros ->; simpl. exists eq_refl => /=. done. Qed. Lemma existT_proper {i1 i2} {v1 : P i1} {v2 : P i2} : ∀ (Heq : i1 = i2), (rew f_equal P Heq in v1 ≡ v2) → existT i1 v1 ≡ existT i2 v2. Proof. intros Heq Heqv n. apply (existT_ne n Heq), equiv_dist, Heqv. Qed. (** [existT] is "non-expansive" — non-dependently-typed version. *) Global Instance existT_ne_2 a : NonExpansive (@existT A P a). Proof. move => ??? Heq. apply (existT_ne _ eq_refl Heq). Qed. Global Instance existT_proper_2 a : Proper ((≡) ==> (≡)) (@existT A P a). Proof. apply ne_proper, _. Qed. Implicit Types (c : chain sigTO). Global Instance sigT_discrete x : Discrete (projT2 x) → Discrete x. Proof. move: x => [xa x] ? [ya y] [] /=; intros -> => /= Hxy n. exists eq_refl => /=. apply equiv_dist, (discrete_0 _), Hxy. Qed. Global Instance sigT_ofe_discrete : (∀ a, OfeDiscrete (P a)) → OfeDiscrete sigTO. Proof. intros ??. apply _. Qed. Lemma sigT_chain_const_proj1 c n : projT1 (c n) = projT1 (c 0). Proof. refine (sigT_dist_proj1 _ (chain_cauchy c 0 n _)). lia. Qed. (* For this COFE construction we need UIP (Uniqueness of Identity Proofs) on [A] (i.e. [∀ x y : A, ProofIrrel (x = y)]. UIP is most commonly obtained from decidable equality (by Hedberg’s theorem, see [stdpp.proof_irrel.eq_pi]). *) Section cofe. Context `{!∀ a b : A, ProofIrrel (a = b)} `{!∀ a, Cofe (P a)}. Program Definition chain_map_snd c : chain (P (projT1 (c 0))) := {| chain_car n := rew (sigT_chain_const_proj1 c n) in projT2 (c n) |}. Next Obligation. move => c n i Hle /=. (* [Hgoal] is our thesis, up to casts: *) case: (chain_cauchy c n i Hle) => [Heqin Hgoal] /=. (* Pretty delicate. We have two casts to [projT1 (c 0)]. We replace those by one cast. *) move: (sigT_chain_const_proj1 c i) (sigT_chain_const_proj1 c n) => Heqi0 Heqn0. (* Rewrite [projT1 (c 0)] to [projT1 (c n)] in goal and [Heqi0]: *) destruct Heqn0. by rewrite /= (proof_irrel Heqi0 Heqin). Qed. Definition sigT_compl : Compl sigTO := λ c, existT (projT1 (chain_car c 0)) (compl (chain_map_snd c)). Global Program Instance sigT_cofe : Cofe sigTO := { compl := sigT_compl }. Next Obligation. intros n c. rewrite /sigT_compl sigT_dist_eq /=. exists (symmetry (sigT_chain_const_proj1 c n)). (* Our thesis, up to casts: *) pose proof (conv_compl n (chain_map_snd c)) as Hgoal. move: (compl (chain_map_snd c)) Hgoal => pc0 /=. destruct (sigT_chain_const_proj1 c n); simpl. done. Qed. End cofe. End sigT. Global Arguments sigTO {_} _. Section sigTOF. Context {A : Type}. Program Definition sigT_map {P1 P2 : A → ofe} : discrete_funO (λ a, P1 a -n> P2 a) -n> sigTO P1 -n> sigTO P2 := λne f xpx, existT _ (f _ (projT2 xpx)). Next Obligation. move => ?? f n [x px] [y py] [/= Heq]. destruct Heq; simpl. exists eq_refl => /=. by f_equiv. Qed. Next Obligation. move => ?? n f g Heq [x px] /=. exists eq_refl => /=. apply Heq. Qed. Program Definition sigTOF (F : A → oFunctor) : oFunctor := {| oFunctor_car A CA B CB := sigTO (λ a, oFunctor_car (F a) A B); oFunctor_map A1 _ A2 _ B1 _ B2 _ fg := sigT_map (λ a, oFunctor_map (F a) fg) |}. Next Obligation. repeat intro. exists eq_refl => /=. solve_proper. Qed. Next Obligation. simpl; intros. apply (existT_proper eq_refl), oFunctor_map_id. Qed. Next Obligation. simpl; intros. apply (existT_proper eq_refl), oFunctor_map_compose. Qed. Global Instance sigTOF_contractive {F} : (∀ a, oFunctorContractive (F a)) → oFunctorContractive (sigTOF F). Proof. repeat intro. apply sigT_map => a. exact: oFunctor_map_contractive. Qed. End sigTOF. Global Arguments sigTOF {_} _%OF. Notation "{ x & P }" := (sigTOF (λ x, P%OF)) : oFunctor_scope. Notation "{ x : A & P }" := (@sigTOF A%type (λ x, P%OF)) : oFunctor_scope. (** * Isomorphisms between OFEs *) Record ofe_iso (A B : ofe) := OfeIso { ofe_iso_1 : A -n> B; ofe_iso_2 : B -n> A; ofe_iso_12 y : ofe_iso_1 (ofe_iso_2 y) ≡ y; ofe_iso_21 x : ofe_iso_2 (ofe_iso_1 x) ≡ x; }. Global Arguments OfeIso {_ _} _ _ _ _. Global Arguments ofe_iso_1 {_ _} _. Global Arguments ofe_iso_2 {_ _} _. Global Arguments ofe_iso_12 {_ _} _ _. Global Arguments ofe_iso_21 {_ _} _ _. Section ofe_iso. Context {A B : ofe}. Local Instance ofe_iso_equiv : Equiv (ofe_iso A B) := λ I1 I2, ofe_iso_1 I1 ≡ ofe_iso_1 I2 ∧ ofe_iso_2 I1 ≡ ofe_iso_2 I2. Local Instance ofe_iso_dist : Dist (ofe_iso A B) := λ n I1 I2, ofe_iso_1 I1 ≡{n}≡ ofe_iso_1 I2 ∧ ofe_iso_2 I1 ≡{n}≡ ofe_iso_2 I2. Global Instance ofe_iso_1_ne : NonExpansive (ofe_iso_1 (A:=A) (B:=B)). Proof. by destruct 1. Qed. Global Instance ofe_iso_2_ne : NonExpansive (ofe_iso_2 (A:=A) (B:=B)). Proof. by destruct 1. Qed. Lemma ofe_iso_ofe_mixin : OfeMixin (ofe_iso A B). Proof. by apply (iso_ofe_mixin (λ I, (ofe_iso_1 I, ofe_iso_2 I))). Qed. Canonical Structure ofe_isoO : ofe := Ofe (ofe_iso A B) ofe_iso_ofe_mixin. Global Instance ofe_iso_cofe `{!Cofe A, !Cofe B} : Cofe ofe_isoO. Proof. apply (iso_cofe_subtype' (λ I : prodO (A -n> B) (B -n> A), (∀ y, I.1 (I.2 y) ≡ y) ∧ (∀ x, I.2 (I.1 x) ≡ x)) (λ I HI, OfeIso (I.1) (I.2) (proj1 HI) (proj2 HI)) (λ I, (ofe_iso_1 I, ofe_iso_2 I))); [by intros []|done|done|]. apply limit_preserving_and; apply limit_preserving_forall=> ?; apply limit_preserving_equiv; first [intros ???; done|solve_proper]. Qed. End ofe_iso. Global Arguments ofe_isoO : clear implicits. Program Definition iso_ofe_refl {A} : ofe_iso A A := OfeIso cid cid _ _. Solve Obligations with done. Definition iso_ofe_sym {A B : ofe} (I : ofe_iso A B) : ofe_iso B A := OfeIso (ofe_iso_2 I) (ofe_iso_1 I) (ofe_iso_21 I) (ofe_iso_12 I). Global Instance iso_ofe_sym_ne {A B} : NonExpansive (iso_ofe_sym (A:=A) (B:=B)). Proof. intros n I1 I2 []; split; simpl; by f_equiv. Qed. Program Definition iso_ofe_trans {A B C} (I : ofe_iso A B) (J : ofe_iso B C) : ofe_iso A C := OfeIso (ofe_iso_1 J ◎ ofe_iso_1 I) (ofe_iso_2 I ◎ ofe_iso_2 J) _ _. Next Obligation. intros A B C I J z; simpl. by rewrite !ofe_iso_12. Qed. Next Obligation. intros A B C I J z; simpl. by rewrite !ofe_iso_21. Qed. Global Instance iso_ofe_trans_ne {A B C} : NonExpansive2 (iso_ofe_trans (A:=A) (B:=B) (C:=C)). Proof. intros n I1 I2 [] J1 J2 []; split; simpl; by f_equiv. Qed. Program Definition iso_ofe_cong (F : oFunctor) `{!Cofe A, !Cofe B} (I : ofe_iso A B) : ofe_iso (oFunctor_apply F A) (oFunctor_apply F B) := OfeIso (oFunctor_map F (ofe_iso_2 I, ofe_iso_1 I)) (oFunctor_map F (ofe_iso_1 I, ofe_iso_2 I)) _ _. Next Obligation. intros F A ? B ? I x. rewrite -oFunctor_map_compose -{2}(oFunctor_map_id F x). apply equiv_dist=> n. apply oFunctor_map_ne; split=> ? /=; by rewrite ?ofe_iso_12 ?ofe_iso_21. Qed. Next Obligation. intros F A ? B ? I y. rewrite -oFunctor_map_compose -{2}(oFunctor_map_id F y). apply equiv_dist=> n. apply oFunctor_map_ne; split=> ? /=; by rewrite ?ofe_iso_12 ?ofe_iso_21. Qed. Global Instance iso_ofe_cong_ne (F : oFunctor) `{!Cofe A, !Cofe B} : NonExpansive (iso_ofe_cong F (A:=A) (B:=B)). Proof. intros n I1 I2 []; split; simpl; by f_equiv. Qed. Global Instance iso_ofe_cong_contractive (F : oFunctor) `{!Cofe A, !Cofe B} : oFunctorContractive F → Contractive (iso_ofe_cong F (A:=A) (B:=B)). Proof. intros ? n I1 I2 HI; split; simpl; f_contractive; by destruct HI. Qed. iris-iris-4.2.0/iris/algebra/proofmode_classes.v000066400000000000000000000060501460620107300216700ustar00rootroot00000000000000From iris.algebra Require Export cmra. From iris.prelude Require Import options. (* The [IsOp a b1 b2] class is used in two directions: to "split" input [a] into outputs [b1] and [b2], and to "merge" inputs [b1] and [b2] into output [a], where in both cases we have [a ≡ b1 ⋅ b2]. Since the [IsOp a b1 b2] class is used in two directions, there are some subtleties we need to account for: - If we want to "merge", we want the "op" instance to be used *last*. That is, before using [IsOp (b1 ⋅ b2) b1 b2], we want to traverse the structure of the term to merge constructors, and we want it to combine terms like [q/2] and [q/2] into [q] instead of [q/2 ⋅ q/2]. - If we want to "split", we want the "op" instance to be used *first*. That is, we want to use [IsOp (b1 ⋅ b2) b1 b2] eagerly, so that for instance, a term like [q1 ⋅ q2] is turned into [q1] and [q2] and not two times [(q1 ⋅ q2) / 2]. To achieve this, there are various classes with different modes: - [IsOp a b1 b2]. This class has no mode, so it can be used even to combine/merge evars. This class has only one direct instance [IsOp (a ⋅ b) a b] with cost 100 (so it is used last), ensuring that the "op" rule is used last when merging. - [IsOp' a b1 b2]. This class requires either [a] OR both [b1] and [b2] to be inputs. All usual instances should be of this class to avoid loops. - [IsOp'LR a b1 b2]. This class requires [a] to be an input and has just one instance [IsOp'LR (a ⋅ b) a b] with cost 0. This ensures that the "op" rule is used first when splitting. *) Class IsOp {A : cmra} (a b1 b2 : A) := is_op : a ≡ b1 ⋅ b2. Global Arguments is_op {_} _ _ _ {_}. Global Hint Mode IsOp + - - - : typeclass_instances. Global Instance is_op_op {A : cmra} (a b : A) : IsOp (a ⋅ b) a b | 100. Proof. by rewrite /IsOp. Qed. Class IsOp' {A : cmra} (a b1 b2 : A) := #[global] is_op' :: IsOp a b1 b2. Global Hint Mode IsOp' + ! - - : typeclass_instances. Global Hint Mode IsOp' + - ! ! : typeclass_instances. Class IsOp'LR {A : cmra} (a b1 b2 : A) := is_op_lr : IsOp a b1 b2. Global Existing Instance is_op_lr | 0. Global Hint Mode IsOp'LR + ! - - : typeclass_instances. Global Instance is_op_lr_op {A : cmra} (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 : cmra} (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 : cmra} (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 : cmra} (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 : cmra} (a : A) b1 b2 : IsOp a b1 b2 → IsOp' (Some a) (Some b1) (Some b2). Proof. by constructor. Qed. iris-iris-4.2.0/iris/algebra/reservation_map.v000066400000000000000000000333721460620107300213660ustar00rootroot00000000000000From iris.algebra Require Export gmap coPset local_updates. From iris.algebra Require Import updates proofmode_classes. From iris.prelude Require Import options. (** The camera [reservation_map A] over a camera [A] extends [gmap positive A] with a notion of "reservation tokens" for a (potentially infinite) set [E : coPset] which represent the right to allocate a map entry at any position [k ∈ E]. The key connectives are [reservation_map_data k a] (the "points-to" assertion of this map), which associates data [a : A] with a key [k : positive], and [reservation_map_token E] (the reservation token), which says that no data has been associated with the indices in the mask [E]. The important properties of this camera are: - The lemma [reservation_map_token_union] enables one to split [reservation_map_token] w.r.t. disjoint union. That is, if we have [E1 ## E2], then we get [reservation_map_token (E1 ∪ E2) = reservation_map_token E1 ⋅ reservation_map_token E2]. - The lemma [reservation_map_alloc] provides a frame preserving update to associate data to a key: [reservation_map_token E ~~> reservation_map_data k a] provided [k ∈ E] and [✓ a]. In the future, it could be interesting to generalize this map to arbitrary key types instead of hard-coding [positive]. *) Record reservation_map (A : Type) := ReservationMap { reservation_map_data_proj : gmap positive A; reservation_map_token_proj : coPset_disj }. Add Printing Constructor reservation_map. Global Arguments ReservationMap {_} _ _. Global Arguments reservation_map_data_proj {_} _. Global Arguments reservation_map_token_proj {_} _. Global Instance: Params (@ReservationMap) 1 := {}. Global Instance: Params (@reservation_map_data_proj) 1 := {}. Global Instance: Params (@reservation_map_token_proj) 1 := {}. Definition reservation_map_data {A : cmra} (k : positive) (a : A) : reservation_map A := ReservationMap {[ k := a ]} ε. Definition reservation_map_token {A : cmra} (E : coPset) : reservation_map A := ReservationMap ∅ (CoPset E). Global Instance: Params (@reservation_map_data) 2 := {}. (* Ofe *) Section ofe. Context {A : ofe}. Implicit Types x y : reservation_map A. Local Instance reservation_map_equiv : Equiv (reservation_map A) := λ x y, reservation_map_data_proj x ≡ reservation_map_data_proj y ∧ reservation_map_token_proj x = reservation_map_token_proj y. Local Instance reservation_map_dist : Dist (reservation_map A) := λ n x y, reservation_map_data_proj x ≡{n}≡ reservation_map_data_proj y ∧ reservation_map_token_proj x = reservation_map_token_proj y. Global Instance ReservationMap_ne : NonExpansive2 (@ReservationMap A). Proof. by split. Qed. Global Instance ReservationMap_proper : Proper ((≡) ==> (=) ==> (≡)) (@ReservationMap A). Proof. by split. Qed. Global Instance reservation_map_data_proj_ne : NonExpansive (@reservation_map_data_proj A). Proof. by destruct 1. Qed. Global Instance reservation_map_data_proj_proper : Proper ((≡) ==> (≡)) (@reservation_map_data_proj A). Proof. by destruct 1. Qed. Definition reservation_map_ofe_mixin : OfeMixin (reservation_map A). Proof. by apply (iso_ofe_mixin (λ x, (reservation_map_data_proj x, reservation_map_token_proj x))). Qed. Canonical Structure reservation_mapO := Ofe (reservation_map A) reservation_map_ofe_mixin. Global Instance ReservationMap_discrete a b : Discrete a → Discrete b → Discrete (ReservationMap a b). Proof. intros ?? [??] [??]; split; unfold_leibniz; by eapply discrete_0. Qed. Global Instance reservation_map_ofe_discrete : OfeDiscrete A → OfeDiscrete reservation_mapO. Proof. intros ? [??]; apply _. Qed. End ofe. Global Arguments reservation_mapO : clear implicits. (* Camera *) Section cmra. Context {A : cmra}. Implicit Types a b : A. Implicit Types x y : reservation_map A. Implicit Types k : positive. Global Instance reservation_map_data_ne i : NonExpansive (@reservation_map_data A i). Proof. solve_proper. Qed. Global Instance reservation_map_data_proper k : Proper ((≡) ==> (≡)) (@reservation_map_data A k). Proof. solve_proper. Qed. Global Instance reservation_map_data_discrete k a : Discrete a → Discrete (reservation_map_data k a). Proof. intros. apply ReservationMap_discrete; apply _. Qed. Global Instance reservation_map_token_discrete E : Discrete (@reservation_map_token A E). Proof. intros. apply ReservationMap_discrete; apply _. Qed. Local Instance reservation_map_valid_instance : Valid (reservation_map A) := λ x, match reservation_map_token_proj x with | CoPset E => ✓ (reservation_map_data_proj x) ∧ (* dom (reservation_map_data_proj x) ⊥ E *) ∀ i, reservation_map_data_proj x !! i = None ∨ i ∉ E | CoPsetBot => False end. Global Arguments reservation_map_valid_instance !_ /. Local Instance reservation_map_validN_instance : ValidN (reservation_map A) := λ n x, match reservation_map_token_proj x with | CoPset E => ✓{n} (reservation_map_data_proj x) ∧ (* dom (reservation_map_data_proj x) ⊥ E *) ∀ i, reservation_map_data_proj x !! i = None ∨ i ∉ E | CoPsetBot => False end. Global Arguments reservation_map_validN_instance !_ /. Local Instance reservation_map_pcore_instance : PCore (reservation_map A) := λ x, Some (ReservationMap (core (reservation_map_data_proj x)) ε). Local Instance reservation_map_op_instance : Op (reservation_map A) := λ x y, ReservationMap (reservation_map_data_proj x ⋅ reservation_map_data_proj y) (reservation_map_token_proj x ⋅ reservation_map_token_proj y). Definition reservation_map_valid_eq : valid = λ x, match reservation_map_token_proj x with | CoPset E => ✓ (reservation_map_data_proj x) ∧ (* dom (reservation_map_data_proj x) ⊥ E *) ∀ i, reservation_map_data_proj x !! i = None ∨ i ∉ E | CoPsetBot => False end := eq_refl _. Definition reservation_map_validN_eq : validN = λ n x, match reservation_map_token_proj x with | CoPset E => ✓{n} (reservation_map_data_proj x) ∧ (* dom (reservation_map_data_proj x) ⊥ E *) ∀ i, reservation_map_data_proj x !! i = None ∨ i ∉ E | CoPsetBot => False end := eq_refl _. Lemma reservation_map_included x y : x ≼ y ↔ reservation_map_data_proj x ≼ reservation_map_data_proj y ∧ reservation_map_token_proj x ≼ reservation_map_token_proj y. Proof. split; [intros [[z1 z2] Hz]; split; [exists z1|exists z2]; apply Hz|]. intros [[z1 Hz1] [z2 Hz2]]; exists (ReservationMap z1 z2); split; auto. Qed. Lemma reservation_map_data_proj_validN n x : ✓{n} x → ✓{n} reservation_map_data_proj x. Proof. by destruct x as [? [?|]]=> // -[??]. Qed. Lemma reservation_map_token_proj_validN n x : ✓{n} x → ✓{n} reservation_map_token_proj x. Proof. by destruct x as [? [?|]]=> // -[??]. Qed. Lemma reservation_map_cmra_mixin : CmraMixin (reservation_map A). Proof. apply cmra_total_mixin. - eauto. - by intros n x y1 y2 [Hy Hy']; split; simpl; rewrite ?Hy ?Hy'. - solve_proper. - intros n [m1 [E1|]] [m2 [E2|]] [Hm ?]=> // -[??]; split; simplify_eq/=. + by rewrite -Hm. + intros i. by rewrite -(dist_None n) -Hm dist_None. - intros [m [E|]]; rewrite reservation_map_valid_eq reservation_map_validN_eq /= ?cmra_valid_validN; naive_solver eauto using O. - intros n [m [E|]]; rewrite reservation_map_validN_eq /=; naive_solver eauto using cmra_validN_S. - split; simpl; [by rewrite assoc|by rewrite assoc_L]. - split; simpl; [by rewrite comm|by rewrite comm_L]. - split; simpl; [by rewrite cmra_core_l|by rewrite left_id_L]. - split; simpl; [by rewrite cmra_core_idemp|done]. - intros ??; rewrite! reservation_map_included; intros [??]. by split; simpl; apply: cmra_core_mono. (* FIXME: FIXME(Coq #6294): needs new unification *) - intros n [m1 [E1|]] [m2 [E2|]]=> //=; rewrite reservation_map_validN_eq /=. rewrite {1}/op /cmra_op /=. case_decide; last done. intros [Hm Hdisj]; split; first by eauto using cmra_validN_op_l. intros i. move: (Hdisj i). rewrite lookup_op. case: (m1 !! i); case: (m2 !! i); set_solver. - intros n x y1 y2 ? [??]; simpl in *. destruct (cmra_extend n (reservation_map_data_proj x) (reservation_map_data_proj y1) (reservation_map_data_proj y2)) as (m1&m2&?&?&?); auto using reservation_map_data_proj_validN. destruct (cmra_extend n (reservation_map_token_proj x) (reservation_map_token_proj y1) (reservation_map_token_proj y2)) as (E1&E2&?&?&?); auto using reservation_map_token_proj_validN. by exists (ReservationMap m1 E1), (ReservationMap m2 E2). Qed. Canonical Structure reservation_mapR := Cmra (reservation_map A) reservation_map_cmra_mixin. Global Instance reservation_map_cmra_discrete : CmraDiscrete A → CmraDiscrete reservation_mapR. Proof. split; first apply _. intros [m [E|]]; rewrite reservation_map_validN_eq reservation_map_valid_eq //=. by intros [?%cmra_discrete_valid ?]. Qed. Local Instance reservation_map_empty_instance : Unit (reservation_map A) := ReservationMap ε ε. Lemma reservation_map_ucmra_mixin : UcmraMixin (reservation_map A). Proof. split; simpl. - rewrite reservation_map_valid_eq /=. split; [apply ucmra_unit_valid|]. set_solver. - split; simpl; [by rewrite left_id|by rewrite left_id_L]. - do 2 constructor; [apply (core_id_core _)|done]. Qed. Canonical Structure reservation_mapUR := Ucmra (reservation_map A) reservation_map_ucmra_mixin. Global Instance reservation_map_data_core_id k a : CoreId a → CoreId (reservation_map_data k a). Proof. do 2 constructor; simpl; auto. apply core_id_core, _. Qed. Lemma reservation_map_data_valid k a : ✓ (reservation_map_data k a) ↔ ✓ a. Proof. rewrite reservation_map_valid_eq /= singleton_valid. set_solver. Qed. Lemma reservation_map_token_valid E : ✓ (reservation_map_token E). Proof. rewrite reservation_map_valid_eq /=. split; first done. by left. Qed. Lemma reservation_map_data_op k a b : reservation_map_data k (a ⋅ b) = reservation_map_data k a ⋅ reservation_map_data k b. Proof. by rewrite {2}/op /reservation_map_op_instance /reservation_map_data /= singleton_op left_id_L. Qed. Lemma reservation_map_data_mono k a b : a ≼ b → reservation_map_data k a ≼ reservation_map_data k b. Proof. intros [c ->]. by rewrite reservation_map_data_op. Qed. Global Instance reservation_map_data_is_op k a b1 b2 : IsOp a b1 b2 → IsOp' (reservation_map_data k a) (reservation_map_data k b1) (reservation_map_data k b2). Proof. rewrite /IsOp' /IsOp=> ->. by rewrite reservation_map_data_op. Qed. Lemma reservation_map_token_union E1 E2 : E1 ## E2 → reservation_map_token (E1 ∪ E2) = reservation_map_token E1 ⋅ reservation_map_token E2. Proof. intros. by rewrite /op /reservation_map_op_instance /reservation_map_token /= coPset_disj_union // left_id_L. Qed. Lemma reservation_map_token_difference E1 E2 : E1 ⊆ E2 → reservation_map_token E2 = reservation_map_token E1 ⋅ reservation_map_token (E2 ∖ E1). Proof. intros. rewrite -reservation_map_token_union; last set_solver. by rewrite -union_difference_L. Qed. Lemma reservation_map_token_valid_op E1 E2 : ✓ (reservation_map_token E1 ⋅ reservation_map_token E2) ↔ E1 ## E2. Proof. rewrite reservation_map_valid_eq /= {1}/op /cmra_op /=. case_decide; last done. split; [done|]; intros _. split. - by rewrite left_id. - intros i. rewrite lookup_op lookup_empty. auto. Qed. Lemma reservation_map_alloc E k a : k ∈ E → ✓ a → reservation_map_token E ~~> reservation_map_data k a. Proof. intros ??. apply cmra_total_update=> n [mf [Ef|]] //. rewrite reservation_map_validN_eq /= {1}/op {1}/cmra_op /=. case_decide; last done. rewrite !left_id_L. intros [Hmf Hdisj]; split. - destruct (Hdisj k) as [Hmfi|]; last set_solver. intros j. rewrite lookup_op. destruct (decide (k = j)) as [<-|]. + rewrite Hmfi lookup_singleton right_id_L. by apply cmra_valid_validN. + by rewrite lookup_singleton_ne // left_id_L. - intros j. destruct (decide (k = j)); first set_solver. rewrite lookup_op lookup_singleton_ne //. destruct (Hdisj j) as [Hmfi|?]; last set_solver. rewrite Hmfi; auto. Qed. Lemma reservation_map_updateP P (Q : reservation_map A → Prop) k a : a ~~>: P → (∀ a', P a' → Q (reservation_map_data k a')) → reservation_map_data k a ~~>: Q. Proof. intros Hup HP. apply cmra_total_updateP=> n [mf [Ef|]] //. rewrite reservation_map_validN_eq /= left_id_L. intros [Hmf Hdisj]. destruct (Hup n (mf !! k)) as (a'&?&?). { move: (Hmf (k)). by rewrite lookup_op lookup_singleton Some_op_opM. } exists (reservation_map_data k a'); split; first by eauto. rewrite /= left_id_L. split. - intros j. destruct (decide (k = j)) as [<-|]. + by rewrite lookup_op lookup_singleton Some_op_opM. + rewrite lookup_op lookup_singleton_ne // left_id_L. move: (Hmf j). rewrite lookup_op. eauto using cmra_validN_op_r. - intros j. move: (Hdisj j). rewrite !lookup_op !op_None !lookup_singleton_None. naive_solver. Qed. Lemma reservation_map_update k a b : a ~~> b → reservation_map_data k a ~~> reservation_map_data k b. Proof. rewrite !cmra_update_updateP. eauto using reservation_map_updateP with subst. Qed. End cmra. Global Arguments reservation_mapR : clear implicits. Global Arguments reservation_mapUR : clear implicits. iris-iris-4.2.0/iris/algebra/sts.v000066400000000000000000000657031460620107300170040ustar00rootroot00000000000000(** This file formalizes the STS construction from the original Iris paper (POPL15). DISCLAIMER: The definition of STSs is included in the Iris development for historical purposes. If you plan to mechanize an Iris proof in Coq, it is usually better to use a more direct encoding of the ghost state you need as a resource algebra (camera). STSs are very painful to use in Coq, and they are therefore barely used in practice. The type [stsT] describes state-transition systems: a type of states, a type of tokens, a step relation between states, and a token assignment function. Then [sts_resR sts], for [sts: stsT], is the resource algebra of "STS resources", which can be fragments ("we are in one of these states", where the set of states needs to be closed under transitions performed without the locally owned tokens), or authoritative ("we are exactly in this state"). The construction is performed via an intermediate internal type, [sts.car]. The reason for this intermediate step is that composition of two STS resources is defined only if their token sets are disjoint and the state sets are not disjoint (i.e., they have at least one element in common). This condition is not decidable, so we cannot use the usual approach (used e.g. in [gset_disj]) of just composing those pairs to a dedicated "invalid" element. Instead, [sts_res] consists of an [sts.car] element (fragment or authoritative), together with a [Prop] defining whether this element is valid. That way we can "defer" the validity check from composition to RA validity. *) From stdpp Require Export propset. From iris.algebra Require Export cmra updates. From iris.prelude Require Import options. Local Arguments valid _ _ !_ /. Local Arguments op _ _ !_ !_ /. Local Arguments core _ _ !_ /. (** * Definition of STSs *) Module sts. Structure stsT := Sts { state : Type; token : Type; prim_step : relation state; tok : state → propset token; }. Global Arguments Sts {_ _} _ _. Global Arguments prim_step {_} _ _. Global Arguments tok {_} _. Notation states sts := (propset (state sts)). Notation tokens sts := (propset (token sts)). (** * Theory and definitions *) Section sts. Context {sts : stsT}. (** ** Step relations *) Inductive step : relation (state sts * tokens sts) := | Step s1 s2 T1 T2 : prim_step s1 s2 → tok s1 ## T1 → tok s2 ## T2 → tok s1 ∪ T1 ≡ tok s2 ∪ T2 → step (s1,T1) (s2,T2). Notation steps := (rtc step). Inductive frame_step (T : tokens sts) (s1 s2 : state sts) : Prop := (* Possible alternative definition: (tok s2) ## T) ∧ s \rightarrow s'. This is not equivalent, but it might be good enough? *) | Frame_step T1 T2 : T1 ## tok s1 ∪ T → step (s1,T1) (s2,T2) → frame_step T s1 s2. Notation frame_steps T := (rtc (frame_step T)). (** ** Closure under frame steps *) Record closed (S : states sts) (T : tokens sts) : Prop := Closed { closed_disjoint s : s ∈ S → tok s ## T; closed_step s1 s2 : s1 ∈ S → frame_step T s1 s2 → s2 ∈ S }. Definition up (s : state sts) (T : tokens sts) : states sts := {[ s' | frame_steps T s s' ]}. Definition up_set (S : states sts) (T : tokens sts) : states sts := S ≫= λ s, up s T. (** Tactic setup *) Local Hint Resolve Step : core. Local Hint Extern 50 (equiv (A:=propset _) _ _) => set_solver : sts. Local Hint Extern 50 (¬equiv (A:=propset _) _ _) => set_solver : sts. Local Hint Extern 50 (_ ∈ _) => set_solver : sts. Local Hint Extern 50 (_ ⊆ _) => set_solver : sts. Local Hint Extern 50 (_ ## _) => set_solver : sts. (** ** Setoids *) Local Instance frame_step_mono : Proper (flip (⊆) ==> (=) ==> (=) ==> impl) frame_step. Proof. intros ?? HT ?? <- ?? <-; destruct 1; econstructor; eauto with sts; set_solver. Qed. Global Instance frame_step_proper : Proper ((≡) ==> (=) ==> (=) ==> iff) frame_step. Proof. move=> ?? /set_equiv_subseteq [??]; split; by apply frame_step_mono. Qed. Local Instance closed_proper' : Proper ((≡) ==> (≡) ==> impl) closed. Proof. destruct 3; constructor; intros; setoid_subst; eauto. Qed. Global Instance closed_proper : Proper ((≡) ==> (≡) ==> iff) closed. Proof. by split; apply closed_proper'. Qed. Global Instance up_preserving : Proper ((=) ==> flip (⊆) ==> (⊆)) up. Proof. intros s ? <- T T' HT ; apply elem_of_subseteq. induction 1 as [|s1 s2 s3 [T1 T2]]; [constructor|]. eapply elem_of_PropSet, rtc_l; [eapply Frame_step with T1 T2|]; eauto with sts. Qed. Global Instance up_proper : Proper ((=) ==> (≡) ==> (≡)) up. Proof. by move=> ??? ?? /set_equiv_subseteq [??]; split; apply up_preserving. Qed. Global Instance up_set_preserving : Proper ((⊆) ==> flip (⊆) ==> (⊆)) up_set. Proof. intros S1 S2 HS T1 T2 HT. rewrite /up_set. f_equiv=> // s1 s2. by apply up_preserving. Qed. Global Instance up_set_proper : Proper ((≡) ==> (≡) ==> (≡)) up_set. Proof. move=> S1 S2 /set_equiv_subseteq [??] T1 T2 /set_equiv_subseteq [??]; split; by apply up_set_preserving. Qed. (** ** Properties of closure under frame steps *) Lemma closed_steps S T s1 s2 : closed S T → s1 ∈ S → frame_steps T s1 s2 → s2 ∈ S. Proof. induction 3; eauto using closed_step. Qed. Lemma closed_op T1 T2 S1 S2 : closed S1 T1 → closed S2 T2 → closed (S1 ∩ S2) (T1 ∪ T2). Proof. intros [? Hstep1] [? Hstep2]; split; [set_solver|]. intros s3 s4; rewrite !elem_of_intersection; intros [??] [T3 T4 ?]; split. - apply Hstep1 with s3, Frame_step with T3 T4; auto with sts. - apply Hstep2 with s3, Frame_step with T3 T4; auto with sts. Qed. Lemma step_closed s1 s2 T1 T2 S Tf : step (s1,T1) (s2,T2) → closed S Tf → s1 ∈ S → T1 ## Tf → s2 ∈ S ∧ T2 ## Tf ∧ tok s2 ## T2. Proof. inversion_clear 1 as [???? HR Hs1 Hs2]; intros [? Hstep]??; split_and?; auto. - eapply Hstep with s1, Frame_step with T1 T2; auto with sts. - set_solver -Hstep Hs1 Hs2. Qed. Lemma steps_closed s1 s2 T1 T2 S Tf : steps (s1,T1) (s2,T2) → closed S Tf → s1 ∈ S → T1 ## Tf → tok s1 ## T1 → s2 ∈ S ∧ T2 ## Tf ∧ tok s2 ## T2. Proof. remember (s1,T1) as sT1 eqn:HsT1; remember (s2,T2) as sT2 eqn:HsT2. intros Hsteps; revert s1 T1 HsT1 s2 T2 HsT2. induction Hsteps as [?|? [s2 T2] ? Hstep Hsteps IH]; intros s1 T1 HsT1 s2' T2' ?????; simplify_eq; first done. destruct (step_closed s1 s2 T1 T2 S Tf) as (?&?&?); eauto. Qed. (** ** Properties of the closure operators *) Lemma elem_of_up s T : s ∈ up s T. Proof. constructor. Qed. Lemma subseteq_up_set S T : S ⊆ up_set S T. Proof. intros s ?; apply elem_of_bind; eauto using elem_of_up. Qed. Lemma elem_of_up_set S T s : s ∈ S → s ∈ up_set S T. Proof. apply subseteq_up_set. Qed. Lemma up_up_set s T : up s T ≡ up_set {[ s ]} T. Proof. by rewrite /up_set set_bind_singleton. Qed. Lemma closed_up_set S T : (∀ s, s ∈ S → tok s ## T) → closed (up_set S T) T. Proof. intros HS; unfold up_set; split. - intros s; rewrite !elem_of_bind; intros (s'&Hstep&Hs'). specialize (HS s' Hs'); clear Hs' S. induction Hstep as [s|s1 s2 s3 [T1 T2 ? Hstep] ? IH]; first done. inversion_clear Hstep; apply IH; clear IH; auto with sts. - intros s1 s2; rewrite /up; set_unfold; intros (s&?&?) ?; exists s. split; [eapply rtc_r|]; eauto. Qed. Lemma closed_up s T : tok s ## T → closed (up s T) T. Proof. intros; rewrite -(set_bind_singleton (λ s, up s T) s). apply closed_up_set; set_solver. Qed. Lemma closed_up_set_empty S : closed (up_set S ∅) ∅. Proof. eauto using closed_up_set with sts. Qed. Lemma closed_up_empty s : closed (up s ∅) ∅. Proof. eauto using closed_up with sts. Qed. Lemma up_closed S T : closed S T → up_set S T ≡ S. Proof. intros ?; apply set_equiv_subseteq; split; auto using subseteq_up_set. intros s; unfold up_set; rewrite elem_of_bind; intros (s'&Hstep&?). induction Hstep; eauto using closed_step. Qed. Lemma up_subseteq s T S : closed S T → s ∈ S → sts.up s T ⊆ S. Proof. move=> ?? s' ?. eauto using closed_steps. Qed. Lemma up_set_subseteq S1 T S2 : closed S2 T → S1 ⊆ S2 → sts.up_set S1 T ⊆ S2. Proof. move=> ?? s [s' [? ?]]. eauto using closed_steps. Qed. Lemma up_op s T1 T2 : up s (T1 ∪ T2) ⊆ up s T1 ∩ up s T2. Proof. (* Notice that the other direction does not hold. *) intros x Hx. split; eapply elem_of_PropSet, rtc_subrel; try exact Hx. - intros; eapply frame_step_mono; last first; try done. set_solver+. - intros; eapply frame_step_mono; last first; try done. set_solver+. Qed. End sts. Notation steps := (rtc step). Notation frame_steps T := (rtc (frame_step T)). (* The type of bounds we can give to the state of an STS. On paper, this is the type that we equip with an RA structure. In Coq we have to do some work to model composition only being defined under some non-computable conditions. *) Inductive car (sts : stsT) := | auth : state sts → propset (token sts) → car sts | frag : propset (state sts) → propset (token sts) → car sts. Global Arguments auth {_} _ _. Global Arguments frag {_} _ _. End sts. Notation stsT := sts.stsT. Notation Sts := sts.Sts. (** * STSs form an RA *) Section sts_res. Context {sts : stsT}. Import sts. Implicit Types S : states sts. Implicit Types T : tokens sts. Inductive sts_car_equiv : Equiv (car sts) := | auth_equiv s T1 T2 : T1 ≡ T2 → auth s T1 ≡ auth s T2 | frag_equiv S1 S2 T1 T2 : T1 ≡ T2 → S1 ≡ S2 → frag S1 T1 ≡ frag S2 T2. Local Existing Instance sts_car_equiv. Local Instance sts_car_valid_instance : Valid (car sts) := λ x, match x with | auth s T => tok s ## T | frag S' T => closed S' T ∧ ∃ s, s ∈ S' end. Local Instance sts_car_core_instance : PCore (car sts) := λ x, Some match x with | frag S' _ => frag (up_set S' ∅ ) ∅ | auth s _ => frag (up s ∅) ∅ end. Inductive sts_car_disjoint_instance : Disjoint (car sts) := | frag_frag_disjoint S1 S2 T1 T2 : (∃ s, s ∈ S1 ∩ S2) → T1 ## T2 → frag S1 T1 ## frag S2 T2 | auth_frag_disjoint s S T1 T2 : s ∈ S → T1 ## T2 → auth s T1 ## frag S T2 | frag_auth_disjoint s S T1 T2 : s ∈ S → T1 ## T2 → frag S T1 ## auth s T2. Local Existing Instance sts_car_disjoint_instance. Local Instance sts_op_instance : Op (car sts) := λ x1 x2, match x1, x2 with | frag S1 T1, frag S2 T2 => frag (S1 ∩ S2) (T1 ∪ T2) | auth s T1, frag _ T2 => auth s (T1 ∪ T2) | frag _ T1, auth s T2 => auth s (T1 ∪ T2) | auth s T1, auth _ T2 => auth s (T1 ∪ T2) (* never happens *) end. Local Hint Extern 50 (equiv (A:=propset _) _ _) => set_solver : sts. Local Hint Extern 50 (∃ s : state sts, _) => set_solver : sts. Local Hint Extern 50 (_ ∈ _) => set_solver : sts. Local Hint Extern 50 (_ ⊆ _) => set_solver : sts. Local Hint Extern 50 (_ ## _) => set_solver : sts. Global Instance auth_proper s : Proper ((≡) ==> (≡)) (@auth sts s). Proof. by constructor. Qed. Global Instance frag_proper : Proper ((≡) ==> (≡) ==> (≡)) (@frag sts). Proof. by constructor. Qed. Local Instance sts_car_equivalence: Equivalence ((≡) : relation (car sts)). Proof. split. - by intros []; constructor. - by destruct 1; constructor. - destruct 1; inversion_clear 1; constructor; etrans; eauto. Qed. Local Instance sts_car_op_proper : Proper ((≡@{car sts}) ==> (≡) ==> (≡)) (⋅). Proof. by do 2 destruct 1; constructor; setoid_subst. Qed. Local Instance sts_car_core_proper : Proper ((≡@{car sts}) ==> (≡)) core. Proof. by destruct 1; constructor; setoid_subst. Qed. Local Instance sts_car_valid_proper : Proper ((≡@{car sts}) ==> impl) valid. Proof. by destruct 1; simpl; intros ?; setoid_subst. Qed. Local Instance sts_car_valid_proper' : Proper ((≡@{car sts}) ==> iff) valid. Proof. by split; apply: sts_car_valid_proper. Qed. Local Instance sts_car_disjoint_proper (x : car sts) : Proper ((≡) ==> impl) (disjoint x). Proof. by intros ? [|]; destruct 1; inversion_clear 1; econstructor; setoid_subst. Qed. Local Instance sts_car_disjoint_symmetric : Symmetric (@disjoint (car sts) _). Proof. destruct 1; constructor; auto with sts. Qed. Local Instance sts_car_disjoint_proper' : Proper ((≡@{car sts}) ==> (≡) ==> iff) disjoint. Proof. intros x1 x2 Hx y1 y2 Hy; split. - by rewrite Hy (symmetry_iff (##) x1) (symmetry_iff (##) x2) Hx. - by rewrite -Hy (symmetry_iff (##) x2) (symmetry_iff (##) x1) -Hx. Qed. Local Lemma sts_car_core_valid (x : car sts) : ✓ x → ✓ core x. Proof. destruct x; naive_solver eauto using closed_up, closed_up_set, elem_of_up, elem_of_up_set with sts. Qed. Local Lemma sts_car_op_valid (x y : car sts) : ✓ x → ✓ y → x ## y → ✓ (x ⋅ y). Proof. destruct 3; simpl in *; destruct_and?; eauto using closed_op; select (closed _ _) (fun H => destruct H); set_solver. Qed. Local Lemma sts_car_op_assoc (x y z : car sts) : ✓ x → ✓ y → ✓ z → x ## y → x ⋅ y ## z → x ⋅ (y ⋅ z) ≡ (x ⋅ y) ⋅ z. Proof. destruct x, y, z; intros _ _ _ _ _; constructor; rewrite ?assoc; auto with sts. Qed. Local Lemma sts_car_op_comm (x y : car sts) : ✓ x → ✓ y → x ## y → x ⋅ y ≡ y ⋅ x. Proof. destruct 3; constructor; auto with sts. Qed. Local Lemma sts_car_disjoint_ll (x y z : car sts) : ✓ x → ✓ y → ✓ z → x ## y → x ⋅ y ## z → x ## z. Proof. destruct 4; inversion_clear 1; constructor; auto with sts. Qed. Local Lemma sts_car_disjoint_rl (x y z : car sts) : ✓ x → ✓ y → ✓ z → y ## z → x ## y ⋅ z → x ## y. Proof. intros ???. rewrite !(symmetry_iff _ x). by apply sts_car_disjoint_ll. Qed. Local Lemma sts_car_disjoint_lr (x y z : car sts) : ✓ x → ✓ y → ✓ z → x ## y → x ⋅ y ## z → y ## z. Proof. intros ????. rewrite sts_car_op_comm //. by apply sts_car_disjoint_ll. Qed. Local Lemma sts_car_disjoint_move_l (x y z : car sts) : ✓ x → ✓ y → ✓ z → x ## y → x ⋅ y ## z → x ## y ⋅ z. Proof. destruct 4; inversion_clear 1; constructor; auto with sts. Qed. Local Lemma sts_car_disjoint_move_r (a b c : car sts) : ✓ a → ✓ b → ✓ c → b ## c → a ## b ⋅ c → a ⋅ b ## c. Proof. intros; symmetry; rewrite sts_car_op_comm; eauto using sts_car_disjoint_rl. apply sts_car_disjoint_move_l; auto; by rewrite sts_car_op_comm. Qed. Local Hint Immediate sts_car_disjoint_move_l sts_car_disjoint_move_r : core. Local Lemma sts_car_core_disjoint_l (x : car sts) : ✓ x → core x ## x. Proof. destruct x; constructor; eauto with sts. Qed. Local Lemma sts_car_core_l (x : car sts) : ✓ x → core x ⋅ x ≡ x. Proof. destruct x; constructor; eauto with sts. Qed. Local Lemma sts_car_core_idemp (x : car sts) : ✓ x → core (core x) ≡ core x. Proof. destruct x as [s T|S T]; constructor; auto with sts. + rewrite (up_closed (up _ _)); auto using closed_up with sts. + rewrite (up_closed (up_set _ _)); eauto using closed_up_set with sts. Qed. Local Lemma sts_car_core_mono (x y : car sts) : ∃ z, ✓ x → ✓ y → x ## y → core (x ⋅ y) ≡ core x ⋅ z ∧ ✓ z ∧ core x ## z. Proof. exists (core (x ⋅ y))=> ?? Hxy; split_and?. + destruct Hxy; constructor; unfold up_set; set_solver. + destruct Hxy; simpl; eauto using closed_up_set_empty, closed_up_empty with sts. + destruct Hxy; econstructor; repeat match goal with | |- context [ up_set ?S ?T ] => unless (S ⊆ up_set S T) by done; pose proof (subseteq_up_set S T) | |- context [ up ?s ?T ] => unless (s ∈ up s T) by done; pose proof (elem_of_up s T) end; auto with sts. Qed. (** The resource type for [sts]. *) Record sts_res := StsRes { (** The underlying STS carrier element, storing the actual data. *) sts_car : car sts; (** Defines whether this element is valid. *) sts_valid : Prop; (** Valid elements must have a valid carrier element. *) sts_valid_prf : sts_valid → ✓ sts_car }. Add Printing Constructor sts_res. Global Arguments StsRes _ _ {_}. (** Setoid and OFE for [sts_res]. *) Local Instance sts_equiv : Equiv sts_res := λ x y, (sts_valid x ↔ sts_valid y) ∧ (sts_valid x → sts_car x ≡ sts_car y). Local Instance sts_equivalence : Equivalence (@equiv sts_res _). Proof. split; unfold equiv, sts_equiv. - by intros [x px ?]; simpl. - intros [x px ?] [y py ?]; naive_solver. - intros [x px ?] [y py ?] [z pz ?] [? Hxy] [? Hyz]; simpl in *. split; [|intros; trans y]; tauto. Qed. Canonical Structure sts_resO : ofe := discreteO sts_res. (** RA for [sts_res]. *) Local Instance sts_res_valid_instance : Valid sts_res := sts_valid. Local Program Instance sts_res_pcore_instance : PCore sts_res := λ x, Some (StsRes (core (sts_car x)) (✓ x)). Next Obligation. intros []; naive_solver eauto using sts_car_core_valid. Qed. Local Program Instance sts_res_op_instance : Op sts_res := λ x y, StsRes (sts_car x ⋅ sts_car y) (✓ x ∧ ✓ y ∧ sts_car x ## sts_car y). Next Obligation. intros [] []; naive_solver eauto using sts_car_op_valid. Qed. Definition sts_res_ra_mixin : RAMixin sts_res. Proof. apply ra_total_mixin; first eauto. - intros ??? [? Heq]; split; simpl; [|intros (?&?&?); by rewrite Heq]. split; intros (?&?&?); split_and!; first [rewrite ?Heq; tauto|rewrite -?Heq; tauto|tauto]. - by intros ?? [? Heq]; split; [done|]; simpl; intros ?; rewrite Heq. - intros ?? [??]; naive_solver. - intros [x px ?] [y py ?] [z pz ?]; split; simpl; [intuition eauto 2 using sts_car_disjoint_lr, sts_car_disjoint_rl |intuition eauto using sts_car_op_assoc, sts_car_disjoint_rl]. - intros [x px ?] [y py ?]; split; naive_solver eauto using sts_car_op_comm. - intros [x px ?]; split; naive_solver eauto using sts_car_core_l, sts_car_core_disjoint_l. - intros [x px ?]; split; naive_solver eauto using sts_car_core_idemp. - intros [x px ?] [y py ?] [[z pz ?] [? Hy]]; simpl in *. destruct (sts_car_core_mono x z) as (z'&Hz'). unshelve eexists (StsRes z' (px ∧ py ∧ pz)). { intros (?&?&?); apply Hz'; tauto. } split; simpl; first tauto. intros. rewrite Hy //. tauto. - by intros [x px ?] [y py ?] (?&?&?). Qed. Canonical Structure sts_resR : cmra := discreteR sts_res sts_res_ra_mixin. Global Instance sts_res_disrete_cmra : CmraDiscrete sts_resR. Proof. apply discrete_cmra_discrete. Qed. Global Instance sts_res_cmra_total : CmraTotal sts_resR. Proof. rewrite /CmraTotal; eauto. Qed. Local Definition to_sts_res (x : car sts) : sts_res := @StsRes x (valid x) id. Global Instance to_sts_res_proper : Proper ((≡) ==> (≡)) to_sts_res. Proof. by intros x1 x2 Hx; split; rewrite /= Hx. Qed. Lemma to_sts_res_op a b : (✓ (a ⋅ b) → ✓ a ∧ ✓ b ∧ a ## b) → to_sts_res (a ⋅ b) ≡ to_sts_res a ⋅ to_sts_res b. Proof. split; naive_solver eauto using sts_car_op_valid. Qed. End sts_res. Global Arguments sts_resR : clear implicits. (** Finally, the general theory of STS that should be used by users *) Section sts_definitions. Context {sts : stsT}. Definition sts_auth (s : sts.state sts) (T : sts.tokens sts) : sts_resR sts := to_sts_res (sts.auth s T). Definition sts_frag (S : sts.states sts) (T : sts.tokens sts) : sts_resR sts := to_sts_res (sts.frag S T). Definition sts_frag_up (s : sts.state sts) (T : sts.tokens sts) : sts_resR sts := sts_frag (sts.up s T) T. End sts_definitions. Global Instance: Params (@sts_auth) 2 := {}. Global Instance: Params (@sts_frag) 1 := {}. Global Instance: Params (@sts_frag_up) 2 := {}. Section stsRA. Import sts. Context {sts : stsT}. Implicit Types s : state sts. Implicit Types S : states sts. Implicit Types T : tokens sts. Local Arguments cmra_valid _ !_/. (** Setoids *) Global Instance sts_auth_proper s : Proper ((≡) ==> (≡)) (sts_auth s). Proof. solve_proper. Qed. Global Instance sts_frag_proper : Proper ((≡) ==> (≡) ==> (≡)) (@sts_frag sts). Proof. solve_proper. Qed. Global Instance sts_frag_up_proper s : Proper ((≡) ==> (≡)) (sts_frag_up s). Proof. solve_proper. Qed. (** Validity *) Lemma sts_auth_valid s T : ✓ sts_auth s T ↔ tok s ## T. Proof. done. Qed. Lemma sts_frag_valid S T : ✓ sts_frag S T ↔ closed S T ∧ ∃ s, s ∈ S. Proof. done. Qed. Lemma sts_frag_up_valid s T : ✓ sts_frag_up s T ↔ tok s ## T. Proof. split. - move=>/sts_frag_valid [H _]. apply H, elem_of_up. - intros. apply sts_frag_valid; split. + by apply closed_up. + set_solver+. Qed. Lemma sts_auth_frag_valid_inv s S T1 T2 : ✓ (sts_auth s T1 ⋅ sts_frag S T2) → s ∈ S. Proof. by intros (?&?&Hdisj); inversion Hdisj. Qed. (** Op *) Lemma sts_auth_frag_op s S T : s ∈ S → closed S T → sts_auth s ∅ ⋅ sts_frag S T ≡ sts_auth s T. Proof. intros; split; [split|constructor; set_solver]; simpl. - intros (?&?&?); by apply closed_disjoint with S. - intros; split_and?; last constructor; set_solver. Qed. Lemma sts_auth_frag_up_op s T : sts_auth s ∅ ⋅ sts_frag_up s T ≡ sts_auth s T. Proof. intros; split; [split|constructor; set_solver]; simpl. - intros (?&[??]&?). by apply closed_disjoint with (up s T), elem_of_up. - intros; split_and?. + set_solver+. + by apply closed_up. + exists s. set_solver. + constructor; last set_solver. apply elem_of_up. Qed. Lemma sts_frag_op S1 S2 T1 T2 : T1 ## T2 → sts.closed S1 T1 → sts.closed S2 T2 → sts_frag (S1 ∩ S2) (T1 ∪ T2) ≡ sts_frag S1 T1 ⋅ sts_frag S2 T2. Proof. intros HT HS1 HS2. rewrite /sts_frag -to_sts_res_op //. move=>/=[?[? ?]]. split_and!; [set_solver..|constructor; set_solver]. Qed. (* Notice that the following does *not* hold -- the composition of the two closures is weaker than the closure with the itnersected token set. Also see up_op. Lemma sts_frag_up_op s T1 T2 : T1 ## T2 → sts_frag_up s (T1 ∪ T2) ≡ sts_frag_up s T1 ⋅ sts_frag_up s T2. *) (** Frame preserving updates *) Lemma sts_update_auth s1 s2 T1 T2 : steps (s1,T1) (s2,T2) → sts_auth s1 T1 ~~> sts_auth s2 T2. Proof. intros ?. apply cmra_discrete_total_update. intros [x x_val Hx_val]; simpl. intros (Htok & Hval & Hdisj). specialize (Hx_val Hval). inversion Hdisj as [|? S ? Tf|]; simplify_eq/=; destruct_and?. destruct (steps_closed s1 s2 T1 T2 S Tf) as (?&?&?); auto; []. repeat (done || constructor). Qed. Lemma sts_update_frag S1 S2 T1 T2 : (closed S1 T1 → closed S2 T2 ∧ S1 ⊆ S2 ∧ T2 ⊆ T1) → sts_frag S1 T1 ~~> sts_frag S2 T2. Proof. rewrite /sts_frag=> HC HS HT. apply cmra_discrete_total_update. intros [x x_val Hx_val]; simpl. intros (Htok & Hval & Hdisj). specialize (Hx_val Hval). inversion Hdisj as [|? S ? Tf|]; simplify_eq/=; (destruct HC as (? & ? & ?); first by destruct_and?). - split_and!; first done. + set_solver. + done. + constructor; set_solver. - split_and!; first done. + set_solver. + done. + constructor; set_solver. Qed. Lemma sts_update_frag_up s1 S2 T1 T2 : (tok s1 ## T1 → closed S2 T2) → s1 ∈ S2 → T2 ⊆ T1 → sts_frag_up s1 T1 ~~> sts_frag S2 T2. Proof. intros HC ? HT; apply sts_update_frag. intros HC1; split; last split; eauto using closed_steps. - eapply HC, HC1, elem_of_up. - rewrite <-HT. eapply up_subseteq; last done. apply HC, HC1, elem_of_up. Qed. Lemma sts_up_set_intersection S1 Sf Tf : closed Sf Tf → S1 ∩ Sf ≡ S1 ∩ up_set (S1 ∩ Sf) Tf. Proof. intros Hclf. apply (anti_symm (⊆)). - move=>s [HS1 HSf]. split. + by apply HS1. + by apply subseteq_up_set. - move=>s [HS1 [s' [/elem_of_PropSet Hsup Hs']]]. split; first done. eapply closed_steps, Hsup; first done. set_solver +Hs'. Qed. Global Instance sts_frag_core_id S : CoreId (sts_frag S ∅). Proof. constructor; split=> //= [[??]]. (* FIXME: rewriting with [sts.up_closed] for some reason fails here. *) f_equiv. by rewrite sts.up_closed. Qed. (** Inclusion *) (* This is surprisingly different from to_validity_included. I am not sure whether this is because to_validity_included is non-canonical, or this one here is non-canonical - but I suspect both. *) (* TODO: These have to be proven again. *) (* Lemma sts_frag_included S1 S2 T1 T2 : closed S2 T2 → S2 ≢ ∅ → (sts_frag S1 T1 ≼ sts_frag S2 T2) ↔ (closed S1 T1 ∧ S1 ≢ ∅ ∧ ∃ Tf, T2 ≡ T1 ∪ Tf ∧ T1 ## Tf ∧ S2 ≡ S1 ∩ up_set S2 Tf). Proof. intros ??; split. - intros [[???] ?]. destruct (to_validity_included (sts_dra.car sts) (sts_dra.frag S1 T1) (sts_dra.frag S2 T2)) as [Hfincl Htoincl]. intros Hcl2 HS2ne. split. - intros Hincl. destruct Hfincl as ((Hcl1 & ?) & (z & EQ & Hval & Hdisj)). { split; last done. split; done. } clear Htoincl. split_and!; try done; []. destruct z as [sf Tf|Sf Tf]. { exfalso. inversion_clear EQ. } exists Tf. inversion_clear EQ as [|? ? ? ? HT2 HS2]. inversion_clear Hdisj as [? ? ? ? _ HTdisj | |]. split_and!; [done..|]. rewrite HS2. apply up_set_intersection. apply Hval. - intros (Hcl & Hne & (Tf & HT & HTdisj & HS)). destruct Htoincl as ((Hcl' & ?) & (z & EQ)); last first. { exists z. exact EQ. } clear Hfincl. split; first (split; done). exists (sts_dra.frag (up_set S2 Tf) Tf). split_and!. + constructor; done. + simpl. split. * apply closed_up_set. move=>s Hs2. move:(closed_disjoint _ _ Hcl2 _ Hs2). set_solver +HT. * by apply up_set_non_empty. + constructor; last done. by rewrite -HS. Qed. Lemma sts_frag_included' S1 S2 T : closed S2 T → closed S1 T → S2 ≢ ∅ → S1 ≢ ∅ → S2 ≡ S1 ∩ up_set S2 ∅ → sts_frag S1 T ≼ sts_frag S2 T. Proof. intros. apply sts_frag_included; split_and?; auto. exists ∅; split_and?; done || set_solver+. Qed. *) End stsRA. (** STSs without tokens: Some stuff is simpler *) Module sts_notok. Structure stsT := Sts { state : Type; prim_step : relation state; }. Global Arguments Sts {_} _. Global Arguments prim_step {_} _ _. Notation states sts := (propset (state sts)). Definition stsT_token := Empty_set. Definition stsT_tok {sts : stsT} (_ : state sts) : propset stsT_token := ∅. Canonical Structure sts_notok (sts : stsT) : sts.stsT := sts.Sts (@prim_step sts) stsT_tok. Coercion sts_notok.sts_notok : sts_notok.stsT >-> sts.stsT. Section sts. Context {sts : stsT}. Implicit Types s : state sts. Implicit Types S : states sts. Notation prim_steps := (rtc prim_step). Lemma sts_step s1 s2 : prim_step s1 s2 → sts.step (s1, ∅) (s2, ∅). Proof. intros. split; set_solver. Qed. Lemma sts_steps s1 s2 : prim_steps s1 s2 → sts.steps (s1, ∅) (s2, ∅). Proof. induction 1; eauto using sts_step, rtc_refl, rtc_l. Qed. Lemma frame_prim_step T s1 s2 : sts.frame_step T s1 s2 → prim_step s1 s2. Proof. inversion 1 as [??? Hstep]. by inversion_clear Hstep. Qed. Lemma prim_frame_step T s1 s2 : prim_step s1 s2 → sts.frame_step T s1 s2. Proof. intros Hstep. apply sts.Frame_step with ∅ ∅; first set_solver. by apply sts_step. Qed. Lemma mk_closed S : (∀ s1 s2, s1 ∈ S → prim_step s1 s2 → s2 ∈ S) → sts.closed S ∅. Proof. intros ?. constructor; [by set_solver|eauto using frame_prim_step]. Qed. End sts. End sts_notok. Notation sts_notokT := sts_notok.stsT. Notation Sts_NoTok := sts_notok.Sts. Section sts_notokRA. Context {sts : sts_notokT}. Import sts_notok. Implicit Types s : state sts. Implicit Types S : states sts. Lemma sts_notok_update_auth s1 s2 : rtc prim_step s1 s2 → sts_auth s1 ∅ ~~> sts_auth s2 ∅. Proof. intros. by apply sts_update_auth, sts_steps. Qed. End sts_notokRA. iris-iris-4.2.0/iris/algebra/ufrac.v000066400000000000000000000032231460620107300172600ustar00rootroot00000000000000(** This file provides an "unbounded" version of the fractional camera whose elements are in the interval (0,..) instead of (0,1]. *) From iris.algebra Require Export cmra. From iris.algebra Require Import proofmode_classes. From iris.prelude Require Import options. (** Since the standard (0,1] fractional camera [frac] is used more often, we define [ufrac] through a [Definition] instead of a [Notation]. That way, Coq infers the [frac] camera by default when using the [Qp] type. *) Definition ufrac := Qp. Section ufrac. Implicit Types p q : ufrac. Canonical Structure ufracO := leibnizO ufrac. Local Instance ufrac_valid_instance : Valid ufrac := λ x, True. Local Instance ufrac_pcore_instance : PCore ufrac := λ _, None. Local Instance ufrac_op_instance : Op ufrac := λ x y, (x + y)%Qp. Lemma ufrac_op p q : p ⋅ q = (p + q)%Qp. Proof. done. Qed. Lemma ufrac_included p q : p ≼ q ↔ (p < q)%Qp. Proof. by rewrite Qp.lt_sum. Qed. Corollary ufrac_included_weak p q : p ≼ q → (p ≤ q)%Qp. Proof. rewrite ufrac_included. apply Qp.lt_le_incl. Qed. Definition ufrac_ra_mixin : RAMixin ufrac. Proof. split; try apply _; try done. Qed. Canonical Structure ufracR := discreteR ufrac ufrac_ra_mixin. Global Instance ufrac_cmra_discrete : CmraDiscrete ufracR. Proof. apply discrete_cmra_discrete. Qed. Global Instance ufrac_cancelable q : Cancelable q. Proof. intros n p1 p2 _. apply (inj (Qp.add q)). Qed. Global Instance ufrac_id_free q : IdFree q. Proof. intros p _. apply Qp.add_id_free. Qed. Global Instance is_op_ufrac q : IsOp' q (q/2)%Qp (q/2)%Qp. Proof. by rewrite /IsOp' /IsOp ufrac_op Qp.div_2. Qed. End ufrac. iris-iris-4.2.0/iris/algebra/updates.v000066400000000000000000000236231460620107300176330ustar00rootroot00000000000000From iris.algebra Require Export cmra. From iris.prelude Require Import options. (** * Frame preserving updates *) (* This quantifies over [option A] for the frame. That is necessary to make the following hold: x ~~> P → Some c ~~> Some P *) Definition cmra_updateP {A : cmra} (x : A) (P : A → Prop) := ∀ n mz, ✓{n} (x ⋅? mz) → ∃ y, P y ∧ ✓{n} (y ⋅? mz). Global Instance: Params (@cmra_updateP) 1 := {}. Infix "~~>:" := cmra_updateP (at level 70). Definition cmra_update {A : cmra} (x y : A) := ∀ n mz, ✓{n} (x ⋅? mz) → ✓{n} (y ⋅? mz). Infix "~~>" := cmra_update (at level 70). Global Instance: Params (@cmra_update) 1 := {}. Section updates. Context {A : cmra}. Implicit Types x y : A. Global Instance cmra_updateP_proper : Proper ((≡) ==> pointwise_relation _ iff ==> iff) (@cmra_updateP A). Proof. rewrite /pointwise_relation /cmra_updateP=> x x' Hx P P' HP; split=> ? n mz; setoid_subst; naive_solver. Qed. Global Instance cmra_update_proper : Proper ((≡) ==> (≡) ==> iff) (@cmra_update A). Proof. rewrite /cmra_update=> x x' Hx y y' Hy; split=> ? n mz ?; setoid_subst; auto. Qed. Lemma cmra_update_updateP x y : x ~~> y ↔ x ~~>: (y =.). Proof. split=> Hup n z ?; eauto. destruct (Hup n z) as (?&<-&?); auto. Qed. Lemma cmra_updateP_id (P : A → Prop) x : P x → x ~~>: P. Proof. intros ? n mz ?; eauto. Qed. Lemma cmra_updateP_compose (P Q : A → Prop) x : x ~~>: P → (∀ y, P y → y ~~>: Q) → x ~~>: Q. Proof. intros Hx Hy n mz ?. destruct (Hx n mz) as (y&?&?); naive_solver. Qed. Lemma cmra_updateP_compose_l (Q : A → Prop) x y : x ~~> y → y ~~>: Q → x ~~>: Q. Proof. rewrite cmra_update_updateP. intros; apply cmra_updateP_compose with (y =.); naive_solver. Qed. Lemma cmra_updateP_weaken (P Q : A → Prop) x : x ~~>: P → (∀ y, P y → Q y) → x ~~>: Q. Proof. eauto using cmra_updateP_compose, cmra_updateP_id. Qed. Lemma cmra_update_exclusive `{!Exclusive x} y: ✓ y → x ~~> y. Proof. move=>??[z|]=>[/exclusiveN_l[]|_]. by apply cmra_valid_validN. Qed. (** Updates form a preorder. *) (** We set this rewrite relation's cost above the stdlib's ([impl], [iff], [eq], ...) and [≡] but below [⊑]. [eq] (at 100) < [≡] (at 150) < [cmra_update] (at 170) < [⊑] (at 200) *) Global Instance cmra_update_rewrite_relation : RewriteRelation (@cmra_update A) | 170 := {}. Global Instance cmra_update_preorder : PreOrder (@cmra_update A). Proof. split. - intros x. by apply cmra_update_updateP, cmra_updateP_id. - intros x y z. rewrite !cmra_update_updateP. eauto using cmra_updateP_compose with subst. Qed. Global Instance cmra_update_proper_update : Proper (flip cmra_update ==> cmra_update ==> impl) (@cmra_update A). Proof. intros x1 x2 Hx y1 y2 Hy ?. etrans; [apply Hx|]. by etrans; [|apply Hy]. Qed. Global Instance cmra_update_flip_proper_update : Proper (cmra_update ==> flip cmra_update ==> flip impl) (@cmra_update A). Proof. intros x1 x2 Hx y1 y2 Hy ?. etrans; [apply Hx|]. by etrans; [|apply Hy]. Qed. Lemma cmra_updateP_op (P1 P2 Q : A → Prop) x1 x2 : x1 ~~>: P1 → x2 ~~>: P2 → (∀ y1 y2, P1 y1 → P2 y2 → Q (y1 ⋅ y2)) → x1 ⋅ x2 ~~>: Q. Proof. intros Hx1 Hx2 Hy n mz ?. destruct (Hx1 n (Some (x2 ⋅? mz))) as (y1&?&?). { by rewrite /= -cmra_op_opM_assoc. } destruct (Hx2 n (Some (y1 ⋅? mz))) as (y2&?&?). { by rewrite /= -cmra_op_opM_assoc (comm _ x2) cmra_op_opM_assoc. } exists (y1 ⋅ y2); split; last rewrite (comm _ y1) cmra_op_opM_assoc; auto. Qed. Lemma cmra_updateP_op' (P1 P2 : A → Prop) x1 x2 : x1 ~~>: P1 → x2 ~~>: P2 → x1 ⋅ x2 ~~>: λ y, ∃ y1 y2, y = y1 ⋅ y2 ∧ P1 y1 ∧ P2 y2. Proof. eauto 10 using cmra_updateP_op. Qed. Lemma cmra_update_op x1 x2 y1 y2 : x1 ~~> y1 → x2 ~~> y2 → x1 ⋅ x2 ~~> y1 ⋅ y2. Proof. rewrite !cmra_update_updateP; eauto using cmra_updateP_op with congruence. Qed. Global Instance cmra_update_op_proper : Proper (cmra_update ==> cmra_update ==> cmra_update) (op (A:=A)). Proof. intros x1 x2 Hx y1 y2 Hy. by apply cmra_update_op. Qed. Global Instance cmra_update_op_flip_proper : Proper (flip cmra_update ==> flip cmra_update ==> flip cmra_update) (op (A:=A)). Proof. intros x1 x2 Hx y1 y2 Hy. by apply cmra_update_op. Qed. Lemma cmra_update_op_l x y : x ⋅ y ~~> x. Proof. intros n mz. rewrite comm cmra_op_opM_assoc. apply cmra_validN_op_r. Qed. Lemma cmra_update_op_r x y : x ⋅ y ~~> y. Proof. rewrite comm. apply cmra_update_op_l. Qed. Lemma cmra_update_included x y : x ≼ y → y ~~> x. Proof. intros [z ->]. apply cmra_update_op_l. Qed. Lemma cmra_update_valid0 x y : (✓{0} x → x ~~> y) → x ~~> y. Proof. intros H n mz Hmz. apply H, Hmz. apply (cmra_validN_le n); last lia. destruct mz. - eapply cmra_validN_op_l, Hmz. - apply Hmz. Qed. (** ** Frame preserving updates for total and discete CMRAs *) Lemma cmra_total_updateP `{!CmraTotal A} x (P : A → Prop) : x ~~>: P ↔ ∀ n z, ✓{n} (x ⋅ z) → ∃ y, P y ∧ ✓{n} (y ⋅ z). Proof. split=> Hup; [intros n z; apply (Hup n (Some z))|]. intros n [z|] ?; simpl; [by apply Hup|]. destruct (Hup n (core x)) as (y&?&?); first by rewrite cmra_core_r. eauto using cmra_validN_op_l. Qed. Lemma cmra_total_update `{!CmraTotal A} x y : x ~~> y ↔ ∀ n z, ✓{n} (x ⋅ z) → ✓{n} (y ⋅ z). Proof. rewrite cmra_update_updateP cmra_total_updateP. naive_solver. Qed. Lemma cmra_discrete_updateP `{!CmraDiscrete A} (x : A) (P : A → Prop) : x ~~>: P ↔ ∀ mz, ✓ (x ⋅? mz) → ∃ y, P y ∧ ✓ (y ⋅? mz). Proof. unfold cmra_updateP. setoid_rewrite <-cmra_discrete_valid_iff. naive_solver eauto using O. Qed. Lemma cmra_discrete_update `{!CmraDiscrete A} (x y : A) : x ~~> y ↔ ∀ mz, ✓ (x ⋅? mz) → ✓ (y ⋅? mz). Proof. unfold cmra_update. setoid_rewrite <-cmra_discrete_valid_iff. naive_solver eauto using O. Qed. Lemma cmra_discrete_total_updateP `{!CmraDiscrete A, CmraTotal A} (x : A) (P : A → Prop) : x ~~>: P ↔ ∀ z, ✓ (x ⋅ z) → ∃ y, P y ∧ ✓ (y ⋅ z). Proof. rewrite cmra_total_updateP; setoid_rewrite <-cmra_discrete_valid_iff. naive_solver eauto using O. Qed. Lemma cmra_discrete_total_update `{!CmraDiscrete A, CmraTotal A} (x y : A) : x ~~> y ↔ ∀ z, ✓ (x ⋅ z) → ✓ (y ⋅ z). Proof. rewrite cmra_total_update; setoid_rewrite <-cmra_discrete_valid_iff. naive_solver eauto using O. Qed. End updates. (** * Transport *) Section cmra_transport. Context {A B : cmra} (H : A = B). Notation T := (cmra_transport H). Lemma cmra_transport_updateP (P : A → Prop) (Q : B → Prop) x : x ~~>: P → (∀ y, P y → Q (T y)) → T x ~~>: Q. Proof. destruct H; eauto using cmra_updateP_weaken. Qed. Lemma cmra_transport_updateP' (P : A → Prop) x : x ~~>: P → T x ~~>: λ y, ∃ y', y = cmra_transport H y' ∧ P y'. Proof. eauto using cmra_transport_updateP. Qed. End cmra_transport. (** * Isomorphism *) Section iso_cmra. Context {A B : cmra} (f : A → B) (g : B → A). Lemma iso_cmra_updateP (P : B → Prop) (Q : A → Prop) y (gf : ∀ x, g (f x) ≡ x) (g_op : ∀ y1 y2, g (y1 ⋅ y2) ≡ g y1 ⋅ g y2) (g_validN : ∀ n y, ✓{n} (g y) ↔ ✓{n} y) : y ~~>: P → (∀ y', P y' → Q (g y')) → g y ~~>: Q. Proof. intros Hup Hx n mz Hmz. destruct (Hup n (f <$> mz)) as (y'&HPy'&Hy'%g_validN). { apply g_validN. destruct mz as [z|]; simpl in *; [|done]. by rewrite g_op gf. } exists (g y'); split; [by eauto|]. destruct mz as [z|]; simpl in *; [|done]. revert Hy'. by rewrite g_op gf. Qed. Lemma iso_cmra_updateP' (P : B → Prop) y (gf : ∀ x, g (f x) ≡ x) (g_op : ∀ y1 y2, g (y1 ⋅ y2) ≡ g y1 ⋅ g y2) (g_validN : ∀ n y, ✓{n} (g y) ↔ ✓{n} y) : y ~~>: P → g y ~~>: λ x, ∃ y, x = g y ∧ P y. Proof. eauto using iso_cmra_updateP. Qed. End iso_cmra. Section update_lift_cmra. Context {A B : cmra}. Implicit Types a : A. Implicit Types b : B. (** This lemma shows that if [f] maps non-deterministic updates from [B] to [A] (i.e., [cmra_updateP] / [~~>:]), then [f] also maps deterministic updates from [B] to [A] (i.e., [cmra_update] / [~~>]) *) Lemma cmra_update_lift_updateP (f : B → A) b b' : (∀ P, b ~~>: P → f b ~~>: λ a', ∃ b', a' = f b' ∧ P b') → b ~~> b' → f b ~~> f b'. Proof. intros Hgen Hupd. eapply cmra_update_updateP, cmra_updateP_weaken. { eapply Hgen, cmra_update_updateP, Hupd. } naive_solver. Qed. End update_lift_cmra. (** * Product *) Section prod. Context {A B : cmra}. Implicit Types x : A * B. Lemma prod_updateP P1 P2 (Q : A * B → Prop) x : x.1 ~~>: P1 → x.2 ~~>: P2 → (∀ a b, P1 a → P2 b → Q (a,b)) → x ~~>: Q. Proof. intros Hx1 Hx2 HP n mz [??]; simpl in *. destruct (Hx1 n (fst <$> mz)) as (a&?&?); first by destruct mz. destruct (Hx2 n (snd <$> mz)) as (b&?&?); first by destruct mz. exists (a,b); repeat split; destruct mz; auto. Qed. Lemma prod_updateP' P1 P2 x : x.1 ~~>: P1 → x.2 ~~>: P2 → x ~~>: λ y, P1 (y.1) ∧ P2 (y.2). Proof. eauto using prod_updateP. Qed. Lemma prod_update x y : x.1 ~~> y.1 → x.2 ~~> y.2 → x ~~> y. Proof. rewrite !cmra_update_updateP. destruct x, y; eauto using prod_updateP with subst. Qed. End prod. (** * Option *) Section option. Context {A : cmra}. Implicit Types x y : A. Lemma option_updateP (P : A → Prop) (Q : option A → Prop) x : x ~~>: P → (∀ y, P y → Q (Some y)) → Some x ~~>: Q. Proof. intros Hx Hy; apply cmra_total_updateP=> n [y|] ?. { destruct (Hx n (Some y)) as (y'&?&?); auto. exists (Some y'); auto. } destruct (Hx n None) as (y'&?&?); rewrite ?cmra_core_r; auto. by exists (Some y'); auto. Qed. Lemma option_updateP' (P : A → Prop) x : x ~~>: P → Some x ~~>: from_option P False. Proof. eauto using option_updateP. Qed. Lemma option_update x y : x ~~> y → Some x ~~> Some y. Proof. rewrite !cmra_update_updateP; eauto using option_updateP with subst. Qed. End option. iris-iris-4.2.0/iris/algebra/vector.v000066400000000000000000000102071460620107300174620ustar00rootroot00000000000000From stdpp Require Export vector. From iris.algebra Require Export ofe. From iris.algebra Require Import list. From iris.prelude Require Import options. Section ofe. Context {A : ofe}. Local Instance vec_equiv m : Equiv (vec A m) := equiv (A:=list A). Local Instance vec_dist m : Dist (vec A m) := dist (A:=list A). Definition vec_ofe_mixin m : OfeMixin (vec A m). Proof. by apply (iso_ofe_mixin vec_to_list). Qed. Canonical Structure vecO m : ofe := Ofe (vec A m) (vec_ofe_mixin m). Global Instance list_cofe `{!Cofe A} m : Cofe (vecO m). Proof. apply: (iso_cofe_subtype (λ l : list A, length l = m) (λ l, eq_rect _ (vec A) (list_to_vec l) m) vec_to_list)=> //. - intros v []. by rewrite /= vec_to_list_to_vec. - intros c. by rewrite (conv_compl 0 (chain_map _ c)) /= vec_to_list_length. Qed. Global Instance vnil_discrete : Discrete (@vnil A). Proof. intros v _. by inv_vec v. Qed. Global Instance vcons_discrete n x (v : vec A n) : Discrete x → Discrete v → Discrete (x ::: v). Proof. intros ?? v' ?. inv_vec v'=>x' v'. inversion_clear 1. constructor. - by eapply discrete. - change (v ≡ v'). by eapply discrete. Qed. Global Instance vec_ofe_discrete m : OfeDiscrete A → OfeDiscrete (vecO m). Proof. intros ? v. induction v; apply _. Qed. End ofe. Global Arguments vecO : clear implicits. Global Typeclasses Opaque vec_dist. Section proper. Context {A : ofe}. Global Instance vcons_ne n : Proper (dist n ==> forall_relation (λ x, dist n ==> dist n)) (@vcons A). Proof. by constructor. Qed. Global Instance vcons_proper : Proper (equiv ==> forall_relation (λ x, equiv ==> equiv)) (@vcons A). Proof. by constructor. Qed. Global Instance vlookup_ne n m : Proper (dist n ==> eq ==> dist n) (@Vector.nth A m). Proof. intros v. induction v as [|x m v IH]; intros v'; inv_vec v'. - intros _ x. inv_fin x. - intros x' v' EQ i ? <-. inversion_clear EQ. inv_fin i=> // i. by apply IH. Qed. Global Instance vlookup_proper m : Proper (equiv ==> eq ==> equiv) (@Vector.nth A m). Proof. intros v v' ? x x' ->. apply equiv_dist=> n. f_equiv. by apply equiv_dist. Qed. Global Instance vec_to_list_ne m : NonExpansive (@vec_to_list A m). Proof. by intros v v'. Qed. Global Instance vec_to_list_proper m : Proper ((≡) ==> (≡)) (@vec_to_list A m). Proof. by intros v v'. Qed. End proper. (** Functor *) Definition vec_map {A B : ofe} m (f : A → B) : vecO A m → vecO B m := @vmap A B f m. Lemma vec_map_ext_ne {A B : ofe} m (f g : A → B) (v : vec A m) n : (∀ x, f x ≡{n}≡ g x) → vec_map m f v ≡{n}≡ vec_map m g v. Proof. intros Hf. eapply (list_fmap_ext_ne f g v) in Hf. by rewrite -!vec_to_list_map in Hf. Qed. Global Instance vec_map_ne {A B : ofe} m f n : Proper (dist n ==> dist n) f → Proper (dist n ==> dist n) (@vec_map A B m f). Proof. intros ? v v' H. eapply list_fmap_ne in H; last done. by rewrite -!vec_to_list_map in H. Qed. Definition vecO_map {A B : ofe} m (f : A -n> B) : vecO A m -n> vecO B m := OfeMor (vec_map m f). Global Instance vecO_map_ne {A A'} m : NonExpansive (@vecO_map A A' m). Proof. intros n f g ? v. by apply vec_map_ext_ne. Qed. Program Definition vecOF (F : oFunctor) m : oFunctor := {| oFunctor_car A _ B _ := vecO (oFunctor_car F A B) m; oFunctor_map A1 _ A2 _ B1 _ B2 _ fg := vecO_map m (oFunctor_map F fg) |}. Next Obligation. intros F A1 ? A2 ? B1 ? B2 ? n m f g Hfg. by apply vecO_map_ne, oFunctor_map_ne. Qed. Next Obligation. intros F m A ? B ? l. change (vec_to_list (vec_map m (oFunctor_map F (cid, cid)) l) ≡ l). rewrite vec_to_list_map. apply listOF. Qed. Next Obligation. intros F m A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' l. change (vec_to_list (vec_map m (oFunctor_map F (f ◎ g, g' ◎ f')) l) ≡ vec_map m (oFunctor_map F (g, g')) (vec_map m (oFunctor_map F (f, f')) l)). rewrite !vec_to_list_map. by apply: (oFunctor_map_compose (listOF F) f g f' g'). Qed. Global Instance vecOF_contractive F m : oFunctorContractive F → oFunctorContractive (vecOF F m). Proof. by intros ?? A1 ? A2 ? B1 ? B2 ? n ???; apply vecO_map_ne; first apply oFunctor_map_contractive. Qed. iris-iris-4.2.0/iris/algebra/view.v000066400000000000000000000737151460620107300171470ustar00rootroot00000000000000From iris.algebra Require Export updates local_updates frac dfrac agree. From iris.algebra Require Import proofmode_classes big_op. From iris.prelude Require Import options. (** The view camera with fractional authoritative elements *) (** The view camera, which is reminiscent of the views framework, is used to provide a logical/"small-footprint" "view" of some "large-footprint" piece of data, which can be shared in the separation logic sense, i.e., different parts of the data can be separately owned by different functions or threads. This is achieved using the two elements of the view camera: - The authoritative element [●V a], which describes the data under consideration. - The fragment [◯V b], which provides a logical view of the data [a]. To enable sharing of the fragments, the type of fragments is equipped with a camera structure so ownership of fragments can be split. Concretely, fragments enjoy the rule [◯V (b1 ⋅ b2) = ◯V b1 ⋅ ◯V b2]. To enable sharing of the authoritative element [●V{dq} a], it is equipped with a discardable fraction [dq]. Updates are only possible with the full authoritative element [●V a] (syntax for [●V{#1} a]]), while fractional authoritative elements have agreement, i.e., [✓ (●V{dq1} a1 ⋅ ●V{dq2} a2) → a1 ≡ a2]. *) (** * The view relation *) (** To relate the authoritative element [a] to its possible fragments [b], the view camera is parametrized by a (step-indexed) relation [view_rel n a b]. This relation should be a.) closed under smaller step-indexes [n], b.) non-expansive w.r.t. the argument [a], c.) closed under smaller [b] (which implies non-expansiveness w.r.t. [b]), and d.) ensure validity of the argument [b]. Note 1: Instead of requiring both a step-indexed and a non-step-indexed version of the relation (like cameras do for validity), we use [∀ n, view_rel n] as the non-step-indexed version. This is anyway necessary when using [≼{n}] as the relation (like the authoritative camera does) as its non-step-indexed version is not equivalent to [∀ n, x ≼{n} y]. Note 2: The view relation is defined as a canonical structure so that given a relation [nat → A → B → Prop], the instance with the laws can be inferred. We do not use type classes for this purpose because cameras themselves are represented using canonical structures. It has proven fragile for a canonical structure instance to take a type class as a parameter (in this case, [viewR] would need to take a class with the view relation laws). *) Structure view_rel (A : ofe) (B : ucmra) := ViewRel { view_rel_holds :> nat → A → B → Prop; view_rel_mono n1 n2 a1 a2 b1 b2 : view_rel_holds n1 a1 b1 → a1 ≡{n2}≡ a2 → b2 ≼{n2} b1 → n2 ≤ n1 → view_rel_holds n2 a2 b2; view_rel_validN n a b : view_rel_holds n a b → ✓{n} b; view_rel_unit n : ∃ a, view_rel_holds n a ε }. Global Arguments ViewRel {_ _} _ _. Global Arguments view_rel_holds {_ _} _ _ _ _. Global Instance: Params (@view_rel_holds) 4 := {}. Global Instance view_rel_ne {A B} (rel : view_rel A B) n : Proper (dist n ==> dist n ==> iff) (rel n). Proof. intros a1 a2 Ha b1 b2 Hb. split=> ?; (eapply view_rel_mono; [done|done|by rewrite Hb|done]). Qed. Global Instance view_rel_proper {A B} (rel : view_rel A B) n : Proper ((≡) ==> (≡) ==> iff) (rel n). Proof. intros a1 a2 Ha b1 b2 Hb. apply view_rel_ne; by apply equiv_dist. Qed. Class ViewRelDiscrete {A B} (rel : view_rel A B) := view_rel_discrete n a b : rel 0 a b → rel n a b. (** * Definition of the view camera *) (** To make use of the lemmas provided in this file, elements of [view] should always be constructed using [●V] and [◯V], and never using the constructor [View]. *) Record view {A B} (rel : nat → A → B → Prop) := View { view_auth_proj : option (dfrac * agree A) ; view_frag_proj : B }. Add Printing Constructor view. Global Arguments View {_ _ _} _ _. Global Arguments view_auth_proj {_ _ _} _. Global Arguments view_frag_proj {_ _ _} _. Global Instance: Params (@View) 3 := {}. Global Instance: Params (@view_auth_proj) 3 := {}. Global Instance: Params (@view_frag_proj) 3 := {}. Definition view_auth {A B} {rel : view_rel A B} (dq : dfrac) (a : A) : view rel := View (Some (dq, to_agree a)) ε. Definition view_frag {A B} {rel : view_rel A B} (b : B) : view rel := View None b. Global Typeclasses Opaque view_auth view_frag. Global Instance: Params (@view_auth) 3 := {}. Global Instance: Params (@view_frag) 3 := {}. Notation "●V dq a" := (view_auth dq a) (at level 20, dq custom dfrac at level 1, format "●V dq a"). Notation "◯V a" := (view_frag a) (at level 20). (** * The OFE structure *) (** We omit the usual [equivI] lemma because it is hard to state a suitably general version in terms of [●V] and [◯V], and because such a lemma has never been needed in practice. *) Section ofe. Context {A B : ofe} (rel : nat → A → B → Prop). Implicit Types a : A. Implicit Types ag : option (dfrac * agree A). Implicit Types b : B. Implicit Types x y : view rel. Local Instance view_equiv : Equiv (view rel) := λ x y, view_auth_proj x ≡ view_auth_proj y ∧ view_frag_proj x ≡ view_frag_proj y. Local Instance view_dist : Dist (view rel) := λ n x y, view_auth_proj x ≡{n}≡ view_auth_proj y ∧ view_frag_proj x ≡{n}≡ view_frag_proj y. Global Instance View_ne : NonExpansive2 (@View A B rel). Proof. by split. Qed. Global Instance View_proper : Proper ((≡) ==> (≡) ==> (≡)) (@View A B rel). Proof. by split. Qed. Global Instance view_auth_proj_ne: NonExpansive (@view_auth_proj A B rel). Proof. by destruct 1. Qed. Global Instance view_auth_proj_proper : Proper ((≡) ==> (≡)) (@view_auth_proj A B rel). Proof. by destruct 1. Qed. Global Instance view_frag_proj_ne : NonExpansive (@view_frag_proj A B rel). Proof. by destruct 1. Qed. Global Instance view_frag_proj_proper : Proper ((≡) ==> (≡)) (@view_frag_proj A B rel). Proof. by destruct 1. Qed. Definition view_ofe_mixin : OfeMixin (view rel). Proof. by apply (iso_ofe_mixin (λ x, (view_auth_proj x, view_frag_proj x))). Qed. Canonical Structure viewO := Ofe (view rel) view_ofe_mixin. Global Instance View_discrete ag b : Discrete ag → Discrete b → Discrete (View ag b). Proof. by intros ?? [??] [??]; split; apply: discrete. Qed. Global Instance view_ofe_discrete : OfeDiscrete A → OfeDiscrete B → OfeDiscrete viewO. Proof. intros ?? [??]; apply _. Qed. End ofe. (** * The camera structure *) Section cmra. Context {A B} (rel : view_rel A B). Implicit Types a : A. Implicit Types ag : option (dfrac * agree A). Implicit Types b : B. Implicit Types x y : view rel. Implicit Types q : frac. Implicit Types dq : dfrac. Global Instance view_auth_ne dq : NonExpansive (@view_auth A B rel dq). Proof. solve_proper. Qed. Global Instance view_auth_proper dq : Proper ((≡) ==> (≡)) (@view_auth A B rel dq). Proof. solve_proper. Qed. Global Instance view_frag_ne : NonExpansive (@view_frag A B rel). Proof. done. Qed. Global Instance view_frag_proper : Proper ((≡) ==> (≡)) (@view_frag A B rel). Proof. done. Qed. Global Instance view_auth_dist_inj n : Inj2 (=) (dist n) (dist n) (@view_auth A B rel). Proof. intros dq1 a1 dq2 a2 [Hag ?]; inversion Hag as [?? [??]|]; simplify_eq/=. split; [done|]. by apply (inj to_agree). Qed. Global Instance view_auth_inj : Inj2 (=) (≡) (≡) (@view_auth A B rel). Proof. intros dq1 a1 dq2 a2 [Hag ?]; inversion Hag as [?? [??]|]; simplify_eq/=. split; [done|]. by apply (inj to_agree). Qed. Global Instance view_frag_dist_inj n : Inj (dist n) (dist n) (@view_frag A B rel). Proof. by intros ?? [??]. Qed. Global Instance view_frag_inj : Inj (≡) (≡) (@view_frag A B rel). Proof. by intros ?? [??]. Qed. Local Instance view_valid_instance : Valid (view rel) := λ x, match view_auth_proj x with | Some (dq, ag) => ✓ dq ∧ (∀ n, ∃ a, ag ≡{n}≡ to_agree a ∧ rel n a (view_frag_proj x)) | None => ∀ n, ∃ a, rel n a (view_frag_proj x) end. Local Instance view_validN_instance : ValidN (view rel) := λ n x, match view_auth_proj x with | Some (dq, ag) => ✓{n} dq ∧ ∃ a, ag ≡{n}≡ to_agree a ∧ rel n a (view_frag_proj x) | None => ∃ a, rel n a (view_frag_proj x) end. Local Instance view_pcore_instance : PCore (view rel) := λ x, Some (View (core (view_auth_proj x)) (core (view_frag_proj x))). Local Instance view_op_instance : Op (view rel) := λ x y, View (view_auth_proj x ⋅ view_auth_proj y) (view_frag_proj x ⋅ view_frag_proj y). Local Definition view_valid_eq : valid = λ x, match view_auth_proj x with | Some (dq, ag) => ✓ dq ∧ (∀ n, ∃ a, ag ≡{n}≡ to_agree a ∧ rel n a (view_frag_proj x)) | None => ∀ n, ∃ a, rel n a (view_frag_proj x) end := eq_refl _. Local Definition view_validN_eq : validN = λ n x, match view_auth_proj x with | Some (dq, ag) => ✓{n} dq ∧ ∃ a, ag ≡{n}≡ to_agree a ∧ rel n a (view_frag_proj x) | None => ∃ a, rel n a (view_frag_proj x) end := eq_refl _. Local Definition view_pcore_eq : pcore = λ x, Some (View (core (view_auth_proj x)) (core (view_frag_proj x))) := eq_refl _. Local Definition view_core_eq : core = λ x, View (core (view_auth_proj x)) (core (view_frag_proj x)) := eq_refl _. Local Definition view_op_eq : op = λ x y, View (view_auth_proj x ⋅ view_auth_proj y) (view_frag_proj x ⋅ view_frag_proj y) := eq_refl _. Lemma view_cmra_mixin : CmraMixin (view rel). Proof. apply (iso_cmra_mixin_restrict_validity (λ x : option (dfrac * agree A) * B, View x.1 x.2) (λ x, (view_auth_proj x, view_frag_proj x))); try done. - intros [x b]. by rewrite /= pair_pcore !cmra_pcore_core. - intros n [[[dq ag]|] b]; rewrite /= view_validN_eq /=. + intros (?&a&->&?). repeat split; simpl; [done|]. by eapply view_rel_validN. + intros [a ?]. repeat split; simpl. by eapply view_rel_validN. - rewrite view_validN_eq. intros n [x1 b1] [x2 b2] [Hx ?]; simpl in *; destruct Hx as [[q1 ag1] [q2 ag2] [??]|]; intros ?; by ofe_subst. - rewrite view_valid_eq view_validN_eq. intros [[[dq aa]|] b]; rewrite /= ?cmra_valid_validN; naive_solver. - rewrite view_validN_eq=> n [[[dq ag]|] b] /=. + intros [? (a&?&?)]; split; [done|]. exists a; split; [by eauto using dist_le|]. apply view_rel_mono with (S n) a b; auto with lia. + intros [a ?]. exists a. apply view_rel_mono with (S n) a b; auto with lia. - rewrite view_validN_eq=> n [[[q1 ag1]|] b1] [[[q2 ag2]|] b2] /=. + intros [?%cmra_validN_op_l (a & Haga & ?)]. split; [done|]. assert (ag1 ≡{n}≡ ag2) as Ha12 by (apply agree_op_invN; by rewrite Haga). exists a. split; [by rewrite -Haga -Ha12 agree_idemp|]. apply view_rel_mono with n a (b1 ⋅ b2); eauto using cmra_includedN_l. + intros [? (a & Haga & ?)]. split; [done|]. exists a; split; [done|]. apply view_rel_mono with n a (b1 ⋅ b2); eauto using cmra_includedN_l. + intros [? (a & Haga & ?)]. exists a. apply view_rel_mono with n a (b1 ⋅ b2); eauto using cmra_includedN_l. + intros [a ?]. exists a. apply view_rel_mono with n a (b1 ⋅ b2); eauto using cmra_includedN_l. Qed. Canonical Structure viewR := Cmra (view rel) view_cmra_mixin. Global Instance view_auth_discrete dq a : Discrete a → Discrete (ε : B) → Discrete (●V{dq} a : view rel). Proof. intros. apply View_discrete; apply _. Qed. Global Instance view_frag_discrete b : Discrete b → Discrete (◯V b : view rel). Proof. intros. apply View_discrete; apply _. Qed. Global Instance view_cmra_discrete : OfeDiscrete A → CmraDiscrete B → ViewRelDiscrete rel → CmraDiscrete viewR. Proof. split; [apply _|]=> -[[[dq ag]|] b]; rewrite view_valid_eq view_validN_eq /=. - rewrite -cmra_discrete_valid_iff. setoid_rewrite <-(discrete_iff _ ag). naive_solver. - naive_solver. Qed. Local Instance view_empty_instance : Unit (view rel) := View ε ε. Lemma view_ucmra_mixin : UcmraMixin (view rel). Proof. split; simpl. - rewrite view_valid_eq /=. apply view_rel_unit. - by intros x; constructor; rewrite /= left_id. - do 2 constructor; [done| apply (core_id_core _)]. Qed. Canonical Structure viewUR := Ucmra (view rel) view_ucmra_mixin. (** Operation *) Lemma view_auth_dfrac_op dq1 dq2 a : ●V{dq1 ⋅ dq2} a ≡ ●V{dq1} a ⋅ ●V{dq2} a. Proof. intros; split; simpl; last by rewrite left_id. by rewrite -Some_op -pair_op agree_idemp. Qed. Global Instance view_auth_dfrac_is_op dq dq1 dq2 a : IsOp dq dq1 dq2 → IsOp' (●V{dq} a) (●V{dq1} a) (●V{dq2} a). Proof. rewrite /IsOp' /IsOp => ->. by rewrite -view_auth_dfrac_op. Qed. Lemma view_frag_op b1 b2 : ◯V (b1 ⋅ b2) = ◯V b1 ⋅ ◯V b2. Proof. done. Qed. Lemma view_frag_mono b1 b2 : b1 ≼ b2 → ◯V b1 ≼ ◯V b2. Proof. intros [c ->]. by rewrite view_frag_op. Qed. Lemma view_frag_core b : core (◯V b) = ◯V (core b). Proof. done. Qed. Lemma view_both_core_discarded a b : core (●V□ a ⋅ ◯V b) ≡ ●V□ a ⋅ ◯V (core b). Proof. rewrite view_core_eq view_op_eq /= !left_id //. Qed. Lemma view_both_core_frac q a b : core (●V{#q} a ⋅ ◯V b) ≡ ◯V (core b). Proof. rewrite view_core_eq view_op_eq /= !left_id //. Qed. Global Instance view_auth_core_id a : CoreId (●V□ a). Proof. do 2 constructor; simpl; auto. apply: core_id_core. Qed. Global Instance view_frag_core_id b : CoreId b → CoreId (◯V b). Proof. do 2 constructor; simpl; auto. apply: core_id_core. Qed. Global Instance view_both_core_id a b : CoreId b → CoreId (●V□ a ⋅ ◯V b). Proof. do 2 constructor; simpl; auto. rewrite !left_id. apply: core_id_core. Qed. Global Instance view_frag_is_op b b1 b2 : IsOp b b1 b2 → IsOp' (◯V b) (◯V b1) (◯V b2). Proof. done. Qed. Global Instance view_frag_sep_homomorphism : MonoidHomomorphism op op (≡) (@view_frag A B rel). Proof. by split; [split; try apply _|]. Qed. Lemma big_opL_view_frag {C} (g : nat → C → B) (l : list C) : (◯V [^op list] k↦x ∈ l, g k x) ≡ [^op list] k↦x ∈ l, ◯V (g k x). Proof. apply (big_opL_commute _). Qed. Lemma big_opM_view_frag `{Countable K} {C} (g : K → C → B) (m : gmap K C) : (◯V [^op map] k↦x ∈ m, g k x) ≡ [^op map] k↦x ∈ m, ◯V (g k x). Proof. apply (big_opM_commute _). Qed. Lemma big_opS_view_frag `{Countable C} (g : C → B) (X : gset C) : (◯V [^op set] x ∈ X, g x) ≡ [^op set] x ∈ X, ◯V (g x). Proof. apply (big_opS_commute _). Qed. Lemma big_opMS_view_frag `{Countable C} (g : C → B) (X : gmultiset C) : (◯V [^op mset] x ∈ X, g x) ≡ [^op mset] x ∈ X, ◯V (g x). Proof. apply (big_opMS_commute _). Qed. (** Validity *) Lemma view_auth_dfrac_op_invN n dq1 a1 dq2 a2 : ✓{n} (●V{dq1} a1 ⋅ ●V{dq2} a2) → a1 ≡{n}≡ a2. Proof. rewrite /op /view_op_instance /= left_id -Some_op -pair_op view_validN_eq /=. intros (?&?& Eq &?). apply (inj to_agree), agree_op_invN. by rewrite Eq. Qed. Lemma view_auth_dfrac_op_inv dq1 a1 dq2 a2 : ✓ (●V{dq1} a1 ⋅ ●V{dq2} a2) → a1 ≡ a2. Proof. intros ?. apply equiv_dist. intros n. by eapply view_auth_dfrac_op_invN, cmra_valid_validN. Qed. Lemma view_auth_dfrac_op_inv_L `{!LeibnizEquiv A} dq1 a1 dq2 a2 : ✓ (●V{dq1} a1 ⋅ ●V{dq2} a2) → a1 = a2. Proof. by intros ?%view_auth_dfrac_op_inv%leibniz_equiv. Qed. Lemma view_auth_dfrac_validN n dq a : ✓{n} (●V{dq} a) ↔ ✓{n}dq ∧ rel n a ε. Proof. rewrite view_validN_eq /=. apply and_iff_compat_l. split; [|by eauto]. by intros [? [->%(inj to_agree) ?]]. Qed. Lemma view_auth_validN n a : ✓{n} (●V a) ↔ rel n a ε. Proof. rewrite view_auth_dfrac_validN. split; [naive_solver|done]. Qed. Lemma view_auth_dfrac_op_validN n dq1 dq2 a1 a2 : ✓{n} (●V{dq1} a1 ⋅ ●V{dq2} a2) ↔ ✓(dq1 ⋅ dq2) ∧ a1 ≡{n}≡ a2 ∧ rel n a1 ε. Proof. split. - intros Hval. assert (a1 ≡{n}≡ a2) as Ha by eauto using view_auth_dfrac_op_invN. revert Hval. rewrite Ha -view_auth_dfrac_op view_auth_dfrac_validN. naive_solver. - intros (?&->&?). by rewrite -view_auth_dfrac_op view_auth_dfrac_validN. Qed. Lemma view_auth_op_validN n a1 a2 : ✓{n} (●V a1 ⋅ ●V a2) ↔ False. Proof. rewrite view_auth_dfrac_op_validN. naive_solver. Qed. Lemma view_frag_validN n b : ✓{n} (◯V b) ↔ ∃ a, rel n a b. Proof. done. Qed. Lemma view_both_dfrac_validN n dq a b : ✓{n} (●V{dq} a ⋅ ◯V b) ↔ ✓dq ∧ rel n a b. Proof. rewrite view_validN_eq /=. apply and_iff_compat_l. setoid_rewrite (left_id _ _ b). split; [|by eauto]. by intros [?[->%(inj to_agree)]]. Qed. Lemma view_both_validN n a b : ✓{n} (●V a ⋅ ◯V b) ↔ rel n a b. Proof. rewrite view_both_dfrac_validN. split; [naive_solver|done]. Qed. Lemma view_auth_dfrac_valid dq a : ✓ (●V{dq} a) ↔ ✓dq ∧ ∀ n, rel n a ε. Proof. rewrite view_valid_eq /=. apply and_iff_compat_l. split; [|by eauto]. intros H n. by destruct (H n) as [? [->%(inj to_agree) ?]]. Qed. Lemma view_auth_valid a : ✓ (●V a) ↔ ∀ n, rel n a ε. Proof. rewrite view_auth_dfrac_valid. split; [naive_solver|done]. Qed. Lemma view_auth_dfrac_op_valid dq1 dq2 a1 a2 : ✓ (●V{dq1} a1 ⋅ ●V{dq2} a2) ↔ ✓(dq1 ⋅ dq2) ∧ a1 ≡ a2 ∧ ∀ n, rel n a1 ε. Proof. rewrite 1!cmra_valid_validN equiv_dist. setoid_rewrite view_auth_dfrac_op_validN. split; last naive_solver. intros Hv. split; last naive_solver. apply (Hv 0). Qed. Lemma view_auth_op_valid a1 a2 : ✓ (●V a1 ⋅ ●V a2) ↔ False. Proof. rewrite view_auth_dfrac_op_valid. naive_solver. Qed. Lemma view_frag_valid b : ✓ (◯V b) ↔ ∀ n, ∃ a, rel n a b. Proof. done. Qed. Lemma view_both_dfrac_valid dq a b : ✓ (●V{dq} a ⋅ ◯V b) ↔ ✓dq ∧ ∀ n, rel n a b. Proof. rewrite view_valid_eq /=. apply and_iff_compat_l. setoid_rewrite (left_id _ _ b). split; [|by eauto]. intros H n. by destruct (H n) as [?[->%(inj to_agree)]]. Qed. Lemma view_both_valid a b : ✓ (●V a ⋅ ◯V b) ↔ ∀ n, rel n a b. Proof. rewrite view_both_dfrac_valid. split; [naive_solver|done]. Qed. (** Inclusion *) Lemma view_auth_dfrac_includedN n dq1 dq2 a1 a2 b : ●V{dq1} a1 ≼{n} ●V{dq2} a2 ⋅ ◯V b ↔ (dq1 ≼ dq2 ∨ dq1 = dq2) ∧ a1 ≡{n}≡ a2. Proof. split. - intros [[[[dqf agf]|] bf] [[?%(discrete_iff _ _) ?]%(inj Some) _]]; simplify_eq/=. + split; [eauto|]. apply to_agree_includedN. by exists agf. + split; [right; done|]. by apply (inj to_agree). - intros [[[? ->]| ->] ->]. + rewrite view_auth_dfrac_op -assoc. apply cmra_includedN_l. + apply cmra_includedN_l. Qed. Lemma view_auth_dfrac_included dq1 dq2 a1 a2 b : ●V{dq1} a1 ≼ ●V{dq2} a2 ⋅ ◯V b ↔ (dq1 ≼ dq2 ∨ dq1 = dq2) ∧ a1 ≡ a2. Proof. intros. split. - split. + by eapply (view_auth_dfrac_includedN 0), cmra_included_includedN. + apply equiv_dist=> n. by eapply view_auth_dfrac_includedN, cmra_included_includedN. - intros [[[dq ->]| ->] ->]. + by rewrite view_auth_dfrac_op -assoc. + done. Qed. Lemma view_auth_includedN n a1 a2 b : ●V a1 ≼{n} ●V a2 ⋅ ◯V b ↔ a1 ≡{n}≡ a2. Proof. rewrite view_auth_dfrac_includedN. naive_solver. Qed. Lemma view_auth_included a1 a2 b : ●V a1 ≼ ●V a2 ⋅ ◯V b ↔ a1 ≡ a2. Proof. rewrite view_auth_dfrac_included. naive_solver. Qed. Lemma view_frag_includedN n p a b1 b2 : ◯V b1 ≼{n} ●V{p} a ⋅ ◯V b2 ↔ b1 ≼{n} b2. Proof. split. - intros [xf [_ Hb]]; simpl in *. revert Hb; rewrite left_id. by exists (view_frag_proj xf). - intros [bf ->]. rewrite comm view_frag_op -assoc. apply cmra_includedN_l. Qed. Lemma view_frag_included p a b1 b2 : ◯V b1 ≼ ●V{p} a ⋅ ◯V b2 ↔ b1 ≼ b2. Proof. split. - intros [xf [_ Hb]]; simpl in *. revert Hb; rewrite left_id. by exists (view_frag_proj xf). - intros [bf ->]. by rewrite comm view_frag_op -assoc. Qed. (** The weaker [view_both_included] lemmas below are a consequence of the [view_auth_included] and [view_frag_included] lemmas above. *) Lemma view_both_dfrac_includedN n dq1 dq2 a1 a2 b1 b2 : ●V{dq1} a1 ⋅ ◯V b1 ≼{n} ●V{dq2} a2 ⋅ ◯V b2 ↔ (dq1 ≼ dq2 ∨ dq1 = dq2) ∧ a1 ≡{n}≡ a2 ∧ b1 ≼{n} b2. Proof. split. - intros. rewrite assoc. split. + rewrite -view_auth_dfrac_includedN. by etrans; [apply cmra_includedN_l|]. + rewrite -view_frag_includedN. by etrans; [apply cmra_includedN_r|]. - intros (?&->&?bf&->). rewrite (comm _ b1) view_frag_op assoc. by apply cmra_monoN_r, view_auth_dfrac_includedN. Qed. Lemma view_both_dfrac_included dq1 dq2 a1 a2 b1 b2 : ●V{dq1} a1 ⋅ ◯V b1 ≼ ●V{dq2} a2 ⋅ ◯V b2 ↔ (dq1 ≼ dq2 ∨ dq1 = dq2) ∧ a1 ≡ a2 ∧ b1 ≼ b2. Proof. split. - intros. rewrite assoc. split. + rewrite -view_auth_dfrac_included. by etrans; [apply cmra_included_l|]. + rewrite -view_frag_included. by etrans; [apply cmra_included_r|]. - intros (?&->&?bf&->). rewrite (comm _ b1) view_frag_op assoc. by apply cmra_mono_r, view_auth_dfrac_included. Qed. Lemma view_both_includedN n a1 a2 b1 b2 : ●V a1 ⋅ ◯V b1 ≼{n} ●V a2 ⋅ ◯V b2 ↔ a1 ≡{n}≡ a2 ∧ b1 ≼{n} b2. Proof. rewrite view_both_dfrac_includedN. naive_solver. Qed. Lemma view_both_included a1 a2 b1 b2 : ●V a1 ⋅ ◯V b1 ≼ ●V a2 ⋅ ◯V b2 ↔ a1 ≡ a2 ∧ b1 ≼ b2. Proof. rewrite view_both_dfrac_included. naive_solver. Qed. (** Updates *) (** Note that we quantify over a frame [bf], and since conceptually [rel n a b] means "[b] is a valid fragment to be part of [a]", there is another implicit frame quantification inside [rel] (usually because [rel] is defined via [≼] which contains an existential quantifier). The difference between the two frames is that the frame quantified inside [rel] may change but [bf] has to be preserved. It is not clear if it is possible to avoid this. *) Lemma view_updateP a b Pab : (∀ n bf, rel n a (b ⋅ bf) → ∃ a' b', Pab a' b' ∧ rel n a' (b' ⋅ bf)) → ●V a ⋅ ◯V b ~~>: λ k, ∃ a' b', k = ●V a' ⋅ ◯V b' ∧ Pab a' b'. Proof. intros Hup; apply cmra_total_updateP=> n [[[dq ag]|] bf] [/=]. { by intros []%(exclusiveN_l _ _). } intros _ (a0 & <-%(inj to_agree) & Hrel). rewrite !left_id in Hrel. apply Hup in Hrel as (a' & b' & Hab' & Hrel). eexists; split. - naive_solver. - split; simpl; [done|]. exists a'; split; [done|]. by rewrite left_id. Qed. Lemma view_update a b a' b' : (∀ n bf, rel n a (b ⋅ bf) → rel n a' (b' ⋅ bf)) → ●V a ⋅ ◯V b ~~> ●V a' ⋅ ◯V b'. Proof. intros Hup. eapply cmra_update_updateP, cmra_updateP_weaken. { eapply view_updateP with (Pab := λ a b, a = a' ∧ b = b'). naive_solver. } { naive_solver. } Qed. Lemma view_update_alloc a a' b' : (∀ n bf, rel n a bf → rel n a' (b' ⋅ bf)) → ●V a ~~> ●V a' ⋅ ◯V b'. Proof. intros Hup. rewrite -(right_id _ _ (●V a)). apply view_update=> n bf. rewrite left_id. apply Hup. Qed. Lemma view_update_dealloc a b a' : (∀ n bf, rel n a (b ⋅ bf) → rel n a' bf) → ●V a ⋅ ◯V b ~~> ●V a'. Proof. intros Hup. rewrite -(right_id _ _ (●V a')). apply view_update=> n bf. rewrite left_id. apply Hup. Qed. Lemma view_update_auth a a' b' : (∀ n bf, rel n a bf → rel n a' bf) → ●V a ~~> ●V a'. Proof. intros Hup. rewrite -(right_id _ _ (●V a)) -(right_id _ _ (●V a')). apply view_update=> n bf. rewrite !left_id. apply Hup. Qed. Local Lemma view_updateP_auth_dfrac dq P a : dq ~~>: P → ●V{dq} a ~~>: λ k, ∃ dq', k = ●V{dq'} a ∧ P dq'. Proof. intros Hupd. apply cmra_total_updateP. move=> n [[[dq' ag]|] bf] [Hv ?]. - destruct (Hupd n (Some dq') Hv) as (dr&Hdr&Heq). eexists. split; first by eexists. done. - destruct (Hupd n None Hv) as (dr&Hdr&Heq). eexists. split; first by eexists. done. Qed. Lemma view_update_auth_persist dq a : ●V{dq} a ~~> ●V□ a. Proof. eapply (cmra_update_lift_updateP (λ dq, view_auth dq a)). { intros; by apply view_updateP_auth_dfrac. } { apply dfrac_discard_update. } Qed. Lemma view_updateP_auth_unpersist a : ●V□ a ~~>: λ k, ∃ q, k = ●V{#q} a. Proof. eapply cmra_updateP_weaken. { eapply view_updateP_auth_dfrac, dfrac_undiscard_update. } naive_solver. Qed. Lemma view_updateP_both_unpersist a b : ●V□ a ⋅ ◯V b ~~>: λ k, ∃ q, k = ●V{#q} a ⋅ ◯V b. Proof. eapply cmra_updateP_weaken. { eapply cmra_updateP_op'. { eapply view_updateP_auth_unpersist. } by eapply cmra_update_updateP. } naive_solver. Qed. Lemma view_updateP_frag b P : (∀ a n bf, rel n a (b ⋅ bf) → ∃ b', P b' ∧ rel n a (b' ⋅ bf)) → ◯V b ~~>: λ k, ∃ b', k = ◯V b' ∧ P b'. Proof. rewrite !cmra_total_updateP view_validN_eq=> ? n [[[dq ag]|] bf]; naive_solver. Qed. Lemma view_update_frag b b' : (∀ a n bf, rel n a (b ⋅ bf) → rel n a (b' ⋅ bf)) → ◯V b ~~> ◯V b'. Proof. rewrite !cmra_total_update view_validN_eq=> ? n [[[dq ag]|] bf]; naive_solver. Qed. Lemma view_update_dfrac_alloc dq a b : (∀ n bf, rel n a bf → rel n a (b ⋅ bf)) → ●V{dq} a ~~> ●V{dq} a ⋅ ◯V b. Proof. intros Hup. apply cmra_total_update=> n [[[p ag]|] bf] [/=]. - intros ? (a0 & Hag & Hrel). split; simpl; [done|]. exists a0; split; [done|]. revert Hrel. assert (to_agree a ≼{n} to_agree a0) as <-%to_agree_includedN. { by exists ag. } rewrite !left_id. apply Hup. - intros ? (a0 & <-%(inj to_agree) & Hrel). split; simpl; [done|]. exists a; split; [done|]. revert Hrel. rewrite !left_id. apply Hup. Qed. Lemma view_local_update a b0 b1 a' b0' b1' : (b0, b1) ~l~> (b0', b1') → (∀ n, view_rel_holds rel n a b0 → view_rel_holds rel n a' b0') → (●V a ⋅ ◯V b0, ●V a ⋅ ◯V b1) ~l~> (●V a' ⋅ ◯V b0', ●V a' ⋅ ◯V b1'). Proof. rewrite !local_update_unital. move=> Hup Hrel n [[[qd ag]|] bf] /view_both_validN Hrel' [/=]. - rewrite right_id -Some_op -pair_op => /Some_dist_inj [/= H1q _]. by destruct (id_free_r (DfracOwn 1) qd). - rewrite !left_id=> _ Hb0. destruct (Hup n bf) as [? Hb0']; [by eauto using view_rel_validN..|]. split; [apply view_both_validN; by auto|]. by rewrite -assoc Hb0'. Qed. End cmra. (** * Utilities to construct functors *) (** Due to the dependent type [rel] in [view] we cannot actually define instances of the functor structures [rFunctor] and [urFunctor]. Functors can only be defined for instances of [view], like [auth]. To make it more convenient to define functors for instances of [view], we define the map operation [view_map] and a bunch of lemmas about it. *) Definition view_map {A A' B B'} {rel : nat → A → B → Prop} {rel' : nat → A' → B' → Prop} (f : A → A') (g : B → B') (x : view rel) : view rel' := View (prod_map id (agree_map f) <$> view_auth_proj x) (g (view_frag_proj x)). Lemma view_map_id {A B} {rel : nat → A → B → Prop} (x : view rel) : view_map id id x = x. Proof. destruct x as [[[]|] ]; by rewrite // /view_map /= agree_map_id. Qed. Lemma view_map_compose {A A' A'' B B' B''} {rel : nat → A → B → Prop} {rel' : nat → A' → B' → Prop} {rel'' : nat → A'' → B'' → Prop} (f1 : A → A') (f2 : A' → A'') (g1 : B → B') (g2 : B' → B'') (x : view rel) : view_map (f2 ∘ f1) (g2 ∘ g1) x =@{view rel''} view_map f2 g2 (view_map (rel':=rel') f1 g1 x). Proof. destruct x as [[[]|] ]; by rewrite // /view_map /= agree_map_compose. Qed. Lemma view_map_ext {A A' B B' : ofe} {rel : nat → A → B → Prop} {rel' : nat → A' → B' → Prop} (f1 f2 : A → A') (g1 g2 : B → B') `{!NonExpansive f1, !NonExpansive g1} (x : view rel) : (∀ a, f1 a ≡ f2 a) → (∀ b, g1 b ≡ g2 b) → view_map f1 g1 x ≡@{view rel'} view_map f2 g2 x. Proof. intros. constructor; simpl; [|by auto]. apply option_fmap_equiv_ext=> a; by rewrite /prod_map /= agree_map_ext. Qed. Global Instance view_map_ne {A A' B B' : ofe} {rel : nat → A → B → Prop} {rel' : nat → A' → B' → Prop} (f : A → A') (g : B → B') `{Hf : !NonExpansive f, Hg : !NonExpansive g} : NonExpansive (view_map (rel':=rel') (rel:=rel) f g). Proof. intros n [o1 bf1] [o2 bf2] [??]; split; simpl in *; [|by apply Hg]. apply option_fmap_ne; [|done]=> pag1 pag2 ?. apply prod_map_ne; [done| |done]. by apply agree_map_ne. Qed. Definition viewO_map {A A' B B' : ofe} {rel : nat → A → B → Prop} {rel' : nat → A' → B' → Prop} (f : A -n> A') (g : B -n> B') : viewO rel -n> viewO rel' := OfeMor (view_map f g). Lemma viewO_map_ne {A A' B B' : ofe} {rel : nat → A → B → Prop} {rel' : nat → A' → B' → Prop} : NonExpansive2 (viewO_map (rel:=rel) (rel':=rel')). Proof. intros n f f' Hf g g' Hg [[[p ag]|] bf]; split=> //=. do 2 f_equiv. by apply agreeO_map_ne. Qed. Lemma view_map_cmra_morphism {A A' B B'} {rel : view_rel A B} {rel' : view_rel A' B'} (f : A → A') (g : B → B') `{!NonExpansive f, !CmraMorphism g} : (∀ n a b, rel n a b → rel' n (f a) (g b)) → CmraMorphism (view_map (rel:=rel) (rel':=rel') f g). Proof. intros Hrel. split. - apply _. - rewrite !view_validN_eq=> n [[[p ag]|] bf] /=; [|naive_solver eauto using cmra_morphism_validN]. intros [? [a' [Hag ?]]]. split; [done|]. exists (f a'). split; [|by auto]. by rewrite -agree_map_to_agree -Hag. - intros [o bf]. apply Some_proper; rewrite /view_map /=. f_equiv; by rewrite cmra_morphism_core. - intros [[[dq1 ag1]|] bf1] [[[dq2 ag2]|] bf2]; try apply View_proper=> //=; by rewrite cmra_morphism_op. Qed. iris-iris-4.2.0/iris/base_logic/000077500000000000000000000000001460620107300164635ustar00rootroot00000000000000iris-iris-4.2.0/iris/base_logic/algebra.v000066400000000000000000000317171460620107300202600ustar00rootroot00000000000000From iris.algebra Require Import cmra view auth agree csum list excl gmap. From iris.algebra.lib Require Import excl_auth gmap_view dfrac_agree. From iris.bi Require Import lib.cmra. From iris.base_logic Require Import bi derived. From iris.prelude Require Import options. (** Internalized properties of our CMRA constructions. *) Local Coercion uPred_holds : uPred >-> Funclass. Section upred. Context {M : ucmra}. (* Force implicit argument M *) Notation "P ⊢ Q" := (bi_entails (PROP:=uPredI M) P Q). Notation "P ⊣⊢ Q" := (equiv (A:=uPredI M) P%I Q%I). Notation "⊢ Q" := (bi_emp_valid (PROP:=uPredI M) Q). Lemma prod_validI {A B : cmra} (x : A * B) : ✓ x ⊣⊢ ✓ x.1 ∧ ✓ x.2. Proof. by uPred.unseal. Qed. Lemma option_validI {A : cmra} (mx : option A) : ✓ mx ⊣⊢ match mx with Some x => ✓ x | None => True : uPred M end. Proof. uPred.unseal. by destruct mx. Qed. Lemma discrete_fun_validI {A} {B : A → ucmra} (g : discrete_fun B) : ✓ g ⊣⊢ ∀ i, ✓ g i. Proof. by uPred.unseal. Qed. (* Analogues of [id_freeN_l] and [id_freeN_r] in the logic, stated in a way that allows us to do [iDestruct (id_freeI_r with "H✓ H≡") as %[]]*) Lemma id_freeI_r {A : cmra} (x y : A) : IdFree x → ⊢ ✓ x -∗ (x ⋅ y) ≡ x -∗ False. Proof. intros ?. apply bi.wand_intro_l. rewrite bi.sep_and right_id. apply bi.wand_intro_r. rewrite bi.sep_and. uPred.unseal. split => n m Hm. case. by apply id_freeN_r. Qed. Lemma id_freeI_l {A : cmra} (x y : A) : IdFree x → ⊢ ✓ x -∗ (y ⋅ x) ≡ x -∗ False. Proof. intros ?. apply bi.wand_intro_l. rewrite bi.sep_and right_id. apply bi.wand_intro_r. rewrite bi.sep_and. uPred.unseal. split => n m Hm. case. by apply id_freeN_l. Qed. Section gmap_ofe. Context `{Countable K} {A : ofe}. Implicit Types m : gmap K A. Implicit Types i : K. Lemma gmap_equivI m1 m2 : m1 ≡ m2 ⊣⊢ ∀ i, m1 !! i ≡ m2 !! i. Proof. by uPred.unseal. Qed. Lemma gmap_union_equiv_eqI m m1 m2 : m ≡ m1 ∪ m2 ⊣⊢ ∃ m1' m2', ⌜ m = m1' ∪ m2' ⌝ ∧ m1' ≡ m1 ∧ m2' ≡ m2. Proof. uPred.unseal; split=> n x _. apply gmap_union_dist_eq. Qed. End gmap_ofe. Section gmap_cmra. Context `{Countable K} {A : cmra}. Implicit Types m : gmap K A. Lemma gmap_validI m : ✓ m ⊣⊢ ∀ i, ✓ (m !! i). Proof. by uPred.unseal. Qed. Lemma singleton_validI i x : ✓ ({[ i := x ]} : gmap K A) ⊣⊢ ✓ x. Proof. rewrite gmap_validI. apply: anti_symm. - rewrite (bi.forall_elim i) lookup_singleton option_validI. done. - apply bi.forall_intro=>j. destruct (decide (i = j)) as [<-|Hne]. + rewrite lookup_singleton option_validI. done. + rewrite lookup_singleton_ne // option_validI. apply bi.True_intro. Qed. End gmap_cmra. Section list_ofe. Context {A : ofe}. Implicit Types l : list A. Lemma list_equivI l1 l2 : l1 ≡ l2 ⊣⊢ ∀ i, l1 !! i ≡ l2 !! i. Proof. uPred.unseal; constructor=> n x ?. apply list_dist_lookup. Qed. End list_ofe. Section excl. Context {A : ofe}. Implicit Types x : excl A. Lemma excl_validI x : ✓ x ⊣⊢ if x is ExclBot then False else True. Proof. uPred.unseal. by destruct x. Qed. End excl. Section agree. Context {A : ofe}. Implicit Types a b : A. Implicit Types x y : agree A. Lemma agree_equivI a b : to_agree a ≡ to_agree b ⊣⊢ (a ≡ b). Proof. uPred.unseal. do 2 split. - intros Hx. exact: (inj to_agree). - intros Hx. exact: to_agree_ne. Qed. Lemma agree_validI x y : ✓ (x ⋅ y) ⊢ x ≡ y. Proof. uPred.unseal; split=> r n _ ?; by apply: agree_op_invN. Qed. Lemma to_agree_validI a : ⊢ ✓ to_agree a. Proof. uPred.unseal; done. Qed. Lemma to_agree_op_validI a b : ✓ (to_agree a ⋅ to_agree b) ⊣⊢ a ≡ b. Proof. apply bi.entails_anti_sym. - rewrite agree_validI. by rewrite agree_equivI. - pose (Ψ := (λ x : A, ✓ (to_agree a ⋅ to_agree x) : uPred M)%I). assert (NonExpansive Ψ) as ? by solve_proper. rewrite (internal_eq_rewrite a b Ψ). eapply bi.impl_elim; first reflexivity. etrans; first apply bi.True_intro. subst Ψ; simpl. rewrite agree_idemp. apply to_agree_validI. Qed. Lemma to_agree_uninjI x : ✓ x ⊢ ∃ a, to_agree a ≡ x. Proof. uPred.unseal. split=> n y _. exact: to_agree_uninjN. Qed. (** Derived lemma: If two [x y : agree O] compose to some [to_agree a], they are internally equal, and also equal to the [to_agree a]. Empirically, [x ⋅ y ≡ to_agree a] appears often when agreement comes up in CMRA validity terms, especially when [view]s are involved. The desired simplification [x ≡ y ∧ y ≡ to_agree a] is also not straightforward to derive, so we have a special lemma to handle this common case. *) Lemma agree_op_equiv_to_agreeI x y a : x ⋅ y ≡ to_agree a ⊢ x ≡ y ∧ y ≡ to_agree a. Proof. assert (x ⋅ y ≡ to_agree a ⊢ x ≡ y) as Hxy_equiv. { rewrite -(agree_validI x y) internal_eq_sym. apply: (internal_eq_rewrite' _ _ (λ o, ✓ o)%I); first done. rewrite -to_agree_validI. apply bi.True_intro. } apply bi.and_intro; first done. rewrite -{1}(idemp bi_and (_ ≡ _)%I) {1}Hxy_equiv. apply bi.impl_elim_l'. apply: (internal_eq_rewrite' _ _ (λ y', x ⋅ y' ≡ to_agree a → y' ≡ to_agree a)%I); [solve_proper|done|]. rewrite agree_idemp. apply bi.impl_refl. Qed. Lemma to_agree_includedI a b : to_agree a ≼ to_agree b ⊣⊢ a ≡ b. Proof. apply (anti_symm _). - apply bi.exist_elim=>c. rewrite internal_eq_sym. rewrite agree_op_equiv_to_agreeI -agree_equivI. apply internal_eq_trans. - apply: (internal_eq_rewrite' _ _ (λ b, to_agree a ≼ to_agree b)%I); [solve_proper|done|]. rewrite -internal_included_refl. apply bi.True_intro. Qed. End agree. Section csum_cmra. Context {A B : cmra}. Implicit Types a : A. Implicit Types b : B. Lemma csum_validI (x : csum A B) : ✓ x ⊣⊢ match x with | Cinl a => ✓ a | Cinr b => ✓ b | CsumBot => False end. Proof. uPred.unseal. by destruct x. Qed. End csum_cmra. Section view. Context {A B} (rel : view_rel A B). Implicit Types a : A. Implicit Types ag : option (frac * agree A). Implicit Types b : B. Implicit Types x y : view rel. Lemma view_both_dfrac_validI_1 (relI : uPred M) dq a b : (∀ n (x : M), rel n a b → relI n x) → ✓ (●V{dq} a ⋅ ◯V b : view rel) ⊢ ⌜✓dq⌝ ∧ relI. Proof. intros Hrel. uPred.unseal. split=> n x _ /=. rewrite /uPred_holds /= view_both_dfrac_validN. by move=> [? /Hrel]. Qed. Lemma view_both_dfrac_validI_2 (relI : uPred M) dq a b : (∀ n (x : M), relI n x → rel n a b) → ⌜✓dq⌝ ∧ relI ⊢ ✓ (●V{dq} a ⋅ ◯V b : view rel). Proof. intros Hrel. uPred.unseal. split=> n x _ /=. rewrite /uPred_holds /= view_both_dfrac_validN. by move=> [? /Hrel]. Qed. Lemma view_both_dfrac_validI (relI : uPred M) dq a b : (∀ n (x : M), rel n a b ↔ relI n x) → ✓ (●V{dq} a ⋅ ◯V b : view rel) ⊣⊢ ⌜✓dq⌝ ∧ relI. Proof. intros. apply (anti_symm _); [apply view_both_dfrac_validI_1|apply view_both_dfrac_validI_2]; naive_solver. Qed. Lemma view_both_validI_1 (relI : uPred M) a b : (∀ n (x : M), rel n a b → relI n x) → ✓ (●V a ⋅ ◯V b : view rel) ⊢ relI. Proof. intros. by rewrite view_both_dfrac_validI_1 // bi.and_elim_r. Qed. Lemma view_both_validI_2 (relI : uPred M) a b : (∀ n (x : M), relI n x → rel n a b) → relI ⊢ ✓ (●V a ⋅ ◯V b : view rel). Proof. intros. rewrite -view_both_dfrac_validI_2 //. apply bi.and_intro; [|done]. by apply bi.pure_intro. Qed. Lemma view_both_validI (relI : uPred M) a b : (∀ n (x : M), rel n a b ↔ relI n x) → ✓ (●V a ⋅ ◯V b : view rel) ⊣⊢ relI. Proof. intros. apply (anti_symm _); [apply view_both_validI_1|apply view_both_validI_2]; naive_solver. Qed. Lemma view_auth_dfrac_validI (relI : uPred M) dq a : (∀ n (x : M), relI n x ↔ rel n a ε) → ✓ (●V{dq} a : view rel) ⊣⊢ ⌜✓dq⌝ ∧ relI. Proof. intros. rewrite -(right_id ε op (●V{dq} a)). by apply view_both_dfrac_validI. Qed. Lemma view_auth_validI (relI : uPred M) a : (∀ n (x : M), relI n x ↔ rel n a ε) → ✓ (●V a : view rel) ⊣⊢ relI. Proof. intros. rewrite -(right_id ε op (●V a)). by apply view_both_validI. Qed. Lemma view_frag_validI (relI : uPred M) b : (∀ n (x : M), relI n x ↔ ∃ a, rel n a b) → ✓ (◯V b : view rel) ⊣⊢ relI. Proof. uPred.unseal=> Hrel. split=> n x _. by rewrite Hrel. Qed. End view. Section auth. Context {A : ucmra}. Implicit Types a b : A. Implicit Types x y : auth A. Lemma auth_auth_dfrac_validI dq a : ✓ (●{dq} a) ⊣⊢ ⌜✓dq⌝ ∧ ✓ a. Proof. apply view_auth_dfrac_validI=> n. uPred.unseal; split; [|by intros [??]]. split; [|done]. apply ucmra_unit_leastN. Qed. Lemma auth_auth_validI a : ✓ (● a) ⊣⊢ ✓ a. Proof. by rewrite auth_auth_dfrac_validI bi.pure_True // left_id. Qed. Lemma auth_auth_dfrac_op_validI dq1 dq2 a1 a2 : ✓ (●{dq1} a1 ⋅ ●{dq2} a2) ⊣⊢ ✓ (dq1 ⋅ dq2) ∧ (a1 ≡ a2) ∧ ✓ a1. Proof. uPred.unseal; split => n x _. apply auth_auth_dfrac_op_validN. Qed. Lemma auth_frag_validI a : ✓ (◯ a) ⊣⊢ ✓ a. Proof. apply view_frag_validI=> n x. rewrite auth_view_rel_exists. by uPred.unseal. Qed. Lemma auth_both_dfrac_validI dq a b : ✓ (●{dq} a ⋅ ◯ b) ⊣⊢ ⌜✓dq⌝ ∧ (∃ c, a ≡ b ⋅ c) ∧ ✓ a. Proof. apply view_both_dfrac_validI=> n. by uPred.unseal. Qed. Lemma auth_both_validI a b : ✓ (● a ⋅ ◯ b) ⊣⊢ (∃ c, a ≡ b ⋅ c) ∧ ✓ a. Proof. by rewrite auth_both_dfrac_validI bi.pure_True // left_id. Qed. End auth. Section excl_auth. Context {A : ofe}. Implicit Types a b : A. Lemma excl_auth_agreeI a b : ✓ (●E a ⋅ ◯E b) ⊢ (a ≡ b). Proof. rewrite auth_both_validI bi.and_elim_l. apply bi.exist_elim=> -[[c|]|]; by rewrite option_equivI /= excl_equivI //= bi.False_elim. Qed. End excl_auth. Section dfrac_agree. Context {A : ofe}. Implicit Types a b : A. Lemma dfrac_agree_validI dq a : ✓ (to_dfrac_agree dq a) ⊣⊢ ⌜✓ dq⌝. Proof. rewrite prod_validI /= uPred.discrete_valid. apply bi.entails_anti_sym. - by rewrite bi.and_elim_l. - apply bi.and_intro; first done. etrans; last apply to_agree_validI. apply bi.True_intro. Qed. Lemma dfrac_agree_validI_2 dq1 dq2 a b : ✓ (to_dfrac_agree dq1 a ⋅ to_dfrac_agree dq2 b) ⊣⊢ ⌜✓ (dq1 ⋅ dq2)⌝ ∧ (a ≡ b). Proof. rewrite prod_validI /= uPred.discrete_valid to_agree_op_validI //. Qed. Lemma frac_agree_validI q a : ✓ (to_frac_agree q a) ⊣⊢ ⌜(q ≤ 1)%Qp⌝. Proof. rewrite dfrac_agree_validI dfrac_valid_own //. Qed. Lemma frac_agree_validI_2 q1 q2 a b : ✓ (to_frac_agree q1 a ⋅ to_frac_agree q2 b) ⊣⊢ ⌜(q1 + q2 ≤ 1)%Qp⌝ ∧ (a ≡ b). Proof. rewrite dfrac_agree_validI_2 dfrac_valid_own //. Qed. End dfrac_agree. Section gmap_view. Context {K : Type} `{Countable K} {V : cmra}. Implicit Types (m : gmap K V) (k : K) (dq : dfrac) (v : V). Lemma gmap_view_both_dfrac_validI dp m k dq v : ✓ (gmap_view_auth dp m ⋅ gmap_view_frag k dq v) ⊣⊢ ∃ v' dq', ⌜✓ dp⌝ ∧ ⌜m !! k = Some v'⌝ ∧ ✓ (dq', v') ∧ Some (dq, v) ≼ Some (dq', v'). Proof. unfold internal_included. uPred.unseal. split=> n x _. apply: gmap_view_both_dfrac_validN. Qed. Lemma gmap_view_both_validI m dp k v : ✓ (gmap_view_auth dp m ⋅ gmap_view_frag k (DfracOwn 1) v) ⊣⊢ ⌜ ✓ dp ⌝ ∧ ✓ v ∧ m !! k ≡ Some v. Proof. uPred.unseal. split=> n x _. apply: gmap_view_both_validN. Qed. Lemma gmap_view_both_validI_total `{!CmraTotal V} dp m k dq v : ✓ (gmap_view_auth dp m ⋅ gmap_view_frag k dq v) ⊢ ∃ v', ⌜✓ dp ⌝ ∧ ⌜ ✓ dq⌝ ∧ ⌜m !! k = Some v'⌝ ∧ ✓ v' ∧ v ≼ v'. Proof. unfold internal_included. uPred.unseal. split=> n x _. apply: gmap_view_both_dfrac_validN_total. Qed. Lemma gmap_view_frag_op_validI k dq1 dq2 v1 v2 : ✓ (gmap_view_frag k dq1 v1 ⋅ gmap_view_frag k dq2 v2) ⊣⊢ ⌜✓ (dq1 ⋅ dq2)⌝ ∧ ✓ (v1 ⋅ v2). Proof. uPred.unseal. split=> n x _. apply: gmap_view_frag_op_validN. Qed. End gmap_view. End upred. iris-iris-4.2.0/iris/base_logic/base_logic.v000066400000000000000000000006711460620107300207450ustar00rootroot00000000000000From iris.bi Require Export bi. From iris.base_logic Require Export derived proofmode algebra. From iris.prelude Require Import options. (* 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 base_logic.bi.uPred. Export derived.uPred. Export bi.bi. End uPred. iris-iris-4.2.0/iris/base_logic/bi.v000066400000000000000000000266631460620107300172610ustar00rootroot00000000000000From iris.bi Require Export derived_connectives extensions updates internal_eq plainly. From iris.base_logic Require Export upred. From iris.prelude Require Import options. 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 : ucmra) : BiMixin uPred_entails uPred_emp uPred_pure uPred_and uPred_or uPred_impl (@uPred_forall M) (@uPred_exist M) uPred_sep uPred_wand. Proof. split. - exact: entails_po. - exact: equiv_entails. - 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: pure_intro. - exact: pure_elim'. - 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'. Qed. Lemma uPred_bi_persistently_mixin (M : ucmra) : BiPersistentlyMixin uPred_entails uPred_emp uPred_and (@uPred_exist M) uPred_sep uPred_persistently. Proof. split. - exact: persistently_ne. - exact: persistently_mono. - exact: persistently_idemp_2. - (* emp ⊢ 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. - (* (( P) ∧ ( Q)) ⊢ (P ∧ Q) (ADMISSIBLE) *) intros P Q. trans (uPred_forall (M:=M) (λ b : bool, uPred_persistently (if b then P else Q))). + apply forall_intro=>[[]]. * apply and_elim_l. * apply and_elim_r. + etrans; first exact: persistently_forall_2. apply persistently_mono. apply and_intro. * etrans; first apply (forall_elim true). done. * etrans; first apply (forall_elim false). done. - exact: @persistently_exist_1. - (* P ∗ Q ⊢ 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_bi_later_mixin (M : ucmra) : BiLaterMixin uPred_entails uPred_pure uPred_or uPred_impl (@uPred_forall M) (@uPred_exist M) uPred_sep uPred_persistently uPred_later. Proof. split. - apply contractive_ne, later_contractive. - 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 : ucmra) : bi := {| bi_ofe_mixin := ofe_mixin_of (uPred M); bi_bi_mixin := uPred_bi_mixin M; bi_bi_later_mixin := uPred_bi_later_mixin M; bi_bi_persistently_mixin := uPred_bi_persistently_mixin M |}. Lemma uPred_internal_eq_mixin M : BiInternalEqMixin (uPredI M) (@uPred_internal_eq M). Proof. split. - 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. Qed. Global Instance uPred_internal_eq M : BiInternalEq (uPredI M) := {| bi_internal_eq_mixin := uPred_internal_eq_mixin M |}. Lemma uPred_plainly_mixin M : BiPlainlyMixin (uPredI M) uPred_plainly. Proof. split. - exact: plainly_ne. - exact: plainly_mono. - exact: plainly_elim_persistently. - exact: plainly_idemp_2. - exact: @plainly_forall_2. - 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: later_plainly_1. - exact: later_plainly_2. Qed. Global Instance uPred_plainly M : BiPlainly (uPredI 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 |}. (** extra BI instances *) Global Instance uPred_affine M : BiAffine (uPredI M) | 0. Proof. intros P. 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. *) Global Hint Immediate uPred_affine : core. Global Instance uPred_persistently_forall M : BiPersistentlyForall (uPredI M). Proof. exact: @persistently_forall_2. Qed. Global Instance uPred_pure_forall M : BiPureForall (uPredI M). Proof. exact: @pure_forall_2. Qed. Global Instance uPred_later_contractive {M} : BiLaterContractive (uPredI M). Proof. exact: @later_contractive. Qed. Global Instance uPred_persistently_impl_plainly M : BiPersistentlyImplPlainly (uPredI M). Proof. exact: persistently_impl_plainly. Qed. Global Instance uPred_plainly_exist_1 M : BiPlainlyExist (uPredI M). Proof. exact: @plainly_exist_1. Qed. Global Instance uPred_prop_ext M : BiPropExt (uPredI M). Proof. exact: prop_ext_2. Qed. Global Instance uPred_bi_bupd_plainly M : BiBUpdPlainly (uPredI M). Proof. exact: bupd_plainly. Qed. (** Re-state/export lemmas about Iris-specific primitive connectives (own, valid) *) Module uPred. Section restate. Context {M : ucmra}. 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 : cmra} : NonExpansive (@uPred_cmra_valid M A) := uPred_primitive.cmra_valid_ne. (** Re-exporting primitive lemmas that are not in any interface *) 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 ⊢ 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. (** This is really just a special case of an entailment between two [siProp], but we do not have the infrastructure to express the more general case. This temporary proof rule will be replaced by the proper one eventually. *) Lemma internal_eq_entails {A B : ofe} (a1 a2 : A) (b1 b2 : B) : (a1 ≡ a2 ⊢ b1 ≡ b2) ↔ (∀ n, a1 ≡{n}≡ a2 → b1 ≡{n}≡ b2). Proof. exact: uPred_primitive.internal_eq_entails. Qed. Lemma ownM_valid (a : M) : uPred_ownM a ⊢ ✓ a. Proof. exact: uPred_primitive.ownM_valid. Qed. Lemma cmra_valid_intro {A : cmra} P (a : A) : ✓ a → P ⊢ (✓ a). Proof. exact: uPred_primitive.cmra_valid_intro. Qed. Lemma cmra_valid_elim {A : cmra} (a : A) : ✓ a ⊢ ⌜ ✓{0} a ⌝. Proof. exact: uPred_primitive.cmra_valid_elim. Qed. Lemma plainly_cmra_valid_1 {A : cmra} (a : A) : ✓ a ⊢ ■ ✓ a. Proof. exact: uPred_primitive.plainly_cmra_valid_1. Qed. Lemma cmra_valid_weaken {A : cmra} (a b : A) : ✓ (a ⋅ b) ⊢ ✓ a. Proof. exact: uPred_primitive.cmra_valid_weaken. Qed. (** This is really just a special case of an entailment between two [siProp], but we do not have the infrastructure to express the more general case. This temporary proof rule will be replaced by the proper one eventually. *) Lemma valid_entails {A B : cmra} (a : A) (b : B) : (∀ n, ✓{n} a → ✓{n} b) → ✓ a ⊢ ✓ b. Proof. exact: uPred_primitive.valid_entails. Qed. (** Consistency/soundness statement *) Lemma pure_soundness φ : (⊢@{uPredI M} ⌜ φ ⌝) → φ. Proof. apply pure_soundness. Qed. Lemma internal_eq_soundness {A : ofe} (x y : A) : (⊢@{uPredI M} x ≡ y) → x ≡ y. Proof. apply internal_eq_soundness. Qed. Lemma later_soundness P : (⊢ ▷ P) → ⊢ P. Proof. apply later_soundness. Qed. (** We restate the unsealing lemmas for the BI layer. The sealing lemmas are partially applied so that they also rewrite under binders. *) Local Lemma uPred_emp_unseal : bi_emp = @upred.uPred_pure_def M True. Proof. by rewrite -upred.uPred_pure_unseal. Qed. Local Lemma uPred_pure_unseal : bi_pure = @upred.uPred_pure_def M. Proof. by rewrite -upred.uPred_pure_unseal. Qed. Local Lemma uPred_and_unseal : bi_and = @upred.uPred_and_def M. Proof. by rewrite -upred.uPred_and_unseal. Qed. Local Lemma uPred_or_unseal : bi_or = @upred.uPred_or_def M. Proof. by rewrite -upred.uPred_or_unseal. Qed. Local Lemma uPred_impl_unseal : bi_impl = @upred.uPred_impl_def M. Proof. by rewrite -upred.uPred_impl_unseal. Qed. Local Lemma uPred_forall_unseal : @bi_forall _ = @upred.uPred_forall_def M. Proof. by rewrite -upred.uPred_forall_unseal. Qed. Local Lemma uPred_exist_unseal : @bi_exist _ = @upred.uPred_exist_def M. Proof. by rewrite -upred.uPred_exist_unseal. Qed. Local Lemma uPred_internal_eq_unseal : @internal_eq _ _ = @upred.uPred_internal_eq_def M. Proof. by rewrite -upred.uPred_internal_eq_unseal. Qed. Local Lemma uPred_sep_unseal : bi_sep = @upred.uPred_sep_def M. Proof. by rewrite -upred.uPred_sep_unseal. Qed. Local Lemma uPred_wand_unseal : bi_wand = @upred.uPred_wand_def M. Proof. by rewrite -upred.uPred_wand_unseal. Qed. Local Lemma uPred_plainly_unseal : plainly = @upred.uPred_plainly_def M. Proof. by rewrite -upred.uPred_plainly_unseal. Qed. Local Lemma uPred_persistently_unseal : bi_persistently = @upred.uPred_persistently_def M. Proof. by rewrite -upred.uPred_persistently_unseal. Qed. Local Lemma uPred_later_unseal : bi_later = @upred.uPred_later_def M. Proof. by rewrite -upred.uPred_later_unseal. Qed. Local Lemma uPred_bupd_unseal : bupd = @upred.uPred_bupd_def M. Proof. by rewrite -upred.uPred_bupd_unseal. Qed. Local Definition uPred_unseal := (uPred_emp_unseal, uPred_pure_unseal, uPred_and_unseal, uPred_or_unseal, uPred_impl_unseal, uPred_forall_unseal, uPred_exist_unseal, uPred_internal_eq_unseal, uPred_sep_unseal, uPred_wand_unseal, uPred_plainly_unseal, uPred_persistently_unseal, uPred_later_unseal, upred.uPred_ownM_unseal, upred.uPred_cmra_valid_unseal, @uPred_bupd_unseal). End restate. (** A tactic for rewriting with the above lemmas. Unfolds [uPred] goals that use the BI layer. This is used by [base_logic.algebra] and [base_logic.bupd_alt]. *) Ltac unseal := rewrite !uPred_unseal /=. End uPred. iris-iris-4.2.0/iris/base_logic/bupd_alt.v000066400000000000000000000106441460620107300204510ustar00rootroot00000000000000From iris.proofmode Require Import proofmode. From iris.base_logic Require Export base_logic. From iris.prelude Require Import options. (* The sections add extra BI assumptions, which is only picked up with [Type*]. *) Set Default Proof Using "Type*". (** This file contains an alternative version of basic updates, that is expression in terms of just the plain modality [■]. *) Definition bupd_alt {PROP : bi} `{!BiPlainly PROP} (P : PROP) : PROP := ∀ R, (P -∗ ■ R) -∗ ■ R. (** This definition is stated for any BI with a plain modality. The above definition is akin to the continuation monad, where one should think of [■ R] being the final result that one wants to get out of the basic update in the end of the day (via [bupd_alt (■ P) ⊢ ■ P]). We show that: 1. [bupd_alt] enjoys the usual rules of the basic update modality. 2. [bupd_alt] entails any other modality that enjoys the laws of a basic update modality (see [bupd_bupd_alt]). 3. The ordinary basic update modality [|==>] on [uPred] entails [bupd_alt] (see [bupd_alt_bupd]). This result is proven in the model of [uPred]. The first two points are shown for any BI with a plain modality. *) Local Coercion uPred_holds : uPred >-> Funclass. Section bupd_alt. Context {PROP : bi} `{!BiPlainly PROP}. Implicit Types P Q R : PROP. Notation bupd_alt := (@bupd_alt PROP _). Global Instance bupd_alt_ne : NonExpansive bupd_alt. Proof. solve_proper. Qed. Global Instance bupd_alt_proper : Proper ((≡) ==> (≡)) bupd_alt. Proof. solve_proper. Qed. Global Instance bupd_alt_mono' : Proper ((⊢) ==> (⊢)) bupd_alt. Proof. solve_proper. Qed. Global Instance bupd_alt_flip_mono' : Proper (flip (⊢) ==> flip (⊢)) bupd_alt. Proof. solve_proper. Qed. (** The laws of the basic update modality hold *) Lemma bupd_alt_intro P : P ⊢ bupd_alt P. Proof. iIntros "HP" (R) "H". by iApply "H". Qed. Lemma bupd_alt_mono P Q : (P ⊢ Q) → bupd_alt P ⊢ bupd_alt Q. Proof. by intros ->. Qed. Lemma bupd_alt_trans P : bupd_alt (bupd_alt P) ⊢ bupd_alt P. Proof. iIntros "HP" (R) "H". iApply "HP". iIntros "HP". by iApply "HP". Qed. Lemma bupd_alt_frame_r P Q : bupd_alt P ∗ Q ⊢ bupd_alt (P ∗ Q). Proof. iIntros "[HP HQ]" (R) "H". iApply "HP". iIntros "HP". iApply ("H" with "[$]"). Qed. Lemma bupd_alt_plainly P : bupd_alt (■ P) ⊢ ■ P. Proof. iIntros "H". iApply ("H" $! P with "[]"); auto. Qed. (** Any modality conforming with [BiBUpdPlainly] entails the alternative definition *) Lemma bupd_bupd_alt `{!BiBUpd PROP, !BiBUpdPlainly PROP} P : (|==> P) ⊢ bupd_alt P. Proof. iIntros "HP" (R) "H". by iMod ("H" with "HP") as "?". Qed. (** We get the usual rule for frame preserving updates if we have an [own] connective satisfying the following rule w.r.t. interaction with plainly. *) Context {M : ucmra} (own : M → PROP). Context (own_updateP_plainly : ∀ x Φ R, x ~~>: Φ → own x ∗ (∀ y, ⌜Φ y⌝ -∗ own y -∗ ■ R) ⊢ ■ R). Lemma own_updateP x (Φ : M → Prop) : x ~~>: Φ → own x ⊢ bupd_alt (∃ y, ⌜Φ y⌝ ∧ own y). Proof. iIntros (Hup) "Hx"; iIntros (R) "H". iApply (own_updateP_plainly with "[$Hx H]"); first done. iIntros (y ?) "Hy". iApply "H"; auto. Qed. End bupd_alt. (** The alternative definition entails the ordinary basic update *) Lemma bupd_alt_bupd {M} (P : uPred M) : bupd_alt P ⊢ |==> P. Proof. rewrite /bupd_alt. uPred.unseal; split=> n x Hx H k y ? Hxy. unshelve refine (H {| uPred_holds k _ := ∃ x' : M, ✓{k} (x' ⋅ y) ∧ P k x' |} k y _ _ _). - intros n1 n2 x1 x2 (z&?&?) _ ?. eauto using cmra_validN_le, uPred_mono. - done. - done. - intros k' z ?? HP. exists z. by rewrite (comm op). Qed. Lemma bupd_alt_bupd_iff {M} (P : uPred M) : bupd_alt P ⊣⊢ |==> P. Proof. apply (anti_symm _). - apply bupd_alt_bupd. - apply bupd_bupd_alt. Qed. (** The law about the interaction between [uPred_ownM] and plainly holds. *) Lemma ownM_updateP {M : ucmra} x (Φ : M → Prop) (R : uPred M) : x ~~>: Φ → uPred_ownM x ∗ (∀ y, ⌜Φ y⌝ -∗ uPred_ownM y -∗ ■ R) ⊢ ■ R. Proof. uPred.unseal=> Hup; split; intros n z Hv (?&z2&?&[z1 ?]&HR); ofe_subst. destruct (Hup n (Some (z1 ⋅ z2))) as (y&?&?); simpl in *. { by rewrite assoc. } refine (HR y n z1 _ _ _ n y _ _ _); auto. - rewrite comm. by eapply cmra_validN_op_r. - by rewrite (comm _ _ y) (comm _ z2). - apply (reflexivity (R:=includedN _)). Qed. iris-iris-4.2.0/iris/base_logic/derived.v000066400000000000000000000156071460620107300203050ustar00rootroot00000000000000From iris.algebra Require Import frac. From iris.bi Require Export bi. From iris.base_logic Require Export bi. From iris.prelude Require Import options. Import bi.bi base_logic.bi.uPred. (** Derived laws for Iris-specific primitive connectives (own, valid). This file does NOT unseal! *) Module uPred. Section derived. Context {M : ucmra}. 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 Q). Notation "P ⊣⊢ Q" := (equiv (A:=uPredI M) P%I Q%I). (** Propers *) Global Instance ownM_proper: Proper ((≡) ==> (⊣⊢)) (@uPred_ownM M) := ne_proper _. Global Instance cmra_valid_proper {A : cmra} : Proper ((≡) ==> (⊣⊢)) (@uPred_cmra_valid M A) := ne_proper _. (** Own and valid derived *) Lemma persistently_cmra_valid_1 {A : cmra} (a : A) : ✓ a ⊢@{uPredI M} (✓ a). 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. 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. intros. rewrite ownM_valid cmra_valid_elim. by apply pure_elim'. Qed. Global Instance ownM_mono : Proper (flip (≼) ==> (⊢)) (@uPred_ownM M). 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 apply pure_intro. apply ownM_unit. Qed. Lemma plainly_cmra_valid {A : cmra} (a : A) : ■ ✓ a ⊣⊢ ✓ a. Proof. apply (anti_symm _), plainly_cmra_valid_1. apply plainly_elim, _. Qed. Lemma intuitionistically_cmra_valid {A : cmra} (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 discrete_valid {A : cmra} `{!CmraDiscrete A} (a : A) : ✓ a ⊣⊢ ⌜✓ a⌝. Proof. apply (anti_symm _). - rewrite cmra_valid_elim. by apply pure_mono, cmra_discrete_valid. - apply pure_elim'=> ?. by apply cmra_valid_intro. 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. (** Timeless instances *) Global Instance valid_timeless {A : cmra} `{!CmraDiscrete A} (a : A) : Timeless (✓ a : uPred M)%I. Proof. rewrite /Timeless !discrete_valid. apply (timeless _). Qed. Global Instance ownM_timeless (a : M) : Discrete a → Timeless (uPred_ownM a). Proof. intros ?. rewrite /Timeless later_ownM. apply exist_elim=> b. rewrite (timeless (a≡b)) (except_0_intro (uPred_ownM b)) -except_0_and. apply except_0_mono. rewrite internal_eq_sym. apply (internal_eq_rewrite' b a (uPred_ownM) _); auto using and_elim_l, and_elim_r. Qed. (** Plainness *) Global Instance cmra_valid_plain {A : cmra} (a : A) : Plain (✓ a : uPred M)%I. Proof. rewrite /Persistent. apply plainly_cmra_valid_1. Qed. (** Persistence *) Global Instance cmra_valid_persistent {A : cmra} (a : A) : Persistent (✓ a : uPred M)%I. 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. (** 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. (** Derive [NonExpansive]/[Contractive] from an internal statement *) Lemma ne_internal_eq {A B : ofe} (f : A → B) : NonExpansive f ↔ ∀ x1 x2, x1 ≡ x2 ⊢ f x1 ≡ f x2. Proof. split; [apply f_equivI|]. intros Hf n x1 x2. by eapply internal_eq_entails. Qed. Lemma ne_2_internal_eq {A B C : ofe} (f : A → B → C) : NonExpansive2 f ↔ ∀ x1 x2 y1 y2, x1 ≡ x2 ∧ y1 ≡ y2 ⊢ f x1 y1 ≡ f x2 y2. Proof. split. - intros Hf x1 x2 y1 y2. change ((x1,y1).1 ≡ (x2,y2).1 ∧ (x1,y1).2 ≡ (x2,y2).2 ⊢ uncurry f (x1,y1) ≡ uncurry f (x2,y2)). rewrite -prod_equivI. apply ne_internal_eq. solve_proper. - intros Hf n x1 x2 Hx y1 y2 Hy. change (uncurry f (x1,y1) ≡{n}≡ uncurry f (x2,y2)). apply ne_internal_eq; [|done]. intros [??] [??]. rewrite prod_equivI. apply Hf. Qed. Lemma contractive_internal_eq {A B : ofe} (f : A → B) : Contractive f ↔ ∀ x1 x2, ▷ (x1 ≡ x2) ⊢ f x1 ≡ f x2. Proof. split; [apply f_equivI_contractive|]. intros Hf n x1 x2 Hx. specialize (Hf x1 x2). rewrite -later_equivI internal_eq_entails in Hf. apply Hf. by f_contractive. Qed. (** Soundness statement for our modalities: facts derived under modalities in the empty context also without the modalities. For basic updates, soundness only holds for plain propositions. *) Lemma bupd_soundness P `{!Plain P} : (⊢ |==> P) → ⊢ P. Proof. rewrite bupd_elim. done. Qed. Lemma laterN_soundness P n : (⊢ ▷^n P) → ⊢ P. Proof. induction n; eauto using later_soundness. Qed. (** As pure demonstration, we also show that this holds for an arbitrary nesting of modalities. We have to do a bit of work to be able to state this theorem though. *) Inductive modality := MBUpd | MLater | MPersistently | MPlainly. Definition denote_modality (m : modality) : uPred M → uPred M := match m with | MBUpd => bupd | MLater => bi_later | MPersistently => bi_persistently | MPlainly => plainly end. Definition denote_modalities (ms : list modality) : uPred M → uPred M := λ P, foldr denote_modality P ms. (** Now we can state and prove 'soundness under arbitrary modalities' for plain propositions. This is probably not a lemma you want to actually use. *) Corollary modal_soundness P `{!Plain P} (ms : list modality) : (⊢ denote_modalities ms P) → ⊢ P. Proof. intros H. apply (laterN_soundness _ (length ms)). move: H. apply bi_emp_valid_mono. induction ms as [|m ms IH]; first done; simpl. destruct m; simpl; rewrite IH. - rewrite -later_intro. apply bupd_elim. apply _. - done. - rewrite -later_intro persistently_elim. done. - rewrite -later_intro plainly_elim. done. Qed. (** Consistency: one cannot deive [False] in the logic, not even under modalities. Again this is just for demonstration and probably not practically useful. *) Corollary consistency : ¬ ⊢@{uPredI M} False. Proof. intros H. by eapply pure_soundness. Qed. End derived. End uPred. iris-iris-4.2.0/iris/base_logic/lib/000077500000000000000000000000001460620107300172315ustar00rootroot00000000000000iris-iris-4.2.0/iris/base_logic/lib/boxes.v000066400000000000000000000321421460620107300205420ustar00rootroot00000000000000From iris.algebra Require Import lib.excl_auth gmap agree. From iris.proofmode Require Import proofmode. From iris.base_logic.lib Require Export invariants. From iris.prelude Require Import options. Import uPred. (** The CMRAs we need. *) Class boxG Σ := boxG_inG : inG Σ (prodR (excl_authR boolO) (optionR (agreeR (laterO (iPropO Σ))))). Local Existing Instance boxG_inG. Definition boxΣ : gFunctors := #[ GFunctor (excl_authR boolO * optionRF (agreeRF (▶ ∙)) ) ]. Global Instance subG_boxΣ Σ : subG boxΣ Σ → boxG Σ. Proof. solve_inG. Qed. Section box_defs. Context `{!invGS_gen hlc Σ, !boxG Σ} (N : namespace). Definition slice_name := gname. Definition box_own_auth (γ : slice_name) (a : excl_authR boolO) : iProp Σ := own γ (a, None). Definition box_own_prop (γ : slice_name) (P : iProp Σ) : iProp Σ := own γ (ε, Some (to_agree (Next P))). Definition slice_inv (γ : slice_name) (P : iProp Σ) : iProp Σ := ∃ b, box_own_auth γ (●E b) ∗ if b then P else True. Definition slice (γ : slice_name) (P : iProp Σ) : iProp Σ := box_own_prop γ P ∗ inv N (slice_inv γ P). Definition box (f : gmap slice_name bool) (P : iProp Σ) : iProp Σ := tc_opaque (∃ Φ : slice_name → iProp Σ, ▷ (P ≡ [∗ map] γ ↦ _ ∈ f, Φ γ) ∗ [∗ map] γ ↦ b ∈ f, box_own_auth γ (◯E b) ∗ box_own_prop γ (Φ γ) ∗ inv N (slice_inv γ (Φ γ)))%I. End box_defs. Global Instance: Params (@box_own_prop) 3 := {}. Global Instance: Params (@slice_inv) 3 := {}. Global Instance: Params (@slice) 5 := {}. Global Instance: Params (@box) 5 := {}. Section box. Context `{!invGS_gen hlc Σ, !boxG Σ} (N : namespace). Implicit Types P Q : iProp Σ. Global Instance box_own_prop_ne γ : NonExpansive (box_own_prop γ). Proof. solve_proper. Qed. Global Instance box_own_prop_contractive γ : Contractive (box_own_prop γ). Proof. solve_contractive. Qed. Global Instance box_inv_ne γ : NonExpansive (slice_inv γ). Proof. solve_proper. Qed. Global Instance slice_ne γ : NonExpansive (slice N γ). Proof. solve_proper. Qed. Global Instance slice_contractive γ : Contractive (slice N γ). Proof. solve_contractive. Qed. Global Instance slice_proper γ : Proper ((≡) ==> (≡)) (slice N γ). Proof. apply ne_proper, _. Qed. Global Instance slice_persistent γ P : Persistent (slice N γ P). Proof. apply _. Qed. Global Instance box_contractive f : Contractive (box N f). Proof. solve_contractive. Qed. Global Instance box_ne f : NonExpansive (box N f). Proof. apply (contractive_ne _). Qed. Global Instance box_proper f : Proper ((≡) ==> (≡)) (box N f). Proof. apply ne_proper, _. Qed. Lemma box_own_auth_agree γ b1 b2 : box_own_auth γ (●E b1) ∗ box_own_auth γ (◯E b2) ⊢ ⌜b1 = b2⌝. Proof. rewrite /box_own_prop -own_op own_valid prod_validI /= and_elim_l. by iDestruct 1 as %?%excl_auth_agree_L. Qed. Lemma box_own_auth_update γ b1 b2 b3 : box_own_auth γ (●E b1) ∗ box_own_auth γ (◯E b2) ==∗ box_own_auth γ (●E b3) ∗ box_own_auth γ (◯E b3). Proof. rewrite /box_own_auth -!own_op. iApply own_update. apply prod_update; last done. apply excl_auth_update. Qed. Lemma box_own_agree γ Q1 Q2 : box_own_prop γ Q1 ∗ box_own_prop γ Q2 ⊢ ▷ (Q1 ≡ Q2). Proof. rewrite /box_own_prop -own_op own_valid prod_validI /= and_elim_r. by rewrite option_validI /= agree_validI agree_equivI later_equivI /=. Qed. Lemma box_alloc : ⊢ box N ∅ True. Proof. iIntros. iExists (λ _, True)%I. by rewrite !big_opM_empty. Qed. Lemma slice_insert_empty E q f Q P : ▷?q box N f P ={E}=∗ ∃ γ, ⌜f !! γ = None⌝ ∗ slice N γ Q ∗ ▷?q box N (<[γ:=false]> f) (Q ∗ P). Proof. iDestruct 1 as (Φ) "[#HeqP Hf]". iMod (own_alloc_cofinite (●E false ⋅ ◯E false, Some (to_agree (Next Q))) (dom f)) as (γ) "[Hdom Hγ]"; first by (split; [apply auth_both_valid_discrete|]). rewrite pair_split. iDestruct "Hγ" as "[[Hγ Hγ'] #HγQ]". iDestruct "Hdom" as % ?%not_elem_of_dom. iMod (inv_alloc N _ (slice_inv γ Q) with "[Hγ]") as "#Hinv". { iNext. iExists false; eauto. } iModIntro; iExists γ; repeat iSplit; auto. iNext. iExists (<[γ:=Q]> Φ); iSplit. - iNext. iRewrite "HeqP". by rewrite big_opM_fn_insert'. - rewrite (big_opM_fn_insert (λ _ _ P', _ ∗ _ _ P' ∗ _ _ (_ _ P')))%I //. iFrame; eauto. Qed. 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')) ∗ 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γ _]". iDestruct (big_sepM_delete _ f _ false with "Hf") as "[[>Hγ' #[HγΦ ?]] ?]"; first done. iDestruct (box_own_auth_agree γ b false with "[-]") as %->; first by iFrame. 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. - iExists Φ; eauto. Qed. Lemma slice_fill E q f γ P Q : ↑N ⊆ E → f !! γ = Some false → 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γ _]". iDestruct (big_sepM_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γ']". iModIntro. iSplitL "Hγ HQ"; first (iNext; iExists true; by iFrame). iModIntro; iNext; iExists Φ; iSplit. - by rewrite big_opM_insert_override. - rewrite -insert_delete_insert big_opM_insert ?lookup_delete //. iFrame; eauto. Qed. Lemma slice_empty E q f P Q γ : ↑N ⊆ E → f !! γ = Some true → 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]". iDestruct (big_sepM_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γ']". iModIntro. iSplitL "Hγ"; first (iNext; iExists false; by repeat iSplit). iModIntro; iNext; iExists Φ; iSplit. - by rewrite big_opM_insert_override. - rewrite -insert_delete_insert big_opM_insert ?lookup_delete //. iFrame; eauto. Qed. Lemma slice_insert_full E q f P Q : ↑N ⊆ E → ▷ Q -∗ ▷?q box N f P ={E}=∗ ∃ γ, ⌜f !! γ = None⌝ ∗ slice N γ Q ∗ ▷?q box N (<[γ:=true]> f) (Q ∗ P). Proof. iIntros (?) "HQ Hbox". iMod (slice_insert_empty with "Hbox") as (γ ?) "[#Hslice Hbox]". iExists γ. iFrame "%#". iMod (slice_fill with "Hslice HQ Hbox"); first done. - by apply lookup_insert. - by rewrite insert_insert. Qed. Lemma slice_delete_full E q f P Q γ : ↑N ⊆ E → f !! γ = Some true → slice N γ Q -∗ ▷?q box N f P ={E}=∗ ∃ P', ▷ Q ∗ ▷?q ▷ (P ≡ (Q ∗ P')) ∗ ▷?q box N (delete γ f) P'. Proof. iIntros (??) "#Hslice Hbox". iMod (slice_empty with "Hslice Hbox") as "[$ Hbox]"; try done. iMod (slice_delete_empty with "Hslice Hbox") as (P') "[Heq Hbox]"; first done. { by apply lookup_insert. } iExists P'. iFrame. rewrite -insert_delete_insert delete_insert ?lookup_delete //. Qed. Lemma box_fill E f P : ↑N ⊆ E → box N f P -∗ ▷ P ={E}=∗ box N (const true <$> 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_sepM_later) in "HeqP". iDestruct ("HeqP" with "HP") as "HP". iCombine "Hf" "HP" as "Hf". rewrite -big_sepM_sep big_opM_fmap; iApply (big_sepM_fupd _ _ f). iApply (@big_sepM_impl with "Hf"). iIntros "!>" (γ b' ?) "[(Hγ' & #$ & #$) HΦ]". iInv N as (b) "[>Hγ _]". iMod (box_own_auth_update γ with "[Hγ Hγ']") as "[Hγ $]"; first by iFrame. iModIntro. iSplitL; last done. iNext; iExists true. iFrame. Qed. Lemma box_empty E f P : ↑N ⊆ E → map_Forall (λ _, (true =.)) f → box N f P ={E}=∗ ▷ P ∗ box N (const false <$> f) P. Proof. iDestruct 1 as (Φ) "[#HeqP Hf]". iAssert (([∗ map] γ↦b ∈ f, ▷ Φ γ) ∗ [∗ map] γ↦b ∈ f, box_own_auth γ (◯E false) ∗ box_own_prop γ (Φ γ) ∗ inv N (slice_inv γ (Φ γ)))%I with "[> Hf]" as "[HΦ ?]". { rewrite -big_sepM_sep -big_sepM_fupd. iApply (@big_sepM_impl with "[$Hf]"). iIntros "!>" (γ b ?) "(Hγ' & #HγΦ & #Hinv)". assert (true = b) as <- by eauto. 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γ $]". 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_sepM_later. by iApply "HeqP". - iExists Φ; iSplit; by rewrite big_opM_fmap. Qed. Lemma slice_iff E q f P Q Q' γ b : ↑N ⊆ E → f !! γ = Some b → ▷ □ (Q ↔ Q') -∗ slice N γ Q -∗ ▷?q box N f P ={E}=∗ ∃ γ' P', ⌜delete γ f !! γ' = None⌝ ∗ ▷?q ▷ □ (P ↔ P') ∗ slice N γ' Q' ∗ ▷?q box N (<[γ' := b]>(delete γ f)) P'. Proof. iIntros (??) "#HQQ' #Hs Hb". destruct b. - iMod (slice_delete_full with "Hs Hb") as (P') "(HQ & Heq & Hb)"; try done. iDestruct ("HQQ'" with "HQ") as "HQ'". iMod (slice_insert_full with "HQ' Hb") as (γ' ?) "[#Hs' Hb]"; try done. iExists γ', _. iIntros "{$∗ $# $%} !>". do 2 iNext. iRewrite "Heq". iIntros "!>". 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 γ', (Q' ∗ P')%I. iIntros "{$∗ $# $%} !>". do 2 iNext. iRewrite "Heq". iIntros "!>". by iSplit; iIntros "[? $]"; iApply "HQQ'". Qed. Lemma slice_split E q f P Q1 Q2 γ b : ↑N ⊆ E → f !! γ = Some b → slice N γ (Q1 ∗ Q2) -∗ ▷?q box N f P ={E}=∗ ∃ γ1 γ2, ⌜delete γ f !! γ1 = None⌝ ∗ ⌜delete γ f !! γ2 = None⌝ ∗ ⌜γ1 ≠ γ2⌝ ∗ slice N γ1 Q1 ∗ slice N γ2 Q2 ∗ ▷?q box N (<[γ2 := b]>(<[γ1 := b]>(delete γ f))) P. Proof. iIntros (??) "#Hslice Hbox". destruct b. - iMod (slice_delete_full with "Hslice Hbox") as (P') "([HQ1 HQ2] & Heq & Hbox)"; try done. iMod (slice_insert_full with "HQ1 Hbox") as (γ1 ?) "[#Hslice1 Hbox]"; first done. iMod (slice_insert_full with "HQ2 Hbox") as (γ2 ?) "[#Hslice2 Hbox]"; first done. 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 _ _ (box _ _) 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]". iMod (slice_insert_empty with "Hbox") as (γ2 ?) "[#Hslice2 Hbox]". 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 _ _ (box _ _) with "[Heq] Hbox"). iNext. iRewrite "Heq". iPureIntro. by rewrite assoc (comm _ Q2). Qed. Lemma slice_combine E q f P Q1 Q2 γ1 γ2 b : ↑N ⊆ E → γ1 ≠ γ2 → f !! γ1 = Some b → f !! γ2 = Some b → slice N γ1 Q1 -∗ slice N γ2 Q2 -∗ ▷?q box N f P ={E}=∗ ∃ γ, ⌜delete γ2 (delete γ1 f) !! γ = None⌝ ∗ slice N γ (Q1 ∗ Q2) ∗ ▷?q box N (<[γ := b]>(delete γ2 (delete γ1 f))) P. Proof. iIntros (????) "#Hslice1 #Hslice2 Hbox". destruct b. - iMod (slice_delete_full with "Hslice1 Hbox") as (P1) "(HQ1 & Heq1 & Hbox)"; try done. iMod (slice_delete_full with "Hslice2 Hbox") as (P2) "(HQ2 & Heq2 & Hbox)"; first done. { by simplify_map_eq. } iMod (slice_insert_full _ _ _ _ (Q1 ∗ Q2) with "[$HQ1 $HQ2] Hbox") as (γ ?) "[#Hslice Hbox]"; first done. iExists γ. iIntros "{$% $#} !>". iNext. iApply (internal_eq_rewrite_contractive _ _ (box _ _) 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 _ _ (box _ _) with "[Heq1 Heq2] Hbox"). iNext. iRewrite "Heq1". iRewrite "Heq2". by rewrite assoc. Qed. End box. Global Typeclasses Opaque slice box. iris-iris-4.2.0/iris/base_logic/lib/cancelable_invariants.v000066400000000000000000000143371460620107300237370ustar00rootroot00000000000000From iris.algebra Require Export frac. From iris.bi.lib Require Import fractional. From iris.proofmode Require Import proofmode. From iris.base_logic.lib Require Export invariants. From iris.prelude Require Import options. Import uPred. Class cinvG Σ := { cinv_inG : inG Σ fracR }. Local Existing Instance cinv_inG. Definition cinvΣ : gFunctors := #[GFunctor fracR]. Global Instance subG_cinvΣ {Σ} : subG cinvΣ Σ → cinvG Σ. Proof. solve_inG. Qed. Section defs. Context `{!invGS_gen hlc Σ, !cinvG Σ}. Definition cinv_own (γ : gname) (p : frac) : iProp Σ := own γ p. Definition cinv (N : namespace) (γ : gname) (P : iProp Σ) : iProp Σ := inv N (P ∨ cinv_own γ 1). End defs. Global Instance: Params (@cinv) 5 := {}. Section proofs. Context `{!invGS_gen hlc Σ, !cinvG Σ}. Global Instance cinv_own_timeless γ p : Timeless (cinv_own γ p). Proof. rewrite /cinv_own; apply _. Qed. Global Instance cinv_contractive N γ : Contractive (cinv N γ). Proof. solve_contractive. Qed. Global Instance cinv_ne N γ : NonExpansive (cinv N γ). Proof. exact: contractive_ne. Qed. Global Instance cinv_proper N γ : Proper ((≡) ==> (≡)) (cinv N γ). Proof. exact: ne_proper. Qed. Global Instance cinv_persistent N γ P : Persistent (cinv N γ P). Proof. rewrite /cinv; apply _. Qed. Global Instance cinv_own_fractional γ : Fractional (cinv_own γ). 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. Lemma cinv_own_valid γ q1 q2 : cinv_own γ q1 -∗ cinv_own γ q2 -∗ ⌜q1 + q2 ≤ 1⌝%Qp. Proof. rewrite -frac_valid -uPred.discrete_valid. apply (own_valid_2 γ q1 q2). Qed. Lemma cinv_own_1_l γ q : cinv_own γ 1 -∗ cinv_own γ q -∗ False. Proof. iIntros "H1 H2". iDestruct (cinv_own_valid with "H1 H2") as %[]%(exclusive_l 1%Qp). Qed. Lemma cinv_iff N γ P Q : cinv N γ P -∗ ▷ □ (P ↔ Q) -∗ cinv N γ Q. Proof. iIntros "HI #HPQ". iApply (inv_iff with "HI"). iIntros "!> !>". iSplit; iIntros "[?|$]"; iLeft; by iApply "HPQ". Qed. (*** Allocation rules. *) (** The "strong" variants permit any infinite [I], and choosing [P] is delayed until after [γ] was chosen.*) Lemma cinv_alloc_strong (I : gname → Prop) E N : pred_infinite I → ⊢ |={E}=> ∃ γ, ⌜ I γ ⌝ ∗ cinv_own γ 1 ∗ ∀ P, ▷ P ={E}=∗ cinv N γ P. Proof. iIntros (?). iMod (own_alloc_strong 1%Qp I) as (γ) "[Hfresh Hγ]"; [done|done|]. iExists γ. iIntros "!> {$Hγ $Hfresh}" (P) "HP". iMod (inv_alloc N _ (P ∨ cinv_own γ 1) with "[HP]"); eauto. Qed. (** The "open" variants create the invariant in the open state, and delay having to prove [P]. These do not imply the other variants because of the extra assumption [↑N ⊆ E]. *) Lemma cinv_alloc_strong_open (I : gname → Prop) E N : pred_infinite I → ↑N ⊆ E → ⊢ |={E}=> ∃ γ, ⌜ I γ ⌝ ∗ cinv_own γ 1 ∗ ∀ P, |={E,E∖↑N}=> cinv N γ P ∗ (▷ P ={E∖↑N,E}=∗ True). Proof. iIntros (??). iMod (own_alloc_strong 1%Qp I) as (γ) "[Hfresh Hγ]"; [done|done|]. iExists γ. iIntros "!> {$Hγ $Hfresh}" (P). iMod (inv_alloc_open N _ (P ∨ cinv_own γ 1)) as "[Hinv Hclose]"; first by eauto. iIntros "!>". iFrame. iIntros "HP". iApply "Hclose". iLeft. done. Qed. Lemma cinv_alloc_cofinite (G : gset gname) E N : ⊢ |={E}=> ∃ γ, ⌜ γ ∉ G ⌝ ∗ cinv_own γ 1 ∗ ∀ P, ▷ P ={E}=∗ cinv N γ P. Proof. apply cinv_alloc_strong. apply (pred_infinite_set (C:=gset gname))=> E'. exists (fresh (G ∪ E')). apply not_elem_of_union, is_fresh. Qed. Lemma cinv_alloc E N P : ▷ P ={E}=∗ ∃ γ, cinv N γ P ∗ cinv_own γ 1. Proof. iIntros "HP". iMod (cinv_alloc_cofinite ∅ E N) as (γ _) "[Hγ Halloc]". iExists γ. iFrame "Hγ". by iApply "Halloc". Qed. Lemma cinv_alloc_open E N P : ↑N ⊆ E → ⊢ |={E,E∖↑N}=> ∃ γ, cinv N γ P ∗ cinv_own γ 1 ∗ (▷ P ={E∖↑N,E}=∗ True). Proof. iIntros (?). iMod (cinv_alloc_strong_open (λ _, True)) as (γ) "(_ & Htok & Hmake)"; [|done|]. { apply pred_infinite_True. } iMod ("Hmake" $! P) as "[Hinv Hclose]". iIntros "!>". iExists γ. iFrame. Qed. (*** Accessors *) Lemma cinv_acc_strong E N γ p P : ↑N ⊆ E → cinv N γ P -∗ (cinv_own γ p ={E,E∖↑N}=∗ ▷ P ∗ cinv_own γ p ∗ (∀ E' : coPset, ▷ P ∨ cinv_own γ 1 ={E',↑N ∪ E'}=∗ True)). Proof. iIntros (?) "Hinv Hown". iPoseProof (inv_acc (↑ N) N with "Hinv") as "H"; first done. rewrite difference_diag_L. iPoseProof (fupd_mask_frame_r _ _ (E ∖ ↑ N) with "H") as "H"; first set_solver. rewrite left_id_L -union_difference_L //. iMod "H" as "[[$ | >Hown'] H]". - iIntros "{$Hown} !>" (E') "HP". iPoseProof (fupd_mask_frame_r _ _ E' with "(H [HP])") as "H"; first set_solver. { iDestruct "HP" as "[?|?]"; eauto. } by rewrite left_id_L. - iDestruct (cinv_own_1_l with "Hown' Hown") as %[]. Qed. Lemma cinv_acc E N γ p P : ↑N ⊆ E → cinv N γ P -∗ cinv_own γ p ={E,E∖↑N}=∗ ▷ P ∗ cinv_own γ p ∗ (▷ P ={E∖↑N,E}=∗ True). Proof. iIntros (?) "#Hinv Hγ". iMod (cinv_acc_strong with "Hinv Hγ") as "($ & $ & H)"; first done. iIntros "!> HP". rewrite {2}(union_difference_L (↑N) E)=> //. iApply "H". by iLeft. Qed. (*** Other *) Lemma cinv_cancel E N γ P : ↑N ⊆ E → cinv N γ P -∗ cinv_own γ 1 ={E}=∗ ▷ P. Proof. iIntros (?) "#Hinv Hγ". iMod (cinv_acc_strong with "Hinv Hγ") as "($ & Hγ & H)"; first done. rewrite {2}(union_difference_L (↑N) E)=> //. iApply "H". by iRight. 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_acc with "Hinv"); done. Qed. End proofs. Global Typeclasses Opaque cinv_own cinv. iris-iris-4.2.0/iris/base_logic/lib/fancy_updates.v000066400000000000000000000275221460620107300222550ustar00rootroot00000000000000From stdpp Require Export coPset. From iris.algebra Require Import gmap auth agree gset coPset. From iris.proofmode Require Import proofmode. From iris.base_logic.lib Require Export own. From iris.base_logic.lib Require Import wsat. From iris.base_logic Require Export later_credits. From iris.prelude Require Import options. Export wsatGS. Import uPred. Import le_upd_if. (** The definition of fancy updates (and in turn the logic built on top of it) is parameterized by whether it supports elimination of laters via later credits or not. This choice is necessary as the fancy update *with* later credits does *not* support the interaction laws with the plainly modality in [BiFUpdPlainly]. While these laws are seldomly used, support for them is required for backwards compatibility. Thus, the [invGS_gen] typeclass ("gen" for "generalized") is parameterized by a parameter of type [has_lc] that determines whether later credits are available or not. [invGS] is provided as a convenient notation for the default [HasLc]. We don't use that notation in this file to avoid confusion. *) Inductive has_lc := HasLc | HasNoLc. Class invGpreS (Σ : gFunctors) : Set := InvGpreS { invGpreS_wsat : wsatGpreS Σ; invGpreS_lc : lcGpreS Σ; }. Class invGS_gen (hlc : has_lc) (Σ : gFunctors) : Set := InvG { invGS_wsat : wsatGS Σ; invGS_lc : lcGS Σ; }. Global Hint Mode invGS_gen - - : typeclass_instances. Global Hint Mode invGpreS - : typeclass_instances. Local Existing Instances invGpreS_wsat invGpreS_lc. (* [invGS_lc] needs to be global in order to enable the use of lemmas like [lc_split] that require [lcGS], and not [invGS]. [invGS_wsat] also needs to be global as the lemmas in [invariants.v] require it. *) Global Existing Instances invGS_lc invGS_wsat. Notation invGS := (invGS_gen HasLc). Definition invΣ : gFunctors := #[wsatΣ; lcΣ]. Global Instance subG_invΣ {Σ} : subG invΣ Σ → invGpreS Σ. Proof. solve_inG. Qed. Local Definition uPred_fupd_def `{!invGS_gen hlc Σ} (E1 E2 : coPset) (P : iProp Σ) : iProp Σ := wsat ∗ ownE E1 -∗ le_upd_if (if hlc is HasLc then true else false) (◇ (wsat ∗ ownE E2 ∗ P)). Local Definition uPred_fupd_aux : seal (@uPred_fupd_def). Proof. by eexists. Qed. Definition uPred_fupd := uPred_fupd_aux.(unseal). Global Arguments uPred_fupd {hlc Σ _}. Local Lemma uPred_fupd_unseal `{!invGS_gen hlc Σ} : @fupd _ uPred_fupd = uPred_fupd_def. Proof. rewrite -uPred_fupd_aux.(seal_eq) //. Qed. Lemma uPred_fupd_mixin `{!invGS_gen hlc Σ} : BiFUpdMixin (uPredI (iResUR Σ)) uPred_fupd. Proof. split. - rewrite uPred_fupd_unseal. solve_proper. - intros E1 E2 (E1''&->&?)%subseteq_disjoint_union_L. rewrite uPred_fupd_unseal /uPred_fupd_def ownE_op //. by iIntros "($ & $ & HE) !> !> [$ $] !> !>". - rewrite uPred_fupd_unseal. iIntros (E1 E2 P) ">H [Hw HE]". iApply "H"; by iFrame. - rewrite uPred_fupd_unseal. iIntros (E1 E2 P Q HPQ) "HP HwE". rewrite -HPQ. by iApply "HP". - rewrite uPred_fupd_unseal. 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_unseal /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_unseal /uPred_fupd_def. by iIntros (????) "[HwP $]". Qed. Global Instance uPred_bi_fupd `{!invGS_gen hlc Σ} : BiFUpd (uPredI (iResUR Σ)) := {| bi_fupd_mixin := uPred_fupd_mixin |}. Global Instance uPred_bi_bupd_fupd `{!invGS_gen hlc Σ} : BiBUpdFUpd (uPredI (iResUR Σ)). Proof. rewrite /BiBUpdFUpd uPred_fupd_unseal. by iIntros (E P) ">? [$ $] !> !>". Qed. (** The interaction laws with the plainly modality are only supported when we opt out of the support for later credits. *) Global Instance uPred_bi_fupd_plainly_no_lc `{!invGS_gen HasNoLc Σ} : BiFUpdPlainly (uPredI (iResUR Σ)). Proof. split; rewrite uPred_fupd_unseal /uPred_fupd_def. - iIntros (E P) "H [Hw HE]". iAssert (◇ ■ P)%I as "#>HP". { by iMod ("H" with "[$]") as "(_ & _ & HP)". } by iFrame. - iIntros (E P Q) "[H HQ] [Hw HE]". iAssert (◇ ■ P)%I as "#>HP". { by iMod ("H" with "HQ [$]") as "(_ & _ & HP)". } by iFrame. - iIntros (E P) "H [Hw HE]". iAssert (▷ ◇ ■ P)%I as "#HP". { iNext. by iMod ("H" with "[$]") as "(_ & _ & HP)". } iFrame. iIntros "!> !> !>". by iMod "HP". - iIntros (E A Φ) "HΦ [Hw HE]". iAssert (◇ ■ ∀ x : A, Φ x)%I as "#>HP". { iIntros (x). by iMod ("HΦ" with "[$Hw $HE]") as "(_&_&?)". } by iFrame. Qed. (** Later credits: the laws are only available when we opt into later credit support.*) (** [lc_fupd_elim_later] allows to eliminate a later from a hypothesis at an update. This is typically used as [iMod (lc_fupd_elim_later with "Hcredit HP") as "HP".], where ["Hcredit"] is a credit available in the context and ["HP"] is the assumption from which a later should be stripped. *) Lemma lc_fupd_elim_later `{!invGS_gen HasLc Σ} E P : £ 1 -∗ (▷ P) -∗ |={E}=> P. Proof. iIntros "Hf Hupd". rewrite uPred_fupd_unseal /uPred_fupd_def. iIntros "[$ $]". iApply (le_upd_later with "Hf"). iNext. by iModIntro. Qed. (** If the goal is a fancy update, this lemma can be used to make a later appear in front of it in exchange for a later credit. This is typically used as [iApply (lc_fupd_add_later with "Hcredit")], where ["Hcredit"] is a credit available in the context. *) Lemma lc_fupd_add_later `{!invGS_gen HasLc Σ} E1 E2 P : £ 1 -∗ (▷ |={E1, E2}=> P) -∗ |={E1, E2}=> P. Proof. iIntros "Hf Hupd". iApply (fupd_trans E1 E1). iApply (lc_fupd_elim_later with "Hf Hupd"). Qed. (** Similar to above, but here we are adding [n] laters. *) Lemma lc_fupd_add_laterN `{!invGS_gen HasLc Σ} E1 E2 P n : £ n -∗ (▷^n |={E1, E2}=> P) -∗ |={E1, E2}=> P. Proof. iIntros "Hf Hupd". iInduction n as [|n] "IH"; first done. iDestruct "Hf" as "[H1 Hf]". iApply (lc_fupd_add_later with "H1"); iNext. iApply ("IH" with "[$] [$]"). Qed. (** * [fupd] soundness lemmas *) (** "Unfolding" soundness stamement for no-LC fupd: This exposes that when initializing the [invGS_gen], we can provide a general lemma that lets one unfold a [|={E1, E2}=> P] into a basic update while also carrying around some frame [ω E] that tracks the current mask. We also provide a bunch of later credits for consistency, but there is no way to use them since this is a [HasNoLc] lemma. *) Lemma fupd_soundness_no_lc_unfold `{!invGpreS Σ} m E : ⊢ |==> ∃ `(Hws: invGS_gen HasNoLc Σ) (ω : coPset → iProp Σ), £ m ∗ ω E ∗ □ (∀ E1 E2 P, (|={E1, E2}=> P) -∗ ω E1 ==∗ ◇ (ω E2 ∗ P)). Proof. iMod wsat_alloc as (Hw) "[Hw HE]". (* We don't actually want any credits, but we need the [lcGS]. *) iMod (later_credits.le_upd.lc_alloc m) as (Hc) "[_ Hlc]". set (Hi := InvG HasNoLc _ Hw Hc). iExists Hi, (λ E, wsat ∗ ownE E)%I. rewrite (union_difference_L E ⊤); [|set_solver]. rewrite ownE_op; [|set_solver]. iDestruct "HE" as "[HE _]". iFrame. iIntros "!>!>" (E1 E2 P) "HP HwE". rewrite fancy_updates.uPred_fupd_unseal /fancy_updates.uPred_fupd_def -assoc /=. by iApply ("HP" with "HwE"). Qed. (** Note: the [_no_lc] soundness lemmas also allow generating later credits, but these cannot be used for anything. They are merely provided to enable making the adequacy proof generic in whether later credits are used. *) Lemma fupd_soundness_no_lc `{!invGpreS Σ} E1 E2 (P : iProp Σ) `{!Plain P} m : (∀ `{Hinv: !invGS_gen HasNoLc Σ}, £ m ={E1,E2}=∗ P) → ⊢ P. Proof. intros Hfupd. apply later_soundness, bupd_soundness; [by apply later_plain|]. iMod fupd_soundness_no_lc_unfold as (hws ω) "(Hlc & Hω & #H)". iMod ("H" with "[Hlc] Hω") as "H'". { iMod (Hfupd with "Hlc") as "H'". iModIntro. iApply "H'". } iDestruct "H'" as "[>H1 >H2]". by iFrame. Qed. Lemma fupd_soundness_lc `{!invGpreS Σ} n E1 E2 (P : iProp Σ) `{!Plain P} : (∀ `{Hinv: !invGS_gen HasLc Σ}, £ n ={E1,E2}=∗ P) → ⊢ P. Proof. intros Hfupd. eapply (lc_soundness (S n)); first done. intros Hc. rewrite lc_succ. iIntros "[Hone Hn]". rewrite -le_upd_trans. iApply bupd_le_upd. iMod wsat_alloc as (Hw) "[Hw HE]". set (Hi := InvG HasLc _ Hw Hc). iAssert (|={⊤,E2}=> P)%I with "[Hn]" as "H". { iMod (fupd_mask_subseteq E1) as "_"; first done. by iApply (Hfupd Hi). } rewrite uPred_fupd_unseal /uPred_fupd_def. iModIntro. iMod ("H" with "[$Hw $HE]") as "H". iPoseProof (except_0_into_later with "H") as "H". iApply (le_upd_later with "Hone"). iNext. iDestruct "H" as "(_ & _ & $)". Qed. (** Generic soundness lemma for the fancy update, parameterized by [use_credits] on whether to use credits or not. *) Lemma fupd_soundness_gen `{!invGpreS Σ} (P : iProp Σ) `{!Plain P} (hlc : has_lc) n E1 E2 : (∀ `{Hinv : invGS_gen hlc Σ}, £ n ={E1,E2}=∗ P) → ⊢ P. Proof. destruct hlc. - apply fupd_soundness_lc. done. - apply fupd_soundness_no_lc. done. Qed. (** [step_fupdN] soundness lemmas *) Lemma step_fupdN_soundness_no_lc `{!invGpreS Σ} (P : iProp Σ) `{!Plain P} n m : (∀ `{Hinv: !invGS_gen HasNoLc Σ}, £ m ={⊤,∅}=∗ |={∅}▷=>^n P) → ⊢ P. Proof. intros Hiter. apply (laterN_soundness _ (S n)); simpl. apply (fupd_soundness_no_lc ⊤ ⊤ _ m)=> Hinv. iIntros "Hc". iPoseProof (Hiter Hinv) as "H". clear Hiter. iApply fupd_plainly_mask_empty. iSpecialize ("H" with "Hc"). iMod (step_fupdN_plain with "H") as "H". iMod "H". iModIntro. rewrite -later_plainly -laterN_plainly -later_laterN laterN_later. iNext. iMod "H" as "#H". auto. Qed. Lemma step_fupdN_soundness_no_lc' `{!invGpreS Σ} (P : iProp Σ) `{!Plain P} n m : (∀ `{Hinv: !invGS_gen HasNoLc Σ}, £ m ={⊤}[∅]▷=∗^n P) → ⊢ P. Proof. intros Hiter. eapply (step_fupdN_soundness_no_lc _ n m)=>Hinv. iIntros "Hcred". destruct n as [|n]. { by iApply fupd_mask_intro_discard; [|iApply (Hiter Hinv)]. } simpl in Hiter |- *. iMod (Hiter with "Hcred") as "H". iIntros "!>!>!>". iMod "H". clear. iInduction n as [|n] "IH"; [by iApply fupd_mask_intro_discard|]. simpl. iMod "H". iIntros "!>!>!>". iMod "H". by iApply "IH". Qed. Lemma step_fupdN_soundness_lc `{!invGpreS Σ} (P : iProp Σ) `{!Plain P} n m : (∀ `{Hinv: !invGS_gen HasLc Σ}, £ m ={⊤,∅}=∗ |={∅}▷=>^n P) → ⊢ P. Proof. intros Hiter. eapply (fupd_soundness_lc (m + n)); [apply _..|]. iIntros (Hinv) "Hlc". rewrite lc_split. iDestruct "Hlc" as "[Hm Hn]". iMod (Hiter with "Hm") as "Hupd". clear Hiter. iInduction n as [|n] "IH"; simpl. - by iModIntro. - rewrite lc_succ. iDestruct "Hn" as "[Hone Hn]". iMod "Hupd". iMod (lc_fupd_elim_later with "Hone Hupd") as "> Hupd". by iApply ("IH" with "Hn Hupd"). Qed. Lemma step_fupdN_soundness_lc' `{!invGpreS Σ} (P : iProp Σ) `{!Plain P} n m : (∀ `{Hinv: !invGS_gen hlc Σ}, £ m ={⊤}[∅]▷=∗^n P) → ⊢ P. Proof. intros Hiter. eapply (fupd_soundness_lc (m + n) ⊤ ⊤); [apply _..|]. iIntros (Hinv) "Hlc". rewrite lc_split. iDestruct "Hlc" as "[Hm Hn]". iPoseProof (Hiter with "Hm") as "Hupd". clear Hiter. (* FIXME can we reuse [step_fupdN_soundness_lc] instead of redoing the induction? *) iInduction n as [|n] "IH"; simpl. - by iModIntro. - rewrite lc_succ. iDestruct "Hn" as "[Hone Hn]". iMod "Hupd". iMod (lc_fupd_elim_later with "Hone Hupd") as "> Hupd". by iApply ("IH" with "Hn Hupd"). Qed. (** Generic soundness lemma for the fancy update, parameterized by [use_credits] on whether to use credits or not. *) Lemma step_fupdN_soundness_gen `{!invGpreS Σ} (P : iProp Σ) `{!Plain P} (hlc : has_lc) (n m : nat) : (∀ `{Hinv : invGS_gen hlc Σ}, £ m ={⊤,∅}=∗ |={∅}▷=>^n P) → ⊢ P. Proof. destruct hlc. - apply step_fupdN_soundness_lc. done. - apply step_fupdN_soundness_no_lc. done. Qed. iris-iris-4.2.0/iris/base_logic/lib/fancy_updates_from_vs.v000066400000000000000000000053721460620107300240070ustar00rootroot00000000000000(* 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 stdpp Require Export coPset. From iris.proofmode Require Import proofmode. From iris.base_logic Require Export base_logic. From iris.prelude Require Import options. (* The sections add extra BI assumptions, which is only picked up with [Type*]. *) Set Default Proof Using "Type*". Section fupd. 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") : bi_scope. Context (vs_ne : ∀ E1 E2, NonExpansive2 (vs E1 E2)). Context (vs_persistent : ∀ E1 E2 P Q, Persistent (P ={E1,E2}=> Q)). Context (vs_impl : ∀ E P Q, □ (P → Q) ⊢ P ={E,E}=> Q). Context (vs_transitive : ∀ E1 E2 E3 P Q R, (P ={E1,E2}=> Q) ∧ (Q ={E2,E3}=> R) ⊢ P ={E1,E3}=> R). Context (vs_mask_frame_r : ∀ E1 E2 Ef P Q, E1 ## Ef → (P ={E1,E2}=> Q) ⊢ P ={E1 ∪ Ef,E2 ∪ Ef}=> Q). Context (vs_frame_r : ∀ E1 E2 P Q R, (P ={E1,E2}=> Q) ⊢ P ∗ R ={E1,E2}=> Q ∗ R). Context (vs_exists : ∀ {A} E1 E2 (Φ : A → uPred M) Q, (∀ x, Φ x ={E1,E2}=> Q) ⊢ (∃ x, Φ x) ={E1,E2}=> Q). Context (vs_persistent_intro_r : ∀ E1 E2 P Q R, Persistent R → (R -∗ (P ={E1,E2}=> Q)) ⊢ P ∗ R ={E1,E2}=> Q). Definition fupd (E1 E2 : coPset) (P : uPred M) : uPred M := ∃ R, R ∗ vs E1 E2 R P. Notation "|={ E1 , E2 }=> Q" := (fupd E1 E2 Q) : bi_scope. Global Instance fupd_ne E1 E2 : NonExpansive (@fupd E1 E2). Proof. solve_proper. Qed. Lemma fupd_intro E P : P ⊢ |={E,E}=> P. Proof. iIntros "HP". iExists P. iFrame "HP". iApply vs_impl; auto. Qed. Lemma fupd_mono E1 E2 P Q : (P ⊢ Q) → (|={E1,E2}=> P) ⊢ |={E1,E2}=> Q. Proof. iIntros (HPQ); iDestruct 1 as (R) "[HR Hvs]". iExists R; iFrame "HR". iApply (vs_transitive with "[$Hvs]"). iApply vs_impl. iIntros "!> HP". by iApply HPQ. Qed. Lemma fupd_trans E1 E2 E3 P : (|={E1,E2}=> |={E2,E3}=> P) ⊢ |={E1,E3}=> P. Proof. iDestruct 1 as (R) "[HR Hvs]". iExists R. iFrame "HR". iApply (vs_transitive with "[$Hvs]"). clear R. iApply vs_exists; iIntros (R). iApply vs_persistent_intro_r; iIntros "Hvs". iApply (vs_transitive with "[$Hvs]"). iApply vs_impl; auto. Qed. Lemma fupd_mask_frame_r E1 E2 Ef P : E1 ## Ef → (|={E1,E2}=> P) ⊢ |={E1 ∪ Ef,E2 ∪ Ef}=> P. Proof. iIntros (HE); iDestruct 1 as (R) "[HR Hvs]". iExists R; iFrame "HR". by iApply vs_mask_frame_r. Qed. Lemma fupd_frame_r E1 E2 P Q : (|={E1,E2}=> P) ∗ Q ⊢ |={E1,E2}=> P ∗ Q. 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. iris-iris-4.2.0/iris/base_logic/lib/gen_heap.v000066400000000000000000000371151460620107300211750ustar00rootroot00000000000000From stdpp Require Export namespaces. From iris.algebra Require Import reservation_map agree frac. From iris.algebra Require Export dfrac. From iris.bi.lib Require Import fractional. From iris.proofmode Require Import proofmode. From iris.base_logic.lib Require Export own. From iris.base_logic.lib Require Import ghost_map. From iris.prelude Require Import options. Import uPred. (** This file provides a generic mechanism for a language-level point-to connective [l ↦{dq} v] reflecting the physical heap. This library is designed to be used as a singleton (i.e., with only a single instance existing in any proof), with the [gen_heapGS] typeclass providing the ghost names of that unique instance. That way, [pointsto] does not need an explicit [gname] parameter. This mechanism can be plugged into a language and related to the physical heap by using [gen_heap_interp σ] in the state interpretation of the weakest precondition. See heap-lang for an example. If you are looking for a library providing "ghost heaps" independent of the physical state, you will likely want explicit ghost names to disambiguate multiple heaps and are thus better off using [ghost_map], or (if you need more flexibility), directly using the underlying [algebra.lib.gmap_view]. This library is generic in the types [L] for locations and [V] for values and supports fractional permissions. Next to the point-to connective [l ↦{dq} v], which keeps track of the value [v] of a location [l], this library also provides a way to attach "meta" or "ghost" data to locations. This is done as follows: - When one allocates a location, in addition to the point-to connective [l ↦ v], one also obtains the token [meta_token l ⊤]. This token is an exclusive resource that denotes that no meta data has been associated with the namespaces in the mask [⊤] for the location [l]. - Meta data tokens can be split w.r.t. namespace masks, i.e. [meta_token l (E1 ∪ E2) ⊣⊢ meta_token l E1 ∗ meta_token l E2] if [E1 ## E2]. - Meta data can be set using the update [meta_token l E ==∗ meta l N x] provided [↑N ⊆ E], and [x : A] for any countable [A]. The [meta l N x] connective is persistent and denotes the knowledge that the meta data [x] has been associated with namespace [N] to the location [l]. To make the mechanism as flexible as possible, the [x : A] in [meta l N x] can be of any countable type [A]. This means that you can associate e.g. single ghost names, but also tuples of ghost names, etc. To further increase flexibility, the [meta l N x] and [meta_token l E] connectives are annotated with a namespace [N] and mask [E]. That way, one can assign a map of meta information to a location. This is particularly useful when building abstractions, then one can gradually assign more ghost information to a location instead of having to do all of this at once. We use namespaces so that these can be matched up with the invariant namespaces. *) (** To implement this mechanism, we use three pieces of ghost state: - A [ghost_map L V], which keeps track of the values of locations. - A [ghost_map L gname], which keeps track of the meta information of locations. More specifically, this RA introduces an indirection: it keeps track of a ghost name for each location. - The ghost names in the aforementioned authoritative RA refer to namespace maps [reservation_map (agree positive)], which store the actual meta information. This indirection is needed because we cannot perform frame preserving updates in an authoritative fragment without owning the full authoritative element (in other words, without the indirection [meta_set] would need [gen_heap_interp] as a premise). *) (** The CMRAs we need, and the global ghost names we are using. *) Class gen_heapGpreS (L V : Type) (Σ : gFunctors) `{Countable L} := { gen_heapGpreS_heap : ghost_mapG Σ L V; gen_heapGpreS_meta : ghost_mapG Σ L gname; gen_heapGpreS_meta_data : inG Σ (reservation_mapR (agreeR positiveO)); }. Local Existing Instances gen_heapGpreS_meta_data gen_heapGpreS_heap gen_heapGpreS_meta. Class gen_heapGS (L V : Type) (Σ : gFunctors) `{Countable L} := GenHeapGS { gen_heap_inG : gen_heapGpreS L V Σ; gen_heap_name : gname; gen_meta_name : gname }. Local Existing Instance gen_heap_inG. Global Arguments GenHeapGS L V Σ {_ _ _} _ _. Global Arguments gen_heap_name {L V Σ _ _} _ : assert. Global Arguments gen_meta_name {L V Σ _ _} _ : assert. Definition gen_heapΣ (L V : Type) `{Countable L} : gFunctors := #[ ghost_mapΣ L V; ghost_mapΣ L gname; GFunctor (reservation_mapR (agreeR positiveO)) ]. Global Instance subG_gen_heapGpreS {Σ L V} `{Countable L} : subG (gen_heapΣ L V) Σ → gen_heapGpreS L V Σ. Proof. solve_inG. Qed. Section definitions. Context `{Countable L, hG : !gen_heapGS L V Σ}. Definition gen_heap_interp (σ : gmap L V) : iProp Σ := ∃ m : gmap L gname, (* The [⊆] is used to avoid assigning ghost information to the locations in the initial heap (see [gen_heap_init]). *) ⌜ dom m ⊆ dom σ ⌝ ∗ ghost_map_auth (gen_heap_name hG) 1 σ ∗ ghost_map_auth (gen_meta_name hG) 1 m. Local Definition pointsto_def (l : L) (dq : dfrac) (v: V) : iProp Σ := l ↪[gen_heap_name hG]{dq} v. Local Definition pointsto_aux : seal (@pointsto_def). Proof. by eexists. Qed. Definition pointsto := pointsto_aux.(unseal). Local Definition pointsto_unseal : @pointsto = @pointsto_def := pointsto_aux.(seal_eq). Local Definition meta_token_def (l : L) (E : coPset) : iProp Σ := ∃ γm, l ↪[gen_meta_name hG]□ γm ∗ own γm (reservation_map_token E). Local Definition meta_token_aux : seal (@meta_token_def). Proof. by eexists. Qed. Definition meta_token := meta_token_aux.(unseal). Local Definition meta_token_unseal : @meta_token = @meta_token_def := meta_token_aux.(seal_eq). (** TODO: The use of [positives_flatten] violates the namespace abstraction (see the proof of [meta_set]. *) Local Definition meta_def `{Countable A} (l : L) (N : namespace) (x : A) : iProp Σ := ∃ γm, l ↪[gen_meta_name hG]□ γm ∗ own γm (reservation_map_data (positives_flatten N) (to_agree (encode x))). Local Definition meta_aux : seal (@meta_def). Proof. by eexists. Qed. Definition meta := meta_aux.(unseal). Local Definition meta_unseal : @meta = @meta_def := meta_aux.(seal_eq). End definitions. Global Arguments meta {L _ _ V Σ _ A _ _} l N x. Local Notation "l ↦ dq v" := (pointsto l dq v) (at level 20, dq custom dfrac at level 1, format "l ↦ dq v") : bi_scope. Section gen_heap. Context {L V} `{Countable L, !gen_heapGS L V Σ}. Implicit Types P Q : iProp Σ. Implicit Types Φ : V → iProp Σ. Implicit Types σ : gmap L V. Implicit Types m : gmap L gname. Implicit Types l : L. Implicit Types v : V. (** General properties of pointsto *) Global Instance pointsto_timeless l dq v : Timeless (l ↦{dq} v). Proof. rewrite pointsto_unseal. apply _. Qed. Global Instance pointsto_fractional l v : Fractional (λ q, l ↦{#q} v)%I. Proof. rewrite pointsto_unseal. apply _. Qed. Global Instance pointsto_as_fractional l q v : AsFractional (l ↦{#q} v) (λ q, l ↦{#q} v)%I q. Proof. rewrite pointsto_unseal. apply _. Qed. Global Instance pointsto_persistent l v : Persistent (l ↦□ v). Proof. rewrite pointsto_unseal. apply _. Qed. Lemma pointsto_valid l dq v : l ↦{dq} v -∗ ⌜✓ dq⌝%Qp. Proof. rewrite pointsto_unseal. apply ghost_map_elem_valid. Qed. Lemma pointsto_valid_2 l dq1 dq2 v1 v2 : l ↦{dq1} v1 -∗ l ↦{dq2} v2 -∗ ⌜✓ (dq1 ⋅ dq2) ∧ v1 = v2⌝. Proof. rewrite pointsto_unseal. apply ghost_map_elem_valid_2. Qed. (** Almost all the time, this is all you really need. *) Lemma pointsto_agree l dq1 dq2 v1 v2 : l ↦{dq1} v1 -∗ l ↦{dq2} v2 -∗ ⌜v1 = v2⌝. Proof. rewrite pointsto_unseal. apply ghost_map_elem_agree. Qed. Global Instance pointsto_combine_sep_gives l dq1 dq2 v1 v2 : CombineSepGives (l ↦{dq1} v1) (l ↦{dq2} v2) ⌜✓ (dq1 ⋅ dq2) ∧ v1 = v2⌝ | 30. Proof. rewrite /CombineSepGives. iIntros "[H1 H2]". iDestruct (pointsto_valid_2 with "H1 H2") as %?. eauto. Qed. Lemma pointsto_combine l dq1 dq2 v1 v2 : l ↦{dq1} v1 -∗ l ↦{dq2} v2 -∗ l ↦{dq1 ⋅ dq2} v1 ∗ ⌜v1 = v2⌝. Proof. rewrite pointsto_unseal. apply ghost_map_elem_combine. Qed. Global Instance pointsto_combine_as l dq1 dq2 v1 v2 : CombineSepAs (l ↦{dq1} v1) (l ↦{dq2} v2) (l ↦{dq1 ⋅ dq2} v1) | 60. (* higher cost than the Fractional instance, which kicks in for #qs *) Proof. rewrite /CombineSepAs. iIntros "[H1 H2]". iDestruct (pointsto_combine with "H1 H2") as "[$ _]". Qed. Lemma pointsto_frac_ne l1 l2 dq1 dq2 v1 v2 : ¬ ✓(dq1 ⋅ dq2) → l1 ↦{dq1} v1 -∗ l2 ↦{dq2} v2 -∗ ⌜l1 ≠ l2⌝. Proof. rewrite pointsto_unseal. apply ghost_map_elem_frac_ne. Qed. Lemma pointsto_ne l1 l2 dq2 v1 v2 : l1 ↦ v1 -∗ l2 ↦{dq2} v2 -∗ ⌜l1 ≠ l2⌝. Proof. rewrite pointsto_unseal. apply ghost_map_elem_ne. Qed. (** Permanently turn any points-to predicate into a persistent points-to predicate. *) Lemma pointsto_persist l dq v : l ↦{dq} v ==∗ l ↦□ v. Proof. rewrite pointsto_unseal. apply ghost_map_elem_persist. Qed. (** Recover fractional ownership for read-only element. *) Lemma pointsto_unpersist l v : l ↦□ v ==∗ ∃ q, l ↦{# q} v. Proof. rewrite pointsto_unseal. apply ghost_map_elem_unpersist. Qed. (** Framing support *) Global Instance frame_pointsto p l v q1 q2 q : FrameFractionalQp q1 q2 q → Frame p (l ↦{#q1} v) (l ↦{#q2} v) (l ↦{#q} v) | 5. Proof. apply: frame_fractional. Qed. (** General properties of [meta] and [meta_token] *) Global Instance meta_token_timeless l N : Timeless (meta_token l N). Proof. rewrite meta_token_unseal. apply _. Qed. Global Instance meta_timeless `{Countable A} l N (x : A) : Timeless (meta l N x). Proof. rewrite meta_unseal. apply _. Qed. Global Instance meta_persistent `{Countable A} l N (x : A) : Persistent (meta l N x). Proof. rewrite meta_unseal. apply _. Qed. Lemma meta_token_union_1 l E1 E2 : E1 ## E2 → meta_token l (E1 ∪ E2) -∗ meta_token l E1 ∗ meta_token l E2. Proof. rewrite meta_token_unseal /meta_token_def. intros ?. iDestruct 1 as (γm1) "[#Hγm Hm]". rewrite reservation_map_token_union //. iDestruct "Hm" as "[Hm1 Hm2]". iSplitL "Hm1"; eauto. Qed. Lemma meta_token_union_2 l E1 E2 : meta_token l E1 -∗ meta_token l E2 -∗ meta_token l (E1 ∪ E2). Proof. rewrite meta_token_unseal /meta_token_def. iIntros "(%γm1 & #Hγm1 & Hm1) (%γm2 & #Hγm2 & Hm2)". iCombine "Hγm1 Hγm2" gives %[_ ->]. iCombine "Hm1 Hm2" gives %?%reservation_map_token_valid_op. iExists γm2. iFrame "Hγm2". rewrite reservation_map_token_union //. by iSplitL "Hm1". Qed. Lemma meta_token_union l E1 E2 : E1 ## E2 → meta_token l (E1 ∪ E2) ⊣⊢ meta_token l E1 ∗ meta_token l E2. Proof. intros; iSplit; first by iApply meta_token_union_1. iIntros "[Hm1 Hm2]". by iApply (meta_token_union_2 with "Hm1 Hm2"). Qed. Lemma meta_token_difference l E1 E2 : E1 ⊆ E2 → meta_token l E2 ⊣⊢ meta_token l E1 ∗ meta_token l (E2 ∖ E1). Proof. intros. rewrite {1}(union_difference_L E1 E2) //. by rewrite meta_token_union; last set_solver. Qed. Lemma meta_agree `{Countable A} l i (x1 x2 : A) : meta l i x1 -∗ meta l i x2 -∗ ⌜x1 = x2⌝. Proof. rewrite meta_unseal /meta_def. iIntros "(%γm1 & Hγm1 & Hm1) (%γm2 & Hγm2 & Hm2)". iCombine "Hγm1 Hγm2" gives %[_ ->]. iCombine "Hm1 Hm2" gives %Hγ; iPureIntro. move: Hγ. rewrite -reservation_map_data_op reservation_map_data_valid. move=> /to_agree_op_inv_L. naive_solver. Qed. Lemma meta_set `{Countable A} E l (x : A) N : ↑ N ⊆ E → meta_token l E ==∗ meta l N x. Proof. rewrite meta_token_unseal meta_unseal /meta_token_def /meta_def. iDestruct 1 as (γm) "[Hγm Hm]". iExists γm. iFrame "Hγm". iApply (own_update with "Hm"). apply reservation_map_alloc; last done. cut (positives_flatten N ∈@{coPset} ↑N); first by set_solver. (* TODO: Avoid unsealing here. *) rewrite namespaces.nclose_unseal. apply elem_coPset_suffixes. exists 1%positive. by rewrite left_id_L. Qed. (** Update lemmas *) Lemma gen_heap_alloc σ l v : σ !! l = None → gen_heap_interp σ ==∗ gen_heap_interp (<[l:=v]>σ) ∗ l ↦ v ∗ meta_token l ⊤. Proof. iIntros (Hσl). rewrite /gen_heap_interp pointsto_unseal /pointsto_def meta_token_unseal /meta_token_def /=. iDestruct 1 as (m Hσm) "[Hσ Hm]". iMod (ghost_map_insert l with "Hσ") as "[Hσ Hl]"; first done. iMod (own_alloc (reservation_map_token ⊤)) as (γm) "Hγm". { apply reservation_map_token_valid. } iMod (ghost_map_insert_persist l with "Hm") as "[Hm Hlm]". { move: Hσl. rewrite -!not_elem_of_dom. set_solver. } iModIntro. iFrame "Hl". iSplitL "Hσ Hm"; last by eauto with iFrame. iExists (<[l:=γm]> m). iFrame. iPureIntro. rewrite !dom_insert_L. set_solver. Qed. Lemma gen_heap_alloc_big σ σ' : σ' ##ₘ σ → gen_heap_interp σ ==∗ gen_heap_interp (σ' ∪ σ) ∗ ([∗ map] l ↦ v ∈ σ', l ↦ v) ∗ ([∗ map] l ↦ _ ∈ σ', meta_token l ⊤). Proof. revert σ; induction σ' as [| l v σ' Hl IH] using map_ind; iIntros (σ Hdisj) "Hσ". { rewrite left_id_L. auto. } iMod (IH with "Hσ") as "[Hσ'σ Hσ']"; first by eapply map_disjoint_insert_l. decompose_map_disjoint. rewrite !big_opM_insert // -insert_union_l //. by iMod (gen_heap_alloc with "Hσ'σ") as "($ & $ & $)"; first by apply lookup_union_None. Qed. Lemma gen_heap_valid σ l dq v : gen_heap_interp σ -∗ l ↦{dq} v -∗ ⌜σ !! l = Some v⌝. Proof. iDestruct 1 as (m Hσm) "[Hσ _]". iIntros "Hl". rewrite /gen_heap_interp pointsto_unseal. by iCombine "Hσ Hl" gives %?. Qed. Lemma gen_heap_update σ l v1 v2 : gen_heap_interp σ -∗ l ↦ v1 ==∗ gen_heap_interp (<[l:=v2]>σ) ∗ l ↦ v2. Proof. iDestruct 1 as (m Hσm) "[Hσ Hm]". iIntros "Hl". rewrite /gen_heap_interp pointsto_unseal /pointsto_def. iCombine "Hσ Hl" gives %Hl. iMod (ghost_map_update with "Hσ Hl") as "[Hσ Hl]". iModIntro. iFrame "Hl". iExists m. iFrame. iPureIntro. apply elem_of_dom_2 in Hl. rewrite dom_insert_L. set_solver. Qed. End gen_heap. (** This variant of [gen_heap_init] should only be used when absolutely needed. The key difference to [gen_heap_init] is that the [inG] instances in the new [gen_heapGS] instance are related to the original [gen_heapGpreS] instance, whereas [gen_heap_init] forgets about that relation. *) Lemma gen_heap_init_names `{Countable L, !gen_heapGpreS L V Σ} σ : ⊢ |==> ∃ γh γm : gname, let hG := GenHeapGS L V Σ γh γm in gen_heap_interp σ ∗ ([∗ map] l ↦ v ∈ σ, l ↦ v) ∗ ([∗ map] l ↦ _ ∈ σ, meta_token l ⊤). Proof. iMod (ghost_map_alloc_empty (K:=L) (V:=V)) as (γh) "Hh". iMod (ghost_map_alloc_empty (K:=L) (V:=gname)) as (γm) "Hm". iExists γh, γm. iAssert (gen_heap_interp (hG:=GenHeapGS _ _ _ γh γm) ∅) with "[Hh Hm]" as "Hinterp". { iExists ∅; simpl. iFrame "Hh Hm". by rewrite dom_empty_L. } iMod (gen_heap_alloc_big with "Hinterp") as "(Hinterp & $ & $)". { apply map_disjoint_empty_r. } rewrite right_id_L. done. Qed. Lemma gen_heap_init `{Countable L, !gen_heapGpreS L V Σ} σ : ⊢ |==> ∃ _ : gen_heapGS L V Σ, gen_heap_interp σ ∗ ([∗ map] l ↦ v ∈ σ, l ↦ v) ∗ ([∗ map] l ↦ _ ∈ σ, meta_token l ⊤). Proof. iMod (gen_heap_init_names σ) as (γh γm) "Hinit". iExists (GenHeapGS _ _ _ γh γm). done. Qed. iris-iris-4.2.0/iris/base_logic/lib/gen_inv_heap.v000066400000000000000000000274551460620107300220570ustar00rootroot00000000000000From iris.algebra Require Import auth excl gmap. From iris.base_logic.lib Require Import own invariants gen_heap. From iris.proofmode Require Import proofmode. From iris.prelude Require Import options. (** An "invariant" location is a location that has some invariant about its value attached to it, and that can never be deallocated explicitly by the program. It provides a persistent witness that will always allow reading the location, guaranteeing that the value read will satisfy the invariant. This is useful for data structures like RDCSS that need to read locations long after their ownership has been passed back to the client, but do not care *what* it is that they are reading in that case. In that extreme case, the invariant may just be [True]. Since invariant locations cannot be deallocated, they only make sense when modeling languages with garbage collection. HeapLang can be used to model either language by choosing whether or not to use the [Free] operation. By using a separate assertion [inv_pointsto_own] for "invariant" locations, we can keep all the other proofs that do not need it conservative. *) Definition inv_heapN: namespace := nroot .@ "inv_heap". Local Notation "l ↦ v" := (pointsto l (DfracOwn 1) v) (at level 20) : bi_scope. Definition inv_heap_mapUR (L V : Type) `{Countable L} : ucmra := gmapUR L $ prodR (optionR $ exclR $ leibnizO V) (agreeR (V -d> PropO)). Definition to_inv_heap {L V : Type} `{Countable L} (h: gmap L (V * (V -d> PropO))) : inv_heap_mapUR L V := prod_map (λ x, Excl' x) to_agree <$> h. Class inv_heapGpreS (L V : Type) (Σ : gFunctors) `{Countable L} := { inv_heapGpreS_inG : inG Σ (authR (inv_heap_mapUR L V)) }. Local Existing Instance inv_heapGpreS_inG. Class inv_heapGS (L V : Type) (Σ : gFunctors) `{Countable L} := Inv_HeapG { inv_heap_inG : inv_heapGpreS L V Σ; inv_heap_name : gname }. Local Existing Instance inv_heap_inG. Global Arguments Inv_HeapG _ _ {_ _ _ _}. Global Arguments inv_heap_name {_ _ _ _ _} _ : assert. Definition inv_heapΣ (L V : Type) `{Countable L} : gFunctors := #[ GFunctor (authR (inv_heap_mapUR L V)) ]. Global Instance subG_inv_heapGpreS (L V : Type) `{Countable L} {Σ} : subG (inv_heapΣ L V) Σ → inv_heapGpreS L V Σ. Proof. solve_inG. Qed. Section definitions. Context {L V : Type} `{Countable L}. Context `{!invGS_gen hlc Σ, !gen_heapGS L V Σ, gG: !inv_heapGS L V Σ}. Definition inv_heap_inv_P : iProp Σ := ∃ h : gmap L (V * (V -d> PropO)), own (inv_heap_name gG) (● to_inv_heap h) ∗ [∗ map] l ↦ p ∈ h, ⌜p.2 p.1⌝ ∗ l ↦ p.1. Definition inv_heap_inv : iProp Σ := inv inv_heapN inv_heap_inv_P. Definition inv_pointsto_own (l : L) (v : V) (I : V → Prop) : iProp Σ := own (inv_heap_name gG) (◯ {[l := (Excl' v, to_agree I) ]}). Definition inv_pointsto (l : L) (I : V → Prop) : iProp Σ := own (inv_heap_name gG) (◯ {[l := (None, to_agree I)]}). End definitions. Local Notation "l '↦_' I v" := (inv_pointsto_own l v I%stdpp%type) (at level 20, I at level 9, format "l '↦_' I v") : bi_scope. Local Notation "l '↦_' I □" := (inv_pointsto l I%stdpp%type) (at level 20, I at level 9, format "l '↦_' I '□'") : bi_scope. (* [inv_heap_inv] has no parameters to infer the types from, so we need to make them explicit. *) Global Arguments inv_heap_inv _ _ {_ _ _ _ _ _ _}. Global Instance: Params (@inv_pointsto_own) 8 := {}. Global Instance: Params (@inv_pointsto) 7 := {}. Section to_inv_heap. Context {L V : Type} `{Countable L}. Implicit Types (h : gmap L (V * (V -d> PropO))). Lemma to_inv_heap_valid h : ✓ to_inv_heap h. Proof. intros l. rewrite lookup_fmap. by case (h !! l). Qed. Lemma to_inv_heap_singleton l v I : to_inv_heap {[l := (v, I)]} =@{inv_heap_mapUR L V} {[l := (Excl' v, to_agree I)]}. Proof. by rewrite /to_inv_heap fmap_insert fmap_empty. Qed. Lemma to_inv_heap_insert l v I h : to_inv_heap (<[l := (v, I)]> h) = <[l := (Excl' v, to_agree I)]> (to_inv_heap h). Proof. by rewrite /to_inv_heap fmap_insert. Qed. Lemma lookup_to_inv_heap_None h l : h !! l = None → to_inv_heap h !! l = None. Proof. by rewrite /to_inv_heap lookup_fmap=> ->. Qed. Lemma lookup_to_inv_heap_Some h l v I : h !! l = Some (v, I) → to_inv_heap h !! l = Some (Excl' v, to_agree I). Proof. by rewrite /to_inv_heap lookup_fmap=> ->. Qed. Lemma lookup_to_inv_heap_Some_2 h l v' I' : to_inv_heap h !! l ≡ Some (v', I') → ∃ v I, v' = Excl' v ∧ I' ≡ to_agree I ∧ h !! l = Some (v, I). Proof. rewrite /to_inv_heap /prod_map lookup_fmap. rewrite fmap_Some_equiv. intros ([] & Hsome & [Heqv HeqI]); simplify_eq/=; eauto. Qed. End to_inv_heap. Lemma inv_heap_init (L V : Type) `{Countable L, !invGS_gen hlc Σ, !gen_heapGS L V Σ, !inv_heapGpreS L V Σ} E : ⊢ |==> ∃ _ : inv_heapGS L V Σ, |={E}=> inv_heap_inv L V. Proof. iMod (own_alloc (● (to_inv_heap ∅))) as (γ) "H●". { rewrite auth_auth_valid. exact: to_inv_heap_valid. } iModIntro. iExists (Inv_HeapG L V γ). iAssert (inv_heap_inv_P (gG := Inv_HeapG L V γ)) with "[H●]" as "P". { iExists _. iFrame. done. } iApply (inv_alloc inv_heapN E inv_heap_inv_P with "P"). Qed. Section inv_heap. Context {L V : Type} `{Countable L}. Context `{!invGS_gen hlc Σ, !gen_heapGS L V Σ, gG: !inv_heapGS L V Σ}. Implicit Types (l : L) (v : V) (I : V → Prop). Implicit Types (h : gmap L (V * (V -d> PropO))). (** * Helpers *) Lemma inv_pointsto_lookup_Some l h I : l ↦_I □ -∗ own (inv_heap_name gG) (● to_inv_heap h) -∗ ⌜∃ v I', h !! l = Some (v, I') ∧ ∀ w, I w ↔ I' w ⌝. Proof. iIntros "Hl_inv H◯". iCombine "H◯ Hl_inv" gives %[Hincl Hvalid]%auth_both_valid_discrete. iPureIntro. move: Hincl; rewrite singleton_included_l; intros ([v' I'] & Hsome & Hincl). apply lookup_to_inv_heap_Some_2 in Hsome as (v'' & I'' & _ & HI & Hh). move: Hincl; rewrite HI Some_included_total pair_included to_agree_included; intros [??]; eauto. Qed. Lemma inv_pointsto_own_lookup_Some l v h I : l ↦_I v -∗ own (inv_heap_name gG) (● to_inv_heap h) -∗ ⌜ ∃ I', h !! l = Some (v, I') ∧ ∀ w, I w ↔ I' w ⌝. Proof. iIntros "Hl_inv H●". iCombine "H● Hl_inv" gives %[Hincl Hvalid]%auth_both_valid_discrete. iPureIntro. move: Hincl; rewrite singleton_included_l; intros ([v' I'] & Hsome & Hincl). apply lookup_to_inv_heap_Some_2 in Hsome as (v'' & I'' & -> & HI & Hh). move: Hincl; rewrite HI Some_included_total pair_included Excl_included to_agree_included; intros [-> ?]; eauto. Qed. (** * Typeclass instances *) (* FIXME(Coq #6294): needs new unification The uses of [apply:] and [move: ..; rewrite ..] (by lack of [apply: .. in ..]) in this file are needed because Coq's default unification algorithm fails. *) Global Instance inv_pointsto_own_proper l v : Proper (pointwise_relation _ iff ==> (≡)) (inv_pointsto_own l v). Proof. intros I1 I2 ?. rewrite /inv_pointsto_own. do 2 f_equiv. apply: singletonM_proper. f_equiv. by apply: to_agree_proper. Qed. Global Instance inv_pointsto_proper l : Proper (pointwise_relation _ iff ==> (≡)) (inv_pointsto l). Proof. intros I1 I2 ?. rewrite /inv_pointsto. do 2 f_equiv. apply: singletonM_proper. f_equiv. by apply: to_agree_proper. Qed. Global Instance inv_heap_inv_persistent : Persistent (inv_heap_inv L V). Proof. apply _. Qed. Global Instance inv_pointsto_persistent l I : Persistent (l ↦_I □). Proof. apply _. Qed. Global Instance inv_pointsto_timeless l I : Timeless (l ↦_I □). Proof. apply _. Qed. Global Instance inv_pointsto_own_timeless l v I : Timeless (l ↦_I v). Proof. apply _. Qed. (** * Public lemmas *) Lemma make_inv_pointsto l v I E : ↑inv_heapN ⊆ E → I v → inv_heap_inv L V -∗ l ↦ v ={E}=∗ l ↦_I v. Proof. iIntros (HN HI) "#Hinv Hl". iMod (inv_acc_timeless _ inv_heapN with "Hinv") as "[HP Hclose]"; first done. iDestruct "HP" as (h) "[H● HsepM]". destruct (h !! l) as [v'| ] eqn: Hlookup. - (* auth map contains l --> contradiction *) iDestruct (big_sepM_lookup with "HsepM") as "[_ Hl']"; first done. by iCombine "Hl Hl'" gives %[??]. - iMod (own_update with "H●") as "[H● H◯]". { apply lookup_to_inv_heap_None in Hlookup. apply (auth_update_alloc _ (to_inv_heap (<[l:=(v,I)]> h)) (to_inv_heap ({[l:=(v,I)]}))). rewrite to_inv_heap_insert to_inv_heap_singleton. by apply: alloc_singleton_local_update. } iMod ("Hclose" with "[H● HsepM Hl]"). + iExists _. iDestruct (big_sepM_insert _ _ _ (_,_) with "[$HsepM $Hl]") as "HsepM"; auto with iFrame. + iModIntro. by rewrite /inv_pointsto_own to_inv_heap_singleton. Qed. Lemma inv_pointsto_own_inv l v I : l ↦_I v -∗ l ↦_I □. Proof. iApply own_mono. apply auth_frag_mono. rewrite singleton_included_total pair_included. split; [apply: ucmra_unit_least|done]. Qed. (** An accessor to make use of [inv_pointsto_own]. This opens the invariant *before* consuming [inv_pointsto_own] so that you can use this before opening an atomic update that provides [inv_pointsto_own]!. *) Lemma inv_pointsto_own_acc_strong E : ↑inv_heapN ⊆ E → inv_heap_inv L V ={E, E ∖ ↑inv_heapN}=∗ ∀ l v I, l ↦_I v -∗ (⌜I v⌝ ∗ l ↦ v ∗ (∀ w, ⌜I w ⌝ -∗ l ↦ w ==∗ inv_pointsto_own l w I ∗ |={E ∖ ↑inv_heapN, E}=> True)). Proof. iIntros (HN) "#Hinv". iMod (inv_acc_timeless _ inv_heapN _ with "Hinv") as "[HP Hclose]"; first done. iIntros "!>" (l v I) "Hl_inv". iDestruct "HP" as (h) "[H● HsepM]". iDestruct (inv_pointsto_own_lookup_Some with "Hl_inv H●") as %(I'&?&HI'). setoid_rewrite HI'. iDestruct (big_sepM_delete with "HsepM") as "[[HI Hl] HsepM]"; first done. iIntros "{$HI $Hl}" (w ?) "Hl". iMod (own_update_2 with "H● Hl_inv") as "[H● H◯]". { apply (auth_update _ _ (<[l := (Excl' w, to_agree I')]> (to_inv_heap h)) {[l := (Excl' w, to_agree I)]}). apply: singleton_local_update. { by apply lookup_to_inv_heap_Some. } apply: prod_local_update_1. apply: option_local_update. apply: exclusive_local_update. done. } iDestruct (big_sepM_insert _ _ _ (w, I') with "[$HsepM $Hl //]") as "HsepM". { apply lookup_delete. } rewrite insert_delete_insert -to_inv_heap_insert. iIntros "!> {$H◯}". iApply ("Hclose" with "[H● HsepM]"). iExists _; by iFrame. Qed. (** Derive a more standard accessor. *) Lemma inv_pointsto_own_acc E l v I: ↑inv_heapN ⊆ E → inv_heap_inv L V -∗ l ↦_I v ={E, E ∖ ↑inv_heapN}=∗ (⌜I v⌝ ∗ l ↦ v ∗ (∀ w, ⌜I w ⌝ -∗ l ↦ w ={E ∖ ↑inv_heapN, E}=∗ l ↦_I w)). Proof. iIntros (?) "#Hinv Hl". iMod (inv_pointsto_own_acc_strong with "Hinv") as "Hacc"; first done. iDestruct ("Hacc" with "Hl") as "(HI & Hl & Hclose)". iIntros "!> {$HI $Hl}" (w) "HI Hl". iMod ("Hclose" with "HI Hl") as "[$ $]". Qed. Lemma inv_pointsto_acc l I E : ↑inv_heapN ⊆ E → inv_heap_inv L V -∗ l ↦_I □ ={E, E ∖ ↑inv_heapN}=∗ ∃ v, ⌜I v⌝ ∗ l ↦ v ∗ (l ↦ v ={E ∖ ↑inv_heapN, E}=∗ ⌜True⌝). Proof. iIntros (HN) "#Hinv Hl_inv". iMod (inv_acc_timeless _ inv_heapN _ with "Hinv") as "[HP Hclose]"; first done. iModIntro. iDestruct "HP" as (h) "[H● HsepM]". iDestruct (inv_pointsto_lookup_Some with "Hl_inv H●") as %(v&I'&?&HI'). iDestruct (big_sepM_lookup_acc with "HsepM") as "[[#HI Hl] HsepM]"; first done. setoid_rewrite HI'. iExists _. iIntros "{$HI $Hl} Hl". iMod ("Hclose" with "[H● HsepM Hl]"); last done. iExists _. iFrame "H●". iApply ("HsepM" with "[$Hl //]"). Qed. End inv_heap. Global Typeclasses Opaque inv_heap_inv inv_pointsto inv_pointsto_own. iris-iris-4.2.0/iris/base_logic/lib/ghost_map.v000066400000000000000000000317131460620107300214060ustar00rootroot00000000000000(** A "ghost map" (or "ghost heap") with a proposition controlling authoritative ownership of the entire heap, and a "points-to-like" proposition for (mutable, fractional, or persistent read-only) ownership of individual elements. *) From iris.bi.lib Require Import fractional. From iris.proofmode Require Import proofmode. From iris.algebra Require Import gmap_view. From iris.algebra Require Export dfrac. From iris.base_logic.lib Require Export own. From iris.prelude Require Import options. (** The CMRA we need. FIXME: This is intentionally discrete-only, but should we support setoids via [Equiv]? *) Class ghost_mapG Σ (K V : Type) `{Countable K} := GhostMapG { ghost_map_inG : inG Σ (gmap_viewR K (agreeR (leibnizO V))); }. Local Existing Instance ghost_map_inG. Definition ghost_mapΣ (K V : Type) `{Countable K} : gFunctors := #[ GFunctor (gmap_viewR K (agreeR (leibnizO V))) ]. Global Instance subG_ghost_mapΣ Σ (K V : Type) `{Countable K} : subG (ghost_mapΣ K V) Σ → ghost_mapG Σ K V. Proof. solve_inG. Qed. Section definitions. Context `{ghost_mapG Σ K V}. Local Definition ghost_map_auth_def (γ : gname) (q : Qp) (m : gmap K V) : iProp Σ := own γ (gmap_view_auth (V:=agreeR $ leibnizO V) (DfracOwn q) (to_agree <$> m)). Local Definition ghost_map_auth_aux : seal (@ghost_map_auth_def). Proof. by eexists. Qed. Definition ghost_map_auth := ghost_map_auth_aux.(unseal). Local Definition ghost_map_auth_unseal : @ghost_map_auth = @ghost_map_auth_def := ghost_map_auth_aux.(seal_eq). Local Definition ghost_map_elem_def (γ : gname) (k : K) (dq : dfrac) (v : V) : iProp Σ := own γ (gmap_view_frag (V:=agreeR $ leibnizO V) k dq (to_agree v)). Local Definition ghost_map_elem_aux : seal (@ghost_map_elem_def). Proof. by eexists. Qed. Definition ghost_map_elem := ghost_map_elem_aux.(unseal). Local Definition ghost_map_elem_unseal : @ghost_map_elem = @ghost_map_elem_def := ghost_map_elem_aux.(seal_eq). End definitions. Notation "k ↪[ γ ] dq v" := (ghost_map_elem γ k dq v) (at level 20, γ at level 50, dq custom dfrac at level 1, format "k ↪[ γ ] dq v") : bi_scope. Local Ltac unseal := rewrite ?ghost_map_auth_unseal /ghost_map_auth_def ?ghost_map_elem_unseal /ghost_map_elem_def. Section lemmas. Context `{ghost_mapG Σ K V}. Implicit Types (k : K) (v : V) (dq : dfrac) (q : Qp) (m : gmap K V). (** * Lemmas about the map elements *) Global Instance ghost_map_elem_timeless k γ dq v : Timeless (k ↪[γ]{dq} v). Proof. unseal. apply _. Qed. Global Instance ghost_map_elem_persistent k γ v : Persistent (k ↪[γ]□ v). Proof. unseal. apply _. Qed. Global Instance ghost_map_elem_fractional k γ v : Fractional (λ q, k ↪[γ]{#q} v)%I. Proof. unseal=> p q. rewrite -own_op -gmap_view_frag_add agree_idemp //. Qed. Global Instance ghost_map_elem_as_fractional k γ q v : AsFractional (k ↪[γ]{#q} v) (λ q, k ↪[γ]{#q} v)%I q. Proof. split; first done. apply _. Qed. Local Lemma ghost_map_elems_unseal γ m dq : ([∗ map] k ↦ v ∈ m, k ↪[γ]{dq} v) ==∗ own γ ([^op map] k↦v ∈ m, gmap_view_frag (V:=agreeR (leibnizO V)) k dq (to_agree v)). Proof. unseal. destruct (decide (m = ∅)) as [->|Hne]. - rewrite !big_opM_empty. iIntros "_". iApply own_unit. - rewrite big_opM_own //. iIntros "?". done. Qed. Lemma ghost_map_elem_valid k γ dq v : k ↪[γ]{dq} v -∗ ⌜✓ dq⌝. Proof. unseal. iIntros "Helem". iDestruct (own_valid with "Helem") as %?%gmap_view_frag_valid. naive_solver. Qed. Lemma ghost_map_elem_valid_2 k γ dq1 dq2 v1 v2 : k ↪[γ]{dq1} v1 -∗ k ↪[γ]{dq2} v2 -∗ ⌜✓ (dq1 ⋅ dq2) ∧ v1 = v2⌝. Proof. unseal. iIntros "H1 H2". iCombine "H1 H2" gives %[? Hag]%gmap_view_frag_op_valid. rewrite to_agree_op_valid_L in Hag. done. Qed. Lemma ghost_map_elem_agree k γ dq1 dq2 v1 v2 : k ↪[γ]{dq1} v1 -∗ k ↪[γ]{dq2} v2 -∗ ⌜v1 = v2⌝. Proof. iIntros "Helem1 Helem2". iDestruct (ghost_map_elem_valid_2 with "Helem1 Helem2") as %[_ ?]. done. Qed. Global Instance ghost_map_elem_combine_gives γ k v1 dq1 v2 dq2 : CombineSepGives (k ↪[γ]{dq1} v1) (k ↪[γ]{dq2} v2) ⌜✓ (dq1 ⋅ dq2) ∧ v1 = v2⌝. Proof. rewrite /CombineSepGives. iIntros "[H1 H2]". iDestruct (ghost_map_elem_valid_2 with "H1 H2") as %[H1 H2]. eauto. Qed. Lemma ghost_map_elem_combine k γ dq1 dq2 v1 v2 : k ↪[γ]{dq1} v1 -∗ k ↪[γ]{dq2} v2 -∗ k ↪[γ]{dq1 ⋅ dq2} v1 ∗ ⌜v1 = v2⌝. Proof. iIntros "Hl1 Hl2". iDestruct (ghost_map_elem_agree with "Hl1 Hl2") as %->. unseal. iCombine "Hl1 Hl2" as "Hl". rewrite agree_idemp. eauto with iFrame. Qed. Global Instance ghost_map_elem_combine_as k γ dq1 dq2 v1 v2 : CombineSepAs (k ↪[γ]{dq1} v1) (k ↪[γ]{dq2} v2) (k ↪[γ]{dq1 ⋅ dq2} v1) | 60. (* higher cost than the Fractional instance [combine_sep_fractional_bwd], which kicks in for #qs *) Proof. rewrite /CombineSepAs. iIntros "[H1 H2]". iDestruct (ghost_map_elem_combine with "H1 H2") as "[$ _]". Qed. Lemma ghost_map_elem_frac_ne γ k1 k2 dq1 dq2 v1 v2 : ¬ ✓ (dq1 ⋅ dq2) → k1 ↪[γ]{dq1} v1 -∗ k2 ↪[γ]{dq2} v2 -∗ ⌜k1 ≠ k2⌝. Proof. iIntros (?) "H1 H2"; iIntros (->). by iCombine "H1 H2" gives %[??]. Qed. Lemma ghost_map_elem_ne γ k1 k2 dq2 v1 v2 : k1 ↪[γ] v1 -∗ k2 ↪[γ]{dq2} v2 -∗ ⌜k1 ≠ k2⌝. Proof. apply ghost_map_elem_frac_ne. apply: exclusive_l. Qed. (** Make an element read-only. *) Lemma ghost_map_elem_persist k γ dq v : k ↪[γ]{dq} v ==∗ k ↪[γ]□ v. Proof. unseal. iApply own_update. apply gmap_view_frag_persist. Qed. (** Recover fractional ownership for read-only element. *) Lemma ghost_map_elem_unpersist k γ v : k ↪[γ]□ v ==∗ ∃ q, k ↪[γ]{# q} v. Proof. unseal. iIntros "H". iMod (own_updateP with "H") as "H"; first by apply gmap_view_frag_unpersist. iDestruct "H" as (? (q&->)) "H". iIntros "!>". iExists q. done. Qed. (** * Lemmas about [ghost_map_auth] *) Lemma ghost_map_alloc_strong P m : pred_infinite P → ⊢ |==> ∃ γ, ⌜P γ⌝ ∗ ghost_map_auth γ 1 m ∗ [∗ map] k ↦ v ∈ m, k ↪[γ] v. Proof. unseal. intros. iMod (own_alloc_strong (gmap_view_auth (V:=agreeR (leibnizO V)) (DfracOwn 1) ∅) P) as (γ) "[% Hauth]"; first done. { apply gmap_view_auth_valid. } iExists γ. iSplitR; first done. rewrite -big_opM_own_1 -own_op. iApply (own_update with "Hauth"). etrans; first apply (gmap_view_alloc_big _ (to_agree <$> m) (DfracOwn 1)). - apply map_disjoint_empty_r. - done. - by apply map_Forall_fmap. - rewrite right_id big_opM_fmap. done. Qed. Lemma ghost_map_alloc_strong_empty P : pred_infinite P → ⊢ |==> ∃ γ, ⌜P γ⌝ ∗ ghost_map_auth γ 1 (∅ : gmap K V). Proof. intros. iMod (ghost_map_alloc_strong P ∅) as (γ) "(% & Hauth & _)"; eauto. Qed. Lemma ghost_map_alloc m : ⊢ |==> ∃ γ, ghost_map_auth γ 1 m ∗ [∗ map] k ↦ v ∈ m, k ↪[γ] v. Proof. iMod (ghost_map_alloc_strong (λ _, True) m) as (γ) "[_ Hmap]". - by apply pred_infinite_True. - eauto. Qed. Lemma ghost_map_alloc_empty : ⊢ |==> ∃ γ, ghost_map_auth γ 1 (∅ : gmap K V). Proof. intros. iMod (ghost_map_alloc ∅) as (γ) "(Hauth & _)"; eauto. Qed. Global Instance ghost_map_auth_timeless γ q m : Timeless (ghost_map_auth γ q m). Proof. unseal. apply _. Qed. Global Instance ghost_map_auth_fractional γ m : Fractional (λ q, ghost_map_auth γ q m)%I. Proof. intros p q. unseal. rewrite -own_op -gmap_view_auth_dfrac_op //. Qed. Global Instance ghost_map_auth_as_fractional γ q m : AsFractional (ghost_map_auth γ q m) (λ q, ghost_map_auth γ q m)%I q. Proof. split; first done. apply _. Qed. Lemma ghost_map_auth_valid γ q m : ghost_map_auth γ q m -∗ ⌜q ≤ 1⌝%Qp. Proof. unseal. iIntros "Hauth". iDestruct (own_valid with "Hauth") as %?%gmap_view_auth_dfrac_valid. done. Qed. Lemma ghost_map_auth_valid_2 γ q1 q2 m1 m2 : ghost_map_auth γ q1 m1 -∗ ghost_map_auth γ q2 m2 -∗ ⌜(q1 + q2 ≤ 1)%Qp ∧ m1 = m2⌝. Proof. unseal. iIntros "H1 H2". iCombine "H1 H2" gives %[? ?%(inj _)]%gmap_view_auth_dfrac_op_valid. iPureIntro. split; first done. by fold_leibniz. Qed. Lemma ghost_map_auth_agree γ q1 q2 m1 m2 : ghost_map_auth γ q1 m1 -∗ ghost_map_auth γ q2 m2 -∗ ⌜m1 = m2⌝. Proof. iIntros "H1 H2". iDestruct (ghost_map_auth_valid_2 with "H1 H2") as %[_ ?]. done. Qed. (** * Lemmas about the interaction of [ghost_map_auth] with the elements *) Lemma ghost_map_lookup {γ q m k dq v} : ghost_map_auth γ q m -∗ k ↪[γ]{dq} v -∗ ⌜m !! k = Some v⌝. Proof. unseal. iIntros "Hauth Hel". iCombine "Hauth Hel" gives %(av' & _ & _ & Hav' & _ & Hincl)%gmap_view_both_dfrac_valid_discrete_total. iPureIntro. apply lookup_fmap_Some in Hav' as [v' [<- Hv']]. apply to_agree_included_L in Hincl. by rewrite Hincl. Qed. Global Instance ghost_map_lookup_combine_gives_1 {γ q m k dq v} : CombineSepGives (ghost_map_auth γ q m) (k ↪[γ]{dq} v) ⌜m !! k = Some v⌝. Proof. rewrite /CombineSepGives. iIntros "[H1 H2]". iDestruct (ghost_map_lookup with "H1 H2") as %->. eauto. Qed. Global Instance ghost_map_lookup_combine_gives_2 {γ q m k dq v} : CombineSepGives (k ↪[γ]{dq} v) (ghost_map_auth γ q m) ⌜m !! k = Some v⌝. Proof. rewrite /CombineSepGives comm. apply ghost_map_lookup_combine_gives_1. Qed. Lemma ghost_map_insert {γ m} k v : m !! k = None → ghost_map_auth γ 1 m ==∗ ghost_map_auth γ 1 (<[k := v]> m) ∗ k ↪[γ] v. Proof. unseal. intros Hm. rewrite -own_op. iApply own_update. rewrite fmap_insert. apply: gmap_view_alloc; [|done..]. rewrite lookup_fmap Hm //. Qed. Lemma ghost_map_insert_persist {γ m} k v : m !! k = None → ghost_map_auth γ 1 m ==∗ ghost_map_auth γ 1 (<[k := v]> m) ∗ k ↪[γ]□ v. Proof. iIntros (?) "Hauth". iMod (ghost_map_insert k with "Hauth") as "[$ Helem]"; first done. iApply ghost_map_elem_persist. done. Qed. Lemma ghost_map_delete {γ m k v} : ghost_map_auth γ 1 m -∗ k ↪[γ] v ==∗ ghost_map_auth γ 1 (delete k m). Proof. unseal. iApply bi.wand_intro_r. rewrite -own_op. iApply own_update. rewrite fmap_delete. apply: gmap_view_delete. Qed. Lemma ghost_map_update {γ m k v} w : ghost_map_auth γ 1 m -∗ k ↪[γ] v ==∗ ghost_map_auth γ 1 (<[k := w]> m) ∗ k ↪[γ] w. Proof. unseal. iApply bi.wand_intro_r. rewrite -!own_op. iApply own_update. rewrite fmap_insert. apply: gmap_view_replace; done. Qed. (** Big-op versions of above lemmas *) Lemma ghost_map_lookup_big {γ q m} m0 : ghost_map_auth γ q m -∗ ([∗ map] k↦v ∈ m0, k ↪[γ] v) -∗ ⌜m0 ⊆ m⌝. Proof. iIntros "Hauth Hfrag". rewrite map_subseteq_spec. iIntros (k v Hm0). iDestruct (ghost_map_lookup with "Hauth [Hfrag]") as %->. { rewrite big_sepM_lookup; done. } done. Qed. Lemma ghost_map_insert_big {γ m} m' : m' ##ₘ m → ghost_map_auth γ 1 m ==∗ ghost_map_auth γ 1 (m' ∪ m) ∗ ([∗ map] k ↦ v ∈ m', k ↪[γ] v). Proof. unseal. intros ?. rewrite -big_opM_own_1 -own_op. iApply own_update. etrans; first apply: (gmap_view_alloc_big _ (to_agree <$> m') (DfracOwn 1)). - apply map_disjoint_fmap. done. - done. - by apply map_Forall_fmap. - rewrite map_fmap_union big_opM_fmap. done. Qed. Lemma ghost_map_insert_persist_big {γ m} m' : m' ##ₘ m → ghost_map_auth γ 1 m ==∗ ghost_map_auth γ 1 (m' ∪ m) ∗ ([∗ map] k ↦ v ∈ m', k ↪[γ]□ v). Proof. iIntros (Hdisj) "Hauth". iMod (ghost_map_insert_big m' with "Hauth") as "[$ Helem]"; first done. iApply big_sepM_bupd. iApply (big_sepM_impl with "Helem"). iIntros "!#" (k v) "_". iApply ghost_map_elem_persist. Qed. Lemma ghost_map_delete_big {γ m} m0 : ghost_map_auth γ 1 m -∗ ([∗ map] k↦v ∈ m0, k ↪[γ] v) ==∗ ghost_map_auth γ 1 (m ∖ m0). Proof. iIntros "Hauth Hfrag". iMod (ghost_map_elems_unseal with "Hfrag") as "Hfrag". unseal. iApply (own_update_2 with "Hauth Hfrag"). rewrite map_fmap_difference. etrans; last apply: gmap_view_delete_big. rewrite big_opM_fmap. done. Qed. Theorem ghost_map_update_big {γ m} m0 m1 : dom m0 = dom m1 → ghost_map_auth γ 1 m -∗ ([∗ map] k↦v ∈ m0, k ↪[γ] v) ==∗ ghost_map_auth γ 1 (m1 ∪ m) ∗ [∗ map] k↦v ∈ m1, k ↪[γ] v. Proof. iIntros (?) "Hauth Hfrag". iMod (ghost_map_elems_unseal with "Hfrag") as "Hfrag". unseal. rewrite -big_opM_own_1 -own_op. iApply (own_update_2 with "Hauth Hfrag"). rewrite map_fmap_union. rewrite -!(big_opM_fmap to_agree (λ k, gmap_view_frag k (DfracOwn 1))). apply gmap_view_replace_big. - rewrite !dom_fmap_L. done. - by apply map_Forall_fmap. Qed. End lemmas. iris-iris-4.2.0/iris/base_logic/lib/ghost_var.v000066400000000000000000000107721460620107300214230ustar00rootroot00000000000000(** A simple "ghost variable" of arbitrary type with fractional ownership. Can be mutated when fully owned. *) From iris.algebra Require Import dfrac_agree proofmode_classes frac. From iris.bi.lib Require Import fractional. From iris.proofmode Require Import proofmode. From iris.base_logic.lib Require Export own. From iris.prelude Require Import options. (** The CMRA we need. *) Class ghost_varG Σ (A : Type) := GhostVarG { ghost_var_inG : inG Σ (dfrac_agreeR $ leibnizO A); }. Local Existing Instance ghost_var_inG. Global Hint Mode ghost_varG - ! : typeclass_instances. Definition ghost_varΣ (A : Type) : gFunctors := #[ GFunctor (dfrac_agreeR $ leibnizO A) ]. Global Instance subG_ghost_varΣ Σ A : subG (ghost_varΣ A) Σ → ghost_varG Σ A. Proof. solve_inG. Qed. Local Definition ghost_var_def `{!ghost_varG Σ A} (γ : gname) (q : Qp) (a : A) : iProp Σ := own γ (to_frac_agree (A:=leibnizO A) q a). Local Definition ghost_var_aux : seal (@ghost_var_def). Proof. by eexists. Qed. Definition ghost_var := ghost_var_aux.(unseal). Local Definition ghost_var_unseal : @ghost_var = @ghost_var_def := ghost_var_aux.(seal_eq). Global Arguments ghost_var {Σ A _} γ q a. Local Ltac unseal := rewrite ?ghost_var_unseal /ghost_var_def. Section lemmas. Context `{!ghost_varG Σ A}. Implicit Types (a b : A) (q : Qp). Global Instance ghost_var_timeless γ q a : Timeless (ghost_var γ q a). Proof. unseal. apply _. Qed. Global Instance ghost_var_fractional γ a : Fractional (λ q, ghost_var γ q a). Proof. intros q1 q2. unseal. rewrite -own_op -frac_agree_op //. Qed. Global Instance ghost_var_as_fractional γ a q : AsFractional (ghost_var γ q a) (λ q, ghost_var γ q a) q. Proof. split; [done|]. apply _. Qed. Lemma ghost_var_alloc_strong a (P : gname → Prop) : pred_infinite P → ⊢ |==> ∃ γ, ⌜P γ⌝ ∗ ghost_var γ 1 a. Proof. unseal. intros. iApply own_alloc_strong; done. Qed. Lemma ghost_var_alloc a : ⊢ |==> ∃ γ, ghost_var γ 1 a. Proof. unseal. iApply own_alloc. done. Qed. Lemma ghost_var_valid_2 γ a1 q1 a2 q2 : ghost_var γ q1 a1 -∗ ghost_var γ q2 a2 -∗ ⌜(q1 + q2 ≤ 1)%Qp ∧ a1 = a2⌝. Proof. unseal. iIntros "Hvar1 Hvar2". iCombine "Hvar1 Hvar2" gives %[Hq Ha]%frac_agree_op_valid. done. Qed. (** Almost all the time, this is all you really need. *) Lemma ghost_var_agree γ a1 q1 a2 q2 : ghost_var γ q1 a1 -∗ ghost_var γ q2 a2 -∗ ⌜a1 = a2⌝. Proof. iIntros "Hvar1 Hvar2". iDestruct (ghost_var_valid_2 with "Hvar1 Hvar2") as %[_ ?]. done. Qed. Global Instance ghost_var_combine_gives γ a1 q1 a2 q2 : CombineSepGives (ghost_var γ q1 a1) (ghost_var γ q2 a2) ⌜(q1 + q2 ≤ 1)%Qp ∧ a1 = a2⌝. Proof. rewrite /CombineSepGives. iIntros "[H1 H2]". iDestruct (ghost_var_valid_2 with "H1 H2") as %[H1 H2]. eauto. Qed. Global Instance ghost_var_combine_as γ a1 q1 a2 q2 q : IsOp q q1 q2 → CombineSepAs (ghost_var γ q1 a1) (ghost_var γ q2 a2) (ghost_var γ q a1) | 60. (* higher cost than the Fractional instance, which is used for a1 = a2 *) Proof. rewrite /CombineSepAs /IsOp => ->. iIntros "[H1 H2]". (* This can't be a single [iCombine] since the instance providing that is exactly what we are proving here. *) iCombine "H1 H2" gives %[_ ->]. by iCombine "H1 H2" as "H". Qed. (** This is just an instance of fractionality above, but that can be hard to find. *) Lemma ghost_var_split γ a q1 q2 : ghost_var γ (q1 + q2) a -∗ ghost_var γ q1 a ∗ ghost_var γ q2 a. Proof. iIntros "[$$]". Qed. (** Update the ghost variable to new value [b]. *) Lemma ghost_var_update b γ a : ghost_var γ 1 a ==∗ ghost_var γ 1 b. Proof. unseal. iApply own_update. apply cmra_update_exclusive. done. Qed. Lemma ghost_var_update_2 b γ a1 q1 a2 q2 : (q1 + q2 = 1)%Qp → ghost_var γ q1 a1 -∗ ghost_var γ q2 a2 ==∗ ghost_var γ q1 b ∗ ghost_var γ q2 b. Proof. intros Hq. unseal. rewrite -own_op. iApply own_update_2. apply frac_agree_update_2. done. Qed. Lemma ghost_var_update_halves b γ a1 a2 : ghost_var γ (1/2) a1 -∗ ghost_var γ (1/2) a2 ==∗ ghost_var γ (1/2) b ∗ ghost_var γ (1/2) b. Proof. iApply ghost_var_update_2. apply Qp.half_half. Qed. (** Framing support *) Global Instance frame_ghost_var p γ a q1 q2 q : FrameFractionalQp q1 q2 q → Frame p (ghost_var γ q1 a) (ghost_var γ q2 a) (ghost_var γ q a) | 5. Proof. apply: frame_fractional. Qed. End lemmas. iris-iris-4.2.0/iris/base_logic/lib/gset_bij.v000066400000000000000000000166011460620107300212120ustar00rootroot00000000000000(** Propositions for reasoning about monotone partial bijections. This library provides two propositions [gset_bij_own_auth γ L] and [gset_bij_own_elem γ a b], where [L] is a bijection between types [A] and [B] represented by a set of associations [gset (A * B)]. The idea is that [gset_bij_own_auth γ L] is an authoritative bijection [L], while [gset_bij_own_elem γ a b] is a persistent resource saying [L] associates [a] and [b]. The main use case is in a logical relation-based proof where [L] maintains the association between locations [A] in one execution and [B] in another (perhaps of different types, if the logical relation relates two different semantics). The association [L] is always bijective, so that if [a] is mapped to [b], there should be no other mappings for either [a] or [b]; the [gset_bij_own_extend] update theorem enforces that new mappings respect this property, and [gset_bij_own_elem_agree] allows the user to exploit bijectivity. The bijection grows monotonically, so that the set of associations only grows; this is captured by the persistence of [gset_bij_own_elem]. This library is a logical, ownership-based wrapper around [gset_bij]. *) From iris.algebra.lib Require Import gset_bij. From iris.bi.lib Require Import fractional. From iris.base_logic.lib Require Import own. From iris.proofmode Require Import proofmode. From iris.prelude Require Import options. (* The uCMRA we need. *) Class gset_bijG Σ A B `{Countable A, Countable B} := GsetBijG { gset_bijG_inG : inG Σ (gset_bijR A B); }. Local Existing Instance gset_bijG_inG. Global Hint Mode gset_bijG - ! ! - - - - : typeclass_instances. Definition gset_bijΣ A B `{Countable A, Countable B}: gFunctors := #[ GFunctor (gset_bijR A B) ]. Global Instance subG_gset_bijΣ `{Countable A, Countable B} Σ : subG (gset_bijΣ A B) Σ → gset_bijG Σ A B. Proof. solve_inG. Qed. Definition gset_bij_own_auth_def `{gset_bijG Σ A B} (γ : gname) (dq : dfrac) (L : gset (A * B)) : iProp Σ := own γ (gset_bij_auth dq L). Definition gset_bij_own_auth_aux : seal (@gset_bij_own_auth_def). Proof. by eexists. Qed. Definition gset_bij_own_auth := unseal gset_bij_own_auth_aux. Definition gset_bij_own_auth_eq : @gset_bij_own_auth = @gset_bij_own_auth_def := seal_eq gset_bij_own_auth_aux. Global Arguments gset_bij_own_auth {_ _ _ _ _ _ _ _}. Definition gset_bij_own_elem_def `{gset_bijG Σ A B} (γ : gname) (a : A) (b : B) : iProp Σ := own γ (gset_bij_elem a b). Definition gset_bij_own_elem_aux : seal (@gset_bij_own_elem_def). Proof. by eexists. Qed. Definition gset_bij_own_elem := unseal gset_bij_own_elem_aux. Definition gset_bij_own_elem_eq : @gset_bij_own_elem = @gset_bij_own_elem_def := seal_eq gset_bij_own_elem_aux. Global Arguments gset_bij_own_elem {_ _ _ _ _ _ _ _}. Section gset_bij. Context `{gset_bijG Σ A B}. Implicit Types (L : gset (A * B)) (a : A) (b : B). Global Instance gset_bij_own_auth_timeless γ q L : Timeless (gset_bij_own_auth γ q L). Proof. rewrite gset_bij_own_auth_eq. apply _. Qed. Global Instance gset_bij_own_elem_timeless γ a b : Timeless (gset_bij_own_elem γ a b). Proof. rewrite gset_bij_own_elem_eq. apply _. Qed. Global Instance gset_bij_own_elem_persistent γ a b : Persistent (gset_bij_own_elem γ a b). Proof. rewrite gset_bij_own_elem_eq. apply _. Qed. Global Instance gset_bij_own_auth_fractional γ L : Fractional (λ q, gset_bij_own_auth γ (DfracOwn q) L). Proof. intros p q. rewrite gset_bij_own_auth_eq -own_op gset_bij_auth_dfrac_op //. Qed. Global Instance gset_bij_own_auth_as_fractional γ q L : AsFractional (gset_bij_own_auth γ (DfracOwn q) L) (λ q, gset_bij_own_auth γ (DfracOwn q) L) q. Proof. split; [auto|apply _]. Qed. Lemma gset_bij_own_auth_agree γ dq1 dq2 L1 L2 : gset_bij_own_auth γ dq1 L1 -∗ gset_bij_own_auth γ dq2 L2 -∗ ⌜✓ (dq1 ⋅ dq2) ∧ L1 = L2 ∧ gset_bijective L1⌝. Proof. rewrite gset_bij_own_auth_eq. iIntros "H1 H2". by iCombine "H1 H2" gives %?%gset_bij_auth_dfrac_op_valid. Qed. Lemma gset_bij_own_auth_exclusive γ L1 L2 : gset_bij_own_auth γ (DfracOwn 1) L1 -∗ gset_bij_own_auth γ (DfracOwn 1) L2 -∗ False. Proof. iIntros "H1 H2". by iDestruct (gset_bij_own_auth_agree with "H1 H2") as %[[] _]. Qed. Lemma gset_bij_own_valid γ q L : gset_bij_own_auth γ q L -∗ ⌜✓ q ∧ gset_bijective L⌝. Proof. rewrite gset_bij_own_auth_eq. iIntros "Hauth". by iDestruct (own_valid with "Hauth") as %?%gset_bij_auth_dfrac_valid. Qed. Lemma gset_bij_own_elem_agree γ a a' b b' : gset_bij_own_elem γ a b -∗ gset_bij_own_elem γ a' b' -∗ ⌜a = a' ↔ b = b'⌝. Proof. rewrite gset_bij_own_elem_eq. iIntros "Hel1 Hel2". by iCombine "Hel1 Hel2" gives %?%gset_bij_elem_agree. Qed. Lemma gset_bij_own_elem_get {γ q L} a b : (a, b) ∈ L → gset_bij_own_auth γ q L -∗ gset_bij_own_elem γ a b. Proof. intros. rewrite gset_bij_own_auth_eq gset_bij_own_elem_eq. iApply own_mono. by apply bij_view_included. Qed. Lemma gset_bij_elem_of {γ q L} a b : gset_bij_own_auth γ q L -∗ gset_bij_own_elem γ a b -∗ ⌜(a, b) ∈ L⌝. Proof. iIntros "Hauth Helem". rewrite gset_bij_own_auth_eq gset_bij_own_elem_eq. iCombine "Hauth Helem" gives "%Ha". iPureIntro. revert Ha. rewrite bij_both_dfrac_valid. intros (_ & _ & ?); done. Qed. Lemma gset_bij_own_elem_get_big γ q L : gset_bij_own_auth γ q L -∗ [∗ set] ab ∈ L, gset_bij_own_elem γ ab.1 ab.2. Proof. iIntros "Hauth". iApply big_sepS_forall. iIntros ([a b] ?) "/=". by iApply gset_bij_own_elem_get. Qed. Lemma gset_bij_own_alloc L : gset_bijective L → ⊢ |==> ∃ γ, gset_bij_own_auth γ (DfracOwn 1) L ∗ [∗ set] ab ∈ L, gset_bij_own_elem γ ab.1 ab.2. Proof. intro. iAssert (∃ γ, gset_bij_own_auth γ (DfracOwn 1) L)%I with "[>]" as (γ) "Hauth". { rewrite gset_bij_own_auth_eq. iApply own_alloc. by apply gset_bij_auth_valid. } iExists γ. iModIntro. iSplit; [done|]. by iApply gset_bij_own_elem_get_big. Qed. Lemma gset_bij_own_alloc_empty : ⊢ |==> ∃ γ, gset_bij_own_auth γ (DfracOwn 1) (∅ : gset (A * B)). Proof. iMod (gset_bij_own_alloc ∅) as (γ) "[Hauth _]"; by auto. Qed. Lemma gset_bij_own_extend {γ L} a b : (∀ b', (a, b') ∉ L) → (∀ a', (a', b) ∉ L) → gset_bij_own_auth γ (DfracOwn 1) L ==∗ gset_bij_own_auth γ (DfracOwn 1) ({[(a, b)]} ∪ L) ∗ gset_bij_own_elem γ a b. Proof. iIntros (??) "Hauth". iAssert (gset_bij_own_auth γ (DfracOwn 1) ({[(a, b)]} ∪ L)) with "[> Hauth]" as "Hauth". { rewrite gset_bij_own_auth_eq. iApply (own_update with "Hauth"). by apply gset_bij_auth_extend. } iModIntro. iSplit; [done|]. iApply (gset_bij_own_elem_get with "Hauth"). set_solver. Qed. Lemma gset_bij_own_extend_internal {γ L} a b : (∀ b', gset_bij_own_elem γ a b' -∗ False) -∗ (∀ a', gset_bij_own_elem γ a' b -∗ False) -∗ gset_bij_own_auth γ (DfracOwn 1) L ==∗ gset_bij_own_auth γ (DfracOwn 1) ({[(a, b)]} ∪ L) ∗ gset_bij_own_elem γ a b. Proof. iIntros "Ha Hb HL". iAssert ⌜∀ b', (a, b') ∉ L⌝%I as %?. { iIntros (b' ?). iApply ("Ha" $! b'). by iApply gset_bij_own_elem_get. } iAssert ⌜∀ a', (a', b) ∉ L⌝%I as %?. { iIntros (a' ?). iApply ("Hb" $! a'). by iApply gset_bij_own_elem_get. } by iApply (gset_bij_own_extend with "HL"). Qed. End gset_bij. iris-iris-4.2.0/iris/base_logic/lib/invariants.v000066400000000000000000000177771460620107300216210ustar00rootroot00000000000000From stdpp Require Export namespaces. From iris.algebra Require Import gmap. From iris.proofmode Require Import proofmode. From iris.base_logic.lib Require Export fancy_updates. From iris.base_logic.lib Require Import wsat. From iris.prelude Require Import options. Import le_upd_if. (** Semantic Invariants *) Local Definition inv_def `{!invGS_gen hlc Σ} (N : namespace) (P : iProp Σ) : iProp Σ := □ ∀ E, ⌜↑N ⊆ E⌝ → |={E,E ∖ ↑N}=> ▷ P ∗ (▷ P ={E ∖ ↑N,E}=∗ True). Local Definition inv_aux : seal (@inv_def). Proof. by eexists. Qed. Definition inv := inv_aux.(unseal). Global Arguments inv {hlc Σ _} N P. Local Definition inv_unseal : @inv = @inv_def := inv_aux.(seal_eq). Global Instance: Params (@inv) 3 := {}. (** * Invariants *) Section inv. Context `{!invGS_gen hlc Σ}. Implicit Types i : positive. Implicit Types N : namespace. Implicit Types E : coPset. Implicit Types P Q R : iProp Σ. (** ** Internal model of invariants *) Definition own_inv (N : namespace) (P : iProp Σ) : iProp Σ := ∃ i, ⌜i ∈ (↑N:coPset)⌝ ∧ ownI i P. Lemma own_inv_acc E N P : ↑N ⊆ E → own_inv N P ={E,E∖↑N}=∗ ▷ P ∗ (▷ P ={E∖↑N,E}=∗ True). Proof. rewrite fancy_updates.uPred_fupd_unseal /fancy_updates.uPred_fupd_def. iDestruct 1 as (i) "[Hi #HiP]". iDestruct "Hi" as % ?%elem_of_subseteq_singleton. rewrite {1 4}(union_difference_L (↑ N) E) // ownE_op; last set_solver. rewrite {1 5}(union_difference_L {[ i ]} (↑ N)) // ownE_op; last set_solver. iIntros "(Hw & [HE $] & $) !> !>". iDestruct (ownI_open i with "[$Hw $HE $HiP]") as "($ & $ & HD)". iIntros "HP [Hw $] !> !>". iApply (ownI_close _ P). by iFrame. Qed. Lemma fresh_inv_name (E : gset positive) N : ∃ i, i ∉ E ∧ i ∈ (↑N:coPset). Proof. exists (coPpick (↑ N ∖ gset_to_coPset E)). rewrite -elem_of_gset_to_coPset (comm and) -elem_of_difference. apply coPpick_elem_of=> Hfin. eapply nclose_infinite, (difference_finite_inv _ _), Hfin. apply gset_to_coPset_finite. Qed. Lemma own_inv_alloc N E P : ▷ P ={E}=∗ own_inv N P. Proof. rewrite fancy_updates.uPred_fupd_unseal /fancy_updates.uPred_fupd_def. iIntros "HP [Hw $]". iMod (ownI_alloc (.∈ (↑N : coPset)) P with "[$HP $Hw]") as (i ?) "[$ ?]"; auto using fresh_inv_name. do 2 iModIntro. iExists i. auto. Qed. (* This does not imply [own_inv_alloc] due to the extra assumption [↑N ⊆ E]. *) Lemma own_inv_alloc_open N E P : ↑N ⊆ E → ⊢ |={E, E∖↑N}=> own_inv N P ∗ (▷P ={E∖↑N, E}=∗ True). Proof. rewrite fancy_updates.uPred_fupd_unseal /fancy_updates.uPred_fupd_def. 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 with "[HE]" as "(HEi & HEN\i & HE\N)". { rewrite -?ownE_op; [|set_solver..]. 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. 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 HE\N" as "HEN". rewrite -?ownE_op; [|set_solver..]. rewrite assoc_L -!union_difference_L //; set_solver. Qed. Lemma own_inv_to_inv M P: own_inv M P -∗ inv M P. Proof. iIntros "#I". rewrite inv_unseal. iIntros (E H). iPoseProof (own_inv_acc with "I") as "H"; eauto. Qed. (** ** Public API of invariants *) Global Instance inv_contractive N : Contractive (inv N). Proof. rewrite inv_unseal. solve_contractive. Qed. Global Instance inv_ne N : NonExpansive (inv N). Proof. apply contractive_ne, _. Qed. Global Instance inv_proper N : Proper (equiv ==> equiv) (inv N). Proof. apply ne_proper, _. Qed. Global Instance inv_persistent N P : Persistent (inv N P). Proof. rewrite inv_unseal. apply _. Qed. Lemma inv_alter N P Q : inv N P -∗ ▷ □ (P -∗ Q ∗ (Q -∗ P)) -∗ inv N Q. Proof. rewrite inv_unseal. iIntros "#HI #HPQ !>" (E H). iMod ("HI" $! E H) as "[HP Hclose]". iDestruct ("HPQ" with "HP") as "[$ HQP]". iIntros "!> HQ". iApply "Hclose". iApply "HQP". done. Qed. Lemma inv_iff N P Q : inv N P -∗ ▷ □ (P ↔ Q) -∗ inv N Q. Proof. iIntros "#HI #HPQ". iApply (inv_alter with "HI"). iIntros "!> !> HP". iSplitL "HP". - by iApply "HPQ". - iIntros "HQ". by iApply "HPQ". Qed. Lemma inv_alloc N E P : ▷ P ={E}=∗ inv N P. Proof. iIntros "HP". iApply own_inv_to_inv. iApply (own_inv_alloc N E with "HP"). Qed. Lemma inv_alloc_open N E P : ↑N ⊆ E → ⊢ |={E, E∖↑N}=> inv N P ∗ (▷P ={E∖↑N, E}=∗ True). Proof. iIntros (?). iMod own_inv_alloc_open as "[HI $]"; first done. iApply own_inv_to_inv. done. Qed. Lemma inv_acc E N P : ↑N ⊆ E → inv N P ={E,E∖↑N}=∗ ▷ P ∗ (▷ P ={E∖↑N,E}=∗ True). Proof. rewrite inv_unseal /inv_def; iIntros (?) "#HI". by iApply "HI". Qed. Lemma inv_combine N1 N2 N P Q : N1 ## N2 → ↑N1 ∪ ↑N2 ⊆@{coPset} ↑N → inv N1 P -∗ inv N2 Q -∗ inv N (P ∗ Q). Proof. rewrite inv_unseal. iIntros (??) "#HinvP #HinvQ !>"; iIntros (E ?). iMod ("HinvP" with "[%]") as "[$ HcloseP]"; first set_solver. iMod ("HinvQ" with "[%]") as "[$ HcloseQ]"; first set_solver. iApply fupd_mask_intro; first set_solver. iIntros "Hclose [HP HQ]". iMod "Hclose" as % _. iMod ("HcloseQ" with "HQ") as % _. by iApply "HcloseP". Qed. Lemma inv_combine_dup_l N P Q : □ (P -∗ P ∗ P) -∗ inv N P -∗ inv N Q -∗ inv N (P ∗ Q). Proof. rewrite inv_unseal. iIntros "#HPdup #HinvP #HinvQ !>" (E ?). iMod ("HinvP" with "[//]") as "[HP HcloseP]". iDestruct ("HPdup" with "HP") as "[$ HP]". iMod ("HcloseP" with "HP") as % _. iMod ("HinvQ" with "[//]") as "[$ HcloseQ]". iIntros "!> [HP HQ]". by iApply "HcloseQ". Qed. Lemma except_0_inv N P : ◇ inv N P ⊢ inv N P. Proof. rewrite inv_unseal /inv_def. iIntros "#H !>" (E ?). iMod "H". by iApply "H". Qed. (** ** Proof mode integration *) Global Instance is_except_0_inv N P : IsExcept0 (inv N P). Proof. apply except_0_inv. Qed. Global Instance into_inv_inv N P : IntoInv (inv N P) N := {}. Global Instance into_acc_inv N P E: IntoAcc (X := unit) (inv N P) (↑N ⊆ E) True (fupd E (E ∖ ↑N)) (fupd (E ∖ ↑N) E) (λ _ : (), (▷ P)%I) (λ _ : (), (▷ P)%I) (λ _ : (), None). Proof. rewrite /IntoAcc /accessor bi.exist_unit. iIntros (?) "#Hinv _". by iApply inv_acc. Qed. (** ** Derived properties *) Lemma inv_acc_strong E N P : ↑N ⊆ E → inv N P ={E,E∖↑N}=∗ ▷ P ∗ ∀ E', ▷ P ={E',↑N ∪ E'}=∗ True. Proof. iIntros (?) "Hinv". iPoseProof (inv_acc (↑ N) N with "Hinv") as "H"; first done. rewrite difference_diag_L. iPoseProof (fupd_mask_frame_r _ _ (E ∖ ↑ N) with "H") as "H"; first set_solver. rewrite left_id_L -union_difference_L //. iMod "H" as "[$ H]"; iModIntro. iIntros (E') "HP". iPoseProof (fupd_mask_frame_r _ _ E' with "(H HP)") as "H"; first set_solver. by rewrite left_id_L. Qed. Lemma inv_acc_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_acc with "Hinv") as "[>HP Hclose]"; auto. iIntros "!> {$HP} HP". iApply "Hclose"; auto. Qed. Lemma inv_split_l N P Q : inv N (P ∗ Q) -∗ inv N P. Proof. iIntros "#HI". iApply inv_alter; eauto. iIntros "!> !> [$ $] $". Qed. Lemma inv_split_r N P Q : inv N (P ∗ Q) -∗ inv N Q. Proof. rewrite (comm _ P Q). eapply inv_split_l. Qed. Lemma inv_split N P Q : inv N (P ∗ Q) -∗ inv N P ∗ inv N Q. Proof. iIntros "#H". iPoseProof (inv_split_l with "H") as "$". iPoseProof (inv_split_r with "H") as "$". Qed. End inv. iris-iris-4.2.0/iris/base_logic/lib/iprop.v000066400000000000000000000157071460620107300205630ustar00rootroot00000000000000From iris.algebra Require Import gmap. From iris.algebra Require cofe_solver. From iris.base_logic Require Export base_logic. From iris.prelude Require Import options. (** In this file we construct the type [iProp] of propositions of the Iris logic. This is done by solving the following recursive domain equation: iProp ≈ uPred (∀ i : gid, gname -fin-> (Σ i) iProp) where: Σ : gFunctors := lists of locally constractive functors i : gid := indexes addressing individual functors in [Σ] γ : gname := ghost variable names The Iris logic is parametrized by a list of locally contractive functors [Σ] from the category of COFEs to the category of CMRAs. These functors are instantiated with [iProp], the type of Iris propositions, which allows one to construct impredicate CMRAs, such as invariants and stored propositions using the agreement CMRA. *) (** * Locally contractive functors *) (** The type [gFunctor] bundles a functor from the category of COFEs to the category of CMRAs with a proof that it is locally contractive. *) Structure gFunctor := GFunctor { gFunctor_F :> rFunctor; gFunctor_map_contractive : rFunctorContractive gFunctor_F; }. Global Arguments GFunctor _ {_}. Global Existing Instance gFunctor_map_contractive. Add Printing Constructor gFunctor. (** The type [gFunctors] describes the parameters [Σ] of the Iris logic: lists of [gFunctor]s. Note that [gFunctors] is isomorphic to [list gFunctor], but defined in an alternative way to avoid universe inconsistencies with respect to the universe monomorphic [list] type. Defining [gFunctors] as a dependent record instead of a [sigT] avoids other universe inconsistencies. *) Record gFunctors := GFunctors { gFunctors_len : nat; gFunctors_lookup : fin gFunctors_len → gFunctor }. Definition gid (Σ : gFunctors) := fin (gFunctors_len Σ). Definition gname := positive. Canonical Structure gnameO := leibnizO gname. (** The resources functor [iResF Σ A := ∀ i : gid, gname -fin-> (Σ i) A]. *) Definition iResF (Σ : gFunctors) : urFunctor := discrete_funURF (λ i, gmapURF gname (gFunctors_lookup Σ i)). (** We define functions for the empty list of functors, the singleton list of functors, and the append operator on lists of functors. These are used to compose [gFunctors] out of smaller pieces. *) Module gFunctors. Definition nil : gFunctors := GFunctors 0 (fin_0_inv _). Definition singleton (F : gFunctor) : gFunctors := GFunctors 1 (fin_S_inv (λ _, gFunctor) F (fin_0_inv _)). Definition app (Σ1 Σ2 : gFunctors) : gFunctors := GFunctors (gFunctors_len Σ1 + gFunctors_len Σ2) (fin_add_inv _ (gFunctors_lookup Σ1) (gFunctors_lookup Σ2)). End gFunctors. Coercion gFunctors.singleton : gFunctor >-> gFunctors. Notation "#[ ]" := gFunctors.nil (format "#[ ]"). Notation "#[ Σ1 ; .. ; Σn ]" := (gFunctors.app Σ1 .. (gFunctors.app Σn gFunctors.nil) ..). (** * Subfunctors *) (** In order to make proofs in the Iris logic modular, they are not done with respect to some concrete list of functors [Σ], but are instead parametrized by an arbitrary list of functors [Σ] that contains at least certain functors. For example, the lock library is parameterized by a functor [Σ] that should have the functors corresponding to the heap and the exclusive monoid to manage to lock invariant. The contraints to can be expressed using the type class [subG Σ1 Σ2], which expresses that the functors [Σ1] are contained in [Σ2]. *) Class subG (Σ1 Σ2 : gFunctors) := in_subG i : { j | gFunctors_lookup Σ1 i = gFunctors_lookup Σ2 j }. (** Avoid trigger happy type class search: this line ensures that type class search is only triggered if the arguments of [subG] do not contain evars. Since instance search for [subG] is restrained, instances should persistently have [subG] as their first parameter to avoid loops. For example, the instances [subG_authΣ] and [auth_discrete] otherwise create a cycle that pops up arbitrarily. *) Global Hint Mode subG ! + : typeclass_instances. Lemma subG_inv Σ1 Σ2 Σ : subG (gFunctors.app Σ1 Σ2) Σ → subG Σ1 Σ * subG Σ2 Σ. Proof. move=> H; split. - move=> i; move: H=> /(_ (Fin.L _ i)) [j] /=. rewrite fin_add_inv_l; eauto. - move=> i; move: H=> /(_ (Fin.R _ i)) [j] /=. rewrite fin_add_inv_r; eauto. Qed. Global Instance subG_refl Σ : subG Σ Σ. Proof. move=> i; by exists i. Qed. Global Instance subG_app_l Σ Σ1 Σ2 : subG Σ Σ1 → subG Σ (gFunctors.app Σ1 Σ2). Proof. move=> H i; move: H=> /(_ i) [j ?]. exists (Fin.L _ j). by rewrite /= fin_add_inv_l. Qed. Global Instance subG_app_r Σ Σ1 Σ2 : subG Σ Σ2 → subG Σ (gFunctors.app Σ1 Σ2). Proof. move=> H i; move: H=> /(_ i) [j ?]. exists (Fin.R _ j). by rewrite /= fin_add_inv_r. Qed. (** * Solution of the recursive domain equation *) (** We first declare a module type and then an instance of it so as to seal all of the construction, this way we are sure we do not use any properties of the construction, and also avoid Coq from blindly unfolding it. *) Module Type iProp_solution_sig. Parameter iPrePropO : gFunctors → ofe. Global Declare Instance iPreProp_cofe {Σ} : Cofe (iPrePropO Σ). Definition iResUR (Σ : gFunctors) : ucmra := discrete_funUR (λ i, gmapUR gname (rFunctor_apply (gFunctors_lookup Σ i) (iPrePropO Σ))). Notation iProp Σ := (uPred (iResUR Σ)). Notation iPropO Σ := (uPredO (iResUR Σ)). Notation iPropI Σ := (uPredI (iResUR Σ)). Parameter iProp_unfold: ∀ {Σ}, iPropO Σ -n> iPrePropO Σ. Parameter iProp_fold: ∀ {Σ}, iPrePropO Σ -n> iPropO Σ. Parameter iProp_fold_unfold: ∀ {Σ} (P : iProp Σ), iProp_fold (iProp_unfold P) ≡ P. Parameter iProp_unfold_fold: ∀ {Σ} (P : iPrePropO Σ), iProp_unfold (iProp_fold P) ≡ P. End iProp_solution_sig. Module Export iProp_solution : iProp_solution_sig. Import cofe_solver. Definition iProp_result (Σ : gFunctors) : solution (uPredOF (iResF Σ)) := solver.result _. Definition iPrePropO (Σ : gFunctors) : ofe := iProp_result Σ. Global Instance iPreProp_cofe {Σ} : Cofe (iPrePropO Σ) := _. Definition iResUR (Σ : gFunctors) : ucmra := discrete_funUR (λ i, gmapUR gname (rFunctor_apply (gFunctors_lookup Σ i) (iPrePropO Σ))). Notation iProp Σ := (uPred (iResUR Σ)). Notation iPropO Σ := (uPredO (iResUR Σ)). Definition iProp_unfold {Σ} : iPropO Σ -n> iPrePropO Σ := ofe_iso_1 (iProp_result Σ). Definition iProp_fold {Σ} : iPrePropO Σ -n> iPropO Σ := ofe_iso_2 (iProp_result Σ). Lemma iProp_fold_unfold {Σ} (P : iProp Σ) : iProp_fold (iProp_unfold P) ≡ P. Proof. apply ofe_iso_21. Qed. Lemma iProp_unfold_fold {Σ} (P : iPrePropO Σ) : iProp_unfold (iProp_fold P) ≡ P. Proof. apply ofe_iso_12. Qed. 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 ⊢@{iPropI Σ} P ≡ Q. Proof. rewrite -{2}(iProp_fold_unfold P) -{2}(iProp_fold_unfold Q). apply: f_equivI. Qed. iris-iris-4.2.0/iris/base_logic/lib/later_credits.v000066400000000000000000000424201460620107300222460ustar00rootroot00000000000000(** This file implements later credits, in particular the later-elimination update. That update is used internally to define the Iris [fupd]; it should not usually be directly used unless you are defining your own [fupd]. *) From iris.prelude Require Import options. From iris.proofmode Require Import tactics. From iris.algebra Require Export auth numbers. From iris.base_logic.lib Require Import iprop own. Import uPred. (** The ghost state for later credits *) Class lcGpreS (Σ : gFunctors) := LcGpreS { lcGpreS_inG : inG Σ (authR natUR) }. Class lcGS (Σ : gFunctors) := LcGS { lcGS_inG : inG Σ (authR natUR); lcGS_name : gname; }. Global Hint Mode lcGS - : typeclass_instances. Local Existing Instances lcGS_inG lcGpreS_inG. Definition lcΣ := #[GFunctor (authR (natUR))]. Global Instance subG_lcΣ {Σ} : subG lcΣ Σ → lcGpreS Σ. Proof. solve_inG. Qed. (** The user-facing credit resource, denoting ownership of [n] credits. *) Local Definition lc_def `{!lcGS Σ} (n : nat) : iProp Σ := own lcGS_name (◯ n). Local Definition lc_aux : seal (@lc_def). Proof. by eexists. Qed. Definition lc := lc_aux.(unseal). Local Definition lc_unseal : @lc = @lc_def := lc_aux.(seal_eq). Global Arguments lc {Σ _} n. Notation "'£' n" := (lc n) (at level 1). (** The internal authoritative part of the credit ghost state, tracking how many credits are available in total. Users should not directly interface with this. *) Local Definition lc_supply_def `{!lcGS Σ} (n : nat) : iProp Σ := own lcGS_name (● n). Local Definition lc_supply_aux : seal (@lc_supply_def). Proof. by eexists. Qed. Local Definition lc_supply := lc_supply_aux.(unseal). Local Definition lc_supply_unseal : @lc_supply = @lc_supply_def := lc_supply_aux.(seal_eq). Global Arguments lc_supply {Σ _} n. Section later_credit_theory. Context `{!lcGS Σ}. Implicit Types (P Q : iProp Σ). (** Later credit rules *) Lemma lc_split n m : £ (n + m) ⊣⊢ £ n ∗ £ m. Proof. rewrite lc_unseal /lc_def. rewrite -own_op auth_frag_op //=. Qed. Lemma lc_zero : ⊢ |==> £ 0. Proof. rewrite lc_unseal /lc_def. iApply own_unit. Qed. Lemma lc_supply_bound n m : lc_supply m -∗ £ n -∗ ⌜n ≤ m⌝. Proof. rewrite lc_unseal /lc_def. rewrite lc_supply_unseal /lc_supply_def. iIntros "H1 H2". iCombine "H1 H2" gives %Hop. iPureIntro. eapply auth_both_valid_discrete in Hop as [Hlt _]. by eapply nat_included. Qed. Lemma lc_decrease_supply n m : lc_supply (n + m) -∗ £ n -∗ |==> lc_supply m. Proof. rewrite lc_unseal /lc_def. rewrite lc_supply_unseal /lc_supply_def. iIntros "H1 H2". iMod (own_update_2 with "H1 H2") as "Hown". { eapply auth_update. eapply (nat_local_update _ _ m 0). lia. } by iDestruct "Hown" as "[Hm _]". Qed. Lemma lc_succ n : £ (S n) ⊣⊢ £ 1 ∗ £ n. Proof. rewrite -lc_split //=. Qed. Lemma lc_weaken {n} m : m ≤ n → £ n -∗ £ m. Proof. intros [k ->]%Nat.le_sum. rewrite lc_split. iIntros "[$ _]". Qed. Global Instance lc_timeless n : Timeless (£ n). Proof. rewrite lc_unseal /lc_def. apply _. Qed. Global Instance lc_0_persistent : Persistent (£ 0). Proof. rewrite lc_unseal /lc_def. apply _. Qed. (** Make sure that the rule for [+] is used before [S], otherwise Coq's unification applies the [S] hint too eagerly. See Iris issue #470. *) Global Instance from_sep_lc_add n m : FromSep (£ (n + m)) (£ n) (£ m) | 0. Proof. by rewrite /FromSep lc_split. Qed. Global Instance from_sep_lc_S n : FromSep (£ (S n)) (£ 1) (£ n) | 1. Proof. by rewrite /FromSep (lc_succ n). Qed. (** When combining later credits with [iCombine], the priorities are reversed when compared to [FromSep] and [IntoSep]. This causes [£ n] and [£ 1] to be combined as [£ (S n)], not as [£ (n + 1)]. *) Global Instance combine_sep_lc_add n m : CombineSepAs (£ n) (£ m) (£ (n + m)) | 1. Proof. by rewrite /CombineSepAs lc_split. Qed. Global Instance combine_sep_lc_S_l n : CombineSepAs (£ n) (£ 1) (£ (S n)) | 0. Proof. by rewrite /CombineSepAs comm (lc_succ n). Qed. Global Instance into_sep_lc_add n m : IntoSep (£ (n + m)) (£ n) (£ m) | 0. Proof. by rewrite /IntoSep lc_split. Qed. Global Instance into_sep_lc_S n : IntoSep (£ (S n)) (£ 1) (£ n) | 1. Proof. by rewrite /IntoSep (lc_succ n). Qed. End later_credit_theory. (** Let users import the above without also getting the below laws. This should only be imported by the internal development of fancy updates. *) Module le_upd. (** Definition of the later-elimination update *) Definition le_upd_pre `{!lcGS Σ} (le_upd : iProp Σ -d> iPropO Σ) : iProp Σ -d> iPropO Σ := λ P, (∀ n, lc_supply n ==∗ (lc_supply n ∗ P) ∨ (∃ m, ⌜m < n⌝ ∗ lc_supply m ∗ ▷ le_upd P))%I. Local Instance le_upd_pre_contractive `{!lcGS Σ} : Contractive le_upd_pre. Proof. solve_contractive. Qed. Local Definition le_upd_def `{!lcGS Σ} : iProp Σ -d> iPropO Σ := fixpoint le_upd_pre. Local Definition le_upd_aux : seal (@le_upd_def). Proof. by eexists. Qed. Definition le_upd := le_upd_aux.(unseal). Local Definition le_upd_unseal : @le_upd = @le_upd_def := le_upd_aux.(seal_eq). Global Arguments le_upd {_ _} _. Notation "'|==£>' P" := (le_upd P%I) (at level 99, P at level 200, format "|==£> P") : bi_scope. Local Lemma le_upd_unfold `{!lcGS Σ} P: (|==£> P) ⊣⊢ ∀ n, lc_supply n ==∗ (lc_supply n ∗ P) ∨ (∃ m, ⌜m < n⌝ ∗ lc_supply m ∗ ▷ le_upd P). Proof. by rewrite le_upd_unseal /le_upd_def {1}(fixpoint_unfold le_upd_pre P) {1}/le_upd_pre. Qed. Section le_upd. Context `{!lcGS Σ}. Implicit Types (P Q : iProp Σ). (** Rules for the later elimination update *) Global Instance le_upd_ne : NonExpansive le_upd. Proof. intros n; induction (lt_wf n) as [n _ IH]. intros P1 P2 HP. rewrite (le_upd_unfold P1) (le_upd_unfold P2). do 9 (done || f_equiv). f_contractive. eapply IH, dist_le; [lia|done|lia]. Qed. Lemma bupd_le_upd P : (|==> P) ⊢ (|==£> P). Proof. rewrite le_upd_unfold; iIntros "Hupd" (x) "Hpr". iMod "Hupd" as "P". iModIntro. iLeft. by iFrame. Qed. Lemma le_upd_intro P : P ⊢ |==£> P. Proof. iIntros "H"; by iApply bupd_le_upd. Qed. Lemma le_upd_bind P Q : (P -∗ |==£> Q) -∗ (|==£> P) -∗ (|==£> Q). Proof. iLöb as "IH". iIntros "PQ". iEval (rewrite (le_upd_unfold P) (le_upd_unfold Q)). iIntros "Hupd" (x) "Hpr". iMod ("Hupd" with "Hpr") as "[Hupd|Hupd]". - iDestruct "Hupd" as "[Hpr Hupd]". iSpecialize ("PQ" with "Hupd"). iEval (rewrite le_upd_unfold) in "PQ". iMod ("PQ" with "Hpr") as "[Hupd|Hupd]". + iModIntro. by iLeft. + iModIntro. iRight. iDestruct "Hupd" as (x'' Hstep'') "[Hpr Hupd]". iExists _; iFrame. by iPureIntro. - iModIntro. iRight. iDestruct "Hupd" as (x') "(Hstep & Hpr & Hupd)". iExists _; iFrame. iNext. by iApply ("IH" with "PQ Hupd"). Qed. Lemma le_upd_later_elim P : £ 1 -∗ (▷ |==£> P) -∗ |==£> P. Proof. iIntros "Hc Hl". iEval (rewrite le_upd_unfold). iIntros (n) "Hs". iDestruct (lc_supply_bound with "Hs Hc") as "%". destruct n as [ | n]; first by lia. replace (S n) with (1 + n) by lia. iMod (lc_decrease_supply with "Hs Hc") as "Hs". eauto 10 with iFrame lia. Qed. (** Derived lemmas *) Lemma le_upd_mono P Q : (P ⊢ Q) → (|==£> P) ⊢ (|==£> Q). Proof. intros Hent. iApply le_upd_bind. iIntros "P"; iApply le_upd_intro; by iApply Hent. Qed. Global Instance le_upd_mono' : Proper ((⊢) ==> (⊢)) le_upd. Proof. intros P Q PQ; by apply le_upd_mono. Qed. Global Instance le_upd_flip_mono' : Proper (flip (⊢) ==> flip (⊢)) le_upd. Proof. intros P Q PQ; by apply le_upd_mono. Qed. Global Instance le_upd_equiv_proper : Proper ((≡) ==> (≡)) le_upd. Proof. apply ne_proper. apply _. Qed. Lemma le_upd_trans P : (|==£> |==£> P) ⊢ |==£> P. Proof. iIntros "HP". iApply le_upd_bind; eauto. Qed. Lemma le_upd_frame_r P R : (|==£> P) ∗ R ⊢ |==£> P ∗ R. Proof. iIntros "[Hupd R]". iApply (le_upd_bind with "[R]"); last done. iIntros "P". iApply le_upd_intro. by iFrame. Qed. Lemma le_upd_frame_l P R : R ∗ (|==£> P) ⊢ |==£> R ∗ P. Proof. rewrite comm le_upd_frame_r comm //. Qed. Lemma le_upd_later P : £ 1 -∗ ▷ P -∗ |==£> P. Proof. iIntros "H1 H2". iApply (le_upd_later_elim with "H1"). iNext. by iApply le_upd_intro. Qed. Lemma except_0_le_upd P : ◇ (le_upd P) ⊢ le_upd (◇ P). Proof. rewrite /bi_except_0. apply or_elim; eauto using le_upd_mono, or_intro_r. by rewrite -le_upd_intro -or_intro_l. Qed. (** A safety check that later-elimination updates can replace basic updates *) (** We do not use this to build an instance, because it would conflict with the basic updates. *) Local Lemma bi_bupd_mixin_le_upd : BiBUpdMixin (iPropI Σ) le_upd. Proof. split; rewrite /bupd. - apply _. - apply le_upd_intro. - apply le_upd_mono. - apply le_upd_trans. - apply le_upd_frame_r. Qed. (** unfolding the later elimination update *) Lemma le_upd_elim n P : lc_supply n -∗ (|==£> P) -∗ Nat.iter n (λ P, |==> ▷ P) (|==> ◇ (∃ m, ⌜m ≤ n⌝ ∗ lc_supply m ∗ P)). Proof. induction (Nat.lt_wf_0 n) as [n _ IH]. iIntros "Ha". rewrite (le_upd_unfold P) //=. iIntros "Hupd". iSpecialize ("Hupd" with "Ha"). destruct n as [|n]; simpl. - iMod "Hupd" as "[[H● ?]| Hf]". { do 2 iModIntro. iExists 0. iFrame. done. } iDestruct "Hf" as (x' Hlt) "_". lia. - iMod "Hupd" as "[[Hc P]|Hupd]". + iModIntro. iNext. iApply iter_modal_intro; last first. { do 2 iModIntro. iExists (S n); iFrame; done. } iIntros (Q) "Q"; iModIntro; by iNext. + iModIntro. iDestruct "Hupd" as (m Hstep) "[Hown Hupd]". iNext. iPoseProof (IH with "Hown Hupd") as "Hit"; first done. clear IH. assert (m ≤ n) as [k ->]%Nat.le_sum by lia. rewrite Nat.add_comm Nat.iter_add. iApply iter_modal_intro. { by iIntros (Q) "$". } iApply (iter_modal_mono with "[] Hit"). { iIntros (R S) "Hent H". by iApply "Hent". } iIntros "H". iMod "H". iModIntro. iMod "H" as (m' Hle) "H". iModIntro. iExists m'. iFrame. iPureIntro. lia. Qed. Lemma le_upd_elim_complete n P : lc_supply n -∗ (|==£> P) -∗ Nat.iter (S n) (λ Q, |==> ▷ Q) P. Proof. iIntros "Hlc Hupd". iPoseProof (le_upd_elim with "Hlc Hupd") as "Hit". rewrite Nat.iter_succ_r. iApply (iter_modal_mono with "[] Hit"). { clear. iIntros (P Q) "Hent HP". by iApply "Hent". } iIntros "Hupd". iMod "Hupd". iModIntro. iMod "Hupd". iNext. iDestruct "Hupd" as "[%m (_ & _ & $)]". Qed. (** Proof mode class instances internally needed for people defining their [fupd] with [le_upd]. *) Global Instance elim_bupd_le_upd p P Q : ElimModal True p false (bupd P) P (le_upd Q) (le_upd Q)%I. Proof. rewrite /ElimModal bi.intuitionistically_if_elim //=. rewrite bupd_le_upd. iIntros "_ [HP HPQ]". iApply (le_upd_bind with "HPQ HP"). Qed. Global Instance from_assumption_le_upd p P Q : FromAssumption p P Q → KnownRFromAssumption p P (le_upd Q). Proof. rewrite /KnownRFromAssumption /FromAssumption=>->. apply le_upd_intro. Qed. Global Instance from_pure_le_upd a P φ : FromPure a P φ → FromPure a (le_upd P) φ. Proof. rewrite /FromPure=> <-. apply le_upd_intro. Qed. Global Instance is_except_0_le_upd P : IsExcept0 P → IsExcept0 (le_upd P). Proof. rewrite /IsExcept0=> HP. by rewrite -{2}HP -(except_0_idemp P) -except_0_le_upd -(except_0_intro P). Qed. Global Instance from_modal_le_upd P : FromModal True modality_id (le_upd P) (le_upd P) P. Proof. by rewrite /FromModal /= -le_upd_intro. Qed. Global Instance elim_modal_le_upd p P Q : ElimModal True p false (le_upd P) P (le_upd Q) (le_upd Q). Proof. by rewrite /ElimModal intuitionistically_if_elim le_upd_frame_r wand_elim_r le_upd_trans. Qed. Global Instance frame_le_upd p R P Q : Frame p R P Q → Frame p R (le_upd P) (le_upd Q). Proof. rewrite /Frame=><-. by rewrite le_upd_frame_l. Qed. End le_upd. (** You probably do NOT want to use this lemma; use [lc_soundness] if you want to actually use [le_upd]! *) Local Lemma lc_alloc `{!lcGpreS Σ} n : ⊢ |==> ∃ _ : lcGS Σ, lc_supply n ∗ £ n. Proof. rewrite lc_unseal /lc_def lc_supply_unseal /lc_supply_def. iMod (own_alloc (● n ⋅ ◯ n)) as (γLC) "[H● H◯]"; first (apply auth_both_valid; split; done). pose (C := LcGS _ _ γLC). iModIntro. iExists C. iFrame. Qed. Lemma lc_soundness `{!lcGpreS Σ} m (P : iProp Σ) `{!Plain P} : (∀ {Hc: lcGS Σ}, £ m -∗ |==£> P) → ⊢ P. Proof. intros H. apply (laterN_soundness _ (S m)). eapply bupd_soundness; first apply _. iStartProof. iMod (lc_alloc m) as (C) "[H● H◯]". iPoseProof (H C) as "Hc". iSpecialize ("Hc" with "H◯"). iPoseProof (le_upd_elim_complete m with "H● Hc") as "H". simpl. iMod "H". iModIntro. iNext. clear H. iInduction m as [|m] "IH"; simpl; [done|]. iMod "H". iNext. by iApply "IH". Qed. End le_upd. (** This should only be imported by the internal development of fancy updates. *) Module le_upd_if. Export le_upd. Section le_upd_if. Context `{!lcGS Σ}. Definition le_upd_if (b : bool) : iProp Σ → iProp Σ := if b then le_upd else bupd. Global Instance le_upd_if_mono' b : Proper ((⊢) ==> (⊢)) (le_upd_if b). Proof. destruct b; apply _. Qed. Global Instance le_upd_if_flip_mono' b : Proper (flip (⊢) ==> flip (⊢)) (le_upd_if b). Proof. destruct b; apply _. Qed. Global Instance le_upd_if_proper b : Proper ((≡) ==> (≡)) (le_upd_if b). Proof. destruct b; apply _. Qed. Global Instance le_upd_if_ne b : NonExpansive (le_upd_if b). Proof. destruct b; apply _. Qed. Lemma le_upd_if_intro b P : P ⊢ le_upd_if b P. Proof. destruct b; [apply le_upd_intro | apply bupd_intro]. Qed. Lemma le_upd_if_bind b P Q : (P -∗ le_upd_if b Q) -∗ (le_upd_if b P) -∗ (le_upd_if b Q). Proof. destruct b; first apply le_upd_bind. simpl. iIntros "HPQ >HP". by iApply "HPQ". Qed. Lemma le_upd_if_mono b P Q : (P ⊢ Q) → (le_upd_if b P) ⊢ (le_upd_if b Q). Proof. destruct b; [apply le_upd_mono | apply bupd_mono]. Qed. Lemma le_upd_if_trans b P : (le_upd_if b (le_upd_if b P)) ⊢ le_upd_if b P. Proof. destruct b; [apply le_upd_trans | apply bupd_trans]. Qed. Lemma le_upd_if_frame_r b P R : (le_upd_if b P) ∗ R ⊢ le_upd_if b (P ∗ R). Proof. destruct b; [apply le_upd_frame_r | apply bupd_frame_r]. Qed. Lemma bupd_le_upd_if b P : (|==> P) ⊢ (le_upd_if b P). Proof. destruct b; [apply bupd_le_upd | done]. Qed. Lemma le_upd_if_frame_l b R Q : (R ∗ le_upd_if b Q) ⊢ le_upd_if b (R ∗ Q). Proof. rewrite comm le_upd_if_frame_r comm //. Qed. Lemma except_0_le_upd_if b P : ◇ (le_upd_if b P) ⊢ le_upd_if b (◇ P). Proof. rewrite /bi_except_0. apply or_elim; eauto using le_upd_if_mono, or_intro_r. by rewrite -le_upd_if_intro -or_intro_l. Qed. (** Proof mode class instances that we need for the internal development, i.e. for the definition of fancy updates. *) Global Instance elim_bupd_le_upd_if b p P Q : ElimModal True p false (bupd P) P (le_upd_if b Q) (le_upd_if b Q)%I. Proof. rewrite /ElimModal bi.intuitionistically_if_elim //=. rewrite bupd_le_upd_if. iIntros "_ [HP HPQ]". iApply (le_upd_if_bind with "HPQ HP"). Qed. Global Instance from_assumption_le_upd_if b p P Q : FromAssumption p P Q → KnownRFromAssumption p P (le_upd_if b Q). Proof. rewrite /KnownRFromAssumption /FromAssumption=>->. apply le_upd_if_intro. Qed. Global Instance from_pure_le_upd_if b a P φ : FromPure a P φ → FromPure a (le_upd_if b P) φ. Proof. rewrite /FromPure=> <-. apply le_upd_if_intro. Qed. Global Instance is_except_0_le_upd_if b P : IsExcept0 P → IsExcept0 (le_upd_if b P). Proof. rewrite /IsExcept0=> HP. by rewrite -{2}HP -(except_0_idemp P) -except_0_le_upd_if -(except_0_intro P). Qed. Global Instance from_modal_le_upd_if b P : FromModal True modality_id (le_upd_if b P) (le_upd_if b P) P. Proof. by rewrite /FromModal /= -le_upd_if_intro. Qed. Global Instance elim_modal_le_upd_if b p P Q : ElimModal True p false (le_upd_if b P) P (le_upd_if b Q) (le_upd_if b Q). Proof. by rewrite /ElimModal intuitionistically_if_elim le_upd_if_frame_r wand_elim_r le_upd_if_trans. Qed. Global Instance frame_le_upd_if b p R P Q : Frame p R P Q → Frame p R (le_upd_if b P) (le_upd_if b Q). Proof. rewrite /Frame=><-. by rewrite le_upd_if_frame_l. Qed. End le_upd_if. End le_upd_if. iris-iris-4.2.0/iris/base_logic/lib/mono_Z.v000066400000000000000000000130201460620107300206550ustar00rootroot00000000000000(** Ghost state for a monotonically increasing non-negative integer. This is basically a [Z]-typed wrapper over [mono_nat], which can be useful when one wants to use [Z] consistently for everything. Provides an authoritative proposition [mono_Z_auth_own γ q n] for the underlying number [n] and a persistent proposition [mono_nat_lb_own γ m] witnessing that the authoritative nat is at least [m]. The key rules are [mono_Z_lb_own_valid], which asserts that an auth at [n] and a lower-bound at [m] imply that [m ≤ n], and [mono_Z_update], which allows to increase the auth element. At any time the auth nat can be "snapshotted" with [mono_Z_get_lb] to produce a persistent lower-bound proposition. Note: This construction requires the integers to be non-negative, i.e., to have the lower bound 0, which gives [mono_Z_lb_own_0 : |==> mono_Z_lb_own γ 0]. This rule would be false if we were to generalize to negative integers. See https://gitlab.mpi-sws.org/iris/iris/-/merge_requests/889 for a discussion about the generalization to negative integers. *) From iris.proofmode Require Import proofmode. From iris.algebra.lib Require Import mono_nat. From iris.bi.lib Require Import fractional. From iris.base_logic.lib Require Export own. From iris.base_logic.lib Require Import mono_nat. From iris.prelude Require Import options. Local Open Scope Z_scope. Class mono_ZG Σ := MonoZG { mono_ZG_natG : mono_natG Σ; }. Local Existing Instance mono_ZG_natG. Definition mono_ZΣ := mono_natΣ. Local Definition mono_Z_auth_own_def `{!mono_ZG Σ} (γ : gname) (q : Qp) (n : Z) : iProp Σ := ⌜0 ≤ n⌝ ∗ mono_nat_auth_own γ q (Z.to_nat n). Local Definition mono_Z_auth_own_aux : seal (@mono_Z_auth_own_def). Proof. by eexists. Qed. Definition mono_Z_auth_own := mono_Z_auth_own_aux.(unseal). Local Definition mono_Z_auth_own_unseal : @mono_Z_auth_own = @mono_Z_auth_own_def := mono_Z_auth_own_aux.(seal_eq). Global Arguments mono_Z_auth_own {Σ _} γ q n. Local Definition mono_Z_lb_own_def `{!mono_ZG Σ} (γ : gname) (n : Z) : iProp Σ := ⌜0 ≤ n⌝ ∗ mono_nat_lb_own γ (Z.to_nat n). Local Definition mono_Z_lb_own_aux : seal (@mono_Z_lb_own_def). Proof. by eexists. Qed. Definition mono_Z_lb_own := mono_Z_lb_own_aux.(unseal). Local Definition mono_Z_lb_own_unseal : @mono_Z_lb_own = @mono_Z_lb_own_def := mono_Z_lb_own_aux.(seal_eq). Global Arguments mono_Z_lb_own {Σ _} γ n. Local Ltac unseal := rewrite ?mono_Z_auth_own_unseal /mono_Z_auth_own_def ?mono_Z_lb_own_unseal /mono_Z_lb_own_def. Section mono_Z. Context `{!mono_ZG Σ}. Implicit Types (n m : Z). Global Instance mono_Z_auth_own_timeless γ q n : Timeless (mono_Z_auth_own γ q n). Proof. unseal. apply _. Qed. Global Instance mono_Z_lb_own_timeless γ n : Timeless (mono_Z_lb_own γ n). Proof. unseal. apply _. Qed. Global Instance mono_Z_lb_own_persistent γ n : Persistent (mono_Z_lb_own γ n). Proof. unseal. apply _. Qed. Global Instance mono_Z_auth_own_fractional γ n : Fractional (λ q, mono_Z_auth_own γ q n). Proof. unseal. intros p q. iSplit. - iIntros "[% [$ $]]". eauto. - iIntros "[[% H1] [% H2]]". iCombine "H1 H2" as "$". eauto. Qed. Global Instance mono_Z_auth_own_as_fractional γ q n : AsFractional (mono_Z_auth_own γ q n) (λ q, mono_Z_auth_own γ q n) q. Proof. split; [auto|apply _]. Qed. Lemma mono_Z_auth_own_agree γ q1 q2 n1 n2 : mono_Z_auth_own γ q1 n1 -∗ mono_Z_auth_own γ q2 n2 -∗ ⌜(q1 + q2 ≤ 1)%Qp ∧ n1 = n2⌝. Proof. unseal. iIntros "[% H1] [% H2]". iDestruct (mono_nat_auth_own_agree with "H1 H2") as %?. iPureIntro. naive_solver lia. Qed. Lemma mono_Z_auth_own_exclusive γ n1 n2 : mono_Z_auth_own γ 1 n1 -∗ mono_Z_auth_own γ 1 n2 -∗ False. Proof. iIntros "H1 H2". by iDestruct (mono_Z_auth_own_agree with "H1 H2") as %[[] _]. Qed. Lemma mono_Z_lb_own_valid γ q n m : mono_Z_auth_own γ q n -∗ mono_Z_lb_own γ m -∗ ⌜(q ≤ 1)%Qp ∧ m ≤ n⌝. Proof. unseal. iIntros "[% Hauth] [% Hlb]". iDestruct (mono_nat_lb_own_valid with "Hauth Hlb") as %Hvalid. iPureIntro. naive_solver lia. Qed. (** The conclusion of this lemma is persistent; the proofmode will preserve the [mono_Z_auth_own] in the premise as long as the conclusion is introduced to the persistent context, for example with [iDestruct (mono_Z_lb_own_get with "Hauth") as "#Hfrag"]. *) Lemma mono_Z_lb_own_get γ q n : mono_Z_auth_own γ q n -∗ mono_Z_lb_own γ n. Proof. unseal. iIntros "[% ?]". iSplit; first done. by iApply mono_nat_lb_own_get. Qed. Lemma mono_Z_lb_own_le {γ n} n' : n' ≤ n → 0 ≤ n' → mono_Z_lb_own γ n -∗ mono_Z_lb_own γ n'. Proof. unseal. iIntros "% % [% ?]". iSplit; first done. iApply mono_nat_lb_own_le; last done. lia. Qed. Lemma mono_Z_lb_own_0 γ : ⊢ |==> mono_Z_lb_own γ 0. Proof. unseal. iMod mono_nat_lb_own_0 as "$". eauto. Qed. Lemma mono_Z_own_alloc n : 0 ≤ n → ⊢ |==> ∃ γ, mono_Z_auth_own γ 1 n ∗ mono_Z_lb_own γ n. Proof. unseal. intros. iMod mono_nat_own_alloc as (γ) "[??]". iModIntro. iExists _. iFrame. eauto. Qed. Lemma mono_Z_own_update {γ n} n' : n ≤ n' → mono_Z_auth_own γ 1 n ==∗ mono_Z_auth_own γ 1 n' ∗ mono_Z_lb_own γ n'. Proof. iIntros (?) "Hauth". iAssert (mono_Z_auth_own γ 1 n') with "[> Hauth]" as "Hauth". { unseal. iDestruct "Hauth" as "[% Hauth]". iMod (mono_nat_own_update with "Hauth") as "[$ _]"; auto with lia. } iModIntro. iSplit; [done|]. by iApply mono_Z_lb_own_get. Qed. End mono_Z. iris-iris-4.2.0/iris/base_logic/lib/mono_nat.v000066400000000000000000000123611460620107300212350ustar00rootroot00000000000000(** Ghost state for a monotonically increasing nat, wrapping the [mono_natR] RA. Provides an authoritative proposition [mono_nat_auth_own γ q n] for the underlying number [n] and a persistent proposition [mono_nat_lb_own γ m] witnessing that the authoritative nat is at least [m]. The key rules are [mono_nat_lb_own_valid], which asserts that an auth at [n] and a lower-bound at [m] imply that [m ≤ n], and [mono_nat_update], which allows to increase the auth element. At any time the auth nat can be "snapshotted" with [mono_nat_get_lb] to produce a persistent lower-bound proposition. *) From iris.proofmode Require Import proofmode. From iris.algebra.lib Require Import mono_nat. From iris.bi.lib Require Import fractional. From iris.base_logic.lib Require Export own. From iris.prelude Require Import options. Class mono_natG Σ := MonoNatG { mono_natG_inG : inG Σ mono_natR; }. Local Existing Instance mono_natG_inG. Definition mono_natΣ : gFunctors := #[ GFunctor mono_natR ]. Global Instance subG_mono_natΣ Σ : subG mono_natΣ Σ → mono_natG Σ. Proof. solve_inG. Qed. Local Definition mono_nat_auth_own_def `{!mono_natG Σ} (γ : gname) (q : Qp) (n : nat) : iProp Σ := own γ (●MN{#q} n). Local Definition mono_nat_auth_own_aux : seal (@mono_nat_auth_own_def). Proof. by eexists. Qed. Definition mono_nat_auth_own := mono_nat_auth_own_aux.(unseal). Local Definition mono_nat_auth_own_unseal : @mono_nat_auth_own = @mono_nat_auth_own_def := mono_nat_auth_own_aux.(seal_eq). Global Arguments mono_nat_auth_own {Σ _} γ q n. Local Definition mono_nat_lb_own_def `{!mono_natG Σ} (γ : gname) (n : nat): iProp Σ := own γ (◯MN n). Local Definition mono_nat_lb_own_aux : seal (@mono_nat_lb_own_def). Proof. by eexists. Qed. Definition mono_nat_lb_own := mono_nat_lb_own_aux.(unseal). Local Definition mono_nat_lb_own_unseal : @mono_nat_lb_own = @mono_nat_lb_own_def := mono_nat_lb_own_aux.(seal_eq). Global Arguments mono_nat_lb_own {Σ _} γ n. Local Ltac unseal := rewrite ?mono_nat_auth_own_unseal /mono_nat_auth_own_def ?mono_nat_lb_own_unseal /mono_nat_lb_own_def. Section mono_nat. Context `{!mono_natG Σ}. Implicit Types (n m : nat). Global Instance mono_nat_auth_own_timeless γ q n : Timeless (mono_nat_auth_own γ q n). Proof. unseal. apply _. Qed. Global Instance mono_nat_lb_own_timeless γ n : Timeless (mono_nat_lb_own γ n). Proof. unseal. apply _. Qed. Global Instance mono_nat_lb_own_persistent γ n : Persistent (mono_nat_lb_own γ n). Proof. unseal. apply _. Qed. Global Instance mono_nat_auth_own_fractional γ n : Fractional (λ q, mono_nat_auth_own γ q n). Proof. unseal. intros p q. rewrite -own_op -mono_nat_auth_dfrac_op //. Qed. Global Instance mono_nat_auth_own_as_fractional γ q n : AsFractional (mono_nat_auth_own γ q n) (λ q, mono_nat_auth_own γ q n) q. Proof. split; [auto|apply _]. Qed. Lemma mono_nat_auth_own_agree γ q1 q2 n1 n2 : mono_nat_auth_own γ q1 n1 -∗ mono_nat_auth_own γ q2 n2 -∗ ⌜(q1 + q2 ≤ 1)%Qp ∧ n1 = n2⌝. Proof. unseal. iIntros "H1 H2". iCombine "H1 H2" gives %?%mono_nat_auth_dfrac_op_valid; done. Qed. Lemma mono_nat_auth_own_exclusive γ n1 n2 : mono_nat_auth_own γ 1 n1 -∗ mono_nat_auth_own γ 1 n2 -∗ False. Proof. iIntros "H1 H2". by iDestruct (mono_nat_auth_own_agree with "H1 H2") as %[[] _]. Qed. Lemma mono_nat_lb_own_valid γ q n m : mono_nat_auth_own γ q n -∗ mono_nat_lb_own γ m -∗ ⌜(q ≤ 1)%Qp ∧ m ≤ n⌝. Proof. unseal. iIntros "Hauth Hlb". iCombine "Hauth Hlb" gives %Hvalid%mono_nat_both_dfrac_valid. auto. Qed. (** The conclusion of this lemma is persistent; the proofmode will preserve the [mono_nat_auth_own] in the premise as long as the conclusion is introduced to the persistent context, for example with [iDestruct (mono_nat_lb_own_get with "Hauth") as "#Hfrag"]. *) Lemma mono_nat_lb_own_get γ q n : mono_nat_auth_own γ q n -∗ mono_nat_lb_own γ n. Proof. unseal. iApply own_mono. apply mono_nat_included. Qed. Lemma mono_nat_lb_own_le {γ n} n' : n' ≤ n → mono_nat_lb_own γ n -∗ mono_nat_lb_own γ n'. Proof. unseal. intros. iApply own_mono. by apply mono_nat_lb_mono. Qed. Lemma mono_nat_lb_own_0 γ : ⊢ |==> mono_nat_lb_own γ 0. Proof. unseal. iApply own_unit. Qed. Lemma mono_nat_own_alloc_strong P n : pred_infinite P → ⊢ |==> ∃ γ, ⌜P γ⌝ ∗ mono_nat_auth_own γ 1 n ∗ mono_nat_lb_own γ n. Proof. unseal. intros. iMod (own_alloc_strong (●MN n ⋅ ◯MN n) P) as (γ) "[% [??]]"; first done. { apply mono_nat_both_valid; auto. } auto with iFrame. Qed. Lemma mono_nat_own_alloc n : ⊢ |==> ∃ γ, mono_nat_auth_own γ 1 n ∗ mono_nat_lb_own γ n. Proof. iMod (mono_nat_own_alloc_strong (λ _, True) n) as (γ) "[_ ?]". - by apply pred_infinite_True. - eauto. Qed. Lemma mono_nat_own_update {γ n} n' : n ≤ n' → mono_nat_auth_own γ 1 n ==∗ mono_nat_auth_own γ 1 n' ∗ mono_nat_lb_own γ n'. Proof. iIntros (?) "Hauth". iAssert (mono_nat_auth_own γ 1 n') with "[> Hauth]" as "Hauth". { unseal. iApply (own_update with "Hauth"). by apply mono_nat_update. } iModIntro. iSplit; [done|]. by iApply mono_nat_lb_own_get. Qed. End mono_nat. iris-iris-4.2.0/iris/base_logic/lib/na_invariants.v000066400000000000000000000111051460620107300222520ustar00rootroot00000000000000From iris.algebra Require Import gset coPset. From iris.proofmode Require Import proofmode. From iris.base_logic.lib Require Export invariants. From iris.prelude Require Import options. Import uPred. (* Non-atomic ("thread-local") invariants. *) Definition na_inv_pool_name := gname. Class na_invG Σ := na_inv_inG : inG Σ (prodR coPset_disjR (gset_disjR positive)). Local Existing Instance na_inv_inG. Definition na_invΣ : gFunctors := #[ GFunctor (constRF (prodR coPset_disjR (gset_disjR positive))) ]. Global Instance subG_na_invG {Σ} : subG na_invΣ Σ → na_invG Σ. Proof. solve_inG. Qed. Section defs. Context `{!invGS_gen hlc Σ, !na_invG Σ}. Definition na_own (p : na_inv_pool_name) (E : coPset) : iProp Σ := own p (CoPset E, GSet ∅). Definition na_inv (p : na_inv_pool_name) (N : namespace) (P : iProp Σ) : iProp Σ := ∃ i, ⌜i ∈ (↑N:coPset)⌝ ∧ inv N (P ∗ own p (ε, GSet {[i]}) ∨ na_own p {[i]}). End defs. Global Instance: Params (@na_inv) 3 := {}. Global Typeclasses Opaque na_own na_inv. Section proofs. Context `{!invGS_gen hlc Σ, !na_invG Σ}. Global Instance na_own_timeless p E : Timeless (na_own p E). Proof. rewrite /na_own; apply _. Qed. Global Instance na_inv_ne p N : NonExpansive (na_inv p N). Proof. rewrite /na_inv. solve_proper. Qed. Global Instance na_inv_proper p N : Proper ((≡) ==> (≡)) (na_inv p N). Proof. apply (ne_proper _). Qed. Global Instance na_inv_persistent p N P : Persistent (na_inv p N P). Proof. rewrite /na_inv; apply _. Qed. Lemma na_inv_iff p N P Q : na_inv p N P -∗ ▷ □ (P ↔ Q) -∗ na_inv p N Q. Proof. rewrite /na_inv. iIntros "(%i & % & HI) #HPQ". iExists i. iSplit; first done. iApply (inv_iff with "HI"). iIntros "!> !>". iSplit; iIntros "[[? Ho]|$]"; iLeft; iFrame "Ho"; by iApply "HPQ". Qed. Lemma na_alloc : ⊢ |==> ∃ p, na_own p ⊤. Proof. by apply own_alloc. Qed. Lemma na_own_disjoint p E1 E2 : na_own p E1 -∗ na_own p E2 -∗ ⌜E1 ## E2⌝. Proof. iApply wand_intro_r. rewrite /na_own -own_op own_valid -coPset_disj_valid_op. by iIntros ([? _]). Qed. Lemma na_own_union p E1 E2 : E1 ## E2 → na_own p (E1 ∪ E2) ⊣⊢ na_own p E1 ∗ na_own p E2. Proof. intros ?. by rewrite /na_own -own_op -pair_op left_id coPset_disj_union. Qed. Lemma na_own_acc E2 E1 tid : E2 ⊆ E1 → na_own tid E1 -∗ na_own tid E2 ∗ (na_own tid E2 -∗ na_own tid E1). Proof. intros HF. assert (E1 = E2 ∪ (E1 ∖ E2)) as -> by exact: union_difference_L. rewrite na_own_union; last by set_solver+. iIntros "[$ $]". auto. Qed. Lemma na_inv_alloc p E N P : ▷ P ={E}=∗ na_inv p N P. Proof. iIntros "HP". iMod (own_unit (prodUR coPset_disjUR (gset_disjUR positive)) p) as "Hempty". iMod (own_updateP with "Hempty") as ([m1 m2]) "[Hm Hown]". { apply prod_updateP'. - apply cmra_updateP_id, (reflexivity (R:=eq)). - apply (gset_disj_alloc_empty_updateP_strong' (λ i, i ∈ (↑N:coPset)))=> Ef. apply fresh_inv_name. } simpl. iDestruct "Hm" as %(<- & i & -> & ?). rewrite /na_inv. iMod (inv_alloc N with "[-]"); last (iModIntro; iExists i; eauto). iNext. iLeft. by iFrame. Qed. Lemma na_inv_acc p E F N P : ↑N ⊆ E → ↑N ⊆ F → na_inv p N P -∗ na_own p F ={E}=∗ ▷ P ∗ na_own p (F∖↑N) ∗ (▷ P ∗ na_own p (F∖↑N) ={E}=∗ na_own p F). Proof. rewrite /na_inv. iIntros (??) "#(%i & % & Hinv) Htoks". 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 "Hinv" as "[[$ >Hdis]|>Htoki2]" "Hclose". - iMod ("Hclose" with "[Htoki]") as "_"; first auto. iIntros "!> [HP $]". iInv N as "[[_ >Hdis2]|>Hitok]". + iCombine "Hdis Hdis2" gives %[_ Hval%gset_disj_valid_op]. set_solver. + 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_acc with "Hinv"); done. Qed. End proofs. iris-iris-4.2.0/iris/base_logic/lib/own.v000066400000000000000000000432451460620107300202330ustar00rootroot00000000000000From iris.algebra Require Import functions gmap proofmode_classes. From iris.proofmode Require Import proofmode. From iris.base_logic.lib Require Export iprop. From iris.prelude Require Import options. Import uPred. (** The class [inG Σ A] expresses that the CMRA [A] is in the list of functors [Σ]. This class is similar to the [subG] class, but written down in terms of individual CMRAs instead of (lists of) CMRA *functors*. This additional class is needed because Coq is otherwise unable to solve type class constraints due to higher-order unification problems. *) Class inG (Σ : gFunctors) (A : cmra) := InG { inG_id : gid Σ; inG_apply := rFunctor_apply (gFunctors_lookup Σ inG_id); inG_prf : A = inG_apply (iPropO Σ) _; }. Global Arguments inG_id {_ _} _. Global Arguments inG_apply {_ _} _ _ {_}. (** We use the mode [-] for [Σ] since there is always a unique [Σ]. We use the mode [!] for [A] since we can have multiple [inG]s for different [A]s, so we do not want Coq to pick one arbitrarily. *) Global Hint Mode inG - ! : typeclass_instances. Lemma subG_inG Σ (F : gFunctor) : subG F Σ → inG Σ (rFunctor_apply F (iPropO Σ)). Proof. move=> /(_ 0%fin) /= [j ->]. by exists j. Qed. (** This tactic solves the usual obligations "subG ? Σ → {in,?}G ? Σ" *) Ltac solve_inG := (* Get all assumptions *) intros; (* Unfold the top-level xΣ. We need to support this to be a function. *) lazymatch goal with | H : subG (?xΣ _ _ _ _) _ |- _ => try unfold xΣ in H | H : subG (?xΣ _ _ _) _ |- _ => try unfold xΣ in H | H : subG (?xΣ _ _) _ |- _ => try unfold xΣ in H | H : subG (?xΣ _) _ |- _ => try unfold xΣ in H | H : subG ?xΣ _ |- _ => try unfold xΣ in H end; (* Take apart subG for non-"atomic" lists *) repeat match goal with | H : subG (gFunctors.app _ _) _ |- _ => apply subG_inv in H; destruct H end; (* Try to turn singleton subG into inG; but also keep the subG for typeclass resolution -- to keep them, we put them onto the goal. *) repeat match goal with | H : subG _ _ |- _ => move:(H); (apply subG_inG in H || clear H) end; (* Again get all assumptions and simplify the functors *) intros; simpl in *; (* We support two kinds of goals: Things convertible to inG; and records with inG and typeclass fields. Try to solve the first case. *) try assumption; (* That didn't work, now we're in for the second case. *) split; (assumption || by apply _). (** * Definition of the connective [own] *) Local Definition inG_unfold {Σ A} {i : inG Σ A} : inG_apply i (iPropO Σ) -n> inG_apply i (iPrePropO Σ) := rFunctor_map _ (iProp_fold, iProp_unfold). Local Definition inG_fold {Σ A} {i : inG Σ A} : inG_apply i (iPrePropO Σ) -n> inG_apply i (iPropO Σ) := rFunctor_map _ (iProp_unfold, iProp_fold). Local Definition iRes_singleton {Σ A} {i : inG Σ A} (γ : gname) (a : A) : iResUR Σ := discrete_fun_singleton (inG_id i) {[ γ := inG_unfold (cmra_transport inG_prf a) ]}. Global Instance: Params (@iRes_singleton) 4 := {}. Local Definition own_def `{!inG Σ A} (γ : gname) (a : A) : iProp Σ := uPred_ownM (iRes_singleton γ a). Local Definition own_aux : seal (@own_def). Proof. by eexists. Qed. Definition own := own_aux.(unseal). Global Arguments own {Σ A _} γ a. Local Definition own_eq : @own = @own_def := own_aux.(seal_eq). Local Instance: Params (@own) 4 := {}. (** * Properties about ghost ownership *) Section global. Context `{i : !inG Σ A}. Implicit Types a : A. (** ** Properties of [iRes_singleton] *) Local Lemma inG_unfold_fold (x : inG_apply i (iPrePropO Σ)) : inG_unfold (inG_fold x) ≡ x. Proof. rewrite /inG_unfold /inG_fold -rFunctor_map_compose -{2}[x]rFunctor_map_id. apply (ne_proper (rFunctor_map _)); split=> ?; apply iProp_unfold_fold. Qed. Local Lemma inG_fold_unfold (x : inG_apply i (iPropO Σ)) : inG_fold (inG_unfold x) ≡ x. Proof. rewrite /inG_unfold /inG_fold -rFunctor_map_compose -{2}[x]rFunctor_map_id. apply (ne_proper (rFunctor_map _)); split=> ?; apply iProp_fold_unfold. Qed. Local Lemma inG_unfold_validN n (x : inG_apply i (iPropO Σ)) : ✓{n} (inG_unfold x) ↔ ✓{n} x. Proof. split; [|apply (cmra_morphism_validN _)]. move=> /(cmra_morphism_validN inG_fold). by rewrite inG_fold_unfold. Qed. Local Instance iRes_singleton_ne γ : NonExpansive (@iRes_singleton Σ A _ γ). Proof. by intros n a a' Ha; apply discrete_fun_singleton_ne; rewrite Ha. Qed. Local Lemma iRes_singleton_validI γ a : ✓ (iRes_singleton γ a) ⊢@{iPropI Σ} ✓ a. Proof. rewrite /iRes_singleton. rewrite discrete_fun_validI (forall_elim (inG_id i)) discrete_fun_lookup_singleton. rewrite singleton_validI. trans (✓ cmra_transport inG_prf a : iProp Σ)%I; last by destruct inG_prf. apply valid_entails=> n. apply inG_unfold_validN. Qed. Local Lemma iRes_singleton_op γ a1 a2 : iRes_singleton γ (a1 ⋅ a2) ≡ iRes_singleton γ a1 ⋅ iRes_singleton γ a2. Proof. rewrite /iRes_singleton discrete_fun_singleton_op singleton_op cmra_transport_op. f_equiv. apply: singletonM_proper. apply (cmra_morphism_op _). Qed. Local Instance iRes_singleton_discrete γ a : Discrete a → Discrete (iRes_singleton γ a). Proof. intros ?. rewrite /iRes_singleton. apply discrete_fun_singleton_discrete, gmap_singleton_discrete; [apply _|]. intros x Hx. assert (cmra_transport inG_prf a ≡ inG_fold x) as Ha. { apply (discrete_0 _). by rewrite -Hx inG_fold_unfold. } by rewrite Ha inG_unfold_fold. Qed. Local Instance iRes_singleton_core_id γ a : CoreId a → CoreId (iRes_singleton γ a). Proof. intros. apply discrete_fun_singleton_core_id, gmap_singleton_core_id. by rewrite /CoreId -cmra_morphism_pcore core_id. Qed. Local Lemma later_internal_eq_iRes_singleton γ a r : ▷ (r ≡ iRes_singleton γ a) ⊢@{iPropI Σ} ◇ ∃ b r', r ≡ iRes_singleton γ b ⋅ r' ∧ ▷ (a ≡ b). Proof. assert (NonExpansive (λ r : iResUR Σ, r (inG_id i) !! γ)). { intros n r1 r2 Hr. f_equiv. by specialize (Hr (inG_id i)). } rewrite (f_equivI (λ r : iResUR Σ, r (inG_id i) !! γ) r). rewrite {1}/iRes_singleton discrete_fun_lookup_singleton lookup_singleton. rewrite option_equivI. case Hb: (r (inG_id _) !! γ)=> [b|]; last first. { by rewrite /bi_except_0 -or_intro_l. } rewrite -except_0_intro. rewrite -(exist_intro (cmra_transport (eq_sym inG_prf) (inG_fold b))). rewrite -(exist_intro (discrete_fun_insert (inG_id _) (delete γ (r (inG_id i))) r)). apply and_intro. - apply equiv_internal_eq. rewrite /iRes_singleton. rewrite cmra_transport_trans eq_trans_sym_inv_l /=. intros i'. rewrite discrete_fun_lookup_op. destruct (decide (i' = inG_id i)) as [->|?]. + rewrite discrete_fun_lookup_insert discrete_fun_lookup_singleton. intros γ'. rewrite lookup_op. destruct (decide (γ' = γ)) as [->|?]. * by rewrite lookup_singleton lookup_delete Hb inG_unfold_fold. * by rewrite lookup_singleton_ne // lookup_delete_ne // left_id. + rewrite discrete_fun_lookup_insert_ne //. by rewrite discrete_fun_lookup_singleton_ne // left_id. - apply later_mono. rewrite (f_equivI inG_fold) inG_fold_unfold. apply: (internal_eq_rewrite' _ _ (λ b, a ≡ cmra_transport (eq_sym inG_prf) b)%I); [solve_proper|apply internal_eq_sym|]. rewrite cmra_transport_trans eq_trans_sym_inv_r /=. apply internal_eq_refl. Qed. (** ** Properties of [own] *) Global Instance own_ne γ : NonExpansive (@own Σ A _ γ). Proof. rewrite !own_eq. solve_proper. Qed. Global Instance own_proper γ : Proper ((≡) ==> (⊣⊢)) (@own Σ A _ γ) := ne_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 ->]. by rewrite own_op sep_elim_l. Qed. Global Instance own_mono' γ : Proper (flip (≼) ==> (⊢)) (@own Σ A _ γ). Proof. intros a1 a2. apply own_mono. Qed. Lemma own_valid γ a : own γ a ⊢ ✓ a. Proof. by rewrite !own_eq /own_def ownM_valid iRes_singleton_validI. Qed. Lemma own_valid_2 γ a1 a2 : own γ a1 -∗ own γ a2 -∗ ✓ (a1 ⋅ a2). Proof. apply entails_wand, 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. apply entails_wand. 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: 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. Global Instance own_timeless γ a : Discrete a → Timeless (own γ a). Proof. rewrite !own_eq /own_def. apply _. Qed. Global Instance own_core_persistent γ a : CoreId a → Persistent (own γ a). Proof. rewrite !own_eq /own_def; apply _. Qed. Lemma later_own γ a : ▷ own γ a ⊢ ◇ ∃ b, own γ b ∧ ▷ (a ≡ b). Proof. rewrite own_eq /own_def later_ownM. apply exist_elim=> r. assert (NonExpansive (λ r : iResUR Σ, r (inG_id i) !! γ)). { intros n r1 r2 Hr. f_equiv. by specialize (Hr (inG_id i)). } rewrite internal_eq_sym later_internal_eq_iRes_singleton. rewrite (except_0_intro (uPred_ownM r)) -except_0_and. f_equiv. rewrite and_exist_l. f_equiv=> b. rewrite and_exist_l. apply exist_elim=> r'. rewrite assoc. apply and_mono_l. etrans; [|apply ownM_mono, (cmra_included_l _ r')]. eapply (internal_eq_rewrite' _ _ uPred_ownM _); [apply and_elim_r|]. apply and_elim_l. Qed. (** ** Allocation *) (* TODO: This also holds if we just have ✓ a at the current step-idx, as Iris assertion. However, the map_updateP_alloc does not suffice to show this. *) Lemma own_alloc_strong_dep (f : gname → A) (P : gname → Prop) : pred_infinite P → (∀ γ, P γ → ✓ (f γ)) → ⊢ |==> ∃ γ, ⌜P γ⌝ ∗ own γ (f γ). Proof. intros HPinf Hf. rewrite -(bupd_mono (∃ m, ⌜∃ γ, P γ ∧ m = iRes_singleton γ (f γ)⌝ ∧ uPred_ownM m)%I). - rewrite /bi_emp_valid (ownM_unit emp). apply bupd_ownM_updateP, (discrete_fun_singleton_updateP_empty _ (λ m, ∃ γ, m = {[ γ := inG_unfold (cmra_transport inG_prf (f γ)) ]} ∧ P γ)); [|naive_solver]. apply (alloc_updateP_strong_dep _ P _ (λ γ, inG_unfold (cmra_transport inG_prf (f γ)))); [done| |naive_solver]. intros γ _ ?. by apply (cmra_morphism_valid inG_unfold), cmra_transport_valid, Hf. - apply exist_elim=>m; apply pure_elim_l=>-[γ [Hfresh ->]]. by rewrite !own_eq /own_def -(exist_intro γ) pure_True // left_id. Qed. Lemma own_alloc_cofinite_dep (f : gname → A) (G : gset gname) : (∀ γ, γ ∉ G → ✓ (f γ)) → ⊢ |==> ∃ γ, ⌜γ ∉ G⌝ ∗ own γ (f γ). Proof. intros Ha. apply (own_alloc_strong_dep f (λ γ, γ ∉ G))=> //. apply (pred_infinite_set (C:=gset gname)). intros E. set (γ := fresh (G ∪ E)). exists γ. apply not_elem_of_union, is_fresh. Qed. Lemma own_alloc_dep (f : gname → A) : (∀ γ, ✓ (f γ)) → ⊢ |==> ∃ γ, own γ (f γ). Proof. intros Ha. rewrite /bi_emp_valid (own_alloc_cofinite_dep f ∅) //; []. apply bupd_mono, exist_mono=>?. apply: sep_elim_r. Qed. Lemma own_alloc_strong a (P : gname → Prop) : pred_infinite P → ✓ a → ⊢ |==> ∃ γ, ⌜P γ⌝ ∗ own γ a. Proof. intros HP Ha. eapply (own_alloc_strong_dep (λ _, a)); eauto. Qed. Lemma own_alloc_cofinite a (G : gset gname) : ✓ a → ⊢ |==> ∃ γ, ⌜γ ∉ G⌝ ∗ own γ a. Proof. intros Ha. eapply (own_alloc_cofinite_dep (λ _, a)); eauto. Qed. Lemma own_alloc a : ✓ a → ⊢ |==> ∃ γ, own γ a. Proof. intros Ha. eapply (own_alloc_dep (λ _, a)); eauto. Qed. (** ** Frame preserving updates *) Lemma own_updateP P γ a : a ~~>: P → own γ a ⊢ |==> ∃ a', ⌜P a'⌝ ∗ own γ a'. Proof. intros Hupd. rewrite !own_eq. rewrite -(bupd_mono (∃ m, ⌜ ∃ a', m = iRes_singleton γ a' ∧ P a' ⌝ ∧ uPred_ownM m)%I). - apply bupd_ownM_updateP, (discrete_fun_singleton_updateP _ (λ m, ∃ x, m = {[ γ := x ]} ∧ ∃ x', x = inG_unfold x' ∧ ∃ a', x' = cmra_transport inG_prf a' ∧ P a')); [|naive_solver]. apply singleton_updateP', (iso_cmra_updateP' inG_fold). { apply inG_unfold_fold. } { apply (cmra_morphism_op _). } { apply inG_unfold_validN. } by apply cmra_transport_updateP'. - apply exist_elim=> m; apply pure_elim_l=> -[a' [-> HP]]. rewrite -(exist_intro a'). rewrite -persistent_and_sep. by apply and_intro; [apply pure_intro|]. Qed. Lemma own_update γ a a' : a ~~> a' → own γ a ⊢ |==> own γ a'. Proof. intros. iIntros "?". iMod (own_updateP (a' =.) with "[$]") as (a'') "[-> $]". { by apply cmra_update_updateP. } done. Qed. Lemma own_update_2 γ a1 a2 a' : a1 ⋅ a2 ~~> a' → own γ a1 -∗ own γ a2 ==∗ own γ a'. Proof. intros. apply entails_wand, wand_intro_r. rewrite -own_op. by iApply own_update. Qed. Lemma own_update_3 γ a1 a2 a3 a' : a1 ⋅ a2 ⋅ a3 ~~> a' → own γ a1 -∗ own γ a2 -∗ own γ a3 ==∗ own γ a'. Proof. intros. apply entails_wand. do 2 apply wand_intro_r. rewrite -!own_op. by iApply own_update. Qed. End global. Global Arguments own_valid {_ _} [_] _ _. Global Arguments own_valid_2 {_ _} [_] _ _ _. Global Arguments own_valid_3 {_ _} [_] _ _ _ _. Global Arguments own_valid_l {_ _} [_] _ _. Global Arguments own_valid_r {_ _} [_] _ _. Global Arguments own_updateP {_ _} [_] _ _ _ _. Global Arguments own_update {_ _} [_] _ _ _ _. Global Arguments own_update_2 {_ _} [_] _ _ _ _ _. Global Arguments own_update_3 {_ _} [_] _ _ _ _ _ _. Lemma own_unit A `{i : !inG Σ (A:ucmra)} γ : ⊢ |==> own γ (ε:A). Proof. rewrite /bi_emp_valid (ownM_unit emp) !own_eq /own_def. apply bupd_ownM_update, discrete_fun_singleton_update_empty. apply (alloc_unit_singleton_update (inG_unfold (cmra_transport inG_prf ε))). - apply (cmra_morphism_valid _), cmra_transport_valid, ucmra_unit_valid. - intros x. rewrite -(inG_unfold_fold x) -(cmra_morphism_op inG_unfold). f_equiv. generalize (inG_fold x)=> x'. destruct inG_prf=> /=. by rewrite left_id. - done. Qed. (** Big op class instances *) Section big_op_instances. Context `{!inG Σ (A:ucmra)}. Global Instance own_cmra_sep_homomorphism γ : WeakMonoidHomomorphism op uPred_sep (≡) (own γ). Proof. split; try apply _. apply own_op. Qed. Lemma big_opL_own {B} γ (f : nat → B → A) (l : list B) : l ≠ [] → own γ ([^op list] k↦x ∈ l, f k x) ⊣⊢ [∗ list] k↦x ∈ l, own γ (f k x). Proof. apply (big_opL_commute1 _). Qed. Lemma big_opM_own `{Countable K} {B} γ (g : K → B → A) (m : gmap K B) : m ≠ ∅ → own γ ([^op map] k↦x ∈ m, g k x) ⊣⊢ [∗ map] k↦x ∈ m, own γ (g k x). Proof. apply (big_opM_commute1 _). Qed. Lemma big_opS_own `{Countable B} γ (g : B → A) (X : gset B) : X ≠ ∅ → own γ ([^op set] x ∈ X, g x) ⊣⊢ [∗ set] x ∈ X, own γ (g x). Proof. apply (big_opS_commute1 _). Qed. Lemma big_opMS_own `{Countable B} γ (g : B → A) (X : gmultiset B) : X ≠ ∅ → own γ ([^op mset] x ∈ X, g x) ⊣⊢ [∗ mset] x ∈ X, own γ (g x). Proof. apply (big_opMS_commute1 _). Qed. Global Instance own_cmra_sep_entails_homomorphism γ : MonoidHomomorphism op uPred_sep (⊢) (own γ). Proof. split; [split|]; try apply _. - intros. by rewrite own_op. - apply (affine _). Qed. Lemma big_opL_own_1 {B} γ (f : nat → B → A) (l : list B) : own γ ([^op list] k↦x ∈ l, f k x) ⊢ [∗ list] k↦x ∈ l, own γ (f k x). Proof. apply (big_opL_commute _). Qed. Lemma big_opM_own_1 `{Countable K} {B} γ (g : K → B → A) (m : gmap K B) : own γ ([^op map] k↦x ∈ m, g k x) ⊢ [∗ map] k↦x ∈ m, own γ (g k x). Proof. apply (big_opM_commute _). Qed. Lemma big_opS_own_1 `{Countable B} γ (g : B → A) (X : gset B) : own γ ([^op set] x ∈ X, g x) ⊢ [∗ set] x ∈ X, own γ (g x). Proof. apply (big_opS_commute _). Qed. Lemma big_opMS_own_1 `{Countable B} γ (g : B → A) (X : gmultiset B) : own γ ([^op mset] x ∈ X, g x) ⊢ [∗ mset] x ∈ X, own γ (g x). Proof. apply (big_opMS_commute _). Qed. End big_op_instances. (** Proofmode class instances *) Section proofmode_instances. 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. 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. (* TODO: Improve this instance with generic own simplification machinery once https://gitlab.mpi-sws.org/iris/iris/-/issues/460 is fixed *) (* Cost > 50 to give priority to [combine_sep_as_fractional]. *) Global Instance combine_sep_as_own γ a b1 b2 : IsOp a b1 b2 → CombineSepAs (own γ b1) (own γ b2) (own γ a) | 60. Proof. intros. by rewrite /CombineSepAs -own_op -is_op. Qed. (* TODO: Improve this instance with generic own validity simplification machinery once https://gitlab.mpi-sws.org/iris/iris/-/issues/460 is fixed *) Global Instance combine_sep_gives_own γ b1 b2 : CombineSepGives (own γ b1) (own γ b2) (✓ (b1 ⋅ b2)). Proof. intros. rewrite /CombineSepGives -own_op own_valid. by apply: bi.persistently_intro. Qed. Global Instance from_and_own_persistent γ a b1 b2 : IsOp a b1 b2 → TCOr (CoreId b1) (CoreId b2) → FromAnd (own γ a) (own γ b1) (own γ b2). Proof. intros ? Hb. rewrite /FromAnd (is_op a) own_op. destruct Hb; by rewrite persistent_and_sep. Qed. End proofmode_instances. iris-iris-4.2.0/iris/base_logic/lib/proph_map.v000066400000000000000000000116621460620107300214130ustar00rootroot00000000000000From iris.proofmode Require Import proofmode. From iris.base_logic.lib Require Export own. From iris.base_logic.lib Require Import ghost_map. From iris.prelude Require Import options. Import uPred. Local Notation proph_map P V := (gmap P (list V)). Definition proph_val_list (P V : Type) := list (P * V). (** The CMRA we need. *) Class proph_mapGpreS (P V : Type) (Σ : gFunctors) `{Countable P} := { proph_map_GpreS_inG : ghost_mapG Σ P (list V) }. Local Existing Instances proph_map_GpreS_inG. Class proph_mapGS (P V : Type) (Σ : gFunctors) `{Countable P} := ProphMapGS { proph_map_inG : proph_mapGpreS P V Σ; proph_map_name : gname }. Global Arguments proph_map_name {_ _ _ _ _} _ : assert. Local Existing Instances proph_map_inG. Definition proph_mapΣ (P V : Type) `{Countable P} : gFunctors := #[ghost_mapΣ P (list V)]. Global Instance subG_proph_mapGpreS {Σ P V} `{Countable P} : subG (proph_mapΣ P V) Σ → proph_mapGpreS P V Σ. Proof. solve_inG. Qed. Section definitions. Context `{pG : proph_mapGS P V Σ}. Implicit Types pvs : proph_val_list P V. Implicit Types R : proph_map P V. Implicit Types p : P. (** The list of resolves for [p] in [pvs]. *) Fixpoint proph_list_resolves pvs p : list V := match pvs with | [] => [] | (q,v)::pvs => if decide (p = q) then v :: proph_list_resolves pvs p else proph_list_resolves pvs p end. Definition proph_resolves_in_list R pvs := map_Forall (λ p vs, vs = proph_list_resolves pvs p) R. Definition proph_map_interp pvs (ps : gset P) : iProp Σ := ∃ R, ⌜proph_resolves_in_list R pvs ∧ dom R ⊆ ps⌝ ∗ ghost_map_auth (proph_map_name pG) 1 R. Local Definition proph_def (p : P) (vs : list V) : iProp Σ := p ↪[proph_map_name pG] vs. Local Definition proph_aux : seal (@proph_def). Proof. by eexists. Qed. Definition proph := proph_aux.(unseal). Local Definition proph_unseal : @proph = @proph_def := proph_aux.(seal_eq). End definitions. Section list_resolves. Context {P V : Type} `{Countable P}. Implicit Type pvs : proph_val_list P V. Implicit Type p : P. Implicit Type R : proph_map P V. Lemma resolves_insert pvs p R : proph_resolves_in_list R pvs → p ∉ dom R → proph_resolves_in_list (<[p := proph_list_resolves pvs p]> R) pvs. Proof. intros Hinlist Hp q vs HEq. destruct (decide (p = q)) as [->|NEq]. - rewrite lookup_insert in HEq. by inversion HEq. - rewrite lookup_insert_ne in HEq; last done. by apply Hinlist. Qed. End list_resolves. Lemma proph_map_init `{Countable P, !proph_mapGpreS P V Σ} pvs ps : ⊢ |==> ∃ _ : proph_mapGS P V Σ, proph_map_interp pvs ps. Proof. iMod (ghost_map_alloc_empty) as (γ) "Hh". iModIntro. iExists (ProphMapGS P V _ _ _ _ γ), ∅. iSplit; last by iFrame. iPureIntro. done. Qed. Section proph_map. Context `{proph_mapGS P V Σ}. Implicit Types p : P. Implicit Types v : V. Implicit Types vs : list V. Implicit Types R : proph_map P V. Implicit Types ps : gset P. (** General properties of pointsto *) Global Instance proph_timeless p vs : Timeless (proph p vs). Proof. rewrite proph_unseal /proph_def. apply _. Qed. Lemma proph_exclusive p vs1 vs2 : proph p vs1 -∗ proph p vs2 -∗ False. Proof. rewrite proph_unseal /proph_def. iIntros "Hp1 Hp2". by iDestruct (ghost_map_elem_ne with "Hp1 Hp2") as %?. Qed. Lemma proph_map_new_proph p ps pvs : p ∉ ps → proph_map_interp pvs ps ==∗ proph_map_interp pvs ({[p]} ∪ ps) ∗ proph p (proph_list_resolves pvs p). Proof. iIntros (Hp) "HR". iDestruct "HR" as (R) "[[% %] H●]". rewrite proph_unseal /proph_def. iMod (ghost_map_insert p (proph_list_resolves pvs p) with "H●") as "[H● H◯]". { apply not_elem_of_dom. set_solver. } iFrame. iPureIntro. split. - apply resolves_insert; first done. set_solver. - rewrite dom_insert. set_solver. Qed. Lemma proph_map_resolve_proph p v pvs ps vs : proph_map_interp ((p,v) :: pvs) ps ∗ proph p vs ==∗ ∃vs', ⌜vs = v::vs'⌝ ∗ proph_map_interp pvs ps ∗ proph p vs'. Proof. iIntros "[HR Hp]". iDestruct "HR" as (R) "[HP H●]". iDestruct "HP" as %[Hres Hdom]. rewrite /proph_map_interp proph_unseal /proph_def. iCombine "H● Hp" gives %HR. assert (vs = v :: proph_list_resolves pvs p) as ->. { rewrite (Hres p vs HR). simpl. by rewrite decide_True. } iMod (ghost_map_update (proph_list_resolves pvs p) with "H● Hp") as "[H● H◯]". iModIntro. iExists (proph_list_resolves pvs p). iFrame. iSplitR. - iPureIntro. done. - iPureIntro. split. + intros q ws HEq. destruct (decide (p = q)) as [<-|NEq]. * rewrite lookup_insert in HEq. by inversion HEq. * rewrite lookup_insert_ne in HEq; last done. rewrite (Hres q ws HEq). simpl. rewrite decide_False; done. + assert (p ∈ dom R) by exact: elem_of_dom_2. rewrite dom_insert. set_solver. Qed. End proph_map. iris-iris-4.2.0/iris/base_logic/lib/saved_prop.v000066400000000000000000000305761460620107300215750ustar00rootroot00000000000000From stdpp Require Import gmap. From iris.algebra Require Import dfrac_agree. From iris.proofmode Require Import proofmode. From iris.base_logic Require Export own. From iris.bi Require Import fractional. From iris.prelude Require Import options. Import uPred. (* "Saved anything" -- this can give you saved propositions, saved predicates, saved whatever-you-like. *) Class savedAnythingG (Σ : gFunctors) (F : oFunctor) := SavedAnythingG { saved_anything_inG : inG Σ (dfrac_agreeR (oFunctor_apply F (iPropO Σ))); saved_anything_contractive : oFunctorContractive F (* NOT an instance to avoid cycles with [subG_savedAnythingΣ]. *) }. Local Existing Instance saved_anything_inG. Definition savedAnythingΣ (F : oFunctor) `{!oFunctorContractive F} : gFunctors := #[ GFunctor (dfrac_agreeRF F) ]. Global Instance subG_savedAnythingΣ {Σ F} `{!oFunctorContractive F} : subG (savedAnythingΣ F) Σ → savedAnythingG Σ F. Proof. solve_inG. Qed. Definition saved_anything_own `{!savedAnythingG Σ F} (γ : gname) (dq : dfrac) (x : oFunctor_apply F (iPropO Σ)) : iProp Σ := own γ (to_dfrac_agree dq x). Global Typeclasses Opaque saved_anything_own. Global Instance: Params (@saved_anything_own) 4 := {}. Section saved_anything. Context `{!savedAnythingG Σ F}. Implicit Types x y : oFunctor_apply F (iPropO Σ). Implicit Types (γ : gname) (dq : dfrac). Global Instance saved_anything_discarded_persistent γ x : Persistent (saved_anything_own γ DfracDiscarded x). Proof. rewrite /saved_anything_own; apply _. Qed. Global Instance saved_anything_ne γ dq : NonExpansive (saved_anything_own γ dq). Proof. solve_proper. Qed. Global Instance saved_anything_proper γ dq : Proper ((≡) ==> (≡)) (saved_anything_own γ dq). Proof. solve_proper. Qed. Global Instance saved_anything_fractional γ x : Fractional (λ q, saved_anything_own γ (DfracOwn q) x). Proof. intros q1 q2. rewrite /saved_anything_own -own_op -dfrac_agree_op //. Qed. Global Instance saved_anything_as_fractional γ x q : AsFractional (saved_anything_own γ (DfracOwn q) x) (λ q, saved_anything_own γ (DfracOwn q) x) q. Proof. split; [done|]. apply _. Qed. (** Allocation *) Lemma saved_anything_alloc_strong x (I : gname → Prop) dq : ✓ dq → pred_infinite I → ⊢ |==> ∃ γ, ⌜I γ⌝ ∗ saved_anything_own γ dq x. Proof. intros ??. by apply own_alloc_strong. Qed. Lemma saved_anything_alloc_cofinite x (G : gset gname) dq : ✓ dq → ⊢ |==> ∃ γ, ⌜γ ∉ G⌝ ∗ saved_anything_own γ dq x. Proof. intros ?. by apply own_alloc_cofinite. Qed. Lemma saved_anything_alloc x dq : ✓ dq → ⊢ |==> ∃ γ, saved_anything_own γ dq x. Proof. intros ?. by apply own_alloc. Qed. (** Validity *) Lemma saved_anything_valid γ dq x : saved_anything_own γ dq x -∗ ⌜✓ dq⌝. Proof. rewrite /saved_anything_own own_valid dfrac_agree_validI //. eauto. Qed. Lemma saved_anything_valid_2 γ dq1 dq2 x y : saved_anything_own γ dq1 x -∗ saved_anything_own γ dq2 y -∗ ⌜✓ (dq1 ⋅ dq2)⌝ ∗ x ≡ y. Proof. iIntros "Hx Hy". rewrite /saved_anything_own. iCombine "Hx Hy" gives "Hv". rewrite dfrac_agree_validI_2. iDestruct "Hv" as "[$ $]". Qed. Lemma saved_anything_agree γ dq1 dq2 x y : saved_anything_own γ dq1 x -∗ saved_anything_own γ dq2 y -∗ x ≡ y. Proof. iIntros "Hx Hy". iPoseProof (saved_anything_valid_2 with "Hx Hy") as "[_ $]". Qed. Global Instance saved_anything_combine_gives γ dq1 dq2 x y : CombineSepGives (saved_anything_own γ dq1 x) (saved_anything_own γ dq2 y) (⌜✓ (dq1 ⋅ dq2)⌝ ∗ x ≡ y). Proof. rewrite /CombineSepGives. iIntros "[Hx Hy]". iPoseProof (saved_anything_valid_2 with "Hx Hy") as "[% #$]". eauto. Qed. Global Instance saved_anything_combine_as γ dq1 dq2 x y : CombineSepAs (saved_anything_own γ dq1 x) (saved_anything_own γ dq2 y) (saved_anything_own γ (dq1 ⋅ dq2) x). (* higher cost than the Fractional instance, which kicks in for #qs *) Proof. rewrite /CombineSepAs. iIntros "[Hx Hy]". iCombine "Hx Hy" gives "[_ #H]". iRewrite -"H" in "Hy". rewrite /saved_anything_own. iCombine "Hx Hy" as "Hxy". by rewrite -dfrac_agree_op. Qed. (** Make an element read-only. *) Lemma saved_anything_persist γ dq v : saved_anything_own γ dq v ==∗ saved_anything_own γ DfracDiscarded v. Proof. iApply own_update. apply dfrac_agree_persist. Qed. (** Recover fractional ownership for read-only element. *) Lemma saved_anything_unpersist γ v : saved_anything_own γ DfracDiscarded v ==∗ ∃ q, saved_anything_own γ (DfracOwn q) v. Proof. iIntros "H". iMod (own_updateP with "H") as "H"; first by apply dfrac_agree_unpersist. iDestruct "H" as (? (q&->)) "H". iIntros "!>". iExists q. done. Qed. (** Updates *) Lemma saved_anything_update y γ x : saved_anything_own γ (DfracOwn 1) x ==∗ saved_anything_own γ (DfracOwn 1) y. Proof. iApply own_update. apply cmra_update_exclusive. done. Qed. Lemma saved_anything_update_2 y γ q1 q2 x1 x2 : (q1 + q2 = 1)%Qp → saved_anything_own γ (DfracOwn q1) x1 -∗ saved_anything_own γ (DfracOwn q2) x2 ==∗ saved_anything_own γ (DfracOwn q1) y ∗ saved_anything_own γ (DfracOwn q2) y. Proof. intros Hq. rewrite -own_op. iApply own_update_2. apply dfrac_agree_update_2. rewrite dfrac_op_own Hq //. Qed. Lemma saved_anything_update_halves y γ x1 x2 : saved_anything_own γ (DfracOwn (1/2)) x1 -∗ saved_anything_own γ (DfracOwn (1/2)) x2 ==∗ saved_anything_own γ (DfracOwn (1/2)) y ∗ saved_anything_own γ (DfracOwn (1/2)) y. Proof. iApply saved_anything_update_2. apply Qp.half_half. Qed. End saved_anything. (** Provide specialized versions of this for convenience. **) (* Saved propositions. *) Notation savedPropG Σ := (savedAnythingG Σ (▶ ∙)). Notation savedPropΣ := (savedAnythingΣ (▶ ∙)). Section saved_prop. Context `{!savedPropG Σ}. Definition saved_prop_own (γ : gname) (dq : dfrac) (P: iProp Σ) := saved_anything_own (F := ▶ ∙) γ dq (Next P). Global Instance saved_prop_own_contractive γ dq : Contractive (saved_prop_own γ dq). Proof. solve_contractive. Qed. Global Instance saved_prop_discarded_persistent γ P : Persistent (saved_prop_own γ DfracDiscarded P). Proof. apply _. Qed. Global Instance saved_prop_fractional γ P : Fractional (λ q, saved_prop_own γ (DfracOwn q) P). Proof. apply _. Qed. Global Instance saved_prop_as_fractional γ P q : AsFractional (saved_prop_own γ (DfracOwn q) P) (λ q, saved_prop_own γ (DfracOwn q) P) q. Proof. apply _. Qed. (** Allocation *) Lemma saved_prop_alloc_strong (I : gname → Prop) (P: iProp Σ) dq : ✓ dq → pred_infinite I → ⊢ |==> ∃ γ, ⌜I γ⌝ ∗ saved_prop_own γ dq P. Proof. intros ??. by apply saved_anything_alloc_strong. Qed. Lemma saved_prop_alloc_cofinite (G : gset gname) (P: iProp Σ) dq : ✓ dq → ⊢ |==> ∃ γ, ⌜γ ∉ G⌝ ∗ saved_prop_own γ dq P. Proof. by apply saved_anything_alloc_cofinite. Qed. Lemma saved_prop_alloc (P : iProp Σ) dq : ✓ dq → ⊢ |==> ∃ γ, saved_prop_own γ dq P. Proof. apply saved_anything_alloc. Qed. (** Validity *) Lemma saved_prop_valid γ dq P : saved_prop_own γ dq P -∗ ⌜✓ dq⌝. Proof. apply saved_anything_valid. Qed. Lemma saved_prop_valid_2 γ dq1 dq2 P Q : saved_prop_own γ dq1 P -∗ saved_prop_own γ dq2 Q -∗ ⌜✓ (dq1 ⋅ dq2)⌝ ∗ ▷ (P ≡ Q). Proof. iIntros "HP HQ". iCombine "HP HQ" gives "($ & Hag)". by iApply later_equivI. Qed. Lemma saved_prop_agree γ dq1 dq2 P Q : saved_prop_own γ dq1 P -∗ saved_prop_own γ dq2 Q -∗ ▷ (P ≡ Q). Proof. iIntros "HP HQ". iCombine "HP" "HQ" gives "[_ $]". Qed. (** Make an element read-only. *) Lemma saved_prop_persist γ dq P : saved_prop_own γ dq P ==∗ saved_prop_own γ DfracDiscarded P. Proof. apply saved_anything_persist. Qed. (** Recover fractional ownership for read-only element. *) Lemma saved_prop_unpersist γ v : saved_prop_own γ DfracDiscarded v ==∗ ∃ q, saved_prop_own γ (DfracOwn q) v. Proof. apply saved_anything_unpersist. Qed. (** Updates *) Lemma saved_prop_update Q γ P : saved_prop_own γ (DfracOwn 1) P ==∗ saved_prop_own γ (DfracOwn 1) Q. Proof. apply saved_anything_update. Qed. Lemma saved_prop_update_2 Q γ q1 q2 P1 P2 : (q1 + q2 = 1)%Qp → saved_prop_own γ (DfracOwn q1) P1 -∗ saved_prop_own γ (DfracOwn q2) P2 ==∗ saved_prop_own γ (DfracOwn q1) Q ∗ saved_prop_own γ (DfracOwn q2) Q. Proof. apply saved_anything_update_2. Qed. Lemma saved_prop_update_halves Q γ P1 P2 : saved_prop_own γ (DfracOwn (1/2)) P1 -∗ saved_prop_own γ (DfracOwn (1/2)) P2 ==∗ saved_prop_own γ (DfracOwn (1/2)) Q ∗ saved_prop_own γ (DfracOwn (1/2)) Q. Proof. apply saved_anything_update_halves. Qed. End saved_prop. (* Saved predicates. *) Notation savedPredG Σ A := (savedAnythingG Σ (A -d> ▶ ∙)). Notation savedPredΣ A := (savedAnythingΣ (A -d> ▶ ∙)). Section saved_pred. Context `{!savedPredG Σ A}. Definition saved_pred_own (γ : gname) (dq : dfrac) (Φ : A → iProp Σ) := saved_anything_own (F := A -d> ▶ ∙) γ dq (Next ∘ Φ). Global Instance saved_pred_own_contractive `{!savedPredG Σ A} γ dq : Contractive (saved_pred_own γ dq : (A -d> iPropO Σ) → iProp Σ). Proof. solve_proper_core ltac:(fun _ => first [ intros ?; progress simpl | by auto | f_contractive | f_equiv ]). Qed. Global Instance saved_pred_discarded_persistent γ Φ : Persistent (saved_pred_own γ DfracDiscarded Φ). Proof. apply _. Qed. Global Instance saved_pred_fractional γ Φ : Fractional (λ q, saved_pred_own γ (DfracOwn q) Φ). Proof. apply _. Qed. Global Instance saved_pred_as_fractional γ Φ q : AsFractional (saved_pred_own γ (DfracOwn q) Φ) (λ q, saved_pred_own γ (DfracOwn q) Φ) q. Proof. apply _. Qed. (** Allocation *) Lemma saved_pred_alloc_strong (I : gname → Prop) (Φ : A → iProp Σ) dq : ✓ dq → pred_infinite I → ⊢ |==> ∃ γ, ⌜I γ⌝ ∗ saved_pred_own γ dq Φ. Proof. intros ??. by apply saved_anything_alloc_strong. Qed. Lemma saved_pred_alloc_cofinite (G : gset gname) (Φ : A → iProp Σ) dq : ✓ dq → ⊢ |==> ∃ γ, ⌜γ ∉ G⌝ ∗ saved_pred_own γ dq Φ. Proof. by apply saved_anything_alloc_cofinite. Qed. Lemma saved_pred_alloc (Φ : A → iProp Σ) dq : ✓ dq → ⊢ |==> ∃ γ, saved_pred_own γ dq Φ. Proof. apply saved_anything_alloc. Qed. (** Validity *) Lemma saved_pred_valid γ dq Φ : saved_pred_own γ dq Φ -∗ ⌜✓ dq⌝. Proof. apply saved_anything_valid. Qed. Lemma saved_pred_valid_2 γ dq1 dq2 Φ Ψ x : saved_pred_own γ dq1 Φ -∗ saved_pred_own γ dq2 Ψ -∗ ⌜✓ (dq1 ⋅ dq2)⌝ ∗ ▷ (Φ x ≡ Ψ x). Proof. iIntros "HΦ HΨ". iCombine "HΦ HΨ" gives "($ & Hag)". iApply later_equivI. by iApply (discrete_fun_equivI with "Hag"). Qed. Lemma saved_pred_agree γ dq1 dq2 Φ Ψ x : saved_pred_own γ dq1 Φ -∗ saved_pred_own γ dq2 Ψ -∗ ▷ (Φ x ≡ Ψ x). Proof. iIntros "HΦ HΨ". iPoseProof (saved_pred_valid_2 with "HΦ HΨ") as "[_ $]". Qed. (** Make an element read-only. *) Lemma saved_pred_persist γ dq Φ : saved_pred_own γ dq Φ ==∗ saved_pred_own γ DfracDiscarded Φ. Proof. apply saved_anything_persist. Qed. (** Recover fractional ownership for read-only element. *) Lemma saved_pred_unpersist γ Φ: saved_pred_own γ DfracDiscarded Φ ==∗ ∃ q, saved_pred_own γ (DfracOwn q) Φ. Proof. apply saved_anything_unpersist. Qed. (** Updates *) Lemma saved_pred_update Ψ γ Φ : saved_pred_own γ (DfracOwn 1) Φ ==∗ saved_pred_own γ (DfracOwn 1) Ψ. Proof. apply saved_anything_update. Qed. Lemma saved_pred_update_2 Ψ γ q1 q2 Φ1 Φ2 : (q1 + q2 = 1)%Qp → saved_pred_own γ (DfracOwn q1) Φ1 -∗ saved_pred_own γ (DfracOwn q2) Φ2 ==∗ saved_pred_own γ (DfracOwn q1) Ψ ∗ saved_pred_own γ (DfracOwn q2) Ψ. Proof. apply saved_anything_update_2. Qed. Lemma saved_pred_update_halves Ψ γ Φ1 Φ2 : saved_pred_own γ (DfracOwn (1/2)) Φ1 -∗ saved_pred_own γ (DfracOwn (1/2)) Φ2 ==∗ saved_pred_own γ (DfracOwn (1/2)) Ψ ∗ saved_pred_own γ (DfracOwn (1/2)) Ψ. Proof. apply saved_anything_update_halves. Qed. End saved_pred. iris-iris-4.2.0/iris/base_logic/lib/token.v000066400000000000000000000035321460620107300205430ustar00rootroot00000000000000(** This library provides assertions that represent "unique tokens". The [token γ] assertion provides ownership of the token named [γ], and the key lemma [token_exclusive] proves only one token exists. *) From iris.algebra Require Import excl. From iris.proofmode Require Import proofmode. From iris.base_logic.lib Require Export own. From iris.prelude Require Import options. (** The CMRA we need. *) Class tokenG Σ := TokenG { token_inG : inG Σ (exclR unitO); }. Local Existing Instance token_inG. Global Hint Mode tokenG - : typeclass_instances. Definition tokenΣ : gFunctors := #[ GFunctor (exclR unitO) ]. Global Instance subG_tokenΣ Σ : subG tokenΣ Σ → tokenG Σ. Proof. solve_inG. Qed. Local Definition token_def `{!tokenG Σ} (γ : gname) : iProp Σ := own γ (Excl ()). Local Definition token_aux : seal (@token_def). Proof. by eexists. Qed. Definition token := token_aux.(unseal). Local Definition token_unseal : @token = @token_def := token_aux.(seal_eq). Global Arguments token {Σ _} γ. Local Ltac unseal := rewrite ?token_unseal /token_def. Section lemmas. Context `{!tokenG Σ}. Global Instance token_timeless γ : Timeless (token γ). Proof. unseal. apply _. Qed. Lemma token_alloc_strong (P : gname → Prop) : pred_infinite P → ⊢ |==> ∃ γ, ⌜P γ⌝ ∗ token γ. Proof. unseal. intros. iApply own_alloc_strong; done. Qed. Lemma token_alloc : ⊢ |==> ∃ γ, token γ. Proof. unseal. iApply own_alloc. done. Qed. Lemma token_exclusive γ : token γ -∗ token γ -∗ False. Proof. unseal. iIntros "Htok1 Htok2". iCombine "Htok1 Htok2" gives %[]. Qed. Global Instance token_combine_gives γ : CombineSepGives (token γ) (token γ) ⌜False⌝. Proof. rewrite /CombineSepGives. iIntros "[H1 H2]". iDestruct (token_exclusive with "H1 H2") as %[]. Qed. End lemmas. iris-iris-4.2.0/iris/base_logic/lib/wsat.v000066400000000000000000000205341460620107300204020ustar00rootroot00000000000000From stdpp Require Export coPset. From iris.algebra Require Import gmap_view gset coPset. From iris.bi Require Import lib.cmra. From iris.proofmode Require Import proofmode. From iris.base_logic.lib Require Export own. From iris.prelude Require Import options. (** All definitions in this file are internal to [fancy_updates] with the exception of what's in the [wsatGS] module. The module [wsatGS] is thus exported in [fancy_updates], where [wsat] is only imported. *) Module wsatGS. Class wsatGpreS (Σ : gFunctors) : Set := WsatGpreS { wsatGpreS_inv : inG Σ (gmap_viewR positive (agreeR $ laterO (iPropO Σ))); wsatGpreS_enabled : inG Σ coPset_disjR; wsatGpreS_disabled : inG Σ (gset_disjR positive); }. Class wsatGS (Σ : gFunctors) : Set := WsatG { wsat_inG : wsatGpreS Σ; invariant_name : gname; enabled_name : gname; disabled_name : gname; }. Definition wsatΣ : gFunctors := #[GFunctor (gmap_viewRF positive (agreeRF $ laterOF idOF)); GFunctor coPset_disjR; GFunctor (gset_disjR positive)]. Global Instance subG_wsatΣ {Σ} : subG wsatΣ Σ → wsatGpreS Σ. Proof. solve_inG. Qed. End wsatGS. Import wsatGS. Local Existing Instances wsat_inG wsatGpreS_inv wsatGpreS_enabled wsatGpreS_disabled. Definition invariant_unfold {Σ} (P : iProp Σ) : later (iProp Σ) := Next P. Definition ownI `{!wsatGS Σ} (i : positive) (P : iProp Σ) : iProp Σ := own invariant_name (gmap_view_frag i DfracDiscarded (to_agree $ invariant_unfold P)). Global Typeclasses Opaque ownI. Global Instance: Params (@invariant_unfold) 1 := {}. Global Instance: Params (@ownI) 3 := {}. Definition ownE `{!wsatGS Σ} (E : coPset) : iProp Σ := own enabled_name (CoPset E). Global Typeclasses Opaque ownE. Global Instance: Params (@ownE) 3 := {}. Definition ownD `{!wsatGS Σ} (E : gset positive) : iProp Σ := own disabled_name (GSet E). Global Typeclasses Opaque ownD. Global Instance: Params (@ownD) 3 := {}. Definition wsat `{!wsatGS Σ} : iProp Σ := locked (∃ I : gmap positive (iProp Σ), own invariant_name (gmap_view_auth (DfracOwn 1) (to_agree <$> (invariant_unfold <$> I))) ∗ [∗ map] i ↦ Q ∈ I, ▷ Q ∗ ownD {[i]} ∨ ownE {[i]})%I. Section wsat. Context `{!wsatGS Σ}. Implicit Types P : iProp Σ. (* Invariants *) Local Instance invariant_unfold_contractive : Contractive (@invariant_unfold Σ). Proof. solve_contractive. Qed. Global Instance ownI_contractive i : Contractive (@ownI Σ _ i). Proof. solve_contractive. Qed. Global Instance ownI_persistent i P : Persistent (ownI i P). Proof. rewrite /ownI. apply _. Qed. Lemma ownE_empty : ⊢ |==> ownE ∅. Proof. rewrite /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⌝. Proof. rewrite /ownE -own_op own_valid. by iIntros (?%coPset_disj_valid_op). Qed. Lemma ownE_op' E1 E2 : ⌜E1 ## E2⌝ ∧ ownE (E1 ∪ E2) ⊣⊢ ownE E1 ∗ ownE E2. Proof. iSplit; [iIntros "[% ?]"; by iApply ownE_op|]. iIntros "HE". iDestruct (ownE_disjoint with "HE") as %?. iSplit; first done. iApply ownE_op; by try iFrame. Qed. Lemma ownE_singleton_twice i : ownE {[i]} ∗ ownE {[i]} ⊢ False. Proof. rewrite ownE_disjoint. iIntros (?); set_solver. Qed. Lemma ownD_empty : ⊢ |==> ownD ∅. Proof. rewrite /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⌝. Proof. rewrite /ownD -own_op own_valid. by iIntros (?%gset_disj_valid_op). Qed. Lemma ownD_op' E1 E2 : ⌜E1 ## E2⌝ ∧ ownD (E1 ∪ E2) ⊣⊢ ownD E1 ∗ ownD E2. Proof. iSplit; [iIntros "[% ?]"; by iApply ownD_op|]. iIntros "HE". iDestruct (ownD_disjoint with "HE") as %?. iSplit; first done. iApply ownD_op; by try iFrame. Qed. Lemma ownD_singleton_twice i : ownD {[i]} ∗ ownD {[i]} ⊢ False. Proof. rewrite ownD_disjoint. iIntros (?); set_solver. Qed. Lemma invariant_lookup (I : gmap positive (iProp Σ)) i P : own invariant_name (gmap_view_auth (DfracOwn 1) (to_agree <$> (invariant_unfold <$> I))) ∗ own invariant_name (gmap_view_frag i DfracDiscarded (to_agree $ invariant_unfold P)) ⊢ ∃ Q, ⌜I !! i = Some Q⌝ ∗ ▷ (Q ≡ P). Proof. rewrite -own_op own_valid gmap_view_both_validI_total. iIntros "[%Q' (_& _ & HQ' & Hval & Hincl)]". rewrite !lookup_fmap. case: (I !! i)=> [Q|] /=; last first. { iDestruct "HQ'" as %?. done. } iDestruct "HQ'" as %[= <-]. iExists Q; iSplit; first done. rewrite to_agree_includedI internal_eq_sym -later_equivI. done. Qed. Lemma ownI_open i P : wsat ∗ ownI i P ∗ ownE {[i]} ⊢ wsat ∗ ▷ P ∗ ownD {[i]}. Proof. rewrite /ownI /wsat -!lock. iIntros "(Hw & Hi & HiE)". iDestruct "Hw" as (I) "[Hw HI]". iDestruct (invariant_lookup I i P with "[$]") as (Q ?) "#HPQ". iDestruct (big_sepM_delete _ _ i with "HI") as "[[[HQ $]|HiE'] HI]"; eauto. - iSplitR "HQ"; last by iNext; iRewrite -"HPQ". iExists I. iFrame "Hw". iApply (big_sepM_delete _ _ i); eauto. iFrame "HI"; eauto. - iDestruct (ownE_singleton_twice with "[$HiE $HiE']") as %[]. Qed. Lemma ownI_close i P : wsat ∗ ownI i P ∗ ▷ P ∗ ownD {[i]} ⊢ wsat ∗ ownE {[i]}. Proof. rewrite /ownI /wsat -!lock. iIntros "(Hw & Hi & HP & HiD)". iDestruct "Hw" as (I) "[Hw HI]". iDestruct (invariant_lookup with "[$]") as (Q ?) "#HPQ". iDestruct (big_sepM_delete _ _ i with "HI") as "[[[HQ ?]|$] HI]"; eauto. - iDestruct (ownD_singleton_twice with "[$]") as %[]. - iExists I. iFrame "Hw". iApply (big_sepM_delete _ _ i); eauto. iFrame "HI". iLeft. iFrame "HiD". by iNext; iRewrite "HPQ". Qed. Lemma ownI_alloc φ P : (∀ E : gset positive, ∃ i, i ∉ E ∧ φ i) → wsat ∗ ▷ P ==∗ ∃ i, ⌜φ i⌝ ∗ wsat ∗ ownI i P. Proof. iIntros (Hfresh) "[Hw HP]". rewrite /wsat -!lock. iDestruct "Hw" as (I) "[Hw HI]". iMod (own_unit (gset_disjUR positive) disabled_name) as "HE". iMod (own_updateP with "[$]") as "HE". { apply (gset_disj_alloc_empty_updateP_strong' (λ i, I !! i = None ∧ φ i)). intros E. destruct (Hfresh (E ∪ dom I)) as (i & [? HIi%not_elem_of_dom]%not_elem_of_union & ?); eauto. } iDestruct "HE" as (X) "[Hi HE]"; iDestruct "Hi" as %(i & -> & HIi & ?). iMod (own_update with "Hw") as "[Hw HiP]". { eapply (gmap_view_alloc _ i DfracDiscarded (to_agree _)); [|done..]. by rewrite /= !lookup_fmap HIi. } iModIntro; iExists i; iSplit; [done|]. rewrite /ownI; iFrame "HiP". iExists (<[i:=P]>I); iSplitL "Hw". { by rewrite !fmap_insert. } iApply (big_sepM_insert _ I); first done. iFrame "HI". iLeft. by rewrite /ownD; iFrame. Qed. Lemma ownI_alloc_open φ P : (∀ E : gset positive, ∃ i, i ∉ E ∧ φ i) → wsat ==∗ ∃ i, ⌜φ i⌝ ∗ (ownE {[i]} -∗ wsat) ∗ ownI i P ∗ ownD {[i]}. Proof. iIntros (Hfresh) "Hw". rewrite /wsat -!lock. iDestruct "Hw" as (I) "[Hw HI]". iMod (own_unit (gset_disjUR positive) disabled_name) as "HD". iMod (own_updateP with "[$]") as "HD". { apply (gset_disj_alloc_empty_updateP_strong' (λ i, I !! i = None ∧ φ i)). intros E. destruct (Hfresh (E ∪ dom I)) as (i & [? HIi%not_elem_of_dom]%not_elem_of_union & ?); eauto. } iDestruct "HD" as (X) "[Hi HD]"; iDestruct "Hi" as %(i & -> & HIi & ?). iMod (own_update with "Hw") as "[Hw HiP]". { eapply (gmap_view_alloc _ i DfracDiscarded (to_agree _)); [|done..]. by rewrite /= !lookup_fmap HIi. } iModIntro; iExists i; iSplit; [done|]. rewrite /ownI; iFrame "HiP". rewrite -/(ownD _). iFrame "HD". iIntros "HE". iExists (<[i:=P]>I); iSplitL "Hw". { by rewrite !fmap_insert. } iApply (big_sepM_insert _ I); first done. iFrame "HI". by iRight. Qed. End wsat. (* Allocation of an initial world *) Lemma wsat_alloc `{!wsatGpreS Σ} : ⊢ |==> ∃ _ : wsatGS Σ, wsat ∗ ownE ⊤. Proof. iIntros. iMod (own_alloc (gmap_view_auth (DfracOwn 1) ∅)) as (γI) "HI"; first by apply gmap_view_auth_valid. iMod (own_alloc (CoPset ⊤)) as (γE) "HE"; first done. iMod (own_alloc (GSet ∅)) as (γD) "HD"; first done. iModIntro; iExists (WsatG _ _ γI γE γD). rewrite /wsat /ownE -lock; iFrame. iExists ∅. rewrite fmap_empty big_opM_empty. by iFrame. Qed. iris-iris-4.2.0/iris/base_logic/proofmode.v000066400000000000000000000046231460620107300206510ustar00rootroot00000000000000From iris.algebra Require Import proofmode_classes. From iris.proofmode Require Import classes. From iris.base_logic Require Export derived. From iris.prelude Require Import options. Import base_logic.bi.uPred. (* Setup of the proof mode *) Section class_instances. Context {M : ucmra}. Implicit Types P Q R : uPred M. Global Instance into_pure_cmra_valid `{!CmraDiscrete A} (a : A) : @IntoPure (uPredI M) (✓ a) (✓ a). Proof. rewrite /IntoPure. by rewrite uPred.discrete_valid. Qed. Global Instance from_pure_cmra_valid {A : cmra} (a : A) : @FromPure (uPredI M) false (✓ a) (✓ a). Proof. rewrite /FromPure /=. eapply bi.pure_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. (* TODO: Improve this instance with generic own simplification machinery once https://gitlab.mpi-sws.org/iris/iris/-/issues/460 is fixed *) (* Cost > 50 to give priority to [combine_sep_as_fractional]. *) Global Instance combine_sep_as_ownM (a b1 b2 : M) : IsOp a b1 b2 → CombineSepAs (uPred_ownM b1) (uPred_ownM b2) (uPred_ownM a) | 60. Proof. intros. by rewrite /CombineSepAs -ownM_op -is_op. Qed. (* TODO: Improve this instance with generic own validity simplification machinery once https://gitlab.mpi-sws.org/iris/iris/-/issues/460 is fixed *) Global Instance combine_sep_gives_ownM (b1 b2 : M) : CombineSepGives (uPred_ownM b1) (uPred_ownM b2) (✓ (b1 ⋅ b2)). Proof. intros. rewrite /CombineSepGives -ownM_op ownM_valid. by apply: bi.persistently_intro. 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. iris-iris-4.2.0/iris/base_logic/upred.v000066400000000000000000001135331460620107300177770ustar00rootroot00000000000000From iris.algebra Require Export cmra updates. From iris.bi Require Import notation. From iris.prelude Require Import options. Local Hint Extern 1 (_ ≼ _) => etrans; [eassumption|] : core. Local Hint Extern 1 (_ ≼ _) => etrans; [|eassumption] : core. Local Hint Extern 10 (_ ≤ _) => lia : core. (** The basic definition of the uPred type, its metric and functor laws. You probably do not want to import this file. Instead, import base_logic.base_logic; that will also give you all the primitive and many derived laws for the logic. *) (** A good way of understanding this definition of the uPred OFE is to consider the OFE uPred0 of monotonous SProp predicates. That is, uPred0 is the OFE of non-expansive functions from M to SProp that are monotonous with respect to CMRA inclusion. This notion of monotonicity has to be stated in the SProp logic. Together with the usual closedness property of SProp, this gives exactly uPred_mono. Then, we quotient uPred0 *in the siProp logic* with respect to equivalence on valid elements of M. That is, we quotient with respect to the following *siProp* equivalence relation: P1 ≡ P2 := ∀ x, ✓ x → (P1(x) ↔ P2(x)) (1) When seen from the ambiant logic, obtaining this quotient requires definig both a custom Equiv and Dist. It is worth noting that this equivalence relation admits canonical representatives. More precisely, one can show that every equivalence class contains exactly one element P0 such that: ∀ x, (✓ x → P0(x)) → P0(x) (2) (Again, this assertion has to be understood in siProp). Intuitively, this says that P0 trivially holds whenever the resource is invalid. Starting from any element P, one can find this canonical representative by choosing: P0(x) := ✓ x → P(x) (3) Hence, as an alternative definition of uPred, we could use the set of canonical representatives (i.e., the subtype of monotonous siProp predicates that verify (2)). This alternative definition would save us from using a quotient. However, the definitions of the various connectives would get more complicated, because we have to make sure they all verify (2), which sometimes requires some adjustments. We would moreover need to prove one more property for every logical connective. *) (** Note that, somewhat curiously, [uPred M] is *not* in general a Camera, at least not if all propositions are considered "valid" Camera elements. It fails to satisfy the extension axiom. Here is the counterexample: We use [M := (option Ex {A,B})^2] -- so we have pairs whose components are ε, A or B. Let [[ P r n := (ownM (A,A) ∧ ▷ False) ∨ ownM (A,B) ∨ ownM (B,A) ∨ ownM (B,B) ↔ r = (A,A) ∧ n = 0 ∨ r = (A,B) ∨ r = (B,A) ∨ r = (B,B) Q1 r n := ownM (A, ε) ∨ ownM (B, ε) ↔ (A, ε) ≼ r ∨ (B, ε) ≼ r ("Left component is not ε") Q2 r n := ownM (ε, A) ∨ ownM (ε, B) ↔ (ε, A) ≼ r ∨ (ε, B) ≼ r ("Right component is not ε") ]] These are all sufficiently closed and non-expansive and whatnot. We have [P ≡{0}≡ Q1 * Q2]. So assume extension holds, then we get Q1', Q2' such that [[ P ≡ Q1' ∗ Q2' Q1 ≡{0}≡ Q1' Q2 ≡{0}≡ Q2' ]] Now comes the contradiction: We know that [P (A,A) 1] does *not* hold, but I am going to show that [(Q1' ∗ Q2') (A,A) 1] holds, which would be a contraction. To this end, I will show (a) [Q1' (A,ε) 1] and (b) [Q2' (ε,A) 1]. The result [(Q1' ∗ Q2') (A,A)] follows from [(A,ε) ⋅ (ε,A) = (A,A)]. (a) Proof of [Q1' (A,ε) 1]. We have [P (A,B) 1], and thus [Q1' r1 1] and [Q2' r2 1] for some [r1 ⋅ r2 = (A,B)]. There are four possible decompositions [r1 ⋅ r2]: - [(ε,ε) ⋅ (A,B)]: This would give us [Q1' (ε,ε) 1], from which we obtain (through down-closure and the equality [Q1 ≡{0}≡ Q1'] above) that [Q1 (ε,ε) 0]. However, we know that's false. - [(A,B) ⋅ (ε,ε)]: Can be excluded for similar reasons (the second resource must not be ε in the 2nd component). - [(ε,B) ⋅ (A,ε)]: Can be excluded for similar reasons (the first resource must not be ε in the 1st component). - [(A,ε) ⋅ (ε,B)]: This gives us the desired [Q1' (A,ε) 1]. (b) Proof of [Q2' (ε,A) 1]. We have [P (B,A) 1], and thus [Q1' r1 1] and [Q2' r2 1] for some [r1 ⋅ r2 = (B,A)]. There are again four possible decompositions, and like above we can exclude three of them. This leaves us with [(B,ε) ⋅ (ε,A)] and thus [Q2' (ε,A) 1]. This completes the proof. *) Record uPred (M : ucmra) : Type := UPred { uPred_holds : nat → M → Prop; uPred_mono n1 n2 x1 x2 : uPred_holds n1 x1 → x1 ≼{n2} x2 → n2 ≤ n1 → uPred_holds n2 x2 }. (** When working in the model, it is convenient to be able to treat [uPred] as [nat → M → Prop]. But we only want to locally break the [uPred] abstraction this way. *) Local Coercion uPred_holds : uPred >-> Funclass. Bind Scope bi_scope with uPred. Global Arguments uPred_holds {_} _ _ _ : simpl never. Add Printing Constructor uPred. Global Instance: Params (@uPred_holds) 3 := {}. Section cofe. Context {M : ucmra}. Inductive uPred_equiv' (P Q : uPred M) : Prop := { uPred_in_equiv : ∀ n x, ✓{n} x → P n x ↔ Q n x }. Local Instance uPred_equiv : Equiv (uPred M) := uPred_equiv'. Inductive uPred_dist' (n : nat) (P Q : uPred M) : Prop := { uPred_in_dist : ∀ n' x, n' ≤ n → ✓{n'} x → P n' x ↔ Q n' x }. Local Instance uPred_dist : Dist (uPred M) := uPred_dist'. Definition uPred_ofe_mixin : OfeMixin (uPred M). Proof. split. - intros P Q; split. + by intros HPQ n; split=> i x ??; apply HPQ. + intros HPQ; split=> n x ?; apply HPQ with n; auto. - intros n; split. + by intros P; split=> x i. + by intros P Q HPQ; split=> x i ??; symmetry; apply HPQ. + intros P Q Q' HP HQ; split=> i x ??. by trans (Q i x);[apply HP|apply HQ]. - intros n m P Q HPQ Hlt. split=> i x ??; apply HPQ; eauto with lia. Qed. Canonical Structure uPredO : ofe := Ofe (uPred M) uPred_ofe_mixin. Program Definition uPred_compl : Compl uPredO := λ c, {| uPred_holds n x := ∀ n', n' ≤ n → ✓{n'} x → c n' n' x |}. Next Obligation. move=> /= c n1 n2 x1 x2 HP Hx12 Hn12 n3 Hn23 Hv. eapply uPred_mono. - eapply HP, cmra_validN_includedN, cmra_includedN_le=>//; lia. - eapply cmra_includedN_le=>//; lia. - done. Qed. Global Program Instance uPred_cofe : Cofe uPredO := {| compl := uPred_compl |}. Next Obligation. intros n c; split=>i x Hin Hv. etrans; [|by symmetry; apply (chain_cauchy c i n)]. split=>H; [by apply H|]. repeat intro. apply (chain_cauchy c _ i)=>//. by eapply uPred_mono. Qed. End cofe. Global Arguments uPredO : clear implicits. Global Instance uPred_ne {M} (P : uPred M) n : Proper (dist n ==> iff) (P n). Proof. intros x1 x2 Hx; split=> ?; eapply uPred_mono; eauto; by rewrite Hx. Qed. Global Instance uPred_proper {M} (P : uPred M) n : Proper ((≡) ==> iff) (P n). Proof. by intros x1 x2 Hx; apply uPred_ne, equiv_dist. Qed. Lemma uPred_holds_ne {M} (P Q : uPred M) n1 n2 x : P ≡{n2}≡ Q → n2 ≤ n1 → ✓{n2} x → Q n1 x → P n2 x. Proof. intros [Hne] ???. eapply Hne; try done. eauto using uPred_mono, cmra_validN_le. Qed. (* Equivalence to the definition of uPred in the appendix. *) Lemma uPred_alt {M : ucmra} (P: nat → M → Prop) : (∀ n1 n2 x1 x2, P n1 x1 → x1 ≼{n1} x2 → n2 ≤ n1 → P n2 x2) ↔ ( (∀ x n1 n2, n2 ≤ n1 → P n1 x → P n2 x) (* Pointwise down-closed *) ∧ (∀ n x1 x2, x1 ≡{n}≡ x2 → ∀ m, m ≤ n → P m x1 ↔ P m x2) (* Non-expansive *) ∧ (∀ n x1 x2, x1 ≼{n} x2 → ∀ m, m ≤ n → P m x1 → P m x2) (* Monotonicity *) ). Proof. (* Provide this lemma to eauto. *) assert (∀ n1 n2 (x1 x2 : M), n2 ≤ n1 → x1 ≡{n1}≡ x2 → x1 ≼{n2} x2). { intros ????? H. eapply cmra_includedN_le; last done. by rewrite H. } (* Now go ahead. *) split. - intros Hupred. repeat split; eauto using cmra_includedN_le. - intros (Hdown & _ & Hmono) **. eapply Hmono; [done..|]. eapply Hdown; done. Qed. (** functor *) Program Definition uPred_map {M1 M2 : ucmra} (f : M2 -n> M1) `{!CmraMorphism f} (P : uPred M1) : uPred M2 := {| uPred_holds n x := P n (f x) |}. Next Obligation. naive_solver eauto using uPred_mono, cmra_morphism_monotoneN. Qed. Global Instance uPred_map_ne {M1 M2 : ucmra} (f : M2 -n> M1) `{!CmraMorphism f} n : Proper (dist n ==> dist n) (uPred_map f). Proof. intros x1 x2 Hx; split=> n' y ??. split; apply Hx; auto using cmra_morphism_validN. Qed. Lemma uPred_map_id {M : ucmra} (P : uPred M): uPred_map cid P ≡ P. Proof. by split=> n x ?. Qed. Lemma uPred_map_compose {M1 M2 M3 : ucmra} (f : M1 -n> M2) (g : M2 -n> M3) `{!CmraMorphism f, !CmraMorphism g} (P : uPred M3): uPred_map (g ◎ f) P ≡ uPred_map f (uPred_map g P). Proof. by split=> n x Hx. Qed. Lemma uPred_map_ext {M1 M2 : ucmra} (f g : M1 -n> M2) `{!CmraMorphism f} `{!CmraMorphism g}: (∀ x, f x ≡ g x) → ∀ x, uPred_map f x ≡ uPred_map g x. Proof. intros Hf P; split=> n x Hx /=; by rewrite /uPred_holds /= Hf. Qed. Definition uPredO_map {M1 M2 : ucmra} (f : M2 -n> M1) `{!CmraMorphism f} : uPredO M1 -n> uPredO M2 := OfeMor (uPred_map f : uPredO M1 → uPredO M2). Lemma uPredO_map_ne {M1 M2 : ucmra} (f g : M2 -n> M1) `{!CmraMorphism f, !CmraMorphism g} n : f ≡{n}≡ g → uPredO_map f ≡{n}≡ uPredO_map g. Proof. by intros Hfg P; split=> n' y ??; rewrite /uPred_holds /= (dist_le _ _ _ _(Hfg y)); last lia. Qed. Program Definition uPredOF (F : urFunctor) : oFunctor := {| oFunctor_car A _ B _ := uPredO (urFunctor_car F B A); oFunctor_map A1 _ A2 _ B1 _ B2 _ fg := uPredO_map (urFunctor_map F (fg.2, fg.1)) |}. Next Obligation. intros F A1 ? A2 ? B1 ? B2 ? n P Q HPQ. apply uPredO_map_ne, urFunctor_map_ne; split; by apply HPQ. Qed. Next Obligation. intros F A ? B ? P; simpl. rewrite -{2}(uPred_map_id P). apply uPred_map_ext=>y. by rewrite urFunctor_map_id. Qed. Next Obligation. intros F A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' P; simpl. rewrite -uPred_map_compose. apply uPred_map_ext=>y; apply urFunctor_map_compose. Qed. Global Instance uPredOF_contractive F : urFunctorContractive F → oFunctorContractive (uPredOF F). Proof. intros ? A1 ? A2 ? B1 ? B2 ? n P Q HPQ. apply uPredO_map_ne, urFunctor_map_contractive. destruct HPQ as [HPQ]. constructor. intros ??. split; by eapply HPQ. 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 }. Global Hint Resolve uPred_mono : uPred_def. (** logical connectives *) Local Program Definition uPred_pure_def {M} (φ : Prop) : uPred M := {| uPred_holds n x := φ |}. Solve Obligations with done. Local Definition uPred_pure_aux : seal (@uPred_pure_def). Proof. by eexists. Qed. Definition uPred_pure := uPred_pure_aux.(unseal). Global Arguments uPred_pure {M}. Local Definition uPred_pure_unseal : @uPred_pure = @uPred_pure_def := uPred_pure_aux.(seal_eq). Local 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. Local Definition uPred_and_aux : seal (@uPred_and_def). Proof. by eexists. Qed. Definition uPred_and := uPred_and_aux.(unseal). Global Arguments uPred_and {M}. Local Definition uPred_and_unseal : @uPred_and = @uPred_and_def := uPred_and_aux.(seal_eq). Local 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. Local Definition uPred_or_aux : seal (@uPred_or_def). Proof. by eexists. Qed. Definition uPred_or := uPred_or_aux.(unseal). Global Arguments uPred_or {M}. Local Definition uPred_or_unseal : @uPred_or = @uPred_or_def := uPred_or_aux.(seal_eq). Local 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. Local Definition uPred_impl_aux : seal (@uPred_impl_def). Proof. by eexists. Qed. Definition uPred_impl := uPred_impl_aux.(unseal). Global Arguments uPred_impl {M}. Local Definition uPred_impl_unseal : @uPred_impl = @uPred_impl_def := uPred_impl_aux.(seal_eq). Local 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. Local Definition uPred_forall_aux : seal (@uPred_forall_def). Proof. by eexists. Qed. Definition uPred_forall := uPred_forall_aux.(unseal). Global Arguments uPred_forall {M A}. Local Definition uPred_forall_unseal : @uPred_forall = @uPred_forall_def := uPred_forall_aux.(seal_eq). Local 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. Local Definition uPred_exist_aux : seal (@uPred_exist_def). Proof. by eexists. Qed. Definition uPred_exist := uPred_exist_aux.(unseal). Global Arguments uPred_exist {M A}. Local Definition uPred_exist_unseal : @uPred_exist = @uPred_exist_def := uPred_exist_aux.(seal_eq). Local Program Definition uPred_internal_eq_def {M} {A : ofe} (a1 a2 : A) : uPred M := {| uPred_holds n x := a1 ≡{n}≡ a2 |}. Solve Obligations with naive_solver eauto 2 using dist_le. Local Definition uPred_internal_eq_aux : seal (@uPred_internal_eq_def). Proof. by eexists. Qed. Definition uPred_internal_eq := uPred_internal_eq_aux.(unseal). Global Arguments uPred_internal_eq {M A}. Local Definition uPred_internal_eq_unseal : @uPred_internal_eq = @uPred_internal_eq_def := uPred_internal_eq_aux.(seal_eq). Local 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. rewrite Hy. eapply dist_le, Hn. by rewrite Hx assoc. Qed. Local Definition uPred_sep_aux : seal (@uPred_sep_def). Proof. by eexists. Qed. Definition uPred_sep := uPred_sep_aux.(unseal). Global Arguments uPred_sep {M}. Local Definition uPred_sep_unseal : @uPred_sep = @uPred_sep_def := uPred_sep_aux.(seal_eq). Local 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. Local Definition uPred_wand_aux : seal (@uPred_wand_def). Proof. by eexists. Qed. Definition uPred_wand := uPred_wand_aux.(unseal). Global Arguments uPred_wand {M}. Local Definition uPred_wand_unseal : @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. *) Local 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. Local Definition uPred_plainly_aux : seal (@uPred_plainly_def). Proof. by eexists. Qed. Definition uPred_plainly := uPred_plainly_aux.(unseal). Global Arguments uPred_plainly {M}. Local Definition uPred_plainly_unseal : @uPred_plainly = @uPred_plainly_def := uPred_plainly_aux.(seal_eq). Local Program Definition uPred_persistently_def {M} (P : uPred M) : uPred M := {| uPred_holds n x := P n (core x) |}. Solve Obligations with naive_solver eauto using uPred_mono, cmra_core_monoN. Local Definition uPred_persistently_aux : seal (@uPred_persistently_def). Proof. by eexists. Qed. Definition uPred_persistently := uPred_persistently_aux.(unseal). Global Arguments uPred_persistently {M}. Local Definition uPred_persistently_unseal : @uPred_persistently = @uPred_persistently_def := uPred_persistently_aux.(seal_eq). Local 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. Local Definition uPred_later_aux : seal (@uPred_later_def). Proof. by eexists. Qed. Definition uPred_later := uPred_later_aux.(unseal). Global Arguments uPred_later {M}. Local Definition uPred_later_unseal : @uPred_later = @uPred_later_def := uPred_later_aux.(seal_eq). Local Program Definition uPred_ownM_def {M : ucmra} (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. exists (a' ⋅ x2). rewrite Hx. eapply dist_le, Hn. rewrite (assoc op) -Hx1 //. Qed. Local Definition uPred_ownM_aux : seal (@uPred_ownM_def). Proof. by eexists. Qed. Definition uPred_ownM := uPred_ownM_aux.(unseal). Global Arguments uPred_ownM {M}. Local Definition uPred_ownM_unseal : @uPred_ownM = @uPred_ownM_def := uPred_ownM_aux.(seal_eq). Local Program Definition uPred_cmra_valid_def {M} {A : cmra} (a : A) : uPred M := {| uPred_holds n x := ✓{n} a |}. Solve Obligations with naive_solver eauto 2 using cmra_validN_le. Local Definition uPred_cmra_valid_aux : seal (@uPred_cmra_valid_def). Proof. by eexists. Qed. Definition uPred_cmra_valid := uPred_cmra_valid_aux.(unseal). Global Arguments uPred_cmra_valid {M A}. Local Definition uPred_cmra_valid_unseal : @uPred_cmra_valid = @uPred_cmra_valid_def := uPred_cmra_valid_aux.(seal_eq). Local 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. Local Definition uPred_bupd_aux : seal (@uPred_bupd_def). Proof. by eexists. Qed. Definition uPred_bupd := uPred_bupd_aux.(unseal). Global Arguments uPred_bupd {M}. Local Definition uPred_bupd_unseal : @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. (** Primitive logical rules. These are not directly usable later because they do not refer to the BI connectives. *) Module uPred_primitive. Local Definition uPred_unseal := (uPred_pure_unseal, uPred_and_unseal, uPred_or_unseal, uPred_impl_unseal, uPred_forall_unseal, uPred_exist_unseal, uPred_internal_eq_unseal, uPred_sep_unseal, uPred_wand_unseal, uPred_plainly_unseal, uPred_persistently_unseal, uPred_later_unseal, uPred_ownM_unseal, uPred_cmra_valid_unseal, @uPred_bupd_unseal). Ltac unseal := rewrite !uPred_unseal /=. Section primitive. Context {M : ucmra}. Implicit Types φ : Prop. Implicit Types P Q : uPred M. Implicit Types A : Type. Local Arguments uPred_holds {_} !_ _ _ /. Local Hint Immediate uPred_in_entails : core. (** The notations below are implicitly local due to the section, so we do not mind the overlap with the general BI notations. *) 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. 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. Lemma entails_anti_sym : AntiSymm (⊣⊢) (⊢). Proof. intros P Q HPQ HQP; split=> x n; by split; [apply HPQ|apply HQP]. Qed. Lemma equiv_entails P Q : (P ⊣⊢ Q) ↔ (P ⊢ Q) ∧ (Q ⊢ P). Proof. split. - intros HPQ; split; split=> x i; apply HPQ. - intros [??]. exact: entails_anti_sym. Qed. Lemma entails_lim (cP cQ : chain (uPredO M)) : (∀ n, cP n ⊢ cQ n) → compl cP ⊢ compl cQ. Proof. intros Hlim; split=> n m ? HP. eapply uPred_holds_ne, Hlim, HP; rewrite ?conv_compl; eauto. Qed. (** 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 : ofe) : 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. eapply 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 : cmra} : 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_2 P Q : ■ ((P -∗ Q) ∧ (Q -∗ P)) ⊢ P ≡ Q. Proof. unseal; split=> n x ? /=. setoid_rewrite (left_id ε op). split; 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 : ofe} P (a : A) : P ⊢ (a ≡ a). Proof. unseal; by split=> n x ??; simpl. Qed. Lemma internal_eq_rewrite {A : ofe} 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 {A} {B : A → ofe} (g1 g2 : discrete_fun B) : (∀ i, g1 i ≡ g2 i) ⊢ g1 ≡ g2. Proof. by unseal. Qed. Lemma sig_eq {A : ofe} (P : A → Prop) (x y : sigO P) : proj1_sig x ≡ proj1_sig y ⊢ x ≡ y. Proof. by unseal. Qed. Lemma later_eq_1 {A : ofe} (x y : A) : Next x ≡ Next y ⊢ ▷ (x ≡ y). Proof. unseal. split. intros [|n]; simpl; [done|]. intros ?? Heq; apply Heq; auto. Qed. Lemma later_eq_2 {A : ofe} (x y : A) : ▷ (x ≡ y) ⊢ Next x ≡ Next y. Proof. unseal. split. intros n ? ? Hn; split; intros m Hlt; simpl in *. destruct n as [|n]; first lia. eauto using dist_le with si_solver. Qed. Lemma discrete_eq_1 {A : ofe} (a b : A) : Discrete a → a ≡ b ⊢ ⌜a ≡ b⌝. Proof. unseal=> ?. split=> n x ?. by apply (discrete_iff n). Qed. (** This is really just a special case of an entailment between two [siProp], but we do not have the infrastructure to express the more general case. This temporary proof rule will be replaced by the proper one eventually. *) Lemma internal_eq_entails {A B : ofe} (a1 a2 : A) (b1 b2 : B) : (a1 ≡ a2 ⊢ b1 ≡ b2) ↔ (∀ n, a1 ≡{n}≡ a2 → b1 ≡{n}≡ b2). Proof. split. - unseal=> -[Hsi] n. apply (Hsi _ ε), ucmra_unit_validN. - unseal=> Hsi. split=>n x ?. apply Hsi. 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 : cmra} P (a : A) : ✓ a → P ⊢ (✓ a). Proof. unseal=> ?; split=> n x ? _ /=; by apply cmra_valid_validN. Qed. Lemma cmra_valid_elim {A : cmra} (a : A) : ✓ a ⊢ ⌜ ✓{0} a ⌝. Proof. unseal; split=> n x ??; apply cmra_validN_le with n; auto. Qed. Lemma plainly_cmra_valid_1 {A : cmra} (a : A) : ✓ a ⊢ ■ ✓ a. Proof. by unseal. Qed. Lemma cmra_valid_weaken {A : cmra} (a b : A) : ✓ (a ⋅ b) ⊢ ✓ a. Proof. unseal; split=> n x _; apply cmra_validN_op_l. Qed. (** This is really just a special case of an entailment between two [siProp], but we do not have the infrastructure to express the more general case. This temporary proof rule will be replaced by the proper one eventually. *) Lemma valid_entails {A B : cmra} (a : A) (b : B) : (∀ n, ✓{n} a → ✓{n} b) → ✓ a ⊢ ✓ b. Proof. unseal=> Hval. split=>n x ?. apply Hval. Qed. (** Consistency/soundness statement *) (** The lemmas [pure_soundness] and [internal_eq_soundness] should become an instance of [siProp] soundness in the future. *) Lemma pure_soundness φ : (True ⊢ ⌜ φ ⌝) → φ. Proof. unseal=> -[H]. by apply (H 0 ε); eauto using ucmra_unit_validN. Qed. Lemma internal_eq_soundness {A : ofe} (x y : A) : (True ⊢ x ≡ y) → x ≡ y. Proof. unseal=> -[H]. apply equiv_dist=> n. by apply (H n ε); eauto using ucmra_unit_validN. Qed. Lemma later_soundness P : (True ⊢ ▷ P) → (True ⊢ P). Proof. unseal=> -[HP]; split=> n x Hx _. apply uPred_mono with n ε; eauto using ucmra_unit_leastN. by apply (HP (S n)); eauto using ucmra_unit_validN. Qed. End primitive. End uPred_primitive. iris-iris-4.2.0/iris/bi/000077500000000000000000000000001460620107300147665ustar00rootroot00000000000000iris-iris-4.2.0/iris/bi/ascii.v000066400000000000000000000116061460620107300162510ustar00rootroot00000000000000From iris.bi Require Import interface derived_connectives updates. From iris.prelude Require Import options. Notation "P |- Q" := (P ⊢ Q) (at level 99, Q at level 200, right associativity, only parsing) : stdpp_scope. Notation "P '|-@{' PROP } Q" := (P ⊢@{PROP} Q) (at level 99, Q at level 200, right associativity, only parsing) : stdpp_scope. Notation "(|-)" := (⊢) (only parsing) : stdpp_scope. Notation "'(|-@{' PROP } )" := (⊢@{PROP}) (only parsing) : stdpp_scope. Notation "|- Q" := (⊢ Q%I) (at level 20, Q at level 200, only parsing) : stdpp_scope. Notation "'|-@{' PROP } Q" := (⊢@{PROP} Q) (at level 20, Q at level 200, only parsing) : stdpp_scope. (** Work around parsing issues: see [notation.v] for details. *) Notation "'(|-@{' PROP } Q )" := (⊢@{PROP} Q) (only parsing) : stdpp_scope. Notation "P -|- Q" := (P ⊣⊢ Q) (at level 95, no associativity, only parsing) : stdpp_scope. Notation "P '-|-@{' PROP } Q" := (P ⊣⊢@{PROP} Q) (at level 95, no associativity, only parsing) : stdpp_scope. Notation "(-|-)" := (⊣⊢) (only parsing) : stdpp_scope. Notation "'(-|-@{' PROP } )" := (⊣⊢@{PROP}) (only parsing) : stdpp_scope. Notation "P -* Q" := (P ⊢ Q)%stdpp (at level 99, Q at level 200, right associativity, only parsing) : stdpp_scope. (* FIXME: Notation "'⌜' φ '⌝'" := (bi_pure φ%type%stdpp) : bi_scope. *) Notation "P /\ Q" := (P ∧ Q)%I (only parsing) : bi_scope. Notation "(/\)" := bi_and (only parsing) : bi_scope. Notation "P \/ Q" := (P ∨ Q)%I (only parsing) : bi_scope. Notation "(\/)" := bi_or (only parsing) : bi_scope. Notation "P -> Q" := (P → Q)%I (only parsing) : bi_scope. Notation "~ P" := (P → False)%I (only parsing) : bi_scope. Notation "P ** Q" := (P ∗ Q)%I (at level 80, right associativity, only parsing) : bi_scope. Notation "(**)" := bi_sep (only parsing) : bi_scope. Notation "P -* Q" := (P -∗ Q)%I (at level 99, Q at level 200, right associativity, only parsing) : bi_scope. (* ∀ x .. y , P *) Notation "'forall' x .. y , P" := (bi_forall (fun x => .. (bi_forall (fun y => P%I)) ..)) (at level 200, x binder, right associativity, only parsing) : bi_scope. (* ∃ x .. y , P *) Notation "'exists' x .. y , P" := (bi_exist (fun x => .. (bi_exist (fun y => P%I)) ..)) (at level 200, x binder, right associativity, only parsing) : bi_scope. Notation "|> P" := (▷ P)%I (at level 20, right associativity, only parsing) : bi_scope. Notation "|>? p P" := (▷?p P)%I (at level 20, p at level 9, P at level 20, only parsing) : bi_scope. Notation "|>^ n P" := (▷^n P)%I (at level 20, n at level 9, P at level 20, only parsing) : bi_scope. Notation "P <-> Q" := (P ↔ Q)%I (at level 95, no associativity, only parsing) : bi_scope. Notation "P *-* Q" := (P ∗-∗ Q)%I (at level 95, no associativity, only parsing) : bi_scope. Notation "'<#>' P" := (□ P)%I (at level 20, right associativity, only parsing) : bi_scope. Notation "'<#>?' p P" := (□?p P)%I (at level 20, p at level 9, P at level 20, right associativity, only parsing) : bi_scope. Notation "'' P" := (◇ P)%I (at level 20, right associativity, only parsing) : bi_scope. Notation "mP -*? Q" := (mP -∗? Q)%I (at level 99, Q at level 200, right associativity, only parsing) : bi_scope. Notation "P ==* Q" := (P ==∗ Q)%stdpp (at level 99, Q at level 200, only parsing) : stdpp_scope. Notation "P ==* Q" := (P ==∗ Q)%I (at level 99, Q at level 200, only parsing) : bi_scope. Notation "P ={ E1 , E2 }=* Q" := (P ={E1,E2}=∗ Q)%I (at level 99, E1,E2 at level 50, Q at level 200, only parsing) : bi_scope. Notation "P ={ E1 , E2 }=* Q" := (P ={E1,E2}=∗ Q) (at level 99, E1,E2 at level 50, Q at level 200, only parsing) : stdpp_scope. Notation "P ={ E }=* Q" := (P ={E}=∗ Q)%I (at level 99, E at level 50, Q at level 200, only parsing) : bi_scope. Notation "P ={ E }=* Q" := (P ={E}=∗ Q) (at level 99, E at level 50, Q at level 200, only parsing) : stdpp_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 "P ={ E1 } [ E2 ]|>=* Q" := (P ={E1}[E2]▷=∗ Q)%I (at level 99, E1,E2 at level 50, Q at level 200, only parsing) : bi_scope. Notation "|={ E }|>=> Q" := (|={E}▷=> Q)%I (at level 99, E at level 50, Q at level 200, only parsing) : bi_scope. Notation "P ={ E }|>=* Q" := (P ={E}▷=∗ Q)%I (at level 99, E at level 50, Q at level 200, only parsing) : bi_scope. Notation "|={ E1 } [ E2 ]|>=>^ n Q" := (|={E1}[E2]▷=>^n Q)%I (at level 99, E1,E2 at level 50, n at level 9, Q at level 200, only parsing) : bi_scope. Notation "P ={ E1 } [ E2 ]|>=*^ n Q" := (P ={E1}[E2]▷=∗^n Q)%I (at level 99, E1,E2 at level 50, n at level 9, Q at level 200, only parsing) : stdpp_scope. Notation "P ={ E1 } [ E2 ]|>=*^ n Q" := (P ={E1}[E2]▷=∗^n Q)%I (at level 99, E1,E2 at level 50, n at level 9, Q at level 200, only parsing) : bi_scope. iris-iris-4.2.0/iris/bi/bi.v000066400000000000000000000010201460620107300155400ustar00rootroot00000000000000From iris.bi Require Export derived_laws derived_laws_later big_op. From iris.bi Require Export updates internal_eq plainly embedding. From iris.prelude Require Import options. Module Import bi. (** Get universes into the desired scope *) Universe Logic. Constraint Logic = bi.interface.universes.Logic. Universe Quant. Constraint Quant = bi.interface.universes.Quant. (** Get other symbols into the desired scope *) Export bi.interface.bi. Export bi.derived_laws.bi. Export bi.derived_laws_later.bi. End bi. iris-iris-4.2.0/iris/bi/big_op.v000066400000000000000000004316451460620107300164310ustar00rootroot00000000000000From stdpp Require Import countable fin_sets functions. From iris.algebra Require Export big_op. From iris.algebra Require Import list gmap. From iris.bi Require Import derived_laws_later. From iris.prelude Require Import options. Import interface.bi derived_laws.bi derived_laws_later.bi. (** Notations for unary variants *) Notation "'[∗' 'list]' k ↦ x ∈ l , P" := (big_opL bi_sep (λ k x, P%I) l) : bi_scope. Notation "'[∗' 'list]' x ∈ l , P" := (big_opL bi_sep (λ _ x, P%I) l) : bi_scope. Notation "'[∗]' Ps" := (big_opL bi_sep (λ _ x, x) Ps%I) : bi_scope. Notation "'[∧' 'list]' k ↦ x ∈ l , P" := (big_opL bi_and (λ k x, P%I) l) : bi_scope. Notation "'[∧' 'list]' x ∈ l , P" := (big_opL bi_and (λ _ x, P%I) l) : bi_scope. Notation "'[∧]' Ps" := (big_opL bi_and (λ _ x, x) Ps%I) : bi_scope. Notation "'[∨' 'list]' k ↦ x ∈ l , P" := (big_opL bi_or (λ k x, P%I) l) : bi_scope. Notation "'[∨' 'list]' x ∈ l , P" := (big_opL bi_or (λ _ x, P%I) l) : bi_scope. Notation "'[∨]' Ps" := (big_opL bi_or (λ _ x, x) Ps%I) : bi_scope. Notation "'[∗' 'map]' k ↦ x ∈ m , P" := (big_opM bi_sep (λ k x, P%I) m) : bi_scope. Notation "'[∗' 'map]' x ∈ m , P" := (big_opM bi_sep (λ _ x, P%I) m) : bi_scope. Notation "'[∧' 'map]' k ↦ x ∈ m , P" := (big_opM bi_and (λ k x, P) m) : bi_scope. Notation "'[∧' 'map]' x ∈ m , P" := (big_opM bi_and (λ _ x, P) m) : bi_scope. Notation "'[∗' 'set]' x ∈ X , P" := (big_opS bi_sep (λ x, P%I) X) : bi_scope. Notation "'[∗' 'mset]' x ∈ X , P" := (big_opMS bi_sep (λ x, P%I) X) : bi_scope. (** Definitions and notations for binary variants *) (** 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. Global Instance: Params (@big_sepL2) 3 := {}. Global Arguments big_sepL2 {PROP A B} _ !_ !_ /. Global Typeclasses Opaque big_sepL2. Notation "'[∗' 'list]' k ↦ x1 ; x2 ∈ l1 ; l2 , P" := (big_sepL2 (λ k x1 x2, P%I) l1 l2) : bi_scope. Notation "'[∗' 'list]' x1 ; x2 ∈ l1 ; l2 , P" := (big_sepL2 (λ _ x1 x2, P%I) l1 l2) : bi_scope. Local Definition big_sepM2_def {PROP : bi} `{Countable K} {A B} (Φ : K → A → B → PROP) (m1 : gmap K A) (m2 : gmap K B) : PROP := ⌜ dom m1 = dom m2 ⌝ ∧ [∗ map] k ↦ xy ∈ map_zip m1 m2, Φ k xy.1 xy.2. Local Definition big_sepM2_aux : seal (@big_sepM2_def). Proof. by eexists. Qed. Definition big_sepM2 := big_sepM2_aux.(unseal). Global Arguments big_sepM2 {PROP K _ _ A B} _ _ _. Local Definition big_sepM2_unseal : @big_sepM2 = _ := big_sepM2_aux.(seal_eq). Global Instance: Params (@big_sepM2) 6 := {}. Notation "'[∗' 'map]' k ↦ x1 ; x2 ∈ m1 ; m2 , P" := (big_sepM2 (λ k x1 x2, P%I) m1 m2) : bi_scope. Notation "'[∗' 'map]' x1 ; x2 ∈ m1 ; m2 , P" := (big_sepM2 (λ _ x1 x2, P%I) m1 m2) : bi_scope. (** * Properties *) Section big_op. Context {PROP : bi}. Implicit Types P Q : PROP. 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' P `{!Affine 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_snoc Φ l x : ([∗ list] k↦y ∈ l ++ [x], Φ k y) ⊣⊢ ([∗ list] k↦y ∈ l, Φ k y) ∗ Φ (length l) x. Proof. by rewrite big_opL_snoc. Qed. Lemma big_sepL_take_drop Φ l n : ([∗ list] k ↦ x ∈ l, Φ k x) ⊣⊢ ([∗ list] k ↦ x ∈ take n l, Φ k x) ∗ ([∗ list] k ↦ x ∈ drop n l, Φ (n + k) x). Proof. by rewrite big_opL_take_drop. Qed. Lemma big_sepL_submseteq (Φ : A → PROP) `{!∀ x, Affine (Φ x)} l1 l2 : l1 ⊆+ l2 → ([∗ list] y ∈ l2, Φ y) ⊢ [∗ list] y ∈ l1, Φ y. Proof. intros [l ->]%submseteq_Permutation. rewrite big_sepL_app. induction l as [|x l IH]; simpl; [by rewrite right_id|by rewrite sep_elim_r]. Qed. (** The lemmas [big_sepL_mono], [big_sepL_ne] and [big_sepL_proper] are more generic than the instances as they also give [l !! k = Some y] in the premise. *) 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_gen_proper; apply _. Qed. Lemma big_sepL_ne Φ Ψ l n : (∀ k y, l !! k = Some y → Φ k y ≡{n}≡ Ψ k y) → ([∗ list] k ↦ y ∈ l, Φ k y)%I ≡{n}≡ ([∗ list] k ↦ y ∈ l, Ψ k y)%I. Proof. apply big_opL_ne. 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. (** No need to declare instances for non-expansiveness and properness, we get both from the generic [big_opL] instances. *) 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_sepL_mono; intros; apply Hf. Qed. Global Instance big_sepL_id_mono' : Proper (Forall2 (⊢) ==> (⊢)) (big_opL (@bi_sep PROP) (λ _ P, P)). Proof. by induction 1 as [|P Q Ps Qs HPQ ? IH]; rewrite /= ?HPQ ?IH. Qed. Global Instance big_sepL_nil_persistent Φ : Persistent ([∗ list] k↦x ∈ [], Φ k x). Proof. simpl; apply _. Qed. Lemma big_sepL_persistent Φ l : (∀ k x, l !! k = Some x → Persistent (Φ k x)) → Persistent ([∗ list] k↦x ∈ l, Φ k x). Proof. apply big_opL_closed; apply _. Qed. Global Instance big_sepL_persistent' Φ l : (∀ k x, Persistent (Φ k x)) → Persistent ([∗ list] k↦x ∈ l, Φ k x). Proof. intros; apply big_sepL_persistent, _. 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. Lemma big_sepL_affine Φ l : (∀ k x, l !! k = Some x → Affine (Φ k x)) → Affine ([∗ list] k↦x ∈ l, Φ k x). Proof. apply big_opL_closed; apply _. Qed. Global Instance big_sepL_affine' Φ l : (∀ k x, Affine (Φ k x)) → Affine ([∗ list] k↦x ∈ l, Φ k x). Proof. intros. apply big_sepL_affine, _. Qed. Global Instance big_sepL_affine_id Ps : TCForall Affine Ps → Affine ([∗] Ps). Proof. induction 1; simpl; apply _. Qed. Global Instance big_sepL_nil_timeless `{!Timeless (emp%I : PROP)} Φ : Timeless ([∗ list] k↦x ∈ [], Φ k x). Proof. simpl; apply _. Qed. Lemma big_sepL_timeless `{!Timeless (emp%I : PROP)} Φ l : (∀ k x, l !! k = Some x → Timeless (Φ k x)) → Timeless ([∗ list] k↦x ∈ l, Φ k x). Proof. apply big_opL_closed; 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. intros. apply big_sepL_timeless, _. Qed. Global Instance big_sepL_timeless_id `{!Timeless (emp%I : PROP)} Ps : TCForall Timeless Ps → Timeless ([∗] Ps). Proof. induction 1; simpl; apply _. Qed. Lemma big_sepL_emp l : ([∗ list] k↦y ∈ l, emp) ⊣⊢@{PROP} emp. Proof. by rewrite big_opL_unit. Qed. Lemma big_sepL_insert_acc Φ l i x : l !! i = Some x → ([∗ list] k↦y ∈ l, Φ k y) ⊢ Φ i x ∗ (∀ y, Φ i y -∗ ([∗ list] k↦y ∈ <[i:=y]>l, Φ k y)). Proof. intros Hli. assert (i ≤ length l) by eauto using lookup_lt_Some, Nat.lt_le_incl. rewrite -(take_drop_middle l i x) // big_sepL_app /=. rewrite Nat.add_0_r take_length_le //. rewrite assoc -!(comm _ (Φ _ _)) -assoc. apply sep_mono_r, forall_intro=> y. rewrite insert_app_r_alt ?take_length_le //. rewrite Nat.sub_diag /=. apply wand_intro_l. rewrite assoc !(comm _ (Φ _ _)) -assoc big_sepL_app /=. by rewrite Nat.add_0_r take_length_le. 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. by rewrite {1}big_sepL_insert_acc // (forall_elim x) list_insert_id. Qed. Lemma big_sepL_lookup Φ l i x `{!TCOr (∀ j y, Affine (Φ j y)) (Absorbing (Φ i x))} : l !! i = Some x → ([∗ list] k↦y ∈ l, Φ k y) ⊢ Φ i x. Proof. intros Hi. destruct select (TCOr _ _). - rewrite -(take_drop_middle l i x) // big_sepL_app /= take_length. apply lookup_lt_Some in Hi. rewrite (_ : _ + 0 = i); last lia. rewrite sep_elim_r sep_elim_l //. - rewrite big_sepL_lookup_acc // sep_elim_l //. Qed. Lemma big_sepL_elem_of (Φ : A → PROP) l x `{!TCOr (∀ y, Affine (Φ y)) (Absorbing (Φ x))} : x ∈ l → ([∗ list] y ∈ l, Φ y) ⊢ Φ x. Proof. intros [i ?]%elem_of_list_lookup. destruct select (TCOr _ _); by apply: 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_omap {B} (f : A → option B) (Φ : B → PROP) l : ([∗ list] y ∈ omap f l, Φ y) ⊣⊢ ([∗ list] y ∈ l, from_option Φ emp (f y)). Proof. by rewrite big_opL_omap. Qed. Lemma big_sepL_bind {B} (f : A → list B) (Φ : B → PROP) l : ([∗ list] y ∈ l ≫= f, Φ y) ⊣⊢ ([∗ list] x ∈ l, [∗ list] y ∈ f x, Φ y). Proof. by rewrite big_opL_bind. Qed. Lemma big_sepL_sep Φ Ψ 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_op. Qed. Lemma big_sepL_sep_2 Φ Ψ l : ([∗ list] k↦x ∈ l, Φ k x) -∗ ([∗ list] k↦x ∈ l, Ψ k x) -∗ ([∗ list] k↦x ∈ l, Φ k x ∗ Ψ k x). Proof. apply entails_wand, wand_intro_r. rewrite big_sepL_sep //. 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_pure_1 (φ : nat → A → Prop) l : ([∗ list] k↦x ∈ l, ⌜φ k x⌝) ⊢@{PROP} ⌜∀ k x, l !! k = Some x → φ k x⌝. Proof. induction l as [|x l IH] using rev_ind. { apply pure_intro=>??. rewrite lookup_nil. done. } rewrite big_sepL_snoc // IH sep_and -pure_and. f_equiv=>-[Hl Hx] k y /lookup_app_Some =>-[Hy|[Hlen Hy]]. - by apply Hl. - apply list_lookup_singleton_Some in Hy as [Hk ->]. replace k with (length l) by lia. done. Qed. Lemma big_sepL_affinely_pure_2 (φ : nat → A → Prop) l : ⌜∀ k x, l !! k = Some x → φ k x⌝ ⊢@{PROP} ([∗ list] k↦x ∈ l, ⌜φ k x⌝). Proof. induction l as [|x l IH] using rev_ind. { rewrite big_sepL_nil. apply affinely_elim_emp. } rewrite big_sepL_snoc // -IH. rewrite -persistent_and_sep_1 -affinely_and -pure_and. f_equiv. f_equiv=>- Hlx. split. - intros k y Hy. apply Hlx. rewrite lookup_app Hy //. - apply Hlx. rewrite lookup_app lookup_ge_None_2 //. rewrite Nat.sub_diag //. Qed. (** The general backwards direction requires [BiAffine] to cover the empty case. *) Lemma big_sepL_pure `{!BiAffine PROP} (φ : nat → A → Prop) l : ([∗ list] k↦x ∈ l, ⌜φ k x⌝) ⊣⊢@{PROP} ⌜∀ k x, l !! k = Some x → φ k x⌝. Proof. apply (anti_symm (⊢)); first by apply big_sepL_pure_1. rewrite -(affine_affinely ⌜_⌝). rewrite big_sepL_affinely_pure_2. by setoid_rewrite affinely_elim. Qed. Lemma big_sepL_persistently `{!BiAffine PROP} Φ l : ([∗ list] k↦x ∈ l, Φ k x) ⊣⊢ [∗ list] k↦x ∈ l, (Φ k x). Proof. apply (big_opL_commute _). Qed. Lemma big_sepL_intro Φ l : □ (∀ k x, ⌜l !! k = Some x⌝ → Φ k x) ⊢ [∗ list] k↦x ∈ l, Φ k x. Proof. revert Φ. induction l as [|x l IH]=> Φ /=; [by apply (affine _)|]. rewrite intuitionistically_sep_dup. f_equiv. - rewrite (forall_elim 0) (forall_elim x) pure_True // True_impl. by rewrite intuitionistically_elim. - rewrite -IH. f_equiv. apply forall_intro=> k; by rewrite (forall_elim (S k)). 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Φ /=. { apply: affine. } rewrite -persistent_and_sep_1. apply and_intro. - rewrite (forall_elim 0) (forall_elim x) pure_True // True_impl. done. - 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 entails_wand, wand_intro_l. rewrite big_sepL_intro -big_sepL_sep. by setoid_rewrite wand_elim_l. Qed. Lemma big_sepL_wand Φ Ψ l : ([∗ list] k↦x ∈ l, Φ k x) -∗ ([∗ list] k↦x ∈ l, Φ k x -∗ Ψ k x) -∗ [∗ list] k↦x ∈ l, Ψ k x. Proof. apply entails_wand, wand_intro_r. rewrite -big_sepL_sep. setoid_rewrite wand_elim_r. done. Qed. Lemma big_sepL_dup P `{!Affine P} l : □ (P -∗ P ∗ P) -∗ P -∗ [∗ list] k↦x ∈ l, P. Proof. apply entails_wand, wand_intro_l. induction l as [|x l IH]=> /=; first by apply: affine. rewrite intuitionistically_sep_dup {1}intuitionistically_elim. rewrite assoc wand_elim_r -assoc. apply sep_mono; done. 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. Lemma big_sepL_lookup_acc_impl {Φ l} i x : l !! i = Some x → ([∗ list] k↦y ∈ l, Φ k y) -∗ (* We obtain [Φ] for [x] *) Φ i x ∗ (* We reobtain the bigop for a predicate [Ψ] selected by the user *) ∀ Ψ, □ (∀ k y, ⌜ l !! k = Some y ⌝ → ⌜ k ≠ i ⌝ → Φ k y -∗ Ψ k y) -∗ Ψ i x -∗ [∗ list] k↦y ∈ l, Ψ k y. Proof. intros. apply entails_wand. rewrite big_sepL_delete //. apply sep_mono_r, forall_intro=> Ψ. apply wand_intro_r, wand_intro_l. rewrite (big_sepL_delete Ψ l i x) //. apply sep_mono_r. eapply wand_apply; [apply wand_entails, big_sepL_impl|apply sep_mono_r]. apply intuitionistically_intro', forall_intro=> k; apply forall_intro=> y. apply impl_intro_l, pure_elim_l=> ?; apply wand_intro_r. rewrite (forall_elim ) (forall_elim y) pure_True // left_id. destruct (decide _) as [->|]; [by apply: affine|]. by rewrite pure_True //left_id intuitionistically_elim wand_elim_l. Qed. Lemma big_sepL_replicate l P : [∗] replicate (length l) P ⊣⊢ [∗ list] y ∈ l, P. Proof. induction l as [|x l]=> //=; by f_equiv. Qed. 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. End sep_list. (* Some lemmas depend on the generalized versions of the above ones. *) Lemma big_sepL_sep_zip_with {A B C} (f : A → B → C) (g1 : C → A) (g2 : C → B) (Φ1 : nat → A → PROP) (Φ2 : nat → B → PROP) l1 l2 : (∀ x y, g1 (f x y) = x) → (∀ x y, g2 (f x y) = y) → length l1 = length l2 → ([∗ list] k↦xy ∈ zip_with f l1 l2, Φ1 k (g1 xy) ∗ Φ2 k (g2 xy)) ⊣⊢ ([∗ list] k↦x ∈ l1, Φ1 k x) ∗ ([∗ list] k↦y ∈ l2, Φ2 k y). Proof. apply big_opL_sep_zip_with. Qed. Lemma big_sepL_sep_zip {A B} (Φ1 : nat → A → PROP) (Φ2 : nat → B → PROP) l1 l2 : length l1 = length l2 → ([∗ list] k↦xy ∈ zip l1 l2, Φ1 k xy.1 ∗ Φ2 k xy.2) ⊣⊢ ([∗ list] k↦x ∈ l1, Φ1 k x) ∗ ([∗ list] k↦y ∈ l2, Φ2 k y). Proof. apply big_opL_sep_zip. Qed. Lemma big_sepL_zip_with {A B C} (Φ : nat → A → PROP) 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. (** ** Big ops over two lists *) 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 ↦ xy ∈ zip l1 l2, Φ k (xy.1) (xy.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. 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' P `{!Affine P} Φ : P ⊢ [∗ list] k↦y1;y2 ∈ [];[], Φ k y1 y2. Proof. apply: affine. Qed. Lemma big_sepL2_nil_inv_l Φ l2 : ([∗ list] k↦y1;y2 ∈ []; l2, Φ k y1 y2) ⊢ ⌜l2 = []⌝. Proof. destruct l2; simpl; auto using False_elim, pure_intro. Qed. Lemma big_sepL2_nil_inv_r Φ l1 : ([∗ list] k↦y1;y2 ∈ l1; [], Φ k y1 y2) ⊢ ⌜l1 = []⌝. Proof. destruct l1; simpl; auto using False_elim, pure_intro. 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_fst_snd Φ l : ([∗ list] k↦y1;y2 ∈ l.*1; l.*2, Φ k y1 y2) ⊣⊢ [∗ list] k ↦ xy ∈ l, Φ k (xy.1) (xy.2). Proof. rewrite big_sepL2_alt !fmap_length. by rewrite pure_True // True_and zip_fst_snd. 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_app_inv Φ l1 l2 l1' l2' : length l1 = length l1' ∨ length l2 = length l2' → ([∗ list] k↦y1;y2 ∈ l1 ++ l2; l1' ++ l2', Φ k y1 y2) ⊢ ([∗ list] k↦y1;y2 ∈ l1; l1', Φ k y1 y2) ∗ ([∗ list] k↦y1;y2 ∈ l2; l2', Φ (length l1 + k)%nat y1 y2). Proof. revert Φ l1'. induction l1 as [|x1 l1 IH]=> Φ -[|x1' l1'] /= Hlen. - by rewrite left_id. - destruct Hlen as [[=]|Hlen]. rewrite big_sepL2_length Hlen /= app_length. apply pure_elim'; lia. - destruct Hlen as [[=]|Hlen]. rewrite big_sepL2_length -Hlen /= app_length. apply pure_elim'; lia. - by rewrite -assoc IH; last lia. Qed. Lemma big_sepL2_app_same_length Φ l1 l2 l1' l2' : length l1 = length l1' ∨ length l2 = length l2' → ([∗ list] k↦y1;y2 ∈ l1 ++ l2; l1' ++ l2', Φ k y1 y2) ⊣⊢ ([∗ list] k↦y1;y2 ∈ l1; l1', Φ k y1 y2) ∗ ([∗ list] k↦y1;y2 ∈ l2; l2', Φ (length l1 + k)%nat y1 y2). Proof. intros. apply (anti_symm _). - by apply big_sepL2_app_inv. - apply wand_elim_l', big_sepL2_app. Qed. Lemma big_sepL2_snoc Φ x1 x2 l1 l2 : ([∗ list] k↦y1;y2 ∈ l1 ++ [x1]; l2 ++ [x2], Φ k y1 y2) ⊣⊢ ([∗ list] k↦y1;y2 ∈ l1; l2, Φ k y1 y2) ∗ Φ (length l1) x1 x2. Proof. rewrite big_sepL2_app_same_length; last by auto. by rewrite big_sepL2_singleton Nat.add_0_r. Qed. (** The lemmas [big_sepL2_mono], [big_sepL2_ne] and [big_sepL2_proper] are more generic than the instances as they also give [li !! k = Some yi] in the premise. *) 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_ne Φ Ψ l1 l2 n : (∀ k y1 y2, l1 !! k = Some y1 → l2 !! k = Some y2 → Φ k y1 y2 ≡{n}≡ Ψ k y1 y2) → ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2)%I ≡{n}≡ ([∗ list] k ↦ y1;y2 ∈ l1;l2, Ψ k y1 y2)%I. Proof. intros H. rewrite !big_sepL2_alt. f_equiv. apply big_sepL_ne=> 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_1_1, equiv_entails_1_2. Qed. Lemma big_sepL2_proper_2 `{!Equiv A, !Equiv B} Φ Ψ l1 l2 l1' l2' : l1 ≡ l1' → l2 ≡ l2' → (∀ k y1 y1' y2 y2', l1 !! k = Some y1 → l1' !! k = Some y1' → y1 ≡ y1' → l2 !! k = Some y2 → l2' !! k = Some y2' → y2 ≡ 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 Hl1 Hl2 Hf. rewrite !big_sepL2_alt. f_equiv. { do 2 f_equiv; by apply length_proper. } apply big_opL_proper_2; [by f_equiv|]. intros k [x1 y1] [x2 y2] (?&?&[=<- <-]&?&?)%lookup_zip_with_Some (?&?&[=<- <-]&?&?)%lookup_zip_with_Some [??]; naive_solver. 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 f g Hf l1 ? <- l2 ? <-. apply big_sepL2_ne; intros; apply Hf. 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. (** Shows that some property [P] is closed under [big_sepL2]. Examples of [P] are [Persistent], [Affine], [Timeless]. *) Lemma big_sepL2_closed (P : PROP → Prop) Φ l1 l2 : P emp%I → P False%I → (∀ Q1 Q2, P Q1 → P Q2 → P (Q1 ∗ Q2)%I) → (∀ k x1 x2, l1 !! k = Some x1 → l2 !! k = Some x2 → P (Φ k x1 x2)) → P ([∗ list] k↦x1;x2 ∈ l1; l2, Φ k x1 x2)%I. Proof. intros ?? Hsep. revert l2 Φ. induction l1 as [|x1 l1 IH]=> -[|x2 l2] Φ HΦ //=. apply Hsep; first by auto. apply IH=> k. apply (HΦ (S k)). Qed. Global Instance big_sepL2_nil_persistent Φ : Persistent ([∗ list] k↦y1;y2 ∈ []; [], Φ k y1 y2). Proof. simpl; apply _. Qed. Lemma big_sepL2_persistent Φ l1 l2 : (∀ k x1 x2, l1 !! k = Some x1 → l2 !! k = Some x2 → Persistent (Φ k x1 x2)) → Persistent ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2). Proof. apply big_sepL2_closed; 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. intros; apply big_sepL2_persistent, _. Qed. Global Instance big_sepL2_nil_affine Φ : Affine ([∗ list] k↦y1;y2 ∈ []; [], Φ k y1 y2). Proof. simpl; apply _. Qed. Lemma big_sepL2_affine Φ l1 l2 : (∀ k x1 x2, l1 !! k = Some x1 → l2 !! k = Some x2 → Affine (Φ k x1 x2)) → Affine ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2). Proof. apply big_sepL2_closed; 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. intros; apply big_sepL2_affine, _. Qed. Global Instance big_sepL2_nil_timeless `{!Timeless (emp%I : PROP)} Φ : Timeless ([∗ list] k↦y1;y2 ∈ []; [], Φ k y1 y2). Proof. simpl; apply _. Qed. Lemma big_sepL2_timeless `{!Timeless (emp%I : PROP)} Φ l1 l2 : (∀ k x1 x2, l1 !! k = Some x1 → l2 !! k = Some x2 → Timeless (Φ k x1 x2)) → Timeless ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2). Proof. apply big_sepL2_closed; 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. intros; apply big_sepL2_timeless, _. Qed. Lemma big_sepL2_insert_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 ∗ (∀ y1 y2, Φ i y1 y2 -∗ ([∗ list] k↦y1;y2 ∈ <[i:=y1]>l1;<[i:=y2]>l2, Φ k y1 y2)). Proof. intros Hl1 Hl2. rewrite big_sepL2_alt. apply pure_elim_l=> Hl. rewrite {1}big_sepL_insert_acc; last by rewrite lookup_zip_with; simplify_option_eq. apply sep_mono_r. apply forall_intro => y1. apply forall_intro => y2. rewrite big_sepL2_alt !insert_length pure_True // left_id -insert_zip_with. by rewrite (forall_elim (y1, y2)). 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. rewrite {1}big_sepL2_insert_acc // (forall_elim x1) (forall_elim x2). by rewrite !list_insert_id. Qed. Lemma big_sepL2_lookup Φ l1 l2 i x1 x2 `{!TCOr (∀ j y1 y2, Affine (Φ j y1 y2)) (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 Hx1 Hx2. destruct select (TCOr _ _). - rewrite -(take_drop_middle l1 i x1) // -(take_drop_middle l2 i x2) //. apply lookup_lt_Some in Hx1. apply lookup_lt_Some in Hx2. rewrite big_sepL2_app_same_length /= 2?take_length; last lia. rewrite (_ : _ + 0 = i); last lia. rewrite sep_elim_r sep_elim_l //. - rewrite big_sepL2_lookup_acc // 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_reverse_2 (Φ : A → B → PROP) l1 l2 : ([∗ list] y1;y2 ∈ l1;l2, Φ y1 y2) ⊢ ([∗ list] y1;y2 ∈ reverse l1;reverse l2, Φ y1 y2). Proof. revert l2. induction l1 as [|x1 l1 IH]; intros [|x2 l2]; simpl; auto using False_elim. rewrite !reverse_cons (comm bi_sep) IH. by rewrite (big_sepL2_app _ _ [x1] _ [x2]) big_sepL2_singleton wand_elim_l. Qed. Lemma big_sepL2_reverse (Φ : A → B → PROP) l1 l2 : ([∗ list] y1;y2 ∈ reverse l1;reverse l2, Φ y1 y2) ⊣⊢ ([∗ list] y1;y2 ∈ l1;l2, Φ y1 y2). Proof. apply (anti_symm _); by rewrite big_sepL2_reverse_2 ?reverse_involutive. Qed. Lemma big_sepL2_replicate_l l x Φ n : length l = n → ([∗ list] k↦x1;x2 ∈ replicate n x; l, Φ k x1 x2) ⊣⊢ [∗ list] k↦x2 ∈ l, Φ k x x2. Proof. intros <-. revert Φ. induction l as [|y l IH]=> //= Φ. by rewrite IH. Qed. Lemma big_sepL2_replicate_r l x Φ n : length l = n → ([∗ list] k↦x1;x2 ∈ l;replicate n x, Φ k x1 x2) ⊣⊢ [∗ list] k↦x1 ∈ l, Φ k x1 x. Proof. intros <-. revert Φ. induction l as [|y l IH]=> //= Φ. by rewrite IH. Qed. Lemma big_sepL2_sep Φ Ψ 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_sep !persistent_and_affinely_sep_l. rewrite -assoc (assoc _ _ ( _)%I). rewrite -(comm bi_sep ( _)%I). rewrite -assoc (assoc _ _ ( _)%I) -!persistent_and_affinely_sep_l. by rewrite affinely_and_r persistent_and_affinely_sep_l idemp. Qed. Lemma big_sepL2_sep_2 Φ Ψ l1 l2 : ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2) -∗ ([∗ list] k↦y1;y2 ∈ l1;l2, Ψ k y1 y2) -∗ ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2 ∗ Ψ k y1 y2). Proof. apply entails_wand, wand_intro_r. rewrite big_sepL2_sep //. 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_pure_1 (φ : nat → A → B → Prop) l1 l2 : ([∗ list] k↦y1;y2 ∈ l1;l2, ⌜φ k y1 y2⌝) ⊢@{PROP} ⌜∀ k y1 y2, l1 !! k = Some y1 → l2 !! k = Some y2 → φ k y1 y2⌝. Proof. rewrite big_sepL2_alt big_sepL_pure_1. rewrite -pure_and. f_equiv=>-[Hlen Hlookup] k y1 y2 Hy1 Hy2. eapply (Hlookup k (y1, y2)). rewrite lookup_zip_with Hy1 /= Hy2 /= //. Qed. Lemma big_sepL2_affinely_pure_2 (φ : nat → A → B → Prop) l1 l2 : length l1 = length l2 → ⌜∀ k y1 y2, l1 !! k = Some y1 → l2 !! k = Some y2 → φ k y1 y2⌝ ⊢@{PROP} ([∗ list] k↦y1;y2 ∈ l1;l2, ⌜φ k y1 y2⌝). Proof. intros Hdom. rewrite big_sepL2_alt. rewrite -big_sepL_affinely_pure_2. rewrite affinely_and_r -pure_and. f_equiv. f_equiv=>-Hforall. split; first done. intros k [y1 y2] (? & ? & [= <- <-] & Hy1 & Hy2)%lookup_zip_with_Some. by eapply Hforall. Qed. (** The general backwards direction requires [BiAffine] to cover the empty case. *) Lemma big_sepL2_pure `{!BiAffine PROP} (φ : nat → A → B → Prop) l1 l2 : ([∗ list] k↦y1;y2 ∈ l1;l2, ⌜φ k y1 y2⌝) ⊣⊢@{PROP} ⌜length l1 = length l2 ∧ ∀ k y1 y2, l1 !! k = Some y1 → l2 !! k = Some y2 → φ k y1 y2⌝. Proof. apply (anti_symm (⊢)). { rewrite pure_and. apply and_intro. - apply big_sepL2_length. - apply big_sepL2_pure_1. } rewrite -(affine_affinely ⌜_⌝%I). rewrite pure_and -affinely_and_r. apply pure_elim_l=>Hdom. rewrite big_sepL2_affinely_pure_2 //. by setoid_rewrite affinely_elim. Qed. Lemma big_sepL2_persistently `{!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 persistently_and persistently_pure big_sepL_persistently. Qed. Lemma big_sepL2_intro Φ l1 l2 : length l1 = length l2 → □ (∀ k x1 x2, ⌜l1 !! k = Some x1⌝ → ⌜l2 !! k = Some x2⌝ → Φ k x1 x2) ⊢ [∗ list] k↦x1;x2 ∈ l1;l2, Φ k x1 x2. Proof. revert l2 Φ. induction l1 as [|x1 l1 IH]=> -[|x2 l2] Φ ?; simplify_eq/=. { by apply (affine _). } rewrite intuitionistically_sep_dup. f_equiv. - rewrite (forall_elim 0) (forall_elim x1) (forall_elim x2). by rewrite !pure_True // !True_impl intuitionistically_elim. - rewrite -IH //. f_equiv. by apply forall_intro=> k; by rewrite (forall_elim (S k)). Qed. Lemma big_sepL2_forall `{!BiAffine PROP} Φ l1 l2 : (∀ k x1 x2, Persistent (Φ k x1 x2)) → ([∗ list] k↦x1;x2 ∈ l1;l2, Φ k x1 x2) ⊣⊢ ⌜length l1 = length l2⌝ ∧ (∀ k x1 x2, ⌜l1 !! k = Some x1⌝ → ⌜l2 !! k = Some x2⌝ → Φ k x1 x2). Proof. intros HΦ. apply (anti_symm _). { apply and_intro; [apply big_sepL2_length|]. apply forall_intro=> k. apply forall_intro=> x1. apply forall_intro=> x2. do 2 (apply impl_intro_l; apply pure_elim_l=> ?). by apply: big_sepL2_lookup. } apply pure_elim_l=> Hlen. revert l2 Φ HΦ Hlen. induction l1 as [|x1 l1 IH]=> -[|x2 l2] Φ HΦ Hlen; simplify_eq/=. { by apply (affine _). } rewrite -persistent_and_sep_1. apply and_intro. - rewrite (forall_elim 0) (forall_elim x1) (forall_elim x2). by rewrite !pure_True // !True_impl. - rewrite -IH //. by apply forall_intro=> k; by rewrite (forall_elim (S k)). 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 entails_wand. rewrite -(idemp bi_and (big_sepL2 _ _ _)) {1}big_sepL2_length. apply pure_elim_l=> ?. rewrite big_sepL2_intro //. apply bi.wand_intro_l. rewrite -big_sepL2_sep. by setoid_rewrite wand_elim_l. Qed. Lemma big_sepL2_wand Φ Ψ l1 l2 : ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2) -∗ ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2 -∗ Ψ k y1 y2) -∗ [∗ list] k↦y1;y2 ∈ l1;l2, Ψ k y1 y2. Proof. apply entails_wand, wand_intro_r. rewrite -big_sepL2_sep. setoid_rewrite wand_elim_r. done. Qed. Lemma big_sepL2_delete Φ 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 ∗ [∗ list] k↦y1;y2 ∈ l1;l2, if decide (k = i) then emp else Φ k y1 y2. Proof. intros. rewrite -(take_drop_middle l1 i x1) // -(take_drop_middle l2 i x2) //. assert (i < length l1 ∧ i < length l2) as [??] by eauto using lookup_lt_Some. rewrite !big_sepL2_app_same_length /=; [|rewrite ?take_length; lia..]. rewrite Nat.add_0_r take_length_le; [|lia]. rewrite decide_True // left_id. rewrite assoc -!(comm _ (Φ _ _ _)) -assoc. do 2 f_equiv. - apply big_sepL2_proper=> k y1 y2 Hk. apply lookup_lt_Some in Hk. rewrite take_length in Hk. by rewrite decide_False; last lia. - apply big_sepL2_proper=> k y1 y2 _. by rewrite decide_False; last lia. Qed. Lemma big_sepL2_delete' `{!BiAffine PROP} Φ 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 ∗ [∗ list] k↦y1;y2 ∈ l1;l2, ⌜ k ≠ i ⌝ → Φ k y1 y2. Proof. intros. rewrite big_sepL2_delete //. (do 2 f_equiv)=> k y1 y2. rewrite -decide_emp. by repeat case_decide. Qed. Lemma big_sepL2_lookup_acc_impl {Φ l1 l2} i x1 x2 : l1 !! i = Some x1 → l2 !! i = Some x2 → ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2) -∗ (* We obtain [Φ] for the [x1] and [x2] *) Φ i x1 x2 ∗ (* We reobtain the bigop for a predicate [Ψ] selected by the user *) ∀ Ψ, □ (∀ k y1 y2, ⌜ l1 !! k = Some y1 ⌝ → ⌜ l2 !! k = Some y2 ⌝ → ⌜ k ≠ i ⌝ → Φ k y1 y2 -∗ Ψ k y1 y2) -∗ Ψ i x1 x2 -∗ [∗ list] k↦y1;y2 ∈ l1;l2, Ψ k y1 y2. Proof. intros. rewrite big_sepL2_delete //. apply entails_wand, sep_mono_r, forall_intro=> Ψ. apply wand_intro_r, wand_intro_l. rewrite (big_sepL2_delete Ψ l1 l2 i) //. apply sep_mono_r. eapply wand_apply; [apply wand_entails, big_sepL2_impl|apply sep_mono_r]. apply intuitionistically_intro', forall_intro=> k; apply forall_intro=> y1; apply forall_intro=> y2. do 2 (apply impl_intro_l, pure_elim_l=> ?); apply wand_intro_r. rewrite (forall_elim k) (forall_elim y1) (forall_elim y2). rewrite !(pure_True (_ = Some _)) // !left_id. destruct (decide _) as [->|]; [by apply: affine|]. by rewrite pure_True //left_id intuitionistically_elim wand_elim_l. Qed. Lemma big_sepL2_later_1 `{!BiAffine PROP} Φ 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 later_and big_sepL_later (timeless ⌜ _ ⌝). rewrite except_0_and. auto using and_mono, except_0_intro. Qed. 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 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 laterN_and big_sepL_laterN_2. auto using and_mono, laterN_intro. Qed. Lemma big_sepL2_flip Φ l1 l2 : ([∗ list] k↦y1;y2 ∈ l2; l1, Φ k y2 y1) ⊣⊢ ([∗ list] k↦y1;y2 ∈ l1; l2, Φ k y1 y2). Proof. revert Φ l2. induction l1 as [|x1 l1 IH]=> Φ -[|x2 l2]//=; simplify_eq. by rewrite IH. Qed. Lemma big_sepL2_sepL (Φ1 : nat → A → PROP) (Φ2 : nat → B → PROP) l1 l2 : length l1 = length l2 → ([∗ list] k↦y1;y2 ∈ l1;l2, Φ1 k y1 ∗ Φ2 k y2) ⊣⊢ ([∗ list] k↦y1 ∈ l1, Φ1 k y1) ∗ ([∗ list] k↦y2 ∈ l2, Φ2 k y2). Proof. intros. rewrite -big_sepL_sep_zip // big_sepL2_alt pure_True // left_id //. Qed. Lemma big_sepL2_sepL_2 (Φ1 : nat → A → PROP) (Φ2 : nat → B → PROP) l1 l2 : length l1 = length l2 → ([∗ list] k↦y1 ∈ l1, Φ1 k y1) -∗ ([∗ list] k↦y2 ∈ l2, Φ2 k y2) -∗ [∗ list] k↦y1;y2 ∈ l1;l2, Φ1 k y1 ∗ Φ2 k y2. Proof. intros. apply entails_wand, wand_intro_r. by rewrite big_sepL2_sepL. Qed. End sep_list2. Lemma big_sepL2_const_sepL_l {A B} (Φ : nat → A → PROP) (l1 : list A) (l2 : list B) : ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1) ⊣⊢ ⌜length l1 = length l2⌝ ∧ ([∗ list] k↦y1 ∈ l1, Φ k y1). Proof. rewrite big_sepL2_alt. trans (⌜length l1 = length l2⌝ ∧ [∗ list] k↦y1 ∈ (zip l1 l2).*1, Φ k y1)%I. { rewrite big_sepL_fmap //. } apply (anti_symm (⊢)); apply pure_elim_l=> Hl; rewrite fst_zip; rewrite ?Hl //; (apply and_intro; [by apply pure_intro|done]). Qed. Lemma big_sepL2_const_sepL_r {A B} (Φ : nat → B → PROP) (l1 : list A) (l2 : list B) : ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y2) ⊣⊢ ⌜length l1 = length l2⌝ ∧ ([∗ list] k↦y2 ∈ l2, Φ k y2). Proof. by rewrite big_sepL2_flip big_sepL2_const_sepL_l (symmetry_iff (=)). Qed. Lemma big_sepL2_sep_sepL_l {A B} (Φ : nat → A → PROP) (Ψ : nat → A → B → PROP) l1 l2 : ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 ∗ Ψ k y1 y2) ⊣⊢ ([∗ list] k↦y1 ∈ l1, Φ k y1) ∗ ([∗ list] k↦y1;y2 ∈ l1;l2, Ψ k y1 y2). Proof. rewrite big_sepL2_sep big_sepL2_const_sepL_l. apply (anti_symm _). { rewrite and_elim_r. done. } rewrite !big_sepL2_alt [(_ ∗ _)%I]comm -!persistent_and_sep_assoc. apply pure_elim_l=>Hl. apply and_intro. { apply pure_intro. done. } rewrite [(_ ∗ _)%I]comm. apply sep_mono; first done. apply and_intro; last done. apply pure_intro. done. Qed. Lemma big_sepL2_sep_sepL_r {A B} (Φ : nat → A → B → PROP) (Ψ : nat → B → PROP) l1 l2 : ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2 ∗ Ψ k y2) ⊣⊢ ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2) ∗ ([∗ list] k↦y2 ∈ l2, Ψ k y2). Proof. rewrite !(big_sepL2_flip _ _ l1). setoid_rewrite (comm bi_sep). by rewrite big_sepL2_sep_sepL_l. Qed. Lemma big_sepL_sepL2_diag {A} (Φ : nat → A → A → PROP) (l : list A) : ([∗ list] k↦y ∈ l, Φ k y y) ⊢ ([∗ list] k↦y1;y2 ∈ l;l, Φ k y1 y2). Proof. rewrite big_sepL2_alt. rewrite pure_True // left_id. rewrite zip_diag big_sepL_fmap /=. done. Qed. Lemma big_sepL2_ne_2 {A B : ofe} (Φ Ψ : nat → A → B → PROP) l1 l2 l1' l2' n : l1 ≡{n}≡ l1' → l2 ≡{n}≡ l2' → (∀ k y1 y1' y2 y2', l1 !! k = Some y1 → l1' !! k = Some y1' → y1 ≡{n}≡ y1' → l2 !! k = Some y2 → l2' !! k = Some y2' → y2 ≡{n}≡ y2' → Φ k y1 y2 ≡{n}≡ Ψ k y1' y2') → ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2)%I ≡{n}≡ ([∗ list] k ↦ y1;y2 ∈ l1';l2', Ψ k y1 y2)%I. Proof. intros Hl1 Hl2 Hf. rewrite !big_sepL2_alt. f_equiv. { do 2 f_equiv; by apply: length_ne. } apply big_opL_ne_2; [by f_equiv|]. intros k [x1 y1] [x2 y2] (?&?&[=<- <-]&?&?)%lookup_zip_with_Some (?&?&[=<- <-]&?&?)%lookup_zip_with_Some [??]; naive_solver. Qed. 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_snoc Φ l x : ([∧ list] k↦y ∈ l ++ [x], Φ k y) ⊣⊢ ([∧ list] k↦y ∈ l, Φ k y) ∧ Φ (length l) x. Proof. by rewrite big_opL_snoc. 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. (** The lemmas [big_andL_mono], [big_andL_ne] and [big_andL_proper] are more generic than the instances as they also give [l !! k = Some y] in the premise. *) 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_gen_proper; apply _. Qed. Lemma big_andL_ne Φ Ψ l n : (∀ k y, l !! k = Some y → Φ k y ≡{n}≡ Ψ k y) → ([∧ list] k ↦ y ∈ l, Φ k y)%I ≡{n}≡ ([∧ list] k ↦ y ∈ l, Ψ k y)%I. Proof. apply big_opL_ne. 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. (** No need to declare instances for non-expansiveness and properness, we get both from the generic [big_opL] instances. *) 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_andL_mono; intros; apply Hf. Qed. Global Instance big_andL_id_mono' : Proper (Forall2 (⊢) ==> (⊢)) (big_opL (@bi_and PROP) (λ _ P, P)). Proof. by induction 1 as [|P Q Ps Qs HPQ ? IH]; rewrite /= ?HPQ ?IH. Qed. Global Instance big_andL_nil_absorbing Φ : Absorbing ([∧ list] k↦x ∈ [], Φ k x). Proof. simpl; apply _. Qed. Lemma big_andL_absorbing Φ l : (∀ k x, l !! k = Some x → Absorbing (Φ k x)) → Absorbing ([∧ list] k↦x ∈ l, Φ k x). Proof. apply big_opL_closed; apply _. Qed. Global Instance big_andL_absorbing' Φ l : (∀ k x, Absorbing (Φ k x)) → Absorbing ([∧ list] k↦x ∈ l, Φ k x). Proof. intros; apply big_andL_absorbing, _. Qed. Global Instance big_andL_nil_persistent Φ : Persistent ([∧ list] k↦x ∈ [], Φ k x). Proof. simpl; apply _. Qed. Lemma big_andL_persistent Φ l : (∀ k x, l !! k = Some x → Persistent (Φ k x)) → Persistent ([∧ list] k↦x ∈ l, Φ k x). Proof. apply big_opL_closed; apply _. Qed. Global Instance big_andL_persistent' Φ l : (∀ k x, Persistent (Φ k x)) → Persistent ([∧ list] k↦x ∈ l, Φ k x). Proof. intros; apply big_andL_persistent, _. Qed. Global Instance big_andL_nil_timeless Φ : Timeless ([∧ list] k↦x ∈ [], Φ k x). Proof. simpl; apply _. Qed. Lemma big_andL_timeless Φ l : (∀ k x, l !! k = Some x → Timeless (Φ k x)) → Timeless ([∧ list] k↦x ∈ l, Φ k x). Proof. apply big_opL_closed; apply _. Qed. Global Instance big_andL_timeless' Φ l : (∀ k x, Timeless (Φ k x)) → Timeless ([∧ list] k↦x ∈ l, Φ k x). Proof. intros; apply big_andL_timeless, _. Qed. Lemma big_andL_lookup Φ l 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 : x ∈ l → ([∧ list] y ∈ l, Φ y) ⊢ Φ x. Proof. intros [i ?]%elem_of_list_lookup. by eapply (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_bind {B} (f : A → list B) (Φ : B → PROP) l : ([∧ list] y ∈ l ≫= f, Φ y) ⊣⊢ ([∧ list] x ∈ l, [∧ list] y ∈ f x, Φ y). Proof. by rewrite big_opL_bind. 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. by rewrite big_opL_op. Qed. Lemma big_andL_persistently Φ l : ([∧ list] k↦x ∈ l, Φ k x) ⊣⊢ [∧ list] k↦x ∈ l, (Φ k x). Proof. apply (big_opL_commute _). Qed. Lemma big_andL_forall Φ 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. Lemma big_andL_intro Φ l : (∀ k x, ⌜l !! k = Some x⌝ → Φ k x) ⊢ [∧ list] k↦x ∈ l, Φ k x. Proof. rewrite big_andL_forall //. Qed. Lemma big_andL_impl Φ Ψ m : ([∧ list] k↦x ∈ m, Φ k x) ∧ (∀ k x, ⌜m !! k = Some x⌝ → Φ k x → Ψ k x) ⊢ [∧ list] k↦x ∈ m, Ψ k x. Proof. rewrite -big_andL_forall -big_andL_and. by setoid_rewrite bi.impl_elim_r. Qed. Lemma big_andL_pure_1 (φ : nat → A → Prop) l : ([∧ list] k↦x ∈ l, ⌜φ k x⌝) ⊢@{PROP} ⌜∀ k x, l !! k = Some x → φ k x⌝. Proof. induction l as [|x l IH] using rev_ind. { apply pure_intro=>??. rewrite lookup_nil. done. } rewrite big_andL_snoc // IH -pure_and. f_equiv=>-[Hl Hx] k y /lookup_app_Some =>-[Hy|[Hlen Hy]]. - by apply Hl. - apply list_lookup_singleton_Some in Hy as [Hk ->]. replace k with (length l) by lia. done. Qed. Lemma big_andL_pure_2 (φ : nat → A → Prop) l : ⌜∀ k x, l !! k = Some x → φ k x⌝ ⊢@{PROP} ([∧ list] k↦x ∈ l, ⌜φ k x⌝). Proof. rewrite big_andL_forall pure_forall_1. f_equiv=>k. rewrite pure_forall_1. f_equiv=>x. apply pure_impl_1. Qed. Lemma big_andL_pure (φ : nat → A → Prop) l : ([∧ list] k↦x ∈ l, ⌜φ k x⌝) ⊣⊢@{PROP} ⌜∀ k x, l !! k = Some x → φ k x⌝. Proof. apply (anti_symm (⊢)); first by apply big_andL_pure_1. apply big_andL_pure_2. Qed. Lemma big_andL_later Φ l : ▷ ([∧ list] k↦x ∈ l, Φ k x) ⊣⊢ ([∧ list] k↦x ∈ l, ▷ Φ k x). Proof. apply (big_opL_commute _). Qed. Lemma big_andL_laterN Φ n l : ▷^n ([∧ list] k↦x ∈ l, Φ k x) ⊣⊢ ([∧ list] k↦x ∈ l, ▷^n Φ k x). Proof. apply (big_opL_commute _). Qed. End and_list. Section or_list. Context {A : Type}. Implicit Types l : list A. Implicit Types Φ Ψ : nat → A → PROP. Lemma big_orL_nil Φ : ([∨ list] k↦y ∈ nil, Φ k y) ⊣⊢ False. Proof. done. Qed. Lemma big_orL_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_orL_singleton Φ x : ([∨ list] k↦y ∈ [x], Φ k y) ⊣⊢ Φ 0 x. Proof. by rewrite big_opL_singleton. Qed. Lemma big_orL_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_orL_snoc Φ l x : ([∨ list] k↦y ∈ l ++ [x], Φ k y) ⊣⊢ ([∨ list] k↦y ∈ l, Φ k y) ∨ Φ (length l) x. Proof. by rewrite big_opL_snoc. Qed. Lemma big_orL_submseteq (Φ : A → PROP) l1 l2 : l1 ⊆+ l2 → ([∨ list] y ∈ l1, Φ y) ⊢ [∨ list] y ∈ l2, Φ y. Proof. intros [l ->]%submseteq_Permutation. by rewrite big_orL_app -or_intro_l. Qed. (** The lemmas [big_orL_mono], [big_orL_ne] and [big_orL_proper] are more generic than the instances as they also give [l !! k = Some y] in the premise. *) Lemma big_orL_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_gen_proper; apply _. Qed. Lemma big_orL_ne Φ Ψ l n : (∀ k y, l !! k = Some y → Φ k y ≡{n}≡ Ψ k y) → ([∨ list] k ↦ y ∈ l, Φ k y)%I ≡{n}≡ ([∨ list] k ↦ y ∈ l, Ψ k y)%I. Proof. apply big_opL_ne. Qed. Lemma big_orL_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. (** No need to declare instances for non-expansiveness and properness, we get both from the generic [big_opL] instances. *) Global Instance big_orL_mono' : Proper (pointwise_relation _ (pointwise_relation _ (⊢)) ==> (=) ==> (⊢)) (big_opL (@bi_or PROP) (A:=A)). Proof. intros f g Hf m ? <-. apply big_orL_mono; intros; apply Hf. Qed. Global Instance big_orL_id_mono' : Proper (Forall2 (⊢) ==> (⊢)) (big_opL (@bi_or PROP) (λ _ P, P)). Proof. by induction 1 as [|P Q Ps Qs HPQ ? IH]; rewrite /= ?HPQ ?IH. Qed. Global Instance big_orL_nil_persistent Φ : Persistent ([∨ list] k↦x ∈ [], Φ k x). Proof. simpl; apply _. Qed. Global Instance big_orL_persistent Φ l : (∀ k x, l !! k = Some x → Persistent (Φ k x)) → Persistent ([∨ list] k↦x ∈ l, Φ k x). Proof. apply big_opL_closed; apply _. Qed. Global Instance big_orL_persistent' Φ l : (∀ k x, Persistent (Φ k x)) → Persistent ([∨ list] k↦x ∈ l, Φ k x). Proof. intros; apply big_orL_persistent, _. Qed. Global Instance big_orL_nil_timeless Φ : Timeless ([∨ list] k↦x ∈ [], Φ k x). Proof. simpl; apply _. Qed. Global Instance big_orL_timeless Φ l : (∀ k x, l !! k = Some x → Timeless (Φ k x)) → Timeless ([∨ list] k↦x ∈ l, Φ k x). Proof. apply big_opL_closed; apply _. Qed. Global Instance big_orL_timeless' Φ l : (∀ k x, Timeless (Φ k x)) → Timeless ([∨ list] k↦x ∈ l, Φ k x). Proof. intros; apply big_orL_timeless, _. Qed. Lemma big_orL_intro Φ l i x : l !! i = Some x → Φ i x ⊢ ([∨ list] k↦y ∈ l, Φ k y). Proof. intros. rewrite -(take_drop_middle l i x) // big_orL_app /=. rewrite Nat.add_0_r take_length_le; eauto using lookup_lt_Some, Nat.lt_le_incl, or_intro_l', or_intro_r'. Qed. Lemma big_orL_elem_of (Φ : A → PROP) l x : x ∈ l → Φ x ⊢ ([∨ list] y ∈ l, Φ y). Proof. intros [i ?]%elem_of_list_lookup; by eapply (big_orL_intro (λ _, Φ)). Qed. Lemma big_orL_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_orL_bind {B} (f : A → list B) (Φ : B → PROP) l : ([∨ list] y ∈ l ≫= f, Φ y) ⊣⊢ ([∨ list] x ∈ l, [∨ list] y ∈ f x, Φ y). Proof. by rewrite big_opL_bind. Qed. Lemma big_orL_or Φ Ψ 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_op. Qed. Lemma big_orL_persistently Φ l : ([∨ list] k↦x ∈ l, Φ k x) ⊣⊢ [∨ list] k↦x ∈ l, (Φ k x). Proof. apply (big_opL_commute _). Qed. Lemma big_orL_exist Φ l : ([∨ list] k↦x ∈ l, Φ k x) ⊣⊢ (∃ k x, ⌜l !! k = Some x⌝ ∧ Φ k x). Proof. apply (anti_symm _). { revert Φ. induction l as [|x l IH]=> Φ. { rewrite big_orL_nil. apply False_elim. } rewrite big_orL_cons. apply or_elim. - by rewrite -(exist_intro 0) -(exist_intro x) pure_True // left_id. - rewrite IH. apply exist_elim=> k. by rewrite -(exist_intro (S k)). } apply exist_elim=> k; apply exist_elim=> x. apply pure_elim_l=> ?. by apply: big_orL_intro. Qed. Lemma big_orL_pure (φ : nat → A → Prop) l : ([∨ list] k↦x ∈ l, ⌜φ k x⌝) ⊣⊢@{PROP} ⌜∃ k x, l !! k = Some x ∧ φ k x⌝. Proof. rewrite big_orL_exist. rewrite pure_exist. apply exist_proper=>k. rewrite pure_exist. apply exist_proper=>x. rewrite -pure_and. done. Qed. Lemma big_orL_sep_l P Φ l : P ∗ ([∨ list] k↦x ∈ l, Φ k x) ⊣⊢ ([∨ list] k↦x ∈ l, P ∗ Φ k x). Proof. rewrite !big_orL_exist sep_exist_l. f_equiv=> k. rewrite sep_exist_l. f_equiv=> x. by rewrite !persistent_and_affinely_sep_l !assoc (comm _ P). Qed. Lemma big_orL_sep_r Q Φ l : ([∨ list] k↦x ∈ l, Φ k x) ∗ Q ⊣⊢ ([∨ list] k↦x ∈ l, Φ k x ∗ Q). Proof. setoid_rewrite (comm bi_sep). apply big_orL_sep_l. Qed. Lemma big_orL_later Φ l : l ≠ [] → ▷ ([∨ list] k↦x ∈ l, Φ k x) ⊣⊢ ([∨ list] k↦x ∈ l, ▷ Φ k x). Proof. apply (big_opL_commute1 _). Qed. Lemma big_orL_laterN Φ n l : l ≠ [] → ▷^n ([∨ list] k↦x ∈ l, Φ k x) ⊣⊢ ([∨ list] k↦x ∈ l, ▷^n Φ k x). Proof. apply (big_opL_commute1 _). Qed. End or_list. (** ** Big ops over finite maps *) Section sep_map. Context `{Countable K} {A : Type}. Implicit Types m : gmap K A. Implicit Types Φ Ψ : K → A → PROP. (** The lemmas [big_sepM_mono], [big_sepM_ne] and [big_sepM_proper] are more generic than the instances as they also give [l !! k = Some y] in the premise. *) 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_gen_proper; apply _ || auto. Qed. Lemma big_sepM_ne Φ Ψ m n : (∀ k x, m !! k = Some x → Φ k x ≡{n}≡ Ψ k x) → ([∗ map] k ↦ x ∈ m, Φ k x)%I ≡{n}≡ ([∗ map] k ↦ x ∈ m, Ψ k x)%I. Proof. apply big_opM_ne. 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. (** No need to declare instances for non-expansiveness and properness, we get both from the generic [big_opM] instances. *) 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; intros; apply Hf. Qed. Global Instance big_sepM_empty_persistent Φ : Persistent ([∗ map] k↦x ∈ ∅, Φ k x). Proof. rewrite big_opM_empty. apply _. Qed. Lemma big_sepM_persistent Φ m : (∀ k x, m !! k = Some x → Persistent (Φ k x)) → Persistent ([∗ map] k↦x ∈ m, Φ k x). Proof. apply big_opM_closed; apply _. Qed. Global Instance big_sepM_persistent' Φ m : (∀ k x, Persistent (Φ k x)) → Persistent ([∗ map] k↦x ∈ m, Φ k x). Proof. intros; apply big_sepM_persistent, _. Qed. Global Instance big_sepM_empty_affine Φ : Affine ([∗ map] k↦x ∈ ∅, Φ k x). Proof. rewrite big_opM_empty. apply _. Qed. Lemma big_sepM_affine Φ m : (∀ k x, m !! k = Some x → Affine (Φ k x)) → Affine ([∗ map] k↦x ∈ m, Φ k x). Proof. apply big_opM_closed; apply _. Qed. Global Instance big_sepM_affine' Φ m : (∀ k x, Affine (Φ k x)) → Affine ([∗ map] k↦x ∈ m, Φ k x). Proof. intros; apply big_sepM_affine, _. Qed. Global Instance big_sepM_empty_timeless `{!Timeless (emp%I : PROP)} Φ : Timeless ([∗ map] k↦x ∈ ∅, Φ k x). Proof. rewrite big_opM_empty. apply _. Qed. Lemma big_sepM_timeless `{!Timeless (emp%I : PROP)} Φ m : (∀ k x, m !! k = Some x → Timeless (Φ k x)) → Timeless ([∗ map] k↦x ∈ m, Φ k x). Proof. apply big_opM_closed; 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_sepM_timeless, _. Qed. (* We place the [Affine] instance after [m1] and [m2], so that manually instantiating [m1] or [m2] in [iApply] does not also implicitly instantiate the [Affine] instance. If it gets instantiated too early, [Φ] is not known, and typeclass inference fails. *) Lemma big_sepM_subseteq Φ m1 m2 `{!∀ k x, Affine (Φ k x)} : m2 ⊆ m1 → ([∗ map] k ↦ x ∈ m1, Φ k x) ⊢ [∗ map] k ↦ x ∈ m2, Φ k x. Proof. intros ?. rewrite -(map_difference_union m2 m1) //. rewrite big_opM_union; last by apply map_disjoint_difference_r. assert (∀ kx, Affine (uncurry Φ kx)) by (intros []; apply _). by rewrite sep_elim_l. Qed. Lemma big_sepM_empty Φ : ([∗ map] k↦x ∈ ∅, Φ k x) ⊣⊢ emp. Proof. by rewrite big_opM_empty. Qed. Lemma big_sepM_empty' P `{!Affine 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_insert_delete Φ m i x : ([∗ map] k↦y ∈ <[i:=x]> m, Φ k y) ⊣⊢ Φ i x ∗ [∗ map] k↦y ∈ delete i m, Φ k y. Proof. apply big_opM_insert_delete. Qed. Lemma big_sepM_insert_2 Φ m i x `{!TCOr (∀ y, Affine (Φ i y)) (Absorbing (Φ i x))} : Φ i x ⊢ ([∗ map] k↦y ∈ m, Φ k y) -∗ [∗ map] k↦y ∈ <[i:=x]> m, Φ k y. Proof. apply wand_intro_r. destruct (m !! i) as [y|] eqn:Hi; last first. { by rewrite -big_sepM_insert. } assert (TCOr (Affine (Φ i y)) (Absorbing (Φ i x))). { destruct select (TCOr _ _); apply _. } rewrite big_sepM_delete // assoc. rewrite (sep_elim_l (Φ i x)) -big_sepM_insert ?lookup_delete //. by rewrite insert_delete_insert. 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 `{!TCOr (∀ j y, Affine (Φ j y)) (Absorbing (Φ i x))} : m !! i = Some x → ([∗ map] k↦y ∈ m, Φ k y) ⊢ Φ i x. Proof. intros Hi. destruct select (TCOr _ _). - rewrite big_sepM_delete // sep_elim_l //. - rewrite big_sepM_lookup_acc // sep_elim_l //. Qed. Lemma big_sepM_lookup_dom (Φ : K → PROP) m i `{!TCOr (∀ j, Affine (Φ j)) (Absorbing (Φ i))} : is_Some (m !! i) → ([∗ map] k↦_ ∈ m, Φ k) ⊢ Φ i. Proof. intros [x ?]. destruct select (TCOr _ _); by apply: big_sepM_lookup. 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_omap {B} (f : A → option B) (Φ : K → B → PROP) m : ([∗ map] k↦y ∈ omap f m, Φ k y) ⊣⊢ ([∗ map] k↦y ∈ m, from_option (Φ k) emp (f y)). Proof. by rewrite big_opM_omap. 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_insert 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_insert big_sepM_insert ?lookup_delete //. Qed. Lemma big_sepM_insert_acc Φ m i x : m !! i = Some x → ([∗ map] k↦y ∈ m, Φ k y) ⊢ Φ i x ∗ (∀ x', Φ i x' -∗ ([∗ map] k↦y ∈ <[i:=x']> m, Φ k y)). Proof. intros ?. rewrite {1}big_sepM_delete //. apply sep_mono; [done|]. apply forall_intro=> x'. rewrite -insert_delete_insert big_sepM_insert ?lookup_delete //. by apply wand_intro_l. 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_filter' (φ : K * A → Prop) `{∀ kx, Decision (φ kx)} Φ m : ([∗ map] k ↦ x ∈ filter φ m, Φ k x) ⊣⊢ ([∗ map] k ↦ x ∈ m, if decide (φ (k, x)) then Φ k x else emp). Proof. apply: big_opM_filter'. Qed. Lemma big_sepM_filter `{!BiAffine PROP} (φ : K * A → Prop) `{∀ kx, Decision (φ kx)} Φ m : ([∗ map] k ↦ x ∈ filter φ m, Φ k x) ⊣⊢ ([∗ map] k ↦ x ∈ m, ⌜φ (k, x)⌝ → Φ k x). Proof. setoid_rewrite <-decide_emp. apply big_sepM_filter'. Qed. Lemma big_sepM_union Φ m1 m2 : m1 ##ₘ m2 → ([∗ map] k↦y ∈ m1 ∪ m2, Φ k y) ⊣⊢ ([∗ map] k↦y ∈ m1, Φ k y) ∗ ([∗ map] k↦y ∈ m2, Φ k y). Proof. apply big_opM_union. Qed. Lemma big_sepM_sep Φ Ψ 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_op. Qed. Lemma big_sepM_sep_2 Φ Ψ m : ([∗ map] k↦x ∈ m, Φ k x) -∗ ([∗ map] k↦x ∈ m, Ψ k x) -∗ ([∗ map] k↦x ∈ m, Φ k x ∗ Ψ k x). Proof. apply entails_wand, wand_intro_r. rewrite big_sepM_sep //. 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_pure_1 (φ : K → A → Prop) m : ([∗ map] k↦x ∈ m, ⌜φ k x⌝) ⊢@{PROP} ⌜map_Forall φ m⌝. Proof. induction m as [|k x m ? IH] using map_ind. { apply pure_intro, map_Forall_empty. } rewrite big_sepM_insert // IH sep_and -pure_and. by rewrite -map_Forall_insert. Qed. Lemma big_sepM_affinely_pure_2 (φ : K → A → Prop) m : ⌜map_Forall φ m⌝ ⊢@{PROP} ([∗ map] k↦x ∈ m, ⌜φ k x⌝). Proof. induction m as [|k x m ? IH] using map_ind. { rewrite big_sepM_empty. apply affinely_elim_emp. } rewrite big_sepM_insert // -IH. by rewrite -persistent_and_sep_1 -affinely_and -pure_and map_Forall_insert. Qed. (** The general backwards direction requires [BiAffine] to cover the empty case. *) Lemma big_sepM_pure `{!BiAffine PROP} (φ : K → A → Prop) m : ([∗ map] k↦x ∈ m, ⌜φ k x⌝) ⊣⊢@{PROP} ⌜map_Forall φ m⌝. Proof. apply (anti_symm (⊢)); first by apply big_sepM_pure_1. rewrite -(affine_affinely ⌜_⌝). rewrite big_sepM_affinely_pure_2. by setoid_rewrite affinely_elim. Qed. Lemma big_sepM_persistently `{!BiAffine PROP} Φ m : ( ([∗ map] k↦x ∈ m, Φ k x)) ⊣⊢ ([∗ map] k↦x ∈ m, (Φ k x)). Proof. apply (big_opM_commute _). Qed. Lemma big_sepM_intro Φ m : □ (∀ k x, ⌜m !! k = Some x⌝ → Φ k x) ⊢ [∗ map] k↦x ∈ m, Φ k x. Proof. revert Φ. induction m as [|i x m ? IH] using map_ind=> Φ. { by rewrite (affine (□ _)) big_sepM_empty. } rewrite big_sepM_insert // intuitionistically_sep_dup. f_equiv. - rewrite (forall_elim i) (forall_elim x) lookup_insert. by rewrite pure_True // True_impl intuitionistically_elim. - rewrite -IH. f_equiv. 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_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 HΦ. apply (anti_symm _). { apply forall_intro=> k; apply forall_intro=> x. apply impl_intro_l, pure_elim_l=> ?; by apply: big_sepM_lookup. } revert Φ HΦ. induction m as [|i x m ? IH] using map_ind=> Φ HΦ. { rewrite big_sepM_empty. apply: affine. } rewrite big_sepM_insert // -persistent_and_sep_1. 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 entails_wand, wand_intro_l. rewrite big_sepM_intro -big_sepM_sep. by setoid_rewrite wand_elim_l. Qed. Lemma big_sepM_wand Φ Ψ m : ([∗ map] k↦x ∈ m, Φ k x) -∗ ([∗ map] k↦x ∈ m, Φ k x -∗ Ψ k x) -∗ [∗ map] k↦x ∈ m, Ψ k x. Proof. apply entails_wand, wand_intro_r. rewrite -big_sepM_sep. setoid_rewrite wand_elim_r. done. Qed. Lemma big_sepM_dup P `{!Affine P} m : □ (P -∗ P ∗ P) -∗ P -∗ [∗ map] k↦x ∈ m, P. Proof. apply entails_wand, wand_intro_l. induction m as [|i x m ? IH] using map_ind. { apply: big_sepM_empty'. } rewrite !big_sepM_insert //. rewrite intuitionistically_sep_dup {1}intuitionistically_elim. rewrite assoc wand_elim_r -assoc. apply sep_mono; done. Qed. Lemma big_sepM_lookup_acc_impl {Φ m} i x : m !! i = Some x → ([∗ map] k↦y ∈ m, Φ k y) -∗ (* We obtain [Φ] for [x] *) Φ i x ∗ (* We reobtain the bigop for a predicate [Ψ] selected by the user *) ∀ Ψ, □ (∀ k y, ⌜ m !! k = Some y ⌝ → ⌜ k ≠ i ⌝ → Φ k y -∗ Ψ k y) -∗ Ψ i x -∗ [∗ map] k↦y ∈ m, Ψ k y. Proof. intros. rewrite big_sepM_delete //. apply entails_wand, sep_mono_r, forall_intro=> Ψ. apply wand_intro_r, wand_intro_l. rewrite (big_sepM_delete Ψ m i x) //. apply sep_mono_r. eapply wand_apply; [apply wand_entails, big_sepM_impl|apply sep_mono_r]. f_equiv; f_equiv=> k; f_equiv=> y. rewrite impl_curry -pure_and lookup_delete_Some. do 2 f_equiv. intros ?; naive_solver. Qed. 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. Lemma big_sepM_map_to_list Φ m : ([∗ map] k↦x ∈ m, Φ k x) ⊣⊢ [∗ list] xk ∈ map_to_list m, Φ (xk.1) (xk.2). Proof. apply big_opM_map_to_list. Qed. Lemma big_sepM_list_to_map Φ l : NoDup l.*1 → ([∗ map] k↦x ∈ list_to_map l, Φ k x) ⊣⊢ [∗ list] xk ∈ l, Φ (xk.1) (xk.2). Proof. apply big_opM_list_to_map. Qed. End sep_map. (* Some lemmas depend on the generalized versions of the above ones. *) Lemma big_sepM_sep_zip_with `{Countable K} {A B C} (f : A → B → C) (g1 : C → A) (g2 : C → B) (Φ1 : K → A → PROP) (Φ2 : K → B → PROP) m1 m2 : (∀ x y, g1 (f x y) = x) → (∀ x y, g2 (f x y) = y) → (∀ k, is_Some (m1 !! k) ↔ is_Some (m2 !! k)) → ([∗ map] k↦xy ∈ map_zip_with f m1 m2, Φ1 k (g1 xy) ∗ Φ2 k (g2 xy)) ⊣⊢ ([∗ map] k↦x ∈ m1, Φ1 k x) ∗ ([∗ map] k↦y ∈ m2, Φ2 k y). Proof. apply big_opM_sep_zip_with. Qed. Lemma big_sepM_sep_zip `{Countable K} {A B} (Φ1 : K → A → PROP) (Φ2 : K → B → PROP) m1 m2 : (∀ k, is_Some (m1 !! k) ↔ is_Some (m2 !! k)) → ([∗ map] k↦xy ∈ map_zip m1 m2, Φ1 k xy.1 ∗ Φ2 k xy.2) ⊣⊢ ([∗ map] k↦x ∈ m1, Φ1 k x) ∗ ([∗ map] k↦y ∈ m2, Φ2 k y). Proof. apply big_opM_sep_zip. Qed. Lemma big_sepM_impl_strong `{Countable K} {A B} (Φ : K → A → PROP) (Ψ : K → B → PROP) (m1 : gmap K A) (m2 : gmap K B) : ([∗ map] k↦x ∈ m1, Φ k x) ⊢ □ (∀ (k : K) (y : B), (if m1 !! k is Some x then Φ k x else emp) -∗ ⌜m2 !! k = Some y⌝ → Ψ k y) -∗ ([∗ map] k↦y ∈ m2, Ψ k y) ∗ ([∗ map] k↦x ∈ filter (λ '(k, _), m2 !! k = None) m1, Φ k x). Proof. apply wand_intro_r. revert m1. induction m2 as [|i y m ? IH] using map_ind=> m1. { rewrite big_sepM_empty left_id sep_elim_l. rewrite map_filter_id //. } rewrite big_sepM_insert; last done. rewrite intuitionistically_sep_dup. rewrite assoc. rewrite (comm _ _ (□ _))%I. rewrite {1}intuitionistically_elim {1}(forall_elim i) {1}(forall_elim y). rewrite lookup_insert pure_True // left_id. destruct (m1 !! i) as [x|] eqn:Hx. - rewrite big_sepM_delete; last done. rewrite assoc assoc wand_elim_l -2!assoc. apply sep_mono_r. assert (filter (λ '(k, _), <[i:=y]> m !! k = None) m1 = filter (λ '(k, _), m !! k = None) (delete i m1)) as ->. { apply map_filter_strong_ext_1=> k z. rewrite lookup_insert_None lookup_delete_Some. naive_solver. } rewrite -IH. do 2 f_equiv. f_equiv=> k. f_equiv=> z. apply wand_intro_r. apply impl_intro_l, pure_elim_l=> ?. assert (i ≠ k) by congruence. rewrite lookup_insert_ne // pure_True // left_id. rewrite lookup_delete_ne // wand_elim_l //. - rewrite left_id -assoc. apply sep_mono_r. assert (filter (λ '(k, _), <[i:=y]> m !! k = None) m1 = filter (λ '(k, _), m !! k = None) m1) as ->. { apply map_filter_strong_ext_1=> k z. rewrite lookup_insert_None. naive_solver. } rewrite -IH. do 2 f_equiv. f_equiv=> k. f_equiv=> z. apply wand_intro_r. apply impl_intro_l, pure_elim_l=> ?. rewrite lookup_insert_ne; last congruence. rewrite pure_True // left_id // wand_elim_l //. Qed. Lemma big_sepM_impl_dom_subseteq `{Countable K} {A B} (Φ : K → A → PROP) (Ψ : K → B → PROP) (m1 : gmap K A) (m2 : gmap K B) : dom m2 ⊆ dom m1 → ([∗ map] k↦x ∈ m1, Φ k x) -∗ □ (∀ (k : K) (x : A) (y : B), ⌜m1 !! k = Some x⌝ → ⌜m2 !! k = Some y⌝ → Φ k x -∗ Ψ k y) -∗ ([∗ map] k↦y ∈ m2, Ψ k y) ∗ ([∗ map] k↦x ∈ filter (λ '(k, _), m2 !! k = None) m1, Φ k x). Proof. intros. apply entails_wand. rewrite big_sepM_impl_strong. apply wand_mono; last done. f_equiv. f_equiv=> k. apply forall_intro=> y. apply wand_intro_r, impl_intro_l, pure_elim_l=> Hlm2. destruct (m1 !! k) as [x|] eqn:Hlm1. - rewrite (forall_elim x) (forall_elim y). do 2 rewrite pure_True // left_id //. apply wand_elim_l. - apply elem_of_dom_2 in Hlm2. apply not_elem_of_dom in Hlm1. set_solver. Qed. Section and_map. Context `{Countable K} {A : Type}. Implicit Types m : gmap K A. Implicit Types Φ Ψ : K → A → PROP. (** The lemmas [big_andM_mono], [big_andM_ne] and [big_andM_proper] are more generic than the instances as they also give [l !! k = Some y] in the premise. *) Lemma big_andM_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_gen_proper; apply _ || auto. Qed. Lemma big_andM_ne Φ Ψ m n : (∀ k x, m !! k = Some x → Φ k x ≡{n}≡ Ψ k x) → ([∧ map] k ↦ x ∈ m, Φ k x)%I ≡{n}≡ ([∧ map] k ↦ x ∈ m, Ψ k x)%I. Proof. apply big_opM_ne. Qed. Lemma big_andM_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. (** No need to declare instances for non-expansiveness and properness, we get both from the generic [big_opM] instances. *) Global Instance big_andM_mono' : Proper (pointwise_relation _ (pointwise_relation _ (⊢)) ==> (=) ==> (⊢)) (big_opM (@bi_and PROP) (K:=K) (A:=A)). Proof. intros f g Hf m ? <-. apply big_andM_mono; intros; apply Hf. Qed. Global Instance big_andM_empty_persistent Φ : Persistent ([∧ map] k↦x ∈ ∅, Φ k x). Proof. rewrite big_opM_empty. apply _. Qed. Lemma big_andM_persistent Φ m : (∀ k x, m !! k = Some x → Persistent (Φ k x)) → Persistent ([∧ map] k↦x ∈ m, Φ k x). Proof. apply big_opM_closed; apply _. Qed. Global Instance big_andM_persistent' Φ m : (∀ k x, Persistent (Φ k x)) → Persistent ([∧ map] k↦x ∈ m, Φ k x). Proof. intros; apply big_andM_persistent, _. Qed. Global Instance big_andM_empty_timeless Φ : Timeless ([∧ map] k↦x ∈ ∅, Φ k x). Proof. rewrite big_opM_empty. apply _. Qed. Lemma big_andM_timeless Φ m : (∀ k x, m !! k = Some x → Timeless (Φ k x)) → Timeless ([∧ map] k↦x ∈ m, Φ k x). Proof. apply big_opM_closed; apply _. Qed. Global Instance big_andM_timeless' Φ m : (∀ k x, Timeless (Φ k x)) → Timeless ([∧ map] k↦x ∈ m, Φ k x). Proof. intros; apply big_andM_timeless, _. Qed. Lemma big_andM_subseteq Φ m1 m2 : m2 ⊆ m1 → ([∧ map] k ↦ x ∈ m1, Φ k x) ⊢ [∧ map] k ↦ x ∈ m2, Φ k x. Proof. intros ?. rewrite -(map_difference_union m2 m1) //. rewrite big_opM_union; last by apply map_disjoint_difference_r. by rewrite and_elim_l. Qed. Lemma big_andM_empty Φ : ([∧ map] k↦x ∈ ∅, Φ k x) ⊣⊢ True. Proof. by rewrite big_opM_empty. Qed. Lemma big_andM_empty' P Φ : P ⊢ [∧ map] k↦x ∈ ∅, Φ k x. Proof. rewrite big_andM_empty. apply: True_intro. Qed. Lemma big_andM_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_andM_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_andM_insert_delete Φ m i x : ([∧ map] k↦y ∈ <[i:=x]> m, Φ k y) ⊣⊢ Φ i x ∧ [∧ map] k↦y ∈ delete i m, Φ k y. Proof. apply big_opM_insert_delete. Qed. Lemma big_andM_insert_2 Φ m i x : Φ i x ∧ ([∧ map] k↦y ∈ m, Φ k y) ⊢ [∧ map] k↦y ∈ <[i:=x]> m, Φ k y. Proof. rewrite big_andM_insert_delete. destruct (m !! i) eqn:Hi; [ | by rewrite delete_notin ]. rewrite big_andM_delete //. apply and_mono_r, and_elim_r. Qed. Lemma big_andM_lookup Φ m i x : m !! i = Some x → ([∧ map] k↦y ∈ m, Φ k y) ⊢ Φ i x. Proof. intros. rewrite -(insert_id m i x) // big_andM_insert_delete. apply and_elim_l. Qed. Lemma big_andM_lookup_dom (Φ : K → PROP) m i : is_Some (m !! i) → ([∧ map] k↦_ ∈ m, Φ k) ⊢ Φ i. Proof. intros [x ?]. by eapply (big_andM_lookup (λ i x, Φ i)). Qed. Lemma big_andM_singleton Φ i x : ([∧ map] k↦y ∈ {[i:=x]}, Φ k y) ⊣⊢ Φ i x. Proof. by rewrite big_opM_singleton. Qed. Lemma big_andM_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_andM_omap {B} (f : A → option B) (Φ : K → B → PROP) m : ([∧ map] k↦y ∈ omap f m, Φ k y) ⊣⊢ ([∧ map] k↦y ∈ m, from_option (Φ k) True (f y)). Proof. by rewrite big_opM_omap. Qed. Lemma big_andM_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_andM_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_andM_filter' (φ : K * A → Prop) `{∀ kx, Decision (φ kx)} Φ m : ([∧ map] k ↦ x ∈ filter φ m, Φ k x) ⊣⊢ ([∧ map] k ↦ x ∈ m, if decide (φ (k, x)) then Φ k x else True). Proof. apply: big_opM_filter'. Qed. Lemma big_andM_filter (φ : K * A → Prop) `{∀ kx, Decision (φ kx)} Φ m : ([∧ map] k ↦ x ∈ filter φ m, Φ k x) ⊣⊢ ([∧ map] k ↦ x ∈ m, ⌜φ (k, x)⌝ → Φ k x). Proof. setoid_rewrite <-decide_bi_True. apply big_andM_filter'. Qed. Lemma big_andM_union Φ m1 m2 : m1 ##ₘ m2 → ([∧ map] k↦y ∈ m1 ∪ m2, Φ k y) ⊣⊢ ([∧ map] k↦y ∈ m1, Φ k y) ∧ ([∧ map] k↦y ∈ m2, Φ k y). Proof. apply big_opM_union. Qed. Lemma big_andM_and Φ Ψ 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_op. Qed. Lemma big_andM_persistently Φ m : ([∧ map] k↦x ∈ m, Φ k x) ⊣⊢ ([∧ map] k↦x ∈ m, (Φ k x)). Proof. apply (big_opM_commute _). Qed. Lemma big_andM_intro Φ m : (∀ k x, ⌜m !! k = Some x⌝ → Φ k x) ⊢ [∧ map] k↦x ∈ m, Φ k x. Proof. revert Φ. induction m as [|i x m ? IH] using map_ind=> Φ. { rewrite big_andM_empty. apply: True_intro. } rewrite big_andM_insert //. apply and_intro. - rewrite (forall_elim i) (forall_elim x) lookup_insert. by rewrite pure_True // True_impl. - rewrite -IH. apply forall_intro=> k. apply forall_intro=> x'. rewrite (forall_elim k) (forall_elim x'). 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_andM_forall Φ m : ([∧ map] k↦x ∈ m, Φ k x) ⊣⊢ (∀ k x, ⌜m !! k = Some x⌝ → Φ k x). Proof. intros. apply (anti_symm _); [| by rewrite -big_andM_intro]. apply forall_intro=> k; apply forall_intro=> x. apply impl_intro_l, pure_elim_l=> ?; by apply: big_andM_lookup. Qed. Lemma big_andM_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. rewrite -big_andM_forall -big_andM_and. by setoid_rewrite bi.impl_elim_r. Qed. Lemma big_andM_pure_1 (φ : K → A → Prop) m : ([∧ map] k↦x ∈ m, ⌜φ k x⌝) ⊢@{PROP} ⌜map_Forall φ m⌝. Proof. induction m as [|k x m ? IH] using map_ind. { apply pure_intro, map_Forall_empty. } rewrite big_andM_insert // IH -pure_and. by rewrite -map_Forall_insert. Qed. Lemma big_andM_pure_2 (φ : K → A → Prop) m : ⌜map_Forall φ m⌝ ⊢@{PROP} ([∧ map] k↦x ∈ m, ⌜φ k x⌝). Proof. rewrite big_andM_forall pure_forall_1. f_equiv=>k. rewrite pure_forall_1. f_equiv=>x. apply pure_impl_1. Qed. Lemma big_andM_pure (φ : K → A → Prop) m : ([∧ map] k↦x ∈ m, ⌜φ k x⌝) ⊣⊢@{PROP} ⌜map_Forall φ m⌝. Proof. apply (anti_symm (⊢)); [ by apply big_andM_pure_1 | by apply big_andM_pure_2]. Qed. Lemma big_andM_later Φ m : ▷ ([∧ map] k↦x ∈ m, Φ k x) ⊣⊢ ([∧ map] k↦x ∈ m, ▷ Φ k x). Proof. apply (big_opM_commute _). Qed. Lemma big_andM_laterN Φ n m : ▷^n ([∧ map] k↦x ∈ m, Φ k x) ⊣⊢ ([∧ map] k↦x ∈ m, ▷^n Φ k x). Proof. apply (big_opM_commute _). Qed. End and_map. (** ** Big ops over two maps *) Lemma big_sepM2_alt `{Countable K} {A B} (Φ : K → A → B → PROP) m1 m2 : ([∗ map] k↦y1;y2 ∈ m1; m2, Φ k y1 y2) ⊣⊢ ⌜ dom m1 = dom m2 ⌝ ∧ [∗ map] k ↦ xy ∈ map_zip m1 m2, Φ k xy.1 xy.2. Proof. by rewrite big_sepM2_unseal. Qed. Section map2. Context `{Countable K} {A B : Type}. Implicit Types Φ Ψ : K → A → B → PROP. Lemma big_sepM2_alt_lookup (Φ : K → A → B → PROP) m1 m2 : ([∗ map] k↦y1;y2 ∈ m1; m2, Φ k y1 y2) ⊣⊢ ⌜ ∀ k, is_Some (m1 !! k) ↔ is_Some (m2 !! k) ⌝ ∧ [∗ map] k ↦ xy ∈ map_zip m1 m2, Φ k xy.1 xy.2. Proof. rewrite big_sepM2_alt set_eq. by setoid_rewrite elem_of_dom. Qed. Lemma big_sepM2_lookup_iff Φ m1 m2 : ([∗ map] k↦y1;y2 ∈ m1; m2, Φ k y1 y2) ⊢ ⌜ ∀ k, is_Some (m1 !! k) ↔ is_Some (m2 !! k) ⌝. Proof. by rewrite big_sepM2_alt_lookup and_elim_l. Qed. Lemma big_sepM2_dom Φ m1 m2 : ([∗ map] k↦y1;y2 ∈ m1; m2, Φ k y1 y2) ⊢ ⌜ dom m1 = dom m2 ⌝. Proof. by rewrite big_sepM2_alt and_elim_l. Qed. Lemma big_sepM2_flip Φ m1 m2 : ([∗ map] k↦y1;y2 ∈ m2; m1, Φ k y2 y1) ⊣⊢ ([∗ map] k↦y1;y2 ∈ m1; m2, Φ k y1 y2). Proof. rewrite !big_sepM2_alt. apply and_proper; [apply pure_proper; naive_solver |]. rewrite -map_zip_with_flip map_zip_with_map_zip big_sepM_fmap. apply big_sepM_proper. by intros k [b a]. Qed. Lemma big_sepM2_empty Φ : ([∗ map] k↦y1;y2 ∈ ∅; ∅, Φ k y1 y2) ⊣⊢ emp. Proof. rewrite big_sepM2_alt map_zip_with_empty big_sepM_empty pure_True ?left_id //. Qed. Lemma big_sepM2_empty' P `{!Affine P} Φ : P ⊢ [∗ map] k↦y1;y2 ∈ ∅;∅, Φ k y1 y2. Proof. rewrite big_sepM2_empty. apply: affine. Qed. Lemma big_sepM2_empty_l m1 Φ : ([∗ map] k↦y1;y2 ∈ m1; ∅, Φ k y1 y2) ⊢ ⌜m1 = ∅⌝. Proof. rewrite big_sepM2_dom dom_empty_L. apply pure_mono, dom_empty_iff_L. Qed. Lemma big_sepM2_empty_r m2 Φ : ([∗ map] k↦y1;y2 ∈ ∅; m2, Φ k y1 y2) ⊢ ⌜m2 = ∅⌝. Proof. rewrite big_sepM2_dom dom_empty_L. apply pure_mono=>?. eapply dom_empty_iff_L. eauto. Qed. Lemma big_sepM2_insert Φ m1 m2 i x1 x2 : m1 !! i = None → m2 !! i = None → ([∗ map] k↦y1;y2 ∈ <[i:=x1]>m1; <[i:=x2]>m2, Φ k y1 y2) ⊣⊢ Φ i x1 x2 ∗ [∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2. Proof. intros Hm1 Hm2. rewrite !big_sepM2_alt -map_insert_zip_with. rewrite big_sepM_insert; last by rewrite map_lookup_zip_with Hm1. rewrite !persistent_and_affinely_sep_l /=. rewrite sep_assoc (sep_comm _ (Φ _ _ _)) -sep_assoc. repeat apply sep_proper=>//. apply affinely_proper, pure_proper. rewrite !dom_insert_L. apply not_elem_of_dom in Hm1. apply not_elem_of_dom in Hm2. set_solver. Qed. (** The lemmas [big_sepM2_mono], [big_sepM2_ne] and [big_sepM2_proper] are more generic than the instances as they also give [mi !! k = Some yi] in the premise. *) Lemma big_sepM2_mono Φ Ψ m1 m2 : (∀ k y1 y2, m1 !! k = Some y1 → m2 !! k = Some y2 → Φ k y1 y2 ⊢ Ψ k y1 y2) → ([∗ map] k ↦ y1;y2 ∈ m1;m2, Φ k y1 y2) ⊢ [∗ map] k ↦ y1;y2 ∈ m1;m2, Ψ k y1 y2. Proof. intros Hm1m2. rewrite !big_sepM2_alt. apply and_mono_r, big_sepM_mono. intros k [x1 x2]. rewrite map_lookup_zip_with. specialize (Hm1m2 k x1 x2). destruct (m1 !! k) as [y1|]; last done. destruct (m2 !! k) as [y2|]; simpl; last done. intros ?; simplify_eq. by apply Hm1m2. Qed. Lemma big_sepM2_ne Φ Ψ m1 m2 n : (∀ k y1 y2, m1 !! k = Some y1 → m2 !! k = Some y2 → Φ k y1 y2 ≡{n}≡ Ψ k y1 y2) → ([∗ map] k ↦ y1;y2 ∈ m1;m2, Φ k y1 y2)%I ≡{n}≡ ([∗ map] k ↦ y1;y2 ∈ m1;m2, Ψ k y1 y2)%I. Proof. intros Hm1m2. rewrite !big_sepM2_alt. f_equiv. apply big_sepM_ne=> k [x1 x2]. rewrite map_lookup_zip_with. specialize (Hm1m2 k x1 x2). destruct (m1 !! k) as [y1|]; last done. destruct (m2 !! k) as [y2|]; simpl; last done. intros ?; simplify_eq. by apply Hm1m2. Qed. Lemma big_sepM2_proper Φ Ψ m1 m2 : (∀ k y1 y2, m1 !! k = Some y1 → m2 !! k = Some y2 → Φ k y1 y2 ⊣⊢ Ψ k y1 y2) → ([∗ map] k ↦ y1;y2 ∈ m1;m2, Φ k y1 y2) ⊣⊢ [∗ map] k ↦ y1;y2 ∈ m1;m2, Ψ k y1 y2. Proof. intros; apply (anti_symm _); apply big_sepM2_mono; auto using equiv_entails_1_1, equiv_entails_1_2. Qed. Lemma big_sepM2_proper_2 `{!Equiv A, !Equiv B} Φ Ψ m1 m2 m1' m2' : m1 ≡ m1' → m2 ≡ m2' → (∀ k y1 y1' y2 y2', m1 !! k = Some y1 → m1' !! k = Some y1' → y1 ≡ y1' → m2 !! k = Some y2 → m2' !! k = Some y2' → y2 ≡ y2' → Φ k y1 y2 ⊣⊢ Ψ k y1' y2') → ([∗ map] k ↦ y1;y2 ∈ m1;m2, Φ k y1 y2) ⊣⊢ [∗ map] k ↦ y1;y2 ∈ m1';m2', Ψ k y1 y2. Proof. intros Hm1 Hm2 Hf. rewrite !big_sepM2_alt. f_equiv. { by rewrite Hm1 Hm2. } apply big_opM_proper_2; [by f_equiv|]. intros k [x1 y1] [x2 y2] (?&?&[=<- <-]&?&?)%map_lookup_zip_with_Some (?&?&[=<- <-]&?&?)%map_lookup_zip_with_Some [??]; naive_solver. Qed. Global Instance big_sepM2_ne' n : Proper (pointwise_relation _ (pointwise_relation _ (pointwise_relation _ (dist n))) ==> (=) ==> (=) ==> (dist n)) (big_sepM2 (PROP:=PROP) (K:=K) (A:=A) (B:=B)). Proof. intros f g Hf m1 ? <- m2 ? <-. apply big_sepM2_ne; intros; apply Hf. Qed. Global Instance big_sepM2_mono' : Proper (pointwise_relation _ (pointwise_relation _ (pointwise_relation _ (⊢))) ==> (=) ==> (=) ==> (⊢)) (big_sepM2 (PROP:=PROP) (K:=K) (A:=A) (B:=B)). Proof. intros f g Hf m1 ? <- m2 ? <-. apply big_sepM2_mono; intros; apply Hf. Qed. Global Instance big_sepM2_proper' : Proper (pointwise_relation _ (pointwise_relation _ (pointwise_relation _ (⊣⊢))) ==> (=) ==> (=) ==> (⊣⊢)) (big_sepM2 (PROP:=PROP) (K:=K) (A:=A) (B:=B)). Proof. intros f g Hf m1 ? <- m2 ? <-. apply big_sepM2_proper; intros; apply Hf. Qed. (** Shows that some property [P] is closed under [big_sepM2]. Examples of [P] are [Persistent], [Affine], [Timeless]. *) Lemma big_sepM2_closed (P : PROP → Prop) Φ m1 m2 : Proper ((≡) ==> iff) P → P emp%I → P False%I → (∀ Q1 Q2, P Q1 → P Q2 → P (Q1 ∗ Q2)%I) → (∀ k x1 x2, m1 !! k = Some x1 → m2 !! k = Some x2 → P (Φ k x1 x2)) → P ([∗ map] k↦x1;x2 ∈ m1; m2, Φ k x1 x2)%I. Proof. intros ??? Hsep HΦ. rewrite big_sepM2_alt. destruct (decide (dom m1 = dom m2)). - rewrite pure_True // left_id. apply big_opM_closed; [done..|]. intros k [x1 x2] Hk. rewrite map_lookup_zip_with in Hk. simplify_option_eq; auto. - by rewrite pure_False // left_absorb. Qed. Global Instance big_sepM2_empty_persistent Φ : Persistent ([∗ map] k↦y1;y2 ∈ ∅; ∅, Φ k y1 y2). Proof. rewrite big_sepM2_empty. apply _. Qed. Lemma big_sepM2_persistent Φ m1 m2 : (∀ k x1 x2, m1 !! k = Some x1 → m2 !! k = Some x2 → Persistent (Φ k x1 x2)) → Persistent ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2). Proof. apply big_sepM2_closed; apply _. Qed. Global Instance big_sepM2_persistent' Φ m1 m2 : (∀ k x1 x2, Persistent (Φ k x1 x2)) → Persistent ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2). Proof. intros; apply big_sepM2_persistent, _. Qed. Global Instance big_sepM2_empty_affine Φ : Affine ([∗ map] k↦y1;y2 ∈ ∅; ∅, Φ k y1 y2). Proof. rewrite big_sepM2_empty. apply _. Qed. Lemma big_sepM2_affine Φ m1 m2 : (∀ k x1 x2, m1 !! k = Some x1 → m2 !! k = Some x2 → Affine (Φ k x1 x2)) → Affine ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2). Proof. apply big_sepM2_closed; apply _. Qed. Global Instance big_sepM2_affine' Φ m1 m2 : (∀ k x1 x2, Affine (Φ k x1 x2)) → Affine ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2). Proof. intros; apply big_sepM2_affine, _. Qed. Global Instance big_sepM2_empty_timeless `{!Timeless (emp%I : PROP)} Φ : Timeless ([∗ map] k↦x1;x2 ∈ ∅;∅, Φ k x1 x2). Proof. rewrite big_sepM2_alt map_zip_with_empty. apply _. Qed. Lemma big_sepM2_timeless `{!Timeless (emp%I : PROP)} Φ m1 m2 : (∀ k x1 x2, m1 !! k = Some x1 → m2 !! k = Some x2 → Timeless (Φ k x1 x2)) → Timeless ([∗ map] k↦x1;x2 ∈ m1;m2, Φ k x1 x2). Proof. apply big_sepM2_closed; apply _. Qed. Global Instance big_sepM2_timeless' `{!Timeless (emp%I : PROP)} Φ m1 m2 : (∀ k x1 x2, Timeless (Φ k x1 x2)) → Timeless ([∗ map] k↦x1;x2 ∈ m1;m2, Φ k x1 x2). Proof. intros; apply big_sepM2_timeless, _. Qed. Lemma big_sepM2_delete Φ m1 m2 i x1 x2 : m1 !! i = Some x1 → m2 !! i = Some x2 → ([∗ map] k↦x;y ∈ m1;m2, Φ k x y) ⊣⊢ Φ i x1 x2 ∗ [∗ map] k↦x;y ∈ delete i m1;delete i m2, Φ k x y. Proof. rewrite !big_sepM2_alt=> Hx1 Hx2. rewrite !persistent_and_affinely_sep_l /=. rewrite sep_assoc (sep_comm (Φ _ _ _)) -sep_assoc. apply sep_proper. - apply affinely_proper, pure_proper. rewrite !dom_delete_L. apply elem_of_dom_2 in Hx1; apply elem_of_dom_2 in Hx2. set_unfold. apply base.forall_proper=> k. destruct (decide (k = i)); naive_solver. - rewrite -map_delete_zip_with. apply (big_sepM_delete (λ i xx, Φ i xx.1 xx.2) (map_zip m1 m2) i (x1,x2)). by rewrite map_lookup_zip_with Hx1 Hx2. Qed. Lemma big_sepM2_delete_l Φ m1 m2 i x1 : m1 !! i = Some x1 → ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2) ⊣⊢ ∃ x2, ⌜m2 !! i = Some x2⌝ ∧ (Φ i x1 x2 ∗ [∗ map] k↦y1;y2 ∈ delete i m1;delete i m2, Φ k y1 y2). Proof. intros Hm1. apply (anti_symm _). - rewrite big_sepM2_alt_lookup. apply pure_elim_l=> Hm. assert (is_Some (m2 !! i)) as [x2 Hm2]. { apply Hm. by econstructor. } rewrite -(exist_intro x2). rewrite big_sepM2_alt_lookup (big_sepM_delete _ _ i (x1,x2)) /=; last by rewrite map_lookup_zip_with Hm1 Hm2. rewrite pure_True // left_id. f_equiv. apply and_intro. + apply pure_intro=> k. by rewrite !lookup_delete_is_Some Hm. + by rewrite -map_delete_zip_with. - apply exist_elim=> x2. apply pure_elim_l=> ?. by rewrite -big_sepM2_delete. Qed. Lemma big_sepM2_delete_r Φ m1 m2 i x2 : m2 !! i = Some x2 → ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2) ⊣⊢ ∃ x1, ⌜m1 !! i = Some x1⌝ ∧ (Φ i x1 x2 ∗ [∗ map] k↦y1;y2 ∈ delete i m1;delete i m2, Φ k y1 y2). Proof. intros Hm2. apply (anti_symm _). - rewrite big_sepM2_alt_lookup. apply pure_elim_l=> Hm. assert (is_Some (m1 !! i)) as [x1 Hm1]. { apply Hm. by econstructor. } rewrite -(exist_intro x1). rewrite big_sepM2_alt_lookup (big_sepM_delete _ _ i (x1,x2)) /=; last by rewrite map_lookup_zip_with Hm1 Hm2. rewrite pure_True // left_id. f_equiv. apply and_intro. + apply pure_intro=> k. by rewrite !lookup_delete_is_Some Hm. + by rewrite -map_delete_zip_with. - apply exist_elim=> x1. apply pure_elim_l=> ?. by rewrite -big_sepM2_delete. Qed. Lemma big_sepM2_insert_delete Φ m1 m2 i x1 x2 : ([∗ map] k↦y1;y2 ∈ <[i:=x1]>m1; <[i:=x2]>m2, Φ k y1 y2) ⊣⊢ Φ i x1 x2 ∗ [∗ map] k↦y1;y2 ∈ delete i m1;delete i m2, Φ k y1 y2. Proof. rewrite -(insert_delete_insert m1) -(insert_delete_insert m2). apply big_sepM2_insert; by rewrite lookup_delete. Qed. Lemma big_sepM2_insert_acc Φ m1 m2 i x1 x2 : m1 !! i = Some x1 → m2 !! i = Some x2 → ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2) ⊢ Φ i x1 x2 ∗ (∀ x1' x2', Φ i x1' x2' -∗ ([∗ map] k↦y1;y2 ∈ <[i:=x1']>m1;<[i:=x2']>m2, Φ k y1 y2)). Proof. intros ??. rewrite {1}big_sepM2_delete //. apply sep_mono; [done|]. apply forall_intro=> x1'. apply forall_intro=> x2'. rewrite -(insert_delete_insert m1) -(insert_delete_insert m2) big_sepM2_insert ?lookup_delete //. by apply wand_intro_l. Qed. Lemma big_sepM2_insert_2 Φ m1 m2 i x1 x2 `{!TCOr (∀ x y, Affine (Φ i x y)) (Absorbing (Φ i x1 x2))} : Φ i x1 x2 -∗ ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2) -∗ ([∗ map] k↦y1;y2 ∈ <[i:=x1]>m1; <[i:=x2]>m2, Φ k y1 y2). Proof. rewrite !big_sepM2_alt. assert (TCOr (∀ x, Affine (Φ i x.1 x.2)) (Absorbing (Φ i x1 x2))). { destruct select (TCOr _ _); apply _. } apply entails_wand, wand_intro_r. rewrite !persistent_and_affinely_sep_l /=. rewrite (sep_comm (Φ _ _ _)) -sep_assoc. apply sep_mono. { apply affinely_mono, pure_mono. rewrite !dom_insert_L. set_solver. } rewrite (big_sepM_insert_2 (λ k xx, Φ k xx.1 xx.2) (map_zip m1 m2) i (x1, x2)). rewrite map_insert_zip_with. apply wand_elim_r. Qed. Lemma big_sepM2_lookup_acc Φ m1 m2 i x1 x2 : m1 !! i = Some x1 → m2 !! i = Some x2 → ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2) ⊢ Φ i x1 x2 ∗ (Φ i x1 x2 -∗ ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2)). Proof. intros Hm1 Hm2. etrans; first apply big_sepM2_insert_acc=>//. apply sep_mono_r. rewrite (forall_elim x1) (forall_elim x2). rewrite !insert_id //. Qed. Lemma big_sepM2_lookup Φ m1 m2 i x1 x2 `{!TCOr (∀ j y1 y2, Affine (Φ j y1 y2)) (Absorbing (Φ i x1 x2))} : m1 !! i = Some x1 → m2 !! i = Some x2 → ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2) ⊢ Φ i x1 x2. Proof. intros Hx1 Hx2. destruct select (TCOr _ _). - rewrite big_sepM2_delete // sep_elim_l //. - rewrite big_sepM2_lookup_acc // sep_elim_l //. Qed. Lemma big_sepM2_lookup_l Φ m1 m2 i x1 `{!TCOr (∀ j y1 y2, Affine (Φ j y1 y2)) (∀ x2, Absorbing (Φ i x1 x2))} : m1 !! i = Some x1 → ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2) ⊢ ∃ x2, ⌜m2 !! i = Some x2⌝ ∧ Φ i x1 x2. Proof. intros Hm1. rewrite big_sepM2_delete_l //. f_equiv=> x2. destruct select (TCOr _ _); by rewrite sep_elim_l. Qed. Lemma big_sepM2_lookup_r Φ m1 m2 i x2 `{!TCOr (∀ j y1 y2, Affine (Φ j y1 y2)) (∀ x1, Absorbing (Φ i x1 x2))} : m2 !! i = Some x2 → ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2) ⊢ ∃ x1, ⌜m1 !! i = Some x1⌝ ∧ Φ i x1 x2. Proof. intros Hm2. rewrite big_sepM2_delete_r //. f_equiv=> x1. destruct select (TCOr _ _); by rewrite sep_elim_l. Qed. Lemma big_sepM2_singleton Φ i x1 x2 : ([∗ map] k↦y1;y2 ∈ {[ i := x1 ]}; {[ i := x2 ]}, Φ k y1 y2) ⊣⊢ Φ i x1 x2. Proof. rewrite big_sepM2_alt. rewrite map_zip_with_singleton big_sepM_singleton. apply (anti_symm _). - apply and_elim_r. - rewrite <- (left_id True%I (∧)%I (Φ i x1 x2)). apply and_mono=> //. apply pure_mono=> _. set_solver. Qed. Lemma big_sepM2_fst_snd Φ m : ([∗ map] k↦y1;y2 ∈ fst <$> m; snd <$> m, Φ k y1 y2) ⊣⊢ [∗ map] k ↦ xy ∈ m, Φ k (xy.1) (xy.2). Proof. rewrite big_sepM2_alt. rewrite !dom_fmap_L. by rewrite pure_True // True_and map_zip_fst_snd. Qed. Lemma big_sepM2_fmap {A' B'} (f : A → A') (g : B → B') (Φ : K → A' → B' → PROP) m1 m2 : ([∗ map] k↦y1;y2 ∈ f <$> m1; g <$> m2, Φ k y1 y2) ⊣⊢ ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k (f y1) (g y2)). Proof. rewrite !big_sepM2_alt. by rewrite map_fmap_zip !dom_fmap_L big_sepM_fmap. Qed. Lemma big_sepM2_fmap_l {A'} (f : A → A') (Φ : K → A' → B → PROP) m1 m2 : ([∗ map] k↦y1;y2 ∈ f <$> m1; m2, Φ k y1 y2) ⊣⊢ ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k (f y1) y2). Proof. rewrite -{1}(map_fmap_id m2). apply big_sepM2_fmap. Qed. Lemma big_sepM2_fmap_r {B'} (g : B → B') (Φ : K → A → B' → PROP) m1 m2 : ([∗ map] k↦y1;y2 ∈ m1; g <$> m2, Φ k y1 y2) ⊣⊢ ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 (g y2)). Proof. rewrite -{1}(map_fmap_id m1). apply big_sepM2_fmap. Qed. Lemma big_sepM2_sep Φ Ψ m1 m2 : ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2 ∗ Ψ k y1 y2) ⊣⊢ ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2) ∗ ([∗ map] k↦y1;y2 ∈ m1;m2, Ψ k y1 y2). Proof. rewrite !big_sepM2_alt. rewrite -{1}(idemp bi_and ⌜ dom m1 = dom m2 ⌝%I). rewrite -assoc. rewrite !persistent_and_affinely_sep_l /=. rewrite -assoc. apply sep_proper=>//. rewrite assoc (comm _ _ ( _)%I) -assoc. apply sep_proper=>//. apply big_sepM_sep. Qed. Lemma big_sepM2_sep_2 Φ Ψ m1 m2 : ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2) -∗ ([∗ map] k↦y1;y2 ∈ m1;m2, Ψ k y1 y2) -∗ ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2 ∗ Ψ k y1 y2). Proof. apply entails_wand, wand_intro_r. rewrite big_sepM2_sep //. Qed. Lemma big_sepM2_and Φ Ψ m1 m2 : ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2 ∧ Ψ k y1 y2) ⊢ ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2) ∧ ([∗ map] k↦y1;y2 ∈ m1;m2, Ψ k y1 y2). Proof. auto using and_intro, big_sepM2_mono, and_elim_l, and_elim_r. Qed. Lemma big_sepM2_pure_1 (φ : K → A → B → Prop) m1 m2 : ([∗ map] k↦y1;y2 ∈ m1;m2, ⌜φ k y1 y2⌝) ⊢@{PROP} ⌜∀ k y1 y2, m1 !! k = Some y1 → m2 !! k = Some y2 → φ k y1 y2⌝. Proof. rewrite big_sepM2_alt. rewrite big_sepM_pure_1 -pure_and. f_equiv=>-[Hdom Hforall] k y1 y2 Hy1 Hy2. eapply (Hforall k (y1, y2)). clear Hforall. apply map_lookup_zip_with_Some. naive_solver. Qed. Lemma big_sepM2_affinely_pure_2 (φ : K → A → B → Prop) m1 m2 : (∀ k : K, is_Some (m1 !! k) ↔ is_Some (m2 !! k)) → ⌜∀ k y1 y2, m1 !! k = Some y1 → m2 !! k = Some y2 → φ k y1 y2⌝ ⊢@{PROP} ([∗ map] k↦y1;y2 ∈ m1;m2, ⌜φ k y1 y2⌝). Proof. intros Hdom. rewrite big_sepM2_alt_lookup. rewrite -big_sepM_affinely_pure_2. rewrite affinely_and_r -pure_and. f_equiv. f_equiv=>-Hforall. split; first done. intros k [y1 y2] (? & ? & [= <- <-] & Hy1 & Hy2)%map_lookup_zip_with_Some; simpl. by eapply Hforall. Qed. (** The general backwards direction requires [BiAffine] to cover the empty case. *) Lemma big_sepM2_pure `{!BiAffine PROP} (φ : K → A → B → Prop) m1 m2 : ([∗ map] k↦y1;y2 ∈ m1;m2, ⌜φ k y1 y2⌝) ⊣⊢@{PROP} ⌜(∀ k : K, is_Some (m1 !! k) ↔ is_Some (m2 !! k)) ∧ (∀ k y1 y2, m1 !! k = Some y1 → m2 !! k = Some y2 → φ k y1 y2)⌝. Proof. apply (anti_symm (⊢)). { rewrite pure_and. apply and_intro. - apply big_sepM2_lookup_iff. - apply big_sepM2_pure_1. } rewrite -(affine_affinely ⌜_⌝%I). rewrite pure_and -affinely_and_r. apply pure_elim_l=>Hdom. rewrite big_sepM2_affinely_pure_2 //. by setoid_rewrite affinely_elim. Qed. Lemma big_sepM2_persistently `{!BiAffine PROP} Φ m1 m2 : ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2) ⊣⊢ [∗ map] k↦y1;y2 ∈ m1;m2, (Φ k y1 y2). Proof. by rewrite !big_sepM2_alt persistently_and persistently_pure big_sepM_persistently. Qed. Lemma big_sepM2_intro Φ m1 m2 : (∀ k : K, is_Some (m1 !! k) ↔ is_Some (m2 !! k)) → □ (∀ k x1 x2, ⌜m1 !! k = Some x1⌝ → ⌜m2 !! k = Some x2⌝ → Φ k x1 x2) ⊢ [∗ map] k↦x1;x2 ∈ m1;m2, Φ k x1 x2. Proof. intros. rewrite big_sepM2_alt_lookup. apply and_intro; [by apply pure_intro|]. rewrite -big_sepM_intro. f_equiv; f_equiv=> k. apply forall_intro=> -[x1 x2]. rewrite (forall_elim x1) (forall_elim x2). apply impl_intro_l, pure_elim_l. intros (?&?&[= <- <-]&?&?)%map_lookup_zip_with_Some. by rewrite !pure_True // !True_impl. Qed. Lemma big_sepM2_forall `{!BiAffine PROP} Φ m1 m2 : (∀ k x1 x2, Persistent (Φ k x1 x2)) → ([∗ map] k↦x1;x2 ∈ m1;m2, Φ k x1 x2) ⊣⊢ ⌜∀ k : K, is_Some (m1 !! k) ↔ is_Some (m2 !! k)⌝ ∧ (∀ k x1 x2, ⌜m1 !! k = Some x1⌝ → ⌜m2 !! k = Some x2⌝ → Φ k x1 x2). Proof. intros. apply (anti_symm _). { apply and_intro; [apply big_sepM2_lookup_iff|]. apply forall_intro=> k. apply forall_intro=> x1. apply forall_intro=> x2. do 2 (apply impl_intro_l; apply pure_elim_l=> ?). by apply: big_sepM2_lookup. } apply pure_elim_l=> Hdom. rewrite big_sepM2_alt_lookup. apply and_intro; [by apply pure_intro|]. rewrite big_sepM_forall. f_equiv=> k. apply forall_intro=> -[x1 x2]. rewrite (forall_elim x1) (forall_elim x2). apply impl_intro_l, pure_elim_l. intros (?&?&[= <- <-]&?&?)%map_lookup_zip_with_Some. by rewrite !pure_True // !True_impl. Qed. Lemma big_sepM2_impl Φ Ψ m1 m2 : ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2) -∗ □ (∀ k x1 x2, ⌜m1 !! k = Some x1⌝ → ⌜m2 !! k = Some x2⌝ → Φ k x1 x2 -∗ Ψ k x1 x2) -∗ [∗ map] k↦y1;y2 ∈ m1;m2, Ψ k y1 y2. Proof. apply entails_wand. rewrite -(idemp bi_and (big_sepM2 _ _ _)) {1}big_sepM2_lookup_iff. apply pure_elim_l=> ?. rewrite big_sepM2_intro //. apply bi.wand_intro_l. rewrite -big_sepM2_sep. by setoid_rewrite wand_elim_l. Qed. Lemma big_sepM2_wand Φ Ψ m1 m2 : ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2) -∗ ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2 -∗ Ψ k y1 y2) -∗ [∗ map] k↦y1;y2 ∈ m1;m2, Ψ k y1 y2. Proof. apply entails_wand, wand_intro_r. rewrite -big_sepM2_sep. setoid_rewrite wand_elim_r. done. Qed. Lemma big_sepM2_lookup_acc_impl {Φ m1 m2} i x1 x2 : m1 !! i = Some x1 → m2 !! i = Some x2 → ([∗ map] k↦y1;y2 ∈ m1;m2, Φ k y1 y2) -∗ (* We obtain [Φ] for [x1] and [x2] *) Φ i x1 x2 ∗ (* We reobtain the bigop for a predicate [Ψ] selected by the user *) ∀ Ψ, □ (∀ k y1 y2, ⌜ m1 !! k = Some y1 ⌝ → ⌜ m2 !! k = Some y2 ⌝ → ⌜ k ≠ i ⌝ → Φ k y1 y2 -∗ Ψ k y1 y2) -∗ Ψ i x1 x2 -∗ [∗ map] k↦y1;y2 ∈ m1;m2, Ψ k y1 y2. Proof. intros. rewrite big_sepM2_delete //. apply entails_wand, sep_mono_r, forall_intro=> Ψ. apply wand_intro_r, wand_intro_l. rewrite (big_sepM2_delete Ψ m1 m2 i) //. apply sep_mono_r. eapply wand_apply; [apply wand_entails, big_sepM2_impl|apply sep_mono_r]. f_equiv; f_equiv=> k; f_equiv=> y1; f_equiv=> y2. rewrite !impl_curry -!pure_and !lookup_delete_Some. do 2 f_equiv. intros ?; naive_solver. Qed. Lemma big_sepM2_later_1 `{!BiAffine PROP} Φ m1 m2 : (▷ [∗ map] k↦x1;x2 ∈ m1;m2, Φ k x1 x2) ⊢ ◇ ([∗ map] k↦x1;x2 ∈ m1;m2, ▷ Φ k x1 x2). Proof. rewrite !big_sepM2_alt later_and (timeless ⌜_⌝). rewrite big_sepM_later except_0_and. auto using and_mono_r, except_0_intro. Qed. Lemma big_sepM2_later_2 Φ m1 m2 : ([∗ map] k↦x1;x2 ∈ m1;m2, ▷ Φ k x1 x2) ⊢ ▷ [∗ map] k↦x1;x2 ∈ m1;m2, Φ k x1 x2. Proof. rewrite !big_sepM2_alt later_and -(later_intro ⌜_⌝). apply and_mono_r. by rewrite big_opM_commute. Qed. Lemma big_sepM2_laterN_2 Φ n m1 m2 : ([∗ map] k↦x1;x2 ∈ m1;m2, ▷^n Φ k x1 x2) ⊢ ▷^n [∗ map] k↦x1;x2 ∈ m1;m2, Φ k x1 x2. Proof. induction n as [|n IHn]; first done. rewrite later_laterN -IHn -big_sepM2_later_2. apply big_sepM2_mono. eauto. Qed. Lemma big_sepM2_sepM (Φ1 : K → A → PROP) (Φ2 : K → B → PROP) m1 m2 : (∀ k, is_Some (m1 !! k) ↔ is_Some (m2 !! k)) → ([∗ map] k↦y1;y2 ∈ m1;m2, Φ1 k y1 ∗ Φ2 k y2) ⊣⊢ ([∗ map] k↦y1 ∈ m1, Φ1 k y1) ∗ ([∗ map] k↦y2 ∈ m2, Φ2 k y2). Proof. intros. rewrite -big_sepM_sep_zip // big_sepM2_alt_lookup pure_True // left_id //. Qed. Lemma big_sepM2_sepM_2 (Φ1 : K → A → PROP) (Φ2 : K → B → PROP) m1 m2 : (∀ k, is_Some (m1 !! k) ↔ is_Some (m2 !! k)) → ([∗ map] k↦y1 ∈ m1, Φ1 k y1) -∗ ([∗ map] k↦y2 ∈ m2, Φ2 k y2) -∗ [∗ map] k↦y1;y2 ∈ m1;m2, Φ1 k y1 ∗ Φ2 k y2. Proof. intros. apply entails_wand, wand_intro_r. by rewrite big_sepM2_sepM. Qed. Lemma big_sepM2_union_inv_l (Φ : K → A → B → PROP) m1 m2 m' : m1 ##ₘ m2 → ([∗ map] k↦x;y ∈ (m1 ∪ m2);m', Φ k x y) ⊢ ∃ m1' m2', ⌜m' = m1' ∪ m2'⌝ ∧ ⌜ m1' ##ₘ m2' ⌝ ∧ ([∗ map] k↦x;y ∈ m1;m1', Φ k x y) ∗ ([∗ map] k↦x;y ∈ m2;m2', Φ k x y). Proof. revert m'. induction m1 as [|i x m1 ? IH] using map_ind; intros m' ?; decompose_map_disjoint. { rewrite -(exist_intro ∅) -(exist_intro m') !left_id_L. rewrite !pure_True //; last by apply map_disjoint_empty_l. rewrite big_sepM2_empty !left_id //. } rewrite -insert_union_l big_sepM2_delete_l; last by apply lookup_insert. apply exist_elim=> y. apply pure_elim_l=> ?. rewrite delete_insert; last by apply lookup_union_None. rewrite IH //. rewrite sep_exist_l. eapply exist_elim=> m1'. rewrite sep_exist_l. eapply exist_elim=> m2'. rewrite comm. apply wand_elim_l', pure_elim_l=> Hm'. apply pure_elim_l=> ?. assert ((m1' ∪ m2') !! i = None) as [??]%lookup_union_None. { by rewrite -Hm' lookup_delete. } apply wand_intro_l. rewrite -(exist_intro (<[i:=y]> m1')) -(exist_intro m2'). apply and_intro. { apply pure_intro. by rewrite -insert_union_l -Hm' insert_delete. } apply and_intro. { apply pure_intro. by apply map_disjoint_insert_l. } by rewrite big_sepM2_insert // -assoc. Qed. End map2. Lemma big_sepM2_union_inv_r `{Countable K} {A B} (Φ : K → A → B → PROP) (m1 m2 : gmap K B) (m' : gmap K A) : m1 ##ₘ m2 → ([∗ map] k↦x;y ∈ m';(m1 ∪ m2), Φ k x y) ⊢ ∃ m1' m2', ⌜ m' = m1' ∪ m2' ⌝ ∧ ⌜ m1' ##ₘ m2' ⌝ ∧ ([∗ map] k↦x;y ∈ m1';m1, Φ k x y) ∗ ([∗ map] k↦x;y ∈ m2';m2, Φ k x y). Proof. intros Hm. rewrite -(big_sepM2_flip Φ). rewrite (big_sepM2_union_inv_l (λ k (x : B) y, Φ k y x)) //. f_equiv=>n1. f_equiv=>n2. f_equiv. by rewrite -!(big_sepM2_flip Φ). Qed. Lemma big_sepM_sepM2_diag `{Countable K} {A} (Φ : K → A → A → PROP) (m : gmap K A) : ([∗ map] k↦y ∈ m, Φ k y y) ⊢ ([∗ map] k↦y1;y2 ∈ m;m, Φ k y1 y2). Proof. rewrite big_sepM2_alt. rewrite pure_True; last naive_solver. rewrite left_id. rewrite map_zip_diag big_sepM_fmap. done. Qed. Lemma big_sepM2_ne_2 `{Countable K} (A B : ofe) (Φ Ψ : K → A → B → PROP) m1 m2 m1' m2' n : m1 ≡{n}≡ m1' → m2 ≡{n}≡ m2' → (∀ k y1 y1' y2 y2', m1 !! k = Some y1 → m1' !! k = Some y1' → y1 ≡{n}≡ y1' → m2 !! k = Some y2 → m2' !! k = Some y2' → y2 ≡{n}≡ y2' → Φ k y1 y2 ≡{n}≡ Ψ k y1' y2') → ([∗ map] k ↦ y1;y2 ∈ m1;m2, Φ k y1 y2)%I ≡{n}≡ ([∗ map] k ↦ y1;y2 ∈ m1';m2', Ψ k y1 y2)%I. Proof. intros Hm1 Hm2 Hf. rewrite !big_sepM2_alt. f_equiv. { by rewrite Hm1 Hm2. } apply big_opM_ne_2; [by f_equiv|]. intros k [x1 y1] [x2 y2] (?&?&[=<- <-]&?&?)%map_lookup_zip_with_Some (?&?&[=<- <-]&?&?)%map_lookup_zip_with_Some [??]; naive_solver. Qed. (** ** Big ops over finite sets *) Section gset. Context `{Countable A}. Implicit Types X : gset A. Implicit Types Φ : A → PROP. (** The lemmas [big_sepS_mono], [big_sepS_ne] and [big_sepS_proper] are more generic than the instances as they also give [x ∈ X] in the premise. *) Lemma big_sepS_mono Φ Ψ X : (∀ x, x ∈ X → Φ x ⊢ Ψ x) → ([∗ set] x ∈ X, Φ x) ⊢ [∗ set] x ∈ X, Ψ x. Proof. intros. apply big_opS_gen_proper; apply _ || auto. Qed. Lemma big_sepS_ne Φ Ψ X n : (∀ x, x ∈ X → Φ x ≡{n}≡ Ψ x) → ([∗ set] x ∈ X, Φ x)%I ≡{n}≡ ([∗ set] x ∈ X, Ψ x)%I. Proof. apply big_opS_ne. 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. (** No need to declare instances for non-expansiveness and properness, we get both from the generic [big_opS] instances. *) 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. Global Instance big_sepS_empty_persistent Φ : Persistent ([∗ set] x ∈ ∅, Φ x). Proof. rewrite big_opS_empty. apply _. Qed. Lemma big_sepS_persistent Φ X : (∀ x, x ∈ X → Persistent (Φ x)) → Persistent ([∗ set] x ∈ X, Φ x). Proof. apply big_opS_closed; apply _. Qed. Global Instance big_sepS_persistent' Φ X : (∀ x, Persistent (Φ x)) → Persistent ([∗ set] x ∈ X, Φ x). Proof. intros; apply big_sepS_persistent, _. Qed. Global Instance big_sepS_empty_affine Φ : Affine ([∗ set] x ∈ ∅, Φ x). Proof. rewrite big_opS_empty. apply _. Qed. Lemma big_sepS_affine Φ X : (∀ x, x ∈ X → Affine (Φ x)) → Affine ([∗ set] x ∈ X, Φ x). Proof. apply big_opS_closed; apply _. Qed. Global Instance big_sepS_affine' Φ X : (∀ x, Affine (Φ x)) → Affine ([∗ set] x ∈ X, Φ x). Proof. intros; apply big_sepS_affine, _. Qed. Global Instance big_sepS_empty_timeless `{!Timeless (emp%I : PROP)} Φ : Timeless ([∗ set] x ∈ ∅, Φ x). Proof. rewrite big_opS_empty. apply _. Qed. Lemma big_sepS_timeless `{!Timeless (emp%I : PROP)} Φ X : (∀ x, x ∈ X → Timeless (Φ x)) → Timeless ([∗ set] x ∈ X, Φ x). Proof. apply big_opS_closed; apply _. Qed. Global Instance big_sepS_timeless' `{!Timeless (emp%I : PROP)} Φ X : (∀ x, Timeless (Φ x)) → Timeless ([∗ set] x ∈ X, Φ x). Proof. intros; apply big_sepS_timeless, _. Qed. (* See comment above [big_sepM_subseteq] as for why the [Affine] instance is placed late. *) Lemma big_sepS_subseteq Φ X Y `{!∀ x, Affine (Φ x)} : Y ⊆ X → ([∗ set] x ∈ X, Φ x) ⊢ [∗ set] x ∈ Y, Φ x. Proof. intros ->%union_difference_L. rewrite big_opS_union; last set_solver. by rewrite sep_elim_l. Qed. Lemma big_sepS_elements Φ X : ([∗ set] x ∈ X, Φ x) ⊣⊢ ([∗ list] x ∈ elements X, Φ x). Proof. by rewrite big_opS_elements. Qed. Lemma big_sepS_empty Φ : ([∗ set] x ∈ ∅, Φ x) ⊣⊢ emp. Proof. by rewrite big_opS_empty. Qed. Lemma big_sepS_empty' P `{!Affine P} Φ : P ⊢ [∗ set] x ∈ ∅, Φ x. Proof. rewrite big_sepS_empty. apply: affine. Qed. Lemma big_sepS_emp X : ([∗ set] x ∈ X, emp) ⊣⊢@{PROP} emp. Proof. by rewrite big_opS_unit. 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_insert_2 {Φ X} x `{!TCOr (Affine (Φ x)) (Absorbing (Φ x))} : Φ x ⊢ ([∗ set] y ∈ X, Φ y) -∗ ([∗ set] y ∈ {[ x ]} ∪ X, Φ y). Proof. apply wand_intro_r. destruct (decide (x ∈ X)); last first. { rewrite -big_sepS_insert //. } rewrite big_sepS_delete // assoc. rewrite (sep_elim_l (Φ x)) -big_sepS_insert; last set_solver. rewrite -union_difference_singleton_L //. replace ({[x]} ∪ X) with X by set_solver. auto. Qed. Lemma big_sepS_insert_2' {Φ X} x `{!TCOr (Affine (Φ x)) (Absorbing (Φ x))} : Φ x -∗ ([∗ set] y ∈ X, Φ y) -∗ ([∗ set] y ∈ X ∪ {[ x ]}, Φ y). Proof. apply entails_wand. rewrite comm_L. by apply big_sepS_insert_2. Qed. Lemma big_sepS_union_2 {Φ} X Y `{!∀ x, TCOr (Affine (Φ x)) (Absorbing (Φ x))} : ([∗ set] y ∈ X, Φ y) -∗ ([∗ set] y ∈ Y, Φ y) -∗ ([∗ set] y ∈ X ∪ Y, Φ y). Proof. apply entails_wand, wand_intro_r. induction X as [|x X ? IH] using set_ind_L. { by rewrite left_id_L big_sepS_empty left_id. } rewrite big_sepS_insert // -assoc IH -assoc_L. destruct (decide (x ∈ Y)). { replace ({[x]} ∪ (X ∪ Y)) with (X ∪ Y) by set_solver. rewrite (big_sepS_delete _ _ x); last set_solver. by rewrite assoc sep_elim_r. } by rewrite big_sepS_insert; last set_solver. Qed. Lemma big_sepS_delete_2 {Φ X} x : Affine (Φ x) → Φ x ⊢ ([∗ set] y ∈ X ∖ {[ x ]}, Φ y) -∗ [∗ set] y ∈ X, Φ y. Proof. intros Haff. apply wand_intro_r. destruct (decide (x ∈ X)). { rewrite -big_sepS_delete //. } rewrite sep_elim_r. replace (X ∖ {[x]}) with X by set_solver. auto. Qed. Lemma big_sepS_elem_of Φ X x `{!TCOr (∀ y, Affine (Φ y)) (Absorbing (Φ x))} : x ∈ X → ([∗ set] y ∈ X, Φ y) ⊢ Φ x. Proof. intros ?. rewrite big_sepS_delete //. destruct select (TCOr _ _); 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' (φ : A → Prop) `{∀ x, Decision (φ x)} Φ X : ([∗ set] y ∈ filter φ X, Φ y) ⊣⊢ ([∗ set] y ∈ X, if decide (φ y) then Φ y else emp). Proof. apply: big_opS_filter'. Qed. Lemma big_sepS_filter `{!BiAffine PROP} (φ : A → Prop) `{∀ x, Decision (φ x)} Φ X : ([∗ set] y ∈ filter φ X, Φ y) ⊣⊢ ([∗ set] y ∈ X, ⌜φ y⌝ → Φ y). Proof. setoid_rewrite <-decide_emp. apply big_sepS_filter'. Qed. Lemma big_sepS_filter_acc' (φ : A → Prop) `{∀ y, Decision (φ y)} Φ X Y : (∀ y, y ∈ Y → φ y → y ∈ X) → ([∗ set] y ∈ X, Φ y) -∗ ([∗ set] y ∈ Y, if decide (φ y) then Φ y else emp) ∗ (([∗ set] y ∈ Y, if decide (φ y) then Φ y else emp) -∗ [∗ set] y ∈ X, Φ y). Proof. intros ?. destruct (proj1 (subseteq_disjoint_union_L (filter φ Y) X)) as (Z&->&?); first set_solver. rewrite big_sepS_union // big_sepS_filter'. by apply entails_wand, sep_mono_r, wand_intro_l. Qed. Lemma big_sepS_filter_acc `{!BiAffine PROP} (φ : A → Prop) `{∀ y, Decision (φ y)} Φ X Y : (∀ y, y ∈ Y → φ y → y ∈ X) → ([∗ set] y ∈ X, Φ y) -∗ ([∗ set] y ∈ Y, ⌜φ y⌝ → Φ y) ∗ (([∗ set] y ∈ Y, ⌜φ y⌝ → Φ y) -∗ [∗ set] y ∈ X, Φ y). Proof. intros. setoid_rewrite <-decide_emp. by apply big_sepS_filter_acc'. Qed. Lemma big_sepS_list_to_set Φ (l : list A) : NoDup l → ([∗ set] x ∈ list_to_set l, Φ x) ⊣⊢ [∗ list] x ∈ l, Φ x. Proof. apply big_opS_list_to_set. Qed. Lemma big_sepS_sep Φ Ψ X : ([∗ set] y ∈ X, Φ y ∗ Ψ y) ⊣⊢ ([∗ set] y ∈ X, Φ y) ∗ ([∗ set] y ∈ X, Ψ y). Proof. apply big_opS_op. Qed. Lemma big_sepS_sep_2 Φ Ψ X : ([∗ set] y ∈ X, Φ y) -∗ ([∗ set] y ∈ X, Ψ y) -∗ ([∗ set] y ∈ X, Φ y ∗ Ψ y). Proof. apply entails_wand, wand_intro_r. rewrite big_sepS_sep //. 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_pure_1 (φ : A → Prop) X : ([∗ set] y ∈ X, ⌜φ y⌝) ⊢@{PROP} ⌜set_Forall φ X⌝. Proof. induction X as [|x X ? IH] using set_ind_L. { apply pure_intro, set_Forall_empty. } rewrite big_sepS_insert // IH sep_and -pure_and. f_equiv=>-[Hx HX]. apply set_Forall_union. - apply set_Forall_singleton. done. - done. Qed. Lemma big_sepS_affinely_pure_2 (φ : A → Prop) X : ⌜set_Forall φ X⌝ ⊢@{PROP} ([∗ set] y ∈ X, ⌜φ y⌝). Proof. induction X as [|x X ? IH] using set_ind_L. { rewrite big_sepS_empty. apply affinely_elim_emp. } rewrite big_sepS_insert // -IH. rewrite -persistent_and_sep_1 -affinely_and -pure_and. f_equiv. f_equiv=>HX. split. - apply HX. set_solver+. - apply set_Forall_union_inv_2 in HX. done. Qed. (** The general backwards direction requires [BiAffine] to cover the empty case. *) Lemma big_sepS_pure `{!BiAffine PROP} (φ : A → Prop) X : ([∗ set] y ∈ X, ⌜φ y⌝) ⊣⊢@{PROP} ⌜set_Forall φ X⌝. Proof. apply (anti_symm (⊢)); first by apply big_sepS_pure_1. rewrite -(affine_affinely ⌜_⌝%I). rewrite big_sepS_affinely_pure_2. by setoid_rewrite affinely_elim. Qed. Lemma big_sepS_persistently `{!BiAffine PROP} Φ X : ([∗ set] y ∈ X, Φ y) ⊣⊢ [∗ set] y ∈ X, (Φ y). Proof. apply (big_opS_commute _). Qed. Lemma big_sepS_intro Φ X : □ (∀ x, ⌜x ∈ X⌝ → Φ x) ⊢ [∗ set] x ∈ X, Φ x. Proof. revert Φ. induction X as [|x X ? IH] using set_ind_L=> Φ. { by rewrite (affine (□ _)) big_sepS_empty. } rewrite intuitionistically_sep_dup big_sepS_insert //. f_equiv. - rewrite (forall_elim x) pure_True ?True_impl; last set_solver. by rewrite intuitionistically_elim. - rewrite -IH. f_equiv. apply forall_mono=> y. apply impl_intro_l, pure_elim_l=> ?. by rewrite pure_True ?True_impl; last set_solver. Qed. Lemma big_sepS_forall `{!BiAffine PROP} Φ X : (∀ x, Persistent (Φ x)) → ([∗ set] x ∈ X, Φ x) ⊣⊢ (∀ x, ⌜x ∈ X⌝ → Φ x). Proof. intros HΦ. apply (anti_symm _). { apply forall_intro=> x. apply impl_intro_l, pure_elim_l=> ?; by apply: big_sepS_elem_of. } revert Φ HΦ. induction X as [|x X ? IH] using set_ind_L=> Φ HΦ. { rewrite big_sepS_empty. apply: affine. } rewrite big_sepS_insert // -persistent_and_sep_1. apply and_intro. - rewrite (forall_elim x) pure_True ?True_impl; last set_solver. done. - 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 entails_wand, wand_intro_l. rewrite big_sepS_intro -big_sepS_sep. by setoid_rewrite wand_elim_l. Qed. Lemma big_sepS_wand Φ Ψ X : ([∗ set] x ∈ X, Φ x) -∗ ([∗ set] x ∈ X, Φ x -∗ Ψ x) -∗ [∗ set] x ∈ X, Ψ x. Proof. apply entails_wand, wand_intro_r. rewrite -big_sepS_sep. setoid_rewrite wand_elim_r. done. Qed. Lemma big_sepS_elem_of_acc_impl {Φ X} x : x ∈ X → ([∗ set] y ∈ X, Φ y) -∗ (* we get [Φ] for the element [x] *) Φ x ∗ (* we reobtain the bigop for a predicate [Ψ] selected by the user *) ∀ Ψ, □ (∀ y, ⌜ y ∈ X ⌝ → ⌜ x ≠ y ⌝ → Φ y -∗ Ψ y) -∗ Ψ x -∗ [∗ set] y ∈ X, Ψ y. Proof. intros. rewrite big_sepS_delete //. apply entails_wand, sep_mono_r, forall_intro=> Ψ. apply wand_intro_r, wand_intro_l. rewrite (big_sepS_delete Ψ X x) //. apply sep_mono_r. eapply wand_apply; [apply wand_entails, big_sepS_impl|apply sep_mono_r]. f_equiv; f_equiv=> y. rewrite impl_curry -pure_and. do 2 f_equiv. intros ?; set_solver. Qed. Lemma big_sepS_dup P `{!Affine P} X : □ (P -∗ P ∗ P) -∗ P -∗ [∗ set] x ∈ X, P. Proof. apply entails_wand, wand_intro_l. induction X as [|x X ? IH] using set_ind_L. { apply: big_sepS_empty'. } rewrite !big_sepS_insert //. rewrite intuitionistically_sep_dup {1}intuitionistically_elim. rewrite assoc wand_elim_r -assoc. apply sep_mono; done. Qed. 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. 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. Lemma big_sepM_gset_to_gmap `{Countable K} {A} (Φ : K → A → PROP) (X : gset K) c : ([∗ map] k↦a ∈ gset_to_gmap c X, Φ k a) ⊣⊢ ([∗ set] k ∈ X, Φ k c). Proof. apply big_opM_gset_to_gmap. Qed. (** ** Big ops over finite multisets *) Section gmultiset. Context `{Countable A}. Implicit Types X : gmultiset A. Implicit Types Φ : A → PROP. (** The lemmas [big_sepMS_mono], [big_sepMS_ne] and [big_sepMS_proper] are more generic than the instances as they also give [l !! k = Some y] in the premise. *) Lemma big_sepMS_mono Φ Ψ X : (∀ x, x ∈ X → Φ x ⊢ Ψ x) → ([∗ mset] x ∈ X, Φ x) ⊢ [∗ mset] x ∈ X, Ψ x. Proof. intros. apply big_opMS_gen_proper; apply _ || auto. Qed. Lemma big_sepMS_ne Φ Ψ X n : (∀ x, x ∈ X → Φ x ≡{n}≡ Ψ x) → ([∗ mset] x ∈ X, Φ x)%I ≡{n}≡ ([∗ mset] x ∈ X, Ψ x)%I. Proof. apply big_opMS_ne. 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. (** No need to declare instances for non-expansiveness and properness, we get both from the generic [big_opMS] instances. *) 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. Global Instance big_sepMS_empty_persistent Φ : Persistent ([∗ mset] x ∈ ∅, Φ x). Proof. rewrite big_opMS_empty. apply _. Qed. Lemma big_sepMS_persistent Φ X : (∀ x, x ∈ X → Persistent (Φ x)) → Persistent ([∗ mset] x ∈ X, Φ x). Proof. apply big_opMS_closed; apply _. Qed. Global Instance big_sepMS_persistent' Φ X : (∀ x, Persistent (Φ x)) → Persistent ([∗ mset] x ∈ X, Φ x). Proof. intros; apply big_sepMS_persistent, _. Qed. Global Instance big_sepMS_empty_affine Φ : Affine ([∗ mset] x ∈ ∅, Φ x). Proof. rewrite big_opMS_empty. apply _. Qed. Lemma big_sepMS_affine Φ X : (∀ x, x ∈ X → Affine (Φ x)) → Affine ([∗ mset] x ∈ X, Φ x). Proof. apply big_opMS_closed; apply _. Qed. Global Instance big_sepMS_affine' Φ X : (∀ x, Affine (Φ x)) → Affine ([∗ mset] x ∈ X, Φ x). Proof. intros; apply big_sepMS_affine, _. Qed. Global Instance big_sepMS_empty_timeless `{!Timeless (emp%I : PROP)} Φ : Timeless ([∗ mset] x ∈ ∅, Φ x). Proof. rewrite big_opMS_empty. apply _. Qed. Lemma big_sepMS_timeless `{!Timeless (emp%I : PROP)} Φ X : (∀ x, x ∈ X → Timeless (Φ x)) → Timeless ([∗ mset] x ∈ X, Φ x). Proof. apply big_opMS_closed; apply _. Qed. Global Instance big_sepMS_timeless' `{!Timeless (emp%I : PROP)} Φ X : (∀ x, Timeless (Φ x)) → Timeless ([∗ mset] x ∈ X, Φ x). Proof. intros; apply big_sepMS_timeless, _. Qed. (* See comment above [big_sepM_subseteq] as for why the [Affine] instance is placed late. *) Lemma big_sepMS_subseteq Φ X Y `{!∀ x, Affine (Φ x)} : Y ⊆ X → ([∗ mset] x ∈ X, Φ x) ⊢ [∗ mset] x ∈ Y, Φ x. Proof. intros ->%gmultiset_disj_union_difference. by rewrite big_opMS_disj_union sep_elim_l. Qed. Lemma big_sepMS_empty Φ : ([∗ mset] x ∈ ∅, Φ x) ⊣⊢ emp. Proof. by rewrite big_opMS_empty. Qed. Lemma big_sepMS_empty' P `{!Affine P} Φ : P ⊢ [∗ mset] x ∈ ∅, Φ x. Proof. rewrite big_sepMS_empty. apply: affine. Qed. Lemma big_sepMS_disj_union Φ X Y : ([∗ mset] y ∈ X ⊎ Y, Φ y) ⊣⊢ ([∗ mset] y ∈ X, Φ y) ∗ [∗ mset] y ∈ Y, Φ y. Proof. apply big_opMS_disj_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 `{!TCOr (∀ y, Affine (Φ y)) (Absorbing (Φ x))} : x ∈ X → ([∗ mset] y ∈ X, Φ y) ⊢ Φ x. Proof. intros ?. rewrite big_sepMS_delete //. destruct select (TCOr _ _); 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_insert Φ X x : ([∗ mset] y ∈ {[+ x +]} ⊎ X, Φ y) ⊣⊢ (Φ x ∗ [∗ mset] y ∈ X, Φ y). Proof. apply big_opMS_insert. Qed. Lemma big_sepMS_sep Φ Ψ X : ([∗ mset] y ∈ X, Φ y ∗ Ψ y) ⊣⊢ ([∗ mset] y ∈ X, Φ y) ∗ ([∗ mset] y ∈ X, Ψ y). Proof. apply big_opMS_op. Qed. Lemma big_sepMS_sep_2 Φ Ψ X : ([∗ mset] y ∈ X, Φ y) -∗ ([∗ mset] y ∈ X, Ψ y) -∗ ([∗ mset] y ∈ X, Φ y ∗ Ψ y). Proof. apply entails_wand, wand_intro_r. rewrite big_sepMS_sep //. 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_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. Lemma big_sepMS_pure_1 (φ : A → Prop) X : ([∗ mset] y ∈ X, ⌜φ y⌝) ⊢@{PROP} ⌜∀ y : A, y ∈ X → φ y⌝. Proof. induction X as [|x X IH] using gmultiset_ind. { apply pure_intro=>??. exfalso. multiset_solver. } rewrite big_sepMS_insert // IH sep_and -pure_and. f_equiv=>-[Hx HX] y /gmultiset_elem_of_disj_union [|]. - move=>/gmultiset_elem_of_singleton =>->. done. - eauto. Qed. Lemma big_sepMS_affinely_pure_2 (φ : A → Prop) X : ⌜∀ y : A, y ∈ X → φ y⌝ ⊢@{PROP} ([∗ mset] y ∈ X, ⌜φ y⌝). Proof. induction X as [|x X IH] using gmultiset_ind. { rewrite big_sepMS_empty. apply affinely_elim_emp. } rewrite big_sepMS_insert // -IH. rewrite -persistent_and_sep_1 -affinely_and -pure_and. f_equiv. f_equiv=>HX. split. - apply HX. set_solver+. - intros y Hy. apply HX. multiset_solver. Qed. (** The general backwards direction requires [BiAffine] to cover the empty case. *) Lemma big_sepMS_pure `{!BiAffine PROP} (φ : A → Prop) X : ([∗ mset] y ∈ X, ⌜φ y⌝) ⊣⊢@{PROP} ⌜∀ y : A, y ∈ X → φ y⌝. Proof. apply (anti_symm (⊢)); first by apply big_sepMS_pure_1. rewrite -(affine_affinely ⌜_⌝%I). rewrite big_sepMS_affinely_pure_2. by setoid_rewrite affinely_elim. Qed. Lemma big_sepMS_persistently `{!BiAffine PROP} Φ X : ([∗ mset] y ∈ X, Φ y) ⊣⊢ [∗ mset] y ∈ X, (Φ y). Proof. apply (big_opMS_commute _). Qed. Lemma big_sepMS_intro Φ X : □ (∀ x, ⌜x ∈ X⌝ → Φ x) ⊢ [∗ mset] x ∈ X, Φ x. Proof. revert Φ. induction X as [|x X IH] using gmultiset_ind=> Φ. { by rewrite (affine (□ _)) big_sepMS_empty. } rewrite intuitionistically_sep_dup big_sepMS_disj_union. rewrite big_sepMS_singleton. f_equiv. - rewrite (forall_elim x) pure_True ?True_impl; last multiset_solver. by rewrite intuitionistically_elim. - rewrite -IH. f_equiv. apply forall_mono=> y. apply impl_intro_l, pure_elim_l=> ?. by rewrite pure_True ?True_impl; last multiset_solver. Qed. Lemma big_sepMS_forall `{!BiAffine PROP} Φ X : (∀ x, Persistent (Φ x)) → ([∗ mset] x ∈ X, Φ x) ⊣⊢ (∀ x, ⌜x ∈ X⌝ → Φ x). Proof. intros HΦ. apply (anti_symm _). { apply forall_intro=> x. apply impl_intro_l, pure_elim_l=> ?; by apply: big_sepMS_elem_of. } revert Φ HΦ. induction X as [|x X IH] using gmultiset_ind=> Φ HΦ. { rewrite big_sepMS_empty. apply: affine. } rewrite big_sepMS_disj_union. rewrite big_sepMS_singleton -persistent_and_sep_1. apply and_intro. - rewrite (forall_elim x) pure_True ?True_impl; last multiset_solver. done. - rewrite -IH. apply forall_mono=> y. apply impl_intro_l, pure_elim_l=> ?. by rewrite pure_True ?True_impl; last multiset_solver. Qed. Lemma big_sepMS_impl Φ Ψ X : ([∗ mset] x ∈ X, Φ x) -∗ □ (∀ x, ⌜x ∈ X⌝ → Φ x -∗ Ψ x) -∗ [∗ mset] x ∈ X, Ψ x. Proof. apply entails_wand, wand_intro_l. rewrite big_sepMS_intro -big_sepMS_sep. by setoid_rewrite wand_elim_l. Qed. Lemma big_sepMS_wand Φ Ψ X : ([∗ mset] x ∈ X, Φ x) -∗ ([∗ mset] x ∈ X, Φ x -∗ Ψ x) -∗ [∗ mset] x ∈ X, Ψ x. Proof. apply entails_wand, wand_intro_r. rewrite -big_sepMS_sep. setoid_rewrite wand_elim_r. done. Qed. Lemma big_sepMS_dup P `{!Affine P} X : □ (P -∗ P ∗ P) -∗ P -∗ [∗ mset] x ∈ X, P. Proof. apply entails_wand, wand_intro_l. induction X as [|x X IH] using gmultiset_ind. { apply: big_sepMS_empty'. } rewrite !big_sepMS_disj_union big_sepMS_singleton. rewrite intuitionistically_sep_dup {1}intuitionistically_elim. rewrite assoc wand_elim_r -assoc. apply sep_mono; done. Qed. Lemma big_sepMS_elem_of_acc_impl {Φ X} x : x ∈ X → ([∗ mset] y ∈ X, Φ y) -∗ (* we get [Φ] for [x] *) Φ x ∗ (* we reobtain the bigop for a predicate [Ψ] selected by the user *) ∀ Ψ, □ (∀ y, ⌜ y ∈ X ∖ {[+ x +]} ⌝ → Φ y -∗ Ψ y) -∗ Ψ x -∗ [∗ mset] y ∈ X, Ψ y. Proof. intros. rewrite big_sepMS_delete //. apply entails_wand, sep_mono_r, forall_intro=> Ψ. apply wand_intro_r, wand_intro_l. rewrite (big_sepMS_delete Ψ X x) //. apply sep_mono_r. apply wand_elim_l', wand_entails, big_sepMS_impl. Qed. End gmultiset. (** Commuting lemmas *) Lemma big_sepL_sepL {A B} (Φ : nat → A → nat → B → PROP) (l1 : list A) (l2 : list B) : ([∗ list] k1↦x1 ∈ l1, [∗ list] k2↦x2 ∈ l2, Φ k1 x1 k2 x2) ⊣⊢ ([∗ list] k2↦x2 ∈ l2, [∗ list] k1↦x1 ∈ l1, Φ k1 x1 k2 x2). Proof. apply big_opL_opL. Qed. Lemma big_sepL_sepM {A} `{Countable K} {B} (Φ : nat → A → K → B → PROP) (l1 : list A) (m2 : gmap K B) : ([∗ list] k1↦x1 ∈ l1, [∗ map] k2↦x2 ∈ m2, Φ k1 x1 k2 x2) ⊣⊢ ([∗ map] k2↦x2 ∈ m2, [∗ list] k1↦x1 ∈ l1, Φ k1 x1 k2 x2). Proof. apply big_opL_opM. Qed. Lemma big_sepL_sepS {A} `{Countable B} (Φ : nat → A → B → PROP) (l1 : list A) (X2 : gset B) : ([∗ list] k1↦x1 ∈ l1, [∗ set] x2 ∈ X2, Φ k1 x1 x2) ⊣⊢ ([∗ set] x2 ∈ X2, [∗ list] k1↦x1 ∈ l1, Φ k1 x1 x2). Proof. apply big_opL_opS. Qed. Lemma big_sepL_sepMS {A} `{Countable B} (Φ : nat → A → B → PROP) (l1 : list A) (X2 : gmultiset B) : ([∗ list] k1↦x1 ∈ l1, [∗ mset] x2 ∈ X2, Φ k1 x1 x2) ⊣⊢ ([∗ mset] x2 ∈ X2, [∗ list] k1↦x1 ∈ l1, Φ k1 x1 x2). Proof. apply big_opL_opMS. Qed. Lemma big_sepM_sepL `{Countable K} {A} {B} (Φ : K → A → nat → B → PROP) (m1 : gmap K A) (l2 : list B) : ([∗ map] k1↦x1 ∈ m1, [∗ list] k2↦x2 ∈ l2, Φ k1 x1 k2 x2) ⊣⊢ ([∗ list] k2↦x2 ∈ l2, [∗ map] k1↦x1 ∈ m1, Φ k1 x1 k2 x2). Proof. apply big_opM_opL. Qed. Lemma big_sepM_sepM `{Countable K1} {A} `{Countable K2} {B} (Φ : K1 → A → K2 → B → PROP) (m1 : gmap K1 A) (m2 : gmap K2 B) : ([∗ map] k1↦x1 ∈ m1, [∗ map] k2↦x2 ∈ m2, Φ k1 x1 k2 x2) ⊣⊢ ([∗ map] k2↦x2 ∈ m2, [∗ map] k1↦x1 ∈ m1, Φ k1 x1 k2 x2). Proof. apply big_opM_opM. Qed. Lemma big_sepM_sepS `{Countable K} {A} `{Countable B} (Φ : K → A → B → PROP) (m1 : gmap K A) (X2 : gset B) : ([∗ map] k1↦x1 ∈ m1, [∗ set] x2 ∈ X2, Φ k1 x1 x2) ⊣⊢ ([∗ set] x2 ∈ X2, [∗ map] k1↦x1 ∈ m1, Φ k1 x1 x2). Proof. apply big_opM_opS. Qed. Lemma big_sepM_sepMS `{Countable K} {A} `{Countable B} (Φ : K → A → B → PROP) (m1 : gmap K A) (X2 : gmultiset B) : ([∗ map] k1↦x1 ∈ m1, [∗ mset] x2 ∈ X2, Φ k1 x1 x2) ⊣⊢ ([∗ mset] x2 ∈ X2, [∗ map] k1↦x1 ∈ m1, Φ k1 x1 x2). Proof. apply big_opM_opMS. Qed. Lemma big_sepS_sepL `{Countable A} {B} (f : A → nat → B → PROP) (X1 : gset A) (l2 : list B) : ([∗ set] x1 ∈ X1, [∗ list] k2↦x2 ∈ l2, f x1 k2 x2) ⊣⊢ ([∗ list] k2↦x2 ∈ l2, [∗ set] x1 ∈ X1, f x1 k2 x2). Proof. apply big_opS_opL. Qed. Lemma big_sepS_sepM `{Countable A} `{Countable K} {B} (f : A → K → B → PROP) (X1 : gset A) (m2 : gmap K B) : ([∗ set] x1 ∈ X1, [∗ map] k2↦x2 ∈ m2, f x1 k2 x2) ⊣⊢ ([∗ map] k2↦x2 ∈ m2, [∗ set] x1 ∈ X1, f x1 k2 x2). Proof. apply big_opS_opM. Qed. Lemma big_sepS_sepS `{Countable A, Countable B} (X : gset A) (Y : gset B) (Φ : A → B → PROP) : ([∗ set] x ∈ X, [∗ set] y ∈ Y, Φ x y) ⊣⊢ ([∗ set] y ∈ Y, [∗ set] x ∈ X, Φ x y). Proof. apply big_opS_opS. Qed. Lemma big_sepS_sepMS `{Countable A, Countable B} (X : gset A) (Y : gmultiset B) (Φ : A → B → PROP) : ([∗ set] x ∈ X, [∗ mset] y ∈ Y, Φ x y) ⊣⊢ ([∗ mset] y ∈ Y, [∗ set] x ∈ X, Φ x y). Proof. apply big_opS_opMS. Qed. Lemma big_sepMS_sepL `{Countable A} {B} (f : A → nat → B → PROP) (X1 : gmultiset A) (l2 : list B) : ([∗ mset] x1 ∈ X1, [∗ list] k2↦x2 ∈ l2, f x1 k2 x2) ⊣⊢ ([∗ list] k2↦x2 ∈ l2, [∗ mset] x1 ∈ X1, f x1 k2 x2). Proof. apply big_opMS_opL. Qed. Lemma big_sepMS_sepM `{Countable A} `{Countable K} {B} (f : A → K → B → PROP) (X1 : gmultiset A) (m2 : gmap K B) : ([∗ mset] x1 ∈ X1, [∗ map] k2↦x2 ∈ m2, f x1 k2 x2) ⊣⊢ ([∗ map] k2↦x2 ∈ m2, [∗ mset] x1 ∈ X1, f x1 k2 x2). Proof. apply big_opMS_opM. Qed. Lemma big_sepMS_sepS `{Countable A, Countable B} (X : gmultiset A) (Y : gset B) (f : A → B → PROP) : ([∗ mset] x ∈ X, [∗ set] y ∈ Y, f x y) ⊣⊢ ([∗ set] y ∈ Y, [∗ mset] x ∈ X, f x y). Proof. apply big_opMS_opS. Qed. Lemma big_sepMS_sepMS `{Countable A, Countable B} (X : gmultiset A) (Y : gmultiset B) (Φ : A → B → PROP) : ([∗ mset] x ∈ X, [∗ mset] y ∈ Y, Φ x y) ⊣⊢ ([∗ mset] y ∈ Y, [∗ mset] x ∈ X, Φ x y). Proof. apply big_opMS_opMS. Qed. End big_op. iris-iris-4.2.0/iris/bi/derived_connectives.v000066400000000000000000000130771460620107300212070ustar00rootroot00000000000000From iris.algebra Require Import monoid. From iris.bi Require Export interface. From iris.prelude Require Import options. Definition bi_iff {PROP : bi} (P Q : PROP) : PROP := (P → Q) ∧ (Q → P). Global Arguments bi_iff {_} _%I _%I : simpl never. Global Instance: Params (@bi_iff) 1 := {}. Infix "↔" := bi_iff : bi_scope. Definition bi_wand_iff {PROP : bi} (P Q : PROP) : PROP := (P -∗ Q) ∧ (Q -∗ P). Global Arguments bi_wand_iff {_} _%I _%I : simpl never. Global Instance: Params (@bi_wand_iff) 1 := {}. Infix "∗-∗" := bi_wand_iff : bi_scope. Notation "P ∗-∗ Q" := (⊢ P ∗-∗ Q) : stdpp_scope. Class Persistent {PROP : bi} (P : PROP) := persistent : P ⊢ P. Global Arguments Persistent {_} _%I : simpl never. Global Arguments persistent {_} _%I {_}. Global Hint Mode Persistent + ! : typeclass_instances. Global Instance: Params (@Persistent) 1 := {}. Definition bi_affinely {PROP : bi} (P : PROP) : PROP := emp ∧ P. Global Arguments bi_affinely {_} _%I : simpl never. Global Instance: Params (@bi_affinely) 1 := {}. Global Typeclasses Opaque bi_affinely. Notation "'' P" := (bi_affinely P) : bi_scope. Class Affine {PROP : bi} (Q : PROP) := affine : Q ⊢ emp. Global Arguments Affine {_} _%I : simpl never. Global Arguments affine {_} _%I {_}. Global Hint Mode Affine + ! : typeclass_instances. Definition bi_absorbingly {PROP : bi} (P : PROP) : PROP := True ∗ P. Global Arguments bi_absorbingly {_} _%I : simpl never. Global Instance: Params (@bi_absorbingly) 1 := {}. Global Typeclasses Opaque bi_absorbingly. Notation "'' P" := (bi_absorbingly P) : bi_scope. Class Absorbing {PROP : bi} (P : PROP) := absorbing : P ⊢ P. Global Arguments Absorbing {_} _%I : simpl never. Global Arguments absorbing {_} _%I. Global Hint Mode Absorbing + ! : typeclass_instances. Definition bi_persistently_if {PROP : bi} (p : bool) (P : PROP) : PROP := (if p then P else P)%I. Global Arguments bi_persistently_if {_} !_ _%I /. Global Instance: Params (@bi_persistently_if) 2 := {}. Global Typeclasses Opaque bi_persistently_if. Notation "'?' p P" := (bi_persistently_if p P) : bi_scope. Definition bi_affinely_if {PROP : bi} (p : bool) (P : PROP) : PROP := (if p then P else P)%I. Global Arguments bi_affinely_if {_} !_ _%I /. Global Instance: Params (@bi_affinely_if) 2 := {}. Global Typeclasses Opaque bi_affinely_if. Notation "'?' p P" := (bi_affinely_if p P) : bi_scope. Definition bi_absorbingly_if {PROP : bi} (p : bool) (P : PROP) : PROP := (if p then P else P)%I. Global Arguments bi_absorbingly_if {_} !_ _%I /. Global Instance: Params (@bi_absorbingly_if) 2 := {}. Global Typeclasses Opaque bi_absorbingly_if. Notation "'?' p P" := (bi_absorbingly_if p P) : bi_scope. Definition bi_intuitionistically {PROP : bi} (P : PROP) : PROP := ( P)%I. Global Arguments bi_intuitionistically {_} _%I : simpl never. Global Instance: Params (@bi_intuitionistically) 1 := {}. Global 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. Global Arguments bi_intuitionistically_if {_} !_ _%I /. Global Instance: Params (@bi_intuitionistically_if) 2 := {}. Global Typeclasses Opaque bi_intuitionistically_if. Notation "'□?' p P" := (bi_intuitionistically_if p P) : bi_scope. Fixpoint bi_laterN {PROP : bi} (n : nat) (P : PROP) : PROP := match n with | O => P | S n' => ▷ ▷^n' P end where "▷^ n P" := (bi_laterN n P) : bi_scope. Global Arguments bi_laterN {_} !_%nat_scope _%I. Global Instance: Params (@bi_laterN) 2 := {}. Notation "▷? p P" := (bi_laterN (Nat.b2n p) P) : bi_scope. Definition bi_except_0 {PROP : bi} (P : PROP) : PROP := ▷ False ∨ P. Global Arguments bi_except_0 {_} _%I : simpl never. Notation "◇ P" := (bi_except_0 P) : bi_scope. Global Instance: Params (@bi_except_0) 1 := {}. Global Typeclasses Opaque bi_except_0. (* Timeless propositions are propositions that do not depend on the step-index. There are two equivalent ways of expressing that a step-indexed proposition [P : nat → Prop] is timeless: * Option one, used here, says that [∀ n, P n → P (S n)]. In the logic, this is stated as [▷ P ⊢ ◇ P] (which actually reads [∀ n > 0, P (n-1) → P n], but this is trivially equivalent). * Option two says that [∀ n, P 0 → P n]. In the logic, this is stated as a meta-entailment [∀ P, (▷ False ∧ P ⊢ Q) → (P ⊢ Q)]. The assumption [▷ False] expresses that the step-index is 0. Both formulations are equivalent. In the logic, this can be shown using Löb induction and [later_false_em]. In the model, this follows from regular natural induction. The law [timeless_alt] in [derived_laws_later.v] provides option two, by proving that both versions are equivalent in the logic. *) Class Timeless {PROP : bi} (P : PROP) := timeless : ▷ P ⊢ ◇ P. Global Arguments Timeless {_} _%I : simpl never. Global Arguments timeless {_} _%I {_}. Global Hint Mode Timeless + ! : typeclass_instances. Global 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 end. Global Arguments bi_wandM {_} !_%I _%I /. Notation "mP -∗? Q" := (bi_wandM mP Q) (at level 99, Q at level 200, right associativity) : bi_scope. iris-iris-4.2.0/iris/bi/derived_laws.v000066400000000000000000002200121460620107300176220ustar00rootroot00000000000000From iris.algebra Require Import monoid. From iris.bi Require Export extensions. From iris.prelude Require Import options. (* The sections add [BiAffine] and the like, which is only picked up with [Type*]. *) Set Default Proof Using "Type*". (** 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 derived. Context {PROP : bi}. Implicit Types φ : Prop. Implicit Types P Q R : PROP. Implicit Types Ps : list PROP. Implicit Types A : Type. Local Hint Extern 100 (NonExpansive _) => solve_proper : core. (* 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_entails. Qed. Lemma equiv_entails_1_1 P Q : (P ⊣⊢ Q) → (P ⊢ Q). Proof. apply equiv_entails. Qed. Lemma equiv_entails_1_2 P Q : (P ⊣⊢ Q) → (Q ⊢ P). Proof. apply equiv_entails. Qed. Lemma equiv_entails_2 P Q : (P ⊢ Q) → (Q ⊢ P) → (P ⊣⊢ Q). Proof. intros. by apply equiv_entails. Qed. Global Instance entails_proper : Proper ((⊣⊢) ==> (⊣⊢) ==> iff) ((⊢) : relation PROP). Proof. move => P1 P2 /equiv_entails [HP1 HP2] Q1 Q2 /equiv_entails [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. Local Hint Resolve pure_intro forall_intro : core. Local Hint Resolve or_elim or_intro_l' or_intro_r' : core. Local Hint Resolve and_intro and_elim_l' and_elim_r' : core. 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. Local Hint Immediate False_elim : core. Lemma entails_eq_True P Q : (P ⊢ Q) ↔ ((P → Q)%I ≡ True%I). Proof. split=>EQ. - apply bi.equiv_entails; 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_entails; 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 impl_refl P Q : Q ⊢ P → P. Proof. apply impl_intro_l, and_elim_l. Qed. Lemma impl_trans P Q R : (P → Q) ∧ (Q → R) ⊢ (P → R). Proof. apply impl_intro_l. by rewrite assoc !impl_elim_r. 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_entails; 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 exist_exist {A B} (Ψ : A → B → PROP) : (∃ x y, Ψ x y) ⊣⊢ (∃ y x, Ψ x y). Proof. apply (anti_symm (⊢)); do 2 (apply exist_elim=>?); rewrite -2!exist_intro; eauto. Qed. Lemma forall_forall {A B} (Ψ : A → B → PROP) : (∀ x y, Ψ x y) ⊣⊢ (∀ y x, Ψ x y). Proof. apply (anti_symm (⊢)); do 2 (apply forall_intro=>?); rewrite 2!forall_elim; eauto. Qed. Lemma exist_forall {A B} (Ψ : A → B → PROP) : (∃ x, ∀ y, Ψ x y) ⊢ (∀ y, ∃ x, Ψ x y). Proof. apply forall_intro=>?. apply exist_elim=>?. rewrite -exist_intro forall_elim ; eauto. Qed. Lemma impl_curry P Q R : (P → Q → R) ⊣⊢ (P ∧ Q → R). Proof. apply (anti_symm _). - apply impl_intro_l. by rewrite (comm _ P) -and_assoc !impl_elim_r. - do 2 apply impl_intro_l. by rewrite assoc (comm _ Q) impl_elim_r. Qed. Lemma or_and_l P Q R : P ∨ Q ∧ R ⊣⊢ (P ∨ Q) ∧ (P ∨ R). Proof. apply (anti_symm (⊢)); first auto. do 2 (apply impl_elim_l', or_elim; apply impl_intro_l); auto. Qed. Lemma or_and_r P Q R : P ∧ Q ∨ R ⊣⊢ (P ∨ R) ∧ (Q ∨ R). Proof. by rewrite -!(comm _ R) or_and_l. Qed. Lemma and_or_l P Q R : P ∧ (Q ∨ R) ⊣⊢ P ∧ Q ∨ P ∧ R. Proof. apply (anti_symm (⊢)); last auto. apply impl_elim_r', or_elim; apply impl_intro_l; auto. Qed. Lemma and_or_r P Q R : (P ∨ Q) ∧ R ⊣⊢ P ∧ R ∨ Q ∧ R. Proof. by rewrite -!(comm _ R) and_or_l. Qed. Lemma and_exist_l {A} P (Ψ : A → PROP) : P ∧ (∃ a, Ψ a) ⊣⊢ ∃ a, P ∧ Ψ a. Proof. apply (anti_symm (⊢)). - apply impl_elim_r'. apply exist_elim=>a. apply impl_intro_l. by rewrite -(exist_intro a). - apply exist_elim=>a. apply and_intro; first by rewrite and_elim_l. by rewrite -(exist_intro a) and_elim_r. Qed. Lemma and_exist_r {A} P (Φ: A → PROP) : (∃ a, Φ a) ∧ P ⊣⊢ ∃ a, Φ a ∧ P. Proof. rewrite -(comm _ P) and_exist_l. apply exist_proper=>a. by rewrite comm. Qed. Lemma or_exist {A} (Φ Ψ : A → PROP) : (∃ a, Φ a ∨ Ψ a) ⊣⊢ (∃ a, Φ a) ∨ (∃ a, Ψ a). Proof. apply (anti_symm (⊢)). - apply exist_elim=> a. by rewrite -!(exist_intro a). - apply or_elim; apply exist_elim=> a; rewrite -(exist_intro a); auto. Qed. Lemma and_alt P Q : P ∧ Q ⊣⊢ ∀ b : bool, if b then P else Q. Proof. apply (anti_symm _); first apply forall_intro=> -[]; auto. by apply and_intro; [rewrite (forall_elim true)|rewrite (forall_elim false)]. Qed. Lemma or_alt P Q : P ∨ Q ⊣⊢ ∃ b : bool, if b then P else Q. Proof. apply (anti_symm _); last apply exist_elim=> -[]; auto. by apply or_elim; [rewrite -(exist_intro true)|rewrite -(exist_intro false)]. Qed. Lemma entails_equiv_and P Q : (P ⊣⊢ Q ∧ P) ↔ (P ⊢ Q). Proof. split. - 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_refl. Qed. Lemma iff_sym P Q : (P ↔ Q) ⊣⊢ (Q ↔ P). Proof. apply equiv_entails. split; apply and_intro; try apply and_elim_r; apply and_elim_l. Qed. Lemma iff_trans P Q R : (P ↔ Q) ∧ (Q ↔ R) ⊢ (P ↔ R). Proof. apply and_intro. - rewrite /bi_iff (and_elim_l _ (_ → _)) (and_elim_l _ (_ → _)). apply impl_trans. - rewrite /bi_iff (and_elim_r _ (_ → _)) (and_elim_r _ (_ → _)) comm. apply impl_trans. Qed. (* BI Stuff *) Local Hint Resolve sep_mono : core. 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_refl P : ⊢ P -∗ P. Proof. apply wand_intro_l. by rewrite right_id. Qed. Lemma wand_trans P Q R : (P -∗ Q) ∗ (Q -∗ R) ⊢ (P -∗ R). Proof. apply wand_intro_l. by rewrite assoc !wand_elim_r. 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. Lemma exist_wand_forall {A} P (Ψ : A → PROP) : ((∃ x : A, Ψ x) -∗ P) ⊣⊢ ∀ x : A, Ψ x -∗ P. Proof. apply equiv_entails; split. - apply forall_intro=>x. by rewrite -exist_intro. - apply wand_intro_r, wand_elim_r', exist_elim=>x. apply wand_intro_r. by rewrite (forall_elim x) wand_elim_r. 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 : ⊢ P ∗-∗ P. Proof. apply and_intro; apply wand_intro_l; by rewrite right_id. Qed. Lemma wand_iff_sym P Q : (P ∗-∗ Q) ⊣⊢ (Q ∗-∗ P). Proof. apply equiv_entails; split; rewrite /bi_wand_iff; eauto. Qed. Lemma wand_iff_trans P Q R : (P ∗-∗ Q) ∗ (Q ∗-∗ R) ⊢ (P ∗-∗ R). Proof. apply and_intro. - rewrite /bi_wand_iff !and_elim_l. apply wand_trans. - rewrite /bi_wand_iff !and_elim_r comm. apply wand_trans. Qed. Lemma wand_entails P Q : (⊢ P -∗ Q) → P ⊢ Q. Proof. intros. rewrite -[P]emp_sep. by apply wand_elim_l'. Qed. Lemma entails_wand P Q : (P ⊢ Q) → ⊢ P -∗ Q. Proof. intros ->. apply wand_intro_r. by rewrite left_id. Qed. (* A version that works with rewrite, in which bi_emp_valid is unfolded. *) Lemma entails_wand' P Q : (P ⊢ Q) → emp ⊢ (P -∗ Q). Proof. apply entails_wand. Qed. Lemma wand_entails' P Q : (emp ⊢ (P -∗ Q)) → P ⊢ Q. Proof. apply wand_entails. Qed. Lemma equiv_wand_iff P Q : (P ⊣⊢ Q) → ⊢ P ∗-∗ Q. Proof. intros ->; apply wand_iff_refl. Qed. Lemma wand_iff_equiv P Q : (⊢ P ∗-∗ Q) → (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). Proof. intros ->. apply impl_intro_l. auto. Qed. Lemma impl_entails P Q `{!Affine P} : (⊢ P → Q) → 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). 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 entails_wand, 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. (* 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 : P ⊢ emp. Proof. rewrite /bi_affinely; auto. Qed. Global Instance affinely_affine P : Affine ( P). Proof. by rewrite /Affine affinely_elim_emp. Qed. Lemma affinely_elim P : P ⊢ P. Proof. rewrite /bi_affinely; auto. Qed. Lemma affinely_mono P Q : (P ⊢ Q) → P ⊢ Q. Proof. by intros ->. Qed. Lemma affinely_idemp P : P ⊣⊢ P. Proof. by rewrite /bi_affinely assoc idemp. Qed. Lemma affinely_intro' P Q : ( P ⊢ Q) → P ⊢ Q. Proof. intros <-. by rewrite affinely_idemp. Qed. Lemma affinely_False : False ⊣⊢ False. Proof. by rewrite /bi_affinely right_absorb. Qed. Lemma affinely_emp : emp ⊣⊢ emp. Proof. by rewrite /bi_affinely (idemp bi_and). Qed. Lemma affinely_or P Q : (P ∨ Q) ⊣⊢ P ∨ Q. Proof. by rewrite /bi_affinely and_or_l. Qed. Lemma affinely_and P Q : (P ∧ Q) ⊣⊢ P ∧ Q. Proof. rewrite /bi_affinely -(comm _ P) (assoc _ (_ ∧ _)%I) -!(assoc _ P). by rewrite idemp !assoc (comm _ P). Qed. Lemma affinely_sep_2 P Q : P ∗ Q ⊢ (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 : (P ∗ Q) ⊣⊢ P ∗ Q. Proof. apply (anti_symm _), affinely_sep_2. by rewrite -{1}affinely_idemp bi_positive !(comm _ ( P)%I) bi_positive. Qed. Lemma affinely_forall {A} (Φ : A → PROP) : (∀ a, Φ a) ⊢ ∀ a, (Φ a). Proof. apply forall_intro=> a. by rewrite (forall_elim a). Qed. Lemma affinely_exist {A} (Φ : A → PROP) : (∃ a, Φ a) ⊣⊢ ∃ a, (Φ a). Proof. by rewrite /bi_affinely and_exist_l. Qed. Lemma affinely_True_emp : True ⊣⊢ emp. Proof. apply (anti_symm _); rewrite /bi_affinely; auto. Qed. Lemma affinely_and_l P Q : P ∧ Q ⊣⊢ (P ∧ Q). Proof. by rewrite /bi_affinely assoc. Qed. Lemma affinely_and_r P Q : P ∧ Q ⊣⊢ (P ∧ Q). Proof. by rewrite /bi_affinely !assoc (comm _ P). Qed. Lemma affinely_and_lr P Q : P ∧ Q ⊣⊢ P ∧ Q. Proof. by rewrite affinely_and_l affinely_and_r. Qed. (* 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. (* 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 ⊢ P. Proof. by rewrite /bi_absorbingly -True_sep_2. Qed. Lemma absorbingly_mono P Q : (P ⊢ Q) → P ⊢ Q. Proof. by intros ->. Qed. Lemma absorbingly_idemp P : P ⊣⊢ P. Proof. apply (anti_symm _), absorbingly_intro. rewrite /bi_absorbingly assoc. apply sep_mono; auto. Qed. Global Instance absorbingly_absorbing P : Absorbing ( P). Proof. by rewrite /Absorbing absorbingly_idemp. Qed. Lemma absorbingly_pure φ : ⌜ φ ⌝ ⊣⊢ ⌜ φ ⌝. Proof. apply (anti_symm _), absorbingly_intro. apply wand_elim_r', pure_elim'=> ?. apply wand_intro_l; auto. Qed. Lemma absorbingly_True : True ⊣⊢ True. Proof. apply absorbingly_pure. Qed. Lemma absorbingly_or P Q : (P ∨ Q) ⊣⊢ P ∨ Q. Proof. by rewrite /bi_absorbingly sep_or_l. Qed. Lemma absorbingly_and_1 P Q : (P ∧ Q) ⊢ P ∧ Q. Proof. apply and_intro; apply absorbingly_mono; auto. Qed. Lemma absorbingly_forall {A} (Φ : A → PROP) : (∀ a, Φ a) ⊢ ∀ a, (Φ a). Proof. apply forall_intro=> a. by rewrite (forall_elim a). Qed. Lemma absorbingly_exist {A} (Φ : A → PROP) : (∃ a, Φ a) ⊣⊢ ∃ a, (Φ a). Proof. by rewrite /bi_absorbingly sep_exist_l. Qed. Lemma absorbingly_sep P Q : (P ∗ Q) ⊣⊢ P ∗ Q. Proof. by rewrite -{1}absorbingly_idemp /bi_absorbingly !assoc -!(comm _ P) !assoc. Qed. Lemma absorbingly_emp_True : emp ⊣⊢ True. Proof. rewrite /bi_absorbingly right_id //. Qed. Lemma absorbingly_wand P Q : (P -∗ Q) ⊢ P -∗ Q. Proof. apply wand_intro_l. by rewrite -absorbingly_sep wand_elim_r. Qed. Lemma absorbingly_sep_l P Q : P ∗ Q ⊣⊢ (P ∗ Q). Proof. by rewrite /bi_absorbingly assoc. Qed. Lemma absorbingly_sep_r P Q : P ∗ Q ⊣⊢ (P ∗ Q). Proof. by rewrite /bi_absorbingly !assoc (comm _ P). Qed. Lemma absorbingly_sep_lr P Q : P ∗ Q ⊣⊢ P ∗ Q. Proof. by rewrite absorbingly_sep_l absorbingly_sep_r. Qed. Lemma affinely_absorbingly_elim `{!BiPositive PROP} P : P ⊣⊢ P. Proof. apply (anti_symm _), affinely_mono, absorbingly_intro. by rewrite /bi_absorbingly affinely_sep affinely_True_emp left_id. 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. (* The instance for [Absorbing (P → Q)] is in the persistence section *) 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. apply wand_intro_l. by rewrite absorbingly_sep_r -absorbingly_sep_l absorbing 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. (* 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} : P ⊣⊢ P. Proof. rewrite /bi_affinely. apply (anti_symm _); auto. Qed. Lemma absorbing_absorbingly P `{!Absorbing P} : 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 `{HQP : TCOr (Affine Q) (Absorbing P)} : P ∗ Q ⊢ P. Proof. destruct HQP. - by rewrite (affine Q) right_id. - by rewrite (True_intro Q) comm. Qed. Lemma sep_elim_r P Q `{TCOr (Affine P) (Absorbing Q)} : P ∗ Q ⊢ Q. Proof. by rewrite comm sep_elim_l. Qed. Lemma sep_and P Q : TCOr (Affine P) (Absorbing Q) → TCOr (Affine Q) (Absorbing P) → P ∗ Q ⊢ P ∧ Q. Proof. intros [?|?] [?|?]; apply and_intro; apply: sep_elim_l || apply: sep_elim_r. Qed. Lemma affinely_intro P Q `{!Affine P} : (P ⊢ Q) → P ⊢ 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) 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. End bi_affine. (* 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 φ1 φ2 : ⌜φ1 → φ2⌝ ⊢ (⌜φ1⌝ → ⌜φ2⌝). Proof. apply impl_intro_l. rewrite -pure_and. apply pure_mono. naive_solver. Qed. Lemma pure_impl_2 `{!BiPureForall PROP} φ1 φ2 : (⌜φ1⌝ → ⌜φ2⌝) ⊢ ⌜φ1 → φ2⌝. Proof. rewrite -pure_forall_2. apply forall_intro=> ?. by rewrite -(left_id True bi_and (_→_))%I (pure_True φ1) // impl_elim_r. Qed. Lemma pure_impl `{!BiPureForall PROP} φ1 φ2 : ⌜φ1 → φ2⌝ ⊣⊢ (⌜φ1⌝ → ⌜φ2⌝). Proof. apply (anti_symm _); auto using pure_impl_1, pure_impl_2. Qed. Lemma pure_forall_1 {A} (φ : A → Prop) : ⌜∀ x, φ x⌝ ⊢ ∀ x, ⌜φ x⌝. Proof. apply forall_intro=> x. eauto using pure_mono. Qed. Lemma pure_forall `{!BiPureForall PROP} {A} (φ : A → Prop) : ⌜∀ x, φ x⌝ ⊣⊢ ∀ x, ⌜φ x⌝. Proof. apply (anti_symm _); auto using pure_forall_1, pure_forall_2. 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 bi_pure_forall_em : (∀ φ : Prop, φ ∨ ¬φ) → BiPureForall PROP. Proof. intros Hem A φ. destruct (Hem (∃ a, ¬φ a)) as [[a Hφ]|Hφ]. { rewrite (forall_elim a). by apply pure_elim'. } apply pure_intro=> a. destruct (Hem (φ a)); naive_solver. 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) // 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. Lemma decide_bi_True φ `{!Decision φ} (P : PROP) : (if decide φ then P else True) ⊣⊢ (⌜φ⌝ → P). Proof. destruct (decide _). - by rewrite pure_True // True_impl. - by rewrite (pure_False φ) // False_impl. Qed. Lemma decide_emp `{!BiAffine PROP} φ `{!Decision φ} (P : PROP) : (if decide φ then P else emp) ⊣⊢ (⌜φ⌝ → P). Proof. rewrite -decide_bi_True. destruct (decide _); [done|]. by rewrite True_emp. Qed. (* Properties of the persistence modality *) Local Hint Resolve persistently_mono : core. Global Instance persistently_mono' : Proper ((⊢) ==> (⊢)) (@bi_persistently PROP). Proof. intros P Q; apply persistently_mono. Qed. Global Instance persistently_flip_mono' : Proper (flip (⊢) ==> flip (⊢)) (@bi_persistently PROP). Proof. intros P Q; apply persistently_mono. Qed. Global Instance persistently_persistent P : Persistent ( P). Proof. by rewrite /Persistent -persistently_idemp_2. Qed. Lemma absorbingly_elim_persistently P : P ⊣⊢ P. Proof. apply (anti_symm _), absorbingly_intro. by rewrite /bi_absorbingly comm persistently_absorbing. Qed. Global Instance persistently_absorbing P : Absorbing ( P). Proof. by rewrite /Absorbing absorbingly_elim_persistently. Qed. Lemma persistently_forall_1 {A} (Ψ : A → PROP) : (∀ a, Ψ a) ⊢ ∀ a, (Ψ a). Proof. apply forall_intro=> x. by rewrite (forall_elim x). Qed. Lemma persistently_forall `{!BiPersistentlyForall PROP} {A} (Ψ : A → PROP) : (∀ a, Ψ a) ⊣⊢ ∀ a, (Ψ a). Proof. apply (anti_symm _); auto using persistently_forall_1, persistently_forall_2. Qed. Lemma persistently_exist {A} (Ψ : A → PROP) : (∃ a, Ψ a) ⊣⊢ ∃ a, (Ψ a). Proof. apply (anti_symm _); first by 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. apply (anti_symm _); by auto using persistently_and_2. 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_emp_intro P : P ⊢ emp. Proof. rewrite -(left_id emp%I bi_sep P). by rewrite {1}persistently_emp_2 sep_elim_l. Qed. Lemma persistently_True_emp : True ⊣⊢ emp. Proof. apply (anti_symm _); auto using persistently_emp_intro. Qed. Lemma persistently_True : True ⊣⊢ True. Proof. apply (anti_symm _); auto. rewrite persistently_True_emp. apply persistently_emp_intro. Qed. Lemma persistently_and_emp P : P ⊣⊢ (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 : P ∧ Q ⊢ (emp ∧ P) ∗ Q. Proof. rewrite persistently_and_emp. apply persistently_and_sep_elim. Qed. Lemma persistently_and_sep_assoc P Q R : P ∧ (Q ∗ R) ⊣⊢ ( 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 sep_elim_l. + by rewrite and_elim_l left_id. - apply and_intro. + by rewrite and_elim_l sep_elim_l. + by rewrite and_elim_r. Qed. Lemma persistently_and_emp_elim P : emp ∧ P ⊢ P. Proof. by rewrite comm persistently_and_sep_elim_emp right_id and_elim_r. Qed. Lemma persistently_into_absorbingly P : P ⊢ P. Proof. rewrite -(right_id True%I _ ( _)%I) -{1}(emp_sep True%I). rewrite persistently_and_sep_assoc. rewrite (comm bi_and) persistently_and_emp_elim comm //. Qed. Lemma persistently_elim P `{!Absorbing P} : P ⊢ P. Proof. by rewrite persistently_into_absorbingly absorbing_absorbingly. Qed. Lemma persistently_idemp_1 P : P ⊢ P. Proof. by rewrite persistently_into_absorbingly absorbingly_elim_persistently. Qed. Lemma persistently_idemp P : P ⊣⊢ P. Proof. apply (anti_symm _); auto using persistently_idemp_1, persistently_idemp_2. Qed. Lemma persistently_intro' P Q : ( P ⊢ Q) → P ⊢ Q. Proof. intros <-. apply persistently_idemp_2. Qed. Lemma persistently_pure φ : ⌜φ⌝ ⊣⊢ ⌜φ⌝. Proof. apply (anti_symm _). { by rewrite persistently_into_absorbingly absorbingly_pure. } apply pure_elim'=> Hφ. rewrite -persistently_True. auto using persistently_mono, pure_intro. Qed. Lemma persistently_sep_dup P : P ⊣⊢ P ∗ P. Proof. apply (anti_symm _). - rewrite -{1}(idemp bi_and ( _)%I). by rewrite -{2}(emp_sep ( _)%I) persistently_and_sep_assoc and_elim_l. - by rewrite sep_elim_l. Qed. Lemma persistently_and_sep_l_1 P Q : P ∧ Q ⊢ P ∗ Q. Proof. by rewrite -{1}(emp_sep Q) persistently_and_sep_assoc and_elim_l. Qed. Lemma persistently_and_sep_r_1 P Q : P ∧ Q ⊢ P ∗ Q. Proof. by rewrite !(comm _ P) persistently_and_sep_l_1. Qed. Lemma persistently_and_sep P Q : (P ∧ Q) ⊢ (P ∗ Q). Proof. rewrite persistently_and. rewrite -{1}persistently_idemp -persistently_and -{1}(emp_sep Q). by rewrite persistently_and_sep_assoc (comm bi_and) persistently_and_emp_elim. Qed. Lemma persistently_affinely_elim P : P ⊣⊢ P. Proof. by rewrite /bi_affinely persistently_and -persistently_True_emp persistently_pure left_id. Qed. Lemma and_sep_persistently P Q : P ∧ Q ⊣⊢ P ∗ Q. Proof. apply (anti_symm _); auto using persistently_and_sep_l_1. apply and_intro. - by rewrite sep_elim_l. - by rewrite sep_elim_r. Qed. Lemma persistently_sep_2 P Q : P ∗ Q ⊢ (P ∗ Q). Proof. by rewrite -persistently_and_sep persistently_and -and_sep_persistently. Qed. Lemma persistently_sep `{!BiPositive PROP} P Q : (P ∗ Q) ⊣⊢ P ∗ 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 : P ⊣⊢ P ∗ P. Proof. apply (anti_symm _). - rewrite -persistently_and_sep_elim. apply and_intro; done. - by rewrite sep_elim_r. Qed. Lemma persistently_alt_fixpoint' P : P ⊣⊢ P ∗ P. Proof. rewrite -{1}persistently_affinely_elim {1}persistently_alt_fixpoint persistently_affinely_elim //. Qed. Lemma persistently_wand P Q : (P -∗ Q) ⊢ P -∗ Q. Proof. apply wand_intro_r. by rewrite persistently_sep_2 wand_elim_l. Qed. Lemma persistently_entails_l P Q : (P ⊢ Q) → P ⊢ Q ∗ P. Proof. intros; rewrite -persistently_and_sep_l_1; auto. Qed. Lemma persistently_entails_r P Q : (P ⊢ Q) → P ⊢ P ∗ Q. Proof. intros; rewrite -persistently_and_sep_r_1; auto. Qed. Lemma persistently_impl_wand_2 P Q : (P -∗ Q) ⊢ (P → Q). Proof. apply persistently_intro', impl_intro_r. rewrite -{2}(emp_sep P) persistently_and_sep_assoc. by rewrite (comm bi_and) persistently_and_emp_elim wand_elim_l. Qed. Lemma impl_wand_persistently_2 P Q : ( P -∗ Q) ⊢ ( 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 : emp ⊣⊢ emp. Proof. by rewrite -!True_emp persistently_pure. Qed. Lemma persistently_and_sep_l P Q : P ∧ Q ⊣⊢ P ∗ Q. Proof. apply (anti_symm (⊢)); eauto using persistently_and_sep_l_1, sep_and with typeclass_instances. Qed. Lemma persistently_and_sep_r P Q : P ∧ Q ⊣⊢ P ∗ Q. Proof. by rewrite !(comm _ P) persistently_and_sep_l. Qed. Lemma persistently_impl_wand P Q : (P → Q) ⊣⊢ (P -∗ Q). Proof. apply (anti_symm (⊢)); auto using persistently_impl_wand_2. apply persistently_intro', wand_intro_l. by rewrite -persistently_and_sep_r persistently_elim impl_elim_r. Qed. Lemma impl_wand_persistently P Q : ( P → Q) ⊣⊢ ( 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 ∗ (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. End persistently_affine_bi. (* 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 `{!BiPersistentlyForall PROP} {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 affinely_persistent P : Persistent P → Persistent ( P). Proof. rewrite /bi_affinely. apply _. Qed. Global Instance absorbingly_persistent P : Persistent P → Persistent ( 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. (* 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. Global Instance intuitionistically_affine P : Affine (□ P). Proof. rewrite /bi_intuitionistically. apply _. Qed. Global Instance intuitionistically_persistent P : Persistent (□ P). Proof. rewrite /bi_intuitionistically. apply _. Qed. Lemma intuitionistically_def P : (□ P)%I = ( P)%I. Proof. done. 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 <-. rewrite /bi_intuitionistically. by rewrite persistently_affinely_elim persistently_idemp. Qed. Lemma intuitionistically_emp : □ emp ⊣⊢ emp. Proof. by rewrite /bi_intuitionistically -persistently_True_emp persistently_pure affinely_True_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_1 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. rewrite /bi_intuitionistically. by rewrite persistently_affinely_elim persistently_idemp. Qed. Lemma intuitionistically_into_persistently_1 P : □ P ⊢ P. Proof. rewrite /bi_intuitionistically affinely_elim //. Qed. Lemma intuitionistically_persistently_elim P : □ 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 ⊢ 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 : □ P ⊣⊢ □ P. Proof. rewrite /bi_intuitionistically persistently_affinely_elim //. Qed. Lemma persistently_and_intuitionistically_sep_l P Q : P ∧ Q ⊣⊢ □ P ∗ Q. Proof. rewrite /bi_intuitionistically. apply (anti_symm _). - by rewrite /bi_affinely -(comm bi_and ( P)%I) -persistently_and_sep_assoc left_id. - apply and_intro. + by rewrite affinely_elim sep_elim_l. + by rewrite affinely_elim_emp left_id. Qed. Lemma persistently_and_intuitionistically_sep_r P Q : P ∧ 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. rewrite -persistently_and_intuitionistically_sep_l. by rewrite -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 : ( 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. Lemma intuitionistically_impl_wand_2 P Q : □ (P -∗ Q) ⊢ □ (P → Q). Proof. by rewrite /bi_intuitionistically persistently_impl_wand_2. Qed. Lemma impl_alt P Q : (P → Q) ⊣⊢ ∃ R, R ∧ (P ∧ R -∗ Q). Proof. apply (anti_symm (⊢)). - rewrite -(right_id True%I bi_and (P → Q)%I) -(exist_intro (P → Q)%I). apply and_mono_r. rewrite impl_elim_r -entails_wand //. apply persistently_emp_intro. - apply exist_elim=> R. apply impl_intro_l. rewrite assoc persistently_and_intuitionistically_sep_r. by rewrite intuitionistically_elim wand_elim_r. Qed. Section bi_affine_intuitionistically. Context `{!BiAffine PROP}. Lemma intuitionistically_into_persistently P : □ P ⊣⊢ 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. Global Instance affinely_if_affine p P : Affine P → Affine (?p P). Proof. destruct p; simpl; apply _. Qed. Global Instance affinely_if_persistent p P : Persistent P → Persistent (?p P). Proof. destruct p; simpl; apply _. Qed. Lemma affinely_if_mono p P Q : (P ⊢ Q) → ?p P ⊢ ?p Q. Proof. by intros ->. Qed. Lemma affinely_if_flag_mono (p q : bool) P : (q → p) → ?p P ⊢ ?q P. Proof. destruct p, q; naive_solver auto using affinely_elim. Qed. Lemma affinely_if_elim p P : ?p P ⊢ P. Proof. destruct p; simpl; auto using affinely_elim. Qed. Lemma affinely_affinely_if p P : P ⊢ ?p P. Proof. destruct p; simpl; auto using affinely_elim. Qed. Lemma affinely_if_intro' p P Q : (?p P ⊢ Q) → ?p P ⊢ ?p Q. Proof. destruct p; simpl; auto using affinely_intro'. Qed. Lemma affinely_if_emp p : ?p emp ⊣⊢ emp. Proof. destruct p; simpl; auto using affinely_emp. Qed. Lemma affinely_if_and p P Q : ?p (P ∧ Q) ⊣⊢ ?p P ∧ ?p Q. Proof. destruct p; simpl; auto using affinely_and. Qed. Lemma affinely_if_or p P Q : ?p (P ∨ Q) ⊣⊢ ?p P ∨ ?p Q. Proof. destruct p; simpl; auto using affinely_or. Qed. Lemma affinely_if_exist {A} p (Ψ : A → PROP) : ?p (∃ a, Ψ a) ⊣⊢ ∃ a, ?p (Ψ a). Proof. destruct p; simpl; auto using affinely_exist. Qed. Lemma affinely_if_sep_2 p P Q : ?p P ∗ ?p Q ⊢ ?p (P ∗ Q). Proof. destruct p; simpl; auto using affinely_sep_2. Qed. Lemma affinely_if_sep `{!BiPositive PROP} p P Q : ?p (P ∗ Q) ⊣⊢ ?p P ∗ ?p Q. Proof. destruct p; simpl; auto using affinely_sep. Qed. Lemma affinely_if_idemp p P : ?p ?p P ⊣⊢ ?p P. Proof. destruct p; simpl; auto using affinely_idemp. Qed. Lemma affinely_if_and_l p P Q : ?p P ∧ Q ⊣⊢ ?p (P ∧ Q). Proof. destruct p; simpl; auto using affinely_and_l. Qed. Lemma affinely_if_and_r p P Q : P ∧ ?p Q ⊣⊢ ?p (P ∧ Q). Proof. destruct p; simpl; auto using affinely_and_r. Qed. Lemma affinely_if_and_lr p P Q : ?p P ∧ Q ⊣⊢ P ∧ ?p Q. Proof. destruct p; simpl; auto using affinely_and_lr. Qed. (* Conditional absorbingly modality *) Global Instance absorbingly_if_ne p : NonExpansive (@bi_absorbingly_if PROP p). Proof. solve_proper. Qed. Global Instance absorbingly_if_proper p : Proper ((⊣⊢) ==> (⊣⊢)) (@bi_absorbingly_if PROP p). Proof. solve_proper. Qed. Global Instance absorbingly_if_mono' p : Proper ((⊢) ==> (⊢)) (@bi_absorbingly_if PROP p). Proof. solve_proper. Qed. Global Instance absorbingly_if_flip_mono' p : Proper (flip (⊢) ==> flip (⊢)) (@bi_absorbingly_if PROP p). Proof. solve_proper. Qed. Global Instance absorbingly_if_persistent p P : Persistent P → Persistent (?p P). Proof. destruct p; simpl; apply _. Qed. Lemma absorbingly_if_absorbingly p P : ?p P ⊢ P. Proof. destruct p; simpl; auto using absorbingly_intro. Qed. Lemma absorbingly_if_intro p P : P ⊢ ?p P. Proof. destruct p; simpl; auto using absorbingly_intro. Qed. Lemma absorbingly_if_mono p P Q : (P ⊢ Q) → ?p P ⊢ ?p Q. Proof. by intros ->. Qed. Lemma absorbingly_if_flag_mono (p q : bool) P : (p → q) → ?p P ⊢ ?q P. Proof. destruct p, q; try naive_solver auto using absorbingly_intro. Qed. Lemma absorbingly_if_idemp p P : ?p ?p P ⊣⊢ ?p P. Proof. destruct p; simpl; auto using absorbingly_idemp. Qed. Lemma absorbingly_if_pure p φ : ?p ⌜ φ ⌝ ⊣⊢ ⌜ φ ⌝. Proof. destruct p; simpl; auto using absorbingly_pure. Qed. Lemma absorbingly_if_or p P Q : ?p (P ∨ Q) ⊣⊢ ?p P ∨ ?p Q. Proof. destruct p; simpl; auto using absorbingly_or. Qed. Lemma absorbingly_if_and_1 p P Q : ?p (P ∧ Q) ⊢ ?p P ∧ ?p Q. Proof. destruct p; simpl; auto using absorbingly_and_1. Qed. Lemma absorbingly_if_forall {A} p (Φ : A → PROP) : ?p (∀ a, Φ a) ⊢ ∀ a, ?p (Φ a). Proof. destruct p; simpl; auto using absorbingly_forall. Qed. Lemma absorbingly_if_exist {A} p (Φ : A → PROP) : ?p (∃ a, Φ a) ⊣⊢ ∃ a, ?p (Φ a). Proof. destruct p; simpl; auto using absorbingly_exist. Qed. Lemma absorbingly_if_sep p P Q : ?p (P ∗ Q) ⊣⊢ ?p P ∗ ?p Q. Proof. destruct p; simpl; auto using absorbingly_sep. Qed. Lemma absorbingly_if_wand p P Q : ?p (P -∗ Q) ⊢ ?p P -∗ ?p Q. Proof. destruct p; simpl; auto using absorbingly_wand. Qed. Lemma absorbingly_if_sep_l p P Q : ?p P ∗ Q ⊣⊢ ?p (P ∗ Q). Proof. destruct p; simpl; auto using absorbingly_sep_l. Qed. Lemma absorbingly_if_sep_r p P Q : P ∗ ?p Q ⊣⊢ ?p (P ∗ Q). Proof. destruct p; simpl; auto using absorbingly_sep_r. Qed. Lemma absorbingly_if_sep_lr p P Q : ?p P ∗ Q ⊣⊢ P ∗ ?p Q. Proof. destruct p; simpl; auto using absorbingly_sep_lr. Qed. Lemma affinely_if_absorbingly_if_elim `{!BiPositive PROP} p P : ?p ?p P ⊣⊢ ?p P. Proof. destruct p; simpl; auto using affinely_absorbingly_elim. 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. Global Instance persistently_if_absorbing P p : Absorbing P → Absorbing (?p P). Proof. intros; destruct p; simpl; apply _. Qed. Lemma persistently_if_mono p P Q : (P ⊢ Q) → ?p P ⊢ ?p Q. Proof. by intros ->. Qed. Lemma persistently_if_pure p φ : ?p ⌜φ⌝ ⊣⊢ ⌜φ⌝. Proof. destruct p; simpl; auto using persistently_pure. Qed. Lemma persistently_if_and p P Q : ?p (P ∧ Q) ⊣⊢ ?p P ∧ ?p Q. Proof. destruct p; simpl; auto using persistently_and. Qed. Lemma persistently_if_or p P Q : ?p (P ∨ Q) ⊣⊢ ?p P ∨ ?p Q. Proof. destruct p; simpl; auto using persistently_or. Qed. Lemma persistently_if_exist {A} p (Ψ : A → PROP) : (?p (∃ a, Ψ a)) ⊣⊢ ∃ a, ?p (Ψ a). Proof. destruct p; simpl; auto using persistently_exist. Qed. Lemma persistently_if_sep_2 p P Q : ?p P ∗ ?p Q ⊢ ?p (P ∗ Q). Proof. destruct p; simpl; auto using persistently_sep_2. Qed. Lemma persistently_if_sep `{!BiPositive PROP} p P Q : ?p (P ∗ Q) ⊣⊢ ?p P ∗ ?p Q. Proof. destruct p; simpl; auto using persistently_sep. Qed. Lemma persistently_if_idemp p P : ?p ?p P ⊣⊢ ?p P. Proof. destruct p; simpl; auto using persistently_idemp. Qed. (* Conditional 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. Global Instance intuitionistically_if_affine p P : Affine P → Affine (□?p P). Proof. destruct p; simpl; apply _. 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 ⊣⊢ ?p ?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 ⊢ P. Proof. done. Qed. Lemma persistent_persistently P `{!Persistent P, !Absorbing P} : P ⊣⊢ P. Proof. apply (anti_symm _); auto using persistent_persistently_2, persistently_elim. Qed. Lemma persistently_intro P Q `{!Persistent P} : (P ⊢ Q) → P ⊢ Q. Proof. intros HP. by rewrite (persistent P) HP. Qed. Lemma persistent_and_affinely_sep_l_1 P Q `{!Persistent P} : P ∧ Q ⊢ P ∗ Q. Proof. rewrite {1}(persistent_persistently_2 P). rewrite persistently_and_intuitionistically_sep_l. rewrite intuitionistically_affinely //. Qed. Lemma persistent_and_affinely_sep_r_1 P Q `{!Persistent Q} : P ∧ Q ⊢ P ∗ 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 ⊣⊢ P ∗ Q. Proof. rewrite -(persistent_persistently P). by rewrite persistently_and_intuitionistically_sep_l. Qed. Lemma persistent_and_affinely_sep_r P Q `{!Persistent Q, !Absorbing Q} : P ∧ Q ⊣⊢ P ∗ Q. Proof. rewrite -(persistent_persistently Q). by rewrite 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 `{HP : !TCOr (Affine P) (Absorbing P), !Persistent P} : P ⊣⊢ P ∗ P. Proof. destruct HP; last by rewrite -(persistent_persistently P) -persistently_sep_dup. apply (anti_symm (⊢)). - by rewrite -{1}(intuitionistic_intuitionistically P) intuitionistically_sep_dup intuitionistically_elim. - by rewrite {1}(affine P) left_id. 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 : □ P ⊣⊢ P. Proof. apply (anti_symm _). - rewrite intuitionistically_into_persistently_1. by rewrite absorbingly_elim_persistently. - rewrite -{1}(idemp bi_and ( _)%I). rewrite persistently_and_intuitionistically_sep_r. by rewrite {1} (True_intro ( _)%I). Qed. Lemma persistent_absorbingly_affinely_2 P `{!Persistent P} : P ⊢ P. Proof. rewrite {1}(persistent P) -absorbingly_intuitionistically_into_persistently. by rewrite intuitionistically_affinely. Qed. Lemma persistent_absorbingly_affinely P `{!Persistent P, !Absorbing P} : P ⊣⊢ P. Proof. rewrite -(persistent_persistently P). by rewrite 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 persistent_impl_wand_affinely P `{!Persistent P, !Absorbing P} Q : (P → Q) ⊣⊢ ( P -∗ Q). Proof. apply (anti_symm _). - apply wand_intro_l. rewrite -persistent_and_affinely_sep_l impl_elim_r //. - apply impl_intro_l. rewrite persistent_and_affinely_sep_l wand_elim_r //. 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. (** We don't have a [Intuitionistic] typeclass, but if we did, this would be its only field. *) Lemma intuitionistic P `{!Persistent P, !Affine P} : P ⊢ □ P. Proof. rewrite intuitionistic_intuitionistically. done. Qed. Lemma intuitionistically_intro P Q `{!Affine P, !Persistent P} : (P ⊢ Q) → P ⊢ □ Q. Proof. intros. apply: affinely_intro. by apply: persistently_intro. 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. 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. (* 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; [by apply _ ..|]. apply persistently_sep. Qed. Global Instance bi_persistently_sep_homomorphism `{!BiAffine PROP} : MonoidHomomorphism bi_sep bi_sep (≡) (@bi_persistently PROP). Proof. split; [by apply _ ..|]. apply persistently_emp. Qed. Global Instance bi_persistently_sep_entails_weak_homomorphism : WeakMonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@bi_persistently PROP). Proof. split; [by 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; [by apply _ ..|]. simpl. apply persistently_emp_intro. Qed. (* Limits *) Lemma limit_preserving_entails {A : ofe} `{!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_emp_valid {A : ofe} `{!Cofe A} (Φ : A → PROP) : NonExpansive Φ → LimitPreserving (λ x, ⊢ Φ x). Proof. intros. apply limit_preserving_entails; first solve_proper. done. Qed. Lemma limit_preserving_equiv {A : ofe} `{!Cofe A} (Φ Ψ : A → PROP) : NonExpansive Φ → NonExpansive Ψ → LimitPreserving (λ x, Φ x ⊣⊢ Ψ x). Proof. intros HΦ HΨ. eapply limit_preserving_ext. { intros x. symmetry; apply equiv_entails. } apply limit_preserving_and; by apply limit_preserving_entails. Qed. Global Instance limit_preserving_Persistent {A : ofe} `{!Cofe A} (Φ : A → PROP) : NonExpansive Φ → LimitPreserving (λ x, Persistent (Φ x)). Proof. intros. apply limit_preserving_entails; solve_proper. Qed. (* iterated modalities *) Lemma iter_modal_intro (M : PROP → PROP) P (n : nat) : (∀ Q, Q ⊢ M Q) → P ⊢ Nat.iter n M P. Proof. intros Hintro; induction n as [|n IHn]; simpl; first done. etransitivity; first apply IHn. apply Hintro. Qed. Lemma iter_modal_mono (M : PROP → PROP) P Q (n : nat) : (∀ P Q, (P -∗ Q) ⊢ M P -∗ M Q) → (P -∗ Q) ⊢ Nat.iter n M P -∗ Nat.iter n M Q. Proof. intros Hmono; induction n as [|n IHn]; simpl; first done. rewrite -Hmono //. Qed. End derived. End bi. iris-iris-4.2.0/iris/bi/derived_laws_later.v000066400000000000000000000551071460620107300210240ustar00rootroot00000000000000From iris.algebra Require Import monoid. From iris.bi Require Export derived_laws. From iris.prelude Require Import options. Module bi. Import interface.bi. Import derived_laws.bi. Section later_derived. Context {PROP : bi}. 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). Local Hint Resolve or_elim or_intro_l' or_intro_r' True_intro False_elim : core. Local Hint Resolve and_elim_l' and_elim_r' and_intro forall_intro : core. Global Instance later_proper : Proper ((⊣⊢) ==> (⊣⊢)) (@bi_later PROP) := ne_proper _. (* Later derived *) Local Hint Resolve later_mono : core. Global Instance later_mono' : Proper ((⊢) ==> (⊢)) (@bi_later PROP). Proof. intros P Q; apply later_mono. Qed. Global Instance later_flip_mono' : Proper (flip (⊢) ==> flip (⊢)) (@bi_later PROP). Proof. intros P Q; apply later_mono. Qed. Lemma later_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_except_0 {A} (Φ : A → PROP) : ▷ (∃ a, Φ a) ⊢ ◇ (∃ a, ▷ Φ a). Proof. apply later_exist_false. 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_wand_iff P Q : ▷ (P ∗-∗ Q) ⊢ ▷ P ∗-∗ ▷ Q. Proof. by rewrite /bi_wand_iff later_and !later_wand. Qed. Lemma later_persistently P : ▷ P ⊣⊢ ▷ P. Proof. apply (anti_symm _); auto using later_persistently_1, later_persistently_2. Qed. Lemma later_affinely_2 P : ▷ P ⊢ ▷ 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 : ▷ P ⊣⊢ ▷ P. Proof. by rewrite /bi_absorbingly later_sep later_True. Qed. Lemma later_affinely `{!BiAffine PROP} P : ▷ P ⊣⊢ ▷ P. Proof. by rewrite !affine_affinely. Qed. Lemma later_intuitionistically `{!BiAffine PROP} P : ▷ □ P ⊣⊢ □ ▷ P. Proof. by rewrite !intuitionistically_into_persistently later_persistently. Qed. Lemma later_intuitionistically_if `{!BiAffine PROP} p P : ▷ □?p P ⊣⊢ □?p ▷ P. Proof. destruct p; simpl; auto using later_intuitionistically. 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. (** * Alternatives to Löb induction *) (** We prove relations between the following statements: 1. [Contractive (▷)], later is contractive as expressed by [BiLaterContractive]. 2. [(▷ P ⊢ P) → (True ⊢ P)], the external/"weak" of Löb as expressed by [BiLöb]. 3. [(▷ P → P) ⊢ P], the internal version/"strong" of Löb. 4. [□ (□ ▷ P -∗ P) ⊢ P], an internal version of Löb with magic wand instead of implication. 5. [□ (▷ P -∗ P) ⊢ P], a weaker version of the former statement, which does not make the induction hypothesis intuitionistic. We prove that: - (1) implies (2) in all BI logics (lemma [later_contractive_bi_löb]). - (2) and (3) are logically equivalent in all BI logics (lemma [löb_alt_strong]). - (2) implies (4) and (5) in all BI logics (lemmas [löb_wand_intuitionistically] and [löb_wand]). - (5) and (2) are logically equivalent in affine BI logics (lemma [löb_alt_wand]). In particular, this gives that (2), (3), (4) and (5) are logically equivalent in affine BI logics such as Iris. *) Lemma löb `{!BiLöb PROP} P : (▷ P → P) ⊢ P. Proof. apply entails_impl_True, löb_weak. apply impl_intro_r. rewrite -{2}(idemp (∧) (▷ P → P))%I. rewrite {2}(later_intro (▷ P → P)). rewrite later_impl. rewrite assoc impl_elim_l. rewrite impl_elim_r. done. Qed. Lemma löb_alt_strong : BiLöb PROP ↔ ∀ P, (▷ P → P) ⊢ P. Proof. split; intros HLöb P; [by apply löb|]. by intros ->%entails_impl_True. Qed. (** 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. *) Global Instance later_contractive_bi_löb : BiLaterContractive PROP → BiLöb PROP. Proof. intros=> P. 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)). 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_wand_intuitionistically `{!BiLöb PROP} P : □ (□ ▷ P -∗ P) ⊢ P. Proof. rewrite -{3}(intuitionistically_elim P) -(löb (□ P)). apply impl_intro_l. rewrite {1}intuitionistically_into_persistently_1 later_persistently. rewrite persistently_and_intuitionistically_sep_l. rewrite -{1}(intuitionistically_idemp (▷ P)) intuitionistically_sep_2. by rewrite wand_elim_r. Qed. Lemma löb_wand `{!BiLöb PROP} P : □ (▷ P -∗ P) ⊢ P. Proof. by rewrite -(intuitionistically_elim (▷ P)) löb_wand_intuitionistically. Qed. (** The proof of the right-to-left direction relies on the BI being affine. It is unclear how to generalize the lemma or proof to support non-affine BIs. *) Lemma löb_alt_wand `{!BiAffine PROP} : BiLöb PROP ↔ ∀ P, □ (▷ P -∗ P) ⊢ P. Proof. split; intros Hlöb; [by apply löb_wand|]. apply löb_alt_strong=> P. rewrite bi.impl_alt. apply bi.exist_elim=> R. apply impl_elim_r'. rewrite -(Hlöb (R → P)%I) -intuitionistically_into_persistently. apply intuitionistically_intro', wand_intro_l, impl_intro_l. rewrite -persistently_and_intuitionistically_sep_r assoc persistently_and_intuitionistically_sep_r intuitionistically_elim. rewrite -{1}(idemp bi_and R) -(assoc _ R) {2}(later_intro R). by rewrite -later_and impl_elim_r (comm _ R) wand_elim_r. Qed. (** A funny consequence of Löb induction. This shows that Löb induction is incompatible with classical logic. See [lib/counterexamples.v] for a fully worked-out proof of that fact. *) Lemma not_not_later_False `{!BiLöb PROP} : ⊢@{PROP} ¬ ¬ ▷ False. Proof. apply entails_impl, löb. Qed. (* Iterated later modality *) Global Instance laterN_ne m : NonExpansive (@bi_laterN PROP m). Proof. induction m; simpl; [by intros ???|]. solve_proper. Qed. Global Instance laterN_proper m : Proper ((⊣⊢) ==> (⊣⊢)) (@bi_laterN PROP m) := ne_proper _. Lemma laterN_0 P : ▷^0 P ⊣⊢ P. Proof. done. Qed. Lemma later_laterN n P : ▷^(S n) P ⊣⊢ ▷ ▷^n P. Proof. done. Qed. Lemma laterN_later n P : ▷^(S n) P ⊣⊢ ▷^n ▷ P. Proof. induction n; f_equiv/=; auto. Qed. Lemma laterN_add 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 bi_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 ((⊢) ==> (⊢)) (@bi_laterN PROP n). Proof. intros P Q; apply laterN_mono. Qed. Global Instance laterN_flip_mono' n : Proper (flip (⊢) ==> flip (⊢)) (@bi_laterN PROP n). Proof. intros P Q; apply laterN_mono. Qed. Lemma laterN_intro n P : P ⊢ ▷^n P. Proof. induction n as [|n IH]; simpl; by rewrite -?later_intro. Qed. Lemma laterN_True n : ▷^n True ⊣⊢ True. Proof. apply (anti_symm (⊢)); auto using laterN_intro, True_intro. Qed. Lemma laterN_emp `{!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 {A} `{!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 P ⊣⊢ ▷^n P. Proof. induction n as [|n IH]; simpl; auto. by rewrite IH later_persistently. Qed. Lemma laterN_affinely_2 n P : ▷^n P ⊢ ▷^n 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 P ⊣⊢ ▷^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 (@bi_except_0 PROP). Proof. solve_proper. Qed. Global Instance except_0_proper : Proper ((⊣⊢) ==> (⊣⊢)) (@bi_except_0 PROP). Proof. solve_proper. Qed. Global Instance except_0_mono' : Proper ((⊢) ==> (⊢)) (@bi_except_0 PROP). Proof. solve_proper. Qed. Global Instance except_0_flip_mono' : Proper (flip (⊢) ==> flip (⊢)) (@bi_except_0 PROP). Proof. solve_proper. Qed. Lemma except_0_intro P : P ⊢ ◇ P. Proof. rewrite /bi_except_0; auto. Qed. Lemma except_0_mono P Q : (P ⊢ Q) → ◇ P ⊢ ◇ Q. Proof. by intros ->. Qed. Lemma except_0_idemp P : ◇ ◇ P ⊣⊢ ◇ P. Proof. apply (anti_symm _); rewrite /bi_except_0; auto. Qed. Lemma except_0_True : ◇ True ⊣⊢ True. Proof. rewrite /bi_except_0. apply (anti_symm _); auto. Qed. Lemma except_0_emp `{!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 /bi_except_0. apply (anti_symm _); auto. Qed. Lemma except_0_and P Q : ◇ (P ∧ Q) ⊣⊢ ◇ P ∧ ◇ Q. Proof. by rewrite /bi_except_0 or_and_l. Qed. Lemma except_0_sep P Q : ◇ (P ∗ Q) ⊣⊢ ◇ P ∗ ◇ Q. Proof. rewrite /bi_except_0. apply (anti_symm _). - apply or_elim; last by auto using sep_mono. by rewrite -!or_intro_l -persistently_pure -later_sep -persistently_sep_dup. - rewrite sep_or_r !sep_or_l {1}(later_intro P) {1}(later_intro Q). rewrite -!later_sep !left_absorb right_absorb. auto. Qed. Lemma except_0_forall {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 /bi_except_0 -later_or False_or. Qed. Lemma except_0_laterN n P : ◇ ▷^n P ⊢ ▷^n ◇ P. Proof. by destruct n as [|n]; rewrite //= ?except_0_later -except_0_intro. Qed. Lemma except_0_into_later P : ◇ P ⊢ ▷ P. Proof. by rewrite -except_0_later -later_intro. Qed. Lemma except_0_persistently P : ◇ P ⊣⊢ ◇ P. Proof. by rewrite /bi_except_0 persistently_or -later_persistently persistently_pure. Qed. Lemma except_0_affinely_2 P : ◇ P ⊢ ◇ 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 : ◇ P ⊣⊢ ◇ 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 : ▷ P ⊢ ◇ ▷ P. Proof. rewrite /bi_affinely later_and (timeless emp) except_0_and. by apply and_mono, except_0_intro. Qed. Global Instance except_0_persistent P : Persistent P → Persistent (◇ P). Proof. rewrite /bi_except_0; apply _. Qed. Global Instance except_0_absorbing P : Absorbing P → Absorbing (◇ P). Proof. rewrite /bi_except_0; apply _. Qed. (* Timeless instances *) Global Instance Timeless_proper : Proper ((≡) ==> iff) (@Timeless PROP). Proof. solve_proper. Qed. (* The left-to-right direction of this lemma shows that to prove a timeless proposition [Q], we can additionally assume that we are at step-index 0, i.e. we can add [▷ False] to our assumptions. The right-to-left direction shows that this is in fact an exact characterization of timeless propositions. See also the comment above the definition of [Timeless]. *) Lemma timeless_alt `{!BiLöb PROP} Q : Timeless Q ↔ (∀ P, (▷ False ∧ P ⊢ Q) → (P ⊢ Q)). Proof. split; rewrite /Timeless => H. * intros P Hpr. rewrite -(löb Q). apply impl_intro_l. rewrite H /bi_except_0 and_or_r. apply or_elim; auto. * rewrite later_false_em. apply or_mono; first done. apply H, impl_elim_r. Qed. Global Instance pure_timeless φ : Timeless (PROP:=PROP) ⌜φ⌝. Proof. rewrite /Timeless /bi_except_0 pure_alt later_exist_false. apply or_elim, exist_elim; [auto|]=> Hφ. rewrite -(exist_intro Hφ). auto. Qed. Global Instance 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 `{!BiLöb PROP} P Q : Timeless Q → Timeless (P → Q). Proof. rewrite !timeless_alt=> HQ R HR. apply impl_intro_l, HQ. rewrite assoc -(comm _ P) -assoc. by apply 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 `{!BiLöb PROP} P Q : Timeless Q → Timeless (P -∗ Q). Proof. rewrite !timeless_alt=> HQ R HR. apply wand_intro_l, HQ. rewrite persistent_and_affinely_sep_l assoc -(comm _ P) -assoc. rewrite -persistent_and_affinely_sep_l. by apply wand_elim_r'. 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 /bi_except_0; auto. - apply exist_elim=> x. rewrite -(exist_intro x); auto. Qed. Global Instance persistently_timeless P : Timeless P → Timeless ( P). Proof. intros. rewrite /Timeless /bi_except_0 later_persistently_1. by rewrite (timeless P) /bi_except_0 persistently_or {1}persistently_elim. Qed. Global Instance affinely_timeless P : Timeless (PROP:=PROP) emp → Timeless P → Timeless ( P). Proof. rewrite /bi_affinely; apply _. Qed. Global Instance absorbingly_timeless P : Timeless P → Timeless ( P). Proof. rewrite /bi_absorbingly; apply _. Qed. Global Instance intuitionistically_timeless P : Timeless (PROP:=PROP) emp → Timeless P → Timeless (□ P). Proof. rewrite /bi_intuitionistically; apply _. Qed. Global Instance from_option_timeless {A} P (Ψ : A → PROP) (mx : option A) : (∀ x, Timeless (Ψ x)) → Timeless P → Timeless (from_option Ψ P mx). Proof. destruct mx; apply _. Qed. (* Big op stuff *) Global Instance bi_later_monoid_and_homomorphism : MonoidHomomorphism bi_and bi_and (≡) (@bi_later PROP). Proof. split; [split|]; try apply _. - apply later_and. - apply later_True. Qed. Global Instance bi_laterN_and_homomorphism n : MonoidHomomorphism bi_and bi_and (≡) (@bi_laterN PROP n). Proof. split; [split|]; try apply _. - apply laterN_and. - apply laterN_True. Qed. Global Instance bi_except_0_and_homomorphism : MonoidHomomorphism bi_and bi_and (≡) (@bi_except_0 PROP). Proof. split; [split|]; try apply _. - apply except_0_and. - apply except_0_True. Qed. Global Instance bi_later_monoid_or_homomorphism : WeakMonoidHomomorphism bi_or bi_or (≡) (@bi_later PROP). Proof. split; try apply _. apply later_or. Qed. Global Instance bi_laterN_or_homomorphism n : WeakMonoidHomomorphism bi_or bi_or (≡) (@bi_laterN PROP n). Proof. split; try apply _. apply laterN_or. Qed. Global Instance bi_except_0_or_homomorphism : WeakMonoidHomomorphism bi_or bi_or (≡) (@bi_except_0 PROP). Proof. split; try apply _. apply except_0_or. Qed. Global Instance bi_later_monoid_sep_weak_homomorphism : WeakMonoidHomomorphism bi_sep bi_sep (≡) (@bi_later PROP). Proof. split; try apply _. apply later_sep. Qed. Global Instance bi_laterN_sep_weak_homomorphism n : WeakMonoidHomomorphism bi_sep bi_sep (≡) (@bi_laterN PROP n). Proof. split; try apply _. apply laterN_sep. Qed. Global Instance bi_except_0_sep_weak_homomorphism : WeakMonoidHomomorphism bi_sep bi_sep (≡) (@bi_except_0 PROP). Proof. split; try apply _. apply except_0_sep. Qed. Global Instance bi_later_monoid_sep_homomorphism `{!BiAffine PROP} : MonoidHomomorphism bi_sep bi_sep (≡) (@bi_later PROP). Proof. split; try apply _. apply later_emp. Qed. Global Instance bi_laterN_sep_homomorphism `{!BiAffine PROP} n : MonoidHomomorphism bi_sep bi_sep (≡) (@bi_laterN PROP n). Proof. split; try apply _. apply laterN_emp. Qed. Global Instance bi_except_0_sep_homomorphism `{!BiAffine PROP} : MonoidHomomorphism bi_sep bi_sep (≡) (@bi_except_0 PROP). Proof. split; try apply _. apply except_0_emp. Qed. Global Instance bi_later_monoid_sep_entails_weak_homomorphism : WeakMonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@bi_later PROP). Proof. split; try apply _. intros P Q. by rewrite later_sep. Qed. Global Instance bi_laterN_sep_entails_weak_homomorphism n : WeakMonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@bi_laterN PROP n). Proof. split; try apply _. intros P Q. by rewrite laterN_sep. Qed. Global Instance bi_except_0_sep_entails_weak_homomorphism : WeakMonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@bi_except_0 PROP). Proof. split; try apply _. intros P Q. by rewrite except_0_sep. Qed. Global Instance bi_later_monoid_sep_entails_homomorphism : MonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@bi_later PROP). Proof. split; try apply _. apply later_intro. Qed. Global Instance bi_laterN_sep_entails_homomorphism n : MonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@bi_laterN PROP n). Proof. split; try apply _. apply laterN_intro. Qed. Global Instance bi_except_0_sep_entails_homomorphism : MonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@bi_except_0 PROP). Proof. split; try apply _. apply except_0_intro. Qed. End later_derived. End bi. iris-iris-4.2.0/iris/bi/embedding.v000066400000000000000000000432171460620107300171020ustar00rootroot00000000000000From iris.algebra Require Import monoid. From iris.bi Require Import interface derived_laws_later big_op. From iris.bi Require Import plainly updates internal_eq. From iris.prelude Require Import options. (* We enable primitive projections in this file to improve the performance of the Iris proofmode: primitive projections for the bi-records makes the proofmode faster. *) Local Set Primitive Projections. (* The sections add extra BI assumptions, which is only picked up with [Type*]. *) Set Default Proof Using "Type*". Class Embed (A B : Type) := embed : A → B. Global Arguments embed {_ _ _} _%I : simpl never. Notation "⎡ P ⎤" := (embed P) : bi_scope. Global Instance: Params (@embed) 3 := {}. Global Typeclasses Opaque embed. Global Hint Mode Embed ! - : typeclass_instances. Global 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 (A:=PROP1) (B:=PROP2)); bi_embed_mixin_mono : Proper ((⊢) ==> (⊢)) (embed (A:=PROP1) (B:=PROP2)); bi_embed_mixin_emp_valid_inj (P : PROP1) : (⊢@{PROP2} ⎡P⎤) → ⊢ P; (** The following axiom expresses that the embedding is injective in the OFE sense. Instead of this axiom being expressed in terms of [siProp] or externally (i.e., as [Inj (dist n) (dist n) embed]), it is expressed using the internal equality of _any other_ BI [PROP']. This is more general, as we do not have any machinary to embed [siProp] into a BI with internal equality. *) bi_embed_mixin_interal_inj {PROP' : bi} `{!BiInternalEq PROP'} (P Q : PROP1) : ⎡P⎤ ≡ ⎡Q⎤ ⊢@{PROP'} (P ≡ Q); bi_embed_mixin_emp_2 : emp ⊢@{PROP2} ⎡emp⎤; bi_embed_mixin_impl_2 (P Q : PROP1) : (⎡P⎤ → ⎡Q⎤) ⊢@{PROP2} ⎡P → Q⎤; bi_embed_mixin_forall_2 A (Φ : A → PROP1) : (∀ x, ⎡Φ x⎤) ⊢@{PROP2} ⎡∀ x, Φ x⎤; bi_embed_mixin_exist_1 A (Φ : A → PROP1) : ⎡∃ x, Φ x⎤ ⊢@{PROP2} ∃ x, ⎡Φ x⎤; bi_embed_mixin_sep (P Q : PROP1) : ⎡P ∗ Q⎤ ⊣⊢@{PROP2} ⎡P⎤ ∗ ⎡Q⎤; bi_embed_mixin_wand_2 (P Q : PROP1) : (⎡P⎤ -∗ ⎡Q⎤) ⊢@{PROP2} ⎡P -∗ Q⎤; bi_embed_mixin_persistently (P : PROP1) : ⎡ P⎤ ⊣⊢@{PROP2} ⎡P⎤ }. Class BiEmbed (PROP1 PROP2 : bi) := { #[global] bi_embed_embed :: Embed PROP1 PROP2; bi_embed_mixin : BiEmbedMixin PROP1 PROP2 bi_embed_embed; }. Global Hint Mode BiEmbed ! - : typeclass_instances. Global Hint Mode BiEmbed - ! : typeclass_instances. Global Arguments bi_embed_embed : simpl never. Class BiEmbedEmp (PROP1 PROP2 : bi) `{!BiEmbed PROP1 PROP2} := embed_emp_1 : ⎡ emp : PROP1 ⎤ ⊢ emp. Global Hint Mode BiEmbedEmp ! - - : typeclass_instances. Global Hint Mode BiEmbedEmp - ! - : typeclass_instances. Class BiEmbedLater (PROP1 PROP2 : bi) `{!BiEmbed PROP1 PROP2} := embed_later P : ⎡▷ P⎤ ⊣⊢@{PROP2} ▷ ⎡P⎤. Global Hint Mode BiEmbedLater ! - - : typeclass_instances. Global Hint Mode BiEmbedLater - ! - : typeclass_instances. Class BiEmbedInternalEq (PROP1 PROP2 : bi) `{!BiEmbed PROP1 PROP2, !BiInternalEq PROP1, !BiInternalEq PROP2} := embed_internal_eq_1 (A : ofe) (x y : A) : ⎡x ≡ y⎤ ⊢@{PROP2} x ≡ y. Global Hint Mode BiEmbedInternalEq ! - - - - : typeclass_instances. Global Hint Mode BiEmbedInternalEq - ! - - - : typeclass_instances. Class BiEmbedBUpd (PROP1 PROP2 : bi) `{!BiEmbed PROP1 PROP2, !BiBUpd PROP1, !BiBUpd PROP2} := embed_bupd P : ⎡|==> P⎤ ⊣⊢@{PROP2} |==> ⎡P⎤. Global Hint Mode BiEmbedBUpd - ! - - - : typeclass_instances. Global Hint Mode BiEmbedBUpd ! - - - - : typeclass_instances. Class BiEmbedFUpd (PROP1 PROP2 : bi) `{!BiEmbed PROP1 PROP2, !BiFUpd PROP1, !BiFUpd PROP2} := embed_fupd E1 E2 P : ⎡|={E1,E2}=> P⎤ ⊣⊢@{PROP2} |={E1,E2}=> ⎡P⎤. Global Hint Mode BiEmbedFUpd - ! - - - : typeclass_instances. Global Hint Mode BiEmbedFUpd ! - - - - : typeclass_instances. Class BiEmbedPlainly (PROP1 PROP2 : bi) `{!BiEmbed PROP1 PROP2, !BiPlainly PROP1, !BiPlainly PROP2} := embed_plainly (P : PROP1) : ⎡■ P⎤ ⊣⊢@{PROP2} ■ ⎡P⎤. Global Hint Mode BiEmbedPlainly - ! - - - : typeclass_instances. Global Hint Mode BiEmbedPlainly ! - - - - : typeclass_instances. Section embed_laws. Context {PROP1 PROP2 : bi} `{!BiEmbed PROP1 PROP2}. Local Notation embed := (embed (A:=bi_car PROP1) (B:=bi_car 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 : (⊢@{PROP2} ⎡P⎤) → ⊢ P. Proof. eapply bi_embed_mixin_emp_valid_inj, bi_embed_mixin. Qed. Lemma embed_interal_inj `{!BiInternalEq PROP'} (P Q : PROP1) : ⎡P⎤ ≡ ⎡Q⎤ ⊢@{PROP'} (P ≡ Q). Proof. eapply bi_embed_mixin_interal_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 : ⎡ P⎤ ⊣⊢ ⎡P⎤. Proof. eapply bi_embed_mixin_persistently, bi_embed_mixin. Qed. End embed_laws. Section embed. Context {PROP1 PROP2 : bi} `{!BiEmbed PROP1 PROP2}. Local Notation embed := (embed (A:=bi_car PROP1) (B:=bi_car 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_entails, conj; apply (inj embed); rewrite EQ //. Qed. Lemma embed_emp_valid (P : PROP1) : (⊢ ⎡P⎤) ↔ (⊢ 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_entails; 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_entails; 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_entails; 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_entails; 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_entails. 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 : ⎡P⎤ ⊢ ⎡ P⎤. Proof. by rewrite embed_and -embed_emp_2. Qed. Lemma embed_affinely `{!BiEmbedEmp PROP1 PROP2} P : ⎡ P⎤ ⊣⊢ ⎡P⎤. Proof. by rewrite /bi_intuitionistically embed_and embed_emp. Qed. Lemma embed_absorbingly P : ⎡ P⎤ ⊣⊢ ⎡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 : ⎡?b P⎤ ⊣⊢ ?b ⎡P⎤. Proof. destruct b; simpl; auto using embed_persistently. Qed. Lemma embed_affinely_if_2 P b : ?b ⎡P⎤ ⊢ ⎡?b P⎤. Proof. destruct b; simpl; auto using embed_affinely_2. Qed. Lemma embed_affinely_if `{!BiEmbedEmp PROP1 PROP2} P b : ⎡?b P⎤ ⊣⊢ ?b ⎡P⎤. Proof. destruct b; simpl; auto using embed_affinely. Qed. Lemma embed_absorbingly_if b P : ⎡?b P⎤ ⊣⊢ ?b ⎡P⎤. Proof. destruct b; simpl; auto using embed_absorbingly. 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. 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. Section later. Context `{!BiEmbedLater PROP1 PROP2}. 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. Global Instance embed_timeless P : Timeless P → Timeless ⎡P⎤. Proof. intros ?. by rewrite /Timeless -embed_except_0 -embed_later timeless. Qed. End later. Section internal_eq. Context `{!BiInternalEq PROP1, !BiInternalEq PROP2, !BiEmbedInternalEq PROP1 PROP2}. Lemma embed_internal_eq (A : ofe) (x y : A) : ⎡x ≡ y⎤ ⊣⊢@{PROP2} x ≡ y. Proof. apply bi.equiv_entails; split; [apply embed_internal_eq_1|]. etrans; [apply (internal_eq_rewrite x y (λ y, ⎡x ≡ y⎤%I)); solve_proper|]. rewrite -(internal_eq_refl True%I) embed_pure. eapply bi.impl_elim; [done|]. apply bi.True_intro. Qed. End internal_eq. Section plainly. Context `{!BiPlainly PROP1, !BiPlainly PROP2, !BiEmbedPlainly PROP1 PROP2}. Lemma embed_plainly_if p P : ⎡■?p P⎤ ⊣⊢ ■?p ⎡P⎤. Proof. destruct p; simpl; auto using embed_plainly. Qed. Lemma embed_plain (P : PROP1) : Plain P → Plain (PROP:=PROP2) ⎡P⎤. Proof. intros ?. by rewrite /Plain {1}(plain P) embed_plainly. Qed. End plainly. End 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].*) Global Hint Extern 4 (Plain _) => notypeclasses refine (embed_plain _ _) : typeclass_instances. (** Transitive embedding: this constructs an embedding of [PROP1] into [PROP3] by combining the embeddings of [PROP1] into [PROP2] and [PROP2] into [PROP3]. Note that declaring these instances globally can make TC search ambiguous or diverging. These are only defined so that a user can conveniently use them to manually combine embeddings. *) Section embed_embed. Context {PROP1 PROP2 PROP3 : bi} `{!BiEmbed PROP1 PROP2, !BiEmbed PROP2 PROP3}. Local Instance embed_embed : Embed PROP1 PROP3 := λ P, ⎡ ⎡ P ⎤ ⎤%I. Lemma embed_embedding_mixin : BiEmbedMixin PROP1 PROP3 embed_embed. Proof. split; unfold embed, embed_embed. - solve_proper. - solve_proper. - intros P. by rewrite !embed_emp_valid. - intros PROP' ? P Q. by rewrite !embed_interal_inj. - by rewrite -!embed_emp_2. - intros P Q. by rewrite -!embed_impl. - intros A Φ. by rewrite -!embed_forall. - intros A Φ. by rewrite -!embed_exist. - intros P Q. by rewrite -!embed_sep. - intros P Q. by rewrite -!embed_wand. - intros P. by rewrite -!embed_persistently. Qed. Local Instance embed_bi_embed : BiEmbed PROP1 PROP3 := {| bi_embed_mixin := embed_embedding_mixin |}. Lemma embed_embed_alt (P : PROP1) : ⎡ P ⎤ ⊣⊢@{PROP3} ⎡ ⎡ P ⎤ ⎤. Proof. done. Qed. Lemma embed_embed_emp : BiEmbedEmp PROP1 PROP2 → BiEmbedEmp PROP2 PROP3 → BiEmbedEmp PROP1 PROP3. Proof. rewrite /BiEmbedEmp !embed_embed_alt. by intros -> ->. Qed. Lemma embed_embed_later : BiEmbedLater PROP1 PROP2 → BiEmbedLater PROP2 PROP3 → BiEmbedLater PROP1 PROP3. Proof. intros ?? P. by rewrite !embed_embed_alt !embed_later. Qed. Lemma embed_embed_internal_eq `{!BiInternalEq PROP1, !BiInternalEq PROP2, !BiInternalEq PROP3} : BiEmbedInternalEq PROP1 PROP2 → BiEmbedInternalEq PROP2 PROP3 → BiEmbedInternalEq PROP1 PROP3. Proof. intros ?? A x y. by rewrite !embed_embed_alt !embed_internal_eq. Qed. Lemma embed_embed_bupd `{!BiBUpd PROP1, !BiBUpd PROP2, !BiBUpd PROP3} : BiEmbedBUpd PROP1 PROP2 → BiEmbedBUpd PROP2 PROP3 → BiEmbedBUpd PROP1 PROP3. Proof. intros ?? P. by rewrite !embed_embed_alt !embed_bupd. Qed. Lemma embed_embed_fupd `{!BiFUpd PROP1, !BiFUpd PROP2, !BiFUpd PROP3} : BiEmbedFUpd PROP1 PROP2 → BiEmbedFUpd PROP2 PROP3 → BiEmbedFUpd PROP1 PROP3. Proof. intros ?? E1 E2 P. by rewrite !embed_embed_alt !embed_fupd. Qed. Lemma embed_embed_plainly `{!BiPlainly PROP1, !BiPlainly PROP2, !BiPlainly PROP3} : BiEmbedPlainly PROP1 PROP2 → BiEmbedPlainly PROP2 PROP3 → BiEmbedPlainly PROP1 PROP3. Proof. intros ?? P. by rewrite !embed_embed_alt !embed_plainly. Qed. End embed_embed. iris-iris-4.2.0/iris/bi/extensions.v000066400000000000000000000044101460620107300173530ustar00rootroot00000000000000(** This file defines various extensions to the base BI interface, via typeclasses that BIs can optionally implement. *) From iris.bi Require Export derived_connectives. From iris.prelude Require Import options. Class BiAffine (PROP : bi) := absorbing_bi (Q : PROP) : Affine Q. Global Hint Mode BiAffine ! : typeclass_instances. Global Existing Instance absorbing_bi | 0. Class BiPositive (PROP : bi) := bi_positive (P Q : PROP) : (P ∗ Q) ⊢ P ∗ Q. Global Hint Mode BiPositive ! : typeclass_instances. (** The class [BiLöb] is required for the [iLöb] tactic. However, for most BI logics [BiLaterContractive] should be used, which gives an instance of [BiLöb] automatically (see [derived_laws_later]). A direct instance of [BiLöb] is useful when considering a BI logic with a discrete OFE, instead of an OFE that takes step-indexing of the logic in account. The internal/"strong" version of Löb [(▷ P → P) ⊢ P] is derivable from [BiLöb]. It is provided by the lemma [löb] in [derived_laws_later]. *) Class BiLöb (PROP : bi) := löb_weak (P : PROP) : (▷ P ⊢ P) → (True ⊢ P). Global Hint Mode BiLöb ! : typeclass_instances. Global Arguments löb_weak {_ _} _ _. Class BiLaterContractive (PROP : bi) := #[global] later_contractive :: Contractive (bi_later (PROP:=PROP)). (** The class [BiPersistentlyForall] states that universal quantification commutes with the persistently modality. The reverse direction of the entailment described by this type class is derivable, so it is not included. *) Class BiPersistentlyForall (PROP : bi) := persistently_forall_2 : ∀ {A} (Ψ : A → PROP), (∀ a, (Ψ a)) ⊢ (∀ a, Ψ a). Global Hint Mode BiPersistentlyForall ! : typeclass_instances. (** The class [BiPureForall] states that universal quantification commutes with the embedding of pure propositions. The reverse direction of the entailment described by this type class is derivable, so it is not included. An instance of [BiPureForall] itself is derivable if we assume excluded middle in Coq, see the lemma [bi_pure_forall_em] in [derived_laws]. *) Class BiPureForall (PROP : bi) := pure_forall_2 : ∀ {A} (φ : A → Prop), (∀ a, ⌜ φ a ⌝) ⊢@{PROP} ⌜ ∀ a, φ a ⌝. Global Hint Mode BiPureForall ! : typeclass_instances. iris-iris-4.2.0/iris/bi/interface.v000066400000000000000000000565301460620107300171260ustar00rootroot00000000000000From iris.algebra Require Export ofe. From iris.bi Require Export notation. From iris.prelude Require Import options. (* We enable primitive projections in this file to improve the performance of the Iris proofmode: primitive projections for the bi-records makes the proofmode faster. *) Local 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). Bind Scope bi_scope with PROP. Local Infix "⊢" := bi_entails. Local Notation "'emp'" := bi_emp : bi_scope. Local Notation "'True'" := (bi_pure True) : bi_scope. Local Notation "'False'" := (bi_pure False) : bi_scope. Local Notation "'⌜' φ '⌝'" := (bi_pure φ%type%stdpp) : bi_scope. Local Infix "∧" := bi_and : bi_scope. Local Infix "∨" := bi_or : bi_scope. Local Infix "→" := bi_impl : bi_scope. Local Notation "∀ x .. y , P" := (bi_forall _ (λ x, .. (bi_forall _ (λ y, P%I)) ..)) : bi_scope. Local Notation "∃ x .. y , P" := (bi_exist _ (λ x, .. (bi_exist _ (λ y, P%I)) ..)) : bi_scope. Local Infix "∗" := bi_sep : bi_scope. Local Infix "-∗" := bi_wand : bi_scope. (** * 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_entails P Q : (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; (** Higher-order logic *) bi_mixin_pure_intro (φ : Prop) P : φ → P ⊢ ⌜ φ ⌝; bi_mixin_pure_elim' (φ : Prop) P : (φ → True ⊢ P) → ⌜ φ ⌝ ⊢ P; 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; }. (** We require any BI to have a persistence modality that carves out the intuitionistic fragment of the separation logic. For logics such as Iris, the persistence modality has a non-trivial definition (involving the [core] of the camera). It is not clear whether a trivial definition exists: while [ P := False] comes close, it does not satisfy [later_persistently_1]. However, for some simpler discrete BIs the persistence modality can be defined as: P := ⌜ emp ⊢ P ⌝ That is, [P] holds persistently if it holds without resources. The nesting of the entailment below the pure embedding ⌜ ⌝ only works for discrete BIs: Non-expansiveness of [] relies on [dist] ignoring the step-index. To prove the rule [ (∃ a, Ψ a) ⊢ ∃ a, Ψ a] the BI furthermore needs to satisfy the "existential property": [emp ⊢ ∃ x, Φ x] implies [∃ x, emp ⊢ Φ x]. This construction is formalized by the smart constructor [bi_persistently_mixin_discrete] for [BiPersistentlyMixin]. See [tests/heapprop] and [tests/heapprop_affine] for examples of how to use this smart constructor. *) Context (bi_persistently : PROP → PROP). Local Notation "'' P" := (bi_persistently P) : bi_scope. Record BiPersistentlyMixin := { bi_mixin_persistently_ne : NonExpansive bi_persistently; (* In the ordered RA model: Holds without further assumptions. *) bi_mixin_persistently_mono P Q : (P ⊢ Q) → P ⊢ Q; (* In the ordered RA model: `core` is idempotent *) bi_mixin_persistently_idemp_2 P : P ⊢ P; (* In the ordered RA model: [ε ≼ core x]. *) bi_mixin_persistently_emp_2 : emp ⊢ emp; (* The laws of a "frame" (https://ncatlab.org/nlab/show/frame, not to be confused with separation logic terminology): commuting with finite conjunction and infinite disjunction. The null-ary case, [persistently_True : True ⊢ True], is derivable from the other laws. *) bi_mixin_persistently_and_2 (P Q : PROP) : ( P) ∧ ( Q) ⊢ (P ∧ Q); bi_mixin_persistently_exist_1 {A} (Ψ : A → PROP) : (∃ a, Ψ a) ⊢ ∃ a, (Ψ a); (* In the ordered RA model: [core x ≼ core (x ⋅ y)]. *) bi_mixin_persistently_absorbing P Q : P ∗ Q ⊢ P; (* In the ordered RA model: [x ⋅ core x = x]. *) bi_mixin_persistently_and_sep_elim P Q : P ∧ Q ⊢ P ∗ Q; }. Lemma bi_persistently_mixin_discrete : (∀ n (P Q : PROP), P ≡{n}≡ Q → P ≡ Q) → (∀ {A} (Φ : A → PROP), (emp ⊢ ∃ x, Φ x) → ∃ x, emp ⊢ Φ x) → (∀ P : PROP, ( P)%I = ⌜ emp ⊢ P ⌝%I) → BiMixin → BiPersistentlyMixin. Proof. intros Hdiscrete Hex Hpers Hbi. pose proof (bi_mixin_entails_po Hbi). split. - (* [NonExpansive bi_persistently] *) intros n P Q [HPQ HQP]%Hdiscrete%(bi_mixin_equiv_entails Hbi). rewrite !Hpers. apply (bi_mixin_pure_ne Hbi). split=> ?; by etrans. - (*[(P ⊢ Q) → P ⊢ Q] *) intros P Q HPQ. rewrite !Hpers. apply (bi_mixin_pure_elim' Hbi)=> ?. apply (bi_mixin_pure_intro Hbi). by trans P. - (* [ P ⊢ P] *) intros P. rewrite !Hpers. apply (bi_mixin_pure_elim' Hbi)=> ?. by do 2 apply (bi_mixin_pure_intro Hbi). - (* [emp ⊢ emp] *) rewrite Hpers. by apply (bi_mixin_pure_intro Hbi). - (* [ P ∧ Q ⊢ (P ∧ Q)] *) intros P Q. rewrite !Hpers. apply (bi_mixin_impl_elim_l' Hbi). apply (bi_mixin_pure_elim' Hbi)=> ?. apply (bi_mixin_impl_intro_r Hbi). etrans; [apply (bi_mixin_and_elim_r Hbi)|]. apply (bi_mixin_pure_elim' Hbi)=> ?. apply (bi_mixin_pure_intro Hbi). by apply (bi_mixin_and_intro Hbi). - (* [ (∃ a, Ψ a) ⊢ ∃ a, Ψ a] *) intros A Φ. rewrite !Hpers. apply (bi_mixin_pure_elim' Hbi)=> /Hex [x ?]. etrans; [|apply (bi_mixin_exist_intro Hbi x)]; simpl. rewrite Hpers. by apply (bi_mixin_pure_intro Hbi). - (* [ P ∗ Q ⊢ P] *) intros P Q. rewrite !Hpers. apply (bi_mixin_wand_elim_l' Hbi). apply (bi_mixin_pure_elim' Hbi)=> ?. apply (bi_mixin_wand_intro_r Hbi). by apply (bi_mixin_pure_intro Hbi). - (* [ P ∧ Q ⊢ P ∗ Q] *) intros P Q. rewrite !Hpers. apply (bi_mixin_impl_elim_l' Hbi). apply (bi_mixin_pure_elim' Hbi)=> ?. apply (bi_mixin_impl_intro_r Hbi). etrans; [apply (bi_mixin_and_elim_r Hbi)|]. etrans; [apply (bi_mixin_emp_sep_1 Hbi)|]. by apply (bi_mixin_sep_mono Hbi). Qed. (** We equip any BI with a later modality. This avoids an additional layer in the BI hierachy and improves performance significantly (see Iris issue #303). For non step-indexed BIs the later modality can simply be defined as the identity function, as the Löb axiom or contractiveness of later is not part of [BiLaterMixin]. For step-indexed BIs one should separately prove an instance of the class [BiLaterContractive PROP] or [BiLöb PROP]. (Note that there is an instance [BiLaterContractive PROP → BiLöb PROP] in [derived_laws_later].) For non step-indexed BIs one can get a "free" instance of [BiLaterMixin] using the smart constructor [bi_later_mixin_id] below. *) Context (bi_later : PROP → PROP). Local Notation "▷ P" := (bi_later P) : bi_scope. Record BiLaterMixin := { bi_mixin_later_ne : NonExpansive bi_later; bi_mixin_later_mono P Q : (P ⊢ Q) → ▷ P ⊢ ▷ Q; bi_mixin_later_intro P : P ⊢ ▷ P; bi_mixin_later_forall_2 {A} (Φ : A → PROP) : (∀ a, ▷ Φ a) ⊢ ▷ ∀ a, Φ a; bi_mixin_later_exist_false {A} (Φ : A → PROP) : (▷ ∃ a, Φ a) ⊢ ▷ False ∨ (∃ a, ▷ Φ a); bi_mixin_later_sep_1 P Q : ▷ (P ∗ Q) ⊢ ▷ P ∗ ▷ Q; bi_mixin_later_sep_2 P Q : ▷ P ∗ ▷ Q ⊢ ▷ (P ∗ Q); bi_mixin_later_persistently_1 P : ▷ P ⊢ ▷ P; bi_mixin_later_persistently_2 P : ▷ P ⊢ ▷ P; (* In a step-index model, this law allows case distinctions on whether the step-index is 0 (expressed as [▷ False] in the logic): * If it is 0, the left side is true, and we know nothing about [P]. * If not, then it is [S n] for some [n], and [P] holds at [n]. By down- closure, it also holds at [0]. Thus, we get to use [P], but only if the step-index is 0 ([▷ False] is true). *) bi_mixin_later_false_em P : ▷ P ⊢ ▷ False ∨ (▷ False → P); }. Lemma bi_later_mixin_id : (∀ (P : PROP), (▷ P)%I = P) → BiMixin → BiLaterMixin. Proof. intros Hlater Hbi. pose proof (bi_mixin_entails_po Hbi). split; repeat intro; rewrite ?Hlater //. - apply (bi_mixin_forall_intro Hbi)=> a. etrans; [apply (bi_mixin_forall_elim Hbi a)|]. by rewrite Hlater. - etrans; [|apply (bi_mixin_or_intro_r Hbi)]. apply (bi_mixin_exist_elim Hbi)=> a. etrans; [|apply (bi_mixin_exist_intro Hbi a)]. by rewrite /= Hlater. - etrans; [|apply (bi_mixin_or_intro_r Hbi)]. apply (bi_mixin_impl_intro_r Hbi), (bi_mixin_and_elim_l Hbi). Qed. End bi_mixin. Module Import universes. (** The universe of the logic (PROP). *) Universe Logic. (** The universe of quantifiers in the logic. *) Universe Quant. End universes. Structure bi := Bi { bi_car :> Type@{Logic}; 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 : Type@{Quant}, (A → bi_car) → bi_car; bi_exist : ∀ A : Type@{Quant}, (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_later : bi_car → bi_car; bi_ofe_mixin : OfeMixin bi_car; bi_cofe_aux : Cofe (Ofe bi_car bi_ofe_mixin); 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_bi_persistently_mixin : BiPersistentlyMixin bi_entails bi_emp bi_and bi_exist bi_sep bi_persistently; bi_bi_later_mixin : BiLaterMixin bi_entails bi_pure bi_or bi_impl bi_forall bi_exist bi_sep bi_persistently bi_later; }. Bind Scope bi_scope with bi_car. Coercion bi_ofeO (PROP : bi) : ofe := Ofe PROP (bi_ofe_mixin PROP). Canonical Structure bi_ofeO. (** The projection [bi_cofe_aux] is not registered as an instance because it has the wrong type. Its result type is unfolded, i.e., [Cofe (Ofe PROP ...)], and thus should never be used. The instance [bi_cofe] has the proper result type [Cofe (bi_ofeO PROP)]. *) Global Instance bi_cofe (PROP : bi) : Cofe PROP := bi_cofe_aux PROP. Global Instance: Params (@bi_entails) 1 := {}. Global Instance: Params (@bi_emp) 1 := {}. Global Instance: Params (@bi_pure) 1 := {}. Global Instance: Params (@bi_and) 1 := {}. Global Instance: Params (@bi_or) 1 := {}. Global Instance: Params (@bi_impl) 1 := {}. Global Instance: Params (@bi_forall) 2 := {}. Global Instance: Params (@bi_exist) 2 := {}. Global Instance: Params (@bi_sep) 1 := {}. Global Instance: Params (@bi_wand) 1 := {}. Global Instance: Params (@bi_persistently) 1 := {}. Global Instance: Params (@bi_later) 1 := {}. Global Arguments bi_car : simpl never. Global Arguments bi_dist : simpl never. Global Arguments bi_equiv : simpl never. Global Arguments bi_entails {PROP} _ _ : simpl never, rename. Global Arguments bi_emp {PROP} : simpl never, rename. Global Arguments bi_pure {PROP} _%stdpp : simpl never, rename. Global Arguments bi_and {PROP} _ _ : simpl never, rename. Global Arguments bi_or {PROP} _ _ : simpl never, rename. Global Arguments bi_impl {PROP} _ _ : simpl never, rename. Global Arguments bi_forall {PROP _} _%I : simpl never, rename. Global Arguments bi_exist {PROP _} _%I : simpl never, rename. Global Arguments bi_sep {PROP} _ _ : simpl never, rename. Global Arguments bi_wand {PROP} _ _ : simpl never, rename. Global Arguments bi_persistently {PROP} _ : simpl never, rename. Global Arguments bi_later {PROP} _ : simpl never, rename. Global Hint Extern 0 (bi_entails _ _) => reflexivity : core. (** We set this rewrite relation's cost above the stdlib's ([impl], [iff], [eq], ...) and [≡] but below [⊑]. [eq] (at 100) < [≡] (at 150) < [bi_entails _] (at 170) < [⊑] (at 200) *) Global Instance bi_rewrite_relation (PROP : bi) : RewriteRelation (@bi_entails PROP) | 170 := {}. Global Instance bi_inhabited {PROP : bi} : Inhabited PROP := populate (bi_pure True). 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. Notation "¬ P" := (P → False)%I : bi_scope. Infix "∗" := bi_sep : bi_scope. Notation "(∗)" := bi_sep (only parsing) : bi_scope. Notation "P -∗ Q" := (bi_wand P Q) : bi_scope. Notation "∀ x .. y , P" := (bi_forall (λ x, .. (bi_forall (λ y, P%I)) ..)) : bi_scope. Notation "∃ x .. y , P" := (bi_exist (λ x, .. (bi_exist (λ y, P%I)) ..)) : bi_scope. Notation "'' P" := (bi_persistently P) : bi_scope. Notation "▷ P" := (bi_later P) : bi_scope. 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 ⊣⊢.)" := (equiv (A:=bi_car _) P) (only parsing) : stdpp_scope. Notation "(.⊣⊢ Q )" := (λ P, P ≡@{bi_car _} Q) (only parsing) : stdpp_scope. Definition bi_emp_valid {PROP : bi} (P : PROP) : Prop := emp ⊢ P. Global Arguments bi_emp_valid {_} _%I : simpl never. Global Typeclasses Opaque bi_emp_valid. Notation "⊢ Q" := (bi_emp_valid Q%I) : stdpp_scope. Notation "'⊢@{' PROP } Q" := (bi_emp_valid (PROP:=PROP) Q%I) (only parsing) : stdpp_scope. (** Work around parsing issues: see [notation.v] for details. *) Notation "'(⊢@{' PROP } Q )" := (bi_emp_valid (PROP:=PROP) Q%I) (only parsing) : stdpp_scope. Notation "(.⊢ Q )" := (λ P, P ⊢ Q) (only parsing) : stdpp_scope. Notation "( P ⊢.)" := (bi_entails P) (only parsing) : stdpp_scope. Notation "P -∗ Q" := (⊢ P -∗ Q) : stdpp_scope. 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_entails P Q : P ≡ Q ↔ (P ⊢ Q) ∧ (Q ⊢ P). Proof. eapply bi_mixin_equiv_entails, 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_persistently_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 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) → P ⊢ Q. Proof. eapply bi_mixin_persistently_mono, bi_bi_persistently_mixin. Qed. Lemma persistently_idemp_2 P : P ⊢ P. Proof. eapply bi_mixin_persistently_idemp_2, bi_bi_persistently_mixin. Qed. Lemma persistently_emp_2 : emp ⊢@{PROP} emp. Proof. eapply bi_mixin_persistently_emp_2, bi_bi_persistently_mixin. Qed. Lemma persistently_and_2 (P Q : PROP) : (( P) ∧ ( Q)) ⊢ (P ∧ Q). Proof. eapply bi_mixin_persistently_and_2, bi_bi_persistently_mixin. Qed. Lemma persistently_exist_1 {A} (Ψ : A → PROP) : (∃ a, Ψ a) ⊢ ∃ a, (Ψ a). Proof. eapply bi_mixin_persistently_exist_1, bi_bi_persistently_mixin. Qed. Lemma persistently_absorbing P Q : P ∗ Q ⊢ P. Proof. eapply (bi_mixin_persistently_absorbing bi_entails), bi_bi_persistently_mixin. Qed. Lemma persistently_and_sep_elim P Q : P ∧ Q ⊢ P ∗ Q. Proof. eapply (bi_mixin_persistently_and_sep_elim bi_entails), bi_bi_persistently_mixin. Qed. (* Later *) Global Instance later_ne : NonExpansive (@bi_later PROP). Proof. eapply bi_mixin_later_ne, bi_bi_later_mixin. Qed. Lemma later_mono P Q : (P ⊢ Q) → ▷ P ⊢ ▷ Q. Proof. eapply bi_mixin_later_mono, bi_bi_later_mixin. Qed. Lemma later_intro P : P ⊢ ▷ P. Proof. eapply bi_mixin_later_intro, bi_bi_later_mixin. Qed. Lemma later_forall_2 {A} (Φ : A → PROP) : (∀ a, ▷ Φ a) ⊢ ▷ ∀ a, Φ a. Proof. eapply bi_mixin_later_forall_2, bi_bi_later_mixin. Qed. Lemma later_exist_false {A} (Φ : A → PROP) : (▷ ∃ a, Φ a) ⊢ ▷ False ∨ (∃ a, ▷ Φ a). Proof. eapply bi_mixin_later_exist_false, bi_bi_later_mixin. Qed. Lemma later_sep_1 P Q : ▷ (P ∗ Q) ⊢ ▷ P ∗ ▷ Q. Proof. eapply bi_mixin_later_sep_1, bi_bi_later_mixin. Qed. Lemma later_sep_2 P Q : ▷ P ∗ ▷ Q ⊢ ▷ (P ∗ Q). Proof. eapply bi_mixin_later_sep_2, bi_bi_later_mixin. Qed. Lemma later_persistently_1 P : ▷ P ⊢ ▷ P. Proof. eapply (bi_mixin_later_persistently_1 bi_entails), bi_bi_later_mixin. Qed. Lemma later_persistently_2 P : ▷ P ⊢ ▷ P. Proof. eapply (bi_mixin_later_persistently_2 bi_entails), bi_bi_later_mixin. Qed. Lemma later_false_em P : ▷ P ⊢ ▷ False ∨ (▷ False → P). Proof. eapply bi_mixin_later_false_em, bi_bi_later_mixin. Qed. End bi_laws. End bi. iris-iris-4.2.0/iris/bi/internal_eq.v000066400000000000000000000312511460620107300174600ustar00rootroot00000000000000From iris.bi Require Import derived_laws_later big_op. From iris.prelude Require Import options. From iris.algebra Require Import excl csum. Import interface.bi derived_laws.bi derived_laws_later.bi. (* We enable primitive projections in this file to improve the performance of the Iris proofmode: primitive projections for the bi-records makes the proofmode faster. *) Local Set Primitive Projections. (** This file defines a type class for BIs with a notion of internal equality. Internal equality is not part of the [bi] canonical structure as [internal_eq] can only be given a definition that satisfies [NonExpansive2 internal_eq] _and_ [▷ (x ≡ y) ⊢ Next x ≡ Next y] if the BI is step-indexed. *) Class InternalEq (PROP : Type) := internal_eq : ∀ {A : ofe}, A → A → PROP. Global Arguments internal_eq {_ _ _} _ _ : simpl never. Global Hint Mode InternalEq ! : typeclass_instances. Global Instance: Params (@internal_eq) 3 := {}. Global Typeclasses Opaque internal_eq. Infix "≡" := internal_eq : bi_scope. Infix "≡@{ A }" := (internal_eq (A := A)) (only parsing) : bi_scope. Notation "( X ≡.)" := (internal_eq X) (only parsing) : bi_scope. Notation "(.≡ X )" := (λ Y, Y ≡ X)%I (only parsing) : bi_scope. Notation "(≡@{ A } )" := (internal_eq (A:=A)) (only parsing) : bi_scope. (* Mixins allow us to create instances easily without having to use Program *) Record BiInternalEqMixin (PROP : bi) `(!InternalEq PROP) := { bi_internal_eq_mixin_internal_eq_ne (A : ofe) : NonExpansive2 (@internal_eq PROP _ A); bi_internal_eq_mixin_internal_eq_refl {A : ofe} (P : PROP) (a : A) : P ⊢ a ≡ a; bi_internal_eq_mixin_internal_eq_rewrite {A : ofe} a b (Ψ : A → PROP) : NonExpansive Ψ → a ≡ b ⊢ Ψ a → Ψ b; bi_internal_eq_mixin_fun_extI {A} {B : A → ofe} (f g : discrete_fun B) : (∀ x, f x ≡ g x) ⊢@{PROP} f ≡ g; bi_internal_eq_mixin_sig_equivI_1 {A : ofe} (P : A → Prop) (x y : sig P) : `x ≡ `y ⊢@{PROP} x ≡ y; bi_internal_eq_mixin_discrete_eq_1 {A : ofe} (a b : A) : Discrete a → a ≡ b ⊢@{PROP} ⌜a ≡ b⌝; bi_internal_eq_mixin_later_equivI_1 {A : ofe} (x y : A) : Next x ≡ Next y ⊢@{PROP} ▷ (x ≡ y); bi_internal_eq_mixin_later_equivI_2 {A : ofe} (x y : A) : ▷ (x ≡ y) ⊢@{PROP} Next x ≡ Next y; }. Class BiInternalEq (PROP : bi) := { #[global] bi_internal_eq_internal_eq :: InternalEq PROP; bi_internal_eq_mixin : BiInternalEqMixin PROP bi_internal_eq_internal_eq; }. Global Hint Mode BiInternalEq ! : typeclass_instances. Global Arguments bi_internal_eq_internal_eq : simpl never. Section internal_eq_laws. Context {PROP : bi} `{!BiInternalEq PROP}. Implicit Types P Q : PROP. Global Instance internal_eq_ne (A : ofe) : NonExpansive2 (@internal_eq PROP _ A). Proof. eapply bi_internal_eq_mixin_internal_eq_ne, (bi_internal_eq_mixin). Qed. Lemma internal_eq_refl {A : ofe} P (a : A) : P ⊢ a ≡ a. Proof. eapply bi_internal_eq_mixin_internal_eq_refl, bi_internal_eq_mixin. Qed. Lemma internal_eq_rewrite {A : ofe} a b (Ψ : A → PROP) : NonExpansive Ψ → a ≡ b ⊢ Ψ a → Ψ b. Proof. eapply bi_internal_eq_mixin_internal_eq_rewrite, bi_internal_eq_mixin. Qed. Lemma fun_extI {A} {B : A → ofe} (f g : discrete_fun B) : (∀ x, f x ≡ g x) ⊢@{PROP} f ≡ g. Proof. eapply bi_internal_eq_mixin_fun_extI, bi_internal_eq_mixin. Qed. Lemma sig_equivI_1 {A : ofe} (P : A → Prop) (x y : sig P) : `x ≡ `y ⊢@{PROP} x ≡ y. Proof. eapply bi_internal_eq_mixin_sig_equivI_1, bi_internal_eq_mixin. Qed. Lemma discrete_eq_1 {A : ofe} (a b : A) : Discrete a → a ≡ b ⊢@{PROP} ⌜a ≡ b⌝. Proof. eapply bi_internal_eq_mixin_discrete_eq_1, bi_internal_eq_mixin. Qed. Lemma later_equivI_1 {A : ofe} (x y : A) : Next x ≡ Next y ⊢@{PROP} ▷ (x ≡ y). Proof. eapply bi_internal_eq_mixin_later_equivI_1, bi_internal_eq_mixin. Qed. Lemma later_equivI_2 {A : ofe} (x y : A) : ▷ (x ≡ y) ⊢@{PROP} Next x ≡ Next y. Proof. eapply bi_internal_eq_mixin_later_equivI_2, bi_internal_eq_mixin. Qed. End internal_eq_laws. (* Derived laws *) Section internal_eq_derived. Context {PROP : bi} `{!BiInternalEq PROP}. Implicit Types P : PROP. (* Force implicit argument PROP *) Notation "P ⊢ Q" := (P ⊢@{PROP} Q). Notation "P ⊣⊢ Q" := (P ⊣⊢@{PROP} Q). Global Instance internal_eq_proper (A : ofe) : Proper ((≡) ==> (≡) ==> (⊣⊢)) (@internal_eq PROP _ A) := ne_proper_2 _. (* Equality *) Local Hint Resolve or_elim or_intro_l' or_intro_r' True_intro False_elim : core. Local Hint Resolve and_elim_l' and_elim_r' and_intro forall_intro : core. Local Hint Resolve internal_eq_refl : core. Local Hint Extern 100 (NonExpansive _) => solve_proper : core. Lemma equiv_internal_eq {A : ofe} P (a b : A) : a ≡ b → P ⊢ a ≡ b. Proof. intros ->. auto. Qed. Lemma internal_eq_rewrite' {A : ofe} 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 : ofe} (a b : A) : a ≡ b ⊢ b ≡ a. Proof. apply (internal_eq_rewrite' a b (λ b, b ≡ a)%I); auto. Qed. Lemma internal_eq_trans {A : ofe} (a b c : A) : a ≡ b ∧ b ≡ c ⊢ a ≡ c. Proof. apply (internal_eq_rewrite' b a (λ b, b ≡ c)%I); auto. rewrite and_elim_l. apply internal_eq_sym. 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_equivI {A B : ofe} (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 f_equivI_contractive {A B : ofe} (f : A → B) `{Hf : !Contractive f} x y : ▷ (x ≡ y) ⊢ f x ≡ f y. Proof. rewrite later_equivI_2. move: Hf=>/contractive_alt [g [? Hfg]]. rewrite !Hfg. by apply f_equivI. Qed. Lemma prod_equivI {A B : ofe} (x y : A * B) : x ≡ y ⊣⊢ x.1 ≡ y.1 ∧ x.2 ≡ y.2. Proof. apply (anti_symm _). - apply and_intro; apply f_equivI; 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 : ofe} (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_equivI, _. Qed. Lemma option_equivI {A : ofe} (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_equivI, _. Qed. Lemma csum_equivI {A B : ofe} (sx sy : csum A B) : sx ≡ sy ⊣⊢ match sx, sy with | Cinl x, Cinl y => x ≡ y | Cinr x, Cinr y => x ≡ y | CsumBot, CsumBot => True | _, _ => False end. Proof. apply (anti_symm _). - apply (internal_eq_rewrite' sx sy (λ sy', match sx, sy' with | Cinl x, Cinl y => x ≡ y | Cinr x, Cinr y => x ≡ y | CsumBot, CsumBot => True | _, _ => False end)%I); [solve_proper|auto|]. destruct sx; eauto. - destruct sx; destruct sy; eauto; apply f_equivI, _. Qed. Lemma excl_equivI {O : ofe} (x y : excl O) : x ≡ y ⊣⊢ match x, y with | Excl a, Excl b => a ≡ b | ExclBot, ExclBot => True | _, _ => False end. Proof. apply (anti_symm _). - apply (internal_eq_rewrite' x y (λ y', match x, y' with | Excl a, Excl b => a ≡ b | ExclBot, ExclBot => True | _, _ => False end)%I); [solve_proper|auto|]. destruct x; eauto. - destruct x as [e1|]; destruct y as [e2|]; [|by eauto..]. apply f_equivI, _. Qed. Lemma sig_equivI {A : ofe} (P : A → Prop) (x y : sig P) : `x ≡ `y ⊣⊢ x ≡ y. Proof. apply (anti_symm _). - apply sig_equivI_1. - apply f_equivI, _. Qed. Section sigT_equivI. Import EqNotations. Lemma sigT_equivI {A : Type} {P : A → ofe} (x y : sigT P) : x ≡ y ⊣⊢ ∃ eq : projT1 x = projT1 y, rew eq in projT2 x ≡ projT2 y. Proof. apply (anti_symm _). - apply (internal_eq_rewrite' x y (λ y, ∃ eq : projT1 x = projT1 y, rew eq in projT2 x ≡ projT2 y))%I; [| done | exact: (exist_intro' _ _ eq_refl) ]. move => n [a pa] [b pb] [/=]; intros -> => /= Hab. apply exist_ne => ?. by rewrite Hab. - apply exist_elim. move: x y => [a pa] [b pb] /=. intros ->; simpl. apply f_equivI, _. Qed. End sigT_equivI. Lemma discrete_fun_equivI {A} {B : A → ofe} (f g : discrete_fun B) : f ≡ g ⊣⊢ ∀ x, f x ≡ g x. Proof. apply (anti_symm _); auto using fun_extI. apply (internal_eq_rewrite' f g (λ g, ∀ x : A, f x ≡ g x)%I); auto. Qed. Lemma ofe_morO_equivI {A B : ofe} (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 -(discrete_fun_equivI (ofe_mor_car _ _ f) (ofe_mor_car _ _ g)). set (h1 (f : A -n> B) := exist (λ f : A -d> B, NonExpansive (f : A → B)) f (ofe_mor_ne A B f)). set (h2 (f : sigO (λ f : A -d> B, NonExpansive (f : A → B))) := @OfeMor 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_equivI -sig_equivI. Qed. Lemma pure_internal_eq {A : ofe} (x y : A) : ⌜x ≡ y⌝ ⊢ x ≡ y. Proof. apply pure_elim'=> ->. apply internal_eq_refl. Qed. Lemma discrete_eq {A : ofe} (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 : ofe} (x y : A) : (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 : ofe} (a b : A) : (a ≡ b) ⊣⊢ a ≡ b. Proof. apply (anti_symm (⊢)). { by rewrite persistently_into_absorbingly absorbingly_internal_eq. } apply (internal_eq_rewrite' a b (λ b, (a ≡ b))%I); auto. rewrite -(internal_eq_refl emp%I a). apply persistently_emp_intro. Qed. Global Instance internal_eq_absorbing {A : ofe} (x y : A) : Absorbing (PROP:=PROP) (x ≡ y). Proof. by rewrite /Absorbing absorbingly_internal_eq. Qed. Global Instance internal_eq_persistent {A : ofe} (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 : ofe} a b (Ψ : A → PROP) {HΨ : Contractive Ψ} : ▷ (a ≡ b) ⊢ Ψ a → Ψ b. Proof. rewrite f_equivI_contractive. apply (internal_eq_rewrite (Ψ a) (Ψ b) id _). Qed. Lemma internal_eq_rewrite_contractive' {A : ofe} a b (Ψ : A → PROP) P {HΨ : Contractive Ψ} : (P ⊢ ▷ (a ≡ b)) → (P ⊢ Ψ a) → P ⊢ Ψ b. Proof. rewrite later_equivI_2. move: HΨ=>/contractive_alt [g [? HΨ]]. rewrite !HΨ. by apply internal_eq_rewrite'. Qed. Lemma later_equivI {A : ofe} (x y : A) : Next x ≡ Next y ⊣⊢ ▷ (x ≡ y). Proof. apply (anti_symm _); auto using later_equivI_1, later_equivI_2. Qed. Lemma later_equivI_prop_2 `{!Contractive (bi_later (PROP:=PROP))} P Q : ▷ (P ≡ Q) ⊢ (▷ P) ≡ (▷ Q). Proof. apply (f_equivI_contractive _). Qed. Global Instance eq_timeless {A : ofe} (a b : A) : Discrete a → Timeless (PROP:=PROP) (a ≡ b). Proof. intros. rewrite /Discrete !discrete_eq. apply (timeless _). Qed. End internal_eq_derived. iris-iris-4.2.0/iris/bi/lib/000077500000000000000000000000001460620107300155345ustar00rootroot00000000000000iris-iris-4.2.0/iris/bi/lib/atomic.v000066400000000000000000000500351460620107300172020ustar00rootroot00000000000000From stdpp Require Import coPset namespaces. From iris.bi Require Export bi updates. From iris.bi.lib Require Import fixpoint. From iris.proofmode Require Import coq_tactics proofmode reduction. From iris.prelude Require Import options. (** 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 {PROP : bi} `{!BiFUpd PROP} {TA TB : tele}. Implicit Types (Eo Ei : coPset) (* outer/inner masks *) (α : TA → PROP) (* atomic pre-condition *) (P : PROP) (* abortion condition *) (β : TA → TB → PROP) (* atomic post-condition *) (Φ : TA → TB → 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)). 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 Ed α P β Φ : atomic_acc Eo (Eo∖Ed) α P β Φ ⊣⊢ ∀ E, ⌜Eo ⊆ E⌝ → atomic_acc E (E∖Ed) α 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. Lemma atomic_acc_mask_weaken Eo1 Eo2 Ei α P β Φ : Eo1 ⊆ Eo2 → atomic_acc Eo1 Ei α P β Φ -∗ atomic_acc Eo2 Ei α P β Φ. Proof. iIntros (HE) "Hstep". iMod (fupd_mask_subseteq Eo1) as "Hclose1"; first done. iMod "Hstep" as (x) "[Hα Hclose2]". iIntros "!>". iExists x. iFrame. iSplitWith "Hclose2". - iIntros "Hα". iMod ("Hclose2" with "Hα") as "$". done. - iIntros (y) "Hβ". iMod ("Hclose2" with "Hβ") as "$". done. Qed. (** atomic_update as a fixed-point of the equation AU = atomic_acc α AU β Q *) Context Eo Ei α β Φ. Definition atomic_update_pre (Ψ : () → PROP) (_ : ()) : PROP := atomic_acc Eo Ei α (Ψ ()) β Φ. Local Instance atomic_update_pre_mono : BiMonoPred atomic_update_pre. Proof. constructor. - iIntros (P1 P2 ??) "#HP12". iIntros ([]) "AU". iApply (atomic_acc_wand with "[HP12] AU"). iSplit; last by eauto. iApply "HP12". - intros ??. solve_proper. Qed. Local Definition atomic_update_def := bi_greatest_fixpoint atomic_update_pre (). End definition. (** Seal it *) Local Definition atomic_update_aux : seal (@atomic_update_def). Proof. by eexists. Qed. Definition atomic_update := atomic_update_aux.(unseal). Global Arguments atomic_update {PROP _ TA TB}. Local Definition atomic_update_unseal : @atomic_update = _ := atomic_update_aux.(seal_eq). Global Arguments atomic_acc {PROP _ TA TB} Eo Ei _ _ _ _ : simpl never. Global Arguments atomic_update {PROP _ TA TB} Eo Ei _ _ _ : simpl never. (** Notation: Atomic updates *) (** We avoid '<<'/'>>' since those can also reasonably be infix operators (and in fact Autosubst uses the latter). *) Notation "'AU' '<{' ∃∃ x1 .. xn , α '}>' @ Eo , Ei '<{' ∀∀ y1 .. yn , β , 'COMM' Φ '}>'" := (* The way to read the [tele_app foo] here is that they convert the n-ary function [foo] into a unary function taking a telescope as the argument. *) (atomic_update (TA:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) (TB:=TeleS (λ y1, .. (TeleS (λ yn, TeleO)) .. )) Eo Ei (tele_app $ λ x1, .. (λ xn, α%I) ..) (tele_app $ λ x1, .. (λ xn, tele_app (λ y1, .. (λ yn, β%I) .. ) ) .. ) (tele_app $ λ x1, .. (λ xn, tele_app (λ y1, .. (λ yn, Φ%I) .. ) ) .. ) ) (at level 20, Eo, Ei, α, β, Φ at level 200, x1 binder, xn binder, y1 binder, yn binder, format "'[hv ' 'AU' '<{' '[' ∃∃ x1 .. xn , '/' α ']' '}>' '/' @ '[' Eo , '/' Ei ']' '/' '<{' '[' ∀∀ y1 .. yn , '/' β , '/' COMM Φ ']' '}>' ']'") : bi_scope. Notation "'AU' '<{' ∃∃ x1 .. xn , α '}>' @ Eo , Ei '<{' β , 'COMM' Φ '}>'" := (atomic_update (TA:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) (TB:=TeleO) Eo Ei (tele_app $ λ x1, .. (λ xn, α%I) ..) (tele_app $ λ x1, .. (λ xn, tele_app β%I) .. ) (tele_app $ λ x1, .. (λ xn, tele_app Φ%I) .. ) ) (at level 20, Eo, Ei, α, β, Φ at level 200, x1 binder, xn binder, format "'[hv ' 'AU' '<{' '[' ∃∃ x1 .. xn , '/' α ']' '}>' '/' @ '[' Eo , '/' Ei ']' '/' '<{' '[' β , '/' COMM Φ ']' '}>' ']'") : bi_scope. Notation "'AU' '<{' α '}>' @ Eo , Ei '<{' ∀∀ y1 .. yn , β , 'COMM' Φ '}>'" := (atomic_update (TA:=TeleO) (TB:=TeleS (λ y1, .. (TeleS (λ yn, TeleO)) .. )) Eo Ei (tele_app α%I) (tele_app $ tele_app (λ y1, .. (λ yn, β%I) ..)) (tele_app $ tele_app (λ y1, .. (λ yn, Φ%I) ..)) ) (at level 20, Eo, Ei, α, β, Φ at level 200, y1 binder, yn binder, format "'[hv ' 'AU' '<{' '[' α ']' '}>' '/' @ '[' Eo , '/' Ei ']' '/' '<{' '[' ∀∀ y1 .. yn , '/' β , '/' COMM Φ ']' '}>' ']'") : bi_scope. Notation "'AU' '<{' α '}>' @ Eo , Ei '<{' β , 'COMM' Φ '}>'" := (atomic_update (TA:=TeleO) (TB:=TeleO) Eo Ei (tele_app α%I) (tele_app $ tele_app β%I) (tele_app $ tele_app Φ%I) ) (at level 20, Eo, Ei, α, β, Φ at level 200, format "'[hv ' 'AU' '<{' '[' α ']' '}>' '/' @ '[' Eo , '/' Ei ']' '/' '<{' '[' β , '/' COMM Φ ']' '}>' ']'") : bi_scope. (** Notation: Atomic accessors *) Notation "'AACC' '<{' ∃∃ x1 .. xn , α , 'ABORT' P '}>' @ Eo , Ei '<{' ∀∀ y1 .. yn , β , 'COMM' Φ '}>'" := (atomic_acc (TA:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) (TB:=TeleS (λ y1, .. (TeleS (λ yn, TeleO)) .. )) Eo Ei (tele_app $ λ x1, .. (λ xn, α%I) ..) P%I (tele_app $ λ x1, .. (λ xn, tele_app (λ y1, .. (λ yn, β%I) .. ) ) .. ) (tele_app $ λ x1, .. (λ xn, tele_app (λ y1, .. (λ yn, Φ%I) .. ) ) .. ) ) (at level 20, Eo, Ei, α, P, β, Φ at level 200, x1 binder, xn binder, y1 binder, yn binder, format "'[hv ' 'AACC' '<{' '[' ∃∃ x1 .. xn , '/' α , '/' ABORT P ']' '}>' '/' @ '[' Eo , '/' Ei ']' '/' '<{' '[' ∀∀ y1 .. yn , '/' β , '/' COMM Φ ']' '}>' ']'") : bi_scope. Notation "'AACC' '<{' ∃∃ x1 .. xn , α , 'ABORT' P '}>' @ Eo , Ei '<{' β , 'COMM' Φ '}>'" := (atomic_acc (TA:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) (TB:=TeleO) Eo Ei (tele_app $ λ x1, .. (λ xn, α%I) ..) P%I (tele_app $ λ x1, .. (λ xn, tele_app β%I) .. ) (tele_app $ λ x1, .. (λ xn, tele_app Φ%I) .. ) ) (at level 20, Eo, Ei, α, P, β, Φ at level 200, x1 binder, xn binder, format "'[hv ' 'AACC' '<{' '[' ∃∃ x1 .. xn , '/' α , '/' ABORT P ']' '}>' '/' @ '[' Eo , '/' Ei ']' '/' '<{' '[' β , '/' COMM Φ ']' '}>' ']'") : bi_scope. Notation "'AACC' '<{' α , 'ABORT' P '}>' @ Eo , Ei '<{' ∀∀ y1 .. yn , β , 'COMM' Φ '}>'" := (atomic_acc (TA:=TeleO) (TB:=TeleS (λ y1, .. (TeleS (λ yn, TeleO)) .. )) Eo Ei (tele_app α%I) P%I (tele_app $ tele_app (λ y1, .. (λ yn, β%I) ..)) (tele_app $ tele_app (λ y1, .. (λ yn, Φ%I) ..)) ) (at level 20, Eo, Ei, α, P, β, Φ at level 200, y1 binder, yn binder, format "'[hv ' 'AACC' '<{' '[' α , '/' ABORT P ']' '}>' '/' @ '[' Eo , '/' Ei ']' '/' '<{' '[' ∀∀ y1 .. yn , '/' β , '/' COMM Φ ']' '}>' ']'") : bi_scope. Notation "'AACC' '<{' α , 'ABORT' P '}>' @ Eo , Ei '<{' β , 'COMM' Φ '}>'" := (atomic_acc (TA:=TeleO) (TB:=TeleO) Eo Ei (tele_app α%I) P%I (tele_app $ tele_app β%I) (tele_app $ tele_app Φ%I) ) (at level 20, Eo, Ei, α, P, β, Φ at level 200, format "'[hv ' 'AACC' '<{' '[' α , '/' ABORT P ']' '}>' '/' @ '[' Eo , '/' Ei ']' '/' '<{' '[' β , '/' COMM Φ ']' '}>' ']'") : bi_scope. (** Lemmas about AU *) Section lemmas. Context `{BiFUpd PROP} {TA TB : tele}. Implicit Types (α : TA → PROP) (β Φ : TA → TB → PROP) (P : PROP). Local Existing Instance atomic_update_pre_mono. (* Can't be in the section above as that fixes the parameters *) Global Instance atomic_acc_ne Eo Ei n : Proper ( pointwise_relation TA (dist n) ==> dist n ==> pointwise_relation TA (pointwise_relation TB (dist n)) ==> pointwise_relation TA (pointwise_relation TB (dist n)) ==> dist n ) (atomic_acc (PROP:=PROP) Eo Ei). Proof. solve_proper. Qed. Global Instance atomic_update_ne Eo Ei n : Proper ( pointwise_relation TA (dist n) ==> pointwise_relation TA (pointwise_relation TB (dist n)) ==> pointwise_relation TA (pointwise_relation TB (dist n)) ==> dist n ) (atomic_update (PROP:=PROP) Eo Ei). Proof. rewrite atomic_update_unseal /atomic_update_def /atomic_update_pre. solve_proper. Qed. Lemma atomic_update_mask_weaken Eo1 Eo2 Ei α β Φ : Eo1 ⊆ Eo2 → atomic_update Eo1 Ei α β Φ -∗ atomic_update Eo2 Ei α β Φ. Proof. rewrite atomic_update_unseal {2}/atomic_update_def /=. iIntros (Heo) "HAU". iApply (greatest_fixpoint_coiter _ (λ _, atomic_update_def Eo1 Ei α β Φ)); last done. iIntros "!> *". rewrite {1}/atomic_update_def /= greatest_fixpoint_unfold. iApply atomic_acc_mask_weaken. done. Qed. Local Lemma aupd_unfold Eo Ei α β Φ : atomic_update Eo Ei α β Φ ⊣⊢ atomic_acc Eo Ei α (atomic_update Eo Ei α β Φ) β Φ. Proof. rewrite atomic_update_unseal /atomic_update_def /=. apply: greatest_fixpoint_unfold. Qed. (** The elimination form: an atomic accessor *) Lemma aupd_aacc Eo Ei α β Φ : atomic_update Eo Ei α β Φ ⊢ atomic_acc Eo Ei α (atomic_update Eo Ei α β Φ) β Φ. Proof using Type*. by rewrite {1}aupd_unfold. Qed. (* This lets you eliminate atomic updates with iMod. *) Global Instance elim_mod_aupd φ Eo Ei E α β Φ Q Q' : (∀ R, ElimModal φ false false (|={E,Ei}=> R) R Q Q') → ElimModal (φ ∧ Eo ⊆ E) false false (atomic_update Eo Ei α β Φ) (∃.. x, α x ∗ (α x ={Ei,E}=∗ atomic_update Eo Ei α β Φ) ∧ (∀.. y, β x y ={Ei,E}=∗ Φ x y)) Q Q'. Proof. intros ?. rewrite /ElimModal /= =>-[??]. iIntros "[AU Hcont]". iPoseProof (aupd_aacc with "AU") as "AC". iMod (atomic_acc_mask_weaken with "AC"); first done. iApply "Hcont". done. Qed. (** The introduction lemma for atomic_update. This should usually not be used directly; use the [iAuIntro] tactic instead. *) Local Lemma aupd_intro P Q α β Eo Ei Φ : Absorbing P → Persistent P → (P ∧ Q ⊢ atomic_acc Eo Ei α Q β Φ) → P ∧ Q ⊢ atomic_update Eo Ei α β Φ. Proof. rewrite atomic_update_unseal {1}/atomic_update_def /=. iIntros (?? HAU) "[#HP HQ]". iApply (greatest_fixpoint_coiter _ (λ _, Q)); last done. iIntros "!>" ([]) "HQ". iApply HAU. iSplit; by iFrame. Qed. Lemma aacc_intro Eo Ei α P β Φ : Ei ⊆ Eo → ⊢ (∀.. x, α x -∗ ((α x ={Eo}=∗ P) ∧ (∀.. y, β x y ={Eo}=∗ Φ x y)) -∗ atomic_acc Eo Ei α P β Φ). Proof. iIntros (? x) "Hα Hclose". iApply fupd_mask_intro; first set_solver. iIntros "Hclose'". iExists x. iFrame. iSplitWith "Hclose". - iIntros "Hα". iMod "Hclose'" as "_". iApply "Hclose". done. - iIntros (y) "Hβ". iMod "Hclose'" as "_". iApply "Hclose". done. Qed. (* This lets you open invariants etc. when the goal is an atomic accessor. *) Global Instance elim_acc_aacc {X} E1 E2 Ei (α' β' : X → PROP) γ' α β Pas Φ : ElimAcc (X:=X) True (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. (* 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']". iApply fupd_mask_intro; first set_solver. iIntros "Hclose''". 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β'". (* FIXME: Using ssreflect rewrite does not work, see Coq bug #7773. *) rewrite ->!tele_app_bind. iDestruct "Hβ'" as "[Hβ' HΦ]". iMod ("Hclose" with "Hβ'") as "Hγ'". iModIntro. destruct (γ' x'); iApply "HΦ"; done. Qed. (* Everything that fancy updates can eliminate without changing, atomic accessors can eliminate as well. This is a forwarding instance needed becuase atomic_acc is becoming opaque. *) Global Instance elim_modal_acc p q φ P P' Eo Ei α Pas β Φ : (∀ Q, ElimModal φ p q P P' (|={Eo,Ei}=> Q) (|={Eo,Ei}=> Q)) → ElimModal φ p q P P' (atomic_acc Eo Ei α Pas β Φ) (atomic_acc Eo Ei α Pas β Φ). Proof. intros Helim. apply Helim. Qed. (** Lemmas for directly proving one atomic accessor in terms of another (or an atomic update). These are only really useful when the atomic accessor you are trying to prove exactly corresponds to an atomic update/accessor you have as an assumption -- which is not very common. *) Lemma aacc_aacc {TA' TB' : tele} E1 E1' E2 E3 α P β Φ (α' : TA' → PROP) P' (β' Φ' : TA' → TB' → PROP) : E1' ⊆ E1 → 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 (atomic_acc_mask_weaken with "Hupd") as (x) "[Hα Hclose]"; first done. 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 "Hres". (* FIXME: Using ssreflect rewrite does not work, see Coq bug #7773. *) rewrite ->!tele_app_bind. iDestruct "Hres" 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 {TA' TB' : tele} E1 E1' E2 E3 α β Φ (α' : TA' → PROP) P' (β' Φ' : TA' → TB' → PROP) : E1' ⊆ E1 → atomic_update E1' E2 α β Φ -∗ (∀.. x, α x -∗ atomic_acc E2 E3 α' (α x ∗ (atomic_update E1' E2 α β Φ ={E1}=∗ P')) β' (λ.. x' y', (α x ∗ (atomic_update E1' E2 α β Φ ={E1}=∗ Φ' x' y')) ∨ ∃.. y, β x y ∗ (Φ x y ={E1}=∗ Φ' x' y'))) -∗ atomic_acc E1 E3 α' P' β' Φ'. Proof. iIntros (?) "Hupd Hstep". iApply (aacc_aacc with "[Hupd] Hstep"); first done. iApply aupd_aacc; done. Qed. Lemma aacc_aupd_commit {TA' TB' : tele} E1 E1' E2 E3 α β Φ (α' : TA' → PROP) P' (β' Φ' : TA' → TB' → PROP) : E1' ⊆ E1 → atomic_update E1' E2 α β Φ -∗ (∀.. x, α x -∗ atomic_acc E2 E3 α' (α x ∗ (atomic_update E1' E2 α β Φ ={E1}=∗ P')) β' (λ.. x' y', ∃.. y, β x y ∗ (Φ x y ={E1}=∗ Φ' x' y'))) -∗ atomic_acc E1 E3 α' P' β' Φ'. Proof. iIntros (?) "Hupd Hstep". iApply (aacc_aupd with "Hupd"); first done. iIntros (x) "Hα". iApply atomic_acc_wand; last first. { iApply "Hstep". done. } (* FIXME: Using ssreflect rewrite does not work, see Coq bug #7773. *) iSplit; first by eauto. iIntros (??) "?". rewrite ->!tele_app_bind. by iRight. Qed. Lemma aacc_aupd_abort {TA' TB' : tele} E1 E1' E2 E3 α β Φ (α' : TA' → PROP) P' (β' Φ' : TA' → TB' → PROP) : E1' ⊆ E1 → atomic_update E1' E2 α β Φ -∗ (∀.. x, α x -∗ atomic_acc E2 E3 α' (α x ∗ (atomic_update E1' E2 α β Φ ={E1}=∗ P')) β' (λ.. x' y', α x ∗ (atomic_update E1' E2 α β Φ ={E1}=∗ Φ' x' y'))) -∗ atomic_acc E1 E3 α' P' β' Φ'. Proof. iIntros (?) "Hupd Hstep". iApply (aacc_aupd with "Hupd"); first done. iIntros (x) "Hα". iApply atomic_acc_wand; last first. { iApply "Hstep". done. } (* FIXME: Using ssreflect rewrite does not work, see Coq bug #7773. *) iSplit; first by eauto. iIntros (??) "?". rewrite ->!tele_app_bind. by iLeft. Qed. End lemmas. (** ProofMode support for atomic updates. *) Section proof_mode. Context `{BiFUpd PROP} {TA TB : tele}. Implicit Types (α : TA → PROP) (β Φ : TA → TB → PROP) (P : PROP). Lemma tac_aupd_intro Γp Γs n α β Eo Ei Φ P : P = env_to_prop Γs → envs_entails (Envs Γp Γs n) (atomic_acc Eo Ei α P β Φ) → envs_entails (Envs Γp Γs n) (atomic_update Eo Ei α β Φ). Proof. intros ->. rewrite envs_entails_unseal of_envs_eq /atomic_acc /=. setoid_rewrite env_to_prop_sound =>HAU. rewrite assoc. apply: aupd_intro. by rewrite -assoc. Qed. End proof_mode. (** * Now the coq-level tactics *) Tactic Notation "iAuIntro" := match goal with | |- envs_entails (Envs ?Γp ?Γs _) (atomic_update _ _ _ _ ?Φ) => notypeclasses refine (tac_aupd_intro Γp Γs _ _ _ _ _ Φ _ _ _); [ (* P = ...: make the P pretty *) pm_reflexivity | (* the new proof mode goal *) ] end. (** Tactic to apply [aacc_intro]. This only really works well when you have [α ?] already and pass it as [iAaccIntro with "Hα"]. Doing [rewrite /atomic_acc /=] is an entirely legitimate alternative. *) Tactic Notation "iAaccIntro" "with" constr(sel) := iStartProof; lazymatch goal with | |- envs_entails _ (@atomic_acc ?PROP ?H ?TA ?TB ?Eo ?Ei ?α ?P ?β ?Φ) => iApply (@aacc_intro PROP H TA TB Eo Ei α P β Φ with sel); first try solve_ndisj; last iSplit | _ => fail "iAAccIntro: Goal is not an atomic accessor" end. (* From here on, prevent TC search from implicitly unfolding these. *) Global Typeclasses Opaque atomic_acc atomic_update. iris-iris-4.2.0/iris/bi/lib/cmra.v000066400000000000000000000127551460620107300166570ustar00rootroot00000000000000From iris.proofmode Require Import proofmode. From iris.bi Require Import internal_eq. From iris.algebra Require Import cmra csum excl agree. From iris.prelude Require Import options. (** Derived [≼] connective on [cmra] elements. This can be defined on any [bi] that has internal equality [≡]. It corresponds to the step-indexed [≼{n}] connective in the [uPred] model. *) Definition internal_included `{!BiInternalEq PROP} {A : cmra} (a b : A) : PROP := ∃ c, b ≡ a ⋅ c. Global Arguments internal_included {_ _ _} _ _ : simpl never. Global Instance: Params (@internal_included) 3 := {}. Global Typeclasses Opaque internal_included. Infix "≼" := internal_included : bi_scope. Section internal_included_laws. Context `{!BiInternalEq PROP}. Implicit Type A B : cmra. (* Force implicit argument PROP *) Notation "P ⊢ Q" := (P ⊢@{PROP} Q). Notation "P ⊣⊢ Q" := (P ⊣⊢@{PROP} Q). (** Propers *) Global Instance internal_included_nonexpansive A : NonExpansive2 (internal_included (PROP := PROP) (A := A)). Proof. solve_proper. Qed. Global Instance internal_included_proper A : Proper ((≡) ==> (≡) ==> (⊣⊢)) (internal_included (PROP := PROP) (A := A)). Proof. solve_proper. Qed. (** Proofmode support *) Global Instance into_pure_internal_included {A} (a b : A) `{!Discrete b} : @IntoPure PROP (a ≼ b) (a ≼ b). Proof. rewrite /IntoPure /internal_included. eauto. Qed. Global Instance from_pure_internal_included {A} (a b : A) : @FromPure PROP false (a ≼ b) (a ≼ b). Proof. rewrite /FromPure /= /internal_included. eauto. Qed. Global Instance into_exist_internal_included {A} (a b : A) : IntoExist (PROP := PROP) (a ≼ b) (λ c, b ≡ a ⋅ c)%I (λ x, x). Proof. by rewrite /IntoExist. Qed. Global Instance from_exist_internal_included {A} (a b : A) : FromExist (PROP := PROP) (a ≼ b) (λ c, b ≡ a ⋅ c)%I. Proof. by rewrite /FromExist. Qed. Global Instance internal_included_persistent {A} (a b : A) : Persistent (PROP := PROP) (a ≼ b). Proof. rewrite /internal_included. apply _. Qed. Global Instance internal_included_absorbing {A} (a b : A) : Absorbing (PROP := PROP) (a ≼ b). Proof. rewrite /internal_included. apply _. Qed. Lemma internal_included_refl `{!CmraTotal A} (x : A) : ⊢@{PROP} x ≼ x. Proof. iExists (core x). by rewrite cmra_core_r. Qed. Lemma internal_included_trans {A} (x y z : A) : ⊢@{PROP} x ≼ y -∗ y ≼ z -∗ x ≼ z. Proof. iIntros "#[%x' Hx'] #[%y' Hy']". iExists (x' ⋅ y'). rewrite assoc. by iRewrite -"Hx'". Qed. (** Simplification lemmas *) Lemma f_homom_includedI {A B} (x y : A) (f : A → B) `{!NonExpansive f} : (* This is a slightly weaker condition than being a [CmraMorphism] *) (∀ c, f x ⋅ f c ≡ f (x ⋅ c)) → (x ≼ y ⊢ f x ≼ f y). Proof. intros f_homom. iDestruct 1 as (z) "Hz". iExists (f z). rewrite f_homom. by iApply f_equivI. Qed. Lemma prod_includedI {A B} (x y : A * B) : x ≼ y ⊣⊢ (x.1 ≼ y.1) ∧ (x.2 ≼ y.2). Proof. destruct x as [x1 x2], y as [y1 y2]; simpl; iSplit. - iIntros "#[%z H]". rewrite prod_equivI /=. iDestruct "H" as "[??]". iSplit; by iExists _. - iIntros "#[[%z1 Hz1] [%z2 Hz2]]". iExists (z1, z2). rewrite prod_equivI /=; auto. Qed. Lemma option_includedI {A} (mx my : option A) : mx ≼ my ⊣⊢ match mx, my with | Some x, Some y => (x ≼ y) ∨ (x ≡ y) | None, _ => True | Some x, None => False end. Proof. iSplit. - iIntros "[%mz H]". rewrite option_equivI. destruct mx as [x|], my as [y|], mz as [z|]; simpl; auto; [|]. + iLeft. by iExists z. + iRight. by iRewrite "H". - destruct mx as [x|], my as [y|]; simpl; auto; [|]. + iDestruct 1 as "[[%z H]|H]"; iRewrite "H". * by iExists (Some z). * by iExists None. + iIntros "_". by iExists (Some y). Qed. Lemma option_included_totalI `{!CmraTotal A} (mx my : option A) : mx ≼ my ⊣⊢ match mx, my with | Some x, Some y => x ≼ y | None, _ => True | Some x, None => False end. Proof. rewrite option_includedI. destruct mx as [x|], my as [y|]; [|done..]. iSplit; [|by auto]. iIntros "[Hx|Hx] //". iRewrite "Hx". iApply (internal_included_refl y). Qed. Lemma csum_includedI {A B} (sx sy : csum A B) : sx ≼ sy ⊣⊢ match sx, sy with | Cinl x, Cinl y => x ≼ y | Cinr x, Cinr y => x ≼ y | _, CsumBot => True | _, _ => False end. Proof. iSplit. - iDestruct 1 as (sz) "H". rewrite csum_equivI. destruct sx, sy, sz; rewrite /internal_included /=; auto. - destruct sx as [x|x|], sy as [y|y|]; eauto; [|]. + iIntros "#[%z H]". iExists (Cinl z). by rewrite csum_equivI. + iIntros "#[%z H]". iExists (Cinr z). by rewrite csum_equivI. Qed. Lemma excl_includedI {O : ofe} (x y : excl O) : x ≼ y ⊣⊢ match y with | ExclBot => True | _ => False end. Proof. iSplit. - iIntros "[%z Hz]". rewrite excl_equivI. destruct y, x, z; auto. - destruct y; [done|]. iIntros "_". by iExists ExclBot. Qed. Lemma agree_includedI {O : ofe} (x y : agree O) : x ≼ y ⊣⊢ y ≡ x ⋅ y. Proof. iSplit. + iIntros "[%z Hz]". iRewrite "Hz". by rewrite assoc agree_idemp. + iIntros "H". by iExists _. Qed. End internal_included_laws. iris-iris-4.2.0/iris/bi/lib/core.v000066400000000000000000000067301460620107300166610ustar00rootroot00000000000000From iris.bi Require Export bi plainly. From iris.proofmode Require Import proofmode. From iris.prelude Require Import options. 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, ■ (Q -∗ Q) -∗ ■ (P -∗ Q) -∗ Q. Global Instance: Params (@coreP) 1 := {}. Global Typeclasses Opaque coreP. Section core. Context {PROP : bi} `{!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 `{!BiPersistentlyForall PROP, !BiPersistentlyImplPlainly PROP} 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_affine P : Affine P → Affine (coreP P). Proof. intros ?. rewrite /coreP /Affine. iIntros "HC". iApply "HC"; eauto. 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. Global Instance coreP_flip_mono : Proper (flip (⊢) ==> flip (⊢)) (coreP (PROP:=PROP)). Proof. solve_proper. Qed. Lemma coreP_wand P Q : ■ (P -∗ Q) -∗ coreP P -∗ coreP Q. Proof. rewrite /coreP. iIntros "#HPQ HP" (R) "#HR #HQR". iApply ("HP" with "HR"). iIntros "!> !> HP". iApply "HQR". by iApply "HPQ". Qed. Lemma coreP_elim P : Persistent P → coreP P -∗ P. Proof. rewrite /coreP. iIntros (?) "HCP". iApply "HCP"; auto. Qed. (** The [] modality is needed for general BIs: - The right-to-left direction corresponds to elimination of [], which cannot be done without []. - The left-to-right direction corresponds the introduction of []. The [] modality makes it stronger since it appears in the LHS of the [⊢] in the premise. As a user, you have to prove [ coreP P ⊢ Q], which is weaker than [coreP P ⊢ Q]. *) Lemma coreP_entails `{!BiPersistentlyForall PROP, !BiPersistentlyImplPlainly PROP} P Q : ( coreP P ⊢ Q) ↔ (P ⊢ Q). Proof. split. - iIntros (HP) "HP". iDestruct (coreP_intro with "HP") as "#HcP {HP}". iIntros "!>". by iApply HP. - iIntros (->) "HcQ". by iDestruct (coreP_elim with "HcQ") as "#HQ". Qed. (** A more convenient variant of the above lemma for affine [P]. *) Lemma coreP_entails' `{!BiPersistentlyForall PROP, !BiPersistentlyImplPlainly PROP} P Q `{!Affine P} : (coreP P ⊢ Q) ↔ (P ⊢ □ Q). Proof. rewrite -(affine_affinely (coreP P)) coreP_entails. split. - rewrite -{2}(affine_affinely P). by intros ->. - intros ->. apply affinely_elim. Qed. End core. iris-iris-4.2.0/iris/bi/lib/counterexamples.v000066400000000000000000000411231460620107300211420ustar00rootroot00000000000000From iris.bi Require Export bi. From iris.proofmode Require Import proofmode. From iris.prelude Require Import options. (* The sections add extra BI assumptions, which is only picked up with "Type"*. *) Set Default Proof Using "Type*". (** This proves that in an affine BI (i.e., a BI that enjoys [P ∗ Q ⊢ P]), the classical excluded middle ([P ∨ ¬P]) axiom makes the separation conjunction trivial, i.e., it gives [P -∗ P ∗ P] and [P ∧ Q -∗ P ∗ Q]. Our proof essentially follows the structure of the proof of Theorem 3 in https://scholar.princeton.edu/sites/default/files/qinxiang/files/putting_order_to_the_separation_logic_jungle_revised_version.pdf *) Module affine_em. Section affine_em. Context {PROP : bi} `{!BiAffine PROP}. Context (em : ∀ P : PROP, ⊢ P ∨ ¬P). Implicit Types P Q : PROP. Lemma sep_dup P : P -∗ P ∗ P. Proof. iIntros "HP". iDestruct (em P) as "[HP'|HnotP]". - iFrame "HP HP'". - iExFalso. by iApply "HnotP". Qed. Lemma and_sep P Q : P ∧ Q -∗ P ∗ Q. Proof. iIntros "HPQ". iDestruct (sep_dup with "HPQ") as "[HPQ HPQ']". iSplitL "HPQ". - by iDestruct "HPQ" as "[HP _]". - by iDestruct "HPQ'" as "[_ HQ]". Qed. End affine_em. End affine_em. (** This proves that the combination of Löb induction [(▷ P → P) ⊢ P] and the classical excluded-middle [P ∨ ¬P] axiom makes the later operator trivial, i.e., it gives [▷ P] for any [P], or equivalently [▷ P ≡ True]. *) Module löb_em. Section löb_em. Context {PROP : bi} `{!BiLöb PROP}. Context (em : ∀ P : PROP, ⊢ P ∨ ¬P). Implicit Types P : PROP. Lemma later_anything P : ⊢@{PROP} ▷ P. Proof. iDestruct (em (▷ False)) as "#[HP|HnotP]". - iNext. done. - iExFalso. iLöb as "IH". iSpecialize ("HnotP" with "IH"). done. Qed. End löb_em. End löb_em. (** This proves that we need the ▷ in a "Saved Proposition" construction with name-dependent allocation. *) Module savedprop. Section savedprop. Context {PROP : bi} `{!BiAffine PROP}. Implicit Types P : PROP. Context (bupd : PROP → PROP). Notation "|==> Q" := (bupd 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 : ident → PROP), ⊢ (|==> ∃ i, saved i (P 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). Global Instance bupd_mono' : Proper ((⊢) ==> (⊢)) bupd. Proof. intros P Q ?. by apply bupd_mono. Qed. Global 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 : ident) : PROP := ∃ P, □ ¬ P ∗ saved i P. Lemma A_alloc : ⊢ |==> ∃ i, saved i (A i). Proof. by apply sprop_alloc_dep. Qed. Lemma saved_NA i : saved i (A i) ⊢ ¬ A i. Proof. iIntros "#Hs #HA". iPoseProof "HA" as "HA'". iDestruct "HA'" as (P) "[HNP HsP]". iApply "HNP". iDestruct (sprop_agree i P (A i) with "[]") as "#[_ HP]". { eauto. } iApply "HP". done. Qed. Lemma saved_A i : saved i (A i) ⊢ A i. Proof. iIntros "#Hs". iExists (A i). iFrame "Hs". iIntros "!>". by iApply saved_NA. Qed. Lemma contradiction : False. Proof using All. apply consistency. iMod A_alloc as (i) "#H". iPoseProof (saved_NA with "H") as "HN". iApply bupd_intro. iApply "HN". iApply saved_A. done. Qed. End savedprop. End savedprop. (** This proves that we need the ▷ when opening invariants. We have two paradoxes in this section, but they share the general axiomatization of invariants. *) Module inv. Section inv. Context {PROP : bi} `{!BiAffine PROP}. Implicit Types P : PROP. (** Assumptions *) (** We have the update modality (two classes: empty/full mask) *) Inductive mask := M0 | M1. Context (fupd : mask → PROP → PROP). 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. Hypothesis fupd_frame_l : ∀ E P Q, P ∗ fupd E Q ⊢ fupd E (P ∗ Q). Hypothesis fupd_mask_mono : ∀ P, fupd M0 P ⊢ fupd M1 P. (** We have invariants *) Context (name : Type) (inv : name → PROP → PROP). Global 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_fupd : ∀ i P Q R, (P ∗ Q ⊢ fupd M0 (P ∗ R)) → (inv i P ∗ Q ⊢ fupd M1 R). (** We assume that we cannot update to false. *) Hypothesis consistency : ¬ (⊢ fupd M1 False). (** This completes the general assumptions shared by both paradoxes. We set up some general lemmas and proof mode compatibility before proceeding with the paradoxes. *) Lemma inv_fupd' i P R : inv i P ∗ (P -∗ fupd M0 (P ∗ fupd M1 R)) ⊢ fupd M1 R. Proof. iIntros "(#HiP & HP)". iApply fupd_fupd. iApply inv_fupd; last first. { iSplit; first done. iExact "HP". } iIntros "(HP & HPw)". by iApply "HPw". Qed. Global Instance fupd_mono' E : Proper ((⊢) ==> (⊢)) (fupd E). Proof. intros P Q ?. by apply fupd_mono. Qed. Global Instance fupd_proper E : Proper ((⊣⊢) ==> (⊣⊢)) (fupd E). Proof. intros P Q; rewrite !bi.equiv_entails=> -[??]; 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 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 P Q : ElimModal True p false (fupd M0 P) P (fupd M1 Q) (fupd M1 Q). Proof. 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 → PROP) : FromExist P Φ → FromExist (fupd E P) (λ a, fupd E (Φ a)). Proof. rewrite /FromExist=>HP. apply bi.exist_elim=> a. apply fupd_mono. by rewrite -HP -(bi.exist_intro a). Qed. (** The original paradox, as found in the "Iris from the Ground Up" paper. *) Section inv1. (** On top of invariants themselves, we need a particular kind of ghost state: we have tokens for a little "two-state STS": [start] -> [finish]. [start] also asserts the exact state; it is only ever owned by the invariant. [finished] is duplicable. *) (** Posssible implementations of these axioms: - Using the STS monoid of a two-state STS, where [start] is the authoritative saying the state is exactly [start], and [finish] is the "we are at least in state [finish]" typically owned by threads. - Ex () +_## () *) Context (gname : Type). Context (start finished : gname → PROP). Hypothesis sts_alloc : ⊢ fupd M0 (∃ γ, start γ). Hypotheses start_finish : ∀ γ, start γ ⊢ fupd M0 (finished γ). Hypothesis finished_not_start : ∀ γ, start γ ∗ finished γ ⊢ False. Hypothesis finished_dup : ∀ γ, finished γ ⊢ finished γ ∗ finished γ. (** Now to the actual counterexample. We start with a weird form of saved propositions. *) Definition saved (γ : gname) (P : PROP) : PROP := ∃ i, inv i (start γ ∨ (finished γ ∗ □ P)). Global Instance saved_persistent γ P : Persistent (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". { auto. } iApply fupd_intro. by iExists γ, i. Qed. Lemma saved_cast γ P Q : saved γ P ∗ saved γ Q ∗ □ P ⊢ fupd M1 (□ Q). Proof. iIntros "(#HsP & #HsQ & #HP)". iDestruct "HsP" as (i) "HiP". iApply (inv_fupd' i). iSplit; first done. iIntros "HaP". iAssert (fupd M0 (finished γ)) with "[HaP]" as "> Hf". { iDestruct "HaP" as "[Hs | [Hf _]]". - by iApply start_finish. - by iApply fupd_intro. } iDestruct (finished_dup with "Hf") as "[Hf Hf']". iApply fupd_intro. iSplitL "Hf'"; first by eauto. (* Step 2: Open the Q-invariant. *) iClear (i) "HiP ". iDestruct "HsQ" as (i) "HiQ". iApply (inv_fupd' i). iSplit; first done. iIntros "[HaQ | [_ #HQ]]". { iExFalso. iApply finished_not_start. by iFrame. } iApply fupd_intro. iSplitL "Hf". { iRight. by iFrame. } by iApply fupd_intro. Qed. (** And now we tie a bad knot. *) Notation not_fupd P := (□ (P -∗ fupd M1 False))%I. Definition A i : PROP := ∃ P, not_fupd P ∗ saved i P. Global Instance A_persistent i : Persistent (A i) := _. Lemma A_alloc : ⊢ fupd M1 (∃ i, saved i (A i)). Proof. by apply saved_alloc. Qed. Lemma saved_NA i : saved i (A i) ⊢ not_fupd (A i). Proof. iIntros "#Hi !> #HA". iPoseProof "HA" as "HA'". iDestruct "HA'" as (P) "#[HNP Hi']". iMod (saved_cast i (A i) P with "[]") as "HP". { eauto. } by iApply "HNP". Qed. Lemma saved_A i : saved i (A i) ⊢ A i. Proof. iIntros "#Hi". iExists (A i). iFrame "#". by iApply saved_NA. Qed. Lemma contradiction : False. Proof using All. apply consistency. iIntros "". iMod A_alloc as (i) "#H". iPoseProof (saved_NA with "H") as "HN". iApply "HN". iApply saved_A. done. Qed. End inv1. (** This is another proof showing that we need the ▷ when opening invariants. Unlike the two paradoxes above, this proof does not rely on impredicative quantification -- at least, not directly. Instead it exploits the impredicative quantification that is implicit in [fupd]. Unlike the previous paradox, the [finish] token needs to be persistent for this paradox to work. This paradox is due to Yusuke Matsushita. *) Section inv2. (** On top of invariants themselves, we need a particular kind of ghost state: we have tokens for a little "two-state STS": [start] -> [finish]. [start] also asserts the exact state; it is only ever owned by the invariant. [finished] is persistent. *) (** Posssible implementations of these axioms: - Using the STS monoid of a two-state STS, where [start] is the authoritative saying the state is exactly [start], and [finish] is the "we are at least in state [finish]" typically owned by threads. - Ex () +_## () *) Context (gname : Type). Context (start finished : gname → PROP). Hypothesis sts_alloc : ⊢ fupd M0 (∃ γ, start γ). Hypotheses start_finish : ∀ γ, start γ ⊢ fupd M0 (finished γ). Hypothesis finished_not_start : ∀ γ, start γ ∗ finished γ ⊢ False. Hypothesis finished_persistent : ∀ γ, Persistent (finished γ). (** Now to the actual counterexample. *) (** A version of ⊥ behind a persistent update. *) Definition B : PROP := □ fupd M1 False. (** A delayed-initialization invariant storing [B]. *) Definition P (γ : gname) : PROP := start γ ∨ B. Definition I (i : name) (γ : gname) : PROP := inv i (P γ). (** If we can ever finish initializing the invariant, we have a contradiction. *) Lemma finished_contradiction γ i : finished γ ∗ I i γ -∗ B. Proof. iIntros "[#Hfin #HI] !>". iApply (inv_fupd' i). iSplit; first done. iIntros "[Hstart|#Hfalse]". { iDestruct (finished_not_start with "[$Hfin $Hstart]") as %[]. } iApply fupd_intro. iSplitR; last done. by iRight. Qed. (** If we can even just create the invariant, we can finish initializing it using the above lemma, and then get the contradiction. *) Lemma invariant_contradiction γ i : I i γ -∗ B. Proof. iIntros "#HI !>". iApply (inv_fupd' i). iSplit; first done. iIntros "HP". iAssert (fupd M0 B) with "[HP]" as ">#Hfalse". { iDestruct "HP" as "[Hstart|#Hfalse]"; last by iApply fupd_intro. iMod (start_finish with "Hstart"). iApply fupd_intro. (** There's a magic moment here where we have the invariant open, but inside [finished_contradiction] we will be proving a [fupd M1] and so we can open the invariant *again*. Really we are just building up a thunk that can be used later when the invariant is closed again. But to build up that thunk we can use resources that we just got out of the invariant, before closing it again. *) iApply finished_contradiction. eauto. } iApply fupd_intro. iSplitR; last done. by iRight. Qed. (** Of course, creating the invariant is trivial. *) Lemma contradiction' : False. Proof using All. apply consistency. iMod sts_alloc as (γ) "Hstart". iMod (inv_alloc (P γ) with "[Hstart]") as (i) "HI". { by iLeft. } iDestruct (invariant_contradiction with "HI") as "#>[]". Qed. End inv2. End inv. End inv. (** This proves that if we have linear impredicative invariants, we can still drop arbitrary resources (i.e., we can "defeat" linearity). We assume [cinv_alloc] without any bells or whistles. Moreover, we also have an accessor that gives back the invariant token immediately, not just after the invariant got closed again. The assumptions here match the proof rules in Iron, save for the side-condition that the invariant must be "uniform". In particular, [cinv_alloc] delays handing out the [cinv_own] token until after the invariant has been created so that this can match Iron by picking [cinv_own γ := fcinv_own γ 1 ∗ fcinv_cancel_own γ 1]. This means [cinv_own] is not "uniform" in Iron terms, which is why Iron does not suffer from this contradiction. This also loosely matches VST's locks with stored resource invariants. There, the stronger variant of the "unlock" rule (see Aquinas Hobor's PhD thesis "Oracle Semantics", §4.7, p. 88) also permits putting the token of a lock entirely into that lock. *) Module linear. Section linear. Context {PROP: bi}. Implicit Types P : PROP. (** Assumptions. *) (** We have the mask-changing update modality (two classes: empty/full mask) *) Inductive mask := M0 | M1. Context (fupd : mask → mask → PROP → PROP). Hypothesis fupd_intro : ∀ E P, P ⊢ fupd E E P. Hypothesis fupd_mono : ∀ E1 E2 P Q, (P ⊢ Q) → fupd E1 E2 P ⊢ fupd E1 E2 Q. Hypothesis fupd_fupd : ∀ E1 E2 E3 P, fupd E1 E2 (fupd E2 E3 P) ⊢ fupd E1 E3 P. Hypothesis fupd_frame_l : ∀ E1 E2 P Q, P ∗ fupd E1 E2 Q ⊢ fupd E1 E2 (P ∗ Q). (** We have cancelable invariants. (Really they would have fractions at [cinv_own] but we do not need that. They would also have a name matching the [mask] type, but we do not need that either.) *) Context (gname : Type) (cinv : gname → PROP → PROP) (cinv_own : gname → PROP). Hypothesis cinv_alloc : ∀ E P, ▷ P -∗ fupd E E (∃ γ, cinv γ P ∗ cinv_own γ). Hypothesis cinv_acc : ∀ P γ, cinv γ P -∗ cinv_own γ -∗ fupd M1 M0 (▷ P ∗ cinv_own γ ∗ (▷ P -∗ fupd M0 M1 emp)). (** Some general lemmas and proof mode compatibility. *) Global Instance fupd_mono' E1 E2 : Proper ((⊢) ==> (⊢)) (fupd E1 E2). Proof. intros P Q ?. by apply fupd_mono. Qed. Global Instance fupd_proper E1 E2 : Proper ((⊣⊢) ==> (⊣⊢)) (fupd E1 E2). Proof. intros P Q; rewrite !bi.equiv_entails=> -[??]; split; by apply fupd_mono. Qed. Lemma fupd_frame_r E1 E2 P Q : fupd E1 E2 P ∗ Q ⊢ fupd E1 E2 (P ∗ Q). Proof. by rewrite comm fupd_frame_l comm. Qed. Global Instance elim_fupd_fupd p E1 E2 E3 P Q : ElimModal True p false (fupd E1 E2 P) P (fupd E1 E3 Q) (fupd E2 E3 Q). Proof. by rewrite /ElimModal bi.intuitionistically_if_elim fupd_frame_r bi.wand_elim_r fupd_fupd. Qed. (** Counterexample: now we can make any resource disappear. *) Lemma leak P : P -∗ fupd M1 M1 emp. Proof. iIntros "HP". iMod (cinv_alloc _ True with "[//]") as (γ) "[Hinv Htok]". iMod (cinv_acc with "Hinv Htok") as "(Htrue & Htok & Hclose)". iApply "Hclose". done. Qed. End linear. End linear. iris-iris-4.2.0/iris/bi/lib/fixpoint.v000066400000000000000000000355011460620107300175670ustar00rootroot00000000000000From iris.bi Require Export bi. From iris.proofmode Require Import proofmode. From iris.prelude Require Import options. Import bi. (** Least and greatest fixpoint of a monotone function, defined entirely inside the logic. *) Class BiMonoPred {PROP : bi} {A : ofe} (F : (A → PROP) → (A → PROP)) := { bi_mono_pred Φ Ψ : NonExpansive Φ → NonExpansive Ψ → □ (∀ x, Φ x -∗ Ψ x) -∗ ∀ x, F Φ x -∗ F Ψ x; bi_mono_pred_ne Φ : NonExpansive Φ → NonExpansive (F Φ) }. Global Arguments bi_mono_pred {_ _ _ _} _ _. Local Existing Instance bi_mono_pred_ne. Definition bi_least_fixpoint {PROP : bi} {A : ofe} (F : (A → PROP) → (A → PROP)) (x : A) : PROP := tc_opaque (∀ Φ : A -n> PROP, □ (∀ x, F Φ x -∗ Φ x) -∗ Φ x)%I. Global Arguments bi_least_fixpoint : simpl never. Definition bi_greatest_fixpoint {PROP : bi} {A : ofe} (F : (A → PROP) → (A → PROP)) (x : A) : PROP := tc_opaque (∃ Φ : A -n> PROP, □ (∀ x, Φ x -∗ F Φ x) ∗ Φ x)%I. Global Arguments bi_greatest_fixpoint : simpl never. (* Both non-expansiveness lemmas do not seem to be interderivable. FIXME: is there some lemma that subsumes both? *) Lemma least_fixpoint_ne' {PROP : bi} {A : ofe} (F : (A → PROP) → (A → PROP)): (∀ Φ, NonExpansive Φ → NonExpansive (F Φ)) → NonExpansive (bi_least_fixpoint F). Proof. solve_proper. Qed. Global Instance least_fixpoint_ne {PROP : bi} {A : ofe} n : Proper (pointwise_relation (A → PROP) (pointwise_relation A (dist n)) ==> dist n ==> dist n) bi_least_fixpoint. Proof. solve_proper. Qed. Global Instance least_fixpoint_proper {PROP : bi} {A : ofe} : Proper (pointwise_relation (A → PROP) (pointwise_relation A (≡)) ==> (≡) ==> (≡)) bi_least_fixpoint. Proof. solve_proper. Qed. Section least. Context {PROP : bi} {A : ofe} (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 using Type*. rewrite /bi_least_fixpoint /=. iIntros "HF" (Φ) "#Hincl". iApply "Hincl". iApply (bi_mono_pred _ Φ with "[#] HF"); [solve_proper|]. 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 using Type*. iIntros "HF". iApply ("HF" $! (OfeMor (F (bi_least_fixpoint F))) with "[#]"). iIntros "!>" (y) "Hy /=". iApply (bi_mono_pred with "[#] Hy"). 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 using Type*. apply (anti_symm _); auto using least_fixpoint_unfold_1, least_fixpoint_unfold_2. Qed. (** The basic induction principle for least fixpoints: as inductive hypothesis, it allows to assume the statement to prove below exactly one application of [F]. *) Lemma least_fixpoint_iter (Φ : A → PROP) `{!NonExpansive Φ} : □ (∀ y, F Φ y -∗ Φ y) -∗ ∀ x, bi_least_fixpoint F x -∗ Φ x. Proof. iIntros "#HΦ" (x) "HF". by iApply ("HF" $! (OfeMor Φ) with "[#]"). Qed. Lemma least_fixpoint_affine : (∀ x, Affine (F (λ _, emp%I) x)) → ∀ x, Affine (bi_least_fixpoint F x). Proof. intros ?. rewrite /Affine. iApply least_fixpoint_iter. by iIntros "!> %y HF". Qed. Lemma least_fixpoint_absorbing : (∀ Φ, (∀ x, Absorbing (Φ x)) → (∀ x, Absorbing (F Φ x))) → ∀ x, Absorbing (bi_least_fixpoint F x). Proof using Type*. intros ? x. rewrite /Absorbing /bi_absorbingly. apply wand_elim_r'. revert x. iApply least_fixpoint_iter; first solve_proper. iIntros "!> %y HF Htrue". iApply least_fixpoint_unfold. iAssert (F (λ x : A, True -∗ bi_least_fixpoint F x) y)%I with "[-]" as "HF". { by iClear "Htrue". } iApply (bi_mono_pred with "[] HF"); first solve_proper. iIntros "!> %x HF". by iApply "HF". Qed. Lemma least_fixpoint_persistent_affine : (∀ Φ, (∀ x, Affine (Φ x)) → (∀ x, Affine (F Φ x))) → (∀ Φ, (∀ x, Persistent (Φ x)) → (∀ x, Persistent (F Φ x))) → ∀ x, Persistent (bi_least_fixpoint F x). Proof using Type*. intros ?? x. rewrite /Persistent -intuitionistically_into_persistently_1. revert x. iApply least_fixpoint_iter; first solve_proper. iIntros "!> %y #HF !>". iApply least_fixpoint_unfold. iApply (bi_mono_pred with "[] HF"); first solve_proper. by iIntros "!> %x #?". Qed. Lemma least_fixpoint_persistent_absorbing : (∀ Φ, (∀ x, Absorbing (Φ x)) → (∀ x, Absorbing (F Φ x))) → (∀ Φ, (∀ x, Persistent (Φ x)) → (∀ x, Persistent (F Φ x))) → ∀ x, Persistent (bi_least_fixpoint F x). Proof using Type*. intros ??. pose proof (least_fixpoint_absorbing _). unfold Persistent. iApply least_fixpoint_iter; first solve_proper. iIntros "!> %y #HF !>". rewrite least_fixpoint_unfold. iApply (bi_mono_pred with "[] HF"); first solve_proper. by iIntros "!> %x #?". Qed. End least. Lemma least_fixpoint_strong_mono {PROP : bi} {A : ofe} (F : (A → PROP) → (A → PROP)) `{!BiMonoPred F} (G : (A → PROP) → (A → PROP)) `{!BiMonoPred G} : □ (∀ Φ x, F Φ x -∗ G Φ x) -∗ ∀ x, bi_least_fixpoint F x -∗ bi_least_fixpoint G x. Proof. iIntros "#Hmon". iApply least_fixpoint_iter. iIntros "!>" (y) "IH". iApply least_fixpoint_unfold. by iApply "Hmon". Qed. (** In addition to [least_fixpoint_iter], we provide two derived, stronger induction principles: - [least_fixpoint_ind] allows to assume [F (λ x, Φ x ∧ bi_least_fixpoint F x) y] when proving the inductive step. Intuitively, it does not only offer the induction hypothesis ([Φ] under an application of [F]), but also the induction predicate [bi_least_fixpoint F] itself (under an application of [F]). - [least_fixpoint_ind_wf] intuitively corresponds to a kind of well-founded induction. It provides the hypothesis [F (bi_least_fixpoint (λ Ψ a, Φ a ∧ F Ψ a)) y] and thus allows to assume the induction hypothesis not just below one application of [F], but below any positive number (by unfolding the least fixpoint). The unfolding lemma [least_fixpoint_unfold] as well as [least_fixpoint_strong_mono] can be useful to work with the hypothesis. *) Section least_ind. Context {PROP : bi} {A : ofe} (F : (A → PROP) → (A → PROP)) `{!BiMonoPred F}. Local Lemma Private_wf_pred_mono `{!NonExpansive Φ} : BiMonoPred (λ (Ψ : A → PROP) (a : A), Φ a ∧ F Ψ a)%I. Proof using Type*. split; last solve_proper. intros Ψ Ψ' Hne Hne'. iIntros "#Mon" (x) "Ha". iSplit; first by iDestruct "Ha" as "[$ _]". iDestruct "Ha" as "[_ Hr]". iApply (bi_mono_pred with "[] Hr"). by iModIntro. Qed. Local Existing Instance Private_wf_pred_mono. Lemma least_fixpoint_ind_wf (Φ : A → PROP) `{!NonExpansive Φ} : □ (∀ y, F (bi_least_fixpoint (λ Ψ a, Φ a ∧ F Ψ a)) y -∗ Φ y) -∗ ∀ x, bi_least_fixpoint F x -∗ Φ x. Proof using Type*. iIntros "#Hmon" (x). rewrite least_fixpoint_unfold. iIntros "Hx". iApply "Hmon". iApply (bi_mono_pred with "[] Hx"). iModIntro. iApply least_fixpoint_iter. iIntros "!> %y Hy". rewrite least_fixpoint_unfold. iSplit; last done. by iApply "Hmon". Qed. Lemma least_fixpoint_ind (Φ : A → PROP) `{!NonExpansive Φ} : □ (∀ y, F (λ x, Φ x ∧ bi_least_fixpoint F x) y -∗ Φ y) -∗ ∀ x, bi_least_fixpoint F x -∗ Φ x. Proof using Type*. iIntros "#Hmon". iApply least_fixpoint_ind_wf. iIntros "!> %y Hy". iApply "Hmon". iApply (bi_mono_pred with "[] Hy"). { solve_proper. } iIntros "!> %x Hx". iSplit. - rewrite least_fixpoint_unfold. iDestruct "Hx" as "[$ _]". - iApply (least_fixpoint_strong_mono with "[] Hx"). iIntros "!>" (??) "[_ $]". Qed. End least_ind. Lemma greatest_fixpoint_ne_outer {PROP : bi} {A : ofe} (F1 : (A → PROP) → (A → PROP)) (F2 : (A → PROP) → (A → PROP)): (∀ Φ x n, F1 Φ x ≡{n}≡ F2 Φ x) → ∀ x1 x2 n, x1 ≡{n}≡ x2 → bi_greatest_fixpoint F1 x1 ≡{n}≡ bi_greatest_fixpoint F2 x2. Proof. intros HF x1 x2 n Hx. rewrite /bi_greatest_fixpoint /=. do 3 f_equiv; last solve_proper. repeat f_equiv. apply HF. Qed. (* Both non-expansiveness lemmas do not seem to be interderivable. FIXME: is there some lemma that subsumes both? *) Lemma greatest_fixpoint_ne' {PROP : bi} {A : ofe} (F : (A → PROP) → (A → PROP)): (∀ Φ, NonExpansive Φ → NonExpansive (F Φ)) → NonExpansive (bi_greatest_fixpoint F). Proof. solve_proper. Qed. Global Instance greatest_fixpoint_ne {PROP : bi} {A : ofe} n : Proper (pointwise_relation (A → PROP) (pointwise_relation A (dist n)) ==> dist n ==> dist n) bi_greatest_fixpoint. Proof. solve_proper. Qed. Global Instance greatest_fixpoint_proper {PROP : bi} {A : ofe} : Proper (pointwise_relation (A → PROP) (pointwise_relation A (≡)) ==> (≡) ==> (≡)) bi_greatest_fixpoint. Proof. solve_proper. Qed. Section greatest. Context {PROP : bi} {A : ofe} (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 using Type*. 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 using Type*. iIntros "HF". iExists (OfeMor (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 using Type*. apply (anti_symm _); auto using greatest_fixpoint_unfold_1, greatest_fixpoint_unfold_2. Qed. (** The following lemma provides basic coinduction capabilities, by requiring to reestablish the coinduction hypothesis after exactly one step. *) Lemma greatest_fixpoint_coiter (Φ : A → PROP) `{!NonExpansive Φ} : □ (∀ y, Φ y -∗ F Φ y) -∗ ∀ x, Φ x -∗ bi_greatest_fixpoint F x. Proof. iIntros "#HΦ" (x) "Hx". iExists (OfeMor Φ). auto. Qed. Lemma greatest_fixpoint_absorbing : (∀ Φ, (∀ x, Absorbing (Φ x)) → (∀ x, Absorbing (F Φ x))) → ∀ x, Absorbing (bi_greatest_fixpoint F x). Proof using Type*. intros ?. rewrite /Absorbing. iApply greatest_fixpoint_coiter; first solve_proper. iIntros "!> %y >HF". iDestruct (greatest_fixpoint_unfold with "HF") as "HF". iApply (bi_mono_pred with "[] HF"); first solve_proper. by iIntros "!> %x HF !>". Qed. End greatest. Lemma greatest_fixpoint_strong_mono {PROP : bi} {A : ofe} (F : (A → PROP) → (A → PROP)) `{!BiMonoPred F} (G : (A → PROP) → (A → PROP)) `{!BiMonoPred G} : □ (∀ Φ x, F Φ x -∗ G Φ x) -∗ ∀ x, bi_greatest_fixpoint F x -∗ bi_greatest_fixpoint G x. Proof using Type*. iIntros "#Hmon". iApply greatest_fixpoint_coiter. iIntros "!>" (y) "IH". rewrite greatest_fixpoint_unfold. by iApply "Hmon". Qed. (** In addition to [greatest_fixpoint_coiter], we provide two derived, stronger coinduction principles: - [greatest_fixpoint_coind] requires to prove [F (λ x, Φ x ∨ bi_greatest_fixpoint F x) y] in the coinductive step instead of [F Φ y] and thus instead allows to prove the original fixpoint again, after taking one step. - [greatest_fixpoint_paco] allows for so-called parameterized coinduction, a stronger coinduction principle, where [F (bi_greatest_fixpoint (λ Ψ a, Φ a ∨ F Ψ a)) y] needs to be established in the coinductive step. It allows to prove the hypothesis [Φ] not just after one step, but after any positive number of unfoldings of the greatest fixpoint. This encodes a way of accumulating "knowledge" in the coinduction hypothesis: if you return to the "initial point" [Φ] of the coinduction after some number of unfoldings (not just one), the proof is done. (Interestingly, this is the dual to [least_fixpoint_ind_wf]). The unfolding lemma [greatest_fixpoint_unfold] and [greatest_fixpoint_strong_mono] may be useful when using this lemma. *Example use case:* Suppose that [F] defines a coinductive simulation relation, e.g., [F rec '(e_t, e_s) := (is_val e_s ∧ is_val e_t ∧ post e_t e_s) ∨ (safe e_t ∧ ∀ e_t', step e_t e_t' → ∃ e_s', step e_s e_s' ∧ rec e_t' e_s')], and [sim e_t e_s := bi_greatest_fixpoint F]. Suppose you want to show a simulation of two loops, [sim (while ...) (while ...)], i.e., [Φ '(e_t, e_s) := e_t = while ... ∧ e_s = while ...]. Then the standard coinduction principle [greatest_fixpoint_iter] requires to establish the coinduction hypothesis [Φ] after precisely one unfolding of [sim], which is clearly not strong enough if the loop takes multiple steps of computation per iteration. But [greatest_fixpoint_paco] allows to establish a fixpoint to which [Φ] has been added as a disjunct. This fixpoint can be unfolded arbitrarily many times, allowing to establish the coinduction hypothesis after any number of steps. This enables to take multiple simulation steps, before closing the coinduction by establishing the hypothesis [Φ] again. *) Section greatest_coind. Context {PROP : bi} {A : ofe} (F : (A → PROP) → (A → PROP)) `{!BiMonoPred F}. Local Lemma Private_paco_mono `{!NonExpansive Φ} : BiMonoPred (λ (Ψ : A → PROP) (a : A), Φ a ∨ F Ψ a)%I. Proof using Type*. split; last solve_proper. intros Ψ Ψ' Hne Hne'. iIntros "#Mon" (x) "[H1|H2]"; first by iLeft. iRight. iApply (bi_mono_pred with "[] H2"). by iModIntro. Qed. Local Existing Instance Private_paco_mono. Lemma greatest_fixpoint_paco (Φ : A → PROP) `{!NonExpansive Φ} : □ (∀ y, Φ y -∗ F (bi_greatest_fixpoint (λ Ψ a, Φ a ∨ F Ψ a)) y) -∗ ∀ x, Φ x -∗ bi_greatest_fixpoint F x. Proof using Type*. iIntros "#Hmon" (x) "HΦ". iDestruct ("Hmon" with "HΦ") as "HF". rewrite greatest_fixpoint_unfold. iApply (bi_mono_pred with "[] HF"). iIntros "!>" (y) "HG". iApply (greatest_fixpoint_coiter with "[] HG"). iIntros "!>" (z) "Hf". rewrite greatest_fixpoint_unfold. iDestruct "Hf" as "[HΦ|$]". by iApply "Hmon". Qed. Lemma greatest_fixpoint_coind (Φ : A → PROP) `{!NonExpansive Φ} : □ (∀ y, Φ y -∗ F (λ x, Φ x ∨ bi_greatest_fixpoint F x) y) -∗ ∀ x, Φ x -∗ bi_greatest_fixpoint F x. Proof using Type*. iIntros "#Ha". iApply greatest_fixpoint_paco. iModIntro. iIntros (y) "Hy". iSpecialize ("Ha" with "Hy"). iApply (bi_mono_pred with "[] Ha"). { solve_proper. } iIntros "!> %x [Hphi | Hgfp]". - iApply greatest_fixpoint_unfold. eauto. - iApply (greatest_fixpoint_strong_mono with "[] Hgfp"); eauto. Qed. End greatest_coind. iris-iris-4.2.0/iris/bi/lib/fractional.v000066400000000000000000000265161460620107300200570ustar00rootroot00000000000000From iris.bi Require Export bi. From iris.proofmode Require Import classes classes_make proofmode. From iris.prelude Require Import options. Class Fractional {PROP : bi} (Φ : Qp → PROP) := fractional p q : Φ (p + q)%Qp ⊣⊢ Φ p ∗ Φ q. Global Arguments Fractional {_} _%I : simpl never. Global Arguments fractional {_ _ _} _ _. (** The [AsFractional] typeclass eta-expands a proposition [P] into [Φ q] such that [Φ] is a fractional predicate. This is needed because higher-order unification cannot be relied upon to guess the right [Φ]. [AsFractional] should generally be used in APIs that work with fractional predicates (instead of [Fractional]): when the user provides the original resource [P], have a premise [AsFractional P Φ 1] to convert that into some fractional predicate. The equivalence in [as_fractional] should hold definitionally; various typeclass instances assume that [Φ q] will un-do the eta-expansion performed by [AsFractional]. *) Class AsFractional {PROP : bi} (P : PROP) (Φ : Qp → PROP) (q : Qp) := { as_fractional : P ⊣⊢ Φ q; as_fractional_fractional : Fractional Φ }. Global Arguments AsFractional {_} _%I _%I _%Qp. Global Hint Mode AsFractional - ! - - : typeclass_instances. (** The class [FrameFractionalQp] is used for fractional framing, it substracts the fractional of the hypothesis from the goal: it computes [r := qP - qR]. See [frame_fractional] for how it is used. *) Class FrameFractionalQp (qR qP r : Qp) := frame_fractional_qp : qP = (qR + r)%Qp. Global Hint Mode FrameFractionalQp ! ! - : typeclass_instances. Section fractional. Context {PROP : bi}. Implicit Types P Q : PROP. Implicit Types Φ : Qp → PROP. Implicit Types q : Qp. Global Instance Fractional_proper : Proper (pointwise_relation _ (≡) ==> iff) (@Fractional PROP). Proof. rewrite /Fractional. intros Φ1 Φ2 Hequiv. by setoid_rewrite Hequiv. Qed. (* Every [Fractional] predicate admits an obvious [AsFractional] instance. Ideally, this instance would mean that a user never has to define a manual [AsFractional] instance for a [Fractional] predicate (even if it's of the form [λ q, Φ a1 ‥ q ‥ an] for some n-ary predicate [Φ].) However, Coq's lack of guarantees for higher-order unification mean this instance wouldn't guarantee to apply for every [AsFractional] goal. Therefore, this instance is not global to avoid conflicts with existing instances defined by our users, since we can't ask users to universally delete their manually-defined [AsFractional] instances for their own [Fractional] predicates. (We could just support this instance for predicates with the fractional argument in the final position, but that was felt to be a bit of a foot-gun - users would have to remember to *not* define an [AsFractional] some of the time.) *) Local Instance fractional_as_fractional Φ q : Fractional Φ → AsFractional (Φ q) Φ q. Proof. done. Qed. (** This lemma is meant to be used when [P] is known. But really you should be using [iDestruct "H" as "[H1 H2]"], which supports splitting at fractions. *) Lemma fractional_split P Φ q1 q2 : AsFractional P Φ (q1 + q2) → P ⊣⊢ Φ q1 ∗ Φ q2. Proof. by move=>-[-> ->]. Qed. (** This lemma is meant to be used when [P] is known. But really you should be using [iDestruct "H" as "[H1 H2]"], which supports halving fractions. *) Lemma fractional_half P Φ q : AsFractional P Φ q → P ⊣⊢ Φ (q/2)%Qp ∗ Φ (q/2)%Qp. Proof. by rewrite -{1}(Qp.div_2 q)=>-[->->]. Qed. (** This lemma is meant to be used when [P1], [P2] are known. But really you should be using [iCombine "H1 H2" as "H"] (for forwards reasoning) or [iSplitL]/[iSplitR] (for goal-oriented reasoning), which support merging fractions. *) Lemma fractional_merge P1 P2 Φ q1 q2 `{!Fractional Φ} : AsFractional P1 Φ q1 → AsFractional P2 Φ q2 → P1 ∗ P2 ⊣⊢ Φ (q1 + q2)%Qp. Proof. move=>-[-> _] [-> _]. rewrite fractional //. Qed. (** Fractional and logical connectives *) Global Instance persistent_fractional (P : PROP) : Persistent P → TCOr (Affine P) (Absorbing P) → Fractional (λ _, P). Proof. intros ?? q q'. apply: bi.persistent_sep_dup. Qed. (** We do not have [AsFractional] instances for [∗] and the big operators because the [iDestruct] tactic already turns [P ∗ Q] into [P] and [Q], [[∗ list] k↦x ∈ y :: l, Φ k x] into [Φ 0 i] and [[∗ list] k↦x ∈ l, Φ (S k) x], etc. Hence, an [AsFractional] instance would cause ambiguity because for example [l ↦{1} v ∗ l' ↦{1} v'] could be turned into [l ↦{1} v] and [l' ↦{1} v'], or into two times [l ↦{1/2} v ∗ l' ↦{1/2} v']. We do provide the [Fractional] instances so that when one defines a derived connection in terms of [∗] or a big operator (and makes that opaque in some way), one could choose to split along the [∗] or along the fraction. *) Global Instance fractional_sep Φ Ψ : Fractional Φ → Fractional Ψ → Fractional (λ q, Φ q ∗ Ψ q)%I. Proof. intros ?? q q'. rewrite !fractional -!assoc. f_equiv. rewrite !assoc. f_equiv. by rewrite comm. Qed. Global Instance fractional_embed `{!BiEmbed PROP PROP'} Φ : Fractional Φ → Fractional (λ q, ⎡ Φ q ⎤ : PROP')%I. Proof. intros ???. by rewrite fractional embed_sep. Qed. Global Instance as_fractional_embed `{!BiEmbed PROP PROP'} P Φ q : AsFractional P Φ q → AsFractional (⎡ P ⎤) (λ q, ⎡ Φ q ⎤)%I q. Proof. intros [??]; split; [by f_equiv|apply _]. Qed. Global Instance fractional_big_sepL {A} (l : list A) Ψ : (∀ k x, Fractional (Ψ k x)) → Fractional (PROP:=PROP) (λ q, [∗ list] k↦x ∈ l, Ψ k x q)%I. Proof. intros ? q q'. rewrite -big_sepL_sep. by setoid_rewrite fractional. Qed. Global Instance fractional_big_sepL2 {A B} (l1 : list A) (l2 : list B) Ψ : (∀ k x1 x2, Fractional (Ψ k x1 x2)) → Fractional (PROP:=PROP) (λ q, [∗ list] k↦x1; x2 ∈ l1; l2, Ψ k x1 x2 q)%I. Proof. intros ? q q'. rewrite -big_sepL2_sep. by setoid_rewrite fractional. Qed. Global Instance fractional_big_sepM `{Countable K} {A} (m : gmap K A) Ψ : (∀ k x, Fractional (Ψ k x)) → Fractional (PROP:=PROP) (λ q, [∗ map] k↦x ∈ m, Ψ k x q)%I. Proof. intros ? q q'. rewrite -big_sepM_sep. by setoid_rewrite fractional. Qed. Global Instance fractional_big_sepS `{Countable A} (X : gset A) Ψ : (∀ x, Fractional (Ψ x)) → Fractional (PROP:=PROP) (λ q, [∗ set] x ∈ X, Ψ x q)%I. Proof. intros ? q q'. rewrite -big_sepS_sep. by setoid_rewrite fractional. Qed. Global Instance fractional_big_sepMS `{Countable A} (X : gmultiset A) Ψ : (∀ x, Fractional (Ψ x)) → Fractional (PROP:=PROP) (λ q, [∗ mset] x ∈ X, Ψ x q)%I. Proof. intros ? q q'. rewrite -big_sepMS_sep. by setoid_rewrite fractional. Qed. (** Proof mode instances *) Global Instance from_sep_fractional P Φ q1 q2 : AsFractional P Φ (q1 + q2) → FromSep P (Φ q1) (Φ q2). Proof. rewrite /FromSep=>-[-> ->] //. Qed. Global Instance combine_sep_as_fractional P1 P2 Φ q1 q2 : AsFractional P1 Φ q1 → AsFractional P2 Φ q2 → CombineSepAs P1 P2 (Φ (q1 + q2)%Qp) | 50. (* Explicit cost, to make it easier to provide instances with higher or lower cost. Higher-cost instances exist to combine (for example) [l ↦{q1} v1] with [l ↦{q2} v2] where [v1] and [v2] are not unifiable. *) Proof. rewrite /CombineSepAs =>-[-> _] [-> <-] //. Qed. Global Instance from_sep_fractional_half P Φ q : AsFractional P Φ q → FromSep P (Φ (q / 2)%Qp) (Φ (q / 2)%Qp) | 10. Proof. rewrite /FromSep -{1}(Qp.div_2 q). intros [-> <-]. rewrite Qp.div_2 //. Qed. Global Instance combine_sep_as_fractional_half P Φ q : AsFractional P Φ (q/2) → CombineSepAs P P (Φ q) | 50. (* Explicit cost, to make it easier to provide instances with higher or lower cost. Higher-cost instances exist to combine (for example) [l ↦{q1} v1] with [l ↦{q2} v2] where [v1] and [v2] are not unifiable. *) Proof. rewrite /CombineSepAs=>-[-> <-]. by rewrite Qp.div_2. Qed. Global Instance into_sep_fractional P Φ q1 q2 : AsFractional P Φ (q1 + q2) → IntoSep P (Φ q1) (Φ q2). Proof. intros [??]. rewrite /IntoSep [P]fractional_split //. Qed. Global Instance into_sep_fractional_half P Φ q : AsFractional P Φ q → IntoSep P (Φ (q / 2)%Qp) (Φ (q / 2)%Qp) | 100. Proof. intros [??]. rewrite /IntoSep [P]fractional_half //. Qed. Global Instance frame_fractional_qp_add_l q q' : FrameFractionalQp q (q + q') q'. Proof. by rewrite /FrameFractionalQp. Qed. Global Instance frame_fractional_qp_add_r q q' : FrameFractionalQp q' (q + q') q. Proof. by rewrite /FrameFractionalQp Qp.add_comm. Qed. Global Instance frame_fractional_qp_half q : FrameFractionalQp (q/2) q (q/2). Proof. by rewrite /FrameFractionalQp Qp.div_2. Qed. (* Not an instance because of performance; you can locally add it if you are willing to pay the cost. We have concrete instances for certain fractional assertions such as ↦. Coq is sometimes unable to infer the [Φ], hence it might be useful to write [apply: (frame_fractional (λ q, ...))] when using the lemma to prove your custom instance. See also https://github.com/coq/coq/issues/17688 *) Lemma frame_fractional Φ p R P qR qP r : AsFractional R Φ qR → AsFractional P Φ qP → FrameFractionalQp qR qP r → Frame p R P (Φ r). Proof. rewrite /Frame /FrameFractionalQp=> -[-> _] [-> ?] ->. by rewrite bi.intuitionistically_if_elim fractional. Qed. End fractional. (** Marked [tc_opaque] instead [Typeclasses Opaque] so that you can use [iDestruct] to eliminate and [iModIntro] to introduce [internal_fractional], while still preventing [iFrame] and [iNext] from unfolding. *) Definition internal_fractional {PROP : bi} (Φ : Qp → PROP) : PROP := tc_opaque (□ ∀ p q, Φ (p + q)%Qp ∗-∗ Φ p ∗ Φ q)%I. Global Instance: Params (@internal_fractional) 1 := {}. Section internal_fractional. Context {PROP : bi}. Implicit Types Φ Ψ : Qp → PROP. Implicit Types q : Qp. Global Instance internal_fractional_ne n : Proper (pointwise_relation _ (dist n) ==> dist n) (@internal_fractional PROP). Proof. solve_proper. Qed. Global Instance internal_fractional_proper : Proper (pointwise_relation _ (≡) ==> (≡)) (@internal_fractional PROP). Proof. solve_proper. Qed. Global Instance internal_fractional_affine Φ : Affine (internal_fractional Φ). Proof. rewrite /internal_fractional /=. apply _. Qed. Global Instance internal_fractional_persistent Φ : Persistent (internal_fractional Φ). Proof. rewrite /internal_fractional /=. apply _. Qed. Lemma fractional_internal_fractional Φ : Fractional Φ → ⊢ internal_fractional Φ. Proof. intros. iIntros "!>" (q1 q2). rewrite [Φ (q1 + q2)%Qp]fractional //=; auto. Qed. Lemma internal_fractional_iff Φ Ψ: □ (∀ q, Φ q ∗-∗ Ψ q) ⊢ internal_fractional Φ -∗ internal_fractional Ψ. Proof. iIntros "#Hiff #HΦdup !>" (p q). iSplit. - iIntros "H". iDestruct ("Hiff" with "H") as "HΦ". iDestruct ("HΦdup" with "HΦ") as "[H1 ?]". iSplitL "H1"; iApply "Hiff"; iFrame. - iIntros "[H1 H2]". iDestruct ("Hiff" with "H1") as "HΦ1". iDestruct ("Hiff" with "H2") as "HΦ2". iApply "Hiff". iApply "HΦdup". iFrame. Qed. End internal_fractional. iris-iris-4.2.0/iris/bi/lib/laterable.v000066400000000000000000000221351460620107300176610ustar00rootroot00000000000000From iris.bi Require Export bi. From iris.proofmode Require Import proofmode. From iris.prelude Require Import options. (** The class of laterable assertions *) Class Laterable {PROP : bi} (P : PROP) := laterable : P ⊢ ∃ Q, ▷ Q ∗ □ (▷ Q -∗ ◇ P). Global Arguments Laterable {_} _%I : simpl never. Global Arguments laterable {_} _%I {_}. Global Hint Mode Laterable + ! : typeclass_instances. (** Proofmode class for turning [P] into a laterable [Q]. Will be the identity if [P] already is laterable, and add [▷] otherwise. *) Class IntoLaterable {PROP : bi} (P Q : PROP) : Prop := { (** This is non-standard; usually we would just demand [P ⊢ make_laterable Q]. However, we need these stronger properties for the [make_laterable_id] hack in [atomic.v]. *) into_laterable : P ⊢ Q; into_laterable_result_laterable : Laterable Q; }. Global Arguments IntoLaterable {_} P%I Q%I. Global Arguments into_laterable {_} P%I Q%I {_}. Global Arguments into_laterable_result_laterable {_} P%I Q%I {_}. Global Hint Mode IntoLaterable + ! - : typeclass_instances. Section instances. Context {PROP : bi}. Implicit Types P : PROP. Implicit Types Ps : list PROP. Global Instance laterable_proper : Proper ((⊣⊢) ==> (↔)) (@Laterable PROP). Proof. solve_proper. Qed. 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. (** This instance, together with the one below, can lead to massive backtracking, but only when searching for [Laterable]. In the future, it should be rewritten using [Hint Immediate] or [Hint Cut], where the latter is preferred once we figure out how to use it. *) Global Instance persistent_laterable `{!BiAffine PROP} P : Persistent P → Laterable P. Proof. intros ?. apply intuitionistic_laterable; apply _. 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 exist_laterable {A} (Φ : A → PROP) : (∀ x, Laterable (Φ x)) → Laterable (∃ x, Φ x). Proof. rewrite /Laterable. iIntros (LΦ). iDestruct 1 as (x) "H". iDestruct (LΦ with "H") as (Q) "[HQ #HΦ]". iExists Q. iIntros "{$HQ} !> HQ". iExists x. by iApply "HΦ". Qed. Lemma big_sep_sepL_laterable Q Ps : Laterable Q → TCForall Laterable Ps → Laterable (Q ∗ [∗] Ps). Proof. intros HQ HPs. revert Q HQ. induction HPs as [|P Ps ?? IH]; intros Q HQ. { simpl. rewrite right_id. done. } simpl. rewrite assoc. apply IH; by apply _. Qed. Global Instance big_sepL_laterable Ps : Laterable (PROP:=PROP) emp → TCForall Laterable Ps → Laterable ([∗] Ps). Proof. intros. assert (Laterable (emp ∗ [∗] Ps)) as Hlater. { apply big_sep_sepL_laterable; done. } rewrite ->left_id in Hlater; last by apply _. done. Qed. (** A wrapper to obtain a weaker, laterable form of any assertion. Alternatively: the modality corresponding to [Laterable]. The ◇ is required to make [make_laterable_intro'] hold. TODO: Define [Laterable] in terms of this (see [laterable_alt] below). *) Definition make_laterable (Q : PROP) : PROP := ∃ P, ▷ P ∗ □ (▷ P -∗ ◇ Q). Global Instance make_laterable_ne : NonExpansive make_laterable. Proof. solve_proper. Qed. Global Instance make_laterable_proper : Proper ((≡) ==> (≡)) make_laterable := ne_proper _. Global Instance make_laterable_mono' : Proper ((⊢) ==> (⊢)) make_laterable. Proof. solve_proper. Qed. Global Instance make_laterable_flip_mono' : Proper (flip (⊢) ==> flip (⊢)) make_laterable. Proof. solve_proper. Qed. Lemma make_laterable_mono Q1 Q2 : (Q1 ⊢ Q2) → (make_laterable Q1 ⊢ make_laterable Q2). Proof. by intros ->. Qed. Lemma make_laterable_except_0 Q : make_laterable (◇ Q) ⊢ make_laterable Q. Proof. iIntros "(%P & HP & #HPQ)". iExists P. iFrame. iIntros "!# HP". iMod ("HPQ" with "HP"). done. Qed. Lemma make_laterable_sep Q1 Q2 : make_laterable Q1 ∗ make_laterable Q2 ⊢ make_laterable (Q1 ∗ Q2). Proof. iIntros "[HQ1 HQ2]". iDestruct "HQ1" as (P1) "[HP1 #HQ1]". iDestruct "HQ2" as (P2) "[HP2 #HQ2]". iExists (P1 ∗ P2)%I. iFrame. iIntros "!# [HP1 HP2]". iDestruct ("HQ1" with "HP1") as ">$". iDestruct ("HQ2" with "HP2") as ">$". done. Qed. (** A stronger version of [make_laterable_mono] that lets us keep laterable resources. We cannot keep arbitrary resources since that would let us "frame in" non-laterable things. *) Lemma make_laterable_wand Q1 Q2 : make_laterable (Q1 -∗ Q2) ⊢ (make_laterable Q1 -∗ make_laterable Q2). Proof. iIntros "HQ HQ1". iDestruct (make_laterable_sep with "[$HQ $HQ1 //]") as "HQ". iApply make_laterable_mono; last done. by rewrite bi.wand_elim_l. Qed. (** A variant of the above for keeping arbitrary intuitionistic resources. Sadly, this is not implied by the above for non-affine BIs. *) Lemma make_laterable_intuitionistic_wand Q1 Q2 : □ (Q1 -∗ Q2) ⊢ (make_laterable Q1 -∗ make_laterable Q2). Proof. iIntros "#HQ HQ1". iDestruct "HQ1" as (P) "[HP #HQ1]". iExists P. iFrame. iIntros "!> HP". iDestruct ("HQ1" with "HP") as "{HQ1} >HQ1". iModIntro. iApply "HQ". done. Qed. Global Instance make_laterable_laterable Q : Laterable (make_laterable Q). Proof. rewrite /Laterable. iIntros "HQ". iDestruct "HQ" as (P) "[HP #HQ]". iExists P. iFrame. iIntros "!> HP !>". iExists P. by iFrame. Qed. Lemma make_laterable_elim Q : make_laterable Q ⊢ ◇ Q. Proof. iIntros "HQ". iDestruct "HQ" as (P) "[HP #HQ]". by iApply "HQ". Qed. (** Written internally (as an entailment of wands) to reflect that persistent assertions can be kept unchanged. *) Lemma make_laterable_intro P Q : Laterable P → □ (P -∗ Q) -∗ P -∗ make_laterable Q. Proof. iIntros (?) "#HQ HP". iDestruct (laterable with "HP") as (P') "[HP' #HPi]". iExists P'. iFrame. iIntros "!> HP'". iDestruct ("HPi" with "HP'") as ">HP". iModIntro. iApply "HQ". done. Qed. Lemma make_laterable_intro' Q : Laterable Q → Q ⊢ make_laterable Q. Proof. intros ?. iApply make_laterable_intro. iIntros "!# $". Qed. Lemma make_laterable_idemp Q : make_laterable (make_laterable Q) ⊣⊢ make_laterable Q. Proof. apply (anti_symm (⊢)). - trans (make_laterable (◇ Q)). + apply make_laterable_mono, make_laterable_elim. + apply make_laterable_except_0. - apply make_laterable_intro', _. Qed. Lemma laterable_alt Q : Laterable Q ↔ (Q ⊢ make_laterable Q). Proof. split. - intros ?. apply make_laterable_intro'. done. - intros ?. done. Qed. (** * Proofmode integration We integrate [make_laterable] with [iModIntro]. All non-laterable hypotheses have a ▷ added in front of them to ensure a laterable context. *) Global Instance into_laterable_laterable P : Laterable P → IntoLaterable P P. Proof. intros ?. constructor; done. Qed. Global Instance into_laterable_fallback P : IntoLaterable P (▷ P) | 100. Proof. constructor; last by apply _. apply bi.later_intro. Qed. Lemma modality_make_laterable_mixin `{!Timeless (PROP:=PROP) emp} : modality_mixin make_laterable MIEnvId (MIEnvTransform IntoLaterable). Proof. split; simpl; eauto using make_laterable_intro', make_laterable_mono, make_laterable_sep, intuitionistic_laterable with typeclass_instances; []. intros P Q ?. rewrite (into_laterable P). apply make_laterable_intro'. eapply (into_laterable_result_laterable P), _. Qed. Definition modality_make_laterable `{!Timeless (PROP:=PROP) emp} := Modality _ modality_make_laterable_mixin. Global Instance from_modal_make_laterable `{!Timeless (PROP:=PROP) emp} P : FromModal True modality_make_laterable (make_laterable P) (make_laterable P) P. Proof. by rewrite /FromModal. Qed. End instances. Global Typeclasses Opaque make_laterable. iris-iris-4.2.0/iris/bi/lib/relations.v000066400000000000000000000334121460620107300177260ustar00rootroot00000000000000(** This file provides constructions to lift a PROP-level binary relation to various closures. *) From iris.bi.lib Require Export fixpoint. From iris.proofmode Require Import proofmode. From iris.prelude Require Import options. (* The sections add extra BI assumptions, which is only picked up with "Type"*. *) Set Default Proof Using "Type*". (** * Definitions *) Section definitions. Context {PROP : bi} `{!BiInternalEq PROP}. Context {A : ofe}. Local Definition bi_rtc_pre (R : A → A → PROP) (x2 : A) (rec : A → PROP) (x1 : A) : PROP := (x1 ≡ x2) ∨ ∃ x', R x1 x' ∗ rec x'. (** The reflexive transitive closure. *) Definition bi_rtc (R : A → A → PROP) (x1 x2 : A) : PROP := bi_least_fixpoint (bi_rtc_pre R x2) x1. Global Instance: Params (@bi_rtc) 4 := {}. Local Definition bi_tc_pre (R : A → A → PROP) (x2 : A) (rec : A → PROP) (x1 : A) : PROP := R x1 x2 ∨ ∃ x', R x1 x' ∗ rec x'. (** The transitive closure. *) Definition bi_tc (R : A → A → PROP) (x1 x2 : A) : PROP := bi_least_fixpoint (bi_tc_pre R x2) x1. Global Instance: Params (@bi_tc) 4 := {}. (** Reductions of exactly [n] steps. *) Fixpoint bi_nsteps (R : A → A → PROP) (n : nat) (x1 x2 : A) : PROP := match n with | 0 => (x1 ≡ x2) | S n' => ∃ x', R x1 x' ∗ bi_nsteps R n' x' x2 end. Global Instance: Params (@bi_nsteps) 5 := {}. End definitions. Local Instance bi_rtc_pre_mono {PROP : bi} `{!BiInternalEq PROP} {A : ofe} (R : A → A → PROP) `{!NonExpansive2 R} (x : A) : BiMonoPred (bi_rtc_pre R x). Proof. constructor; [|solve_proper]. iIntros (rec1 rec2 ??) "#H". iIntros (x1) "[Hrec | Hrec]". { by iLeft. } iRight. iDestruct "Hrec" as (x') "[HP Hrec]". iDestruct ("H" with "Hrec") as "Hrec". eauto with iFrame. Qed. Global Instance bi_rtc_ne {PROP : bi} `{!BiInternalEq PROP} {A : ofe} (R : A → A → PROP) : NonExpansive2 (bi_rtc R). Proof. intros n x1 x2 Hx y1 y2 Hy. rewrite /bi_rtc Hx. f_equiv=> rec z. solve_proper. Qed. Global Instance bi_rtc_proper {PROP : bi} `{!BiInternalEq PROP} {A : ofe} (R : A → A → PROP) : Proper ((≡) ==> (≡) ==> (⊣⊢)) (bi_rtc R). Proof. apply ne_proper_2. apply _. Qed. Local Instance bi_tc_pre_mono `{!BiInternalEq PROP} {A : ofe} (R : A → A → PROP) `{NonExpansive2 R} (x : A) : BiMonoPred (bi_tc_pre R x). Proof. constructor; [|solve_proper]. iIntros (rec1 rec2 ??) "#H". iIntros (x1) "Hrec". iDestruct "Hrec" as "[Hrec | Hrec]". { by iLeft. } iDestruct "Hrec" as (x') "[HR Hrec]". iRight. iExists x'. iFrame "HR". by iApply "H". Qed. Global Instance bi_tc_ne `{!BiInternalEq PROP} {A : ofe} (R : A → A → PROP) `{NonExpansive2 R} : NonExpansive2 (bi_tc R). Proof. intros n x1 x2 Hx y1 y2 Hy. rewrite /bi_tc Hx. f_equiv=> rec z. solve_proper. Qed. Global Instance bi_tc_proper `{!BiInternalEq PROP} {A : ofe} (R : A → A → PROP) `{NonExpansive2 R} : Proper ((≡) ==> (≡) ==> (⊣⊢)) (bi_tc R). Proof. apply ne_proper_2. apply _. Qed. Global Instance bi_nsteps_ne {PROP : bi} `{!BiInternalEq PROP} {A : ofe} (R : A → A → PROP) `{NonExpansive2 R} (n : nat) : NonExpansive2 (bi_nsteps R n). Proof. induction n; solve_proper. Qed. Global Instance bi_nsteps_proper {PROP : bi} `{!BiInternalEq PROP} {A : ofe} (R : A → A → PROP) `{NonExpansive2 R} (n : nat) : Proper ((≡) ==> (≡) ==> (⊣⊢)) (bi_nsteps R n). Proof. apply ne_proper_2. apply _. Qed. (** * General theorems *) Section general. Context {PROP : bi} `{!BiInternalEq PROP}. Context {A : ofe}. Context (R : A → A → PROP) `{!NonExpansive2 R}. (** ** Results about the reflexive-transitive closure [bi_rtc] *) Local Lemma bi_rtc_unfold (x1 x2 : A) : bi_rtc R x1 x2 ≡ bi_rtc_pre R x2 (λ x1, bi_rtc R x1 x2) x1. Proof. by rewrite /bi_rtc; rewrite -least_fixpoint_unfold. Qed. Lemma bi_rtc_strong_ind_l x2 Φ : NonExpansive Φ → □ (∀ x1, (x1 ≡ x2) ∨ (∃ x', R x1 x' ∗ (Φ x' ∧ bi_rtc R x' x2)) -∗ Φ x1) -∗ ∀ x1, bi_rtc R x1 x2 -∗ Φ x1. Proof. iIntros (?) "#IH". rewrite /bi_rtc. by iApply (least_fixpoint_ind (bi_rtc_pre R x2) with "IH"). Qed. Lemma bi_rtc_ind_l x2 Φ : NonExpansive Φ → □ (∀ x1, (x1 ≡ x2) ∨ (∃ x', R x1 x' ∗ Φ x') -∗ Φ x1) -∗ ∀ x1, bi_rtc R x1 x2 -∗ Φ x1. Proof. iIntros (?) "#IH". rewrite /bi_rtc. by iApply (least_fixpoint_iter (bi_rtc_pre R x2) with "IH"). Qed. Lemma bi_rtc_refl x : ⊢ bi_rtc R x x. Proof. rewrite bi_rtc_unfold. by iLeft. Qed. Lemma bi_rtc_l x1 x2 x3 : R x1 x2 -∗ bi_rtc R x2 x3 -∗ bi_rtc R x1 x3. Proof. iIntros "H1 H2". iEval (rewrite bi_rtc_unfold /bi_rtc_pre). iRight. iExists x2. iFrame. Qed. Lemma bi_rtc_once x1 x2 : R x1 x2 -∗ bi_rtc R x1 x2. Proof. iIntros "H". iApply (bi_rtc_l with "H"). iApply bi_rtc_refl. Qed. Lemma bi_rtc_trans x1 x2 x3 : bi_rtc R x1 x2 -∗ bi_rtc R x2 x3 -∗ bi_rtc R x1 x3. Proof. iRevert (x1). iApply bi_rtc_ind_l. { solve_proper. } iIntros "!>" (x1) "[H | H] H2". { by iRewrite "H". } iDestruct "H" as (x') "[H IH]". iApply (bi_rtc_l with "H"). by iApply "IH". Qed. Lemma bi_rtc_r x y z : bi_rtc R x y -∗ R y z -∗ bi_rtc R x z. Proof. iIntros "H H'". iApply (bi_rtc_trans with "H"). by iApply bi_rtc_once. Qed. Lemma bi_rtc_inv x z : bi_rtc R x z -∗ (x ≡ z) ∨ ∃ y, R x y ∗ bi_rtc R y z. Proof. rewrite bi_rtc_unfold. iIntros "[H | H]"; eauto. Qed. Global Instance bi_rtc_affine : (∀ x y, Affine (R x y)) → ∀ x y, Affine (bi_rtc R x y). Proof. intros. apply least_fixpoint_affine; apply _. Qed. (* FIXME: It would be nicer to use the least_fixpoint_persistent lemmas, but they seem to weak. *) Global Instance bi_rtc_persistent : (∀ x y, Persistent (R x y)) → ∀ x y, Persistent (bi_rtc R x y). Proof. intros ? x y. rewrite /Persistent. iRevert (x). iApply bi_rtc_ind_l; first solve_proper. iIntros "!>" (x) "[#Heq | (%x' & #Hxx' & #Hx'y)]". { iRewrite "Heq". iApply bi_rtc_refl. } iApply (bi_rtc_l with "Hxx' Hx'y"). Qed. (** ** Results about the transitive closure [bi_tc] *) Local Lemma bi_tc_unfold (x1 x2 : A) : bi_tc R x1 x2 ≡ bi_tc_pre R x2 (λ x1, bi_tc R x1 x2) x1. Proof. by rewrite /bi_tc; rewrite -least_fixpoint_unfold. Qed. Lemma bi_tc_strong_ind_l x2 Φ : NonExpansive Φ → □ (∀ x1, (R x1 x2 ∨ (∃ x', R x1 x' ∗ (Φ x' ∧ bi_tc R x' x2))) -∗ Φ x1) -∗ ∀ x1, bi_tc R x1 x2 -∗ Φ x1. Proof. iIntros (?) "#IH". rewrite /bi_tc. iApply (least_fixpoint_ind (bi_tc_pre R x2) with "IH"). Qed. Lemma bi_tc_ind_l x2 Φ : NonExpansive Φ → □ (∀ x1, (R x1 x2 ∨ (∃ x', R x1 x' ∗ Φ x')) -∗ Φ x1) -∗ ∀ x1, bi_tc R x1 x2 -∗ Φ x1. Proof. iIntros (?) "#IH". rewrite /bi_tc. iApply (least_fixpoint_iter (bi_tc_pre R x2) with "IH"). Qed. Lemma bi_tc_l x1 x2 x3 : R x1 x2 -∗ bi_tc R x2 x3 -∗ bi_tc R x1 x3. Proof. iIntros "H1 H2". iEval (rewrite bi_tc_unfold /bi_tc_pre). iRight. iExists x2. iFrame. Qed. Lemma bi_tc_once x1 x2 : R x1 x2 -∗ bi_tc R x1 x2. Proof. iIntros "H". iEval (rewrite bi_tc_unfold /bi_tc_pre). by iLeft. Qed. Lemma bi_tc_trans x1 x2 x3 : bi_tc R x1 x2 -∗ bi_tc R x2 x3 -∗ bi_tc R x1 x3. Proof. iRevert (x1). iApply bi_tc_ind_l. { solve_proper. } iIntros "!>" (x1) "H H2". iDestruct "H" as "[H | H]". { iApply (bi_tc_l with "H H2"). } iDestruct "H" as (x') "[H IH]". iApply (bi_tc_l with "H"). by iApply "IH". Qed. Lemma bi_tc_r x y z : bi_tc R x y -∗ R y z -∗ bi_tc R x z. Proof. iIntros "H H'". iApply (bi_tc_trans with "H"). by iApply bi_tc_once. Qed. Lemma bi_tc_rtc_l x y z : bi_rtc R x y -∗ bi_tc R y z -∗ bi_tc R x z. Proof. iRevert (x). iApply bi_rtc_ind_l. { solve_proper. } iIntros "!>" (x) "[Heq | H] Hyz". { by iRewrite "Heq". } iDestruct "H" as (x') "[H IH]". iApply (bi_tc_l with "H"). by iApply "IH". Qed. Lemma bi_tc_rtc_r x y z : bi_tc R x y -∗ bi_rtc R y z -∗ bi_tc R x z. Proof. iIntros "Hxy Hyz". iRevert (x) "Hxy". iRevert (y) "Hyz". iApply bi_rtc_ind_l. { solve_proper. } iIntros "!>" (y) "[Heq | H] %x Hxy". { by iRewrite -"Heq". } iDestruct "H" as (y') "[H IH]". iApply "IH". iApply (bi_tc_r with "Hxy H"). Qed. Lemma bi_tc_rtc x y : bi_tc R x y -∗ bi_rtc R x y. Proof. iRevert (x). iApply bi_tc_ind_l. { solve_proper. } iIntros "!>" (x) "[Hxy | H]". { by iApply bi_rtc_once. } iDestruct "H" as (x') "[H H']". iApply (bi_rtc_l with "H H'"). Qed. Global Instance bi_tc_affine : (∀ x y, Affine (R x y)) → ∀ x y, Affine (bi_tc R x y). Proof. intros. apply least_fixpoint_affine; apply _. Qed. Global Instance bi_tc_absorbing : (∀ x y, Absorbing (R x y)) → ∀ x y, Absorbing (bi_tc R x y). Proof. intros. apply least_fixpoint_absorbing; apply _. Qed. (* FIXME: It would be nicer to use the least_fixpoint_persistent lemmas, but they seem to weak. *) Global Instance bi_tc_persistent : (∀ x y, Persistent (R x y)) → ∀ x y, Persistent (bi_tc R x y). Proof. intros ? x y. rewrite /Persistent. iRevert (x). iApply bi_tc_ind_l; first solve_proper. iIntros "!# %x [#H|(%x'&#?&#?)] !>"; first by iApply bi_tc_once. by iApply bi_tc_l. Qed. (** ** Results about [bi_nsteps] *) Lemma bi_nsteps_O x : ⊢ bi_nsteps R 0 x x. Proof. auto. Qed. Lemma bi_nsteps_once x y : R x y -∗ bi_nsteps R 1 x y. Proof. simpl. eauto. Qed. Lemma bi_nsteps_once_inv x y : bi_nsteps R 1 x y -∗ R x y. Proof. iDestruct 1 as (x') "[Hxx' Heq]". by iRewrite -"Heq". Qed. Lemma bi_nsteps_l n x y z : R x y -∗ bi_nsteps R n y z -∗ bi_nsteps R (S n) x z. Proof. iIntros "? ?". iExists y. iFrame. Qed. Lemma bi_nsteps_trans n m x y z : bi_nsteps R n x y -∗ bi_nsteps R m y z -∗ bi_nsteps R (n + m) x z. Proof. iInduction n as [|n] "IH" forall (x); simpl. - iIntros "Heq". iRewrite "Heq". auto. - iDestruct 1 as (x') "[Hxx' Hx'y]". iIntros "Hyz". iExists x'. iFrame "Hxx'". iApply ("IH" with "Hx'y Hyz"). Qed. Lemma bi_nsteps_r n x y z : bi_nsteps R n x y -∗ R y z -∗ bi_nsteps R (S n) x z. Proof. iIntros "Hxy Hyx". rewrite -Nat.add_1_r. iApply (bi_nsteps_trans with "Hxy"). by iApply bi_nsteps_once. Qed. Lemma bi_nsteps_add_inv n m x z : bi_nsteps R (n + m) x z ⊢ ∃ y, bi_nsteps R n x y ∗ bi_nsteps R m y z. Proof. iInduction n as [|n] "IH" forall (x). - iIntros "Hxz". iExists x. auto. - iDestruct 1 as (y) "[Hxy Hyz]". iDestruct ("IH" with "Hyz") as (y') "[Hyy' Hy'z]". iExists y'. iFrame "Hy'z". iApply (bi_nsteps_l with "Hxy Hyy'"). Qed. Lemma bi_nsteps_inv_r n x z : bi_nsteps R (S n) x z ⊢ ∃ y, bi_nsteps R n x y ∗ R y z. Proof. rewrite -Nat.add_1_r bi_nsteps_add_inv /=. iDestruct 1 as (y) "[Hxy (%x' & Hxx' & Heq)]". iExists y. iRewrite -"Heq". iFrame. Qed. (** ** Equivalences between closure operators *) Lemma bi_rtc_tc x y : bi_rtc R x y ⊣⊢ (x ≡ y) ∨ bi_tc R x y. Proof. iSplit. - iRevert (x). iApply bi_rtc_ind_l. { solve_proper. } iIntros "!>" (x) "[Heq | H]". { by iLeft. } iRight. iDestruct "H" as (x') "[H [Heq | IH]]". { iRewrite -"Heq". by iApply bi_tc_once. } iApply (bi_tc_l with "H IH"). - iIntros "[Heq | Hxy]". { iRewrite "Heq". iApply bi_rtc_refl. } by iApply bi_tc_rtc. Qed. Lemma bi_tc_nsteps x y : bi_tc R x y ⊣⊢ ∃ n, ⌜0 < n⌝ ∗ bi_nsteps R n x y. Proof. iSplit. - iRevert (x). iApply bi_tc_ind_l. { solve_proper. } iIntros "!>" (x) "[Hxy | H]". { iExists 1. iSplitR; first auto with lia. iApply (bi_nsteps_l with "Hxy"). iApply bi_nsteps_O. } iDestruct "H" as (x') "[Hxx' IH]". iDestruct "IH" as (n ?) "Hx'y". iExists (S n). iSplitR; first auto with lia. iApply (bi_nsteps_l with "Hxx' Hx'y"). - iDestruct 1 as (n ?) "Hxy". iInduction n as [|n] "IH" forall (y). { lia. } rewrite bi_nsteps_inv_r. iDestruct "Hxy" as (x') "[Hxx' Hx'y]". destruct n. { simpl. iRewrite "Hxx'". by iApply bi_tc_once. } iApply (bi_tc_r with "[Hxx'] Hx'y"). iApply ("IH" with "[%] Hxx'"). lia. Qed. Lemma bi_rtc_nsteps x y : bi_rtc R x y ⊣⊢ ∃ n, bi_nsteps R n x y. Proof. iSplit. - iRevert (x). iApply bi_rtc_ind_l. { solve_proper. } iIntros "!>" (x) "[Heq | H]". { iExists 0. iRewrite "Heq". iApply bi_nsteps_O. } iDestruct "H" as (x') "[Hxx' IH]". iDestruct "IH" as (n) "Hx'y". iExists (S n). iApply (bi_nsteps_l with "Hxx' Hx'y"). - iDestruct 1 as (n) "Hxy". iInduction n as [|n] "IH" forall (y). { simpl. iRewrite "Hxy". iApply bi_rtc_refl. } iDestruct (bi_nsteps_inv_r with "Hxy") as (x') "[Hxx' Hx'y]". iApply (bi_rtc_r with "[Hxx'] Hx'y"). by iApply "IH". Qed. End general. Section timeless. Context {PROP : bi} `{!BiInternalEq PROP, !BiAffine PROP}. Context `{!OfeDiscrete A}. Context (R : A → A → PROP) `{!NonExpansive2 R}. Global Instance bi_nsteps_timeless n : (∀ x y, Timeless (R x y)) → ∀ x y, Timeless (bi_nsteps R n x y). Proof. induction n; apply _. Qed. Global Instance bi_rtc_timeless : (∀ x y, Timeless (R x y)) → ∀ x y, Timeless (bi_rtc R x y). Proof. intros ? x y. rewrite bi_rtc_nsteps. apply _. Qed. Global Instance bi_tc_timeless : (∀ x y, Timeless (R x y)) → ∀ x y, Timeless (bi_tc R x y). Proof. intros ? x y. rewrite bi_tc_nsteps. apply _. Qed. End timeless. Global Typeclasses Opaque bi_rtc. Global Typeclasses Opaque bi_tc. Global Typeclasses Opaque bi_nsteps. iris-iris-4.2.0/iris/bi/monpred.v000066400000000000000000001543721460620107300166350ustar00rootroot00000000000000From stdpp Require Import coPset. From iris.bi Require Import bi. From iris.prelude Require Import options. (** 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 (⊑@{bi_index_type}) }. Global 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 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 bi_scope with monPred. Implicit Types P Q : monPred. (** Ofe + Cofe instances *) Section cofe_def. Inductive monPred_equiv' P Q : Prop := { monPred_in_equiv i : P i ≡ Q i } . Local 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 }. Local Instance monPred_dist : Dist monPred := monPred_dist'. Definition monPred_sig P : { f : I -d> PROP | Proper ((⊑) ==> (⊢)) f } := exist _ (monPred_at P) (monPred_mono P). Definition sig_monPred (P' : { f : I -d> 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 []|]. Defined. Let monPred_sig_dist: ∀ n, ∀ P Q : monPred, P ≡{n}≡ Q ↔ monPred_sig P ≡{n}≡ monPred_sig Q. Proof. by split; [intros []|]. Defined. Definition monPred_ofe_mixin : OfeMixin monPred. Proof. by apply (iso_ofe_mixin monPred_sig monPred_sig_equiv monPred_sig_dist). Qed. Canonical Structure monPredO := Ofe monPred monPred_ofe_mixin. Global Instance monPred_cofe `{!Cofe PROP} : Cofe monPredO. Proof. unshelve refine (iso_cofe_subtype (A:=I-d>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 cofe_def. Lemma monPred_sig_monPred (P' : { f : I -d> 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_entails; 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 cofe. Global Arguments monPred _ _ : clear implicits. Global Arguments monPred_at {_ _} _%I _. Local Existing Instance monPred_mono. Global Arguments monPredO _ _ : clear implicits. (** BI canonical structure and type class instances *) Module Export monPred_defs. Section monPred_defs. 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 }. Local Hint Immediate monPred_in_entails : core. Program Definition monPred_upclosed (Φ : I → PROP) : monPred := MonPred (λ i, (∀ j, ⌜i ⊑ j⌝ → Φ j)%I) _. Next Obligation. solve_proper. Qed. Local Definition monPred_embed_def : Embed PROP monPred := λ (P : PROP), MonPred (λ _, P) _. Local Definition monPred_embed_aux : seal (@monPred_embed_def). Proof. by eexists. Qed. Definition monPred_embed := monPred_embed_aux.(unseal). Local Definition monPred_embed_unseal : @embed _ _ monPred_embed = _ := monPred_embed_aux.(seal_eq). Local Definition monPred_emp_def : monPred := MonPred (λ _, emp)%I _. Local Definition monPred_emp_aux : seal (@monPred_emp_def). Proof. by eexists. Qed. Definition monPred_emp := monPred_emp_aux.(unseal). Local Definition monPred_emp_unseal : @monPred_emp = _ := monPred_emp_aux.(seal_eq). Local Definition monPred_pure_def (φ : Prop) : monPred := MonPred (λ _, ⌜φ⌝)%I _. Local Definition monPred_pure_aux : seal (@monPred_pure_def). Proof. by eexists. Qed. Definition monPred_pure := monPred_pure_aux.(unseal). Local Definition monPred_pure_unseal : @monPred_pure = _ := monPred_pure_aux.(seal_eq). Local Definition monPred_objectively_def P : monPred := MonPred (λ _, ∀ i, P i)%I _. Local Definition monPred_objectively_aux : seal (@monPred_objectively_def). Proof. by eexists. Qed. Definition monPred_objectively := monPred_objectively_aux.(unseal). Local Definition monPred_objectively_unseal : @monPred_objectively = _ := monPred_objectively_aux.(seal_eq). Local Definition monPred_subjectively_def P : monPred := MonPred (λ _, ∃ i, P i)%I _. Local Definition monPred_subjectively_aux : seal (@monPred_subjectively_def). Proof. by eexists. Qed. Definition monPred_subjectively := monPred_subjectively_aux.(unseal). Local Definition monPred_subjectively_unseal : @monPred_subjectively = _ := monPred_subjectively_aux.(seal_eq). Local Program Definition monPred_and_def P Q : monPred := MonPred (λ i, P i ∧ Q i)%I _. Next Obligation. solve_proper. Qed. Local Definition monPred_and_aux : seal (@monPred_and_def). Proof. by eexists. Qed. Definition monPred_and := monPred_and_aux.(unseal). Local Definition monPred_and_unseal : @monPred_and = _ := monPred_and_aux.(seal_eq). Local Program Definition monPred_or_def P Q : monPred := MonPred (λ i, P i ∨ Q i)%I _. Next Obligation. solve_proper. Qed. Local Definition monPred_or_aux : seal (@monPred_or_def). Proof. by eexists. Qed. Definition monPred_or := monPred_or_aux.(unseal). Local Definition monPred_or_unseal : @monPred_or = _ := monPred_or_aux.(seal_eq). Local Definition monPred_impl_def P Q : monPred := monPred_upclosed (λ i, P i → Q i)%I. Local Definition monPred_impl_aux : seal (@monPred_impl_def). Proof. by eexists. Qed. Definition monPred_impl := monPred_impl_aux.(unseal). Local Definition monPred_impl_unseal : @monPred_impl = _ := monPred_impl_aux.(seal_eq). Local Program Definition monPred_forall_def A (Φ : A → monPred) : monPred := MonPred (λ i, ∀ x : A, Φ x i)%I _. Next Obligation. solve_proper. Qed. Local Definition monPred_forall_aux : seal (@monPred_forall_def). Proof. by eexists. Qed. Definition monPred_forall := monPred_forall_aux.(unseal). Local Definition monPred_forall_unseal : @monPred_forall = _ := monPred_forall_aux.(seal_eq). Local Program Definition monPred_exist_def A (Φ : A → monPred) : monPred := MonPred (λ i, ∃ x : A, Φ x i)%I _. Next Obligation. solve_proper. Qed. Local Definition monPred_exist_aux : seal (@monPred_exist_def). Proof. by eexists. Qed. Definition monPred_exist := monPred_exist_aux.(unseal). Local Definition monPred_exist_unseal : @monPred_exist = _ := monPred_exist_aux.(seal_eq). Local Program Definition monPred_sep_def P Q : monPred := MonPred (λ i, P i ∗ Q i)%I _. Next Obligation. solve_proper. Qed. Local Definition monPred_sep_aux : seal (@monPred_sep_def). Proof. by eexists. Qed. Definition monPred_sep := monPred_sep_aux.(unseal). Local Definition monPred_sep_unseal : @monPred_sep = _ := monPred_sep_aux.(seal_eq). Local Definition monPred_wand_def P Q : monPred := monPred_upclosed (λ i, P i -∗ Q i)%I. Local Definition monPred_wand_aux : seal (@monPred_wand_def). Proof. by eexists. Qed. Definition monPred_wand := monPred_wand_aux.(unseal). Local Definition monPred_wand_unseal : @monPred_wand = _ := monPred_wand_aux.(seal_eq). Local Program Definition monPred_persistently_def P : monPred := MonPred (λ i, (P i))%I _. Next Obligation. solve_proper. Qed. Local Definition monPred_persistently_aux : seal (@monPred_persistently_def). Proof. by eexists. Qed. Definition monPred_persistently := monPred_persistently_aux.(unseal). Local Definition monPred_persistently_unseal : @monPred_persistently = _ := monPred_persistently_aux.(seal_eq). Local Program Definition monPred_in_def (i0 : I) : monPred := MonPred (λ i : I, ⌜i0 ⊑ i⌝%I) _. Next Obligation. solve_proper. Qed. Local Definition monPred_in_aux : seal (@monPred_in_def). Proof. by eexists. Qed. Definition monPred_in := monPred_in_aux.(unseal). Local Definition monPred_in_unseal : @monPred_in = _ := monPred_in_aux.(seal_eq). Local Program Definition monPred_later_def P : monPred := MonPred (λ i, ▷ (P i))%I _. Next Obligation. solve_proper. Qed. Local Definition monPred_later_aux : seal monPred_later_def. Proof. by eexists. Qed. Definition monPred_later := monPred_later_aux.(unseal). Local Definition monPred_later_unseal : monPred_later = _ := monPred_later_aux.(seal_eq). Local Definition monPred_internal_eq_def `{!BiInternalEq PROP} (A : ofe) (a b : A) : monPred := MonPred (λ _, a ≡ b)%I _. Local Definition monPred_internal_eq_aux : seal (@monPred_internal_eq_def). Proof. by eexists. Qed. Definition monPred_internal_eq := monPred_internal_eq_aux.(unseal). Global Arguments monPred_internal_eq {_}. Local Definition monPred_internal_eq_unseal `{!BiInternalEq PROP} : @internal_eq _ monPred_internal_eq = monPred_internal_eq_def. Proof. by rewrite -monPred_internal_eq_aux.(seal_eq). Qed. Local Program Definition monPred_bupd_def `{BiBUpd PROP} (P : monPred) : monPred := MonPred (λ i, |==> P i)%I _. Next Obligation. solve_proper. Qed. Local Definition monPred_bupd_aux : seal (@monPred_bupd_def). Proof. by eexists. Qed. Definition monPred_bupd := monPred_bupd_aux.(unseal). Global Arguments monPred_bupd {_}. Local Definition monPred_bupd_unseal `{BiBUpd PROP} : @bupd _ monPred_bupd = monPred_bupd_def. Proof. by rewrite -monPred_bupd_aux.(seal_eq). Qed. Local 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. Local Definition monPred_fupd_aux : seal (@monPred_fupd_def). Proof. by eexists. Qed. Definition monPred_fupd := monPred_fupd_aux.(unseal). Global Arguments monPred_fupd {_}. Local Definition monPred_fupd_unseal `{BiFUpd PROP} : @fupd _ monPred_fupd = monPred_fupd_def. Proof. by rewrite -monPred_fupd_aux.(seal_eq). Qed. Local Definition monPred_plainly_def `{BiPlainly PROP} P : monPred := MonPred (λ _, ∀ i, ■ (P i))%I _. Local Definition monPred_plainly_aux : seal (@monPred_plainly_def). Proof. by eexists. Qed. Definition monPred_plainly := monPred_plainly_aux.(unseal). Global Arguments monPred_plainly {_}. Local Definition monPred_plainly_unseal `{BiPlainly PROP} : @plainly _ monPred_plainly = monPred_plainly_def. Proof. by rewrite -monPred_plainly_aux.(seal_eq). Qed. End monPred_defs. (** This is not the final collection of unsealing lemmas, below we redefine [monPred_unseal] to also unfold the BI layer (i.e., the projections of the BI structures/classes). *) Local Definition monPred_unseal := (@monPred_embed_unseal, @monPred_emp_unseal, @monPred_pure_unseal, @monPred_objectively_unseal, @monPred_subjectively_unseal, @monPred_and_unseal, @monPred_or_unseal, @monPred_impl_unseal, @monPred_forall_unseal, @monPred_exist_unseal, @monPred_sep_unseal, @monPred_wand_unseal, @monPred_persistently_unseal, @monPred_in_unseal, @monPred_later_unseal). End monPred_defs. Global Arguments monPred_objectively {_ _} _%I. Global Arguments monPred_subjectively {_ _} _%I. Notation "'' P" := (monPred_objectively P) : bi_scope. Notation "'' P" := (monPred_subjectively P) : bi_scope. Section instances. 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. Proof. split; rewrite ?monPred_defs.monPred_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_entails. + intros [[] []]. split=>i. by apply bi.equiv_entails. - intros P φ ?. split=> i. by apply bi.pure_intro. - intros φ P HP. split=> i. apply bi.pure_elim'=> ?. by apply HP. - 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 //. Qed. Lemma monPred_bi_persistently_mixin : BiPersistentlyMixin (PROP:=monPred I PROP) monPred_entails monPred_emp monPred_and monPred_exist monPred_sep monPred_persistently. Proof. split; rewrite ?monPred_defs.monPred_unseal; try by (split=> ? /=; repeat f_equiv). - 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_and_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. Lemma monPred_bi_later_mixin : BiLaterMixin (PROP:=monPred I PROP) monPred_entails monPred_pure monPred_or monPred_impl monPred_forall monPred_exist monPred_sep monPred_persistently monPred_later. Proof. split; rewrite ?monPred_defs.monPred_unseal. - by split=> ? /=; repeat f_equiv. - 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 monPredI : bi := {| bi_ofe_mixin := monPred_ofe_mixin; bi_bi_mixin := monPred_bi_mixin; bi_bi_persistently_mixin := monPred_bi_persistently_mixin; bi_bi_later_mixin := monPred_bi_later_mixin |}. (** We restate the unsealing lemmas so that they also unfold the BI layer. The sealing lemmas are partially applied so that they also work under binders. *) Local Lemma monPred_emp_unseal : bi_emp = @monPred_defs.monPred_emp_def I PROP. Proof. by rewrite -monPred_defs.monPred_emp_unseal. Qed. Local Lemma monPred_pure_unseal : bi_pure = @monPred_defs.monPred_pure_def I PROP. Proof. by rewrite -monPred_defs.monPred_pure_unseal. Qed. Local Lemma monPred_and_unseal : bi_and = @monPred_defs.monPred_and_def I PROP. Proof. by rewrite -monPred_defs.monPred_and_unseal. Qed. Local Lemma monPred_or_unseal : bi_or = @monPred_defs.monPred_or_def I PROP. Proof. by rewrite -monPred_defs.monPred_or_unseal. Qed. Local Lemma monPred_impl_unseal : bi_impl = @monPred_defs.monPred_impl_def I PROP. Proof. by rewrite -monPred_defs.monPred_impl_unseal. Qed. Local Lemma monPred_forall_unseal : @bi_forall _ = @monPred_defs.monPred_forall_def I PROP. Proof. by rewrite -monPred_defs.monPred_forall_unseal. Qed. Local Lemma monPred_exist_unseal : @bi_exist _ = @monPred_defs.monPred_exist_def I PROP. Proof. by rewrite -monPred_defs.monPred_exist_unseal. Qed. Local Lemma monPred_sep_unseal : bi_sep = @monPred_defs.monPred_sep_def I PROP. Proof. by rewrite -monPred_defs.monPred_sep_unseal. Qed. Local Lemma monPred_wand_unseal : bi_wand = @monPred_defs.monPred_wand_def I PROP. Proof. by rewrite -monPred_defs.monPred_wand_unseal. Qed. Local Lemma monPred_persistently_unseal : bi_persistently = @monPred_defs.monPred_persistently_def I PROP. Proof. by rewrite -monPred_defs.monPred_persistently_unseal. Qed. Local Lemma monPred_later_unseal : bi_later = @monPred_defs.monPred_later_def I PROP. Proof. by rewrite -monPred_defs.monPred_later_unseal. Qed. (** This definition only includes the unseal lemmas for the [bi] connectives. After we have defined the right class instances, we define [monPred_unseal], which also includes [embed], [internal_eq], [bupd], [fupd], [plainly], [monPred_objectively], [monPred_subjectively] and [monPred_in]. *) Local Definition monPred_unseal_bi := (monPred_emp_unseal, monPred_pure_unseal, monPred_and_unseal, monPred_or_unseal, monPred_impl_unseal, monPred_forall_unseal, monPred_exist_unseal, monPred_sep_unseal, monPred_wand_unseal, monPred_persistently_unseal, monPred_later_unseal). Definition monPred_embedding_mixin : BiEmbedMixin PROP monPredI monPred_embed. Proof. split; try apply _; rewrite /bi_emp_valid !(monPred_defs.monPred_embed_unseal, monPred_unseal_bi); try done. - move=> P /= [/(_ inhabitant) ?] //. - intros PROP' ? P Q. set (f P := @monPred_at I PROP P inhabitant). assert (NonExpansive f) by solve_proper. apply (f_equivI f). - 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 |}. Lemma monPred_internal_eq_mixin `{!BiInternalEq PROP} : BiInternalEqMixin monPredI monPred_internal_eq. Proof. split; rewrite !(monPred_defs.monPred_internal_eq_unseal, monPred_unseal_bi). - split=> i /=. solve_proper. - intros A P a. split=> i /=. apply internal_eq_refl. - intros A a b Ψ ?. split=> i /=. setoid_rewrite bi.pure_impl_forall. do 2 apply bi.forall_intro => ?. erewrite (internal_eq_rewrite _ _ (flip Ψ _)) => //=. solve_proper. - intros A1 A2 f g. split=> i /=. by apply fun_extI. - intros A P x y. split=> i /=. by apply sig_equivI_1. - intros A a b ?. split=> i /=. by apply discrete_eq_1. - intros A x y. split=> i /=. by apply later_equivI_1. - intros A x y. split=> i /=. by apply later_equivI_2. Qed. Global Instance monPred_bi_internal_eq `{BiInternalEq PROP} : BiInternalEq monPredI := {| bi_internal_eq_mixin := monPred_internal_eq_mixin |}. Lemma monPred_bupd_mixin `{BiBUpd PROP} : BiBUpdMixin monPredI monPred_bupd. Proof. split; rewrite !(monPred_defs.monPred_bupd_unseal, monPred_unseal_bi). - 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. apply bupd_frame_r. Qed. Global Instance monPred_bi_bupd `{BiBUpd PROP} : BiBUpd monPredI := {| bi_bupd_mixin := monPred_bupd_mixin |}. Lemma monPred_fupd_mixin `{BiFUpd PROP} : BiFUpdMixin monPredI monPred_fupd. Proof. split; rewrite /bi_emp_valid /bi_except_0 !(monPred_defs.monPred_fupd_unseal, monPred_unseal_bi). - split=>/= i. solve_proper. - intros E1 E2 HE12. split=>/= i. by apply fupd_mask_intro_subseteq. - intros E1 E2 P. split=>/= i. apply 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. by rewrite (bi.forall_elim i) bi.pure_True // left_id fupd_mask_frame_r'. - intros E1 E2 P Q. split=>/= i. apply fupd_frame_r. Qed. Global Instance monPred_bi_fupd `{BiFUpd PROP} : BiFUpd monPredI := {| bi_fupd_mixin := monPred_fupd_mixin |}. Lemma monPred_plainly_mixin `{BiPlainly PROP} : BiPlainlyMixin monPredI monPred_plainly. Proof. split; rewrite !(monPred_defs.monPred_plainly_unseal, monPred_unseal_bi). - 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 /=. do 3 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 /=. setoid_rewrite bi.pure_impl_forall. rewrite 2!bi.forall_elim //. do 2 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. 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 monPredI := {| bi_plainly_mixin := monPred_plainly_mixin |}. Local Lemma monPred_embed_unseal : embed = @monPred_defs.monPred_embed_def I PROP. Proof. by rewrite -monPred_defs.monPred_embed_unseal. Qed. Local Lemma monPred_internal_eq_unseal `{!BiInternalEq PROP} : @internal_eq _ _ = @monPred_defs.monPred_internal_eq_def I PROP _. Proof. by rewrite -monPred_defs.monPred_internal_eq_unseal. Qed. Local Lemma monPred_bupd_unseal `{BiBUpd PROP} : bupd = @monPred_defs.monPred_bupd_def I PROP _. Proof. by rewrite -monPred_defs.monPred_bupd_unseal. Qed. Local Lemma monPred_fupd_unseal `{BiFUpd PROP} : fupd = @monPred_defs.monPred_fupd_def I PROP _. Proof. by rewrite -monPred_defs.monPred_fupd_unseal. Qed. Local Lemma monPred_plainly_unseal `{BiPlainly PROP} : plainly = @monPred_defs.monPred_plainly_def I PROP _. Proof. by rewrite -monPred_defs.monPred_plainly_unseal. Qed. (** And finally the proper [unseal] tactic (which we also redefine outside of the section since Ltac definitions do not outlive a section). *) Local Definition monPred_unseal := (monPred_unseal_bi, @monPred_defs.monPred_objectively_unseal, @monPred_defs.monPred_subjectively_unseal, @monPred_embed_unseal, @monPred_internal_eq_unseal, @monPred_bupd_unseal, @monPred_fupd_unseal, @monPred_plainly_unseal, @monPred_defs.monPred_in_unseal). Ltac unseal := rewrite !monPred_unseal /=. Global Instance monPred_bi_löb : BiLöb PROP → BiLöb monPredI. Proof. rewrite {2}/BiLöb; unseal=> ? P HP; split=> i /=. apply löb_weak, HP. Qed. Global Instance monPred_bi_positive : BiPositive PROP → BiPositive monPredI. Proof. split => ?. rewrite /bi_affinely. unseal. apply bi_positive. Qed. Global Instance monPred_bi_affine : BiAffine PROP → BiAffine monPredI. Proof. split => ?. unseal. by apply affine. Qed. Global Instance monPred_bi_persistently_forall : BiPersistentlyForall PROP → BiPersistentlyForall monPredI. Proof. intros ? A φ. split=> /= i. unseal. by apply persistently_forall_2. Qed. Global Instance monPred_bi_pure_forall : BiPureForall PROP → BiPureForall monPredI. Proof. intros ? A φ. split=> /= i. unseal. by apply pure_forall_2. Qed. Global Instance monPred_bi_later_contractive : BiLaterContractive PROP → BiLaterContractive monPredI. Proof. intros ? n. unseal=> P Q HPQ. split=> i /=. f_contractive. apply HPQ. Qed. Global Instance monPred_bi_embed_emp : BiEmbedEmp PROP monPredI. Proof. split. by unseal. Qed. Global Instance monPred_bi_embed_later : BiEmbedLater PROP monPredI. Proof. split; by unseal. Qed. Global Instance monPred_bi_embed_internal_eq `{BiInternalEq PROP} : BiEmbedInternalEq PROP monPredI. Proof. split. by unseal. Qed. Global Instance monPred_bi_bupd_fupd `{BiBUpdFUpd PROP} : BiBUpdFUpd monPredI. Proof. intros E P. split=> i. unseal. apply bupd_fupd. Qed. Global Instance monPred_bi_embed_bupd `{!BiBUpd PROP} : BiEmbedBUpd PROP monPredI. Proof. split. by unseal. Qed. Global Instance monPred_bi_embed_fupd `{BiFUpd PROP} : BiEmbedFUpd PROP monPredI. Proof. split. by unseal. Qed. Global Instance monPred_bi_persistently_impl_plainly `{!BiPlainly PROP, !BiPersistentlyForall PROP, !BiPersistentlyImplPlainly PROP} : BiPersistentlyImplPlainly monPredI. Proof. intros P Q. split=> i. unseal. setoid_rewrite bi.pure_impl_forall. setoid_rewrite <-plainly_forall. do 2 setoid_rewrite bi.persistently_forall. by setoid_rewrite persistently_impl_plainly. Qed. Global Instance monPred_bi_prop_ext `{!BiPlainly PROP, !BiInternalEq PROP, !BiPropExt PROP} : BiPropExt monPredI. Proof. intros P Q. split=> i /=. rewrite /bi_wand_iff. unseal. rewrite -{3}(sig_monPred_sig P) -{3}(sig_monPred_sig Q) -f_equivI -sig_equivI !discrete_fun_equivI /=. f_equiv=> j. rewrite prop_ext. by rewrite !(bi.forall_elim j) !bi.pure_True // !bi.True_impl. Qed. Global Instance monPred_bi_plainly_exist `{!BiPlainly PROP, @BiIndexBottom I bot} : BiPlainlyExist PROP → BiPlainlyExist monPredI. Proof. split=> ? /=. unseal. 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 monPredI. Proof. split=> i. unseal. apply (anti_symm _). - by apply bi.forall_intro. - by rewrite (bi.forall_elim inhabitant). Qed. Global Instance monPred_bi_bupd_plainly `{BiBUpdPlainly PROP} : BiBUpdPlainly monPredI. Proof. intros P. split=> /= i. unseal. by rewrite bi.forall_elim bupd_plainly. Qed. Global Instance monPred_bi_fupd_plainly `{BiFUpdPlainly PROP} : BiFUpdPlainly monPredI. Proof. split; rewrite /bi_except_0; unseal. - intros E P. split=>/= i. by rewrite (bi.forall_elim i) fupd_plainly_mask_empty. - intros E P R. split=>/= i. rewrite (bi.forall_elim i) bi.pure_True // bi.True_impl. by rewrite (bi.forall_elim i) fupd_plainly_keep_l. - intros E P. split=>/= i. by rewrite (bi.forall_elim i) fupd_plainly_later. - intros E A Φ. split=>/= i. rewrite -fupd_plainly_forall_2. apply bi.forall_mono=> x. by rewrite (bi.forall_elim i). Qed. End instances. (** The final unseal tactic that also unfolds the BI layer. *) Module Import monPred. Ltac unseal := rewrite !monPred_unseal /=. End monPred. Class Objective {I : biIndex} {PROP : bi} (P : monPred I PROP) := objective_at i j : P i ⊢ P j. Global Arguments Objective {_ _} _%I. Global Arguments objective_at {_ _} _%I {_}. Global Hint Mode Objective + + ! : typeclass_instances. Global 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. (** monPred_at unfolding laws *) 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 : ( P) i ⊣⊢ (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 : ( P) i ⊣⊢ ∀ j, P j. Proof. by unseal. Qed. Lemma monPred_at_subjectively i P : ( P) i ⊣⊢ ∃ j, P j. Proof. by unseal. Qed. Lemma monPred_at_persistently_if i p P : (?p P) i ⊣⊢ ?p (P i). Proof. destruct p=>//=. apply monPred_at_persistently. Qed. Lemma monPred_at_affinely i P : ( P) i ⊣⊢ (P i). Proof. by rewrite /bi_affinely monPred_at_and monPred_at_emp. Qed. Lemma monPred_at_affinely_if i p P : (?p P) i ⊣⊢ ?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 : ( P) i ⊣⊢ (P i). Proof. by rewrite /bi_absorbingly monPred_at_sep monPred_at_pure. Qed. Lemma monPred_at_absorbingly_if i p P : (?p P) i ⊣⊢ ?p (P i). Proof. destruct p=>//=. apply monPred_at_absorbingly. 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. (** 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. Lemma monPred_persistent P : (∀ i, Persistent (P i)) → Persistent P. Proof. intros HP. constructor=> i. unseal. apply HP. Qed. Lemma monPred_absorbing P : (∀ i, Absorbing (P i)) → Absorbing P. Proof. intros HP. constructor=> i. rewrite /bi_absorbingly. unseal. apply HP. Qed. Lemma monPred_affine P : (∀ i, Affine (P i)) → Affine P. Proof. intros HP. constructor=> i. unseal. apply HP. 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). rewrite /Absorbing /bi_absorbingly. 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 depends on the index. *) Global Instance monPred_in_persistent i : Persistent (@monPred_in I PROP i). Proof. apply monPred_persistent=> j. rewrite monPred_at_in. apply _. Qed. Global Instance monPred_in_absorbing i : Absorbing (@monPred_in I PROP i). Proof. apply monPred_absorbing=> j. rewrite monPred_at_in. apply _. Qed. Lemma monPred_at_embed i (P : PROP) : monPred_at ⎡P⎤ i ⊣⊢ P. Proof. by unseal. Qed. Lemma monPred_emp_unfold : emp%I =@{monPred} ⎡emp : PROP⎤%I. Proof. by unseal. Qed. Lemma monPred_pure_unfold : bi_pure =@{_ → monPred} λ φ, ⎡ ⌜ φ ⌝ : 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) → ( P ⊢ 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 `{!BiPersistentlyForall PROP} P : Persistent P → Persistent ( P). Proof. rewrite monPred_objectively_unfold. apply _. Qed. Global Instance monPred_objectively_absorbing P : Absorbing P → Absorbing ( P). Proof. rewrite monPred_objectively_unfold. apply _. Qed. Global Instance monPred_objectively_affine P : Affine P → Affine ( 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) → P ⊢ 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 ( P). Proof. rewrite monPred_subjectively_unfold. apply _. Qed. Global Instance monPred_subjectively_absorbing P : Absorbing P → Absorbing ( P). Proof. rewrite monPred_subjectively_unfold. apply _. Qed. Global Instance monPred_subjectively_affine P : Affine P → Affine ( P). Proof. rewrite monPred_subjectively_unfold. apply _. Qed. (* Laws for monPred_objectively and of Objective. *) Lemma monPred_objectively_elim P : P ⊢ P. Proof. rewrite monPred_objectively_unfold. unseal. split=>?. apply bi.forall_elim. Qed. Lemma monPred_objectively_idemp P : P ⊣⊢ P. Proof. apply bi.equiv_entails; split; [by apply monPred_objectively_elim|]. unseal. split=>i /=. by apply bi.forall_intro=>_. Qed. Lemma monPred_objectively_forall {A} (Φ : A → monPred) : (∀ x, Φ x) ⊣⊢ ∀ x, (Φ x). Proof. unseal. split=>i. apply bi.equiv_entails; split=>/=; do 2 apply bi.forall_intro=>?; by do 2 rewrite bi.forall_elim. Qed. Lemma monPred_objectively_and P Q : (P ∧ Q) ⊣⊢ P ∧ Q. Proof. unseal. split=>i. apply bi.equiv_entails; 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, (Φ x)) ⊢ (∃ x, (Φ x)). Proof. apply bi.exist_elim=>?. f_equiv. apply bi.exist_intro. Qed. Lemma monPred_objectively_or P Q : P ∨ Q ⊢ (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 : P ∗ Q ⊢ (P ∗ Q). Proof. unseal. split=>i /=. apply bi.forall_intro=>?. by rewrite !bi.forall_elim. Qed. Lemma monPred_objectively_sep `{BiIndexBottom bot} P Q : (P ∗ Q) ⊣⊢ P ∗ Q. Proof. apply bi.equiv_entails, 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) : ⎡P⎤ ⊣⊢@{monPredI} ⎡P⎤. Proof. apply bi.equiv_entails; split; unseal; split=>i /=. - by rewrite (bi.forall_elim inhabitant). - by apply bi.forall_intro. Qed. Lemma monPred_objectively_emp : (emp : monPred) ⊣⊢ emp. Proof. rewrite monPred_emp_unfold. apply monPred_objectively_embed. Qed. Lemma monPred_objectively_pure φ : (⌜ φ ⌝ : monPred) ⊣⊢ ⌜ φ ⌝. Proof. rewrite monPred_pure_unfold. apply monPred_objectively_embed. Qed. Lemma monPred_subjectively_intro P : P ⊢ P. Proof. unseal. split=>?. apply bi.exist_intro. Qed. Lemma monPred_subjectively_forall {A} (Φ : A → monPred) : ( (∀ x, Φ x)) ⊢ ∀ x, (Φ x). Proof. apply bi.forall_intro=>?. f_equiv. apply bi.forall_elim. Qed. Lemma monPred_subjectively_and P Q : (P ∧ Q) ⊢ P ∧ 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) : (∃ x, Φ x) ⊣⊢ ∃ x, (Φ x). Proof. unseal. split=>i. apply bi.equiv_entails; split=>/=; do 2 apply bi.exist_elim=>?; by do 2 rewrite -bi.exist_intro. Qed. Lemma monPred_subjectively_or P Q : (P ∨ Q) ⊣⊢ P ∨ Q. Proof. split=>i. unseal. apply bi.or_exist. Qed. Lemma monPred_subjectively_sep P Q : (P ∗ Q) ⊢ P ∗ Q. Proof. unseal. split=>i /=. apply bi.exist_elim=>?. by rewrite -!bi.exist_intro. Qed. Lemma monPred_subjectively_idemp P : P ⊣⊢ P. Proof. apply bi.equiv_entails; split; [|by apply monPred_subjectively_intro]. unseal. split=>i /=. by apply bi.exist_elim=>_. Qed. Lemma objective_objectively P `{!Objective P} : P ⊢ P. Proof. rewrite monPred_objectively_unfold /= embed_forall. apply bi.forall_intro=>?. split=>?. unseal. apply objective_at, _. Qed. Lemma objective_subjectively P `{!Objective P} : 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 ( P). Proof. intros ??. by unseal. Qed. Global Instance subjectively_objective P : Objective ( 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 ( P). Proof. intros i j. unseal. by rewrite objective_at. Qed. Global Instance affinely_objective P `{!Objective P} : Objective ( 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 ( P). Proof. rewrite /bi_absorbingly. apply _. Qed. Global Instance persistently_if_objective P p `{!Objective P} : Objective (?p P). Proof. rewrite /bi_persistently_if. destruct p; apply _. Qed. Global Instance affinely_if_objective P p `{!Objective P} : Objective (?p P). Proof. rewrite /bi_affinely_if. destruct p; apply _. Qed. Global Instance absorbingly_if_objective P p `{!Objective P} : Objective (?p P). Proof. rewrite /bi_absorbingly_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, (Φ k x)) ⊢ ([∗ 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, (Φ k x)) ⊢ ([∗ 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, (Φ y)) ⊢ ([∗ 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, (Φ y)) ⊢ ([∗ 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 : ([∗ list] k↦x ∈ l, Φ k x) ⊣⊢ ([∗ list] k↦x ∈ l, (Φ 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) : ([∗ map] k↦x ∈ m, Φ k x) ⊣⊢ ([∗ map] k↦x ∈ m, (Φ k x)). Proof. apply (big_opM_commute _). Qed. Lemma monPred_objectively_big_sepS `{BiIndexBottom bot} `{Countable A} (Φ : A → monPred) (X : gset A) : ([∗ set] y ∈ X, Φ y) ⊣⊢ ([∗ set] y ∈ X, (Φ y)). Proof. apply (big_opS_commute _). Qed. Lemma monPred_objectively_big_sepMS `{BiIndexBottom bot} `{Countable A} (Φ : A → monPred) (X : gmultiset A) : ([∗ mset] y ∈ X, Φ y) ⊣⊢ ([∗ mset] y ∈ X, (Φ 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). 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). 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). 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). Proof. intros ??. rewrite !monPred_at_big_sepMS. do 2 f_equiv. by apply objective_at. Qed. (** BUpd *) Lemma monPred_at_bupd `{!BiBUpd PROP} i P : (|==> P) i ⊣⊢ |==> P i. Proof. by rewrite monPred_bupd_unseal. Qed. Global Instance bupd_objective `{!BiBUpd PROP} P `{!Objective P} : Objective (|==> P). Proof. intros ??. by rewrite !monPred_at_bupd objective_at. Qed. (** Later *) Global Instance monPred_at_timeless P i : Timeless P → Timeless (P i). Proof. move => [] /(_ i). rewrite /Timeless /bi_except_0. by unseal. Qed. Global Instance monPred_in_timeless i0 : Timeless (@monPred_in I PROP i0). Proof. split => ? /=. rewrite /bi_except_0. unseal. apply timeless, _. Qed. Global Instance monPred_objectively_timeless P : Timeless P → Timeless ( P). Proof. move=>[]. rewrite /Timeless /bi_except_0. unseal=>Hti. split=> ? /=. by apply timeless, bi.forall_timeless. Qed. Global Instance monPred_subjectively_timeless P : Timeless P → Timeless ( P). Proof. move=>[]. rewrite /Timeless /bi_except_0. unseal=>Hti. split=> ? /=. by apply timeless, bi.exist_timeless. 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 as [|? IHn]; first done. rewrite /= monPred_at_later IHn //. Qed. Lemma monPred_at_except_0 i P : (◇ P) i ⊣⊢ ◇ P i. Proof. rewrite /bi_except_0. 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 /bi_except_0. apply _. Qed. (** Internal equality *) Lemma monPred_internal_eq_unfold `{!BiInternalEq PROP} : @internal_eq monPredI _ = λ A x y, ⎡ x ≡ y ⎤%I. Proof. rewrite monPred_internal_eq_unseal. by unseal. Qed. Lemma monPred_at_internal_eq `{!BiInternalEq PROP} {A : ofe} i (a b : A) : @monPred_at (a ≡ b) i ⊣⊢ a ≡ b. Proof. rewrite monPred_internal_eq_unfold. by apply monPred_at_embed. Qed. Lemma monPred_equivI `{!BiInternalEq PROP'} P Q : P ≡ Q ⊣⊢@{PROP'} ∀ i, P i ≡ Q i. Proof. apply bi.equiv_entails. split. - apply bi.forall_intro=> ?. apply (f_equivI (flip monPred_at _)). - by rewrite -{2}(sig_monPred_sig P) -{2}(sig_monPred_sig Q) -f_equivI -sig_equivI !discrete_fun_equivI. Qed. Global Instance internal_eq_objective `{!BiInternalEq PROP} {A : ofe} (x y : A) : @Objective I PROP (x ≡ y). Proof. intros ??. rewrite monPred_internal_eq_unfold. by unseal. Qed. (** FUpd *) Lemma monPred_at_fupd `{!BiFUpd PROP} i E1 E2 P : (|={E1,E2}=> P) i ⊣⊢ |={E1,E2}=> P i. Proof. by rewrite monPred_fupd_unseal. Qed. Global Instance fupd_objective E1 E2 P `{!Objective P} `{!BiFUpd PROP} : Objective (|={E1,E2}=> P). Proof. intros ??. by rewrite !monPred_at_fupd objective_at. Qed. (** Plainly *) Lemma monPred_plainly_unfold `{!BiPlainly PROP} : plainly = λ P, ⎡ ∀ i, ■ (P i) ⎤%I. Proof. by rewrite monPred_plainly_unseal monPred_embed_unseal. Qed. Lemma monPred_at_plainly `{!BiPlainly PROP} i P : (■ P) i ⊣⊢ ∀ j, ■ (P j). Proof. by rewrite monPred_plainly_unseal. 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 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 ( P). Proof. rewrite monPred_objectively_unfold. apply _. Qed. Global Instance monPred_subjectively_plain `{!BiPlainly PROP} P : Plain P → Plain ( P). Proof. rewrite monPred_subjectively_unfold. apply _. Qed. End bi_facts. iris-iris-4.2.0/iris/bi/notation.v000066400000000000000000000200761460620107300170150ustar00rootroot00000000000000From iris.prelude Require Import options. (** 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 "(⊢)". Reserved Notation "'(⊢@{' PROP } )". Reserved Notation "( P ⊣⊢.)". Reserved Notation "(.⊣⊢ Q )". Reserved Notation "P ⊣⊢ Q" (at level 95, no associativity). Reserved Notation "P '⊣⊢@{' PROP } Q" (at level 95, no associativity). Reserved Notation "(⊣⊢)". Reserved Notation "'(⊣⊢@{' PROP } )". Reserved Notation "(.⊢ Q )". Reserved Notation "( P ⊢.)". Reserved Notation "⊢ Q" (at level 20, Q at level 200). Reserved Notation "'⊢@{' PROP } Q" (at level 20, Q at level 200). (** The definition must coincide with "'⊢@{' PROP } Q". *) Reserved Notation "'(⊢@{' PROP } Q )". (** Rationale: Notation [( '⊢@{' PROP } )] prevents parsing [(⊢@{PROP} Q)] using the [⊢@{PROP} Q] notation; since the latter parse arises from composing two notations, it is missed by the automatic left-factorization. To fix that, we force left-factorization by explicitly composing parentheses with ['⊢@{' PROP } Q] into the new notation [( '⊢@{' PROP } Q )], which successfully undergoes automatic left-factoring. *) (** * BI connectives *) Reserved Notation "'emp'". Reserved Notation "'⌜' φ '⌝'" (at level 1, φ at level 200, format "⌜ φ ⌝"). Reserved Notation "P ∗ Q" (at level 80, right associativity, format "P ∗ '/' Q"). Reserved Notation "P -∗ Q" (at level 99, Q at level 200, right associativity, format "'[' P -∗ '/' '[' Q ']' ']'"). Reserved Notation "⎡ P ⎤". (** Modalities *) 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 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 "'' 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 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 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 "'' P" (at level 20, right associativity). Reserved Notation "'' 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 ']' ']'"). (** Step-taking fancy updates *) 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 ']' ']'"). (** Multi-step-taking fancy updates *) Reserved Notation "|={ E1 } [ E2 ]▷=>^ n Q" (at level 99, E1, E2 at level 50, n at level 9, Q at level 200, format "'[ ' |={ E1 } [ E2 ]▷=>^ n '/' Q ']'"). Reserved Notation "P ={ E1 } [ E2 ]▷=∗^ n Q" (at level 99, E1, E2 at level 50, n at level 9, Q at level 200, format "'[' P ={ E1 } [ E2 ]▷=∗^ n '/' '[' Q ']' ']'"). Reserved Notation "|={ E }▷=>^ n Q" (at level 99, E at level 50, n at level 9, Q at level 200, format "'[ ' |={ E }▷=>^ n '/' Q ']'"). Reserved Notation "P ={ E }▷=∗^ n Q" (at level 99, E at level 50, n at level 9, Q at level 200, format "'[' P ={ E }▷=∗^ n '/' '[' Q ']' ']'"). (** * Big Ops *) Reserved Notation "'[∗' 'list]' k ↦ x ∈ l , P" (at level 200, l at level 10, k binder, x binder, right associativity, format "[∗ list] k ↦ x ∈ l , P"). Reserved Notation "'[∗' 'list]' x ∈ l , P" (at level 200, l at level 10, x binder, 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 binder, x1 binder, x2 binder, 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 binder, x2 binder, 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 binder, x binder, right associativity, format "[∧ list] k ↦ x ∈ l , P"). Reserved Notation "'[∧' 'list]' x ∈ l , P" (at level 200, l at level 10, x binder, right associativity, format "[∧ list] x ∈ l , P"). Reserved Notation "'[∧]' Ps" (at level 20). Reserved Notation "'[∨' 'list]' k ↦ x ∈ l , P" (at level 200, l at level 10, k binder, x binder, right associativity, format "[∨ list] k ↦ x ∈ l , P"). Reserved Notation "'[∨' 'list]' x ∈ l , P" (at level 200, l at level 10, x binder, 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 binder, x binder, right associativity, format "[∗ map] k ↦ x ∈ m , P"). Reserved Notation "'[∗' 'map]' x ∈ m , P" (at level 200, m at level 10, x binder, right associativity, format "[∗ map] x ∈ m , P"). Reserved Notation "'[∗' 'map]' k ↦ x1 ; x2 ∈ m1 ; m2 , P" (at level 200, m1, m2 at level 10, k binder, x1 binder, x2 binder, right associativity, format "[∗ map] k ↦ x1 ; x2 ∈ m1 ; m2 , P"). Reserved Notation "'[∗' 'map]' x1 ; x2 ∈ m1 ; m2 , P" (at level 200, m1, m2 at level 10, x1 binder, x2 binder, right associativity, format "[∗ map] x1 ; x2 ∈ m1 ; m2 , P"). Reserved Notation "'[∧' 'map]' k ↦ x ∈ m , P" (at level 200, m at level 10, k binder, x binder, right associativity, format "[∧ map] k ↦ x ∈ m , P"). Reserved Notation "'[∧' 'map]' x ∈ m , P" (at level 200, m at level 10, x binder, right associativity, format "[∧ map] x ∈ m , P"). Reserved Notation "'[∗' 'set]' x ∈ X , P" (at level 200, X at level 10, x binder, right associativity, format "[∗ set] x ∈ X , P"). Reserved Notation "'[∗' 'mset]' x ∈ X , P" (at level 200, X at level 10, x binder, right associativity, format "[∗ mset] x ∈ X , P"). (** Define the scope *) Declare Scope bi_scope. Delimit Scope bi_scope with I. iris-iris-4.2.0/iris/bi/plainly.v000066400000000000000000000747141460620107300166420ustar00rootroot00000000000000From iris.algebra Require Import monoid. From iris.bi Require Import derived_laws_later big_op internal_eq. From iris.prelude Require Import options. Import interface.bi derived_laws.bi derived_laws_later.bi. (* We enable primitive projections in this file to improve the performance of the Iris proofmode: primitive projections for the bi-records makes the proofmode faster. *) Local Set Primitive Projections. (* The sections add [BiAffine] and the like, which is only picked up with "Type"*. *) Set Default Proof Using "Type*". Class Plainly (PROP : Type) := plainly : PROP → PROP. Global Arguments plainly {PROP}%type_scope {_} _%I. Global Hint Mode Plainly ! : typeclass_instances. Global Instance: Params (@plainly) 2 := {}. Global Typeclasses Opaque plainly. Notation "■ P" := (plainly P) : bi_scope. (* Mixins allow us to create instances easily without having to use Program *) Record BiPlainlyMixin (PROP : bi) `(Plainly PROP) := { bi_plainly_mixin_plainly_ne : NonExpansive (plainly (PROP:=PROP)); bi_plainly_mixin_plainly_mono (P Q : PROP) : (P ⊢ Q) → ■ P ⊢ ■ Q; bi_plainly_mixin_plainly_elim_persistently (P : PROP) : ■ P ⊢ P; bi_plainly_mixin_plainly_idemp_2 (P : PROP) : ■ P ⊢ ■ ■ P; bi_plainly_mixin_plainly_forall_2 {A} (Ψ : A → PROP) : (∀ a, ■ (Ψ a)) ⊢ ■ (∀ a, Ψ a); (* The following law and [persistently_impl_plainly] below 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_plainly_impl_plainly (P Q : PROP) : (■ P → ■ Q) ⊢ ■ (■ P → Q); bi_plainly_mixin_plainly_emp_intro (P : PROP) : P ⊢ ■ emp; bi_plainly_mixin_plainly_absorb (P Q : PROP) : ■ P ∗ Q ⊢ ■ P; bi_plainly_mixin_later_plainly_1 (P : PROP) : ▷ ■ P ⊢ ■ ▷ P; bi_plainly_mixin_later_plainly_2 (P : PROP) : ■ ▷ P ⊢ ▷ ■ P; }. Class BiPlainly (PROP : bi) := { #[global] bi_plainly_plainly :: Plainly PROP; bi_plainly_mixin : BiPlainlyMixin PROP bi_plainly_plainly; }. Global Hint Mode BiPlainly ! : typeclass_instances. Global Arguments bi_plainly_plainly : simpl never. Class BiPersistentlyImplPlainly `{!BiPlainly PROP} := persistently_impl_plainly (P Q : PROP) : (■ P → Q) ⊢ (■ P → Q). Global Arguments BiPersistentlyImplPlainly : clear implicits. Global Arguments BiPersistentlyImplPlainly _ {_}. Global Arguments persistently_impl_plainly _ {_ _} _. Global Hint Mode BiPersistentlyImplPlainly ! - : typeclass_instances. Class BiPlainlyExist {PROP: bi} `{!BiPlainly PROP} := plainly_exist_1 A (Ψ : A → PROP) : ■ (∃ a, Ψ a) ⊢ ∃ a, ■ (Ψ a). Global Arguments BiPlainlyExist : clear implicits. Global Arguments BiPlainlyExist _ {_}. Global Arguments plainly_exist_1 _ {_ _} _. Global Hint Mode BiPlainlyExist ! - : typeclass_instances. Class BiPropExt {PROP: bi} `{!BiPlainly PROP, !BiInternalEq PROP} := prop_ext_2 (P Q : PROP) : ■ (P ∗-∗ Q) ⊢ P ≡ Q. Global Arguments BiPropExt : clear implicits. Global Arguments BiPropExt _ {_ _}. Global Arguments prop_ext_2 _ {_ _ _} _. Global Hint Mode BiPropExt ! - - : typeclass_instances. Section plainly_laws. Context {PROP: bi} `{!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 ⊢ 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 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 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 {PROP: bi} `{!BiPlainly PROP} (P : PROP) := plain : P ⊢ ■ P. Global Arguments Plain {_ _} _%I : simpl never. Global Arguments plain {_ _} _%I {_}. Global Hint Mode Plain + - ! : typeclass_instances. Global Instance: Params (@Plain) 1 := {}. Definition plainly_if {PROP: bi} `{!BiPlainly PROP} (p : bool) (P : PROP) : PROP := (if p then ■ P else P)%I. Global Arguments plainly_if {_ _} !_ _%I /. Global Instance: Params (@plainly_if) 2 := {}. Global Typeclasses Opaque plainly_if. Notation "■? p P" := (plainly_if p P) : bi_scope. (* Derived laws *) Section plainly_derived. Context {PROP: bi} `{!BiPlainly PROP}. Implicit Types P : PROP. Local Hint Resolve pure_intro forall_intro : core. Local Hint Resolve or_elim or_intro_l' or_intro_r' : core. Local Hint Resolve and_intro and_elim_l' and_elim_r' : core. 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 : ■ P ⊢ P. Proof. by rewrite plainly_elim_persistently /bi_affinely persistently_and_emp_elim. Qed. Lemma persistently_elim_plainly P : ■ 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 : ?p ■ P ⊣⊢ ■ P. Proof. destruct p; last done. exact: persistently_elim_plainly. Qed. Lemma plainly_persistently_elim P : ■ P ⊣⊢ ■ P. Proof. apply (anti_symm _). - rewrite -{1}(left_id True%I bi_and (■ _)%I) (plainly_emp_intro True). 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 : ■ 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 ⊢ 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_emp_2 : emp ⊢@{PROP} ■ emp. Proof. apply plainly_emp_intro. 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) 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). by rewrite plainly_and_sep_assoc (comm bi_and) plainly_and_emp_elim. Qed. Lemma plainly_affinely_elim P : ■ 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 (_ ∗ _)) 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) 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) ⊣⊢ ( ■ P -∗ Q). Proof. by rewrite -(persistently_elim_plainly P) impl_wand_intuitionistically. Qed. Lemma persistently_wand_affinely_plainly `{!BiPersistentlyImplPlainly PROP} P Q : ( ■ P -∗ Q) ⊢ ( ■ P -∗ Q). Proof. rewrite -!impl_wand_affinely_plainly. apply: persistently_impl_plainly. Qed. Lemma plainly_wand_affinely_plainly P Q : ( ■ P -∗ ■ Q) ⊢ ■ ( ■ 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. Global Instance impl_persistent `{!BiPersistentlyImplPlainly PROP} 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 `{!BiPersistentlyImplPlainly PROP} P Q : Plain P → Persistent Q → Absorbing Q → Persistent (P -∗ Q). Proof. intros. rewrite /Persistent {2}(plain P). trans ( (■ 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. Global Instance limit_preserving_Plain {A : ofe} `{!Cofe A} (Φ : A → PROP) : NonExpansive Φ → LimitPreserving (λ x, Plain (Φ x)). Proof. intros. apply limit_preserving_entails; solve_proper. Qed. (* Instances for big operators *) 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_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; try apply _. simpl. rewrite plainly_emp. done. Qed. Global Instance plainly_sep_homomorphism `{!BiAffine PROP} : MonoidHomomorphism bi_sep bi_sep (≡) (@plainly PROP _). Proof. split; try apply _. apply plainly_emp. Qed. 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. Lemma big_sepL_plainly `{!BiAffine PROP} {A} (Φ : nat → A → PROP) l : ■ ([∗ list] k↦x ∈ l, Φ k x) ⊣⊢ [∗ list] k↦x ∈ l, ■ (Φ k x). Proof. apply (big_opL_commute _). Qed. Lemma big_andL_plainly {A} (Φ : nat → A → PROP) l : ■ ([∧ list] k↦x ∈ l, Φ k x) ⊣⊢ [∧ list] k↦x ∈ l, ■ (Φ k x). Proof. apply (big_opL_commute _). Qed. Lemma big_orL_plainly `{!BiPlainlyExist PROP} {A} (Φ : nat → A → PROP) l : ■ ([∨ list] k↦x ∈ l, Φ k x) ⊣⊢ [∨ list] k↦x ∈ l, ■ (Φ k x). Proof. apply (big_opL_commute _). Qed. Lemma big_sepL2_plainly `{!BiAffine PROP} {A B} (Φ : nat → A → B → 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. Lemma big_sepM_plainly `{!BiAffine PROP, Countable K} {A} (Φ : K → A → PROP) m : ■ ([∗ map] k↦x ∈ m, Φ k x) ⊣⊢ [∗ map] k↦x ∈ m, ■ (Φ k x). Proof. apply (big_opM_commute _). Qed. Lemma big_sepM2_plainly `{!BiAffine PROP, Countable K} {A B} (Φ : K → A → B → PROP) m1 m2 : ■ ([∗ map] k↦x1;x2 ∈ m1;m2, Φ k x1 x2) ⊣⊢ [∗ map] k↦x1;x2 ∈ m1;m2, ■ (Φ k x1 x2). Proof. by rewrite !big_sepM2_alt plainly_and plainly_pure big_sepM_plainly. Qed. Lemma big_sepS_plainly `{!BiAffine PROP, Countable A} (Φ : A → PROP) X : ■ ([∗ set] y ∈ X, Φ y) ⊣⊢ [∗ set] y ∈ X, ■ (Φ y). Proof. apply (big_opS_commute _). Qed. Lemma big_sepMS_plainly `{!BiAffine PROP, Countable A} (Φ : A → PROP) X : ■ ([∗ mset] y ∈ X, Φ y) ⊣⊢ [∗ mset] y ∈ X, ■ (Φ y). Proof. apply (big_opMS_commute _). 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 ( P). Proof. rewrite /Plain=> HP. rewrite {1}HP plainly_persistently_elim persistently_elim_plainly //. Qed. Global Instance affinely_plain P : Plain P → Plain ( 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 ( 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. Global Instance big_sepL_nil_plain {A} (Φ : nat → A → PROP) : Plain ([∗ list] k↦x ∈ [], Φ k x). Proof. simpl; apply _. Qed. Global Instance big_sepL_plain {A} (Φ : nat → A → PROP) 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_andL_nil_plain {A} (Φ : nat → A → PROP) : Plain ([∧ list] k↦x ∈ [], Φ k x). Proof. simpl; apply _. Qed. Global Instance big_andL_plain {A} (Φ : nat → A → PROP) 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_orL_nil_plain {A} (Φ : nat → A → PROP) : Plain ([∨ list] k↦x ∈ [], Φ k x). Proof. simpl; apply _. Qed. Global Instance big_orL_plain {A} (Φ : nat → A → PROP) 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_sepL2_nil_plain {A B} (Φ : nat → A → B → PROP) : Plain ([∗ list] k↦y1;y2 ∈ []; [], Φ k y1 y2). Proof. simpl; apply _. Qed. Global Instance big_sepL2_plain {A B} (Φ : nat → A → B → 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. Global Instance big_sepM_empty_plain `{Countable K} {A} (Φ : K → A → PROP) : Plain ([∗ map] k↦x ∈ ∅, Φ k x). Proof. rewrite big_opM_empty. apply _. Qed. Global Instance big_sepM_plain `{Countable K} {A} (Φ : K → A → PROP) m : (∀ k x, Plain (Φ k x)) → Plain ([∗ map] k↦x ∈ m, Φ k x). Proof. induction m using map_ind; [rewrite big_opM_empty|rewrite big_opM_insert //]; apply _. Qed. Global Instance big_sepM2_empty_plain `{Countable K} {A B} (Φ : K → A → B → PROP) : Plain ([∗ map] k↦x1;x2 ∈ ∅;∅, Φ k x1 x2). Proof. rewrite big_sepM2_empty. apply _. Qed. Global Instance big_sepM2_plain `{Countable K} {A B} (Φ : K → A → B → PROP) m1 m2 : (∀ k x1 x2, Plain (Φ k x1 x2)) → Plain ([∗ map] k↦x1;x2 ∈ m1;m2, Φ k x1 x2). Proof. intros. rewrite big_sepM2_alt. apply _. Qed. Global Instance big_sepS_empty_plain `{Countable A} (Φ : A → PROP) : Plain ([∗ set] x ∈ ∅, Φ x). Proof. rewrite big_opS_empty. apply _. Qed. Global Instance big_sepS_plain `{Countable A} (Φ : A → PROP) X : (∀ x, Plain (Φ x)) → Plain ([∗ set] x ∈ X, Φ x). Proof. induction X using set_ind_L; [rewrite big_opS_empty|rewrite big_opS_insert //]; apply _. Qed. Global Instance big_sepMS_empty_plain `{Countable A} (Φ : A → PROP) : Plain ([∗ mset] x ∈ ∅, Φ x). Proof. rewrite big_opMS_empty. apply _. Qed. Global Instance big_sepMS_plain `{Countable A} (Φ : A → PROP) X : (∀ x, Plain (Φ x)) → Plain ([∗ mset] x ∈ X, Φ x). Proof. induction X using gmultiset_ind; [rewrite big_opMS_empty|rewrite big_opMS_insert]; apply _. Qed. Global Instance plainly_timeless P `{!BiPlainlyExist PROP} : Timeless P → Timeless (■ P). Proof. intros. rewrite /Timeless /bi_except_0 later_plainly_1. by rewrite (timeless P) /bi_except_0 plainly_or {1}plainly_elim. Qed. (* Interaction with equality *) Section internal_eq. Context `{!BiInternalEq PROP}. Lemma plainly_internal_eq {A:ofe} (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. Global Instance internal_eq_plain {A : ofe} (a b : A) : Plain (PROP:=PROP) (a ≡ b). Proof. by intros; rewrite /Plain plainly_internal_eq. Qed. End internal_eq. Section prop_ext. Context `{!BiInternalEq PROP, !BiPropExt PROP}. Lemma prop_ext P Q : P ≡ Q ⊣⊢ ■ (P ∗-∗ Q). Proof. apply (anti_symm (⊢)); last exact: prop_ext_2. apply (internal_eq_rewrite' P Q (λ Q, ■ (P ∗-∗ Q))%I); [ solve_proper | done | ]. rewrite (plainly_emp_intro (P ≡ Q)). apply plainly_mono, wand_iff_refl. Qed. Lemma plainly_alt P : ■ P ⊣⊢ 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) True_impl. Qed. (* This proof uses [BiPlainlyExist] and [BiLöb] via [plainly_timeless] and [wand_timeless]. *) Global Instance internal_eq_timeless `{!BiPlainlyExist PROP, !BiLöb PROP} `{!Timeless P} `{!Timeless Q} : Timeless (PROP := PROP) (P ≡ Q). Proof. rewrite prop_ext. apply _. Qed. End prop_ext. (* 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 /bi_except_0 -plainly_or_2 -later_plainly plainly_pure. Qed. Lemma except_0_plainly `{!BiPlainlyExist PROP} P : ◇ ■ P ⊣⊢ ■ ◇ P. Proof. by rewrite /bi_except_0 plainly_or -later_plainly plainly_pure. 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 /bi_except_0; apply _. 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. *) Global Hint Immediate plain_persistent : typeclass_instances. iris-iris-4.2.0/iris/bi/telescopes.v000066400000000000000000000076771460620107300173440ustar00rootroot00000000000000From stdpp Require Export telescopes. From iris.bi Require Export bi. From iris.prelude Require Import options. Import bi. (* This cannot import the proofmode because it is imported by the proofmode! *) (** Telescopic quantifiers *) Definition bi_texist {PROP : bi} {TT : tele@{Quant}} (Ψ : TT → PROP) : PROP := tele_fold (@bi_exist PROP) (λ x, x) (tele_bind Ψ). Global Arguments bi_texist {_ !_} _ /. Definition bi_tforall {PROP : bi} {TT : tele@{Quant}} (Ψ : TT → PROP) : PROP := tele_fold (@bi_forall PROP) (λ x, x) (tele_bind Ψ). Global 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 telescopes. Context {PROP : bi} {TT : tele@{Quant}}. Implicit Types Ψ : TT → PROP. Lemma bi_tforall_forall Ψ : 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)). + destruct a=> /=. setoid_rewrite <- IH. rewrite 2!forall_elim. done. Qed. Lemma bi_texist_exist Ψ : 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. destruct 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. Global Instance bi_tforall_absorbing Ψ : (∀ x, Absorbing (Ψ x)) → Absorbing (∀.. x, Ψ x). Proof. rewrite bi_tforall_forall. apply _. Qed. Global Instance bi_tforall_persistent `{!BiPersistentlyForall PROP} Ψ : (∀ x, Persistent (Ψ x)) → Persistent (∀.. x, Ψ x). Proof. rewrite bi_tforall_forall. apply _. Qed. Global Instance bi_texist_affine Ψ : (∀ x, Affine (Ψ x)) → Affine (∃.. x, Ψ x). Proof. rewrite bi_texist_exist. apply _. Qed. Global Instance bi_texist_absorbing Ψ : (∀ x, Absorbing (Ψ x)) → Absorbing (∃.. x, Ψ x). Proof. rewrite bi_texist_exist. apply _. Qed. Global Instance bi_texist_persistent Ψ : (∀ x, Persistent (Ψ x)) → Persistent (∃.. x, Ψ x). Proof. rewrite bi_texist_exist. apply _. Qed. Global Instance bi_tforall_timeless Ψ : (∀ x, Timeless (Ψ x)) → Timeless (∀.. x, Ψ x). Proof. rewrite bi_tforall_forall. apply _. Qed. Global Instance bi_texist_timeless Ψ : (∀ x, Timeless (Ψ x)) → Timeless (∃.. x, Ψ x). Proof. rewrite bi_texist_exist. apply _. Qed. End telescopes. iris-iris-4.2.0/iris/bi/updates.v000066400000000000000000000676731460620107300166450ustar00rootroot00000000000000From stdpp Require Import coPset. From iris.bi Require Import interface derived_laws_later big_op plainly. From iris.prelude Require Import options. Import interface.bi derived_laws.bi derived_laws_later.bi. (* We enable primitive projections in this file to improve the performance of the Iris proofmode: primitive projections for the bi-records makes the proofmode faster. *) Local Set Primitive Projections. (* The sections add extra BI assumptions, which is only picked up with "Type"*. *) Set Default Proof Using "Type*". (* 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. Global Instance : Params (@bupd) 2 := {}. Global Hint Mode BUpd ! : typeclass_instances. Global Arguments bupd {_}%type_scope {_} _%bi_scope. Global Typeclasses Opaque bupd. Notation "|==> Q" := (bupd Q) : bi_scope. Notation "P ==∗ Q" := (P -∗ |==> Q)%I : bi_scope. Notation "P ==∗ Q" := (P -∗ |==> Q) : stdpp_scope. Class FUpd (PROP : Type) : Type := fupd : coPset → coPset → PROP → PROP. Global Instance: Params (@fupd) 4 := {}. Global Hint Mode FUpd ! : typeclass_instances. Global Arguments fupd {_}%type_scope {_} _ _ _%bi_scope. Global Typeclasses Opaque fupd. 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. (** * Step-taking fancy updates. *) (** These have two masks, but they are different than the two masks of a mask-changing update: in [|={Eo}[Ei]▷=> Q], the first mask [Eo] ("outer mask") holds at the beginning and the end; the second mask [Ei] ("inner mask") holds around each ▷. This is also why we use a different notation than for the two masks of a mask-changing updates. *) Notation "|={ Eo } [ Ei ]▷=> Q" := (|={Eo,Ei}=> ▷ |={Ei,Eo}=> Q)%I : bi_scope. Notation "P ={ Eo } [ Ei ]▷=∗ Q" := (P -∗ |={Eo}[Ei]▷=> Q)%I : bi_scope. Notation "P ={ Eo } [ Ei ]▷=∗ Q" := (P -∗ |={Eo}[Ei]▷=> Q) : stdpp_scope. Notation "|={ E }▷=> Q" := (|={E}[E]▷=> Q)%I : bi_scope. Notation "P ={ E }▷=∗ Q" := (P ={E}[E]▷=∗ Q)%I : bi_scope. Notation "P ={ E }▷=∗ Q" := (P ={E}[E]▷=∗ Q) : stdpp_scope. (** For the iterated version, in principle there are 4 masks: "outer" and "inner" of [|={Eo}[Ei]▷=>], as well as "begin" and "end" masks [E1] and [E2] that could potentially differ from [Eo]. The latter can be obtained from this notation by adding normal mask-changing update modalities: [ |={E1,Eo}=> |={Eo}[Ei]▷=>^n |={Eo,E2}=> Q] *) Notation "|={ Eo } [ Ei ]▷=>^ n Q" := (Nat.iter n (λ P, |={Eo}[Ei]▷=> P) Q)%I : bi_scope. Notation "P ={ Eo } [ Ei ]▷=∗^ n Q" := (P -∗ |={Eo}[Ei]▷=>^n Q)%I : bi_scope. Notation "P ={ Eo } [ Ei ]▷=∗^ n Q" := (P -∗ |={Eo}[Ei]▷=>^n Q) : stdpp_scope. Notation "|={ E }▷=>^ n Q" := (|={E}[E]▷=>^n Q)%I : bi_scope. Notation "P ={ E }▷=∗^ n Q" := (P ={E}[E]▷=∗^n Q)%I : bi_scope. Notation "P ={ E }▷=∗^ n Q" := (P ={E}[E]▷=∗^n Q) : stdpp_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 (PROP:=PROP)); 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 : bi) `(FUpd PROP) := { bi_fupd_mixin_fupd_ne E1 E2 : NonExpansive (fupd (PROP:=PROP) E1 E2); bi_fupd_mixin_fupd_mask_subseteq E1 E2 : E2 ⊆ E1 → ⊢@{PROP} |={E1,E2}=> |={E2,E1}=> emp; 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 R : PROP) : (|={E1,E2}=> P) ∗ R ⊢ |={E1,E2}=> P ∗ R; }. Class BiBUpd (PROP : bi) := { #[global] bi_bupd_bupd :: BUpd PROP; bi_bupd_mixin : BiBUpdMixin PROP bi_bupd_bupd; }. Global Hint Mode BiBUpd ! : typeclass_instances. Global Arguments bi_bupd_bupd : simpl never. Class BiFUpd (PROP : bi) := { #[global] bi_fupd_fupd :: FUpd PROP; bi_fupd_mixin : BiFUpdMixin PROP bi_fupd_fupd; }. Global Hint Mode BiFUpd ! : typeclass_instances. Global Arguments bi_fupd_fupd : simpl never. Class BiBUpdFUpd (PROP : bi) `{BiBUpd PROP, BiFUpd PROP} := bupd_fupd E (P : PROP) : (|==> P) ⊢ |={E}=> P. Global Hint Mode BiBUpdFUpd ! - - : typeclass_instances. Class BiBUpdPlainly (PROP : bi) `{!BiBUpd PROP, !BiPlainly PROP} := bupd_plainly (P : PROP) : (|==> ■ P) ⊢ P. Global Hint Mode BiBUpdPlainly ! - - : typeclass_instances. (** These rules for the interaction between the [■] and [|={E1,E2=>] modalities only make sense for affine logics. From the axioms below, one could derive [■ P ={E}=∗ P] (see the lemma [fupd_plainly_elim]), which in turn gives [True ={E}=∗ emp]. *) Class BiFUpdPlainly (PROP : bi) `{!BiFUpd PROP, !BiPlainly PROP} := { (** When proving a fancy update of a plain proposition, you can also prove it while being allowed to open all invariants. *) fupd_plainly_mask_empty E (P : PROP) : (|={E,∅}=> ■ P) ⊢ |={E}=> P; (** A strong eliminator (a la modus ponens) for the wand-fancy-update with a plain conclusion: We eliminate [R ={E}=∗ ■ P] by supplying an [R], but we get to keep the [R]. *) fupd_plainly_keep_l E (P R : PROP) : (R ={E}=∗ ■ P) ∗ R ⊢ |={E}=> P ∗ R; (** Later "almost" commutes with fancy updates over plain propositions. It commutes "almost" because of the ◇ modality, which is needed in the definition of fancy updates so one can remove laters of timeless propositions. *) fupd_plainly_later E (P : PROP) : (▷ |={E}=> ■ P) ⊢ |={E}=> ▷ ◇ P; (** Forall quantifiers commute with fancy updates over plain propositions. *) fupd_plainly_forall_2 E {A} (Φ : A → PROP) : (∀ x, |={E}=> ■ Φ x) ⊢ |={E}=> ∀ x, Φ x }. Global Hint Mode BiBUpdFUpd ! - - : typeclass_instances. Section bupd_laws. Context {PROP : bi} `{!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 {PROP : bi} `{!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. (** [iMod] with this lemma is useful to change the current mask to a subset, and obtain a fupd for changing it back. For the case where you want to get rid of a mask-changing fupd in the goal, [iApply fupd_mask_intro] avoids having to specify the mask. *) Lemma fupd_mask_subseteq {E1} E2 : E2 ⊆ E1 → ⊢@{PROP} |={E1,E2}=> |={E2,E1}=> emp. Proof. eapply bi_fupd_mixin_fupd_mask_subseteq, 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 R : PROP) : (|={E1,E2}=> P) ∗ R ⊢ |={E1,E2}=> P ∗ R. Proof. eapply bi_fupd_mixin_fupd_frame_r, bi_fupd_mixin. Qed. End fupd_laws. Section bupd_derived. Context {PROP : bi} `{!BiBUpd PROP}. Implicit Types P Q R : PROP. 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. Lemma bupd_idemp P : (|==> |==> P) ⊣⊢ |==> P. Proof. apply: anti_symm. - apply bupd_trans. - apply bupd_intro. Qed. Global Instance bupd_sep_homomorphism : MonoidHomomorphism bi_sep bi_sep (flip (⊢)) (bupd (PROP:=PROP)). Proof. split; [split|]; try apply _; [apply bupd_sep | apply bupd_intro]. Qed. Lemma bupd_or P Q : (|==> P) ∨ (|==> Q) ⊢ |==> (P ∨ Q). Proof. apply or_elim; apply bupd_mono; [ apply or_intro_l | apply or_intro_r ]. Qed. Global Instance bupd_or_homomorphism : MonoidHomomorphism bi_or bi_or (flip (⊢)) (bupd (PROP:=PROP)). Proof. split; [split|]; try apply _; [apply bupd_or | apply bupd_intro]. Qed. Lemma bupd_and P Q : (|==> (P ∧ Q)) ⊢ (|==> P) ∧ (|==> Q). Proof. apply and_intro; apply bupd_mono; [apply and_elim_l | apply and_elim_r]. Qed. Lemma bupd_exist A (Φ : A → PROP) : (∃ x : A, |==> Φ x) ⊢ |==> ∃ x : A, Φ x. Proof. apply exist_elim=> a. by rewrite -(exist_intro a). Qed. Lemma bupd_forall A (Φ : A → PROP) : (|==> ∀ x : A, Φ x) ⊢ ∀ x : A, |==> Φ x. Proof. apply forall_intro=> a. by rewrite -(forall_elim a). Qed. Lemma big_sepL_bupd {A} (Φ : nat → A → PROP) l : ([∗ list] k↦x ∈ l, |==> Φ k x) ⊢ |==> [∗ list] k↦x ∈ l, Φ k x. Proof. by rewrite (big_opL_commute _). Qed. Lemma big_sepM_bupd {A} `{Countable K} (Φ : K → A → PROP) l : ([∗ map] k↦x ∈ l, |==> Φ k x) ⊢ |==> [∗ map] k↦x ∈ l, Φ k x. Proof. by rewrite (big_opM_commute _). Qed. Lemma big_sepS_bupd `{Countable A} (Φ : A → PROP) l : ([∗ set] x ∈ l, |==> Φ x) ⊢ |==> [∗ set] x ∈ l, Φ x. Proof. by rewrite (big_opS_commute _). Qed. Lemma big_sepMS_bupd `{Countable A} (Φ : A → PROP) l : ([∗ mset] x ∈ l, |==> Φ x) ⊢ |==> [∗ mset] x ∈ l, Φ x. Proof. by rewrite (big_opMS_commute _). Qed. Lemma except_0_bupd P : ◇ (|==> P) ⊢ (|==> ◇ P). Proof. rewrite /bi_except_0. apply or_elim; eauto using bupd_mono, or_intro_r. by rewrite -bupd_intro -or_intro_l. Qed. Global Instance bupd_absorbing P : Absorbing P → Absorbing (|==> P). Proof. rewrite /Absorbing /bi_absorbingly bupd_frame_l =>-> //. Qed. Section bupd_plainly. Context `{!BiPlainly PROP, !BiBUpdPlainly PROP}. Lemma bupd_elim P `{!Plain P} : (|==> P) ⊢ P. Proof. by rewrite {1}(plain P) bupd_plainly. Qed. Lemma bupd_plain_forall {A} (Φ : A → PROP) `{∀ x, Plain (Φ x)} : (|==> ∀ x, Φ x) ⊣⊢ (∀ x, |==> Φ x). Proof. apply (anti_symm _). - apply bupd_forall. - rewrite -bupd_intro. apply forall_intro=> x. by rewrite (forall_elim x) bupd_elim. Qed. Global Instance bupd_plain P : Plain P → Plain (|==> P). Proof. intros. rewrite /Plain. rewrite {1}(plain P) {1}bupd_elim. by rewrite -bupd_intro. Qed. End bupd_plainly. End bupd_derived. Section fupd_derived. Context {PROP : bi} `{!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_mask_intro_subseteq E1 E2 P : E2 ⊆ E1 → P ⊢ |={E1,E2}=> |={E2,E1}=> P. Proof. intros HE. apply wand_entails', wand_intro_r. rewrite fupd_mask_subseteq; last exact: HE. rewrite !fupd_frame_r. rewrite left_id. done. Qed. Lemma fupd_intro E P : P ⊢ |={E}=> P. Proof. by rewrite {1}(fupd_mask_intro_subseteq E E P) // fupd_trans. 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_idemp E P : (|={E}=> |={E}=> P) ⊣⊢ |={E}=> P. Proof. apply: anti_symm. - apply fupd_trans. - apply fupd_intro. Qed. (** Weaken the first mask of the goal from [E1] to [E2]. This lemma is intended to be [iApply]ed. However, usually you can [iMod (fupd_mask_subseteq E2)] instead and that will be slightly more convenient. *) Lemma fupd_mask_weaken {E1} E2 {E3 P} : E2 ⊆ E1 → ((|={E2,E1}=> emp) ={E2,E3}=∗ P) ⊢ |={E1,E3}=> P. Proof. intros HE. apply wand_entails', wand_intro_r. rewrite {1}(fupd_mask_subseteq E2) //. rewrite fupd_frame_r. by rewrite wand_elim_r fupd_trans. Qed. (** Introduction lemma for a mask-changing fupd. This lemma is intended to be [iApply]ed. *) Lemma fupd_mask_intro E1 E2 P : E2 ⊆ E1 → ((|={E2,E1}=> emp) -∗ P) ⊢ |={E1,E2}=> P. Proof. intros. etrans; [|by apply fupd_mask_weaken]. by rewrite -fupd_intro. Qed. Lemma fupd_mask_intro_discard E1 E2 P `{!Absorbing P} : E2 ⊆ E1 → P ⊢ |={E1,E2}=> P. Proof. intros. etrans; [|by apply fupd_mask_intro]. apply wand_intro_r. rewrite sep_elim_l. done. Qed. Lemma fupd_frame_l E1 E2 R Q : (R ∗ |={E1,E2}=> Q) ⊢ |={E1,E2}=> R ∗ Q. Proof. rewrite !(comm _ R); 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. Global Instance fupd_absorbing E1 E2 P : Absorbing P → Absorbing (|={E1,E2}=> P). Proof. rewrite /Absorbing /bi_absorbingly fupd_frame_l =>-> //. 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. by replace (E1 ∪ E ∖ E1) with E by (by apply union_difference_L). Qed. (* A variant of [fupd_mask_frame] that works well for accessors: Tailored to eliminate 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 entails_wand, 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_mask_intro_subseteq (E1 ∖ E2 ∪ E ∖ E1) (E ∖ E2) emp); 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_subseteq_emptyset_difference E1 E2 : E2 ⊆ E1 → ⊢@{PROP} |={E1, E2}=> |={∅, E1∖E2}=> emp. Proof. intros ?. rewrite [in fupd E1](union_difference_L E2 E1); [|done]. rewrite (comm_L (∪)) -[X in fupd _ X](left_id_L ∅ (∪) E2) -fupd_mask_frame_r; [|set_solver+]. apply fupd_mask_intro_subseteq; set_solver. Qed. Lemma fupd_or E1 E2 P Q : (|={E1,E2}=> P) ∨ (|={E1,E2}=> Q) ⊢@{PROP} (|={E1,E2}=> (P ∨ Q)). Proof. apply or_elim; apply fupd_mono; [ apply or_intro_l | apply or_intro_r ]. Qed. Global Instance fupd_or_homomorphism E : MonoidHomomorphism bi_or bi_or (flip (⊢)) (fupd (PROP:=PROP) E E). Proof. split; [split|]; try apply _; [apply fupd_or | apply fupd_intro]. Qed. Lemma fupd_and E1 E2 P Q : (|={E1,E2}=> (P ∧ Q)) ⊢@{PROP} (|={E1,E2}=> P) ∧ (|={E1,E2}=> Q). Proof. apply and_intro; apply fupd_mono; [apply and_elim_l | apply and_elim_r]. Qed. Lemma fupd_exist E1 E2 A (Φ : A → PROP) : (∃ x : A, |={E1, E2}=> Φ x) ⊢ |={E1, E2}=> ∃ x : A, Φ x. Proof. apply exist_elim=> a. by rewrite -(exist_intro a). Qed. Lemma fupd_forall E1 E2 A (Φ : A → PROP) : (|={E1, E2}=> ∀ x : A, Φ x) ⊢ ∀ x : A, |={E1, E2}=> Φ x. Proof. apply forall_intro=> a. by rewrite -(forall_elim a). 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. Global Instance fupd_sep_homomorphism E : MonoidHomomorphism bi_sep bi_sep (flip (⊢)) (fupd (PROP:=PROP) E E). Proof. split; [split|]; try apply _; [apply fupd_sep | apply fupd_intro]. Qed. Lemma big_sepL_fupd {A} E (Φ : nat → A → PROP) l : ([∗ list] k↦x ∈ l, |={E}=> Φ k x) ⊢ |={E}=> [∗ list] k↦x ∈ l, Φ k x. Proof. by rewrite (big_opL_commute _). Qed. Lemma big_sepL2_fupd {A B} E (Φ : nat → A → B → PROP) l1 l2 : ([∗ list] k↦x;y ∈ l1;l2, |={E}=> Φ k x y) ⊢ |={E}=> [∗ list] k↦x;y ∈ l1;l2, Φ k x y. Proof. rewrite !big_sepL2_alt !persistent_and_affinely_sep_l. etrans; [| by apply fupd_frame_l]. apply sep_mono_r. apply big_sepL_fupd. Qed. Lemma big_sepM_fupd `{Countable K} {A} E (Φ : K → A → PROP) m : ([∗ map] k↦x ∈ m, |={E}=> Φ k x) ⊢ |={E}=> [∗ map] k↦x ∈ m, Φ k x. Proof. by rewrite (big_opM_commute _). Qed. Lemma big_sepS_fupd `{Countable A} E (Φ : A → PROP) X : ([∗ set] x ∈ X, |={E}=> Φ x) ⊢ |={E}=> [∗ set] x ∈ X, Φ x. Proof. by rewrite (big_opS_commute _). Qed. Lemma big_sepMS_fupd `{Countable A} E (Φ : A → PROP) l : ([∗ mset] x ∈ l, |={E}=> Φ x) ⊢ |={E}=> [∗ mset] x ∈ l, Φ x. Proof. by rewrite (big_opMS_commute _). Qed. (** Fancy updates that take a step derived rules. *) Lemma step_fupd_wand Eo Ei P Q : (|={Eo}[Ei]▷=> P) -∗ (P -∗ Q) -∗ |={Eo}[Ei]▷=> Q. Proof. apply entails_wand, wand_intro_l. by rewrite (later_intro (P -∗ Q)) fupd_frame_l -later_sep fupd_frame_l wand_elim_l. Qed. Lemma step_fupd_mask_frame_r Eo Ei Ef P : Eo ## Ef → Ei ## Ef → (|={Eo}[Ei]▷=> P) ⊢ |={Eo ∪ Ef}[Ei ∪ 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 Eo1 Eo2 Ei1 Ei2 P : Ei2 ⊆ Ei1 → Eo1 ⊆ Eo2 → (|={Eo1}[Ei1]▷=> P) ⊢ |={Eo2}[Ei2]▷=> P. Proof. intros ??. rewrite -(emp_sep (|={Eo1}[Ei1]▷=> P)%I). rewrite (fupd_mask_intro_subseteq Eo2 Eo1 emp) //. rewrite fupd_frame_r -(fupd_trans Eo2 Eo1 Ei2). f_equiv. rewrite fupd_frame_l -(fupd_trans Eo1 Ei1 Ei2). f_equiv. rewrite (fupd_mask_intro_subseteq Ei1 Ei2 (|={_,_}=> emp)) //. rewrite fupd_frame_r. f_equiv. rewrite [X in (X ∗ _)%I]later_intro -later_sep. f_equiv. rewrite fupd_frame_r -(fupd_trans Ei2 Ei1 Eo2). f_equiv. rewrite fupd_frame_l -(fupd_trans Ei1 Eo1 Eo2). f_equiv. by rewrite fupd_frame_r left_id. Qed. Lemma step_fupd_intro Ei Eo P : Ei ⊆ Eo → ▷ P ⊢ |={Eo}[Ei]▷=> P. Proof. intros. by rewrite -(step_fupd_mask_mono Ei _ Ei _) // -!fupd_intro. Qed. Lemma step_fupd_frame_l Eo Ei R Q : (R ∗ |={Eo}[Ei]▷=> Q) ⊢ |={Eo}[Ei]▷=> (R ∗ Q). Proof. rewrite fupd_frame_l. apply fupd_mono. rewrite [P in P ∗ _ ⊢ _](later_intro R) -later_sep fupd_frame_l. by apply later_mono, fupd_mono. Qed. Lemma step_fupd_fupd Eo Ei P : (|={Eo}[Ei]▷=> P) ⊣⊢ (|={Eo}[Ei]▷=> |={Eo}=> P). Proof. apply (anti_symm (⊢)). - by rewrite -fupd_intro. - by rewrite fupd_trans. Qed. Lemma step_fupdN_mono Eo Ei n P Q : (P ⊢ Q) → (|={Eo}[Ei]▷=>^n P) ⊢ (|={Eo}[Ei]▷=>^n Q). Proof. intros HPQ. induction n as [|n IH]=> //=. rewrite IH //. Qed. Lemma step_fupdN_wand Eo Ei n P Q : (|={Eo}[Ei]▷=>^n P) -∗ (P -∗ Q) -∗ (|={Eo}[Ei]▷=>^n Q). Proof. apply entails_wand, wand_intro_l. induction n as [|n IH]=> /=. { by rewrite wand_elim_l. } rewrite -IH -fupd_frame_l later_sep -fupd_frame_l. by apply sep_mono; first apply later_intro. Qed. Lemma step_fupdN_intro Ei Eo n P : Ei ⊆ Eo → ▷^n P ⊢ |={Eo}[Ei]▷=>^n P. Proof. induction n as [|n IH]=> ?; [done|]. rewrite /= -step_fupd_intro; [|done]. by rewrite IH. Qed. Lemma step_fupdN_S_fupd n E P : (|={E}[∅]▷=>^(S n) P) ⊣⊢ (|={E}[∅]▷=>^(S n) |={E}=> P). Proof. apply (anti_symm (⊢)); rewrite !Nat.iter_succ_r; apply step_fupdN_mono; rewrite -step_fupd_fupd //. Qed. Lemma step_fupdN_frame_l Eo Ei n R Q : (R ∗ |={Eo}[Ei]▷=>^n Q) ⊢ |={Eo}[Ei]▷=>^n (R ∗ Q). Proof. induction n as [|n IH]; simpl; [done|]. rewrite step_fupd_frame_l IH //=. Qed. Lemma step_fupdN_add n m Eo Ei P : (|={Eo}[Ei]▷=>^(n+m) P) ⊣⊢ (|={Eo}[Ei]▷=>^n |={Eo}[Ei]▷=>^m P). Proof. induction n as [ | n IH]; simpl; [done | by rewrite IH]. Qed. (** The sidecondition [Ei ⊆ Eo] is needed because for [n = 0], this lemma introduces updates in the same way as [step_fupdN_intro] (in fact, for [n = 0] it is essentially [step_fupdN_intro], modulo laters). *) Lemma step_fupdN_le n m Eo Ei P : n ≤ m → Ei ⊆ Eo → (|={Eo}[Ei]▷=>^n P) ⊢ (|={Eo}[Ei]▷=>^m P). Proof. intros ??. replace m with ((m - n) + n) by lia. rewrite step_fupdN_add. rewrite -(step_fupdN_intro _ _ (m - n)); last done. by rewrite -laterN_intro. Qed. Section fupd_plainly_derived. Context `{!BiPlainly PROP, !BiFUpdPlainly PROP}. Lemma fupd_plainly_mask E E' P : (|={E,E'}=> ■ P) ⊢ |={E}=> P. Proof. rewrite -(fupd_plainly_mask_empty). apply fupd_elim, (fupd_mask_intro_discard _ _ _). set_solver. Qed. Lemma fupd_plainly_elim E P : ■ P ⊢ |={E}=> P. Proof. by rewrite (fupd_intro E (■ P)) fupd_plainly_mask. Qed. Lemma fupd_plainly_keep_r E P R : R ∗ (R ={E}=∗ ■ P) ⊢ |={E}=> R ∗ P. Proof. by rewrite !(comm _ R) fupd_plainly_keep_l. Qed. Lemma fupd_plain_mask_empty E P `{!Plain P} : (|={E,∅}=> P) ⊢ |={E}=> P. Proof. by rewrite {1}(plain P) fupd_plainly_mask_empty. Qed. Lemma fupd_plain_mask E E' P `{!Plain P} : (|={E,E'}=> P) ⊢ |={E}=> P. Proof. by rewrite {1}(plain P) fupd_plainly_mask. Qed. Lemma fupd_plain_keep_l E P R `{!Plain P} : (R ={E}=∗ P) ∗ R ⊢ |={E}=> P ∗ R. Proof. by rewrite {1}(plain P) fupd_plainly_keep_l. Qed. Lemma fupd_plain_keep_r E P R `{!Plain P} : R ∗ (R ={E}=∗ P) ⊢ |={E}=> R ∗ P. Proof. by rewrite {1}(plain P) fupd_plainly_keep_r. Qed. Lemma fupd_plainly_laterN E n P : (▷^n |={E}=> ■ P) ⊢ |={E}=> ▷^n ◇ P. Proof. revert P. induction n as [|n IH]=> P /=. { by rewrite -except_0_intro (fupd_plainly_elim E) fupd_trans. } rewrite -!later_laterN !laterN_later. rewrite -plainly_idemp fupd_plainly_later. by rewrite except_0_plainly_1 later_plainly_1 IH except_0_later. Qed. Lemma fupd_plain_later E P `{!Plain P} : (▷ |={E}=> P) ⊢ |={E}=> ▷ ◇ P. Proof. by rewrite {1}(plain P) fupd_plainly_later. Qed. Lemma fupd_plain_laterN E n P `{!Plain P} : (▷^n |={E}=> P) ⊢ |={E}=> ▷^n ◇ P. Proof. by rewrite {1}(plain P) fupd_plainly_laterN. Qed. Lemma fupd_plain_forall_2 E {A} (Φ : A → PROP) `{!∀ x, Plain (Φ x)} : (∀ x, |={E}=> Φ x) ⊢ |={E}=> ∀ x, Φ x. Proof. rewrite -fupd_plainly_forall_2. apply forall_mono=> x. by rewrite {1}(plain (Φ _)). Qed. Lemma fupd_plain_forall E1 E2 {A} (Φ : A → PROP) `{!∀ x, Plain (Φ x)} : E2 ⊆ E1 → (|={E1,E2}=> ∀ x, Φ x) ⊣⊢ (∀ x, |={E1,E2}=> Φ x). Proof. intros. apply (anti_symm _); first apply fupd_forall. trans (∀ x, |={E1}=> Φ x)%I. { apply forall_mono=> x. by rewrite fupd_plain_mask. } rewrite fupd_plain_forall_2. apply fupd_elim. rewrite {1}(plain (∀ x, Φ x)) (fupd_mask_intro_discard E1 E2 (■ _)) //. apply fupd_elim. by rewrite fupd_plainly_elim. Qed. Lemma fupd_plain_forall' E {A} (Φ : A → PROP) `{!∀ x, Plain (Φ x)} : (|={E}=> ∀ x, Φ x) ⊣⊢ (∀ x, |={E}=> Φ x). Proof. by apply fupd_plain_forall. Qed. Lemma step_fupd_plain Eo Ei P `{!Plain P} : (|={Eo}[Ei]▷=> P) ⊢ |={Eo}=> ▷ ◇ P. Proof. rewrite -(fupd_plain_mask _ Ei (▷ ◇ P)). apply fupd_elim. by rewrite fupd_plain_mask -fupd_plain_later. Qed. Lemma step_fupdN_plain Eo Ei n P `{!Plain P} : (|={Eo}[Ei]▷=>^n P) ⊢ |={Eo}=> ▷^n ◇ P. Proof. induction n as [|n IH]. - by rewrite -fupd_intro -except_0_intro. - rewrite Nat.iter_succ step_fupd_fupd IH !fupd_trans step_fupd_plain. apply fupd_mono. destruct n as [|n]; simpl. * by rewrite except_0_idemp. * by rewrite except_0_later. Qed. Lemma step_fupd_plain_forall Eo Ei {A} (Φ : A → PROP) `{!∀ x, Plain (Φ x)} : Ei ⊆ Eo → (|={Eo}[Ei]▷=> ∀ x, Φ x) ⊣⊢ (∀ x, |={Eo}[Ei]▷=> Φ x). Proof. intros. apply (anti_symm _). { apply forall_intro=> x. by rewrite (forall_elim x). } trans (∀ x, |={Eo}=> ▷ ◇ Φ x)%I. { apply forall_mono=> x. by rewrite step_fupd_plain. } rewrite -fupd_plain_forall'. apply fupd_elim. rewrite -(fupd_except_0 Ei Eo) -step_fupd_intro //. by rewrite -later_forall -except_0_forall. Qed. End fupd_plainly_derived. End fupd_derived. iris-iris-4.2.0/iris/bi/weakestpre.v000066400000000000000000000351701460620107300173350ustar00rootroot00000000000000(** Shared notation file for WP connectives. *) From stdpp Require Export coPset. From iris.bi Require Import interface derived_connectives. From iris.prelude Require Import options. Declare Scope expr_scope. Delimit Scope expr_scope with E. Declare Scope val_scope. Delimit Scope val_scope with V. Inductive stuckness := NotStuck | MaybeStuck. Definition stuckness_leb (s1 s2 : stuckness) : bool := match s1, s2 with | MaybeStuck, NotStuck => false | _, _ => true end. Global Instance stuckness_le : SqSubsetEq stuckness := stuckness_leb. Global Instance stuckness_le_po : PreOrder (⊑@{stuckness}). Proof. split; by repeat intros []. Qed. (** 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 (PROP EXPR VAL A : Type) := wp : A → coPset → EXPR → (VAL → PROP) → PROP. Global Arguments wp {_ _ _ _ _} _ _ _%E _%I. Global Instance: Params (@wp) 8 := {}. Class Twp (PROP EXPR VAL A : Type) := twp : A → coPset → EXPR → (VAL → PROP) → PROP. Global Arguments twp {_ _ _ _ _} _ _ _%E _%I. Global Instance: Params (@twp) 8 := {}. (** 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 general approach we use for all these complex notations: an outer '[hv' to switch bwteen "horizontal mode" where it all fits on one line, and "vertical mode" where each '/' becomes a line break. Then, as appropriate, nested boxes ('['...']') for things like preconditions and postconditions such that they are maximally horizontal and suitably indented inside the parentheses that surround them. *) Notation "'WP' e @ s ; E {{ v , Q } }" := (wp s E e%E (λ v, Q)) (at level 20, e, Q at level 200, format "'[hv' '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 "'[hv' '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 "'[hv' '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 "'[hv' '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 "'[hv' '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. *) Notation "'WP' e @ s ; E [{ v , Q } ]" := (twp s E e%E (λ v, Q)) (at level 20, e, Q at level 200, format "'[hv' '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 "'[hv' '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 "'[hv' '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 "'[hv' '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 "'[hv' '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 ']' '/' [[{ '[hv' 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 '/' [[{ '[hv' 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 '/' ? [[{ '[hv' 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 '/' [[{ '[hv' 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 '/' ? [[{ '[hv' 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 ']' '/' [[{ '[hv' 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 '/' [[{ '[hv' 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 '/' ? [[{ '[hv' 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 '/' [[{ '[hv' 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 '/' ? [[{ '[hv' 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. iris-iris-4.2.0/iris/prelude/000077500000000000000000000000001460620107300160345ustar00rootroot00000000000000iris-iris-4.2.0/iris/prelude/options.v000066400000000000000000000020531460620107300177160ustar00rootroot00000000000000(** Coq configuration for Iris (not meant to leak to clients). If you are a user of Iris, note that importing this file means you are implicitly opting-in to every new option we will add here in the future. We are *not* guaranteeing any kind of stability here. Instead our advice is for you to have your own options file; then you can re-export the Iris file there but if we ever add an option you disagree with you can easily overwrite it in one central location. *) (* Everything here should be [Export Set], which means when this file is *imported*, the option will only apply on the import site but not transitively. *) From stdpp Require Export options. #[export] Set Suggest Proof Using. (* also warns about forgotten [Proof.] *) (* We always annotate hints with locality ([Global] or [Local]). This enforces that at least global hints are annotated. *) #[export] Set Warnings "+deprecated-hint-without-locality". (* "Fake" import to whitelist this file for the check that ensures we import this file everywhere. From iris.prelude Require Import options. *) iris-iris-4.2.0/iris/prelude/prelude.v000066400000000000000000000002651460620107300176660ustar00rootroot00000000000000From stdpp Require Export ssreflect. From iris.prelude Require Import options. (** Iris itself and many dependencies still rely on this coercion. *) Coercion Z.of_nat : nat >-> Z. iris-iris-4.2.0/iris/program_logic/000077500000000000000000000000001460620107300172205ustar00rootroot00000000000000iris-iris-4.2.0/iris/program_logic/adequacy.v000066400000000000000000000425411460620107300212110ustar00rootroot00000000000000From iris.algebra Require Import gmap auth agree gset coPset. From iris.proofmode Require Import proofmode. From iris.base_logic.lib Require Import wsat. From iris.program_logic Require Export weakestpre. From iris.prelude Require Import options. Import uPred. (** This file contains the adequacy statements of the Iris program logic. First we prove a number of auxilary results. *) Section adequacy. Context `{!irisGS_gen hlc Λ Σ}. Implicit Types e : expr Λ. Implicit Types P Q : iProp Σ. Implicit Types Φ : val Λ → iProp Σ. Implicit Types Φs : list (val Λ → iProp Σ). Notation wptp s t Φs := ([∗ list] e;Φ ∈ t;Φs, WP e @ s; ⊤ {{ Φ }})%I. Local Lemma wp_step s e1 σ1 ns κ κs e2 σ2 efs nt Φ : prim_step e1 σ1 κ e2 σ2 efs → state_interp σ1 ns (κ ++ κs) nt -∗ £ (S (num_laters_per_step ns)) -∗ WP e1 @ s; ⊤ {{ Φ }} ={⊤,∅}=∗ |={∅}▷=>^(S $ num_laters_per_step ns) |={∅,⊤}=> state_interp σ2 (S ns) κs (nt + length efs) ∗ WP e2 @ s; ⊤ {{ Φ }} ∗ wptp s efs (replicate (length efs) fork_post). Proof. rewrite {1}wp_unfold /wp_pre. iIntros (?) "Hσ Hcred H". rewrite (val_stuck e1 σ1 κ e2 σ2 efs) //. iMod ("H" $! σ1 ns with "Hσ") as "(_ & H)". iModIntro. iApply (step_fupdN_wand with "(H [//] Hcred)"). iIntros ">H". by rewrite Nat.add_comm big_sepL2_replicate_r. Qed. Local Lemma wptp_step s es1 es2 κ κs σ1 ns σ2 Φs nt : step (es1,σ1) κ (es2, σ2) → state_interp σ1 ns (κ ++ κs) nt -∗ £ (S (num_laters_per_step ns)) -∗ wptp s es1 Φs -∗ ∃ nt', |={⊤,∅}=> |={∅}▷=>^(S $ num_laters_per_step$ ns) |={∅,⊤}=> state_interp σ2 (S ns) κs (nt + nt') ∗ wptp s es2 (Φs ++ replicate nt' fork_post). Proof. iIntros (Hstep) "Hσ Hcred Ht". destruct Hstep as [e1' σ1' e2' σ2' efs t2' t3 Hstep]; simplify_eq/=. iDestruct (big_sepL2_app_inv_l with "Ht") as (Φs1 Φs2 ->) "[? Ht]". iDestruct (big_sepL2_cons_inv_l with "Ht") as (Φ Φs3 ->) "[Ht ?]". iExists _. iMod (wp_step with "Hσ Hcred Ht") as "H"; first done. iModIntro. iApply (step_fupdN_wand with "H"). iIntros ">($ & He2 & Hefs) !>". rewrite -(assoc_L app) -app_comm_cons. iFrame. Qed. (* The total number of laters used between the physical steps number [start] (included) to [start+ns] (excluded). *) Local Fixpoint steps_sum (num_laters_per_step : nat → nat) (start ns : nat) : nat := match ns with | O => 0 | S ns => S $ num_laters_per_step start + steps_sum num_laters_per_step (S start) ns end. Local Lemma wptp_preservation s n es1 es2 κs κs' σ1 ns σ2 Φs nt : nsteps n (es1, σ1) κs (es2, σ2) → state_interp σ1 ns (κs ++ κs') nt -∗ £ (steps_sum num_laters_per_step ns n) -∗ wptp s es1 Φs ={⊤,∅}=∗ |={∅}▷=>^(steps_sum num_laters_per_step ns n) |={∅,⊤}=> ∃ nt', state_interp σ2 (n + ns) κs' (nt + nt') ∗ wptp s es2 (Φs ++ replicate nt' fork_post). Proof. revert nt es1 es2 κs κs' σ1 ns σ2 Φs. induction n as [|n IH]=> nt es1 es2 κs κs' σ1 ns σ2 Φs /=. { inversion_clear 1; iIntros "? ? ?"; iExists 0=> /=. rewrite Nat.add_0_r right_id_L. iFrame. by iApply fupd_mask_subseteq. } iIntros (Hsteps) "Hσ Hcred He". inversion_clear Hsteps as [|?? [t1' σ1']]. rewrite -(assoc_L (++)) Nat.iter_add -{1}plus_Sn_m plus_n_Sm. rewrite lc_split. iDestruct "Hcred" as "[Hc1 Hc2]". iDestruct (wptp_step with "Hσ Hc1 He") as (nt') ">H"; first eauto; simplify_eq. iModIntro. iApply step_fupdN_S_fupd. iApply (step_fupdN_wand with "H"). iIntros ">(Hσ & He)". iMod (IH with "Hσ Hc2 He") as "IH"; first done. iModIntro. iApply (step_fupdN_wand with "IH"). iIntros ">IH". iDestruct "IH" as (nt'') "[??]". rewrite -Nat.add_assoc -(assoc_L app) -replicate_add. by eauto with iFrame. Qed. Local Lemma wp_not_stuck κs nt e σ ns Φ : state_interp σ ns κs nt -∗ WP e {{ Φ }} ={⊤, ∅}=∗ ⌜not_stuck e σ⌝. Proof. rewrite wp_unfold /wp_pre /not_stuck. iIntros "Hσ H". destruct (to_val e) as [v|] eqn:?. { iMod (fupd_mask_subseteq ∅); first set_solver. iModIntro. eauto. } iSpecialize ("H" $! σ ns [] κs with "Hσ"). rewrite sep_elim_l. iMod "H" as "%". iModIntro. eauto. Qed. (** The adequacy statement of Iris consists of two parts: (1) the postcondition for all threads that have terminated in values and (2) progress (i.e., after n steps the program is not stuck). For an n-step execution of a thread pool, the two parts are given by [wptp_strong_adequacy] and [wptp_progress] below. For the final adequacy theorem of Iris, [wp_strong_adequacy_gen], we would like to instantiate the Iris proof (i.e., instantiate the [∀ {Hinv : !invGS_gen hlc Σ} κs, ...]) and then use both lemmas to get progress and the postconditions. Unfortunately, since the addition of later credits, this is no longer possible, because the original proof relied on an interaction of the update modality and plain propositions. So instead, we employ a trick: we duplicate the instantiation of the Iris proof, such that we can "run the WP proof twice". That is, we instantiate the [∀ {Hinv : !invGS_gen hlc Σ} κs, ...] both in [wp_progress_gen] and [wp_strong_adequacy_gen]. In doing so, we can avoid the interactions with the plain modality. In [wp_strong_adequacy_gen], we can then make use of [wp_progress_gen] to prove the progress component of the main adequacy theorem. *) Local Lemma wptp_postconditions Φs κs' s n es1 es2 κs σ1 ns σ2 nt: nsteps n (es1, σ1) κs (es2, σ2) → state_interp σ1 ns (κs ++ κs') nt -∗ £ (steps_sum num_laters_per_step ns n) -∗ wptp s es1 Φs ={⊤,∅}=∗ |={∅}▷=>^(steps_sum num_laters_per_step ns n) |={∅,⊤}=> ∃ nt', state_interp σ2 (n + ns) κs' (nt + nt') ∗ [∗ list] e;Φ ∈ es2;Φs ++ replicate nt' fork_post, from_option Φ True (to_val e). Proof. iIntros (Hstep) "Hσ Hcred He". iMod (wptp_preservation with "Hσ Hcred He") as "Hwp"; first done. iModIntro. iApply (step_fupdN_wand with "Hwp"). iMod 1 as (nt') "(Hσ & Ht)"; simplify_eq/=. iExists _. iFrame "Hσ". iApply big_sepL2_fupd. iApply (big_sepL2_impl with "Ht"). iIntros "!#" (? e Φ ??) "Hwp". destruct (to_val e) as [v2|] eqn:He2'; last done. apply of_to_val in He2' as <-. simpl. iApply wp_value_fupd'. done. Qed. Local Lemma wptp_progress Φs κs' n es1 es2 κs σ1 ns σ2 nt e2 : nsteps n (es1, σ1) κs (es2, σ2) → e2 ∈ es2 → state_interp σ1 ns (κs ++ κs') nt -∗ £ (steps_sum num_laters_per_step ns n) -∗ wptp NotStuck es1 Φs ={⊤,∅}=∗ |={∅}▷=>^(steps_sum num_laters_per_step ns n) |={∅}=> ⌜not_stuck e2 σ2⌝. Proof. iIntros (Hstep Hel) "Hσ Hcred He". iMod (wptp_preservation with "Hσ Hcred He") as "Hwp"; first done. iModIntro. iApply (step_fupdN_wand with "Hwp"). iMod 1 as (nt') "(Hσ & Ht)"; simplify_eq/=. eapply elem_of_list_lookup in Hel as [i Hlook]. destruct ((Φs ++ replicate nt' fork_post) !! i) as [Φ|] eqn: Hlook2; last first. { rewrite big_sepL2_alt. iDestruct "Ht" as "[%Hlen _]". exfalso. eapply lookup_lt_Some in Hlook. rewrite Hlen in Hlook. eapply lookup_lt_is_Some_2 in Hlook. rewrite Hlook2 in Hlook. destruct Hlook as [? ?]. naive_solver. } iDestruct (big_sepL2_lookup with "Ht") as "Ht"; [done..|]. by iApply (wp_not_stuck with "Hσ"). Qed. End adequacy. Local Lemma wp_progress_gen (hlc : has_lc) Σ Λ `{!invGpreS Σ} es σ1 n κs t2 σ2 e2 (num_laters_per_step : nat → nat) : (∀ `{Hinv : !invGS_gen hlc Σ}, ⊢ |={⊤}=> ∃ (stateI : state Λ → nat → list (observation Λ) → nat → iProp Σ) (Φs : list (val Λ → iProp Σ)) (fork_post : val Λ → iProp Σ) state_interp_mono, let _ : irisGS_gen hlc Λ Σ := IrisG Hinv stateI fork_post num_laters_per_step state_interp_mono in stateI σ1 0 κs 0 ∗ ([∗ list] e;Φ ∈ es;Φs, WP e @ ⊤ {{ Φ }})) → nsteps n (es, σ1) κs (t2, σ2) → e2 ∈ t2 → not_stuck e2 σ2. Proof. intros Hwp ??. eapply pure_soundness. eapply (step_fupdN_soundness_gen _ hlc (steps_sum num_laters_per_step 0 n) (steps_sum num_laters_per_step 0 n)). iIntros (Hinv) "Hcred". iMod Hwp as (stateI Φ fork_post state_interp_mono) "(Hσ & Hwp)". iDestruct (big_sepL2_length with "Hwp") as %Hlen1. iMod (@wptp_progress _ _ _ (IrisG Hinv stateI fork_post num_laters_per_step state_interp_mono) _ [] with "[Hσ] Hcred Hwp") as "H"; [done| done |by rewrite right_id_L|]. iAssert (|={∅}▷=>^(steps_sum num_laters_per_step 0 n) |={∅}=> ⌜not_stuck e2 σ2⌝)%I with "[-]" as "H"; last first. { destruct steps_sum; [done|]. by iApply step_fupdN_S_fupd. } iApply (step_fupdN_wand with "H"). iIntros "$". Qed. (** Iris's generic adequacy result *) (** The lemma is parameterized by [use_credits] over whether to make later credits available or not. Below, a concrete instances is provided with later credits (see [wp_strong_adequacy]). *) Lemma wp_strong_adequacy_gen (hlc : has_lc) Σ Λ `{!invGpreS Σ} s es σ1 n κs t2 σ2 φ (num_laters_per_step : nat → nat) : (* WP *) (∀ `{Hinv : !invGS_gen hlc Σ}, ⊢ |={⊤}=> ∃ (stateI : state Λ → nat → list (observation Λ) → nat → iProp Σ) (Φs : list (val Λ → iProp Σ)) (fork_post : val Λ → iProp Σ) (* Note: existentially quantifying over Iris goal! [iExists _] should usually work. *) state_interp_mono, let _ : irisGS_gen hlc Λ Σ := IrisG Hinv stateI fork_post num_laters_per_step state_interp_mono in stateI σ1 0 κs 0 ∗ ([∗ list] e;Φ ∈ es;Φs, WP e @ s; ⊤ {{ Φ }}) ∗ (∀ es' t2', (* es' is the final state of the initial threads, t2' the rest *) ⌜ t2 = es' ++ t2' ⌝ -∗ (* es' corresponds to the initial threads *) ⌜ length es' = length es ⌝ -∗ (* If this is a stuck-free triple (i.e. [s = NotStuck]), then all threads in [t2] are not stuck *) ⌜ ∀ e2, s = NotStuck → e2 ∈ t2 → not_stuck e2 σ2 ⌝ -∗ (* The state interpretation holds for [σ2] *) stateI σ2 n [] (length t2') -∗ (* If the initial threads are done, their post-condition [Φ] holds *) ([∗ list] e;Φ ∈ es';Φs, from_option Φ True (to_val e)) -∗ (* For all forked-off threads that are done, their postcondition [fork_post] holds. *) ([∗ list] v ∈ omap to_val t2', fork_post v) -∗ (* Under all these assumptions, and while opening all invariants, we can conclude [φ] in the logic. After opening all required invariants, one can use [fupd_mask_subseteq] to introduce the fancy update. *) |={⊤,∅}=> ⌜ φ ⌝)) → nsteps n (es, σ1) κs (t2, σ2) → (* Then we can conclude [φ] at the meta-level. *) φ. Proof. intros Hwp ?. eapply pure_soundness. eapply (step_fupdN_soundness_gen _ hlc (steps_sum num_laters_per_step 0 n) (steps_sum num_laters_per_step 0 n)). iIntros (Hinv) "Hcred". iMod Hwp as (stateI Φ fork_post state_interp_mono) "(Hσ & Hwp & Hφ)". iDestruct (big_sepL2_length with "Hwp") as %Hlen1. iMod (@wptp_postconditions _ _ _ (IrisG Hinv stateI fork_post num_laters_per_step state_interp_mono) _ [] with "[Hσ] Hcred Hwp") as "H"; [done|by rewrite right_id_L|]. iAssert (|={∅}▷=>^(steps_sum num_laters_per_step 0 n) |={∅}=> ⌜φ⌝)%I with "[-]" as "H"; last first. { destruct steps_sum; [done|]. by iApply step_fupdN_S_fupd. } iApply (step_fupdN_wand with "H"). iMod 1 as (nt') "(Hσ & Hval) /=". iDestruct (big_sepL2_app_inv_r with "Hval") as (es' t2' ->) "[Hes' Ht2']". iDestruct (big_sepL2_length with "Ht2'") as %Hlen2. rewrite replicate_length in Hlen2; subst. iDestruct (big_sepL2_length with "Hes'") as %Hlen3. rewrite -plus_n_O. iApply ("Hφ" with "[//] [%] [ ] Hσ Hes'"); (* FIXME: Different implicit types for [length] are inferred, so [lia] and [congruence] do not work due to https://github.com/coq/coq/issues/16634 *) [by rewrite Hlen1 Hlen3| |]; last first. { by rewrite big_sepL2_replicate_r // big_sepL_omap. } (* At this point in the adequacy proof, we use a trick: we effectively run the user-provided WP proof again (i.e., instantiate the `invGS_gen` and execute the program) by using the lemma [wp_progress_gen]. In doing so, we can obtain the progress part of the adequacy theorem. *) iPureIntro. intros e2 -> Hel. eapply (wp_progress_gen hlc); [ done | clear stateI Φ fork_post state_interp_mono Hlen1 Hlen3 | done|done]. iIntros (?). iMod Hwp as (stateI Φ fork_post state_interp_mono) "(Hσ & Hwp & Hφ)". iModIntro. iExists _, _, _, _. iFrame. Qed. (** Adequacy when using later credits (the default) *) Definition wp_strong_adequacy := wp_strong_adequacy_gen HasLc. Global Arguments wp_strong_adequacy _ _ {_}. (** Since the full adequacy statement is quite a mouthful, we prove some more intuitive and simpler corollaries. These lemmas are morover stated in terms of [rtc erased_step] so one does not have to provide the trace. *) Record adequate {Λ} (s : stuckness) (e1 : expr Λ) (σ1 : state Λ) (φ : val Λ → state Λ → Prop) := { adequate_result t2 σ2 v2 : rtc erased_step ([e1], σ1) (of_val v2 :: t2, σ2) → φ v2 σ2; adequate_not_stuck t2 σ2 e2 : s = NotStuck → rtc erased_step ([e1], σ1) (t2, σ2) → e2 ∈ t2 → not_stuck e2 σ2 }. Lemma adequate_alt {Λ} s e1 σ1 (φ : val Λ → state Λ → Prop) : adequate s e1 σ1 φ ↔ ∀ t2 σ2, rtc erased_step ([e1], σ1) (t2, σ2) → (∀ v2 t2', t2 = of_val v2 :: t2' → φ v2 σ2) ∧ (∀ e2, s = NotStuck → e2 ∈ t2 → not_stuck e2 σ2). Proof. split. - intros []; naive_solver. - constructor; naive_solver. Qed. Theorem adequate_tp_safe {Λ} (e1 : expr Λ) t2 σ1 σ2 φ : adequate NotStuck e1 σ1 φ → rtc erased_step ([e1], σ1) (t2, σ2) → Forall (λ e, is_Some (to_val e)) t2 ∨ ∃ t3 σ3, erased_step (t2, σ2) (t3, σ3). Proof. intros Had ?. destruct (decide (Forall (λ e, is_Some (to_val e)) t2)) as [|Ht2]; [by left|]. apply (not_Forall_Exists _), Exists_exists in Ht2; destruct Ht2 as (e2&?&He2). destruct (adequate_not_stuck NotStuck e1 σ1 φ Had t2 σ2 e2) as [?|(κ&e3&σ3&efs&?)]; rewrite ?eq_None_not_Some; auto. { exfalso. eauto. } destruct (elem_of_list_split t2 e2) as (t2'&t2''&->); auto. right; exists (t2' ++ e3 :: t2'' ++ efs), σ3, κ; econstructor; eauto. Qed. (** This simpler form of adequacy requires the [irisGS] instance that you use everywhere to syntactically be of the form {| iris_invGS := ...; state_interp σ _ κs _ := ...; fork_post v := ...; num_laters_per_step _ := 0; state_interp_mono _ _ _ _ := fupd_intro _ _; |} In other words, the state interpretation must ignore [ns] and [nt], the number of laters per step must be 0, and the proof of [state_interp_mono] must have this specific proof term. *) (** Again, we first prove a lemma generic over the usage of credits. *) Lemma wp_adequacy_gen (hlc : has_lc) Σ Λ `{!invGpreS Σ} s e σ φ : (∀ `{Hinv : !invGS_gen hlc Σ} κs, ⊢ |={⊤}=> ∃ (stateI : state Λ → list (observation Λ) → iProp Σ) (fork_post : val Λ → iProp Σ), let _ : irisGS_gen hlc Λ Σ := IrisG Hinv (λ σ _ κs _, stateI σ κs) fork_post (λ _, 0) (λ _ _ _ _, fupd_intro _ _) in stateI σ κs ∗ WP e @ s; ⊤ {{ v, ⌜φ v⌝ }}) → adequate s e σ (λ v _, φ v). Proof. intros Hwp. apply adequate_alt; intros t2 σ2 [n [κs ?]]%erased_steps_nsteps. eapply (wp_strong_adequacy_gen hlc Σ _); [ | done]=> ?. iMod Hwp as (stateI fork_post) "[Hσ Hwp]". iExists (λ σ _ κs _, stateI σ κs), [(λ v, ⌜φ v⌝%I)], fork_post, _ => /=. iIntros "{$Hσ $Hwp} !>" (e2 t2' -> ? ?) "_ H _". iApply fupd_mask_intro_discard; [done|]. iSplit; [|done]. iDestruct (big_sepL2_cons_inv_r with "H") as (e' ? ->) "[Hwp H]". iDestruct (big_sepL2_nil_inv_r with "H") as %->. iIntros (v2 t2'' [= -> <-]). by rewrite to_of_val. Qed. (** Instance for using credits *) Definition wp_adequacy := wp_adequacy_gen HasLc. Global Arguments wp_adequacy _ _ {_}. Lemma wp_invariance_gen (hlc : has_lc) Σ Λ `{!invGpreS Σ} s e1 σ1 t2 σ2 φ : (∀ `{Hinv : !invGS_gen hlc Σ} κs, ⊢ |={⊤}=> ∃ (stateI : state Λ → list (observation Λ) → nat → iProp Σ) (fork_post : val Λ → iProp Σ), let _ : irisGS_gen hlc Λ Σ := IrisG Hinv (λ σ _, stateI σ) fork_post (λ _, 0) (λ _ _ _ _, fupd_intro _ _) in stateI σ1 κs 0 ∗ WP e1 @ s; ⊤ {{ _, True }} ∗ (stateI σ2 [] (pred (length t2)) -∗ ∃ E, |={⊤,E}=> ⌜φ⌝)) → rtc erased_step ([e1], σ1) (t2, σ2) → φ. Proof. intros Hwp [n [κs ?]]%erased_steps_nsteps. eapply (wp_strong_adequacy_gen hlc Σ); [done| |done]=> ?. iMod (Hwp _ κs) as (stateI fork_post) "(Hσ & Hwp & Hφ)". iExists (λ σ _, stateI σ), [(λ _, True)%I], fork_post, _ => /=. iIntros "{$Hσ $Hwp} !>" (e2 t2' -> _ _) "Hσ H _ /=". iDestruct (big_sepL2_cons_inv_r with "H") as (? ? ->) "[_ H]". iDestruct (big_sepL2_nil_inv_r with "H") as %->. iDestruct ("Hφ" with "Hσ") as (E) ">Hφ". by iApply fupd_mask_intro_discard; first set_solver. Qed. Definition wp_invariance := wp_invariance_gen HasLc. Global Arguments wp_invariance _ _ {_}. iris-iris-4.2.0/iris/program_logic/atomic.v000066400000000000000000000365331460620107300206750ustar00rootroot00000000000000(** This file declares notation for logically atomic Hoare triples, and some generic lemmas about them. To enable the definition of a shared theory applying to triples with any number of binders, the triples themselves are defined via telescopes, but as a user you need not be concerned with that. You can just use the following notation: <<{ ∀∀ x, atomic_precondition }>> code @ E <<{ ∃∃ y, atomic_postcondition | z, RET return_value; private_postcondition }>> Here, [x] (which can be any number of binders, including 0) is bound in all of the atomic pre- and postcondition and the private (non-atomic) postcondition and the return value, [y] (which can be any number of binders, including 0) is bound in both postconditions and the return value, and [z] (which can be any number of binders, including 0) is bound in the return value and the private postcondition. Note that atomic triples are *not* implicitly persistent, unlike Texan triples. If you need a private (non-atomic) precondition, you can use a magic wand: private_precondition -∗ <<{ ∀∀ x, atomic_precondition }>> code @ E <<{ ∃∃ y, atomic_postcondition | z, RET return_value; private_postcondition }>> If you don't need a private postcondition, you can leave it away, e.g.: <<{ ∀∀ x, atomic_precondition }>> code @ E <<{ ∃∃ y, atomic_postcondition | RET return_value }>> Note that due to combinatorial explosion and because Coq does not have a facility to declare such notation in a compositional way, not *all* variants of this notation exist: if you have binders before the [RET] (which is very uncommon), you must have a private postcondition (it can be [True]), and you must have [∀∀] and [∃∃] binders (they can be [_: ()]). For an example for how to prove and use logically atomic specifications, see [iris_heap_lang/lib/increment.v]. *) From stdpp Require Import namespaces. From iris.bi Require Import telescopes. From iris.bi.lib Require Export atomic. From iris.proofmode Require Import proofmode classes. From iris.program_logic Require Export weakestpre. From iris.base_logic Require Import invariants. From iris.prelude Require Import options. (* This hard-codes the inner mask to be empty, because we have yet to find an example where we want it to be anything else. For the non-atomic post-condition, we use an [option PROP], combined with a [-∗?]. This is to avoid introducing spurious [True -∗] into proofs that do not need a non-atomic post-condition (which is most of them). *) Definition atomic_wp `{!irisGS_gen hlc Λ Σ} {TA TB TP : tele} (e: expr Λ) (* expression *) (E : coPset) (* *implementation* mask *) (α: TA → iProp Σ) (* atomic pre-condition *) (β: TA → TB → iProp Σ) (* atomic post-condition *) (POST: TA → TB → TP → option (iProp Σ)) (* non-atomic post-condition *) (f: TA → TB → TP → val Λ) (* Turn the return data into the return value *) : iProp Σ := ∀ (Φ : val Λ → iProp Σ), (* The (outer) user mask is what is left after the implementation opened its things. *) atomic_update (⊤∖E) ∅ α β (λ.. x y, ∀.. z, POST x y z -∗? Φ (f x y z)) -∗ WP e {{ Φ }}. (** We avoid '<<{'/'}>>' since those can also reasonably be infix operators (and in fact Autosubst uses the latter). *) Notation "'<<{' ∀∀ x1 .. xn , α '}>>' e @ E '<<{' ∃∃ y1 .. yn , β '|' z1 .. zn , 'RET' v ; POST '}>>'" := (* The way to read the [tele_app foo] here is that they convert the n-ary function [foo] into a unary function taking a telescope as the argument. *) (atomic_wp (TA:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) (TB:=TeleS (λ y1, .. (TeleS (λ yn, TeleO)) .. )) (TP:=TeleS (λ z1, .. (TeleS (λ zn, TeleO)) .. )) e%E E (tele_app $ λ x1, .. (λ xn, α%I) ..) (tele_app $ λ x1, .. (λ xn, tele_app $ λ y1, .. (λ yn, β%I) .. ) .. ) (tele_app $ λ x1, .. (λ xn, tele_app $ λ y1, .. (λ yn, tele_app $ λ z1, .. (λ zn, Some POST%I) .. ) .. ) .. ) (tele_app $ λ x1, .. (λ xn, tele_app $ λ y1, .. (λ yn, tele_app $ λ z1, .. (λ zn, v%V) .. ) .. ) .. ) ) (at level 20, E, β, α, v, POST at level 200, x1 binder, xn binder, y1 binder, yn binder, z1 binder, zn binder, format "'[hv' '<<{' '[' ∀∀ x1 .. xn , '/' α ']' '}>>' '/ ' e @ E '/' '<<{' '[' ∃∃ y1 .. yn , '/' β '|' '/' z1 .. zn , RET v ; '/' POST ']' '}>>' ']'") : bi_scope. (* There are overall 16 of possible variants of this notation: - with and without ∀∀ binders - with and without ∃∃ binders - with and without RET binders - with and without POST However we don't support the case where RET binders are present but anything else is missing. Below we declare the 8 notations that involve no RET binders. *) (* No RET binders *) Notation "'<<{' ∀∀ x1 .. xn , α '}>>' e @ E '<<{' ∃∃ y1 .. yn , β '|' 'RET' v ; POST '}>>'" := (atomic_wp (TA:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) (TB:=TeleS (λ y1, .. (TeleS (λ yn, TeleO)) .. )) (TP:=TeleO) e%E E (tele_app $ λ x1, .. (λ xn, α%I) ..) (tele_app $ λ x1, .. (λ xn, tele_app $ λ y1, .. (λ yn, β%I) .. ) .. ) (tele_app $ λ x1, .. (λ xn, tele_app $ λ y1, .. (λ yn, tele_app $ Some POST%I) .. ) .. ) (tele_app $ λ x1, .. (λ xn, tele_app $ λ y1, .. (λ yn, tele_app $ v%V) .. ) .. ) ) (at level 20, E, β, α, v, POST at level 200, x1 binder, xn binder, y1 binder, yn binder, format "'[hv' '<<{' '[' ∀∀ x1 .. xn , '/' α ']' '}>>' '/ ' e @ E '/' '<<{' '[' ∃∃ y1 .. yn , '/' β '|' '/' RET v ; '/' POST ']' '}>>' ']'") : bi_scope. (* No ∃∃ binders, no RET binders *) Notation "'<<{' ∀∀ x1 .. xn , α '}>>' e @ E '<<{' β '|' 'RET' v ; POST '}>>'" := (atomic_wp (TA:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) (TB:=TeleO) (TP:=TeleO) e%E E (tele_app $ λ x1, .. (λ xn, α%I) ..) (tele_app $ λ x1, .. (λ xn, tele_app β%I) .. ) (tele_app $ λ x1, .. (λ xn, tele_app $ tele_app $ Some POST%I ) .. ) (tele_app $ λ x1, .. (λ xn, tele_app $ tele_app $ v%V ) .. ) ) (at level 20, E, β, α, v, POST at level 200, x1 binder, xn binder, format "'[hv' '<<{' '[' ∀∀ x1 .. xn , '/' α ']' '}>>' '/ ' e @ E '/' '<<{' '[' β '|' '/' RET v ; '/' POST ']' '}>>' ']'") : bi_scope. (* No ∀∀ binders, no RET binders *) Notation "'<<{' α '}>>' e @ E '<<{' ∃∃ y1 .. yn , β '|' 'RET' v ; POST '}>>'" := (atomic_wp (TA:=TeleO) (TB:=TeleS (λ y1, .. (TeleS (λ yn, TeleO)) .. )) (TP:=TeleO) e%E E (tele_app $ α%I) (tele_app $ tele_app $ λ y1, .. (λ yn, β%I) .. ) (tele_app $ tele_app $ λ y1, .. (λ yn, tele_app $ Some POST%I) .. ) (tele_app $ tele_app $ λ y1, .. (λ yn, tele_app $ v%V) .. ) ) (at level 20, E, β, α, v, POST at level 200, y1 binder, yn binder, format "'[hv' '<<{' '[' α ']' '}>>' '/ ' e @ E '/' '<<{' '[' ∃∃ y1 .. yn , '/' β '|' '/' RET v ; '/' POST ']' '}>>' ']'") : bi_scope. (* No ∀∀ binders, no ∃∃ binders, no RET binders *) Notation "'<<{' α '}>>' e @ E '<<{' β '|' 'RET' v ; POST '}>>'" := (atomic_wp (TA:=TeleO) (TB:=TeleO) (TP:=TeleO) e%E E (tele_app $ α%I) (tele_app $ tele_app β%I) (tele_app $ tele_app $ tele_app $ Some POST%I) (tele_app $ tele_app $ tele_app $ v%V) ) (at level 20, E, β, α, v, POST at level 200, format "'[hv' '<<{' '[' α ']' '}>>' '/ ' e @ E '/' '<<{' '[' β '|' '/' RET v ; '/' POST ']' '}>>' ']'") : bi_scope. (* No RET binders, no POST *) Notation "'<<{' ∀∀ x1 .. xn , α '}>>' e @ E '<<{' ∃∃ y1 .. yn , β '|' 'RET' v '}>>'" := (atomic_wp (TA:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) (TB:=TeleS (λ y1, .. (TeleS (λ yn, TeleO)) .. )) (TP:=TeleO) e%E E (tele_app $ λ x1, .. (λ xn, α%I) ..) (tele_app $ λ x1, .. (λ xn, tele_app $ λ y1, .. (λ yn, β%I) .. ) .. ) (tele_app $ λ x1, .. (λ xn, tele_app $ λ y1, .. (λ yn, tele_app None) .. ) .. ) (tele_app $ λ x1, .. (λ xn, tele_app $ λ y1, .. (λ yn, tele_app v%V) .. ) .. ) ) (at level 20, E, β, α, v at level 200, x1 binder, xn binder, y1 binder, yn binder, format "'[hv' '<<{' '[' ∀∀ x1 .. xn , '/' α ']' '}>>' '/ ' e @ E '/' '<<{' '[' ∃∃ y1 .. yn , '/' β '|' '/' RET v ']' '}>>' ']'") : bi_scope. (* No ∃∃ binders, no RET binders, no POST *) Notation "'<<{' ∀∀ x1 .. xn , α '}>>' e @ E '<<{' β '|' 'RET' v '}>>'" := (atomic_wp (TA:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) (TB:=TeleO) (TP:=TeleO) e%E E (tele_app $ λ x1, .. (λ xn, α%I) ..) (tele_app $ λ x1, .. (λ xn, tele_app β%I) .. ) (tele_app $ λ x1, .. (λ xn, tele_app $ tele_app None) .. ) (tele_app $ λ x1, .. (λ xn, tele_app $ tele_app v%V) .. ) ) (at level 20, E, β, α, v at level 200, x1 binder, xn binder, format "'[hv' '<<{' '[' ∀∀ x1 .. xn , '/' α ']' '}>>' '/ ' e @ E '/' '<<{' '[' β '|' '/' RET v ']' '}>>' ']'") : bi_scope. (* No ∀∀ binders, no RET binders, no POST *) Notation "'<<{' α '}>>' e @ E '<<{' ∃∃ y1 .. yn , β '|' 'RET' v '}>>'" := (atomic_wp (TA:=TeleO) (TB:=TeleS (λ y1, .. (TeleS (λ yn, TeleO)) .. )) (TP:=TeleO) e%E E (tele_app α%I) (tele_app $ tele_app $ λ y1, .. (λ yn, β%I) .. ) (tele_app $ tele_app $ λ y1, .. (λ yn, tele_app None) .. ) (tele_app $ tele_app $ λ y1, .. (λ yn, tele_app v%V) .. ) ) (at level 20, E, β, α, v at level 200, y1 binder, yn binder, format "'[hv' '<<{' '[' α ']' '}>>' '/ ' e @ E '/' '<<{' '[' ∃∃ y1 .. yn , '/' β '|' '/' RET v ']' '}>>' ']'") : bi_scope. (* No ∀∀ binders, no ∃∃ binders, no RET binders, no POST *) Notation "'<<{' α '}>>' e @ E '<<{' β '|' 'RET' v '}>>'" := (atomic_wp (TA:=TeleO) (TB:=TeleO) (TP:=TeleO) e%E E (tele_app α%I) (tele_app $ tele_app β%I) (tele_app $ tele_app $ tele_app None) (tele_app $ tele_app $ tele_app v%V) ) (at level 20, E, β, α, v at level 200, format "'[hv' '<<{' '[' α ']' '}>>' '/ ' e @ E '/' '<<{' '[' β '|' '/' RET v ']' '}>>' ']'") : bi_scope. (** Theory *) Section lemmas. Context `{!irisGS_gen hlc Λ Σ} {TA TB TP : tele}. Notation iProp := (iProp Σ). Implicit Types (α : TA → iProp) (β : TA → TB → iProp) (POST : TA → TB → TP → option iProp) (f : TA → TB → TP → val Λ). (* Atomic triples imply sequential triples. *) Lemma atomic_wp_seq e E α β POST f : atomic_wp e E α β POST f -∗ ∀ Φ, ∀.. x, α x -∗ (∀.. y, β x y -∗ ∀.. z, POST x y z -∗? Φ (f x y z)) -∗ WP e {{ Φ }}. Proof. iIntros "Hwp" (Φ x) "Hα HΦ". iApply (wp_frame_wand with "HΦ"). iApply "Hwp". iAuIntro. iAaccIntro with "Hα"; first by eauto. iIntros (y) "Hβ !>". (* FIXME: Using ssreflect rewrite does not work, see Coq bug #7773. *) rewrite ->!tele_app_bind. iIntros (z) "Hpost HΦ". iApply ("HΦ" with "Hβ Hpost"). Qed. (** This version matches the Texan triple, i.e., with a later in front of the [(∀.. y, β x y -∗ Φ (f x y))]. *) Lemma atomic_wp_seq_step e E α β POST f : TCEq (to_val e) None → atomic_wp e E α β POST f -∗ ∀ Φ, ∀.. x, α x -∗ ▷ (∀.. y, β x y -∗ ∀.. z, POST x y z -∗? Φ (f x y z)) -∗ WP e {{ Φ }}. Proof. iIntros (?) "H"; iIntros (Φ x) "Hα HΦ". iApply (wp_step_fupd _ _ ⊤ _ (∀.. y : TB, _) with "[$HΦ //]"); first done. iApply (atomic_wp_seq with "H Hα"). iIntros "%y Hβ %z Hpost HΦ". iApply ("HΦ" with "Hβ Hpost"). Qed. (* Sequential triples with the empty mask for a physically atomic [e] are atomic. *) Lemma atomic_seq_wp_atomic e E α β POST f `{!Atomic WeaklyAtomic e} : (∀ Φ, ∀.. x, α x -∗ (∀.. y, β x y -∗ ∀.. z, POST x y z -∗? Φ (f x y z)) -∗ WP e @ ∅ {{ Φ }}) -∗ atomic_wp e E α β POST f. Proof. iIntros "Hwp" (Φ) "AU". iMod "AU" as (x) "[Hα [_ Hclose]]". iApply ("Hwp" with "Hα"). iIntros "%y Hβ %z Hpost". iMod ("Hclose" with "Hβ") as "HΦ". rewrite ->!tele_app_bind. iApply "HΦ". done. Qed. (** Sequential triples with a persistent precondition and no initial quantifier are atomic. *) Lemma persistent_seq_wp_atomic e E (α : [tele] → iProp) (β : [tele] → TB → iProp) (POST : [tele] → TB → TP → option iProp) (f : [tele] → TB → TP → val Λ) {HP : Persistent (α [tele_arg])} : (∀ Φ, α [tele_arg] -∗ (∀.. y, β [tele_arg] y -∗ ∀.. z, POST [tele_arg] y z -∗? Φ (f [tele_arg] y z)) -∗ WP e {{ Φ }}) -∗ atomic_wp e E α β POST f. Proof. simpl in HP. iIntros "Hwp" (Φ) "HΦ". iApply fupd_wp. iMod ("HΦ") as "[#Hα [Hclose _]]". iMod ("Hclose" with "Hα") as "HΦ". iApply wp_fupd. iApply ("Hwp" with "Hα"). iIntros "!> %y Hβ %z Hpost". iMod ("HΦ") as "[_ [_ Hclose]]". iMod ("Hclose" with "Hβ") as "HΦ". (* FIXME: Using ssreflect rewrite does not work, see Coq bug #7773. *) rewrite ->!tele_app_bind. iApply "HΦ". done. Qed. Lemma atomic_wp_mask_weaken e E1 E2 α β POST f : E1 ⊆ E2 → atomic_wp e E1 α β POST f -∗ atomic_wp e E2 α β POST f. Proof. iIntros (HE) "Hwp". iIntros (Φ) "AU". iApply "Hwp". iApply atomic_update_mask_weaken; last done. set_solver. Qed. (** We can open invariants around atomic triples. (Just for demonstration purposes; we always use [iInv] in proofs.) *) Lemma atomic_wp_inv e E α β POST f N I : ↑N ⊆ E → atomic_wp e (E ∖ ↑N) (λ.. x, ▷ I ∗ α x) (λ.. x y, ▷ I ∗ β x y) POST f -∗ inv N I -∗ atomic_wp e E α β POST f. Proof. intros ?. iIntros "Hwp #Hinv" (Φ) "AU". iApply "Hwp". iAuIntro. iInv N as "HI". iApply (aacc_aupd with "AU"); first solve_ndisj. iIntros (x) "Hα". iAaccIntro with "[HI Hα]"; rewrite ->!tele_app_bind; first by iFrame. - (* abort *) iIntros "[HI $]". by eauto with iFrame. - (* commit *) iIntros (y). rewrite ->!tele_app_bind. iIntros "[HI Hβ]". iRight. iExists y. rewrite ->!tele_app_bind. by eauto with iFrame. Qed. End lemmas. iris-iris-4.2.0/iris/program_logic/ectx_language.v000066400000000000000000000334141460620107300222220ustar00rootroot00000000000000(** An axiomatization of evaluation-context based languages, including a proof that this gives rise to a "language" in the Iris sense. *) From iris.prelude Require Export prelude. From iris.program_logic Require Import language. From iris.prelude Require Import options. (** TAKE CARE: When you define an [ectxLanguage] canonical structure for your language, you need to also define a corresponding [language] canonical structure. Use the coercion [LanguageOfEctx] as defined in the bottom of this file for doing that. *) Section ectx_language_mixin. Context {expr val ectx state observation : Type}. Context (of_val : val → expr). Context (to_val : expr → option val). Context (empty_ectx : ectx). Context (comp_ectx : ectx → ectx → ectx). Context (fill : ectx → expr → expr). Context (base_step : expr → state → list observation → expr → state → list expr → Prop). Record EctxLanguageMixin := { mixin_to_of_val v : to_val (of_val v) = Some v; mixin_of_to_val e v : to_val e = Some v → of_val v = e; mixin_val_base_stuck e1 σ1 κ e2 σ2 efs : base_step e1 σ1 κ e2 σ2 efs → to_val e1 = None; mixin_fill_empty e : fill empty_ectx e = e; mixin_fill_comp K1 K2 e : fill K1 (fill K2 e) = fill (comp_ectx K1 K2) e; mixin_fill_inj K : Inj (=) (=) (fill K); mixin_fill_val K e : is_Some (to_val (fill K e)) → is_Some (to_val e); (** Given a base redex [e1_redex] somewhere in a term, and another decomposition of the same term into [fill K' e1'] such that [e1'] is not a value, then the base redex context is [e1']'s context [K'] filled with another context [K'']. In particular, this implies [e1 = fill K'' e1_redex] by [fill_inj], i.e., [e1]' contains the base redex.) This implies there can be only one base redex, see [base_redex_unique]. *) mixin_step_by_val K' K_redex e1' e1_redex σ1 κ e2 σ2 efs : fill K' e1' = fill K_redex e1_redex → to_val e1' = None → base_step e1_redex σ1 κ e2 σ2 efs → ∃ K'', K_redex = comp_ectx K' K''; (** If [fill K e] takes a base step, then either [e] is a value or [K] is the empty evaluation context. In other words, if [e] is not a value wrapping it in a context does not add new base redex positions. *) mixin_base_ctx_step_val K e σ1 κ e2 σ2 efs : base_step (fill K e) σ1 κ e2 σ2 efs → is_Some (to_val e) ∨ K = empty_ectx; }. End ectx_language_mixin. Structure ectxLanguage := EctxLanguage { expr : Type; val : Type; ectx : Type; state : Type; observation : Type; of_val : val → expr; to_val : expr → option val; empty_ectx : ectx; comp_ectx : ectx → ectx → ectx; fill : ectx → expr → expr; base_step : expr → state → list observation → expr → state → list expr → Prop; ectx_language_mixin : EctxLanguageMixin of_val to_val empty_ectx comp_ectx fill base_step }. Bind Scope expr_scope with expr. Bind Scope val_scope with val. Global Arguments EctxLanguage {_ _ _ _ _ _ _ _ _ _ _} _. Global Arguments of_val {_} _. Global Arguments to_val {_} _. Global Arguments empty_ectx {_}. Global Arguments comp_ectx {_} _ _. Global Arguments fill {_} _ _. Global Arguments base_step {_} _ _ _ _ _ _. (* From an ectx_language, we can construct a language. *) Section ectx_language. Context {Λ : ectxLanguage}. Implicit Types v : val Λ. Implicit Types e : expr Λ. Implicit Types K : ectx Λ. (* Only project stuff out of the mixin that is not also in language *) Lemma val_base_stuck e1 σ1 κ e2 σ2 efs : base_step e1 σ1 κ e2 σ2 efs → to_val e1 = None. Proof. apply ectx_language_mixin. Qed. Lemma fill_empty e : fill empty_ectx e = e. Proof. apply ectx_language_mixin. Qed. Lemma fill_comp K1 K2 e : fill K1 (fill K2 e) = fill (comp_ectx K1 K2) e. Proof. apply ectx_language_mixin. Qed. Global Instance fill_inj K : Inj (=) (=) (fill K). Proof. apply ectx_language_mixin. Qed. Lemma fill_val K e : is_Some (to_val (fill K e)) → is_Some (to_val e). Proof. apply ectx_language_mixin. Qed. Lemma step_by_val K' K_redex e1' e1_redex σ1 κ e2 σ2 efs : fill K' e1' = fill K_redex e1_redex → to_val e1' = None → base_step e1_redex σ1 κ e2 σ2 efs → ∃ K'', K_redex = comp_ectx K' K''. Proof. apply ectx_language_mixin. Qed. Lemma base_ctx_step_val K e σ1 κ e2 σ2 efs : base_step (fill K e) σ1 κ e2 σ2 efs → is_Some (to_val e) ∨ K = empty_ectx. Proof. apply ectx_language_mixin. Qed. Definition base_reducible (e : expr Λ) (σ : state Λ) := ∃ κ e' σ' efs, base_step e σ κ e' σ' efs. Definition base_reducible_no_obs (e : expr Λ) (σ : state Λ) := ∃ e' σ' efs, base_step e σ [] e' σ' efs. Definition base_irreducible (e : expr Λ) (σ : state Λ) := ∀ κ e' σ' efs, ¬base_step e σ κ e' σ' efs. Definition base_stuck (e : expr Λ) (σ : state Λ) := to_val e = None ∧ base_irreducible e σ. (* All non-value redexes are at the root. In other words, all sub-redexes are values. *) Definition sub_redexes_are_values (e : expr Λ) := ∀ K e', e = fill K e' → to_val e' = None → K = empty_ectx. Inductive prim_step (e1 : expr Λ) (σ1 : state Λ) (κ : list (observation Λ)) (e2 : expr Λ) (σ2 : state Λ) (efs : list (expr Λ)) : Prop := Ectx_step K e1' e2' : e1 = fill K e1' → e2 = fill K e2' → base_step e1' σ1 κ e2' σ2 efs → prim_step e1 σ1 κ e2 σ2 efs. Lemma Ectx_step' K e1 σ1 κ e2 σ2 efs : base_step e1 σ1 κ e2 σ2 efs → prim_step (fill K e1) σ1 κ (fill K e2) σ2 efs. Proof. econstructor; eauto. Qed. Definition ectx_lang_mixin : LanguageMixin of_val to_val prim_step. Proof. split. - apply ectx_language_mixin. - apply ectx_language_mixin. - intros ?????? [??? -> -> ?%val_base_stuck]. apply eq_None_not_Some. by intros ?%fill_val%eq_None_not_Some. Qed. Canonical Structure ectx_lang : language := Language ectx_lang_mixin. Definition base_atomic (a : atomicity) (e : expr Λ) : Prop := ∀ σ κ e' σ' efs, base_step e σ κ e' σ' efs → if a is WeaklyAtomic then irreducible e' σ' else is_Some (to_val e'). (** * Some lemmas about this language *) Lemma fill_not_val K e : to_val e = None → to_val (fill K e) = None. Proof. rewrite !eq_None_not_Some. eauto using fill_val. Qed. Lemma base_reducible_no_obs_reducible e σ : base_reducible_no_obs e σ → base_reducible e σ. Proof. intros (?&?&?&?). eexists. eauto. Qed. Lemma not_base_reducible e σ : ¬base_reducible e σ ↔ base_irreducible e σ. Proof. unfold base_reducible, base_irreducible. naive_solver. Qed. (** The decomposition into base redex and context is unique. In all sensible instances, [comp_ectx K' empty_ectx] will be the same as [K'], so the conclusion is [K = K' ∧ e = e'], but we do not require a law to actually prove that so we cannot use that fact here. *) Lemma base_redex_unique K K' e e' σ : fill K e = fill K' e' → base_reducible e σ → base_reducible e' σ → K = comp_ectx K' empty_ectx ∧ e = e'. Proof. intros Heq (κ & e2 & σ2 & efs & Hred) (κ' & e2' & σ2' & efs' & Hred'). edestruct (step_by_val K' K e' e) as [K'' HK]; [by eauto using val_base_stuck..|]. subst K. move: Heq. rewrite -fill_comp. intros <-%(inj (fill _)). destruct (base_ctx_step_val _ _ _ _ _ _ _ Hred') as [[]%not_eq_None_Some|HK'']. { by eapply val_base_stuck. } subst K''. rewrite fill_empty. done. Qed. Lemma base_prim_step e1 σ1 κ e2 σ2 efs : base_step e1 σ1 κ e2 σ2 efs → prim_step e1 σ1 κ e2 σ2 efs. Proof. apply Ectx_step with empty_ectx; by rewrite ?fill_empty. Qed. Lemma base_step_not_stuck e σ κ e' σ' efs : base_step e σ κ e' σ' efs → not_stuck e σ. Proof. rewrite /not_stuck /reducible /=. eauto 10 using base_prim_step. Qed. Lemma fill_prim_step K e1 σ1 κ e2 σ2 efs : prim_step e1 σ1 κ e2 σ2 efs → prim_step (fill K e1) σ1 κ (fill K e2) σ2 efs. Proof. destruct 1 as [K' e1' e2' -> ->]. rewrite !fill_comp. by econstructor. Qed. Lemma fill_reducible K e σ : reducible e σ → reducible (fill K e) σ. Proof. intros (κ&e'&σ'&efs&?). exists κ, (fill K e'), σ', efs. by apply fill_prim_step. Qed. Lemma fill_reducible_no_obs K e σ : reducible_no_obs e σ → reducible_no_obs (fill K e) σ. Proof. intros (e'&σ'&efs&?). exists (fill K e'), σ', efs. by apply fill_prim_step. Qed. Lemma base_prim_reducible e σ : base_reducible e σ → reducible e σ. Proof. intros (κ&e'&σ'&efs&?). eexists κ, e', σ', efs. by apply base_prim_step. Qed. Lemma base_prim_fill_reducible e K σ : base_reducible e σ → reducible (fill K e) σ. Proof. intro. by apply fill_reducible, base_prim_reducible. Qed. Lemma base_prim_reducible_no_obs e σ : base_reducible_no_obs e σ → reducible_no_obs e σ. Proof. intros (e'&σ'&efs&?). eexists e', σ', efs. by apply base_prim_step. Qed. Lemma base_prim_irreducible e σ : irreducible e σ → base_irreducible e σ. Proof. rewrite -not_reducible -not_base_reducible. eauto using base_prim_reducible. Qed. Lemma base_prim_fill_reducible_no_obs e K σ : base_reducible_no_obs e σ → reducible_no_obs (fill K e) σ. Proof. intro. by apply fill_reducible_no_obs, base_prim_reducible_no_obs. Qed. Lemma prim_base_reducible e σ : reducible e σ → sub_redexes_are_values e → base_reducible e σ. Proof. intros (κ&e'&σ'&efs&[K e1' e2' -> -> Hstep]) ?. assert (K = empty_ectx) as -> by eauto 10 using val_base_stuck. rewrite fill_empty /base_reducible; eauto. Qed. Lemma prim_base_irreducible e σ : base_irreducible e σ → sub_redexes_are_values e → irreducible e σ. Proof. rewrite -not_reducible -not_base_reducible. eauto using prim_base_reducible. Qed. Lemma base_stuck_stuck e σ : base_stuck e σ → sub_redexes_are_values e → stuck e σ. Proof. intros [] ?. split; first done. by apply prim_base_irreducible. Qed. Lemma ectx_language_atomic a e : base_atomic a e → sub_redexes_are_values e → Atomic a e. Proof. intros Hatomic_step Hatomic_fill σ κ e' σ' efs [K e1' e2' -> -> Hstep]. assert (K = empty_ectx) as -> by eauto 10 using val_base_stuck. rewrite fill_empty. eapply Hatomic_step. by rewrite fill_empty. Qed. Lemma base_reducible_prim_step_ctx K e1 σ1 κ e2 σ2 efs : base_reducible e1 σ1 → prim_step (fill K e1) σ1 κ e2 σ2 efs → ∃ e2', e2 = fill K e2' ∧ base_step e1 σ1 κ e2' σ2 efs. Proof. intros (κ'&e2''&σ2''&efs''&HhstepK) [K' e1' e2' HKe1 -> Hstep]. edestruct (step_by_val K) as [K'' ?]; eauto using val_base_stuck; simplify_eq/=. rewrite -fill_comp in HKe1; simplify_eq. exists (fill K'' e2'). rewrite fill_comp; split; first done. apply base_ctx_step_val in HhstepK as [[v ?]|?]; simplify_eq. { apply val_base_stuck in Hstep; simplify_eq. } by rewrite !fill_empty. Qed. Lemma base_reducible_prim_step e1 σ1 κ e2 σ2 efs : base_reducible e1 σ1 → prim_step e1 σ1 κ e2 σ2 efs → base_step e1 σ1 κ e2 σ2 efs. Proof. intros. edestruct (base_reducible_prim_step_ctx empty_ectx) as (?&?&?); rewrite ?fill_empty; eauto. by simplify_eq; rewrite fill_empty. Qed. (* Every evaluation context is a context. *) Global Instance ectx_lang_ctx K : LanguageCtx (fill K). Proof. split; simpl. - eauto using fill_not_val. - intros ?????? [K' e1' e2' Heq1 Heq2 Hstep]. by exists (comp_ectx K K') e1' e2'; rewrite ?Heq1 ?Heq2 ?fill_comp. - intros e1 σ1 κ e2 σ2 efs Hnval [K'' e1'' e2'' Heq1 -> Hstep]. destruct (step_by_val K K'' e1 e1'' σ1 κ e2'' σ2 efs) as [K' ->]; eauto. rewrite -fill_comp in Heq1; apply (inj (fill _)) in Heq1. exists (fill K' e2''); rewrite -fill_comp; split; auto. econstructor; eauto. Qed. Record pure_base_step (e1 e2 : expr Λ) := { pure_base_step_safe σ1 : base_reducible_no_obs e1 σ1; pure_base_step_det σ1 κ e2' σ2 efs : base_step e1 σ1 κ e2' σ2 efs → κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs = [] }. Lemma pure_base_step_pure_step e1 e2 : pure_base_step e1 e2 → pure_step e1 e2. Proof. intros [Hp1 Hp2]. split. - intros σ. destruct (Hp1 σ) as (e2' & σ2 & efs & ?). eexists e2', σ2, efs. by apply base_prim_step. - intros σ1 κ e2' σ2 efs ?%base_reducible_prim_step; eauto using base_reducible_no_obs_reducible. Qed. (** This is not an instance because HeapLang's [wp_pure] tactic already takes care of handling the evaluation context. So the instance is redundant. If you are defining your own language and your [wp_pure] works differently, you might want to specialize this lemma to your language and register that as an instance. *) Lemma pure_exec_fill K φ n e1 e2 : PureExec φ n e1 e2 → PureExec φ n (fill K e1) (fill K e2). Proof. apply: pure_exec_ctx. Qed. End ectx_language. Global Arguments ectx_lang : clear implicits. Global Arguments Ectx_step {Λ e1 σ1 κ e2 σ2 efs}. Coercion ectx_lang : ectxLanguage >-> language. (* This definition makes sure that the fields of the [language] record do not refer to the projections of the [ectxLanguage] record but to the actual fields of the [ectxLanguage] record. This is crucial for canonical structure search to work. Note that this trick no longer works when we switch to canonical projections because then the pattern match [let '...] will be desugared into projections. *) Definition LanguageOfEctx (Λ : ectxLanguage) : language := let '@EctxLanguage E V C St K of_val to_val empty comp fill base mix := Λ in @Language E V St K of_val to_val _ (@ectx_lang_mixin (@EctxLanguage E V C St K of_val to_val empty comp fill base mix)). Global Arguments LanguageOfEctx : simpl never. iris-iris-4.2.0/iris/program_logic/ectx_lifting.v000066400000000000000000000142751460620107300220770ustar00rootroot00000000000000(** Some derived lemmas for ectx-based languages *) From iris.proofmode Require Import proofmode. From iris.program_logic Require Export ectx_language weakestpre lifting. From iris.prelude Require Import options. Section wp. Context {Λ : ectxLanguage} `{!irisGS_gen hlc Λ Σ} {Hinh : Inhabited (state Λ)}. Implicit Types s : stuckness. Implicit Types P : iProp Σ. Implicit Types Φ : val Λ → iProp Σ. Implicit Types v : val Λ. Implicit Types e : expr Λ. Local Hint Resolve base_prim_reducible base_reducible_prim_step : core. Local Definition reducible_not_val_inhabitant e := reducible_not_val e inhabitant. Local Hint Resolve reducible_not_val_inhabitant : core. Local Hint Resolve base_stuck_stuck : core. Lemma wp_lift_base_step_fupd {s E Φ} e1 : to_val e1 = None → (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E,∅}=∗ ⌜base_reducible e1 σ1⌝ ∗ ∀ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={∅}=∗ ▷ |={∅,E}=> state_interp σ2 (S ns) κs (length efs + nt) ∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ fork_post }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros (?) "H". iApply wp_lift_step_fupd=>//. iIntros (σ1 ns κ κs nt) "Hσ". iMod ("H" with "Hσ") as "[% H]"; iModIntro. iSplit; first by destruct s; eauto. iIntros (e2 σ2 efs ?). iApply "H"; eauto. Qed. Lemma wp_lift_base_step {s E Φ} e1 : to_val e1 = None → (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E,∅}=∗ ⌜base_reducible e1 σ1⌝ ∗ ▷ ∀ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={∅,E}=∗ state_interp σ2 (S ns) κs (length efs + nt) ∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ fork_post }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros (?) "H". iApply wp_lift_base_step_fupd; [done|]. iIntros (?????) "?". iMod ("H" with "[$]") as "[$ H]". iIntros "!>" (e2 σ2 efs ?) "Hcred !> !>". by iApply "H". Qed. Lemma wp_lift_base_stuck E Φ e : to_val e = None → sub_redexes_are_values e → (∀ σ ns κs nt, state_interp σ ns κs nt ={E,∅}=∗ ⌜base_stuck e σ⌝) ⊢ WP e @ E ?{{ Φ }}. Proof. iIntros (??) "H". iApply wp_lift_stuck; first done. iIntros (σ ns κs nt) "Hσ". iMod ("H" with "Hσ") as "%". by auto. Qed. Lemma wp_lift_pure_base_stuck E Φ e : to_val e = None → sub_redexes_are_values e → (∀ σ, base_stuck e σ) → ⊢ WP e @ E ?{{ Φ }}. Proof using Hinh. iIntros (?? Hstuck). iApply wp_lift_base_stuck; [done|done|]. iIntros (σ ns κs nt) "_". iApply fupd_mask_intro; by auto with set_solver. Qed. Lemma wp_lift_atomic_base_step_fupd {s E1 E2 Φ} e1 : to_val e1 = None → (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E1}=∗ ⌜base_reducible e1 σ1⌝ ∗ ∀ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={E1}[E2]▷=∗ state_interp σ2 (S ns) κs (length efs + nt) ∗ from_option Φ False (to_val e2) ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ fork_post }}) ⊢ WP e1 @ s; E1 {{ Φ }}. Proof. iIntros (?) "H". iApply wp_lift_atomic_step_fupd; [done|]. iIntros (σ1 ns κ κs nt) "Hσ1". iMod ("H" with "Hσ1") as "[% H]"; iModIntro. iSplit; first by destruct s; auto. iIntros (e2 σ2 efs Hstep). iApply "H"; eauto. Qed. Lemma wp_lift_atomic_base_step {s E Φ} e1 : to_val e1 = None → (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E}=∗ ⌜base_reducible e1 σ1⌝ ∗ ▷ ∀ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={E}=∗ state_interp σ2 (S ns) κs (length efs + nt) ∗ from_option Φ False (to_val e2) ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ fork_post }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros (?) "H". iApply wp_lift_atomic_step; eauto. iIntros (σ1 ns κ κs nt) "Hσ1". iMod ("H" with "Hσ1") as "[% H]"; iModIntro. iSplit; first by destruct s; auto. iNext. iIntros (e2 σ2 efs Hstep). iApply "H"; eauto. Qed. Lemma wp_lift_atomic_base_step_no_fork_fupd {s E1 E2 Φ} e1 : to_val e1 = None → (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E1}=∗ ⌜base_reducible e1 σ1⌝ ∗ ∀ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={E1}[E2]▷=∗ ⌜efs = []⌝ ∗ state_interp σ2 (S ns) κs nt ∗ from_option Φ False (to_val e2)) ⊢ WP e1 @ s; E1 {{ Φ }}. Proof. iIntros (?) "H". iApply wp_lift_atomic_base_step_fupd; [done|]. iIntros (σ1 ns κ κs nt) "Hσ1". iMod ("H" $! σ1 with "Hσ1") as "[$ H]"; iModIntro. iIntros (v2 σ2 efs Hstep) "Hcred". iMod ("H" $! v2 σ2 efs with "[# //] Hcred") as "H". iIntros "!> !>". iMod "H" as "(-> & ? & ?) /=". by iFrame. Qed. Lemma wp_lift_atomic_base_step_no_fork {s E Φ} e1 : to_val e1 = None → (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E}=∗ ⌜base_reducible e1 σ1⌝ ∗ ▷ ∀ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={E}=∗ ⌜efs = []⌝ ∗ state_interp σ2 (S ns) κs nt ∗ from_option Φ False (to_val e2)) ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros (?) "H". iApply wp_lift_atomic_base_step; eauto. iIntros (σ1 ns κ κs nt) "Hσ1". iMod ("H" $! σ1 with "Hσ1") as "[$ H]"; iModIntro. iNext; iIntros (v2 σ2 efs Hstep) "Hcred". iMod ("H" $! v2 σ2 efs with "[//] Hcred") as "(-> & ? & ?) /=". by iFrame. Qed. Lemma wp_lift_pure_det_base_step_no_fork {s E E' Φ} e1 e2 : to_val e1 = None → (∀ σ1, base_reducible e1 σ1) → (∀ σ1 κ e2' σ2 efs', base_step e1 σ1 κ e2' σ2 efs' → κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = []) → (|={E}[E']▷=> £ 1 -∗ WP e2 @ s; E {{ Φ }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof using Hinh. intros. rewrite -(wp_lift_pure_det_step_no_fork e1 e2); eauto. destruct s; by auto. Qed. Lemma wp_lift_pure_det_base_step_no_fork' {s E Φ} e1 e2 : to_val e1 = None → (∀ σ1, base_reducible e1 σ1) → (∀ σ1 κ e2' σ2 efs', base_step e1 σ1 κ e2' σ2 efs' → κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = []) → ▷ (£ 1 -∗ WP e2 @ s; E {{ Φ }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof using Hinh. intros. rewrite -[(WP e1 @ s; _ {{ _ }})%I]wp_lift_pure_det_base_step_no_fork //. rewrite -step_fupd_intro //. Qed. End wp. iris-iris-4.2.0/iris/program_logic/ectxi_language.v000066400000000000000000000161501460620107300223710ustar00rootroot00000000000000(** An axiomatization of languages based on evaluation context items, including a proof that these are instances of general ectx-based languages. *) From iris.prelude Require Export prelude. From iris.program_logic Require Import language ectx_language. From iris.prelude Require Import options. (** TAKE CARE: When you define an [ectxiLanguage] canonical structure for your language, you need to also define a corresponding [language] and [ectxLanguage] canonical structure for canonical structure inference to work properly. You should use the coercion [EctxLanguageOfEctxi] and [LanguageOfEctx] for that, and not [ectxi_lang] and [ectxi_lang_ectx], otherwise the canonical projections will not point to the right terms. A full concrete example of setting up your language can be found in [heap_lang]. Below you can find the relevant parts: Module heap_lang. (* Your language definition *) Lemma heap_lang_mixin : EctxiLanguageMixin of_val to_val fill_item base_step. Proof. (* ... *) Qed. End heap_lang. Canonical Structure heap_ectxi_lang := EctxiLanguage heap_lang.heap_lang_mixin. Canonical Structure heap_ectx_lang := EctxLanguageOfEctxi heap_ectxi_lang. Canonical Structure heap_lang := LanguageOfEctx heap_ectx_lang. *) Section ectxi_language_mixin. Context {expr val ectx_item state observation : Type}. Context (of_val : val → expr). Context (to_val : expr → option val). Context (fill_item : ectx_item → expr → expr). Context (base_step : expr → state → list observation → expr → state → list expr → Prop). Record EctxiLanguageMixin := { mixin_to_of_val v : to_val (of_val v) = Some v; mixin_of_to_val e v : to_val e = Some v → of_val v = e; mixin_val_stuck e1 σ1 κ e2 σ2 efs : base_step e1 σ1 κ e2 σ2 efs → to_val e1 = None; mixin_fill_item_val Ki e : is_Some (to_val (fill_item Ki e)) → is_Some (to_val e); (** [fill_item] is always injective on the expression for a fixed context. *) mixin_fill_item_inj Ki : Inj (=) (=) (fill_item Ki); (** [fill_item] with (potentially different) non-value expressions is injective on the context. *) mixin_fill_item_no_val_inj Ki1 Ki2 e1 e2 : to_val e1 = None → to_val e2 = None → fill_item Ki1 e1 = fill_item Ki2 e2 → Ki1 = Ki2; (** If [fill_item Ki e] takes a base step, then [e] is a value (unlike for [ectx_language], an empty context is impossible here). In other words, if [e] is not a value then wrapping it in a context does not add new base redex positions. *) mixin_base_ctx_step_val Ki e σ1 κ e2 σ2 efs : base_step (fill_item Ki e) σ1 κ e2 σ2 efs → is_Some (to_val e); }. End ectxi_language_mixin. Structure ectxiLanguage := EctxiLanguage { expr : Type; val : Type; ectx_item : Type; state : Type; observation : Type; of_val : val → expr; to_val : expr → option val; fill_item : ectx_item → expr → expr; base_step : expr → state → list observation → expr → state → list expr → Prop; ectxi_language_mixin : EctxiLanguageMixin of_val to_val fill_item base_step }. Bind Scope expr_scope with expr. Bind Scope val_scope with val. Global Arguments EctxiLanguage {_ _ _ _ _ _ _ _ _} _. Global Arguments of_val {_} _. Global Arguments to_val {_} _. Global Arguments fill_item {_} _ _. Global Arguments base_step {_} _ _ _ _ _ _. Section ectxi_language. Context {Λ : ectxiLanguage}. Implicit Types (e : expr Λ) (Ki : ectx_item Λ). Notation ectx := (list (ectx_item Λ)). (* Only project stuff out of the mixin that is not also in ectxLanguage *) Global Instance fill_item_inj Ki : Inj (=) (=) (fill_item Ki). Proof. apply ectxi_language_mixin. Qed. Lemma fill_item_val Ki e : is_Some (to_val (fill_item Ki e)) → is_Some (to_val e). Proof. apply ectxi_language_mixin. Qed. Lemma fill_item_no_val_inj Ki1 Ki2 e1 e2 : to_val e1 = None → to_val e2 = None → fill_item Ki1 e1 = fill_item Ki2 e2 → Ki1 = Ki2. Proof. apply ectxi_language_mixin. Qed. Lemma base_ctx_step_val Ki e σ1 κ e2 σ2 efs : base_step (fill_item Ki e) σ1 κ e2 σ2 efs → is_Some (to_val e). Proof. apply ectxi_language_mixin. Qed. Definition fill (K : ectx) (e : expr Λ) : expr Λ := foldl (flip fill_item) e K. Lemma fill_app (K1 K2 : ectx) e : fill (K1 ++ K2) e = fill K2 (fill K1 e). Proof. apply foldl_app. Qed. Definition ectxi_lang_ectx_mixin : EctxLanguageMixin of_val to_val [] (flip (++)) fill base_step. Proof. assert (fill_val : ∀ K e, is_Some (to_val (fill K e)) → is_Some (to_val e)). { intros K. induction K as [|Ki K IH]=> e //=. by intros ?%IH%fill_item_val. } assert (fill_not_val : ∀ K e, to_val e = None → to_val (fill K e) = None). { intros K e. rewrite !eq_None_not_Some. eauto. } split. - apply ectxi_language_mixin. - apply ectxi_language_mixin. - apply ectxi_language_mixin. - done. - intros K1 K2 e. by rewrite /fill /= foldl_app. - intros K; induction K as [|Ki K IH]; rewrite /Inj; naive_solver. - done. - intros K K' e1 κ e1' σ1 e2 σ2 efs Hfill Hred Hstep; revert K' Hfill. induction K as [|Ki K IH] using rev_ind=> /= K' Hfill; eauto using app_nil_r. destruct K' as [|Ki' K' _] using @rev_ind; simplify_eq/=. { rewrite fill_app in Hstep. apply base_ctx_step_val in Hstep. apply fill_val in Hstep. by apply not_eq_None_Some in Hstep. } rewrite !fill_app /= in Hfill. assert (Ki = Ki') as ->. { eapply fill_item_no_val_inj, Hfill; eauto using val_base_stuck. apply fill_not_val. revert Hstep. apply ectxi_language_mixin. } simplify_eq. destruct (IH K') as [K'' ->]; auto. exists K''. by rewrite assoc. - intros K e1 σ1 κ e2 σ2 efs. destruct K as [|Ki K _] using rev_ind; simpl; first by auto. rewrite fill_app /=. intros ?%base_ctx_step_val; eauto using fill_val. Qed. Canonical Structure ectxi_lang_ectx := EctxLanguage ectxi_lang_ectx_mixin. Canonical Structure ectxi_lang := LanguageOfEctx ectxi_lang_ectx. Lemma fill_not_val K e : to_val e = None → to_val (fill K e) = None. Proof. rewrite !eq_None_not_Some. eauto using fill_val. Qed. Lemma ectxi_language_sub_redexes_are_values e : (∀ Ki e', e = fill_item Ki e' → is_Some (to_val e')) → sub_redexes_are_values e. Proof. intros Hsub K e' ->. destruct K as [|Ki K _] using @rev_ind=> //=. intros []%eq_None_not_Some. eapply fill_val, Hsub. by rewrite /= fill_app. Qed. Global Instance ectxi_lang_ctx_item Ki : LanguageCtx (fill_item Ki). Proof. change (LanguageCtx (fill [Ki])). apply _. Qed. End ectxi_language. Global Arguments ectxi_lang_ectx : clear implicits. Global Arguments ectxi_lang : clear implicits. Coercion ectxi_lang_ectx : ectxiLanguage >-> ectxLanguage. Coercion ectxi_lang : ectxiLanguage >-> language. Definition EctxLanguageOfEctxi (Λ : ectxiLanguage) : ectxLanguage := let '@EctxiLanguage E V C St K of_val to_val fill base mix := Λ in @EctxLanguage E V (list C) St K of_val to_val _ _ _ _ (@ectxi_lang_ectx_mixin (@EctxiLanguage E V C St K of_val to_val fill base mix)). Global Arguments EctxLanguageOfEctxi : simpl never. iris-iris-4.2.0/iris/program_logic/language.v000066400000000000000000000333601460620107300211770ustar00rootroot00000000000000From iris.algebra Require Export ofe. From iris.bi Require Export weakestpre. From iris.prelude Require Import options. Section language_mixin. Context {expr val state observation : Type}. Context (of_val : val → expr). Context (to_val : expr → option val). (** We annotate the reduction relation with observations [κ], which we will use in the definition of weakest preconditions to predict future observations and assert correctness of the predictions. *) Context (prim_step : expr → state → list observation → expr → state → list expr → Prop). Record LanguageMixin := { mixin_to_of_val v : to_val (of_val v) = Some v; mixin_of_to_val e v : to_val e = Some v → of_val v = e; mixin_val_stuck e σ κ e' σ' efs : prim_step e σ κ e' σ' efs → to_val e = None }. End language_mixin. Structure language := Language { expr : Type; val : Type; state : Type; observation : Type; of_val : val → expr; to_val : expr → option val; prim_step : expr → state → list observation → expr → state → list expr → Prop; language_mixin : LanguageMixin of_val to_val prim_step }. Bind Scope expr_scope with expr. Bind Scope val_scope with val. Global Arguments Language {_ _ _ _ _ _ _} _. Global Arguments of_val {_} _. Global Arguments to_val {_} _. Global Arguments prim_step {_} _ _ _ _ _ _. Canonical Structure stateO Λ := leibnizO (state Λ). Canonical Structure valO Λ := leibnizO (val Λ). Canonical Structure exprO Λ := leibnizO (expr Λ). Definition cfg (Λ : language) := (list (expr Λ) * state Λ)%type. Class LanguageCtx {Λ : language} (K : expr Λ → expr Λ) := { fill_not_val e : to_val e = None → to_val (K e) = None; fill_step e1 σ1 κ e2 σ2 efs : prim_step e1 σ1 κ e2 σ2 efs → prim_step (K e1) σ1 κ (K e2) σ2 efs; fill_step_inv e1' σ1 κ e2 σ2 efs : to_val e1' = None → prim_step (K e1') σ1 κ e2 σ2 efs → ∃ e2', e2 = K e2' ∧ prim_step e1' σ1 κ e2' σ2 efs }. Global Instance language_ctx_id Λ : LanguageCtx (@id (expr Λ)). Proof. constructor; naive_solver. Qed. Inductive atomicity := StronglyAtomic | WeaklyAtomic. Definition stuckness_to_atomicity (s : stuckness) : atomicity := if s is MaybeStuck then StronglyAtomic else WeaklyAtomic. Section language. Context {Λ : language}. Implicit Types v : val Λ. Implicit Types e : expr Λ. Lemma to_of_val v : to_val (of_val v) = Some v. Proof. apply language_mixin. Qed. Lemma of_to_val e v : to_val e = Some v → of_val v = e. Proof. apply language_mixin. Qed. Lemma val_stuck e σ κ e' σ' efs : prim_step e σ κ e' σ' efs → to_val e = None. Proof. apply language_mixin. Qed. Definition reducible (e : expr Λ) (σ : state Λ) := ∃ κ e' σ' efs, prim_step e σ κ e' σ' efs. (* Total WP only permits reductions without observations *) Definition reducible_no_obs (e : expr Λ) (σ : state Λ) := ∃ e' σ' efs, prim_step e σ [] e' σ' efs. Definition irreducible (e : expr Λ) (σ : state Λ) := ∀ κ e' σ' efs, ¬prim_step e σ κ e' σ' efs. Definition stuck (e : expr Λ) (σ : state Λ) := to_val e = None ∧ irreducible e σ. Definition not_stuck (e : expr Λ) (σ : state Λ) := is_Some (to_val e) ∨ reducible e σ. (* [Atomic WeaklyAtomic]: This (weak) form of atomicity is enough to open invariants when WP ensures safety, i.e., programs never can get stuck. We have an example in lambdaRust of an expression that is atomic in this sense, but not in the stronger sense defined below, and we have to be able to open invariants around that expression. See `CasStuckS` in [lambdaRust](https://gitlab.mpi-sws.org/FP/LambdaRust-coq/blob/master/theories/lang/lang.v). [Atomic StronglyAtomic]: To open invariants with a WP that does not ensure safety, we need a stronger form of atomicity. With the above definition, in case `e` reduces to a stuck non-value, there is no proof that the invariants have been established again. *) Class Atomic (a : atomicity) (e : expr Λ) : Prop := atomic σ e' κ σ' efs : prim_step e σ κ e' σ' efs → if a is WeaklyAtomic then irreducible e' σ' else is_Some (to_val e'). Inductive step (ρ1 : cfg Λ) (κ : list (observation Λ)) (ρ2 : cfg Λ) : Prop := | step_atomic e1 σ1 e2 σ2 efs t1 t2 : ρ1 = (t1 ++ e1 :: t2, σ1) → ρ2 = (t1 ++ e2 :: t2 ++ efs, σ2) → prim_step e1 σ1 κ e2 σ2 efs → step ρ1 κ ρ2. Local Hint Constructors step : core. Inductive nsteps : nat → cfg Λ → list (observation Λ) → cfg Λ → Prop := | nsteps_refl ρ : nsteps 0 ρ [] ρ | nsteps_l n ρ1 ρ2 ρ3 κ κs : step ρ1 κ ρ2 → nsteps n ρ2 κs ρ3 → nsteps (S n) ρ1 (κ ++ κs) ρ3. Local Hint Constructors nsteps : core. Definition erased_step (ρ1 ρ2 : cfg Λ) := ∃ κ, step ρ1 κ ρ2. (** [rtc erased_step] and [nsteps] encode the same thing, just packaged in a different way. *) Lemma erased_steps_nsteps ρ1 ρ2 : rtc erased_step ρ1 ρ2 ↔ ∃ n κs, nsteps n ρ1 κs ρ2. Proof. split. - induction 1; firstorder eauto. (* FIXME: [naive_solver eauto] should be able to handle this *) - intros (n & κs & Hsteps). unfold erased_step. induction Hsteps; eauto using rtc_refl, rtc_l. Qed. Lemma of_to_val_flip v e : of_val v = e → to_val e = Some v. Proof. intros <-. by rewrite to_of_val. Qed. Lemma not_reducible e σ : ¬reducible e σ ↔ irreducible e σ. Proof. unfold reducible, irreducible. naive_solver. Qed. Lemma reducible_not_val e σ : reducible e σ → to_val e = None. Proof. intros (?&?&?&?&?); eauto using val_stuck. Qed. Lemma reducible_no_obs_reducible e σ : reducible_no_obs e σ → reducible e σ. Proof. intros (?&?&?&?); eexists; eauto. Qed. Lemma val_irreducible e σ : is_Some (to_val e) → irreducible e σ. Proof. intros [??] ???? ?%val_stuck. by destruct (to_val e). Qed. Global Instance of_val_inj : Inj (=) (=) (@of_val Λ). Proof. by intros v v' Hv; apply (inj Some); rewrite -!to_of_val Hv. Qed. Lemma not_not_stuck e σ : ¬not_stuck e σ ↔ stuck e σ. Proof. rewrite /stuck /not_stuck -not_eq_None_Some -not_reducible. destruct (decide (to_val e = None)); naive_solver. Qed. Lemma strongly_atomic_atomic e a : Atomic StronglyAtomic e → Atomic a e. Proof. unfold Atomic. destruct a; eauto using val_irreducible. Qed. Lemma reducible_fill `{!@LanguageCtx Λ K} e σ : reducible e σ → reducible (K e) σ. Proof. unfold reducible in *. naive_solver eauto using fill_step. Qed. Lemma reducible_fill_inv `{!@LanguageCtx Λ K} e σ : to_val e = None → reducible (K e) σ → reducible e σ. Proof. intros ? (e'&σ'&k&efs&Hstep); unfold reducible. apply fill_step_inv in Hstep as (e2' & _ & Hstep); eauto. Qed. Lemma reducible_no_obs_fill `{!@LanguageCtx Λ K} e σ : reducible_no_obs e σ → reducible_no_obs (K e) σ. Proof. unfold reducible_no_obs in *. naive_solver eauto using fill_step. Qed. Lemma reducible_no_obs_fill_inv `{!@LanguageCtx Λ K} e σ : to_val e = None → reducible_no_obs (K e) σ → reducible_no_obs e σ. Proof. intros ? (e'&σ'&efs&Hstep); unfold reducible_no_obs. apply fill_step_inv in Hstep as (e2' & _ & Hstep); eauto. Qed. Lemma irreducible_fill `{!@LanguageCtx Λ K} e σ : to_val e = None → irreducible e σ → irreducible (K e) σ. Proof. rewrite -!not_reducible. naive_solver eauto using reducible_fill_inv. Qed. Lemma irreducible_fill_inv `{!@LanguageCtx Λ K} e σ : irreducible (K e) σ → irreducible e σ. Proof. rewrite -!not_reducible. naive_solver eauto using reducible_fill. Qed. Lemma not_stuck_fill_inv K `{!@LanguageCtx Λ K} e σ : not_stuck (K e) σ → not_stuck e σ. Proof. rewrite /not_stuck -!not_eq_None_Some. intros [?|?]. - auto using fill_not_val. - destruct (decide (to_val e = None)); eauto using reducible_fill_inv. Qed. Lemma stuck_fill `{!@LanguageCtx Λ K} e σ : stuck e σ → stuck (K e) σ. Proof. rewrite -!not_not_stuck. eauto using not_stuck_fill_inv. Qed. Lemma step_Permutation (t1 t1' t2 : list (expr Λ)) κ σ1 σ2 : t1 ≡ₚ t1' → step (t1,σ1) κ (t2,σ2) → ∃ t2', t2 ≡ₚ t2' ∧ step (t1',σ1) κ (t2',σ2). Proof. intros Ht [e1 σ1' e2 σ2' efs tl tr ?? Hstep]; simplify_eq/=. move: Ht; rewrite -Permutation_middle (symmetry_iff (≡ₚ)). intros (tl'&tr'&->&Ht)%Permutation_cons_inv_r. exists (tl' ++ e2 :: tr' ++ efs); split; [|by econstructor]. by rewrite -!Permutation_middle !assoc_L Ht. Qed. Lemma step_insert i t2 σ2 e κ e' σ3 efs : t2 !! i = Some e → prim_step e σ2 κ e' σ3 efs → step (t2, σ2) κ (<[i:=e']>t2 ++ efs, σ3). Proof. intros. edestruct (elem_of_list_split_length t2) as (t21&t22&?&?); first (by eauto using elem_of_list_lookup_2); simplify_eq. econstructor; eauto. by rewrite insert_app_r_alt // Nat.sub_diag /= -assoc_L. Qed. Lemma erased_step_Permutation (t1 t1' t2 : list (expr Λ)) σ1 σ2 : t1 ≡ₚ t1' → erased_step (t1,σ1) (t2,σ2) → ∃ t2', t2 ≡ₚ t2' ∧ erased_step (t1',σ1) (t2',σ2). Proof. intros Heq [? Hs]. pose proof (step_Permutation _ _ _ _ _ _ Heq Hs). firstorder. (* FIXME: [naive_solver] should be able to handle this *) Qed. Record pure_step (e1 e2 : expr Λ) := { pure_step_safe σ1 : reducible_no_obs e1 σ1; pure_step_det σ1 κ e2' σ2 efs : prim_step e1 σ1 κ e2' σ2 efs → κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs = [] }. Notation pure_steps_tp := (Forall2 (rtc pure_step)). (* TODO: Exclude the case of [n=0], either here, or in [wp_pure] to avoid it succeeding when it did not actually do anything. *) Class PureExec (φ : Prop) (n : nat) (e1 e2 : expr Λ) := pure_exec : φ → relations.nsteps pure_step n e1 e2. Lemma pure_step_ctx K `{!@LanguageCtx Λ K} e1 e2 : pure_step e1 e2 → pure_step (K e1) (K e2). Proof. intros [Hred Hstep]. split. - unfold reducible_no_obs in *. naive_solver eauto using fill_step. - intros σ1 κ e2' σ2 efs Hpstep. destruct (fill_step_inv e1 σ1 κ e2' σ2 efs) as (e2'' & -> & ?); [|exact Hpstep|]. + destruct (Hred σ1) as (? & ? & ? & ?); eauto using val_stuck. + edestruct (Hstep σ1 κ e2'' σ2 efs) as (? & -> & -> & ->); auto. Qed. Lemma pure_step_nsteps_ctx K `{!@LanguageCtx Λ K} n e1 e2 : relations.nsteps pure_step n e1 e2 → relations.nsteps pure_step n (K e1) (K e2). Proof. eauto using nsteps_congruence, pure_step_ctx. Qed. Lemma rtc_pure_step_ctx K `{!@LanguageCtx Λ K} e1 e2 : rtc pure_step e1 e2 → rtc pure_step (K e1) (K e2). Proof. eauto using rtc_congruence, pure_step_ctx. Qed. (* We do not make this an instance because it is awfully general. *) Lemma pure_exec_ctx K `{!@LanguageCtx Λ K} φ n e1 e2 : PureExec φ n e1 e2 → PureExec φ n (K e1) (K e2). Proof. rewrite /PureExec; eauto using pure_step_nsteps_ctx. Qed. (* This is a family of frequent assumptions for PureExec *) Class IntoVal (e : expr Λ) (v : val Λ) := into_val : of_val v = e. Class AsVal (e : expr Λ) := as_val : ∃ v, of_val v = e. (* There is no instance [IntoVal → AsVal] as often one can solve [AsVal] more efficiently since no witness has to be computed. *) Global Instance as_vals_of_val vs : TCForall AsVal (of_val <$> vs). Proof. apply TCForall_Forall, Forall_fmap, Forall_true=> v. rewrite /AsVal /=; eauto. Qed. Lemma as_val_is_Some e : (∃ v, of_val v = e) → is_Some (to_val e). Proof. intros [v <-]. rewrite to_of_val. eauto. Qed. Lemma prim_step_not_stuck e σ κ e' σ' efs : prim_step e σ κ e' σ' efs → not_stuck e σ. Proof. rewrite /not_stuck /reducible. eauto 10. Qed. Lemma rtc_pure_step_val `{!Inhabited (state Λ)} v e : rtc pure_step (of_val v) e → to_val e = Some v. Proof. intros ?; rewrite <- to_of_val. f_equal; symmetry; eapply rtc_nf; first done. intros [e' [Hstep _]]. destruct (Hstep inhabitant) as (?&?&?&Hval%val_stuck). by rewrite to_of_val in Hval. Qed. (** Let thread pools [t1] and [t3] be such that each thread in [t1] makes (zero or more) pure steps to the corresponding thread in [t3]. Furthermore, let [t2] be a thread pool such that [t1] under state [σ1] makes a (single) step to thread pool [t2] and state [σ2]. In this situation, either the step from [t1] to [t2] corresponds to one of the pure steps between [t1] and [t3], or, there is an [i] such that [i]th thread does not participate in the pure steps between [t1] and [t3] and [t2] corresponds to taking a step in the [i]th thread starting from [t1]. *) Lemma erased_step_pure_step_tp t1 σ1 t2 σ2 t3 : erased_step (t1, σ1) (t2, σ2) → pure_steps_tp t1 t3 → (σ1 = σ2 ∧ pure_steps_tp t2 t3) ∨ (∃ i e efs e' κ, t1 !! i = Some e ∧ t3 !! i = Some e ∧ t2 = <[i:=e']>t1 ++ efs ∧ prim_step e σ1 κ e' σ2 efs). Proof. intros [κ [e σ e' σ' efs t11 t12 ?? Hstep]] Hps; simplify_eq/=. apply Forall2_app_inv_l in Hps as (t31&?&Hpsteps&(e''&t32&Hps&?&->)%Forall2_cons_inv_l&->). destruct Hps as [e|e1 e2 e3 [_ Hprs]]. - right. exists (length t11), e, efs, e', κ; split_and!; last done. + by rewrite lookup_app_r // Nat.sub_diag. + apply Forall2_length in Hpsteps. by rewrite lookup_app_r Hpsteps // Nat.sub_diag. + by rewrite insert_app_r_alt // Nat.sub_diag /= -assoc_L. - edestruct Hprs as (?&?&?&?); first done; simplify_eq. left; split; first done. rewrite right_id_L. eauto using Forall2_app. Qed. End language. Global Hint Mode PureExec + - - ! - : typeclass_instances. Global Arguments step_atomic {Λ ρ1 κ ρ2}. Notation pure_steps_tp := (Forall2 (rtc pure_step)). iris-iris-4.2.0/iris/program_logic/lifting.v000066400000000000000000000170611460620107300210500ustar00rootroot00000000000000(** The "lifting lemmas" in this file serve to lift the rules of the operational semantics to the program logic. *) From iris.proofmode Require Import proofmode. From iris.program_logic Require Export weakestpre. From iris.prelude Require Import options. Section lifting. Context `{!irisGS_gen hlc Λ Σ}. Implicit Types s : stuckness. Implicit Types v : val Λ. Implicit Types e : expr Λ. Implicit Types σ : state Λ. Implicit Types P Q : iProp Σ. Implicit Types Φ : val Λ → iProp Σ. Local Hint Resolve reducible_no_obs_reducible : core. Lemma wp_lift_step_fupdN s E Φ e1 : to_val e1 = None → (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E,∅}=∗ ⌜if s is NotStuck then reducible e1 σ1 else True⌝ ∗ ∀ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ (S $ num_laters_per_step ns) ={∅}▷=∗^(S $ num_laters_per_step ns) |={∅,E}=> state_interp σ2 (S ns) κs (length efs + nt) ∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ fork_post }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof. by rewrite wp_unfold /wp_pre=>->. Qed. Lemma wp_lift_step_fupd s E Φ e1 : to_val e1 = None → (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E,∅}=∗ ⌜if s is NotStuck then reducible e1 σ1 else True⌝ ∗ ∀ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={∅}=∗ ▷ |={∅,E}=> state_interp σ2 (S ns) κs (length efs + nt) ∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ fork_post }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros (?) "Hwp". rewrite -wp_lift_step_fupdN; [|done]. iIntros (?????) "Hσ". iMod ("Hwp" with "Hσ") as "($ & Hwp)". iIntros "!>" (??? ?) "Hcred". iPoseProof (lc_weaken 1 with "Hcred") as "Hcred"; first lia. simpl. rewrite -step_fupdN_intro; [|done]. rewrite -bi.laterN_intro. iMod ("Hwp" with "[//] Hcred") as "Hwp". iApply step_fupd_intro; done. Qed. Lemma wp_lift_stuck E Φ e : to_val e = None → (∀ σ ns κs nt, state_interp σ ns κs nt ={E,∅}=∗ ⌜stuck e σ⌝) ⊢ WP e @ E ?{{ Φ }}. Proof. rewrite wp_unfold /wp_pre=>->. iIntros "H" (σ1 ns κ κs nt) "Hσ". iMod ("H" with "Hσ") as %[? Hirr]. iModIntro. iSplit; first done. iIntros (e2 σ2 efs ?). by case: (Hirr κ e2 σ2 efs). Qed. (** Derived lifting lemmas. *) Lemma wp_lift_step s E Φ e1 : to_val e1 = None → (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E,∅}=∗ ⌜if s is NotStuck then reducible e1 σ1 else True⌝ ∗ ▷ ∀ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={∅,E}=∗ state_interp σ2 (S ns) κs (length efs + nt) ∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ fork_post }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros (?) "H". iApply wp_lift_step_fupd; [done|]. iIntros (?????) "Hσ". iMod ("H" with "Hσ") as "[$ H]". iIntros "!> * % Hcred !> !>". by iApply "H". Qed. Lemma wp_lift_pure_step_no_fork `{!Inhabited (state Λ)} s E E' Φ e1 : (∀ σ1, if s is NotStuck then reducible e1 σ1 else to_val e1 = None) → (∀ κ σ1 e2 σ2 efs, prim_step e1 σ1 κ e2 σ2 efs → κ = [] ∧ σ2 = σ1 ∧ efs = []) → (|={E}[E']▷=> ∀ κ e2 efs σ, ⌜prim_step e1 σ κ e2 σ efs⌝ -∗ £ 1 -∗ WP e2 @ s; E {{ Φ }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros (Hsafe Hstep) "H". iApply wp_lift_step. { specialize (Hsafe inhabitant). destruct s; eauto using reducible_not_val. } iIntros (σ1 ns κ κs nt) "Hσ". iMod "H". iApply fupd_mask_intro; first set_solver. iIntros "Hclose". iSplit. { iPureIntro. destruct s; done. } iNext. iIntros (e2 σ2 efs ?) "Hcred". destruct (Hstep κ σ1 e2 σ2 efs) as (-> & <- & ->); auto. iMod (state_interp_mono with "Hσ") as "$". iMod "Hclose" as "_". iMod "H". iModIntro. by iDestruct ("H" with "[//] Hcred") as "$". Qed. Lemma wp_lift_pure_stuck `{!Inhabited (state Λ)} E Φ e : (∀ σ, stuck e σ) → True ⊢ WP e @ E ?{{ Φ }}. Proof. iIntros (Hstuck) "_". iApply wp_lift_stuck. - destruct(to_val e) as [v|] eqn:He; last done. rewrite -He. by case: (Hstuck inhabitant). - iIntros (σ ns κs nt) "_". iApply fupd_mask_intro; auto with set_solver. Qed. (* Atomic steps don't need any mask-changing business here, one can use the generic lemmas here. *) Lemma wp_lift_atomic_step_fupd {s E1 E2 Φ} e1 : to_val e1 = None → (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E1}=∗ ⌜if s is NotStuck then reducible e1 σ1 else True⌝ ∗ ∀ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={E1}[E2]▷=∗ state_interp σ2 (S ns) κs (length efs + nt) ∗ from_option Φ False (to_val e2) ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ fork_post }}) ⊢ WP e1 @ s; E1 {{ Φ }}. Proof. iIntros (?) "H". iApply (wp_lift_step_fupd s E1 _ e1)=>//; iIntros (σ1 ns κ κs nt) "Hσ1". iMod ("H" $! σ1 with "Hσ1") as "[$ H]". iApply fupd_mask_intro; first set_solver. iIntros "Hclose" (e2 σ2 efs ?) "Hcred". iMod "Hclose" as "_". iMod ("H" $! e2 σ2 efs with "[#] Hcred") as "H"; [done|]. iApply fupd_mask_intro; first set_solver. iIntros "Hclose !>". iMod "Hclose" as "_". iMod "H" as "($ & HQ & $)". destruct (to_val e2) eqn:?; last by iExFalso. iApply wp_value; last done. by apply of_to_val. Qed. Lemma wp_lift_atomic_step {s E Φ} e1 : to_val e1 = None → (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E}=∗ ⌜if s is NotStuck then reducible e1 σ1 else True⌝ ∗ ▷ ∀ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={E}=∗ state_interp σ2 (S ns) κs (length efs + nt) ∗ from_option Φ False (to_val e2) ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ fork_post }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros (?) "H". iApply wp_lift_atomic_step_fupd; [done|]. iIntros (?????) "?". iMod ("H" with "[$]") as "[$ H]". iIntros "!> *". iIntros (Hstep) "Hcred !> !>". by iApply "H". Qed. Lemma wp_lift_pure_det_step_no_fork `{!Inhabited (state Λ)} {s E E' Φ} e1 e2 : (∀ σ1, if s is NotStuck then reducible e1 σ1 else to_val e1 = None) → (∀ σ1 κ e2' σ2 efs', prim_step e1 σ1 κ e2' σ2 efs' → κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = []) → (|={E}[E']▷=> £ 1 -∗ WP e2 @ s; E {{ Φ }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros (? Hpuredet) "H". iApply (wp_lift_pure_step_no_fork s E E'); try done. { naive_solver. } iApply (step_fupd_wand with "H"); iIntros "H". iIntros (κ e' efs' σ (_&?&->&?)%Hpuredet); auto. Qed. Lemma wp_pure_step_fupd `{!Inhabited (state Λ)} s E E' e1 e2 φ n Φ : PureExec φ n e1 e2 → φ → (|={E}[E']▷=>^n £ n -∗ WP e2 @ s; E {{ Φ }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros (Hexec Hφ) "Hwp". specialize (Hexec Hφ). iInduction Hexec as [e|n e1 e2 e3 [Hsafe ?]] "IH"; simpl. { iMod lc_zero as "Hz". by iApply "Hwp". } iApply wp_lift_pure_det_step_no_fork. - intros σ. specialize (Hsafe σ). destruct s; eauto using reducible_not_val. - done. - iApply (step_fupd_wand with "Hwp"). iIntros "Hwp Hone". iApply "IH". iApply (step_fupdN_wand with "Hwp"). iIntros "Hwp Hc". iApply ("Hwp" with "[Hone Hc]"). rewrite (lc_succ n). iFrame. Qed. Lemma wp_pure_step_later `{!Inhabited (state Λ)} s E e1 e2 φ n Φ : PureExec φ n e1 e2 → φ → ▷^n (£ n -∗ WP e2 @ s; E {{ Φ }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof. intros Hexec ?. rewrite -wp_pure_step_fupd //. clear Hexec. enough (∀ P, ▷^n P ⊢ |={E}▷=>^n P) as Hwp by apply Hwp. intros ?. induction n as [|n IH]; by rewrite //= -step_fupd_intro // IH. Qed. End lifting. iris-iris-4.2.0/iris/program_logic/ownp.v000066400000000000000000000310541460620107300203750ustar00rootroot00000000000000From iris.algebra Require Import lib.excl_auth. From iris.proofmode Require Import proofmode classes. From iris.program_logic Require Export weakestpre. From iris.program_logic Require Import lifting adequacy. From iris.program_logic Require ectx_language. From iris.prelude Require Import options. (** This module provides an interface to handling ownership of the global state that works more like Iris 2.0 did. The state interpretation (in WP) is fixed to be authoritative ownership of the entire state (using the [excl] RA). Users can then put the corresponding fragment into an invariant on their own to establish a more interesting notion of ownership, such as the standard heap with disjoint union. *) Class ownPGS (Λ : language) (Σ : gFunctors) := OwnPGS { ownP_invG : invGS Σ; ownP_inG : inG Σ (excl_authR (stateO Λ)); ownP_name : gname; }. Local Existing Instance ownP_inG. Global Instance ownPG_irisGS `{!ownPGS Λ Σ} : irisGS Λ Σ := { iris_invGS := ownP_invG; state_interp σ _ κs _ := own ownP_name (●E σ)%I; fork_post _ := True%I; num_laters_per_step _ := 0; state_interp_mono _ _ _ _ := fupd_intro _ _ }. Global Opaque iris_invGS. Definition ownPΣ (Λ : language) : gFunctors := #[invΣ; GFunctor (excl_authR (stateO Λ))]. Class ownPGpreS (Λ : language) (Σ : gFunctors) : Set := { #[global] ownPPre_invG :: invGpreS Σ; ownPPre_state_inG : inG Σ (excl_authR (stateO Λ)) }. Local Existing Instance ownPPre_state_inG. Global Instance subG_ownPΣ {Λ Σ} : subG (ownPΣ Λ) Σ → ownPGpreS Λ Σ. Proof. solve_inG. Qed. (** Ownership *) Definition ownP `{!ownPGS Λ Σ} (σ : state Λ) : iProp Σ := own ownP_name (◯E σ). Global Typeclasses Opaque ownP. Global Instance: Params (@ownP) 3 := {}. (* Adequacy *) Theorem ownP_adequacy Σ `{!ownPGpreS Λ Σ} s e σ φ : (∀ `{!ownPGS Λ Σ}, ownP σ ⊢ WP e @ s; ⊤ {{ v, ⌜φ v⌝ }}) → adequate s e σ (λ v _, φ v). Proof. intros Hwp. apply (wp_adequacy Σ _). iIntros (? κs). iMod (own_alloc (●E σ ⋅ ◯E σ)) as (γσ) "[Hσ Hσf]"; first by apply excl_auth_valid. iModIntro. iExists (λ σ κs, own γσ (●E σ))%I, (λ _, True%I). iFrame "Hσ". iApply (Hwp (OwnPGS _ _ _ _ γσ)). rewrite /ownP. iFrame. Qed. Theorem ownP_invariance Σ `{!ownPGpreS Λ Σ} s e σ1 t2 σ2 φ : (∀ `{!ownPGS Λ Σ}, ownP σ1 ={⊤}=∗ WP e @ s; ⊤ {{ _, True }} ∗ |={⊤,∅}=> ∃ σ', ownP σ' ∧ ⌜φ σ'⌝) → rtc erased_step ([e], σ1) (t2, σ2) → φ σ2. Proof. intros Hwp Hsteps. eapply (wp_invariance Σ Λ s e σ1 t2 σ2 _)=> //. iIntros (? κs). iMod (own_alloc (●E σ1 ⋅ ◯E σ1)) as (γσ) "[Hσ Hσf]"; first by apply auth_both_valid_discrete. iExists (λ σ κs' _, own γσ (●E σ))%I, (λ _, True%I). iFrame "Hσ". iMod (Hwp (OwnPGS _ _ _ _ γσ) with "[Hσf]") as "[$ H]"; first by rewrite /ownP; iFrame. iIntros "!> Hσ". iExists ∅. iMod "H" as (σ2') "[Hσf %]". rewrite /ownP. iCombine "Hσ Hσf" gives %[Hp%Excl_included _]%auth_both_valid_discrete; simplify_eq; auto. Qed. (** Lifting *) (** All lifting lemmas defined here discard later credits.*) Section lifting. Context `{!ownPGS Λ Σ}. Implicit Types s : stuckness. Implicit Types e : expr Λ. Implicit Types Φ : val Λ → iProp Σ. Lemma ownP_eq σ1 ns σ2 κs nt : state_interp σ1 ns κs nt -∗ ownP σ2 -∗ ⌜σ1 = σ2⌝. Proof. iIntros "Hσ● Hσ◯". rewrite /ownP. by iCombine "Hσ● Hσ◯" gives %[->%Excl_included _]%auth_both_valid_discrete. Qed. Lemma ownP_state_twice σ1 σ2 : ownP σ1 ∗ ownP σ2 ⊢ False. Proof. rewrite /ownP -own_op own_valid. by iIntros (?%excl_auth_frag_op_valid). Qed. Global Instance ownP_timeless σ : Timeless (@ownP Λ Σ _ σ). Proof. rewrite /ownP; apply _. Qed. Lemma ownP_lift_step s E Φ e1 : (|={E,∅}=> ∃ σ1, ⌜if s is NotStuck then reducible e1 σ1 else to_val e1 = None⌝ ∗ ▷ ownP σ1 ∗ ▷ ∀ κ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ -∗ ownP σ2 ={∅,E}=∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros "H". destruct (to_val e1) as [v|] eqn:EQe1. - apply of_to_val in EQe1 as <-. iApply fupd_wp. iMod "H" as (σ1) "[Hred _]"; iDestruct "Hred" as %Hred. destruct s; last done. apply reducible_not_val in Hred. move: Hred; by rewrite to_of_val. - iApply wp_lift_step; [done|]; iIntros (σ1 ns κ κs nt) "Hσκs". iMod "H" as (σ1' ?) "[>Hσf H]". iDestruct (ownP_eq with "Hσκs Hσf") as %<-. iModIntro; iSplit; [by destruct s|]; iNext; iIntros (e2 σ2 efs Hstep) "Hcred". iDestruct "Hσκs" as "Hσ". rewrite /ownP. iMod (own_update_2 with "Hσ Hσf") as "[Hσ Hσf]". { apply excl_auth_update. } iFrame "Hσ". iApply ("H" with "[]"); eauto with iFrame. Qed. Lemma ownP_lift_stuck E Φ e : (|={E,∅}=> ∃ σ, ⌜stuck e σ⌝ ∗ ▷ (ownP σ)) ⊢ WP e @ E ?{{ Φ }}. Proof. iIntros "H". destruct (to_val e) as [v|] eqn:EQe. - apply of_to_val in EQe as <-. iApply fupd_wp. iMod "H" as (σ1) "[H _]". iDestruct "H" as %[Hnv _]. exfalso. by rewrite to_of_val in Hnv. - iApply wp_lift_stuck; [done|]. iIntros (σ1 ns κs nt) "Hσ". iMod "H" as (σ1') "(% & >Hσf)". by iDestruct (ownP_eq with "Hσ Hσf") as %->. Qed. Lemma ownP_lift_pure_step `{!Inhabited (state Λ)} s E Φ e1 : (∀ σ1, if s is NotStuck then reducible e1 σ1 else to_val e1 = None) → (∀ σ1 κ e2 σ2 efs, prim_step e1 σ1 κ e2 σ2 efs → κ = [] ∧ σ2 = σ1) → (▷ ∀ κ e2 efs σ, ⌜prim_step e1 σ κ e2 σ efs⌝ → WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros (Hsafe Hstep) "H"; iApply wp_lift_step. { specialize (Hsafe inhabitant). destruct s; last done. by eapply reducible_not_val. } iIntros (σ1 ns κ κs nt) "Hσ". iApply fupd_mask_intro; first set_solver. iIntros "Hclose". iSplit; [by destruct s|]; iNext; iIntros (e2 σ2 efs ?) "Hcred". destruct (Hstep σ1 κ e2 σ2 efs); auto; subst. by iMod "Hclose"; iModIntro; iFrame; iApply "H". Qed. (** Derived lifting lemmas. *) Lemma ownP_lift_atomic_step {s E Φ} e1 σ1 : (if s is NotStuck then reducible e1 σ1 else to_val e1 = None) → (▷ (ownP σ1) ∗ ▷ ∀ κ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ -∗ ownP σ2 -∗ from_option Φ False (to_val e2) ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros (?) "[Hσ H]"; iApply ownP_lift_step. iApply fupd_mask_intro; first set_solver. iIntros "Hclose". iExists σ1; iFrame; iSplit; first by destruct s. iNext; iIntros (κ e2 σ2 efs ?) "Hσ". iDestruct ("H" $! κ e2 σ2 efs with "[] [Hσ]") as "[HΦ $]"; [by eauto..|]. destruct (to_val e2) eqn:?; last by iExFalso. iMod "Hclose"; iApply wp_value; last done. by apply of_to_val. Qed. Lemma ownP_lift_atomic_det_step {s E Φ e1} σ1 v2 σ2 efs : (if s is NotStuck then reducible e1 σ1 else to_val e1 = None) → (∀ κ' e2' σ2' efs', prim_step e1 σ1 κ' e2' σ2' efs' → σ2' = σ2 ∧ to_val e2' = Some v2 ∧ efs' = efs) → ▷ (ownP σ1) ∗ ▷ (ownP σ2 -∗ Φ v2 ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros (? Hdet) "[Hσ1 Hσ2]"; iApply ownP_lift_atomic_step; try done. iFrame; iNext; iIntros (κ' e2' σ2' efs' ?) "Hσ2'". edestruct (Hdet κ') as (<-&Hval&<-); first done. rewrite Hval. iApply ("Hσ2" with "Hσ2'"). Qed. Lemma ownP_lift_atomic_det_step_no_fork {s E e1} σ1 v2 σ2 : (if s is NotStuck then reducible e1 σ1 else to_val e1 = None) → (∀ κ' e2' σ2' efs', prim_step e1 σ1 κ' e2' σ2' efs' → σ2' = σ2 ∧ to_val e2' = Some v2 ∧ efs' = []) → {{{ ▷ (ownP σ1) }}} e1 @ s; E {{{ RET v2; ownP σ2 }}}. Proof. intros. rewrite -(ownP_lift_atomic_det_step σ1 v2 σ2 []); [|done..]. rewrite big_sepL_nil right_id. iIntros "Hs Hs'". iSplitL "Hs"; first by iFrame. iModIntro. iIntros "Hσ2". iApply "Hs'". iFrame. Qed. Lemma ownP_lift_pure_det_step_no_fork `{!Inhabited (state Λ)} {s E Φ} e1 e2 : (∀ σ1, if s is NotStuck then reducible e1 σ1 else to_val e1 = None) → (∀ σ1 κ e2' σ2 efs', prim_step e1 σ1 κ e2' σ2 efs' → κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = []) → ▷ WP e2 @ s; E {{ Φ }} ⊢ WP e1 @ s; E {{ Φ }}. Proof. intros. rewrite -(wp_lift_pure_det_step_no_fork e1 e2) //. iIntros "Hwp". iApply step_fupd_intro; first done. iNext. by iIntros "_". Qed. End lifting. Section ectx_lifting. Import ectx_language. Context {Λ : ectxLanguage} `{!ownPGS Λ Σ} {Hinh : Inhabited (state Λ)}. Implicit Types s : stuckness. Implicit Types Φ : val Λ → iProp Σ. Implicit Types e : expr Λ. Local Hint Resolve base_prim_reducible base_reducible_prim_step : core. Local Definition reducible_not_val_inhabitant e := reducible_not_val e inhabitant. Local Hint Resolve reducible_not_val_inhabitant : core. Local Hint Resolve base_stuck_stuck : core. Lemma ownP_lift_base_step s E Φ e1 : (|={E,∅}=> ∃ σ1, ⌜base_reducible e1 σ1⌝ ∗ ▷ (ownP σ1) ∗ ▷ ∀ κ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ -∗ ownP σ2 ={∅,E}=∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros "H". iApply ownP_lift_step. iMod "H" as (σ1 ?) "[>Hσ1 Hwp]". iModIntro. iExists σ1. iSplit. { destruct s; try by eauto using reducible_not_val. } iFrame. iNext. iIntros (κ e2 σ2 efs ?) "Hσ2". iApply ("Hwp" with "[] Hσ2"); eauto. Qed. Lemma ownP_lift_base_stuck E Φ e : sub_redexes_are_values e → (|={E,∅}=> ∃ σ, ⌜base_stuck e σ⌝ ∗ ▷ (ownP σ)) ⊢ WP e @ E ?{{ Φ }}. Proof. iIntros (?) "H". iApply ownP_lift_stuck. iMod "H" as (σ) "[% >Hσ]". iExists σ. iModIntro. by auto with iFrame. Qed. Lemma ownP_lift_pure_base_step s E Φ e1 : (∀ σ1, base_reducible e1 σ1) → (∀ σ1 κ e2 σ2 efs, base_step e1 σ1 κ e2 σ2 efs → κ = [] ∧ σ2 = σ1) → (▷ ∀ κ e2 efs σ, ⌜base_step e1 σ κ e2 σ efs⌝ → WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof using Hinh. iIntros (??) "H". iApply ownP_lift_pure_step; eauto. { by destruct s; auto. } iNext. iIntros (?????). iApply "H"; eauto. Qed. Lemma ownP_lift_atomic_base_step {s E Φ} e1 σ1 : base_reducible e1 σ1 → ▷ (ownP σ1) ∗ ▷ (∀ κ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ -∗ ownP σ2 -∗ from_option Φ False (to_val e2) ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros (?) "[Hst H]". iApply ownP_lift_atomic_step; eauto. { by destruct s; eauto using reducible_not_val. } iSplitL "Hst"; first done. iNext. iIntros (???? ?) "Hσ". iApply ("H" with "[] Hσ"); eauto. Qed. Lemma ownP_lift_atomic_det_base_step {s E Φ e1} σ1 v2 σ2 efs : base_reducible e1 σ1 → (∀ κ' e2' σ2' efs', base_step e1 σ1 κ' e2' σ2' efs' → σ2' = σ2 ∧ to_val e2' = Some v2 ∧ efs' = efs) → ▷ (ownP σ1) ∗ ▷ (ownP σ2 -∗ Φ v2 ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof. intros Hr Hs. destruct s; apply ownP_lift_atomic_det_step; eauto using reducible_not_val; intros; eapply Hs; eauto 10. Qed. Lemma ownP_lift_atomic_det_base_step_no_fork {s E e1} σ1 κ v2 σ2 : base_reducible e1 σ1 → (∀ κ' e2' σ2' efs', base_step e1 σ1 κ' e2' σ2' efs' → κ' = κ ∧ σ2' = σ2 ∧ to_val e2' = Some v2 ∧ efs' = []) → {{{ ▷ (ownP σ1) }}} e1 @ s; E {{{ RET v2; ownP σ2 }}}. Proof. intros ???; apply ownP_lift_atomic_det_step_no_fork; last naive_solver. by destruct s; eauto using reducible_not_val. Qed. Lemma ownP_lift_pure_det_base_step_no_fork {s E Φ} e1 e2 : (∀ σ1, base_reducible e1 σ1) → (∀ σ1 κ e2' σ2 efs', base_step e1 σ1 κ e2' σ2 efs' → κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = []) → ▷ WP e2 @ s; E {{ Φ }} ⊢ WP e1 @ s; E {{ Φ }}. Proof using Hinh. iIntros (??) "H"; iApply wp_lift_pure_det_step_no_fork; try by eauto. by destruct s; eauto using reducible_not_val. Qed. End ectx_lifting. iris-iris-4.2.0/iris/program_logic/total_adequacy.v000066400000000000000000000143601460620107300224120ustar00rootroot00000000000000From iris.algebra Require Import gmap auth agree gset coPset list. From iris.bi Require Import big_op fixpoint. From iris.proofmode Require Import proofmode. From iris.program_logic Require Export total_weakestpre adequacy. From iris.prelude Require Import options. Import uPred. Section adequacy. Context `{!irisGS_gen HasNoLc Λ Σ}. Implicit Types e : expr Λ. Definition twptp_pre (twptp : list (expr Λ) → iProp Σ) (t1 : list (expr Λ)) : iProp Σ := ∀ t2 σ1 ns κ κs σ2 nt, ⌜step (t1,σ1) κ (t2,σ2)⌝ -∗ state_interp σ1 ns κs nt ={⊤}=∗ ∃ nt', ⌜κ = []⌝ ∗ state_interp σ2 (S ns) κs nt' ∗ twptp t2. Lemma twptp_pre_mono (twptp1 twptp2 : list (expr Λ) → iProp Σ) : □ (∀ t, twptp1 t -∗ twptp2 t) -∗ ∀ t, twptp_pre twptp1 t -∗ twptp_pre twptp2 t. Proof. iIntros "#H"; iIntros (t) "Hwp". rewrite /twptp_pre. iIntros (t2 σ1 ns κ κs σ2 nt1) "Hstep Hσ". iMod ("Hwp" with "[$] [$]") as (n2) "($ & Hσ & ?)". iModIntro. iExists n2. iFrame "Hσ". by iApply "H". Qed. Local Instance twptp_pre_mono' : BiMonoPred twptp_pre. Proof. constructor; first (intros ????; apply twptp_pre_mono). intros wp Hwp n t1 t2 ?%(discrete_iff _ _)%leibniz_equiv; solve_proper. Qed. Definition twptp (t : list (expr Λ)) : iProp Σ := bi_least_fixpoint twptp_pre t. Lemma twptp_unfold t : twptp t ⊣⊢ twptp_pre twptp t. Proof. by rewrite /twptp least_fixpoint_unfold. Qed. Lemma twptp_ind Ψ : ⊢ (□ ∀ t, twptp_pre (λ t, Ψ t ∧ twptp t) t -∗ Ψ t) → ∀ t, twptp t -∗ Ψ t. Proof. iIntros "#IH" (t) "H". assert (NonExpansive Ψ). { by intros n ?? ->%(discrete_iff _ _)%leibniz_equiv. } iApply (least_fixpoint_ind _ Ψ with "[] H"). iIntros "!>" (t') "H". by iApply "IH". Qed. Local Instance twptp_Permutation : Proper ((≡ₚ) ==> (⊢)) twptp. Proof. iIntros (t1 t1' Ht) "Ht1". iRevert (t1' Ht); iRevert (t1) "Ht1". iApply twptp_ind; iIntros "!>" (t1) "IH"; iIntros (t1' Ht). rewrite twptp_unfold /twptp_pre. iIntros (t2 σ1 ns κ κs σ2 nt Hstep) "Hσ". destruct (step_Permutation t1' t1 t2 κ σ1 σ2) as (t2'&?&?); [done..|]. iMod ("IH" $! t2' with "[% //] Hσ") as (n2) "($ & Hσ & IH & _)". iModIntro. iExists n2. iFrame "Hσ". by iApply "IH". Qed. Lemma twptp_app t1 t2 : twptp t1 -∗ twptp t2 -∗ twptp (t1 ++ t2). Proof. iIntros "H1". iRevert (t2). iRevert (t1) "H1". iApply twptp_ind; iIntros "!>" (t1) "IH1". iIntros (t2) "H2". iRevert (t1) "IH1"; iRevert (t2) "H2". iApply twptp_ind; iIntros "!>" (t2) "IH2". iIntros (t1) "IH1". rewrite twptp_unfold /twptp_pre. iIntros (t1'' σ1 ns κ κs σ2 nt Hstep) "Hσ1". destruct Hstep as [e1 σ1' e2 σ2' efs' t1' t2' [=Ht ?] ? Hstep]; simplify_eq/=. apply app_eq_inv in Ht as [(t&?&?)|(t&?&?)]; subst. (* Case distinction on whether [e1] is in [t1] or [t2]. *) - destruct t as [|e1' ?]; simplify_eq/=. + iMod ("IH2" with "[%] Hσ1") as (n2) "($ & Hσ & IH2 & _)". { by eapply (step_atomic _ _ _ _ _ []). } iModIntro. iExists n2. iFrame "Hσ". rewrite -{2}(left_id_L [] (++) (e2 :: _)). iApply "IH2". by setoid_rewrite (right_id_L [] (++)). + iMod ("IH1" with "[%] Hσ1") as (n2) "($ & Hσ & IH1 & _)"; first by econstructor. iAssert (twptp t2) with "[IH2]" as "Ht2". { rewrite twptp_unfold. iApply (twptp_pre_mono with "[] IH2"). iIntros "!> * [_ ?] //". } iModIntro. iExists n2. iFrame "Hσ". rewrite -assoc_L (comm _ t2) !cons_middle !assoc_L. by iApply "IH1". - iMod ("IH2" with "[%] Hσ1") as (n2) "($ & Hσ & IH2 & _)"; first by econstructor. iModIntro. iExists n2. iFrame "Hσ". rewrite -assoc_L. by iApply "IH2". Qed. Lemma twp_twptp s Φ e : WP e @ s; ⊤ [{ Φ }] -∗ twptp [e]. Proof. iIntros "He". remember (⊤ : coPset) as E eqn:HE. iRevert (HE). iRevert (e E Φ) "He". iApply twp_ind. iIntros "!>" (e E Φ); iIntros "IH" (->). rewrite twptp_unfold /twptp_pre /twp_pre. iIntros (t1' σ1' ns κ κs σ2' nt Hstep) "Hσ1". destruct Hstep as [e1 σ1 e2 σ2 efs [|? t1] t2 ?? Hstep]; simplify_eq/=; try discriminate_list. destruct (to_val e1) as [v|] eqn:He1. { apply val_stuck in Hstep; naive_solver. } iMod ("IH" with "Hσ1") as "[_ IH]". iMod ("IH" with "[% //]") as "($ & Hσ & [IH _] & IHfork)". iModIntro. iExists (length efs + nt). iFrame "Hσ". iApply (twptp_app [_] with "(IH [//])"). clear. iInduction efs as [|e efs] "IH"; simpl. { rewrite twptp_unfold /twptp_pre. iIntros (t2 σ1 ns κ κs σ2 nt1 Hstep). destruct Hstep; simplify_eq/=; discriminate_list. } iDestruct "IHfork" as "[[IH' _] IHfork]". iApply (twptp_app [_] with "(IH' [//])"). by iApply "IH". Qed. Lemma twptp_total σ ns nt t : state_interp σ ns [] nt -∗ twptp t ={⊤}=∗ ⌜sn erased_step (t, σ)⌝. Proof. iIntros "Hσ Ht". iRevert (σ ns nt) "Hσ". iRevert (t) "Ht". iApply twptp_ind; iIntros "!>" (t) "IH"; iIntros (σ ns nt) "Hσ". iApply (pure_mono _ _ (Acc_intro _)). iIntros ([t' σ'] [κ Hstep]). rewrite /twptp_pre. iMod ("IH" with "[% //] Hσ") as (n' ->) "[Hσ [H _]]". by iApply "H". Qed. End adequacy. Theorem twp_total Σ Λ `{!invGpreS Σ} s e σ Φ n : (∀ `{Hinv : !invGS_gen HasNoLc Σ}, ⊢ |={⊤}=> ∃ (stateI : state Λ → nat → list (observation Λ) → nat → iProp Σ) (** We abstract over any instance of [irisG], and thus any value of the field [num_laters_per_step]. This is needed because instances of [irisG] (e.g., the one of HeapLang) are shared between WP and TWP, where TWP simply ignores [num_laters_per_step]. *) (num_laters_per_step : nat → nat) (fork_post : val Λ → iProp Σ) state_interp_mono, let _ : irisGS_gen HasNoLc Λ Σ := IrisG Hinv stateI fork_post num_laters_per_step state_interp_mono in stateI σ n [] 0 ∗ WP e @ s; ⊤ [{ Φ }]) → sn erased_step ([e], σ). (* i.e. ([e], σ) is strongly normalizing *) Proof. intros Hwp. eapply pure_soundness. apply (fupd_soundness_no_lc ⊤ ⊤ _ 0)=> Hinv. iIntros "_". iMod (Hwp) as (stateI num_laters_per_step fork_post stateI_mono) "[Hσ H]". set (iG := IrisG Hinv stateI fork_post num_laters_per_step stateI_mono). iApply (@twptp_total _ _ iG _ n with "Hσ"). by iApply (@twp_twptp _ _ (IrisG Hinv _ fork_post _ _)). Qed. iris-iris-4.2.0/iris/program_logic/total_ectx_lifting.v000066400000000000000000000066071460620107300233020ustar00rootroot00000000000000(** Some derived lemmas for ectx-based languages *) From iris.proofmode Require Import proofmode. From iris.program_logic Require Export ectx_language total_weakestpre total_lifting. From iris.prelude Require Import options. Section wp. Context {Λ : ectxLanguage} `{!irisGS_gen hlc Λ Σ} {Hinh : Inhabited (state Λ)}. Implicit Types P : iProp Σ. Implicit Types Φ : val Λ → iProp Σ. Implicit Types v : val Λ. Implicit Types e : expr Λ. Local Hint Resolve base_prim_reducible_no_obs base_reducible_prim_step base_reducible_no_obs_reducible : core. Lemma twp_lift_base_step {s E Φ} e1 : to_val e1 = None → (∀ σ1 ns κs nt, state_interp σ1 ns κs nt ={E,∅}=∗ ⌜base_reducible_no_obs e1 σ1⌝ ∗ ∀ κ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ ={∅,E}=∗ ⌜κ = []⌝ ∗ state_interp σ2 (S ns) κs (length efs + nt) ∗ WP e2 @ s; E [{ Φ }] ∗ [∗ list] i ↦ ef ∈ efs, WP ef @ s; ⊤ [{ fork_post }]) ⊢ WP e1 @ s; E [{ Φ }]. Proof. iIntros (?) "H". iApply (twp_lift_step _ E)=>//. iIntros (σ1 ns κs nt) "Hσ". iMod ("H" $! σ1 with "Hσ") as "[% H]"; iModIntro. iSplit; [destruct s; auto|]. iIntros (κ e2 σ2 efs Hstep). iApply "H". by eauto. Qed. Lemma twp_lift_pure_base_step_no_fork {s E Φ} e1 : (∀ σ1, base_reducible_no_obs e1 σ1) → (∀ σ1 κ e2 σ2 efs, base_step e1 σ1 κ e2 σ2 efs → κ = [] ∧ σ2 = σ1 ∧ efs = []) → (|={E}=> ∀ κ e2 efs σ, ⌜base_step e1 σ κ e2 σ efs⌝ → WP e2 @ s; E [{ Φ }] ) ⊢ WP e1 @ s; E [{ Φ }]. Proof using Hinh. iIntros (??) ">H". iApply twp_lift_pure_step_no_fork; eauto. iIntros "!>" (?????). iApply "H"; eauto. Qed. Lemma twp_lift_atomic_base_step {s E Φ} e1 : to_val e1 = None → (∀ σ1 ns κs nt, state_interp σ1 ns κs nt ={E}=∗ ⌜base_reducible_no_obs e1 σ1⌝ ∗ ∀ κ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ ={E}=∗ ⌜κ = []⌝ ∗ state_interp σ2 (S ns) κs (length efs + nt) ∗ from_option Φ False (to_val e2) ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ [{ fork_post }]) ⊢ WP e1 @ s; E [{ Φ }]. Proof. iIntros (?) "H". iApply twp_lift_atomic_step; eauto. iIntros (σ1 ns κs nt) "Hσ1". iMod ("H" $! σ1 with "Hσ1") as "[% H]"; iModIntro. iSplit; first by destruct s; auto. iIntros (κ e2 σ2 efs Hstep). iApply "H"; eauto. Qed. Lemma twp_lift_atomic_base_step_no_fork {s E Φ} e1 : to_val e1 = None → (∀ σ1 ns κs nt, state_interp σ1 ns κs nt ={E}=∗ ⌜base_reducible_no_obs e1 σ1⌝ ∗ ∀ κ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ ={E}=∗ ⌜κ = []⌝ ∗ ⌜efs = []⌝ ∗ state_interp σ2 (S ns) κs nt ∗ from_option Φ False (to_val e2)) ⊢ WP e1 @ s; E [{ Φ }]. Proof. iIntros (?) "H". iApply twp_lift_atomic_base_step; eauto. iIntros (σ1 ns κs nt) "Hσ1". iMod ("H" $! σ1 with "Hσ1") as "[$ H]"; iModIntro. iIntros (κ v2 σ2 efs Hstep). iMod ("H" with "[# //]") as "(-> & -> & ? & $) /=". by iFrame. Qed. Lemma twp_lift_pure_det_base_step_no_fork {s E Φ} e1 e2 : to_val e1 = None → (∀ σ1, base_reducible_no_obs e1 σ1) → (∀ σ1 κ e2' σ2 efs', base_step e1 σ1 κ e2' σ2 efs' → κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = []) → WP e2 @ s; E [{ Φ }] ⊢ WP e1 @ s; E [{ Φ }]. Proof using Hinh. intros. rewrite -(twp_lift_pure_det_step_no_fork e1 e2); eauto. Qed. End wp. iris-iris-4.2.0/iris/program_logic/total_lifting.v000066400000000000000000000071511460620107300222520ustar00rootroot00000000000000From iris.bi Require Export big_op. From iris.proofmode Require Import proofmode. From iris.program_logic Require Export total_weakestpre. From iris.prelude Require Import options. Section lifting. Context `{!irisGS_gen hlc Λ Σ}. Implicit Types v : val Λ. Implicit Types e : expr Λ. Implicit Types σ : state Λ. Implicit Types P Q : iProp Σ. Implicit Types Φ : val Λ → iProp Σ. Local Hint Resolve reducible_no_obs_reducible : core. Lemma twp_lift_step s E Φ e1 : to_val e1 = None → (∀ σ1 ns κs nt, state_interp σ1 ns κs nt ={E,∅}=∗ ⌜if s is NotStuck then reducible_no_obs e1 σ1 else True⌝ ∗ ∀ κ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ ={∅,E}=∗ ⌜κ = []⌝ ∗ state_interp σ2 (S ns) κs (length efs + nt) ∗ WP e2 @ s; E [{ Φ }] ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ [{ fork_post }]) ⊢ WP e1 @ s; E [{ Φ }]. Proof. by rewrite twp_unfold /twp_pre=> ->. Qed. (** Derived lifting lemmas. *) Lemma twp_lift_pure_step_no_fork `{!Inhabited (state Λ)} s E Φ e1 : (∀ σ1, reducible_no_obs e1 σ1) → (∀ σ1 κ e2 σ2 efs, prim_step e1 σ1 κ e2 σ2 efs → κ = [] ∧ σ2 = σ1 ∧ efs = []) → (|={E}=> ∀ κ e2 efs σ, ⌜prim_step e1 σ κ e2 σ efs⌝ → WP e2 @ s; E [{ Φ }]) ⊢ WP e1 @ s; E [{ Φ }]. Proof. iIntros (Hsafe Hstep) ">H". iApply twp_lift_step. { eapply reducible_not_val, reducible_no_obs_reducible, (Hsafe inhabitant). } iIntros (σ1 ns κs n) "Hσ". iApply fupd_mask_intro; first by set_solver. iIntros "Hclose". iSplit. { iPureIntro. destruct s; auto. } iIntros (κ e2 σ2 efs ?). destruct (Hstep σ1 κ e2 σ2 efs) as (->&<-&->); auto. iMod (state_interp_mono with "Hσ"). iMod "Hclose" as "_". iDestruct ("H" with "[//]") as "H". simpl. by iFrame. Qed. (* Atomic steps don't need any mask-changing business here, one can use the generic lemmas here. *) Lemma twp_lift_atomic_step {s E Φ} e1 : to_val e1 = None → (∀ σ1 ns κs nt, state_interp σ1 ns κs nt ={E}=∗ ⌜if s is NotStuck then reducible_no_obs e1 σ1 else True⌝ ∗ ∀ κ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ ={E}=∗ ⌜κ = []⌝ ∗ state_interp σ2 (S ns) κs (length efs + nt) ∗ from_option Φ False (to_val e2) ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ [{ fork_post }]) ⊢ WP e1 @ s; E [{ Φ }]. Proof. iIntros (?) "H". iApply (twp_lift_step _ E _ e1)=>//; iIntros (σ1 ns κs nt) "Hσ1". iMod ("H" $! σ1 with "Hσ1") as "[$ H]". iApply fupd_mask_intro; first set_solver. iIntros "Hclose" (κ e2 σ2 efs) "%". iMod "Hclose" as "_". iMod ("H" $! κ e2 σ2 efs with "[#]") as "($ & $ & HΦ & $)"; first by eauto. destruct (to_val e2) eqn:?; last by iExFalso. iApply twp_value; last done. by apply of_to_val. Qed. Lemma twp_lift_pure_det_step_no_fork `{!Inhabited (state Λ)} {s E Φ} e1 e2 : (∀ σ1, reducible_no_obs e1 σ1) → (∀ σ1 κ e2' σ2 efs', prim_step e1 σ1 κ e2' σ2 efs' → κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = []) → (|={E}=> WP e2 @ s; E [{ Φ }]) ⊢ WP e1 @ s; E [{ Φ }]. Proof. iIntros (? Hpuredet) ">H". iApply (twp_lift_pure_step_no_fork s E); try done. { naive_solver. } iIntros "!>" (κ' e' efs' σ (_&_&->&->)%Hpuredet); auto. Qed. Lemma twp_pure_step `{!Inhabited (state Λ)} s E e1 e2 φ n Φ : PureExec φ n e1 e2 → φ → WP e2 @ s; E [{ Φ }] ⊢ WP e1 @ s; E [{ Φ }]. Proof. iIntros (Hexec Hφ) "Hwp". specialize (Hexec Hφ). iInduction Hexec as [e|n e1 e2 e3 [Hsafe ?]] "IH"; simpl; first done. iApply twp_lift_pure_det_step_no_fork; [done|naive_solver|]. iModIntro. by iApply "IH". Qed. End lifting. iris-iris-4.2.0/iris/program_logic/total_weakestpre.v000066400000000000000000000374551460620107300230020ustar00rootroot00000000000000From iris.bi Require Import fixpoint big_op. From iris.proofmode Require Import proofmode. From iris.program_logic Require Export weakestpre. From iris.prelude Require Import options. Import uPred. (** The definition of total weakest preconditions is very similar to the definition of normal (i.e. partial) weakest precondition, with the exception that there is no later modality. Hence, instead of taking a Banach's fixpoint, we take a least fixpoint. *) Definition twp_pre `{!irisGS_gen hlc Λ Σ} (s : stuckness) (wp : coPset → expr Λ → (val Λ → iProp Σ) → iProp Σ) : coPset → expr Λ → (val Λ → iProp Σ) → iProp Σ := λ E e1 Φ, match to_val e1 with | Some v => |={E}=> Φ v | None => ∀ σ1 ns κs nt, state_interp σ1 ns κs nt ={E,∅}=∗ ⌜if s is NotStuck then reducible_no_obs e1 σ1 else True⌝ ∗ ∀ κ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ ={∅,E}=∗ ⌜κ = []⌝ ∗ state_interp σ2 (S ns) κs (length efs + nt) ∗ wp E e2 Φ ∗ [∗ list] ef ∈ efs, wp ⊤ ef fork_post end%I. (** This is some uninteresting bookkeeping to prove that [twp_pre_mono] is monotone. The actual least fixpoint [twp_def] can be found below. *) Local Lemma twp_pre_mono `{!irisGS_gen hlc Λ Σ} s (wp1 wp2 : coPset → expr Λ → (val Λ → iProp Σ) → iProp Σ) : ⊢ (□ ∀ E e Φ, wp1 E e Φ -∗ wp2 E e Φ) → ∀ E e Φ, twp_pre s wp1 E e Φ -∗ twp_pre s wp2 E e Φ. Proof. iIntros "#H"; iIntros (E e1 Φ) "Hwp". rewrite /twp_pre. destruct (to_val e1) as [v|]; first done. iIntros (σ1 ns κs nt) "Hσ". iMod ("Hwp" with "Hσ") as "($ & Hwp)"; iModIntro. iIntros (κ e2 σ2 efs) "Hstep". iMod ("Hwp" with "Hstep") as (?) "(Hσ & Hwp & Hfork)". iModIntro. iFrame "Hσ". iSplit; first done. iSplitL "Hwp". - by iApply "H". - iApply (@big_sepL_impl with "Hfork"); iIntros "!>" (k e _) "Hwp". by iApply "H". Qed. (* Uncurry [twp_pre] and equip its type with an OFE structure *) Local Definition twp_pre' `{!irisGS_gen hlc Λ Σ} (s : stuckness) : (prodO (prodO (leibnizO coPset) (exprO Λ)) (val Λ -d> iPropO Σ) → iPropO Σ) → prodO (prodO (leibnizO coPset) (exprO Λ)) (val Λ -d> iPropO Σ) → iPropO Σ := uncurry3 ∘ twp_pre s ∘ curry3. Local Instance twp_pre_mono' `{!irisGS_gen hlc Λ Σ} s : BiMonoPred (twp_pre' s). Proof. constructor. - iIntros (wp1 wp2 ??) "#H"; iIntros ([[E e1] Φ]); iRevert (E e1 Φ). iApply twp_pre_mono. iIntros "!>" (E e Φ). iApply ("H" $! (E,e,Φ)). - intros wp Hwp n [[E1 e1] Φ1] [[E2 e2] Φ2] [[?%leibniz_equiv ?%leibniz_equiv] ?]; simplify_eq/=. rewrite /curry3 /twp_pre. do 26 (f_equiv || done). by apply pair_ne. Qed. Local Definition twp_def `{!irisGS_gen hlc Λ Σ} : Twp (iProp Σ) (expr Λ) (val Λ) stuckness := λ s E e Φ, bi_least_fixpoint (twp_pre' s) (E,e,Φ). Local Definition twp_aux : seal (@twp_def). Proof. by eexists. Qed. Definition twp' := twp_aux.(unseal). Global Arguments twp' {hlc Λ Σ _}. Global Existing Instance twp'. Local Lemma twp_unseal `{!irisGS_gen hlc Λ Σ} : twp = @twp_def hlc Λ Σ _. Proof. rewrite -twp_aux.(seal_eq) //. Qed. Section twp. Context `{!irisGS_gen hlc Λ Σ}. Implicit Types s : stuckness. Implicit Types P : iProp Σ. Implicit Types Φ : val Λ → iProp Σ. Implicit Types v : val Λ. Implicit Types e : expr Λ. (* Weakest pre *) Lemma twp_unfold s E e Φ : WP e @ s; E [{ Φ }] ⊣⊢ twp_pre s (twp s) E e Φ. Proof. by rewrite twp_unseal /twp_def least_fixpoint_unfold. Qed. Lemma twp_ind s Ψ : (∀ n E e, Proper (pointwise_relation _ (dist n) ==> dist n) (Ψ E e)) → □ (∀ e E Φ, twp_pre s (λ E e Φ, Ψ E e Φ ∧ WP e @ s; E [{ Φ }]) E e Φ -∗ Ψ E e Φ) -∗ ∀ e E Φ, WP e @ s; E [{ Φ }] -∗ Ψ E e Φ. Proof. iIntros (HΨ). iIntros "#IH" (e E Φ) "H". rewrite twp_unseal. set (Ψ' := uncurry3 Ψ : prodO (prodO (leibnizO coPset) (exprO Λ)) (val Λ -d> iPropO Σ) → iPropO Σ). assert (NonExpansive Ψ'). { intros n [[E1 e1] Φ1] [[E2 e2] Φ2] [[?%leibniz_equiv ?%leibniz_equiv] ?]; simplify_eq/=. by apply HΨ. } iApply (least_fixpoint_ind _ Ψ' with "[] H"). iIntros "!>" ([[??] ?]) "H". by iApply "IH". Qed. Global Instance twp_ne s E e n : Proper (pointwise_relation _ (dist n) ==> dist n) (twp (PROP:=iProp Σ) s E e). Proof. intros Φ1 Φ2 HΦ. rewrite !twp_unseal. by apply (least_fixpoint_ne _), pair_ne, HΦ. Qed. Global Instance twp_proper s E e : Proper (pointwise_relation _ (≡) ==> (≡)) (twp (PROP:=iProp Σ) s E e). Proof. by intros Φ Φ' ?; apply equiv_dist=>n; apply twp_ne=>v; apply equiv_dist. Qed. Lemma twp_value_fupd' s E Φ v : WP of_val v @ s; E [{ Φ }] ⊣⊢ |={E}=> Φ v. Proof. rewrite twp_unfold /twp_pre to_of_val. auto. Qed. Lemma twp_strong_mono s1 s2 E1 E2 e Φ Ψ : s1 ⊑ s2 → E1 ⊆ E2 → WP e @ s1; E1 [{ Φ }] -∗ (∀ v, Φ v ={E2}=∗ Ψ v) -∗ WP e @ s2; E2 [{ Ψ }]. Proof. iIntros (? HE) "H HΦ". iRevert (E2 Ψ HE) "HΦ"; iRevert (e E1 Φ) "H". iApply twp_ind; first solve_proper. iIntros "!>" (e E1 Φ) "IH"; iIntros (E2 Ψ HE) "HΦ". rewrite !twp_unfold /twp_pre. destruct (to_val e) as [v|] eqn:?. { iApply ("HΦ" with "[> -]"). by iApply (fupd_mask_mono E1 _). } iIntros (σ1 ns κs nt) "Hσ". iMod (fupd_mask_subseteq E1) as "Hclose"; first done. iMod ("IH" with "[$]") as "[% IH]". iModIntro; iSplit; [by destruct s1, s2|]. iIntros (κ e2 σ2 efs Hstep). iMod ("IH" with "[//]") as (?) "(Hσ & IH & IHefs)"; auto. iMod "Hclose" as "_"; iModIntro. iFrame "Hσ". iSplit; first done. iSplitR "IHefs". - iDestruct "IH" as "[IH _]". iApply ("IH" with "[//] HΦ"). - iApply (big_sepL_impl with "IHefs"); iIntros "!>" (k ef _) "[IH _]". iApply "IH"; auto. Qed. Lemma fupd_twp s E e Φ : (|={E}=> WP e @ s; E [{ Φ }]) ⊢ WP e @ s; E [{ Φ }]. Proof. rewrite twp_unfold /twp_pre. iIntros "H". destruct (to_val e) as [v|] eqn:?. { by iMod "H". } iIntros (σ1 ns κs nt) "Hσ1". iMod "H". by iApply "H". Qed. Lemma twp_fupd s E e Φ : WP e @ s; E [{ v, |={E}=> Φ v }] ⊢ WP e @ s; E [{ Φ }]. Proof. iIntros "H". iApply (twp_strong_mono with "H"); auto. Qed. Lemma twp_atomic s E1 E2 e Φ `{!Atomic (stuckness_to_atomicity s) e} : (|={E1,E2}=> WP e @ s; E2 [{ v, |={E2,E1}=> Φ v }]) ⊢ WP e @ s; E1 [{ Φ }]. Proof. iIntros "H". rewrite !twp_unfold /twp_pre /=. destruct (to_val e) as [v|] eqn:He. { by iDestruct "H" as ">>> $". } iIntros (σ1 ns κs nt) "Hσ". iMod "H". iMod ("H" $! σ1 with "Hσ") as "[$ H]". iModIntro. iIntros (κ e2 σ2 efs Hstep). iMod ("H" with "[//]") as (?) "(Hσ & H & Hefs)". destruct s. - rewrite !twp_unfold /twp_pre. destruct (to_val e2) as [v2|] eqn:He2. + iDestruct "H" as ">> $". by iFrame. + iMod ("H" with "[$]") as "[H _]". iDestruct "H" as %(? & ? & ? & ?). by edestruct (atomic _ _ _ _ _ Hstep). - destruct (atomic _ _ _ _ _ Hstep) as [v <-%of_to_val]. rewrite twp_value_fupd'. iMod "H" as ">H". iModIntro. iSplit; first done. iFrame "Hσ Hefs". by iApply twp_value_fupd'. Qed. Lemma twp_bind K `{!LanguageCtx K} s E e Φ : WP e @ s; E [{ v, WP K (of_val v) @ s; E [{ Φ }] }] ⊢ WP K e @ s; E [{ Φ }]. Proof. revert Φ. cut (∀ Φ', WP e @ s; E [{ Φ' }] -∗ ∀ Φ, (∀ v, Φ' v -∗ WP K (of_val v) @ s; E [{ Φ }]) -∗ WP K e @ s; E [{ Φ }]). { iIntros (help Φ) "H". iApply (help with "H"); auto. } iIntros (Φ') "H". iRevert (e E Φ') "H". iApply twp_ind; first solve_proper. iIntros "!>" (e E1 Φ') "IH". iIntros (Φ) "HΦ". rewrite /twp_pre. destruct (to_val e) as [v|] eqn:He. { apply of_to_val in He as <-. iApply fupd_twp. by iApply "HΦ". } rewrite twp_unfold /twp_pre fill_not_val //. iIntros (σ1 ns κs nt) "Hσ". iMod ("IH" with "[$]") as "[% IH]". iModIntro; iSplit. { iPureIntro. unfold reducible_no_obs in *. destruct s; naive_solver eauto using fill_step. } iIntros (κ e2 σ2 efs Hstep). destruct (fill_step_inv e σ1 κ e2 σ2 efs) as (e2'&->&?); auto. iMod ("IH" $! κ e2' σ2 efs with "[//]") as (?) "(Hσ & IH & IHefs)". iModIntro. iFrame "Hσ". iSplit; first done. iSplitR "IHefs". - iDestruct "IH" as "[IH _]". by iApply "IH". - by setoid_rewrite and_elim_r. Qed. Lemma twp_bind_inv K `{!LanguageCtx K} s E e Φ : WP K e @ s; E [{ Φ }] -∗ WP e @ s; E [{ v, WP K (of_val v) @ s; E [{ Φ }] }]. Proof. iIntros "H". remember (K e) as e' eqn:He'. iRevert (e He'). iRevert (e' E Φ) "H". iApply twp_ind; first solve_proper. iIntros "!>" (e' E1 Φ) "IH". iIntros (e ->). rewrite !twp_unfold {2}/twp_pre. destruct (to_val e) as [v|] eqn:He. { iModIntro. apply of_to_val in He as <-. rewrite !twp_unfold. iApply (twp_pre_mono with "[] IH"). by iIntros "!>" (E e Φ') "[_ ?]". } rewrite /twp_pre fill_not_val //. iIntros (σ1 ns κs nt) "Hσ". iMod ("IH" with "[$]") as "[% IH]". iModIntro; iSplit. { destruct s; eauto using reducible_no_obs_fill_inv. } iIntros (κ e2 σ2 efs Hstep). iMod ("IH" $! κ (K e2) σ2 efs with "[]") as (?) "(Hσ & IH & IHefs)"; eauto using fill_step. iModIntro. iFrame "Hσ". iSplit; first done. iSplitR "IHefs". - iDestruct "IH" as "[IH _]". by iApply "IH". - by setoid_rewrite and_elim_r. Qed. Lemma twp_wp s E e Φ : WP e @ s; E [{ Φ }] -∗ WP e @ s; E {{ Φ }}. Proof. iIntros "H". iLöb as "IH" forall (E e Φ). rewrite wp_unfold twp_unfold /wp_pre /twp_pre. destruct (to_val e) as [v|]=>//=. iIntros (σ1 ns κ κs nt) "Hσ". iMod ("H" with "Hσ") as "[% H]". iIntros "!>". iSplitR. { destruct s; eauto using reducible_no_obs_reducible. } iIntros (e2 σ2 efs) "Hstep _". iMod ("H" with "Hstep") as (->) "(Hσ & H & Hfork)". iApply fupd_mask_intro; [set_solver+|]. iIntros "Hclose". iIntros "!>!>". iApply step_fupdN_intro=>//. iModIntro. iMod "Hclose" as "_". iModIntro. iFrame "Hσ". iSplitL "H". { by iApply "IH". } iApply (@big_sepL_impl with "Hfork"). iIntros "!>" (k ef _) "H". by iApply "IH". Qed. (** This lemma is similar to [wp_step_fupdN_strong], the difference is the TWP (instead of a WP) in the premise. Since TWPs do not use up later credits, we get [£ n] in the viewshift in the premise. *) Lemma twp_wp_fupdN_strong n s E1 E2 e P Φ : TCEq (to_val e) None → E2 ⊆ E1 → (∀ σ ns κs nt, state_interp σ ns κs nt ={E1,∅}=∗ ⌜n ≤ S (num_laters_per_step ns)⌝) ∧ ((|={E1,E2}=> £ n ={∅}▷=∗^n |={E2,E1}=> P) ∗ WP e @ s; E2 [{ v, P ={E1}=∗ Φ v }]) -∗ WP e @ s; E1 {{ Φ }}. Proof. destruct n as [|n]. { iIntros (_ ?) "/= [_ [HP Hwp]]". iApply (wp_strong_mono with "[Hwp]"); [done..|by iApply twp_wp|]; simpl. iIntros (v) "H". iApply ("H" with "[>HP]"). iMod "HP". iMod lc_zero as "Hlc". by iApply "HP". } rewrite wp_unfold twp_unfold /wp_pre /twp_pre. iIntros (-> ?) "H". iIntros (σ1 ns κ κs nt) "Hσ". destruct (decide (n ≤ num_laters_per_step ns)) as [Hn|Hn]; first last. { iDestruct "H" as "[Hn _]". iMod ("Hn" with "Hσ") as %?. lia. } iDestruct "H" as "[_ [>HP Hwp]]". iMod ("Hwp" with "[$]") as "[% H]". iIntros "!>". iSplitR. { destruct s; eauto using reducible_no_obs_reducible. } iIntros (e2 σ2 efs Hstep) "Hcred /=". iDestruct ("H" $! κ e2 σ2 efs with "[% //]") as "H". iMod ("HP" with "[Hcred]") as "HP". { iApply (lc_weaken with "Hcred"); lia. } iIntros "!> !>". iMod "HP". iModIntro. iApply step_fupdN_le; [apply Hn|done|..]. iApply (step_fupdN_wand with "HP"); iIntros "HP". iMod "H" as (->) "($ & Hwp & Hfork)". iMod "HP". iModIntro. iSplitR "Hfork". - iApply twp_wp. iApply (twp_strong_mono with "Hwp"); [done|set_solver|]. iIntros (v) "HΦ". iApply ("HΦ" with "HP"). - iApply (big_sepL_impl with "Hfork"). iIntros "!>" (k ef _) "H". by iApply twp_wp. Qed. (** * Derived rules *) Lemma twp_mono s E e Φ Ψ : (∀ v, Φ v ⊢ Ψ v) → WP e @ s; E [{ Φ }] ⊢ WP e @ s; E [{ Ψ }]. Proof. iIntros (HΦ) "H"; iApply (twp_strong_mono with "H"); auto. iIntros (v) "?". by iApply HΦ. Qed. Lemma twp_stuck_mono s1 s2 E e Φ : s1 ⊑ s2 → WP e @ s1; E [{ Φ }] ⊢ WP e @ s2; E [{ Φ }]. Proof. iIntros (?) "H". iApply (twp_strong_mono with "H"); auto. Qed. Lemma twp_stuck_weaken s E e Φ : WP e @ s; E [{ Φ }] ⊢ WP e @ E ?[{ Φ }]. Proof. apply twp_stuck_mono. by destruct s. Qed. Lemma twp_mask_mono s E1 E2 e Φ : E1 ⊆ E2 → WP e @ s; E1 [{ Φ }] -∗ WP e @ s; E2 [{ Φ }]. Proof. iIntros (?) "H"; iApply (twp_strong_mono with "H"); auto. Qed. Global Instance twp_mono' s E e : Proper (pointwise_relation _ (⊢) ==> (⊢)) (twp (PROP:=iProp Σ) s E e). Proof. by intros Φ Φ' ?; apply twp_mono. Qed. Lemma twp_value_fupd s E Φ e v : IntoVal e v → WP e @ s; E [{ Φ }] ⊣⊢ |={E}=> Φ v. Proof. intros <-. by apply twp_value_fupd'. Qed. Lemma twp_value' s E Φ v : Φ v ⊢ WP (of_val v) @ s; E [{ Φ }]. Proof. rewrite twp_value_fupd'. auto. Qed. Lemma twp_value s E Φ e v : IntoVal e v → Φ v ⊢ WP e @ s; E [{ Φ }]. Proof. intros <-. apply twp_value'. Qed. Lemma twp_frame_l s E e Φ R : R ∗ WP e @ s; E [{ Φ }] ⊢ WP e @ s; E [{ v, R ∗ Φ v }]. Proof. iIntros "[? H]". iApply (twp_strong_mono with "H"); auto with iFrame. Qed. Lemma twp_frame_r s E e Φ R : WP e @ s; E [{ Φ }] ∗ R ⊢ WP e @ s; E [{ v, Φ v ∗ R }]. Proof. iIntros "[H ?]". iApply (twp_strong_mono with "H"); auto with iFrame. Qed. Lemma twp_wand s E e Φ Ψ : WP e @ s; E [{ Φ }] -∗ (∀ v, Φ v -∗ Ψ v) -∗ WP e @ s; E [{ Ψ }]. Proof. iIntros "H HΦ". iApply (twp_strong_mono with "H"); auto. iIntros (?) "?". by iApply "HΦ". Qed. Lemma twp_wand_l s E e Φ Ψ : (∀ v, Φ v -∗ Ψ v) ∗ WP e @ s; E [{ Φ }] -∗ WP e @ s; E [{ Ψ }]. Proof. iIntros "[H Hwp]". iApply (twp_wand with "Hwp H"). Qed. Lemma twp_wand_r s E e Φ Ψ : WP e @ s; E [{ Φ }] ∗ (∀ v, Φ v -∗ Ψ v) -∗ WP e @ s; E [{ Ψ }]. Proof. iIntros "[Hwp H]". iApply (twp_wand with "Hwp H"). Qed. Lemma twp_frame_wand s E e Φ R : R -∗ WP e @ s; E [{ v, R -∗ Φ v }] -∗ WP e @ s; E [{ Φ }]. Proof. iIntros "HR HWP". iApply (twp_wand with "HWP"). iIntros (v) "HΦ". by iApply "HΦ". Qed. Lemma twp_wp_step s E e P Φ : TCEq (to_val e) None → ▷ P -∗ WP e @ s; E [{ v, P ={E}=∗ Φ v }] -∗ WP e @ s; E {{ Φ }}. Proof. iIntros (?) "HP Hwp". iApply (wp_step_fupd _ _ E _ P with "[HP]"); [auto..|]. by iApply twp_wp. Qed. End twp. (** Proofmode class instances *) Section proofmode_classes. Context `{!irisGS_gen hlc Λ Σ}. Implicit Types P Q : iProp Σ. Implicit Types Φ : val Λ → iProp Σ. Implicit Types v : val Λ. Implicit Types e : expr Λ. Global Instance frame_twp p s E e R Φ Ψ : (FrameInstantiateExistDisabled → ∀ v, Frame p R (Φ v) (Ψ v)) → Frame p R (WP e @ s; E [{ Φ }]) (WP e @ s; E [{ Ψ }]) | 2. Proof. rewrite /Frame=> HR. rewrite twp_frame_l. apply twp_mono, HR. constructor. Qed. Global Instance is_except_0_wp s E e Φ : IsExcept0 (WP e @ s; E [{ Φ }]). Proof. by rewrite /IsExcept0 -{2}fupd_twp -except_0_fupd -fupd_intro. Qed. Global Instance elim_modal_bupd_twp p s E e P Φ : ElimModal True p false (|==> P) P (WP e @ s; E [{ Φ }]) (WP e @ s; E [{ Φ }]). Proof. by rewrite /ElimModal intuitionistically_if_elim (bupd_fupd E) fupd_frame_r wand_elim_r fupd_twp. Qed. Global Instance elim_modal_fupd_twp p s E e P Φ : ElimModal True p false (|={E}=> P) P (WP e @ s; E [{ Φ }]) (WP e @ s; E [{ Φ }]). Proof. by rewrite /ElimModal intuitionistically_if_elim fupd_frame_r wand_elim_r fupd_twp. Qed. Global Instance elim_modal_fupd_twp_atomic p s E1 E2 e P Φ : ElimModal (Atomic (stuckness_to_atomicity s) e) p false (|={E1,E2}=> P) P (WP e @ s; E1 [{ Φ }]) (WP e @ s; E2 [{ v, |={E2,E1}=> Φ v }])%I | 100. Proof. intros ?. by rewrite intuitionistically_if_elim fupd_frame_r wand_elim_r twp_atomic. Qed. Global Instance add_modal_fupd_twp s E e P Φ : AddModal (|={E}=> P) P (WP e @ s; E [{ Φ }]). Proof. by rewrite /AddModal fupd_frame_r wand_elim_r fupd_twp. Qed. End proofmode_classes. iris-iris-4.2.0/iris/program_logic/weakestpre.v000066400000000000000000000560651460620107300215750ustar00rootroot00000000000000From iris.proofmode Require Import base proofmode classes. From iris.base_logic.lib Require Export fancy_updates. From iris.program_logic Require Export language. (* FIXME: If we import iris.bi.weakestpre earlier texan triples do not get pretty-printed correctly. *) From iris.bi Require Export weakestpre. From iris.prelude Require Import options. Import uPred. Class irisGS_gen (hlc : has_lc) (Λ : language) (Σ : gFunctors) := IrisG { #[global] iris_invGS :: invGS_gen hlc Σ; (** The state interpretation is an invariant that should hold in between each step of reduction. Here [Λstate] is the global state, the first [nat] is the number of steps already performed by the program, [list (observation Λ)] are the remaining observations, and the last [nat] is the number of forked-off threads (not the total number of threads, which is one higher because there is always a main thread). *) state_interp : state Λ → nat → list (observation Λ) → nat → iProp Σ; (** A fixed postcondition for any forked-off thread. For most languages, e.g. heap_lang, this will simply be [True]. However, it is useful if one wants to keep track of resources precisely, as in e.g. Iron. *) fork_post : val Λ → iProp Σ; (** The number of additional logical steps (i.e., later modality in the definition of WP) and later credits per physical step is [S (num_laters_per_step ns)], where [ns] is the number of physical steps executed so far. We add one to [num_laters_per_step] to ensure that there is always at least one later and later credit for each physical step. *) num_laters_per_step : nat → nat; (** When performing pure steps, the state interpretation needs to be adapted for the change in the [ns] parameter. Note that we use an empty-mask fancy update here. We could also use a basic update or a bare magic wand, the expressiveness of the framework would be the same. If we removed the modality here, then the client would have to include the modality it needs as part of the definition of [state_interp]. Since adding the modality as part of the definition [state_interp_mono] does not significantly complicate the formalization in Iris, we prefer simplifying the client. *) state_interp_mono σ ns κs nt: state_interp σ ns κs nt ⊢ |={∅}=> state_interp σ (S ns) κs nt }. Global Opaque iris_invGS. Global Arguments IrisG {hlc Λ Σ}. Notation irisGS := (irisGS_gen HasLc). (** The predicate we take the fixpoint of in order to define the WP. *) (** In the step case, we both provide [S (num_laters_per_step ns)] later credits, as well as an iterated update modality that allows stripping as many laters, where [ns] is the number of steps already taken. We have both as each of these provides distinct advantages: - Later credits do not have to be used right away, but can be kept to eliminate laters at a later point. - The step-taking update composes well in parallel: we can independently compose two clients who want to eliminate their laters for the same physical step, which is not possible with later credits, as they can only be used by exactly one client. - The step-taking update can even be used by clients that opt out of later credits, e.g. because they use [BiFUpdPlainly]. *) Definition wp_pre `{!irisGS_gen hlc Λ Σ} (s : stuckness) (wp : coPset -d> expr Λ -d> (val Λ -d> iPropO Σ) -d> iPropO Σ) : coPset -d> expr Λ -d> (val Λ -d> iPropO Σ) -d> iPropO Σ := λ E e1 Φ, match to_val e1 with | Some v => |={E}=> Φ v | None => ∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E,∅}=∗ ⌜if s is NotStuck then reducible e1 σ1 else True⌝ ∗ ∀ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ (S (num_laters_per_step ns)) ={∅}▷=∗^(S $ num_laters_per_step ns) |={∅,E}=> state_interp σ2 (S ns) κs (length efs + nt) ∗ wp E e2 Φ ∗ [∗ list] i ↦ ef ∈ efs, wp ⊤ ef fork_post end%I. Local Instance wp_pre_contractive `{!irisGS_gen hlc Λ Σ} s : Contractive (wp_pre s). Proof. rewrite /wp_pre /= => n wp wp' Hwp E e1 Φ. do 25 (f_contractive || f_equiv). (* FIXME : simplify this proof once we have a good definition and a proper instance for step_fupdN. *) induction num_laters_per_step as [|k IH]; simpl. - repeat (f_contractive || f_equiv); apply Hwp. - by rewrite -IH. Qed. Local Definition wp_def `{!irisGS_gen hlc Λ Σ} : Wp (iProp Σ) (expr Λ) (val Λ) stuckness := λ s : stuckness, fixpoint (wp_pre s). Local Definition wp_aux : seal (@wp_def). Proof. by eexists. Qed. Definition wp' := wp_aux.(unseal). Global Arguments wp' {hlc Λ Σ _}. Global Existing Instance wp'. Local Lemma wp_unseal `{!irisGS_gen hlc Λ Σ} : wp = @wp_def hlc Λ Σ _. Proof. rewrite -wp_aux.(seal_eq) //. Qed. Section wp. Context `{!irisGS_gen hlc Λ Σ}. Implicit Types s : stuckness. Implicit Types P : iProp Σ. Implicit Types Φ : val Λ → iProp Σ. Implicit Types v : val Λ. Implicit Types e : expr Λ. (* Weakest pre *) Lemma wp_unfold s E e Φ : WP e @ s; E {{ Φ }} ⊣⊢ wp_pre s (wp (PROP:=iProp Σ) s) E e Φ. Proof. rewrite wp_unseal. apply (fixpoint_unfold (wp_pre s)). Qed. Global Instance wp_ne s E e n : Proper (pointwise_relation _ (dist n) ==> dist n) (wp (PROP:=iProp Σ) s E e). Proof. revert e. induction (lt_wf n) as [n _ IH]=> e Φ Ψ HΦ. rewrite !wp_unfold /wp_pre /=. (* FIXME: figure out a way to properly automate this proof *) (* FIXME: reflexivity, as being called many times by f_equiv and f_contractive is very slow here *) do 25 (f_contractive || f_equiv). (* FIXME : simplify this proof once we have a good definition and a proper instance for step_fupdN. *) induction num_laters_per_step as [|k IHk]; simpl; last by rewrite IHk. rewrite IH; [done|lia|]. intros v. eapply dist_le; [apply HΦ|lia]. Qed. Global Instance wp_proper s E e : Proper (pointwise_relation _ (≡) ==> (≡)) (wp (PROP:=iProp Σ) s E e). Proof. by intros Φ Φ' ?; apply equiv_dist=>n; apply wp_ne=>v; apply equiv_dist. Qed. Global Instance wp_contractive s E e n : TCEq (to_val e) None → Proper (pointwise_relation _ (dist_later n) ==> dist n) (wp (PROP:=iProp Σ) s E e). Proof. intros He Φ Ψ HΦ. rewrite !wp_unfold /wp_pre He /=. do 24 (f_contractive || f_equiv). (* FIXME : simplify this proof once we have a good definition and a proper instance for step_fupdN. *) induction num_laters_per_step as [|k IHk]; simpl; last by rewrite IHk. by do 4 f_equiv. Qed. Lemma wp_value_fupd' s E Φ v : WP of_val v @ s; E {{ Φ }} ⊣⊢ |={E}=> Φ v. Proof. rewrite wp_unfold /wp_pre to_of_val. auto. Qed. Lemma wp_strong_mono s1 s2 E1 E2 e Φ Ψ : s1 ⊑ s2 → E1 ⊆ E2 → WP e @ s1; E1 {{ Φ }} -∗ (∀ v, Φ v ={E2}=∗ Ψ v) -∗ WP e @ s2; E2 {{ Ψ }}. Proof. iIntros (? HE) "H HΦ". iLöb as "IH" forall (e E1 E2 HE Φ Ψ). rewrite !wp_unfold /wp_pre /=. destruct (to_val e) as [v|] eqn:?. { iApply ("HΦ" with "[> -]"). by iApply (fupd_mask_mono E1 _). } iIntros (σ1 ns κ κs nt) "Hσ". iMod (fupd_mask_subseteq E1) as "Hclose"; first done. iMod ("H" with "[$]") as "[% H]". iModIntro. iSplit; [by destruct s1, s2|]. iIntros (e2 σ2 efs Hstep) "Hcred". iMod ("H" with "[//] Hcred") as "H". iIntros "!> !>". iMod "H". iModIntro. iApply (step_fupdN_wand with "[H]"); first by iApply "H". iIntros ">($ & H & Hefs)". iMod "Hclose" as "_". iModIntro. iSplitR "Hefs". - iApply ("IH" with "[//] H HΦ"). - iApply (big_sepL_impl with "Hefs"); iIntros "!>" (k ef _). iIntros "H". iApply ("IH" with "[] H"); auto. Qed. Lemma fupd_wp s E e Φ : (|={E}=> WP e @ s; E {{ Φ }}) ⊢ WP e @ s; E {{ Φ }}. Proof. rewrite wp_unfold /wp_pre. iIntros "H". destruct (to_val e) as [v|] eqn:?. { by iMod "H". } iIntros (σ1 ns κ κs nt) "Hσ1". iMod "H". by iApply "H". Qed. Lemma wp_fupd s E e Φ : WP e @ s; E {{ v, |={E}=> Φ v }} ⊢ WP e @ s; E {{ Φ }}. Proof. iIntros "H". iApply (wp_strong_mono s s E with "H"); auto. Qed. Lemma wp_atomic s E1 E2 e Φ `{!Atomic (stuckness_to_atomicity s) e} : (|={E1,E2}=> WP e @ s; E2 {{ v, |={E2,E1}=> Φ v }}) ⊢ WP e @ s; E1 {{ Φ }}. Proof. iIntros "H". rewrite !wp_unfold /wp_pre. destruct (to_val e) as [v|] eqn:He. { by iDestruct "H" as ">>> $". } iIntros (σ1 ns κ κs nt) "Hσ". iMod "H". iMod ("H" $! σ1 with "Hσ") as "[$ H]". iModIntro. iIntros (e2 σ2 efs Hstep) "Hcred". iApply (step_fupdN_wand with "(H [//] Hcred)"). iIntros ">(Hσ & H & Hefs)". destruct s. - rewrite !wp_unfold /wp_pre. destruct (to_val e2) as [v2|] eqn:He2. + iDestruct "H" as ">> $". by iFrame. + iMod ("H" $! _ _ [] with "[$]") as "[H _]". iDestruct "H" as %(? & ? & ? & ? & ?). by edestruct (atomic _ _ _ _ _ Hstep). - destruct (atomic _ _ _ _ _ Hstep) as [v <-%of_to_val]. rewrite wp_value_fupd'. iMod "H" as ">H". iModIntro. iFrame "Hσ Hefs". by iApply wp_value_fupd'. Qed. (** This lemma gives us access to the later credits that are generated in each step, assuming that we have instantiated [num_laters_per_step] with a non-trivial (e.g. linear) function. This lemma can be used to provide a "regeneration" mechanism for later credits. [state_interp] will have to be defined in a way that involves the required regneration tokens. TODO: point to an example of how this is used. In detail, a client can use this lemma as follows: * the client obtains the state interpretation [state_interp _ ns _ _], * it uses some ghost state wired up to the interpretation to know that [ns = k + m], and update the state interpretation to [state_interp _ m _ _], * _after_ [e] has finally stepped, we get [num_laters_per_step k] later credits that we can use to prove [P] in the postcondition, and we have to update the state interpretation from [state_interp _ (S m) _ _] to [state_interp _ (S ns) _ _] again. *) Lemma wp_credit_access s E e Φ P : TCEq (to_val e) None → (∀ m k, num_laters_per_step m + num_laters_per_step k ≤ num_laters_per_step (m + k)) → (∀ σ1 ns κs nt, state_interp σ1 ns κs nt ={E}=∗ ∃ k m, state_interp σ1 m κs nt ∗ ⌜ns = (m + k)%nat⌝ ∗ (∀ nt σ2 κs, £ (num_laters_per_step k) -∗ state_interp σ2 (S m) κs nt ={E}=∗ state_interp σ2 (S ns) κs nt ∗ P)) -∗ WP e @ s; E {{ v, P ={E}=∗ Φ v }} -∗ WP e @ s; E {{ Φ }}. Proof. rewrite !wp_unfold /wp_pre /=. iIntros (-> Htri) "Hupd Hwp". iIntros (σ1 ns κ κs nt) "Hσ1". iMod ("Hupd" with "Hσ1") as (k m) "(Hσ1 & -> & Hpost)". iMod ("Hwp" with "Hσ1") as "[$ Hwp]". iModIntro. iIntros (e2 σ2 efs Hstep) "Hc". iDestruct "Hc" as "[Hone Hc]". iPoseProof (lc_weaken with "Hc") as "Hc"; first apply Htri. iDestruct "Hc" as "[Hm Hk]". iCombine "Hone Hm" as "Hm". iApply (step_fupd_wand with "(Hwp [//] Hm)"). iIntros "Hwp". iApply (step_fupdN_le (num_laters_per_step m)); [ | done | ]. { etrans; last apply Htri. lia. } iApply (step_fupdN_wand with "Hwp"). iIntros ">(SI & Hwp & $)". iMod ("Hpost" with "Hk SI") as "[$ HP]". iModIntro. iApply (wp_strong_mono with "Hwp"); [by auto..|]. iIntros (v) "HΦ". iApply ("HΦ" with "HP"). Qed. (** In this stronger version of [wp_step_fupdN], the masks in the step-taking fancy update are a bit weird and somewhat difficult to use in practice. Hence, we prove it for the sake of completeness, but [wp_step_fupdN] is just a little bit weaker, suffices in practice and is easier to use. See the statement of [wp_step_fupdN] below to understand the use of ordinary conjunction here. *) Lemma wp_step_fupdN_strong n s E1 E2 e P Φ : TCEq (to_val e) None → E2 ⊆ E1 → (∀ σ ns κs nt, state_interp σ ns κs nt ={E1,∅}=∗ ⌜n ≤ S (num_laters_per_step ns)⌝) ∧ ((|={E1,E2}=> |={∅}▷=>^n |={E2,E1}=> P) ∗ WP e @ s; E2 {{ v, P ={E1}=∗ Φ v }}) -∗ WP e @ s; E1 {{ Φ }}. Proof. destruct n as [|n]. { iIntros (_ ?) "/= [_ [HP Hwp]]". iApply (wp_strong_mono with "Hwp"); [done..|]. iIntros (v) "H". iApply ("H" with "[>HP]"). by do 2 iMod "HP". } rewrite !wp_unfold /wp_pre /=. iIntros (-> ?) "H". iIntros (σ1 ns κ κs nt) "Hσ". destruct (decide (n ≤ num_laters_per_step ns)) as [Hn|Hn]; first last. { iDestruct "H" as "[Hn _]". iMod ("Hn" with "Hσ") as %?. lia. } iDestruct "H" as "[_ [>HP Hwp]]". iMod ("Hwp" with "[$]") as "[$ H]". iMod "HP". iIntros "!>" (e2 σ2 efs Hstep) "Hcred". iMod ("H" $! e2 σ2 efs with "[% //] Hcred") as "H". iIntros "!>!>". iMod "H". iMod "HP". iModIntro. revert n Hn. generalize (num_laters_per_step ns)=>n0 n Hn. iInduction n as [|n] "IH" forall (n0 Hn). - iApply (step_fupdN_wand with "H"). iIntros ">($ & Hwp & $)". iMod "HP". iModIntro. iApply (wp_strong_mono with "Hwp"); [done|set_solver|]. iIntros (v) "HΦ". iApply ("HΦ" with "HP"). - destruct n0 as [|n0]; [lia|]=>/=. iMod "HP". iMod "H". iIntros "!> !>". iMod "HP". iMod "H". iModIntro. iApply ("IH" with "[] HP H"). auto with lia. Qed. Lemma wp_bind K `{!LanguageCtx K} s E e Φ : WP e @ s; E {{ v, WP K (of_val v) @ s; E {{ Φ }} }} ⊢ WP K e @ s; E {{ Φ }}. Proof. iIntros "H". iLöb as "IH" forall (E e Φ). rewrite wp_unfold /wp_pre. destruct (to_val e) as [v|] eqn:He. { apply of_to_val in He as <-. by iApply fupd_wp. } rewrite wp_unfold /wp_pre fill_not_val /=; [|done]. iIntros (σ1 step κ κs n) "Hσ". iMod ("H" with "[$]") as "[% H]". iModIntro; iSplit. { destruct s; eauto using reducible_fill. } iIntros (e2 σ2 efs Hstep) "Hcred". destruct (fill_step_inv e σ1 κ e2 σ2 efs) as (e2'&->&?); auto. iMod ("H" $! e2' σ2 efs with "[//] Hcred") as "H". iIntros "!>!>". iMod "H". iModIntro. iApply (step_fupdN_wand with "H"). iIntros "H". iMod "H" as "($ & H & $)". iModIntro. by iApply "IH". Qed. Lemma wp_bind_inv K `{!LanguageCtx K} s E e Φ : WP K e @ s; E {{ Φ }} ⊢ WP e @ s; E {{ v, WP K (of_val v) @ s; E {{ Φ }} }}. Proof. iIntros "H". iLöb as "IH" forall (E e Φ). rewrite !wp_unfold /wp_pre /=. destruct (to_val e) as [v|] eqn:He. { apply of_to_val in He as <-. by rewrite !wp_unfold /wp_pre. } rewrite fill_not_val //. iIntros (σ1 ns κ κs nt) "Hσ". iMod ("H" with "[$]") as "[% H]". iModIntro; iSplit. { destruct s; eauto using reducible_fill_inv. } iIntros (e2 σ2 efs Hstep) "Hcred". iMod ("H" $! _ _ _ with "[] Hcred") as "H"; first eauto using fill_step. iIntros "!> !>". iMod "H". iModIntro. iApply (step_fupdN_wand with "H"). iIntros "H". iMod "H" as "($ & H & $)". iModIntro. by iApply "IH". Qed. (** * Derived rules *) Lemma wp_mono s E e Φ Ψ : (∀ v, Φ v ⊢ Ψ v) → WP e @ s; E {{ Φ }} ⊢ WP e @ s; E {{ Ψ }}. Proof. iIntros (HΦ) "H"; iApply (wp_strong_mono with "H"); auto. iIntros (v) "?". by iApply HΦ. Qed. Lemma wp_stuck_mono s1 s2 E e Φ : s1 ⊑ s2 → WP e @ s1; E {{ Φ }} ⊢ WP e @ s2; E {{ Φ }}. Proof. iIntros (?) "H". iApply (wp_strong_mono with "H"); auto. Qed. Lemma wp_stuck_weaken s E e Φ : WP e @ s; E {{ Φ }} ⊢ WP e @ E ?{{ Φ }}. Proof. apply wp_stuck_mono. by destruct s. Qed. Lemma wp_mask_mono s E1 E2 e Φ : E1 ⊆ E2 → WP e @ s; E1 {{ Φ }} ⊢ WP e @ s; E2 {{ Φ }}. Proof. iIntros (?) "H"; iApply (wp_strong_mono with "H"); auto. Qed. Global Instance wp_mono' s E e : Proper (pointwise_relation _ (⊢) ==> (⊢)) (wp (PROP:=iProp Σ) s E e). Proof. by intros Φ Φ' ?; apply wp_mono. Qed. Global Instance wp_flip_mono' s E e : Proper (pointwise_relation _ (flip (⊢)) ==> (flip (⊢))) (wp (PROP:=iProp Σ) s E e). Proof. by intros Φ Φ' ?; apply wp_mono. Qed. Lemma wp_value_fupd s E Φ e v : IntoVal e v → WP e @ s; E {{ Φ }} ⊣⊢ |={E}=> Φ v. Proof. intros <-. by apply wp_value_fupd'. Qed. Lemma wp_value' s E Φ v : Φ v ⊢ WP (of_val v) @ s; E {{ Φ }}. Proof. rewrite wp_value_fupd'. auto. Qed. Lemma wp_value s E Φ e v : IntoVal e v → Φ v ⊢ WP e @ s; E {{ Φ }}. Proof. intros <-. apply wp_value'. Qed. Lemma wp_frame_l s E e Φ R : R ∗ WP e @ s; E {{ Φ }} ⊢ WP e @ s; E {{ v, R ∗ Φ v }}. Proof. iIntros "[? H]". iApply (wp_strong_mono with "H"); auto with iFrame. Qed. Lemma wp_frame_r s E e Φ R : WP e @ s; E {{ Φ }} ∗ R ⊢ WP e @ s; E {{ v, Φ v ∗ R }}. Proof. iIntros "[H ?]". iApply (wp_strong_mono with "H"); auto with iFrame. Qed. (** This lemma states that if we can prove that [n] laters are used in the current physical step, then one can perform an n-steps fancy update during that physical step. The resources needed to prove the bound on [n] are not used up: they can be reused in the proof of the WP or in the proof of the n-steps fancy update. In order to describe this unusual resource flow, we use ordinary conjunction as a premise. *) Lemma wp_step_fupdN n s E1 E2 e P Φ : TCEq (to_val e) None → E2 ⊆ E1 → (∀ σ ns κs nt, state_interp σ ns κs nt ={E1,∅}=∗ ⌜n ≤ S (num_laters_per_step ns)⌝) ∧ ((|={E1∖E2,∅}=> |={∅}▷=>^n |={∅,E1∖E2}=> P) ∗ WP e @ s; E2 {{ v, P ={E1}=∗ Φ v }}) -∗ WP e @ s; E1 {{ Φ }}. Proof. iIntros (??) "H". iApply (wp_step_fupdN_strong with "[H]"); [done|]. iApply (and_mono_r with "H"). apply sep_mono_l. iIntros "HP". iMod fupd_mask_subseteq_emptyset_difference as "H"; [|iMod "HP"]; [set_solver|]. iMod "H" as "_". replace (E1 ∖ (E1 ∖ E2)) with E2; last first. { set_unfold=>x. destruct (decide (x ∈ E2)); naive_solver. } iModIntro. iApply (step_fupdN_wand with "HP"). iIntros "H". iApply fupd_mask_frame; [|iMod "H"; iModIntro]; [set_solver|]. by rewrite difference_empty_L (comm_L (∪)) -union_difference_L. Qed. Lemma wp_step_fupd s E1 E2 e P Φ : TCEq (to_val e) None → E2 ⊆ E1 → (|={E1}[E2]▷=> P) -∗ WP e @ s; E2 {{ v, P ={E1}=∗ Φ v }} -∗ WP e @ s; E1 {{ Φ }}. Proof. iIntros (??) "HR H". iApply (wp_step_fupdN_strong 1 _ E1 E2 with "[-]"); [done|..]. iSplit. - iIntros (????) "_". iMod (fupd_mask_subseteq ∅) as "_"; [set_solver+|]. auto with lia. - iFrame "H". iMod "HR" as "$". auto. Qed. Lemma wp_frame_step_l s E1 E2 e Φ R : TCEq (to_val e) None → E2 ⊆ E1 → (|={E1}[E2]▷=> R) ∗ WP e @ s; E2 {{ Φ }} ⊢ WP e @ s; E1 {{ v, R ∗ Φ v }}. Proof. iIntros (??) "[Hu Hwp]". iApply (wp_step_fupd with "Hu"); try done. iApply (wp_mono with "Hwp"). by iIntros (?) "$$". Qed. Lemma wp_frame_step_r s E1 E2 e Φ R : TCEq (to_val e) None → E2 ⊆ E1 → WP e @ s; E2 {{ Φ }} ∗ (|={E1}[E2]▷=> R) ⊢ WP e @ s; E1 {{ v, Φ v ∗ R }}. Proof. rewrite [(WP _ @ _; _ {{ _ }} ∗ _)%I]comm; setoid_rewrite (comm _ _ R). apply wp_frame_step_l. Qed. Lemma wp_frame_step_l' s E e Φ R : TCEq (to_val e) None → ▷ R ∗ WP e @ s; E {{ Φ }} ⊢ WP e @ s; E {{ v, R ∗ Φ v }}. Proof. iIntros (?) "[??]". iApply (wp_frame_step_l s E E); try iFrame; eauto. Qed. Lemma wp_frame_step_r' s E e Φ R : TCEq (to_val e) None → WP e @ s; E {{ Φ }} ∗ ▷ R ⊢ WP e @ s; E {{ v, Φ v ∗ R }}. Proof. iIntros (?) "[??]". iApply (wp_frame_step_r s E E); try iFrame; eauto. Qed. Lemma wp_wand s E e Φ Ψ : WP e @ s; E {{ Φ }} -∗ (∀ v, Φ v -∗ Ψ v) -∗ WP e @ s; E {{ Ψ }}. Proof. iIntros "Hwp H". iApply (wp_strong_mono with "Hwp"); auto. iIntros (?) "?". by iApply "H". Qed. Lemma wp_wand_l s E e Φ Ψ : (∀ v, Φ v -∗ Ψ v) ∗ WP e @ s; E {{ Φ }} ⊢ WP e @ s; E {{ Ψ }}. Proof. iIntros "[H Hwp]". iApply (wp_wand with "Hwp H"). Qed. Lemma wp_wand_r s E e Φ Ψ : WP e @ s; E {{ Φ }} ∗ (∀ v, Φ v -∗ Ψ v) ⊢ WP e @ s; E {{ Ψ }}. Proof. iIntros "[Hwp H]". iApply (wp_wand with "Hwp H"). Qed. Lemma wp_frame_wand s E e Φ R : R -∗ WP e @ s; E {{ v, R -∗ Φ v }} -∗ WP e @ s; E {{ Φ }}. Proof. iIntros "HR HWP". iApply (wp_wand with "HWP"). iIntros (v) "HΦ". by iApply "HΦ". Qed. End wp. (** Proofmode class instances *) Section proofmode_classes. Context `{!irisGS_gen hlc Λ Σ}. Implicit Types P Q : iProp Σ. Implicit Types Φ : val Λ → iProp Σ. Implicit Types v : val Λ. Implicit Types e : expr Λ. Global Instance frame_wp p s E e R Φ Ψ : (FrameInstantiateExistDisabled → ∀ v, Frame p R (Φ v) (Ψ v)) → Frame p R (WP e @ s; E {{ Φ }}) (WP e @ s; E {{ Ψ }}) | 2. Proof. rewrite /Frame=> HR. rewrite wp_frame_l. apply wp_mono, HR. constructor. Qed. Global Instance is_except_0_wp s E e Φ : IsExcept0 (WP e @ s; E {{ Φ }}). Proof. by rewrite /IsExcept0 -{2}fupd_wp -except_0_fupd -fupd_intro. Qed. Global Instance elim_modal_bupd_wp p s E e P Φ : ElimModal True p false (|==> P) P (WP e @ s; E {{ Φ }}) (WP e @ s; E {{ Φ }}). Proof. by rewrite /ElimModal intuitionistically_if_elim (bupd_fupd E) fupd_frame_r wand_elim_r fupd_wp. Qed. Global Instance elim_modal_fupd_wp p s E e P Φ : ElimModal True p false (|={E}=> P) P (WP e @ s; E {{ Φ }}) (WP e @ s; E {{ Φ }}). Proof. by rewrite /ElimModal intuitionistically_if_elim fupd_frame_r wand_elim_r fupd_wp. Qed. (** Error message instance for non-mask-changing view shifts. Also uses a slightly different error: we cannot apply [fupd_mask_subseteq] if [e] is not atomic, so we tell the user to first add a leading [fupd] and then change the mask of that. *) Global Instance elim_modal_fupd_wp_wrong_mask p s E1 E2 e P Φ : ElimModal (pm_error "Goal and eliminated modality must have the same mask. Use [iApply fupd_wp; iMod (fupd_mask_subseteq E2)] to adjust the mask of your goal to [E2]") p false (|={E2}=> P) False (WP e @ s; E1 {{ Φ }}) False | 100. Proof. intros []. Qed. Global Instance elim_modal_fupd_wp_atomic p s E1 E2 e P Φ : ElimModal (Atomic (stuckness_to_atomicity s) e) p false (|={E1,E2}=> P) P (WP e @ s; E1 {{ Φ }}) (WP e @ s; E2 {{ v, |={E2,E1}=> Φ v }})%I | 100. Proof. intros ?. by rewrite intuitionistically_if_elim fupd_frame_r wand_elim_r wp_atomic. Qed. (** Error message instance for mask-changing view shifts. *) Global Instance elim_modal_fupd_wp_atomic_wrong_mask p s E1 E2 E2' e P Φ : ElimModal (pm_error "Goal and eliminated modality must have the same mask. Use [iMod (fupd_mask_subseteq E2)] to adjust the mask of your goal to [E2]") p false (|={E2,E2'}=> P) False (WP e @ s; E1 {{ Φ }}) False | 200. Proof. intros []. Qed. Global Instance add_modal_fupd_wp s E e P Φ : AddModal (|={E}=> P) P (WP e @ s; E {{ Φ }}). Proof. by rewrite /AddModal fupd_frame_r wand_elim_r fupd_wp. Qed. Global Instance elim_acc_wp_atomic {X} E1 E2 α β γ e s Φ : ElimAcc (X:=X) (Atomic (stuckness_to_atomicity s) e) (fupd E1 E2) (fupd E2 E1) α β γ (WP e @ s; E1 {{ Φ }}) (λ x, WP e @ s; E2 {{ v, |={E2}=> β x ∗ (γ x -∗? Φ v) }})%I | 100. Proof. iIntros (?) "Hinner >Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]". iApply (wp_wand with "(Hinner Hα)"). iIntros (v) ">[Hβ HΦ]". iApply "HΦ". by iApply "Hclose". Qed. Global Instance elim_acc_wp_nonatomic {X} E α β γ e s Φ : ElimAcc (X:=X) True (fupd E E) (fupd E E) α β γ (WP e @ s; E {{ Φ }}) (λ x, WP e @ s; E {{ v, |={E}=> β x ∗ (γ x -∗? Φ v) }})%I. Proof. iIntros (_) "Hinner >Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]". iApply wp_fupd. iApply (wp_wand with "(Hinner Hα)"). iIntros (v) ">[Hβ HΦ]". iApply "HΦ". by iApply "Hclose". Qed. End proofmode_classes. iris-iris-4.2.0/iris/proofmode/000077500000000000000000000000001460620107300163665ustar00rootroot00000000000000iris-iris-4.2.0/iris/proofmode/base.v000066400000000000000000000136151460620107300174750ustar00rootroot00000000000000From Coq Require Export Ascii. From stdpp Require Export strings. From iris.prelude Require Export prelude. From iris.prelude Require Import options. From Ltac2 Require Ltac2. (** * Utility definitions used by the proofmode *) (** ** N-ary tactics *) (** Ltac1 does not provide primitives to manipulate lists (e.g., [ident_list], [simple_intropattern_list]), needed for [iIntros], [iDestruct], etc. We can do that in Ltac2. For most proofmode tactics we only need to iterate over a list (either in forward or backward direction). The Ltac1 tactics [ltac1_list_iter] and [ltac1_list_rev_iter] allow us to do that while encapsulating the Ltac2 code. These tactics can be used as: Ltac _iTactic xs := ltac1_list_iter ltac:(fun x => /* stuff */) xs. Tactic Notation "iTactic" "(" ne_ident_list(xs) ")" := _iTactic xs. It is important to note that given one n-ary [Tactic Notation] we cannot call another n-ary [Tactic Notation]. For example, the following does NOT work: Tactic Notation "iAnotherTactic" "(" ne_ident_list(xs) ")" := /* stuff */ iTactic (xs). Because of this reason, as already shown above, we typically provide an [Ltac] called [_iTactic] (note the underscore to mark it is "private"), and define the [Tactic Notation] as a wrapper, allowing us to write: Tactic Notation "iAnotherTactic" "(" ne_ident_list(xs) ")" := /* stuff */ _iTactic xs. *) Ltac2 of_ltac1_list l := Option.get (Ltac1.to_list l). Ltac ltac1_list_iter tac l := let go := ltac2:(tac l |- List.iter (ltac1:(tac x |- tac x) tac) (of_ltac1_list l)) in go tac l. Ltac ltac1_list_rev_iter tac l := let go := ltac2:(tac l |- List.iter (ltac1:(tac x |- tac x) tac) (List.rev (of_ltac1_list l))) in go tac l. (** Since the Ltac1-Ltac2 API only supports unit-returning functions, there is no nice way to produce an empty list in ltac1. We therefore often define a special version [_iTactic0] for the empty list. This version can be created using [with_ltac1_nil]: Ltac _iTactic0 := with_ltac1_nil ltac:(fun xs => _iTactic xs) *) Ltac with_ltac1_nil tac := let go := ltac2:(tac |- ltac1:(tac l |- tac l) tac (Ltac1.of_list [])) in go tac. (* Directions of rewrites *) Inductive direction := Left | Right. Local Open Scope lazy_bool_scope. (* Some specific versions of operations on strings, booleans, positive for the proof mode. We need those so that we can make [cbv] unfold just them, but not the actual operations that may appear in users' proofs. *) Lemma lazy_andb_true (b1 b2 : bool) : b1 &&& b2 = true ↔ b1 = true ∧ b2 = true. Proof. destruct b1, b2; intuition congruence. Qed. Definition negb (b : bool) : bool := if b then false else true. Lemma negb_true b : negb b = true ↔ b = false. Proof. by destruct b. Qed. Fixpoint Pos_succ (x : positive) : positive := match x with | (p~1)%positive => ((Pos_succ p)~0)%positive | (p~0)%positive => (p~1)%positive | 1%positive => 2%positive end. Definition beq (b1 b2 : bool) : bool := match b1, b2 with | false, false | true, true => true | _, _ => false end. Definition ascii_beq (x y : ascii) : bool := let 'Ascii x1 x2 x3 x4 x5 x6 x7 x8 := x in let 'Ascii y1 y2 y3 y4 y5 y6 y7 y8 := y in beq x1 y1 &&& beq x2 y2 &&& beq x3 y3 &&& beq x4 y4 &&& beq x5 y5 &&& beq x6 y6 &&& beq x7 y7 &&& beq x8 y8. Fixpoint string_beq (s1 s2 : string) : bool := match s1, s2 with | "", "" => true | String a1 s1, String a2 s2 => ascii_beq a1 a2 &&& string_beq s1 s2 | _, _ => false end. Lemma beq_true b1 b2 : beq b1 b2 = true ↔ b1 = b2. Proof. destruct b1, b2; simpl; intuition congruence. Qed. Lemma ascii_beq_true x y : ascii_beq x y = true ↔ x = y. Proof. destruct x, y; rewrite /= !lazy_andb_true !beq_true. intuition congruence. Qed. Lemma string_beq_true s1 s2 : string_beq s1 s2 = true ↔ s1 = s2. Proof. revert s2. induction s1 as [|x s1 IH]=> -[|y s2] //=. rewrite lazy_andb_true ascii_beq_true IH. intuition congruence. Qed. Lemma string_beq_reflect s1 s2 : reflect (s1 = s2) (string_beq s1 s2). Proof. apply iff_reflect. by rewrite string_beq_true. Qed. Module Export ident. Inductive ident := | IAnon : positive → ident | INamed :> string → ident. End ident. Global Instance maybe_IAnon : Maybe IAnon := λ i, match i with IAnon n => Some n | _ => None end. Global Instance maybe_INamed : Maybe INamed := λ i, match i with INamed s => Some s | _ => None end. Global Instance beq_eq_dec : EqDecision ident. Proof. solve_decision. Defined. Definition positive_beq := Eval compute in Pos.eqb. Lemma positive_beq_true x y : positive_beq x y = true ↔ x = y. Proof. apply Pos.eqb_eq. Qed. Definition ident_beq (i1 i2 : ident) : bool := match i1, i2 with | IAnon n1, IAnon n2 => positive_beq n1 n2 | INamed s1, INamed s2 => string_beq s1 s2 | _, _ => false end. Lemma ident_beq_true i1 i2 : ident_beq i1 i2 = true ↔ i1 = i2. Proof. destruct i1, i2; rewrite /= ?string_beq_true ?positive_beq_true; naive_solver. Qed. Lemma ident_beq_reflect i1 i2 : reflect (i1 = i2) (ident_beq i1 i2). Proof. apply iff_reflect. by rewrite ident_beq_true. Qed. (** Copies of some functions on [list] and [option] for better reduction control. *) Fixpoint pm_app {A} (l1 l2 : list A) : list A := match l1 with [] => l2 | x :: l1 => x :: pm_app l1 l2 end. Definition pm_option_bind {A B} (f : A → option B) (mx : option A) : option B := match mx with Some x => f x | None => None end. Global Arguments pm_option_bind {_ _} _ !_ /. Definition pm_from_option {A B} (f : A → B) (y : B) (mx : option A) : B := match mx with None => y | Some x => f x end. Global Arguments pm_from_option {_ _} _ _ !_ /. Definition pm_option_fun {A B} (f : option (A → B)) (x : A) : option B := match f with None => None | Some f => Some (f x) end. Global Arguments pm_option_fun {_ _} !_ _ /. (* Can't write [id] here as that would not reduce. *) Notation pm_default := (pm_from_option (λ x, x)). iris-iris-4.2.0/iris/proofmode/class_instances.v000066400000000000000000001506421460620107300217410ustar00rootroot00000000000000From iris.bi Require Import telescopes. From iris.proofmode Require Import base modality_instances classes classes_make. From iris.proofmode Require Import ltac_tactics. From iris.prelude Require Import options. Import bi. (* FIXME(Coq #6294): needs new unification *) (** The lemma [from_assumption_exact] is not an instance, but defined using [notypeclasses refine] through [Hint Extern] to enable the better unification algorithm. We use [shelve] to avoid the creation of unshelved goals for evars by [refine], which otherwise causes TC search to fail. Such unshelved goals are created for example when solving [FromAssumption p ?P ?Q] where both [?P] and [?Q] are evars. See [test_iApply_evar] in [tests/proofmode] for an example. *) Lemma from_assumption_exact {PROP : bi} p (P : PROP) : FromAssumption p P P. Proof. by rewrite /FromAssumption /= intuitionistically_if_elim. Qed. Global Hint Extern 0 (FromAssumption _ _ _) => notypeclasses refine (from_assumption_exact _ _); shelve : typeclass_instances. (* FIXME(Coq #6294): needs new unification *) (** Similarly, the lemma [from_exist_exist] is defined using a [Hint Extern] to enable the better unification algorithm. See https://gitlab.mpi-sws.org/iris/iris/issues/288 *) Lemma from_exist_exist {PROP : bi} {A} (Φ : A → PROP) : FromExist (∃ a, Φ a) Φ. Proof. by rewrite /FromExist. Qed. Global Hint Extern 0 (FromExist _ _) => notypeclasses refine (from_exist_exist _) : typeclass_instances. Section class_instances. Context {PROP : bi}. Implicit Types P Q R : PROP. Implicit Types mP : option PROP. (** AsEmpValid *) Global Instance as_emp_valid_emp_valid P : AsEmpValid0 (⊢ P) P | 0. Proof. by rewrite /AsEmpValid. Qed. Global Instance as_emp_valid_entails P Q : AsEmpValid0 (P ⊢ Q) (P -∗ Q). Proof. split; [ apply bi.entails_wand | apply bi.wand_entails ]. Qed. Global Instance as_emp_valid_equiv P Q : AsEmpValid0 (P ≡ Q) (P ∗-∗ Q). Proof. split; [ apply bi.equiv_wand_iff | apply bi.wand_iff_equiv ]. Qed. Global Instance as_emp_valid_forall {A : Type} (φ : A → Prop) (P : A → PROP) : (∀ x, AsEmpValid (φ x) (P x)) → AsEmpValid (∀ x, φ x) (∀ x, P x). Proof. rewrite /AsEmpValid=>H1. split=>H2. - apply bi.forall_intro=>?. apply H1, H2. - intros x. apply H1. revert H2. by rewrite (bi.forall_elim x). Qed. Global Instance as_emp_valid_tforall {TT : tele} (φ : TT → Prop) (P : TT → PROP) : (∀ x, AsEmpValid (φ x) (P x)) → AsEmpValid (∀.. x, φ x) (∀.. x, P x). Proof. rewrite /AsEmpValid !tforall_forall bi_tforall_forall. apply as_emp_valid_forall. Qed. (** FromAffinely *) Global Instance from_affinely_affine P : Affine P → FromAffinely P P. Proof. intros. by rewrite /FromAffinely affinely_elim. Qed. Global Instance from_affinely_default P : FromAffinely ( P) P | 100. Proof. by rewrite /FromAffinely. Qed. Global Instance from_affinely_intuitionistically P : FromAffinely (□ P) ( P) | 100. Proof. by rewrite /FromAffinely. Qed. (** IntoAbsorbingly *) Global Instance into_absorbingly_True : @IntoAbsorbingly PROP True emp | 0. Proof. by rewrite /IntoAbsorbingly -absorbingly_emp_True. Qed. Global Instance into_absorbingly_absorbing P : Absorbing P → IntoAbsorbingly P P | 1. Proof. intros. by rewrite /IntoAbsorbingly absorbing_absorbingly. Qed. Global Instance into_absorbingly_intuitionistically P : IntoAbsorbingly ( P) (□ P) | 2. Proof. by rewrite /IntoAbsorbingly -absorbingly_intuitionistically_into_persistently. Qed. Global Instance into_absorbingly_default P : IntoAbsorbingly ( P) P | 100. Proof. by rewrite /IntoAbsorbingly. Qed. (** FromAssumption *) Global Instance from_assumption_persistently_r P Q : FromAssumption true P Q → KnownRFromAssumption true P ( Q). Proof. rewrite /KnownRFromAssumption /FromAssumption /= =><-. apply intuitionistically_persistent. Qed. Global Instance from_assumption_affinely_r P Q : FromAssumption true P Q → KnownRFromAssumption true P ( 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 ( 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 ( 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 ( 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 ( P) Q. Proof. rewrite /KnownLFromAssumption /FromAssumption /= =><-. by rewrite affinely_elim. Qed. Global Instance from_assumption_intuitionistically_l_true p P Q : FromAssumption p P Q → KnownLFromAssumption p (□ P) Q. Proof. rewrite /KnownLFromAssumption /FromAssumption /= =><-. by rewrite intuitionistically_elim. Qed. Global Instance from_assumption_forall {A} p (Φ : A → PROP) Q x : FromAssumption p (Φ x) Q → KnownLFromAssumption p (∀ x, Φ x) Q. Proof. rewrite /KnownLFromAssumption /FromAssumption=> <-. by rewrite forall_elim. Qed. Global Instance from_assumption_tforall {TT : tele} p (Φ : TT → PROP) Q x : FromAssumption p (Φ x) Q → KnownLFromAssumption p (∀.. x, Φ x) Q. Proof. rewrite /KnownLFromAssumption /FromAssumption=> <-. by rewrite bi_tforall_forall forall_elim. Qed. (** IntoPure *) Global Instance into_pure_pure φ : @IntoPure PROP ⌜φ⌝ φ. Proof. by rewrite /IntoPure. Qed. Global Instance into_pure_pure_and (φ1 φ2 : Prop) P1 P2 : IntoPure P1 φ1 → IntoPure P2 φ2 → IntoPure (P1 ∧ P2) (φ1 ∧ φ2). Proof. rewrite /IntoPure pure_and. by intros -> ->. Qed. Global Instance into_pure_pure_or (φ1 φ2 : Prop) P1 P2 : IntoPure P1 φ1 → IntoPure P2 φ2 → IntoPure (P1 ∨ P2) (φ1 ∨ φ2). Proof. rewrite /IntoPure pure_or. by intros -> ->. Qed. Global Instance into_pure_pure_impl `{!BiPureForall PROP} (φ1 φ2 : Prop) P1 P2 : FromPure false P1 φ1 → IntoPure P2 φ2 → IntoPure (P1 → P2) (φ1 → φ2). Proof. rewrite /FromPure /IntoPure /= => <- ->. apply pure_impl_2. Qed. Global Instance into_pure_exist {A} (Φ : A → PROP) (φ : A → Prop) : (∀ x, IntoPure (Φ x) (φ x)) → IntoPure (∃ x, Φ x) (∃ x, φ x). Proof. rewrite /IntoPure=>Hx. rewrite pure_exist. by setoid_rewrite Hx. Qed. Global Instance into_pure_texist {TT : tele} (Φ : TT → PROP) (φ : TT → Prop) : (∀ x, IntoPure (Φ x) (φ x)) → IntoPure (∃.. x, Φ x) (∃.. x, φ x). Proof. rewrite /IntoPure texist_exist bi_texist_exist. apply into_pure_exist. Qed. Global Instance into_pure_forall `{!BiPureForall PROP} {A} (Φ : A → PROP) (φ : A → Prop) : (∀ x, IntoPure (Φ x) (φ x)) → IntoPure (∀ x, Φ x) (∀ x, φ x). Proof. rewrite /IntoPure=>Hx. rewrite -pure_forall_2. by setoid_rewrite Hx. Qed. Global Instance into_pure_tforall `{!BiPureForall PROP} {TT : tele} (Φ : TT → PROP) (φ : TT → Prop) : (∀ x, IntoPure (Φ x) (φ x)) → IntoPure (∀.. x, Φ x) (∀.. x, φ x). Proof. rewrite /IntoPure !tforall_forall bi_tforall_forall. apply into_pure_forall. Qed. Global Instance into_pure_pure_sep (φ1 φ2 : Prop) P1 P2 : IntoPure P1 φ1 → IntoPure P2 φ2 → IntoPure (P1 ∗ P2) (φ1 ∧ φ2). Proof. rewrite /IntoPure=> -> ->. by rewrite sep_and pure_and. Qed. Global Instance into_pure_pure_wand `{!BiPureForall PROP} a (φ1 φ2 : Prop) P1 P2 : FromPure a P1 φ1 → IntoPure P2 φ2 → IntoPure (P1 -∗ P2) (φ1 → φ2). Proof. rewrite /FromPure /IntoPure=> <- -> /=. rewrite pure_impl. apply impl_intro_l, pure_elim_l=> ?. rewrite (pure_True φ1) //. by rewrite -affinely_affinely_if affinely_True_emp left_id. Qed. Global Instance into_pure_affinely P φ : IntoPure P φ → IntoPure ( 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 ( P) φ. Proof. rewrite /IntoPure=> ->. by rewrite absorbingly_pure. Qed. Global Instance into_pure_persistently P φ : IntoPure P φ → IntoPure ( P) φ. Proof. rewrite /IntoPure=> ->. apply: persistently_elim. Qed. Global Instance into_pure_big_sepL {A} (Φ : nat → A → PROP) (φ : nat → A → Prop) (l : list A) : (∀ k x, IntoPure (Φ k x) (φ k x)) → IntoPure ([∗ list] k↦x ∈ l, Φ k x) (∀ k x, l !! k = Some x → φ k x). Proof. rewrite /IntoPure. intros HΦ. setoid_rewrite HΦ. rewrite big_sepL_pure_1. done. Qed. Global Instance into_pure_big_sepM `{Countable K} {A} (Φ : K → A → PROP) (φ : K → A → Prop) (m : gmap K A) : (∀ k x, IntoPure (Φ k x) (φ k x)) → IntoPure ([∗ map] k↦x ∈ m, Φ k x) (map_Forall φ m). Proof. rewrite /IntoPure. intros HΦ. setoid_rewrite HΦ. rewrite big_sepM_pure_1. done. Qed. Global Instance into_pure_big_sepS `{Countable A} (Φ : A → PROP) (φ : A → Prop) (X : gset A) : (∀ x, IntoPure (Φ x) (φ x)) → IntoPure ([∗ set] x ∈ X, Φ x) (set_Forall φ X). Proof. rewrite /IntoPure. intros HΦ. setoid_rewrite HΦ. rewrite big_sepS_pure_1. done. Qed. Global Instance into_pure_big_sepMS `{Countable A} (Φ : A → PROP) (φ : A → Prop) (X : gmultiset A) : (∀ x, IntoPure (Φ x) (φ x)) → IntoPure ([∗ mset] x ∈ X, Φ x) (∀ y : A, y ∈ X → φ y). Proof. rewrite /IntoPure. intros HΦ. setoid_rewrite HΦ. rewrite big_sepMS_pure_1. done. Qed. (** FromPure *) Global Instance from_pure_emp : @FromPure PROP true emp True. Proof. rewrite /FromPure /=. apply (affine _). Qed. Global Instance from_pure_pure φ : @FromPure PROP false ⌜φ⌝ φ. Proof. by rewrite /FromPure /=. Qed. Global Instance from_pure_pure_and a1 a2 (φ1 φ2 : Prop) P1 P2 : FromPure a1 P1 φ1 → FromPure a2 P2 φ2 → FromPure (if a1 then true else a2) (P1 ∧ P2) (φ1 ∧ φ2). Proof. rewrite /FromPure pure_and=> <- <- /=. rewrite affinely_if_and. f_equiv; apply affinely_if_flag_mono; destruct a1; naive_solver. Qed. Global Instance from_pure_pure_or a1 a2 (φ1 φ2 : Prop) P1 P2 : FromPure a1 P1 φ1 → FromPure a2 P2 φ2 → FromPure (if a1 then true else a2) (P1 ∨ P2) (φ1 ∨ φ2). Proof. rewrite /FromPure pure_or=> <- <- /=. rewrite affinely_if_or. f_equiv; apply affinely_if_flag_mono; destruct a1; naive_solver. Qed. Global Instance from_pure_pure_impl a (φ1 φ2 : Prop) P1 P2 : IntoPure P1 φ1 → FromPure a P2 φ2 → FromPure a (P1 → P2) (φ1 → φ2). Proof. rewrite /FromPure /IntoPure pure_impl_1=> -> <-. destruct a=>//=. apply bi.impl_intro_l. by rewrite affinely_and_r bi.impl_elim_r. Qed. Global Instance from_pure_exist {A} a (Φ : A → PROP) (φ : A → Prop) : (∀ x, FromPure a (Φ x) (φ x)) → FromPure a (∃ x, Φ x) (∃ x, φ x). Proof. rewrite /FromPure=>Hx. rewrite pure_exist affinely_if_exist. by setoid_rewrite Hx. Qed. Global Instance from_pure_texist {TT : tele} a (Φ : TT → PROP) (φ : TT → Prop) : (∀ x, FromPure a (Φ x) (φ x)) → FromPure a (∃.. x, Φ x) (∃.. x, φ x). Proof. rewrite /FromPure texist_exist bi_texist_exist. apply from_pure_exist. Qed. Global Instance from_pure_forall {A} a (Φ : A → PROP) (φ : A → Prop) : (∀ x, FromPure a (Φ x) (φ x)) → FromPure a (∀ x, Φ x) (∀ x, φ x). Proof. rewrite /FromPure=>Hx. rewrite pure_forall_1. setoid_rewrite <-Hx. destruct a=>//=. apply affinely_forall. Qed. Global Instance from_pure_tforall {TT : tele} a (Φ : TT → PROP) (φ : TT → Prop) : (∀ x, FromPure a (Φ x) (φ x)) → FromPure a (∀.. x, Φ x) (∀.. x, φ x). Proof. rewrite /FromPure !tforall_forall bi_tforall_forall. apply from_pure_forall. Qed. Global Instance from_pure_pure_sep_true a1 a2 (φ1 φ2 : Prop) P1 P2 : FromPure a1 P1 φ1 → FromPure a2 P2 φ2 → FromPure (if a1 then a2 else false) (P1 ∗ P2) (φ1 ∧ φ2). Proof. rewrite /FromPure=> <- <-. destruct a1; simpl. - by rewrite pure_and -persistent_and_affinely_sep_l affinely_if_and_r. - by rewrite pure_and -affinely_affinely_if -persistent_and_affinely_sep_r_1. Qed. Global Instance from_pure_pure_wand a (φ1 φ2 : Prop) P1 P2 : IntoPure P1 φ1 → FromPure a P2 φ2 → TCOr (TCEq a false) (Affine P1) → FromPure a (P1 -∗ P2) (φ1 → φ2). Proof. rewrite /FromPure /IntoPure=> HP1 <- Ha /=. apply wand_intro_l. destruct a; simpl. - destruct Ha as [Ha|?]; first inversion Ha. rewrite -persistent_and_affinely_sep_r -(affine_affinely P1) HP1. by rewrite affinely_and_l pure_impl_1 impl_elim_r. - by rewrite HP1 sep_and pure_impl_1 impl_elim_r. Qed. Global Instance from_pure_persistently P a φ : FromPure true P φ → FromPure a ( P) φ. Proof. rewrite /FromPure=> <- /=. by rewrite persistently_affinely_elim affinely_if_elim persistently_pure. Qed. Global Instance from_pure_affinely_true a P φ : FromPure a P φ → FromPure true ( P) φ. Proof. rewrite /FromPure=><- /=. by rewrite -affinely_affinely_if affinely_idemp. Qed. Global Instance from_pure_intuitionistically_true a P φ : FromPure a P φ → FromPure true (□ P) φ. Proof. rewrite /FromPure=><- /=. rewrite -intuitionistically_affinely_elim -affinely_affinely_if affinely_idemp. by rewrite intuitionistic_intuitionistically. Qed. Global Instance from_pure_absorbingly a P φ : FromPure a P φ → FromPure false ( P) φ. Proof. rewrite /FromPure=> <- /=. rewrite -affinely_affinely_if. by rewrite -persistent_absorbingly_affinely_2. Qed. Global Instance from_pure_big_sepL {A} a (Φ : nat → A → PROP) (φ : nat → A → Prop) (l : list A) : (∀ k x, FromPure a (Φ k x) (φ k x)) → TCOr (TCEq a true) (BiAffine PROP) → FromPure a ([∗ list] k↦x ∈ l, Φ k x) (∀ k x, l !! k = Some x → φ k x). Proof. rewrite /FromPure. destruct a; simpl; intros HΦ Haffine. - rewrite big_sepL_affinely_pure_2. setoid_rewrite HΦ. done. - destruct Haffine as [[=]%TCEq_eq|?]. rewrite -big_sepL_pure. setoid_rewrite HΦ. done. Qed. Global Instance from_pure_big_sepM `{Countable K} {A} a (Φ : K → A → PROP) (φ : K → A → Prop) (m : gmap K A) : (∀ k x, FromPure a (Φ k x) (φ k x)) → TCOr (TCEq a true) (BiAffine PROP) → FromPure a ([∗ map] k↦x ∈ m, Φ k x) (map_Forall φ m). Proof. rewrite /FromPure. destruct a; simpl; intros HΦ Haffine. - rewrite big_sepM_affinely_pure_2. setoid_rewrite HΦ. done. - destruct Haffine as [[=]%TCEq_eq|?]. rewrite -big_sepM_pure. setoid_rewrite HΦ. done. Qed. Global Instance from_pure_big_sepS `{Countable A} a (Φ : A → PROP) (φ : A → Prop) (X : gset A) : (∀ x, FromPure a (Φ x) (φ x)) → TCOr (TCEq a true) (BiAffine PROP) → FromPure a ([∗ set] x ∈ X, Φ x) (set_Forall φ X). Proof. rewrite /FromPure. destruct a; simpl; intros HΦ Haffine. - rewrite big_sepS_affinely_pure_2. setoid_rewrite HΦ. done. - destruct Haffine as [[=]%TCEq_eq|?]. rewrite -big_sepS_pure. setoid_rewrite HΦ. done. Qed. Global Instance from_pure_big_sepMS `{Countable A} a (Φ : A → PROP) (φ : A → Prop) (X : gmultiset A) : (∀ x, FromPure a (Φ x) (φ x)) → TCOr (TCEq a true) (BiAffine PROP) → FromPure a ([∗ mset] x ∈ X, Φ x) (∀ y : A, y ∈ X → φ y). Proof. rewrite /FromPure. destruct a; simpl; intros HΦ Haffine. - rewrite big_sepMS_affinely_pure_2. setoid_rewrite HΦ. done. - destruct Haffine as [[=]%TCEq_eq|?]. rewrite -big_sepMS_pure. setoid_rewrite HΦ. done. Qed. (** IntoPersistent *) Global Instance into_persistent_persistently p P Q : IntoPersistent true P Q → IntoPersistent p ( 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 ( P) Q | 0. Proof. rewrite /IntoPersistent /= => <-. by rewrite affinely_elim. Qed. Global Instance into_persistent_intuitionistically p P Q : IntoPersistent true P Q → IntoPersistent p (□ P) Q | 0. Proof. rewrite /IntoPersistent /= =><-. destruct p; simpl; eauto using persistently_mono, intuitionistically_elim, intuitionistically_into_persistently_1. Qed. Global Instance into_persistent_here P : IntoPersistent true P P | 1. Proof. by rewrite /IntoPersistent. Qed. Global Instance into_persistent_persistent P : Persistent P → IntoPersistent false P P | 100. Proof. intros. by rewrite /IntoPersistent. Qed. (** FromModal *) Global Instance from_modal_affinely P : FromModal True modality_affinely ( P) ( P) P | 2. Proof. by rewrite /FromModal. Qed. Global Instance from_modal_persistently P : FromModal True modality_persistently ( P) ( P) P | 2. Proof. by rewrite /FromModal. Qed. Global Instance from_modal_intuitionistically P : FromModal True modality_intuitionistically (□ P) (□ P) P | 1. Proof. by rewrite /FromModal. Qed. Global Instance from_modal_intuitionistically_affine_bi P : BiAffine PROP → FromModal True modality_persistently (□ P) (□ P) P | 0. Proof. intros. by rewrite /FromModal /= intuitionistically_into_persistently. Qed. Global Instance from_modal_absorbingly P : FromModal True modality_id ( P) ( P) P. Proof. by rewrite /FromModal /= -absorbingly_intro. Qed. (** IntoWand *) Global Instance into_wand_wand' p q (P Q P' Q' : PROP) : IntoWand' p q (P -∗ Q) P' Q' → IntoWand p q (P -∗ Q) P' Q' | 100. Proof. done. Qed. Global Instance into_wand_impl' p q (P Q P' Q' : PROP) : IntoWand' p q (P → Q) P' Q' → IntoWand p q (P → Q) P' Q' | 100. Proof. done. Qed. Global Instance into_wand_wandM' p q mP (Q P' Q' : PROP) : IntoWand' p q (mP -∗? Q) P' Q' → IntoWand p q (mP -∗? Q) P' Q' | 100. Proof. done. Qed. Global Instance into_wand_wand p q P Q P' : FromAssumption q P P' → IntoWand p q (P' -∗ Q) P Q. Proof. rewrite /FromAssumption /IntoWand=> HP. by rewrite HP intuitionistically_if_elim. Qed. (** Implication instances For non-affine BIs, generally we assume [P → ...] is written in cases where that would be equivalent to [ P -∗ ...], i.e., [P] is absorbing and persistent and an affinely modality is added when proving the premise. If the implication itself or the premise are taken from the persistent context, things become a bit easier and we can drop some of these requirements. We also support arbitrary implications for affine BIs via [BiAffine]. *) Global Instance into_wand_impl_false_false P Q P' P'' : Absorbing P → (* Cheap check comes first *) TCOr (BiAffine PROP) (Persistent P) → MakeAffinely P P' → FromAssumption false P'' P' → IntoWand false false (P → Q) P'' Q. Proof. rewrite /MakeAffinely /IntoWand /FromAssumption /= => ? Hpers <- ->. apply wand_intro_l. destruct Hpers. - rewrite impl_wand_1 affinely_elim wand_elim_r //. - rewrite persistent_impl_wand_affinely wand_elim_r //. Qed. Global Instance into_wand_impl_false_true P Q P' : Absorbing P' → FromAssumption true P P' → IntoWand false true (P' → Q) P Q. Proof. rewrite /IntoWand /FromAssumption /= => ? HP. apply wand_intro_l. rewrite -(persistently_elim P'). rewrite persistent_impl_wand_affinely. rewrite -(intuitionistically_idemp P) HP. apply wand_elim_r. Qed. Global Instance into_wand_impl_true_false P Q P' P'' : MakeAffinely P P' → FromAssumption false P'' P' → IntoWand true false (P → Q) P'' Q. Proof. rewrite /MakeAffinely /IntoWand /FromAssumption /= => <- ->. apply wand_intro_r. rewrite sep_and intuitionistically_elim affinely_elim impl_elim_l //. Qed. Global Instance into_wand_impl_true_true P Q P' : FromAssumption true P P' → IntoWand true true (P' → Q) P Q. Proof. rewrite /FromAssumption /IntoWand /= => <-. apply wand_intro_l. rewrite sep_and [(□ (_ → _))%I]intuitionistically_elim impl_elim_r //. Qed. Global Instance into_wand_wandM p q mP' P Q : FromAssumption q P (default emp%I mP') → IntoWand p q (mP' -∗? Q) P Q. Proof. rewrite /IntoWand wandM_sound. exact: into_wand_wand. Qed. Global Instance into_wand_and_l p q R1 R2 P' Q' : IntoWand p q R1 P' Q' → IntoWand p q (R1 ∧ R2) P' Q'. Proof. rewrite /IntoWand=> ?. by rewrite /bi_wand_iff and_elim_l. Qed. Global Instance into_wand_and_r p q R1 R2 P' Q' : IntoWand p q R2 Q' P' → IntoWand p q (R1 ∧ R2) Q' P'. Proof. rewrite /IntoWand=> ?. by rewrite /bi_wand_iff and_elim_r. Qed. Global Instance into_wand_forall_prop_true p (φ : Prop) P : IntoWand p true (∀ _ : φ, P) ⌜ φ ⌝ P. Proof. rewrite /IntoWand (intuitionistically_if_elim p) /= -impl_wand_intuitionistically -pure_impl_forall bi.persistently_elim //. Qed. Global Instance into_wand_forall_prop_false p (φ : Prop) Pφ P : MakeAffinely ⌜ φ ⌝ Pφ → IntoWand p false (∀ _ : φ, P) Pφ P. Proof. rewrite /MakeAffinely /IntoWand=> <-. rewrite (intuitionistically_if_elim p) /=. by rewrite -pure_impl_forall -persistent_impl_wand_affinely. Qed. Global Instance into_wand_forall {A} p q (Φ : A → PROP) P Q x : IntoWand p q (Φ x) P Q → IntoWand p q (∀ x, Φ x) P Q. Proof. rewrite /IntoWand=> <-. by rewrite (forall_elim x). Qed. Global Instance into_wand_tforall {TT : tele} p q (Φ : TT → PROP) P Q x : IntoWand p q (Φ x) P Q → IntoWand p q (∀.. x, Φ x) P Q. Proof. rewrite /IntoWand=> <-. by rewrite bi_tforall_forall (forall_elim x). Qed. Global Instance into_wand_affine p q R P Q : IntoWand p q R P Q → IntoWand p q ( R) ( P) ( Q). Proof. rewrite /IntoWand /= => HR. apply wand_intro_r. destruct p; simpl in *. - rewrite (affinely_elim R) -(affine_affinely (□ R)) HR. destruct q; simpl in *. + rewrite (affinely_elim P) -{2}(affine_affinely (□ P)). by rewrite affinely_sep_2 wand_elim_l. + by rewrite affinely_sep_2 wand_elim_l. - rewrite HR. destruct q; simpl in *. + rewrite (affinely_elim P) -{2}(affine_affinely (□ P)). by rewrite affinely_sep_2 wand_elim_l. + by rewrite affinely_sep_2 wand_elim_l. Qed. (* In case the argument is affine, but the wand resides in the spatial context, we can only eliminate the affine modality in the argument. This would lead to the following instance: IntoWand false q R P Q → IntoWand' false q R ( 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 ( P) ( Q). Proof. rewrite /IntoWand' /IntoWand /= => HR. apply wand_intro_r. rewrite -(affine_affinely (□ R)) HR. destruct q; simpl. - rewrite (affinely_elim P) -{2}(affine_affinely (□ P)). by rewrite affinely_sep_2 wand_elim_l. - by rewrite affinely_sep_2 wand_elim_l. Qed. Global Instance into_wand_intuitionistically p q R P Q : IntoWand true q R P Q → IntoWand p q (□ R) P Q. Proof. rewrite /IntoWand /= => ->. by rewrite {1}intuitionistically_if_elim. Qed. Global Instance into_wand_persistently_true q R P Q : IntoWand true q R P Q → IntoWand true q ( 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 ( R) P Q. Proof. intros ?. by rewrite /IntoWand persistently_elim. Qed. (** FromWand *) Global Instance from_wand_wand P1 P2 : FromWand (P1 -∗ P2) P1 P2. Proof. by rewrite /FromWand. Qed. Global Instance from_wand_wandM mP1 P2 : FromWand (mP1 -∗? P2) (default emp mP1)%I P2. Proof. by rewrite /FromWand wandM_sound. Qed. (** FromImpl *) Global Instance from_impl_impl P1 P2 : FromImpl (P1 → P2) P1 P2. Proof. by rewrite /FromImpl. Qed. (** FromAnd *) Global Instance from_and_and P1 P2 : FromAnd (P1 ∧ P2) P1 P2 | 100. Proof. by rewrite /FromAnd. Qed. Global Instance from_and_sep_persistent_l P1 P1' P2 : Persistent P1 → IntoAbsorbingly P1' P1 → FromAnd (P1 ∗ P2) P1' P2 | 9. Proof. rewrite /IntoAbsorbingly /FromAnd=> ? ->. rewrite persistent_and_affinely_sep_l_1 {1}(persistent_persistently_2 P1). by rewrite absorbingly_elim_persistently -{2}(intuitionistically_elim P1). Qed. Global Instance from_and_sep_persistent_r P1 P2 P2' : Persistent P2 → IntoAbsorbingly P2' P2 → FromAnd (P1 ∗ P2) P1 P2' | 10. Proof. rewrite /IntoAbsorbingly /FromAnd=> ? ->. rewrite persistent_and_affinely_sep_r_1 {1}(persistent_persistently_2 P2). by rewrite absorbingly_elim_persistently -{2}(intuitionistically_elim P2). Qed. Global Instance from_and_pure φ ψ : @FromAnd PROP ⌜φ ∧ ψ⌝ ⌜φ⌝ ⌜ψ⌝. Proof. by rewrite /FromAnd pure_and. Qed. Global Instance from_and_persistently P Q1 Q2 : FromAnd P Q1 Q2 → FromAnd ( P) ( Q1) ( Q2). Proof. rewrite /FromAnd=> <-. by rewrite persistently_and. Qed. Global Instance from_and_persistently_sep P Q1 Q2 : FromSep P Q1 Q2 → FromAnd ( P) ( Q1) ( Q2) | 11. Proof. rewrite /FromAnd=> <-. by rewrite -persistently_and persistently_and_sep. Qed. Global Instance from_and_big_sepL_cons_persistent {A} (Φ : nat → A → PROP) l x l' : IsCons l x l' → Persistent (Φ 0 x) → FromAnd ([∗ list] k ↦ y ∈ l, Φ k y) (Φ 0 x) ([∗ list] k ↦ y ∈ l', Φ (S k) y). Proof. rewrite /IsCons=> -> ?. by rewrite /FromAnd big_sepL_cons persistent_and_sep_1. Qed. Global Instance from_and_big_sepL_app_persistent {A} (Φ : nat → A → PROP) l l1 l2 : IsApp l l1 l2 → (∀ k y, Persistent (Φ k y)) → FromAnd ([∗ list] k ↦ y ∈ l, Φ k y) ([∗ list] k ↦ y ∈ l1, Φ k y) ([∗ list] k ↦ y ∈ l2, Φ (length l1 + k) y). Proof. rewrite /IsApp=> -> ?. by rewrite /FromAnd big_sepL_app persistent_and_sep_1. Qed. Global Instance from_and_big_sepL2_cons_persistent {A B} (Φ : nat → A → B → PROP) l1 x1 l1' l2 x2 l2' : IsCons l1 x1 l1' → IsCons l2 x2 l2' → Persistent (Φ 0 x1 x2) → FromAnd ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2) (Φ 0 x1 x2) ([∗ list] k ↦ y1;y2 ∈ l1';l2', Φ (S k) y1 y2). Proof. rewrite /IsCons=> -> -> ?. by rewrite /FromAnd big_sepL2_cons persistent_and_sep_1. Qed. Global Instance from_and_big_sepL2_app_persistent {A B} (Φ : nat → A → B → PROP) l1 l1' l1'' l2 l2' l2'' : IsApp l1 l1' l1'' → IsApp l2 l2' l2'' → (∀ k y1 y2, Persistent (Φ k y1 y2)) → FromAnd ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2) ([∗ list] k ↦ y1;y2 ∈ l1';l2', Φ k y1 y2) ([∗ list] k ↦ y1;y2 ∈ l1'';l2'', Φ (length l1' + k) y1 y2). Proof. rewrite /IsApp=> -> -> ?. rewrite /FromAnd persistent_and_sep_1. apply wand_elim_l', big_sepL2_app. Qed. Global Instance from_and_big_sepMS_disj_union_persistent `{Countable A} (Φ : A → PROP) X1 X2 : (∀ y, Persistent (Φ y)) → FromAnd ([∗ mset] y ∈ X1 ⊎ X2, Φ y) ([∗ mset] y ∈ X1, Φ y) ([∗ mset] y ∈ X2, Φ y). Proof. intros. by rewrite /FromAnd big_sepMS_disj_union persistent_and_sep_1. Qed. (** FromSep *) Global Instance from_sep_sep P1 P2 : FromSep (P1 ∗ P2) P1 P2 | 100. Proof. by rewrite /FromSep. Qed. Global Instance from_sep_and P1 P2 : TCOr (Affine P1) (Absorbing P2) → TCOr (Affine P2) (Absorbing P1) → FromSep (P1 ∧ P2) P1 P2 | 101. Proof. intros. by rewrite /FromSep sep_and. Qed. Global Instance from_sep_pure φ ψ : @FromSep PROP ⌜φ ∧ ψ⌝ ⌜φ⌝ ⌜ψ⌝. Proof. by rewrite /FromSep pure_and sep_and. Qed. Global Instance from_sep_affinely P Q1 Q2 : FromSep P Q1 Q2 → FromSep ( P) ( Q1) ( 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 ( P) ( Q1) ( Q2). Proof. rewrite /FromSep=> <-. by rewrite absorbingly_sep. Qed. Global Instance from_sep_persistently P Q1 Q2 : FromSep P Q1 Q2 → FromSep ( P) ( Q1) ( Q2). Proof. rewrite /FromSep=> <-. by rewrite persistently_sep_2. Qed. Global Instance from_sep_big_sepL_cons {A} (Φ : nat → A → PROP) l x l' : IsCons l x l' → FromSep ([∗ list] k ↦ y ∈ l, Φ k y) (Φ 0 x) ([∗ list] k ↦ y ∈ l', Φ (S k) y). Proof. rewrite /IsCons=> ->. by rewrite /FromSep big_sepL_cons. Qed. Global Instance from_sep_big_sepL_app {A} (Φ : nat → A → PROP) l l1 l2 : IsApp l l1 l2 → FromSep ([∗ list] k ↦ y ∈ l, Φ k y) ([∗ list] k ↦ y ∈ l1, Φ k y) ([∗ list] k ↦ y ∈ l2, Φ (length l1 + k) y). Proof. rewrite /IsApp=> ->. by rewrite /FromSep big_opL_app. Qed. Global Instance from_sep_big_sepL2_cons {A B} (Φ : nat → A → B → PROP) l1 x1 l1' l2 x2 l2' : IsCons l1 x1 l1' → IsCons l2 x2 l2' → FromSep ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2) (Φ 0 x1 x2) ([∗ list] k ↦ y1;y2 ∈ l1';l2', Φ (S k) y1 y2). Proof. rewrite /IsCons=> -> ->. by rewrite /FromSep big_sepL2_cons. Qed. Global Instance from_sep_big_sepL2_app {A B} (Φ : nat → A → B → PROP) l1 l1' l1'' l2 l2' l2'' : IsApp l1 l1' l1'' → IsApp l2 l2' l2'' → FromSep ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2) ([∗ list] k ↦ y1;y2 ∈ l1';l2', Φ k y1 y2) ([∗ list] k ↦ y1;y2 ∈ l1'';l2'', Φ (length l1' + k) y1 y2). Proof. rewrite /IsApp=>-> ->. apply wand_elim_l', big_sepL2_app. Qed. Global Instance from_sep_big_sepMS_disj_union `{Countable A} (Φ : A → PROP) X1 X2 : FromSep ([∗ mset] y ∈ X1 ⊎ X2, Φ y) ([∗ mset] y ∈ X1, Φ y) ([∗ mset] y ∈ X2, Φ y). Proof. by rewrite /FromSep big_sepMS_disj_union. Qed. (** MaybeCombineSepAs *) Global Instance maybe_combine_sep_as_affinely Q1 Q2 P progress : MaybeCombineSepAs Q1 Q2 P progress → MaybeCombineSepAs ( Q1) ( Q2) ( P) progress | 30. Proof. rewrite /MaybeCombineSepAs =><-. by rewrite affinely_sep_2. Qed. Global Instance maybe_combine_sep_as_intuitionistically Q1 Q2 P progress : MaybeCombineSepAs Q1 Q2 P progress → MaybeCombineSepAs (□ Q1) (□ Q2) (□ P) progress | 30. Proof. rewrite /MaybeCombineSepAs =><-. by rewrite intuitionistically_sep_2. Qed. Global Instance maybe_combine_sep_as_absorbingly Q1 Q2 P progress : MaybeCombineSepAs Q1 Q2 P progress → MaybeCombineSepAs ( Q1) ( Q2) ( P) progress | 30. Proof. rewrite /MaybeCombineSepAs =><-. by rewrite absorbingly_sep. Qed. Global Instance maybe_combine_sep_as_persistently Q1 Q2 P progress : MaybeCombineSepAs Q1 Q2 P progress → MaybeCombineSepAs ( Q1) ( Q2) ( P) progress | 30. Proof. rewrite /MaybeCombineSepAs =><-. by rewrite persistently_sep_2. Qed. (** CombineSepGives *) (* The results of these recursive instances drop the input modalities. This is fine, because the [P] argument in [CombineSepGives Q1 Q2 P] is by definition beneath a [] modality, and we have: - [ P ⊢ P] holds, we have [ P ⊣⊢ P] by [persistently_affinely_elim] and the obtained [□ P] in [iCombine] is always [Affine] anyway. - [□ P = P], see [] and [] - [ P ⊣⊢ P], see [absorbingly_elim_persistently] - [ P ⊣⊢ P], see [persistently_idemp] *) Global Instance combine_sep_as_affinely Q1 Q2 P : CombineSepGives Q1 Q2 P → CombineSepGives ( Q1) ( Q2) P | 30. Proof. by rewrite /CombineSepGives affinely_sep_2 affinely_elim => ->. Qed. Global Instance combine_sep_as_intuitionistically Q1 Q2 P : CombineSepGives Q1 Q2 P → CombineSepGives (□ Q1) (□ Q2) P | 30. Proof. rewrite /CombineSepGives => <-. by rewrite !intuitionistically_elim. Qed. Global Instance combine_sep_as_absorbingly Q1 Q2 P : CombineSepGives Q1 Q2 P → CombineSepGives ( Q1) ( Q2) P | 30. Proof. rewrite /CombineSepGives -absorbingly_sep =>->. by rewrite absorbingly_elim_persistently. Qed. Global Instance combine_sep_as_persistently Q1 Q2 P : CombineSepGives Q1 Q2 P → CombineSepGives ( Q1) ( Q2) P | 30. Proof. rewrite /CombineSepGives persistently_sep_2 => ->. by rewrite persistently_idemp. Qed. (** IntoAnd *) Global Instance into_and_and p P Q : IntoAnd p (P ∧ Q) P Q | 10. Proof. by rewrite /IntoAnd intuitionistically_if_and. Qed. Global Instance into_and_and_affine_l P Q Q' : Affine P → FromAffinely Q' Q → IntoAnd false (P ∧ Q) P Q'. Proof. intros. rewrite /IntoAnd /=. by rewrite -(affine_affinely P) affinely_and_l affinely_and (from_affinely Q'). Qed. Global Instance into_and_and_affine_r P P' Q : Affine Q → FromAffinely P' P → IntoAnd false (P ∧ Q) P' Q. Proof. intros. rewrite /IntoAnd /=. by rewrite -(affine_affinely Q) affinely_and_r affinely_and (from_affinely P'). Qed. Global Instance into_and_sep `{!BiPositive PROP} P Q : IntoAnd true (P ∗ Q) P Q. Proof. rewrite /IntoAnd /= intuitionistically_sep -and_sep_intuitionistically intuitionistically_and //. Qed. Global Instance into_and_sep_affine p P Q : TCOr (Affine P) (Absorbing Q) → TCOr (Affine Q) (Absorbing P) → IntoAnd p (P ∗ Q) P Q. Proof. intros. by rewrite /IntoAnd /= sep_and. Qed. Global Instance into_and_pure p φ ψ : @IntoAnd PROP p ⌜φ ∧ ψ⌝ ⌜φ⌝ ⌜ψ⌝. Proof. by rewrite /IntoAnd pure_and intuitionistically_if_and. Qed. Global Instance into_and_affinely p P Q1 Q2 : IntoAnd p P Q1 Q2 → IntoAnd p ( P) ( Q1) ( 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 ( P) ( Q1) ( Q2). Proof. rewrite /IntoAnd /=. destruct p; simpl. - rewrite -persistently_and !intuitionistically_persistently_elim //. - intros ->. by rewrite persistently_and. Qed. (** IntoSep *) Global Instance into_sep_sep P Q : IntoSep (P ∗ Q) P Q. Proof. by rewrite /IntoSep. Qed. Inductive AndIntoSep : PROP → PROP → PROP → PROP → Prop := | and_into_sep_affine P Q Q' : Affine P → FromAffinely Q' Q → AndIntoSep P P Q Q' | and_into_sep P Q : AndIntoSep P ( P) Q Q. Existing Class AndIntoSep. Global Existing Instance and_into_sep_affine | 0. Global Existing Instance and_into_sep | 2. Global Instance into_sep_and_persistent_l P P' Q Q' : Persistent P → AndIntoSep P P' Q Q' → IntoSep (P ∧ Q) P' Q'. Proof. destruct 2 as [P Q Q'|P Q]; rewrite /IntoSep. - rewrite -(from_affinely Q' Q) -(affine_affinely P) affinely_and_lr. by rewrite persistent_and_affinely_sep_l_1. - by rewrite persistent_and_affinely_sep_l_1. Qed. Global Instance into_sep_and_persistent_r P P' Q Q' : Persistent Q → AndIntoSep Q Q' P P' → IntoSep (P ∧ Q) P' Q'. Proof. destruct 2 as [Q P P'|Q P]; rewrite /IntoSep. - rewrite -(from_affinely P' P) -(affine_affinely Q) -affinely_and_lr. by rewrite persistent_and_affinely_sep_r_1. - by rewrite persistent_and_affinely_sep_r_1. Qed. Global Instance into_sep_pure φ ψ : @IntoSep PROP ⌜φ ∧ ψ⌝ ⌜φ⌝ ⌜ψ⌝. Proof. by rewrite /IntoSep pure_and persistent_and_sep_1. Qed. Global Instance into_sep_affinely `{!BiPositive PROP} P Q1 Q2 : IntoSep P Q1 Q2 → IntoSep ( P) ( Q1) ( Q2) | 0. Proof. rewrite /IntoSep /= => ->. by rewrite affinely_sep. Qed. Global Instance into_sep_intuitionistically `{!BiPositive PROP} P Q1 Q2 : IntoSep P Q1 Q2 → IntoSep (□ P) (□ Q1) (□ Q2) | 0. Proof. rewrite /IntoSep /= => ->. by rewrite intuitionistically_sep. Qed. (* FIXME: This instance is kind of strange, it just gets rid of the bi_affinely. Also, it overlaps with `into_sep_affinely_later`, and hence has higher cost. *) Global Instance into_sep_affinely_trim P Q1 Q2 : IntoSep P Q1 Q2 → IntoSep ( 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 ( P) ( Q1) ( Q2). Proof. rewrite /IntoSep /= => ->. by rewrite persistently_sep. Qed. Global Instance into_sep_persistently_affine P Q1 Q2 : IntoSep P Q1 Q2 → TCOr (Affine Q1) (Absorbing Q2) → TCOr (Affine Q2) (Absorbing Q1) → IntoSep ( P) ( Q1) ( Q2). Proof. rewrite /IntoSep /= => -> ??. by rewrite sep_and persistently_and persistently_and_sep_l_1. Qed. Global Instance into_sep_intuitionistically_affine P Q1 Q2 : IntoSep P Q1 Q2 → TCOr (Affine Q1) (Absorbing Q2) → TCOr (Affine Q2) (Absorbing Q1) → IntoSep (□ P) (□ Q1) (□ Q2). Proof. rewrite /IntoSep /= => -> ??. by rewrite sep_and intuitionistically_and and_sep_intuitionistically. Qed. Global Instance into_sep_big_sepL_cons {A} (Φ : nat → A → PROP) l x l' : IsCons l x l' → IntoSep ([∗ list] k ↦ y ∈ l, Φ k y) (Φ 0 x) ([∗ list] k ↦ y ∈ l', Φ (S k) y). Proof. rewrite /IsCons=>->. by rewrite /IntoSep big_sepL_cons. Qed. Global Instance into_sep_big_sepL_app {A} (Φ : nat → A → PROP) l l1 l2 : IsApp l l1 l2 → IntoSep ([∗ list] k ↦ y ∈ l, Φ k y) ([∗ list] k ↦ y ∈ l1, Φ k y) ([∗ list] k ↦ y ∈ l2, Φ (length l1 + k) y). Proof. rewrite /IsApp=>->. by rewrite /IntoSep big_sepL_app. Qed. (* No instance for app, since that only works when the LHSs have the same length *) Global Instance into_sep_big_sepL2_cons {A B} (Φ : nat → A → B → PROP) l1 x1 l1' l2 x2 l2' : IsCons l1 x1 l1' → IsCons l2 x2 l2' → IntoSep ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2) (Φ 0 x1 x2) ([∗ list] k ↦ y1;y2 ∈ l1';l2', Φ (S k) y1 y2). Proof. rewrite /IsCons=>-> ->. by rewrite /IntoSep big_sepL2_cons. Qed. Global Instance into_sep_big_sepMS_disj_union `{Countable A} (Φ : A → PROP) X1 X2 : IntoSep ([∗ mset] y ∈ X1 ⊎ X2, Φ y) ([∗ mset] y ∈ X1, Φ y) ([∗ mset] y ∈ X2, Φ y). Proof. by rewrite /IntoSep big_sepMS_disj_union. Qed. (** FromOr *) Global Instance from_or_or P1 P2 : FromOr (P1 ∨ P2) P1 P2. Proof. by rewrite /FromOr. Qed. Global Instance from_or_pure φ ψ : @FromOr PROP ⌜φ ∨ ψ⌝ ⌜φ⌝ ⌜ψ⌝. Proof. by rewrite /FromOr pure_or. Qed. Global Instance from_or_affinely P Q1 Q2 : FromOr P Q1 Q2 → FromOr ( P) ( Q1) ( 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 ( P) ( Q1) ( Q2). Proof. rewrite /FromOr=> <-. by rewrite absorbingly_or. Qed. Global Instance from_or_persistently P Q1 Q2 : FromOr P Q1 Q2 → FromOr ( P) ( Q1) ( Q2). Proof. rewrite /FromOr=> <-. by rewrite persistently_or. Qed. (** IntoOr *) Global Instance into_or_or P Q : IntoOr (P ∨ Q) P Q. Proof. by rewrite /IntoOr. Qed. Global Instance into_or_pure φ ψ : @IntoOr PROP ⌜φ ∨ ψ⌝ ⌜φ⌝ ⌜ψ⌝. Proof. by rewrite /IntoOr pure_or. Qed. Global Instance into_or_affinely P Q1 Q2 : IntoOr P Q1 Q2 → IntoOr ( P) ( Q1) ( 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 ( P) ( Q1) ( Q2). Proof. rewrite /IntoOr=>->. by rewrite absorbingly_or. Qed. Global Instance into_or_persistently P Q1 Q2 : IntoOr P Q1 Q2 → IntoOr ( P) ( Q1) ( Q2). Proof. rewrite /IntoOr=>->. by rewrite persistently_or. Qed. (** FromExist *) Global Instance from_exist_texist {TT : tele} (Φ : TT → PROP) : FromExist (∃.. a, Φ a) Φ. Proof. by rewrite /FromExist bi_texist_exist. Qed. Global Instance from_exist_pure {A} (φ : A → Prop) : @FromExist PROP A ⌜∃ x, φ x⌝ (λ a, ⌜φ a⌝)%I. Proof. by rewrite /FromExist pure_exist. Qed. Global Instance from_exist_affinely {A} P (Φ : A → PROP) : FromExist P Φ → FromExist ( P) (λ a, (Φ 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 ( P) (λ a, (Φ a))%I. Proof. rewrite /FromExist=> <-. by rewrite absorbingly_exist. Qed. Global Instance from_exist_persistently {A} P (Φ : A → PROP) : FromExist P Φ → FromExist ( P) (λ a, (Φ a))%I. Proof. rewrite /FromExist=> <-. by rewrite persistently_exist. Qed. (** IntoExist *) (* These three instances [into_exist_exist], [into_exist_pure], and [into_exist_texist] need to be written without notations, for example [bi_exist Φ] and not [∃ a, Φ a], so that [AsIdentName] is always passed the entire body of the exists with the binder. *) Global Instance into_exist_exist {A} (Φ : A → PROP) name : AsIdentName Φ name → IntoExist (bi_exist Φ) Φ name. Proof. by rewrite /IntoExist. Qed. Global Instance into_exist_pure {A} (φ : A → Prop) name : AsIdentName φ name → @IntoExist PROP A ⌜ex φ⌝ (λ a, ⌜φ a⌝)%I name. Proof. by rewrite /IntoExist pure_exist. Qed. Global Instance into_exist_texist {TT : tele} (Φ : TT → PROP) name : AsIdentName Φ name → IntoExist (bi_texist Φ) Φ name | 10. Proof. by rewrite /IntoExist bi_texist_exist. Qed. Global Instance into_exist_affinely {A} P (Φ : A → PROP) name : IntoExist P Φ name → IntoExist ( P) (λ a, (Φ a))%I name. Proof. rewrite /IntoExist=> HP. by rewrite HP affinely_exist. Qed. Global Instance into_exist_intuitionistically {A} P (Φ : A → PROP) name : IntoExist P Φ name → IntoExist (□ P) (λ a, □ (Φ a))%I name. Proof. rewrite /IntoExist=> HP. by rewrite HP intuitionistically_exist. Qed. (* This instance is generalized to let us use [iDestruct as (P) "..."] and [iIntros "[% ...]"] for conjunctions with a pure left-hand side. There is some risk of backtracking here, but that should only happen in failing cases (assuming that appropriate modality commuting instances are provided for both conjunctions and existential quantification). The alternative of providing specialized instances for cases like ⌜P ∧ Q⌝ turned out to not be tenable. [to_ident_name H] makes the default name [H] when [P] is destructed with [iExistDestruct]. See [IntoPureT] for why [φ] is a [Type]. *) Global Instance into_exist_and_pure PQ P Q (φ : Type) : IntoAnd false PQ P Q → IntoPureT P φ → IntoExist PQ (λ _ : φ, Q) (to_ident_name H) | 10. Proof. intros HPQ (φ'&->&?). rewrite /IntoAnd /= in HPQ. rewrite /IntoExist HPQ (into_pure P). apply pure_elim_l=> Hφ. by rewrite -(exist_intro Hφ). Qed. (* [to_ident_name H] makes the default name [H] when [P] is destructed with [iExistDestruct]. See [IntoPureT] for why [φ] is a [Type]. *) Global Instance into_exist_sep_pure P Q (φ : Type) : IntoPureT P φ → TCOr (Affine P) (Absorbing Q) → IntoExist (P ∗ Q) (λ _ : φ, Q) (to_ident_name H). Proof. intros (φ'&->&?) ?. rewrite /IntoExist. eapply (pure_elim φ'); [by rewrite (into_pure P); apply sep_elim_l, _|]=>?. rewrite -exist_intro //. apply sep_elim_r, _. Qed. Global Instance into_exist_absorbingly {A} P (Φ : A → PROP) name : IntoExist P Φ name → IntoExist ( P) (λ a, (Φ a))%I name. Proof. rewrite /IntoExist=> HP. by rewrite HP absorbingly_exist. Qed. Global Instance into_exist_persistently {A} P (Φ : A → PROP) name : IntoExist P Φ name → IntoExist ( P) (λ a, (Φ a))%I name. Proof. rewrite /IntoExist=> HP. by rewrite HP persistently_exist. Qed. (** IntoForall *) Global Instance into_forall_forall {A} (Φ : A → PROP) : IntoForall (∀ a, Φ a) Φ. Proof. by rewrite /IntoForall. Qed. Global Instance into_forall_tforall {TT : tele} (Φ : TT → PROP) : IntoForall (∀.. a, Φ a) Φ | 10. Proof. by rewrite /IntoForall bi_tforall_forall. Qed. Global Instance into_forall_affinely {A} P (Φ : A → PROP) : IntoForall P Φ → IntoForall ( P) (λ a, (Φ a))%I. Proof. rewrite /IntoForall=> HP. by rewrite HP affinely_forall. Qed. Global Instance into_forall_intuitionistically {A} P (Φ : A → PROP) : IntoForall P Φ → IntoForall (□ P) (λ a, □ (Φ a))%I. Proof. rewrite /IntoForall=> HP. by rewrite HP intuitionistically_forall. Qed. Global Instance into_forall_persistently `{!BiPersistentlyForall PROP} {A} P (Φ : A → PROP) : IntoForall P Φ → IntoForall ( P) (λ a, (Φ a))%I. Proof. rewrite /IntoForall=> HP. by rewrite HP persistently_forall. Qed. Global Instance into_forall_impl_pure a φ P Q : FromPureT a P φ → TCOr (TCEq a false) (BiAffine PROP) → IntoForall (P → Q) (λ _ : φ, Q). Proof. rewrite /FromPureT /FromPure /IntoForall=> -[φ' [-> <-]] [->|?] /=. - by rewrite pure_impl_forall. - by rewrite -affinely_affinely_if affine_affinely pure_impl_forall. Qed. Global Instance into_forall_wand_pure a φ P Q : FromPureT a P φ → IntoForall (P -∗ Q) (λ _ : φ, Q). Proof. rewrite /FromPureT /FromPure /IntoForall=> -[φ' [-> <-]] /=. apply forall_intro=>? /=. rewrite -affinely_affinely_if. by rewrite -(pure_intro _ True) // /bi_affinely right_id emp_wand. Qed. (* These instances must be used only after [into_forall_wand_pure] and [into_forall_wand_pure] above. *) Global Instance into_forall_wand P Q : IntoForall (P -∗ Q) (λ _ : ⊢ P, Q) | 10. Proof. rewrite /IntoForall. apply forall_intro=><-. rewrite emp_wand //. Qed. Global Instance into_forall_impl `{!BiAffine PROP} P Q : IntoForall (P → Q) (λ _ : ⊢ P, Q) | 10. Proof. rewrite /IntoForall. apply forall_intro=><-. rewrite -True_emp True_impl //. Qed. (** FromForall *) Global Instance from_forall_forall {A} (Φ : A → PROP) name : AsIdentName Φ name → FromForall (bi_forall Φ) Φ name. Proof. by rewrite /FromForall. Qed. Global Instance from_forall_tforall {TT : tele} (Φ : TT → PROP) name : AsIdentName Φ name → FromForall (bi_tforall Φ) Φ name. Proof. by rewrite /FromForall bi_tforall_forall. Qed. Global Instance from_forall_pure `{!BiPureForall PROP} {A} (φ : A → Prop) name : AsIdentName φ name → @FromForall PROP A ⌜∀ a : A, φ a⌝ (λ a, ⌜ φ a ⌝)%I name. Proof. by rewrite /FromForall pure_forall_2. Qed. Global Instance from_tforall_pure `{!BiPureForall PROP} {TT : tele} (φ : TT → Prop) name : AsIdentName φ name → @FromForall PROP TT ⌜tforall φ⌝ (λ x, ⌜ φ x ⌝)%I name. Proof. by rewrite /FromForall tforall_forall pure_forall. Qed. (* [H] is the default name for the [φ] hypothesis, in the following three instances *) Global Instance from_forall_pure_not `{!BiPureForall PROP} (φ : Prop) : @FromForall PROP φ ⌜¬ φ⌝ (λ _ : φ, False)%I (to_ident_name H). Proof. by rewrite /FromForall pure_forall. Qed. Global Instance from_forall_impl_pure P Q φ : IntoPureT P φ → FromForall (P → Q) (λ _ : φ, Q) (to_ident_name H). Proof. intros (φ'&->&?). by rewrite /FromForall -pure_impl_forall (into_pure P). Qed. Global Instance from_forall_wand_pure P Q φ : IntoPureT P φ → TCOr (Affine P) (Absorbing Q) → FromForall (P -∗ Q) (λ _ : φ, Q)%I (to_ident_name H). Proof. intros (φ'&->&?) [|]; rewrite /FromForall; apply wand_intro_r. - rewrite -(affine_affinely P) (into_pure P) -persistent_and_affinely_sep_r. apply pure_elim_r=>?. by rewrite forall_elim. - by rewrite (into_pure P) -pure_wand_forall wand_elim_l. Qed. Global Instance from_forall_intuitionistically `{!BiAffine PROP, !BiPersistentlyForall PROP} {A} P (Φ : A → PROP) name : FromForall P Φ name → FromForall (□ P) (λ a, □ (Φ a))%I name. Proof. rewrite /FromForall=> <-. setoid_rewrite intuitionistically_into_persistently. by rewrite persistently_forall. Qed. Global Instance from_forall_persistently `{!BiPersistentlyForall PROP} {A} P (Φ : A → PROP) name : FromForall P Φ name → FromForall ( P) (λ a, (Φ a))%I name. Proof. rewrite /FromForall=> <-. by rewrite persistently_forall. Qed. (** ElimModal *) Global Instance elim_modal_wand φ p p' P P' Q Q' R : ElimModal φ p p' P P' Q Q' → ElimModal φ p p' P P' (R -∗ Q) (R -∗ Q'). Proof. rewrite /ElimModal=> H Hφ. apply wand_intro_r. rewrite wand_curry -assoc (comm _ (□?p' _)%I) -wand_curry wand_elim_l; auto. Qed. Global Instance elim_modal_wandM φ p p' P P' Q Q' mR : ElimModal φ p p' P P' Q Q' → ElimModal φ p p' P P' (mR -∗? Q) (mR -∗? Q'). Proof. rewrite /ElimModal !wandM_sound. exact: elim_modal_wand. Qed. Global Instance elim_modal_forall {A} φ p p' P P' (Φ Ψ : A → PROP) : (∀ x, ElimModal φ p p' P P' (Φ x) (Ψ x)) → ElimModal φ p p' P P' (∀ x, Φ x) (∀ x, Ψ x). Proof. rewrite /ElimModal=> H ?. apply forall_intro=> a. rewrite (forall_elim a); auto. Qed. Global Instance elim_modal_tforall {TT : tele} φ p p' P P' (Φ Ψ : TT → PROP) : (∀ x, ElimModal φ p p' P P' (Φ x) (Ψ x)) → ElimModal φ p p' P P' (∀.. x, Φ x) (∀.. x, Ψ x). Proof. rewrite /ElimModal !bi_tforall_forall. apply elim_modal_forall. Qed. Global Instance elim_modal_absorbingly_here p P Q : Absorbing Q → ElimModal True p false ( P) P Q Q. Proof. rewrite /ElimModal=> ? _. by rewrite intuitionistically_if_elim absorbingly_sep_l wand_elim_r absorbing_absorbingly. Qed. (** AddModal *) Global Instance add_modal_wand P P' Q R : AddModal P P' Q → AddModal P P' (R -∗ Q). Proof. rewrite /AddModal=> H. apply wand_intro_r. by rewrite wand_curry -assoc (comm _ P') -wand_curry wand_elim_l. Qed. Global Instance add_modal_wandM P P' Q mR : AddModal P P' Q → AddModal P P' (mR -∗? Q). Proof. rewrite /AddModal wandM_sound. exact: add_modal_wand. Qed. Global Instance add_modal_forall {A} P P' (Φ : A → PROP) : (∀ x, AddModal P P' (Φ x)) → AddModal P P' (∀ x, Φ x). Proof. rewrite /AddModal=> H. apply forall_intro=> a. by rewrite (forall_elim a). Qed. Global Instance add_modal_tforall {TT : tele} P P' (Φ : TT → PROP) : (∀ x, AddModal P P' (Φ x)) → AddModal P P' (∀.. x, Φ x). Proof. rewrite /AddModal bi_tforall_forall. apply add_modal_forall. Qed. (** ElimInv *) Global Instance elim_inv_acc_without_close {X : Type} φ1 φ2 Pinv Pin (M1 M2 : PROP → PROP) α β mγ Q (Q' : X → PROP) : IntoAcc (X:=X) Pinv φ1 Pin M1 M2 α β mγ → ElimAcc (X:=X) φ2 M1 M2 α β mγ Q Q' → ElimInv (φ1 ∧ φ2) Pinv Pin α None Q Q'. Proof. rewrite /ElimAcc /IntoAcc /ElimInv. iIntros (Hacc Helim [??]) "(Hinv & Hin & Hcont)". iApply (Helim with "[Hcont]"); first done. - iIntros (x) "Hα". iApply "Hcont". iSplitL; simpl; done. - iApply (Hacc with "Hinv Hin"). done. Qed. (* This uses [pm_default] because, after inference, all accessors will have [None] or [Some _] there, so we want to reduce the combinator before showing the goal to the user. *) Global Instance elim_inv_acc_with_close {X : Type} φ1 φ2 Pinv Pin (M1 M2 : PROP → PROP) α β mγ Q Q' : IntoAcc Pinv φ1 Pin M1 M2 α β mγ → (∀ R, ElimModal φ2 false false (M1 R) R Q Q') → ElimInv (X:=X) (φ1 ∧ φ2) Pinv Pin α (Some (λ x, β x -∗ M2 (pm_default emp (mγ x))))%I Q (λ _, Q'). Proof. rewrite /ElimAcc /IntoAcc /ElimInv. iIntros (Hacc Helim [??]) "(Hinv & Hin & Hcont)". iMod (Hacc with "Hinv Hin") as (x) "[Hα Hclose]"; first done. iApply "Hcont". simpl. iSplitL "Hα"; done. Qed. End class_instances. iris-iris-4.2.0/iris/proofmode/class_instances_embedding.v000066400000000000000000000235741460620107300237420ustar00rootroot00000000000000From iris.bi Require Import bi. From iris.proofmode Require Import modality_instances classes. From iris.prelude Require Import options. Import bi. (** We add a useless hypothesis [BiEmbed PROP PROP'] in order to make sure this instance is not used when there is no embedding between [PROP] and [PROP']. The first [`{BiEmbed PROP PROP'}] is not considered as a premise by Coq TC search mechanism because the rest of the hypothesis is dependent on it. *) Global Instance as_emp_valid_embed `{!BiEmbed PROP PROP'} (φ : Prop) (P : PROP) : BiEmbed PROP PROP' → AsEmpValid0 φ P → AsEmpValid φ ⎡P⎤. Proof. rewrite /AsEmpValid0 /AsEmpValid=> _ ->. rewrite embed_emp_valid //. Qed. Section class_instances_embedding. Context `{!BiEmbed PROP PROP'}. Implicit Types P Q R : PROP. Global Instance into_pure_embed P φ : IntoPure P φ → IntoPure ⎡P⎤ φ. Proof. rewrite /IntoPure=> ->. by rewrite embed_pure. Qed. Global Instance from_pure_embed a P φ : FromPure a P φ → FromPure a ⎡P⎤ φ. Proof. rewrite /FromPure=> <-. by rewrite -embed_pure embed_affinely_if_2. Qed. Global Instance into_persistent_embed p P Q : IntoPersistent p P Q → IntoPersistent p ⎡P⎤ ⎡Q⎤ | 0. Proof. rewrite /IntoPersistent -embed_persistently -embed_persistently_if=> -> //. Qed. (* When having a modality nested in an embedding, e.g. [ ⎡|==> P⎤ ], we prefer the embedding over the modality. *) Global Instance from_modal_embed P : FromModal True (@modality_embed PROP PROP' _) ⎡P⎤ ⎡P⎤ P. Proof. by rewrite /FromModal. Qed. Global Instance from_modal_id_embed φ `(sel : A) P Q : FromModal φ modality_id sel P Q → FromModal φ modality_id sel ⎡P⎤ ⎡Q⎤ | 100. Proof. rewrite /FromModal /= =>HPQ ?. by rewrite -HPQ. Qed. Global Instance from_modal_affinely_embed φ `(sel : A) P Q : FromModal φ modality_affinely sel P Q → FromModal φ modality_affinely sel ⎡P⎤ ⎡Q⎤ | 100. Proof. rewrite /FromModal /= =>HPQ ?. by rewrite -HPQ // embed_affinely_2. Qed. Global Instance from_modal_persistently_embed φ `(sel : A) P Q : FromModal φ modality_persistently sel P Q → FromModal φ modality_persistently sel ⎡P⎤ ⎡Q⎤ | 100. Proof. rewrite /FromModal /= =>HPQ ?. by rewrite -HPQ // embed_persistently. Qed. Global Instance from_modal_intuitionistically_embed φ `(sel : A) P Q : FromModal φ modality_intuitionistically sel P Q → FromModal φ modality_intuitionistically sel ⎡P⎤ ⎡Q⎤ | 100. Proof. rewrite /FromModal /= =>HPQ ?. by rewrite -HPQ // embed_intuitionistically_2. Qed. Global Instance into_wand_embed p q R P Q : IntoWand p q R P Q → IntoWand p q ⎡R⎤ ⎡P⎤ ⎡Q⎤. Proof. by rewrite /IntoWand !embed_intuitionistically_if_2 -embed_wand=> ->. Qed. (* There are two versions for [IntoWand ⎡R⎤ ...] with the argument being [ ⎡P⎤]. When the wand [⎡R⎤] resides in the intuitionistic context the result of wand elimination will have the affine modality. Otherwise, it won't. Note that when the wand [⎡R⎤] is under an affine modality, the instance [into_wand_affine] would already have been used. *) Global Instance into_wand_affine_embed_true q P Q R : IntoWand true q R P Q → IntoWand true q ⎡R⎤ ( ⎡P⎤) ( ⎡Q⎤) | 100. Proof. rewrite /IntoWand /=. rewrite -(intuitionistically_idemp ⎡ _ ⎤) embed_intuitionistically_2=> ->. apply bi.wand_intro_l. destruct q; simpl. - rewrite affinely_elim -(intuitionistically_idemp ⎡ _ ⎤). rewrite embed_intuitionistically_2 intuitionistically_sep_2 -embed_sep. by rewrite wand_elim_r intuitionistically_affinely. - by rewrite intuitionistically_affinely affinely_sep_2 -embed_sep wand_elim_r. Qed. Global Instance into_wand_affine_embed_false q P Q R : IntoWand false q R ( P) Q → IntoWand false q ⎡R⎤ ( ⎡P⎤) ⎡Q⎤ | 100. Proof. rewrite /IntoWand /= => ->. by rewrite embed_affinely_2 embed_intuitionistically_if_2 embed_wand. Qed. Global Instance from_wand_embed P Q1 Q2 : FromWand P Q1 Q2 → FromWand ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤. Proof. by rewrite /FromWand -embed_wand => <-. Qed. Global Instance from_impl_embed P Q1 Q2 : FromImpl P Q1 Q2 → FromImpl ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤. Proof. by rewrite /FromImpl -embed_impl => <-. Qed. Global Instance from_and_embed P Q1 Q2 : FromAnd P Q1 Q2 → FromAnd ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤. Proof. by rewrite /FromAnd -embed_and => <-. Qed. Global Instance from_sep_embed P Q1 Q2 : FromSep P Q1 Q2 → FromSep ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤. Proof. by rewrite /FromSep -embed_sep => <-. Qed. Global Instance maybe_combine_sep_as_embed Q1 Q2 P progress : MaybeCombineSepAs Q1 Q2 P progress → MaybeCombineSepAs ⎡Q1⎤ ⎡Q2⎤ ⎡P⎤ progress. Proof. by rewrite /MaybeCombineSepAs -embed_sep => <-. Qed. Global Instance combine_sep_gives_embed Q1 Q2 P : CombineSepGives Q1 Q2 P → CombineSepGives ⎡Q1⎤ ⎡Q2⎤ ⎡P⎤. Proof. by rewrite /CombineSepGives -embed_sep -embed_persistently => ->. Qed. Global Instance into_and_embed p P Q1 Q2 : IntoAnd p P Q1 Q2 → IntoAnd p ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤. Proof. rewrite /IntoAnd -embed_and=> HP. apply intuitionistically_if_intro'. by rewrite embed_intuitionistically_if_2 HP intuitionistically_if_elim. Qed. Global Instance into_sep_embed P Q1 Q2 : IntoSep P Q1 Q2 → IntoSep ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤. Proof. rewrite /IntoSep -embed_sep=> -> //. Qed. Global Instance from_or_embed P Q1 Q2 : FromOr P Q1 Q2 → FromOr ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤. Proof. by rewrite /FromOr -embed_or => <-. Qed. Global Instance into_or_embed P Q1 Q2 : IntoOr P Q1 Q2 → IntoOr ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤. Proof. by rewrite /IntoOr -embed_or => <-. Qed. Global Instance from_exist_embed {A} P (Φ : A → PROP) : FromExist P Φ → FromExist ⎡P⎤ (λ a, ⎡Φ a⎤%I). Proof. by rewrite /FromExist -embed_exist => <-. Qed. Global Instance into_exist_embed {A} P (Φ : A → PROP) name : IntoExist P Φ name → IntoExist ⎡P⎤ (λ a, ⎡Φ a⎤%I) name. Proof. by rewrite /IntoExist -embed_exist => <-. Qed. Global Instance into_forall_embed {A} P (Φ : A → PROP) : IntoForall P Φ → IntoForall ⎡P⎤ (λ a, ⎡Φ a⎤%I). Proof. by rewrite /IntoForall -embed_forall => <-. Qed. Global Instance from_forall_embed {A} P (Φ : A → PROP) name : FromForall P Φ name → FromForall ⎡P⎤ (λ a, ⎡Φ a⎤%I) name. Proof. by rewrite /FromForall -embed_forall => <-. Qed. Global Instance into_inv_embed P N : IntoInv P N → IntoInv ⎡P⎤ N := {}. Global Instance is_except_0_embed `{!BiEmbedLater PROP PROP'} P : IsExcept0 P → IsExcept0 ⎡P⎤. Proof. by rewrite /IsExcept0 -embed_except_0=>->. Qed. Global Instance from_modal_later_embed `{!BiEmbedLater PROP PROP'} φ `(sel : A) n P Q : FromModal φ (modality_laterN n) sel P Q → FromModal φ (modality_laterN n) sel ⎡P⎤ ⎡Q⎤. Proof. rewrite /FromModal /= =>HPQ ?. by rewrite -HPQ // embed_laterN. Qed. Global Instance from_modal_plainly_embed `{!BiPlainly PROP, !BiPlainly PROP', !BiEmbedPlainly PROP PROP'} φ `(sel : A) P Q : FromModal φ modality_plainly sel P Q → FromModal φ (PROP2:=PROP') modality_plainly sel ⎡P⎤ ⎡Q⎤ | 100. Proof. rewrite /FromModal /= =>HPQ ?. by rewrite -HPQ // embed_plainly. Qed. Global Instance into_internal_eq_embed `{!BiInternalEq PROP, !BiInternalEq PROP', !BiEmbedInternalEq PROP PROP'} {A : ofe} (x y : A) (P : PROP) : IntoInternalEq P x y → IntoInternalEq (⎡P⎤ : PROP')%I x y. Proof. rewrite /IntoInternalEq=> ->. by rewrite embed_internal_eq. Qed. Global Instance into_except_0_embed `{!BiEmbedLater PROP PROP'} P Q : IntoExcept0 P Q → IntoExcept0 ⎡P⎤ ⎡Q⎤. Proof. rewrite /IntoExcept0=> ->. by rewrite embed_except_0. Qed. Global Instance elim_modal_embed_bupd_goal `{!BiBUpd PROP, !BiBUpd PROP', !BiEmbedBUpd PROP PROP'} p p' φ (P P' : PROP') (Q Q' : PROP) : ElimModal φ p p' P P' (|==> ⎡Q⎤)%I (|==> ⎡Q'⎤)%I → ElimModal φ p p' P P' ⎡|==> Q⎤ ⎡|==> Q'⎤. Proof. by rewrite /ElimModal !embed_bupd. Qed. Global Instance elim_modal_embed_bupd_hyp `{!BiBUpd PROP, !BiBUpd PROP', !BiEmbedBUpd PROP PROP'} p p' φ (P : PROP) (P' Q Q' : PROP') : ElimModal φ p p' (|==> ⎡P⎤)%I P' Q Q' → ElimModal φ p p' ⎡|==> P⎤ P' Q Q'. Proof. by rewrite /ElimModal !embed_bupd. Qed. Global Instance elim_modal_embed_fupd_goal `{!BiFUpd PROP, !BiFUpd PROP', !BiEmbedFUpd PROP PROP'} p p' φ E1 E2 E3 (P P' : PROP') (Q Q' : PROP) : ElimModal φ p p' P P' (|={E1,E3}=> ⎡Q⎤)%I (|={E2,E3}=> ⎡Q'⎤)%I → ElimModal φ p p' P P' ⎡|={E1,E3}=> Q⎤ ⎡|={E2,E3}=> Q'⎤. Proof. by rewrite /ElimModal !embed_fupd. Qed. Global Instance elim_modal_embed_fupd_hyp `{!BiFUpd PROP, !BiFUpd PROP', !BiEmbedFUpd PROP PROP'} p p' φ E1 E2 (P : PROP) (P' Q Q' : PROP') : ElimModal φ p p' (|={E1,E2}=> ⎡P⎤)%I P' Q Q' → ElimModal φ p p' ⎡|={E1,E2}=> P⎤ P' Q Q'. Proof. by rewrite /ElimModal embed_fupd. Qed. Global Instance add_modal_embed_bupd_goal `{!BiBUpd PROP, !BiBUpd PROP', !BiEmbedBUpd PROP PROP'} (P P' : PROP') (Q : PROP) : AddModal P P' (|==> ⎡Q⎤)%I → AddModal P P' ⎡|==> Q⎤. Proof. by rewrite /AddModal !embed_bupd. Qed. Global Instance add_modal_embed_fupd_goal `{!BiFUpd PROP, !BiFUpd PROP', !BiEmbedFUpd PROP PROP'} E1 E2 (P P' : PROP') (Q : PROP) : AddModal P P' (|={E1,E2}=> ⎡Q⎤)%I → AddModal P P' ⎡|={E1,E2}=> Q⎤. Proof. by rewrite /AddModal !embed_fupd. Qed. Global Instance into_embed_embed P : IntoEmbed ⎡P⎤ P. Proof. by rewrite /IntoEmbed. Qed. Global Instance into_embed_affinely `{!BiBUpd PROP, !BiBUpd PROP', !BiEmbedBUpd PROP PROP'} (P : PROP') (Q : PROP) : IntoEmbed P Q → IntoEmbed ( P) ( Q). Proof. rewrite /IntoEmbed=> ->. by rewrite embed_affinely_2. Qed. Global Instance into_later_embed `{!BiEmbedLater PROP PROP'} n P Q : IntoLaterN false n P Q → IntoLaterN false n ⎡P⎤ ⎡Q⎤. Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite embed_laterN. Qed. End class_instances_embedding. iris-iris-4.2.0/iris/proofmode/class_instances_frame.v000066400000000000000000000524731460620107300231160ustar00rootroot00000000000000From iris.bi Require Import telescopes. From iris.proofmode Require Import classes classes_make. From iris.prelude Require Import options. Import bi. (** This file defines the instances that make up the framing machinery. *) Section class_instances_frame. Context {PROP : bi}. Implicit Types P Q R : PROP. (** When framing [R] against itself, we leave [True] if possible (via [frame_here_absorbing] or [frame_affinely_here_absorbing]) since it is a weaker goal. Otherwise we leave [emp] via [frame_here]. Only if all those options fail, we start decomposing [R], via instances like [frame_exist]. To ensure that, all other instances must have cost > 1. *) Global Instance frame_here_absorbing p R : QuickAbsorbing R → Frame p R R True | 0. Proof. rewrite /QuickAbsorbing /Frame. intros. by rewrite intuitionistically_if_elim sep_elim_l. Qed. Global Instance frame_here p R : Frame p R R emp | 1. Proof. intros. by rewrite /Frame intuitionistically_if_elim sep_elim_l. Qed. Global Instance frame_affinely_here_absorbing p R : QuickAbsorbing R → Frame p ( R) R True | 0. Proof. rewrite /QuickAbsorbing /Frame. intros. rewrite intuitionistically_if_elim affinely_elim. apply sep_elim_l, _. Qed. Global Instance frame_affinely_here p R : Frame p ( R) R emp | 1. Proof. intros. rewrite /Frame intuitionistically_if_elim affinely_elim. apply sep_elim_l, _. Qed. Global Instance frame_here_pure_persistent a φ Q : FromPure a Q φ → Frame true ⌜φ⌝ Q emp | 2. Proof. rewrite /FromPure /Frame /= => <-. rewrite right_id. by rewrite -affinely_affinely_if intuitionistically_affinely. Qed. Global Instance frame_here_pure a φ Q : FromPure a Q φ → TCOr (TCEq a false) (BiAffine PROP) → Frame false ⌜φ⌝ Q emp | 2. (* Same cost as default. *) Proof. rewrite /FromPure /Frame => <- [->|?] /=. - by rewrite right_id. - by rewrite right_id -affinely_affinely_if affine_affinely. Qed. Global Instance frame_embed `{!BiEmbed PROP PROP'} p P Q (Q' : PROP') R : Frame p R P Q → MakeEmbed Q Q' → Frame p ⎡R⎤ ⎡P⎤ Q' | 2. (* Same cost as default. *) Proof. rewrite /Frame /MakeEmbed => <- <-. rewrite embed_sep embed_intuitionistically_if_2 => //. Qed. Global Instance frame_pure_embed `{!BiEmbed PROP PROP'} p P Q (Q' : PROP') φ : Frame p ⌜φ⌝ P Q → MakeEmbed Q Q' → Frame p ⌜φ⌝ ⎡P⎤ Q' | 2. (* Same cost as default. *) Proof. rewrite /Frame /MakeEmbed -embed_pure. apply (frame_embed p P Q). Qed. Global Instance frame_sep_persistent_l progress R P1 P2 Q1 Q2 Q' : Frame true R P1 Q1 → MaybeFrame true R P2 Q2 progress → MakeSep Q1 Q2 Q' → Frame true R (P1 ∗ P2) Q' | 9. Proof. rewrite /Frame /MaybeFrame' /MakeSep /= => <- [<-] <-. rewrite {1}(intuitionistically_sep_dup R). by rewrite !assoc -(assoc _ _ _ Q1) -(comm _ Q1) assoc -(comm _ Q1). Qed. Global Instance frame_sep_l R P1 P2 Q Q' : Frame false R P1 Q → MakeSep Q P2 Q' → Frame false R (P1 ∗ P2) Q' | 9. Proof. rewrite /Frame /MakeSep => <- <-. by rewrite assoc. Qed. Global Instance frame_sep_r p R P1 P2 Q Q' : Frame p R P2 Q → MakeSep P1 Q Q' → Frame p R (P1 ∗ P2) Q' | 10. Proof. rewrite /Frame /MakeSep => <- <-. by rewrite assoc -(comm _ P1) assoc. Qed. Global Instance frame_big_sepL_cons {A} p (Φ : nat → A → PROP) R Q l x l' : IsCons l x l' → Frame p R (Φ 0 x ∗ [∗ list] k ↦ y ∈ l', Φ (S k) y) Q → Frame p R ([∗ list] k ↦ y ∈ l, Φ k y) Q | 2. (* Same cost as default. *) Proof. rewrite /IsCons=>->. by rewrite /Frame big_sepL_cons. Qed. Global Instance frame_big_sepL_app {A} p (Φ : nat → A → PROP) R Q l l1 l2 : IsApp l l1 l2 → Frame p R (([∗ list] k ↦ y ∈ l1, Φ k y) ∗ [∗ list] k ↦ y ∈ l2, Φ (length l1 + k) y) Q → Frame p R ([∗ list] k ↦ y ∈ l, Φ k y) Q | 2. (* Same cost as default. *) Proof. rewrite /IsApp=>->. by rewrite /Frame big_sepL_app. Qed. Global Instance frame_big_sepL2_cons {A B} p (Φ : nat → A → B → PROP) R Q l1 x1 l1' l2 x2 l2' : IsCons l1 x1 l1' → IsCons l2 x2 l2' → Frame p R (Φ 0 x1 x2 ∗ [∗ list] k ↦ y1;y2 ∈ l1';l2', Φ (S k) y1 y2) Q → Frame p R ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2) Q. (* Default cost > 1. *) Proof. rewrite /IsCons=>-> ->. by rewrite /Frame big_sepL2_cons. Qed. Global Instance frame_big_sepL2_app {A B} p (Φ : nat → A → B → PROP) R Q l1 l1' l1'' l2 l2' l2'' : IsApp l1 l1' l1'' → IsApp l2 l2' l2'' → Frame p R (([∗ list] k ↦ y1;y2 ∈ l1';l2', Φ k y1 y2) ∗ [∗ list] k ↦ y1;y2 ∈ l1'';l2'', Φ (length l1' + k) y1 y2) Q → Frame p R ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2) Q. Proof. rewrite /IsApp /Frame=>-> -> ->. apply wand_elim_l', big_sepL2_app. Qed. Global Instance frame_big_sepMS_disj_union `{Countable A} p (Φ : A → PROP) R Q X X1 X2 : IsDisjUnion X X1 X2 -> Frame p R (([∗ mset] y ∈ X1, Φ y) ∗ [∗ mset] y ∈ X2, Φ y) Q → Frame p R ([∗ mset] y ∈ X, Φ y) Q | 2. Proof. rewrite /IsDisjUnion=>->. by rewrite /Frame big_sepMS_disj_union. Qed. (** The instances that allow framing under [∨] and [∧] need to be carefully constructed. Such instances should make progress on at least one, but possibly _both_ sides of the connective---unlike [∗], where we want to make progress on exactly one side. Naive implementations of this idea can cause Coq to do multiple searches for [Frame] instances of the subterms. For terms with nested [∧]s or [∨]s, this can cause an exponential blowup in the time it takes for Coq to _fail_ to construct a [Frame] instance. This happens especially when the resource we are framing in contains evars, since Coq's typeclass search does more backtracking in this case. To combat this, the [∧] and [∨] instances use [MaybeFrame] classes--- a notation for [MaybeFrame'] guarded by a [TCNoBackTrack]. The [MaybeFrame] clauses for the subterms output a boolean [progress] indicator, on which some condition is posed. The [TCNoBackTrack] ensures that when this condition is not met, Coq will not backtrack on the [MaybeFrame] clauses to consider different [progress]es. *) (* For framing below [∧], we can frame [R] away in *both* conjuncts (unlike with [∗] where we can only frame it in one conjunct). We require at least one of those to make progress though. *) Global Instance frame_and p progress1 progress2 R P1 P2 Q1 Q2 Q' : MaybeFrame p R P1 Q1 progress1 → MaybeFrame p R P2 Q2 progress2 → (** If below [TCEq] fails, the [frame_and] instance is immediately abandoned: the [TCNoBackTrack]s above prevent Coq from considering other ways to construct [MaybeFrame] instances. *) TCEq (progress1 || progress2) true → MakeAnd Q1 Q2 Q' → Frame p R (P1 ∧ P2) Q' | 9. Proof. rewrite /MaybeFrame' /Frame /MakeAnd => [[<-]] [<-] _ <-. apply and_intro; [rewrite and_elim_l|rewrite and_elim_r]; done. Qed. (** We could in principle write the instance [frame_or_spatial] by a bunch of instances (omitting the parameter [p = false]): Frame R P1 Q1 → Frame R P2 Q2 → Frame R (P1 ∨ P2) (Q1 ∨ Q2) Frame R P1 True → Frame R (P1 ∨ P2) P2 Frame R P2 True → Frame R (P1 ∨ P2) P1 The problem here is that Coq will try to infer [Frame R P1 ?] and [Frame R P2 ?] multiple times, whereas the current solution makes sure that said inference appears at most once. If Coq would memorize the results of type class resolution, the solution with multiple instances would be preferred (and more Prolog-like). *) (** Framing a spatial resource [R] under [∨] is done only when: - [R] can be framed on both sides of the [∨]; or - [R] completely solves one side of the [∨], reducing it to [True]. This instance does _not_ framing spatial resources when they can be framed in exactly one side, since that can make your goal unprovable. *) Global Instance frame_or_spatial progress1 progress2 R P1 P2 Q1 Q2 Q : MaybeFrame false R P1 Q1 progress1 → MaybeFrame false R P2 Q2 progress2 → (** Below [TCOr] encodes the condition described above. If this condition cannot be satisfied, the [frame_or_spatial] instance is immediately abandoned: the [TCNoBackTrack]s present in the [MaybeFrame] notation prevent Coq from considering other ways to construct [MaybeFrame'] instances. *) TCOr (TCEq (progress1 && progress2) true) (TCOr (TCAnd (TCEq progress1 true) (TCEq Q1 True%I)) (TCAnd (TCEq progress2 true) (TCEq Q2 True%I))) → MakeOr Q1 Q2 Q → Frame false R (P1 ∨ P2) Q | 9. Proof. rewrite /Frame /MakeOr => [[<-]] [<-] _ <-. by rewrite -sep_or_l. Qed. (** Framing a persistent resource [R] under [∨] is done when [R] can be framed on _at least_ one side. This does not affect provability of your goal, since you can keep the resource after framing. *) Global Instance frame_or_persistent progress1 progress2 R P1 P2 Q1 Q2 Q : MaybeFrame true R P1 Q1 progress1 → MaybeFrame true R P2 Q2 progress2 → (** If below [TCEq] fails, the [frame_or_persistent] instance is immediately abandoned: the [TCNoBackTrack]s present in the [MaybeFrame] notation prevent Coq from considering other ways to construct [MaybeFrame'] instances. *) TCEq (progress1 || progress2) true → MakeOr Q1 Q2 Q → Frame true R (P1 ∨ P2) Q | 9. Proof. rewrite /Frame /MakeOr => [[<-]] [<-] _ <-. by rewrite -sep_or_l. Qed. Global Instance frame_wand p R P1 P2 Q2 : (FrameInstantiateExistDisabled → Frame p R P2 Q2) → Frame p R (P1 -∗ P2) (P1 -∗ Q2) | 2. Proof. rewrite /Frame=> /(_ ltac:(constructor)) ?. apply wand_intro_l. by rewrite assoc (comm _ P1) -assoc wand_elim_r. Qed. Global Instance frame_affinely p R P Q Q' : TCOr (TCEq p true) (QuickAffine R) → Frame p R P Q → MakeAffinely Q Q' → Frame p R ( P) Q'. (* Default cost > 1 *) Proof. rewrite /QuickAffine /Frame /MakeAffinely=> -[->|?] <- <- /=; by rewrite -{1}(affine_affinely (_ R)) affinely_sep_2. Qed. Global Instance frame_intuitionistically R P Q Q' : Frame true R P Q → MakeIntuitionistically Q Q' → Frame true R (□ P) Q' | 2. (* Same cost as default. *) Proof. rewrite /Frame /MakeIntuitionistically=> <- <- /=. rewrite -intuitionistically_sep_2 intuitionistically_idemp //. Qed. Global Instance frame_absorbingly p R P Q Q' : Frame p R P Q → MakeAbsorbingly Q Q' → Frame p R ( P) Q' | 2. (* Same cost as default. *) Proof. rewrite /Frame /MakeAbsorbingly=> <- <- /=. by rewrite absorbingly_sep_r. Qed. Global Instance frame_persistently R P Q Q' : Frame true R P Q → MakePersistently Q Q' → Frame true R ( P) Q' | 2. (* Same cost as default. *) Proof. rewrite /Frame /MakePersistently=> <- <- /=. rewrite -persistently_and_intuitionistically_sep_l. by rewrite -persistently_sep_2 -persistently_and_sep_l_1 persistently_affinely_elim persistently_idemp. Qed. (** We construct an instance for [Frame]ing under existentials that can both instantiate the existential and leave it untouched: - If we have [H : P a] and goal [∃ b, P b ∗ Q b], framing [H] turns the goal into [Q a], i.e., instantiates the existential. - If we have [H : P] and goal [∃ b, P ∗ Q b], framing [H] turns the goal into [∃ b, Q b], i.e., leaves the existential untouched. Below we describe the instances. More information can be found in the paper https://doi.org/10.1145/3636501.3636950 The general lemma is: *) Local Lemma frame_exist_helper {A} p R (Φ : A → PROP) {C} (g : C → A) (Ψ : C → PROP) : (∀ c, Frame p R (Φ $ g c) (Ψ c)) → Frame p R (∃ a, Φ a) (∃ c, Ψ c). Proof. rewrite /Frame=> HΨ. rewrite sep_exist_l. apply bi.exist_elim=> c. rewrite HΨ. apply exist_intro. Qed. (** [frame_exist_helper] captures the two common usecases: - To instantiate the existential with witness [a], take [C = unit] and use [g = λ _, a]. - To keep the existential quantification untouched, take [C = A] and [g = id] Note that having separate instances for these two cases is a bad idea: typeclass search for [n] existential quantifiers would have [2^n] possibilities! We cannot use [frame_exist] directly in type class search. One reason is that we do not want to present the user with a useless existential quantification on [unit]. This means we want to replace [∃ c, Φ c] with the telescopic quantification [∃.. c, Φ c]. Another reason is that [frame_exist] does not indicate how [C] and [g] should be inferred, so type class search would simply fail. We want to infer these as follows. On a goal [Frame p R (∃ a, Φ a) _]: - We first run type class search on [Frame p R (Φ ?a) _]. If an instance is found, [?a] is a term that might still contain evars. The idea is to turn these evars back into existential quantifiers, whenever that is possible. - To do so, choose [C] to be the telescope with types for each of the evars in [?a]. - This means [c : C] is (morally) a tuple with an element for each of the evars in [?a]---so we can unify all evars to be a projection of [c]. - After this unification, [?a] is an explicit function of [c], which means we have found [g]. *) (** To perform above inference, we introduce a separate equality type class. *) Inductive GatherEvarsEq {A} (x : A) : A → Prop := GatherEvarsEq_refl : GatherEvarsEq x x. Existing Class GatherEvarsEq. (** The goal [GatherEvarsEq a (?g c)] with [a : A] and [g : ?C → A] is solved in the way described above. This is done by tactic [solve_gather_evars_eq], given at the end of this section, with an accompanying [Hint Extern]. *) (** We are now able to state a lemma for building [Frame] instances directly: [Lemma frame_exist_slow {A} p R (Φ : A → PROP) (TT : tele) (g : TT → A) (Ψ : TT → PROP) : (∀ c, ∃ a' G, Frame p R (Φ a') G ∧ GatherEvarsEq a' (g c) ∧ TCEq G (Ψ c)) → Frame p R (∃ a, Φ a) (∃.. c, Ψ c)%I.] Although this would function as intended, the two inner [ex] and [conj]s repeat terms in the implicit arguments; in particular, they repeat the quantified goal [Φ] a bunch of times. This means the term size can get quite big, and make type checking slower than need. We therefore make an effort to reduce term size and type-checking time by creating a tailored [Class], which furthermore can be solved automatically by type class search. *) #[projections(primitive)] Class FrameExistRequirements (p : bool) (R : PROP) {A} (Φ : A → PROP) (a' : A) (G' : PROP) := { frame_exist_witness : A; frame_exist_resource : PROP; frame_exist_proof : Frame p R (Φ frame_exist_witness) frame_exist_resource; frame_exist_witness_eq : GatherEvarsEq frame_exist_witness a'; frame_exist_resource_eq : TCEq frame_exist_resource G' }. Global Existing Instance Build_FrameExistRequirements. (* This class is used so that we can [cbn] away the [bi_texist] in the result of framing. This is done by the [Hint Extern] at the bottom of the file. *) Inductive TCCbnTele {A} (x : A) : A → Prop := TCCbnTele_refl : TCCbnTele x x. Existing Class TCCbnTele. Global Hint Mode TCCbnTele ! - - : typeclass_instances. (* We include a dependency on [FrameInstantiateExistEnabled] so as to disable this instance when framing beneath [∀], [-∗] and [→] *) Global Instance frame_exist {A} p R (Φ : A → PROP) (TT : tele) (g : TT → A) (Ψ : TT → PROP) Q : FrameInstantiateExistEnabled → (∀ c, FrameExistRequirements p R Φ (g c) (Ψ c)) → TCCbnTele (∃.. c, Ψ c)%I Q → Frame p R (∃ a, Φ a) Q. Proof. move=> _ H <-. rewrite /Frame bi_texist_exist. eapply frame_exist_helper=> c. by specialize (H c) as [a G HG -> ->]. Qed. (* If [FrameInstantiateExistDisabled] holds we are not allowed to instantiate existentials, so we just frame below the quantifier without instantiating anything. *) Global Instance frame_exist_no_instantiate {A} p R (Φ Ψ : A → PROP) : FrameInstantiateExistDisabled → (∀ a, Frame p R (Φ a) (Ψ a)) → Frame p R (∃ a, Φ a) (∃ a, Ψ a). Proof. move=> _ H. eapply frame_exist_helper, H. Qed. Global Instance frame_texist {TT : tele} p R (Φ Ψ : TT → PROP) : (∀ x, Frame p R (Φ x) (Ψ x)) → Frame p R (∃.. x, Φ x) (∃.. x, Ψ x) | 2. Proof. rewrite /Frame !bi_texist_exist. apply frame_exist_helper. Qed. Global Instance frame_forall {A} p R (Φ Ψ : A → PROP) : (FrameInstantiateExistDisabled → ∀ a, Frame p R (Φ a) (Ψ a)) → Frame p R (∀ x, Φ x) (∀ x, Ψ x) | 2. Proof. rewrite /Frame=> /(_ ltac:(constructor)) ?. by rewrite sep_forall_l; apply forall_mono. Qed. Global Instance frame_tforall {TT : tele} p R (Φ Ψ : TT → PROP) : (FrameInstantiateExistDisabled → (∀ x, Frame p R (Φ x) (Ψ x))) → Frame p R (∀.. x, Φ x) (∀.. x, Ψ x) | 2. Proof. rewrite /Frame !bi_tforall_forall. apply frame_forall. Qed. Global Instance frame_impl_persistent R P1 P2 Q2 : (FrameInstantiateExistDisabled → Frame true R P2 Q2) → Frame true R (P1 → P2) (P1 → Q2) | 2. Proof. rewrite /Frame /= => /(_ ltac:(constructor)) ?. apply impl_intro_l. by rewrite -persistently_and_intuitionistically_sep_l assoc (comm _ P1) -assoc impl_elim_r persistently_and_intuitionistically_sep_l. Qed. (** You may wonder why this uses [Persistent] and not [QuickPersistent]. The reason is that [QuickPersistent] is not needed anywhere else, and even without [QuickPersistent], this instance avoids quadratic complexity: we usually use the [Quick*] classes to not traverse the same term over and over again, but here [P1] is encountered at most once. It is hence not worth adding a new typeclass just for this extremely rarely used instance. *) Global Instance frame_impl R P1 P2 Q2 : Persistent P1 → QuickAbsorbing P1 → (FrameInstantiateExistDisabled → Frame false R P2 Q2) → Frame false R (P1 → P2) (P1 → Q2). (* Default cost > 1 *) Proof. rewrite /Frame /QuickAbsorbing /==> ?? /(_ ltac:(constructor)) ?. apply impl_intro_l. rewrite {1}(persistent P1) persistently_and_intuitionistically_sep_l assoc. rewrite (comm _ (□ P1)%I) -assoc -persistently_and_intuitionistically_sep_l. rewrite persistently_elim impl_elim_r //. Qed. Global Instance frame_eq_embed `{!BiEmbed PROP PROP', !BiInternalEq PROP, !BiInternalEq PROP', !BiEmbedInternalEq PROP PROP'} p P Q (Q' : PROP') {A : ofe} (a b : A) : Frame p (a ≡ b) P Q → MakeEmbed Q Q' → Frame p (a ≡ b) ⎡P⎤ Q'. (* Default cost > 1 *) Proof. rewrite /Frame /MakeEmbed -embed_internal_eq. apply (frame_embed p P Q). Qed. Global Instance frame_later p R R' P Q Q' : TCNoBackTrack (MaybeIntoLaterN true 1 R' R) → Frame p R P Q → MakeLaterN 1 Q Q' → Frame p R' (▷ P) Q'. (* Default cost > 1 *) Proof. rewrite /Frame /MakeLaterN /MaybeIntoLaterN=>-[->] <- <-. by rewrite later_intuitionistically_if_2 later_sep. Qed. Global Instance frame_laterN p n R R' P Q Q' : TCNoBackTrack (MaybeIntoLaterN true n R' R) → Frame p R P Q → MakeLaterN n Q Q' → Frame p R' (▷^n P) Q'. (* Default cost > 1 *) Proof. rewrite /Frame /MakeLaterN /MaybeIntoLaterN=>-[->] <- <-. by rewrite laterN_intuitionistically_if_2 laterN_sep. Qed. Global Instance frame_bupd `{!BiBUpd PROP} p R P Q : Frame p R P Q → Frame p R (|==> P) (|==> Q) | 2. Proof. rewrite /Frame=><-. by rewrite bupd_frame_l. Qed. Global Instance frame_fupd `{!BiFUpd PROP} p E1 E2 R P Q : Frame p R P Q → Frame p R (|={E1,E2}=> P) (|={E1,E2}=> Q) | 2. Proof. rewrite /Frame=><-. by rewrite fupd_frame_l. Qed. Global Instance frame_except_0 p R P Q Q' : Frame p R P Q → MakeExcept0 Q Q' → Frame p R (◇ P) Q' | 2. (* Same cost as default *) Proof. rewrite /Frame /MakeExcept0=><- <-. by rewrite except_0_sep -(except_0_intro (□?p R)). Qed. End class_instances_frame. (** We now write the tactic for constructing [GatherEvarsEq] instances. We want to prove goals of shape [GatherEvarsEq a (?g c)] with [a : A], and [g : ?C → A]. We need to infer both the function [g] and [C : tele].*) Ltac solve_gather_evars_eq := lazymatch goal with | |- GatherEvarsEq ?a (?g ?c) => let rec retcon_tele T arg := (* [retcon_tele] takes two arguments: - [T], an evar that has type [tele] - [arg], a term that has type [tele_arg T] (recall that [tele_arg] is the [tele → Type] coercion) [retcon_tele] will find all the evars occurring in [a], and unify [T] to be the telescope with types for all these evars. These evars will be unified with projections of [arg]. In effect, it ensures 'retro-active continuity', namely that the telescope [T] was appropriately chosen all along. *) match a with | context [?term] => is_evar term; let X := type of term in lazymatch X with | tele => fail (* Shortcircuit, since nesting telescopes is a bad idea *) | _ => idtac end; let T' := open_constr:(_) in (* creates a new evar *) unify T (TeleS (λ _ : X, T')); (* The evar telescope [T'] is used for any remaining evars *) unify term (tele_arg_head (λ _ : X, T') arg); (* [tele_arg_head] is the first projection of [arg] *) retcon_tele T' (tele_arg_tail (λ _ : X, T') arg) (* recurse with the tail projection of [arg] *) | _ => (* no more evars: unify [T] with the empty telescope *) unify T TeleO end in let T' := lazymatch (type of c) with tele_arg ?T => T end in retcon_tele T' c; exact (GatherEvarsEq_refl _) end. Global Hint Extern 0 (GatherEvarsEq _ _) => solve_gather_evars_eq : typeclass_instances. Global Hint Extern 0 (TCCbnTele _ _) => cbn [bi_texist tele_fold tele_bind tele_arg_head tele_arg_tail]; exact (TCCbnTele_refl _) : typeclass_instances. iris-iris-4.2.0/iris/proofmode/class_instances_internal_eq.v000066400000000000000000000064441460620107300243220ustar00rootroot00000000000000From stdpp Require Import nat_cancel. From iris.proofmode Require Import modality_instances classes. From iris.prelude Require Import options. Import bi. Section class_instances_internal_eq. Context `{!BiInternalEq PROP}. Implicit Types P Q R : PROP. (* When a user calls [iPureIntro] on [⊢ a ≡ b], the following instance turns turns this into the pure goal [a ≡ b : Prop]. If [a, b : A] with [LeibnizEquiv A], another candidate would be [a = b]. While this does not lead to information loss, [=] is harder to prove than [≡]. We thus leave such simplifications to the user (e.g. they can call [fold_leibniz]). *) Global Instance from_pure_internal_eq {A : ofe} (a b : A) : @FromPure PROP false (a ≡ b) (a ≡ b). Proof. by rewrite /FromPure pure_internal_eq. Qed. (* On the other hand, when a user calls [iIntros "%H"] on [⊢ (a ≡ b) -∗ P], it is most convenient if [H] is as strong as possible---meaning, the user would rather get [H : a = b] than [H : a ≡ b]. This is only possible if the equivalence on [A] implies Leibniz equality (i.e., we have [LeibnizEquiv A]). If the equivalence on [A] does not imply Leibniz equality, we cannot simplify [a ≡ b] any further. The following instance implements above logic, while avoiding a double search for [Discrete a]. *) Global Instance into_pure_eq {A : ofe} (a b : A) (P : Prop) : Discrete a → TCOr (TCAnd (LeibnizEquiv A) (TCEq P (a = b))) (TCEq P (a ≡ b)) → @IntoPure PROP (a ≡ b) P. Proof. move=> ? [[? ->]|->]; rewrite /IntoPure discrete_eq; last done. by rewrite leibniz_equiv_iff. Qed. Global Instance from_modal_Next {A : ofe} (x y : A) : FromModal (PROP1:=PROP) (PROP2:=PROP) True (modality_laterN 1) (▷^1 (x ≡ y) : PROP)%I (Next x ≡ Next y) (x ≡ y). Proof. by rewrite /FromModal /= later_equivI. Qed. Global Instance into_laterN_Next {A : ofe} only_head n n' (x y : A) : NatCancel n 1 n' 0 → IntoLaterN (PROP:=PROP) only_head n (Next x ≡ Next y) (x ≡ y) | 2. Proof. rewrite /IntoLaterN /MaybeIntoLaterN /NatCancel Nat.add_0_r. move=> <-. rewrite later_equivI. by rewrite Nat.add_comm /= -laterN_intro. Qed. Global Instance into_internal_eq_internal_eq {A : ofe} (x y : A) : @IntoInternalEq PROP _ A (x ≡ y) x y. Proof. by rewrite /IntoInternalEq. Qed. Global Instance into_internal_eq_affinely {A : ofe} (x y : A) P : IntoInternalEq P x y → IntoInternalEq ( P) x y. Proof. rewrite /IntoInternalEq=> ->. by rewrite affinely_elim. Qed. Global Instance into_internal_eq_intuitionistically {A : ofe} (x y : A) P : IntoInternalEq P x y → IntoInternalEq (□ P) x y. Proof. rewrite /IntoInternalEq=> ->. by rewrite intuitionistically_elim. Qed. Global Instance into_internal_eq_absorbingly {A : ofe} (x y : A) P : IntoInternalEq P x y → IntoInternalEq ( P) x y. Proof. rewrite /IntoInternalEq=> ->. by rewrite absorbingly_internal_eq. Qed. Global Instance into_internal_eq_plainly `{!BiPlainly PROP} {A : ofe} (x y : A) P : IntoInternalEq P x y → IntoInternalEq (■ P) x y. Proof. rewrite /IntoInternalEq=> ->. by rewrite plainly_elim. Qed. Global Instance into_internal_eq_persistently {A : ofe} (x y : A) P : IntoInternalEq P x y → IntoInternalEq ( P) x y. Proof. rewrite /IntoInternalEq=> ->. by rewrite persistently_elim. Qed. End class_instances_internal_eq. iris-iris-4.2.0/iris/proofmode/class_instances_later.v000066400000000000000000000464331460620107300231320ustar00rootroot00000000000000From stdpp Require Import nat_cancel. From iris.proofmode Require Import classes classes_make modality_instances. From iris.prelude Require Import options. Import bi. Section class_instances_later. Context {PROP : bi}. Implicit Types P Q R : PROP. (** FromAssumption *) Global Instance from_assumption_later p P Q : FromAssumption p P Q → KnownRFromAssumption p P (▷ Q). Proof. rewrite /KnownRFromAssumption /FromAssumption=>->. apply later_intro. Qed. Global Instance from_assumption_laterN n p P Q : FromAssumption p P Q → KnownRFromAssumption p P (▷^n Q). Proof. rewrite /KnownRFromAssumption /FromAssumption=>->. apply laterN_intro. Qed. Global Instance from_assumption_except_0 p P Q : FromAssumption p P Q → KnownRFromAssumption p P (◇ Q). Proof. rewrite /KnownRFromAssumption /FromAssumption=>->. apply except_0_intro. Qed. (** FromPure *) Global Instance from_pure_later a P φ : FromPure a P φ → FromPure a (▷ P) φ. Proof. rewrite /FromPure=> ->. apply later_intro. Qed. Global Instance from_pure_laterN a n P φ : FromPure a P φ → FromPure a (▷^n P) φ. Proof. rewrite /FromPure=> ->. apply laterN_intro. Qed. Global Instance from_pure_except_0 a P φ : FromPure a P φ → FromPure a (◇ P) φ. Proof. rewrite /FromPure=> ->. apply except_0_intro. Qed. (** IntoWand *) Global Instance into_wand_later p q R P Q : IntoWand p q R P Q → IntoWand p q (▷ R) (▷ P) (▷ Q). Proof. rewrite /IntoWand /= => HR. by rewrite !later_intuitionistically_if_2 -later_wand HR. Qed. Global Instance into_wand_later_args p q R P Q : IntoWand p q R P Q → IntoWand' p q R (▷ P) (▷ Q). Proof. rewrite /IntoWand' /IntoWand /= => HR. by rewrite !later_intuitionistically_if_2 (later_intro (□?p R)) -later_wand HR. Qed. Global Instance into_wand_laterN n p q R P Q : IntoWand p q R P Q → IntoWand p q (▷^n R) (▷^n P) (▷^n Q). Proof. rewrite /IntoWand /= => HR. by rewrite !laterN_intuitionistically_if_2 -laterN_wand HR. Qed. Global Instance into_wand_laterN_args n p q R P Q : IntoWand p q R P Q → IntoWand' p q R (▷^n P) (▷^n Q). Proof. rewrite /IntoWand' /IntoWand /= => HR. by rewrite !laterN_intuitionistically_if_2 (laterN_intro _ (□?p R)) -laterN_wand HR. Qed. (** FromAnd *) Global Instance from_and_later P Q1 Q2 : FromAnd P Q1 Q2 → FromAnd (▷ P) (▷ Q1) (▷ Q2). Proof. rewrite /FromAnd=> <-. by rewrite later_and. Qed. Global Instance from_and_laterN n P Q1 Q2 : FromAnd P Q1 Q2 → FromAnd (▷^n P) (▷^n Q1) (▷^n Q2). Proof. rewrite /FromAnd=> <-. by rewrite laterN_and. Qed. Global Instance from_and_except_0 P Q1 Q2 : FromAnd P Q1 Q2 → FromAnd (◇ P) (◇ Q1) (◇ Q2). Proof. rewrite /FromAnd=><-. by rewrite except_0_and. Qed. (** FromSep *) Global Instance from_sep_later P Q1 Q2 : FromSep P Q1 Q2 → FromSep (▷ P) (▷ Q1) (▷ Q2). Proof. rewrite /FromSep=> <-. by rewrite later_sep. Qed. Global Instance from_sep_laterN n P Q1 Q2 : FromSep P Q1 Q2 → FromSep (▷^n P) (▷^n Q1) (▷^n Q2). Proof. rewrite /FromSep=> <-. by rewrite laterN_sep. Qed. Global Instance from_sep_except_0 P Q1 Q2 : FromSep P Q1 Q2 → FromSep (◇ P) (◇ Q1) (◇ Q2). Proof. rewrite /FromSep=><-. by rewrite except_0_sep. Qed. (** MaybeCombineSepAs *) Global Instance maybe_combine_sep_as_later Q1 Q2 P progress : MaybeCombineSepAs Q1 Q2 P progress → MaybeCombineSepAs (▷ Q1) (▷ Q2) (▷ P) progress. Proof. by rewrite /MaybeCombineSepAs -later_sep => <-. Qed. Global Instance maybe_combine_sep_as_laterN n Q1 Q2 P progress : MaybeCombineSepAs Q1 Q2 P progress → MaybeCombineSepAs (▷^n Q1) (▷^n Q2) (▷^n P) progress. Proof. by rewrite /MaybeCombineSepAs -laterN_sep => <-. Qed. Global Instance maybe_combine_sep_as_except_0 Q1 Q2 P progress : MaybeCombineSepAs Q1 Q2 P progress → MaybeCombineSepAs (◇ Q1) (◇ Q2) (◇ P) progress. Proof. by rewrite /MaybeCombineSepAs -except_0_sep => <-. Qed. (** MaybeCombineSepGives *) Global Instance maybe_combine_sep_gives_later Q1 Q2 P : CombineSepGives Q1 Q2 P → CombineSepGives (▷ Q1) (▷ Q2) (▷ P). Proof. by rewrite /CombineSepGives -later_sep -later_persistently => ->. Qed. Global Instance maybe_combine_sep_gives_laterN n Q1 Q2 P : CombineSepGives Q1 Q2 P → CombineSepGives (▷^n Q1) (▷^n Q2) (▷^n P). Proof. by rewrite /CombineSepGives -laterN_sep -laterN_persistently => ->. Qed. Global Instance maybe_combine_sep_gives_except_0 Q1 Q2 P : CombineSepGives Q1 Q2 P → CombineSepGives (◇ Q1) (◇ Q2) (◇ P). Proof. by rewrite /CombineSepGives -except_0_sep -except_0_persistently => ->. Qed. (** IntoAnd *) Global Instance into_and_later p P Q1 Q2 : IntoAnd p P Q1 Q2 → IntoAnd p (▷ P) (▷ Q1) (▷ Q2). Proof. rewrite /IntoAnd=> HP. apply intuitionistically_if_intro'. by rewrite later_intuitionistically_if_2 HP intuitionistically_if_elim later_and. Qed. Global Instance into_and_laterN n p P Q1 Q2 : IntoAnd p P Q1 Q2 → IntoAnd p (▷^n P) (▷^n Q1) (▷^n Q2). Proof. rewrite /IntoAnd=> HP. apply intuitionistically_if_intro'. by rewrite laterN_intuitionistically_if_2 HP intuitionistically_if_elim laterN_and. Qed. Global Instance into_and_except_0 p P Q1 Q2 : IntoAnd p P Q1 Q2 → IntoAnd p (◇ P) (◇ Q1) (◇ Q2). Proof. rewrite /IntoAnd=> HP. apply intuitionistically_if_intro'. by rewrite except_0_intuitionistically_if_2 HP intuitionistically_if_elim except_0_and. Qed. (** IntoSep *) Global Instance into_sep_later P Q1 Q2 : IntoSep P Q1 Q2 → IntoSep (▷ P) (▷ Q1) (▷ Q2). Proof. rewrite /IntoSep=> ->. by rewrite later_sep. Qed. Global Instance into_sep_laterN n P Q1 Q2 : IntoSep P Q1 Q2 → IntoSep (▷^n P) (▷^n Q1) (▷^n Q2). Proof. rewrite /IntoSep=> ->. by rewrite laterN_sep. Qed. Global Instance into_sep_except_0 P Q1 Q2 : IntoSep P Q1 Q2 → IntoSep (◇ P) (◇ Q1) (◇ Q2). Proof. rewrite /IntoSep=> ->. by rewrite except_0_sep. Qed. (* FIXME: This instance is overly specific, generalize it. *) Global Instance into_sep_affinely_later `{!Timeless (PROP:=PROP) emp} P Q1 Q2 : IntoSep P Q1 Q2 → Affine Q1 → Affine Q2 → IntoSep ( ▷ P) ( ▷ Q1) ( ▷ Q2). Proof. rewrite /IntoSep /= => -> ??. rewrite -{1}(affine_affinely Q1) -{1}(affine_affinely Q2) later_sep !later_affinely_1. rewrite -except_0_sep /bi_except_0 affinely_or. apply or_elim, affinely_elim. rewrite -(idemp bi_and ( ▷ False)%I) persistent_and_sep_1. by rewrite -(False_elim Q1) -(False_elim Q2). Qed. (** FromOr *) Global Instance from_or_later P Q1 Q2 : FromOr P Q1 Q2 → FromOr (▷ P) (▷ Q1) (▷ Q2). Proof. rewrite /FromOr=><-. by rewrite later_or. Qed. Global Instance from_or_laterN n P Q1 Q2 : FromOr P Q1 Q2 → FromOr (▷^n P) (▷^n Q1) (▷^n Q2). Proof. rewrite /FromOr=><-. by rewrite laterN_or. Qed. Global Instance from_or_except_0 P Q1 Q2 : FromOr P Q1 Q2 → FromOr (◇ P) (◇ Q1) (◇ Q2). Proof. rewrite /FromOr=><-. by rewrite except_0_or. Qed. (** IntoOr *) Global Instance into_or_later P Q1 Q2 : IntoOr P Q1 Q2 → IntoOr (▷ P) (▷ Q1) (▷ Q2). Proof. rewrite /IntoOr=>->. by rewrite later_or. Qed. Global Instance into_or_laterN n P Q1 Q2 : IntoOr P Q1 Q2 → IntoOr (▷^n P) (▷^n Q1) (▷^n Q2). Proof. rewrite /IntoOr=>->. by rewrite laterN_or. Qed. Global Instance into_or_except_0 P Q1 Q2 : IntoOr P Q1 Q2 → IntoOr (◇ P) (◇ Q1) (◇ Q2). Proof. rewrite /IntoOr=>->. by rewrite except_0_or. Qed. (** FromExist *) Global Instance from_exist_later {A} P (Φ : A → PROP) : FromExist P Φ → FromExist (▷ P) (λ a, ▷ (Φ a))%I. Proof. rewrite /FromExist=> <-. apply exist_elim=>x. apply later_mono, exist_intro. Qed. Global Instance from_exist_laterN {A} n P (Φ : A → PROP) : FromExist P Φ → FromExist (▷^n P) (λ a, ▷^n (Φ a))%I. Proof. rewrite /FromExist=> <-. apply exist_elim=>x. apply laterN_mono, exist_intro. Qed. Global Instance from_exist_except_0 {A} P (Φ : A → PROP) : FromExist P Φ → FromExist (◇ P) (λ a, ◇ (Φ a))%I. Proof. rewrite /FromExist=> <-. by rewrite except_0_exist_2. Qed. (** IntoExist *) Global Instance into_exist_later {A} P (Φ : A → PROP) name : IntoExist P Φ name → Inhabited A → IntoExist (▷ P) (λ a, ▷ (Φ a))%I name. Proof. rewrite /IntoExist=> HP ?. by rewrite HP later_exist. Qed. Global Instance into_exist_laterN {A} n P (Φ : A → PROP) name : IntoExist P Φ name → Inhabited A → IntoExist (▷^n P) (λ a, ▷^n (Φ a))%I name. Proof. rewrite /IntoExist=> HP ?. by rewrite HP laterN_exist. Qed. Global Instance into_exist_except_0 {A} P (Φ : A → PROP) name : IntoExist P Φ name → Inhabited A → IntoExist (◇ P) (λ a, ◇ (Φ a))%I name. Proof. rewrite /IntoExist=> HP ?. by rewrite HP except_0_exist. Qed. (** IntoForall *) Global Instance into_forall_later {A} P (Φ : A → PROP) : IntoForall P Φ → IntoForall (▷ P) (λ a, ▷ (Φ a))%I. Proof. rewrite /IntoForall=> HP. by rewrite HP later_forall. Qed. Global Instance into_forall_laterN {A} P (Φ : A → PROP) n : IntoForall P Φ → IntoForall (▷^n P) (λ a, ▷^n (Φ a))%I. Proof. rewrite /IntoForall=> HP. by rewrite HP laterN_forall. Qed. Global Instance into_forall_except_0 {A} P (Φ : A → PROP) : IntoForall P Φ → IntoForall (◇ P) (λ a, ◇ (Φ a))%I. Proof. rewrite /IntoForall=> HP. by rewrite HP except_0_forall. Qed. (** FromForall *) Global Instance from_forall_later {A} P (Φ : A → PROP) name : FromForall P Φ name → FromForall (▷ P) (λ a, ▷ (Φ a))%I name. Proof. rewrite /FromForall=> <-. by rewrite later_forall. Qed. Global Instance from_forall_laterN {A} P (Φ : A → PROP) n name : FromForall P Φ name → FromForall (▷^n P) (λ a, ▷^n (Φ a))%I name. Proof. rewrite /FromForall => <-. by rewrite laterN_forall. Qed. Global Instance from_forall_except_0 {A} P (Φ : A → PROP) name : FromForall P Φ name → FromForall (◇ P) (λ a, ◇ (Φ a))%I name. Proof. rewrite /FromForall=> <-. by rewrite except_0_forall. Qed. (** IsExcept0 *) Global Instance is_except_0_except_0 P : IsExcept0 (◇ P). Proof. by rewrite /IsExcept0 except_0_idemp. Qed. Global Instance is_except_0_later P : IsExcept0 (▷ P). Proof. by rewrite /IsExcept0 except_0_later. Qed. (** FromModal *) Global Instance from_modal_later P : FromModal True (modality_laterN 1) (▷^1 P) (▷ P) P. Proof. by rewrite /FromModal. Qed. Global Instance from_modal_laterN n P : FromModal True (modality_laterN n) (▷^n P) (▷^n P) P. Proof. by rewrite /FromModal. Qed. Global Instance from_modal_except_0 P : FromModal True modality_id (◇ P) (◇ P) P. Proof. by rewrite /FromModal /= -except_0_intro. Qed. (** IntoExcept0 *) Global Instance into_except_0_except_0 P : IntoExcept0 (◇ P) P. Proof. by rewrite /IntoExcept0. Qed. Global Instance into_except_0_later P : Timeless P → IntoExcept0 (▷ P) P. Proof. by rewrite /IntoExcept0. Qed. Global Instance into_except_0_later_if p P : Timeless P → IntoExcept0 (▷?p P) P. Proof. rewrite /IntoExcept0. destruct p; auto using except_0_intro. Qed. Global Instance into_except_0_affinely P Q : IntoExcept0 P Q → IntoExcept0 ( P) ( 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 ( P) ( Q). Proof. rewrite /IntoExcept0=> ->. by rewrite except_0_absorbingly. Qed. Global Instance into_except_0_persistently P Q : IntoExcept0 P Q → IntoExcept0 ( P) ( Q). Proof. rewrite /IntoExcept0=> ->. by rewrite except_0_persistently. Qed. (** ElimModal *) Global Instance elim_modal_timeless p P P' Q : IntoExcept0 P P' → IsExcept0 Q → ElimModal True p p P P' Q Q. Proof. intros. rewrite /ElimModal (except_0_intro (_ -∗ _)) (into_except_0 P). by rewrite except_0_intuitionistically_if_2 -except_0_sep wand_elim_r. Qed. (** AddModal *) (* Low cost to add a [▷] rather than a [◇] when [P] is timeless. *) Global Instance add_modal_later_except_0 P Q : Timeless P → AddModal (▷ P) P (◇ Q) | 0. Proof. intros. rewrite /AddModal (except_0_intro (_ -∗ _)) (timeless P). by rewrite -except_0_sep wand_elim_r except_0_idemp. Qed. Global Instance add_modal_later P Q : Timeless P → AddModal (▷ P) P (▷ Q) | 0. Proof. intros. rewrite /AddModal (except_0_intro (_ -∗ _)) (timeless P). by rewrite -except_0_sep wand_elim_r except_0_later. Qed. Global Instance add_modal_except_0 P Q : AddModal (◇ P) P (◇ Q) | 1. Proof. intros. rewrite /AddModal (except_0_intro (_ -∗ _)). by rewrite -except_0_sep wand_elim_r except_0_idemp. Qed. Global Instance add_modal_except_0_later P Q : AddModal (◇ P) P (▷ Q) | 1. Proof. intros. rewrite /AddModal (except_0_intro (_ -∗ _)). by rewrite -except_0_sep wand_elim_r except_0_later. Qed. (** IntoAcc *) (* TODO: We could have instances from "unfolded" accessors with or without the first binder. *) (** IntoLater *) Global Instance into_laterN_0 only_head P : IntoLaterN only_head 0 P P. Proof. by rewrite /IntoLaterN /MaybeIntoLaterN. Qed. Global Instance into_laterN_later only_head n n' m' P Q lQ : NatCancel n 1 n' m' → (** If canceling has failed (i.e. [1 = m']), we should make progress deeper into [P], as such, we continue with the [IntoLaterN] class, which is required to make progress. If canceling has succeeded, we do not need to make further progress, but there may still be a left-over (i.e. [n']) to cancel more deeply into [P], as such, we continue with [MaybeIntoLaterN]. *) TCIf (TCEq 1 m') (IntoLaterN only_head n' P Q) (MaybeIntoLaterN only_head n' P Q) → (* Similar to [iFrame], the [iNext] tactic also performs a traversal through a term (a hypothesis) to find laters to strip. And like [iFrame] we don't want this to be excessively smart. So we use the same typeclass as [iFrame] here. *) MakeLaterN m' Q lQ → IntoLaterN only_head n (▷ P) lQ | 2. Proof. rewrite /MakeLaterN /IntoLaterN /MaybeIntoLaterN /NatCancel. move=> Hn [_ ->|->] <-; by rewrite -later_laterN -laterN_add -Hn Nat.add_comm. Qed. Global Instance into_laterN_laterN only_head n m n' m' P Q lQ : NatCancel n m n' m' → TCIf (TCEq m m') (IntoLaterN only_head n' P Q) (MaybeIntoLaterN only_head n' P Q) → MakeLaterN m' Q lQ → IntoLaterN only_head n (▷^m P) lQ | 1. Proof. rewrite /MakeLaterN /IntoLaterN /MaybeIntoLaterN /NatCancel. move=> Hn [_ ->|->] <-; by rewrite -!laterN_add -Hn Nat.add_comm. Qed. Global Instance into_laterN_and_l n P1 P2 Q1 Q2 : IntoLaterN false n P1 Q1 → MaybeIntoLaterN false n P2 Q2 → IntoLaterN false n (P1 ∧ P2) (Q1 ∧ Q2) | 10. Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> -> ->. by rewrite laterN_and. Qed. Global Instance into_laterN_and_r n P P2 Q2 : IntoLaterN false n P2 Q2 → IntoLaterN false n (P ∧ P2) (P ∧ Q2) | 11. Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_and -(laterN_intro _ P). Qed. Global Instance into_laterN_forall {A} n (Φ Ψ : A → PROP) : (∀ x, IntoLaterN false n (Φ x) (Ψ x)) → IntoLaterN false n (∀ x, Φ x) (∀ x, Ψ x). Proof. rewrite /IntoLaterN /MaybeIntoLaterN laterN_forall=> ?. by apply forall_mono. Qed. Global Instance into_laterN_exist {A} n (Φ Ψ : A → PROP) : (∀ x, IntoLaterN false n (Φ x) (Ψ x)) → IntoLaterN false n (∃ x, Φ x) (∃ x, Ψ x). Proof. rewrite /IntoLaterN /MaybeIntoLaterN -laterN_exist_2=> ?. by apply exist_mono. Qed. Global Instance into_laterN_or_l n P1 P2 Q1 Q2 : IntoLaterN false n P1 Q1 → MaybeIntoLaterN false n P2 Q2 → IntoLaterN false n (P1 ∨ P2) (Q1 ∨ Q2) | 10. Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> -> ->. by rewrite laterN_or. Qed. Global Instance into_laterN_or_r n P P2 Q2 : IntoLaterN false n P2 Q2 → IntoLaterN false n (P ∨ P2) (P ∨ Q2) | 11. Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_or -(laterN_intro _ P). Qed. Global Instance into_later_affinely n P Q : IntoLaterN false n P Q → IntoLaterN false n ( P) ( 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 ( P) ( Q). Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_absorbingly. Qed. Global Instance into_later_persistently n P Q : IntoLaterN false n P Q → IntoLaterN false n ( P) ( Q). Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_persistently. Qed. Global Instance into_laterN_sep_l n P1 P2 Q1 Q2 : IntoLaterN false n P1 Q1 → MaybeIntoLaterN false n P2 Q2 → IntoLaterN false n (P1 ∗ P2) (Q1 ∗ Q2) | 10. Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> -> ->. by rewrite laterN_sep. Qed. Global Instance into_laterN_sep_r n P P2 Q2 : IntoLaterN false n P2 Q2 → IntoLaterN false n (P ∗ P2) (P ∗ Q2) | 11. Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_sep -(laterN_intro _ P). Qed. Global Instance into_laterN_big_sepL n {A} (Φ Ψ : nat → A → PROP) (l: list A) : (∀ x k, IntoLaterN false n (Φ k x) (Ψ k x)) → IntoLaterN false n ([∗ list] k ↦ x ∈ l, Φ k x) ([∗ list] k ↦ x ∈ l, Ψ k x). Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ?. rewrite big_opL_commute. by apply big_sepL_mono. Qed. Global Instance into_laterN_big_sepL2 n {A B} (Φ Ψ : nat → A → B → PROP) l1 l2 : (∀ x1 x2 k, IntoLaterN false n (Φ k x1 x2) (Ψ k x1 x2)) → IntoLaterN false n ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2) ([∗ list] k ↦ y1;y2 ∈ l1;l2, Ψ k y1 y2). Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ?. rewrite -big_sepL2_laterN_2. by apply big_sepL2_mono. Qed. Global Instance into_laterN_big_sepM n `{Countable K} {A} (Φ Ψ : K → A → PROP) (m : gmap K A) : (∀ x k, IntoLaterN false n (Φ k x) (Ψ k x)) → IntoLaterN false n ([∗ map] k ↦ x ∈ m, Φ k x) ([∗ map] k ↦ x ∈ m, Ψ k x). Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ?. rewrite big_opM_commute. by apply big_sepM_mono. Qed. Global Instance into_laterN_big_sepM2 n `{Countable K} {A B} (Φ Ψ : K → A → B → PROP) (m1 : gmap K A) (m2 : gmap K B) : (∀ x1 x2 k, IntoLaterN false n (Φ k x1 x2) (Ψ k x1 x2)) → IntoLaterN false n ([∗ map] k ↦ x1;x2 ∈ m1;m2, Φ k x1 x2) ([∗ map] k ↦ x1;x2 ∈ m1;m2, Ψ k x1 x2). Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> HΦΨ. rewrite -big_sepM2_laterN_2. by apply big_sepM2_mono. Qed. Global Instance into_laterN_big_sepS n `{Countable A} (Φ Ψ : A → PROP) (X : gset A) : (∀ x, IntoLaterN false n (Φ x) (Ψ x)) → IntoLaterN false n ([∗ set] x ∈ X, Φ x) ([∗ set] x ∈ X, Ψ x). Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ?. rewrite big_opS_commute. by apply big_sepS_mono. Qed. Global Instance into_laterN_big_sepMS n `{Countable A} (Φ Ψ : A → PROP) (X : gmultiset A) : (∀ x, IntoLaterN false n (Φ x) (Ψ x)) → IntoLaterN false n ([∗ mset] x ∈ X, Φ x) ([∗ mset] x ∈ X, Ψ x). Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ?. rewrite big_opMS_commute. by apply big_sepMS_mono. Qed. End class_instances_later. iris-iris-4.2.0/iris/proofmode/class_instances_make.v000066400000000000000000000207371460620107300227370ustar00rootroot00000000000000(** IMPORTANT: Read the comment in [classes_make] about the "constant time" requirements of these instances. *) From iris.proofmode Require Export classes_make. From iris.prelude Require Import options. Import bi. Section class_instances_make. Context {PROP : bi}. Implicit Types P Q R : PROP. (** Affine *) Global Instance bi_affine_quick_affine P : BiAffine PROP → QuickAffine P. Proof. rewrite /QuickAffine. apply _. Qed. Global Instance False_quick_affine : @QuickAffine PROP False. Proof. rewrite /QuickAffine. apply _. Qed. Global Instance emp_quick_affine : @QuickAffine PROP emp. Proof. rewrite /QuickAffine. apply _. Qed. Global Instance affinely_quick_affine P : QuickAffine ( P). Proof. rewrite /QuickAffine. apply _. Qed. Global Instance intuitionistically_quick_affine P : QuickAffine (□ P). Proof. rewrite /QuickAffine. apply _. Qed. (** Absorbing *) Global Instance bi_affine_quick_absorbing P : BiAffine PROP → QuickAbsorbing P. Proof. rewrite /QuickAbsorbing. apply _. Qed. Global Instance pure_quick_absorbing φ : @QuickAbsorbing PROP ⌜ φ ⌝. Proof. rewrite /QuickAbsorbing. apply _. Qed. Global Instance absorbingly_quick_absorbing P : QuickAbsorbing ( P). Proof. rewrite /QuickAbsorbing. apply _. Qed. Global Instance persistently_quick_absorbing P : QuickAbsorbing ( P). Proof. rewrite /QuickAbsorbing. apply _. Qed. (** Embed *) Global Instance make_embed_pure {PROP'} `{!BiEmbed PROP PROP'} φ : KnownMakeEmbed (PROP:=PROP) ⌜φ⌝ ⌜φ⌝. Proof. apply embed_pure. Qed. Global Instance make_embed_emp {PROP'} `{!BiEmbed PROP PROP'} `{!BiEmbedEmp PROP PROP'} : KnownMakeEmbed (PROP:=PROP) emp emp. Proof. apply embed_emp. Qed. Global Instance make_embed_default {PROP'} `{!BiEmbed PROP PROP'} P : MakeEmbed P ⎡P⎤ | 100. Proof. by rewrite /MakeEmbed. Qed. (** Sep *) Global Instance make_sep_emp_l P : KnownLMakeSep emp P P. Proof. apply left_id, _. Qed. Global Instance make_sep_emp_r P : KnownRMakeSep P emp P. Proof. apply right_id, _. Qed. Global Instance make_sep_true_l P : QuickAbsorbing P → KnownLMakeSep True P P. Proof. rewrite /QuickAbsorbing /KnownLMakeSep /MakeSep=> ?. by apply True_sep. Qed. Global Instance make_sep_true_r P : QuickAbsorbing P → KnownRMakeSep P True P. Proof. rewrite /QuickAbsorbing /KnownLMakeSep /MakeSep=> ?. by apply sep_True. Qed. Global Instance make_sep_default P Q : MakeSep P Q (P ∗ Q) | 100. Proof. by rewrite /MakeSep. Qed. (** And *) Global Instance make_and_true_l P : KnownLMakeAnd True P P. Proof. apply left_id, _. Qed. Global Instance make_and_true_r P : KnownRMakeAnd P True P. Proof. by rewrite /KnownRMakeAnd /MakeAnd right_id. Qed. Global Instance make_and_emp_l P : QuickAffine P → KnownLMakeAnd emp P P. Proof. apply emp_and. Qed. Global Instance make_and_emp_r P : QuickAffine P → KnownRMakeAnd P emp P. Proof. apply and_emp. Qed. Global Instance make_and_false_l P : KnownLMakeAnd False P False. Proof. apply left_absorb, _. Qed. Global Instance make_and_false_r P : KnownRMakeAnd P False False. Proof. by rewrite /KnownRMakeAnd /MakeAnd right_absorb. Qed. Global Instance make_and_default P Q : MakeAnd P Q (P ∧ Q) | 100. Proof. by rewrite /MakeAnd. Qed. (** Or *) Global Instance make_or_true_l P : KnownLMakeOr True P True. Proof. apply left_absorb, _. Qed. Global Instance make_or_true_r P : KnownRMakeOr P True True. Proof. by rewrite /KnownRMakeOr /MakeOr right_absorb. Qed. Global Instance make_or_emp_l P : QuickAffine P → KnownLMakeOr emp P emp. Proof. apply emp_or. Qed. Global Instance make_or_emp_r P : QuickAffine P → KnownRMakeOr P emp emp. Proof. apply or_emp. Qed. Global Instance make_or_false_l P : KnownLMakeOr False P P. Proof. apply left_id, _. Qed. Global Instance make_or_false_r P : KnownRMakeOr P False P. Proof. by rewrite /KnownRMakeOr /MakeOr right_id. Qed. Global Instance make_or_default P Q : MakeOr P Q (P ∨ Q) | 100. Proof. by rewrite /MakeOr. Qed. (** Affinely - [make_affinely_affine] adds no modality, but only if the argument is affine. - [make_affinely_True] turns [True] into [emp]. For an affine BI this instance overlaps with [make_affinely_affine], since [True] is affine. Since we prefer to avoid [emp] in goals involving affine BIs, we give [make_affinely_affine] a lower cost than [make_affinely_True]. - [make_affinely_default] adds the modality. This is the default instance since it can always be used, and thus has the highest cost. (For this last point, the cost of the [KnownMakeAffinely] instances does not actually matter, since this is a [MakeAffinely] instance, i.e. an instance of a different class. What really matters is that the [known_make_affinely] instance has a lower cost than [make_affinely_default].) *) Global Instance make_affinely_affine P : QuickAffine P → KnownMakeAffinely P P | 0. Proof. apply affine_affinely. Qed. Global Instance make_affinely_True : @KnownMakeAffinely PROP True emp | 1. Proof. by rewrite /KnownMakeAffinely /MakeAffinely affinely_True_emp. Qed. Global Instance make_affinely_default P : MakeAffinely P ( P) | 100. Proof. by rewrite /MakeAffinely. Qed. (** Absorbingly - [make_absorbingly_absorbing] adds no modality, but only if the argument is absorbing. - [make_absorbingly_emp] turns [emp] into [True]. For an affine BI this instance overlaps with [make_absorbingly_absorbing], since [emp] is absorbing. For consistency, we give this instance the same cost as [make_affinely_True], but it does not really matter since goals in affine BIs typically do not contain occurrences of [emp] to start with. - [make_absorbingly_default] adds the modality. This is the default instance since it can always be used, and thus has the highest cost. (For this last point, the cost of the [KnownMakeAbsorbingly] instances does not actually matter, since this is a [MakeAbsorbingly] instance, i.e. an instance of a different class. What really matters is that the [known_make_absorbingly] instance has a lower cost than [make_absorbingly_default].) *) Global Instance make_absorbingly_absorbing P : QuickAbsorbing P → KnownMakeAbsorbingly P P | 0. Proof. apply absorbing_absorbingly. Qed. Global Instance make_absorbingly_emp : @KnownMakeAbsorbingly PROP emp True | 1. Proof. by rewrite /KnownMakeAbsorbingly /MakeAbsorbingly -absorbingly_emp_True. Qed. Global Instance make_absorbingly_default P : MakeAbsorbingly P ( P) | 100. Proof. by rewrite /MakeAbsorbingly. Qed. (** Persistently *) Global Instance make_persistently_emp : @KnownMakePersistently PROP emp True | 0. Proof. by rewrite /KnownMakePersistently /MakePersistently -persistently_True_emp persistently_pure. Qed. Global Instance make_persistently_True : @KnownMakePersistently PROP True True | 0. Proof. by rewrite /KnownMakePersistently /MakePersistently persistently_pure. Qed. Global Instance make_persistently_default P : MakePersistently P ( P) | 100. Proof. by rewrite /MakePersistently. Qed. (** Intuitionistically *) Global Instance make_intuitionistically_emp : @KnownMakeIntuitionistically PROP emp emp | 0. Proof. by rewrite /KnownMakeIntuitionistically /MakeIntuitionistically intuitionistically_emp. Qed. (** For affine BIs, we would prefer [□ True] to become [True] rather than [emp], so we have this instance with lower cost than the next. *) Global Instance make_intuitionistically_True_affine : BiAffine PROP → @KnownMakeIntuitionistically PROP True True | 0. Proof. intros. rewrite /KnownMakeIntuitionistically /MakeIntuitionistically intuitionistically_True_emp True_emp //. Qed. Global Instance make_intuitionistically_True : @KnownMakeIntuitionistically PROP True emp | 1. Proof. by rewrite /KnownMakeIntuitionistically /MakeIntuitionistically intuitionistically_True_emp. Qed. Global Instance make_intuitionistically_default P : MakeIntuitionistically P (□ P) | 100. Proof. by rewrite /MakeIntuitionistically. Qed. (** Later *) Global Instance make_laterN_true n : @KnownMakeLaterN PROP n True True | 0. Proof. by rewrite /KnownMakeLaterN /MakeLaterN laterN_True. Qed. Global Instance make_laterN_emp `{!BiAffine PROP} n : @KnownMakeLaterN PROP n emp emp | 0. Proof. by rewrite /KnownMakeLaterN /MakeLaterN laterN_emp. Qed. Global Instance make_laterN_default n P : MakeLaterN n P (▷^n P) | 100. Proof. by rewrite /MakeLaterN. Qed. (** Except-0 *) Global Instance make_except_0_True : @KnownMakeExcept0 PROP True True. Proof. by rewrite /KnownMakeExcept0 /MakeExcept0 except_0_True. Qed. Global Instance make_except_0_default P : MakeExcept0 P (◇ P) | 100. Proof. by rewrite /MakeExcept0. Qed. End class_instances_make. iris-iris-4.2.0/iris/proofmode/class_instances_plainly.v000066400000000000000000000102421460620107300234600ustar00rootroot00000000000000From iris.bi Require Import bi. From iris.proofmode Require Import modality_instances classes. From iris.prelude Require Import options. Import bi. Section class_instances_plainly. Context {PROP} `{!BiPlainly PROP}. Implicit Types P Q R : PROP. Global Instance from_assumption_plainly_l_true P Q : FromAssumption true P Q → KnownLFromAssumption true (■ P) Q. Proof. rewrite /KnownLFromAssumption /FromAssumption /= =><-. rewrite intuitionistically_plainly_elim //. Qed. Global Instance from_assumption_plainly_l_false `{!BiAffine PROP} P Q : FromAssumption true P Q → KnownLFromAssumption false (■ P) Q. Proof. rewrite /KnownLFromAssumption /FromAssumption /= =><-. rewrite plainly_elim_persistently intuitionistically_into_persistently //. Qed. Global Instance from_pure_plainly P φ : FromPure false P φ → FromPure false (■ P) φ. Proof. rewrite /FromPure=> <-. by rewrite plainly_pure. Qed. Global Instance into_pure_plainly P φ : IntoPure P φ → IntoPure (■ P) φ. Proof. rewrite /IntoPure=> ->. apply: plainly_elim. Qed. Global Instance into_wand_plainly_true q R P Q : IntoWand true q R P Q → IntoWand true q (■ R) P Q. Proof. rewrite /IntoWand /= intuitionistically_plainly_elim //. Qed. Global Instance into_wand_plainly_false q R P Q : Absorbing R → IntoWand false q R P Q → IntoWand false q (■ R) P Q. Proof. intros ?. by rewrite /IntoWand plainly_elim. Qed. Global Instance from_and_plainly P Q1 Q2 : FromAnd P Q1 Q2 → FromAnd (■ P) (■ Q1) (■ Q2). Proof. rewrite /FromAnd=> <-. by rewrite plainly_and. Qed. Global Instance from_sep_plainly P Q1 Q2 : FromSep P Q1 Q2 → FromSep (■ P) (■ Q1) (■ Q2). Proof. rewrite /FromSep=> <-. by rewrite plainly_sep_2. Qed. Global Instance into_and_plainly p P Q1 Q2 : IntoAnd p P Q1 Q2 → IntoAnd p (■ P) (■ Q1) (■ Q2). Proof. rewrite /IntoAnd /=. destruct p; simpl. - rewrite -plainly_and -[(□ ■ P)%I]intuitionistically_idemp intuitionistically_plainly =>->. rewrite [(□ (_ ∧ _))%I]intuitionistically_elim //. - intros ->. by rewrite plainly_and. Qed. Global Instance into_sep_plainly `{!BiPositive PROP} P Q1 Q2 : IntoSep P Q1 Q2 → IntoSep (■ P) (■ Q1) (■ Q2). Proof. rewrite /IntoSep /= => ->. by rewrite plainly_sep. Qed. Global Instance into_sep_plainly_affine P Q1 Q2 : IntoSep P Q1 Q2 → TCOr (Affine Q1) (Absorbing Q2) → TCOr (Affine Q2) (Absorbing Q1) → IntoSep (■ P) (■ Q1) (■ Q2). Proof. rewrite /IntoSep /= => -> ??. by rewrite sep_and plainly_and plainly_and_sep_l_1. Qed. Global Instance from_or_plainly P Q1 Q2 : FromOr P Q1 Q2 → FromOr (■ P) (■ Q1) (■ Q2). Proof. rewrite /FromOr=> <-. by rewrite -plainly_or_2. Qed. Global Instance into_or_plainly `{!BiPlainlyExist PROP} P Q1 Q2 : IntoOr P Q1 Q2 → IntoOr (■ P) (■ Q1) (■ Q2). Proof. rewrite /IntoOr=>->. by rewrite plainly_or. Qed. Global Instance from_exist_plainly {A} P (Φ : A → PROP) : FromExist P Φ → FromExist (■ P) (λ a, ■ (Φ a))%I. Proof. rewrite /FromExist=> <-. by rewrite -plainly_exist_2. Qed. Global Instance into_exist_plainly `{!BiPlainlyExist PROP} {A} P (Φ : A → PROP) name : IntoExist P Φ name → IntoExist (■ P) (λ a, ■ (Φ a))%I name. Proof. rewrite /IntoExist=> HP. by rewrite HP plainly_exist. Qed. Global Instance into_forall_plainly {A} P (Φ : A → PROP) : IntoForall P Φ → IntoForall (■ P) (λ a, ■ (Φ a))%I. Proof. rewrite /IntoForall=> HP. by rewrite HP plainly_forall. Qed. Global Instance from_forall_plainly {A} P (Φ : A → PROP) name : FromForall P Φ name → FromForall (■ P) (λ a, ■ (Φ a))%I name. Proof. rewrite /FromForall=> <-. by rewrite plainly_forall. Qed. Global Instance from_modal_plainly P : FromModal True modality_plainly (■ P) (■ P) P | 2. Proof. by rewrite /FromModal. Qed. Global Instance into_except_0_plainly `{!BiPlainlyExist PROP} P Q : IntoExcept0 P Q → IntoExcept0 (■ P) (■ Q). Proof. rewrite /IntoExcept0=> ->. by rewrite except_0_plainly. Qed. Global Instance into_later_plainly n P Q : IntoLaterN false n P Q → IntoLaterN false n (■ P) (■ Q). Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_plainly. Qed. End class_instances_plainly. iris-iris-4.2.0/iris/proofmode/class_instances_updates.v000066400000000000000000000220511460620107300234560ustar00rootroot00000000000000From stdpp Require Import nat_cancel. From iris.bi Require Import bi. From iris.proofmode Require Import modality_instances classes. From iris.proofmode Require Import ltac_tactics class_instances. From iris.prelude Require Import options. Import bi. Section class_instances_updates. Context {PROP : bi}. Implicit Types P Q R : PROP. Global Instance from_assumption_bupd `{!BiBUpd PROP} p P Q : FromAssumption p P Q → KnownRFromAssumption p P (|==> Q). Proof. rewrite /KnownRFromAssumption /FromAssumption=>->. apply bupd_intro. Qed. Global Instance from_assumption_fupd `{!BiBUpd PROP, !BiFUpd PROP, !BiBUpdFUpd PROP} E p P Q : FromAssumption p P (|==> Q) → KnownRFromAssumption p P (|={E}=> Q). Proof. rewrite /KnownRFromAssumption /FromAssumption=>->. apply bupd_fupd. Qed. Global Instance from_pure_bupd `{!BiBUpd PROP} a P φ : FromPure a P φ → FromPure a (|==> P) φ. Proof. rewrite /FromPure=> <-. apply bupd_intro. Qed. Global Instance from_pure_fupd `{!BiFUpd PROP} a E P φ : FromPure a P φ → FromPure a (|={E}=> P) φ. Proof. rewrite /FromPure=> <-. apply fupd_intro. Qed. Global Instance into_wand_bupd `{!BiBUpd PROP} p q R P Q : IntoWand false false R P Q → IntoWand p q (|==> R) (|==> P) (|==> Q). Proof. rewrite /IntoWand /= => HR. rewrite !intuitionistically_if_elim HR. apply wand_intro_l. by rewrite bupd_sep wand_elim_r. Qed. Global Instance into_wand_fupd `{!BiFUpd PROP} E p q R P Q : IntoWand false false R P Q → IntoWand p q (|={E}=> R) (|={E}=> P) (|={E}=> Q). Proof. rewrite /IntoWand /= => HR. rewrite !intuitionistically_if_elim HR. apply wand_intro_l. by rewrite fupd_sep wand_elim_r. Qed. Global Instance into_wand_bupd_persistent `{!BiBUpd PROP} p q R P Q : IntoWand false q R P Q → IntoWand p q (|==> R) P (|==> Q). Proof. rewrite /IntoWand /= => HR. rewrite intuitionistically_if_elim HR. apply wand_intro_l. by rewrite bupd_frame_l wand_elim_r. Qed. Global Instance into_wand_fupd_persistent `{!BiFUpd PROP} E1 E2 p q R P Q : IntoWand false q R P Q → IntoWand p q (|={E1,E2}=> R) P (|={E1,E2}=> Q). Proof. rewrite /IntoWand /= => HR. rewrite intuitionistically_if_elim HR. apply wand_intro_l. by rewrite fupd_frame_l wand_elim_r. Qed. Global Instance into_wand_bupd_args `{!BiBUpd PROP} p q R P Q : IntoWand p false R P Q → IntoWand' p q R (|==> P) (|==> Q). Proof. rewrite /IntoWand' /IntoWand /= => ->. apply wand_intro_l. by rewrite intuitionistically_if_elim bupd_wand_r. Qed. Global Instance into_wand_fupd_args `{!BiFUpd PROP} E1 E2 p q R P Q : IntoWand p false R P Q → IntoWand' p q R (|={E1,E2}=> P) (|={E1,E2}=> Q). Proof. rewrite /IntoWand' /IntoWand /= => ->. apply wand_intro_l. by rewrite intuitionistically_if_elim fupd_wand_r. Qed. Global Instance from_sep_bupd `{!BiBUpd PROP} P Q1 Q2 : FromSep P Q1 Q2 → FromSep (|==> P) (|==> Q1) (|==> Q2). Proof. rewrite /FromSep=><-. apply bupd_sep. Qed. Global Instance from_sep_fupd `{!BiFUpd PROP} E P Q1 Q2 : FromSep P Q1 Q2 → FromSep (|={E}=> P) (|={E}=> Q1) (|={E}=> Q2). Proof. rewrite /FromSep =><-. apply fupd_sep. Qed. Global Instance from_or_bupd `{!BiBUpd PROP} P Q1 Q2 : FromOr P Q1 Q2 → FromOr (|==> P) (|==> Q1) (|==> Q2). Proof. rewrite /FromOr=><-. apply bupd_or. Qed. Global Instance from_or_fupd `{!BiFUpd PROP} E1 E2 P Q1 Q2 : FromOr P Q1 Q2 → FromOr (|={E1,E2}=> P) (|={E1,E2}=> Q1) (|={E1,E2}=> Q2). Proof. rewrite /FromOr=><-. apply fupd_or. Qed. Global Instance into_and_bupd `{!BiBUpd PROP} P Q1 Q2 : IntoAnd false P Q1 Q2 → IntoAnd false (|==> P) (|==> Q1) (|==> Q2). Proof. rewrite /IntoAnd/==>->. apply bupd_and. Qed. Global Instance into_and_fupd `{!BiFUpd PROP} E1 E2 P Q1 Q2 : IntoAnd false P Q1 Q2 → IntoAnd false (|={E1,E2}=> P) (|={E1,E2}=> Q1) (|={E1,E2}=> Q2). Proof. rewrite /IntoAnd/==>->. apply fupd_and. Qed. Global Instance from_exist_bupd `{!BiBUpd PROP} {A} P (Φ : A → PROP) : FromExist P Φ → FromExist (|==> P) (λ a, |==> Φ a)%I. Proof. rewrite /FromExist=><-. apply bupd_exist. Qed. Global Instance from_exist_fupd `{!BiFUpd PROP} {A} E1 E2 P (Φ : A → PROP) : FromExist P Φ → FromExist (|={E1,E2}=> P) (λ a, |={E1,E2}=> Φ a)%I. Proof. rewrite /FromExist=><-. apply fupd_exist. Qed. Global Instance into_forall_bupd `{!BiBUpd PROP} {A} P (Φ : A → PROP) : IntoForall P Φ → IntoForall (|==> P) (λ a, |==> Φ a)%I. Proof. rewrite /IntoForall=>->. apply bupd_forall. Qed. Global Instance into_forall_fupd `{!BiFUpd PROP} {A} E1 E2 P (Φ : A → PROP) : IntoForall P Φ → IntoForall (|={E1,E2}=> P) (λ a, |={E1,E2}=> Φ a)%I. Proof. rewrite /IntoForall=>->. apply fupd_forall. Qed. Global Instance from_forall_fupd `{!BiFUpd PROP, !BiPlainly PROP, !BiFUpdPlainly PROP} E1 E2 {A} P (Φ : A → PROP) name : (* Some cases in which [E2 ⊆ E1] holds *) TCOr (TCEq E1 E2) (TCOr (TCEq E1 ⊤) (TCEq E2 ∅)) → FromForall P Φ name → (∀ x, Plain (Φ x)) → FromForall (|={E1,E2}=> P) (λ a, |={E1,E2}=> (Φ a))%I name. Proof. rewrite /FromForall=> -[->|[->|->]] <- ?; rewrite fupd_plain_forall; set_solver. Qed. Global Instance from_forall_step_fupd `{!BiFUpd PROP, !BiPlainly PROP, !BiFUpdPlainly PROP} E1 E2 {A} P (Φ : A → PROP) name : (* Some cases in which [E2 ⊆ E1] holds *) TCOr (TCEq E1 E2) (TCOr (TCEq E1 ⊤) (TCEq E2 ∅)) → FromForall P Φ name → (∀ x, Plain (Φ x)) → FromForall (|={E1}[E2]▷=> P) (λ a, |={E1}[E2]▷=> (Φ a))%I name. Proof. rewrite /FromForall=> -[->|[->|->]] <- ?; rewrite step_fupd_plain_forall; set_solver. Qed. Global Instance is_except_0_bupd `{!BiBUpd PROP} P : IsExcept0 P → IsExcept0 (|==> P). Proof. rewrite /IsExcept0=> HP. by rewrite -{2}HP -(except_0_idemp P) -except_0_bupd -(except_0_intro P). Qed. Global Instance is_except_0_fupd `{!BiFUpd PROP} E1 E2 P : IsExcept0 (|={E1,E2}=> P). Proof. by rewrite /IsExcept0 except_0_fupd. Qed. Global Instance from_modal_bupd `{!BiBUpd PROP} P : FromModal True modality_id (|==> P) (|==> P) P. Proof. by rewrite /FromModal /= -bupd_intro. Qed. Global Instance from_modal_fupd E P `{!BiFUpd PROP} : FromModal True modality_id (|={E}=> P) (|={E}=> P) P. Proof. by rewrite /FromModal /= -fupd_intro. Qed. Global Instance from_modal_fupd_wrong_mask E1 E2 P `{!BiFUpd PROP} : FromModal (pm_error "Only non-mask-changing update modalities can be introduced directly. Use [iApply fupd_mask_intro] to introduce mask-changing update modalities") modality_id (|={E1,E2}=> P) (|={E1,E2}=> P) P | 100. Proof. by intros []. Qed. Global Instance elim_modal_bupd `{!BiBUpd PROP} p P Q : ElimModal True p false (|==> P) P (|==> Q) (|==> Q). Proof. by rewrite /ElimModal intuitionistically_if_elim bupd_frame_r wand_elim_r bupd_trans. Qed. Global Instance elim_modal_bupd_plain_goal `{!BiBUpd PROP, !BiPlainly PROP, !BiBUpdPlainly PROP} p P Q : Plain Q → ElimModal True p false (|==> P) P Q Q. Proof. intros. by rewrite /ElimModal intuitionistically_if_elim bupd_frame_r wand_elim_r bupd_elim. Qed. Global Instance elim_modal_bupd_plain `{!BiBUpd PROP, !BiPlainly PROP, !BiBUpdPlainly PROP} p P Q : Plain P → ElimModal True p p (|==> P) P Q Q. Proof. intros. by rewrite /ElimModal bupd_elim wand_elim_r. Qed. Global Instance elim_modal_bupd_fupd `{!BiBUpd PROP, !BiFUpd PROP, !BiBUpdFUpd PROP} p E1 E2 P Q : ElimModal True p false (|==> P) P (|={E1,E2}=> Q) (|={E1,E2}=> Q) | 10. Proof. by rewrite /ElimModal intuitionistically_if_elim (bupd_fupd E1) fupd_frame_r wand_elim_r fupd_trans. Qed. Global Instance elim_modal_fupd_fupd `{!BiFUpd PROP} p E1 E2 E3 P Q : ElimModal True p false (|={E1,E2}=> P) P (|={E1,E3}=> Q) (|={E2,E3}=> Q). Proof. by rewrite /ElimModal intuitionistically_if_elim fupd_frame_r wand_elim_r fupd_trans. Qed. Global Instance elim_modal_fupd_fupd_wrong_mask `{!BiFUpd PROP} p E0 E1 E2 E3 P Q : ElimModal (pm_error "Goal and eliminated modality must have the same mask. Use [iMod (fupd_mask_subseteq E2)] to adjust the mask of your goal to [E2]") p false (|={E1,E2}=> P) False (|={E0,E3}=> Q) False | 100. Proof. intros []. Qed. Global Instance add_modal_bupd `{!BiBUpd PROP} P Q : AddModal (|==> P) P (|==> Q). Proof. by rewrite /AddModal bupd_frame_r wand_elim_r bupd_trans. Qed. Global Instance add_modal_fupd `{!BiFUpd PROP} E1 E2 P Q : AddModal (|={E1}=> P) P (|={E1,E2}=> Q). Proof. by rewrite /AddModal fupd_frame_r wand_elim_r fupd_trans. Qed. Global Instance elim_acc_bupd `{!BiBUpd PROP} {X} α β mγ Q : ElimAcc (X:=X) True bupd bupd α β mγ (|==> Q) (λ x, |==> β x ∗ (mγ x -∗? |==> Q))%I. Proof. iIntros (_) "Hinner >Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]". iMod ("Hinner" with "Hα") as "[Hβ Hfin]". iMod ("Hclose" with "Hβ") as "Hγ". by iApply "Hfin". Qed. Global Instance elim_acc_fupd `{!BiFUpd PROP} {X} E1 E2 E α β mγ Q : ElimAcc (X:=X) True (fupd E1 E2) (fupd E2 E1) α β mγ (|={E1,E}=> Q) (λ x, |={E2}=> β x ∗ (mγ x -∗? |={E1,E}=> Q))%I. Proof. iIntros (_) "Hinner >Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]". iMod ("Hinner" with "Hα") as "[Hβ Hfin]". iMod ("Hclose" with "Hβ") as "Hγ". by iApply "Hfin". Qed. End class_instances_updates. iris-iris-4.2.0/iris/proofmode/classes.v000066400000000000000000001016611460620107300202170ustar00rootroot00000000000000From stdpp Require Import namespaces. From iris.bi Require Export bi. From iris.proofmode Require Import base. From iris.proofmode Require Export ident_name modalities. From iris.prelude Require Import options. Import bi. (** Use this as precondition on "failing" instances of typeclasses that have pure preconditions (such as [ElimModal]), if you want a nice error to be shown when this instances is picked as part of some proof mode tactic. *) Inductive pm_error (s : string) := . Class FromAssumption {PROP : bi} (p : bool) (P Q : PROP) := from_assumption : □?p P ⊢ Q. Global Arguments FromAssumption {_} _ _%I _%I : simpl never. Global Arguments from_assumption {_} _ _%I _%I {_}. Global Hint Mode FromAssumption + + - - : typeclass_instances. Class KnownLFromAssumption {PROP : bi} (p : bool) (P Q : PROP) := #[global] knownl_from_assumption :: FromAssumption p P Q. Global Arguments KnownLFromAssumption {_} _ _%I _%I : simpl never. Global Arguments knownl_from_assumption {_} _ _%I _%I {_}. Global Hint Mode KnownLFromAssumption + + ! - : typeclass_instances. Class KnownRFromAssumption {PROP : bi} (p : bool) (P Q : PROP) := #[global] knownr_from_assumption :: FromAssumption p P Q. Global Arguments KnownRFromAssumption {_} _ _%I _%I : simpl never. Global Arguments knownr_from_assumption {_} _ _%I _%I {_}. Global Hint Mode KnownRFromAssumption + + - ! : typeclass_instances. Class IntoPure {PROP : bi} (P : PROP) (φ : Prop) := into_pure : P ⊢ ⌜φ⌝. Global Arguments IntoPure {_} _%I _%type_scope : simpl never. Global Arguments into_pure {_} _%I _%type_scope {_}. Global Hint Mode IntoPure + ! - : typeclass_instances. (* [IntoPureT] is a variant of [IntoPure] with the argument in [Type] to avoid some shortcoming of unification in Coq's type class search. An example where we use this workaround is to repair the following instance: Global Instance into_exist_and_pure P Q (φ : Prop) : IntoPure P φ → IntoExist (P ∧ Q) (λ _ : φ, Q). Coq is unable to use this instance: [class_apply] -- which is used by type class search -- fails with the error that it cannot unify [Prop] and [Type]. This is probably caused because [class_apply] uses an ancient unification algorith. The [refine] tactic -- which uses a better unification algorithm -- succeeds to apply the above instance. Since we do not want to define [Hint Extern] declarations using [refine] for any instance like [into_exist_and_pure], we factor this out in the class [IntoPureT]. This way, we only have to declare a [Hint Extern] using [refine] once, and use [IntoPureT] in any instance like [into_exist_and_pure]. TODO: Report this as a Coq bug, or wait for https://github.com/coq/coq/pull/991 to be finished and merged someday. *) Class IntoPureT {PROP : bi} (P : PROP) (φ : Type) := into_pureT : ∃ ψ : Prop, φ = ψ ∧ IntoPure P ψ. Lemma into_pureT_hint {PROP : bi} (P : PROP) (φ : Prop) : IntoPure P φ → IntoPureT P φ. Proof. by exists φ. Qed. Global Hint Extern 0 (IntoPureT _ _) => notypeclasses refine (into_pureT_hint _ _ _) : typeclass_instances. (** [FromPure a P φ] is used when introducing a pure assertion. It is used by [iPureIntro] and the [[%]] specialization pattern. The Boolean [a] specifies whether introduction of [P] needs [emp] in addition to [φ]. Concretely, for the [iPureIntro] tactic, this means it specifies whether the spatial context should be empty or not. Note that the Boolean [a] is not needed for the (dual) [IntoPure] class, because there we can just ask that [P] is [Affine]. *) Class FromPure {PROP : bi} (a : bool) (P : PROP) (φ : Prop) := from_pure : ?a ⌜φ⌝ ⊢ P. Global Arguments FromPure {_} _ _%I _%type_scope : simpl never. Global Arguments from_pure {_} _ _%I _%type_scope {_}. Global Hint Mode FromPure + - ! - : typeclass_instances. Class FromPureT {PROP : bi} (a : bool) (P : PROP) (φ : Type) := from_pureT : ∃ ψ : Prop, φ = ψ ∧ FromPure a P ψ. Lemma from_pureT_hint {PROP : bi} (a : bool) (P : PROP) (φ : Prop) : FromPure a P φ → FromPureT a P φ. Proof. by exists φ. Qed. Global Hint Extern 0 (FromPureT _ _ _) => notypeclasses refine (from_pureT_hint _ _ _ _) : typeclass_instances. Class IntoInternalEq `{BiInternalEq PROP} {A : ofe} (P : PROP) (x y : A) := into_internal_eq : P ⊢ x ≡ y. Global Arguments IntoInternalEq {_ _ _} _%I _%type_scope _%type_scope : simpl never. Global Arguments into_internal_eq {_ _ _} _%I _%type_scope _%type_scope {_}. Global Hint Mode IntoInternalEq + - - ! - - : typeclass_instances. Class IntoPersistent {PROP : bi} (p : bool) (P Q : PROP) := into_persistent : ?p P ⊢ Q. Global Arguments IntoPersistent {_} _ _%I _%I : simpl never. Global Arguments into_persistent {_} _ _%I _%I {_}. Global Hint Mode IntoPersistent + + ! - : typeclass_instances. (** The [FromModal φ M sel P Q] class is used by the [iModIntro] tactic to transform a goal [P] into a modality [M] and proposition [Q], under additional pure assumptions [φ]. The inputs are [P] and [sel] and the outputs are [M] and [Q]. The input [sel] can be used to specify which modality to introduce in case there are multiple choices to turn [P] into a modality. For example, given [⎡|==> R⎤], [sel] can be either [|==> ?e] or [⎡ ?e ⎤], which turn it into an update modality or embedding, respectively. In case there is no need to specify the modality to introduce, [sel] should be an evar. For modalities [N] that do not need to augment the proof mode environment, one can define an instance [FromModal True modality_id (N P) P]. Defining such an instance only imposes the proof obligation [P ⊢ N P]. Examples of such modalities [N] are [bupd], [fupd], [except_0], [monPred_subjectively] and [bi_absorbingly]. *) Class FromModal {PROP1 PROP2 : bi} {A} (φ : Prop) (M : modality PROP1 PROP2) (sel : A) (P : PROP2) (Q : PROP1) := from_modal : φ → M Q ⊢ P. Global Arguments FromModal {_ _ _} _ _ _%I _%I _%I : simpl never. Global Arguments from_modal {_ _ _} _ _ _ _%I _%I {_}. Global Hint Mode FromModal - + - - - - ! - : typeclass_instances. (** The [FromAffinely P Q] class is used to add an [] modality to the proposition [Q]. The input is [Q] and the output is [P]. *) Class FromAffinely {PROP : bi} (P Q : PROP) := from_affinely : Q ⊢ P. Global Arguments FromAffinely {_} _%I _%I : simpl never. Global Arguments from_affinely {_} _%I _%I {_}. Global Hint Mode FromAffinely + - ! : typeclass_instances. (** The [IntoAbsorbingly P Q] class is used to add an [] modality to the proposition [Q]. The input is [Q] and the output is [P]. *) Class IntoAbsorbingly {PROP : bi} (P Q : PROP) := into_absorbingly : P ⊢ Q. Global Arguments IntoAbsorbingly {_} _%I _%I. Global Arguments into_absorbingly {_} _%I _%I {_}. Global Hint Mode IntoAbsorbingly + - ! : typeclass_instances. (** Converting an assumption [R] into a wand [P -∗ Q] is done in three stages: - Strip modalities and universal quantifiers of [R] until an arrow or a wand has been obtained. - Balance modalities in the arguments [P] and [Q] to match the goal (which used for [iApply]) or the premise (when used with [iSpecialize] and a specific hypothesis). - Instantiate the premise of the wand or implication. *) Class IntoWand {PROP : bi} (p q : bool) (R P Q : PROP) := into_wand : □?p R ⊢ □?q P -∗ Q. Global Arguments IntoWand {_} _ _ _%I _%I _%I : simpl never. Global Arguments into_wand {_} _ _ _%I _%I _%I {_}. Global Hint Mode IntoWand + + + ! - - : typeclass_instances. Class IntoWand' {PROP : bi} (p q : bool) (R P Q : PROP) := into_wand' : IntoWand p q R P Q. Global Arguments IntoWand' {_} _ _ _%I _%I _%I : simpl never. Global Hint Mode IntoWand' + + + ! ! - : typeclass_instances. Global Hint Mode IntoWand' + + + ! - ! : typeclass_instances. Class FromWand {PROP : bi} (P Q1 Q2 : PROP) := from_wand : (Q1 -∗ Q2) ⊢ P. Global Arguments FromWand {_} _%I _%I _%I : simpl never. Global Arguments from_wand {_} _%I _%I _%I {_}. Global Hint Mode FromWand + ! - - : typeclass_instances. Class FromImpl {PROP : bi} (P Q1 Q2 : PROP) := from_impl : (Q1 → Q2) ⊢ P. Global Arguments FromImpl {_} _%I _%I _%I : simpl never. Global Arguments from_impl {_} _%I _%I _%I {_}. Global Hint Mode FromImpl + ! - - : typeclass_instances. Class FromSep {PROP : bi} (P Q1 Q2 : PROP) := from_sep : Q1 ∗ Q2 ⊢ P. Global Arguments FromSep {_} _%I _%I _%I : simpl never. Global Arguments from_sep {_} _%I _%I _%I {_}. Global Hint Mode FromSep + ! - - : typeclass_instances. (* For iSplit{L,R} *) Class FromAnd {PROP : bi} (P Q1 Q2 : PROP) := from_and : Q1 ∧ Q2 ⊢ P. Global Arguments FromAnd {_} _%I _%I _%I : simpl never. Global Arguments from_and {_} _%I _%I _%I {_}. Global Hint Mode FromAnd + ! - - : typeclass_instances. (** The [IntoAnd p P Q1 Q2] class is used to handle some [[H1 H2]] intro patterns: - [IntoAnd true] is used for such patterns in the intuitionistic context - [IntoAnd false] is used for such patterns where one of the two sides is discarded (e.g. [[_ H]]) or where the left-hand side is pure as in [[% H]] (via an [IntoExist] fallback). The inputs are [p P] and the outputs are [Q1 Q2]. *) Class IntoAnd {PROP : bi} (p : bool) (P Q1 Q2 : PROP) := into_and : □?p P ⊢ □?p (Q1 ∧ Q2). Global Arguments IntoAnd {_} _ _%I _%I _%I : simpl never. Global Arguments into_and {_} _ _%I _%I _%I {_}. Global Hint Mode IntoAnd + + ! - - : typeclass_instances. (** The [IntoSep P Q1 Q2] class is used to handle [[H1 H2]] intro patterns in the spatial context, except: - when one side is [_], then [IntoAnd] is tried first (but [IntoSep] is used as fallback) - when the left-hand side is [%], then [IntoExist] is used) The input is [P] and the outputs are [Q1 Q2]. *) Class IntoSep {PROP : bi} (P Q1 Q2 : PROP) := into_sep : P ⊢ Q1 ∗ Q2. Global Arguments IntoSep {_} _%I _%I _%I : simpl never. Global Arguments into_sep {_} _%I _%I _%I {_}. Global Hint Mode IntoSep + ! - - : typeclass_instances. Class FromOr {PROP : bi} (P Q1 Q2 : PROP) := from_or : Q1 ∨ Q2 ⊢ P. Global Arguments FromOr {_} _%I _%I _%I : simpl never. Global Arguments from_or {_} _%I _%I _%I {_}. Global Hint Mode FromOr + ! - - : typeclass_instances. Class IntoOr {PROP : bi} (P Q1 Q2 : PROP) := into_or : P ⊢ Q1 ∨ Q2. Global Arguments IntoOr {_} _%I _%I _%I : simpl never. Global Arguments into_or {_} _%I _%I _%I {_}. Global Hint Mode IntoOr + ! - - : typeclass_instances. Class FromExist {PROP : bi} {A} (P : PROP) (Φ : A → PROP) := from_exist : (∃ x, Φ x) ⊢ P. Global Arguments FromExist {_ _} _%I _%I : simpl never. Global Arguments from_exist {_ _} _%I _%I {_}. Global Hint Mode FromExist + - ! - : typeclass_instances. Class IntoExist {PROP : bi} {A} (P : PROP) (Φ : A → PROP) (name: ident_name) := into_exist : P ⊢ ∃ x, Φ x. Global Arguments IntoExist {_ _} _%I _%I _ : simpl never. Global Arguments into_exist {_ _} _%I _%I _ {_}. Global Hint Mode IntoExist + - ! - - : typeclass_instances. Class IntoForall {PROP : bi} {A} (P : PROP) (Φ : A → PROP) := into_forall : P ⊢ ∀ x, Φ x. Global Arguments IntoForall {_ _} _%I _%I : simpl never. Global Arguments into_forall {_ _} _%I _%I {_}. Global Hint Mode IntoForall + - ! - : typeclass_instances. Class FromForall {PROP : bi} {A} (P : PROP) (Φ : A → PROP) (name : ident_name) := from_forall : (∀ x, Φ x) ⊢ P. Global Arguments FromForall {_ _} _%I _%I _ : simpl never. Global Arguments from_forall {_ _} _%I _%I _ {_}. Global Hint Mode FromForall + - ! - - : typeclass_instances. Class IsExcept0 {PROP : bi} (Q : PROP) := is_except_0 : ◇ Q ⊢ Q. Global Arguments IsExcept0 {_} _%I : simpl never. Global Arguments is_except_0 {_} _%I {_}. Global Hint Mode IsExcept0 + ! : typeclass_instances. (** [CombineSepAs], [MaybeCombineSepAs] and [CombineSepGives] are all used for the [iCombine] tactic. These three classes take two hypotheses [P] and [Q] as input, and return a (possibly simplified) new hypothesis [R]. [CombineSepAs P Q R] means that [R] may be obtained by deleting both [P] and [Q], and that [R] is not a trivial combination. [MaybeCombineSepAs P Q R progress] is like [CombineSepAs], but [R] can be the trivial combination [P ∗ Q], and the [progress] parameter indicates whether this trivial combination is used. [CombineSepGives P Q R] means that [□ R] may be obtained 'for free' from [P] and [Q]. The result [R] of [CombineSepAs] and [MaybeCombineSepAs] will not contain the observations from [CombineSepGives]. We deliberately use separate typeclasses [CombineSepAs] and [CombineSepGives]. This allows one to (1) combine hypotheses and get additional persistent information, (2) only combine the hypotheses, without the additional persistent information, (3) only get the additional persistent information, while keeping the original hypotheses. A possible alternative would have been something like [CombineSepAsGives P1 P2 P R := combine_as_gives : P1 ∗ P2 ⊢ P ∗ □ R], but this was deemed to be harder to use. Specifically, this would force you to always specify both [P] and [R], even though one might only have a good candidate for [P], but not [R], or the other way around. Note that [FromSep] and [CombineSepAs] have nearly the same definition. However, they have different Hint Modes and are used for different tactics. [FromSep] is used to compute the two new goals obtained after applying [iSplitL]/[iSplitR], taking the current goal as input. [CombineSepAs] is used to combine two hypotheses into one. In terms of costs, note that the [AsFractional] instance for [CombineSepAs] has cost 50. If that instance should take priority over yours, make sure to use a higher cost. *) Class CombineSepAs {PROP : bi} (P Q R : PROP) := combine_sep_as : P ∗ Q ⊢ R. Global Arguments CombineSepAs {_} _%I _%I _%I : simpl never. Global Arguments combine_sep_as {_} _%I _%I _%I {_}. Global Hint Mode CombineSepAs + ! ! - : typeclass_instances. (** The [progress] parameter is of the following [progress_indicator] type: *) Inductive progress_indicator := MadeProgress | NoProgress. (** This aims to make [MaybeCombineSepAs] instances easier to read than if we had used Booleans. [NoProgress] indicates that the default instance [maybe_combine_sep_as_default] below has been used, while [MadeProgress] indicates that a [CombineSepAs] instance was used. *) Class MaybeCombineSepAs {PROP : bi} (P Q R : PROP) (progress : progress_indicator) := maybe_combine_sep_as : P ∗ Q ⊢ R. Global Arguments MaybeCombineSepAs {_} _%I _%I _%I _ : simpl never. Global Arguments maybe_combine_sep_as {_} _%I _%I _%I _ {_}. Global Hint Mode MaybeCombineSepAs + ! ! - - : typeclass_instances. Global Instance maybe_combine_sep_as_combine_sep_as {PROP : bi} (R P Q : PROP) : CombineSepAs P Q R → MaybeCombineSepAs P Q R MadeProgress | 20. Proof. done. Qed. Global Instance maybe_combine_sep_as_default {PROP : bi} (P Q : PROP) : MaybeCombineSepAs P Q (P ∗ Q) NoProgress | 100. Proof. intros. by rewrite /MaybeCombineSepAs. Qed. (** We do not have this Maybe construction for [CombineSepGives], nor do we provide the trivial [CombineSepGives P Q True]. This is by design: when the user writes down a 'gives' clause in the [iCombine] tactic, they intend to receive non-trivial information. If such information cannot be found, we want to produce an error, instead of the trivial hypothesis [True]. *) Class CombineSepGives {PROP : bi} (P Q R : PROP) := combine_sep_gives : P ∗ Q ⊢ R. Global Arguments CombineSepGives {_} _%I _%I _%I : simpl never. Global Arguments combine_sep_gives {_} _%I _%I _%I {_}. Global Hint Mode CombineSepGives + ! ! - : typeclass_instances. (** The [ElimModal φ p p' P P' Q Q'] class is used by the [iMod] tactic. The inputs are [p], [P] and [Q], and the outputs are [φ], [p'], [P'] and [Q']. The class is used to transform a hypothesis [P] into a hypothesis [P'], given a goal [Q], which is simultaneously transformed into [Q']. The Booleans [p] and [p'] indicate whether the original, respectively, updated hypothesis reside in the persistent context (iff [true]). The proposition [φ] can be used to express a side-condition that [iMod] will generate (if not [True]). An example instance is: ElimModal True p false (|={E1,E2}=> P) P (|={E1,E3}=> Q) (|={E2,E3}=> Q). This instance expresses that to eliminate [|={E1,E2}=> P] the goal is transformed from [|={E1,E3}=> Q] into [|={E2,E3}=> Q], and the resulting hypothesis is moved into the spatial context (regardless of where it was originally). A corresponding [ElimModal] instance for the Iris 1/2-style update modality, would have a side-condition [φ] on the masks. *) Class ElimModal {PROP : bi} (φ : Prop) (p p' : bool) (P P' : PROP) (Q Q' : PROP) := elim_modal : φ → □?p P ∗ (□?p' P' -∗ Q') ⊢ Q. Global Arguments ElimModal {_} _ _ _ _%I _%I _%I _%I : simpl never. Global Arguments elim_modal {_} _ _ _ _%I _%I _%I _%I {_}. Global Hint Mode ElimModal + - ! - ! - ! - : typeclass_instances. (* Used by the specialization pattern [ > ] in [iSpecialize] and [iAssert] to add a modality to the goal corresponding to a premise/asserted proposition. *) Class AddModal {PROP : bi} (P P' : PROP) (Q : PROP) := add_modal : P ∗ (P' -∗ Q) ⊢ Q. Global Arguments AddModal {_} _%I _%I _%I : simpl never. Global Arguments add_modal {_} _%I _%I _%I {_}. Global Hint Mode AddModal + - ! ! : typeclass_instances. Lemma add_modal_id {PROP : bi} (P Q : PROP) : AddModal P P Q. Proof. by rewrite /AddModal wand_elim_r. Qed. (** We use the classes [IsCons] and [IsApp] to make sure that instances such as [frame_big_sepL_cons] and [frame_big_sepL_app] cannot be applied repeatedly often when having [ [∗ list] k ↦ x ∈ ?e, Φ k x] with [?e] an evar. *) Class IsCons {A} (l : list A) (x : A) (k : list A) := is_cons : l = x :: k. Class IsApp {A} (l k1 k2 : list A) := is_app : l = k1 ++ k2. Global Hint Mode IsCons + ! - - : typeclass_instances. Global Hint Mode IsApp + ! - - : typeclass_instances. Global Instance is_cons_cons {A} (x : A) (l : list A) : IsCons (x :: l) x l. Proof. done. Qed. Global Instance is_app_app {A} (l1 l2 : list A) : IsApp (l1 ++ l2) l1 l2. Proof. done. Qed. (** [IsDisjUnion] is similar to [IsCons] and [IsApp] but identifies the [disj_union] operator. *) Class IsDisjUnion `{DisjUnion A} (X X1 X2 : A) := is_disj_union : X = X1 ⊎ X2. Global Hint Mode IsDisjUnion + + ! - - : typeclass_instances. Global Instance is_disj_union_disj_union `{DisjUnion A} (X1 X2 : A) : IsDisjUnion (X1 ⊎ X2) X1 X2. Proof. done. Qed. Class Frame {PROP : bi} (p : bool) (R P Q : PROP) := frame : □?p R ∗ Q ⊢ P. Global Arguments Frame {_} _ _%I _%I _%I. Global Arguments frame {_} _ _%I _%I _%I {_}. Global Hint Mode Frame + + ! ! - : typeclass_instances. (* The boolean [progress] indicates whether actual framing has been performed. If it is [false], then the default instance [maybe_frame_default] below has been used. [MaybeFrame'] instances should generally _not_ be used directly---instead, use the [MaybeFrame] notation defined below. *) Class MaybeFrame' {PROP : bi} (p : bool) (R P Q : PROP) (progress : bool) := maybe_frame : □?p R ∗ Q ⊢ P. Global Arguments MaybeFrame' {_} _ _%I _%I _%I _. Global Arguments maybe_frame {_} _ _%I _%I _%I _ {_}. Global Hint Mode MaybeFrame' + + ! - - - : typeclass_instances. Global Instance maybe_frame_frame {PROP : bi} p (R P Q : PROP) : Frame p R P Q → MaybeFrame' p R P Q true. Proof. done. Qed. Global Instance maybe_frame_default_persistent {PROP : bi} (R P : PROP) : MaybeFrame' true R P P false | 100. Proof. intros. rewrite /MaybeFrame' /=. by rewrite sep_elim_r. Qed. Global Instance maybe_frame_default {PROP : bi} (R P : PROP) : TCOr (Affine R) (Absorbing P) → MaybeFrame' false R P P false | 100. Proof. intros. rewrite /MaybeFrame' /=. apply: sep_elim_r. Qed. (* We never want to backtrack on instances of [MaybeFrame']. We provide a notation for [MaybeFrame'] wrapped in the [TCNoBackTrack] construct. For more details, see also iris!989 and the [frame_and] and [frame_or_spatial] instances in [class_instances_frame.v] *) Notation MaybeFrame p R P Q progress := (TCNoBackTrack (MaybeFrame' p R P Q progress)). (* The [iFrame] tactic is able to instantiate witnesses for existential quantifiers. We need a way to disable this behavior beneath connectives like [∀], [-∗] and [→], since it is often unwanted in these cases. Also see iris#565. We implement this using two (notations for) type classes: [FrameInstantiateExistDisabled] and [FrameInstantiateExistEnabled]. These are essentially 'flags' for type class search, and do not carry any information: [FrameInstantiateExistDisabled] is equivalent to [True], but does not come with any instances. Recursive [Frame] instances can disable instantiating existentials in their recursive search by replacing the recursive [Frame ...] premise with [(FrameInstantiateExistDisabled → Frame ...)]. This explicitly adds a [FrameInstantiateExistDisabled] hypothesis to the recursive [Frame] search, causing [FrameInstantiateExistDisabled] to have instances in that recursive search. This will disable the 'strong' instance that instantiates existential quantifiers, and instead enable a weaker instance that looks for a [Frame] that works for all possible instantiations. The weaker is enabled since we made [FrameInstantiateExistDisabled] one of its premises. *) Class FrameInstantiateExistDisabled : Prop := frame_instantiate_exist_disabled {}. (* The strong instance also has a new premise: an instance of the [FrameInstantiateExistEnabled] type class, defined using stdpp's [TCUnless]. *) Notation FrameInstantiateExistEnabled := (TCUnless FrameInstantiateExistDisabled). (* Since [TCUnless P] will only find an instance if no instance of [P] can be found, the addition of [FrameInstantiateExistDisabled] to the context disables the instantiation of existential quantifiers. *) Class IntoExcept0 {PROP : bi} (P Q : PROP) := into_except_0 : P ⊢ ◇ Q. Global Arguments IntoExcept0 {_} _%I _%I : simpl never. Global Arguments into_except_0 {_} _%I _%I {_}. Global Hint Mode IntoExcept0 + ! - : typeclass_instances. Global Hint Mode IntoExcept0 + - ! : typeclass_instances. (* The class [MaybeIntoLaterN] has only two instances: - The default instance [MaybeIntoLaterN n P P], i.e. [▷^n P -∗ P] - The instance [IntoLaterN n P Q → MaybeIntoLaterN n P Q], where [IntoLaterN] is identical to [MaybeIntoLaterN], but is supposed to make progress, i.e. it should actually strip a later. The point of using the auxilary class [IntoLaterN] is to ensure that the default instance is not applied deeply inside a term, which may result in too many definitions being unfolded (see issue #55). For binary connectives we have the following instances: << IntoLaterN n P P' MaybeIntoLaterN n Q Q' ------------------------------------------ IntoLaterN n (P /\ Q) (P' /\ Q') IntoLaterN n Q Q' ------------------------------- IntoLaterN n (P /\ Q) (P /\ Q') >> The Boolean [only_head] indicates whether laters should only be stripped in head position or also below other logical connectives. For [iNext] it should strip laters below other logical connectives, but this should not happen while framing, e.g. the following should succeed: << Lemma test_iFrame_later_1 P Q : P ∗ ▷ Q -∗ ▷ (P ∗ ▷ Q). Proof. iIntros "H". iFrame "H". Qed. >> *) Class MaybeIntoLaterN {PROP : bi} (only_head : bool) (n : nat) (P Q : PROP) := maybe_into_laterN : P ⊢ ▷^n Q. Global Arguments MaybeIntoLaterN {_} _ _%nat_scope _%I _%I. Global Arguments maybe_into_laterN {_} _ _%nat_scope _%I _%I {_}. Global Hint Mode MaybeIntoLaterN + + + - - : typeclass_instances. Class IntoLaterN {PROP : bi} (only_head : bool) (n : nat) (P Q : PROP) := #[global] into_laterN :: MaybeIntoLaterN only_head n P Q. Global Arguments IntoLaterN {_} _ _%nat_scope _%I _%I. Global Hint Mode IntoLaterN + + + ! - : typeclass_instances. Global Instance maybe_into_laterN_default {PROP : bi} only_head n (P : PROP) : MaybeIntoLaterN only_head n P P | 1000. Proof. apply laterN_intro. Qed. (* In the case both parameters are evars and n=0, we have to stop the search and unify both evars immediately instead of looping using other instances. *) Global Instance maybe_into_laterN_default_0 {PROP : bi} only_head (P : PROP) : MaybeIntoLaterN only_head 0 P P | 0. Proof. apply _. Qed. (** The class [IntoEmbed P Q] is used to transform hypotheses while introducing embeddings using [iModIntro]. Input: the proposition [P], output: the proposition [Q] so that [P ⊢ ⎡Q⎤]. *) Class IntoEmbed {PROP PROP' : bi} `{BiEmbed PROP PROP'} (P : PROP') (Q : PROP) := into_embed : P ⊢ ⎡Q⎤. Global Arguments IntoEmbed {_ _ _} _%I _%I. Global Arguments into_embed {_ _ _} _%I _%I {_}. Global Hint Mode IntoEmbed + + + ! - : typeclass_instances. (* We use two type classes for [AsEmpValid], in order to avoid loops in typeclass search. Indeed, the [as_emp_valid_embed] instance would try to add an arbitrary number of embeddings. To avoid this, the [AsEmpValid0] type class cannot handle embeddings, and therefore [as_emp_valid_embed] only tries to add one embedding, and we never try to insert nested embeddings. This has the additional advantage of always trying [as_emp_valid_embed] as a second option, so that this instance is never used when the BI is unknown. No Hint Modes are declared here. The appropriate one would be [Hint Mode - ! -], but the fact that Coq ignores primitive projections for hints modes would make this fail.*) Class AsEmpValid {PROP : bi} (φ : Prop) (P : PROP) := as_emp_valid : φ ↔ ⊢ P. Global Arguments AsEmpValid {_} _%type _%I. Class AsEmpValid0 {PROP : bi} (φ : Prop) (P : PROP) := as_emp_valid_0 : AsEmpValid φ P. Global Arguments AsEmpValid0 {_} _%type _%I. Global Existing Instance as_emp_valid_0 | 0. Lemma as_emp_valid_1 (φ : Prop) {PROP : bi} (P : PROP) `{!AsEmpValid φ P} : φ → ⊢ P. Proof. by apply as_emp_valid. Qed. Lemma as_emp_valid_2 (φ : Prop) {PROP : bi} (P : PROP) `{!AsEmpValid φ P} : (⊢ P) → φ. Proof. by apply as_emp_valid. Qed. (* Input: [P]; Outputs: [N], Extracts the namespace associated with an invariant assertion. Used for [iInv]. *) Class IntoInv {PROP : bi} (P: PROP) (N: namespace). Global Arguments IntoInv {_} _%I _. Global Hint Mode IntoInv + ! - : typeclass_instances. (** Accessors. This definition only exists for the purpose of the proof mode; a truly usable and general form would use telescopes and also allow binders for the closing view shift. [γ] is an [option] to make it easy for ElimAcc instances to recognize the [emp] case and make it look nicer. *) Definition accessor {PROP : bi} {X : Type} (M1 M2 : PROP → PROP) (α β : X → PROP) (mγ : X → option PROP) : PROP := M1 (∃ x, α x ∗ (β x -∗ M2 (default emp (mγ x))))%I. (* Typeclass for assertions around which accessors can be eliminated. Inputs: [Q], [E1], [E2], [α], [β], [γ] Outputs: [Q'], [φ] Elliminates an accessor [accessor E1 E2 α β γ] in goal [Q'], turning the goal into [Q'] with a new assumption [α x], where [φ] is a side-condition at the Cow level that needs to hold. *) Class ElimAcc {PROP : bi} {X : Type} (φ : Prop) (M1 M2 : PROP → PROP) (α β : X → PROP) (mγ : X → option PROP) (Q : PROP) (Q' : X → PROP) := elim_acc : φ → ((∀ x, α x -∗ Q' x) -∗ accessor M1 M2 α β mγ -∗ Q). Global Arguments ElimAcc {_} {_} _ _%I _%I _%I _%I _%I _%I : simpl never. Global Arguments elim_acc {_} {_} _ _%I _%I _%I _%I _%I _%I {_}. Global Hint Mode ElimAcc + ! - ! ! ! ! ! ! - : typeclass_instances. (* Turn [P] into an accessor. Inputs: - [Pacc]: the assertion to be turned into an accessor (e.g. an invariant) Outputs: - [Pin]: additional logic assertion needed for starting the accessor. - [φ]: additional Coq assertion needed for starting the accessor. - [X] [α], [β], [γ]: the accessor parameters. - [M1], [M2]: the two accessor modalities (they will typically still have some evars though, e.g. for the masks) *) Class IntoAcc {PROP : bi} {X : Type} (Pacc : PROP) (φ : Prop) (Pin : PROP) (M1 M2 : PROP → PROP) (α β : X → PROP) (mγ : X → option PROP) := into_acc : φ → Pacc -∗ Pin -∗ accessor M1 M2 α β mγ. Global Arguments IntoAcc {_} {_} _%I _ _%I _%I _%I _%I _%I _%I : simpl never. Global Arguments into_acc {_} {_} _%I _ _%I _%I _%I _%I _%I _%I {_} : simpl never. Global Hint Mode IntoAcc + - ! - - - - - - - : typeclass_instances. (* The typeclass used for the [iInv] tactic. Input: [Pinv] Other Arguments: - [Pinv] is an invariant assertion - [Pin] is an additional logic assertion needed for opening an invariant - [φ] is an additional Coq assertion needed for opening an invariant - [Pout] is the assertion obtained by opening the invariant - [Pclose] is the closing view shift. It must be (Some _) or None when doing typeclass search as instances are allowed to make a case distinction on whether the user wants a closing view-shift or not. - [Q] is a goal on which iInv may be invoked - [Q'] is the transformed goal that must be proved after opening the invariant. Most users will never want to instantiate this; there is a general instance based on [ElimAcc] and [IntoAcc]. However, logics like Iris 2 that support invariants but not mask-changing fancy updates can use this class directly to still benefit from [iInv]. *) Class ElimInv {PROP : bi} {X : Type} (φ : Prop) (Pinv Pin : PROP) (Pout : X → PROP) (mPclose : option (X → PROP)) (Q : PROP) (Q' : X → PROP) := elim_inv : φ → Pinv ∗ Pin ∗ (∀ x, Pout x ∗ (default (λ _, emp) mPclose) x -∗ Q' x) ⊢ Q. Global Arguments ElimInv {_} {_} _ _%I _%I _%I _%I _%I _%I : simpl never. Global Arguments elim_inv {_} {_} _ _%I _%I _%I _%I _%I _%I {_}. Global Hint Mode ElimInv + - - ! - - ! ! - : typeclass_instances. (** We make sure that tactics that perform actions on *specific* hypotheses or parts of the goal look through the [tc_opaque] connective, which is used to make definitions opaque for type class search. For example, when using [iDestruct], an explicit hypothesis is affected, and as such, we should look through opaque definitions. However, when using [iFrame] or [iNext], arbitrary hypotheses or parts of the goal are affected, and as such, type class opacity should be respected. This means that there are [tc_opaque] instances for all proofmode type classes with the exception of: - [FromAssumption] used by [iAssumption] - [Frame] and [MaybeFrame] used by [iFrame] - [MaybeIntoLaterN] and [FromLaterN] used by [iNext] - [IntoPersistent] used by [iIntuitionistic] *) Global Instance into_pure_tc_opaque {PROP : bi} (P : PROP) φ : IntoPure P φ → IntoPure (tc_opaque P) φ := id. Global Instance from_pure_tc_opaque {PROP : bi} (a : bool) (P : PROP) φ : FromPure a P φ → FromPure a (tc_opaque P) φ := id. Global Instance from_wand_tc_opaque {PROP : bi} (P Q1 Q2 : PROP) : FromWand P Q1 Q2 → FromWand (tc_opaque P) Q1 Q2 := id. Global Instance into_wand_tc_opaque {PROP : bi} p q (R P Q : PROP) : IntoWand p q R P Q → IntoWand p q (tc_opaque R) P Q := id. (* This instance has a very high cost. The tactic [iCombine] will look for [FromSep ?P Q1 Q2]. If the cost of this instance is low (and in particular, lower than the default instance [from_sep_sep], which picks [?P := Q1 * Q2]), then TC search would diverge. *) Global Instance from_sep_tc_opaque {PROP : bi} (P Q1 Q2 : PROP) : FromSep P Q1 Q2 → FromSep (tc_opaque P) Q1 Q2 | 102 := id. Global Instance from_and_tc_opaque {PROP : bi} (P Q1 Q2 : PROP) : FromAnd P Q1 Q2 → FromAnd (tc_opaque P) Q1 Q2 := id. Global Instance into_and_tc_opaque {PROP : bi} p (P Q1 Q2 : PROP) : IntoAnd p P Q1 Q2 → IntoAnd p (tc_opaque P) Q1 Q2 := id. Global Instance into_sep_tc_opaque {PROP : bi} (P Q1 Q2 : PROP) : IntoSep P Q1 Q2 → IntoSep (tc_opaque P) Q1 Q2 := id. Global Instance from_or_tc_opaque {PROP : bi} (P Q1 Q2 : PROP) : FromOr P Q1 Q2 → FromOr (tc_opaque P) Q1 Q2 := id. Global Instance into_or_tc_opaque {PROP : bi} (P Q1 Q2 : PROP) : IntoOr P Q1 Q2 → IntoOr (tc_opaque P) Q1 Q2 := id. Global Instance from_exist_tc_opaque {PROP : bi} {A} (P : PROP) (Φ : A → PROP) : FromExist P Φ → FromExist (tc_opaque P) Φ := id. Global Instance into_exist_tc_opaque {PROP : bi} {A} (P : PROP) (Φ : A → PROP) (name: ident_name) : IntoExist P Φ name → IntoExist (tc_opaque P) Φ name := id. Global Instance from_forall_tc_opaque {PROP : bi} {A} (P : PROP) (Φ : A → PROP) (name : ident_name) : FromForall P Φ name → FromForall (tc_opaque P) Φ name := id. Global Instance into_forall_tc_opaque {PROP : bi} {A} (P : PROP) (Φ : A → PROP) : IntoForall P Φ → IntoForall (tc_opaque P) Φ := id. Global Instance from_modal_tc_opaque {PROP1 PROP2 : bi} {A} φ M (sel : A) (P : PROP2) (Q : PROP1) : FromModal φ M sel P Q → FromModal φ M sel (tc_opaque P) Q := id. Global Instance elim_modal_tc_opaque {PROP : bi} φ p p' (P P' Q Q' : PROP) : ElimModal φ p p' P P' Q Q' → ElimModal φ p p' (tc_opaque P) P' Q Q' := id. Global Instance into_inv_tc_opaque {PROP : bi} (P : PROP) N : IntoInv P N → IntoInv (tc_opaque P) N := id. Global Instance elim_inv_tc_opaque {PROP : bi} {X} φ Pinv Pin Pout Pclose Q Q' : ElimInv (PROP:=PROP) (X:=X) φ Pinv Pin Pout Pclose Q Q' → ElimInv φ (tc_opaque Pinv) Pin Pout Pclose Q Q' := id. iris-iris-4.2.0/iris/proofmode/classes_make.v000066400000000000000000000172141460620107300212140ustar00rootroot00000000000000(** The [MakeX] classes are "smart constructors" for the logical connectives and modalities that perform some trivial logical simplifications to give "clean" results. For example, when framing below logical connectives/modalities, framing should remove connectives/modalities if the result of framing is [emp]. For example, when framing [P] (using [iFrame]) in goal [P ∗ Q], the result should be [Q]. The result should not be [emp ∗ Q], where [emp] would be the result of (recursively) framing [P] in [P]. Hence, in the recursive calls, the framing machinery uses the class [MakeSep P Q PQ]. If either [P] or [Q] is [emp] (or [True] in case of appropriate assumptions w.r.t. affinity), the result [PQ] is [Q] or [P], respectively. In other cases, the result is [PQ] is simply [P ∗ Q]. The [MakeX] classes are used in each recursive step of the framing machinery. Hence, they should be "constant time", which means that the number of steps in the inference search for [MakeX] should not depend on the size of the inputs. This implies that [MakeX] instances should not be recursive, and [MakeX] instances should not have premises of other classes with recursive instances. In particular, [MakeX] instances should not have [Affine] or [Absorbing] premises (because these could invoke a recursive search). Instances for [MakeX] instances typically look only at the top-level symbol of the input, or check if the whole BI is affine (via the [BiAffine] class) -- the latter can be linear in the size of [PROP] itself, but is still independent of the size of the term. One could imagine a smarter way of "cleaning up", as implemented in https://gitlab.mpi-sws.org/iris/iris/-/merge_requests/450 for some modalities, but that makes framing less predictable and might have some performance impact (i.e., not be constant time). Hence, we only perform such cleanup for [True] and [emp]. For each of the [MakeX] class, there is a [KnownMakeX] variant, which only succeeds if the parameter(s) is not an evar. In the case the parameter(s) is an evar, then [MakeX] will not instantiate it arbitrarily. The reason for this is that if given an evar, these classes would typically try to instantiate this evar with some arbitrary logical constructs such as [emp] or [True]. Therefore, we use a [Hint Mode] to disable all the instances that would have this behavior. In practice this means that usually only the default instance should use [MakeX], and most specialized instances should use [KnownMakeX]. *) From iris.bi Require Export bi. From iris.prelude Require Import options. (** Aliases for [Affine] and [Absorbing], but the instances are severely restricted. They only inspect the top-level symbol or check if the whole BI is affine. *) Class QuickAffine {PROP : bi} (P : PROP) := quick_affine : Affine P. Global Hint Mode QuickAffine + ! : typeclass_instances. Class QuickAbsorbing {PROP : bi} (P : PROP) := quick_absorbing : Absorbing P. Global Hint Mode QuickAbsorbing + ! : typeclass_instances. Class MakeEmbed {PROP PROP' : bi} `{BiEmbed PROP PROP'} (P : PROP) (Q : PROP') := make_embed : ⎡P⎤ ⊣⊢ Q. Global Arguments MakeEmbed {_ _ _} _%I _%I. Global Hint Mode MakeEmbed + + + - - : typeclass_instances. Class KnownMakeEmbed {PROP PROP' : bi} `{BiEmbed PROP PROP'} (P : PROP) (Q : PROP') := #[global] known_make_embed :: MakeEmbed P Q. Global Arguments KnownMakeEmbed {_ _ _} _%I _%I. Global Hint Mode KnownMakeEmbed + + + ! - : typeclass_instances. Class MakeSep {PROP : bi} (P Q PQ : PROP) := make_sep : P ∗ Q ⊣⊢ PQ . Global Arguments MakeSep {_} _%I _%I _%I. Global Hint Mode MakeSep + - - - : typeclass_instances. Class KnownLMakeSep {PROP : bi} (P Q PQ : PROP) := #[global] knownl_make_sep :: MakeSep P Q PQ. Global Arguments KnownLMakeSep {_} _%I _%I _%I. Global Hint Mode KnownLMakeSep + ! - - : typeclass_instances. Class KnownRMakeSep {PROP : bi} (P Q PQ : PROP) := #[global] knownr_make_sep :: MakeSep P Q PQ. Global Arguments KnownRMakeSep {_} _%I _%I _%I. Global Hint Mode KnownRMakeSep + - ! - : typeclass_instances. Class MakeAnd {PROP : bi} (P Q PQ : PROP) := make_and_l : P ∧ Q ⊣⊢ PQ. Global Arguments MakeAnd {_} _%I _%I _%I. Global Hint Mode MakeAnd + - - - : typeclass_instances. Class KnownLMakeAnd {PROP : bi} (P Q PQ : PROP) := #[global] knownl_make_and :: MakeAnd P Q PQ. Global Arguments KnownLMakeAnd {_} _%I _%I _%I. Global Hint Mode KnownLMakeAnd + ! - - : typeclass_instances. Class KnownRMakeAnd {PROP : bi} (P Q PQ : PROP) := #[global] knownr_make_and :: MakeAnd P Q PQ. Global Arguments KnownRMakeAnd {_} _%I _%I _%I. Global Hint Mode KnownRMakeAnd + - ! - : typeclass_instances. Class MakeOr {PROP : bi} (P Q PQ : PROP) := make_or_l : P ∨ Q ⊣⊢ PQ. Global Arguments MakeOr {_} _%I _%I _%I. Global Hint Mode MakeOr + - - - : typeclass_instances. Class KnownLMakeOr {PROP : bi} (P Q PQ : PROP) := #[global] knownl_make_or :: MakeOr P Q PQ. Global Arguments KnownLMakeOr {_} _%I _%I _%I. Global Hint Mode KnownLMakeOr + ! - - : typeclass_instances. Class KnownRMakeOr {PROP : bi} (P Q PQ : PROP) := #[global] knownr_make_or :: MakeOr P Q PQ. Global Arguments KnownRMakeOr {_} _%I _%I _%I. Global Hint Mode KnownRMakeOr + - ! - : typeclass_instances. Class MakeAffinely {PROP : bi} (P Q : PROP) := make_affinely : P ⊣⊢ Q. Global Arguments MakeAffinely {_} _%I _%I. Global Hint Mode MakeAffinely + - - : typeclass_instances. Class KnownMakeAffinely {PROP : bi} (P Q : PROP) := #[global] known_make_affinely :: MakeAffinely P Q. Global Arguments KnownMakeAffinely {_} _%I _%I. Global Hint Mode KnownMakeAffinely + ! - : typeclass_instances. Class MakeIntuitionistically {PROP : bi} (P Q : PROP) := make_intuitionistically : □ P ⊣⊢ Q. Global Arguments MakeIntuitionistically {_} _%I _%I. Global Hint Mode MakeIntuitionistically + - - : typeclass_instances. Class KnownMakeIntuitionistically {PROP : bi} (P Q : PROP) := #[global] known_make_intuitionistically :: MakeIntuitionistically P Q. Global Arguments KnownMakeIntuitionistically {_} _%I _%I. Global Hint Mode KnownMakeIntuitionistically + ! - : typeclass_instances. Class MakeAbsorbingly {PROP : bi} (P Q : PROP) := make_absorbingly : P ⊣⊢ Q. Global Arguments MakeAbsorbingly {_} _%I _%I. Global Hint Mode MakeAbsorbingly + - - : typeclass_instances. Class KnownMakeAbsorbingly {PROP : bi} (P Q : PROP) := #[global] known_make_absorbingly :: MakeAbsorbingly P Q. Global Arguments KnownMakeAbsorbingly {_} _%I _%I. Global Hint Mode KnownMakeAbsorbingly + ! - : typeclass_instances. Class MakePersistently {PROP : bi} (P Q : PROP) := make_persistently : P ⊣⊢ Q. Global Arguments MakePersistently {_} _%I _%I. Global Hint Mode MakePersistently + - - : typeclass_instances. Class KnownMakePersistently {PROP : bi} (P Q : PROP) := #[global] known_make_persistently :: MakePersistently P Q. Global Arguments KnownMakePersistently {_} _%I _%I. Global Hint Mode KnownMakePersistently + ! - : typeclass_instances. Class MakeLaterN {PROP : bi} (n : nat) (P lP : PROP) := make_laterN : ▷^n P ⊣⊢ lP. Global Arguments MakeLaterN {_} _%nat _%I _%I. Global Hint Mode MakeLaterN + + - - : typeclass_instances. Class KnownMakeLaterN {PROP : bi} (n : nat) (P lP : PROP) := #[global] known_make_laterN :: MakeLaterN n P lP. Global Arguments KnownMakeLaterN {_} _%nat _%I _%I. Global Hint Mode KnownMakeLaterN + + ! - : typeclass_instances. Class MakeExcept0 {PROP : bi} (P Q : PROP) := make_except_0 : ◇ P ⊣⊢ Q. Global Arguments MakeExcept0 {_} _%I _%I. Global Hint Mode MakeExcept0 + - - : typeclass_instances. Class KnownMakeExcept0 {PROP : bi} (P Q : PROP) := #[global] known_make_except_0 :: MakeExcept0 P Q. Global Arguments KnownMakeExcept0 {_} _%I _%I. Global Hint Mode KnownMakeExcept0 + ! - : typeclass_instances. iris-iris-4.2.0/iris/proofmode/coq_tactics.v000066400000000000000000001513371460620107300210630ustar00rootroot00000000000000From iris.bi Require Export bi telescopes. From iris.proofmode Require Export base environments classes classes_make modality_instances. From iris.prelude Require Import options. Import bi. Import env_notations. Local Open Scope lazy_bool_scope. (* Coq versions of the tactics *) Section tactics. Context {PROP : bi}. Implicit Types Γ : env PROP. Implicit Types Δ : envs PROP. Implicit Types P Q : PROP. (** * Starting and stopping the proof mode *) Lemma tac_start P : envs_entails (Envs Enil Enil 1) P → ⊢ P. Proof. rewrite envs_entails_unseal !of_envs_eq /=. rewrite left_id=><-. apply and_intro=> //. apply pure_intro; repeat constructor. Qed. Lemma tac_stop Δ P : (match env_intuitionistic Δ, env_spatial Δ with | Enil, Γs => env_to_prop Γs | Γp, Enil => □ env_to_prop_and Γp | Γp, Γs => □ env_to_prop_and Γp ∗ env_to_prop Γs end ⊢ P) → envs_entails Δ P. Proof. rewrite envs_entails_unseal !of_envs_eq. intros <-. rewrite and_elim_r. destruct (env_intuitionistic Δ). { rewrite env_to_prop_sound and_elim_r //. } cbv zeta. destruct (env_spatial Δ). - rewrite env_to_prop_and_pers_sound. rewrite comm. done. - rewrite env_to_prop_and_pers_sound env_to_prop_sound. rewrite /bi_affinely [(emp ∧ _)%I]comm -persistent_and_sep_assoc left_id //. Qed. (** * Basic rules *) Lemma tac_eval Δ Q Q' : (∀ (Q'':=Q'), Q'' ⊢ Q) → (* We introduce [Q''] as a let binding so that tactics like `reflexivity` as called by [rewrite //] do not eagerly unify it with [Q]. See [test_iEval] in [tests/proofmode]. *) envs_entails Δ Q' → envs_entails Δ Q. Proof. by intros <-. Qed. Lemma tac_eval_in Δ i p P P' Q : envs_lookup i Δ = Some (p, P) → (∀ (P'':=P'), P ⊢ P') → match envs_simple_replace i p (Esnoc Enil i P') Δ with | None => False | Some Δ' => envs_entails Δ' Q end → envs_entails Δ Q. Proof. destruct (envs_simple_replace _ _ _ _) as [Δ'|] eqn:Hrep; last done. rewrite envs_entails_unseal /=. intros ? HP ?. rewrite envs_simple_replace_singleton_sound //; simpl. by rewrite HP wand_elim_r. Qed. 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. Local 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_unseal (affine (of_envs Δ)). Qed. Lemma tac_assumption Δ i p P Q : envs_lookup i Δ = Some (p,P) → FromAssumption p P Q → (let Δ' := envs_delete true i p Δ in if env_spatial_is_nil Δ' then TCTrue else TCOr (Absorbing Q) (AffineEnv (env_spatial Δ'))) → envs_entails Δ Q. Proof. intros ?? H. rewrite envs_entails_unseal envs_lookup_sound //. simpl in *. 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_assumption_coq Δ P Q : (⊢ P) → FromAssumption false P Q → (if env_spatial_is_nil Δ then TCTrue else TCOr (Absorbing Q) (AffineEnv (env_spatial Δ))) → envs_entails Δ Q. Proof. rewrite /FromAssumption /bi_emp_valid /= => HP HPQ H. rewrite envs_entails_unseal -(left_id emp%I bi_sep (of_envs Δ)). rewrite HP HPQ. destruct (env_spatial_is_nil _) eqn:?. - by rewrite (env_spatial_is_nil_intuitionistically _) // sep_elim_l. - destruct H; by rewrite sep_elim_l. Qed. Lemma tac_rename Δ i j p P Q : envs_lookup i Δ = Some (p,P) → match envs_simple_replace i p (Esnoc Enil j P) Δ with | None => False | Some Δ' => envs_entails Δ' Q end → envs_entails Δ Q. Proof. destruct (envs_simple_replace _ _ _ _) as [Δ'|] eqn:Hrep; last done. rewrite envs_entails_unseal=> ??. rewrite envs_simple_replace_singleton_sound //. by rewrite wand_elim_r. Qed. Lemma tac_clear Δ i p P Q : envs_lookup i Δ = Some (p,P) → (if p then TCTrue else TCOr (Affine P) (Absorbing Q)) → envs_entails (envs_delete true i p Δ) Q → envs_entails Δ Q. Proof. rewrite envs_entails_unseal=> ?? HQ. rewrite envs_lookup_sound //. rewrite HQ. by destruct p; rewrite /= sep_elim_r. Qed. (** * False *) Lemma tac_ex_falso Δ Q : envs_entails Δ False → envs_entails Δ Q. Proof. by rewrite envs_entails_unseal -(False_elim Q). Qed. Lemma tac_false_destruct Δ i p P Q : envs_lookup i Δ = Some (p,P) → P = False%I → envs_entails Δ Q. Proof. rewrite envs_entails_unseal => ??. subst. rewrite envs_lookup_sound //; simpl. by rewrite intuitionistically_if_elim sep_elim_l False_elim. Qed. (** * Pure *) Lemma tac_pure_intro Δ Q φ a : FromPure a Q φ → (if a then AffineEnv (env_spatial Δ) else TCTrue) → φ → envs_entails Δ Q. Proof. intros ???. rewrite envs_entails_unseal -(from_pure a Q). destruct a; simpl. - by rewrite (affine (of_envs Δ)) pure_True // affinely_True_emp. - by apply pure_intro. Qed. Lemma tac_pure Δ i p P φ Q : envs_lookup i Δ = Some (p, P) → IntoPure P φ → (if p then TCTrue else TCOr (Affine P) (Absorbing Q)) → (φ → envs_entails (envs_delete true i p Δ) Q) → envs_entails Δ Q. Proof. rewrite envs_entails_unseal=> ?? HPQ HQ. rewrite envs_lookup_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 ⌜ _ ⌝) absorbingly_sep_lr. rewrite -persistent_and_affinely_sep_l. apply pure_elim_l=> ?. by rewrite HQ. Qed. Lemma tac_pure_revert Δ φ P Q : FromAffinely P ⌜ φ ⌝ → envs_entails Δ (P -∗ Q) → (φ → envs_entails Δ Q). Proof. rewrite /FromAffinely envs_entails_unseal. intros <- -> ?. by rewrite pure_True // affinely_True_emp left_id. Qed. (** * Intuitionistic *) Lemma tac_intuitionistic Δ i j p P P' Q : envs_lookup i Δ = Some (p, P) → IntoPersistent p P P' → (if p then TCTrue else TCOr (Affine P) (Absorbing Q)) → match envs_replace i p true (Esnoc Enil j P') Δ with | None => False | Some Δ' => envs_entails Δ' Q end → envs_entails Δ Q. Proof. destruct (envs_replace _ _ _ _ _) as [Δ'|] eqn:Hrep; last done. rewrite envs_entails_unseal=>?? HPQ HQ. rewrite envs_replace_singleton_sound //=. destruct p; simpl; rewrite /bi_intuitionistically. - by rewrite -(into_persistent true P) /= wand_elim_r. - destruct HPQ. + rewrite -(affine_affinely P) (_ : P = ?false P)%I // (into_persistent _ P) wand_elim_r //. + rewrite (_ : P = ?false P)%I // (into_persistent _ P). by rewrite -{1}absorbingly_intuitionistically_into_persistently absorbingly_sep_l wand_elim_r HQ. Qed. Lemma tac_spatial Δ i j p P P' Q : envs_lookup i Δ = Some (p, P) → (if p then FromAffinely P' P else TCEq P' P) → match envs_replace i p false (Esnoc Enil j P') Δ with | None => False | Some Δ' => envs_entails Δ' Q end → envs_entails Δ Q. Proof. intros ? HP. destruct (envs_replace _ _ _ _ _) as [Δ'|] eqn:Hrep; last done. rewrite envs_entails_unseal=> <-. rewrite envs_replace_singleton_sound //; simpl. destruct p; simpl; last destruct HP. - by rewrite intuitionistically_affinely (from_affinely P' P) wand_elim_r. - by rewrite wand_elim_r. Qed. (** * Implication and wand *) Lemma tac_impl_intro Δ i P P' Q R : FromImpl R P Q → (if env_spatial_is_nil Δ then TCTrue else Persistent P) → FromAffinely P' P → match envs_app false (Esnoc Enil i P') Δ with | None => False | Some Δ' => envs_entails Δ' Q end → envs_entails Δ R. Proof. destruct (envs_app _ _ _) eqn:?; last done. rewrite /FromImpl envs_entails_unseal => <- ???. 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' 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' P) persistent_and_affinely_sep_l_1 wand_elim_r. Qed. Lemma tac_impl_intro_intuitionistic Δ i P P' Q R : FromImpl R P Q → IntoPersistent false P P' → match envs_app true (Esnoc Enil i P') Δ with | None => False | Some Δ' => envs_entails Δ' Q end → envs_entails Δ R. Proof. destruct (envs_app _ _ _) eqn:?; last done. rewrite /FromImpl envs_entails_unseal => <- ??. rewrite envs_app_singleton_sound //=. apply impl_intro_l. rewrite (_ : P = ?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_unseal => <- ?. apply impl_intro_l. by rewrite and_elim_r. Qed. Lemma tac_wand_intro Δ i P Q R : FromWand R P Q → match envs_app false (Esnoc Enil i P) Δ with | None => False | Some Δ' => envs_entails Δ' Q end → envs_entails Δ R. Proof. destruct (envs_app _ _ _) as [Δ'|] eqn:Hrep; last done. rewrite /FromWand envs_entails_unseal => <- HQ. rewrite envs_app_sound //; simpl. by rewrite right_id HQ. Qed. Lemma tac_wand_intro_intuitionistic Δ i P P' Q R : FromWand R P Q → IntoPersistent false P P' → TCOr (Affine P) (Absorbing Q) → match envs_app true (Esnoc Enil i P') Δ with | None => False | Some Δ' => envs_entails Δ' Q end → envs_entails Δ R. Proof. destruct (envs_app _ _ _) as [Δ'|] eqn:Hrep; last done. rewrite /FromWand envs_entails_unseal => <- ? HPQ HQ. rewrite envs_app_singleton_sound //=. apply wand_intro_l. destruct HPQ. - rewrite -(affine_affinely P) (_ : P = ?false P)%I // (into_persistent _ P) wand_elim_r //. - rewrite (_ : P = ?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_drop Δ P Q R : FromWand R P Q → TCOr (Affine P) (Absorbing Q) → envs_entails Δ Q → envs_entails Δ R. Proof. rewrite envs_entails_unseal /FromWand => <- HPQ ->. apply wand_intro_l. by rewrite sep_elim_r. Qed. (* This is pretty much [tac_specialize_assert] with [js:=[j]] and [tac_exact], but it is doing some work to keep the order of hypotheses preserved. *) Lemma tac_specialize remove_intuitionistic Δ i p j q P1 P2 R Q : envs_lookup i Δ = Some (p, P1) → let Δ' := envs_delete remove_intuitionistic i p Δ in envs_lookup j Δ' = Some (q, R) → IntoWand q p R P1 P2 → match envs_replace j q (p &&& q) (Esnoc Enil j P2) Δ' with | Some Δ'' => envs_entails Δ'' Q | None => False end → envs_entails Δ Q. Proof. rewrite envs_entails_unseal /IntoWand. intros ?? HR ?. destruct (envs_replace _ _ _ _ _) as [Δ''|] eqn:?; last done. rewrite (envs_lookup_sound' _ remove_intuitionistic) //. rewrite envs_replace_singleton_sound //. destruct p; simpl in *. - rewrite -{1}intuitionistically_idemp -{1}intuitionistically_if_idemp. rewrite {1}(intuitionistically_intuitionistically_if q). by rewrite HR assoc intuitionistically_if_sep_2 !wand_elim_r. - by rewrite HR assoc !wand_elim_r. Qed. Lemma tac_specialize_assert Δ j (q am neg : bool) js R P1 P2 P1' Q : envs_lookup j Δ = Some (q, R) → IntoWand q false R P1 P2 → (if am then AddModal P1' P1 Q else TCEq P1' P1) → match '(Δ1,Δ2) ← envs_split (if neg is true then Right else Left) js (envs_delete true j q Δ); Δ2' ← envs_app (negb am &&& q &&& env_spatial_is_nil Δ1) (Esnoc Enil j P2) Δ2; Some (Δ1,Δ2') (* does not preserve position of [j] *) with | Some (Δ1,Δ2') => (* The constructor [conj] of [∧] still stores the contexts [Δ1] and [Δ2'] *) envs_entails Δ1 P1' ∧ envs_entails Δ2' Q | None => False end → envs_entails Δ Q. Proof. rewrite envs_entails_unseal. intros ?? Hmod HQ. destruct (_ ≫= _) as [[Δ1 Δ2']|] eqn:?; last done. destruct HQ as [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_singleton_sound Δ2) //; simpl. rewrite -intuitionistically_if_idemp (into_wand q false) /=. destruct (negb am &&& q &&& env_spatial_is_nil Δ1) eqn:Hp; simpl. - move: Hp. rewrite !lazy_andb_true negb_true. intros [[-> ->] ?]; simpl. destruct Hmod. rewrite env_spatial_is_nil_intuitionistically // HP1. by rewrite assoc intuitionistically_sep_2 wand_elim_l wand_elim_r HQ. - rewrite intuitionistically_if_elim HP1. destruct am; last destruct Hmod. + by rewrite assoc -(comm _ P1') -assoc wand_trans HQ. + by rewrite assoc wand_elim_l wand_elim_r HQ. Qed. Lemma tac_unlock_emp Δ Q : envs_entails Δ Q → envs_entails Δ (emp ∗ locked Q). Proof. rewrite envs_entails_unseal=> ->. by rewrite -lock left_id. Qed. Lemma tac_unlock_True Δ Q : envs_entails Δ Q → envs_entails Δ (True ∗ locked Q). Proof. rewrite envs_entails_unseal=> ->. 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 am : bool) R P1 P2 P1' Q Q' : envs_lookup j Δ = Some (q, R) → IntoWand q false R P1 P2 → (if am then AddModal P1' P1 Q else TCEq P1' P1) → envs_entails (envs_delete true j q Δ) (P1' ∗ locked Q') → Q' = (P2 -∗ Q)%I → envs_entails Δ Q. Proof. rewrite envs_entails_unseal. intros ?? Hmod HPQ ->. rewrite envs_lookup_sound //. rewrite HPQ -lock. rewrite (into_wand q false) /= assoc -(comm _ P1') -assoc wand_trans. destruct am; [done|destruct Hmod]. by rewrite wand_elim_r. Qed. Lemma tac_specialize_assert_pure Δ j q a R P1 P2 φ Q : envs_lookup j Δ = Some (q, R) → IntoWand q false R P1 P2 → FromPure a P1 φ → φ → match envs_simple_replace j q (Esnoc Enil j P2) Δ with | None => False | Some Δ' => envs_entails Δ' Q end → envs_entails Δ Q. Proof. destruct (envs_simple_replace _ _ _ _) as [Δ'|] eqn:?; last done. rewrite envs_entails_unseal=> ?????. rewrite envs_simple_replace_singleton_sound //=. rewrite -intuitionistically_if_idemp (into_wand q false) /=. rewrite -(from_pure a P1) pure_True //. rewrite -affinely_affinely_if affinely_True_emp. by rewrite left_id wand_elim_r. Qed. Lemma tac_specialize_assert_intuitionistic Δ j q P1 P1' P2 R Q : envs_lookup j Δ = Some (q, R) → IntoWand q true R P1 P2 → Persistent P1 → IntoAbsorbingly P1' P1 → envs_entails (envs_delete true j q Δ) P1' → match envs_simple_replace j q (Esnoc Enil j P2) Δ with | Some Δ'' => envs_entails Δ'' Q | None => False end → envs_entails Δ Q. Proof. rewrite envs_entails_unseal => ???? HP1 HQ. destruct (envs_simple_replace _ _ _ _) as [Δ''|] eqn:?; last done. rewrite -HQ envs_lookup_sound //. rewrite -(idemp bi_and (of_envs (envs_delete _ _ _ _))). rewrite {2}envs_simple_replace_singleton_sound' //; simpl. rewrite {1}HP1 (into_absorbingly P1' 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 q true) wand_elim_l wand_elim_r. Qed. Lemma tac_specialize_intuitionistic_helper Δ j q P R R' Q : envs_lookup j Δ = Some (q,P) → (if q then TCTrue else BiAffine PROP) → envs_entails Δ ( R) → IntoPersistent false R R' → match envs_replace j q true (Esnoc Enil j R') Δ with | Some Δ'' => envs_entails Δ'' Q | None => False end → envs_entails Δ Q. Proof. rewrite envs_entails_unseal => ?? HR ??. destruct (envs_replace _ _ _ _ _) as [Δ'|] eqn:?; last done. rewrite -(idemp bi_and (of_envs Δ)) {1}HR. rewrite envs_replace_singleton_sound //; destruct q; simpl. - by rewrite (_ : R = ?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 = ?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_intuitionistic_helper_done Δ i q P : envs_lookup i Δ = Some (q,P) → envs_entails Δ ( P). Proof. rewrite envs_entails_unseal /bi_absorbingly=> /envs_lookup_sound=> ->. rewrite intuitionistically_if_elim comm. f_equiv; auto using pure_intro. Qed. Lemma tac_revert Δ i Q : match envs_lookup_delete true i Δ with | Some (p,P,Δ') => envs_entails Δ' ((if p then □ P else P)%I -∗ Q) | None => False end → envs_entails Δ Q. Proof. rewrite envs_entails_unseal => HQ. destruct (envs_lookup_delete _ _ _) as [[[p P] Δ']|] eqn:?; last done. rewrite envs_lookup_delete_sound //=. rewrite HQ. destruct p; simpl; auto using wand_elim_r. Qed. 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 envs_entails_unseal /IntoIH bi.intuitionistically_elim. Qed. Global Instance into_ih_forall {A} (φ : A → Prop) Δ Φ : (∀ x, IntoIH (φ x) Δ (Φ x)) → IntoIH (∀ x, φ x) Δ (∀ x, Φ x) | 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. Proof. rewrite /IntoIH=> HΔ ?. apply impl_intro_l, pure_elim_l. auto. Qed. (** The instances [into_ih_Forall] and [into_ih_Forall2] are used to support induction principles for mutual inductive types such as finitely branching trees: Inductive ntree := Tree : list ntree → ntree. Lemma ntree_ind (P : ntree → Prop) : (∀ l, Forall P l → P (Tree l)) → ∀ t, P t. Note 1: We need an [IntoIH] instance for any predicate transformer (like [Forall]) that is used in induction principles. However, since nested induction with lists is most common, we currently only support [Forall] and [Forall2]. Note 2: We could also write the instance [into_ih_Forall] using the big operator for conjunction, or using the forall quantifier. We use the big operator because that corresponds most closely to [Forall], and we use the version with separating conjunction because we do not have a binary version of the big operator for conjunctions, and want to treat [Forall] and [Forall2] consistently. *) Global Instance into_ih_Forall {A} (φ : A → Prop) l Δ Φ : (∀ x, IntoIH (φ x) Δ (Φ x)) → IntoIH (Forall φ l) Δ ([∗ list] x ∈ l, □ Φ x) | 2. Proof. rewrite /IntoIH=> HΔ. induction 1 as [|x l ? IH]; simpl. { apply (affine _). } rewrite {1}intuitionistically_sep_dup. f_equiv; [|done]. apply intuitionistically_intro', HΔ; auto. Qed. Global Instance into_ih_Forall2 {A B} (φ : A → B → Prop) l1 l2 Δ Φ : (∀ x1 x2, IntoIH (φ x1 x2) Δ (Φ x1 x2)) → IntoIH (Forall2 φ l1 l2) Δ ([∗ list] x1;x2 ∈ l1;l2, □ Φ x1 x2) | 2. Proof. rewrite /IntoIH=> HΔ. induction 1 as [|x1 x2 l1 l2 ? IH]; simpl. { apply (affine _). } rewrite {1}intuitionistically_sep_dup. f_equiv; [|done]. apply intuitionistically_intro', HΔ; auto. Qed. Lemma tac_revert_ih Δ P Q {φ : Prop} (Hφ : φ) : IntoIH φ Δ P → env_spatial_is_nil Δ = true → envs_entails Δ ( P → Q) → envs_entails Δ Q. Proof. rewrite /IntoIH envs_entails_unseal. intros HP ? HPQ. rewrite (env_spatial_is_nil_intuitionistically Δ) //. rewrite -(idemp bi_and (□ (of_envs Δ))%I). rewrite -{1}intuitionistically_idemp {1}intuitionistically_into_persistently_1. by rewrite {1}HP // intuitionistically_elim HPQ impl_elim_r. Qed. Lemma tac_assert Δ j P Q : match envs_app true (Esnoc Enil j (P -∗ P)%I) Δ with | None => False | Some Δ' => envs_entails Δ' Q end → envs_entails Δ Q. Proof. destruct (envs_app _ _ _) as [Δ'|] eqn:?; last done. rewrite envs_entails_unseal=> ?. rewrite (envs_app_singleton_sound Δ) //; simpl. by rewrite -(entails_wand P) // intuitionistically_emp emp_wand. Qed. Definition IntoEmpValid (φ : Type) (P : PROP) := φ → ⊢ P. (** These lemmas are [Defined] because the guardedness checker must see through them. See https://gitlab.mpi-sws.org/iris/iris/issues/274. For the same reason, their bodies use as little automation as possible. *) Lemma into_emp_valid_here φ P : AsEmpValid φ P → IntoEmpValid φ P. Proof. by intros [??]. Defined. Lemma into_emp_valid_impl (φ ψ : Type) P : φ → IntoEmpValid ψ P → IntoEmpValid (φ → ψ) P. Proof. rewrite /IntoEmpValid => Hφ Hi1 Hi2. apply Hi1, Hi2, Hφ. Defined. Lemma into_emp_valid_forall {A} (φ : A → Type) P x : IntoEmpValid (φ x) P → IntoEmpValid (∀ x : A, φ x) P. Proof. rewrite /IntoEmpValid => Hi1 Hi2. apply Hi1, Hi2. Defined. Lemma into_emp_valid_tforall {TT : tele} (φ : TT → Prop) P x : IntoEmpValid (φ x) P → IntoEmpValid (∀.. x : TT, φ x) P. Proof. rewrite /IntoEmpValid tforall_forall=> Hi1 Hi2. apply Hi1, Hi2. Defined. Lemma into_emp_valid_proj φ P : IntoEmpValid φ P → φ → ⊢ P. Proof. intros HP. apply HP. Defined. (** When called by the proof mode, the proof of [P] is produced by calling [into_emp_valid_proj]. That call must be transparent to the guardedness checker, per https://gitlab.mpi-sws.org/iris/iris/issues/274; hence, it must be done _outside_ [tac_pose_proof], so the latter can remain opaque. *) Lemma tac_pose_proof Δ j P Q : (⊢ P) → match envs_app true (Esnoc Enil j P) Δ with | None => False | Some Δ' => envs_entails Δ' Q end → envs_entails Δ Q. Proof. destruct (envs_app _ _ _) as [Δ'|] eqn:?; last done. rewrite envs_entails_unseal => HP <-. rewrite envs_app_singleton_sound //=. by rewrite -HP /= intuitionistically_emp emp_wand. Qed. Lemma tac_pose_proof_hyp Δ i j Q : match envs_lookup_delete false i Δ with | None => False | Some (p, P, Δ') => match envs_app p (Esnoc Enil j P) Δ' with | None => False | Some Δ'' => envs_entails Δ'' Q end end → envs_entails Δ Q. Proof. destruct (envs_lookup_delete _ _ _) as [((p&P)&Δ')|] eqn:Hlookup; last done. destruct (envs_app _ _ _) as [Δ''|] eqn:?; last done. rewrite envs_entails_unseal. move: Hlookup. rewrite envs_lookup_delete_Some. intros [? ->] <-. rewrite envs_lookup_sound' // envs_app_singleton_sound //=. by rewrite wand_elim_r. Qed. Lemma tac_apply Δ i p R P1 P2 : envs_lookup i Δ = Some (p, R) → IntoWand p false R P1 P2 → envs_entails (envs_delete true i p Δ) P1 → envs_entails Δ P2. Proof. rewrite envs_entails_unseal => ?? HP1. rewrite envs_lookup_sound //. by rewrite (into_wand p false) /= HP1 wand_elim_l. Qed. (** * Conjunction splitting *) Lemma tac_and_split Δ P Q1 Q2 : FromAnd P Q1 Q2 → envs_entails Δ Q1 → envs_entails Δ Q2 → envs_entails Δ P. Proof. rewrite envs_entails_unseal. intros. rewrite -(from_and P). by apply and_intro. Qed. (** * Separating conjunction splitting *) Lemma tac_sep_split Δ d js P Q1 Q2 : FromSep P Q1 Q2 → match envs_split d js Δ with | None => False | Some (Δ1,Δ2) => envs_entails Δ1 Q1 ∧ envs_entails Δ2 Q2 end → envs_entails Δ P. Proof. destruct (envs_split _ _ _) as [(Δ1&Δ2)|] eqn:?; last done. rewrite envs_entails_unseal=>? [HQ1 HQ2]. rewrite envs_split_sound //. by rewrite HQ1 HQ2. Qed. (** * Combining For the [iCombine] tactic, users provide a [Ps : list PROP] which should be combined to a single [PROP]. The (public) classes currently available, [MaybeCombineSepAs] and [CombineSepGives], can combine two given [PROP]s. The following [CombineSepsAs] and [CombineSepsAsGives] typeclasses are an implementation detail of [iCombine], lifting the combining operation to one on [list PROP]. Computing the 'gives' clause for a list of hypotheses is somewhat involved. We cannot just fold [CombineSepGives] over the list, since the output of the first [CombineSepGives] is not suitable as the input for the next iteration. For example, one might have [CombineSepGives (own γ a) (own γ b) (✓ (a ⋅ b))]. This does not directly allow us to combine [[own γ a; own γ b; own γ c]] to [✓ (a ⋅ b ⋅ c)], since [CombineSepGives (✓ (b ⋅ c)) (own γ a) ?] does not work. We need to first compute the 'as' clause of the tail to proceed: that is, use the fact that the 'as' clause of [[own γ b; own γ c]] is [own γ (b ⋅ c)]. We could let [CombineSepsAs] compute the 'as' clause of the tail separately, but this results in quadratic complexity. We therefore bundle both clauses in the [CombineSepsAsGives] typeclass given below. Note that an alternative would be to compute pairwise 'gives' clauses of the head of the list with every element in the tail, and [∧]-ing that with the 'gives' clause of the tail. In the example above, this would result in [✓ (a ⋅ b) ∧ ✓ (a ⋅ c) ∧ ✓ (b ⋅ c)]. This approach is not strong enough: it does not allow us to conclude [✓ (a ⋅ b ⋅ c)]. *) Class CombineSepsAsGives {PROP : bi} (Ps : list PROP) (Q R : PROP) := { combine_seps_as_gives_as : [∗] Ps ⊢ Q; combine_seps_as_gives_gives : [∗] Ps ⊢ R; }. Global Hint Mode CombineSepsAsGives + ! - - : typeclass_instances. Global Arguments CombineSepsAsGives {_} _%I _%I _%I. Global Arguments combine_seps_as_gives_as {_} _%I _%I _%I {_}. Global Arguments combine_seps_as_gives_gives {_} _%I _%I _%I {_}. Global Instance combine_seps_as_gives_nil : @CombineSepsAsGives PROP [] emp True. Proof. split; first done. rewrite persistently_True. by apply pure_intro. Qed. Global Instance combine_seps_as_gives_singleton P : CombineSepsAsGives [P] P True | 1. Proof. split; first by rewrite /= right_id. rewrite persistently_True. by apply pure_intro. Qed. Global Instance combine_seps_gives_cons P Ps Q R Q' progress R' R'': CombineSepsAsGives Ps Q R → (* [Q] and [R] are result from combining tail *) MaybeCombineSepAs P Q Q' progress → (* [Q'] is [P] and [Q] combined *) CombineSepGives P Q R' → (* [R'] is obtained for free from [P] and [Q] *) MakeAnd R R' R'' → (* [R''] is nicely and-ing [R] and [R'] *) CombineSepsAsGives (P :: Ps) Q' R'' | 2. (** By and-ing [R] and [R'], the resulting 'gives' clause [R''] will contain redundant information in some cases. However, this is necessary in other cases. For example, if we take [Ps = [own γ q1; own γ q2; own γ q3]] with [fracR] as the cmra, we get [R'' = (q2 + q3 ≤ 1) ∧ (q1 + q2 + q3 ≤ 1)]. Here, the first conjunct [R] follows from the second [R'], so there is redundancy. However, if we take [Ps = [own γ (CoPset E1); own γ (CoPset E2); own γ (CoPset E3)]] with [coPset_disjR] as the cmra, we get [R'' = (E2 ## E3) ∧ (E1 ## (E2 ∪ E3))], where the first conjunct does not follow from the second conjunct. Similarly for [Ps = [l ↦{q1} v1; l ↦{q2} v2; l ↦ {q3} v3]], where [R'' = (v1 = v2) ∧ (v2 = v3) ∧ {..other info about qs..}]. *) Proof. case => HPsQ. rewrite /CombineSepGives /MakeAnd => HPsR HQ' HR' HR''. split; first by rewrite /= HPsQ HQ'. rewrite -HR'' /=. rewrite persistently_and. apply and_intro. - by rewrite HPsR sep_elim_r. - by rewrite HPsQ. Qed. (** If just the 'as' clause is needed, we will instead look for instances of the following [CombineSepsAs] typeclass. *) Class CombineSepsAs {PROP : bi} (Ps : list PROP) (Q : PROP) := combine_seps_as : [∗] Ps ⊢ Q. Global Hint Mode CombineSepsAs + ! - : typeclass_instances. Global Arguments CombineSepsAs {_} _%I _%I. Global Arguments combine_seps_as {_} _%I _%I {_}. (** To ensure consistency of the output [Q] with that of [CombineSepsAsGives], the only instance of [CombineSepsAs] is constructed with an instance of [CombineSepsAsGives]. The one thing we need to keep in mind here is that instances of [CombineSepsAsGives] can only be found if [CombineSepGives] instances exist. Unlike for the 'as' clause, there is no trivial 'gives' combination --- if the user writes a 'gives' clause, they intend to receive non-trivial information, and should receive an error if this cannot be found. To still allow trivial combining with an 'as' clause, we add a trivial [CombineSepGives] instance _only_ during the typeclass search of [CombineSepsAs] via [CombineSepsAsGives]. This means we both get consistent output [Q] from [CombineSepsAsGives] and [CombineSepsAs], while [iCombine "H1 H2" gives "H"] still fails if "H1" and "H2" are unrelated *) Global Instance combine_seps_as_from_as_gives Ps Q R : ((∀ P P', CombineSepGives P P' True%I) → CombineSepsAsGives Ps Q R) → CombineSepsAs Ps Q. Proof. move => HPsQ. apply HPsQ. move => P P'. rewrite /CombineSepGives. rewrite persistently_True. by apply pure_intro. Qed. Lemma tac_combine_as Δ1 Δ2 Δ3 js p Ps j P Q : envs_lookup_delete_list false js Δ1 = Some (p, Ps, Δ2) → CombineSepsAs Ps P → envs_app p (Esnoc Enil j P) Δ2 = Some Δ3 → envs_entails Δ3 Q → envs_entails Δ1 Q. Proof. rewrite envs_entails_unseal => ??? <-. rewrite envs_lookup_delete_list_sound //. rewrite combine_seps_as. rewrite envs_app_singleton_sound //=. by rewrite wand_elim_r. Qed. Lemma combine_seps_gives_of_envs Δ1 Δ2 js p Ps P R : envs_lookup_delete_list false js Δ1 = Some (p, Ps, Δ2) → CombineSepsAsGives Ps P R → of_envs Δ1 ⊢ of_envs Δ1 ∗ □ R. Proof. move => ??. assert (of_envs Δ1 ⊢ of_envs Δ1 ∧ R) as H. { apply and_intro; first done. rewrite envs_lookup_delete_list_sound //. by rewrite combine_seps_as_gives_gives intuitionistically_if_elim sep_elim_l. } by rewrite {1}H persistently_and_intuitionistically_sep_r. Qed. Lemma tac_combine_gives Δ1 Δ2 Δ3 js p Ps j P Q R : envs_lookup_delete_list false js Δ1 = Some (p, Ps, Δ2) → CombineSepsAsGives Ps P R → envs_app true (Esnoc Enil j R) Δ1 = Some Δ3 → envs_entails Δ3 Q → envs_entails Δ1 Q. Proof. rewrite envs_entails_unseal => ??? <-. erewrite combine_seps_gives_of_envs => //. rewrite envs_app_singleton_sound //=. by apply wand_elim_l'. Qed. Lemma tac_combine_as_gives Δ1 Δ2 Δ3 js p Ps j k P R Q : envs_lookup_delete_list false js Δ1 = Some (p, Ps, Δ2) → CombineSepsAsGives Ps P R → (* this □ is okay, since we will call iDestructHyp anyway *) envs_app p (Esnoc (Esnoc Enil j P) k (□ R)%I) Δ2 = Some Δ3 → envs_entails Δ3 Q → envs_entails Δ1 Q. Proof. rewrite envs_entails_unseal => ??? <-. rewrite (combine_seps_gives_of_envs _ _ _ _ Ps) //. rewrite envs_lookup_delete_list_sound //. rewrite combine_seps_as_gives_as envs_app_sound //. destruct p => /=. - rewrite right_id affinely_and -!intuitionistically_def. rewrite intuitionistically_idemp and_sep_intuitionistically. by rewrite -(comm _ (□ R)%I) assoc wand_elim_r. - by rewrite right_id -(comm _ (□ R)%I) assoc 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) → (if p then IntoAnd true P P1 P2 else IntoSep P P1 P2) → match envs_simple_replace i p (Esnoc (Esnoc Enil j1 P1) j2 P2) Δ with | None => False | Some Δ' => envs_entails Δ' Q end → envs_entails Δ Q. Proof. destruct (envs_simple_replace _ _ _ _) as [Δ'|] eqn:Hrep; last done. rewrite envs_entails_unseal. intros. rewrite envs_simple_replace_sound //=. destruct p. - rewrite (into_and _ P) /= right_id (comm _ P1). rewrite -persistently_and 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) → (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)))) → match envs_simple_replace i p (Esnoc Enil j (if d is Left then P1 else P2)) Δ with | None => False | Some Δ' => envs_entails Δ' Q end → envs_entails Δ Q. Proof. destruct (envs_simple_replace _ _ _ _) as [Δ'|] eqn:Hrep; last done. rewrite envs_entails_unseal => ? 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_unseal => ? Hframe ->. rewrite -Hframe /=. 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 i Δ = Some (p, R) → Frame p R P Q → envs_entails (envs_delete false i p Δ) Q → envs_entails Δ P. Proof. rewrite envs_entails_unseal. intros ? Hframe HQ. rewrite (envs_lookup_sound' _ false) //. by rewrite -Hframe HQ. Qed. (** * Disjunction *) Lemma tac_or_l Δ P Q1 Q2 : FromOr P Q1 Q2 → envs_entails Δ Q1 → envs_entails Δ P. Proof. rewrite envs_entails_unseal=> ? ->. 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_unseal=> ? ->. rewrite -(from_or P). by apply or_intro_r'. Qed. Lemma tac_or_destruct Δ i p j1 j2 P P1 P2 Q : envs_lookup i Δ = Some (p, P) → IntoOr P P1 P2 → match envs_simple_replace i p (Esnoc Enil j1 P1) Δ, envs_simple_replace i p (Esnoc Enil j2 P2) Δ with | Some Δ1, Some Δ2 => envs_entails Δ1 Q ∧ envs_entails Δ2 Q | _, _ => False end → envs_entails Δ Q. Proof. destruct (envs_simple_replace i p (Esnoc Enil j1 P1)) as [Δ1|] eqn:?; last done. destruct (envs_simple_replace i p (Esnoc Enil j2 P2)) as [Δ2|] eqn:?; last done. rewrite envs_entails_unseal. 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 → PROP) Q name : FromForall Q Φ name → ( (* see [tac_exist_destruct] for an explanation of this let binding *) let _ := name in ∀ a, envs_entails Δ (Φ a)) → envs_entails Δ Q. Proof. rewrite envs_entails_unseal /FromForall=> <-. apply forall_intro. Qed. Lemma tac_forall_specialize {A} Δ i p P (Φ : A → PROP) Q : envs_lookup i Δ = Some (p, P) → IntoForall P Φ → (∃ x : A, match envs_simple_replace i p (Esnoc Enil i (Φ x)) Δ with | None => False | Some Δ' => envs_entails Δ' Q end) → envs_entails Δ Q. Proof. rewrite envs_entails_unseal. intros ?? (x&?). destruct (envs_simple_replace) as [Δ'|] eqn:?; last done. 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 → PROP) : envs_entails Δ (∀ a, Φ a) → ∀ a, envs_entails Δ (Φ a). Proof. rewrite envs_entails_unseal => HΔ a. by rewrite HΔ (forall_elim a). Qed. (** * Existential *) Lemma tac_exist {A} Δ P (Φ : A → PROP) : FromExist P Φ → (∃ a, envs_entails Δ (Φ a)) → envs_entails Δ P. Proof. rewrite envs_entails_unseal => ? [a ?]. rewrite -(from_exist P). eauto using exist_intro'. Qed. Lemma tac_exist_destruct {A} Δ i p j P (Φ : A → PROP) (name: ident_name) Q : envs_lookup i Δ = Some (p, P) → IntoExist P Φ name → ( (* this let binding makes it easy for the tactic [iExistDestruct] to use [name] (from resolving [IntoExist] in an earlier subgoal) within this goal *) let _ := name in ∀ a, match envs_simple_replace i p (Esnoc Enil j (Φ a)) Δ with | Some Δ' => envs_entails Δ' Q | None => False end) → envs_entails Δ Q. Proof. rewrite envs_entails_unseal => ?? HΦ. rewrite envs_lookup_sound //. rewrite (into_exist P) intuitionistically_if_exist sep_exist_r. apply exist_elim=> a; specialize (HΦ a) as Hmatch. destruct (envs_simple_replace _ _ _ _) as [Δ'|] eqn:Hrep; last done. rewrite envs_simple_replace_singleton_sound' //; simpl. by rewrite wand_elim_r. Qed. (** * Modalities *) Lemma tac_modal_elim Δ i j p p' φ P' P Q Q' : envs_lookup i Δ = Some (p, P) → ElimModal φ p p' P P' Q Q' → φ → match envs_replace i p p' (Esnoc Enil j P') Δ with | None => False | Some Δ' => envs_entails Δ' Q' end → envs_entails Δ Q. Proof. destruct (envs_replace _ _ _ _ _) as [Δ'|] eqn:?; last done. rewrite envs_entails_unseal => ??? HΔ. rewrite envs_replace_singleton_sound //=. rewrite HΔ. by eapply elim_modal. Qed. (** * Accumulate hypotheses *) Lemma tac_accu Δ P : env_to_prop (env_spatial Δ) = P → envs_entails Δ P. Proof. rewrite envs_entails_unseal=><-. rewrite env_to_prop_sound !of_envs_eq and_elim_r and_elim_r //. Qed. (** * Invariants *) Lemma tac_inv_elim {X : Type} Δ i j φ p Pinv Pin Pout (Pclose : option (X → PROP)) Q (Q' : X → PROP) : envs_lookup i Δ = Some (p, Pinv) → ElimInv φ Pinv Pin Pout Pclose Q Q' → φ → (∀ R, match envs_app false (Esnoc Enil j (Pin -∗ (∀ x, Pout x -∗ pm_option_fun Pclose x -∗? Q' x) -∗ R )%I) (envs_delete false i p Δ) with Some Δ'' => envs_entails Δ'' R | None => False end) → envs_entails Δ Q. Proof. rewrite envs_entails_unseal=> ? Hinv ? /(_ Q) Hmatch. destruct (envs_app _ _ _) eqn:?; last done. rewrite -Hmatch (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. (** * Rewriting *) Lemma tac_rewrite `{!BiInternalEq PROP} Δ i p Pxy d Q : envs_lookup i Δ = Some (p, Pxy) → ∀ {A : ofe} (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_unseal. 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 `{!BiInternalEq PROP} Δ i p Pxy j q P d Q : envs_lookup i Δ = Some (p, Pxy) → envs_lookup j Δ = Some (q, P) → ∀ {A : ofe} (x y : A) (Φ : A → PROP), IntoInternalEq Pxy x y → (P ⊣⊢ Φ (if d is Left then y else x)) → NonExpansive Φ → match envs_simple_replace j q (Esnoc Enil j (Φ (if d is Left then x else y))) Δ with | None => False | Some Δ' => envs_entails Δ' Q end → envs_entails Δ Q. Proof. rewrite envs_entails_unseal /IntoInternalEq => ?? A x y Φ HPxy HP ? Hentails. destruct (envs_simple_replace _ _ _ _) as [Δ'|] eqn:?; last done. rewrite -Hentails. rewrite -(idemp bi_and (of_envs Δ)) {2}(envs_lookup_sound _ i) //. rewrite (envs_simple_replace_singleton_sound _ _ j) //=. rewrite HP HPxy (intuitionistically_if_elim _ (_ ≡ _)) 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. (** * Löb *) Lemma tac_löb Δ i Q : BiLöb PROP → env_spatial_is_nil Δ = true → match envs_app true (Esnoc Enil i (▷ Q)%I) Δ with | None => False | Some Δ' => envs_entails Δ' Q end → envs_entails Δ Q. Proof. destruct (envs_app _ _ _) as [Δ'|] eqn:?; last done. rewrite envs_entails_unseal => ?? HQ. rewrite (env_spatial_is_nil_intuitionistically Δ) //. rewrite envs_app_singleton_sound //; simpl. rewrite HQ. apply löb_wand_intuitionistically. Qed. End tactics. (** * Introduction of modalities *) (** The following _private_ classes are used internally by [tac_modal_intro] / [iModIntro] to transform the proofmode environments when introducing a modality. The class [TransformIntuitionisticEnv M C Γin Γout] is used to transform the intuitionistic 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 TransformIntuitionisticEnv {PROP1 PROP2} (M : modality PROP1 PROP2) (C : PROP2 → PROP1 → Prop) (Γin : env PROP2) (Γout : env PROP1) := { transform_intuitionistic_env : (∀ P Q, C P Q → □ P ⊢ M (□ Q)) → (∀ P Q, M P ∧ M Q ⊢ M (P ∧ Q)) → env_and_persistently Γin ⊢ M ( env_and_persistently Γout); transform_intuitionistic_env_wf : env_wf Γin → env_wf Γout; transform_intuitionistic_env_dom i : Γin !! i = None → Γout !! i = None; }. (* The class [TransformSpatialEnv M C Γin Γout filtered] is used to transform the spatial 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 [IntoModalIntuitionisticEnv M Γin Γout s] is used to transform the intuitionistic 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 IntoModalIntuitionisticEnv {PROP2} : ∀ {PROP1} (M : modality PROP1 PROP2) (Γin : env PROP2) (Γout : env PROP1), modality_action PROP1 PROP2 → Prop := | MIEnvIsEmpty_intuitionistic {PROP1} (M : modality PROP1 PROP2) : IntoModalIntuitionisticEnv M Enil Enil MIEnvIsEmpty | MIEnvForall_intuitionistic (M : modality PROP2 PROP2) (C : PROP2 → Prop) Γ : TCForall C (env_to_list Γ) → IntoModalIntuitionisticEnv M Γ Γ (MIEnvForall C) | MIEnvTransform_intuitionistic {PROP1} (M : modality PROP1 PROP2) (C : PROP2 → PROP1 → Prop) Γin Γout : TransformIntuitionisticEnv M C Γin Γout → IntoModalIntuitionisticEnv M Γin Γout (MIEnvTransform C) | MIEnvClear_intuitionistic {PROP1 : bi} (M : modality PROP1 PROP2) Γ : IntoModalIntuitionisticEnv M Γ Enil MIEnvClear | MIEnvId_intuitionistic (M : modality PROP2 PROP2) Γ : IntoModalIntuitionisticEnv M Γ Γ MIEnvId. Existing Class IntoModalIntuitionisticEnv. Global Existing Instances MIEnvIsEmpty_intuitionistic MIEnvForall_intuitionistic MIEnvTransform_intuitionistic MIEnvClear_intuitionistic MIEnvId_intuitionistic. (* 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. Global 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_intuitionistic_env_nil C : TransformIntuitionisticEnv M C Enil Enil. Proof. split; [|eauto using Enil_wf|done]=> /= ??. rewrite !affinely_True_emp -modality_emp //. Qed. Global Instance transform_intuitionistic_env_snoc (C : PROP2 → PROP1 → Prop) Γ Γ' i P Q : C P Q → TransformIntuitionisticEnv M C Γ Γ' → TransformIntuitionisticEnv M C (Esnoc Γ i P) (Esnoc Γ' i Q). Proof. intros ? [HΓ Hwf Hdom]; split; simpl. - intros HC Hand. rewrite -Hand. apply and_intro. + rewrite -modality_emp affinely_elim_emp. done. + rewrite affinely_and HΓ //. rewrite /bi_intuitionistically in HC. rewrite HC //. rewrite !affinely_elim. eauto. - inversion 1; constructor; auto. - intros j. destruct (ident_beq _ _); naive_solver. Qed. Global Instance transform_intuitionistic_env_snoc_not (C : PROP2 → PROP1 → Prop) Γ Γ' i P : TransformIntuitionisticEnv M C Γ Γ' → TransformIntuitionisticEnv 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)). - 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 → IntoModalIntuitionisticEnv 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_unseal /FromModal !of_envs_eq => HQ' HΓp HΓs ? Hφ 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. } trans (?fi Q')%I; last first. { destruct fi; last done. apply: absorbing. } simpl. rewrite -(HQ' Hφ). rewrite -HQ pure_True // left_id. clear HQ' HQ. rewrite !persistent_and_affinely_sep_l. rewrite -modality_sep absorbingly_if_sep. f_equiv. - rewrite -absorbingly_if_intro. remember (modality_intuitionistic_action M). destruct HΓp as [? M|M C Γp ?%TCForall_Forall|? M C Γp Γp' []|? M Γp|M Γp]; simpl. + rewrite !affinely_True_emp. apply modality_emp. + eauto using modality_intuitionistic_forall_big_and. + eauto using modality_intuitionistic_transform, modality_and_transform. + by rewrite {1}affinely_elim_emp affinely_True_emp (modality_emp M). + eauto using modality_intuitionistic_id_big_and. - remember (modality_spatial_action M). destruct HΓs as [? M|M C Γs ?%TCForall_Forall|? M C Γs Γs' fi []|? M Γs|M Γs]; simpl. + by rewrite modality_emp. + rewrite {1}(modality_spatial_forall_big_sep _ _ Γs) //. + destruct fi. * rewrite /= /bi_absorbingly (comm _ True%I). eauto using modality_spatial_transform. * rewrite /= -(right_id emp%I bi_sep (M _)). eauto using modality_spatial_transform. + rewrite -{1}(modality_spatial_clear M) // -modality_emp. rewrite absorbingly_emp_True. apply True_intro. + rewrite {1}(modality_spatial_id M ([∗] Γs)) //. Qed. End tac_modal_intro. (** The class [MaybeIntoLaterNEnvs] is used by tactics that need to introduce laters, e.g., the symbolic execution tactics. *) Class MaybeIntoLaterNEnvs {PROP : bi} (n : nat) (Δ1 Δ2 : envs PROP) := { into_later_intuitionistic : TransformIntuitionisticEnv (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 {PROP : bi} n (Γp1 Γp2 Γs1 Γs2 : env PROP) m : TransformIntuitionisticEnv (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 {PROP : bi} n (Δ1 Δ2 : envs PROP) : MaybeIntoLaterNEnvs n Δ1 Δ2 → of_envs Δ1 ⊢ ▷^n (of_envs Δ2). Proof. intros [[Hp ??] [Hs ??]]; rewrite !of_envs_eq. rewrite ![(env_and_persistently _ ∧ _)%I]persistent_and_affinely_sep_l. rewrite !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. iris-iris-4.2.0/iris/proofmode/environments.v000066400000000000000000001072351460620107300213140ustar00rootroot00000000000000From iris.prelude Require Export prelude. From iris.bi Require Export bi. From iris.proofmode Require Import base. From iris.prelude Require Import options. Import bi. Inductive env (A : Type) : Type := | Enil : env A | Esnoc : env A → ident → A → env A. Global Arguments Enil {_}. Global Arguments Esnoc {_} _ _ _. Global Instance: Params (@Enil) 1 := {}. Global Instance: Params (@Esnoc) 1 := {}. Fixpoint env_lookup {A} (i : ident) (Γ : env A) : option A := match Γ with | Enil => None | Esnoc Γ j x => if ident_beq i j then Some x else env_lookup i Γ end. Module env_notations. Notation "y ≫= f" := (pm_option_bind f y). Notation "x ← y ; z" := (y ≫= λ x, z). Notation "' x1 ← y ; z" := (y ≫= (λ x1, z)). Notation "Γ !! j" := (env_lookup j Γ). End env_notations. Import env_notations. Local Open Scope lazy_bool_scope. Inductive env_wf {A} : env A → Prop := | Enil_wf : env_wf Enil | Esnoc_wf Γ i x : Γ !! i = None → env_wf Γ → env_wf (Esnoc Γ i x). Fixpoint env_to_list {A} (E : env A) : list A := match E with Enil => [] | Esnoc Γ _ x => x :: env_to_list Γ end. Coercion env_to_list : env >-> list. Global Instance: Params (@env_to_list) 1 := {}. Fixpoint env_dom {A} (Γ : env A) : list ident := match Γ with Enil => [] | Esnoc Γ i _ => i :: env_dom Γ end. Fixpoint env_app {A} (Γapp : env A) (Γ : env A) : option (env A) := match Γapp with | Enil => Some Γ | Esnoc Γapp i x => Γ' ← env_app Γapp Γ; match Γ' !! i with None => Some (Esnoc Γ' i x) | Some _ => None end end. Fixpoint env_replace {A} (i: ident) (Γi: env A) (Γ: env A) : option (env A) := match Γ with | Enil => None | Esnoc Γ j x => if ident_beq i j then env_app Γi Γ else match Γi !! j with | None => Γ' ← env_replace i Γi Γ; Some (Esnoc Γ' j x) | Some _ => None end end. Fixpoint env_delete {A} (i : ident) (Γ : env A) : env A := match Γ with | Enil => Enil | Esnoc Γ j x => if ident_beq i j then Γ else Esnoc (env_delete i Γ) j x end. Fixpoint env_lookup_delete {A} (i : ident) (Γ : env A) : option (A * env A) := match Γ with | Enil => None | Esnoc Γ j x => if ident_beq i j then Some (x,Γ) else '(y,Γ') ← env_lookup_delete i Γ; Some (y, Esnoc Γ' j x) end. Inductive env_Forall2 {A B} (P : A → B → Prop) : env A → env B → Prop := | env_Forall2_nil : env_Forall2 P Enil Enil | env_Forall2_snoc Γ1 Γ2 i x y : env_Forall2 P Γ1 Γ2 → P x y → env_Forall2 P (Esnoc Γ1 i x) (Esnoc Γ2 i y). Inductive env_subenv {A} : relation (env A) := | env_subenv_nil : env_subenv Enil Enil | env_subenv_snoc Γ1 Γ2 i x : env_subenv Γ1 Γ2 → env_subenv (Esnoc Γ1 i x) (Esnoc Γ2 i x) | env_subenv_skip Γ1 Γ2 i y : env_subenv Γ1 Γ2 → env_subenv Γ1 (Esnoc Γ2 i y). Section env. Context {A : Type}. Implicit Types Γ : env A. Implicit Types i : ident. Implicit Types x : A. Local Hint Resolve Esnoc_wf Enil_wf : core. Ltac simplify := repeat match goal with | _ => 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 [pm_option_bind _ ?x] |- _ => destruct x eqn:? | |- context [pm_option_bind _ ?x] => destruct x eqn:? | _ => case_match end. Lemma env_lookup_perm Γ i x : Γ !! i = Some x → Γ ≡ₚ x :: env_delete i Γ. Proof. induction Γ; intros; simplify; rewrite 1?Permutation_swap; f_equiv; eauto. Qed. Lemma env_lookup_snoc Γ i P : env_lookup i (Esnoc Γ i P) = Some P. Proof. induction Γ; simplify; auto. Qed. Lemma env_lookup_snoc_ne Γ i j P : i ≠ j → env_lookup i (Esnoc Γ j P) = env_lookup i Γ. Proof. induction Γ=> ?; simplify; auto. Qed. Lemma env_app_perm Γ Γapp Γ' : env_app Γapp Γ = Some Γ' → env_to_list Γ' ≡ₚ Γapp ++ Γ. Proof. revert Γ'; induction Γapp; intros; simplify; f_equal; auto. Qed. Lemma env_app_fresh Γ Γapp Γ' i : env_app Γapp Γ = Some Γ' → Γapp !! i = None → Γ !! i = None → Γ' !! i = None. Proof. revert Γ'. induction Γapp; intros; simplify; eauto. Qed. Lemma env_app_fresh_1 Γ Γapp Γ' i x : env_app Γapp Γ = Some Γ' → Γ' !! i = None → Γ !! i = None. Proof. revert Γ'. induction Γapp; intros; simplify; eauto. Qed. Lemma env_app_disjoint Γ Γapp Γ' i : env_app Γapp Γ = Some Γ' → Γapp !! i = None ∨ Γ !! i = None. Proof. revert Γ'. induction Γapp; intros; simplify; naive_solver eauto using env_app_fresh_1. Qed. Lemma env_app_wf Γ Γapp Γ' : env_app Γapp Γ = Some Γ' → env_wf Γ → env_wf Γ'. Proof. revert Γ'. induction Γapp; intros; simplify; eauto. Qed. Lemma env_replace_fresh Γ Γj Γ' i j : env_replace j Γj Γ = Some Γ' → Γj !! i = None → env_delete j Γ !! i = None → Γ' !! i = None. Proof. revert Γ'. induction Γ; intros; simplify; eauto using env_app_fresh. Qed. Lemma env_replace_wf Γ Γi Γ' i : env_replace i Γi Γ = Some Γ' → env_wf (env_delete i Γ) → env_wf Γ'. Proof. revert Γ'. induction Γ; intros ??; simplify; [|inversion_clear 1]; eauto using env_app_wf, env_replace_fresh. Qed. Lemma env_replace_lookup Γ Γi Γ' i : env_replace i Γi Γ = Some Γ' → is_Some (Γ !! i). Proof. revert Γ'. induction Γ; intros; simplify; eauto. Qed. Lemma env_replace_perm Γ Γi Γ' i : env_replace i Γi Γ = Some Γ' → Γ' ≡ₚ Γi ++ env_delete i Γ. Proof. revert Γ'. induction Γ as [|Γ IH j y]=>Γ' ?; simplify; auto using env_app_perm. rewrite -Permutation_middle -IH //. Qed. Lemma env_lookup_delete_correct Γ i : env_lookup_delete i Γ = (x ← Γ !! i; Some (x,env_delete i Γ)). Proof. induction Γ; intros; simplify; eauto. Qed. Lemma env_lookup_delete_Some Γ Γ' i x : env_lookup_delete i Γ = Some (x,Γ') ↔ Γ !! i = Some x ∧ Γ' = env_delete i Γ. Proof. rewrite env_lookup_delete_correct; simplify; naive_solver. Qed. Lemma env_lookup_env_delete Γ j : env_wf Γ → env_delete j Γ !! j = None. Proof. induction 1; intros; simplify; eauto. Qed. Lemma env_lookup_env_delete_ne Γ i j : i ≠ j → env_delete j Γ !! i = Γ !! i. Proof. induction Γ; intros; simplify; eauto. Qed. Lemma env_delete_fresh Γ i j : Γ !! i = None → env_delete j Γ !! i = None. Proof. induction Γ; intros; simplify; eauto. Qed. Lemma env_delete_wf Γ j : env_wf Γ → env_wf (env_delete j Γ). Proof. induction 1; simplify; eauto using env_delete_fresh. Qed. Global Instance env_Forall2_refl (P : relation A) : Reflexive P → Reflexive (env_Forall2 P). Proof. intros ? Γ. induction Γ; constructor; auto. Qed. Global Instance env_Forall2_sym (P : relation A) : Symmetric P → Symmetric (env_Forall2 P). Proof. induction 2; constructor; auto. Qed. Global Instance env_Forall2_trans (P : relation A) : Transitive P → Transitive (env_Forall2 P). Proof. intros ? Γ1 Γ2 Γ3 HΓ; revert Γ3. induction HΓ; inversion_clear 1; constructor; eauto. Qed. Global Instance env_Forall2_antisymm (P Q : relation A) : AntiSymm P Q → AntiSymm (env_Forall2 P) (env_Forall2 Q). Proof. induction 2; inversion_clear 1; constructor; auto. Qed. Lemma env_Forall2_impl {B} (P Q : A → B → Prop) Γ Σ : env_Forall2 P Γ Σ → (∀ x y, P x y → Q x y) → env_Forall2 Q Γ Σ. Proof. induction 1; constructor; eauto. Qed. Global Instance Esnoc_proper (P : relation A) : Proper (env_Forall2 P ==> (=) ==> P ==> env_Forall2 P) Esnoc. Proof. intros Γ1 Γ2 HΓ i ? <-; by constructor. Qed. Global Instance env_to_list_proper (P : relation A) : Proper (env_Forall2 P ==> Forall2 P) env_to_list. Proof. induction 1; constructor; auto. Qed. Lemma env_Forall2_fresh {B} (P : A → B → Prop) Γ Σ i : env_Forall2 P Γ Σ → Γ !! i = None → Σ !! i = None. Proof. by induction 1; simplify. Qed. Lemma env_Forall2_wf {B} (P : A → B → Prop) Γ Σ : env_Forall2 P Γ Σ → env_wf Γ → env_wf Σ. Proof. induction 1; inversion_clear 1; eauto using env_Forall2_fresh. Qed. Lemma env_subenv_fresh Γ Σ i : env_subenv Γ Σ → Σ !! i = None → Γ !! i = None. Proof. by induction 1; simplify. Qed. Lemma env_subenv_wf Γ Σ : env_subenv Γ Σ → env_wf Σ → env_wf Γ. Proof. induction 1; inversion_clear 1; eauto using env_subenv_fresh. Qed. 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 (** A counter to generate fresh hypothesis names *) }. Add Printing Constructor envs. Global Arguments Envs {_} _ _ _. Global Arguments env_intuitionistic {_} _. Global Arguments env_spatial {_} _. Global Arguments env_counter {_} _. (** We now define the judgment [envs_entails Δ Q] for proof mode entailments. This judgment expresses that [Q] can be proved under the proof mode environment [Δ]. To improve performance and to encapsulate the internals of the proof mode (i.e. to ensure that tactics like [intro] cannot accidentally unfold the entailment), we seal off [envs_entails]. The way the the definitions below are setup involves some trickery so we can implement the [iFresh] tactic, which increases the counter [env_counter], in an efficient way. Concretely, we made sure that [envs_entails (Envs Γp Γs c) Q] and [envs_entails (Envs Γp Γs c') Q] are convertible for any [c] and [c']. This way, [iFresh] can simply be implemented by changing the goal from [envs_entails (Envs Γp Γs c) Q] into [envs_entails (Envs Γp Γs (Pos_succ c)) Q] using the tactic [change_no_check]. This way, the generated proof term contains no additional steps for changing the counter. We first define a version [pre_envs_entails] that takes the two contexts [env_intuitionistic] and [env_spatial] as its arguments. We seal this definition and then lift it to take the whole proof mode context [Δ : envs PROP]. This is crucial to make sure that the counter [env_counter] is not part of the seal. *) Record envs_wf' {PROP : bi} (Γp Γs : env PROP) := { env_intuitionistic_valid : env_wf Γp; env_spatial_valid : env_wf Γs; envs_disjoint i : Γp !! i = None ∨ Γs !! i = None }. Definition envs_wf {PROP : bi} (Δ : envs PROP) := envs_wf' (env_intuitionistic Δ) (env_spatial Δ). Notation env_and_persistently Γ := ([∧ list] P ∈ env_to_list Γ, P)%I. Definition of_envs' {PROP : bi} (Γp Γs : env PROP) : PROP := (⌜envs_wf' Γp Γs⌝ ∧ env_and_persistently Γp ∧ [∗] Γs)%I. Global Instance: Params (@of_envs') 1 := {}. Definition of_envs {PROP : bi} (Δ : envs PROP) : PROP := of_envs' (env_intuitionistic Δ) (env_spatial Δ). Global Instance: Params (@of_envs) 1 := {}. Global Arguments of_envs : simpl never. Local Definition pre_envs_entails_def {PROP : bi} (Γp Γs : env PROP) (Q : PROP) := of_envs' Γp Γs ⊢ Q. Local Definition pre_envs_entails_aux : seal (@pre_envs_entails_def). Proof. by eexists. Qed. Local Definition pre_envs_entails := pre_envs_entails_aux.(unseal). Local Definition pre_envs_entails_unseal : @pre_envs_entails = @pre_envs_entails_def := pre_envs_entails_aux.(seal_eq). Definition envs_entails {PROP : bi} (Δ : envs PROP) (Q : PROP) : Prop := pre_envs_entails PROP (env_intuitionistic Δ) (env_spatial Δ) Q. Definition envs_entails_unseal : @envs_entails = λ PROP (Δ : envs PROP) Q, (of_envs Δ ⊢ Q). Proof. by rewrite /envs_entails pre_envs_entails_unseal. Qed. Global Arguments envs_entails {PROP} Δ Q%I. Global 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_intuitionistic : bool) (i : ident) (p : bool) (Δ : envs PROP) : envs PROP := let (Γp,Γs,n) := Δ in match p with | true => Envs (if remove_intuitionistic then env_delete i Γp else Γp) Γs n | false => Envs Γp (env_delete i Γs) n end. Definition envs_lookup_delete {PROP} (remove_intuitionistic : 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_intuitionistic 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_intuitionistic : 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_intuitionistic j Δ; '(q,Ps,Δ'') ← envs_lookup_delete_list remove_intuitionistic js Δ'; Some ((p:bool) &&& q, P :: Ps, Δ'') 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_intuitionistic {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). Fixpoint env_to_prop_go {PROP : bi} (acc : PROP) (Γ : env PROP) : PROP := match Γ with Enil => acc | Esnoc Γ _ P => env_to_prop_go (P ∗ acc)%I Γ end. Definition env_to_prop {PROP : bi} (Γ : env PROP) : PROP := match Γ with Enil => emp%I | Esnoc Γ _ P => env_to_prop_go P Γ end. Fixpoint env_to_prop_and_go {PROP : bi} (acc : PROP) (Γ : env PROP) : PROP := match Γ with Enil => acc | Esnoc Γ _ P => env_to_prop_and_go (P ∧ acc)%I Γ end. Definition env_to_prop_and {PROP : bi} (Γ : env PROP) : PROP := match Γ with Enil => True%I | Esnoc Γ _ P => env_to_prop_and_go P Γ end. Section envs. Context {PROP : bi}. Implicit Types Γ Γp Γs : env PROP. Implicit Types Δ : envs PROP. Implicit Types P Q : PROP. Lemma of_envs_eq Δ : of_envs Δ = (⌜envs_wf Δ⌝ ∧ env_and_persistently (env_intuitionistic Δ) ∧ [∗] env_spatial Δ)%I. Proof. done. Qed. Lemma of_envs'_alt Γp Γs : of_envs' Γp Γs ⊣⊢ ⌜envs_wf' Γp Γs⌝ ∧ □ [∧] Γp ∗ [∗] Γs. Proof. rewrite /of_envs'. f_equiv. rewrite -persistent_and_affinely_sep_l. f_equiv. clear. induction Γp as [|Γp IH ? Q]; simpl. { apply (anti_symm (⊢)); last by apply True_intro. by rewrite persistently_True. } rewrite IH persistently_and. done. Qed. Lemma of_envs_alt Δ : of_envs Δ ⊣⊢ ⌜envs_wf Δ⌝ ∧ □ [∧] env_intuitionistic Δ ∗ [∗] env_spatial Δ. Proof. rewrite /of_envs of_envs'_alt //. 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 PROP) : Symmetric R → Symmetric (envs_Forall2 R). Proof. intros ??? [??]; by constructor. Qed. 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 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 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 env_intuitionistic_mono : Proper (envs_Forall2 (⊢) ==> env_Forall2 (⊢)) (@env_intuitionistic PROP). Proof. solve_proper. Qed. Global Instance env_intuitionistic_flip_mono : Proper (flip (envs_Forall2 (⊢)) ==> flip (env_Forall2 (⊢))) (@env_intuitionistic PROP). Proof. solve_proper. Qed. Global Instance env_intuitionistic_proper : Proper (envs_Forall2 (⊣⊢) ==> env_Forall2 (⊣⊢)) (@env_intuitionistic PROP). Proof. solve_proper. Qed. Global Instance env_spatial_mono : Proper (envs_Forall2 (⊢) ==> env_Forall2 (⊢)) (@env_spatial PROP). Proof. solve_proper. Qed. Global Instance env_spatial_flip_mono : Proper (flip (envs_Forall2 (⊢)) ==> flip (env_Forall2 (⊢))) (@env_spatial PROP). Proof. solve_proper. Qed. Global Instance env_spatial_proper : Proper (envs_Forall2 (⊣⊢) ==> env_Forall2 (⊣⊢)) (@env_spatial PROP). Proof. solve_proper. Qed. Global Instance of_envs_mono' : Proper (env_Forall2 (⊢) ==> env_Forall2 (⊢) ==> (⊢)) (@of_envs' PROP). Proof. intros Γp1 Γp2 Hp Γs1 Γs2 Hs; apply and_mono; simpl in *. - apply pure_mono=> -[???]. constructor; naive_solver eauto using env_Forall2_wf, env_Forall2_fresh. - f_equiv; [|by repeat f_equiv]. induction Hp; simpl; repeat (done || f_equiv). Qed. Global Instance of_envs_proper' : Proper (env_Forall2 (⊣⊢) ==> env_Forall2 (⊣⊢) ==> (⊣⊢)) (@of_envs' PROP). Proof. intros Γp1 Γp2 Hp Γs1 Γs2 Hs; apply (anti_symm (⊢)); apply of_envs_mono'; eapply (env_Forall2_impl (⊣⊢)); by eauto using equiv_entails_1_1. Qed. Global Instance of_envs_mono : Proper (envs_Forall2 (⊢) ==> (⊢)) (@of_envs PROP). Proof. solve_proper. Qed. Global Instance of_envs_proper : Proper (envs_Forall2 (⊣⊢) ==> (⊣⊢)) (@of_envs PROP). Proof. solve_proper. Qed. 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 PROP). Proof. rewrite envs_entails_unseal. solve_proper. Qed. Global Instance envs_entails_mono : Proper (flip (envs_Forall2 (⊢)) ==> (⊢) ==> impl) (@envs_entails PROP). Proof. rewrite envs_entails_unseal=> Δ1 Δ2 ? P1 P2 <- <-. by f_equiv. Qed. Global Instance envs_entails_flip_mono : Proper (envs_Forall2 (⊢) ==> flip (⊢) ==> flip impl) (@envs_entails PROP). Proof. rewrite envs_entails_unseal=> Δ1 Δ2 ? P1 P2 <- <-. by f_equiv. Qed. Lemma envs_delete_intuitionistic Δ 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' Δ rp i p P : envs_lookup i Δ = Some (p,P) → of_envs Δ ⊢ □?p P ∗ of_envs (envs_delete rp i p Δ). Proof. rewrite /envs_lookup /envs_delete !of_envs_eq=>?. apply pure_elim_l=> Hwf. destruct Δ as [Γp Γs], (Γp !! i) eqn:Heqo; simplify_eq/=. - rewrite pure_True ?left_id; last (destruct Hwf, rp; constructor; naive_solver eauto using env_delete_wf, env_delete_fresh). rewrite -persistently_and_intuitionistically_sep_l assoc. apply and_mono; last done. apply and_intro. + rewrite (env_lookup_perm Γp) //= and_elim_l //. + destruct rp; last done. rewrite (env_lookup_perm Γp) //= and_elim_r //. - destruct (Γs !! i) eqn:?; simplify_eq/=. rewrite pure_True ?left_id; last (destruct Hwf; constructor; naive_solver eauto using env_delete_wf, env_delete_fresh). rewrite (env_lookup_perm Γs) //=. rewrite ![(P ∗ _)%I]comm. rewrite persistent_and_sep_assoc. done. Qed. Lemma envs_lookup_sound Δ i p P : envs_lookup i Δ = Some (p,P) → of_envs Δ ⊢ □?p P ∗ of_envs (envs_delete true i p Δ). Proof. apply envs_lookup_sound'. Qed. Lemma envs_lookup_intuitionistic_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. rewrite /envs_lookup !of_envs_eq=>Hwf ?. rewrite [⌜envs_wf Δ⌝%I]pure_True // left_id. destruct Δ as [Γp Γs], (Γp !! i) eqn:Heqo; simplify_eq/=. - rewrite -persistently_and_intuitionistically_sep_l. rewrite (env_lookup_perm Γp) //= [(⌜_⌝ ∧ _)%I]and_elim_r !assoc //. - destruct (Γs !! i) eqn:?; simplify_eq/=. rewrite (env_lookup_perm Γs) //=. rewrite [(⌜_⌝ ∧ _)%I]and_elim_r. rewrite (comm _ P) -persistent_and_sep_assoc. apply and_mono; first done. rewrite comm //. Qed. Lemma envs_lookup_split Δ i p P : envs_lookup i Δ = Some (p,P) → of_envs Δ ⊢ □?p P ∗ (□?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. apply wand_intro_l, envs_lookup_sound_2; done. Qed. 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 Δ Δ' 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 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 _) 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. rewrite /envs_lookup /envs_snoc=> ?. destruct Δ as [Γp Γs], p, (Γp !! i); simplify_eq; by rewrite env_lookup_snoc. Qed. Lemma envs_lookup_snoc_ne Δ i j p P : i ≠ j → envs_lookup i (envs_snoc Δ p j P) = envs_lookup i Δ. Proof. rewrite /envs_lookup /envs_snoc=> ?. destruct Δ as [Γp Γs], p; simplify_eq; by rewrite env_lookup_snoc_ne. 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_eq=> ?; 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 and_intro; [apply pure_intro|]. + destruct Hwf; constructor; simpl; eauto using Esnoc_wf. intros j; destruct (ident_beq_reflect j i); naive_solver. + rewrite -persistently_and_intuitionistically_sep_l 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. + rewrite (comm _ P) -persistent_and_sep_assoc. apply and_mono; first done. rewrite comm //. Qed. Lemma envs_app_sound Δ Δ' p Γ : envs_app p Γ Δ = Some Δ' → of_envs Δ ⊢ (if p then env_and_persistently Γ else [∗] Γ) -∗ of_envs Δ'. Proof. rewrite !of_envs_eq /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:Heqo; simplify_eq/=. 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. + apply and_intro. * rewrite and_elim_l. rewrite (env_app_perm _ _ Γp') //. rewrite affinely_elim big_opL_app sep_and. done. * rewrite and_elim_r. rewrite sep_elim_r. done. - destruct (env_app Γ Γp) eqn:Happ, (env_app Γ Γs) as [Γs'|] eqn:?; simplify_eq/=. 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. apply and_intro. * rewrite and_elim_l. rewrite sep_elim_r. done. * rewrite and_elim_r. done. 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 true i p Δ) ⊢ (if p then env_and_persistently Γ else [∗] Γ) -∗ of_envs Δ'. Proof. rewrite /envs_simple_replace /envs_delete !of_envs_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:Heqo; simplify_eq/=. 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. apply and_intro; first apply and_intro. * rewrite and_elim_l affinely_elim sep_elim_l. done. * rewrite sep_elim_r and_elim_l //. * rewrite and_elim_r sep_elim_r //. - destruct (env_app Γ Γp) eqn:Happ, (env_replace i Γ Γs) as [Γs'|] eqn:?; simplify_eq/=. 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. apply and_intro. * rewrite and_elim_l. rewrite sep_elim_r. done. * rewrite and_elim_r. done. 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 ∗ ((if p then env_and_persistently Γ 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 env_and_persistently Γ 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 true i p Δ) ⊢ (if q then env_and_persistently Γ else [∗] Γ) -∗ of_envs Δ'. Proof. 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 ∗ ((if q then env_and_persistently Γ 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. Proof. rewrite /envs_lookup /envs_clear_spatial. destruct Δ as [Γp Γs]; simpl; destruct (Γp !! j) eqn:?; simplify_eq/=; auto. by destruct (Γs !! j). Qed. Lemma envs_clear_spatial_sound Δ : of_envs Δ ⊢ of_envs (envs_clear_spatial Δ) ∗ [∗] env_spatial Δ. Proof. rewrite !of_envs_eq /envs_clear_spatial /=. apply pure_elim_l=> Hwf. rewrite -persistent_and_sep_assoc. apply and_intro. - apply pure_intro. destruct Hwf; constructor; simpl; auto using Enil_wf. - rewrite -persistent_and_sep_assoc left_id. done. Qed. Lemma envs_clear_intuitionistic_sound Δ : of_envs Δ ⊢ env_and_persistently (env_intuitionistic Δ) ∗ of_envs (envs_clear_intuitionistic Δ). Proof. rewrite !of_envs_eq /envs_clear_spatial /=. apply pure_elim_l=> Hwf. rewrite persistent_and_sep_1. rewrite (pure_True); first by rewrite 2!left_id. destruct Hwf. constructor; simpl; auto using Enil_wf. Qed. Lemma env_spatial_is_nil_intuitionistically Δ : env_spatial_is_nil Δ = true → of_envs Δ ⊢ □ of_envs Δ. Proof. intros. rewrite !of_envs_eq; destruct Δ as [? []]; simplify_eq/=. rewrite /bi_intuitionistically !persistently_and. rewrite persistently_pure persistent_persistently -persistently_emp_2. apply and_intro; last done. rewrite !and_elim_r. done. Qed. Lemma envs_lookup_envs_delete Δ i p P : envs_wf Δ → 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/=. - rewrite env_lookup_env_delete //. revert Hlookup. destruct (Hdisj i) as [->| ->]; [|done]. by destruct (Γs !! _). - rewrite env_lookup_env_delete //. by destruct (Γp !! _). Qed. 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/=. - destruct rp=> //. by rewrite env_lookup_env_delete_ne. - destruct (Γp !! i); simplify_eq/=; by rewrite ?env_lookup_env_delete_ne. Qed. Lemma envs_incr_counter_equiv Δ : envs_Forall2 (⊣⊢) Δ (envs_incr_counter Δ). Proof. done. Qed. Lemma envs_incr_counter_sound Δ : of_envs (envs_incr_counter Δ) ⊣⊢ of_envs Δ. Proof. by f_equiv. Qed. Lemma envs_split_go_sound js Δ1 Δ2 Δ1' Δ2' : (∀ j P, envs_lookup j Δ1 = Some (false, P) → envs_lookup j Δ2 = None) → envs_split_go js Δ1 Δ2 = Some (Δ1',Δ2') → of_envs Δ1 ∗ of_envs Δ2 ⊢ of_envs Δ1' ∗ of_envs Δ2'. Proof. 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_eq !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 (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 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 ( _)%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/=; [|done]. by rewrite comm. Qed. Lemma env_to_prop_sound Γ : env_to_prop Γ ⊣⊢ [∗] Γ. Proof. destruct Γ as [|Γ i P]; simpl; first done. revert P. induction Γ as [|Γ IH ? Q]=>P; simpl. - by rewrite right_id. - rewrite /= IH (comm _ Q _) assoc. done. Qed. Lemma env_to_prop_and_pers_sound Γ i P : □ env_to_prop_and (Esnoc Γ i P) ⊣⊢ env_and_persistently (Esnoc Γ i P). Proof. revert P. induction Γ as [|Γ IH ? Q]=>P; simpl. - by rewrite right_id. - rewrite /= IH. clear IH. f_equiv. simpl. rewrite assoc. f_equiv. rewrite persistently_and comm. done. Qed. End envs. iris-iris-4.2.0/iris/proofmode/ident_name.v000066400000000000000000000035671460620107300206730ustar00rootroot00000000000000From stdpp Require Import base. From iris.prelude Require Import options. (** [ident_name] is a way to remember an identifier within the binder of a (trivial) function, which can be constructed and retrieved with Ltac but is easy to forward around opaquely in Gallina (through typeclasses, for example) *) Definition ident_name := unit → unit. (** [to_ident_name id] returns a constr of type [ident_name] that holds [id] in the binder name *) Ltac to_ident_name id := eval cbv in (ltac:(clear; intros id; assumption) : unit → unit). (** to_ident_name is a Gallina-level version of [to_ident_name] for constructing [ident_name] literals. *) Notation to_ident_name id := (λ id:unit, id) (only parsing). (** The idea of [AsIdentName] is to convert the binder in [f] to an [ident_name] representing the name of the binder. If [f] is not a lambda, this typeclass can produce the fallback identifier [__unknown]. For example, if the user writes [bi_exist Φ], there is no binder anywhere to extract. This class has only one instance, a [Hint Extern] which implements that conversion to resolve [name] in Ltac (see [solve_as_ident_name]). *) Class AsIdentName {A B} (f : A → B) (name : ident_name) := as_ident_name {}. Global Arguments as_ident_name {A B f} name : assert. Ltac solve_as_ident_name := lazymatch goal with (* The [H] here becomes the default name if the binder is anonymous. We use [H] with the idea that an unnamed and unused binder is likely to be a proposition. *) | |- AsIdentName (λ H, _) _ => let name := to_ident_name H in notypeclasses refine (as_ident_name name) | |- AsIdentName _ _ => let name := to_ident_name ident:(__unknown) in notypeclasses refine (as_ident_name name) | |- _ => fail "solve_as_ident_name: goal should be `AsIdentName`" end. Global Hint Extern 1 (AsIdentName _ _) => solve_as_ident_name : typeclass_instances. iris-iris-4.2.0/iris/proofmode/intro_patterns.v000066400000000000000000000160011460620107300216260ustar00rootroot00000000000000From stdpp Require Export strings. From iris.proofmode Require Import base tokens sel_patterns. From iris.prelude Require Import options. Inductive gallina_ident := | IGallinaNamed : string → gallina_ident | IGallinaAnon : gallina_ident. Inductive intro_pat := | IIdent : ident → intro_pat | IFresh : intro_pat | IDrop : intro_pat | IFrame : intro_pat | IList : list (list intro_pat) → intro_pat | IPure : gallina_ident → intro_pat | IIntuitionistic : intro_pat → intro_pat | ISpatial : intro_pat → intro_pat | IModalElim : intro_pat → intro_pat | IRewrite : direction → intro_pat | IPureIntro : intro_pat | IModalIntro : intro_pat | ISimpl : intro_pat | IDone : intro_pat | IForall : intro_pat | IAll : intro_pat | IClear : sel_pat → intro_pat | IClearFrame : sel_pat → intro_pat. Module intro_pat. Inductive stack_item := | StPat : intro_pat → stack_item | StList : stack_item | StConjList : stack_item | StBar : stack_item | StAmp : stack_item | StIntuitionistic : stack_item | StSpatial : stack_item | StModalElim : stack_item. Notation stack := (list stack_item). Fixpoint close_list (k : stack) (ps : list intro_pat) (pss : list (list intro_pat)) : option stack := match k with | StList :: k => Some (StPat (IList (ps :: pss)) :: k) | StPat pat :: k => close_list k (pat :: ps) pss | StIntuitionistic :: k => '(p,ps) ← maybe2 (::) ps; close_list k (IIntuitionistic p :: ps) pss | StModalElim :: k => '(p,ps) ← maybe2 (::) ps; close_list k (IModalElim p :: ps) pss | StBar :: k => close_list k [] (ps :: pss) | _ => None end. Fixpoint big_conj (ps : list intro_pat) : intro_pat := match ps with | [] => IList [[]] | [p] => IList [[ p ]] | [p1;p2] => IList [[ p1 ; p2 ]] | p :: ps => IList [[ p ; big_conj ps ]] end. Fixpoint close_conj_list (k : stack) (cur : option intro_pat) (ps : list intro_pat) : option stack := match k with | StConjList :: k => ps ← match cur with | None => guard (ps = []);; Some [] | Some p => Some (p :: ps) end; Some (StPat (big_conj ps) :: k) | StPat pat :: k => guard (cur = None);; close_conj_list k (Some pat) ps | StIntuitionistic :: k => p ← cur; close_conj_list k (Some (IIntuitionistic p)) ps | StSpatial :: k => p ← cur; close_conj_list k (Some (ISpatial p)) ps | StModalElim :: k => p ← cur; close_conj_list k (Some (IModalElim p)) ps | StAmp :: k => p ← cur; close_conj_list k None (p :: ps) | _ => None end. Fixpoint parse_go (ts : list token) (k : stack) : option stack := match ts with | [] => Some k | TName "_" :: ts => parse_go ts (StPat IDrop :: k) | TName s :: ts => parse_go ts (StPat (IIdent s) :: k) | TAnon :: ts => parse_go ts (StPat IFresh :: k) | TFrame :: ts => parse_go ts (StPat IFrame :: k) | TBracketL :: ts => parse_go ts (StList :: k) | TBar :: ts => parse_go ts (StBar :: k) | TBracketR :: ts => close_list k [] [] ≫= parse_go ts | TParenL :: ts => parse_go ts (StConjList :: k) | TAmp :: ts => parse_go ts (StAmp :: k) | TParenR :: ts => close_conj_list k None [] ≫= parse_go ts | TPure (Some s) :: ts => parse_go ts (StPat (IPure (IGallinaNamed s)) :: k) | TPure None :: ts => parse_go ts (StPat (IPure IGallinaAnon) :: k) | TIntuitionistic :: ts => parse_go ts (StIntuitionistic :: k) | TMinus :: TIntuitionistic :: ts => parse_go ts (StSpatial :: k) | TModal :: ts => parse_go ts (StModalElim :: k) | TArrow d :: ts => parse_go ts (StPat (IRewrite d) :: k) | TPureIntro :: ts => parse_go ts (StPat IPureIntro :: k) | (TModalIntro | TIntuitionisticIntro) :: ts => parse_go ts (StPat IModalIntro :: k) | TSimpl :: ts => parse_go ts (StPat ISimpl :: k) | TDone :: ts => parse_go ts (StPat IDone :: k) | TAll :: ts => parse_go ts (StPat IAll :: k) | TForall :: ts => parse_go ts (StPat IForall :: k) | TBraceL :: ts => parse_clear ts k | _ => None end with parse_clear (ts : list token) (k : stack) : option stack := match ts with | TFrame :: TName s :: ts => parse_clear ts (StPat (IClearFrame (SelIdent s)) :: k) | TFrame :: TPure None :: ts => parse_clear ts (StPat (IClearFrame SelPure) :: k) | TFrame :: TIntuitionistic :: ts => parse_clear ts (StPat (IClearFrame SelIntuitionistic) :: k) | TFrame :: TSep :: ts => parse_clear ts (StPat (IClearFrame SelSpatial) :: k) | TName s :: ts => parse_clear ts (StPat (IClear (SelIdent s)) :: k) | TPure None :: ts => parse_clear ts (StPat (IClear SelPure) :: k) | TIntuitionistic :: ts => parse_clear ts (StPat (IClear SelIntuitionistic) :: k) | TSep :: ts => parse_clear ts (StPat (IClear SelSpatial) :: k) | TBraceR :: ts => parse_go ts k | _ => None end. Fixpoint close (k : stack) (ps : list intro_pat) : option (list intro_pat) := match k with | [] => Some ps | StPat pat :: k => close k (pat :: ps) | StIntuitionistic :: k => '(p,ps) ← maybe2 (::) ps; close k (IIntuitionistic p :: ps) | StSpatial :: k => '(p,ps) ← maybe2 (::) ps; close k (ISpatial p :: ps) | StModalElim :: k => '(p,ps) ← maybe2 (::) ps; close k (IModalElim p :: ps) | _ => None end. Definition parse (s : string) : option (list intro_pat) := k ← parse_go (tokenize s) []; close k []. Ltac parse s := lazymatch type of s with | list intro_pat => s | intro_pat => constr:([s]) | list string => lazymatch eval vm_compute in (mjoin <$> mapM parse s) with | Some ?pats => pats | _ => fail "intro_pat.parse: cannot parse" s "as an introduction pattern" end | string => lazymatch eval vm_compute in (parse s) with | Some ?pats => pats | _ => fail "intro_pat.parse: cannot parse" s "as an introduction pattern" end | ident => constr:([IIdent s]) | ?X => fail "intro_pat.parse: the term" s "is expected to be an introduction pattern" "(usually a string)," "but has unexpected type" X end. Ltac parse_one s := lazymatch type of s with | intro_pat => s | string => lazymatch eval vm_compute in (parse s) with | Some [?pat] => pat | _ => fail "intro_pat.parse_one: cannot parse" s "as an introduction pattern" end | ?X => fail "intro_pat.parse_one: the term" s "is expected to be an introduction pattern" "(usually a string)," "but has unexpected type" X end. End intro_pat. Fixpoint intro_pat_intuitionistic (p : intro_pat) := match p with | IPure _ => true | IRewrite _ => true | IIntuitionistic _ => true | IList pps => forallb (forallb intro_pat_intuitionistic) pps | ISimpl => true | IClear _ => true | IClearFrame _ => true | _ => false end. Ltac intro_pat_intuitionistic p := lazymatch type of p with | intro_pat => eval cbv in (intro_pat_intuitionistic p) | list intro_pat => eval cbv in (forallb intro_pat_intuitionistic p) | string => let pat := intro_pat.parse p in eval cbv in (forallb intro_pat_intuitionistic pat) | ident => false | bool => p | ?X => fail "intro_pat_intuitionistic: the term" p "is expected to be an introduction pattern" "(usually a string)," "but has unexpected type" X end. iris-iris-4.2.0/iris/proofmode/ltac_tactics.v000066400000000000000000002425041460620107300212210ustar00rootroot00000000000000From stdpp Require Import namespaces hlist pretty. From iris.bi Require Export bi telescopes. From iris.proofmode Require Import base intro_patterns spec_patterns sel_patterns coq_tactics reduction string_ident. From iris.proofmode Require Export classes notation. From iris.prelude Require Import options. Export ident. (** Tactic used for solving side-conditions arising from TC resolution in [iMod] and [iInv]. *) Ltac iSolveSideCondition := lazymatch goal with | |- pm_error ?err => fail "" err | _ => split_and?; try solve [ fast_done | solve_ndisj | tc_solve ] end. (** Used for printing [string]s and [ident]s. *) Ltac pretty_ident H := lazymatch H with | INamed ?H => H | ?H => H end. (** * Misc *) Ltac iGetCtx := lazymatch goal with | |- envs_entails ?Δ _ => Δ | |- context[ envs_split _ _ ?Δ ] => Δ end. Ltac iMissingHypsCore Δ Hs := let Hhyps := pm_eval (envs_dom Δ) in eval vm_compute in (list_difference Hs Hhyps). Ltac iMissingHyps Hs := let Δ := iGetCtx in iMissingHypsCore Δ Hs. Ltac iTypeOf H := let Δ := match goal with |- envs_entails ?Δ _ => Δ end in pm_eval (envs_lookup H Δ). Ltac iBiOfGoal := match goal with |- @envs_entails ?PROP _ _ => PROP end. Tactic Notation "iMatchHyp" tactic1(tac) := match goal with | |- context[ environments.Esnoc _ ?x ?P ] => tac x P end. Tactic Notation "iSelect" open_constr(pat) tactic1(tac) := lazymatch goal with | |- context[ environments.Esnoc _ ?x pat ] => (* Before runnig [tac] on the hypothesis name [x] we must first unify the pattern [pat] with the term it matched against. This forces every evar coming from [pat] (and in particular from the [_] it contains and from the implicit arguments it uses) to be instantiated. If we do not do so then shelved goals are produced for every such evar. *) lazymatch iTypeOf x with | Some (_,?T) => unify T pat; tac x end end. (** * Start a proof *) Tactic Notation "iStartProof" := lazymatch goal with | |- (let _ := _ in _) => fail "iStartProof: goal is a `let`, use `simpl`," "`intros x`, `iIntros (x)`, or `iIntros ""%x""" | |- envs_entails _ _ => idtac | |- ?φ => notypeclasses refine (as_emp_valid_2 φ _ _); [tc_solve || fail "iStartProof: not a BI assertion:" φ |notypeclasses refine (tac_start _ _)] 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-negligible 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) _ _ _); [tc_solve || fail "iStartProof: not a BI assertion" |apply tac_start] end. Tactic Notation "iStopProof" := lazymatch goal with | |- envs_entails _ _ => apply tac_stop; pm_reduce | |- _ => fail "iStopProof: proofmode not started" end. (** * Generate a fresh identifier *) (** The tactic [iFresh] bumps the fresh name counter in the proof mode environment and returns the old value. Note that we use [Ltac] instead of [Tactic Notation] since [Tactic Notation] tactics can only have side-effects, but cannot return terms. *) Ltac iFresh := (* We make use of an Ltac hack to allow the [iFresh] tactic to both have a side-effect (i.e. to bump the counter) and to return a value (the fresh name). We do this by wrapped the side-effect under a [match] in a let-binding. See https://stackoverflow.com/a/46178884 *) let start := lazymatch goal with | _ => iStartProof end in let c := lazymatch goal with | |- envs_entails (Envs _ _ ?c) _ => c end in let inc := lazymatch goal with | |- envs_entails (Envs ?Δp ?Δs _) ?Q => let c' := eval vm_compute in (Pos.succ c) in change_no_check (envs_entails (Envs Δp Δs c') Q) end in constr:(IAnon c). (** * 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_reduce; lazymatch goal with | |- False => let H2 := pretty_ident H2 in fail "iRename:" H2 "not fresh" | _ => idtac (* subgoal *) end]. Tactic Notation "iRename" "select" open_constr(pat) "into" constr(n) := iSelect pat ltac:(fun H => iRename H into n). (** Elaborated selection patterns, unlike the type [sel_pat], contains only specific identifiers, and no wildcards like `#` (with the exception of the pure selection pattern `%`) *) Inductive esel_pat := | ESelPure | ESelIdent : (* whether the ident is intuitionistic *) bool → ident → esel_pat. Local Ltac iElaborateSelPat_go pat Δ Hs := lazymatch pat with | [] => eval cbv in Hs | SelPure :: ?pat => iElaborateSelPat_go pat Δ (ESelPure :: Hs) | SelIntuitionistic :: ?pat => let Hs' := pm_eval (env_dom (env_intuitionistic Δ)) in let Δ' := pm_eval (envs_clear_intuitionistic Δ) 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. (** Converts a selection pattern (given as a string) to a list of elaborated selection patterns. *) 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; tc_solve || 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" |pm_reduce]. 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. Tactic Notation "iClear" "select" open_constr(pat) := iSelect pat ltac:(fun H => iClear H). (** ** Simplification *) Tactic Notation "iEval" tactic3(t) := iStartProof; eapply tac_eval; [let x := fresh in intros x; t; unfold x; reflexivity |]. Local Ltac iEval_go t Hs := lazymatch Hs with | [] => idtac | ESelPure :: ?Hs => fail "iEval: %: unsupported selection pattern" | ESelIdent _ ?H :: ?Hs => eapply tac_eval_in with H _ _ _; [pm_reflexivity || let H := pretty_ident H in fail "iEval:" H "not found" |let x := fresh in intros x; t; unfold x; reflexivity |pm_reduce; iEval_go t Hs] end. Tactic Notation "iEval" tactic3(t) "in" constr(Hs) := iStartProof; let Hs := iElaborateSelPat Hs in iEval_go t Hs. 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 with the current Ltac, but it may be possible in Ltac2. *) (** * 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" |tc_solve || 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; tc_solve || let H := pretty_ident H in fail "iExact: remaining hypotheses not affine and the goal not absorbing"]. 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 "iAssumptionCoq" := let Hass := fresh in match goal with | H : ⊢ ?P |- envs_entails _ ?Q => pose proof (_ : FromAssumption false P Q) as Hass; notypeclasses refine (tac_assumption_coq _ P _ H _ _); [exact Hass |pm_reduce; tc_solve || fail 2 "iAssumption: remaining hypotheses not affine and the goal not absorbing"] 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 |exact Hass |pm_reduce; tc_solve || fail 2 "iAssumption: remaining hypotheses not affine and the goal not absorbing"] |assert_fails (is_evar P); 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 |iAssumptionCoq |fail "iAssumption:" Q "not found"] end. (** * False *) Tactic Notation "iExFalso" := iStartProof; apply tac_ex_falso. (** * Making hypotheses intuitionistic or pure *) Local Tactic Notation "iIntuitionistic" constr(H) "as" constr(H') := eapply tac_intuitionistic with H H' _ _ _; (* (i:=H) (j:=H') *) [pm_reflexivity || let H := pretty_ident H in fail "iIntuitionistic:" H "not found" |tc_solve || let P := match goal with |- IntoPersistent _ ?P _ => P end in fail "iIntuitionistic:" P "not persistent" |pm_reduce; tc_solve || let P := match goal with |- TCOr (Affine ?P) _ => P end in fail "iIntuitionistic:" P "not affine and the goal not absorbing" |pm_reduce; lazymatch goal with | |- False => let H' := pretty_ident H' in fail "iIntuitionistic:" H' "not fresh" | _ => idtac (* subgoal *) end]. Local Tactic Notation "iSpatial" constr(H) "as" constr(H') := eapply tac_spatial with H H' _ _ _; [pm_reflexivity || let H := pretty_ident H in fail "iSpatial:" H "not found" |pm_reduce; tc_solve |pm_reduce; lazymatch goal with | |- False => let H' := pretty_ident H' in fail "iSpatial:" H' "not fresh" | _ => idtac (* subgoal *) end]. 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" |tc_solve || let P := match goal with |- IntoPure ?P _ => P end in fail "iPure:" P "not pure" |pm_reduce; tc_solve || let P := match goal with |- TCOr (Affine ?P) _ => P end in fail "iPure:" P "not affine and the goal not absorbing" |pm_reduce; intros pat]. Tactic Notation "iEmpIntro" := iStartProof; eapply tac_emp_intro; [pm_reduce; tc_solve || fail "iEmpIntro: spatial context contains non-affine hypotheses"]. Tactic Notation "iPureIntro" := iStartProof; eapply tac_pure_intro; [tc_solve || let P := match goal with |- FromPure _ ?P _ => P end in fail "iPureIntro:" P "not pure" |pm_reduce; tc_solve || fail "iPureIntro: spatial context contains non-affine hypotheses" |]. (** Framing *) (** Helper tactics are exposed for users that build their own custom framing logic *) Ltac iFrameFinish := pm_prettify; try match goal with | |- envs_entails _ True => by iPureIntro | |- envs_entails _ emp => iEmpIntro end. Ltac iFramePure t := iStartProof; let φ := type of t in eapply (tac_frame_pure _ _ _ _ t); [tc_solve || fail "iFrame: cannot frame" φ |iFrameFinish]. Ltac iFrameHyp H := iStartProof; eapply tac_frame with H _ _ _; [pm_reflexivity || let H := pretty_ident H in fail "iFrame:" H "not found" |tc_solve || let R := match goal with |- Frame _ ?R _ _ => R end in fail "iFrame: cannot frame" R |pm_reduce; iFrameFinish]. Ltac iFrameAnyPure := repeat match goal with H : _ |- _ => iFramePure H end. Ltac iFrameAnyIntuitionistic := 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. 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. Local Ltac _iFrame_go Hs := lazymatch Hs with | [] => idtac | SelPure :: ?Hs => iFrameAnyPure; _iFrame_go Hs | SelIntuitionistic :: ?Hs => iFrameAnyIntuitionistic; _iFrame_go Hs | SelSpatial :: ?Hs => iFrameAnySpatial; _iFrame_go Hs | SelIdent ?H :: ?Hs => iFrameHyp H; _iFrame_go Hs end. Ltac _iFrame0 Hs := let Hs := sel_pat.parse Hs in _iFrame_go Hs. Ltac _iFrame ts Hs := ltac1_list_iter iFramePure ts; _iFrame0 Hs. Tactic Notation "iFrame" := iFrameAnySpatial. Tactic Notation "iFrame" "(" ne_constr_list(ts) ")" := _iFrame ts "". Tactic Notation "iFrame" constr(Hs) := _iFrame0 Hs. Tactic Notation "iFrame" "(" ne_constr_list(ts) ")" constr(Hs) := _iFrame ts Hs. Tactic Notation "iFrame" "select" open_constr(pat) := iSelect pat ltac:(fun H => iFrameHyp H). (** * 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 *) (* We use [_ || _] instead of [first [..|..]] so that the error in the second branch propagates upwards. *) ( (* introduction at the meta level *) intros x ) || ( (* introduction in the logic *) iStartProof; lazymatch goal with | |- envs_entails _ _ => eapply tac_forall_intro; [tc_solve || let P := match goal with |- FromForall ?P _ _ => P end in fail "iIntro: cannot turn" P "into a universal quantifier" |let name := lazymatch goal with | |- let _ := (λ name, _) in _ => name end in pm_prettify; let y := fresh name in intros y; revert y; intros x (* subgoal *)] end). Local Tactic Notation "iIntro" constr(H) := iStartProof; first [(* (?Q → _) *) eapply tac_impl_intro with H _ _ _; (* (i:=H) *) [tc_solve |pm_reduce; tc_solve || let P := lazymatch goal with |- Persistent ?P => P end in let H := pretty_ident H in fail 1 "iIntro: introducing non-persistent" H ":" P "into non-empty spatial context" |tc_solve |pm_reduce; let H := pretty_ident H in lazymatch goal with | |- False => let H := pretty_ident H in fail 1 "iIntro:" H "not fresh" | _ => idtac (* subgoal *) end] |(* (_ -∗ _) *) eapply tac_wand_intro with H _ _; (* (i:=H) *) [tc_solve | pm_reduce; lazymatch goal with | |- False => let H := pretty_ident H in fail 1 "iIntro:" H "not fresh" | _ => idtac (* subgoal *) end] | let H := pretty_ident H in fail 1 "iIntro: could not introduce" H ", goal is not a wand or implication" ]. Local Tactic Notation "iIntro" "#" constr(H) := iStartProof; first [(* (?P → _) *) eapply tac_impl_intro_intuitionistic with H _ _ _; (* (i:=H) *) [tc_solve |tc_solve || let P := match goal with |- IntoPersistent _ ?P _ => P end in fail 1 "iIntro:" P "not persistent" |pm_reduce; lazymatch goal with | |- False => let H := pretty_ident H in fail 1 "iIntro:" H "not fresh" | _ => idtac (* subgoal *) end] |(* (?P -∗ _) *) eapply tac_wand_intro_intuitionistic with H _ _ _; (* (i:=H) *) [tc_solve |tc_solve || let P := match goal with |- IntoPersistent _ ?P _ => P end in fail 1 "iIntro:" P "not intuitionistic" |tc_solve || let P := match goal with |- TCOr (Affine ?P) _ => P end in fail 1 "iIntro:" P "not affine and the goal not absorbing" |pm_reduce; lazymatch goal with | |- False => let H := pretty_ident H in fail 1 "iIntro:" H "not fresh" | _ => idtac (* subgoal *) end] |fail 1 "iIntro: nothing to introduce"]. Local Tactic Notation "iIntro" constr(H) "as" constr(p) := lazymatch p with | true => iIntro #H | _ => iIntro H end. Local Tactic Notation "iIntro" "_" := iStartProof; first [(* (?Q → _) *) eapply tac_impl_intro_drop; [tc_solve |(* subgoal *)] |(* (_ -∗ _) *) eapply tac_wand_intro_drop; [tc_solve |tc_solve || let P := match goal with |- TCOr (Affine ?P) _ => P end in fail 1 "iIntro:" P "not affine and the goal not absorbing" |(* subgoal *)] |(* (∀ _, _) *) iIntro (_) (* subgoal *) |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. (** * Revert *) Ltac iForallRevert x := let err x := intros x; iMatchHyp (fun H P => lazymatch P with | context [x] => let H := pretty_ident H in fail 2 "iRevert:" x "is used in hypothesis" H end) in iStartProof; first [let A := type of x in idtac|fail 1 "iRevert:" x "not in scope"]; let A := type of x in lazymatch type of A with | Prop => revert x; first [eapply tac_pure_revert; [tc_solve (* [FromAffinely], should never fail *) |] |err x] | _ => revert x; first [apply tac_forall_revert; (* Ensure the name [x] is preserved, see [test_iRevert_order_and_names]. *) lazymatch goal with | |- envs_entails ?Δ (bi_forall ?P) => change (envs_entails Δ (∀ x, P x)); lazy beta end |err x] end. (** The tactic [iRevertHyp H with tac] reverts the hypothesis [H] and calls [tac] with a Boolean that is [true] iff [H] was in the intuitionistic context. *) Tactic Notation "iRevertHyp" constr(H) "with" tactic1(tac) := eapply tac_revert with H; [lazymatch goal with | |- match envs_lookup_delete true ?i ?Δ with _ => _ end => lazymatch eval pm_eval in (envs_lookup_delete true i Δ) with | Some (?p,_,_) => pm_reduce; tac p | None => let H := pretty_ident H in fail "iRevert:" H "not found" end end]. Tactic Notation "iRevertHyp" constr(H) := iRevertHyp H with (fun _ => idtac). Ltac _iRevert_go Hs := lazymatch Hs with | [] => idtac | ESelPure :: ?Hs => repeat match goal with x : _ |- _ => revert x end; _iRevert_go Hs | ESelIdent _ ?H :: ?Hs => iRevertHyp H; _iRevert_go Hs end. Ltac _iRevert0 Hs := iStartProof; let Hs := iElaborateSelPat Hs in _iRevert_go Hs. Ltac _iRevert xs Hs := _iRevert0 Hs; ltac1_list_rev_iter iForallRevert xs. Tactic Notation "iRevert" constr(Hs) := _iRevert0 Hs. Tactic Notation "iRevert" "(" ne_ident_list(xs) ")" := _iRevert xs "". Tactic Notation "iRevert" "(" ne_ident_list(xs) ")" constr(Hs) := _iRevert xs Hs. Tactic Notation "iRevert" "select" open_constr(pat) := iSelect pat ltac:(fun H => iRevertHyp H). (** * The specialize and pose proof tactics *) Record iTrm {X As S} := ITrm { itrm : X ; itrm_vars : hlist As ; itrm_hyps : S }. Global 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). Tactic Notation "iPoseProofCoreHyp" constr(H) "as" constr(Hnew) := let Δ := iGetCtx in notypeclasses refine (tac_pose_proof_hyp _ H Hnew _ _); pm_reduce; lazymatch goal with | |- False => let lookup := pm_eval (envs_lookup_delete false H Δ) in lazymatch lookup with | None => let H := pretty_ident H in fail "iPoseProof:" H "not found" | _ => let Hnew := pretty_ident Hnew in fail "iPoseProof:" Hnew "not fresh" end | _ => idtac end. (* The tactic [iIntoEmpValid] tactic "imports a Coq lemma into the proofmode", i.e., it solves a goal [IntoEmpValid ψ ?Q]. The argument [ψ] must be of the following shape: [∀ (x_1 : A_1) .. (x_n : A_n), φ] for which we have an instance [AsEmpValid φ ?Q]. Examples of such [φ]s are - [⊢ P], in which case [?Q] is unified with [P]. - [P1 ⊢ P2], in which case [?Q] is unified with [P1 -∗ P2]. - [P1 ⊣⊢ P2], in which case [?Q] is unified with [P1 ↔ P2]. The tactic instantiates each dependent argument [x_i : A_i] with an evar, and generates a goal [A_i] for each non-dependent argument [x_i : A_i]. For example, if goal is [IntoEmpValid (∀ x, P x → R1 x ⊢ R2 x) ?Q], then the [iIntoEmpValid] tactic generates an evar [?x], a subgoal [P ?x], and unifies [?Q] with [R1 ?x -∗ R2 ?x]. The tactic is implemented so as to provide a "fast path" for the arrow, forall and tforall cases, gated by syntactic ltac pattern matching on the shape of the goal. This is an optimization: the behavior of the tactic is equivalent to the code in the last "wildcard" case, but faster on larger goals, where running (possibly failing) [notypeclasses refine]s can take a significant amount of time. *) Ltac iIntoEmpValid_go := lazymatch goal with | |- IntoEmpValid (let _ := _ in _) _ => (* Normalize [let] so we don't need to rely on type class search to do so. Letting type class search do so is unreliable, see Iris issue #520, and test [test_apply_wand_below_let]. *) lazy zeta; iIntoEmpValid_go | |- IntoEmpValid (?φ → ?ψ) _ => (* Case [φ → ψ] *) (* note: the ltac pattern [_ → _] would not work as it would also match [∀ _, _] *) notypeclasses refine (into_emp_valid_impl _ _ _ _ _); [(*goal for [φ] *)|iIntoEmpValid_go] | |- IntoEmpValid (∀ _, _) _ => (* Case [∀ x : A, φ] *) notypeclasses refine (into_emp_valid_forall _ _ _ _); iIntoEmpValid_go | |- IntoEmpValid (∀.. _, _) _ => (* Case [∀.. x : TT, φ] *) notypeclasses refine (into_emp_valid_tforall _ _ _ _); iIntoEmpValid_go | |- _ => first [(* Case [φ → ψ] *) notypeclasses refine (into_emp_valid_impl _ _ _ _ _); [(*goal for [φ] *)|iIntoEmpValid_go] |(* Case [∀ x : A, φ] *) notypeclasses refine (into_emp_valid_forall _ _ _ _); iIntoEmpValid_go |(* Case [∀.. x : TT, φ] *) notypeclasses refine (into_emp_valid_tforall _ _ _ _); iIntoEmpValid_go |(* Case [P ⊢ Q], [P ⊣⊢ Q], [⊢ P] *) notypeclasses refine (into_emp_valid_here _ _ _) ] end. Ltac iIntoEmpValid := (* Factor out the base case of the loop to avoid needless backtracking *) iIntoEmpValid_go; [.. (* goals for premises *) |tc_solve || let φ := lazymatch goal with |- AsEmpValid ?φ _ => φ end in fail "iPoseProof:" φ "not a BI assertion"]. Tactic Notation "iPoseProofCoreLem" open_constr(lem) "as" tactic3(tac) := let Hnew := iFresh in notypeclasses refine (tac_pose_proof _ Hnew _ _ (into_emp_valid_proj _ _ _ lem) _); [iIntoEmpValid |pm_reduce; lazymatch goal with | |- False => let Hnew := pretty_ident Hnew in fail "iPoseProof:" Hnew "not fresh" | _ => tac Hnew end]; (* Solve all remaining TC premises generated by [iIntoEmpValid] *) try tc_solve. (** There is some hacky stuff going on here: because of Coq bug #6583, unresolved type classes in e.g. the arguments [xs] of [iSpecializeArgs_go] are resolved at arbitrary moments. That is because tactics like [apply], [split] and [eexists] wrongly trigger type class search. To avoid TC being triggered too eagerly, the tactics below use [notypeclasses refine] instead of [apply], [split] and [eexists]. *) 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" |tc_solve || 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 _) end; [shelve..|pm_reduce; 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 := tc_solve || 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 => first [ done | let Q := match goal with |- envs_entails _ ?Q => Q end in fail 1 "iSpecialize: cannot solve" Q "using done" | let Q := match goal with |- ?Q => Q end in fail 1 "iSpecialize: cannot solve" Q "using done" ] | false => idtac end in let Δ := iGetCtx 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 => (* If we not need to specialize [H2] we can avoid a lot of unncessary context manipulation. *) notypeclasses refine (tac_specialize false _ 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" |tc_solve || 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_reduce; iSpecializePat_go H1 pats] | SIdent ?H2 ?pats1 :: ?pats => (* If [H2] is in the intuitionistic context, we copy it into a new hypothesis [Htmp], so that it can be used multiple times. *) let H2tmp := iFresh in iPoseProofCoreHyp H2 as H2tmp; (* Revert [H1] and re-introduce it later so that it will not be consumsed by [pats1]. *) iRevertHyp H1 with (fun p => iSpecializePat_go H2tmp pats1; [.. (* side-conditions of [iSpecialize] *) |iIntro H1 as p]); (* We put the stuff below outside of the closure to get less verbose Ltac backtraces (which would otherwise include the whole closure). *) [.. (* side-conditions of [iSpecialize] *) |(* Use [remove_intuitionistic = true] to remove the copy [Htmp]. *) notypeclasses refine (tac_specialize true _ H2tmp _ H1 _ _ _ _ _ _ _ _ _); [pm_reflexivity || let H2tmp := pretty_ident H2tmp in fail "iSpecialize:" H2tmp "not found" |pm_reflexivity || let H1 := pretty_ident H1 in fail "iSpecialize:" H1 "not found" |tc_solve || 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_reduce; 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 |tc_solve || let Q := match goal with |- FromPure _ ?Q _ => Q end in fail "iSpecialize:" Q "not pure" |solve_done d (*goal*) |pm_reduce; iSpecializePat_go H1 pats] | SGoal (SpecGoal GIntuitionistic false ?Hs_frame [] ?d) :: ?pats => notypeclasses refine (tac_specialize_assert_intuitionistic _ H1 _ _ _ _ _ _ _ _ _ _ _ _); [pm_reflexivity || let H1 := pretty_ident H1 in fail "iSpecialize:" H1 "not found" |solve_to_wand H1 |tc_solve || let Q := match goal with |- Persistent ?Q => Q end in fail "iSpecialize:" Q "not persistent" |tc_solve |pm_reduce; iFrame Hs_frame; solve_done d (*goal*) |pm_reduce; iSpecializePat_go H1 pats] | SGoal (SpecGoal GIntuitionistic _ _ _ _) :: ?pats => fail "iSpecialize: cannot select hypotheses for intuitionistic 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 _ (if m is GModal then true else false) lr Hs' _ _ _ _ _ _ _ _ _); [pm_reflexivity || let H1 := pretty_ident H1 in fail "iSpecialize:" H1 "not found" |solve_to_wand H1 |tc_solve || fail "iSpecialize: goal not a modality" |pm_reduce; lazymatch goal with | |- False => let Hs' := iMissingHypsCore Δ Hs' in fail "iSpecialize: hypotheses" Hs' "not found" | _ => notypeclasses refine (conj _ _); [iFrame Hs_frame; solve_done d (*goal*) |iSpecializePat_go H1 pats] end] | SAutoFrame GIntuitionistic :: ?pats => notypeclasses refine (tac_specialize_assert_intuitionistic _ H1 _ _ _ _ _ _ _ _ _ _ _ _); [pm_reflexivity || let H1 := pretty_ident H1 in fail "iSpecialize:" H1 "not found" |solve_to_wand H1 |tc_solve || let Q := match goal with |- Persistent ?Q => Q end in fail "iSpecialize:" Q "not persistent" |tc_solve || fail "iSpecialize: Cannot find IntoAbsorbingly;" "this should not happen, please report a bug" |pm_reduce; solve [iFrame "∗ #"] |pm_reduce; iSpecializePat_go H1 pats] | SAutoFrame ?m :: ?pats => notypeclasses refine (tac_specialize_frame _ H1 _ (if m is GModal then true else false) _ _ _ _ _ _ _ _ _ _ _); [pm_reflexivity || let H1 := pretty_ident H1 in fail "iSpecialize:" H1 "not found" |solve_to_wand H1 |tc_solve || fail "iSpecialize: goal not a modality" |pm_reduce; first [notypeclasses refine (tac_unlock_emp _ _ _) |notypeclasses refine (tac_unlock_True _ _ _) |iFrame "∗ #"; notypeclasses refine (tac_unlock _ _ _) |let P := match goal with |- envs_entails _ (?P ∗ locked _)%I => P end in fail 1 "iSpecialize: premise" P "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 tactics [iSpecialize trm as #] and [iSpecializeCore trm as true] allow one to use the entire spatial context /twice/: the first time for proving the premises [Q1 .. Qn] of [H : Q1 -* .. -∗ Qn -∗ R], and the second time for proving the remaining goal. This is possible if all of the following properties hold: 1. The conclusion [R] of the hypothesis [H] is persistent. 2. The specialization pattern [[> ..]] for wrapping a modality is not used for any of the premises [Q1 .. Qn]. 3. The BI is either affine, or the hypothesis [H] resides in the intuitionistic context. The copying of the context for proving the premises of [H] and the remaining goal is implemented using the lemma [tac_specialize_intuitionistic_helper]. Since the tactic [iSpecialize .. as #] is used a helper to implement [iDestruct .. as "#.."], [iPoseProof .. as "#.."], [iSpecialize .. as "#.."], and friends, the behavior on violations of these conditions is as follows: - If condition 1 is violated (i.e. the conclusion [R] of [H] is not persistent), the tactic will fail. - If condition 2 or 3 is violated, the tactic will fall back to consuming the hypotheses for proving the premises [Q1 .. Qn]. That is, it will fall back to not using [tac_specialize_intuitionistic_helper]. The function [use_tac_specialize_intuitionistic_helper Δ pat] below returns [true] iff the specialization pattern [pat] consumes any spatial hypotheses, and does not contain the pattern [[> ..]] (cf. condition 2). If the function returns [false], then the conclusion can be moved in the intuitionistic context even if conditions 1 and 3 do not hold. Therefore, in that case, we prefer putting the conclusion to the intuitionistic context directly and not using [tac_specialize_intuitionistic_helper], which requires conditions 1 and 3. *) Fixpoint use_tac_specialize_intuitionistic_helper {M} (Δ : envs M) (pats : list spec_pat) : bool := match pats with | [] => false | (SForall | SPureGoal _) :: pats => use_tac_specialize_intuitionistic_helper Δ pats | SAutoFrame _ :: _ => true | SIdent H _ :: pats => match envs_lookup_delete false H Δ with | Some (false, _, Δ) => true | Some (true, _, Δ) => use_tac_specialize_intuitionistic_helper Δ pats | None => false (* dummy case (invalid pattern, will fail in the tactic anyway) *) end | SGoal (SpecGoal GModal _ _ _ _) :: _ => false | SGoal (SpecGoal GIntuitionistic _ _ _ _) :: pats => use_tac_specialize_intuitionistic_helper Δ pats | SGoal (SpecGoal GSpatial neg Hs_frame Hs _) :: pats => match envs_split (if neg is true then Right else Left) (if neg then Hs else pm_app Hs_frame Hs) Δ with | Some (Δ1,Δ2) => if env_spatial_is_nil Δ1 then use_tac_specialize_intuitionistic_helper Δ2 pats else true | None => false (* dummy case (invalid pattern, will fail in the tactic anyway) *) end end. (** The argument [p] of [iSpecializeCore] can either be a Boolean, or an introduction pattern that is coerced into [true] when it solely contains [#] or [%] patterns at the top-level. *) Tactic Notation "iSpecializeCore" open_constr(H) "with" open_constr(xs) open_constr(pat) "as" constr(p) := let p := intro_pat_intuitionistic 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 => let pat := spec_pat.parse pat in let Δ := iGetCtx in (* Check if we should use [tac_specialize_intuitionistic_helper]. Notice that [pm_eval] does not unfold [use_tac_specialize_intuitionistic_helper], so we should do that first. *) let b := eval cbv [use_tac_specialize_intuitionistic_helper] in (if p then use_tac_specialize_intuitionistic_helper Δ pat else false) in lazymatch eval pm_eval in b with | true => (* Check that the BI is either affine, or the hypothesis [H] resides in the intuitionistic context. *) lazymatch iTypeOf H with | Some (?q, _) => let PROP := iBiOfGoal in lazymatch eval compute in (q || tc_to_bool (BiAffine PROP)) with | true => notypeclasses refine (tac_specialize_intuitionistic_helper _ H _ _ _ _ _ _ _ _ _ _); [pm_reflexivity (* This premise, [envs_lookup j Δ = Some (q,P)], holds because the [iTypeOf] above succeeded *) |pm_reduce; tc_solve (* This premise, [if q then TCTrue else BiAffine PROP], holds because we established that [q || TC_to_bool (BiAffine PROP)] is true *) |iSpecializePat H pat; [.. |notypeclasses refine (tac_specialize_intuitionistic_helper_done _ H _ _ _); pm_reflexivity] |tc_solve || let Q := match goal with |- IntoPersistent _ ?Q _ => Q end in fail "iSpecialize:" Q "not persistent" |pm_reduce (* goal *)] | false => iSpecializePat H pat end | None => let H := pretty_ident H in fail "iSpecialize:" H "not found" end | 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. (** The tactic [iPoseProofCore lem as p tac] inserts the resource described by [lem] into the context. The tactic takes a continuation [tac] as its argument, which is called with a temporary fresh name [H] that refers to the hypothesis containing [lem]. The argument [p] is like that of [iSpecialize]. It is a Boolean that denotes whether the conclusion of the specialized term [lem] is persistent. *) Tactic Notation "iPoseProofCore" open_constr(lem) "as" constr(p) tactic3(tac) := iStartProof; 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 Htmp := lazymatch lem with | ITrm _ ?xs ?pat => iSpecializeCore (ITrm Htmp xs pat) as p | _ => idtac end in lazymatch type of t with | ident => let Htmp := iFresh in iPoseProofCoreHyp t as Htmp; spec_tac Htmp; [..|tac Htmp] | _ => iPoseProofCoreLem t as (fun Htmp => spec_tac Htmp; [..|tac Htmp]) end. (** * The apply tactic *) (** [iApply lem] takes an argument [lem : P₁ -∗ .. -∗ Pₙ -∗ Q] (after the specialization patterns in [lem] have been executed), where [Q] should match the goal, and generates new goals [P1] ... [Pₙ]. Depending on the number of premises [n], the tactic will have the following behavior: - If [n = 0], it will immediately solve the goal (i.e. it will not generate any subgoals). When working in a general BI, this means that the tactic can fail in case there are non-affine spatial hypotheses in the context prior to using the [iApply] tactic. Note that if [n = 0], the tactic behaves exactly like [iExact lem]. - If [n > 0] it will generate a goals [P₁] ... [Pₙ]. All spatial hypotheses will be transferred to the last goal, i.e. [Pₙ]; the other goals will receive no spatial hypotheses. If you want to control more precisely how the spatial hypotheses are subdivided, you should add additional introduction patterns to [lem]. *) (* The helper [iApplyHypExact] takes care of the [n=0] case. It fails with level 0 if we should proceed to the [n > 0] case, and with level 1 if there is an actual error. *) Local Ltac iApplyHypExact H := eapply tac_assumption with H _ _; (* (i:=H) *) [pm_reflexivity |tc_solve |pm_reduce; tc_solve || fail 1 "iApply: remaining hypotheses not affine and the goal not absorbing"]. Local Ltac iApplyHypLoop H := first [eapply tac_apply with H _ _ _; [pm_reflexivity |tc_solve |pm_reduce] |iSpecializePat H "[]"; last iApplyHypLoop H]. Tactic Notation "iApplyHyp" constr(H) := first [iApplyHypExact H |iApplyHypLoop H |lazymatch iTypeOf H with | Some (_,?Q) => fail 1 "iApply: cannot apply" Q end]. Tactic Notation "iApply" open_constr(lem) := iPoseProofCore lem as false (fun H => iApplyHyp H); pm_prettify. (* reduce redexes created by instantiation; this is done at the very end after all type classes have been solved. *) (** * Disjunction *) Tactic Notation "iLeft" := iStartProof; eapply tac_or_l; [tc_solve || let P := match goal with |- FromOr ?P _ _ => P end in fail "iLeft:" P "not a disjunction" |(* subgoal *)]. Tactic Notation "iRight" := iStartProof; eapply tac_or_r; [tc_solve || let P := match goal with |- FromOr ?P _ _ => P end in fail "iRight:" P "not a disjunction" |(* subgoal *)]. 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" |tc_solve || let P := match goal with |- IntoOr ?P _ _ => P end in fail "iOrDestruct: cannot destruct" P | pm_reduce; lazymatch goal with | |- False => let H1 := pretty_ident H1 in let H2 := pretty_ident H2 in fail "iOrDestruct:" H1 "or" H2 "not fresh" | _ => split end]. (** * Conjunction and separating conjunction *) Tactic Notation "iSplit" := iStartProof; eapply tac_and_split; [tc_solve || let P := match goal with |- FromAnd ?P _ _ => P end in fail "iSplit:" P "not a conjunction" |(* subgoal 1 *) |(* subgoal 2 *)]. Tactic Notation "iSplitL" constr(Hs) := iStartProof; let Hs := words Hs in let Hs := eval vm_compute in (INamed <$> Hs) in let Δ := iGetCtx in eapply tac_sep_split with Left Hs _ _; (* (js:=Hs) *) [tc_solve || let P := match goal with |- FromSep ?P _ _ => P end in fail "iSplitL:" P "not a separating conjunction" |pm_reduce; lazymatch goal with | |- False => let Hs := iMissingHypsCore Δ Hs in fail "iSplitL: hypotheses" Hs "not found" | _ => split; [(* subgoal 1 *)|(* subgoal 2 *)] end]. Tactic Notation "iSplitR" constr(Hs) := iStartProof; let Hs := words Hs in let Hs := eval vm_compute in (INamed <$> Hs) in let Δ := iGetCtx in eapply tac_sep_split with Right Hs _ _; (* (js:=Hs) *) [tc_solve || let P := match goal with |- FromSep ?P _ _ => P end in fail "iSplitR:" P "not a separating conjunction" |pm_reduce; lazymatch goal with | |- False => let Hs := iMissingHypsCore Δ Hs in fail "iSplitR: hypotheses" Hs "not found" | _ => split; [(* subgoal 1 *)|(* subgoal 2 *)] end]. 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; tc_solve || let P := lazymatch goal with | |- IntoSep ?P _ _ => P | |- IntoAnd _ ?P _ _ => P end in fail "iAndDestruct: cannot destruct" P |pm_reduce; lazymatch goal with | |- False => let H1 := pretty_ident H1 in let H2 := pretty_ident H2 in fail "iAndDestruct:" H1 "or" H2 "not fresh" | _ => idtac (* subgoal *) end]. 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; tc_solve || let P := match goal with |- TCOr (IntoAnd _ ?P _ _) _ => P end in fail "iAndDestructChoice: cannot destruct" P |pm_reduce; lazymatch goal with | |- False => let H' := pretty_ident H' in fail "iAndDestructChoice:" H' "not fresh" | _ => idtac (* subgoal *) end]. (** * Existential *) Ltac _iExists x := iStartProof; eapply tac_exist; [tc_solve || let P := match goal with |- FromExist ?P _ => P end in fail "iExists:" P "not an existential" |pm_prettify; eexists x (* subgoal *) ]. Tactic Notation "iExists" ne_uconstr_list_sep(xs,",") := ltac1_list_iter _iExists xs. 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" |tc_solve || let P := match goal with |- IntoExist ?P _ _ => P end in fail "iExistDestruct: cannot destruct" P|]; let name := lazymatch goal with | |- let _ := (λ name, _) in _ => name end in intros _; let y := fresh name in intros y; pm_reduce; match goal with | |- False => let Hx := pretty_ident Hx in fail "iExistDestruct:" Hx "not fresh" | _ => revert y; intros x (* subgoal *) end. (** * Modality introduction *) Tactic Notation "iModIntro" uconstr(sel) := iStartProof; notypeclasses refine (tac_modal_intro _ _ sel _ _ _ _ _ _ _ _ _ _ _ _ _ _); [tc_solve || fail "iModIntro: the goal is not a modality" |tc_solve || let s := lazymatch goal with |- IntoModalIntuitionisticEnv _ _ _ ?s => s end in lazymatch eval hnf in s with | MIEnvForall ?C => fail "iModIntro: intuitionistic context does not satisfy" C | MIEnvIsEmpty => fail "iModIntro: intuitionistic context is non-empty" end |tc_solve || 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; tc_solve || fail "iModIntro: cannot filter spatial context when goal is not absorbing" |iSolveSideCondition |pm_prettify (* reduce redexes created by instantiation *) (* subgoal *) ]. Tactic Notation "iModIntro" := iModIntro _. (** DEPRECATED *) #[deprecated(note = "Use iModIntro instead")] 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) "as" constr(H') := eapply tac_modal_elim with H H' _ _ _ _ _ _; [pm_reflexivity || fail "iMod:" H "not found" |tc_solve || 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_reduce; lazymatch goal with | |- False => let H' := pretty_ident H' in fail "iMod:" H' "not fresh" | _ => pm_prettify(* subgoal *) end]. (** * Basic destruct tactic *) (* Two helper tactics to compute an identifier for the hypothesis corresponding to the intro-pattern [pat], when trying to avoid extra renamings. These mainly look whether the pattern is a name, and use that name in that case. Otherwise, [ident_for_pat] generates a fresh name (a safe option), and [ident_for_pat_default] uses the [default] name that it was provided if it is an anonymous name. *) Local Ltac ident_for_pat pat := lazymatch pat with | IIdent ?x => x | _ => let x := iFresh in x end. Local Ltac ident_for_pat_default pat default := lazymatch pat with | IIdent ?x => x | _ => lazymatch default with | IAnon _ => default | _ => let x := iFresh in x end end. (** [pat0] is the unparsed pattern, and is only used in error messages *) Local Ltac iDestructHypGo Hz pat0 pat := lazymatch pat with | IFresh => lazymatch Hz with | IAnon _ => idtac | INamed ?Hz => let Hz' := iFresh in iRename Hz into Hz' end | IDrop => iClearHyp Hz | IFrame => iFrameHyp Hz | IIdent Hz => idtac | IIdent ?y => iRename Hz into y | IList [[]] => iExFalso; iExact Hz (* conjunctive patterns like [H1 H2] *) | IList [[?pat1; IDrop]] => let x := ident_for_pat_default pat1 Hz in iAndDestructChoice Hz as Left x; iDestructHypGo x pat0 pat1 | IList [[IDrop; ?pat2]] => let x := ident_for_pat_default pat2 Hz in iAndDestructChoice Hz as Right x; iDestructHypGo x pat0 pat2 (* [% ...] is always interpreted as an existential; there are [IntoExist] instances in place to handle conjunctions with a pure left-hand side this way as well. *) | IList [[IPure IGallinaAnon; ?pat2]] => let x := ident_for_pat_default pat2 Hz in iExistDestruct Hz as ? x; iDestructHypGo x pat0 pat2 | IList [[IPure (IGallinaNamed ?s); ?pat2]] => let x := fresh in let y := ident_for_pat_default pat2 Hz in iExistDestruct Hz as x y; rename_by_string x s; iDestructHypGo y pat0 pat2 | IList [[?pat1; ?pat2]] => (* We have to take care of not using the same name for the two hypotheses: [ident_for_pat_default] will thus only reuse [Hz] (which could in principle clash with a name from [pat2]) if it is an anonymous name. *) let x1 := ident_for_pat_default pat1 Hz in let x2 := ident_for_pat pat2 in iAndDestruct Hz as x1 x2; iDestructHypGo x1 pat0 pat1; iDestructHypGo x2 pat0 pat2 | IList [_ :: _ :: _] => fail "iDestruct:" pat0 "has too many conjuncts" | IList [[_]] => fail "iDestruct:" pat0 "has just a single conjunct" (* disjunctive patterns like [H1|H2] *) | IList [[?pat1];[?pat2]] => let x1 := ident_for_pat_default pat1 Hz in let x2 := ident_for_pat_default pat2 Hz in iOrDestruct Hz as x1 x2; [iDestructHypGo x1 pat0 pat1|iDestructHypGo x2 pat0 pat2] (* this matches a list of three or more disjunctions [H1|H2|H3] *) | IList (_ :: _ :: _ :: _) => fail "iDestruct:" pat0 "has too many disjuncts" (* the above patterns don't match [H1 H2|H3] *) | IList [_;_] => fail "iDestruct: in" pat0 "a disjunct has multiple patterns" | IPure IGallinaAnon => iPure Hz as ? | IPure (IGallinaNamed ?s) => let x := fresh in iPure Hz as x; rename_by_string x s | IRewrite Right => iPure Hz as -> | IRewrite Left => iPure Hz as <- | IIntuitionistic ?pat => let x := ident_for_pat_default pat Hz in iIntuitionistic Hz as x; iDestructHypGo x pat0 pat | ISpatial ?pat => let x := ident_for_pat_default pat Hz in iSpatial Hz as x; iDestructHypGo x pat0 pat | IModalElim ?pat => let x := ident_for_pat_default pat Hz in iModCore Hz as x; iDestructHypGo x pat0 pat | _ => fail "iDestruct:" pat0 "is not supported due to" pat end. Local Ltac iDestructHypFindPat Hgo 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; iDestructHypFindPat Hgo pat found pats | IClear ?H :: ?pats => iClear H; iDestructHypFindPat Hgo pat found pats | IClearFrame ?H :: ?pats => iFrame H; iDestructHypFindPat Hgo pat found pats | ?pat1 :: ?pats => lazymatch found with | false => iDestructHypGo Hgo pat pat1; iDestructHypFindPat Hgo pat true pats | true => fail "iDestruct:" pat "should contain exactly one proper introduction pattern" end end. Ltac _iDestructHyp0 H pat := let pats := intro_pat.parse pat in iDestructHypFindPat H pat false pats. Ltac _iDestructHyp H xs pat := ltac1_list_iter ltac:(fun x => iExistDestruct H as x H) xs; _iDestructHyp0 H pat. Tactic Notation "iDestructHyp" constr(H) "as" constr(pat) := _iDestructHyp0 H pat. Tactic Notation "iDestructHyp" constr(H) "as" "(" ne_simple_intropattern_list(xs) ")" constr(pat) := _iDestructHyp H xs 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 let Δ := iGetCtx in notypeclasses refine (tac_combine_as _ _ _ Hs _ _ H _ _ _ _ _ _); [pm_reflexivity || let Hs := iMissingHypsCore Δ Hs in fail "iCombine: hypotheses" Hs "not found" |tc_solve |pm_reflexivity || let H := pretty_ident H in fail "iCombine:" H "not fresh" (* should never happen in normal usage, since [H := iFresh] FIXME: improve once consistent error messages are added, see https://gitlab.mpi-sws.org/iris/iris/-/issues/499 *) |iDestructHyp H as pat]. Tactic Notation "iCombine" constr(H1) constr(H2) "as" constr(pat) := iCombine [H1;H2] as pat. Tactic Notation "iCombineGivesCore" constr(Hs) "gives" tactic3(tac) := let Hs := words Hs in let Hs := eval vm_compute in (INamed <$> Hs) in let H := iFresh in let Δ := iGetCtx in notypeclasses refine (tac_combine_gives _ _ _ Hs _ _ H _ _ _ _ _ _ _); [pm_reflexivity || let Hs := iMissingHypsCore Δ Hs in fail "iCombine: hypotheses" Hs "not found" |tc_solve || fail "iCombine: cannot find 'gives' clause for hypotheses" Hs |pm_reflexivity || let H := pretty_ident H in fail "iCombine:" H "not fresh" (* should never happen in normal usage, since [H := iFresh] FIXME: improve once consistent error messages are added, see https://gitlab.mpi-sws.org/iris/iris/-/issues/499 *) |tac H]. Tactic Notation "iCombine" constr(Hs) "gives" constr(pat) := iCombineGivesCore Hs gives (fun H => iDestructHyp H as pat). Tactic Notation "iCombine" constr(H1) constr(H2) "gives" constr(pat) := iCombine [H1;H2] gives pat. Tactic Notation "iCombine" constr(Hs) "gives" "%" simple_intropattern(pat) := iCombineGivesCore Hs gives (fun H => iPure H as pat). Tactic Notation "iCombine" constr(H1) constr(H2) "gives" "%" simple_intropattern(pat) := iCombine [H1;H2] gives %pat. Tactic Notation "iCombineAsGivesCore" constr(Hs) "as" constr(pat1) "gives" tactic3(tac) := let Hs := words Hs in let Hs := eval vm_compute in (INamed <$> Hs) in let H1 := iFresh in let H2 := iFresh in let Δ := iGetCtx in notypeclasses refine (tac_combine_as_gives _ _ _ Hs _ _ H1 H2 _ _ _ _ _ _ _); [pm_reflexivity || let Hs := iMissingHypsCore Δ Hs in fail "iCombine: hypotheses" Hs "not found" |tc_solve || fail "iCombine: cannot find 'gives' clause for hypotheses" Hs |pm_reflexivity || let H1 := pretty_ident H1 in let H2 := pretty_ident H2 in fail "iCombine:" H1 "or" H2 "not fresh" (* should never happen in normal usage, since [H1] and [H2] are [iFresh] FIXME: improve once consistent error messages are added, see https://gitlab.mpi-sws.org/iris/iris/-/issues/499 *) |iDestructHyp H1 as pat1; tac H2]. Tactic Notation "iCombine" constr(Hs) "as" constr(pat1) "gives" constr(pat2) := iCombineAsGivesCore Hs as pat1 gives (fun H => iDestructHyp H as pat2). Tactic Notation "iCombine" constr(H1) constr(H2) "as" constr(pat1) "gives" constr(pat2) := iCombine [H1;H2] as pat1 gives pat2. Tactic Notation "iCombine" constr(Hs) "as" constr(pat1) "gives" "%" simple_intropattern(pat2) := iCombineAsGivesCore Hs as pat1 gives (fun H => iPure H as pat2). Tactic Notation "iCombine" constr(H1) constr(H2) "as" constr(pat1) "gives" "%" simple_intropattern(pat2) := iCombine [H1;H2] as pat1 gives %pat2. (** * Introduction tactic *) Ltac _iIntros_go pats startproof := lazymatch pats with | [] => lazymatch startproof with | true => iStartProof | false => idtac end (* Optimizations to avoid generating fresh names *) | IPure (IGallinaNamed ?s) :: ?pats => let i := fresh in iIntro (i); rename_by_string i s; _iIntros_go pats startproof | IPure IGallinaAnon :: ?pats => iIntro (?); _iIntros_go pats startproof | IIntuitionistic (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 | 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 *) | IIntuitionistic ?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. Ltac _iIntros0 pat := let pats := intro_pat.parse pat in (* HACK to avoid calling [iStartProof] on side-conditions opened by [iIntros (?%lemma)]. *) lazymatch pats with | [] => idtac | _ => _iIntros_go pats true end. Ltac _iIntros xs pat := ltac1_list_iter ltac:(fun x => iIntro (x)) xs; _iIntros0 pat. Tactic Notation "iIntros" := _iIntros0 [IAll]. Tactic Notation "iIntros" constr(pat) := _iIntros0 pat. Tactic Notation "iIntros" "(" ne_simple_intropattern_list(xs) ")" := _iIntros xs "". Tactic Notation "iIntros" "(" ne_simple_intropattern_list(xs) ")" constr(pat) := _iIntros xs pat. Tactic Notation "iIntros" constr(pat) "(" ne_simple_intropattern_list(xs) ")" := _iIntros0 pat; _iIntros xs "". Tactic Notation "iIntros" constr(pat1) "(" ne_simple_intropattern_list(xs) ")" constr(pat2) := _iIntros0 pat1; _iIntros xs pat2. (* Used for generalization in [iInduction] and [iLöb] *) Ltac _iRevertIntros_go Hs tac := lazymatch Hs with | [] => tac () | ESelPure :: ?Hs => fail "iRevertIntros: % not supported" | ESelIdent ?p ?H :: ?Hs => iRevertHyp H; _iRevertIntros_go Hs tac; iIntro H as p end. Ltac _iRevertIntros0 Hs tac := try iStartProof; let Hs := iElaborateSelPat Hs in _iRevertIntros_go Hs tac. Ltac _iRevertIntros xs Hs tac := _iRevertIntros0 Hs ltac:(fun _ => _iRevert xs ""; tac (); _iIntros xs ""). Tactic Notation "iRevertIntros" constr(Hs) "with" tactic3(tac) := _iRevertIntros0 Hs tac. Tactic Notation "iRevertIntros" "(" ne_ident_list(xs) ")" constr(Hs) "with" tactic3(tac):= _iRevertIntros xs Hs tac. Tactic Notation "iRevertIntros" "with" tactic3(tac) := _iRevertIntros0 "" tac. Tactic Notation "iRevertIntros" "(" ne_ident_list(xs) ")" "with" tactic3(tac):= _iRevertIntros xs "" tac. (** * Destruct and PoseProof tactics *) (** The tactics [iDestruct] and [iPoseProof] are similar, but there are some subtle differences: 1. The [iDestruct] tactic can be called with a natural number [n] instead of a hypothesis/lemma, i.e., [iDestruct n as ...]. This introduces [n] hypotheses, and then calls [iDestruct] on the last introduced hypothesis. The [iPoseProof] tactic does not support this feature. 2. When the argument [lem] of [iDestruct lem as ...] is a proof mode identifier (instead of a proof mode term, i.e., no quantifiers or wands/implications are eliminated), then the original hypothesis will always be removed. For example, calling [iDestruct "H" as ...] on ["H" : P ∨ Q] will remove ["H"]. Conversely, [iPoseProof] always tries to keep the hypothesis. For example, calling [iPoseProof "H" as ...] on ["H" : P ∨ Q] will keep ["H"] if it resides in the intuitionistic context. These differences are also present in Coq's [destruct] and [pose proof] tactics. However, Coq's [destruct lem as ...] is more eager on removing the original hypothesis, it might also remove the original hypothesis if [lem] is not an identifier, but an applied term. For example, calling [destruct (H HP) as ...] on [H : P → Q] and [HP : P] will remove [H]. The [iDestruct] does not do this because it could lead to information loss if [H] resides in the intuitionistic context and [HP] resides in the spatial context. *) Tactic Notation "iDestructCore" open_constr(lem) "as" constr(p) tactic3(tac) := 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 => (** This case is used to make the tactic work in [Z_scope]. It would be better if we could bind tactic notation arguments to notation scopes, but that is not supported by Ltac. *) let n := eval compute in (Z.to_nat lem) in intro_destruct n | ident => tac lem | string => tac constr:(INamed lem) | _ => iPoseProofCore lem as p tac end. Ltac _iDestruct0 lem pat := iDestructCore lem as pat (fun H => iDestructHyp H as pat). Ltac _iDestruct lem xs pat := iDestructCore lem as pat (fun H => _iDestructHyp H xs pat). Tactic Notation "iDestruct" open_constr(lem) "as" constr(pat) := _iDestruct0 lem pat. Tactic Notation "iDestruct" open_constr(lem) "as" "(" ne_simple_intropattern_list(xs) ")" constr(pat) := _iDestruct lem xs pat. Tactic Notation "iDestruct" open_constr(lem) "as" "%" simple_intropattern(pat) := iDestructCore lem as true (fun H => iPure H as pat). Tactic Notation "iDestruct" "select" open_constr(pat) "as" constr(ipat) := iSelect pat ltac:(fun H => _iDestruct0 H ipat). Tactic Notation "iDestruct" "select" open_constr(pat) "as" "(" ne_simple_intropattern_list(xs) ")" constr(ipat) := iSelect pat ltac:(fun H => _iDestruct H xs ipat). Tactic Notation "iDestruct" "select" open_constr(pat) "as" "%" simple_intropattern(ipat) := iSelect pat ltac:(fun H => iDestruct H as % ipat). Tactic Notation "iPoseProof" open_constr(lem) "as" constr(pat) := iPoseProofCore lem as pat (fun H => iDestructHyp H as pat). Tactic Notation "iPoseProof" open_constr(lem) "as" "(" ne_simple_intropattern_list(xs) ")" constr(pat) := iPoseProofCore lem as pat (fun H => _iDestructHyp H xs 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 intuitionistic hypotheses containing the induction variable [x] - Revert the pure hypotheses [x1..xn] - Actually perform induction - Introduce the pure hypotheses [x1..xn] - Introduce the spatial hypotheses and intuitionistic hypotheses involving [x] - Introduce the proofmode hypotheses [Hs] *) Tactic Notation "iInductionCore" tactic3(tac) "as" constr(IH) := let rec fix_ihs rev_tac := lazymatch goal with | H : context [envs_entails _ _] |- _ => notypeclasses refine (tac_revert_ih _ _ _ H _ _ _); [tc_solve || let φ := match goal with |- IntoIH ?φ _ _ => φ end in fail "iInduction: cannot import IH" φ "into proof mode context (IntoIH instance missing)" |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 [IIntuitionistic (IIdent IH')]; let j := eval vm_compute in (1 + j)%N in rev_tac j) | _ => rev_tac 0%N end in tac (); 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. Ltac _iInduction x xs Hs tac IH := (* FIXME: We should be able to do this in a more sane way, by concatenating the spec patterns instead of calling [iRevertIntros] multiple times. *) _iRevertIntros0 Hs ltac:(fun _ => _iRevertIntros0 "∗" ltac:(fun _ => let Hsx := iHypsContaining x in _iRevertIntros xs Hsx ltac:(fun _ => iInductionCore tac as IH ) ) ). Ltac _iInduction0 x Hs tac IH := with_ltac1_nil ltac:(fun xs => _iInduction x xs Hs tac IH). (* Without induction scheme *) Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH) := _iInduction0 x "" ltac:(fun _ => induction x as pat) IH. Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH) "forall" "(" ne_ident_list(xs) ")" := _iInduction x xs "" ltac:(fun _ => induction x as pat) IH. Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH) "forall" constr(Hs) := _iInduction0 x Hs ltac:(fun _ => induction x as pat) IH. Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH) "forall" "(" ne_ident_list(xs) ")" constr(Hs) := _iInduction x xs Hs ltac:(fun _ => induction x as pat) IH. (* With induction scheme *) Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH) "using" uconstr(u) := _iInduction0 x "" ltac:(fun _ => induction x as pat using u) IH. Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH) "using" uconstr(u) "forall" "(" ne_ident_list(xs) ")" := _iInduction x xs "" ltac:(fun _ => induction x as pat using u) IH. Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH) "using" uconstr(u) "forall" constr(Hs) := _iInduction0 x Hs ltac:(fun _ => induction x as pat using u) IH. Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH) "using" uconstr(u) "forall" "(" ne_ident_list(xs) ")" constr(Hs) := _iInduction x xs Hs ltac:(fun _ => induction x as pat using u) 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 _ _ _ _); [tc_solve || fail "iLöb: no 'BiLöb' instance found" |reflexivity || fail "iLöb: spatial context not empty; this should not happen, please report a bug" |pm_reduce; lazymatch goal with | |- False => let IH := pretty_ident IH in fail "iLöb:" IH "not fresh" | _ => idtac end]. Ltac _iLöb xs Hs IH := (* FIXME: We should be able to do this in a more sane way, by concatenating the spec patterns instead of calling [iRevertIntros] multiple times. *) _iRevertIntros0 Hs ltac:(fun _ => _iRevertIntros xs "∗" ltac:(fun _ => iLöbCore as IH ) ). Ltac _iLöb0 Hs IH := with_ltac1_nil ltac:(fun xs => _iLöb xs Hs IH). Tactic Notation "iLöb" "as" constr (IH) := _iLöb0 "" IH. Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ne_ident_list(xs) ")" := _iLöb xs "" IH. Tactic Notation "iLöb" "as" constr (IH) "forall" constr(Hs) := _iLöb0 Hs IH. Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ne_ident_list(xs) ")" constr(Hs) := _iLöb xs Hs 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) tactic3(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_reduce; iSpecializeCore H with hnil pats as p; [..|tac H]]. Tactic Notation "iAssertCore" open_constr(Q) "as" constr(p) tactic3(tac) := let p := intro_pat_intuitionistic 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 => _iDestructHyp0 H pat). Tactic Notation "iAssert" open_constr(Q) "with" constr(Hs) "as" "(" ne_simple_intropattern_list(xs) ")" constr(pat) := iAssertCore Q with Hs as pat (fun H => _iDestructHyp H xs pat). Tactic Notation "iAssert" open_constr(Q) "as" constr(pat) := iAssertCore Q as pat (fun H => _iDestructHyp0 H pat). Tactic Notation "iAssert" open_constr(Q) "as" "(" ne_simple_intropattern_list(xs) ")" constr(pat) := iAssertCore Q as pat (fun H => _iDestructHyp H xs 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 (fun Heq => eapply (tac_rewrite _ Heq _ _ lr); [pm_reflexivity || let Heq := pretty_ident Heq in fail "iRewrite:" Heq "not found" |tc_solve || 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 (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" |tc_solve || let P := match goal with |- IntoInternalEq ?P _ _ ⊢ _ => P end in fail "iRewrite:" P "not an equality" |iRewriteFindPred |intros ??? ->; reflexivity |pm_reduce; 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 as H). Tactic Notation "iMod" open_constr(lem) "as" constr(pat) := iDestructCore lem as false (fun H => iModCore H as H; last iDestructHyp H as pat). Tactic Notation "iMod" open_constr(lem) "as" "(" ne_simple_intropattern_list(xs) ")" constr(pat) := iDestructCore lem as false (fun H => iModCore H as H; last _iDestructHyp H xs pat). Tactic Notation "iMod" open_constr(lem) "as" "%" simple_intropattern(pat) := iDestructCore lem as false (fun H => iModCore H as 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 ?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" tactic3(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 => notypeclasses refine (tac_inv_elim _ select H _ _ _ _ _ Pclose_pat _ _ _ _ _ _); [ (by iAssumptionCore) || fail "iInv: invariant" select "not found" |..] | ident => notypeclasses refine (tac_inv_elim _ select H _ _ _ _ _ Pclose_pat _ _ _ _ _ _); [ (by iAssumptionCore) || fail "iInv: invariant" select "not found" |..] | namespace => notypeclasses refine (tac_inv_elim _ _ H _ _ _ _ _ Pclose_pat _ _ _ _ _ _); [ (by iAssumptionInv select) || fail "iInv: invariant" select "not found" |..] | _ => fail "iInv: selector" select "is not of the right type " end; [tc_solve || let I := match goal with |- ElimInv _ ?I _ _ _ _ _ => I end in fail "iInv: cannot eliminate invariant" I |iSolveSideCondition |let R := fresh in intros R; pm_reduce; (* 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" tactic3(tac) := iInvCore N with pats as (@None string) in tac. (* Without selection pattern *) Tactic Notation "iInvCore" constr(N) "as" constr(Hclose) "in" tactic3(tac) := iInvCore N with "[$]" as Hclose in tac. (* Without both *) Tactic Notation "iInvCore" constr(N) "in" tactic3(tac) := iInvCore N with "[$]" as (@None string) in tac. Ltac _iDestructAccAndHyp0 pat x H := lazymatch type of x with | unit => destruct x as []; _iDestructHyp0 H pat | _ => fail "Missing intro pattern for accessor variable" end. (** [_iDestructAccAndHyp xs pat x H] expects [x] to be a variable in the context. Then it behaves as follows: - If [x] has type [unit], it destructs [x] and continues as [_iDestructHyp H xs pat]. That is, it is basically as if [x] did not exist. - Otherwise, [xs] must be a non-empty list of patterns, and the first pattern is applied to [x]. Then we continue as [_iDestructHyp H (tail xs) pat]. Basically it is as if "H" (the hypothesis being destructed) actually was [∃ x, H], so that the first pattern in the [xs] destructs this existential. *) Ltac _iDestructAccAndHyp xs pat x H := let go := ltac2:(tac xs |- match of_ltac1_list xs with | [] => Control.throw_invalid_argument "iDestructAccAndHyp: List should be non-empty" | x1 :: xs' => ltac1:(x1 |- intros x1) x1; ltac1:(tac xs' |- tac xs') tac (Ltac1.of_list xs') end) in lazymatch type of x with | unit => destruct x as []; _iDestructHyp H xs pat | _ => revert x; go ltac:(fun xs' => _iDestructHyp H xs' pat) xs end. (* With everything *) Tactic Notation "iInv" constr(N) "with" constr(Hs) "as" constr(pat) constr(Hclose) := iInvCore N with Hs as (Some Hclose) in _iDestructAccAndHyp0 pat. Tactic Notation "iInv" constr(N) "with" constr(Hs) "as" "(" ne_simple_intropattern_list(xs) ")" constr(pat) constr(Hclose) := iInvCore N with Hs as (Some Hclose) in _iDestructAccAndHyp xs pat. (* Without closing view shift *) Tactic Notation "iInv" constr(N) "with" constr(Hs) "as" constr(pat) := iInvCore N with Hs in _iDestructAccAndHyp0 pat. Tactic Notation "iInv" constr(N) "with" constr(Hs) "as" "(" ne_simple_intropattern_list(xs) ")" constr(pat) := iInvCore N with Hs in _iDestructAccAndHyp xs pat. (* Without selection pattern *) Tactic Notation "iInv" constr(N) "as" constr(pat) constr(Hclose) := iInvCore N as (Some Hclose) in _iDestructAccAndHyp0 pat. Tactic Notation "iInv" constr(N) "as" "(" ne_simple_intropattern_list(xs) ")" constr(pat) constr(Hclose) := iInvCore N as (Some Hclose) in _iDestructAccAndHyp xs pat. (* Without both *) Tactic Notation "iInv" constr(N) "as" constr(pat) := iInvCore N in _iDestructAccAndHyp0 pat. Tactic Notation "iInv" constr(N) "as" "(" ne_simple_intropattern_list(xs) ")" constr(pat) := iInvCore N in _iDestructAccAndHyp xs pat. (** Miscellaneous *) Tactic Notation "iAccu" := iStartProof; eapply tac_accu; [pm_reflexivity || fail "iAccu: not an evar"]. (** Automation *) Global Hint Extern 0 (_ ⊢ _) => iStartProof : core. Global Hint Extern 0 (⊢ _) => iStartProof : core. (* Make sure that [by] and [done] solve trivial things in proof mode. [iPureIntro] invokes [FromPure], so adding [FromPure] instances can help improve what [done] can do. *) Global Hint Extern 0 (envs_entails _ _) => iPureIntro; try done : core. Global Hint Extern 0 (envs_entails _ ?Q) => first [is_evar Q; fail 1|iAssumption] : core. Global Hint Extern 0 (envs_entails _ emp) => iEmpIntro : core. (* TODO: look for a more principled way of adding trivial hints like those below; see the discussion in !75 for further details. *) Global Hint Extern 0 (envs_entails _ (_ ≡ _)) => rewrite envs_entails_unseal; apply internal_eq_refl : core. Global Hint Extern 0 (envs_entails _ (big_opL _ _ _)) => rewrite envs_entails_unseal; apply (big_sepL_nil' _) : core. Global Hint Extern 0 (envs_entails _ (big_sepL2 _ _ _)) => rewrite envs_entails_unseal; apply (big_sepL2_nil' _) : core. Global Hint Extern 0 (envs_entails _ (big_opM _ _ _)) => rewrite envs_entails_unseal; apply (big_sepM_empty' _) : core. Global Hint Extern 0 (envs_entails _ (big_sepM2 _ _ _)) => rewrite envs_entails_unseal; apply (big_sepM2_empty' _) : core. Global Hint Extern 0 (envs_entails _ (big_opS _ _ _)) => rewrite envs_entails_unseal; apply (big_sepS_empty' _) : core. Global Hint Extern 0 (envs_entails _ (big_opMS _ _ _)) => rewrite envs_entails_unseal; apply (big_sepMS_empty' _) : core. (* These introduce as much as possible at once, for better performance. *) Global Hint Extern 0 (envs_entails _ (∀ _, _)) => iIntros : core. Global Hint Extern 0 (envs_entails _ (_ → _)) => iIntros : core. Global Hint Extern 0 (envs_entails _ (_ -∗ _)) => iIntros : core. (* Multi-intro doesn't work for custom binders. *) Global Hint Extern 0 (envs_entails _ (∀.. _, _)) => iIntros (?) : core. Global Hint Extern 1 (envs_entails _ (_ ∧ _)) => iSplit : core. Global Hint Extern 1 (envs_entails _ (_ ∗ _)) => iSplit : core. Global Hint Extern 1 (envs_entails _ (_ ↔ _)) => iSplit : core. Global Hint Extern 1 (envs_entails _ (_ ∗-∗ _)) => iSplit : core. Global Hint Extern 1 (envs_entails _ (▷ _)) => iNext : core. Global Hint Extern 1 (envs_entails _ (■ _)) => iModIntro : core. Global Hint Extern 1 (envs_entails _ ( _)) => iModIntro : core. Global Hint Extern 1 (envs_entails _ ( _)) => iModIntro : core. Global Hint Extern 1 (envs_entails _ (□ _)) => iModIntro : core. Global Hint Extern 1 (envs_entails _ (∃ _, _)) => iExists _ : core. Global Hint Extern 1 (envs_entails _ (∃.. _, _)) => iExists _ : core. Global Hint Extern 1 (envs_entails _ (◇ _)) => iModIntro : core. Global Hint Extern 1 (envs_entails _ (_ ∨ _)) => iLeft : core. Global Hint Extern 1 (envs_entails _ (_ ∨ _)) => iRight : core. Global Hint Extern 1 (envs_entails _ (|==> _)) => iModIntro : core. Global Hint Extern 1 (envs_entails _ ( _)) => iModIntro : core. Global Hint Extern 2 (envs_entails _ (|={_}=> _)) => iModIntro : core. Global Hint Extern 2 (envs_entails _ (_ ∗ _)) => progress iFrame : iFrame. iris-iris-4.2.0/iris/proofmode/modalities.v000066400000000000000000000217151460620107300207150ustar00rootroot00000000000000From stdpp Require Import namespaces. From iris.bi Require Export bi. From iris.prelude Require Import options. Import bi. (** The `iModIntro` tactic is not tied the Iris modalities, but can be instantiated with a variety of modalities. For the purpose of MoSeL, a modality is a mapping of propositions `M : PROP1 → PROP2` (where `PROP1` and `PROP2` are BI-algebras, although usually it is the same algebra) that is monotone and distributes over separating conjunction. Specifically, the following rules have to be satisfied: P ⊢ Q emp ⊢ M emp ---------- M P ⊢ M Q M P ∗ M Q ⊢ M (P ∗ Q) Together those conditions allow one to introduce the modality in the goal, while stripping away the modalities in the context. Additionally, upon introducing a modality one can perform a number of associated actions on the intuitionistic and spatial contexts. Such an action can be one of the following: - 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-is. Formally, these actions correspond to the inductive type [modality_action]. For each of those actions you have to prove that the transformation is valid. To instantiate the modality you have to define: 1) a mixin `modality_mixin`, 2) a record `modality`, 3) a `FromModal` type class instance from `classes.v`. For examples consult `modality_id` at the end of this file, or the instances in the `modality_instances.v` file. Note that in MoSeL modalities can map the propositions between two different BI-algebras. Most of the modalities in Iris operate on the same type of assertions. For example, the modality can potentially maps propositions of an arbitrary BI-algebra into the sub-BI-algebra of affine propositions, but it is implemented as an endomapping. On the other hand, the embedding modality ⎡-⎤ is a mapping between propositions of different BI-algebras. *) 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. Global Arguments MIEnvIsEmpty {_ _}. Global Arguments MIEnvForall {_} _. Global Arguments MIEnvTransform {_ _} _. Global Arguments MIEnvClear {_ _}. Global 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 }. Global Arguments Modality {_ _} _ {_ _} _. Global Arguments modality_intuitionistic_action {_ _} _. Global 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_entails=> -[??]; 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 → ( [∧ list] P ∈ Ps, P) ⊢ M ( [∧ list] P ∈ Ps, P). Proof. induction 2 as [|P Ps ? _ IH]; simpl. { rewrite affinely_True_emp. apply modality_emp. } rewrite affinely_and -modality_and_forall //. apply and_mono, IH. by eapply modality_intuitionistic_forall. Qed. Lemma modality_intuitionistic_id_big_and Ps : modality_intuitionistic_action M = MIEnvId → ( [∧ list] P ∈ Ps, P) ⊢ M ( [∧ list] P ∈ Ps, P). Proof. intros. induction Ps as [|P Ps IH]; simpl. { rewrite affinely_True_emp. apply modality_emp. } rewrite -affinely_and_r. rewrite {1}IH {IH}. rewrite !persistently_and_intuitionistically_sep_l. by rewrite {1}(modality_intuitionistic_id P) // modality_sep. 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 True modality_id] to support introduction for modalities that enjoy [P ⊢ M P]. This is done by defining an instance [FromModal True 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. iris-iris-4.2.0/iris/proofmode/modality_instances.v000066400000000000000000000050521460620107300224500ustar00rootroot00000000000000From iris.bi Require Import bi. From iris.proofmode Require Export classes. From iris.prelude Require Import options. Import bi. Section modalities. Context {PROP : bi}. Lemma modality_persistently_mixin : modality_mixin (@bi_persistently PROP) MIEnvId MIEnvClear. Proof. split; simpl; eauto using equiv_entails_1_2, 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_1_2, 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_1_2, 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_1_2, 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. Lemma modality_plainly_mixin `{!BiPlainly PROP} : modality_mixin (@plainly PROP _) (MIEnvForall Plain) MIEnvClear. Proof. split; simpl; split_and?; eauto using equiv_entails_1_2, 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 (@bi_laterN PROP n) (MIEnvTransform (MaybeIntoLaterN false n)) (MIEnvTransform (MaybeIntoLaterN false n)). Proof. split; simpl; split_and?; eauto using equiv_entails_1_2, 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 modalities. iris-iris-4.2.0/iris/proofmode/monpred.v000066400000000000000000000753001460620107300202260ustar00rootroot00000000000000From iris.bi Require Export monpred. From iris.bi Require Import plainly. From iris.proofmode Require Import proofmode classes_make modality_instances. From iris.prelude Require Import options. Class MakeMonPredAt {I : biIndex} {PROP : bi} (i : I) (P : monPred I PROP) (𝓟 : PROP) := make_monPred_at : P i ⊣⊢ 𝓟. Global Arguments MakeMonPredAt {_ _} _ _%I _%I. (** Since [MakeMonPredAt] is used by [AsEmpValid] to import lemmas into the proof mode, the index [I] and BI [PROP] often contain evars. Hence, it is important to use the mode [!] also for the first two arguments. *) Global Hint Mode MakeMonPredAt ! ! - ! - : typeclass_instances. Class IsBiIndexRel {I : biIndex} (i j : I) := is_bi_index_rel : i ⊑ j. Global Hint Mode IsBiIndexRel + - - : typeclass_instances. Global Instance is_bi_index_rel_refl {I : biIndex} (i : I) : IsBiIndexRel i i | 0. Proof. by rewrite /IsBiIndexRel. Qed. Global 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. Global Arguments FrameMonPredAt {_ _} _ _ _%I _%I _%I. Global 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 select (TCDiag _ _ _) (fun H => destruct H); eauto using bi.equiv_entails_1_2, 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 True modality_objectively ( P) ( P) P | 1. Proof. by rewrite /FromModal. Qed. Global Instance from_modal_subjectively P : FromModal True modality_id ( P) ( 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 /==> HPQ <- ?. by rewrite -HPQ // 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 /==> HPQ <- ?. by rewrite -HPQ // 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 /==> HPQ <- ?. by rewrite -HPQ // 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. rewrite /FromModal /MakeMonPredAt=> HPQ <- ?. by rewrite -HPQ. 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 ( P) ( 𝓟). Proof. by rewrite /MakeMonPredAt monPred_at_persistently=><-. Qed. Global Instance make_monPred_at_affinely i P 𝓟 : MakeMonPredAt i P 𝓟 → MakeMonPredAt i ( P) ( 𝓟). 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 ( P) ( 𝓟). Proof. by rewrite /MakeMonPredAt monPred_at_absorbingly=><-. Qed. Global Instance make_monPred_at_persistently_if i P 𝓟 p : MakeMonPredAt i P 𝓟 → MakeMonPredAt i (?p P) (?p 𝓟). Proof. destruct p; simpl; apply _. Qed. Global Instance make_monPred_at_affinely_if i P 𝓟 p : MakeMonPredAt i P 𝓟 → MakeMonPredAt i (?p P) (?p 𝓟). Proof. destruct p; simpl; apply _. Qed. Global Instance make_monPred_at_absorbingly_if i P 𝓟 p : MakeMonPredAt i P 𝓟 → MakeMonPredAt i (?p P) (?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) (|==> 𝓟). 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 P Q : FromAssumption p P Q → KnownLFromAssumption p ( P) Q. Proof. by rewrite /KnownLFromAssumption /FromAssumption monPred_objectively_elim. Qed. Global Instance from_assumption_make_monPred_subjectively p P Q : FromAssumption p P Q → KnownRFromAssumption p P ( Q). Proof. 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 : @FromPure PROP false (monPred_in i j) (i ⊑ j). Proof. by rewrite /FromPure monPred_at_in. 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 (to_ident_name idx). 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 (to_ident_name idx). 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) name (Ψ : A → PROP) i : IntoExist P Φ name → (∀ a, MakeMonPredAt i (Φ a) (Ψ a)) → IntoExist (P i) Ψ name. 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 (( P) i)%I Φ (to_ident_name idx). 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 (( 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 (( P) i) Φ. Proof. rewrite /FromExist /MakeMonPredAt monPred_at_subjectively=>H. by setoid_rewrite <- H. Qed. (* TODO: this implementation uses [idx] as the automatic name for the index. In theory a monPred could define an appropriate metavariable for indices with an [ident_name] argument to [MakeMonPredAt], but this is not implemented. *) Global Instance into_exist_monPred_at_ex P (Φ : I → PROP) i : (∀ i, MakeMonPredAt i P (Φ i)) → IntoExist (( P) i) Φ (to_ident_name idx). Proof. rewrite /IntoExist /MakeMonPredAt monPred_at_subjectively=>H. by setoid_rewrite <- H. Qed. Global Instance from_forall_monPred_at {A} P (Φ : A → monPred) name (Ψ : A → PROP) i : FromForall P Φ name → (∀ a, MakeMonPredAt i (Φ a) (Ψ a)) → FromForall (P i) Ψ name. 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) 𝓠 | 2. 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 /IsBiIndexRel /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 /IsBiIndexRel /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 𝓡 ( P i) 𝓠 → FrameMonPredAt p i 𝓡 ( P) 𝓠. Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_absorbingly. Qed. Global Instance frame_monPred_at_affinely p P 𝓡 𝓠 i : Frame p 𝓡 ( P i) 𝓠 → FrameMonPredAt p i 𝓡 ( P) 𝓠. Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_affinely. Qed. Global Instance frame_monPred_at_persistently p P 𝓡 𝓠 i : Frame p 𝓡 ( P i) 𝓠 → FrameMonPredAt p i 𝓡 ( 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 𝓡 ( 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 𝓡 ( 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 elim_modal_at φ p p' 𝓟 𝓟' P P' V: ElimModal φ p p' ⎡𝓟⎤ ⎡𝓟'⎤ P P' → ElimModal φ p p' 𝓟 𝓟' (P V) (P' V). Proof. rewrite /ElimModal -!embed_intuitionistically_if. iIntros (HH Hφ) "[? HP]". iApply HH; [done|]. iFrame. iIntros (? <-) "?". by iApply "HP". 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. Global Instance from_forall_monPred_at_plainly `{!BiPlainly PROP} i P Φ : (∀ i, MakeMonPredAt i P (Φ i)) → FromForall ((■ P) i) (λ j, ■ (Φ j))%I (to_ident_name idx). 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 `{!BiInternalEq PROP} {A : ofe} (x y : A) i : MakeMonPredAt 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) (◇ 𝓠). Proof. by rewrite /MakeMonPredAt monPred_at_except_0=><-. Qed. Global Instance make_monPred_at_later i P 𝓠 : MakeMonPredAt i P 𝓠 → MakeMonPredAt i (▷ P) (▷ 𝓠). Proof. by rewrite /MakeMonPredAt monPred_at_later=><-. Qed. Global Instance make_monPred_at_laterN i n P 𝓠 : MakeMonPredAt i P 𝓠 → MakeMonPredAt i (▷^n P) (▷^n 𝓠). 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) (|={E1,E2}=> 𝓟). Proof. by rewrite /MakeMonPredAt monPred_at_fupd=> <-. Qed. Global Instance into_internal_eq_monPred_at `{!BiInternalEq PROP} {A : ofe} (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=> HPQ <- ?. rewrite -HPQ //. 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. 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]. *) Global Hint Extern 3 (IntoWand _ _ (monPred_at _ _) ?P ?Q) => is_evar P; is_evar Q; eapply @into_wand_monPred_at_unknown_unknown : typeclass_instances. Global Hint Extern 2 (IntoWand _ _ (monPred_at _ _) ?P (monPred_at ?Q _)) => eapply @into_wand_monPred_at_unknown_known : typeclass_instances. Global Hint Extern 2 (IntoWand _ _ (monPred_at _ _) (monPred_at ?P _) ?Q) => eapply @into_wand_monPred_at_known_unknown_le : typeclass_instances. Global Hint Extern 2 (IntoWand _ _ (monPred_at _ _) (monPred_at ?P _) ?Q) => eapply @into_wand_monPred_at_known_unknown_ge : typeclass_instances. Section modal. Context {I : biIndex} {PROP : bi}. 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 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. Global Instance elim_acc_at_None `{!BiFUpd PROP} {X} φ E1 E2 E3 E4 α α' β β' P P'x i : (∀ x, MakeEmbed (α x) (α' x)) → (∀ x, MakeEmbed (β x) (β' x)) → ElimAcc (X:=X) φ (fupd E1 E2) (fupd E3 E4) α' β' (λ _, None) P P'x → ElimAcc (X:=X) φ (fupd E1 E2) (fupd E3 E4) α β (λ _, None) (P i) (λ x, P'x x i). Proof. rewrite /ElimAcc /MakeEmbed. iIntros (Hα Hβ HEA ?) "Hinner Hacc". iApply (HEA with "[Hinner]"); first done. - iIntros (x). iSpecialize ("Hinner" $! x). rewrite -Hα. by iIntros (? <-). - iMod "Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]". iModIntro. iExists x. rewrite -Hα -Hβ. iFrame. iIntros (? _) "Hβ". by iApply "Hclose". Qed. Global Instance elim_acc_at_Some `{!BiFUpd PROP} {X} φ E1 E2 E3 E4 α α' β β' γ γ' P P'x i : (∀ x, MakeEmbed (α x) (α' x)) → (∀ x, MakeEmbed (β x) (β' x)) → (∀ x, MakeEmbed (γ x) (γ' x)) → ElimAcc (X:=X) φ (fupd E1 E2) (fupd E3 E4) α' β' (λ x, Some (γ' x)) P P'x → ElimAcc (X:=X) φ (fupd E1 E2) (fupd E3 E4) α β (λ x, Some (γ x)) (P i) (λ x, P'x x i). Proof. rewrite /ElimAcc /MakeEmbed. iIntros (Hα Hβ Hγ HEA ?) "Hinner Hacc". iApply (HEA with "[Hinner]"); first done. - iIntros (x). iSpecialize ("Hinner" $! x). rewrite -Hα. by iIntros (? <-). - iMod "Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]". iModIntro. iExists x. rewrite -Hα -Hβ -Hγ. iFrame. iIntros (? _) "Hβ /=". by iApply "Hclose". 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 modal. iris-iris-4.2.0/iris/proofmode/notation.v000066400000000000000000000034531460620107300204150ustar00rootroot00000000000000From stdpp Require Export strings. From iris.proofmode Require Import coq_tactics environments. From iris.prelude Require Import options. Declare Scope proof_scope. Delimit Scope proof_scope with env. Global Arguments Envs _ _%proof_scope _%proof_scope _. Global Arguments Enil {_}. Global Arguments Esnoc {_} _%proof_scope _%string _%I. Notation "" := Enil (only printing) : proof_scope. 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%I) (at level 1, P at level 200, left associativity, format "Γ '_' : '[' P ']' '//'", only printing) : proof_scope. Notation "Γ '--------------------------------------' □ Δ '--------------------------------------' ∗ Q" := (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) (at level 1, Q at level 200, left associativity, format "'[' Δ '--------------------------------------' ∗ '//' Q ']'", only printing) : stdpp_scope. Notation "Γ '--------------------------------------' □ Q" := (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) (at level 1, Q at level 200, format "'[' '--------------------------------------' ∗ '//' Q ']'", only printing) : stdpp_scope. iris-iris-4.2.0/iris/proofmode/proofmode.v000066400000000000000000000012241460620107300205460ustar00rootroot00000000000000(** The main proofmode file that everyone should import. Unless you are working with the guts of the proofmode, do not import any other file from this folder! *) From iris.proofmode Require Export ltac_tactics. (* This [Require Import] is not a no-op: it exports typeclass instances from these files. *) From iris.proofmode Require Import class_instances class_instances_later class_instances_updates class_instances_embedding class_instances_plainly class_instances_internal_eq. From iris.proofmode Require Import class_instances_frame class_instances_make. From iris.proofmode Require Import modality_instances. From iris.prelude Require Import options. iris-iris-4.2.0/iris/proofmode/reduction.v000066400000000000000000000037521460620107300205600ustar00rootroot00000000000000From iris.bi Require Import bi telescopes. From iris.proofmode Require Import base environments. From iris.prelude Require Import options. (** 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]. This needs to contain all definitions used in the user-visible statements in [coq_tactics], and their dependencies. *) Declare Reduction pm_eval := cbv [ (* base *) base.negb 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_intuitionistic envs_incr_counter envs_split_go envs_split env_to_prop_go env_to_prop env_to_prop_and_go env_to_prop_and (* PM list and option functions *) pm_app pm_option_bind pm_from_option pm_option_fun ]. Ltac pm_eval t := eval pm_eval in t. Ltac pm_reduce := (* Use [change_no_check] instead of [change] to avoid performing the conversion check twice. *) match goal with |- ?u => let v := pm_eval u in change_no_check 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_absorbingly_if bi_intuitionistically_if bi_wandM bi_laterN bi_tforall bi_texist ]. Ltac pm_prettify := (* Use [change_no_check] instead of [change] to avoid performing the conversion check twice. *) match goal with |- ?u => let v := eval pm_prettify in u in change_no_check v end. iris-iris-4.2.0/iris/proofmode/sel_patterns.v000066400000000000000000000026301460620107300212610ustar00rootroot00000000000000From stdpp Require Export strings. From iris.proofmode Require Import base tokens. From iris.prelude Require Import options. Inductive sel_pat := | SelPure | SelIntuitionistic | SelSpatial | SelIdent : ident → sel_pat. Fixpoint sel_pat_pure (ps : list sel_pat) : bool := match ps with | [] => false | SelPure :: ps => true | _ :: ps => sel_pat_pure ps end. Module sel_pat. Fixpoint parse_go (ts : list token) (k : list sel_pat) : option (list sel_pat) := match ts with | [] => Some (reverse k) | TName s :: ts => parse_go ts (SelIdent s :: k) | TPure None :: ts => parse_go ts (SelPure :: k) | TIntuitionistic :: ts => parse_go ts (SelIntuitionistic :: k) | TSep :: ts => parse_go ts (SelSpatial :: k) | _ => None end. Definition parse (s : string) : option (list sel_pat) := parse_go (tokenize s) []. Ltac parse s := lazymatch type of s with | sel_pat => constr:([s]) | list sel_pat => s | ident => constr:([SelIdent s]) | list ident => eval vm_compute in (SelIdent <$> s) | list string => eval vm_compute in (SelIdent ∘ INamed <$> s) | string => lazymatch eval vm_compute in (parse s) with | Some ?pats => pats | _ => fail "sel_pat.parse: cannot parse" s "as a selection pattern" end | ?X => fail "sel_pat.parse: the term" s "is expected to be a selection pattern" "(usually a string)," "but has unexpected type" X end. End sel_pat. iris-iris-4.2.0/iris/proofmode/spec_patterns.v000066400000000000000000000072621460620107300214360ustar00rootroot00000000000000From stdpp Require Export strings. From iris.proofmode Require Import base tokens. From iris.prelude Require Import options. Inductive goal_kind := GSpatial | GModal | GIntuitionistic. Record spec_goal := SpecGoal { spec_goal_kind : goal_kind; spec_goal_negate : bool; spec_goal_frame : list ident; spec_goal_hyps : list ident; spec_goal_done : bool }. Inductive spec_pat := | SForall : spec_pat | SIdent : ident → list spec_pat → spec_pat | SPureGoal (perform_done : bool) : spec_pat | SGoal : spec_goal → spec_pat | SAutoFrame : goal_kind → spec_pat. Definition goal_kind_modal (k : goal_kind) : bool := match k with GModal => true | _ => false end. Definition spec_pat_modal (p : spec_pat) : bool := match p with | SGoal g => goal_kind_modal (spec_goal_kind g) | SAutoFrame k => goal_kind_modal k | _ => false end. Module spec_pat. Inductive stack_item := | StPat : spec_pat → stack_item | StIdent : string → stack_item. Notation stack := (list stack_item). Fixpoint close (k : stack) (ps : list spec_pat) : option (list spec_pat) := match k with | [] => Some ps | StPat p :: k => close k (p :: ps) | StIdent _ :: _ => None end. Fixpoint close_ident (k : stack) (ps : list spec_pat) : option stack := match k with | [] => None | StPat p :: k => close_ident k (p :: ps) | StIdent s :: k => Some (StPat (SIdent s ps) :: k) end. Fixpoint parse_go (ts : list token) (k : stack) : option (list spec_pat) := match ts with | [] => close k [] | TParenL :: TName s :: ts => parse_go ts (StIdent s :: k) | TParenR :: ts => k ← close_ident k []; parse_go ts k | TName s :: ts => parse_go ts (StPat (SIdent s []) :: k) | TBracketL :: TIntuitionistic :: TFrame :: TBracketR :: ts => parse_go ts (StPat (SAutoFrame GIntuitionistic) :: k) | TBracketL :: TFrame :: TBracketR :: ts => parse_go ts (StPat (SAutoFrame GSpatial) :: k) | TBracketL :: TModal :: TFrame :: TBracketR :: ts => parse_go ts (StPat (SAutoFrame GModal) :: k) | TBracketL :: TPure None :: TBracketR :: ts => parse_go ts (StPat (SPureGoal false) :: k) | TBracketL :: TPure None :: TDone :: TBracketR :: ts => parse_go ts (StPat (SPureGoal true) :: k) | TBracketL :: TIntuitionistic :: ts => parse_goal ts GIntuitionistic false [] [] k | TBracketL :: TModal :: ts => parse_goal ts GModal false [] [] k | TBracketL :: ts => parse_goal ts GSpatial false [] [] k | TForall :: ts => parse_go ts (StPat SForall :: k) | _ => None end with parse_goal (ts : list token) (ki : goal_kind) (neg : bool) (frame hyps : list ident) (k : stack) : option (list spec_pat) := match ts with | TMinus :: ts => guard (¬neg ∧ frame = [] ∧ hyps = []);; parse_goal ts ki true frame hyps k | TName s :: ts => parse_goal ts ki neg frame (INamed s :: hyps) k | TFrame :: TName s :: ts => parse_goal ts ki neg (INamed s :: frame) hyps k | TDone :: TBracketR :: ts => parse_go ts (StPat (SGoal (SpecGoal ki neg (reverse frame) (reverse hyps) true)) :: k) | TBracketR :: ts => parse_go ts (StPat (SGoal (SpecGoal ki neg (reverse frame) (reverse hyps) false)) :: k) | _ => None end. Definition parse (s : string) : option (list spec_pat) := parse_go (tokenize s) []. 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 "spec_pat.parse: cannot parse" s "as a specialization pattern" end | ident => constr:([SIdent s []]) | ?X => fail "spec_pat.parse: the term" s "is expected to be a specialization pattern" "(usually a string)," "but has unexpected type" X end. End spec_pat. iris-iris-4.2.0/iris/proofmode/string_ident.v000066400000000000000000000137131460620107300212530ustar00rootroot00000000000000From Ltac2 Require Ltac2. From Coq Require Import Strings.String. From Coq Require Import Init.Byte. From iris.prelude Require Import options. Import List.ListNotations. Local Open Scope list. Module StringToIdent. Import Ltac2. Ltac2 Type exn ::= [ NotStringLiteral(constr) | InvalidIdent(string) ]. Ltac2 coq_byte_to_int (b : constr) : int := (match! b with (* generate this line with python3 -c 'print(" ".join([\'| x%02x => %d\' % (x,x) for x in range(256)]))' *) | x00 => 0 | x01 => 1 | x02 => 2 | x03 => 3 | x04 => 4 | x05 => 5 | x06 => 6 | x07 => 7 | x08 => 8 | x09 => 9 | x0a => 10 | x0b => 11 | x0c => 12 | x0d => 13 | x0e => 14 | x0f => 15 | x10 => 16 | x11 => 17 | x12 => 18 | x13 => 19 | x14 => 20 | x15 => 21 | x16 => 22 | x17 => 23 | x18 => 24 | x19 => 25 | x1a => 26 | x1b => 27 | x1c => 28 | x1d => 29 | x1e => 30 | x1f => 31 | x20 => 32 | x21 => 33 | x22 => 34 | x23 => 35 | x24 => 36 | x25 => 37 | x26 => 38 | x27 => 39 | x28 => 40 | x29 => 41 | x2a => 42 | x2b => 43 | x2c => 44 | x2d => 45 | x2e => 46 | x2f => 47 | x30 => 48 | x31 => 49 | x32 => 50 | x33 => 51 | x34 => 52 | x35 => 53 | x36 => 54 | x37 => 55 | x38 => 56 | x39 => 57 | x3a => 58 | x3b => 59 | x3c => 60 | x3d => 61 | x3e => 62 | x3f => 63 | x40 => 64 | x41 => 65 | x42 => 66 | x43 => 67 | x44 => 68 | x45 => 69 | x46 => 70 | x47 => 71 | x48 => 72 | x49 => 73 | x4a => 74 | x4b => 75 | x4c => 76 | x4d => 77 | x4e => 78 | x4f => 79 | x50 => 80 | x51 => 81 | x52 => 82 | x53 => 83 | x54 => 84 | x55 => 85 | x56 => 86 | x57 => 87 | x58 => 88 | x59 => 89 | x5a => 90 | x5b => 91 | x5c => 92 | x5d => 93 | x5e => 94 | x5f => 95 | x60 => 96 | x61 => 97 | x62 => 98 | x63 => 99 | x64 => 100 | x65 => 101 | x66 => 102 | x67 => 103 | x68 => 104 | x69 => 105 | x6a => 106 | x6b => 107 | x6c => 108 | x6d => 109 | x6e => 110 | x6f => 111 | x70 => 112 | x71 => 113 | x72 => 114 | x73 => 115 | x74 => 116 | x75 => 117 | x76 => 118 | x77 => 119 | x78 => 120 | x79 => 121 | x7a => 122 | x7b => 123 | x7c => 124 | x7d => 125 | x7e => 126 | x7f => 127 | x80 => 128 | x81 => 129 | x82 => 130 | x83 => 131 | x84 => 132 | x85 => 133 | x86 => 134 | x87 => 135 | x88 => 136 | x89 => 137 | x8a => 138 | x8b => 139 | x8c => 140 | x8d => 141 | x8e => 142 | x8f => 143 | x90 => 144 | x91 => 145 | x92 => 146 | x93 => 147 | x94 => 148 | x95 => 149 | x96 => 150 | x97 => 151 | x98 => 152 | x99 => 153 | x9a => 154 | x9b => 155 | x9c => 156 | x9d => 157 | x9e => 158 | x9f => 159 | xa0 => 160 | xa1 => 161 | xa2 => 162 | xa3 => 163 | xa4 => 164 | xa5 => 165 | xa6 => 166 | xa7 => 167 | xa8 => 168 | xa9 => 169 | xaa => 170 | xab => 171 | xac => 172 | xad => 173 | xae => 174 | xaf => 175 | xb0 => 176 | xb1 => 177 | xb2 => 178 | xb3 => 179 | xb4 => 180 | xb5 => 181 | xb6 => 182 | xb7 => 183 | xb8 => 184 | xb9 => 185 | xba => 186 | xbb => 187 | xbc => 188 | xbd => 189 | xbe => 190 | xbf => 191 | xc0 => 192 | xc1 => 193 | xc2 => 194 | xc3 => 195 | xc4 => 196 | xc5 => 197 | xc6 => 198 | xc7 => 199 | xc8 => 200 | xc9 => 201 | xca => 202 | xcb => 203 | xcc => 204 | xcd => 205 | xce => 206 | xcf => 207 | xd0 => 208 | xd1 => 209 | xd2 => 210 | xd3 => 211 | xd4 => 212 | xd5 => 213 | xd6 => 214 | xd7 => 215 | xd8 => 216 | xd9 => 217 | xda => 218 | xdb => 219 | xdc => 220 | xdd => 221 | xde => 222 | xdf => 223 | xe0 => 224 | xe1 => 225 | xe2 => 226 | xe3 => 227 | xe4 => 228 | xe5 => 229 | xe6 => 230 | xe7 => 231 | xe8 => 232 | xe9 => 233 | xea => 234 | xeb => 235 | xec => 236 | xed => 237 | xee => 238 | xef => 239 | xf0 => 240 | xf1 => 241 | xf2 => 242 | xf3 => 243 | xf4 => 244 | xf5 => 245 | xf6 => 246 | xf7 => 247 | xf8 => 248 | xf9 => 249 | xfa => 250 | xfb => 251 | xfc => 252 | xfd => 253 | xfe => 254 | xff => 255 end). Ltac2 coq_byte_to_char (b : constr) : char := Char.of_int (coq_byte_to_int b). Fixpoint coq_string_to_list_byte (s : string) : list byte := match s with | EmptyString => [] | String c s => Ascii.byte_of_ascii c :: coq_string_to_list_byte s end. (** copy a list of Coq byte constrs into a string (already of the right length) *) Ltac2 rec coq_byte_list_blit_list (pos : int) (ls : constr) (str : string) : unit := match! ls with | nil => () | ?c :: ?ls => let b := coq_byte_to_char c in String.set str pos b; coq_byte_list_blit_list (Int.add pos 1) ls str end. Ltac2 rec coq_string_length (s : constr) : int := match! s with | EmptyString => 0 | String _ ?s' => Int.add 1 (coq_string_length s') | _ => Control.throw (NotStringLiteral(s)) end. Ltac2 compute (c : constr) : constr := Std.eval_vm None c. (** [coq_string_to_string] converts a Gallina string in a constr to an Ltac2 native string *) Ltac2 coq_string_to_string (s : constr) : string := let l := coq_string_length s in let str := String.make l (Char.of_int 0) in let bytes := compute constr:(coq_string_to_list_byte $s) in let _ := coq_byte_list_blit_list 0 bytes str in str. Ltac2 ident_from_string (s : string) : ident := match Ident.of_string s with | Some id => id | None => Control.throw (InvalidIdent s) end. (** [coq_string_to_ident] implements the ident to string conversion in Ltac2 *) Ltac2 coq_string_to_ident (s : constr) : ident := ident_from_string (coq_string_to_string s). (** We want to wrap [coq_string_to_ident] in an Ltac1 API, but Ltac1-2 FFI does not support returning values from Ltac2 to Ltac1. So we provide [string_to_ident_cps] in CPS instead. *) Ltac string_to_ident_cps := ltac2:(s1 r |- let s := Option.get (Ltac1.to_constr s1) in let ident := coq_string_to_ident s in Ltac1.apply r [Ltac1.of_ident ident] Ltac1.run). End StringToIdent. (** Finally we wrap everything up intro a tactic that renames a variable given by ident [id] into the name given by string [s]. *) Ltac rename_by_string id s := StringToIdent.string_to_ident_cps s ltac:(fun x => rename id into x). (* We also directly expose the CPS primitive. *) Ltac string_to_ident_cps := StringToIdent.string_to_ident_cps. iris-iris-4.2.0/iris/proofmode/tactics.v000066400000000000000000000003531460620107300202100ustar00rootroot00000000000000(* This file is *deprecated*. It exists just to give people some time to adjust their code. Directly import [iris.proofmode.proofmode] instead. *) From iris.proofmode Require Export proofmode. From iris.prelude Require Import options. iris-iris-4.2.0/iris/proofmode/tokens.v000066400000000000000000000077101460620107300200650ustar00rootroot00000000000000From iris.proofmode Require Import base. From iris.prelude Require Import options. Inductive token := | TName : string → token | TNat : nat → token | TAnon : token | TFrame : token | TBar : token | TBracketL : token | TBracketR : token | TAmp : token | TParenL : token | TParenR : token | TBraceL : token | TBraceR : token | TPure : option string → token | TIntuitionistic : token | TModal : token | TPureIntro : token | TIntuitionisticIntro : token | TModalIntro : token | TSimpl : token | TDone : token | TForall : token | TAll : token | TMinus : token | TSep : token | TArrow : direction → token. Inductive state := | SName : string → state | SNat : nat → state | SPure : string -> state | SNone : state. Definition cons_state (kn : state) (k : list token) : list token := match kn with | SNone => k | SName s => TName (string_rev s) :: k | SPure s => TPure (if String.eqb s "" then None else Some (string_rev s)) :: k | SNat n => TNat n :: k end. Fixpoint tokenize_go (s : string) (k : list token) (kn : state) : list token := match s with | "" => reverse (cons_state kn k) | String "?" s => tokenize_go s (TAnon :: cons_state kn k) SNone | String "$" s => tokenize_go s (TFrame :: cons_state kn k) SNone | String "[" s => tokenize_go s (TBracketL :: cons_state kn k) SNone | String "]" s => tokenize_go s (TBracketR :: cons_state kn k) SNone | String "|" s => tokenize_go s (TBar :: cons_state kn k) SNone | String "(" s => tokenize_go s (TParenL :: cons_state kn k) SNone | String ")" s => tokenize_go s (TParenR :: cons_state kn k) SNone | String "&" s => tokenize_go s (TAmp :: cons_state kn k) SNone | String "{" s => tokenize_go s (TBraceL :: cons_state kn k) SNone | String "}" s => tokenize_go s (TBraceR :: cons_state kn k) SNone | String "%" s => tokenize_go s (cons_state kn k) (SPure "") | String "#" s => tokenize_go s (TIntuitionistic :: cons_state kn k) SNone | String ">" s => tokenize_go s (TModal :: cons_state kn k) SNone | String "!" (String "%" s) => tokenize_go s (TPureIntro :: cons_state kn k) SNone | String "!" (String "#" s) => tokenize_go s (TIntuitionisticIntro :: cons_state kn k) SNone | String "!" (String ">" s) => tokenize_go s (TModalIntro :: cons_state kn k) SNone | String "/" (String "/" (String "=" s)) => tokenize_go s (TSimpl :: TDone :: cons_state kn k) SNone | String "/" (String "/" s) => tokenize_go s (TDone :: cons_state kn k) SNone | String "/" (String "=" s) => tokenize_go s (TSimpl :: cons_state kn k) SNone | String "*" (String "*" s) => tokenize_go s (TAll :: cons_state kn k) SNone | String "*" s => tokenize_go s (TForall :: cons_state kn k) SNone | String "-" (String ">" s) => tokenize_go s (TArrow Right :: cons_state kn k) SNone | String "<" (String "-" s) => tokenize_go s (TArrow Left :: cons_state kn k) SNone | String "-" s => tokenize_go s (TMinus :: cons_state kn k) SNone | String (Ascii.Ascii false true false false false true true true) (* unicode ∗ *) (String (Ascii.Ascii false false false true false false false true) (String (Ascii.Ascii true true true false true false false true) s)) => tokenize_go s (TSep :: cons_state kn k) SNone | String a s => (* TODO: Complain about invalid characters, to future-proof this against making more characters special. *) if is_space a then tokenize_go s (cons_state kn k) SNone else match kn with | SNone => match is_nat a with | Some n => tokenize_go s k (SNat n) | None => tokenize_go s k (SName (String a "")) end | SName s' => tokenize_go s k (SName (String a s')) | SPure s' => tokenize_go s k (SPure (String a s')) | SNat n => match is_nat a with | Some n' => tokenize_go s k (SNat (n' + 10 * n)) | None => tokenize_go s (TNat n :: k) (SName (String a "")) end end end. Definition tokenize (s : string) : list token := tokenize_go s [] SNone. iris-iris-4.2.0/iris/si_logic/000077500000000000000000000000001460620107300161645ustar00rootroot00000000000000iris-iris-4.2.0/iris/si_logic/bi.v000066400000000000000000000202441460620107300167470ustar00rootroot00000000000000From iris.bi Require Export bi. From iris.si_logic Require Export siprop. From iris.prelude Require Import options. Import siProp_primitive. (** BI instances for [siProp], and re-stating the remaining primitive laws in terms of the BI interface. This file does *not* unseal. *) (** We pick [*] and [-*] to coincide with [∧] and [→], respectively. This seems to be the most reasonable choice to fit a "pure" higher-order logic into the proofmode's BI framework. *) Definition siProp_emp : siProp := siProp_pure True. Definition siProp_sep : siProp → siProp → siProp := siProp_and. Definition siProp_wand : siProp → siProp → siProp := siProp_impl. Definition siProp_persistently (P : siProp) : siProp := P. Definition siProp_plainly (P : siProp) : siProp := P. Local Existing Instance entails_po. Lemma siProp_bi_mixin : BiMixin siProp_entails siProp_emp siProp_pure siProp_and siProp_or siProp_impl (@siProp_forall) (@siProp_exist) siProp_sep siProp_wand. Proof. split. - exact: entails_po. - exact: equiv_entails. - exact: pure_ne. - exact: and_ne. - exact: or_ne. - exact: impl_ne. - exact: forall_ne. - exact: exist_ne. - exact: and_ne. - exact: impl_ne. - exact: pure_intro. - exact: pure_elim'. - 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. - (* (P ⊢ Q) → (P' ⊢ Q') → P ∗ P' ⊢ Q ∗ Q' *) intros P P' Q Q' H1 H2. apply and_intro. + by etrans; first apply and_elim_l. + by etrans; first apply and_elim_r. - (* P ⊢ emp ∗ P *) intros P. apply and_intro; last done. by apply pure_intro. - (* emp ∗ P ⊢ P *) intros P. apply and_elim_r. - (* P ∗ Q ⊢ Q ∗ P *) intros P Q. apply and_intro; [ apply and_elim_r | apply and_elim_l ]. - (* (P ∗ Q) ∗ R ⊢ P ∗ (Q ∗ R) *) intros P Q R. repeat apply and_intro. + etrans; first apply and_elim_l. by apply and_elim_l. + etrans; first apply and_elim_l. by apply and_elim_r. + apply and_elim_r. - (* (P ∗ Q ⊢ R) → P ⊢ Q -∗ R *) apply impl_intro_r. - (* (P ⊢ Q -∗ R) → P ∗ Q ⊢ R *) apply impl_elim_l'. Qed. Lemma siProp_bi_persistently_mixin : BiPersistentlyMixin siProp_entails siProp_emp siProp_and (@siProp_exist) siProp_sep siProp_persistently. Proof. split. - solve_proper. - (* (P ⊢ Q) → P ⊢ Q *) done. - (* P ⊢ P *) done. - (* emp ⊢ emp *) done. - (* (∀ a, (Ψ a)) ⊢ (∀ a, Ψ a) *) done. - (* (∃ a, Ψ a) ⊢ ∃ a, (Ψ a) *) done. - (* P ∗ Q ⊢ P *) apply and_elim_l. - (* P ∧ Q ⊢ P ∗ Q *) done. Qed. Lemma siProp_bi_later_mixin : BiLaterMixin siProp_entails siProp_pure siProp_or siProp_impl (@siProp_forall) (@siProp_exist) siProp_sep siProp_persistently siProp_later. Proof. split. - apply contractive_ne, later_contractive. - exact: later_mono. - exact: later_intro. - exact: @later_forall_2. - exact: @later_exist_false. - (* ▷ (P ∗ Q) ⊢ ▷ P ∗ ▷ Q *) intros P Q. apply and_intro; apply later_mono. + apply and_elim_l. + apply and_elim_r. - (* ▷ P ∗ ▷ Q ⊢ ▷ (P ∗ Q) *) intros P Q. trans (siProp_forall (λ b : bool, siProp_later (if b then P else Q))). { apply forall_intro=> -[]. - apply and_elim_l. - apply and_elim_r. } etrans; [apply later_forall_2|apply later_mono]. apply and_intro. + refine (forall_elim true). + refine (forall_elim false). - (* ▷ P ⊢ ▷ P *) done. - (* ▷ P ⊢ ▷ P *) done. - exact: later_false_em. Qed. Canonical Structure siPropI : bi := {| bi_ofe_mixin := ofe_mixin_of siProp; bi_bi_mixin := siProp_bi_mixin; bi_bi_persistently_mixin := siProp_bi_persistently_mixin; bi_bi_later_mixin := siProp_bi_later_mixin |}. Global Instance siProp_pure_forall : BiPureForall siPropI. Proof. exact: @pure_forall_2. Qed. Global Instance siProp_later_contractive : BiLaterContractive siPropI. Proof. exact: @later_contractive. Qed. Lemma siProp_internal_eq_mixin : BiInternalEqMixin siPropI (@siProp_internal_eq). Proof. split. - 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. Qed. Global Instance siProp_internal_eq : BiInternalEq siPropI := {| bi_internal_eq_mixin := siProp_internal_eq_mixin |}. Lemma siProp_plainly_mixin : BiPlainlyMixin siPropI siProp_plainly. Proof. split; try done. - solve_proper. - (* P ⊢ ■ emp *) intros P. by apply pure_intro. - (* ■ P ∗ Q ⊢ ■ P *) intros P Q. apply and_elim_l. Qed. Global Instance siProp_plainlyC : BiPlainly siPropI := {| bi_plainly_mixin := siProp_plainly_mixin |}. Global Instance siProp_prop_ext : BiPropExt siPropI. Proof. exact: prop_ext_2. Qed. (** extra BI instances *) Global Instance siProp_affine : BiAffine siPropI | 0. Proof. intros P. 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. *) Global Hint Immediate siProp_affine : core. Global Instance siProp_plain (P : siProp) : Plain P | 0. Proof. done. Qed. Global Instance siProp_persistent (P : siProp) : Persistent P. Proof. done. Qed. Global Instance siProp_plainly_exist_1 : BiPlainlyExist siPropI. Proof. done. Qed. (** Re-state/export soundness lemmas *) Module siProp. Section restate. Lemma pure_soundness φ : (⊢@{siPropI} ⌜ φ ⌝) → φ. Proof. apply pure_soundness. Qed. Lemma internal_eq_soundness {A : ofe} (x y : A) : (⊢@{siPropI} x ≡ y) → x ≡ y. Proof. apply internal_eq_soundness. Qed. Lemma later_soundness (P : siProp) : (⊢ ▷ P) → ⊢ P. Proof. apply later_soundness. Qed. (** We restate the unsealing lemmas so that they also unfold the BI layer. The sealing lemmas are partially applied so that they also work under binders. *) Local Lemma siProp_emp_unseal : bi_emp = @siprop.siProp_pure_def True. Proof. by rewrite -siprop.siProp_pure_unseal. Qed. Local Lemma siProp_pure_unseal : bi_pure = @siprop.siProp_pure_def. Proof. by rewrite -siprop.siProp_pure_unseal. Qed. Local Lemma siProp_and_unseal : bi_and = @siprop.siProp_and_def. Proof. by rewrite -siprop.siProp_and_unseal. Qed. Local Lemma siProp_or_unseal : bi_or = @siprop.siProp_or_def. Proof. by rewrite -siprop.siProp_or_unseal. Qed. Local Lemma siProp_impl_unseal : bi_impl = @siprop.siProp_impl_def. Proof. by rewrite -siprop.siProp_impl_unseal. Qed. Local Lemma siProp_forall_unseal : @bi_forall _ = @siprop.siProp_forall_def. Proof. by rewrite -siprop.siProp_forall_unseal. Qed. Local Lemma siProp_exist_unseal : @bi_exist _ = @siprop.siProp_exist_def. Proof. by rewrite -siprop.siProp_exist_unseal. Qed. Local Lemma siProp_sep_unseal : bi_sep = @siprop.siProp_and_def. Proof. by rewrite -siprop.siProp_and_unseal. Qed. Local Lemma siProp_wand_unseal : bi_wand = @siprop.siProp_impl_def. Proof. by rewrite -siprop.siProp_impl_unseal. Qed. Local Lemma siProp_plainly_unseal : plainly = @id siProp. Proof. done. Qed. Local Lemma siProp_persistently_unseal : bi_persistently = @id siProp. Proof. done. Qed. Local Lemma siProp_later_unseal : bi_later = @siprop.siProp_later_def. Proof. by rewrite -siprop.siProp_later_unseal. Qed. Local Lemma siProp_internal_eq_unseal : @internal_eq _ _ = @siprop.siProp_internal_eq_def. Proof. by rewrite -siprop.siProp_internal_eq_unseal. Qed. Local Definition siProp_unseal := (siProp_emp_unseal, siProp_pure_unseal, siProp_and_unseal, siProp_or_unseal, siProp_impl_unseal, siProp_forall_unseal, siProp_exist_unseal, siProp_sep_unseal, siProp_wand_unseal, siProp_plainly_unseal, siProp_persistently_unseal, siProp_later_unseal, siProp_internal_eq_unseal). End restate. (** The final unseal tactic that also unfolds the BI layer. *) Ltac unseal := rewrite !siProp_unseal /=. End siProp. iris-iris-4.2.0/iris/si_logic/siprop.v000066400000000000000000000321241460620107300176710ustar00rootroot00000000000000From iris.algebra Require Export ofe. From iris.bi Require Import notation. From iris.prelude Require Import options. (** The type [siProp] defines "plain" step-indexed propositions, on which we define the usual connectives of higher-order logic, and prove that these satisfy the usual laws of higher-order logic. *) Record siProp := SiProp { siProp_holds : nat → Prop; siProp_closed n1 n2 : siProp_holds n1 → n2 ≤ n1 → siProp_holds n2 }. Local Coercion siProp_holds : siProp >-> Funclass. Global Arguments siProp_holds : simpl never. Add Printing Constructor siProp. Bind Scope bi_scope with siProp. Section cofe. Inductive siProp_equiv' (P Q : siProp) : Prop := { siProp_in_equiv : ∀ n, P n ↔ Q n }. Local Instance siProp_equiv : Equiv siProp := siProp_equiv'. Inductive siProp_dist' (n : nat) (P Q : siProp) : Prop := { siProp_in_dist : ∀ n', n' ≤ n → P n' ↔ Q n' }. Local Instance siProp_dist : Dist siProp := siProp_dist'. Definition siProp_ofe_mixin : OfeMixin siProp. Proof. split. - intros P Q; split. + by intros HPQ n; split=> i ?; apply HPQ. + intros HPQ; split=> n; apply HPQ with n; auto. - intros n; split. + by intros P; split=> i. + by intros P Q HPQ; split=> i ?; symmetry; apply HPQ. + intros P Q Q' HP HQ; split=> i ?. by trans (Q i);[apply HP|apply HQ]. - intros n m P Q HPQ Hlt. split=> i ?; apply HPQ; lia. Qed. Canonical Structure siPropO : ofe := Ofe siProp siProp_ofe_mixin. Program Definition siProp_compl : Compl siPropO := λ c, {| siProp_holds n := c n n |}. Next Obligation. intros c n1 n2 ??; simpl in *. apply (chain_cauchy c n2 n1); eauto using siProp_closed. Qed. Global Program Instance siProp_cofe : Cofe siPropO := {| compl := siProp_compl |}. Next Obligation. intros n c; split=>i ?; symmetry; apply (chain_cauchy c i n); auto. Qed. End cofe. (** logical entailement *) Inductive siProp_entails (P Q : siProp) : Prop := { siProp_in_entails : ∀ n, P n → Q n }. Global Hint Resolve siProp_closed : siProp_def. (** logical connectives *) Local Program Definition siProp_pure_def (φ : Prop) : siProp := {| siProp_holds n := φ |}. Solve Obligations with done. Local Definition siProp_pure_aux : seal (@siProp_pure_def). Proof. by eexists. Qed. Definition siProp_pure := unseal siProp_pure_aux. Local Definition siProp_pure_unseal : @siProp_pure = @siProp_pure_def := seal_eq siProp_pure_aux. Local Program Definition siProp_and_def (P Q : siProp) : siProp := {| siProp_holds n := P n ∧ Q n |}. Solve Obligations with naive_solver eauto 2 with siProp_def. Local Definition siProp_and_aux : seal (@siProp_and_def). Proof. by eexists. Qed. Definition siProp_and := unseal siProp_and_aux. Local Definition siProp_and_unseal : @siProp_and = @siProp_and_def := seal_eq siProp_and_aux. Local Program Definition siProp_or_def (P Q : siProp) : siProp := {| siProp_holds n := P n ∨ Q n |}. Solve Obligations with naive_solver eauto 2 with siProp_def. Local Definition siProp_or_aux : seal (@siProp_or_def). Proof. by eexists. Qed. Definition siProp_or := unseal siProp_or_aux. Local Definition siProp_or_unseal : @siProp_or = @siProp_or_def := seal_eq siProp_or_aux. Local Program Definition siProp_impl_def (P Q : siProp) : siProp := {| siProp_holds n := ∀ n', n' ≤ n → P n' → Q n' |}. Next Obligation. intros P Q [|n1] [|n2]; auto with lia. Qed. Local Definition siProp_impl_aux : seal (@siProp_impl_def). Proof. by eexists. Qed. Definition siProp_impl := unseal siProp_impl_aux. Local Definition siProp_impl_unseal : @siProp_impl = @siProp_impl_def := seal_eq siProp_impl_aux. Local Program Definition siProp_forall_def {A} (Ψ : A → siProp) : siProp := {| siProp_holds n := ∀ a, Ψ a n |}. Solve Obligations with naive_solver eauto 2 with siProp_def. Local Definition siProp_forall_aux : seal (@siProp_forall_def). Proof. by eexists. Qed. Definition siProp_forall {A} := unseal siProp_forall_aux A. Local Definition siProp_forall_unseal : @siProp_forall = @siProp_forall_def := seal_eq siProp_forall_aux. Local Program Definition siProp_exist_def {A} (Ψ : A → siProp) : siProp := {| siProp_holds n := ∃ a, Ψ a n |}. Solve Obligations with naive_solver eauto 2 with siProp_def. Local Definition siProp_exist_aux : seal (@siProp_exist_def). Proof. by eexists. Qed. Definition siProp_exist {A} := unseal siProp_exist_aux A. Local Definition siProp_exist_unseal : @siProp_exist = @siProp_exist_def := seal_eq siProp_exist_aux. Local Program Definition siProp_later_def (P : siProp) : siProp := {| siProp_holds n := match n return _ with 0 => True | S n' => P n' end |}. Next Obligation. intros P [|n1] [|n2]; eauto using siProp_closed with lia. Qed. Local Definition siProp_later_aux : seal (@siProp_later_def). Proof. by eexists. Qed. Definition siProp_later := unseal siProp_later_aux. Local Definition siProp_later_unseal : @siProp_later = @siProp_later_def := seal_eq siProp_later_aux. Local Program Definition siProp_internal_eq_def {A : ofe} (a1 a2 : A) : siProp := {| siProp_holds n := a1 ≡{n}≡ a2 |}. Solve Obligations with naive_solver eauto 2 using dist_le. Local Definition siProp_internal_eq_aux : seal (@siProp_internal_eq_def). Proof. by eexists. Qed. Definition siProp_internal_eq {A} := unseal siProp_internal_eq_aux A. Local Definition siProp_internal_eq_unseal : @siProp_internal_eq = @siProp_internal_eq_def := seal_eq siProp_internal_eq_aux. (** Primitive logical rules. These are not directly usable later because they do not refer to the BI connectives. *) Module siProp_primitive. Local Definition siProp_unseal := (siProp_pure_unseal, siProp_and_unseal, siProp_or_unseal, siProp_impl_unseal, siProp_forall_unseal, siProp_exist_unseal, siProp_later_unseal, siProp_internal_eq_unseal). Ltac unseal := rewrite !siProp_unseal /=. Section primitive. Local Arguments siProp_holds !_ _ /. (** The notations below are implicitly local due to the section, so we do not mind the overlap with the general BI notations. *) Notation "P ⊢ Q" := (siProp_entails P Q). Notation "'True'" := (siProp_pure True) : bi_scope. Notation "'False'" := (siProp_pure False) : bi_scope. Notation "'⌜' φ '⌝'" := (siProp_pure φ%type%stdpp) : bi_scope. Infix "∧" := siProp_and : bi_scope. Infix "∨" := siProp_or : bi_scope. Infix "→" := siProp_impl : bi_scope. Notation "∀ x .. y , P" := (siProp_forall (λ x, .. (siProp_forall (λ y, P%I)) ..)) : bi_scope. Notation "∃ x .. y , P" := (siProp_exist (λ x, .. (siProp_exist (λ y, P%I)) ..)) : bi_scope. Notation "▷ P" := (siProp_later P) : bi_scope. Notation "x ≡ y" := (siProp_internal_eq x y) : bi_scope. (** Below there follow the primitive laws for [siProp]. There are no derived laws in this file. *) (** Entailment *) Lemma entails_po : PreOrder siProp_entails. Proof. split. - intros P; by split=> i. - intros P Q Q' HP HQ; split=> i ?; by apply HQ, HP. Qed. Lemma entails_anti_symm : AntiSymm (≡) siProp_entails. Proof. intros P Q HPQ HQP; split=> n; by split; [apply HPQ|apply HQP]. Qed. Lemma equiv_entails P Q : (P ≡ Q) ↔ (P ⊢ Q) ∧ (Q ⊢ P). Proof. split. - intros HPQ; split; split=> i; apply HPQ. - intros [??]. by apply entails_anti_symm. Qed. (** Non-expansiveness and setoid morphisms *) Lemma pure_ne n : Proper (iff ==> dist n) siProp_pure. Proof. intros φ1 φ2 Hφ. by unseal. Qed. Lemma and_ne : NonExpansive2 siProp_and. Proof. intros n P P' HP Q Q' HQ; unseal; split=> n' ?. split; (intros [??]; split; [by apply HP|by apply HQ]). Qed. Lemma or_ne : NonExpansive2 siProp_or. Proof. intros n P P' HP Q Q' HQ; split=> n' ?. unseal; split; (intros [?|?]; [left; by apply HP|right; by apply HQ]). Qed. Lemma impl_ne : NonExpansive2 siProp_impl. Proof. intros n P P' HP Q Q' HQ; split=> n' ?. unseal; split; intros HPQ n'' ??; apply HQ, HPQ, HP; auto with lia. Qed. Lemma forall_ne A n : Proper (pointwise_relation _ (dist n) ==> dist n) (@siProp_forall 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) (@siProp_exist A). Proof. intros Ψ1 Ψ2 HΨ. unseal; split=> n' ?; split; intros [a ?]; exists a; by apply HΨ. Qed. Lemma later_contractive : Contractive siProp_later. Proof. unseal; intros [|n] P Q HPQ; split=> -[|n'] ? //=; try lia. eapply HPQ; eauto with si_solver. Qed. Lemma internal_eq_ne (A : ofe) : NonExpansive2 (@siProp_internal_eq 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. (** Introduction and elimination rules *) Lemma pure_intro (φ : Prop) P : φ → P ⊢ ⌜ φ ⌝. Proof. intros ?. unseal; by split. Qed. Lemma pure_elim' (φ : Prop) P : (φ → True ⊢ P) → ⌜ φ ⌝ ⊢ P. Proof. unseal=> HP; split=> n ?. by apply HP. Qed. Lemma pure_forall_2 {A} (φ : A → Prop) : (∀ a, ⌜ φ a ⌝) ⊢ ⌜ ∀ a, φ a ⌝. Proof. by unseal. Qed. Lemma and_elim_l P Q : P ∧ Q ⊢ P. Proof. unseal; by split=> n [??]. Qed. Lemma and_elim_r P Q : P ∧ Q ⊢ Q. Proof. unseal; by split=> n [??]. Qed. Lemma and_intro P Q R : (P ⊢ Q) → (P ⊢ R) → P ⊢ Q ∧ R. Proof. intros HQ HR; unseal; split=> n ?. split. - by apply HQ. - by apply HR. Qed. Lemma or_intro_l P Q : P ⊢ P ∨ Q. Proof. unseal; split=> n ?; left; auto. Qed. Lemma or_intro_r P Q : Q ⊢ P ∨ Q. Proof. unseal; split=> n ?; right; auto. Qed. Lemma or_elim P Q R : (P ⊢ R) → (Q ⊢ R) → P ∨ Q ⊢ R. Proof. intros HP HQ. unseal; split=> n [?|?]. - by apply HP. - by apply HQ. Qed. Lemma impl_intro_r P Q R : (P ∧ Q ⊢ R) → P ⊢ Q → R. Proof. unseal=> HQ; split=> n ? n' ??. apply HQ; naive_solver eauto using siProp_closed. Qed. Lemma impl_elim_l' P Q R : (P ⊢ Q → R) → P ∧ Q ⊢ R. Proof. unseal=> HP; split=> n [??]. apply HP with n; auto. Qed. Lemma forall_intro {A} P (Ψ : A → siProp) : (∀ a, P ⊢ Ψ a) → P ⊢ ∀ a, Ψ a. Proof. unseal; intros HPΨ; split=> n ? a; by apply HPΨ. Qed. Lemma forall_elim {A} {Ψ : A → siProp} a : (∀ a, Ψ a) ⊢ Ψ a. Proof. unseal; split=> n HP; apply HP. Qed. Lemma exist_intro {A} {Ψ : A → siProp} a : Ψ a ⊢ ∃ a, Ψ a. Proof. unseal; split=> n ?; by exists a. Qed. Lemma exist_elim {A} (Φ : A → siProp) Q : (∀ a, Φ a ⊢ Q) → (∃ a, Φ a) ⊢ Q. Proof. unseal; intros HΨ; split=> n [a ?]; by apply HΨ with a. Qed. (** Later *) Lemma later_eq_1 {A : ofe} (x y : A) : Next x ≡ Next y ⊢ ▷ (x ≡ y). Proof. unseal. split. intros [|n]; simpl; [done|]. intros Heq; apply Heq; auto. Qed. Lemma later_eq_2 {A : ofe} (x y : A) : ▷ (x ≡ y) ⊢ Next x ≡ Next y. Proof. unseal. split. intros n Hn; split; intros m Hlt; simpl in *. destruct n as [|n]; eauto using dist_le with si_solver. Qed. Lemma later_mono P Q : (P ⊢ Q) → ▷ P ⊢ ▷ Q. Proof. unseal=> HP; split=>-[|n]; [done|apply HP; eauto using cmra_validN_S]. Qed. Lemma later_intro P : P ⊢ ▷ P. Proof. unseal; split=> -[|n] /= HP; eauto using siProp_closed. Qed. Lemma later_forall_2 {A} (Φ : A → siProp) : (∀ a, ▷ Φ a) ⊢ ▷ ∀ a, Φ a. Proof. unseal; by split=> -[|n]. Qed. Lemma later_exist_false {A} (Φ : A → siProp) : (▷ ∃ a, Φ a) ⊢ ▷ False ∨ (∃ a, ▷ Φ a). Proof. unseal; split=> -[|[|n]] /=; eauto. Qed. Lemma later_false_em P : ▷ P ⊢ ▷ False ∨ (▷ False → P). Proof. unseal; split=> -[|n] /= HP; [by left|right]. intros [|n'] ?; eauto using siProp_closed with lia. Qed. (** Equality *) Lemma internal_eq_refl {A : ofe} P (a : A) : P ⊢ (a ≡ a). Proof. unseal; by split=> n ? /=. Qed. Lemma internal_eq_rewrite {A : ofe} a b (Ψ : A → siProp) : NonExpansive Ψ → a ≡ b ⊢ Ψ a → Ψ b. Proof. intros Hnonexp. unseal; split=> n Hab n' ? HΨ. eapply Hnonexp with n a; auto. Qed. Lemma fun_ext {A} {B : A → ofe} (f g : discrete_fun B) : (∀ x, f x ≡ g x) ⊢ f ≡ g. Proof. by unseal. Qed. Lemma sig_eq {A : ofe} (P : A → Prop) (x y : sig P) : `x ≡ `y ⊢ x ≡ y. Proof. by unseal. Qed. Lemma discrete_eq_1 {A : ofe} (a b : A) : Discrete a → a ≡ b ⊢ ⌜a ≡ b⌝. Proof. unseal=> ?. split=> n. by apply (discrete_iff n). Qed. Lemma prop_ext_2 P Q : ((P → Q) ∧ (Q → P)) ⊢ P ≡ Q. Proof. unseal; split=> n /= HPQ. split=> n' ?. move: HPQ=> [] /(_ n') ? /(_ n'). naive_solver. Qed. (** Consistency/soundness statement *) Lemma pure_soundness φ : (True ⊢ ⌜ φ ⌝) → φ. Proof. unseal=> -[H]. by apply (H 0). Qed. Lemma internal_eq_soundness {A : ofe} (x y : A) : (True ⊢ x ≡ y) → x ≡ y. Proof. unseal=> -[H]. apply equiv_dist=> n. by apply (H n). Qed. Lemma later_soundness P : (True ⊢ ▷ P) → (True ⊢ P). Proof. unseal=> -[HP]; split=> n _. apply siProp_closed with n; last done. by apply (HP (S n)). Qed. End primitive. End siProp_primitive. iris-iris-4.2.0/iris_deprecated/000077500000000000000000000000001460620107300165545ustar00rootroot00000000000000iris-iris-4.2.0/iris_deprecated/.keep000066400000000000000000000000001460620107300174670ustar00rootroot00000000000000iris-iris-4.2.0/iris_deprecated/base_logic/000077500000000000000000000000001460620107300206435ustar00rootroot00000000000000iris-iris-4.2.0/iris_deprecated/base_logic/auth.v000066400000000000000000000217151460620107300220010ustar00rootroot00000000000000(** This logic-level wrapper on top of the [auth] RA turns out to be much harder to use than just directly using the RA, hence it is deprecated and will be removed entirely after some grace period. *) From iris.algebra Require Export auth. From iris.algebra Require Import gmap. From iris.proofmode Require Import tactics. From iris.base_logic.lib Require Export invariants. From iris.prelude Require Import options. Import uPred. (* The CMRA we need. *) Class authG Σ (A : ucmra) := AuthG { auth_inG : inG Σ (authR A); #[global] auth_cmra_discrete :: CmraDiscrete A; }. Local Existing Instance auth_inG. Definition authΣ (A : ucmra) : gFunctors := #[ GFunctor (authR A) ]. Global Instance subG_authΣ Σ A : subG (authΣ A) Σ → CmraDiscrete A → authG Σ A. Proof. solve_inG. Qed. Section definitions. Context `{!invGS Σ, !authG Σ A} {T : Type} (γ : gname). Definition auth_own (a : A) : iProp Σ := own γ (◯ a). Definition auth_inv (f : T → A) (φ : T → iProp Σ) : iProp Σ := ∃ t, own γ (● f t) ∗ φ t. Definition auth_ctx (N : namespace) (f : T → A) (φ : T → iProp Σ) : iProp Σ := inv N (auth_inv f φ). Global Instance auth_own_ne : NonExpansive auth_own. Proof. solve_proper. Qed. Global Instance auth_own_proper : Proper ((≡) ==> (⊣⊢)) auth_own. Proof. solve_proper. Qed. Global Instance auth_own_timeless a : Timeless (auth_own a). Proof. apply _. Qed. Global Instance auth_own_core_id a : CoreId a → Persistent (auth_own a). Proof. apply _. Qed. Global Instance auth_inv_ne n : Proper (pointwise_relation T (dist n) ==> pointwise_relation T (dist n) ==> dist n) auth_inv. Proof. solve_proper. Qed. Global Instance auth_inv_proper : Proper (pointwise_relation T (≡) ==> pointwise_relation T (⊣⊢) ==> (⊣⊢)) auth_inv. Proof. solve_proper. Qed. Global Instance auth_ctx_ne N n : Proper (pointwise_relation T (dist n) ==> pointwise_relation T (dist n) ==> dist n) (auth_ctx N). Proof. solve_proper. Qed. Global Instance auth_ctx_proper N : Proper (pointwise_relation T (≡) ==> pointwise_relation T (⊣⊢) ==> (⊣⊢)) (auth_ctx N). Proof. solve_proper. Qed. Global Instance auth_ctx_persistent N f φ : Persistent (auth_ctx N f φ). Proof. apply _. Qed. End definitions. Global Typeclasses Opaque auth_own auth_inv auth_ctx. Global Instance: Params (@auth_own) 4 := {}. Global Instance: Params (@auth_inv) 5 := {}. Global Instance: Params (@auth_ctx) 7 := {}. Section auth. Context `{!invGS Σ, !authG Σ A}. Context {T : Type} `{!Inhabited T}. Context (f : T → A) (φ : T → iProp Σ). Implicit Types N : namespace. Implicit Types P Q R : iProp Σ. Implicit Types a b : A. Implicit Types t u : T. Implicit Types γ : gname. 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. Proof. rewrite /IsOp /FromAnd=> ->. by rewrite auth_own_op. Qed. Global Instance from_and_auth_own_persistent γ a b1 b2 : IsOp a b1 b2 → Or (CoreId b1) (CoreId b2) → FromAnd true (auth_own γ a) (auth_own γ b1) (auth_own γ b2) | 91. Proof. intros ? Hper; apply mk_from_and_persistent; [destruct Hper; apply _|]. by rewrite -auth_own_op -is_op. Qed. Global Instance into_and_auth_own p γ a b1 b2 : 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. Lemma auth_own_valid γ a : auth_own γ a ⊢ ✓ a. Proof. by rewrite /auth_own own_valid auth_frag_validI. Qed. Global Instance auth_own_sep_homomorphism γ : WeakMonoidHomomorphism op uPred_sep (≡) (auth_own γ). Proof. split; try apply _. apply auth_own_op. Qed. Lemma big_opL_auth_own {B} γ (g : nat → B → A) (l : list B) : l ≠ [] → auth_own γ ([^op list] k↦x ∈ l, g k x) ⊣⊢ [∗ list] k↦x ∈ l, auth_own γ (g k x). Proof. apply (big_opL_commute1 _). Qed. Lemma big_opM_auth_own `{Countable K} {B} γ (g : K → B → A) (m : gmap K B) : m ≠ ∅ → auth_own γ ([^op map] k↦x ∈ m, g k x) ⊣⊢ [∗ map] k↦x ∈ m, auth_own γ (g k x). Proof. apply (big_opM_commute1 _). Qed. Lemma big_opS_auth_own `{Countable B} γ (g : B → A) (X : gset B) : X ≠ ∅ → auth_own γ ([^op set] x ∈ X, g x) ⊣⊢ [∗ set] x ∈ X, auth_own γ (g x). Proof. apply (big_opS_commute1 _). Qed. Lemma big_opMS_auth_own `{Countable B} γ (g : B → A) (X : gmultiset B) : X ≠ ∅ → auth_own γ ([^op mset] x ∈ X, g x) ⊣⊢ [∗ mset] x ∈ X, auth_own γ (g x). Proof. apply (big_opMS_commute1 _). Qed. Global Instance auth_own_cmra_sep_entails_homomorphism γ : MonoidHomomorphism op uPred_sep (⊢) (auth_own γ). Proof. split; [split|]; try apply _. - intros. by rewrite auth_own_op. - apply (affine _). Qed. Lemma big_opL_auth_own_1 {B} γ (g : nat → B → A) (l : list B) : auth_own γ ([^op list] k↦x ∈ l, g k x) ⊢ [∗ list] k↦x ∈ l, auth_own γ (g k x). Proof. apply (big_opL_commute _). Qed. Lemma big_opM_auth_own_1 `{Countable K} {B} γ (g : K → B → A) (m : gmap K B) : auth_own γ ([^op map] k↦x ∈ m, g k x) ⊢ [∗ map] k↦x ∈ m, auth_own γ (g k x). Proof. apply (big_opM_commute _). Qed. Lemma big_opS_auth_own_1 `{Countable B} γ (g : B → A) (X : gset B) : auth_own γ ([^op set] x ∈ X, g x) ⊢ [∗ set] x ∈ X, auth_own γ (g x). Proof. apply (big_opS_commute _). Qed. Lemma big_opMS_auth_own_1 `{Countable B} γ (g : B → A) (X : gmultiset B) : auth_own γ ([^op mset] x ∈ X, g x) ⊢ [∗ mset] x ∈ X, auth_own γ (g x). Proof. apply (big_opMS_commute _). Qed. Global Instance own_mono' γ : Proper (flip (≼) ==> (⊢)) (auth_own γ). Proof. intros a1 a2. apply auth_own_mono. Qed. Lemma auth_alloc_strong N E t (I : gname → Prop) : pred_infinite I → ✓ (f t) → ▷ φ t ={E}=∗ ∃ γ, ⌜I γ⌝ ∗ auth_ctx γ N f φ ∗ auth_own γ (f t). Proof. iIntros (??) "Hφ". rewrite /auth_own /auth_ctx. iMod (own_alloc_strong (● f t ⋅ ◯ f t) I) as (γ) "[% [Hγ Hγ']]"; [done|by apply auth_both_valid_discrete|]. iMod (inv_alloc N _ (auth_inv γ f φ) with "[-Hγ']") as "#?". { iNext. rewrite /auth_inv. iExists t. by iFrame. } eauto. Qed. Lemma auth_alloc_cofinite N E t (G : gset gname) : ✓ (f t) → ▷ φ t ={E}=∗ ∃ γ, ⌜γ ∉ G⌝ ∗ auth_ctx γ N f φ ∗ auth_own γ (f t). Proof. intros ?. apply auth_alloc_strong=>//. apply (pred_infinite_set (C:=gset gname)) => E'. exists (fresh (G ∪ E')). apply not_elem_of_union, is_fresh. Qed. Lemma auth_alloc N E t : ✓ (f t) → ▷ φ t ={E}=∗ ∃ γ, auth_ctx γ N f φ ∗ auth_own γ (f t). Proof. iIntros (?) "Hφ". iMod (auth_alloc_cofinite N E t ∅ with "Hφ") as (γ) "[_ ?]"; eauto. Qed. Lemma auth_empty γ : ⊢ |==> auth_own γ ε. Proof. by rewrite /auth_own -own_unit. Qed. Lemma auth_inv_acc E γ a : ▷ auth_inv γ f φ ∗ auth_own γ a ={E}=∗ ∃ t, ⌜a ≼ f t⌝ ∗ ▷ φ t ∗ ∀ u b, ⌜(f t, a) ~l~> (f u, b)⌝ ∗ ▷ φ u ={E}=∗ ▷ auth_inv γ f φ ∗ auth_own γ b. Proof using Type*. iIntros "[Hinv Hγf]". rewrite /auth_inv /auth_own. iDestruct "Hinv" as (t) "[>Hγa Hφ]". iModIntro. iExists t. iDestruct (own_valid_2 with "Hγa Hγf") as % [? ?]%auth_both_valid_discrete. iSplit; first done. iFrame "Hφ". iIntros (u b) "[% Hφ]". iMod (own_update_2 with "Hγa Hγf") as "[Hγa Hγf]". { eapply auth_update; eassumption. } by iFrame. Qed. Lemma auth_acc E N γ a : ↑N ⊆ E → auth_ctx γ N f φ ∗ auth_own γ a ={E,E∖↑N}=∗ ∃ t, ⌜a ≼ f t⌝ ∗ ▷ φ t ∗ ∀ u b, ⌜(f t, a) ~l~> (f u, b)⌝ ∗ ▷ φ u ={E∖↑N,E}=∗ auth_own γ b. Proof using Type*. iIntros (?) "[#? Hγf]". rewrite /auth_ctx. iInv N as "Hinv" "Hclose". (* The following is essentially a very trivial composition of the accessors [auth_inv_acc] and [inv_acc] -- but since we don't have any good support for that currently, this gets more tedious than it should, with us having to unpack and repack various proofs. TODO: Make this mostly automatic, by supporting "opening accessors around accessors". *) iMod (auth_inv_acc with "[$Hinv $Hγf]") as (t) "(?&?&HclAuth)". iModIntro. iExists t. iFrame. iIntros (u b) "H". iMod ("HclAuth" $! u b with "H") as "(Hinv & ?)". by iMod ("Hclose" with "Hinv"). Qed. End auth. Global Arguments auth_acc {_ _ _} [_] {_} [_] _ _ _ _ _ _ _. iris-iris-4.2.0/iris_deprecated/base_logic/sts.v000066400000000000000000000171021460620107300216440ustar00rootroot00000000000000(** This logic-level wrapper on top of the [sts] RA turns out to be much harder to use than just directly using the RA, hence it is deprecated and will be removed entirely after some grace period. *) From iris.algebra Require Export sts. From iris.proofmode Require Import tactics. From iris.base_logic.lib Require Export invariants. From iris.prelude Require Import options. Import uPred. (** The CMRA we need. *) Class stsG Σ (sts : stsT) := StsG { sts_inG : inG Σ (sts_resR sts); #[global] sts_inhabited :: Inhabited (sts.state sts); }. Local Existing Instance sts_inG. Definition stsΣ (sts : stsT) : gFunctors := #[ GFunctor (sts_resR sts) ]. Global Instance subG_stsΣ Σ sts : subG (stsΣ sts) Σ → Inhabited (sts.state sts) → stsG Σ sts. Proof. solve_inG. Qed. Section definitions. Context `{!stsG Σ sts} (γ : gname). Definition sts_ownS (S : sts.states sts) (T : sts.tokens sts) : iProp Σ := own γ (sts_frag S T). Definition sts_own (s : sts.state sts) (T : sts.tokens sts) : iProp Σ := own γ (sts_frag_up s T). Definition sts_inv (φ : sts.state sts → iProp Σ) : iProp Σ := ∃ s, own γ (sts_auth s ∅) ∗ φ s. Definition sts_ctx `{!invGS Σ} (N : namespace) (φ: sts.state sts → iProp Σ) : iProp Σ := inv N (sts_inv φ). Global Instance sts_inv_ne n : Proper (pointwise_relation _ (dist n) ==> dist n) sts_inv. Proof. solve_proper. Qed. Global Instance sts_inv_proper : Proper (pointwise_relation _ (≡) ==> (≡)) sts_inv. Proof. solve_proper. Qed. Global Instance sts_ownS_proper : Proper ((≡) ==> (≡) ==> (⊣⊢)) sts_ownS. Proof. solve_proper. Qed. Global Instance sts_own_proper s : Proper ((≡) ==> (⊣⊢)) (sts_own s). Proof. solve_proper. Qed. Global Instance sts_ctx_ne `{!invGS Σ} n N : Proper (pointwise_relation _ (dist n) ==> dist n) (sts_ctx N). Proof. solve_proper. Qed. Global Instance sts_ctx_proper `{!invGS Σ} N : Proper (pointwise_relation _ (≡) ==> (⊣⊢)) (sts_ctx N). Proof. solve_proper. Qed. Global Instance sts_ctx_persistent `{!invGS Σ} N φ : Persistent (sts_ctx N φ). Proof. apply _. Qed. Global Instance sts_own_persistent s : Persistent (sts_own s ∅). Proof. apply _. Qed. Global Instance sts_ownS_persistent S : Persistent (sts_ownS S ∅). Proof. apply _. Qed. End definitions. Global Instance: Params (@sts_inv) 4 := {}. Global Instance: Params (@sts_ownS) 4 := {}. Global Instance: Params (@sts_own) 5 := {}. Global Instance: Params (@sts_ctx) 6 := {}. Section sts. Context `{!invGS Σ, !stsG Σ sts}. Implicit Types φ : sts.state sts → iProp Σ. Implicit Types N : namespace. Implicit Types P Q R : iProp Σ. Implicit Types γ : gname. Implicit Types S : sts.states sts. Implicit Types T : sts.tokens sts. (* The same rule as implication does *not* hold, as could be shown using sts_frag_included. *) Lemma sts_ownS_weaken γ S1 S2 T1 T2 : T2 ⊆ T1 → S1 ⊆ S2 → sts.closed S2 T2 → sts_ownS γ S1 T1 ==∗ sts_ownS γ S2 T2. Proof. intros ???. iApply own_update. by apply sts_update_frag. Qed. Lemma sts_own_weaken γ s S T1 T2 : T2 ⊆ T1 → s ∈ S → sts.closed S T2 → sts_own γ s T1 ==∗ sts_ownS γ S T2. Proof. intros ???. iApply own_update. by apply sts_update_frag_up. Qed. Lemma sts_own_weaken_state γ s1 s2 T : sts.frame_steps T s2 s1 → sts.tok s2 ## T → sts_own γ s1 T ==∗ sts_own γ s2 T. Proof. intros ??. iApply own_update. apply sts_update_frag_up; [|done..]. intros Hdisj. apply sts.closed_up. done. Qed. Lemma sts_own_weaken_tok γ s T1 T2 : T2 ⊆ T1 → sts_own γ s T1 ==∗ sts_own γ s T2. Proof. intros ?. iApply own_update. apply sts_update_frag_up; last done. - intros. apply sts.closed_up. set_solver. - apply sts.elem_of_up. Qed. Lemma sts_ownS_op γ S1 S2 T1 T2 : T1 ## T2 → sts.closed S1 T1 → sts.closed S2 T2 → sts_ownS γ (S1 ∩ S2) (T1 ∪ T2) ⊣⊢ (sts_ownS γ S1 T1 ∗ sts_ownS γ S2 T2). Proof. intros. by rewrite /sts_ownS -own_op sts_frag_op. Qed. Lemma sts_own_op γ s T1 T2 : T1 ## T2 → sts_own γ s (T1 ∪ T2) ==∗ sts_own γ s T1 ∗ sts_own γ s T2. (* The other direction does not hold -- see sts.up_op. *) Proof. intros. rewrite /sts_own -own_op. iIntros "Hown". iDestruct (own_valid with "Hown") as %Hval%sts_frag_up_valid. rewrite -sts_frag_op. - iApply (sts_own_weaken with "Hown"); first done. + split; apply sts.elem_of_up. + eapply sts.closed_op; apply sts.closed_up; set_solver. - done. - apply sts.closed_up; set_solver. - apply sts.closed_up; set_solver. Qed. Local Typeclasses Opaque sts_own sts_ownS sts_inv sts_ctx. Lemma sts_alloc φ E N s : ▷ φ s ={E}=∗ ∃ γ, sts_ctx γ N φ ∧ sts_own γ s (⊤ ∖ sts.tok s). Proof. iIntros "Hφ". rewrite /sts_ctx /sts_own. iMod (own_alloc (sts_auth s (⊤ ∖ sts.tok s))) as (γ) "Hγ". { apply sts_auth_valid; set_solver. } iExists γ; iRevert "Hγ"; rewrite -sts_auth_frag_up_op; iIntros "[Hγ $]". iMod (inv_alloc N _ (sts_inv γ φ) with "[Hφ Hγ]") as "#?"; auto. rewrite /sts_inv. iNext. iExists s. by iFrame. Qed. Lemma sts_inv_accS φ E γ S T : ▷ sts_inv γ φ ∗ sts_ownS γ S T ={E}=∗ ∃ s, ⌜s ∈ S⌝ ∗ ▷ φ s ∗ ∀ s' T', ⌜sts.steps (s, T) (s', T')⌝ ∗ ▷ φ s' ={E}=∗ ▷ sts_inv γ φ ∗ sts_own γ s' T'. Proof. iIntros "[Hinv Hγf]". rewrite /sts_ownS /sts_inv /sts_own. iDestruct "Hinv" as (s) "[>Hγ Hφ]". iDestruct (own_valid_2 with "Hγ Hγf") as %Hvalid. assert (s ∈ S) by eauto using sts_auth_frag_valid_inv. assert (✓ sts_frag S T) as [??] by eauto using cmra_valid_op_r. iModIntro; iExists s; iSplit; [done|]; iFrame "Hφ". iIntros (s' T') "[% Hφ]". iMod (own_update_2 with "Hγ Hγf") as "Hγ". { rewrite sts_auth_frag_op; [|done..]. by apply sts_update_auth. } iRevert "Hγ"; rewrite -sts_auth_frag_up_op; iIntros "[Hγ $]". iModIntro. iNext. iExists s'; by iFrame. Qed. Lemma sts_inv_acc φ E γ s0 T : ▷ sts_inv γ φ ∗ sts_own γ s0 T ={E}=∗ ∃ s, ⌜sts.frame_steps T s0 s⌝ ∗ ▷ φ s ∗ ∀ s' T', ⌜sts.steps (s, T) (s', T')⌝ ∗ ▷ φ s' ={E}=∗ ▷ sts_inv γ φ ∗ sts_own γ s' T'. Proof. by apply sts_inv_accS. Qed. Lemma sts_accS φ E N γ S T : ↑N ⊆ E → sts_ctx γ N φ ∗ sts_ownS γ S T ={E,E∖↑N}=∗ ∃ s, ⌜s ∈ S⌝ ∗ ▷ φ s ∗ ∀ s' T', ⌜sts.steps (s, T) (s', T')⌝ ∗ ▷ φ s' ={E∖↑N,E}=∗ sts_own γ s' T'. Proof. iIntros (?) "[#? Hγf]". rewrite /sts_ctx. iInv N as "Hinv" "Hclose". (* The following is essentially a very trivial composition of the accessors [sts_inv_acc] and [inv_acc] -- but since we don't have any good support for that currently, this gets more tedious than it should, with us having to unpack and repack various proofs. TODO: Make this mostly automatic, by supporting "opening accessors around accessors". *) iMod (sts_inv_accS with "[Hinv Hγf]") as (s) "(?&?& HclSts)"; first by iFrame. iModIntro. iExists s. iFrame. iIntros (s' T') "H". iMod ("HclSts" $! s' T' with "H") as "(Hinv & ?)". by iMod ("Hclose" with "Hinv"). Qed. Lemma sts_acc φ E N γ s0 T : ↑N ⊆ E → sts_ctx γ N φ ∗ sts_own γ s0 T ={E,E∖↑N}=∗ ∃ s, ⌜sts.frame_steps T s0 s⌝ ∗ ▷ φ s ∗ ∀ s' T', ⌜sts.steps (s, T) (s', T')⌝ ∗ ▷ φ s' ={E∖↑N,E}=∗ sts_own γ s' T'. Proof. by apply sts_accS. Qed. End sts. Global Typeclasses Opaque sts_own sts_ownS sts_inv sts_ctx. iris-iris-4.2.0/iris_deprecated/base_logic/viewshifts.v000066400000000000000000000074161460620107300232350ustar00rootroot00000000000000(** The binary (implicitly persistent) view shift connective is rarely ever useful in Coq. This module only exists to verify that the proof rules we give on paper hold true. Use the non-persistent connective [={E}=∗] wrapped in a [□] modality if needed. This file will be removed when we find a good way to have a [Definition] with telescopes for Texan triples. *) From iris.proofmode Require Import tactics. From iris.base_logic.lib Require Export invariants. From iris.prelude Require Import options. Definition vs `{!invGS Σ} (E1 E2 : coPset) (P Q : iProp Σ) : iProp Σ := □ (P -∗ |={E1,E2}=> Q). Global Arguments vs {_ _} _ _ _%I _%I. Global 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") : 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") : bi_scope. Notation "P ={ E1 , E2 }=> Q" := (P ={E1,E2}=> Q)%I (at level 99, E1,E2 at level 50, Q at level 200, format "P ={ E1 , E2 }=> Q") : stdpp_scope. Notation "P ={ E }=> Q" := (P ={E}=> Q)%I (at level 99, E at level 50, Q at level 200, format "P ={ E }=> Q") : stdpp_scope. Section vs. Context `{!invGS Σ}. Implicit Types P Q R : iProp Σ. Implicit Types N : namespace. Global Instance vs_ne E1 E2 : NonExpansive2 (vs E1 E2). Proof. solve_proper. Qed. Global Instance vs_proper E1 E2 : Proper ((≡) ==> (≡) ==> (≡)) (vs E1 E2). Proof. apply ne_proper_2, _. Qed. Lemma vs_mono E1 E2 P P' Q Q' : (P ⊢ P') → (Q' ⊢ Q) → (P' ={E1,E2}=> Q') ⊢ P ={E1,E2}=> Q. Proof. by intros HP HQ; rewrite /vs -HP HQ. Qed. Global Instance vs_mono' E1 E2 : Proper (flip (⊢) ==> (⊢) ==> (⊢)) (vs E1 E2). Proof. solve_proper. Qed. Lemma vs_false_elim E1 E2 P : ⊢ False ={E1,E2}=> P. Proof. iIntros "!> []". Qed. Lemma vs_timeless E P : Timeless P → ⊢ ▷ P ={E}=> P. Proof. by iIntros (?) "!> > ?". Qed. Lemma vs_transitive E1 E2 E3 P Q R : (P ={E1,E2}=> Q) ∧ (Q ={E2,E3}=> R) ⊢ P ={E1,E3}=> R. Proof. iIntros "#[HvsP HvsQ] !> HP". iMod ("HvsP" with "HP") as "HQ". by iApply "HvsQ". Qed. Lemma vs_reflexive E P : ⊢ P ={E}=> P. Proof. by iIntros "!> HP". Qed. Lemma vs_impl E P Q : □ (P → Q) ⊢ P ={E}=> Q. Proof. iIntros "#HPQ !> HP". by iApply "HPQ". Qed. Lemma vs_frame_l E1 E2 P Q R : (P ={E1,E2}=> Q) ⊢ R ∗ P ={E1,E2}=> R ∗ Q. Proof. iIntros "#Hvs !> [$ HP]". by iApply "Hvs". Qed. Lemma vs_frame_r E1 E2 P Q R : (P ={E1,E2}=> Q) ⊢ P ∗ R ={E1,E2}=> Q ∗ R. Proof. iIntros "#Hvs !> [HP $]". by iApply "Hvs". Qed. Lemma vs_mask_frame_r E1 E2 Ef P Q : E1 ## Ef → (P ={E1,E2}=> Q) ⊢ P ={E1 ∪ Ef,E2 ∪ Ef}=> Q. Proof. iIntros (?) "#Hvs !> HP". iApply fupd_mask_frame_r; auto. by iApply "Hvs". Qed. Lemma vs_inv N E P Q R : ↑N ⊆ E → inv N R ∗ (▷ R ∗ P ={E∖↑N}=> ▷ R ∗ Q) ⊢ P ={E}=> Q. Proof. iIntros (?) "#[? Hvs] !> HP". iInv N as "HR" "Hclose". iMod ("Hvs" with "[HR HP]") as "[? $]"; first by iFrame. by iApply "Hclose". Qed. Lemma vs_inv_acc N E P : ↑N ⊆ E → ⊢ inv N P ={E,E∖↑N}=> ▷ P ∗ ∃ R, R ∗ (R ∗ ▷ P ={E∖↑N,E}=> True). Proof. (* FIXME: scope printing is weird, there are [%stdpp]. *) iIntros (?) "!> #Hinv". iMod (inv_acc with "Hinv") as "[$ Hclose]"; first done. iModIntro. iExists (▷ P ={E ∖ ↑N,E}=∗ True)%I. iFrame. iIntros "!> [Hclose HP]". iMod ("Hclose" with "HP"). done. Qed. 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 bi.wand_alt. do 2 f_equiv. setoid_rewrite bi.affine_affinely; last apply _. by rewrite bi.persistently_impl_wand. Qed. End vs. iris-iris-4.2.0/iris_deprecated/program_logic/000077500000000000000000000000001460620107300214005ustar00rootroot00000000000000iris-iris-4.2.0/iris_deprecated/program_logic/hoare.v000066400000000000000000000154141460620107300226720ustar00rootroot00000000000000(** Hoare triples are rarely ever useful in Coq. This module only exists to verify that the proof rules we give on paper hold true. Use Texan triples or [WP] instead. This file will be removed when we find a good way to have a [Definition] with telescopes for Texan triples. *) From iris.proofmode Require Import tactics. From iris.deprecated.base_logic Require Export viewshifts. From iris.program_logic Require Export weakestpre. From iris.prelude Require Import options. Definition ht `{!irisGS Λ Σ} (s : stuckness) (E : coPset) (P : iProp Σ) (e : expr Λ) (Φ : val Λ → iProp Σ) : iProp Σ := (□ (P -∗ WP e @ s; E {{ Φ }}))%I. Global Instance: Params (@ht) 5 := {}. Notation "{{ P } } e @ s ; E {{ Φ } }" := (ht s E P%I e%E Φ%I) (at level 20, P, e, Φ at level 200, format "{{ P } } e @ s ; E {{ Φ } }") : stdpp_scope. Notation "{{ P } } e @ E {{ Φ } }" := (ht NotStuck E P%I e%E Φ%I) (at level 20, P, e, Φ at level 200, format "{{ P } } e @ E {{ Φ } }") : stdpp_scope. Notation "{{ P } } e @ E ? {{ Φ } }" := (ht MaybeStuck E P%I e%E Φ%I) (at level 20, P, e, Φ at level 200, format "{{ P } } e @ E ? {{ Φ } }") : stdpp_scope. Notation "{{ P } } e {{ Φ } }" := (ht NotStuck ⊤ P%I e%E Φ%I) (at level 20, P, e, Φ at level 200, format "{{ P } } e {{ Φ } }") : stdpp_scope. Notation "{{ P } } e ? {{ Φ } }" := (ht MaybeStuck ⊤ P%I e%E Φ%I) (at level 20, P, e, Φ at level 200, format "{{ P } } e ? {{ Φ } }") : stdpp_scope. Notation "{{ P } } e @ s ; E {{ v , Q } }" := (ht s E P%I e%E (λ v, Q)%I) (at level 20, P, e, Q at level 200, format "{{ P } } e @ s ; E {{ v , Q } }") : stdpp_scope. Notation "{{ P } } e @ E {{ v , Q } }" := (ht NotStuck E P%I e%E (λ v, Q)%I) (at level 20, P, e, Q at level 200, format "{{ P } } e @ E {{ v , Q } }") : stdpp_scope. Notation "{{ P } } e @ E ? {{ v , Q } }" := (ht MaybeStuck E P%I e%E (λ v, Q)%I) (at level 20, P, e, Q at level 200, format "{{ P } } e @ E ? {{ v , Q } }") : stdpp_scope. Notation "{{ P } } e {{ v , Q } }" := (ht NotStuck ⊤ P%I e%E (λ v, Q)%I) (at level 20, P, e, Q at level 200, format "{{ P } } e {{ v , Q } }") : stdpp_scope. Notation "{{ P } } e ? {{ v , Q } }" := (ht MaybeStuck ⊤ P%I e%E (λ v, Q)%I) (at level 20, P, e, Q at level 200, format "{{ P } } e ? {{ v , Q } }") : stdpp_scope. Section hoare. Context `{!irisGS Λ Σ}. Implicit Types s : stuckness. Implicit Types P Q : iProp Σ. Implicit Types Φ Ψ : val Λ → iProp Σ. Implicit Types v : val Λ. Import uPred. Global Instance ht_ne s E n : Proper (dist n ==> eq ==> pointwise_relation _ (dist n) ==> dist n) (ht s E). Proof. solve_proper. Qed. Global Instance ht_proper s E : Proper ((≡) ==> eq ==> pointwise_relation _ (≡) ==> (≡)) (ht 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 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 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. Lemma ht_alt s E P Φ e : (P ⊢ WP e @ s; E {{ Φ }}) → ⊢ {{ P }} e @ s; E {{ Φ }}. Proof. iIntros (Hwp) "!> HP". by iApply Hwp. Qed. Lemma ht_val s E v : ⊢ {{ True }} of_val v @ s; E {{ v', ⌜v = v'⌝ }}. Proof. iIntros "!> _". by iApply wp_value'. Qed. Lemma ht_vs s E P P' Φ Φ' e : (P ={E}=> P') ∧ {{ P' }} e @ s; E {{ Φ' }} ∧ (∀ v, Φ' v ={E}=> Φ v) ⊢ {{ P }} e @ s; E {{ Φ }}. Proof. iIntros "(#Hvs & #Hwp & #HΦ) !> HP". iMod ("Hvs" with "HP") as "HP". iApply wp_fupd. iApply (wp_wand with "(Hwp HP)"). iIntros (v) "Hv". by iApply "HΦ". Qed. Lemma ht_atomic s E1 E2 P P' Φ Φ' e `{!Atomic (stuckness_to_atomicity s) e} : (P ={E1,E2}=> P') ∧ {{ P' }} e @ s; E2 {{ Φ' }} ∧ (∀ v, Φ' v ={E2,E1}=> Φ v) ⊢ {{ P }} e @ s; E1 {{ Φ }}. Proof. iIntros "(#Hvs & #Hwp & #HΦ) !> HP". iApply (wp_atomic _ _ E2); auto. iMod ("Hvs" with "HP") as "HP". iModIntro. iApply (wp_wand with "(Hwp HP)"). iIntros (v) "Hv". by iApply "HΦ". Qed. Lemma ht_bind `{!LanguageCtx K} s E P Φ Φ' e : {{ P }} e @ s; E {{ Φ }} ∧ (∀ v, {{ Φ v }} K (of_val v) @ s; E {{ Φ' }}) ⊢ {{ P }} K e @ s; E {{ Φ' }}. Proof. iIntros "[#Hwpe #HwpK] !> HP". iApply wp_bind. iApply (wp_wand with "(Hwpe HP)"). iIntros (v) "Hv". by iApply "HwpK". Qed. Lemma ht_stuck_weaken s E P Φ e : {{ P }} e @ s; E {{ Φ }} ⊢ {{ P }} e @ E ?{{ Φ }}. Proof. by iIntros "#Hwp !> ?"; iApply wp_stuck_weaken; iApply "Hwp". Qed. Lemma ht_mask_weaken s E1 E2 P Φ e : E1 ⊆ E2 → {{ P }} e @ s; E1 {{ Φ }} ⊢ {{ P }} e @ s; E2 {{ Φ }}. Proof. iIntros (?) "#Hwp !> HP". iApply (wp_mask_mono _ E1 E2); try done. by iApply "Hwp". Qed. Lemma ht_frame_l s E P Φ R e : {{ P }} e @ s; E {{ Φ }} ⊢ {{ R ∗ P }} e @ s; E {{ v, R ∗ Φ v }}. Proof. iIntros "#Hwp !> [$ HP]". by iApply "Hwp". Qed. Lemma ht_frame_r s E P Φ R e : {{ P }} e @ s; E {{ Φ }} ⊢ {{ P ∗ R }} e @ s; E {{ v, Φ v ∗ R }}. Proof. iIntros "#Hwp !> [HP $]". by iApply "Hwp". Qed. Lemma ht_frame_step_l s E1 E2 P R1 R2 e Φ : TCEq (to_val e) None → E2 ⊆ E1 → (R1 ={E1,E2}=> ▷ |={E2,E1}=> R2) ∧ {{ P }} e @ s; E2 {{ Φ }} ⊢ {{ R1 ∗ P }} e @ s; E1 {{ λ v, R2 ∗ Φ v }}. Proof. iIntros (??) "[#Hvs #Hwp] !> [HR HP]". iApply (wp_frame_step_l _ E1 E2); try done. iSplitL "HR"; [by iApply "Hvs"|by iApply "Hwp"]. Qed. Lemma ht_frame_step_r s E1 E2 P R1 R2 e Φ : TCEq (to_val e) None → E2 ⊆ E1 → (R1 ={E1,E2}=> ▷ |={E2,E1}=> R2) ∧ {{ P }} e @ s; E2 {{ Φ }} ⊢ {{ P ∗ R1 }} e @ s; E1 {{ λ v, Φ v ∗ R2 }}. Proof. iIntros (??) "[#Hvs #Hwp] !> [HP HR]". iApply (wp_frame_step_r _ E1 E2); try done. iSplitR "HR"; [by iApply "Hwp"|by iApply "Hvs"]. Qed. Lemma ht_frame_step_l' s E P R e Φ : TCEq (to_val e) None → {{ P }} e @ s; E {{ Φ }} ⊢ {{ ▷ R ∗ P }} e @ s; E {{ v, R ∗ Φ v }}. Proof. iIntros (?) "#Hwp !> [HR HP]". iApply wp_frame_step_l'; try done. iFrame "HR". by iApply "Hwp". Qed. Lemma ht_frame_step_r' s E P Φ R e : TCEq (to_val e) None → {{ P }} e @ s; E {{ Φ }} ⊢ {{ P ∗ ▷ R }} e @ s; E {{ v, Φ v ∗ R }}. Proof. iIntros (?) "#Hwp !> [HP HR]". iApply wp_frame_step_r'; try done. iFrame "HR". by iApply "Hwp". Qed. Lemma ht_exists (T : Type) s E (P : T → iProp Σ) Φ e : (∀ x, {{ P x }} e @ s; E {{ Φ }}) ⊢ {{ ∃ x, P x }} e @ s; E {{ Φ }}. Proof. iIntros "#HT !> HP". iDestruct "HP" as (x) "HP". by iApply "HT". Qed. End hoare. iris-iris-4.2.0/iris_heap_lang/000077500000000000000000000000001460620107300163725ustar00rootroot00000000000000iris-iris-4.2.0/iris_heap_lang/adequacy.v000066400000000000000000000045031460620107300203570ustar00rootroot00000000000000From iris.algebra Require Import auth. From iris.base_logic.lib Require Import mono_nat. From iris.proofmode Require Import proofmode. From iris.program_logic Require Export weakestpre adequacy. From iris.heap_lang Require Import proofmode notation. From iris.prelude Require Import options. Class heapGpreS Σ := HeapGpreS { #[global] heapGpreS_iris :: invGpreS Σ; #[global] heapGpreS_heap :: gen_heapGpreS loc (option val) Σ; #[global] heapGpreS_inv_heap :: inv_heapGpreS loc (option val) Σ; #[global] heapGpreS_proph :: proph_mapGpreS proph_id (val * val) Σ; #[global] heapGS_step_cnt :: mono_natG Σ; }. Definition heapΣ : gFunctors := #[invΣ; gen_heapΣ loc (option val); inv_heapΣ loc (option val); proph_mapΣ proph_id (val * val); mono_natΣ]. Global Instance subG_heapGpreS {Σ} : subG heapΣ Σ → heapGpreS Σ. Proof. solve_inG. Qed. (* TODO: The [wp_adequacy] lemma is insufficient for a state interpretation with a non-constant step index function. We thus use the more general [wp_strong_adequacy] lemma. The proof below replicates part of the proof of [wp_adequacy], and it hence would make sense to see if we can prove a version of [wp_adequacy] for a non-constant step version. *) Definition heap_adequacy Σ `{!heapGpreS Σ} s e σ φ : (∀ `{!heapGS Σ}, ⊢ inv_heap_inv -∗ WP e @ s; ⊤ {{ v, ⌜φ v⌝ }}) → adequate s e σ (λ v _, φ v). Proof. intros Hwp. apply adequate_alt; intros t2 σ2 [n [κs ?]]%erased_steps_nsteps. eapply (wp_strong_adequacy Σ _); [|done]. iIntros (Hinv). iMod (gen_heap_init σ.(heap)) as (?) "[Hh _]". iMod (inv_heap_init loc (option val)) as (?) ">Hi". iMod (proph_map_init κs σ.(used_proph_id)) as (?) "Hp". iMod (mono_nat_own_alloc) as (γ) "[Hsteps _]". iDestruct (Hwp (HeapGS _ _ _ _ _ _ _ _) with "Hi") as "Hwp". iModIntro. iExists (λ σ ns κs nt, (gen_heap_interp σ.(heap) ∗ proph_map_interp κs σ.(used_proph_id) ∗ mono_nat_auth_own γ 1 ns))%I. iExists [(λ v, ⌜φ v⌝%I)], (λ _, True)%I, _ => /=. iFrame. iIntros (es' t2' -> ? ?) " _ H _". iApply fupd_mask_intro_discard; [done|]. iSplit; [|done]. iDestruct (big_sepL2_cons_inv_r with "H") as (e' ? ->) "[Hwp H]". iDestruct (big_sepL2_nil_inv_r with "H") as %->. iIntros (v2 t2'' [= -> <-]). by rewrite to_of_val. Qed. iris-iris-4.2.0/iris_heap_lang/class_instances.v000066400000000000000000000166011460620107300217410ustar00rootroot00000000000000From iris.program_logic Require Export language. From iris.heap_lang Require Export lang. From iris.heap_lang Require Import tactics notation. From iris.prelude Require Import options. Global Instance into_val_val v : IntoVal (Val v) v. Proof. done. Qed. Global Instance as_val_val v : AsVal (Val v). Proof. by eexists. Qed. (** * Instances of the [Atomic] class *) Section atomic. Local Ltac solve_atomic := apply strongly_atomic_atomic, ectx_language_atomic; [inversion 1; naive_solver |apply ectxi_language_sub_redexes_are_values; intros [] **; naive_solver]. Global Instance rec_atomic s f x e : Atomic s (Rec f x e). Proof. solve_atomic. Qed. Global Instance pair_atomic s v1 v2 : Atomic s (Pair (Val v1) (Val v2)). Proof. solve_atomic. Qed. Global Instance injl_atomic s v : Atomic s (InjL (Val v)). Proof. solve_atomic. Qed. Global Instance injr_atomic s v : Atomic s (InjR (Val v)). Proof. solve_atomic. Qed. (** The instance below is a more general version of [Skip] *) Global Instance beta_atomic s f x v1 v2 : Atomic s (App (RecV f x (Val v1)) (Val v2)). Proof. destruct f, x; solve_atomic. Qed. Global Instance unop_atomic s op v : Atomic s (UnOp op (Val v)). Proof. solve_atomic. Qed. Global Instance binop_atomic s op v1 v2 : Atomic s (BinOp op (Val v1) (Val v2)). Proof. solve_atomic. Qed. Global Instance if_true_atomic s v1 e2 : Atomic s (If (Val $ LitV $ LitBool true) (Val v1) e2). Proof. solve_atomic. Qed. Global Instance if_false_atomic s e1 v2 : Atomic s (If (Val $ LitV $ LitBool false) e1 (Val v2)). Proof. solve_atomic. Qed. Global Instance fst_atomic s v : Atomic s (Fst (Val v)). Proof. solve_atomic. Qed. Global Instance snd_atomic s v : Atomic s (Snd (Val v)). Proof. solve_atomic. Qed. Global Instance fork_atomic s e : Atomic s (Fork e). Proof. solve_atomic. Qed. Global Instance alloc_atomic s v w : Atomic s (AllocN (Val v) (Val w)). Proof. solve_atomic. Qed. Global Instance free_atomic s v : Atomic s (Free (Val v)). Proof. solve_atomic. Qed. Global Instance load_atomic s v : Atomic s (Load (Val v)). Proof. solve_atomic. Qed. Global Instance xchg_atomic s v1 v2 : Atomic s (Xchg (Val v1) (Val v2)). Proof. solve_atomic. Qed. Global Instance store_atomic s v1 v2 : Atomic s (Store (Val v1) (Val v2)). Proof. solve_atomic. Qed. Global Instance cmpxchg_atomic s v0 v1 v2 : Atomic s (CmpXchg (Val v0) (Val v1) (Val v2)). Proof. solve_atomic. Qed. Global Instance faa_atomic s v1 v2 : Atomic s (FAA (Val v1) (Val v2)). Proof. solve_atomic. Qed. Global Instance new_proph_atomic s : Atomic s NewProph. Proof. solve_atomic. Qed. Global Instance resolve_atomic s e v1 v2 : Atomic s e → Atomic s (Resolve e (Val v1) (Val v2)). Proof. rename e into e1. intros H σ1 e2 κ σ2 efs [Ks e1' e2' Hfill -> step]. simpl in *. induction Ks as [|K Ks _] using rev_ind; simpl in Hfill. - subst. inversion_clear step. by eapply (H σ1 (Val _) _ σ2 efs), base_prim_step. - rewrite fill_app. rewrite fill_app in Hfill. assert (∀ v, Val v = fill Ks e1' → False) as fill_absurd. { intros v Hv. assert (to_val (fill Ks e1') = Some v) as Htv by by rewrite -Hv. apply to_val_fill_some in Htv. destruct Htv as [-> ->]. inversion step. } destruct K; (inversion Hfill; clear Hfill; subst; try match goal with | H : Val ?v = fill Ks e1' |- _ => by apply fill_absurd in H end). refine (_ (H σ1 (fill (Ks ++ [_]) e2') _ σ2 efs _)). + destruct s; intro Hs; simpl in *. * destruct Hs as [v Hs]. apply to_val_fill_some in Hs. by destruct Hs, Ks. * apply irreducible_resolve. by rewrite fill_app in Hs. + econstructor; try done. simpl. by rewrite fill_app. Qed. End atomic. (** * Instances of the [PureExec] class *) (** The behavior of the various [wp_] tactics with regard to lambda differs in the following way: - [wp_pures] does *not* reduce lambdas/recs that are hidden behind a definition. - [wp_rec] and [wp_lam] reduce lambdas/recs that are hidden behind a definition. To realize this behavior, we define the class [AsRecV v f x erec], which takes a value [v] as its input, and turns it into a [RecV f x erec] via the instance [AsRecV_recv : AsRecV (RecV f x e) f x e]. We register this instance via [Hint Extern] so that it is only used if [v] is syntactically a lambda/rec, and not if [v] contains a lambda/rec that is hidden behind a definition. To make sure that [wp_rec] and [wp_lam] do reduce lambdas/recs that are hidden behind a definition, we activate [AsRecV_recv] by hand in these tactics. *) Class AsRecV (v : val) (f x : binder) (erec : expr) := as_recv : v = RecV f x erec. Global Hint Mode AsRecV ! - - - : typeclass_instances. Definition AsRecV_recv f x e : AsRecV (RecV f x e) f x e := eq_refl. Global Hint Extern 0 (AsRecV (RecV _ _ _) _ _ _) => apply AsRecV_recv : typeclass_instances. Section pure_exec. Local Ltac solve_exec_safe := intros; subst; do 3 eexists; econstructor; eauto. Local Ltac solve_exec_puredet := simpl; intros; by inv_base_step. Local Ltac solve_pure_exec := subst; intros ?; apply nsteps_once, pure_base_step_pure_step; constructor; [solve_exec_safe | solve_exec_puredet]. Global Instance pure_recc f x (erec : expr) : PureExec True 1 (Rec f x erec) (Val $ RecV f x erec). Proof. solve_pure_exec. Qed. Global Instance pure_pairc (v1 v2 : val) : PureExec True 1 (Pair (Val v1) (Val v2)) (Val $ PairV v1 v2). Proof. solve_pure_exec. Qed. Global Instance pure_injlc (v : val) : PureExec True 1 (InjL $ Val v) (Val $ InjLV v). Proof. solve_pure_exec. Qed. Global Instance pure_injrc (v : val) : PureExec True 1 (InjR $ Val v) (Val $ InjRV v). Proof. solve_pure_exec. Qed. Global Instance pure_beta f x (erec : expr) (v1 v2 : val) `{!AsRecV v1 f x erec} : PureExec True 1 (App (Val v1) (Val v2)) (subst' x v2 (subst' f v1 erec)). Proof. unfold AsRecV in *. solve_pure_exec. Qed. Global Instance pure_unop op v v' : PureExec (un_op_eval op v = Some v') 1 (UnOp op (Val v)) (Val v'). Proof. solve_pure_exec. Qed. Global Instance pure_binop op v1 v2 v' : PureExec (bin_op_eval op v1 v2 = Some v') 1 (BinOp op (Val v1) (Val v2)) (Val v') | 10. Proof. solve_pure_exec. Qed. (* Lower-cost instance for [EqOp]. *) Global Instance pure_eqop v1 v2 : PureExec (vals_compare_safe v1 v2) 1 (BinOp EqOp (Val v1) (Val v2)) (Val $ LitV $ LitBool $ bool_decide (v1 = v2)) | 1. Proof. intros Hcompare. cut (bin_op_eval EqOp v1 v2 = Some $ LitV $ LitBool $ bool_decide (v1 = v2)). { intros. revert Hcompare. solve_pure_exec. } rewrite /bin_op_eval /= decide_True //. Qed. Global Instance pure_if_true e1 e2 : PureExec True 1 (If (Val $ LitV $ LitBool true) e1 e2) e1. Proof. solve_pure_exec. Qed. Global Instance pure_if_false e1 e2 : PureExec True 1 (If (Val $ LitV $ LitBool false) e1 e2) e2. Proof. solve_pure_exec. Qed. Global Instance pure_fst v1 v2 : PureExec True 1 (Fst (Val $ PairV v1 v2)) (Val v1). Proof. solve_pure_exec. Qed. Global Instance pure_snd v1 v2 : PureExec True 1 (Snd (Val $ PairV v1 v2)) (Val v2). Proof. solve_pure_exec. Qed. Global Instance pure_case_inl v e1 e2 : PureExec True 1 (Case (Val $ InjLV v) e1 e2) (App e1 (Val v)). Proof. solve_pure_exec. Qed. Global Instance pure_case_inr v e1 e2 : PureExec True 1 (Case (Val $ InjRV v) e1 e2) (App e2 (Val v)). Proof. solve_pure_exec. Qed. End pure_exec. iris-iris-4.2.0/iris_heap_lang/derived_laws.v000066400000000000000000000374161460620107300212440ustar00rootroot00000000000000(** This file extends the HeapLang program logic with some derived laws (not using the lifting lemmas) about arrays and prophecies. We collect both the total WP [twp_X] and partial WP [wp_X] versions of the laws. The versions with later credits [wp_X_lc] are omitted because they are too specific and can simply be derived using [twp_wp_step_lc] when needed. For utility functions on arrays (e.g., freeing/copying an array), see [heap_lang.lib.array]. *) From stdpp Require Import fin_maps. From iris.bi Require Import lib.fractional. From iris.proofmode Require Import proofmode. From iris.heap_lang Require Export primitive_laws. From iris.heap_lang Require Import tactics notation. From iris.prelude Require Import options. (** The [array] connective is a version of [pointsto] that works with lists of values. *) Definition array `{!heapGS_gen hlc Σ} (l : loc) (dq : dfrac) (vs : list val) : iProp Σ := [∗ list] i ↦ v ∈ vs, (l +ₗ i) ↦{dq} v. Notation "l ↦∗ dq vs" := (array l dq vs) (at level 20, dq custom dfrac at level 1, format "l ↦∗ dq vs") : bi_scope. (** We have [FromSep] and [IntoSep] instances to split the fraction (via the [AsFractional] instance below), but not for splitting the list, as that would lead to overlapping instances. *) Section lifting. Context `{!heapGS_gen hlc Σ}. Implicit Types P Q : iProp Σ. Implicit Types Φ : val → iProp Σ. Implicit Types σ : state. Implicit Types v : val. Implicit Types vs : list val. Implicit Types l : loc. Implicit Types sz off : nat. Global Instance array_timeless l q vs : Timeless (array l q vs) := _. Global Instance array_fractional l vs : Fractional (λ q, l ↦∗{#q} vs)%I := _. Global Instance array_as_fractional l q vs : AsFractional (l ↦∗{#q} vs) (λ q, l ↦∗{#q} vs)%I q. Proof. split; done || apply _. Qed. Lemma array_nil l dq : l ↦∗{dq} [] ⊣⊢ emp. Proof. by rewrite /array. Qed. Lemma array_singleton l dq v : l ↦∗{dq} [v] ⊣⊢ l ↦{dq} v. Proof. by rewrite /array /= right_id Loc.add_0. Qed. Lemma array_app l dq vs ws : l ↦∗{dq} (vs ++ ws) ⊣⊢ l ↦∗{dq} vs ∗ (l +ₗ length vs) ↦∗{dq} ws. Proof. rewrite /array big_sepL_app. setoid_rewrite Nat2Z.inj_add. by setoid_rewrite Loc.add_assoc. Qed. Lemma array_cons l dq v vs : l ↦∗{dq} (v :: vs) ⊣⊢ l ↦{dq} v ∗ (l +ₗ 1) ↦∗{dq} vs. Proof. rewrite /array big_sepL_cons Loc.add_0. setoid_rewrite Loc.add_assoc. setoid_rewrite Nat2Z.inj_succ. by setoid_rewrite Z.add_1_l. Qed. Global Instance array_cons_frame l dq v vs R Q : Frame false R (l ↦{dq} v ∗ (l +ₗ 1) ↦∗{dq} vs) Q → Frame false R (l ↦∗{dq} (v :: vs)) Q | 2. Proof. by rewrite /Frame array_cons. Qed. Lemma update_array l dq vs off v : vs !! off = Some v → ⊢ l ↦∗{dq} vs -∗ ((l +ₗ off) ↦{dq} v ∗ ∀ v', (l +ₗ off) ↦{dq} v' -∗ l ↦∗{dq} <[off:=v']>vs). Proof. iIntros (Hlookup) "Hl". rewrite -[X in (l ↦∗{_} X)%I](take_drop_middle _ off v); last done. iDestruct (array_app with "Hl") as "[Hl1 Hl]". iDestruct (array_cons with "Hl") as "[Hl2 Hl3]". assert (off < length vs) as H by (apply lookup_lt_is_Some; by eexists). rewrite take_length min_l; last by lia. iFrame "Hl2". iIntros (w) "Hl2". clear Hlookup. assert (<[off:=w]> vs !! off = Some w) as Hlookup. { apply list_lookup_insert. lia. } rewrite -[in (l ↦∗{_} <[off:=w]> vs)%I](take_drop_middle (<[off:=w]> vs) off w Hlookup). iApply array_app. rewrite take_insert; last by lia. iFrame. iApply array_cons. rewrite take_length min_l; last by lia. iFrame. rewrite drop_insert_gt; last by lia. done. Qed. (** * Rules for allocation *) Lemma pointsto_seq_array l dq v n : ([∗ list] i ∈ seq 0 n, (l +ₗ (i : nat)) ↦{dq} v) -∗ l ↦∗{dq} replicate n v. Proof. rewrite /array. iInduction n as [|n'] "IH" forall (l); simpl. { done. } iIntros "[$ Hl]". rewrite -fmap_S_seq big_sepL_fmap. setoid_rewrite Nat2Z.inj_succ. setoid_rewrite <-Z.add_1_l. setoid_rewrite <-Loc.add_assoc. iApply "IH". done. Qed. Lemma twp_allocN s E v n : (0 < n)%Z → [[{ True }]] AllocN (Val $ LitV $ LitInt $ n) (Val v) @ s; E [[{ l, RET LitV (LitLoc l); l ↦∗ replicate (Z.to_nat n) v ∗ [∗ list] i ∈ seq 0 (Z.to_nat n), meta_token (l +ₗ (i : nat)) ⊤ }]]. Proof. iIntros (Hzs Φ) "_ HΦ". iApply twp_allocN_seq; [done..|]. iIntros (l) "Hlm". iApply "HΦ". iDestruct (big_sepL_sep with "Hlm") as "[Hl $]". by iApply pointsto_seq_array. Qed. Lemma wp_allocN s E v n : (0 < n)%Z → {{{ True }}} AllocN (Val $ LitV $ LitInt $ n) (Val v) @ s; E {{{ l, RET LitV (LitLoc l); l ↦∗ replicate (Z.to_nat n) v ∗ [∗ list] i ∈ seq 0 (Z.to_nat n), meta_token (l +ₗ (i : nat)) ⊤ }}}. Proof. iIntros (? Φ) "_ HΦ". iApply (twp_wp_step with "HΦ"). iApply twp_allocN; [auto..|]; iIntros (l) "H HΦ". by iApply "HΦ". Qed. Lemma twp_allocN_vec s E v n : (0 < n)%Z → [[{ True }]] AllocN #n v @ s ; E [[{ l, RET #l; l ↦∗ vreplicate (Z.to_nat n) v ∗ [∗ list] i ∈ seq 0 (Z.to_nat n), meta_token (l +ₗ (i : nat)) ⊤ }]]. Proof. iIntros (Hzs Φ) "_ HΦ". iApply twp_allocN; [ lia | done | .. ]. iIntros (l) "[Hl Hm]". iApply "HΦ". rewrite vec_to_list_replicate. iFrame. Qed. Lemma wp_allocN_vec s E v n : (0 < n)%Z → {{{ True }}} AllocN #n v @ s ; E {{{ l, RET #l; l ↦∗ vreplicate (Z.to_nat n) v ∗ [∗ list] i ∈ seq 0 (Z.to_nat n), meta_token (l +ₗ (i : nat)) ⊤ }}}. Proof. iIntros (? Φ) "_ HΦ". iApply (twp_wp_step with "HΦ"). iApply twp_allocN_vec; [auto..|]; iIntros (l) "H HΦ". by iApply "HΦ". Qed. (** * Rules for accessing array elements *) Lemma twp_load_offset s E l dq off vs v : vs !! off = Some v → [[{ l ↦∗{dq} vs }]] ! #(l +ₗ off) @ s; E [[{ RET v; l ↦∗{dq} vs }]]. Proof. iIntros (Hlookup Φ) "Hl HΦ". iDestruct (update_array l _ _ _ _ Hlookup with "Hl") as "[Hl1 Hl2]". iApply (twp_load with "Hl1"). iIntros "Hl1". iApply "HΦ". iDestruct ("Hl2" $! v) as "Hl2". rewrite list_insert_id; last done. iApply "Hl2". iApply "Hl1". Qed. Lemma wp_load_offset s E l dq off vs v : vs !! off = Some v → {{{ ▷ l ↦∗{dq} vs }}} ! #(l +ₗ off) @ s; E {{{ RET v; l ↦∗{dq} vs }}}. Proof. iIntros (? Φ) ">H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_load_offset with "H"); [by eauto..|]; iIntros "H HΦ". by iApply "HΦ". Qed. Lemma twp_load_offset_vec s E l dq sz (off : fin sz) (vs : vec val sz) : [[{ l ↦∗{dq} vs }]] ! #(l +ₗ off) @ s; E [[{ RET vs !!! off; l ↦∗{dq} vs }]]. Proof. apply twp_load_offset. by apply vlookup_lookup. Qed. Lemma wp_load_offset_vec s E l dq sz (off : fin sz) (vs : vec val sz) : {{{ ▷ l ↦∗{dq} vs }}} ! #(l +ₗ off) @ s; E {{{ RET vs !!! off; l ↦∗{dq} vs }}}. Proof. apply wp_load_offset. by apply vlookup_lookup. Qed. Lemma twp_store_offset s E l off vs v : is_Some (vs !! off) → [[{ l ↦∗ vs }]] #(l +ₗ off) <- v @ s; E [[{ RET #(); l ↦∗ <[off:=v]> vs }]]. Proof. iIntros ([w Hlookup] Φ) "Hl HΦ". iDestruct (update_array l _ _ _ _ Hlookup with "Hl") as "[Hl1 Hl2]". iApply (twp_store with "Hl1"). iIntros "Hl1". iApply "HΦ". iApply "Hl2". iApply "Hl1". Qed. Lemma wp_store_offset s E l off vs v : is_Some (vs !! off) → {{{ ▷ l ↦∗ vs }}} #(l +ₗ off) <- v @ s; E {{{ RET #(); l ↦∗ <[off:=v]> vs }}}. Proof. iIntros (? Φ) ">H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_store_offset with "H"); [by eauto..|]; iIntros "H HΦ". by iApply "HΦ". Qed. Lemma twp_store_offset_vec s E l sz (off : fin sz) (vs : vec val sz) v : [[{ l ↦∗ vs }]] #(l +ₗ off) <- v @ s; E [[{ RET #(); l ↦∗ vinsert off v vs }]]. Proof. setoid_rewrite vec_to_list_insert. apply twp_store_offset. eexists. by apply vlookup_lookup. Qed. Lemma wp_store_offset_vec s E l sz (off : fin sz) (vs : vec val sz) v : {{{ ▷ l ↦∗ vs }}} #(l +ₗ off) <- v @ s; E {{{ RET #(); l ↦∗ vinsert off v vs }}}. Proof. iIntros (Φ) ">H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_store_offset_vec with "H"); [by eauto..|]; iIntros "H HΦ". by iApply "HΦ". Qed. Lemma twp_xchg_offset s E l off vs v v' : vs !! off = Some v → [[{ l ↦∗ vs }]] Xchg #(l +ₗ off) v' @ s; E [[{ RET v; l ↦∗ <[off:=v']> vs }]]. Proof. iIntros (Hlookup Φ) "Hl HΦ". iDestruct (update_array l _ _ _ _ Hlookup with "Hl") as "[Hl1 Hl2]". iApply (twp_xchg with "Hl1"). iIntros "Hl1". iApply "HΦ". iApply "Hl2". iApply "Hl1". Qed. Lemma wp_xchg_offset s E l off vs v v' : vs !! off = Some v → {{{ ▷ l ↦∗ vs }}} Xchg #(l +ₗ off) v' @ s; E {{{ RET v; l ↦∗ <[off:=v']> vs }}}. Proof. iIntros (? Φ) ">H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_xchg_offset with "H"); [by eauto..|]; iIntros "H HΦ". by iApply "HΦ". Qed. Lemma twp_xchg_offset_vec s E l sz (off : fin sz) (vs : vec val sz) v : [[{ l ↦∗ vs }]] Xchg #(l +ₗ off) v @ s; E [[{ RET (vs !!! off); l ↦∗ vinsert off v vs }]]. Proof. setoid_rewrite vec_to_list_insert. apply twp_xchg_offset. by apply vlookup_lookup. Qed. Lemma wp_xchg_offset_vec s E l sz (off : fin sz) (vs : vec val sz) v : {{{ ▷ l ↦∗ vs }}} Xchg #(l +ₗ off) v @ s; E {{{ RET (vs !!! off); l ↦∗ vinsert off v vs }}}. Proof. iIntros (Φ) ">H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_xchg_offset_vec with "H"); [by eauto..|]; iIntros "H HΦ". by iApply "HΦ". Qed. Lemma twp_cmpxchg_suc_offset s E l off vs v' v1 v2 : vs !! off = Some v' → v' = v1 → vals_compare_safe v' v1 → [[{ l ↦∗ vs }]] CmpXchg #(l +ₗ off) v1 v2 @ s; E [[{ RET (v', #true); l ↦∗ <[off:=v2]> vs }]]. Proof. iIntros (Hlookup ?? Φ) "Hl HΦ". iDestruct (update_array l _ _ _ _ Hlookup with "Hl") as "[Hl1 Hl2]". iApply (twp_cmpxchg_suc with "Hl1"); [done..|]. iIntros "Hl1". iApply "HΦ". iApply "Hl2". iApply "Hl1". Qed. Lemma wp_cmpxchg_suc_offset s E l off vs v' v1 v2 : vs !! off = Some v' → v' = v1 → vals_compare_safe v' v1 → {{{ ▷ l ↦∗ vs }}} CmpXchg #(l +ₗ off) v1 v2 @ s; E {{{ RET (v', #true); l ↦∗ <[off:=v2]> vs }}}. Proof. iIntros (??? Φ) ">H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_cmpxchg_suc_offset with "H"); [by eauto..|]; iIntros "H HΦ". by iApply "HΦ". Qed. Lemma twp_cmpxchg_suc_offset_vec s E l sz (off : fin sz) (vs : vec val sz) v1 v2 : vs !!! off = v1 → vals_compare_safe (vs !!! off) v1 → [[{ l ↦∗ vs }]] CmpXchg #(l +ₗ off) v1 v2 @ s; E [[{ RET (vs !!! off, #true); l ↦∗ vinsert off v2 vs }]]. Proof. intros. setoid_rewrite vec_to_list_insert. apply twp_cmpxchg_suc_offset; [|done..]. by apply vlookup_lookup. Qed. Lemma wp_cmpxchg_suc_offset_vec s E l sz (off : fin sz) (vs : vec val sz) v1 v2 : vs !!! off = v1 → vals_compare_safe (vs !!! off) v1 → {{{ ▷ l ↦∗ vs }}} CmpXchg #(l +ₗ off) v1 v2 @ s; E {{{ RET (vs !!! off, #true); l ↦∗ vinsert off v2 vs }}}. Proof. iIntros (?? Φ) ">H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_cmpxchg_suc_offset_vec with "H"); [by eauto..|]; iIntros "H HΦ". by iApply "HΦ". Qed. Lemma twp_cmpxchg_fail_offset s E l dq off vs v0 v1 v2 : vs !! off = Some v0 → v0 ≠ v1 → vals_compare_safe v0 v1 → [[{ l ↦∗{dq} vs }]] CmpXchg #(l +ₗ off) v1 v2 @ s; E [[{ RET (v0, #false); l ↦∗{dq} vs }]]. Proof. iIntros (Hlookup HNEq Hcmp Φ) "Hl HΦ". iDestruct (update_array l _ _ _ _ Hlookup with "Hl") as "[Hl1 Hl2]". iApply (twp_cmpxchg_fail with "Hl1"); first done. { destruct Hcmp; by [ left | right ]. } iIntros "Hl1". iApply "HΦ". iDestruct ("Hl2" $! v0) as "Hl2". rewrite list_insert_id; last done. iApply "Hl2". iApply "Hl1". Qed. Lemma wp_cmpxchg_fail_offset s E l dq off vs v0 v1 v2 : vs !! off = Some v0 → v0 ≠ v1 → vals_compare_safe v0 v1 → {{{ ▷ l ↦∗{dq} vs }}} CmpXchg #(l +ₗ off) v1 v2 @ s; E {{{ RET (v0, #false); l ↦∗{dq} vs }}}. Proof. iIntros (??? Φ) ">H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_cmpxchg_fail_offset with "H"); [by eauto..|]; iIntros "H HΦ". by iApply "HΦ". Qed. Lemma twp_cmpxchg_fail_offset_vec s E l dq sz (off : fin sz) (vs : vec val sz) v1 v2 : vs !!! off ≠ v1 → vals_compare_safe (vs !!! off) v1 → [[{ l ↦∗{dq} vs }]] CmpXchg #(l +ₗ off) v1 v2 @ s; E [[{ RET (vs !!! off, #false); l ↦∗{dq} vs }]]. Proof. intros. apply twp_cmpxchg_fail_offset; [|done..]. by apply vlookup_lookup. Qed. Lemma wp_cmpxchg_fail_offset_vec s E l dq sz (off : fin sz) (vs : vec val sz) v1 v2 : vs !!! off ≠ v1 → vals_compare_safe (vs !!! off) v1 → {{{ ▷ l ↦∗{dq} vs }}} CmpXchg #(l +ₗ off) v1 v2 @ s; E {{{ RET (vs !!! off, #false); l ↦∗{dq} vs }}}. Proof. intros. eapply wp_cmpxchg_fail_offset; [|done..]. by apply vlookup_lookup. Qed. Lemma twp_faa_offset s E l off vs (i1 i2 : Z) : vs !! off = Some #i1 → [[{ l ↦∗ vs }]] FAA #(l +ₗ off) #i2 @ s; E [[{ RET LitV (LitInt i1); l ↦∗ <[off:=#(i1 + i2)]> vs }]]. Proof. iIntros (Hlookup Φ) "Hl HΦ". iDestruct (update_array l _ _ _ _ Hlookup with "Hl") as "[Hl1 Hl2]". iApply (twp_faa with "Hl1"). iIntros "Hl1". iApply "HΦ". iApply "Hl2". iApply "Hl1". Qed. Lemma wp_faa_offset s E l off vs (i1 i2 : Z) : vs !! off = Some #i1 → {{{ ▷ l ↦∗ vs }}} FAA #(l +ₗ off) #i2 @ s; E {{{ RET LitV (LitInt i1); l ↦∗ <[off:=#(i1 + i2)]> vs }}}. Proof. iIntros (? Φ) ">H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_faa_offset with "H"); [by eauto..|]; iIntros "H HΦ". by iApply "HΦ". Qed. Lemma twp_faa_offset_vec s E l sz (off : fin sz) (vs : vec val sz) (i1 i2 : Z) : vs !!! off = #i1 → [[{ l ↦∗ vs }]] FAA #(l +ₗ off) #i2 @ s; E [[{ RET LitV (LitInt i1); l ↦∗ vinsert off #(i1 + i2) vs }]]. Proof. intros. setoid_rewrite vec_to_list_insert. apply twp_faa_offset. by apply vlookup_lookup. Qed. Lemma wp_faa_offset_vec s E l sz (off : fin sz) (vs : vec val sz) (i1 i2 : Z) : vs !!! off = #i1 → {{{ ▷ l ↦∗ vs }}} FAA #(l +ₗ off) #i2 @ s; E {{{ RET LitV (LitInt i1); l ↦∗ vinsert off #(i1 + i2) vs }}}. Proof. iIntros (? Φ) ">H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_faa_offset_vec with "H"); [by eauto..|]; iIntros "H HΦ". by iApply "HΦ". Qed. (** Derived prophecy laws *) (** Lemmas for some particular expression inside the [Resolve]. *) Lemma wp_resolve_proph s E (p : proph_id) (pvs : list (val * val)) v : {{{ proph p pvs }}} ResolveProph (Val $ LitV $ LitProphecy p) (Val v) @ s; E {{{ pvs', RET (LitV LitUnit); ⌜pvs = (LitV LitUnit, v)::pvs'⌝ ∗ proph p pvs' }}}. Proof. iIntros (Φ) "Hp HΦ". iApply (wp_resolve with "Hp"); first done. iApply lifting.wp_pure_step_later; first done. iIntros "!> _". iApply wp_value. iIntros (vs') "HEq Hp". iApply "HΦ". iFrame. Qed. Lemma wp_resolve_cmpxchg_suc s E l (p : proph_id) (pvs : list (val * val)) v1 v2 v : vals_compare_safe v1 v1 → {{{ proph p pvs ∗ ▷ l ↦ v1 }}} Resolve (CmpXchg #l v1 v2) #p v @ s; E {{{ RET (v1, #true) ; ∃ pvs', ⌜pvs = ((v1, #true)%V, v)::pvs'⌝ ∗ proph p pvs' ∗ l ↦ v2 }}}. Proof. iIntros (Hcmp Φ) "[Hp Hl] HΦ". iApply (wp_resolve with "Hp"); first done. assert (val_is_unboxed v1) as Hv1; first by destruct Hcmp. iApply (wp_cmpxchg_suc with "Hl"); [done..|]. iIntros "!> Hl". iIntros (pvs' ->) "Hp". iApply "HΦ". eauto with iFrame. Qed. Lemma wp_resolve_cmpxchg_fail s E l (p : proph_id) (pvs : list (val * val)) dq v' v1 v2 v : v' ≠ v1 → vals_compare_safe v' v1 → {{{ proph p pvs ∗ ▷ l ↦{dq} v' }}} Resolve (CmpXchg #l v1 v2) #p v @ s; E {{{ RET (v', #false) ; ∃ pvs', ⌜pvs = ((v', #false)%V, v)::pvs'⌝ ∗ proph p pvs' ∗ l ↦{dq} v' }}}. Proof. iIntros (NEq Hcmp Φ) "[Hp Hl] HΦ". iApply (wp_resolve with "Hp"); first done. iApply (wp_cmpxchg_fail with "Hl"); [done..|]. iIntros "!> Hl". iIntros (pvs' ->) "Hp". iApply "HΦ". eauto with iFrame. Qed. End lifting. Global Typeclasses Opaque array. iris-iris-4.2.0/iris_heap_lang/lang.v000066400000000000000000001034631460620107300175110ustar00rootroot00000000000000From stdpp Require Export binders strings. From stdpp Require Import gmap. From iris.algebra Require Export ofe. From iris.program_logic Require Export language ectx_language ectxi_language. From iris.heap_lang Require Export locations. From iris.prelude Require Import options. (** heap_lang. A fairly simple language used for common Iris examples. Noteworthy design choices: - This is a right-to-left evaluated language, like CakeML and OCaml. The reason for this is that it makes curried functions usable: Given a WP for [f a b], we know that any effects [f] might have to not matter until after *both* [a] and [b] are evaluated. With left-to-right evaluation, that triple is basically useless unless the user let-expands [b]. - Even after deallocating a location, the heap remembers that these locations were previously allocated and makes sure they do not get reused. This is necessary to ensure soundness of the [meta] feature provided by [gen_heap]. Also, unlike in languages like C, allocated and deallocated "blocks" do not have to match up: you can allocate a large array of locations and then deallocate a hole out of it in the middle. - For prophecy variables, we annotate the reduction steps with an "observation" and tweak adequacy such that WP knows all future observations. There is another possible choice: Use non-deterministic choice when creating a prophecy variable ([NewProph]), and when resolving it ([Resolve]) make the program diverge unless the variable matches. That, however, requires an erasure proof that this endless loop does not make specifications useless. The expression [Resolve e p v] attaches a prophecy resolution (for prophecy variable [p] to value [v]) to the top-level base-reduction step of [e]. The prophecy resolution happens simultaneously with the base-step being taken. Furthermore, it is required that the base-step produces a value (otherwise the [Resolve] is stuck), and this value is also attached to the resolution. A prophecy variable is thus resolved to a pair containing (1) the result value of the wrapped expression (called [e] above), and (2) the value that was attached by the [Resolve] (called [v] above). This allows, for example, to distinguish a resolution originating from a successful [CmpXchg] from one originating from a failing [CmpXchg]. For example: - [Resolve (CmpXchg #l #n #(n+1)) #p v] will behave as [CmpXchg #l #n #(n+1)], which means step to a value-boole pair [(n', b)] while updating the heap, but in the meantime the prophecy variable [p] will be resolved to [(n', b), v)]. - [Resolve (! #l) #p v] will behave as [! #l], that is return the value [w] pointed to by [l] on the heap (assuming it was allocated properly), but it will additionally resolve [p] to the pair [(w,v)]. Note that the sub-expressions of [Resolve e p v] (i.e., [e], [p] and [v]) are reduced as usual, from right to left. However, the evaluation of [e] is restricted so that the base-step to which the resolution is attached cannot be taken by the context. For example: - [Resolve (CmpXchg #l #n (#n + #1)) #p v] will first be reduced (with by a context-step) to [Resolve (CmpXchg #l #n #(n+1) #p v], and then behave as described above. - However, [Resolve ((λ: "n", CmpXchg #l "n" ("n" + #1)) #n) #p v] is stuck. Indeed, it can only be evaluated using a base-step (it is a β-redex), but the process does not yield a value. The mechanism described above supports nesting [Resolve] expressions to attach several prophecy resolutions to a base-redex. *) Delimit Scope expr_scope with E. Delimit Scope val_scope with V. Module heap_lang. (** Expressions and vals. *) Definition proph_id := positive. (** We have a notion of "poison" as a variant of unit that may not be compared with anything. This is useful for erasure proofs: if we erased things to unit, [ == unit] would evaluate to true after erasure, changing program behavior. So we erase to the poison value instead, making sure that no legal comparisons could be affected. *) Inductive base_lit : Set := | LitInt (n : Z) | LitBool (b : bool) | LitUnit | LitPoison | LitLoc (l : loc) | LitProphecy (p: proph_id). Inductive un_op : Set := | NegOp | MinusUnOp. Inductive bin_op : Set := (** We use "quot" and "rem" instead of "div" and "mod" to better match the behavior of 'real' languages: e.g., in Rust, -30/-4 == 7. ("div" would return 8.) *) | PlusOp | MinusOp | MultOp | QuotOp | RemOp (* Arithmetic *) | AndOp | OrOp | XorOp (* Bitwise *) | ShiftLOp | ShiftROp (* Shifts *) | LeOp | LtOp | EqOp (* Relations *) | OffsetOp. (* Pointer offset *) Inductive expr := (* Values *) | Val (v : val) (* Base lambda calculus *) | Var (x : string) | Rec (f x : binder) (e : expr) | App (e1 e2 : expr) (* Base types and their operations *) | UnOp (op : un_op) (e : expr) | BinOp (op : bin_op) (e1 e2 : expr) | If (e0 e1 e2 : expr) (* Products *) | Pair (e1 e2 : expr) | Fst (e : expr) | Snd (e : expr) (* Sums *) | InjL (e : expr) | InjR (e : expr) | Case (e0 : expr) (e1 : expr) (e2 : expr) (* Heap *) | AllocN (e1 e2 : expr) (* array length (positive number), initial value *) | Free (e : expr) | Load (e : expr) | Store (e1 : expr) (e2 : expr) | CmpXchg (e0 : expr) (e1 : expr) (e2 : expr) (* Compare-exchange *) | Xchg (e0 : expr) (e1 : expr) (* exchange *) | FAA (e1 : expr) (e2 : expr) (* Fetch-and-add *) (* Concurrency *) | Fork (e : expr) (* Prophecy *) | NewProph | Resolve (e0 : expr) (e1 : expr) (e2 : expr) (* wrapped expr, proph, val *) with val := | LitV (l : base_lit) | RecV (f x : binder) (e : expr) | PairV (v1 v2 : val) | InjLV (v : val) | InjRV (v : val). Bind Scope expr_scope with expr. Bind Scope val_scope with val. (** An observation associates a prophecy variable (identifier) to a pair of values. The first value is the one that was returned by the (atomic) operation during which the prophecy resolution happened (typically, a boolean when the wrapped operation is a CmpXchg). The second value is the one that the prophecy variable was actually resolved to. *) Definition observation : Set := proph_id * (val * val). Notation of_val := Val (only parsing). Definition to_val (e : expr) : option val := match e with | Val v => Some v | _ => 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 LitPoison, InjLV (LitV LitPoison), InjRV (LitV LitPoison), 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 lit_is_unboxed (l: base_lit) : Prop := match l with (** Disallow comparing (erased) prophecies with (erased) prophecies, by considering them boxed. *) | LitProphecy _ | LitPoison => False | LitInt _ | LitBool _ | LitLoc _ | LitUnit => True end. Definition val_is_unboxed (v : val) : Prop := match v with | LitV l => lit_is_unboxed l | InjLV (LitV l) => lit_is_unboxed l | InjRV (LitV l) => lit_is_unboxed l | _ => False end. Global Instance lit_is_unboxed_dec l : Decision (lit_is_unboxed l). Proof. destruct l; simpl; exact (decide _). Defined. Global Instance val_is_unboxed_dec v : Decision (val_is_unboxed v). Proof. destruct v as [ | | | [] | [] ]; simpl; exact (decide _). Defined. (** We just compare the word-sized representation of two values, without looking 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_compare_safe (vl v1 : val) : Prop := val_is_unboxed vl ∨ val_is_unboxed v1. Global Arguments vals_compare_safe !_ !_ /. (** The state: heaps of [option val]s, with [None] representing deallocated locations. *) Record state : Type := { heap: gmap loc (option val); used_proph_id: gset proph_id; }. (** Equality and other typeclass stuff *) Lemma to_of_val v : to_val (of_val v) = Some v. Proof. by destruct v. Qed. Lemma of_to_val e v : to_val e = Some v → of_val v = e. Proof. destruct e=>//=. by intros [= <-]. Qed. Global Instance of_val_inj : Inj (=) (=) of_val. Proof. intros ??. congruence. Qed. Global Instance base_lit_eq_dec : EqDecision base_lit. Proof. solve_decision. Defined. Global Instance un_op_eq_dec : EqDecision un_op. Proof. solve_decision. Defined. Global Instance bin_op_eq_dec : EqDecision bin_op. Proof. solve_decision. Defined. Global Instance expr_eq_dec : EqDecision expr. Proof. refine ( fix go (e1 e2 : expr) {struct e1} : Decision (e1 = e2) := match e1, e2 with | Val v, Val v' => cast_if (decide (v = v')) | Var x, Var x' => cast_if (decide (x = x')) | Rec f x e, Rec f' x' e' => cast_if_and3 (decide (f = f')) (decide (x = x')) (decide (e = e')) | App e1 e2, App e1' e2' => cast_if_and (decide (e1 = e1')) (decide (e2 = e2')) | UnOp o e, UnOp o' e' => cast_if_and (decide (o = o')) (decide (e = e')) | BinOp o e1 e2, BinOp o' e1' e2' => cast_if_and3 (decide (o = o')) (decide (e1 = e1')) (decide (e2 = e2')) | If e0 e1 e2, If e0' e1' e2' => cast_if_and3 (decide (e0 = e0')) (decide (e1 = e1')) (decide (e2 = e2')) | Pair e1 e2, Pair e1' e2' => cast_if_and (decide (e1 = e1')) (decide (e2 = e2')) | Fst e, Fst e' => cast_if (decide (e = e')) | Snd e, Snd e' => cast_if (decide (e = e')) | InjL e, InjL e' => cast_if (decide (e = e')) | InjR e, InjR e' => cast_if (decide (e = e')) | Case e0 e1 e2, Case e0' e1' e2' => cast_if_and3 (decide (e0 = e0')) (decide (e1 = e1')) (decide (e2 = e2')) | AllocN e1 e2, AllocN e1' e2' => cast_if_and (decide (e1 = e1')) (decide (e2 = e2')) | Free e, Free e' => cast_if (decide (e = e')) | Load e, Load e' => cast_if (decide (e = e')) | Store e1 e2, Store e1' e2' => cast_if_and (decide (e1 = e1')) (decide (e2 = e2')) | CmpXchg e0 e1 e2, CmpXchg e0' e1' e2' => cast_if_and3 (decide (e0 = e0')) (decide (e1 = e1')) (decide (e2 = e2')) | Xchg e0 e1, Xchg e0' e1' => cast_if_and (decide (e0 = e0')) (decide (e1 = e1')) | FAA e1 e2, FAA e1' e2' => cast_if_and (decide (e1 = e1')) (decide (e2 = e2')) | Fork e, Fork e' => cast_if (decide (e = e')) | NewProph, NewProph => left _ | Resolve e0 e1 e2, Resolve e0' e1' e2' => cast_if_and3 (decide (e0 = e0')) (decide (e1 = e1')) (decide (e2 = e2')) | _, _ => right _ end with gov (v1 v2 : val) {struct v1} : Decision (v1 = v2) := match v1, v2 with | LitV l, LitV l' => cast_if (decide (l = l')) | RecV f x e, RecV f' x' e' => cast_if_and3 (decide (f = f')) (decide (x = x')) (decide (e = e')) | PairV e1 e2, PairV e1' e2' => cast_if_and (decide (e1 = e1')) (decide (e2 = e2')) | InjLV e, InjLV e' => cast_if (decide (e = e')) | InjRV e, InjRV e' => cast_if (decide (e = e')) | _, _ => right _ end for go); try (clear go gov; abstract intuition congruence). Defined. Global Instance val_eq_dec : EqDecision val. Proof. solve_decision. Defined. Global Instance base_lit_countable : Countable base_lit. Proof. refine (inj_countable' (λ l, match l with | LitInt n => (inl (inl n), None) | LitBool b => (inl (inr b), None) | LitUnit => (inr (inl false), None) | LitPoison => (inr (inl true), None) | LitLoc l => (inr (inr l), None) | LitProphecy p => (inr (inl false), Some p) end) (λ l, match l with | (inl (inl n), None) => LitInt n | (inl (inr b), None) => LitBool b | (inr (inl false), None) => LitUnit | (inr (inl true), None) => LitPoison | (inr (inr l), None) => LitLoc l | (_, Some p) => LitProphecy p end) _); by intros []. Qed. Global Instance un_op_finite : Countable un_op. Proof. refine (inj_countable' (λ op, match op with NegOp => 0 | MinusUnOp => 1 end) (λ n, match n with 0 => NegOp | _ => MinusUnOp end) _); by intros []. Qed. Global Instance bin_op_countable : Countable bin_op. Proof. refine (inj_countable' (λ op, match op with | PlusOp => 0 | MinusOp => 1 | MultOp => 2 | QuotOp => 3 | RemOp => 4 | AndOp => 5 | OrOp => 6 | XorOp => 7 | ShiftLOp => 8 | ShiftROp => 9 | LeOp => 10 | LtOp => 11 | EqOp => 12 | OffsetOp => 13 end) (λ n, match n with | 0 => PlusOp | 1 => MinusOp | 2 => MultOp | 3 => QuotOp | 4 => RemOp | 5 => AndOp | 6 => OrOp | 7 => XorOp | 8 => ShiftLOp | 9 => ShiftROp | 10 => LeOp | 11 => LtOp | 12 => EqOp | _ => OffsetOp end) _); by intros []. Qed. Global Instance expr_countable : Countable expr. Proof. set (enc := fix go e := match e with | Val v => GenNode 0 [gov v] | Var x => GenLeaf (inl (inl x)) | Rec f x e => GenNode 1 [GenLeaf (inl (inr f)); GenLeaf (inl (inr x)); go e] | App e1 e2 => GenNode 2 [go e1; go e2] | UnOp op e => GenNode 3 [GenLeaf (inr (inr (inl op))); go e] | BinOp op e1 e2 => GenNode 4 [GenLeaf (inr (inr (inr op))); go e1; go e2] | If e0 e1 e2 => GenNode 5 [go e0; go e1; go e2] | Pair e1 e2 => GenNode 6 [go e1; go e2] | Fst e => GenNode 7 [go e] | Snd e => GenNode 8 [go e] | InjL e => GenNode 9 [go e] | InjR e => GenNode 10 [go e] | Case e0 e1 e2 => GenNode 11 [go e0; go e1; go e2] | Fork e => GenNode 12 [go e] | AllocN e1 e2 => GenNode 13 [go e1; go e2] | Free e => GenNode 14 [go e] | Load e => GenNode 15 [go e] | Store e1 e2 => GenNode 16 [go e1; go e2] | CmpXchg e0 e1 e2 => GenNode 17 [go e0; go e1; go e2] | Xchg e0 e1 => GenNode 18 [go e0; go e1] | FAA e1 e2 => GenNode 19 [go e1; go e2] | NewProph => GenNode 20 [] | Resolve e0 e1 e2 => GenNode 21 [go e0; go e1; go e2] end with gov v := match v with | LitV l => GenLeaf (inr (inl l)) | RecV f x e => GenNode 0 [GenLeaf (inl (inr f)); GenLeaf (inl (inr x)); go e] | PairV v1 v2 => GenNode 1 [gov v1; gov v2] | InjLV v => GenNode 2 [gov v] | InjRV v => GenNode 3 [gov v] end for go). set (dec := fix go e := match e with | GenNode 0 [v] => Val (gov v) | GenLeaf (inl (inl x)) => Var x | GenNode 1 [GenLeaf (inl (inr f)); GenLeaf (inl (inr x)); e] => Rec f x (go e) | GenNode 2 [e1; e2] => App (go e1) (go e2) | GenNode 3 [GenLeaf (inr (inr (inl op))); e] => UnOp op (go e) | GenNode 4 [GenLeaf (inr (inr (inr op))); e1; e2] => BinOp op (go e1) (go e2) | GenNode 5 [e0; e1; e2] => If (go e0) (go e1) (go e2) | GenNode 6 [e1; e2] => Pair (go e1) (go e2) | GenNode 7 [e] => Fst (go e) | GenNode 8 [e] => Snd (go e) | GenNode 9 [e] => InjL (go e) | GenNode 10 [e] => InjR (go e) | GenNode 11 [e0; e1; e2] => Case (go e0) (go e1) (go e2) | GenNode 12 [e] => Fork (go e) | GenNode 13 [e1; e2] => AllocN (go e1) (go e2) | GenNode 14 [e] => Free (go e) | GenNode 15 [e] => Load (go e) | GenNode 16 [e1; e2] => Store (go e1) (go e2) | GenNode 17 [e0; e1; e2] => CmpXchg (go e0) (go e1) (go e2) | GenNode 18 [e0; e1] => Xchg (go e0) (go e1) | GenNode 19 [e1; e2] => FAA (go e1) (go e2) | GenNode 20 [] => NewProph | GenNode 21 [e0; e1; e2] => Resolve (go e0) (go e1) (go e2) | _ => Val $ LitV LitUnit (* dummy *) end with gov v := match v with | GenLeaf (inr (inl l)) => LitV l | GenNode 0 [GenLeaf (inl (inr f)); GenLeaf (inl (inr x)); e] => RecV f x (go e) | GenNode 1 [v1; v2] => PairV (gov v1) (gov v2) | GenNode 2 [v] => InjLV (gov v) | GenNode 3 [v] => InjRV (gov v) | _ => LitV LitUnit (* dummy *) end for go). refine (inj_countable' enc dec _). refine (fix go (e : expr) {struct e} := _ with gov (v : val) {struct v} := _ for go). - destruct e as [v| | | | | | | | | | | | | | | | | | | | | |]; simpl; f_equal; [exact (gov v)|done..]. - destruct v; by f_equal. Qed. Global Instance val_countable : Countable val. Proof. refine (inj_countable of_val to_val _); auto using to_of_val. Qed. Global Instance state_inhabited : Inhabited state := populate {| heap := inhabitant; used_proph_id := inhabitant |}. Global Instance val_inhabited : Inhabited val := populate (LitV LitUnit). Global Instance expr_inhabited : Inhabited expr := populate (Val inhabitant). Canonical Structure stateO := leibnizO state. Canonical Structure locO := leibnizO loc. Canonical Structure valO := leibnizO val. Canonical Structure exprO := leibnizO expr. (** Evaluation contexts *) (** Note that [ResolveLCtx] is not by itself an evaluation context item: we do not reduce directly under Resolve's first argument. We only reduce things nested further down. Once no nested contexts exist any more, the expression must take exactly one more step to a value, and Resolve then (atomically) also uses that value for prophecy resolution. *) Inductive ectx_item := | AppLCtx (v2 : val) | AppRCtx (e1 : expr) | UnOpCtx (op : un_op) | BinOpLCtx (op : bin_op) (v2 : val) | BinOpRCtx (op : bin_op) (e1 : expr) | IfCtx (e1 e2 : expr) | PairLCtx (v2 : val) | PairRCtx (e1 : expr) | FstCtx | SndCtx | InjLCtx | InjRCtx | CaseCtx (e1 : expr) (e2 : expr) | AllocNLCtx (v2 : val) | AllocNRCtx (e1 : expr) | FreeCtx | LoadCtx | StoreLCtx (v2 : val) | StoreRCtx (e1 : expr) | XchgLCtx (v2 : val) | XchgRCtx (e1 : expr) | CmpXchgLCtx (v1 : val) (v2 : val) | CmpXchgMCtx (e0 : expr) (v2 : val) | CmpXchgRCtx (e0 : expr) (e1 : expr) | FaaLCtx (v2 : val) | FaaRCtx (e1 : expr) | ResolveLCtx (ctx : ectx_item) (v1 : val) (v2 : val) | ResolveMCtx (e0 : expr) (v2 : val) | ResolveRCtx (e0 : expr) (e1 : expr). (** Contextual closure will only reduce [e] in [Resolve e (Val _) (Val _)] if the local context of [e] is non-empty. As a consequence, the first argument of [Resolve] is not completely evaluated (down to a value) by contextual closure: no base steps (i.e., surface reductions) are taken. This means that contextual closure will reduce [Resolve (CmpXchg #l #n (#n + #1)) #p #v] into [Resolve (CmpXchg #l #n #(n+1)) #p #v], but it cannot context-step any further. *) Fixpoint fill_item (Ki : ectx_item) (e : expr) : expr := match Ki with | AppLCtx v2 => App e (of_val v2) | AppRCtx e1 => App e1 e | UnOpCtx op => UnOp op e | BinOpLCtx op v2 => BinOp op e (Val v2) | BinOpRCtx op e1 => BinOp op e1 e | IfCtx e1 e2 => If e e1 e2 | PairLCtx v2 => Pair e (Val v2) | PairRCtx e1 => Pair e1 e | FstCtx => Fst e | SndCtx => Snd e | InjLCtx => InjL e | InjRCtx => InjR e | CaseCtx e1 e2 => Case e e1 e2 | AllocNLCtx v2 => AllocN e (Val v2) | AllocNRCtx e1 => AllocN e1 e | FreeCtx => Free e | LoadCtx => Load e | StoreLCtx v2 => Store e (Val v2) | StoreRCtx e1 => Store e1 e | XchgLCtx v2 => Xchg e (Val v2) | XchgRCtx e1 => Xchg e1 e | CmpXchgLCtx v1 v2 => CmpXchg e (Val v1) (Val v2) | CmpXchgMCtx e0 v2 => CmpXchg e0 e (Val v2) | CmpXchgRCtx e0 e1 => CmpXchg e0 e1 e | FaaLCtx v2 => FAA e (Val v2) | FaaRCtx e1 => FAA e1 e | ResolveLCtx K v1 v2 => Resolve (fill_item K e) (Val v1) (Val v2) | ResolveMCtx ex v2 => Resolve ex e (Val v2) | ResolveRCtx ex e1 => Resolve ex e1 e end. (** Substitution *) Fixpoint subst (x : string) (v : val) (e : expr) : expr := match e with | Val _ => e | Var y => if decide (x = y) then Val v else Var y | Rec f y e => Rec f y $ if decide (BNamed x ≠ f ∧ BNamed x ≠ y) then subst x v e else e | App e1 e2 => App (subst x v e1) (subst x v e2) | UnOp op e => UnOp op (subst x v e) | BinOp op e1 e2 => BinOp op (subst x v e1) (subst x v e2) | If e0 e1 e2 => If (subst x v e0) (subst x v e1) (subst x v e2) | Pair e1 e2 => Pair (subst x v e1) (subst x v e2) | Fst e => Fst (subst x v e) | Snd e => Snd (subst x v e) | InjL e => InjL (subst x v e) | InjR e => InjR (subst x v e) | Case e0 e1 e2 => Case (subst x v e0) (subst x v e1) (subst x v e2) | AllocN e1 e2 => AllocN (subst x v e1) (subst x v e2) | Free e => Free (subst x v e) | Load e => Load (subst x v e) | Xchg e1 e2 => Xchg (subst x v e1) (subst x v e2) | Store e1 e2 => Store (subst x v e1) (subst x v e2) | CmpXchg e0 e1 e2 => CmpXchg (subst x v e0) (subst x v e1) (subst x v e2) | FAA e1 e2 => FAA (subst x v e1) (subst x v e2) | Fork e => Fork (subst x v e) | NewProph => NewProph | Resolve ex e1 e2 => Resolve (subst x v ex) (subst x v e1) (subst x v e2) end. Definition subst' (mx : binder) (v : val) : expr → expr := match mx with BNamed x => subst x v | BAnon => id end. (** The stepping relation *) Definition un_op_eval (op : un_op) (v : val) : option val := match op, v with | NegOp, LitV (LitBool b) => Some $ LitV $ LitBool (negb b) | NegOp, LitV (LitInt n) => Some $ LitV $ LitInt (Z.lnot n) | MinusUnOp, LitV (LitInt n) => Some $ LitV $ LitInt (- n) | _, _ => None end. Definition bin_op_eval_int (op : bin_op) (n1 n2 : Z) : option base_lit := match op with | PlusOp => Some $ LitInt (n1 + n2) | MinusOp => Some $ LitInt (n1 - n2) | MultOp => Some $ LitInt (n1 * n2) | QuotOp => Some $ LitInt (n1 `quot` n2) | RemOp => Some $ LitInt (n1 `rem` n2) | AndOp => Some $ LitInt (Z.land n1 n2) | OrOp => Some $ LitInt (Z.lor n1 n2) | XorOp => Some $ LitInt (Z.lxor n1 n2) | ShiftLOp => Some $ LitInt (n1 ≪ n2) | ShiftROp => Some $ LitInt (n1 ≫ n2) | LeOp => Some $ LitBool (bool_decide (n1 ≤ n2)) | LtOp => Some $ LitBool (bool_decide (n1 < n2)) | EqOp => Some $ LitBool (bool_decide (n1 = n2)) | OffsetOp => None (* Pointer arithmetic *) end%Z. Definition bin_op_eval_bool (op : bin_op) (b1 b2 : bool) : option base_lit := match op with | PlusOp | MinusOp | MultOp | QuotOp | RemOp => None (* Arithmetic *) | AndOp => Some (LitBool (b1 && b2)) | OrOp => Some (LitBool (b1 || b2)) | XorOp => Some (LitBool (xorb b1 b2)) | ShiftLOp | ShiftROp => None (* Shifts *) | LeOp | LtOp => None (* InEquality *) | EqOp => Some (LitBool (bool_decide (b1 = b2))) | OffsetOp => None (* Pointer arithmetic *) end. Definition bin_op_eval_loc (op : bin_op) (l1 : loc) (v2 : base_lit) : option base_lit := match op, v2 with | OffsetOp, LitInt off => Some $ LitLoc (l1 +ₗ off) | LeOp, LitLoc l2 => Some $ LitBool (bool_decide (l1 ≤ₗ l2)) | LtOp, LitLoc l2 => Some $ LitBool (bool_decide (l1 <ₗ l2)) | _, _ => None end. Definition bin_op_eval (op : bin_op) (v1 v2 : val) : option val := if decide (op = EqOp) then (* Crucially, this compares the same way as [CmpXchg]! *) if decide (vals_compare_safe v1 v2) then Some $ LitV $ LitBool $ bool_decide (v1 = v2) else None else match v1, v2 with | LitV (LitInt n1), LitV (LitInt n2) => LitV <$> bin_op_eval_int op n1 n2 | LitV (LitBool b1), LitV (LitBool b2) => LitV <$> bin_op_eval_bool op b1 b2 | LitV (LitLoc l1), LitV v2 => LitV <$> bin_op_eval_loc op l1 v2 | _, _ => None end. Definition state_upd_heap (f: gmap loc (option val) → gmap loc (option val)) (σ: state) : state := {| heap := f σ.(heap); used_proph_id := σ.(used_proph_id) |}. Global Arguments state_upd_heap _ !_ /. Definition state_upd_used_proph_id (f: gset proph_id → gset proph_id) (σ: state) : state := {| heap := σ.(heap); used_proph_id := f σ.(used_proph_id) |}. Global Arguments state_upd_used_proph_id _ !_ /. Fixpoint heap_array (l : loc) (vs : list val) : gmap loc (option val) := match vs with | [] => ∅ | v :: vs' => {[l := Some v]} ∪ heap_array (l +ₗ 1) vs' end. Lemma heap_array_singleton l v : heap_array l [v] = {[l := Some v]}. Proof. by rewrite /heap_array right_id. Qed. Lemma heap_array_lookup l vs ow k : heap_array l vs !! k = Some ow ↔ ∃ j w, (0 ≤ j)%Z ∧ k = l +ₗ j ∧ ow = Some w ∧ vs !! (Z.to_nat j) = Some w. Proof. revert k l; induction vs as [|v' vs IH]=> l' l /=. { rewrite lookup_empty. naive_solver lia. } rewrite -insert_union_singleton_l lookup_insert_Some IH. split. - intros [[-> ?] | (Hl & j & w & ? & -> & -> & ?)]. { eexists 0, _. rewrite Loc.add_0. naive_solver lia. } eexists (1 + j)%Z, _. rewrite Loc.add_assoc !Z.add_1_l Z2Nat.inj_succ; auto with lia. - intros (j & w & ? & -> & -> & Hil). destruct (decide (j = 0)); simplify_eq/=. { rewrite Loc.add_0; eauto. } right. split. { rewrite -{1}(Loc.add_0 l). intros ?%(inj (Loc.add _)); lia. } assert (Z.to_nat j = S (Z.to_nat (j - 1))) as Hj. { rewrite -Z2Nat.inj_succ; last lia. f_equal; lia. } rewrite Hj /= in Hil. eexists (j - 1)%Z, _. rewrite Loc.add_assoc Z.add_sub_assoc Z.add_simpl_l. auto with lia. Qed. Lemma heap_array_map_disjoint (h : gmap loc (option val)) (l : loc) (vs : list val) : (∀ i, (0 ≤ i)%Z → (i < length vs)%Z → h !! (l +ₗ i) = None) → (heap_array l vs) ##ₘ h. Proof. intros Hdisj. apply map_disjoint_spec=> l' v1 v2. intros (j&w&?&->&?&Hj%lookup_lt_Some%inj_lt)%heap_array_lookup. move: Hj. rewrite Z2Nat.id // => ?. by rewrite Hdisj. Qed. (* [h] is added on the right here to make [state_init_heap_singleton] true. *) Definition state_init_heap (l : loc) (n : Z) (v : val) (σ : state) : state := state_upd_heap (λ h, heap_array l (replicate (Z.to_nat n) v) ∪ h) σ. Lemma state_init_heap_singleton l v σ : state_init_heap l 1 v σ = state_upd_heap <[l:=Some v]> σ. Proof. destruct σ as [h p]. rewrite /state_init_heap /=. f_equiv. rewrite right_id insert_union_singleton_l. done. Qed. Inductive base_step : expr → state → list observation → expr → state → list expr → Prop := | RecS f x e σ : base_step (Rec f x e) σ [] (Val $ RecV f x e) σ [] | PairS v1 v2 σ : base_step (Pair (Val v1) (Val v2)) σ [] (Val $ PairV v1 v2) σ [] | InjLS v σ : base_step (InjL $ Val v) σ [] (Val $ InjLV v) σ [] | InjRS v σ : base_step (InjR $ Val v) σ [] (Val $ InjRV v) σ [] | BetaS f x e1 v2 e' σ : e' = subst' x v2 (subst' f (RecV f x e1) e1) → base_step (App (Val $ RecV f x e1) (Val v2)) σ [] e' σ [] | UnOpS op v v' σ : un_op_eval op v = Some v' → base_step (UnOp op (Val v)) σ [] (Val v') σ [] | BinOpS op v1 v2 v' σ : bin_op_eval op v1 v2 = Some v' → base_step (BinOp op (Val v1) (Val v2)) σ [] (Val v') σ [] | IfTrueS e1 e2 σ : base_step (If (Val $ LitV $ LitBool true) e1 e2) σ [] e1 σ [] | IfFalseS e1 e2 σ : base_step (If (Val $ LitV $ LitBool false) e1 e2) σ [] e2 σ [] | FstS v1 v2 σ : base_step (Fst (Val $ PairV v1 v2)) σ [] (Val v1) σ [] | SndS v1 v2 σ : base_step (Snd (Val $ PairV v1 v2)) σ [] (Val v2) σ [] | CaseLS v e1 e2 σ : base_step (Case (Val $ InjLV v) e1 e2) σ [] (App e1 (Val v)) σ [] | CaseRS v e1 e2 σ : base_step (Case (Val $ InjRV v) e1 e2) σ [] (App e2 (Val v)) σ [] | AllocNS n v σ l : (0 < n)%Z → (∀ i, (0 ≤ i)%Z → (i < n)%Z → σ.(heap) !! (l +ₗ i) = None) → base_step (AllocN (Val $ LitV $ LitInt n) (Val v)) σ [] (Val $ LitV $ LitLoc l) (state_init_heap l n v σ) [] | FreeS l v σ : σ.(heap) !! l = Some $ Some v → base_step (Free (Val $ LitV $ LitLoc l)) σ [] (Val $ LitV LitUnit) (state_upd_heap <[l:=None]> σ) [] | LoadS l v σ : σ.(heap) !! l = Some $ Some v → base_step (Load (Val $ LitV $ LitLoc l)) σ [] (of_val v) σ [] | StoreS l v w σ : σ.(heap) !! l = Some $ Some v → base_step (Store (Val $ LitV $ LitLoc l) (Val w)) σ [] (Val $ LitV LitUnit) (state_upd_heap <[l:=Some w]> σ) [] | XchgS l v1 v2 σ : σ.(heap) !! l = Some $ Some v1 → base_step (Xchg (Val $ LitV $ LitLoc l) (Val v2)) σ [] (Val v1) (state_upd_heap <[l:=Some v2]> σ) [] | CmpXchgS l v1 v2 vl σ b : σ.(heap) !! l = Some $ Some vl → (* Crucially, this compares the same way as [EqOp]! *) vals_compare_safe vl v1 → b = bool_decide (vl = v1) → base_step (CmpXchg (Val $ LitV $ LitLoc l) (Val v1) (Val v2)) σ [] (Val $ PairV vl (LitV $ LitBool b)) (if b then state_upd_heap <[l:=Some v2]> σ else σ) [] | FaaS l i1 i2 σ : σ.(heap) !! l = Some $ Some (LitV (LitInt i1)) → base_step (FAA (Val $ LitV $ LitLoc l) (Val $ LitV $ LitInt i2)) σ [] (Val $ LitV $ LitInt i1) (state_upd_heap <[l:=Some $ LitV (LitInt (i1 + i2))]>σ) [] | ForkS e σ: base_step (Fork e) σ [] (Val $ LitV LitUnit) σ [e] | NewProphS σ p : p ∉ σ.(used_proph_id) → base_step NewProph σ [] (Val $ LitV $ LitProphecy p) (state_upd_used_proph_id ({[ p ]} ∪.) σ) [] | ResolveS p v e σ w σ' κs ts : base_step e σ κs (Val v) σ' ts → base_step (Resolve e (Val $ LitV $ LitProphecy p) (Val w)) σ (κs ++ [(p, (v, w))]) (Val v) σ' ts. (** Basic properties about the language *) Global Instance fill_item_inj Ki : Inj (=) (=) (fill_item Ki). Proof. induction Ki; intros ???; simplify_eq/=; auto with f_equal. Qed. Lemma fill_item_val Ki e : is_Some (to_val (fill_item Ki e)) → is_Some (to_val e). Proof. intros [v ?]. induction Ki; simplify_option_eq; eauto. Qed. Lemma val_base_stuck e1 σ1 κ e2 σ2 efs : base_step e1 σ1 κ e2 σ2 efs → to_val e1 = None. Proof. destruct 1; naive_solver. Qed. Lemma base_ctx_step_val Ki e σ1 κ e2 σ2 efs : base_step (fill_item Ki e) σ1 κ e2 σ2 efs → is_Some (to_val e). Proof. revert κ e2. induction Ki; inversion_clear 1; simplify_option_eq; eauto. Qed. Lemma fill_item_no_val_inj Ki1 Ki2 e1 e2 : to_val e1 = None → to_val e2 = None → fill_item Ki1 e1 = fill_item Ki2 e2 → Ki1 = Ki2. Proof. revert Ki1. induction Ki2; intros Ki1; induction Ki1; naive_solver eauto with f_equal. Qed. Lemma alloc_fresh v n σ : let l := Loc.fresh (dom σ.(heap)) in (0 < n)%Z → base_step (AllocN ((Val $ LitV $ LitInt $ n)) (Val v)) σ [] (Val $ LitV $ LitLoc l) (state_init_heap l n v σ) []. Proof. intros. apply AllocNS; first done. intros. apply not_elem_of_dom. by apply Loc.fresh_fresh. Qed. Lemma new_proph_id_fresh σ : let p := fresh σ.(used_proph_id) in base_step NewProph σ [] (Val $ LitV $ LitProphecy p) (state_upd_used_proph_id ({[ p ]} ∪.) σ) []. Proof. constructor. apply is_fresh. Qed. Lemma heap_lang_mixin : EctxiLanguageMixin of_val to_val fill_item base_step. Proof. split; apply _ || eauto using to_of_val, of_to_val, val_base_stuck, fill_item_val, fill_item_no_val_inj, base_ctx_step_val. Qed. End heap_lang. (** Language *) Canonical Structure heap_ectxi_lang := EctxiLanguage heap_lang.heap_lang_mixin. Canonical Structure heap_ectx_lang := EctxLanguageOfEctxi heap_ectxi_lang. Canonical Structure heap_lang := LanguageOfEctx heap_ectx_lang. (* Prefer heap_lang names over ectx_language names. *) Export heap_lang. (** The following lemma is not provable using the axioms of [ectxi_language]. The proof requires a case analysis over context items ([destruct i] on the last line), which in all cases yields a non-value. To prove this lemma for [ectxi_language] in general, we would require that a term of the form [fill_item i e] is never a value. *) Lemma to_val_fill_some K e v : to_val (fill K e) = Some v → K = [] ∧ e = Val v. Proof. intro H. destruct K as [|Ki K]; first by apply of_to_val in H. exfalso. assert (to_val e ≠ None) as He. { intro A. by rewrite fill_not_val in H. } assert (∃ w, e = Val w) as [w ->]. { destruct e; try done; eauto. } assert (to_val (fill (Ki :: K) (Val w)) = None). { destruct Ki; simpl; apply fill_not_val; done. } by simplify_eq. Qed. Lemma prim_step_to_val_is_base_step e σ1 κs w σ2 efs : prim_step e σ1 κs (Val w) σ2 efs → base_step e σ1 κs (Val w) σ2 efs. Proof. intro H. destruct H as [K e1 e2 H1 H2]. assert (to_val (fill K e2) = Some w) as H3; first by rewrite -H2. apply to_val_fill_some in H3 as [-> ->]. subst e. done. Qed. (** If [e1] makes a base step to a value under some state [σ1] then any base step from [e1] under any other state [σ1'] must necessarily be to a value. *) Lemma base_step_to_val e1 σ1 κ e2 σ2 efs σ1' κ' e2' σ2' efs' : base_step e1 σ1 κ e2 σ2 efs → base_step e1 σ1' κ' e2' σ2' efs' → is_Some (to_val e2) → is_Some (to_val e2'). Proof. destruct 1; inversion 1; naive_solver. Qed. Lemma irreducible_resolve e v1 v2 σ : irreducible e σ → irreducible (Resolve e (Val v1) (Val v2)) σ. Proof. intros H κs ? σ' efs [Ks e1' e2' Hfill -> step]. simpl in *. induction Ks as [|K Ks _] using rev_ind; simpl in Hfill. - subst e1'. inversion step. eapply H. by apply base_prim_step. - rewrite fill_app /= in Hfill. destruct K; (inversion Hfill; subst; clear Hfill; try match goal with | H : Val ?v = fill Ks ?e |- _ => (assert (to_val (fill Ks e) = Some v) as HEq by rewrite -H //); apply to_val_fill_some in HEq; destruct HEq as [-> ->]; inversion step end). eapply (H κs (fill_item _ (foldl (flip fill_item) e2' Ks)) σ' efs). eapply (Ectx_step (Ks ++ [_])); last done; simpl; by rewrite fill_app. Qed. iris-iris-4.2.0/iris_heap_lang/lib/000077500000000000000000000000001460620107300171405ustar00rootroot00000000000000iris-iris-4.2.0/iris_heap_lang/lib/arith.v000066400000000000000000000031121460620107300204330ustar00rootroot00000000000000From iris.proofmode Require Import proofmode. From iris.program_logic Require Export weakestpre. From iris.heap_lang Require Export lang. From iris.heap_lang Require Import proofmode notation. From iris.prelude Require Import options. (** A library defining binary [minimum] and [maximum] functions, together with their expected specs. These operations come up often when working manipulating array indices (checking for bounds). *) Definition minimum : val := λ: "m" "n", if: "m" < "n" then "m" else "n". Definition maximum : val := λ: "m" "n", if: "m" < "n" then "n" else "m". Lemma minimum_spec `{!heapGS Σ} s E (Φ : val → iProp Σ) (m n : Z) : ▷ Φ #(m `min` n) -∗ WP minimum #m #n @ s;E {{ Φ }}. Proof. iIntros "HΦ". wp_lam. wp_pures. case_bool_decide; wp_pures. - rewrite Z.min_l; [ done | by lia ]. - rewrite Z.min_r; [ done | by lia ]. Qed. Lemma minimum_spec_nat `{!heapGS Σ} s E (Φ : val → iProp Σ) (m n : nat) : ▷ Φ #(m `min` n)%nat -∗ WP minimum #m #n @ s;E {{ Φ }}. Proof. iIntros "HΦ". iApply minimum_spec. by rewrite Nat2Z.inj_min. Qed. Lemma maximum_spec `{!heapGS Σ} s E (Φ : val → iProp Σ) (m n : Z) : ▷ Φ #(m `max` n) -∗ WP maximum #m #n @ s;E {{ Φ }}. Proof. iIntros "HΦ". wp_lam. wp_pures. case_bool_decide; wp_pures. - rewrite Z.max_r; [ done | by lia ]. - rewrite Z.max_l; [ done | by lia ]. Qed. Lemma maximum_spec_nat `{!heapGS Σ} s E (Φ : val → iProp Σ) (m n : nat) : ▷ Φ #(m `max` n)%nat -∗ WP maximum #m #n @ s;E {{ Φ }}. Proof. iIntros "HΦ". iApply maximum_spec. by rewrite Nat2Z.inj_max. Qed. iris-iris-4.2.0/iris_heap_lang/lib/array.v000066400000000000000000000250061460620107300204500ustar00rootroot00000000000000From iris.proofmode Require Import proofmode. From iris.program_logic Require Export weakestpre. From iris.heap_lang Require Export derived_laws. From iris.heap_lang Require Import proofmode notation. From iris.prelude Require Import options. (** Provides some array utilities: * [array_free], to deallocate an entire array in one go. * [array_copy_to], a function which copies to an array in-place. * Using [array_copy_to] we also implement [array_clone], which allocates a fresh array and copies to it. * [array_init], to create and initialize an array with a given function. Specifically, [array_init n f] creates a new array of size [n] in which the [i]th element is initialized with [f #i] *) Definition array_free : val := rec: "freeN" "ptr" "n" := if: "n" ≤ #0 then #() else Free "ptr";; "freeN" ("ptr" +ₗ #1) ("n" - #1). Definition array_copy_to : val := rec: "array_copy_to" "dst" "src" "n" := if: "n" ≤ #0 then #() else "dst" <- !"src";; "array_copy_to" ("dst" +ₗ #1) ("src" +ₗ #1) ("n" - #1). Definition array_clone : val := λ: "src" "n", let: "dst" := AllocN "n" #() in array_copy_to "dst" "src" "n";; "dst". (* [array_init_loop src i n f] initializes elements [i], [i+1], ..., [n] of the array [src] to [f #i], [f #(i+1)], ..., [f #n] *) Local Definition array_init_loop : val := rec: "loop" "src" "i" "n" "f" := if: "i" = "n" then #() else "src" +ₗ "i" <- "f" "i";; "loop" "src" ("i" + #1) "n" "f". Definition array_init : val := λ: "n" "f", let: "src" := AllocN "n" #() in array_init_loop "src" #0 "n" "f";; "src". Section proof. Context `{!heapGS_gen hlc Σ}. Lemma twp_array_free s E l vs (n : Z) : n = length vs → [[{ l ↦∗ vs }]] array_free #l #n @ s; E [[{ RET #(); True }]]. Proof. iIntros (Hlen Φ) "Hl HΦ". iInduction vs as [|v vs] "IH" forall (l n Hlen); subst n; wp_rec; wp_pures. { iApply "HΦ". done. } iDestruct (array_cons with "Hl") as "[Hv Hl]". wp_free. wp_pures. iApply ("IH" with "[] Hl"); eauto with lia. Qed. Lemma wp_array_free s E l vs (n : Z) : n = length vs → {{{ l ↦∗ vs }}} array_free #l #n @ s; E {{{ RET #(); True }}}. Proof. iIntros (? Φ) "H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_array_free with "H"); [auto..|]; iIntros "H HΦ". by iApply "HΦ". Qed. Lemma twp_array_copy_to stk E (dst src : loc) vdst vsrc dq (n : Z) : Z.of_nat (length vdst) = n → Z.of_nat (length vsrc) = n → [[{ dst ↦∗ vdst ∗ src ↦∗{dq} vsrc }]] array_copy_to #dst #src #n @ stk; E [[{ RET #(); dst ↦∗ vsrc ∗ src ↦∗{dq} vsrc }]]. Proof. iIntros (Hvdst Hvsrc Φ) "[Hdst Hsrc] HΦ". iInduction vdst as [|v1 vdst] "IH" forall (n dst src vsrc Hvdst Hvsrc); destruct vsrc as [|v2 vsrc]; simplify_eq/=; try lia; wp_rec; wp_pures. { iApply "HΦ". auto with iFrame. } iDestruct (array_cons with "Hdst") as "[Hv1 Hdst]". iDestruct (array_cons with "Hsrc") as "[Hv2 Hsrc]". wp_load; wp_store. wp_smart_apply ("IH" with "[%] [%] Hdst Hsrc") as "[Hvdst Hvsrc]"; [ lia .. | ]. iApply "HΦ"; by iFrame. Qed. Lemma wp_array_copy_to stk E (dst src : loc) vdst vsrc dq (n : Z) : Z.of_nat (length vdst) = n → Z.of_nat (length vsrc) = n → {{{ dst ↦∗ vdst ∗ src ↦∗{dq} vsrc }}} array_copy_to #dst #src #n @ stk; E {{{ RET #(); dst ↦∗ vsrc ∗ src ↦∗{dq} vsrc }}}. Proof. iIntros (? ? Φ) "H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_array_copy_to with "H"); [auto..|]; iIntros "H HΦ". by iApply "HΦ". Qed. Lemma twp_array_clone stk E l dq vl n : Z.of_nat (length vl) = n → (0 < n)%Z → [[{ l ↦∗{dq} vl }]] array_clone #l #n @ stk; E [[{ l', RET #l'; l' ↦∗ vl ∗ l ↦∗{dq} vl }]]. Proof. iIntros (Hvl Hn Φ) "Hvl HΦ". wp_lam. wp_alloc dst as "Hdst"; first by auto. wp_smart_apply (twp_array_copy_to with "[$Hdst $Hvl]") as "[Hdst Hl]". - rewrite replicate_length Z2Nat.id; lia. - auto. - wp_pures. iApply "HΦ"; by iFrame. Qed. Lemma wp_array_clone stk E l dq vl n : Z.of_nat (length vl) = n → (0 < n)%Z → {{{ l ↦∗{dq} vl }}} array_clone #l #n @ stk; E {{{ l', RET #l'; l' ↦∗ vl ∗ l ↦∗{dq} vl }}}. Proof. iIntros (? ? Φ) "H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_array_clone with "H"); [auto..|]; iIntros (l') "H HΦ". by iApply "HΦ". Qed. Section array_init. Context (Q : nat → val → iProp Σ). Implicit Types (f v : val) (i j : nat). Local Lemma wp_array_init_loop stk E l i n k f : n = Z.of_nat (i + k) → {{{ (l +ₗ i) ↦∗ replicate k #() ∗ [∗ list] j ∈ seq i k, WP f #(j : nat) @ stk; E {{ Q j }} }}} array_init_loop #l #i #n f @ stk; E {{{ vs, RET #(); ⌜ length vs = k ⌝ ∗ (l +ₗ i) ↦∗ vs ∗ [∗ list] j↦v ∈ vs, Q (i + j) v }}}. Proof. iIntros (Hn Φ) "[Hl Hf] HΦ". iInduction k as [|k] "IH" forall (i Hn); simplify_eq/=; wp_rec; wp_pures. { rewrite bool_decide_eq_true_2; last (repeat f_equal; lia). wp_pures. iApply ("HΦ" $! []). auto. } rewrite bool_decide_eq_false_2; last naive_solver lia. iDestruct (array_cons with "Hl") as "[Hl HSl]". iDestruct "Hf" as "[Hf HSf]". wp_smart_apply (wp_wand with "Hf") as (v) "Hv". wp_store. wp_pures. rewrite Z.add_1_r -Nat2Z.inj_succ. iApply ("IH" with "[%] [HSl] HSf"); first lia. { by rewrite Loc.add_assoc Z.add_1_r -Nat2Z.inj_succ. } iIntros "!>" (vs). iDestruct 1 as (<-) "[HSl Hvs]". iApply ("HΦ" $! (v :: vs)). iSplit; [naive_solver|]. iSplitL "Hl HSl". - iFrame "Hl". by rewrite Loc.add_assoc Z.add_1_r -Nat2Z.inj_succ. - iEval (rewrite /= Nat.add_0_r; setoid_rewrite Nat.add_succ_r). iFrame. Qed. Local Lemma twp_array_init_loop stk E l i n k f : n = Z.of_nat (i + k) → [[{ (l +ₗ i) ↦∗ replicate k #() ∗ [∗ list] j ∈ seq i k, WP f #(j : nat) @ stk; E [{ Q j }] }]] array_init_loop #l #i #n f @ stk; E [[{ vs, RET #(); ⌜ length vs = k ⌝ ∗ (l +ₗ i) ↦∗ vs ∗ [∗ list] j↦v ∈ vs, Q (i + j) v }]]. Proof. iIntros (Hn Φ) "[Hl Hf] HΦ". iInduction k as [|k] "IH" forall (i Hn); simplify_eq/=; wp_rec; wp_pures. { rewrite bool_decide_eq_true_2; last (repeat f_equal; lia). wp_pures. iApply ("HΦ" $! []). auto. } rewrite bool_decide_eq_false_2; last naive_solver lia. iDestruct (array_cons with "Hl") as "[Hl HSl]". iDestruct "Hf" as "[Hf HSf]". wp_smart_apply (twp_wand with "Hf") as (v) "Hv". wp_store. wp_pures. rewrite Z.add_1_r -Nat2Z.inj_succ. iApply ("IH" with "[%] [HSl] HSf"); first lia. { by rewrite Loc.add_assoc Z.add_1_r -Nat2Z.inj_succ. } iIntros (vs). iDestruct 1 as (<-) "[HSl Hvs]". iApply ("HΦ" $! (v :: vs)). iSplit; [naive_solver|]. iSplitL "Hl HSl". - iFrame "Hl". by rewrite Loc.add_assoc Z.add_1_r -Nat2Z.inj_succ. - iEval (rewrite /= Nat.add_0_r; setoid_rewrite Nat.add_succ_r). iFrame. Qed. Lemma wp_array_init stk E n f : (0 < n)%Z → {{{ [∗ list] i ∈ seq 0 (Z.to_nat n), WP f #(i : nat) @ stk; E {{ Q i }} }}} array_init #n f @ stk; E {{{ l vs, RET #l; ⌜Z.of_nat (length vs) = n⌝ ∗ l ↦∗ vs ∗ [∗ list] k↦v ∈ vs, Q k v }}}. Proof. iIntros (Hn Φ) "Hf HΦ". wp_lam. wp_alloc l as "Hl"; first done. wp_smart_apply (wp_array_init_loop _ _ _ 0 n (Z.to_nat n) with "[Hl $Hf] [HΦ]") as "!> %vs". { by rewrite /= Z2Nat.id; last lia. } { by rewrite Loc.add_0. } iDestruct 1 as (Hlen) "[Hl Hvs]". wp_pures. iApply ("HΦ" $! _ vs). iModIntro. iSplit. { iPureIntro. by rewrite Hlen Z2Nat.id; last lia. } rewrite Loc.add_0. iFrame. Qed. Lemma twp_array_init stk E n f : (0 < n)%Z → [[{ [∗ list] i ∈ seq 0 (Z.to_nat n), WP f #(i : nat) @ stk; E [{ Q i }] }]] array_init #n f @ stk; E [[{ l vs, RET #l; ⌜Z.of_nat (length vs) = n⌝ ∗ l ↦∗ vs ∗ [∗ list] k↦v ∈ vs, Q k v }]]. Proof. iIntros (Hn Φ) "Hf HΦ". wp_lam. wp_alloc l as "Hl"; first done. wp_smart_apply (twp_array_init_loop _ _ _ 0 n (Z.to_nat n) with "[Hl $Hf] [HΦ]") as "%vs". { by rewrite /= Z2Nat.id; last lia. } { by rewrite Loc.add_0. } iDestruct 1 as (Hlen) "[Hl Hvs]". wp_pures. iApply ("HΦ" $! _ vs). iModIntro. iSplit. { iPureIntro. by rewrite Hlen Z2Nat.id; last lia. } rewrite Loc.add_0. iFrame. Qed. End array_init. Section array_init_fmap. Context {A} (g : A → val) (Q : nat → A → iProp Σ). Implicit Types (xs : list A) (f : val). Local Lemma big_sepL_exists_eq vs : ([∗ list] k↦v ∈ vs, ∃ x, ⌜v = g x⌝ ∗ Q k x) -∗ ∃ xs, ⌜ vs = g <$> xs ⌝ ∗ [∗ list] k↦x ∈ xs, Q k x. Proof. iIntros "Hvs". iInduction vs as [|v vs] "IH" forall (Q); simpl. { iExists []. by auto. } iDestruct "Hvs" as "[(%x & -> & Hv) Hvs]". iDestruct ("IH" with "Hvs") as (xs ->) "Hxs". iExists (x :: xs). by iFrame. Qed. Lemma wp_array_init_fmap stk E n f : (0 < n)%Z → {{{ [∗ list] i ∈ seq 0 (Z.to_nat n), WP f #(i : nat) @ stk; E {{ v, ∃ x, ⌜v = g x⌝ ∗ Q i x }} }}} array_init #n f @ stk; E {{{ l xs, RET #l; ⌜Z.of_nat (length xs) = n⌝ ∗ l ↦∗ (g <$> xs) ∗ [∗ list] k↦x ∈ xs, Q k x }}}. Proof. iIntros (Hn Φ) "Hf HΦ". iApply (wp_array_init with "Hf"); first done. iIntros "!>" (l vs). iDestruct 1 as (<-) "[Hl Hvs]". iDestruct (big_sepL_exists_eq with "Hvs") as (xs ->) "Hxs". iApply "HΦ". iFrame "Hl Hxs". by rewrite fmap_length. Qed. Lemma twp_array_init_fmap stk E n f : (0 < n)%Z → [[{ [∗ list] i ∈ seq 0 (Z.to_nat n), WP f #(i : nat) @ stk; E [{ v, ∃ x, ⌜v = g x⌝ ∗ Q i x }] }]] array_init #n f @ stk; E [[{ l xs, RET #l; ⌜Z.of_nat (length xs) = n⌝ ∗ l ↦∗ (g <$> xs) ∗ [∗ list] k↦x ∈ xs, Q k x }]]. Proof. iIntros (Hn Φ) "Hf HΦ". iApply (twp_array_init with "Hf"); first done. iIntros (l vs). iDestruct 1 as (<-) "[Hl Hvs]". iDestruct (big_sepL_exists_eq with "Hvs") as (xs ->) "Hxs". iApply "HΦ". iFrame "Hl Hxs". by rewrite fmap_length. Qed. End array_init_fmap. End proof. iris-iris-4.2.0/iris_heap_lang/lib/assert.v000066400000000000000000000020241460620107300206260ustar00rootroot00000000000000From iris.proofmode Require Import proofmode. From iris.program_logic Require Export weakestpre. From iris.heap_lang Require Export lang. From iris.heap_lang Require Import proofmode notation. From iris.prelude Require Import options. Definition assert : val := λ: "v", if: "v" #() then #() else #0 #0. (* #0 #0 is unsafe *) (* just below ;; *) Notation "'assert:' e" := (assert (λ: <>, e)%E) (at level 99) : expr_scope. Notation "'assert:' e" := (assert (λ: <>, e)%V) (at level 99) : val_scope. Lemma twp_assert `{!heapGS_gen hlc Σ} E (Φ : val → iProp Σ) e : WP e @ E [{ v, ⌜v = #true⌝ ∧ Φ #() }] -∗ WP (assert: e)%V @ E [{ Φ }]. Proof. iIntros "HΦ". wp_lam. wp_smart_apply (twp_wand with "HΦ"). iIntros (v) "[% ?]"; subst. by wp_if. Qed. Lemma wp_assert `{!heapGS_gen hlc Σ} E (Φ : val → iProp Σ) e : WP e @ E {{ v, ⌜v = #true⌝ ∧ ▷ Φ #() }} -∗ WP (assert: e)%V @ E {{ Φ }}. Proof. iIntros "HΦ". wp_lam. wp_smart_apply (wp_wand with "HΦ"). iIntros (v) "[% ?]"; subst. by wp_if. Qed. iris-iris-4.2.0/iris_heap_lang/lib/atomic_heap.v000066400000000000000000000217611460620107300216070ustar00rootroot00000000000000From iris.bi.lib Require Import fractional. From iris.proofmode Require Import proofmode. From iris.program_logic Require Export atomic. From iris.heap_lang Require Export derived_laws. From iris.heap_lang Require Import notation proofmode. From iris.prelude Require Import options. (** A general logically atomic interface for a heap. All parameters are implicit, since it is expected that there is only one [heapGS_gen] in scope that could possibly apply. For example: Context `{!heapGS_gen hlc Σ, !atomic_heap}. Or, for libraries that require later credits: Context `{!heapGS Σ, !atomic_heap}. Only one instance of this class should ever be in scope. To write a library that is generic over the lock, just add a [`{!atomic_heap}] implicit parameter around the code and [`{!atomic_heapGS Σ}] around the proofs. To use a particular atomic heap instance, use [Local Existing Instance ]. When writing an instance of this class, please take care not to shadow the class projections (e.g., either use [Local Definition alloc] or avoid the name [alloc] altogether), and do not register an instance -- just make it a [Definition] that others can register later. *) Class atomic_heap := AtomicHeap { (* -- operations -- *) alloc : val; free : val; load : val; store : val; cmpxchg : val; (** * Ghost state *) (** The assumptions about [Σ], and the singleton [gname]s (if needed) *) atomic_heapGS : gFunctors → Type; (* -- predicates -- *) pointsto `{!heapGS_gen hlc Σ} {H : atomic_heapGS Σ} (l : loc) (dq: dfrac) (v : val) : iProp Σ; (* -- pointsto properties -- *) #[global] pointsto_timeless `{!heapGS_gen hlc Σ} {H : atomic_heapGS Σ} l q v :: Timeless (pointsto (H:=H) l q v); #[global] pointsto_fractional `{!heapGS_gen hlc Σ} {H : atomic_heapGS Σ} l v :: Fractional (λ (q : Qp), pointsto (H:=H) l (DfracOwn q) v); #[global] pointsto_persistent `{!heapGS_gen hlc Σ} {H : atomic_heapGS Σ} l v :: Persistent (pointsto (H:=H) l DfracDiscarded v); #[global] pointsto_as_fractional `{!heapGS_gen hlc Σ} {H : atomic_heapGS Σ} l q v :: AsFractional (pointsto (H:=H) l (DfracOwn q) v) (λ q, pointsto (H:=H) l (DfracOwn q) v) q; pointsto_agree `{!heapGS_gen hlc Σ} {H : atomic_heapGS Σ} l dq1 dq2 v1 v2 : pointsto (H:=H) l dq1 v1 -∗ pointsto (H:=H) l dq2 v2 -∗ ⌜v1 = v2⌝; pointsto_persist `{!heapGS_gen hlc Σ} {H : atomic_heapGS Σ} l dq v : pointsto (H:=H) l dq v ==∗ pointsto (H:=H) l DfracDiscarded v; (* -- operation specs -- *) alloc_spec `{!heapGS_gen hlc Σ} {H : atomic_heapGS Σ} (v : val) : {{{ True }}} alloc v {{{ l, RET #l; pointsto (H:=H) l (DfracOwn 1) v }}}; free_spec `{!heapGS_gen hlc Σ} {H : atomic_heapGS Σ} (l : loc) (v : val) : {{{ pointsto (H:=H) l (DfracOwn 1) v }}} free #l {{{ l, RET #l; True }}}; load_spec `{!heapGS_gen hlc Σ} {H : atomic_heapGS Σ} (l : loc) : ⊢ <<{ ∀∀ (v : val) q, pointsto (H:=H) l q v }>> load #l @ ∅ <<{ pointsto (H:=H) l q v | RET v }>>; store_spec `{!heapGS_gen hlc Σ} {H : atomic_heapGS Σ} (l : loc) (w : val) : ⊢ <<{ ∀∀ v, pointsto (H:=H) l (DfracOwn 1) v }>> store #l w @ ∅ <<{ pointsto (H:=H) l (DfracOwn 1) w | RET #() }>>; (* 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. The postcondition deliberately does not use [bool_decide] so that users can [destruct (decide (a = b))] and it will simplify in both places. *) cmpxchg_spec `{!heapGS_gen hlc Σ} {H : atomic_heapGS Σ} (l : loc) (w1 w2 : val) : val_is_unboxed w1 → ⊢ <<{ ∀∀ v, pointsto (H:=H) l (DfracOwn 1) v }>> cmpxchg #l w1 w2 @ ∅ <<{ if decide (v = w1) then pointsto (H:=H) l (DfracOwn 1) w2 else pointsto (H:=H) l (DfracOwn 1) v | RET (v, #if decide (v = w1) then true else false) }>>; }. Global Arguments alloc : simpl never. Global Arguments free : simpl never. Global Arguments load : simpl never. Global Arguments store : simpl never. Global Arguments cmpxchg : simpl never. Global Arguments pointsto : simpl never. Existing Class atomic_heapGS. Global Hint Mode atomic_heapGS + + : typeclass_instances. Global Hint Extern 0 (atomic_heapGS _) => progress simpl : typeclass_instances. Local Notation CAS e1 e2 e3 := (Snd (cmpxchg e1 e2 e3)). Definition faa_atomic `{!atomic_heap} : val := rec: "faa" "l" "n" := let: "m" := load "l" in if: CAS "l" "m" ("m" + "n") then "m" else "faa" "l" "n". (** Notation for heap primitives, in a module so you can import it separately. *) Module notation. Notation "l ↦ dq v" := (pointsto l dq v) (at level 20, dq custom dfrac at level 1, format "l ↦ dq v") : bi_scope. Notation "'ref' e" := (alloc e) : expr_scope. Notation "! e" := (load e) : expr_scope. Notation "e1 <- e2" := (store e1 e2) : expr_scope. Notation CAS e1 e2 e3 := (Snd (cmpxchg e1 e2 e3)). Notation FAA e1 e2 := (faa_atomic e1 e2). End notation. Section derived. Context `{!heapGS_gen hlc Σ, !atomic_heap, !atomic_heapGS Σ}. Import notation. Lemma cas_spec (l : loc) (w1 w2 : val) : val_is_unboxed w1 → ⊢ <<{ ∀∀ v, pointsto l (DfracOwn 1) v }>> CAS #l w1 w2 @ ∅ <<{ if decide (v = w1) then pointsto l (DfracOwn 1) w2 else pointsto l (DfracOwn 1) v | RET #if decide (v = w1) then true else false }>>. Proof. iIntros (? Φ) "AU". awp_apply cmpxchg_spec; first done. iApply (aacc_aupd_commit with "AU"); first done. iIntros (v) "H↦". iAaccIntro with "H↦"; first by eauto with iFrame. iIntros "$ !> HΦ !>". wp_pures. done. Qed. Lemma faa_spec (l : loc) (i2 : Z) : ⊢ <<{ ∀∀ i1 : Z, pointsto l (DfracOwn 1) #i1 }>> FAA #l #i2 @ ∅ <<{ pointsto l (DfracOwn 1) #(i1 + i2) | RET #i1 }>>. Proof. iIntros (Φ) "AU". rewrite /faa_atomic. iLöb as "IH". wp_pures. awp_apply load_spec. iApply (aacc_aupd_abort with "AU"); first done. iIntros (i1) "H↦". iAaccIntro with "H↦"; first by eauto with iFrame. iIntros "$ !> AU !>". wp_pures. awp_apply cas_spec; first done. iApply (aacc_aupd with "AU"); first done. iIntros (m) "Hl". iAaccIntro with "Hl"; first by eauto with iFrame. iIntros "Hl"; destruct (decide (#m = #i1)); simplify_eq. - iModIntro. iRight. iFrame. iIntros "Hpost". iModIntro. by wp_pures. - iModIntro. iLeft. iFrame. iIntros "AU". iModIntro. wp_pure. by iApply "IH". Qed. End derived. (** Proof that the primitive physical operations of heap_lang satisfy said interface. *) Definition primitive_alloc : val := λ: "v", ref "v". Definition primitive_free : val := λ: "v", Free "v". Definition primitive_load : val := λ: "l", !"l". Definition primitive_store : val := λ: "l" "x", "l" <- "x". Definition primitive_cmpxchg : val := λ: "l" "e1" "e2", CmpXchg "l" "e1" "e2". Section proof. Context `{!heapGS_gen hlc Σ}. Lemma primitive_alloc_spec (v : val) : {{{ True }}} primitive_alloc v {{{ l, RET #l; l ↦ v }}}. Proof. iIntros (Φ) "_ HΦ". wp_lam. wp_alloc l. iApply "HΦ". done. Qed. Lemma primitive_free_spec (l : loc) (v : val) : {{{ l ↦ v }}} primitive_free #l {{{ l, RET #l; True }}}. Proof. iIntros (Φ) "Hl HΦ". wp_lam. wp_free. iApply "HΦ". done. Qed. Lemma primitive_load_spec (l : loc) : ⊢ <<{ ∀∀ (v : val) q, l ↦{q} v }>> primitive_load #l @ ∅ <<{ l ↦{q} v | RET v }>>. Proof. iIntros (Φ) "AU". wp_lam. iMod "AU" as (v q) "[H↦ [_ Hclose]]". wp_load. iMod ("Hclose" with "H↦") as "HΦ". done. Qed. Lemma primitive_store_spec (l : loc) (w : val) : ⊢ <<{ ∀∀ v, l ↦ v }>> primitive_store #l w @ ∅ <<{ l ↦ w | RET #() }>>. Proof. iIntros (Φ) "AU". wp_lam. wp_let. iMod "AU" as (v) "[H↦ [_ Hclose]]". wp_store. iMod ("Hclose" with "H↦") as "HΦ". done. Qed. Lemma primitive_cmpxchg_spec (l : loc) (w1 w2 : val) : val_is_unboxed w1 → ⊢ <<{ ∀∀ (v : val), l ↦ v }>> primitive_cmpxchg #l w1 w2 @ ∅ <<{ if decide (v = w1) then l ↦ w2 else l ↦ v | RET (v, #if decide (v = w1) then true else false) }>>. Proof. iIntros (? Φ) "AU". wp_lam. wp_pures. iMod "AU" as (v) "[H↦ [_ Hclose]]". destruct (decide (v = w1)) as [Heq|Hne]; [wp_cmpxchg_suc|wp_cmpxchg_fail]; iMod ("Hclose" with "H↦") as "HΦ"; done. Qed. End proof. (* NOT an instance because users should choose explicitly to use it (using [Explicit Instance]). *) Definition primitive_atomic_heap : atomic_heap := {| atomic_heapGS _ := TCTrue; alloc_spec _ _ _ _ := primitive_alloc_spec; free_spec _ _ _ _ := primitive_free_spec; load_spec _ _ _ _ := primitive_load_spec; store_spec _ _ _ _ := primitive_store_spec; cmpxchg_spec _ _ _ _ := primitive_cmpxchg_spec; pointsto_persist _ _ _ _ := primitive_laws.pointsto_persist; pointsto_agree _ _ _ _ := primitive_laws.pointsto_agree |}. iris-iris-4.2.0/iris_heap_lang/lib/clairvoyant_coin.v000066400000000000000000000053151460620107300226760ustar00rootroot00000000000000From iris.base_logic Require Export invariants. From iris.program_logic Require Export weakestpre. From iris.heap_lang Require Export lang proofmode notation. From iris.heap_lang.lib Require Export nondet_bool. From iris.prelude Require Import options. (** The clairvoyant coin predicts all the values that it will *non-deterministically* choose throughout the execution of the program. This can be seen in the spec. The predicate [coin c bs] expresses that [bs] is the list of all the values of the coin in the future. The [read_coin] operation always returns the head of [bs] and the [toss_coin] operation takes the [tail] of [bs]. *) Definition new_coin: val := λ: <>, (ref (nondet_bool #()), NewProph). Definition read_coin : val := λ: "cp", !(Fst "cp"). Definition toss_coin : val := λ: "cp", let: "c" := Fst "cp" in let: "p" := Snd "cp" in let: "r" := nondet_bool #() in "c" <- "r";; resolve_proph: "p" to: "r";; #(). Section proof. Context `{!heapGS Σ}. Definition prophecy_to_list_bool (vs : list (val * val)) : list bool := (λ v, bool_decide (v = #true)) ∘ snd <$> vs. Definition coin (cp : val) (bs : list bool) : iProp Σ := ∃ (c : loc) (p : proph_id) (vs : list (val * val)), ⌜cp = (#c, #p)%V⌝ ∗ ⌜bs ≠ []⌝ ∗ ⌜tail bs = prophecy_to_list_bool vs⌝ ∗ proph p vs ∗ from_option (λ b : bool, c ↦ #b) (∃ b : bool, c ↦ #b) (head bs). Lemma new_coin_spec : {{{ True }}} new_coin #() {{{ c bs, RET c; coin c bs }}}. Proof. iIntros (Φ) "_ HΦ". wp_lam. wp_apply wp_new_proph as (vs p) "Hp"; first done. wp_apply nondet_bool_spec as (b) "_"; first done. wp_alloc c as "Hc". wp_pair. iApply ("HΦ" $! (#c, #p)%V (b :: prophecy_to_list_bool vs)). rewrite /coin; eauto 10 with iFrame. Qed. Lemma read_coin_spec cp bs : {{{ coin cp bs }}} read_coin cp {{{b bs', RET #b; ⌜bs = b :: bs'⌝ ∗ coin cp bs }}}. Proof. iIntros (Φ) "Hc HΦ". iDestruct "Hc" as (c p vs -> ? ?) "[Hp Hb]". destruct bs as [|b bs]; simplify_eq/=. wp_lam. wp_load. iApply "HΦ"; iSplitR; first done. rewrite /coin; eauto 10 with iFrame. Qed. Lemma toss_coin_spec cp bs : {{{ coin cp bs }}} toss_coin cp {{{b bs', RET #(); ⌜bs = b :: bs'⌝ ∗ coin cp bs' }}}. Proof. iIntros (Φ) "Hc HΦ". iDestruct "Hc" as (c p vs -> ? ?) "[Hp Hb]". destruct bs as [|b bs]; simplify_eq/=. wp_lam. do 2 (wp_proj; wp_let). wp_apply nondet_bool_spec as (r) "_"; first done. wp_store. wp_apply (wp_resolve_proph with "[Hp]") as (ws) "[-> Hp]"; first done. wp_seq. iApply "HΦ"; iSplitR; first done. destruct r; rewrite /coin; eauto 10 with iFrame. Qed. End proof. iris-iris-4.2.0/iris_heap_lang/lib/counter.v000066400000000000000000000153571460620107300210210ustar00rootroot00000000000000From iris.algebra Require Import lib.frac_auth numbers auth. From iris.proofmode Require Import proofmode. From iris.base_logic.lib Require Export invariants. From iris.program_logic Require Export weakestpre. From iris.heap_lang Require Export lang. From iris.heap_lang Require Import proofmode notation. From iris.prelude Require Import options. Definition newcounter : val := λ: <>, ref #0. Definition incr : val := rec: "incr" "l" := let: "n" := !"l" in if: CAS "l" "n" (#1 + "n") then #() else "incr" "l". Definition read : val := λ: "l", !"l". (** Monotone counter *) Class mcounterG Σ := MCounterG { mcounter_inG : inG Σ (authR max_natUR) }. Local Existing Instance mcounter_inG. Definition mcounterΣ : gFunctors := #[GFunctor (authR max_natUR)]. Global Instance subG_mcounterΣ {Σ} : subG mcounterΣ Σ → mcounterG Σ. Proof. solve_inG. Qed. Section mono_proof. Context `{!heapGS Σ, !mcounterG Σ} (N : namespace). Definition mcounter_inv (γ : gname) (l : loc) : iProp Σ := ∃ n, own γ (● (MaxNat n)) ∗ l ↦ #n. Definition mcounter (l : loc) (n : nat) : iProp Σ := ∃ γ, inv N (mcounter_inv γ l) ∧ own γ (◯ (MaxNat n)). (** The main proofs. *) Global Instance mcounter_persistent l n : Persistent (mcounter l n). Proof. apply _. Qed. Lemma newcounter_mono_spec : {{{ True }}} newcounter #() {{{ l, RET #l; mcounter l 0 }}}. Proof. iIntros (Φ) "_ HΦ". rewrite /newcounter /=. wp_lam. wp_alloc l as "Hl". iMod (own_alloc (● (MaxNat O) ⋅ ◯ (MaxNat O))) as (γ) "[Hγ Hγ']"; first by apply auth_both_valid_discrete. iMod (inv_alloc N _ (mcounter_inv γ l) with "[Hl Hγ]"). { iNext. iExists 0. by iFrame. } iModIntro. iApply "HΦ". rewrite /mcounter; eauto 10. Qed. Lemma incr_mono_spec l n : {{{ mcounter l n }}} incr #l {{{ RET #(); mcounter l (S n) }}}. Proof. iIntros (Φ) "Hl HΦ". iLöb as "IH". wp_rec. 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_pures. wp_bind (CmpXchg _ _ _). iInv N as (c') ">[Hγ Hl]". destruct (decide (c' = c)) as [->|]. - iCombine "Hγ Hγf" gives %[?%max_nat_included _]%auth_both_valid_discrete. iMod (own_update_2 with "Hγ Hγf") as "[Hγ Hγf]". { apply auth_update, (max_nat_local_update _ _ (MaxNat (S c))). simpl. auto. } wp_cmpxchg_suc. iModIntro. iSplitL "Hl Hγ". { iNext. iExists (S c). rewrite Nat2Z.inj_succ Z.add_1_l. by iFrame. } wp_pures. iApply "HΦ". iModIntro. iExists γ; repeat iSplit; eauto. iApply (own_mono with "Hγf"). (* FIXME: FIXME(Coq #6294): needs new unification *) apply: auth_frag_mono. by apply max_nat_included, le_n_S. - wp_cmpxchg_fail; first (by intros [= ?%Nat2Z.inj]). iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c'; by iFrame|]. wp_pures. iApply ("IH" with "[Hγf] [HΦ]"); last by auto. rewrite {3}/mcounter; eauto 10. Qed. Lemma read_mono_spec l j : {{{ mcounter l j }}} read #l {{{ i, RET #i; ⌜j ≤ i⌝ ∧ mcounter l i }}}. Proof. iIntros (ϕ) "Hc HΦ". iDestruct "Hc" as (γ) "[#Hinv Hγf]". rewrite /read /=. wp_lam. iInv N as (c) ">[Hγ Hl]". wp_load. iCombine "Hγ Hγf" gives %[?%max_nat_included _]%auth_both_valid_discrete. iMod (own_update_2 with "Hγ Hγf") as "[Hγ Hγf]". { apply auth_update, (max_nat_local_update _ _ (MaxNat c)); auto. } iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|]. iApply ("HΦ" with "[-]"). rewrite /mcounter; eauto 10. Qed. End mono_proof. (** Counter with contributions *) Class ccounterG Σ := CCounterG { ccounter_inG : inG Σ (frac_authR natR) }. Local Existing Instance ccounter_inG. Definition ccounterΣ : gFunctors := #[GFunctor (frac_authR natR)]. Global Instance subG_ccounterΣ {Σ} : subG ccounterΣ Σ → ccounterG Σ. Proof. solve_inG. Qed. Section contrib_spec. Context `{!heapGS Σ, !ccounterG Σ} (N : namespace). Definition ccounter_inv (γ : gname) (l : loc) : iProp Σ := ∃ n, own γ (●F n) ∗ l ↦ #n. Definition ccounter_ctx (γ : gname) (l : loc) : iProp Σ := inv N (ccounter_inv γ l). Definition ccounter (γ : gname) (q : frac) (n : nat) : iProp Σ := own γ (◯F{q} n). (** The main proofs. *) Lemma ccounter_op γ q1 q2 n1 n2 : ccounter γ (q1 + q2) (n1 + n2) ⊣⊢ ccounter γ q1 n1 ∗ ccounter γ q2 n2. Proof. by rewrite /ccounter frac_auth_frag_op -own_op. Qed. Lemma newcounter_contrib_spec (R : iProp Σ) : {{{ True }}} newcounter #() {{{ γ l, RET #l; ccounter_ctx γ l ∗ ccounter γ 1 0 }}}. Proof. iIntros (Φ) "_ HΦ". rewrite /newcounter /=. wp_lam. wp_alloc l as "Hl". iMod (own_alloc (●F O ⋅ ◯F 0)) as (γ) "[Hγ Hγ']"; first by apply auth_both_valid_discrete. iMod (inv_alloc N _ (ccounter_inv γ l) with "[Hl Hγ]"). { iNext. iExists 0. by iFrame. } iModIntro. iApply "HΦ". rewrite /ccounter_ctx /ccounter; eauto 10. Qed. Lemma incr_contrib_spec γ l q n : {{{ ccounter_ctx γ l ∗ ccounter γ q n }}} incr #l {{{ 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]". wp_load. iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|]. wp_pures. wp_bind (CmpXchg _ _ _). 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)); lia. } wp_cmpxchg_suc. iModIntro. iSplitL "Hl Hγ". { iNext. iExists (S c). rewrite Nat2Z.inj_succ Z.add_1_l. by iFrame. } wp_pures. by iApply "HΦ". - wp_cmpxchg_fail; first (by intros [= ?%Nat2Z.inj]). iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c'; by iFrame|]. wp_pures. by iApply ("IH" with "[Hγf] [HΦ]"); auto. Qed. Lemma read_contrib_spec γ l q n : {{{ ccounter_ctx γ l ∗ ccounter γ q n }}} read #l {{{ c, RET #c; ⌜n ≤ c⌝ ∧ ccounter γ q n }}}. Proof. iIntros (Φ) "[#? Hγf] HΦ". rewrite /read /=. wp_lam. iInv N as (c) ">[Hγ Hl]". wp_load. iCombine "Hγ Hγf" gives % ?%frac_auth_included_total%nat_included. iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|]. iApply ("HΦ" with "[-]"); rewrite /ccounter; eauto 10. Qed. Lemma read_contrib_spec_1 γ l n : {{{ ccounter_ctx γ l ∗ ccounter γ 1 n }}} read #l {{{ RET #n; ccounter γ 1 n }}}. Proof. iIntros (Φ) "[#? Hγf] HΦ". rewrite /read /=. wp_lam. iInv N as (c) ">[Hγ Hl]". wp_load. iCombine "Hγ Hγf" gives % <-%frac_auth_agree_L. iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|]. by iApply "HΦ". Qed. End contrib_spec. iris-iris-4.2.0/iris_heap_lang/lib/diverge.v000066400000000000000000000023121460620107300207520ustar00rootroot00000000000000From iris.proofmode Require Import proofmode. From iris.program_logic Require Export weakestpre. From iris.heap_lang Require Export lang. From iris.heap_lang Require Import proofmode notation. From iris.prelude Require Import options. (** This library provides a [diverge] function that goes into an infinite loop when provided with an (arbitrary) argument value. This function can be used to let the program diverge in corner cases that one wants to omit in proofs. This mechanism should be used with care and communicated clearly, obviously. Note that this mechanism only works when establishing partial correctness with the ordinary version of weakest preconditions, and not when establishing total correctness using the total version of weakest preconditions. A typical application for [diverge] is insertion functions for data structures having a fixed capacity. In such cases, we can choose divergence instead of an explicit error handling when the full capacity has already been reached. *) Definition diverge : val := rec: "diverge" "v" := "diverge" "v". Lemma wp_diverge `{!heapGS Σ} s E (Φ : val → iProp Σ) (v : val) : ⊢ WP diverge v @ s;E {{ Φ }}. Proof. iLöb as "IH". wp_lam. iApply "IH". Qed. iris-iris-4.2.0/iris_heap_lang/lib/increment.v000066400000000000000000000170701460620107300213200ustar00rootroot00000000000000From iris.bi.lib Require Import fractional. From iris.proofmode Require Import proofmode. From iris.base_logic.lib Require Export invariants. From iris.program_logic Require Export atomic. From iris.heap_lang Require Import proofmode notation atomic_heap par. From iris.prelude Require Import options. (** Show that implementing fetch-and-add on top of CAS preserves logical atomicity. *) (** First: logically atomic increment directly on top of the physical heap. *) Section increment_physical. Context `{!heapGS Σ}. Definition incr_phy : val := rec: "incr" "l" := let: "oldv" := !"l" in if: CAS "l" "oldv" ("oldv" + #1) then "oldv" (* return old value if success *) else "incr" "l". Lemma incr_phy_spec (l: loc) : ⊢ <<{ ∀∀ (v : Z), l ↦ #v }>> incr_phy #l @ ∅ <<{ l ↦ #(v + 1) | RET #v }>>. Proof. iIntros (Φ) "AU". iLöb as "IH". wp_lam. (* [iMod] knows how to eliminate [AU] assertions. They are mask-changing though so we first need to bind to make sure we have an atomic expression. Out of the [AU], we then get the atomic precondition as well as the closing updates. There's two closing updates, one to "abort" the update and one to "commit"; in this case, we only need the "abort". *) wp_bind (!_)%E. iMod "AU" as (v) "[Hl [Hclose _]]". wp_load. iMod ("Hclose" with "Hl") as "AU". iModIntro. wp_pures. (* As above, but this time we need both the "abort" and "commit" updates. *) wp_bind (CmpXchg _ _ _)%E. iMod "AU" as (w) "[Hl Hclose]". destruct (decide (#v = #w)) as [[= ->]|Hx]. - wp_cmpxchg_suc. iDestruct "Hclose" as "[_ Hclose]". iMod ("Hclose" with "Hl") as "HΦ". iModIntro. wp_pures. done. - wp_cmpxchg_fail. iDestruct "Hclose" as "[Hclose _]". iMod ("Hclose" with "Hl") as "AU". iModIntro. wp_pures. iApply "IH". done. Qed. End increment_physical. (** Next: logically atomic increment on top of an arbitrary logically atomic heap *) Section increment. Context `{!atomic_heap}. Import atomic_heap.notation. Definition incr : val := rec: "incr" "l" := let: "oldv" := !"l" in if: CAS "l" "oldv" ("oldv" + #1) then "oldv" (* return old value if success *) else "incr" "l". Context `{!heapGS Σ, !atomic_heapGS Σ}. (** A proof of the incr specification that unfolds the definition of atomic accessors. This is the style that most logically atomic proofs take. *) Lemma incr_spec_direct (l: loc) : ⊢ <<{ ∀∀ (v : Z), l ↦ #v }>> incr #l @ ∅ <<{ l ↦ #(v + 1) | RET #v }>>. Proof. iIntros (Φ) "AU". iLöb as "IH". wp_lam. awp_apply load_spec. (* Prove the atomic update for load *) (* To [iMod] a *mask-changing* update (like "AU"), we have to unfold [atomic_acc] in the goal. Note that non-mask-changing [iMod] and [iInv] would work here without unfolding, i.e., an [AACC] in the goal supports eliminating non-mask-changing updates and accessors but it does not support eliminating mask-changing updates. *) rewrite /atomic_acc /=. iMod "AU" as (v) "[Hl [Hclose _]]". (* Usually, we would use [iAaccIntro], but here we cannot because we unfolded [atomic_acc], so we do it by hand. *) iModIntro. iExists _, _. iFrame "Hl". iSplit. { (* abort case *) done. } iIntros "Hl". iMod ("Hclose" with "Hl") as "AU". iModIntro. (* Now go on *) wp_pures. awp_apply cas_spec; first done. (* Prove the atomic update for CAS. We want to prove the precondition of that update (the ↦) as quickly as possible because every step we take along the way has to be "reversible" to prove the "abort" update. *) rewrite /atomic_acc /=. iMod "AU" as (w) "[Hl Hclose]". iModIntro. iExists _. iFrame "Hl". iSplit. { (* abort case *) iDestruct "Hclose" as "[? _]". done. } (* Good, we proved the precondition, now we can proceed "as normal". *) iIntros "Hl". simpl. destruct (decide (#w = #v)) as [[= ->]|Hx]. - iDestruct "Hclose" as "[_ Hclose]". iMod ("Hclose" with "Hl") as "HΦ". iIntros "!>". wp_if. by iApply "HΦ". - iDestruct "Hclose" as "[Hclose _]". iMod ("Hclose" with "Hl") as "AU". iIntros "!>". wp_if. iApply "IH". done. Qed. (** A proof of the incr specification that uses lemmas ([aacc_aupd_*]) to avoid reasoning with the definition of atomic accessors. These lemmas are only usable here because the atomic update we have and the one we try to prove are in 1:1 correspondence; most logically atomic proofs will not be able to use them. *) Lemma incr_spec (l: loc) : ⊢ <<{ ∀∀ (v : Z), l ↦ #v }>> incr #l @ ∅ <<{ l ↦ #(v + 1) | RET #v }>>. Proof. iIntros (Φ) "AU". iLöb as "IH". wp_lam. awp_apply load_spec. (* Prove the atomic update for load *) iApply (aacc_aupd_abort with "AU"); first done. iIntros (x) "H↦". iAaccIntro with "H↦"; first by eauto with iFrame. iIntros "$ !> AU !>". (* Now go on *) wp_pures. awp_apply cas_spec; first done. (* Prove the atomic update for CAS *) iApply (aacc_aupd with "AU"); first done. iIntros (x') "H↦". iAaccIntro with "H↦"; first by eauto with iFrame. iIntros "H↦ !>". simpl. destruct (decide (#x' = #x)) as [[= ->]|Hx]. - iRight. iFrame. iIntros "HΦ !>". wp_if. by iApply "HΦ". - iLeft. iFrame. iIntros "AU !>". wp_if. iApply "IH". done. Qed. (** A "weak increment": assumes that there is no race *) Definition weak_incr: val := rec: "weak_incr" "l" := let: "oldv" := !"l" in "l" <- ("oldv" + #1);; "oldv" (* return old value *). (** Logically atomic spec for weak increment. Also an example for what TaDA calls "private precondition". *) (* TODO: Generalize to q and 1-q, based on some theory for a "maybe-pointsto" connective that works on [option Qp] (the type of 1-q). *) Lemma weak_incr_spec (l: loc) (v : Z) : l ↦{#1/2} #v -∗ <<{ ∀∀ (v' : Z), l ↦{#1/2} #v' }>> weak_incr #l @ ∅ <<{ ⌜v = v'⌝ ∗ l ↦ #(v + 1) | RET #v }>>. Proof. iIntros "Hl" (Φ) "AU". wp_lam. wp_apply (atomic_wp_seq $! (load_spec _) with "Hl") as "Hl". wp_pures. awp_apply store_spec. (* Prove the atomic update for store *) iApply (aacc_aupd_commit with "AU"); first done. iIntros (x) "H↦". iDestruct (pointsto_agree with "Hl H↦") as %[= <-]. iCombine "Hl" "H↦" as "Hl". iAaccIntro with "Hl". { iIntros "[$ $]"; eauto. } iIntros "$ !>". iSplit; first done. iIntros "HΦ !>". wp_seq. done. Qed. End increment. Section increment_client. Context `{!heapGS Σ, !spawnG Σ}. Local Existing Instance primitive_atomic_heap. Definition incr_client : val := λ: "x", let: "l" := ref "x" in incr "l" ||| incr "l". Lemma incr_client_safe (x: Z): ⊢ WP incr_client #x {{ _, True }}. Proof using Type*. wp_lam. wp_alloc l as "Hl". 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 #l {{ _, True }})%I as "#Aupd". { iIntros "!>". awp_apply incr_spec. clear x. iInv nroot as (x) ">H↦". iAaccIntro with "H↦"; first 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_smart_apply wp_par. - iAssumption. - iAssumption. - iIntros (??) "_ !>". done. Qed. End increment_client. iris-iris-4.2.0/iris_heap_lang/lib/lazy_coin.v000066400000000000000000000040651460620107300213230ustar00rootroot00000000000000From iris.base_logic Require Export invariants. From iris.program_logic Require Export weakestpre. From iris.heap_lang Require Export lang proofmode notation. From iris.heap_lang.lib Require Export nondet_bool. From iris.prelude Require Import options. Definition new_coin: val := λ: <>, (ref NONE, NewProph). Definition read_coin : val := λ: "cp", let: "c" := Fst "cp" in let: "p" := Snd "cp" in match: !"c" with NONE => let: "r" := nondet_bool #() in "c" <- SOME "r";; resolve_proph: "p" to: "r";; "r" | SOME "b" => "b" end. Section proof. Context `{!heapGS Σ}. Definition val_to_bool (v : val) : bool := bool_decide (v = #true). Definition prophecy_to_bool (vs : list (val * val)) : bool := default false (val_to_bool ∘ snd <$> head vs). Lemma prophecy_to_bool_of_bool (b : bool) v vs : prophecy_to_bool ((v, #b) :: vs) = b. Proof. by destruct b. Qed. Definition coin (cp : val) (b : bool) : iProp Σ := ∃ (c : loc) (p : proph_id) (vs : list (val * val)), ⌜cp = (#c, #p)%V⌝ ∗ proph p vs ∗ (c ↦ SOMEV #b ∨ (c ↦ NONEV ∗ ⌜b = prophecy_to_bool vs⌝)). Lemma new_coin_spec : {{{ True }}} new_coin #() {{{ c b, RET c; coin c b }}}. Proof. iIntros (Φ) "_ HΦ". wp_lam. wp_apply wp_new_proph; first done. iIntros (vs p) "Hp". wp_alloc c as "Hc". wp_pair. iApply ("HΦ" $! (#c, #p)%V ). rewrite /coin; eauto 10 with iFrame. Qed. Lemma read_coin_spec cp b : {{{ coin cp b }}} read_coin cp {{{ RET #b; coin cp b }}}. Proof. iIntros (Φ) "Hc HΦ". iDestruct "Hc" as (c p vs ->) "[Hp [Hc | [Hc ->]]]". - wp_lam. wp_load. wp_match. iApply "HΦ". rewrite /coin; eauto 10 with iFrame. - wp_lam. wp_load. wp_match. wp_apply nondet_bool_spec; first done. iIntros (r) "_". wp_let. wp_store. wp_apply (wp_resolve_proph with "[Hp]"); first done. iIntros (ws) "[-> Hws]". rewrite !prophecy_to_bool_of_bool. wp_seq. iApply "HΦ". rewrite /coin; eauto 10 with iFrame. Qed. End proof. iris-iris-4.2.0/iris_heap_lang/lib/lock.v000066400000000000000000000063041460620107300202620ustar00rootroot00000000000000From iris.base_logic.lib Require Export invariants. From iris.heap_lang Require Import proofmode notation. From iris.prelude Require Import options. (** A general interface for a lock. All parameters are implicit, since it is expected that there is only one [heapGS_gen] in scope that could possibly apply. Only one instance of this class should ever be in scope. To write a library that is generic over the lock, just add a [`{!lock}] implicit parameter around the code and [`{!lockG Σ}] around the proofs. To use a particular lock instance, use [Local Existing Instance ]. When writing an instance of this class, please take care not to shadow the class projections (e.g., either use [Local Definition newlock] or avoid the name [newlock] altogether), and do not register an instance -- just make it a [Definition] that others can register later. *) Class lock := Lock { (** * Operations *) newlock : val; acquire : val; release : val; (** * Ghost state *) (** The assumptions about [Σ] *) lockG : gFunctors → Type; (** [name] is used to associate [locked] with [is_lock] *) lock_name : Type; (** * Predicates *) (** No namespace [N] parameter because we only expose program specs, which anyway have the full mask. *) is_lock `{!heapGS_gen hlc Σ} {L : lockG Σ} (γ: lock_name) (lock: val) (R: iProp Σ) : iProp Σ; locked `{!heapGS_gen hlc Σ} {L : lockG Σ} (γ: lock_name) : iProp Σ; (** * General properties of the predicates *) #[global] is_lock_persistent `{!heapGS_gen hlc Σ} {L : lockG Σ} γ lk R :: Persistent (is_lock (L:=L) γ lk R); is_lock_iff `{!heapGS_gen hlc Σ} {L : lockG Σ} γ lk R1 R2 : is_lock (L:=L) γ lk R1 -∗ ▷ □ (R1 ∗-∗ R2) -∗ is_lock (L:=L) γ lk R2; #[global] locked_timeless `{!heapGS_gen hlc Σ} {L : lockG Σ} γ :: Timeless (locked (L:=L) γ); locked_exclusive `{!heapGS_gen hlc Σ} {L : lockG Σ} γ : locked (L:=L) γ -∗ locked (L:=L) γ -∗ False; (** * Program specs *) newlock_spec `{!heapGS_gen hlc Σ} {L : lockG Σ} (R : iProp Σ) : {{{ R }}} newlock #() {{{ lk γ, RET lk; is_lock (L:=L) γ lk R }}}; acquire_spec `{!heapGS_gen hlc Σ} {L : lockG Σ} γ lk R : {{{ is_lock (L:=L) γ lk R }}} acquire lk {{{ RET #(); locked (L:=L) γ ∗ R }}}; release_spec `{!heapGS_gen hlc Σ} {L : lockG Σ} γ lk R : {{{ is_lock (L:=L) γ lk R ∗ locked (L:=L) γ ∗ R }}} release lk {{{ RET #(); True }}} }. Global Arguments newlock : simpl never. Global Arguments acquire : simpl never. Global Arguments release : simpl never. Global Arguments is_lock : simpl never. Global Arguments locked : simpl never. Existing Class lockG. Global Hint Mode lockG + + : typeclass_instances. Global Hint Extern 0 (lockG _) => progress simpl : typeclass_instances. Global Instance is_lock_contractive `{!heapGS_gen hlc Σ, !lock, !lockG Σ} γ lk : Contractive (is_lock γ lk). Proof. apply (uPred.contractive_internal_eq (M:=iResUR Σ)). iIntros (P Q) "#HPQ". iApply prop_ext. iIntros "!>". iSplit; iIntros "H"; iApply (is_lock_iff with "H"); iNext; iRewrite "HPQ"; auto. Qed. Global Instance is_lock_proper `{!heapGS_gen hlc Σ, !lock, !lockG Σ} γ lk : Proper ((≡) ==> (≡)) (is_lock γ lk) := ne_proper _. iris-iris-4.2.0/iris_heap_lang/lib/logatom_lock.v000066400000000000000000000076511460620107300220120ustar00rootroot00000000000000(** A TaDA-style logically atomic specification for a lock, derived for an arbitrary implementation of the lock interface. The opposite direction could also be derived rather easily (modulo a later in the [acquire] postcondition or a restriction to timeless lock invariants), as shown in the TaDA paper. In essence, this is an instance of the general fact that 'invariant-based' ("HoCAP-style") logically atomic specifications are equivalent to TaDA-style logically atomic specifications; see for that being worked out and explained in more detail for a stack specification. *) From iris.proofmode Require Import proofmode. From iris.base_logic.lib Require Import ghost_var. From iris.program_logic Require Export atomic. From iris.heap_lang Require Import proofmode notation atomic_heap lock. From iris.prelude Require Import options. Inductive state := Free | Locked. Class alockG Σ := LockG { lock_tokG : ghost_varG Σ state }. Local Existing Instance lock_tokG. Definition alockΣ : gFunctors := #[ghost_varΣ state]. Global Instance subG_alockΣ {Σ} : subG alockΣ Σ → alockG Σ. Proof. solve_inG. Qed. Section tada. Context `{!heapGS Σ, !alockG Σ, !lock, !lockG Σ}. Record tada_lock_name := TadaLockName { tada_lock_name_state : gname; tada_lock_name_lock : lock_name; }. Definition tada_lock_state (γ : tada_lock_name) (s : state) : iProp Σ := ghost_var γ.(tada_lock_name_state) (3/4) s ∗ if s is Locked then locked γ.(tada_lock_name_lock) ∗ ghost_var γ.(tada_lock_name_state) (1/4) Locked else True. Definition tada_is_lock (γ : tada_lock_name) (lk : val) : iProp Σ := is_lock γ.(tada_lock_name_lock) lk (ghost_var γ.(tada_lock_name_state) (1/4) Free). Global Instance tada_is_lock_persistent γ lk : Persistent (tada_is_lock γ lk). Proof. apply _. Qed. Global Instance tada_lock_state_timeless γ s : Timeless (tada_lock_state γ s). Proof. destruct s; apply _. Qed. Lemma tada_lock_state_exclusive γ s1 s2 : tada_lock_state γ s1 -∗ tada_lock_state γ s2 -∗ False. Proof. iIntros "[Hvar1 _] [Hvar2 _]". iCombine "Hvar1 Hvar2" gives %[Hval _]. exfalso. done. Qed. Lemma newlock_tada_spec : {{{ True }}} newlock #() {{{ lk γ, RET lk; tada_is_lock γ lk ∗ tada_lock_state γ Free }}}. Proof. iIntros (Φ) "_ HΦ". iMod (ghost_var_alloc Free) as (γvar) "Hvar". replace 1%Qp with (3/4 + 1/4)%Qp; last first. { rewrite Qp.three_quarter_quarter //. } iDestruct "Hvar" as "[Hvar1 Hvar2]". wp_apply (newlock_spec with "Hvar2") as (lk γlock) "Hlock". iApply ("HΦ" $! lk (TadaLockName _ _)). iFrame. Qed. Lemma acquire_tada_spec γ lk : tada_is_lock γ lk -∗ <<{ ∀∀ s, tada_lock_state γ s }>> acquire lk @ ∅ <<{ ⌜ s = Free ⌝ ∗ tada_lock_state γ Locked | RET #() }>>. Proof. iIntros "#Hislock %Φ AU". iApply wp_fupd. wp_apply (acquire_spec with "Hislock") as "[Hlocked Hvar1]". iMod "AU" as (s) "[[Hvar2 _] [_ Hclose]]". iCombine "Hvar1 Hvar2" gives %[_ <-]. iMod (ghost_var_update_2 Locked with "Hvar1 Hvar2") as "[Hvar1 Hvar2]". { rewrite Qp.quarter_three_quarter //. } iMod ("Hclose" with "[$Hvar2 $Hlocked $Hvar1]"); done. Qed. Lemma release_tada_spec γ lk : tada_is_lock γ lk -∗ <<{ tada_lock_state γ Locked }>> release lk @ ∅ <<{ tada_lock_state γ Free | RET #() }>>. Proof. iIntros "#Hislock %Φ AU". iApply fupd_wp. iMod "AU" as "[[Hvar1 [Hlocked Hvar2]] [_ Hclose]]". iMod (ghost_var_update_2 Free with "Hvar1 Hvar2") as "[Hvar1 Hvar2]". { rewrite Qp.three_quarter_quarter //. } iMod ("Hclose" with "[$Hvar1]"). iModIntro. wp_apply (release_spec with "[$Hislock $Hlocked $Hvar2]"). auto. Qed. End tada. Global Typeclasses Opaque tada_is_lock tada_lock_state. iris-iris-4.2.0/iris_heap_lang/lib/nondet_bool.v000066400000000000000000000015101460620107300216260ustar00rootroot00000000000000From iris.base_logic Require Export invariants. From iris.program_logic Require Export weakestpre. From iris.heap_lang Require Export lang proofmode notation. From iris.prelude Require Import options. Definition nondet_bool : val := λ: <>, let: "l" := ref #true in Fork ("l" <- #false);; !"l". Section proof. Context `{!heapGS Σ}. Lemma nondet_bool_spec : {{{ True }}} nondet_bool #() {{{ (b : bool), RET #b; True }}}. Proof. iIntros (Φ) "_ HΦ". wp_lam. wp_alloc l as "Hl". wp_let. pose proof (nroot .@ "rnd") as rndN. iMod (inv_alloc rndN _ (∃ (b : bool), l ↦ #b)%I with "[Hl]") as "#Hinv"; first by eauto. wp_apply wp_fork. - iInv rndN as (?) "?". wp_store; eauto. - wp_seq. iInv rndN as (?) "?". wp_load. iSplitR "HΦ"; first by eauto. by iApply "HΦ". Qed. End proof. iris-iris-4.2.0/iris_heap_lang/lib/par.v000066400000000000000000000032611460620107300201130ustar00rootroot00000000000000From iris.heap_lang Require Import proofmode notation. From iris.heap_lang Require Export spawn. From iris.prelude Require Import options. Definition parN : namespace := nroot .@ "par". Definition par : val := λ: "e1" "e2", let: "handle" := spawn "e1" in let: "v2" := "e2" #() in let: "v1" := join "handle" in ("v1", "v2"). Notation "e1 ||| e2" := (par (λ: <>, e1)%E (λ: <>, e2)%E) : expr_scope. Notation "e1 ||| e2" := (par (λ: <>, e1)%V (λ: <>, e2)%V) : val_scope. Section proof. Local Set Default Proof Using "Type*". Context `{!heapGS_gen hlc Σ, !spawnG Σ}. (* Notice that this allows us to strip a later *after* the two Ψ have been 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 Σ) (f1 f2 : val) (Φ : val → iProp Σ) : WP f1 #() {{ Ψ1 }} -∗ WP f2 #() {{ Ψ2 }} -∗ (▷ ∀ v1 v2, Ψ1 v1 ∗ Ψ2 v2 -∗ ▷ Φ (v1,v2)%V) -∗ WP par f1 f2 {{ Φ }}. Proof. iIntros "Hf1 Hf2 HΦ". wp_lam. wp_let. wp_apply (spawn_spec parN with "Hf1") as (l) "Hl". wp_let. wp_bind (f2 _). wp_apply (wp_wand with "Hf2") as (v) "H2". wp_let. wp_apply (join_spec with "[$Hl]") as (w) "H1". iSpecialize ("HΦ" with "[$H1 $H2]"). by wp_pures. Qed. Lemma wp_par (Ψ1 Ψ2 : val → iProp Σ) (e1 e2 : expr) (Φ : val → iProp Σ) : WP e1 {{ Ψ1 }} -∗ WP e2 {{ Ψ2 }} -∗ (∀ v1 v2, Ψ1 v1 ∗ Ψ2 v2 -∗ ▷ Φ (v1,v2)%V) -∗ WP (e1 ||| e2)%V {{ Φ }}. Proof. iIntros "H1 H2 H". wp_apply (par_spec Ψ1 Ψ2 with "[H1] [H2] [H]"); [by wp_lam..|auto]. Qed. End proof. iris-iris-4.2.0/iris_heap_lang/lib/rw_lock.v000066400000000000000000000116601460620107300207730ustar00rootroot00000000000000From iris.base_logic.lib Require Export invariants. From iris.bi.lib Require Export fractional. From iris.heap_lang Require Import proofmode notation. From iris.prelude Require Import options. (** A general interface for a reader-writer lock. All parameters are implicit, since it is expected that there is only one [heapGS_gen] in scope that could possibly apply. Only one instance of this class should ever be in scope. To write a library that is generic over the lock, just add a [`{!rwlock}] implicit parameter around the code and [`{!rwlockG Σ}] around the proofs. To use a particular lock instance, use [Local Existing Instance ]. When writing an instance of this class, please take care not to shadow the class projections (e.g., either use [Local Definition newlock] or avoid the name [newlock] altogether), and do not register an instance -- just make it a [Definition] that others can register later. *) Class rwlock := RwLock { (** * Operations *) newlock : val; acquire_reader : val; release_reader : val; acquire_writer : val; release_writer : val; (** * Ghost state *) (** The assumptions about [Σ] *) rwlockG : gFunctors → Type; (** [lock_name] is used to associate [reader_locked] and [writer_locked] with [is_rw_lock] *) lock_name : Type; (** * Predicates *) (** No namespace [N] parameter because we only expose program specs, which anyway have the full mask. *) is_rw_lock `{!heapGS_gen hlc Σ} {L : rwlockG Σ} (γ : lock_name) (lock : val) (Φ : Qp → iProp Σ) : iProp Σ; reader_locked `{!heapGS_gen hlc Σ} {L : rwlockG Σ} (γ : lock_name) (q : Qp) : iProp Σ; writer_locked `{!heapGS_gen hlc Σ} {L : rwlockG Σ} (γ : lock_name) : iProp Σ; (** * General properties of the predicates *) #[global] is_rw_lock_persistent `{!heapGS_gen hlc Σ} {L : rwlockG Σ} γ lk Φ :: Persistent (is_rw_lock (L:=L) γ lk Φ); is_rw_lock_iff `{!heapGS_gen hlc Σ} {L : rwlockG Σ} γ lk Φ Ψ : is_rw_lock (L:=L) γ lk Φ -∗ ▷ □ (∀ q, Φ q ∗-∗ Ψ q) -∗ is_rw_lock (L:=L) γ lk Ψ; #[global] reader_locked_timeless `{!heapGS_gen hlc Σ} {L : rwlockG Σ} γ q :: Timeless (reader_locked (L:=L) γ q); #[global] writer_locked_timeless `{!heapGS_gen hlc Σ} {L : rwlockG Σ} γ :: Timeless (writer_locked (L:=L) γ); writer_locked_exclusive `{!heapGS_gen hlc Σ} {L : rwlockG Σ} γ : writer_locked (L:=L) γ -∗ writer_locked (L:=L) γ -∗ False; writer_locked_not_reader_locked `{!heapGS_gen hlc Σ} {L : rwlockG Σ} γ q : writer_locked (L:=L) γ -∗ reader_locked (L:=L) γ q -∗ False; (** * Program specs *) newlock_spec `{!heapGS_gen hlc Σ} {L : rwlockG Σ} (Φ : Qp → iProp Σ) `{!AsFractional P Φ 1} : {{{ P }}} newlock #() {{{ lk γ, RET lk; is_rw_lock (L:=L) γ lk Φ }}}; acquire_reader_spec `{!heapGS_gen hlc Σ} {L : rwlockG Σ} γ lk Φ : {{{ is_rw_lock (L:=L) γ lk Φ }}} acquire_reader lk {{{ q, RET #(); reader_locked (L:=L) γ q ∗ Φ q }}}; release_reader_spec `{!heapGS_gen hlc Σ} {L : rwlockG Σ} γ lk Φ q : {{{ is_rw_lock (L:=L) γ lk Φ ∗ reader_locked (L:=L) γ q ∗ Φ q }}} release_reader lk {{{ RET #(); True }}}; acquire_writer_spec `{!heapGS_gen hlc Σ} {L : rwlockG Σ} γ lk Φ : {{{ is_rw_lock (L:=L) γ lk Φ }}} acquire_writer lk {{{ RET #(); writer_locked (L:=L) γ ∗ Φ 1%Qp }}}; release_writer_spec `{!heapGS_gen hlc Σ} {L : rwlockG Σ} γ lk Φ : {{{ is_rw_lock (L:=L) γ lk Φ ∗ writer_locked (L:=L) γ ∗ Φ 1%Qp }}} release_writer lk {{{ RET #(); True }}}; }. Global Arguments newlock : simpl never. Global Arguments acquire_reader : simpl never. Global Arguments release_reader : simpl never. Global Arguments acquire_writer : simpl never. Global Arguments release_writer : simpl never. Global Arguments is_rw_lock : simpl never. Global Arguments reader_locked : simpl never. Global Arguments writer_locked : simpl never. Existing Class rwlockG. Global Hint Mode rwlockG + + : typeclass_instances. Global Hint Extern 0 (rwlockG _) => progress simpl : typeclass_instances. Global Instance is_rw_lock_contractive `{!heapGS_gen hlc Σ, !rwlock, !rwlockG Σ} γ lk n : Proper (pointwise_relation _ (dist_later n) ==> dist n) (is_rw_lock γ lk). Proof. assert (Contractive (is_rw_lock γ lk : (Qp -d> iPropO Σ) → _)) as Hcontr. { apply (uPred.contractive_internal_eq (M:=iResUR Σ)); iIntros (Φ1 Φ2) "#HΦ". rewrite discrete_fun_equivI. iApply plainly.prop_ext_2; iIntros "!>"; iSplit; iIntros "H"; iApply (is_rw_lock_iff with "H"); iIntros "!> !>" (q); iRewrite ("HΦ" $! q); auto. } intros Φ1 Φ2 HΦ. apply Hcontr. dist_later_intro. apply HΦ. Qed. Global Instance is_rw_lock_proper `{!heapGS_gen hlc Σ, !rwlock, !rwlockG Σ} γ lk : Proper (pointwise_relation _ (≡) ==> (≡)) (is_rw_lock γ lk). Proof. intros Φ1 Φ2 HΦ. apply equiv_dist=> n. apply is_rw_lock_contractive=> q. dist_later_intro. apply equiv_dist, HΦ. Qed. iris-iris-4.2.0/iris_heap_lang/lib/rw_spin_lock.v000066400000000000000000000314671460620107300220330ustar00rootroot00000000000000From iris.algebra Require Import gmultiset. From iris.base_logic Require Import invariants. From iris.bi.lib Require Export fractional. From iris.program_logic Require Export weakestpre. From iris.heap_lang Require Export lang. From iris.heap_lang Require Import proofmode notation. From iris.heap_lang.lib Require Export rw_lock. From iris.prelude Require Import options. Local Definition newlock : val := λ: <>, ref #0. Local Definition try_acquire_reader : val := λ: "l", let: "n" := !"l" in if: #0 ≤ "n" then CAS "l" "n" ("n" + #1) else #false. Local Definition acquire_reader : val := rec: "acquire" "l" := if: try_acquire_reader "l" then #() else "acquire" "l". Local Definition release_reader : val := λ: "l", FAA "l" #(-1) ;; #(). Local Definition try_acquire_writer : val := λ: "l", CAS "l" #0 #(-1). Local Definition acquire_writer : val := rec: "acquire" "l" := if: try_acquire_writer "l" then #() else "acquire" "l". Local Definition release_writer : val := λ: "l", "l" <- #0. Class rw_spin_lockG Σ := RwLockG { rwlock_tokG : inG Σ (authR (gmultisetUR Qp)) }. Local Existing Instance rwlock_tokG. Definition rw_spin_lockΣ : gFunctors := #[GFunctor (authR (gmultisetUR Qp)) ]. Global Instance subG_rw_spin_lockΣ {Σ} : subG rw_spin_lockΣ Σ → rw_spin_lockG Σ. Proof. solve_inG. Qed. Section proof. Context `{!heapGS_gen hlc Σ, !rw_spin_lockG Σ}. Let N := nroot .@ "rw_lock". Local Definition rw_state_inv (γ : gname) (l : loc) (Φ : Qp → iProp Σ) : iProp Σ := ∃ z : Z, l ↦ #z ∗ (* We need *some* ghost state that allows us to establish a contradiction in the left disjunct (where the lock is write-locked) when proving [release_reader_spec], so we use a fraction of the empty authoritative reader set (the rest goes to [writer_locked].) Any fraction would do, but the benefit of giving over half to [writer_locked] (and keeping less than half here) is that we can prove [writer_locked_exclusive]. *) (⌜(z = -1)%Z⌝ ∗ own γ (●{# 1/4} ∅) ∨ ⌜(0 ≤ z)%Z⌝ ∗ ∃ (q : Qp) (g : gmultiset Qp), own γ (● g) ∗ ⌜size g = Z.to_nat z⌝ ∗ ⌜set_fold Qp.add q g = 1%Qp⌝ ∗ Φ q ). Local Hint Extern 0 (environments.envs_entails _ (rw_state_inv _ _ _)) => unfold rw_state_inv : core. (* This definition is [tc_opaque] because the ▷ around [internal_fractional] should be preserved even when taking steps (otherwise it's more annoying to re-establish.) *) Local Definition is_rw_lock (γ : gname) (lk : val) (Φ : Qp → iProp Σ) : iProp Σ := tc_opaque (▷ internal_fractional Φ ∗ ∃ l : loc, ⌜lk = #l⌝ ∗ inv N (rw_state_inv γ l Φ))%I. Global Instance is_rw_lock_persistent γ lk Φ : Persistent (is_rw_lock γ lk Φ). Proof. unfold is_rw_lock, tc_opaque. apply _. Qed. Local Hint Extern 0 (environments.envs_entails _ (is_rw_lock _ _ _)) => unfold is_rw_lock : core. Local Definition reader_locked (γ : gname) (q : Qp) : iProp Σ := own γ (◯ {[+ q +]}). Local Definition writer_locked (γ : gname) : iProp Σ := own γ (● {# 3/4} ∅). Local Lemma writer_locked_exclusive γ : writer_locked γ -∗ writer_locked γ -∗ False. Proof. iIntros "H1 H2". iCombine "H1 H2" gives %Hvalid. exfalso. rewrite auth_auth_dfrac_op_valid dfrac_op_own dfrac_valid_own in Hvalid. by destruct Hvalid as [? _]. Qed. Local Lemma writer_locked_not_reader_locked γ q : writer_locked γ -∗ reader_locked γ q -∗ False. Proof. iIntros "H1 H2". iCombine "H1 H2" gives %Hvalid. exfalso. apply auth_both_dfrac_valid in Hvalid as (_ & Hvalid & _). generalize (Hvalid 0)=> /cmra_discrete_included_r /gmultiset_included /(_ q). rewrite multiplicity_empty multiplicity_singleton. by lia. Qed. Lemma is_rw_lock_iff γ lk Φ Ψ : is_rw_lock γ lk Φ -∗ ▷ □ (∀ q, Φ q ∗-∗ Ψ q) -∗ is_rw_lock γ lk Ψ. Proof. iIntros "[#HΦdup [%l [-> #Hlockinv]]] #Hiff". iSplitR. { iApply (internal_fractional_iff with "Hiff HΦdup"). } iExists l; iSplitR; first done. iApply (inv_iff with "[Hlockinv Hiff //]"); iIntros "!> !>". iDestruct "Hiff" as "#Hiff". iClear "HΦdup Hlockinv". iSplit. - iIntros "(%z & ? & Hstate)". iExists z. iFrame. iDestruct "Hstate" as "[?|(? & % & % & ? & ? & ? & ?)]". + iFrame. + iRight. iFrame. by iApply "Hiff". - iIntros "(%z & ? & Hstate)". iExists z. iFrame. iDestruct "Hstate" as "[?|(? & % & % & ? & ? & ? & ?)]". + iFrame. + iRight. iFrame. by iApply "Hiff". Qed. (* Some helper lemmas for "auth of a multiset" *) Local Lemma auth_valid_gmultiset_singleton `{Countable A} dq (v : A) (g : gmultiset A) : ✓ (● { dq } g ⋅ ◯ ({[+ v +]})) → v ∈ g. Proof. rewrite auth_both_dfrac_valid_discrete gmultiset_included gmultiset_singleton_subseteq_l. intros (_ & ? & _); assumption. Qed. Local Lemma own_auth_gmultiset_singleton_2 γ dq v g : own γ (● { dq } g) ∗ own γ (◯ ({[+ v +]})) ⊢ ⌜v ∈ g⌝. Proof. iIntros "[Hauth Hfrag]". iCombine "Hauth Hfrag" gives %Hvalid. iPureIntro. apply (auth_valid_gmultiset_singleton _ _ _ Hvalid). Qed. Local Lemma newlock_spec (Φ : Qp → iProp Σ) `{!AsFractional P Φ 1} : {{{ P }}} newlock #() {{{ lk γ, RET lk; is_rw_lock γ lk Φ }}}. Proof. iIntros (φ) "HΦ Hφ". wp_lam. iMod (own_alloc (● ∅)) as (γ) "Hγ". { apply auth_auth_valid; done. } wp_alloc l as "Hl". iMod (inv_alloc N _ (rw_state_inv γ l Φ) with "[-Hφ]") as "#?". { rewrite [P]as_fractional. eauto 10 with iFrame. } iApply "Hφ". iSplitR. { iApply fractional_internal_fractional. apply (as_fractional_fractional (P:=P)). } eauto 10. Qed. Local Lemma try_acquire_reader_spec γ lk Φ : {{{ is_rw_lock γ lk Φ }}} try_acquire_reader lk {{{ (b : bool), RET #b; if b then ∃ q, reader_locked γ q ∗ Φ q else True }}}. Proof. iIntros (φ) "[#HΦdup (%l & -> & #Hlockinv)] Hφ". wp_lam. wp_bind (!_)%E. iInv "Hlockinv" as (z) "[> Hl Hz]". wp_load. iSplitL "Hl Hz"; first by eauto with iFrame. iModIntro. wp_pures. destruct (Z.le_dec 0%Z z) as [Hle|?]; last first. { rewrite bool_decide_false //. wp_pures. iApply "Hφ". done. } rewrite bool_decide_true //. wp_pures. wp_bind (CmpXchg _ _ _). iInv "Hlockinv" as (z') "[> Hl Hz]". wp_cmpxchg as [= ->]|?; last first. { iSplitR "Hφ". { eauto with iFrame. } iModIntro. wp_pures. by iApply "Hφ". } iDestruct "Hz" as "[[-> _]|(Hz_ge_0 & %q & %g & Hg)]"; first done. iDestruct "Hg" as "(Hauth & %Hsize & %Hfold & HΦ)". rewrite -[q in Φ q]Qp.div_2. iDestruct ("HΦdup" $! (q / 2)%Qp (q / 2)%Qp with "HΦ") as "[HΦ HΦgive]". iMod (own_update _ _ (●(g ⊎ {[+ (q / 2)%Qp+]}) ⋅ ◯({[+ (q / 2)%Qp +]})) with "Hauth") as "[Hauth Hview]". { apply auth_update_alloc. rewrite -{2}[({[+ (q / 2)%Qp+]})]gmultiset_disj_union_left_id. apply gmultiset_local_update_alloc. } iSplitR "HΦgive Hview Hφ". { iExists (z + 1)%Z. iModIntro. iModIntro. iFrame. iRight. iSplitL "Hz_ge_0"; first by eauto with lia. iExists _, _. iFrame. iSplit. { iPureIntro. rewrite gmultiset_size_disj_union gmultiset_size_singleton. lia. } iPureIntro. rewrite gmultiset_set_fold_disj_union gmultiset_set_fold_singleton -gmultiset_set_fold_comm_acc. { rewrite Qp.div_2 //. } intros. rewrite 2!Qp.add_assoc [(_ + q/2)%Qp]Qp.add_comm //. } iModIntro. wp_pures. iApply "Hφ". eauto with iFrame. Qed. Local Lemma acquire_reader_spec γ lk Φ : {{{ is_rw_lock γ lk Φ }}} acquire_reader lk {{{ q, RET #(); reader_locked γ q ∗ Φ q }}}. Proof. iIntros (φ) "#Hislock Hφ". iLöb as "IH". wp_rec. wp_apply (try_acquire_reader_spec with "Hislock"); iIntros ([|]). - iIntros "[% ?]". wp_if_true. iApply "Hφ". eauto with iFrame. - iIntros. wp_if_false. iApply "IH". eauto. Qed. Local Lemma release_reader_spec γ lk Φ q : {{{ is_rw_lock γ lk Φ ∗ reader_locked γ q ∗ Φ q }}} release_reader lk {{{ RET #(); True }}}. Proof. iIntros (φ) "((#HΦdup & %l & -> & Hlockinv) & Hlocked & HΦ) Hφ". wp_lam. wp_bind (FAA _ _). iInv "Hlockinv" as (z) "[> Hl Hz]". wp_faa. unfold reader_locked. iDestruct "Hz" as "[[_ Hempty]|(%Hz_ge_0 & %q' & %g & Hg & %Hsize & %Hsum & HΦq')]". { iExFalso. iDestruct (own_auth_gmultiset_singleton_2 with "[$]") as %?. multiset_solver. } iAssert (⌜(0 < z)%Z ∧ q ∈ g⌝)%I as %?. { iDestruct (own_auth_gmultiset_singleton_2 with "[$]") as %?. iPureIntro. split; last assumption. apply Z2Nat.neq_0_pos. rewrite -Hsize gmultiset_size_empty_iff. multiset_solver. } iCombine "Hg Hlocked" as "Hown". iMod (own_update _ _ (●(g ∖ {[+ q +]})) with "Hown") as "Hown". { apply auth_update_dealloc. replace ε with ({[+ q +]} ∖ {[+ q +]} : gmultiset Qp); last first. { rewrite gmultiset_difference_diag //. } apply gmultiset_local_update_dealloc. multiset_solver. } iModIntro. iSplitR "Hφ". { iExists (z + -1)%Z. iFrame. iRight. iSplit. { eauto with lia. } iExists _, _. iDestruct ("HΦdup" $! q q' with "[$HΦ $HΦq']") as "HΦ". iModIntro. iFrame. iSplit. { iPureIntro. rewrite gmultiset_size_difference; last multiset_solver. rewrite gmultiset_size_singleton. lia. } iPureIntro. rewrite -Hsum gmultiset_set_fold_comm_acc; last first. { intros. rewrite 2!Qp.add_assoc [(_ + q)%Qp]Qp.add_comm //. } rewrite -gmultiset_set_fold_singleton -gmultiset_set_fold_disj_union gmultiset_disj_union_comm -gmultiset_disj_union_difference //. multiset_solver. } wp_pures. by iApply "Hφ". Qed. Local Lemma try_acquire_writer_spec γ lk Φ : {{{ is_rw_lock γ lk Φ }}} try_acquire_writer lk {{{ (b : bool), RET #b; if b then writer_locked γ ∗ Φ 1%Qp else True }}}. Proof. iIntros (φ) "(#HΦdup & %l & -> & #Hlockinv) Hφ". wp_lam. wp_bind (CmpXchg _ _ _). iInv ("Hlockinv") as (z) "[> Hl Hz]". wp_cmpxchg as [= ->]|?; last first. { iModIntro. iSplitL "Hl Hz". { eauto with iFrame. } wp_pures. by iApply "Hφ". } iDestruct "Hz" as "[[%H0_eq_1 ?]|(_ & %q & %g & Hg & %Hsize & %Hfold & HΦ)]". { done. } apply gmultiset_size_empty_inv in Hsize as ->. rewrite gmultiset_set_fold_empty in Hfold. subst q. rewrite -[in (●{# 1} _)]Qp.quarter_three_quarter. iDestruct "Hg" as "[Hg Hg_give]". iModIntro. iSplitL "Hl Hg". { eauto 10 with iFrame. } wp_pures. iApply "Hφ". by iFrame. Qed. Local Lemma acquire_writer_spec γ lk Φ : {{{ is_rw_lock γ lk Φ }}} acquire_writer lk {{{ RET #(); writer_locked γ ∗ Φ 1%Qp }}}. Proof. iIntros (φ) "#Hislock Hφ". iLöb as "IH". wp_rec. wp_apply (try_acquire_writer_spec with "Hislock"); iIntros ([|]). - iIntros. wp_if_true. iApply "Hφ". eauto with iFrame. - iIntros. wp_if_false. iApply "IH". eauto. Qed. Local Lemma release_writer_spec γ lk Φ : {{{ is_rw_lock γ lk Φ ∗ writer_locked γ ∗ Φ 1%Qp }}} release_writer lk {{{ RET #(); True }}}. Proof. iIntros (φ) "((#HΦdup & %l & -> & #Hlockinv) & Hlocked & HΦ) Hφ". wp_lam. iInv ("Hlockinv") as (z) "[> Hl Hz]". wp_store. iDestruct "Hz" as "[[? Hg]|(_ & % & % & Hg_owned & _)]"; last first. { iExFalso. iCombine "Hg_owned Hlocked" gives %Hvalid. rewrite auth_auth_dfrac_op_valid dfrac_op_own dfrac_valid_own in Hvalid. by destruct Hvalid as [? _]. } iCombine "Hg Hlocked" as "Hown". rewrite Qp.quarter_three_quarter. iSplitR "Hφ"; first by eauto 15 with iFrame. by iApply "Hφ". Qed. End proof. Definition rw_spin_lock : rwlock := {| rw_lock.rwlockG := rw_spin_lockG; rw_lock.writer_locked_exclusive _ _ _ _ := writer_locked_exclusive; rw_lock.writer_locked_not_reader_locked _ _ _ _ := writer_locked_not_reader_locked; rw_lock.is_rw_lock_iff _ _ _ _ := is_rw_lock_iff; rw_lock.newlock_spec _ _ _ _ := newlock_spec; rw_lock.acquire_reader_spec _ _ _ _ := acquire_reader_spec; rw_lock.release_reader_spec _ _ _ _ := release_reader_spec; rw_lock.acquire_writer_spec _ _ _ _ := acquire_writer_spec; rw_lock.release_writer_spec _ _ _ _ := release_writer_spec |}. iris-iris-4.2.0/iris_heap_lang/lib/spawn.v000066400000000000000000000056441460620107300204700ustar00rootroot00000000000000From iris.algebra Require Import excl. From iris.proofmode Require Import proofmode. From iris.base_logic.lib Require Export invariants. From iris.program_logic Require Export weakestpre. From iris.heap_lang Require Export lang. From iris.heap_lang Require Import proofmode notation. From iris.prelude Require Import options. Definition spawn : val := λ: "f", let: "c" := ref NONE in Fork ("c" <- SOME ("f" #())) ;; "c". Definition join : val := rec: "join" "c" := match: !"c" with SOME "x" => "x" | NONE => "join" "c" end. (** The CMRA & functor we need. *) (* Not bundling heapGS, as it may be shared with other users. *) Class spawnG Σ := SpawnG { spawn_tokG : inG Σ (exclR unitO) }. Local Existing Instance spawn_tokG. Definition spawnΣ : gFunctors := #[GFunctor (exclR unitO)]. Global Instance subG_spawnΣ {Σ} : subG spawnΣ Σ → spawnG Σ. Proof. solve_inG. Qed. (** Now we come to the Iris part of the proof. *) Section proof. Context `{!heapGS_gen hlc Σ, !spawnG Σ} (N : namespace). Definition spawn_inv (γ : gname) (l : loc) (Ψ : val → iProp Σ) : iProp Σ := ∃ lv, l ↦ lv ∗ (⌜lv = NONEV⌝ ∨ ∃ w, ⌜lv = SOMEV w⌝ ∗ (Ψ w ∨ own γ (Excl ()))). Definition join_handle (l : loc) (Ψ : val → iProp Σ) : iProp Σ := ∃ γ, own γ (Excl ()) ∗ inv N (spawn_inv γ l Ψ). Global Instance spawn_inv_ne n γ l : Proper (pointwise_relation val (dist n) ==> dist n) (spawn_inv γ l). Proof. solve_proper. Qed. Global Instance join_handle_ne n l : Proper (pointwise_relation val (dist n) ==> dist n) (join_handle l). Proof. solve_proper. Qed. (** The main proofs. *) Lemma spawn_spec (Ψ : val → iProp Σ) (f : val) : {{{ WP f #() {{ Ψ }} }}} spawn f {{{ l, RET #l; join_handle l Ψ }}}. Proof. iIntros (Φ) "Hf HΦ". rewrite /spawn /=. wp_lam. wp_alloc l as "Hl". iMod (own_alloc (Excl ())) as (γ) "Hγ"; first done. iMod (inv_alloc N _ (spawn_inv γ l Ψ) with "[Hl]") as "#?". { iNext. iExists NONEV. iFrame; eauto. } wp_smart_apply (wp_fork with "[Hf]"). - iNext. wp_bind (f _). iApply (wp_wand with "Hf"); iIntros (v) "Hv". wp_inj. iInv N as (v') "[Hl _]". wp_store. iSplitL; last done. iIntros "!> !>". iExists (SOMEV v). iFrame. eauto. - wp_pures. iApply "HΦ". rewrite /join_handle. 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]". wp_load. iDestruct "Hinv" as "[%|Hinv]"; subst. - iModIntro. iSplitL "Hl"; [iNext; iExists _; iFrame; eauto|]. wp_smart_apply ("IH" with "Hγ [HΦ]"). auto. - iDestruct "Hinv" as (v' ->) "[HΨ|Hγ']". + iModIntro. iSplitL "Hl Hγ"; [iNext; iExists _; iFrame; eauto|]. wp_pures. by iApply "HΦ". + iCombine "Hγ Hγ'" gives %[]. Qed. End proof. Global Typeclasses Opaque join_handle. iris-iris-4.2.0/iris_heap_lang/lib/spin_lock.v000066400000000000000000000100021460620107300213010ustar00rootroot00000000000000From iris.proofmode Require Import proofmode. From iris.program_logic Require Export weakestpre. From iris.base_logic Require Import lib.token. From iris.heap_lang Require Export lang. From iris.heap_lang Require Import proofmode notation. From iris.heap_lang.lib Require Export lock. From iris.prelude Require Import options. Local Definition newlock : val := λ: <>, ref #false. Local Definition try_acquire : val := λ: "l", CAS "l" #false #true. Local Definition acquire : val := rec: "acquire" "l" := if: try_acquire "l" then #() else "acquire" "l". Local Definition release : val := λ: "l", "l" <- #false. (** The CMRA we need. *) Class spin_lockG Σ := LockG { lock_tokG : tokenG Σ }. Local Existing Instance lock_tokG. Definition spin_lockΣ : gFunctors := #[tokenΣ]. Global Instance subG_spin_lockΣ {Σ} : subG spin_lockΣ Σ → spin_lockG Σ. Proof. solve_inG. Qed. Section proof. Context `{!heapGS_gen hlc Σ, !spin_lockG Σ}. Let N := nroot .@ "spin_lock". Local Definition lock_inv (γ : gname) (l : loc) (R : iProp Σ) : iProp Σ := ∃ b : bool, l ↦ #b ∗ if b then True else token γ ∗ R. Local Definition is_lock (γ : gname) (lk : val) (R : iProp Σ) : iProp Σ := ∃ l: loc, ⌜lk = #l⌝ ∧ inv N (lock_inv γ l R). Local Definition locked (γ : gname) : iProp Σ := token γ. Local Lemma locked_exclusive (γ : gname) : locked γ -∗ locked γ -∗ False. Proof. iIntros "H1 H2". by iCombine "H1 H2" gives %?. Qed. (** The main proofs. *) Local Lemma is_lock_iff γ lk R1 R2 : is_lock γ lk R1 -∗ ▷ □ (R1 ∗-∗ R2) -∗ is_lock γ lk R2. Proof. iDestruct 1 as (l ->) "#Hinv"; iIntros "#HR". iExists l; iSplit; [done|]. iApply (inv_iff with "Hinv"). iIntros "!> !>"; iSplit; iDestruct 1 as (b) "[Hl H]"; iExists b; iFrame "Hl"; destruct b; first [done|iDestruct "H" as "[$ ?]"; by iApply "HR"]. Qed. Local Lemma newlock_spec (R : iProp Σ): {{{ R }}} newlock #() {{{ lk γ, RET lk; is_lock γ lk R }}}. Proof. iIntros (Φ) "HR HΦ". rewrite /newlock /=. wp_lam. wp_alloc l as "Hl". iMod token_alloc as (γ) "Hγ". iMod (inv_alloc N _ (lock_inv γ l R) with "[-HΦ]") as "#?". { iIntros "!>". iExists false. by iFrame. } iModIntro. iApply "HΦ". iExists l. eauto. Qed. Local Lemma try_acquire_spec γ lk R : {{{ is_lock γ lk R }}} try_acquire lk {{{ b, RET #b; if b is true then locked γ ∗ R else True }}}. Proof. iIntros (Φ) "#Hl HΦ". iDestruct "Hl" as (l ->) "#Hinv". wp_rec. wp_bind (CmpXchg _ _ _). iInv N as ([]) "[Hl HR]". - wp_cmpxchg_fail. iModIntro. iSplitL "Hl". { iNext. iExists true; eauto. } wp_pures. iApply ("HΦ" $! false). done. - wp_cmpxchg_suc. iDestruct "HR" as "[Hγ HR]". iModIntro. iSplitL "Hl". { iNext; iExists true; eauto. } rewrite /locked. wp_pures. by iApply ("HΦ" $! true with "[$Hγ $HR]"). Qed. Local Lemma acquire_spec γ lk R : {{{ is_lock γ lk R }}} acquire lk {{{ RET #(); locked γ ∗ R }}}. Proof. iIntros (Φ) "#Hl HΦ". iLöb as "IH". wp_rec. wp_apply (try_acquire_spec with "Hl"). iIntros ([]). - iIntros "[Hlked HR]". wp_if. iApply "HΦ"; auto with iFrame. - iIntros "_". wp_if. iApply ("IH" with "[HΦ]"). auto. Qed. Local Lemma release_spec γ lk R : {{{ is_lock γ lk R ∗ locked γ ∗ R }}} release lk {{{ RET #(); True }}}. Proof. iIntros (Φ) "(Hlock & Hlocked & HR) HΦ". iDestruct "Hlock" as (l ->) "#Hinv". rewrite /release /=. wp_lam. iInv N as (b) "[Hl _]". wp_store. iSplitR "HΦ"; last by iApply "HΦ". iModIntro. iNext. iExists false. by iFrame. Qed. End proof. (* NOT an instance because users should choose explicitly to use it (using [Explicit Instance]). *) Definition spin_lock : lock := {| lock.lockG := spin_lockG; lock.locked_exclusive _ _ _ _ := locked_exclusive; lock.is_lock_iff _ _ _ _ := is_lock_iff; lock.newlock_spec _ _ _ _ := newlock_spec; lock.acquire_spec _ _ _ _ := acquire_spec; lock.release_spec _ _ _ _ := release_spec |}. iris-iris-4.2.0/iris_heap_lang/lib/ticket_lock.v000066400000000000000000000147741460620107300216370ustar00rootroot00000000000000From iris.algebra Require Import excl auth gset. From iris.proofmode Require Import proofmode. From iris.program_logic Require Export weakestpre. From iris.heap_lang Require Export lang. From iris.heap_lang Require Import proofmode notation. From iris.heap_lang.lib Require Export lock. From iris.prelude Require Import options. Local Definition wait_loop: val := rec: "wait_loop" "x" "lk" := let: "o" := !(Fst "lk") in if: "x" = "o" then #() (* my turn *) else "wait_loop" "x" "lk". Local Definition newlock : val := λ: <>, ((* owner *) ref #0, (* next *) ref #0). Local Definition acquire : val := rec: "acquire" "lk" := let: "n" := !(Snd "lk") in if: CAS (Snd "lk") "n" ("n" + #1) then wait_loop "n" "lk" else "acquire" "lk". Local Definition release : val := λ: "lk", (Fst "lk") <- !(Fst "lk") + #1. (** The CMRAs we need. *) Class tlockG Σ := tlock_G : inG Σ (authR (prodUR (optionUR (exclR natO)) (gset_disjUR nat))). Local Existing Instance tlock_G. Definition tlockΣ : gFunctors := #[ GFunctor (authR (prodUR (optionUR (exclR natO)) (gset_disjUR nat))) ]. Global Instance subG_tlockΣ {Σ} : subG tlockΣ Σ → tlockG Σ. Proof. solve_inG. Qed. Section proof. Context `{!heapGS_gen hlc Σ, !tlockG Σ}. Let N := nroot .@ "ticket_lock". Local Definition lock_inv (γ : gname) (lo ln : loc) (R : iProp Σ) : iProp Σ := ∃ o n : nat, lo ↦ #o ∗ ln ↦ #n ∗ own γ (● (Excl' o, GSet (set_seq 0 n))) ∗ ((own γ (◯ (Excl' o, GSet ∅)) ∗ R) ∨ own γ (◯ (ε, GSet {[ o ]}))). Local Definition is_lock (γ : gname) (lk : val) (R : iProp Σ) : iProp Σ := ∃ lo ln : loc, ⌜lk = (#lo, #ln)%V⌝ ∗ inv N (lock_inv γ lo ln R). Local Definition issued (γ : gname) (x : nat) : iProp Σ := own γ (◯ (ε, GSet {[ x ]})). Local Definition locked (γ : gname) : iProp Σ := ∃ o, own γ (◯ (Excl' o, GSet ∅)). Local Lemma locked_exclusive (γ : gname) : locked γ -∗ locked γ -∗ False. Proof. iIntros "[%σ1 H1] [%σ2 H2]". iCombine "H1 H2" gives %[[] _]%auth_frag_op_valid_1. Qed. Local Lemma is_lock_iff γ lk R1 R2 : is_lock γ lk R1 -∗ ▷ □ (R1 ∗-∗ R2) -∗ is_lock γ lk R2. Proof. iDestruct 1 as (lo ln ->) "#Hinv"; iIntros "#HR". iExists lo, ln; iSplit; [done|]. iApply (inv_iff with "Hinv"). iIntros "!> !>"; iSplit; iIntros "(%o & %n & Ho & Hn & H● & H)"; iExists o, n; iFrame "Ho Hn H●"; (iDestruct "H" as "[[H◯ H]|H◯]"; [iLeft; iFrame "H◯"; by iApply "HR"|by iRight]). Qed. Local Lemma newlock_spec (R : iProp Σ) : {{{ R }}} newlock #() {{{ lk γ, RET lk; is_lock γ lk R }}}. Proof. iIntros (Φ) "HR HΦ". wp_lam. wp_alloc ln as "Hln". wp_alloc lo as "Hlo". iMod (own_alloc (● (Excl' 0, GSet ∅) ⋅ ◯ (Excl' 0, GSet ∅))) as (γ) "[Hγ Hγ']". { by apply auth_both_valid_discrete. } iMod (inv_alloc _ _ (lock_inv γ lo ln R) with "[-HΦ]"). { iNext. rewrite /lock_inv. iExists 0, 0. auto with iFrame. } wp_pures. iModIntro. iApply ("HΦ" $! (#lo, #ln)%V γ). iExists lo, ln. eauto. Qed. Local Lemma wait_loop_spec γ lk x R : {{{ is_lock γ lk R ∗ issued γ x }}} wait_loop #x lk {{{ RET #(); locked γ ∗ R }}}. Proof. iIntros (Φ) "[Hl Ht] HΦ". iDestruct "Hl" as (lo ln ->) "#Hinv". iLöb as "IH". wp_rec. subst. wp_pures. wp_bind (! _)%E. iInv N as (o n) "(Hlo & Hln & Ha)". wp_load. destruct (decide (x = o)) as [->|Hneq]. - iDestruct "Ha" as "[Hainv [[Ho HR] | Haown]]". + iModIntro. iFrame "Hlo Hln Hainv Ht". wp_pures. case_bool_decide; [|done]. wp_if. iApply ("HΦ" with "[-]"). rewrite /locked. iFrame. + iCombine "Ht Haown" gives %[_ ?%gset_disj_valid_op]%auth_frag_op_valid_1. set_solver. - iModIntro. iFrame "Hlo Hln Ha". wp_pures. case_bool_decide; [simplify_eq |]. wp_if. iApply ("IH" with "Ht"). iNext. by iExact "HΦ". Qed. Local Lemma acquire_spec γ lk R : {{{ is_lock γ lk R }}} acquire lk {{{ RET #(); locked γ ∗ R }}}. 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]]". wp_load. iModIntro. iFrame "Hlo Hln Ha". wp_pures. wp_bind (CmpXchg _ _ _). iInv N as (o' n') "(>Hlo' & >Hln' & >Hauth & Haown)". destruct (decide (#n' = #n))%V as [[= ->%Nat2Z.inj] | Hneq]. - 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 (set_seq_S_end_disjoint 0). } rewrite -(set_seq_S_end_union_L 0). wp_cmpxchg_suc. iModIntro. iSplitL "Hlo' Hln' Haown Hauth". { iNext. iExists o', (S n). rewrite Nat2Z.inj_succ -Z.add_1_r. by iFrame. } wp_pures. iApply (wait_loop_spec γ (#lo, #ln) with "[-HΦ]"). + rewrite /is_lock; eauto 10. + by iNext. - wp_cmpxchg_fail. iModIntro. iFrame "Hlo' Hln' Hauth Haown". wp_pures. by iApply "IH"; auto. Qed. Local Lemma release_spec γ lk R : {{{ is_lock γ lk R ∗ locked γ ∗ R }}} release lk {{{ RET #(); True }}}. Proof. iIntros (Φ) "(Hl & Hγ & HR) HΦ". iDestruct "Hl" as (lo ln ->) "#Hinv". iDestruct "Hγ" as (o) "Hγo". wp_lam. wp_proj. wp_bind (! _)%E. iInv N as (o' n) "(>Hlo & >Hln & >Hauth & Haown)". wp_load. iCombine "Hauth Hγo" gives %[[<-%Excl_included%leibniz_equiv _]%prod_included _]%auth_both_valid_discrete. iModIntro. iFrame. wp_pures. iInv N as (o' n') "(>Hlo & >Hln & >Hauth & Haown)". iApply wp_fupd. wp_store. iCombine "Hauth Hγo" gives %[[<-%Excl_included%leibniz_equiv _]%prod_included _]%auth_both_valid_discrete. iDestruct "Haown" as "[[Hγo' _]|Haown]". { iCombine "Hγo Hγo'" gives %[[] ?]%auth_frag_op_valid_1. } 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))). } iModIntro. iSplitR "HΦ"; last by iApply "HΦ". iIntros "!> !>". iExists (S o), n'. rewrite Nat2Z.inj_succ -Z.add_1_r. auto with iFrame. Qed. End proof. Definition ticket_lock : lock := {| lock.lockG := tlockG; lock.locked_exclusive _ _ _ _ := locked_exclusive; lock.is_lock_iff _ _ _ _ := is_lock_iff; lock.newlock_spec _ _ _ _ := newlock_spec; lock.acquire_spec _ _ _ _ := acquire_spec; lock.release_spec _ _ _ _ := release_spec |}. iris-iris-4.2.0/iris_heap_lang/locations.v000066400000000000000000000054061460620107300205610ustar00rootroot00000000000000From stdpp Require Import countable numbers gmap. From iris.prelude Require Export prelude. From iris.prelude Require Import options. Record loc := Loc { loc_car : Z }. Add Printing Constructor loc. Module Loc. Local Open Scope Z_scope. Lemma eq_spec l1 l2 : l1 = l2 ↔ loc_car l1 = loc_car l2. Proof. destruct l1, l2; naive_solver. Qed. Global Instance eq_dec : EqDecision loc. Proof. solve_decision. Defined. Global Instance inhabited : Inhabited loc := populate {|loc_car := 0 |}. Global Instance countable : Countable loc. Proof. by apply (inj_countable' loc_car Loc); intros []. Defined. Global Program Instance infinite : Infinite loc := inj_infinite (λ p, {| loc_car := p |}) (λ l, Some (loc_car l)) _. Next Obligation. done. Qed. Definition add (l : loc) (off : Z) : loc := {| loc_car := loc_car l + off|}. Definition le (l1 l2 : loc) : Prop := loc_car l1 ≤ loc_car l2. Definition lt (l1 l2 : loc) : Prop := loc_car l1 < loc_car l2. Module Import notations. Notation "l +ₗ off" := (add l off) (at level 50, left associativity) : stdpp_scope. Notation "l1 ≤ₗ l2" := (le l1 l2) (at level 70) : stdpp_scope. Notation "l1 <ₗ l2" := (lt l1 l2) (at level 70) : stdpp_scope. End notations. Lemma add_assoc l i j : l +ₗ i +ₗ j = l +ₗ (i + j). Proof. rewrite eq_spec /=. lia. Qed. Lemma add_0 l : l +ₗ 0 = l. Proof. rewrite eq_spec /=; lia. Qed. Global Instance add_inj l : Inj eq eq (add l). Proof. intros x1 x2. rewrite eq_spec /=. lia. Qed. Global Instance le_dec l1 l2 : Decision (l1 ≤ₗ l2). Proof. rewrite /le. apply _. Qed. Global Instance lt_dec l1 l2 : Decision (l1 <ₗ l2). Proof. rewrite /lt. apply _. Qed. Global Instance le_po : PartialOrder le. Proof. rewrite /le. split; [split|]. - by intros ?. - intros [x] [y] [z]; lia. - intros [x] [y] ??; f_equal/=; lia. Qed. Global Instance le_total : Total le. Proof. rewrite /Total /le. lia. Qed. Lemma le_ngt l1 l2 : l1 ≤ₗ l2 ↔ ¬l2 <ₗ l1. Proof. apply Z.le_ngt. Qed. Lemma le_lteq l1 l2 : l1 ≤ₗ l2 ↔ l1 <ₗ l2 ∨ l1 = l2. Proof. rewrite eq_spec. apply Z.le_lteq. Qed. Lemma add_le_mono l1 l2 i1 i2 : l1 ≤ₗ l2 → i1 ≤ i2 → l1 +ₗ i1 ≤ₗ l2 +ₗ i2. Proof. apply Z.add_le_mono. Qed. Definition fresh (ls : gset loc) : loc := {| loc_car := set_fold (λ k r, (1 + loc_car k) `max` r) 1 ls |}. Lemma fresh_fresh ls i : 0 ≤ i → fresh ls +ₗ i ∉ ls. Proof. intros Hi. cut (∀ l, l ∈ ls → loc_car l < loc_car (fresh ls) + i). { intros help Hf%help. simpl in *. lia. } apply (set_fold_ind_L (λ r ls, ∀ l, l ∈ ls → (loc_car l < r + i))); set_solver by eauto with lia. Qed. Global Opaque fresh. End Loc. Export Loc.notations. iris-iris-4.2.0/iris_heap_lang/metatheory.v000066400000000000000000000247621460620107300207550ustar00rootroot00000000000000From stdpp Require Import gmap stringmap. From iris.heap_lang Require Export lang. From iris.prelude Require Import options. (* This file contains some metatheory about the heap_lang language, which is not needed for verifying programs. *) (* Adding a binder to a set of identifiers. *) Local Definition set_binder_insert (x : binder) (X : stringset) : stringset := match x with | BAnon => X | BNamed f => {[f]} ∪ X end. (* Check if expression [e] is closed w.r.t. the set [X] of variable names, and that all the values in [e] are closed *) Fixpoint is_closed_expr (X : stringset) (e : expr) : bool := match e with | Val v => is_closed_val v | Var x => bool_decide (x ∈ X) | Rec f x e => is_closed_expr (set_binder_insert f (set_binder_insert x X)) e | UnOp _ e | Fst e | Snd e | InjL e | InjR e | Fork e | Free e | Load e => is_closed_expr X e | App e1 e2 | BinOp _ e1 e2 | Pair e1 e2 | AllocN e1 e2 | Store e1 e2 | Xchg e1 e2 | FAA e1 e2 => is_closed_expr X e1 && is_closed_expr X e2 | If e0 e1 e2 | Case e0 e1 e2 | CmpXchg e0 e1 e2 | Resolve e0 e1 e2 => is_closed_expr X e0 && is_closed_expr X e1 && is_closed_expr X e2 | NewProph => true end with is_closed_val (v : val) : bool := match v with | LitV _ => true | RecV f x e => is_closed_expr (set_binder_insert f (set_binder_insert x ∅)) e | PairV v1 v2 => is_closed_val v1 && is_closed_val v2 | InjLV v | InjRV v => is_closed_val v end. (* Parallel substitution *) Fixpoint subst_map (vs : gmap string val) (e : expr) : expr := match e with | Val _ => e | Var y => if vs !! y is Some v then Val v else Var y | Rec f y e => Rec f y (subst_map (binder_delete y (binder_delete f vs)) e) | App e1 e2 => App (subst_map vs e1) (subst_map vs e2) | UnOp op e => UnOp op (subst_map vs e) | BinOp op e1 e2 => BinOp op (subst_map vs e1) (subst_map vs e2) | If e0 e1 e2 => If (subst_map vs e0) (subst_map vs e1) (subst_map vs e2) | Pair e1 e2 => Pair (subst_map vs e1) (subst_map vs e2) | Fst e => Fst (subst_map vs e) | Snd e => Snd (subst_map vs e) | InjL e => InjL (subst_map vs e) | InjR e => InjR (subst_map vs e) | Case e0 e1 e2 => Case (subst_map vs e0) (subst_map vs e1) (subst_map vs e2) | Fork e => Fork (subst_map vs e) | AllocN e1 e2 => AllocN (subst_map vs e1) (subst_map vs e2) | Free e => Free (subst_map vs e) | Load e => Load (subst_map vs e) | Store e1 e2 => Store (subst_map vs e1) (subst_map vs e2) | Xchg e1 e2 => Xchg (subst_map vs e1) (subst_map vs e2) | CmpXchg e0 e1 e2 => CmpXchg (subst_map vs e0) (subst_map vs e1) (subst_map vs e2) | FAA e1 e2 => FAA (subst_map vs e1) (subst_map vs e2) | NewProph => NewProph | Resolve e0 e1 e2 => Resolve (subst_map vs e0) (subst_map vs e1) (subst_map vs e2) end. (* Properties *) Local Instance set_unfold_elem_of_insert_binder x y X Q : SetUnfoldElemOf y X Q → SetUnfoldElemOf y (set_binder_insert x X) (Q ∨ BNamed y = x). Proof. destruct 1; constructor; destruct x; set_solver. Qed. Lemma is_closed_weaken X Y e : is_closed_expr X e → X ⊆ Y → is_closed_expr Y e. Proof. revert X Y; induction e; naive_solver (eauto; set_solver). Qed. Lemma is_closed_weaken_empty X e : is_closed_expr ∅ e → is_closed_expr X e. Proof. intros. by apply is_closed_weaken with ∅, empty_subseteq. Qed. Lemma is_closed_subst X e y v : is_closed_val v → is_closed_expr ({[y]} ∪ X) e → is_closed_expr X (subst y v e). Proof. intros Hv. revert X. induction e=> X /= ?; destruct_and?; split_and?; simplify_option_eq; try match goal with | H : ¬(_ ∧ _) |- _ => apply not_and_l in H as [?%dec_stable|?%dec_stable] end; eauto using is_closed_weaken with set_solver. Qed. Lemma is_closed_subst' X e x v : is_closed_val v → is_closed_expr (set_binder_insert x X) e → is_closed_expr X (subst' x v e). Proof. destruct x; eauto using is_closed_subst. Qed. Lemma subst_is_closed X e x es : is_closed_expr X e → x ∉ X → subst x es e = e. Proof. revert X. induction e=> X /=; rewrite ?bool_decide_spec ?andb_True=> ??; repeat case_decide; simplify_eq/=; f_equal; intuition eauto with set_solver. Qed. Lemma subst_is_closed_empty e x v : is_closed_expr ∅ e → subst x v e = e. Proof. intros. apply subst_is_closed with (∅:stringset); set_solver. Qed. Lemma subst_subst e x v v' : subst x v (subst x v' e) = subst x v' e. Proof. intros. induction e; simpl; try (f_equal; by auto); simplify_option_eq; auto using subst_is_closed_empty with f_equal. Qed. Lemma subst_subst' e x v v' : subst' x v (subst' x v' e) = subst' x v' e. Proof. destruct x; simpl; auto using subst_subst. Qed. Lemma subst_subst_ne e x y v v' : x ≠ y → subst x v (subst y v' e) = subst y v' (subst x v e). Proof. intros. induction e; simpl; try (f_equal; by auto); simplify_option_eq; auto using eq_sym, subst_is_closed_empty with f_equal. Qed. Lemma subst_subst_ne' e x y v v' : x ≠ y → subst' x v (subst' y v' e) = subst' y v' (subst' x v e). Proof. destruct x, y; simpl; auto using subst_subst_ne with congruence. Qed. Lemma subst_rec' f y e x v : x = f ∨ x = y ∨ x = BAnon → subst' x v (Rec f y e) = Rec f y e. Proof. intros. destruct x; simplify_option_eq; naive_solver. Qed. Lemma subst_rec_ne' f y e x v : (x ≠ f ∨ f = BAnon) → (x ≠ y ∨ y = BAnon) → subst' x v (Rec f y e) = Rec f y (subst' x v e). Proof. intros. destruct x; simplify_option_eq; naive_solver. Qed. Lemma bin_op_eval_closed op v1 v2 v' : is_closed_val v1 → is_closed_val v2 → bin_op_eval op v1 v2 = Some v' → is_closed_val v'. Proof. rewrite /bin_op_eval /bin_op_eval_bool /bin_op_eval_int /bin_op_eval_loc; repeat case_match; by naive_solver. Qed. Lemma heap_closed_alloc σ l n w : (0 < n)%Z → is_closed_val w → map_Forall (λ _ v, from_option is_closed_val true v) (heap σ) → (∀ i : Z, (0 ≤ i)%Z → (i < n)%Z → heap σ !! (l +ₗ i) = None) → map_Forall (λ _ v, from_option is_closed_val true v) (heap_array l (replicate (Z.to_nat n) w) ∪ heap σ). Proof. intros Hn Hw Hσ Hl. eapply (map_Forall_ind (λ k v, ((heap_array l (replicate (Z.to_nat n) w) ∪ heap σ) !! k = Some v))). - apply map_Forall_empty. - intros m i x Hi Hix Hkwm Hm. apply map_Forall_insert_2; auto. apply lookup_union_Some in Hix; last first. { eapply heap_array_map_disjoint; rewrite replicate_length Z2Nat.id; auto with lia. } destruct Hix as [(?&?&?&?&?&[-> Hlt%inj_lt]%lookup_replicate_1)%heap_array_lookup| [j Hj]%elem_of_map_to_list%elem_of_list_lookup_1]. + simplify_eq/=. rewrite !Z2Nat.id in Hlt; eauto with lia. + apply map_Forall_to_list in Hσ. by eapply Forall_lookup in Hσ; eauto; simpl in *. - apply map_Forall_to_list, Forall_forall. intros [? ?]; apply elem_of_map_to_list. Qed. (* The stepping relation preserves closedness *) Lemma base_step_is_closed e1 σ1 obs e2 σ2 es : is_closed_expr ∅ e1 → map_Forall (λ _ v, from_option is_closed_val true v) σ1.(heap) → base_step e1 σ1 obs e2 σ2 es → is_closed_expr ∅ e2 ∧ Forall (is_closed_expr ∅) es ∧ map_Forall (λ _ v, from_option is_closed_val true v) σ2.(heap). Proof. intros Cl1 Clσ1 STEP. induction STEP; simpl in *; split_and!; try apply map_Forall_insert_2; try by naive_solver. - subst. repeat apply is_closed_subst'; naive_solver. - unfold un_op_eval in *. repeat case_match; naive_solver. - eapply bin_op_eval_closed; eauto; naive_solver. - by apply heap_closed_alloc. - select (_ !! _ = Some _) ltac:(fun H => by specialize (Clσ1 _ _ H)). - select (_ !! _ = Some _) ltac:(fun H => by specialize (Clσ1 _ _ H)). - select (_ !! _ = Some _) ltac:(fun H => by specialize (Clσ1 _ _ H)). - case_match; try apply map_Forall_insert_2; by naive_solver. Qed. Lemma subst_map_empty e : subst_map ∅ e = e. Proof. assert (∀ x, binder_delete x (∅:gmap string val) = ∅) as Hdel. { intros [|x]; by rewrite /= ?delete_empty. } induction e; simplify_map_eq; rewrite ?Hdel; auto with f_equal. Qed. Lemma subst_map_insert x v vs e : subst_map (<[x:=v]>vs) e = subst x v (subst_map (delete x vs) e). Proof. revert vs. induction e=> vs; simplify_map_eq; auto with f_equal. - match goal with | |- context [ <[?x:=_]> _ !! ?y ] => destruct (decide (x = y)); simplify_map_eq=> // end. by case (vs !! _); simplify_option_eq. - destruct (decide _) as [[??]|[<-%dec_stable|[<-%dec_stable ?]]%not_and_l_alt]. + rewrite !binder_delete_insert // !binder_delete_delete; eauto with f_equal. + by rewrite /= delete_insert_delete delete_idemp. + by rewrite /= binder_delete_insert // delete_insert_delete !binder_delete_delete delete_idemp. Qed. Lemma subst_map_singleton x v e : subst_map {[x:=v]} e = subst x v e. Proof. by rewrite subst_map_insert delete_empty subst_map_empty. Qed. Lemma subst_map_binder_insert b v vs e : subst_map (binder_insert b v vs) e = subst' b v (subst_map (binder_delete b vs) e). Proof. destruct b; rewrite ?subst_map_insert //. Qed. Lemma subst_map_binder_insert_empty b v e : subst_map (binder_insert b v ∅) e = subst' b v e. Proof. by rewrite subst_map_binder_insert binder_delete_empty subst_map_empty. Qed. Lemma subst_map_binder_insert_2 b1 v1 b2 v2 vs e : subst_map (binder_insert b1 v1 (binder_insert b2 v2 vs)) e = subst' b2 v2 (subst' b1 v1 (subst_map (binder_delete b2 (binder_delete b1 vs)) e)). Proof. destruct b1 as [|s1], b2 as [|s2]=> /=; auto using subst_map_insert. rewrite subst_map_insert. destruct (decide (s1 = s2)) as [->|]. - by rewrite delete_idemp subst_subst delete_insert_delete. - by rewrite delete_insert_ne // subst_map_insert subst_subst_ne. Qed. Lemma subst_map_binder_insert_2_empty b1 v1 b2 v2 e : subst_map (binder_insert b1 v1 (binder_insert b2 v2 ∅)) e = subst' b2 v2 (subst' b1 v1 e). Proof. by rewrite subst_map_binder_insert_2 !binder_delete_empty subst_map_empty. Qed. Lemma subst_map_is_closed X e vs : is_closed_expr X e → (∀ x, x ∈ X → vs !! x = None) → subst_map vs e = e. Proof. revert X vs. assert (∀ x x1 x2 X (vs : gmap string val), (∀ x, x ∈ X → vs !! x = None) → x ∈ set_binder_insert x2 (set_binder_insert x1 X) → binder_delete x1 (binder_delete x2 vs) !! x = None). { intros x x1 x2 X vs ??. rewrite !lookup_binder_delete_None. set_solver. } induction e=> X vs /= ? HX; repeat case_match; naive_solver eauto with f_equal. Qed. Lemma subst_map_is_closed_empty e vs : is_closed_expr ∅ e → subst_map vs e = e. Proof. intros. apply subst_map_is_closed with (∅ : stringset); set_solver. Qed. iris-iris-4.2.0/iris_heap_lang/notation.v000066400000000000000000000167671460620107300204350ustar00rootroot00000000000000From iris.program_logic Require Import language. From iris.heap_lang Require Export lang. From iris.prelude Require Import options. (** Coercions to make programs easier to type. *) Coercion LitInt : Z >-> base_lit. Coercion LitBool : bool >-> base_lit. Coercion LitLoc : loc >-> base_lit. Coercion LitProphecy : proph_id >-> base_lit. Coercion App : expr >-> Funclass. Coercion Val : val >-> expr. Coercion Var : string >-> expr. (** 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). Notation LamV x e := (RecV BAnon x e) (only parsing). Notation LetCtx x e2 := (AppRCtx (LamV x e2)) (only parsing). Notation SeqCtx e2 := (LetCtx BAnon e2) (only parsing). Notation Match e0 x1 e1 x2 e2 := (Case e0 (Lam x1 e1) (Lam x2 e2)) (only parsing). Notation Alloc e := (AllocN (Val $ LitV $ LitInt 1) e) (only parsing). (** Compare-and-set (CAS) returns just a boolean indicating success or failure. *) Notation CAS l e1 e2 := (Snd (CmpXchg l e1 e2)) (only parsing). (* Skip should be atomic, we sometimes open invariants around it. Hence, we need to explicitly use LamV instead of e.g., Seq. *) Notation Skip := (App (Val $ LamV BAnon (Val $ LitV LitUnit)) (Val $ LitV LitUnit)). (* No scope for the values, does not conflict and scope is often not inferred properly. *) Notation "# l" := (LitV l%Z%V%stdpp) (at level 8, format "# l"). (** Syntax inspired by Coq/Ocaml. Constructions with higher precedence come first. *) Notation "( e1 , e2 , .. , en )" := (Pair .. (Pair e1 e2) .. en) : expr_scope. Notation "( e1 , e2 , .. , en )" := (PairV .. (PairV e1 e2) .. en) : val_scope. (* Using the '[hv' ']' printing box, we make sure that when the notation for match does not fit on a single line, line breaks will be inserted for *each* breaking point '/'. Note that after each breaking point /, one can put n spaces (for example '/ '). That way, when the breaking point is turned into a line break, indentation of n spaces will appear after the line break. As such, when the match does not fit on one line, it will print it like: match: e0 with InjL x1 => e1 | InjR x2 => e2 end Moreover, if the branches do not fit on a single line, it will be printed as: match: e0 with InjL x1 => lots of stuff bla bla bla bla bla bla bla bla | InjR x2 => even more stuff bla bla bla bla bla bla bla bla end *) Notation "'match:' e0 'with' 'InjL' x1 => e1 | 'InjR' x2 => e2 'end'" := (Match e0 x1%binder e1 x2%binder e2) (e0, x1, e1, x2, e2 at level 200, format "'[hv' 'match:' e0 'with' '/ ' '[' 'InjL' x1 => '/ ' e1 ']' '/' '[' | 'InjR' x2 => '/ ' e2 ']' '/' 'end' ']'") : expr_scope. Notation "'match:' e0 'with' 'InjR' x1 => e1 | 'InjL' x2 => e2 'end'" := (Match e0 x2%binder e2 x1%binder e1) (e0, x1, e1, x2, e2 at level 200, only parsing) : expr_scope. Notation "()" := LitUnit : val_scope. Notation "! e" := (Load e%E) (at level 9, right associativity) : expr_scope. Notation "'ref' e" := (Alloc e%E) (at level 10) : expr_scope. Notation "- e" := (UnOp MinusUnOp e%E) : expr_scope. Notation "e1 + e2" := (BinOp PlusOp e1%E e2%E) : expr_scope. Notation "e1 +ₗ e2" := (BinOp OffsetOp e1%E e2%E) : expr_scope. Notation "e1 - e2" := (BinOp MinusOp e1%E e2%E) : expr_scope. Notation "e1 * e2" := (BinOp MultOp e1%E e2%E) : expr_scope. Notation "e1 `quot` e2" := (BinOp QuotOp e1%E e2%E) : expr_scope. Notation "e1 `rem` e2" := (BinOp RemOp e1%E e2%E) : expr_scope. Notation "e1 ≪ e2" := (BinOp ShiftLOp e1%E e2%E) : expr_scope. Notation "e1 ≫ e2" := (BinOp ShiftROp e1%E e2%E) : expr_scope. Notation "e1 ≤ e2" := (BinOp LeOp e1%E e2%E) : expr_scope. Notation "e1 < e2" := (BinOp LtOp e1%E e2%E) : expr_scope. Notation "e1 = e2" := (BinOp EqOp e1%E e2%E) : expr_scope. Notation "e1 ≠ e2" := (UnOp NegOp (BinOp EqOp e1%E e2%E)) : expr_scope. Notation "~ e" := (UnOp NegOp e%E) (at level 75, right associativity) : expr_scope. (* The unicode ← is already part of the notation "_ ← _; _" for bind. *) Notation "e1 <- e2" := (Store e1%E e2%E) (at level 80) : expr_scope. (* The breaking point '/ ' makes sure that the body of the rec is indented by two spaces in case the whole rec does not fit on a single line. *) Notation "'rec:' f x := e" := (Rec f%binder x%binder e%E) (at level 200, f at level 1, x at level 1, e at level 200, format "'[' 'rec:' f x := '/ ' e ']'") : expr_scope. Notation "'rec:' f x := e" := (RecV f%binder x%binder e%E) (at level 200, f at level 1, x at level 1, e at level 200, format "'[' 'rec:' f x := '/ ' e ']'") : val_scope. Notation "'if:' e1 'then' e2 'else' e3" := (If e1%E e2%E e3%E) (at level 200, e1, e2, e3 at level 200) : expr_scope. (** Derived notions, in order of declaration. The notations for let and seq are stated explicitly instead of relying on the Notations Let and Seq as defined above. This is needed because App is now a coercion, and these notations are otherwise not pretty printed back accordingly. *) Notation "'rec:' f x y .. z := e" := (Rec f%binder x%binder (Lam y%binder .. (Lam z%binder e%E) ..)) (at level 200, f, x, y, z at level 1, e at level 200, format "'[' 'rec:' f x y .. z := '/ ' e ']'") : expr_scope. Notation "'rec:' f x y .. z := e" := (RecV f%binder x%binder (Lam y%binder .. (Lam z%binder e%E) ..)) (at level 200, f, x, y, z at level 1, e at level 200, format "'[' 'rec:' f x y .. z := '/ ' e ']'") : val_scope. (* The breaking point '/ ' makes sure that the body of the λ: is indented by two spaces in case the whole λ: does not fit on a single line. *) Notation "λ: x , e" := (Lam x%binder e%E) (at level 200, x at level 1, e at level 200, format "'[' 'λ:' x , '/ ' e ']'") : expr_scope. Notation "λ: x y .. z , e" := (Lam x%binder (Lam y%binder .. (Lam z%binder e%E) ..)) (at level 200, x, y, z at level 1, e at level 200, format "'[' 'λ:' x y .. z , '/ ' e ']'") : expr_scope. Notation "λ: x , e" := (LamV x%binder e%E) (at level 200, x at level 1, e at level 200, format "'[' 'λ:' x , '/ ' e ']'") : val_scope. Notation "λ: x y .. z , e" := (LamV x%binder (Lam y%binder .. (Lam z%binder e%E) .. )) (at level 200, x, y, z at level 1, e at level 200, format "'[' 'λ:' x y .. z , '/ ' e ']'") : val_scope. Notation "'let:' x := e1 'in' e2" := (Lam x%binder e2%E e1%E) (at level 200, x at level 1, e1, e2 at level 200, format "'[' 'let:' x := '[' e1 ']' 'in' '/' e2 ']'") : expr_scope. Notation "e1 ;; e2" := (Lam BAnon e2%E e1%E) (at level 100, e2 at level 200, format "'[' '[hv' '[' e1 ']' ;; ']' '/' e2 ']'") : expr_scope. (* Shortcircuit Boolean connectives *) Notation "e1 && e2" := (If e1%E e2%E (LitV (LitBool false))) (only parsing) : expr_scope. Notation "e1 || e2" := (If e1%E (LitV (LitBool true)) e2%E) (only parsing) : expr_scope. (** Notations for option *) Notation NONE := (InjL (LitV LitUnit)) (only parsing). Notation NONEV := (InjLV (LitV LitUnit)) (only parsing). Notation SOME x := (InjR x) (only parsing). Notation SOMEV x := (InjRV x) (only parsing). Notation "'match:' e0 'with' 'NONE' => e1 | 'SOME' x => e2 'end'" := (Match e0 BAnon e1 x%binder e2) (e0, e1, x, e2 at level 200, only parsing) : expr_scope. Notation "'match:' e0 'with' 'SOME' x => e2 | 'NONE' => e1 'end'" := (Match e0 BAnon e1 x%binder e2) (e0, e1, x, e2 at level 200, only parsing) : expr_scope. Notation ResolveProph e1 e2 := (Resolve Skip e1 e2) (only parsing). Notation "'resolve_proph:' p 'to:' v" := (ResolveProph p v) (at level 100) : expr_scope. iris-iris-4.2.0/iris_heap_lang/pretty.v000066400000000000000000000034501460620107300201120ustar00rootroot00000000000000From stdpp Require Export pretty. From iris.heap_lang Require Import lang. From iris.prelude Require Import options. (** * Pretty printing for HeapLang values *) Global Instance pretty_loc : Pretty loc := λ l, pretty l.(loc_car). Global Instance pretty_base_lit : Pretty base_lit := λ l, match l with | LitInt z => pretty z | LitBool b => if b then "true" else "false" | LitUnit => "()" | LitPoison => "" | LitLoc l => "(loc " +:+ pretty l +:+ ")" | LitProphecy i => "(prophecy " +:+ pretty i +:+ ")" end. Global Instance pretty_binder : Pretty binder := λ b, match b with | BNamed x => x | BAnon => "<>" end. (** Note that this instance does not print function bodies and is thus not injective (unlike most `pretty` instances). *) Global Instance pretty_val : Pretty val := fix go v := match v with | LitV l => "#" +:+ pretty l | RecV f x e => match f with | BNamed f => "rec: " +:+ f +:+ " " +:+ pretty x +:+ " := " | BAnon => "λ: " +:+ pretty x +:+ ", " end | PairV v1 v2 => "(" +:+ go v1 +:+ ", " +:+ go v2 +:+ ")" | InjLV v => "inl (" +:+ go v +:+ ")" | InjRV v => "inr (" +:+ go v +:+ ")" end. Global Instance pretty_un_op : Pretty un_op := λ op, match op with | NegOp => "~" | MinusUnOp => "-" end. Global Instance pretty_bin_op : Pretty bin_op := λ op, match op with | PlusOp => "+" | MinusOp => "-" | MultOp => "*" | QuotOp => "`quot`" | RemOp => "`rem`" | AndOp => "&" | OrOp => "|" | XorOp => "`xor`" | ShiftLOp => "<<" | ShiftROp => ">>" | LeOp => "≤" | LtOp => "<" | EqOp => "=" | OffsetOp => "+ₗ" end. iris-iris-4.2.0/iris_heap_lang/primitive_laws.v000066400000000000000000000725521460620107300216320ustar00rootroot00000000000000(** This file proves the basic laws of the HeapLang program logic by applying the Iris lifting lemmas. *) From iris.proofmode Require Import proofmode. From iris.bi.lib Require Import fractional. From iris.base_logic.lib Require Import mono_nat. From iris.base_logic.lib Require Export gen_heap proph_map gen_inv_heap. From iris.program_logic Require Export weakestpre total_weakestpre. From iris.program_logic Require Import ectx_lifting total_ectx_lifting. From iris.heap_lang Require Export class_instances. From iris.heap_lang Require Import tactics notation. From iris.prelude Require Import options. Class heapGS_gen hlc Σ := HeapGS { heapGS_invGS : invGS_gen hlc Σ; #[global] heapGS_gen_heapGS :: gen_heapGS loc (option val) Σ; #[global] heapGS_inv_heapGS :: inv_heapGS loc (option val) Σ; #[global] heapGS_proph_mapGS :: proph_mapGS proph_id (val * val) Σ; heapGS_step_name : gname; heapGS_step_cnt : mono_natG Σ; }. Local Existing Instance heapGS_step_cnt. Notation heapGS := (heapGS_gen HasLc). Section steps. Context `{!heapGS_gen hlc Σ}. Local Definition steps_auth (n : nat) : iProp Σ := mono_nat_auth_own heapGS_step_name 1 n. Definition steps_lb (n : nat) : iProp Σ := mono_nat_lb_own heapGS_step_name n. Lemma steps_lb_0 : ⊢ |==> steps_lb 0. Proof. by apply mono_nat_lb_own_0. Qed. Local Lemma steps_lb_valid n m : steps_auth n -∗ steps_lb m -∗ ⌜m ≤ n⌝. Proof. iIntros "Hauth Hlb". by iDestruct (mono_nat_lb_own_valid with "Hauth Hlb") as %[_ Hle]. Qed. Local Lemma steps_lb_get n : steps_auth n -∗ steps_lb n. Proof. apply mono_nat_lb_own_get. Qed. Local Lemma steps_auth_update n n' : n ≤ n' → steps_auth n ==∗ steps_auth n' ∗ steps_lb n'. Proof. intros Hle. by apply mono_nat_own_update. Qed. Local Lemma steps_auth_update_S n : steps_auth n ==∗ steps_auth (S n). Proof. iIntros "Hauth". iMod (mono_nat_own_update with "Hauth") as "[$ _]"; [lia|done]. Qed. Lemma steps_lb_le n n' : n' ≤ n → steps_lb n -∗ steps_lb n'. Proof. intros Hle. by iApply mono_nat_lb_own_le. Qed. End steps. Global Program Instance heapGS_irisGS `{!heapGS_gen hlc Σ} : irisGS_gen hlc heap_lang Σ := { iris_invGS := heapGS_invGS; state_interp σ step_cnt κs _ := (gen_heap_interp σ.(heap) ∗ proph_map_interp κs σ.(used_proph_id) ∗ steps_auth step_cnt)%I; fork_post _ := True%I; num_laters_per_step n := n; }. Next Obligation. iIntros (??? σ ns κs nt) "/= ($ & $ & H)". by iMod (steps_auth_update_S with "H") as "$". Qed. (** Since we use an [option val] instance of [gen_heap], we need to overwrite the notations. That also helps for scopes and coercions. *) Notation "l ↦ dq v" := (pointsto (L:=loc) (V:=option val) l dq (Some v%V)) (at level 20, dq custom dfrac at level 1, format "l ↦ dq v") : bi_scope. (** Same for [gen_inv_heap], except that these are higher-order notations so to make setoid rewriting in the predicate [I] work we need actual definitions here. *) Section definitions. Context `{!heapGS_gen hlc Σ}. Definition inv_pointsto_own (l : loc) (v : val) (I : val → Prop) : iProp Σ := inv_pointsto_own l (Some v) (from_option I False). Definition inv_pointsto (l : loc) (I : val → Prop) : iProp Σ := inv_pointsto l (from_option I False). End definitions. Global Instance: Params (@inv_pointsto_own) 4 := {}. Global Instance: Params (@inv_pointsto) 3 := {}. Notation inv_heap_inv := (inv_heap_inv loc (option val)). Notation "l '↦_' I □" := (inv_pointsto l I%stdpp%type) (at level 20, I at level 9, format "l '↦_' I '□'") : bi_scope. Notation "l ↦_ I v" := (inv_pointsto_own l v I%stdpp%type) (at level 20, I at level 9, format "l ↦_ I v") : bi_scope. Section lifting. Context `{!heapGS_gen hlc Σ}. Implicit Types P Q : iProp Σ. Implicit Types Φ Ψ : val → iProp Σ. Implicit Types efs : list expr. Implicit Types σ : state. Implicit Types v : val. Implicit Types l : loc. Lemma wp_lb_update s n E e Φ : TCEq (to_val e) None → steps_lb n -∗ WP e @ s; E {{ v, steps_lb (S n) -∗ Φ v }} -∗ WP e @ s; E {{ Φ }}. Proof. (** TODO: We should try to use a generic lifting lemma (and avoid [wp_unfold]) here, since this breaks the WP abstraction. *) rewrite !wp_unfold /wp_pre /=. iIntros (->) "Hlb Hwp". iIntros (σ1 ns κ κs m) "(Hσ & Hκ & Hsteps)". iDestruct (steps_lb_valid with "Hsteps Hlb") as %?. iMod ("Hwp" $! σ1 ns κ κs m with "[$Hσ $Hκ $Hsteps]") as "[%Hs Hwp]". iModIntro. iSplit; [done|]. iIntros (e2 σ2 efs Hstep) "Hcred". iMod ("Hwp" with "[//] Hcred") as "Hwp". iIntros "!> !>". iMod "Hwp" as "Hwp". iIntros "!>". iApply (step_fupdN_wand with "Hwp"). iIntros "Hwp". iMod "Hwp" as "(($ & $ & Hsteps)& Hwp & $)". iDestruct (steps_lb_get with "Hsteps") as "#HlbS". iDestruct (steps_lb_le _ (S n) with "HlbS") as "#HlbS'"; [lia|]. iModIntro. iFrame "Hsteps". iApply (wp_wand with "Hwp"). iIntros (v) "HΦ". by iApply "HΦ". Qed. (** A stronger version of [twp_wp_step] to turn a TWP into a WP. Provided [steps_lb n], this version gives us [S n] laters ([twp_wp_step] gives just one) and [S n] later credits ([twp_wp_step] gives none). *) Lemma twp_wp_step_lc s n E e P Φ : TCEq (to_val e) None → steps_lb n -∗ ▷^(S n) P -∗ WP e @ s; E [{ v, P -∗ £ (S n) ={E}=∗ Φ v }] -∗ WP e @ s; E {{ Φ }}. Proof. iIntros (?) "#Hlb HP Hwp". iApply (twp_wp_fupdN_strong (S n) _ _ _ _ (P ∗ £ (S n))); [done|]. iSplit. - iIntros (σ ns κ m) "(Hσ & Hκ & Hsteps)". iDestruct (steps_lb_valid with "[$] [$]") as %?. iApply fupd_mask_intro_discard; [set_solver|]. iPureIntro. rewrite /num_laters_per_step /=. lia. - iSplitL "HP". + iIntros "!> ?". iApply step_fupdN_intro; [done|]. iIntros "!> !>". by iFrame. + iApply (twp_wand with "Hwp"). iIntros (v) "H [??]". by iApply ("H" with "[$]"). Qed. (** A version of [twp_wp_step_lc] that provides only a single later modality (but still [S n] later credits). This version is tailored to lift total Texan triples to a partial Texan triples with later credits, see e.g., [wp_alloc_lc] below. *) Lemma twp_wp_step_lc_texan s n E e P Φ : TCEq (to_val e) None → steps_lb n -∗ ▷ P -∗ WP e @ s; E [{ v, P -∗ £ (S n) ={E}=∗ Φ v }] -∗ WP e @ s; E {{ Φ }}. Proof. iIntros (?) "#Hlb HP Hwp". iApply (twp_wp_step_lc with "[$] [HP] Hwp"); auto. Qed. Lemma wp_step_fupdN_lb s n E1 E2 e P Φ : TCEq (to_val e) None → E2 ⊆ E1 → steps_lb n -∗ (|={E1∖E2,∅}=> |={∅}▷=>^(S n) |={∅,E1∖E2}=> P) -∗ WP e @ s; E2 {{ v, P ={E1}=∗ Φ v }} -∗ WP e @ s; E1 {{ Φ }}. Proof. iIntros (He HE) "Hlb HP Hwp". iApply wp_step_fupdN; [done|]. iSplit; [|by iFrame]. iIntros (σ ns κs nt) "(? & ? & Hsteps)". iDestruct (steps_lb_valid with "Hsteps Hlb") as %Hle. iApply fupd_mask_intro; [set_solver|]. iIntros "_". iPureIntro. rewrite /num_laters_per_step /=. lia. Qed. (** Recursive functions: we do not use this lemmas as it is easier to use Löb induction directly, but this demonstrates that we can state the expected reasoning principle for recursive functions, without any visible ▷. *) Lemma wp_rec_löb s E f x e Φ Ψ : □ ( □ (∀ v, Ψ v -∗ WP (rec: f x := e)%V v @ s; E {{ Φ }}) -∗ ∀ v, Ψ v -∗ WP (subst' x v (subst' f (rec: f x := e) e)) @ s; E {{ Φ }}) -∗ ∀ v, Ψ v -∗ WP (rec: f x := e)%V v @ s; E {{ Φ }}. Proof. iIntros "#Hrec". iLöb as "IH". iIntros (v) "HΨ". iApply lifting.wp_pure_step_later; first done. iIntros "!> _". iApply ("Hrec" with "[] HΨ"). iIntros "!>" (w) "HΨ". iApply ("IH" with "HΨ"). Qed. (** Fork: Not using Texan triples to avoid some unnecessary [True] *) Lemma wp_fork s E e Φ : ▷ WP e @ s; ⊤ {{ _, True }} -∗ ▷ Φ (LitV LitUnit) -∗ WP Fork e @ s; E {{ Φ }}. Proof. iIntros "He HΦ". iApply wp_lift_atomic_base_step; [done|]. iIntros (σ1 ns κ κs nt) "(?&?&Hsteps) !>"; iSplit; first by eauto with base_step. iIntros "!>" (v2 σ2 efs Hstep) "_"; inv_base_step. iMod (steps_auth_update_S with "Hsteps") as "Hsteps". by iFrame. Qed. Lemma twp_fork s E e Φ : WP e @ s; ⊤ [{ _, True }] -∗ Φ (LitV LitUnit) -∗ WP Fork e @ s; E [{ Φ }]. Proof. iIntros "He HΦ". iApply twp_lift_atomic_base_step; [done|]. iIntros (σ1 ns κs nt) "(?&?&Hsteps) !>"; iSplit; first by eauto with base_step. iIntros (κ v2 σ2 efs Hstep); inv_base_step. iMod (steps_auth_update_S with "Hsteps") as "Hsteps". by iFrame. Qed. (** Heap *) (** We need to adjust the [gen_heap] and [gen_inv_heap] lemmas because of our value type being [option val]. *) Lemma pointsto_valid l dq v : l ↦{dq} v -∗ ⌜✓ dq⌝. Proof. apply pointsto_valid. Qed. Lemma pointsto_valid_2 l dq1 dq2 v1 v2 : l ↦{dq1} v1 -∗ l ↦{dq2} v2 -∗ ⌜✓ (dq1 ⋅ dq2) ∧ v1 = v2⌝. Proof. iIntros "H1 H2". iCombine "H1 H2" gives %[? [= ?]]. done. Qed. Lemma pointsto_agree l dq1 dq2 v1 v2 : l ↦{dq1} v1 -∗ l ↦{dq2} v2 -∗ ⌜v1 = v2⌝. Proof. iIntros "H1 H2". iCombine "H1 H2" gives %[_ [= ?]]. done. Qed. Global Instance pointsto_combine_sep_gives l dq1 dq2 v1 v2 : CombineSepGives (l ↦{dq1} v1) (l ↦{dq2} v2) ⌜✓ (dq1 ⋅ dq2) ∧ v1 = v2⌝ | 20. (* We provide an instance with lower cost than the gen_heap instance to avoid having to deal with Some v1 = Some v2 *) Proof. rewrite /CombineSepGives. iIntros "[H1 H2]". iCombine "H1 H2" gives %[? [=->]]. eauto. Qed. Lemma pointsto_combine l dq1 dq2 v1 v2 : l ↦{dq1} v1 -∗ l ↦{dq2} v2 -∗ l ↦{dq1 ⋅ dq2} v1 ∗ ⌜v1 = v2⌝. Proof. iIntros "Hl1 Hl2". by iCombine "Hl1 Hl2" as "$" gives %[_ ->]. Qed. Lemma pointsto_frac_ne l1 l2 dq1 dq2 v1 v2 : ¬ ✓(dq1 ⋅ dq2) → l1 ↦{dq1} v1 -∗ l2 ↦{dq2} v2 -∗ ⌜l1 ≠ l2⌝. Proof. apply pointsto_frac_ne. Qed. Lemma pointsto_ne l1 l2 dq2 v1 v2 : l1 ↦ v1 -∗ l2 ↦{dq2} v2 -∗ ⌜l1 ≠ l2⌝. Proof. apply pointsto_ne. Qed. Lemma pointsto_persist l dq v : l ↦{dq} v ==∗ l ↦□ v. Proof. apply pointsto_persist. Qed. Lemma pointsto_unpersist l v : l ↦□ v ==∗ ∃ q, l ↦{#q} v. Proof. apply pointsto_unpersist. Qed. Global Instance inv_pointsto_own_proper l v : Proper (pointwise_relation _ iff ==> (≡)) (inv_pointsto_own l v). Proof. intros I1 I2 HI. rewrite /inv_pointsto_own. f_equiv=>-[w|]; last done. simpl. apply HI. Qed. Global Instance inv_pointsto_proper l : Proper (pointwise_relation _ iff ==> (≡)) (inv_pointsto l). Proof. intros I1 I2 HI. rewrite /inv_pointsto. f_equiv=>-[w|]; last done. simpl. apply HI. Qed. Lemma make_inv_pointsto l v (I : val → Prop) E : ↑inv_heapN ⊆ E → I v → inv_heap_inv -∗ l ↦ v ={E}=∗ l ↦_I v. Proof. iIntros (??) "#HI Hl". iApply make_inv_pointsto; done. Qed. Lemma inv_pointsto_own_inv l v I : l ↦_I v -∗ l ↦_I □. Proof. apply inv_pointsto_own_inv. Qed. Lemma inv_pointsto_own_acc_strong E : ↑inv_heapN ⊆ E → inv_heap_inv ={E, E ∖ ↑inv_heapN}=∗ ∀ l v I, l ↦_I v -∗ (⌜I v⌝ ∗ l ↦ v ∗ (∀ w, ⌜I w ⌝ -∗ l ↦ w ==∗ inv_pointsto_own l w I ∗ |={E ∖ ↑inv_heapN, E}=> True)). Proof. iIntros (?) "#Hinv". iMod (inv_pointsto_own_acc_strong with "Hinv") as "Hacc"; first done. iIntros "!>" (l v I) "Hl". iDestruct ("Hacc" with "Hl") as "(% & Hl & Hclose)". iFrame "%∗". iIntros (w) "% Hl". iApply "Hclose"; done. Qed. Lemma inv_pointsto_own_acc E l v I: ↑inv_heapN ⊆ E → inv_heap_inv -∗ l ↦_I v ={E, E ∖ ↑inv_heapN}=∗ (⌜I v⌝ ∗ l ↦ v ∗ (∀ w, ⌜I w ⌝ -∗ l ↦ w ={E ∖ ↑inv_heapN, E}=∗ l ↦_I w)). Proof. iIntros (?) "#Hinv Hl". iMod (inv_pointsto_own_acc with "Hinv Hl") as "(% & Hl & Hclose)"; first done. iFrame "%∗". iIntros "!>" (w) "% Hl". iApply "Hclose"; done. Qed. Lemma inv_pointsto_acc l I E : ↑inv_heapN ⊆ E → inv_heap_inv -∗ l ↦_I □ ={E, E ∖ ↑inv_heapN}=∗ ∃ v, ⌜I v⌝ ∗ l ↦ v ∗ (l ↦ v ={E ∖ ↑inv_heapN, E}=∗ True). Proof. iIntros (?) "#Hinv Hl". iMod (inv_pointsto_acc with "Hinv Hl") as ([v|]) "(% & Hl & Hclose)"; [done| |done]. iIntros "!>". iExists (v). iFrame "%∗". Qed. (** The usable rules for [allocN] stated in terms of the [array] proposition are derived in te file [array]. *) Lemma heap_array_to_seq_meta l vs (n : nat) : length vs = n → ([∗ map] l' ↦ _ ∈ heap_array l vs, meta_token l' ⊤) -∗ [∗ list] i ∈ seq 0 n, meta_token (l +ₗ (i : nat)) ⊤. Proof. iIntros (<-) "Hvs". iInduction vs as [|v vs] "IH" forall (l)=> //=. rewrite big_opM_union; last first. { apply map_disjoint_spec=> l' v1 v2 /lookup_singleton_Some [-> _]. intros (j&w&?&Hjl&?&?)%heap_array_lookup. rewrite Loc.add_assoc -{1}[l']Loc.add_0 in Hjl. simplify_eq; lia. } rewrite Loc.add_0 -fmap_S_seq big_sepL_fmap. setoid_rewrite Nat2Z.inj_succ. setoid_rewrite <-Z.add_1_l. setoid_rewrite <-Loc.add_assoc. rewrite big_opM_singleton; iDestruct "Hvs" as "[$ Hvs]". by iApply "IH". Qed. Lemma heap_array_to_seq_pointsto l v (n : nat) : ([∗ map] l' ↦ ov ∈ heap_array l (replicate n v), gen_heap.pointsto l' (DfracOwn 1) ov) -∗ [∗ list] i ∈ seq 0 n, (l +ₗ (i : nat)) ↦ v. Proof. iIntros "Hvs". iInduction n as [|n] "IH" forall (l); simpl. { done. } rewrite big_opM_union; last first. { apply map_disjoint_spec=> l' v1 v2 /lookup_singleton_Some [-> _]. intros (j&w&?&Hjl&_)%heap_array_lookup. rewrite Loc.add_assoc -{1}[l']Loc.add_0 in Hjl. simplify_eq; lia. } rewrite Loc.add_0 -fmap_S_seq big_sepL_fmap. setoid_rewrite Nat2Z.inj_succ. setoid_rewrite <-Z.add_1_l. setoid_rewrite <-Loc.add_assoc. rewrite big_opM_singleton; iDestruct "Hvs" as "[$ Hvs]". by iApply "IH". Qed. Lemma twp_allocN_seq s E v n : (0 < n)%Z → [[{ True }]] AllocN (Val $ LitV $ LitInt $ n) (Val v) @ s; E [[{ l, RET LitV (LitLoc l); [∗ list] i ∈ seq 0 (Z.to_nat n), (l +ₗ (i : nat)) ↦ v ∗ meta_token (l +ₗ (i : nat)) ⊤ }]]. Proof. iIntros (Hn Φ) "_ HΦ". iApply twp_lift_atomic_base_step_no_fork; first done. iIntros (σ1 ns κs nt) "(Hσ & Hκs & Hsteps) !>". iSplit; first by destruct n; auto with lia base_step. iIntros (κ v2 σ2 efs Hstep); inv_base_step. iMod (gen_heap_alloc_big _ (heap_array _ (replicate (Z.to_nat n) v)) with "Hσ") as "(Hσ & Hl & Hm)". { apply heap_array_map_disjoint. rewrite replicate_length Z2Nat.id; auto with lia. } iMod (steps_auth_update_S with "Hsteps") as "Hsteps". iModIntro; do 2 (iSplit; first done). iFrame "Hσ Hκs Hsteps". iApply "HΦ". iApply big_sepL_sep. iSplitL "Hl". - by iApply heap_array_to_seq_pointsto. - iApply (heap_array_to_seq_meta with "Hm"). by rewrite replicate_length. Qed. Lemma wp_allocN_seq s E v n : (0 < n)%Z → {{{ True }}} AllocN (Val $ LitV $ LitInt $ n) (Val v) @ s; E {{{ l, RET LitV (LitLoc l); [∗ list] i ∈ seq 0 (Z.to_nat n), (l +ₗ (i : nat)) ↦ v ∗ meta_token (l +ₗ (i : nat)) ⊤ }}}. Proof. iIntros (Hn Φ) "_ HΦ". iApply (twp_wp_step with "HΦ"). iApply twp_allocN_seq; [by auto..|]; iIntros (l) "H HΦ". by iApply "HΦ". Qed. Lemma wp_allocN_seq_lc s E v n n' : (0 < n)%Z → {{{ steps_lb n' }}} AllocN (Val $ LitV $ LitInt $ n) (Val v) @ s; E {{{ l, RET LitV (LitLoc l); ([∗ list] i ∈ seq 0 (Z.to_nat n), (l +ₗ (i : nat)) ↦ v ∗ meta_token (l +ₗ (i : nat)) ⊤) ∗ £ (S n') }}}. Proof. iIntros (Hn Φ) "#? HΦ". iApply (twp_wp_step_lc_texan with "[$] HΦ"). iApply twp_allocN_seq; [by auto..|]; iIntros (l) "H HΦ ? !>". iApply "HΦ"; iFrame. Qed. Lemma twp_alloc s E v : [[{ True }]] Alloc (Val v) @ s; E [[{ l, RET LitV (LitLoc l); l ↦ v ∗ meta_token l ⊤ }]]. Proof. iIntros (Φ) "_ HΦ". iApply twp_allocN_seq; [auto with lia..|]. iIntros (l) "/= (? & _)". rewrite Loc.add_0. iApply "HΦ"; iFrame. Qed. Lemma wp_alloc s E v : {{{ True }}} Alloc (Val v) @ s; E {{{ l, RET LitV (LitLoc l); l ↦ v ∗ meta_token l ⊤ }}}. Proof. iIntros (Φ) "_ HΦ". iApply (twp_wp_step with "HΦ"). iApply twp_alloc; [by auto..|]; iIntros (l) "H HΦ". by iApply "HΦ". Qed. Lemma wp_alloc_lc s E v n : {{{ steps_lb n }}} Alloc (Val v) @ s; E {{{ l, RET LitV (LitLoc l); l ↦ v ∗ meta_token l ⊤ ∗ £ (S n) }}}. Proof. iIntros (Φ) "#? HΦ". iApply (twp_wp_step_lc_texan with "[$] HΦ"). iApply twp_alloc; [by auto..|]; iIntros (l) "[??] HΦ ? !>". iApply "HΦ"; iFrame. Qed. Lemma twp_free s E l v : [[{ l ↦ v }]] Free (Val $ LitV $ LitLoc l) @ s; E [[{ RET LitV LitUnit; True }]]. Proof. iIntros (Φ) "Hl HΦ". iApply twp_lift_atomic_base_step_no_fork; first done. iIntros (σ1 ns κs nt) "(Hσ & Hκs & Hsteps) !>". iDestruct (gen_heap_valid with "Hσ Hl") as %?. iSplit; first by eauto with base_step. iIntros (κ v2 σ2 efs Hstep); inv_base_step. iMod (gen_heap_update with "Hσ Hl") as "[$ Hl]". iMod (steps_auth_update_S with "Hsteps") as "Hsteps". iModIntro. iSplit; first done. iSplit; first done. iFrame. by iApply "HΦ". Qed. Lemma wp_free s E l v : {{{ ▷ l ↦ v }}} Free (Val $ LitV (LitLoc l)) @ s; E {{{ RET LitV LitUnit; True }}}. Proof. iIntros (Φ) ">H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_free with "H"); [by auto..|]; iIntros "H HΦ". by iApply "HΦ". Qed. Lemma wp_free_lc s E l v n : {{{ steps_lb n ∗ ▷ l ↦ v }}} Free (Val $ LitV (LitLoc l)) @ s; E {{{ RET LitV LitUnit; £ (S n) }}}. Proof. iIntros (Φ) "[#? >H] HΦ". iApply (twp_wp_step_lc_texan with "[$] HΦ"). iApply (twp_free with "H"); [by auto..|]; iIntros "H HΦ ? !>". by iApply "HΦ". Qed. Lemma twp_load s E l dq v : [[{ l ↦{dq} v }]] Load (Val $ LitV $ LitLoc l) @ s; E [[{ RET v; l ↦{dq} v }]]. Proof. iIntros (Φ) "Hl HΦ". iApply twp_lift_atomic_base_step_no_fork; first done. iIntros (σ1 ns κs nt) "(Hσ & Hκs & Hsteps) !>". iDestruct (gen_heap_valid with "Hσ Hl") as %?. iSplit; first by eauto with base_step. iIntros (κ v2 σ2 efs Hstep); inv_base_step. iMod (steps_auth_update_S with "Hsteps") as "Hsteps". iModIntro. iSplit; [done|]. iSplit; [done|]. iFrame. by iApply "HΦ". Qed. Lemma wp_load s E l dq v : {{{ ▷ l ↦{dq} v }}} Load (Val $ LitV $ LitLoc l) @ s; E {{{ RET v; l ↦{dq} v }}}. Proof. iIntros (Φ) ">H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_load with "H"). iIntros "H HΦ". by iApply "HΦ". Qed. Lemma wp_load_lc s E l dq v n : {{{ steps_lb n ∗ ▷ l ↦{dq} v }}} Load (Val $ LitV $ LitLoc l) @ s; E {{{ RET v; l ↦{dq} v ∗ £ (S n) }}}. Proof. iIntros (Φ) "[#? >H] HΦ". iApply (twp_wp_step_lc_texan with "[$] HΦ"). iApply (twp_load with "H"). iIntros "H HΦ ? !>". iApply "HΦ"; iFrame. Qed. Lemma twp_store s E l v' v : [[{ l ↦ v' }]] Store (Val $ LitV $ LitLoc l) (Val v) @ s; E [[{ RET LitV LitUnit; l ↦ v }]]. Proof. iIntros (Φ) "Hl HΦ". iApply twp_lift_atomic_base_step_no_fork; first done. iIntros (σ1 ns κs nt) "(Hσ & Hκs & Hsteps) !>". iDestruct (gen_heap_valid with "Hσ Hl") as %?. iSplit; first by eauto with base_step. iIntros (κ v2 σ2 efs Hstep); inv_base_step. iMod (steps_auth_update_S with "Hsteps") as "Hsteps". iMod (gen_heap_update with "Hσ Hl") as "[$ Hl]". iModIntro. iSplit; first done. iSplit; first done. iFrame. by iApply "HΦ". Qed. Lemma wp_store s E l v' v : {{{ ▷ l ↦ v' }}} Store (Val $ LitV (LitLoc l)) (Val v) @ s; E {{{ RET LitV LitUnit; l ↦ v }}}. Proof. iIntros (Φ) ">H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_store with "H"); [by auto..|]; iIntros "H HΦ". by iApply "HΦ". Qed. Lemma wp_store_lc s E l v' v n : {{{ steps_lb n ∗ ▷ l ↦ v' }}} Store (Val $ LitV (LitLoc l)) (Val v) @ s; E {{{ RET LitV LitUnit; l ↦ v ∗ £ (S n) }}}. Proof. iIntros (Φ) "[#? >H] HΦ". iApply (twp_wp_step_lc_texan with "[$] HΦ"). iApply (twp_store with "H"); [by auto..|]; iIntros "H HΦ ? !>". iApply "HΦ"; iFrame. Qed. Lemma twp_xchg s E l v' v : [[{ l ↦ v' }]] Xchg (Val $ LitV $ LitLoc l) (Val v) @ s; E [[{ RET v'; l ↦ v }]]. Proof. iIntros (Φ) "Hl HΦ". iApply twp_lift_atomic_base_step_no_fork; first done. iIntros (σ1 ns κs nt) "(Hσ & Hκs & Hsteps) !>". iDestruct (gen_heap_valid with "Hσ Hl") as %?. iSplit; first by eauto with base_step. iIntros (κ v2 σ2 efs Hstep); inv_base_step. iMod (steps_auth_update_S with "Hsteps") as "Hsteps". iMod (gen_heap_update with "Hσ Hl") as "[$ Hl]". iModIntro. iSplit; first done. iSplit; first done. iFrame. by iApply "HΦ". Qed. Lemma wp_xchg s E l v' v : {{{ ▷ l ↦ v' }}} Xchg (Val $ LitV (LitLoc l)) (Val v) @ s; E {{{ RET v'; l ↦ v }}}. Proof. iIntros (Φ) ">H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_xchg with "H"); [by auto..|]. iIntros "H HΦ". by iApply "HΦ". Qed. Lemma wp_xchg_lc s E l v' v n : {{{ steps_lb n ∗ ▷ l ↦ v' }}} Xchg (Val $ LitV (LitLoc l)) (Val v) @ s; E {{{ RET v'; l ↦ v ∗ £ (S n) }}}. Proof. iIntros (Φ) "[#? >H] HΦ". iApply (twp_wp_step_lc_texan with "[$] HΦ"). iApply (twp_xchg with "H"); [by auto..|]. iIntros "H HΦ ? !>". iApply "HΦ"; iFrame. Qed. Lemma twp_cmpxchg_fail s E l dq v' v1 v2 : v' ≠ v1 → vals_compare_safe v' v1 → [[{ l ↦{dq} v' }]] CmpXchg (Val $ LitV $ LitLoc l) (Val v1) (Val v2) @ s; E [[{ RET PairV v' (LitV $ LitBool false); l ↦{dq} v' }]]. Proof. iIntros (?? Φ) "Hl HΦ". iApply twp_lift_atomic_base_step_no_fork; first done. iIntros (σ1 ns κs nt) "(Hσ & Hκs & Hsteps) !>". iDestruct (gen_heap_valid with "Hσ Hl") as %?. iSplit; first by eauto with base_step. iIntros (κ v2' σ2 efs Hstep); inv_base_step. rewrite bool_decide_false //. iMod (steps_auth_update_S with "Hsteps") as "Hsteps". iModIntro; iSplit; first done. iSplit; first done. iFrame. by iApply "HΦ". Qed. Lemma wp_cmpxchg_fail s E l dq v' v1 v2 : v' ≠ v1 → vals_compare_safe v' v1 → {{{ ▷ l ↦{dq} v' }}} CmpXchg (Val $ LitV $ LitLoc l) (Val v1) (Val v2) @ s; E {{{ RET PairV v' (LitV $ LitBool false); l ↦{dq} v' }}}. Proof. iIntros (?? Φ) ">H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_cmpxchg_fail with "H"); [by auto..|]; iIntros "H HΦ". by iApply "HΦ". Qed. Lemma wp_cmpxchg_fail_lc s E l dq v' v1 v2 n : v' ≠ v1 → vals_compare_safe v' v1 → {{{ steps_lb n ∗ ▷ l ↦{dq} v' }}} CmpXchg (Val $ LitV $ LitLoc l) (Val v1) (Val v2) @ s; E {{{ RET PairV v' (LitV $ LitBool false); l ↦{dq} v' ∗ £ (S n) }}}. Proof. iIntros (?? Φ) "[#? >H] HΦ". iApply (twp_wp_step_lc_texan with "[$] HΦ"). iApply (twp_cmpxchg_fail with "H"); [by auto..|]; iIntros "H HΦ ? !>". iApply "HΦ"; iFrame. Qed. Lemma twp_cmpxchg_suc s E l v1 v2 v' : v' = v1 → vals_compare_safe v' v1 → [[{ l ↦ v' }]] CmpXchg (Val $ LitV $ LitLoc l) (Val v1) (Val v2) @ s; E [[{ RET PairV v' (LitV $ LitBool true); l ↦ v2 }]]. Proof. iIntros (?? Φ) "Hl HΦ". iApply twp_lift_atomic_base_step_no_fork; first done. iIntros (σ1 ns κs nt) "(Hσ & Hκs & Hsteps) !>". iDestruct (gen_heap_valid with "Hσ Hl") as %?. iSplit; first by eauto with base_step. iIntros (κ v2' σ2 efs Hstep); inv_base_step. rewrite bool_decide_true //. iMod (gen_heap_update with "Hσ Hl") as "[$ Hl]". iMod (steps_auth_update_S with "Hsteps") as "Hsteps". iModIntro. iSplit; first done. iSplit; first done. iFrame. by iApply "HΦ". Qed. Lemma wp_cmpxchg_suc s E l v1 v2 v' : v' = v1 → vals_compare_safe v' v1 → {{{ ▷ l ↦ v' }}} CmpXchg (Val $ LitV $ LitLoc l) (Val v1) (Val v2) @ s; E {{{ RET PairV v' (LitV $ LitBool true); l ↦ v2 }}}. Proof. iIntros (?? Φ) ">H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_cmpxchg_suc with "H"); [by auto..|]; iIntros "H HΦ". by iApply "HΦ". Qed. Lemma wp_cmpxchg_suc_lc s E l v1 v2 v' n : v' = v1 → vals_compare_safe v' v1 → {{{ steps_lb n ∗ ▷ l ↦ v' }}} CmpXchg (Val $ LitV $ LitLoc l) (Val v1) (Val v2) @ s; E {{{ RET PairV v' (LitV $ LitBool true); l ↦ v2 ∗ £ (S n) }}}. Proof. iIntros (?? Φ) "[#? >H] HΦ". iApply (twp_wp_step_lc_texan with "[$] HΦ"). iApply (twp_cmpxchg_suc with "H"); [by auto..|]; iIntros "H HΦ ? !>". iApply "HΦ"; iFrame. Qed. Lemma twp_faa s E l i1 i2 : [[{ l ↦ LitV (LitInt i1) }]] FAA (Val $ LitV $ LitLoc l) (Val $ LitV $ LitInt i2) @ s; E [[{ RET LitV (LitInt i1); l ↦ LitV (LitInt (i1 + i2)) }]]. Proof. iIntros (Φ) "Hl HΦ". iApply twp_lift_atomic_base_step_no_fork; first done. iIntros (σ1 ns κs nt) "(Hσ & Hκs & Hsteps) !>". iDestruct (gen_heap_valid with "Hσ Hl") as %?. iSplit; first by eauto with base_step. iIntros (κ e2 σ2 efs Hstep); inv_base_step. iMod (gen_heap_update with "Hσ Hl") as "[$ Hl]". iMod (steps_auth_update_S with "Hsteps") as "Hsteps". iModIntro. do 2 (iSplit; first done). iFrame. by iApply "HΦ". Qed. Lemma wp_faa s E l i1 i2 : {{{ ▷ l ↦ LitV (LitInt i1) }}} FAA (Val $ LitV $ LitLoc l) (Val $ LitV $ LitInt i2) @ s; E {{{ RET LitV (LitInt i1); l ↦ LitV (LitInt (i1 + i2)) }}}. Proof. iIntros (Φ) ">H HΦ". iApply (twp_wp_step with "HΦ"). iApply (twp_faa with "H"); [by auto..|]; iIntros "H HΦ". by iApply "HΦ". Qed. Lemma wp_faa_lc s E l i1 i2 n : {{{ steps_lb n ∗ ▷ l ↦ LitV (LitInt i1) }}} FAA (Val $ LitV $ LitLoc l) (Val $ LitV $ LitInt i2) @ s; E {{{ RET LitV (LitInt i1); l ↦ LitV (LitInt (i1 + i2)) ∗ £ (S n) }}}. Proof. iIntros (Φ) "[#? >H] HΦ". iApply (twp_wp_step_lc_texan with "[$] HΦ"). iApply (twp_faa with "H"); [by auto..|]; iIntros "H HΦ ? !>". iApply "HΦ"; iFrame. Qed. Lemma wp_new_proph s E : {{{ True }}} NewProph @ s; E {{{ pvs p, RET (LitV (LitProphecy p)); proph p pvs }}}. Proof. iIntros (Φ) "_ HΦ". iApply wp_lift_atomic_base_step_no_fork; first done. iIntros (σ1 ns κ κs nt) "(Hσ & HR & Hsteps) !>". iSplit; first by eauto with base_step. iIntros "!>" (v2 σ2 efs Hstep) "_". inv_base_step. rename select proph_id into p. iMod (steps_auth_update_S with "Hsteps") as "Hsteps". iMod (proph_map_new_proph p with "HR") as "[HR Hp]"; first done. iModIntro; iSplit; first done. iFrame. by iApply "HΦ". Qed. (* In the following, strong atomicity is required due to the fact that [e] must be able to make a base step for [Resolve e _ _] not to be (base) stuck. *) Lemma resolve_reducible e σ (p : proph_id) v : Atomic StronglyAtomic e → reducible e σ → reducible (Resolve e (Val (LitV (LitProphecy p))) (Val v)) σ. Proof. intros A (κ & e' & σ' & efs & H). exists (κ ++ [(p, (default v (to_val e'), v))]), e', σ', efs. eapply (Ectx_step []); try done. assert (∃w, Val w = e') as [w <-]. { unfold Atomic in A. apply (A σ e' κ σ' efs) in H. unfold is_Some in H. destruct H as [w H]. exists w. simpl in H. by apply (of_to_val _ _ H). } simpl. constructor. by apply prim_step_to_val_is_base_step. Qed. Lemma step_resolve e vp vt σ1 κ e2 σ2 efs : Atomic StronglyAtomic e → prim_step (Resolve e (Val vp) (Val vt)) σ1 κ e2 σ2 efs → base_step (Resolve e (Val vp) (Val vt)) σ1 κ e2 σ2 efs. Proof. intros A [Ks e1' e2' Hfill -> step]. simpl in *. induction Ks as [|K Ks _] using rev_ind. + simpl in *. subst. inv_base_step. by constructor. + rewrite fill_app /= in Hfill. destruct K; inversion Hfill; subst; clear Hfill. - rename select ectx_item into Ki. assert (fill_item Ki (fill Ks e1') = fill (Ks ++ [Ki]) e1') as Eq1; first by rewrite fill_app. assert (fill_item Ki (fill Ks e2') = fill (Ks ++ [Ki]) e2') as Eq2; first by rewrite fill_app. rewrite fill_app /=. rewrite Eq1 in A. assert (is_Some (to_val (fill (Ks ++ [Ki]) e2'))) as H. { apply (A σ1 _ κ σ2 efs). eapply (Ectx_step (Ks ++ [Ki])); done. } destruct H as [v H]. apply to_val_fill_some in H. by destruct H, Ks. - rename select (of_val vp = _) into Hvp. assert (to_val (fill Ks e1') = Some vp) as Hfillvp by rewrite -Hvp //. apply to_val_fill_some in Hfillvp as [-> ->]. inv_base_step. - rename select (of_val vt = _) into Hvt. assert (to_val (fill Ks e1') = Some vt) as Hfillvt by rewrite -Hvt //. apply to_val_fill_some in Hfillvt as [-> ->]. inv_base_step. Qed. Lemma wp_resolve s E e Φ (p : proph_id) v (pvs : list (val * val)) : Atomic StronglyAtomic e → to_val e = None → proph p pvs -∗ WP e @ s; E {{ r, ∀ pvs', ⌜pvs = (r, v)::pvs'⌝ -∗ proph p pvs' -∗ Φ r }} -∗ WP Resolve e (Val $ LitV $ LitProphecy p) (Val v) @ s; E {{ Φ }}. Proof. (* TODO we should try to use a generic lifting lemma (and avoid [wp_unfold]) here, since this breaks the WP abstraction. *) iIntros (A He) "Hp WPe". rewrite !wp_unfold /wp_pre /= He. simpl in *. iIntros (σ1 ns κ κs nt) "(Hσ & Hκ & Hsteps)". destruct κ as [|[p' [w' v']] κ' _] using rev_ind. - iMod ("WPe" $! σ1 ns [] κs nt with "[$Hσ $Hκ $Hsteps]") as "[Hs WPe]". iModIntro. iSplit. { iDestruct "Hs" as "%". iPureIntro. destruct s; [ by apply resolve_reducible | done]. } iIntros (e2 σ2 efs step). exfalso. apply step_resolve in step; last done. inv_base_step. match goal with H: ?κs ++ [_] = [] |- _ => by destruct κs end. - rewrite -assoc. iMod ("WPe" $! σ1 ns _ _ nt with "[$Hσ $Hκ $Hsteps]") as "[Hs WPe]". iModIntro. iSplit. { iDestruct "Hs" as %?. iPureIntro. destruct s; [ by apply resolve_reducible | done]. } iIntros (e2 σ2 efs step) "Hcred". apply step_resolve in step; last done. inv_base_step; simplify_list_eq. iMod ("WPe" $! (Val w') σ2 efs with "[%] Hcred") as "WPe". { by eexists [] _ _. } iModIntro. iNext. iMod "WPe" as "WPe". iModIntro. iApply (step_fupdN_wand with "WPe"); iIntros "> [($ & Hκ & $) WPe]". iMod (proph_map_resolve_proph p' (w',v') κs with "[$Hκ $Hp]") as (vs' ->) "[$ HPost]". iModIntro. rewrite !wp_unfold /wp_pre /=. iDestruct "WPe" as "[HΦ $]". iMod "HΦ". iModIntro. by iApply "HΦ". Qed. End lifting. iris-iris-4.2.0/iris_heap_lang/proofmode.v000066400000000000000000001233711460620107300205620ustar00rootroot00000000000000From iris.proofmode Require Import coq_tactics reduction spec_patterns. From iris.proofmode Require Export tactics. From iris.program_logic Require Import atomic. From iris.heap_lang Require Export tactics derived_laws. From iris.heap_lang Require Import notation. From iris.prelude Require Import options. Import uPred. Lemma tac_wp_expr_eval `{!heapGS_gen hlc Σ} Δ s E Φ e e' : (∀ (e'':=e'), e = e'') → envs_entails Δ (WP e' @ s; E {{ Φ }}) → envs_entails Δ (WP e @ s; E {{ Φ }}). Proof. by intros ->. Qed. Lemma tac_twp_expr_eval `{!heapGS_gen hlc Σ} Δ s E Φ e e' : (∀ (e'':=e'), e = e'') → envs_entails Δ (WP e' @ s; E [{ Φ }]) → envs_entails Δ (WP e @ s; E [{ Φ }]). Proof. by intros ->. Qed. Tactic Notation "wp_expr_eval" tactic3(t) := iStartProof; lazymatch goal with | |- envs_entails _ (wp ?s ?E ?e ?Q) => notypeclasses refine (tac_wp_expr_eval _ _ _ _ e _ _ _); [let x := fresh in intros x; t; unfold x; notypeclasses refine eq_refl|] | |- envs_entails _ (twp ?s ?E ?e ?Q) => notypeclasses refine (tac_twp_expr_eval _ _ _ _ e _ _ _); [let x := fresh in intros x; t; unfold x; notypeclasses refine eq_refl|] | _ => fail "wp_expr_eval: not a 'wp'" end. Ltac wp_expr_simpl := wp_expr_eval simpl. Lemma tac_wp_pure `{!heapGS_gen hlc Σ} Δ Δ' s E K e1 e2 φ n Φ : PureExec φ n e1 e2 → φ → MaybeIntoLaterNEnvs n Δ Δ' → envs_entails Δ' (WP (fill K e2) @ s; E {{ Φ }}) → envs_entails Δ (WP (fill K e1) @ s; E {{ Φ }}). Proof. rewrite envs_entails_unseal=> ??? HΔ'. rewrite into_laterN_env_sound /=. (* We want [pure_exec_fill] to be available to TC search locally. *) pose proof @pure_exec_fill. rewrite HΔ' -lifting.wp_pure_step_later //. iIntros "Hwp !> _" => //. Qed. Lemma tac_twp_pure `{!heapGS_gen hlc Σ} Δ s E K e1 e2 φ n Φ : PureExec φ n e1 e2 → φ → envs_entails Δ (WP (fill K e2) @ s; E [{ Φ }]) → envs_entails Δ (WP (fill K e1) @ s; E [{ Φ }]). Proof. rewrite envs_entails_unseal=> ?? ->. (* We want [pure_exec_fill] to be available to TC search locally. *) pose proof @pure_exec_fill. rewrite -total_lifting.twp_pure_step //. Qed. Lemma tac_wp_pure_credit `{!heapGS_gen hlc Σ} Δ Δ' s E j K e1 e2 ϕ Φ : PureExec ϕ 1 e1 e2 → ϕ → MaybeIntoLaterNEnvs 1 Δ Δ' → match envs_app false (Esnoc Enil j (£ 1)) Δ' with | Some Δ'' => envs_entails Δ'' (WP fill K e2 @ s; E {{ Φ }}) | None => False end → envs_entails Δ (WP (fill K e1) @ s; E {{ Φ }}). Proof. rewrite envs_entails_unseal=> ??? HΔ. pose proof @pure_exec_fill. rewrite -lifting.wp_pure_step_later; last done. rewrite into_laterN_env_sound /=. apply later_mono. destruct (envs_app _ _ _) as [Δ''|] eqn:HΔ'; [ | contradiction ]. rewrite envs_app_sound //; simpl. rewrite right_id. apply wand_intro_r. by rewrite wand_elim_l. Qed. Lemma tac_wp_value_nofupd `{!heapGS_gen hlc Σ} Δ s E Φ v : envs_entails Δ (Φ v) → envs_entails Δ (WP (Val v) @ s; E {{ Φ }}). Proof. rewrite envs_entails_unseal=> ->. by apply wp_value. Qed. Lemma tac_twp_value_nofupd `{!heapGS_gen hlc Σ} Δ s E Φ v : envs_entails Δ (Φ v) → envs_entails Δ (WP (Val v) @ s; E [{ Φ }]). Proof. rewrite envs_entails_unseal=> ->. by apply twp_value. Qed. Lemma tac_wp_value `{!heapGS_gen hlc Σ} Δ s E (Φ : val → iPropI Σ) v : envs_entails Δ (|={E}=> Φ v) → envs_entails Δ (WP (Val v) @ s; E {{ Φ }}). Proof. rewrite envs_entails_unseal=> ->. by rewrite wp_value_fupd. Qed. Lemma tac_twp_value `{!heapGS_gen hlc Σ} Δ s E (Φ : val → iPropI Σ) v : envs_entails Δ (|={E}=> Φ v) → envs_entails Δ (WP (Val v) @ s; E [{ Φ }]). Proof. rewrite envs_entails_unseal=> ->. by rewrite twp_value_fupd. Qed. (** Simplify the goal if it is [WP] of a value. If the postcondition already allows a fupd, do not add a second one. But otherwise, *do* add a fupd. This ensures that all the lemmas applied here are bidirectional, so we never will make a goal unprovable. *) Ltac wp_value_head := lazymatch goal with | |- envs_entails _ (wp ?s ?E (Val _) (λ _, fupd ?E _ _)) => eapply tac_wp_value_nofupd | |- envs_entails _ (wp ?s ?E (Val _) (λ _, wp _ ?E _ _)) => eapply tac_wp_value_nofupd | |- envs_entails _ (wp ?s ?E (Val _) _) => eapply tac_wp_value | |- envs_entails _ (twp ?s ?E (Val _) (λ _, fupd ?E _ _)) => eapply tac_twp_value_nofupd | |- envs_entails _ (twp ?s ?E (Val _) (λ _, twp _ ?E _ _)) => eapply tac_twp_value_nofupd | |- envs_entails _ (twp ?s ?E (Val _) _) => eapply tac_twp_value end. Ltac wp_finish := wp_expr_simpl; (* simplify occurences of subst/fill *) try wp_value_head; (* in case we have reached a value, get rid of the WP *) pm_prettify. (* prettify ▷s caused by [MaybeIntoLaterNEnvs] and λs caused by wp_value *) Ltac solve_vals_compare_safe := (* The first branch is for when we have [vals_compare_safe] in the context. The other two branches are for when either one of the branches reduces to [True] or we have it in the context. *) fast_done || (left; fast_done) || (right; fast_done). (** The argument [efoc] can be used to specify the construct that should be reduced. For example, you can write [wp_pure (EIf _ _ _)], which will search for an [EIf _ _ _] in the expression, and reduce it. The use of [open_constr] in this tactic is essential. It will convert all holes (i.e. [_]s) into evars, that later get unified when an occurences is found (see [unify e' efoc] in the code below). *) Tactic Notation "wp_pure" open_constr(efoc) := iStartProof; lazymatch goal with | |- envs_entails _ (wp ?s ?E ?e ?Q) => let e := eval simpl in e in reshape_expr e ltac:(fun K e' => unify e' efoc; eapply (tac_wp_pure _ _ _ _ K e'); [tc_solve (* PureExec *) |try solve_vals_compare_safe (* The pure condition for PureExec -- handles trivial goals, including [vals_compare_safe] *) |tc_solve (* IntoLaters *) |wp_finish (* new goal *) ]) || fail "wp_pure: cannot find" efoc "in" e "or" efoc "is not a redex" | |- envs_entails _ (twp ?s ?E ?e ?Q) => let e := eval simpl in e in reshape_expr e ltac:(fun K e' => unify e' efoc; eapply (tac_twp_pure _ _ _ K e'); [tc_solve (* PureExec *) |try solve_vals_compare_safe (* The pure condition for PureExec *) |wp_finish (* new goal *) ]) || fail "wp_pure: cannot find" efoc "in" e "or" efoc "is not a redex" | _ => fail "wp_pure: not a 'wp'" end. Tactic Notation "wp_pure" := wp_pure _. Tactic Notation "wp_pure" open_constr(efoc) "credit:" constr(H) := iStartProof; let Htmp := iFresh in let finish _ := pm_reduce; (iDestructHyp Htmp as H || fail 2 "wp_pure:" H "is not fresh"); wp_finish in lazymatch goal with | |- envs_entails _ (wp ?s ?E ?e ?Q) => let e := eval simpl in e in reshape_expr e ltac:(fun K e' => unify e' efoc; eapply (tac_wp_pure_credit _ _ _ _ Htmp K e'); [tc_solve (* PureExec *) |try solve_vals_compare_safe (* The pure condition for PureExec -- handles trivial goals, including [vals_compare_safe] *) |tc_solve (* IntoLaters *) |finish () (* new goal *) ]) || fail "wp_pure: cannot find" efoc "in" e "or" efoc "is not a redex" | |- envs_entails _ (twp ?s ?E ?e ?Q) => fail "wp_pure: credit generation is not supported for a TWP" | _ => fail "wp_pure: not a 'wp'" end. Tactic Notation "wp_pure" "credit:" constr(H) := wp_pure _ credit: H. (* TODO: do this in one go, without [repeat]. *) Ltac wp_pures := iStartProof; first [ (* The `;[]` makes sure that no side-condition magically spawns. *) progress repeat (wp_pure _; []) | wp_finish (* In case wp_pure never ran, make sure we do the usual cleanup. *) ]. (** Unlike [wp_pures], the tactics [wp_rec] and [wp_lam] should also reduce lambdas/recs that are hidden behind a definition, i.e. they should use [AsRecV_recv] as a proper instance instead of a [Hint Extern]. We achieve this by putting [AsRecV_recv] in the current environment so that it can be used as an instance by the typeclass resolution system. We then perform the reduction, and finally we clear this new hypothesis. *) Tactic Notation "wp_rec" := let H := fresh in assert (H := AsRecV_recv); wp_pure (App _ _); clear H. Tactic Notation "wp_if" := wp_pure (If _ _ _). Tactic Notation "wp_if_true" := wp_pure (If (LitV (LitBool true)) _ _). Tactic Notation "wp_if_false" := wp_pure (If (LitV (LitBool false)) _ _). Tactic Notation "wp_unop" := wp_pure (UnOp _ _). Tactic Notation "wp_binop" := wp_pure (BinOp _ _ _). Tactic Notation "wp_op" := wp_unop || wp_binop. Tactic Notation "wp_lam" := wp_rec. Tactic Notation "wp_let" := wp_pure (Rec BAnon (BNamed _) _); wp_lam. Tactic Notation "wp_seq" := wp_pure (Rec BAnon BAnon _); wp_lam. Tactic Notation "wp_proj" := wp_pure (Fst _) || wp_pure (Snd _). Tactic Notation "wp_case" := wp_pure (Case _ _ _). Tactic Notation "wp_match" := wp_case; wp_pure (Rec _ _ _); wp_lam. Tactic Notation "wp_inj" := wp_pure (InjL _) || wp_pure (InjR _). Tactic Notation "wp_pair" := wp_pure (Pair _ _). Tactic Notation "wp_closure" := wp_pure (Rec _ _ _). Lemma tac_wp_bind `{!heapGS_gen hlc Σ} 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 (Val v) @ s; E {{ Φ }} }})%I → envs_entails Δ (WP fill K e @ s; E {{ Φ }}). Proof. rewrite envs_entails_unseal=> -> ->. by apply: wp_bind. Qed. Lemma tac_twp_bind `{!heapGS_gen hlc Σ} 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 (Val v) @ s; E [{ Φ }] }])%I → envs_entails Δ (WP fill K e @ s; E [{ Φ }]). Proof. rewrite envs_entails_unseal=> -> ->. by apply: twp_bind. Qed. Ltac wp_bind_core K := lazymatch eval hnf in K with | [] => idtac | _ => 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|reduction.pm_prettify] end. Tactic Notation "wp_bind" open_constr(efoc) := iStartProof; lazymatch goal with | |- envs_entails _ (wp ?s ?E ?e ?Q) => first [ reshape_expr e ltac:(fun K e' => unify e' efoc; wp_bind_core K) | fail 1 "wp_bind: cannot find" efoc "in" e ] | |- envs_entails _ (twp ?s ?E ?e ?Q) => first [ reshape_expr e ltac:(fun K e' => unify e' efoc; twp_bind_core K) | fail 1 "wp_bind: cannot find" efoc "in" e ] | _ => fail "wp_bind: not a 'wp'" end. (** Heap tactics *) Section heap. Context `{!heapGS_gen hlc Σ}. Implicit Types P Q : iProp Σ. Implicit Types Φ : val → iProp Σ. Implicit Types Δ : envs (uPredI (iResUR Σ)). Implicit Types v : val. Implicit Types z : Z. Lemma tac_wp_allocN Δ Δ' s E j K v n Φ : (0 < n)%Z → MaybeIntoLaterNEnvs 1 Δ Δ' → (∀ l, match envs_app false (Esnoc Enil j (array l (DfracOwn 1) (replicate (Z.to_nat n) v))) Δ' with | Some Δ'' => envs_entails Δ'' (WP fill K (Val $ LitV $ LitLoc l) @ s; E {{ Φ }}) | None => False end) → envs_entails Δ (WP fill K (AllocN (Val $ LitV $ LitInt n) (Val v)) @ s; E {{ Φ }}). Proof. rewrite envs_entails_unseal=> ? ? HΔ. rewrite -wp_bind. eapply wand_apply; first by apply wand_entails, wp_allocN. rewrite left_id into_laterN_env_sound; apply later_mono, forall_intro=> l. specialize (HΔ l). destruct (envs_app _ _ _) as [Δ''|] eqn:HΔ'; [ | contradiction ]. rewrite envs_app_sound //; simpl. apply wand_intro_l. by rewrite (sep_elim_l (l ↦∗ _)%I) right_id wand_elim_r. Qed. Lemma tac_twp_allocN Δ s E j K v n Φ : (0 < n)%Z → (∀ l, match envs_app false (Esnoc Enil j (array l (DfracOwn 1) (replicate (Z.to_nat n) v))) Δ with | Some Δ' => envs_entails Δ' (WP fill K (Val $ LitV $ LitLoc l) @ s; E [{ Φ }]) | None => False end) → envs_entails Δ (WP fill K (AllocN (Val $ LitV $ LitInt n) (Val v)) @ s; E [{ Φ }]). Proof. rewrite envs_entails_unseal=> ? HΔ. rewrite -twp_bind. eapply wand_apply; first by apply wand_entails, twp_allocN. rewrite left_id. apply forall_intro=> l. specialize (HΔ l). destruct (envs_app _ _ _) as [Δ'|] eqn:HΔ'; [ | contradiction ]. rewrite envs_app_sound //; simpl. apply wand_intro_l. by rewrite (sep_elim_l (l ↦∗ _)%I) right_id wand_elim_r. Qed. Lemma tac_wp_alloc Δ Δ' s E j K v Φ : MaybeIntoLaterNEnvs 1 Δ Δ' → (∀ l, match envs_app false (Esnoc Enil j (l ↦ v)) Δ' with | Some Δ'' => envs_entails Δ'' (WP fill K (Val $ LitV l) @ s; E {{ Φ }}) | None => False end) → envs_entails Δ (WP fill K (Alloc (Val v)) @ s; E {{ Φ }}). Proof. rewrite envs_entails_unseal=> ? HΔ. rewrite -wp_bind. eapply wand_apply; first by apply wand_entails, wp_alloc. rewrite left_id into_laterN_env_sound; apply later_mono, forall_intro=> l. specialize (HΔ l). destruct (envs_app _ _ _) as [Δ''|] eqn:HΔ'; [ | contradiction ]. rewrite envs_app_sound //; simpl. apply wand_intro_l. by rewrite (sep_elim_l (l ↦ v)%I) right_id wand_elim_r. Qed. Lemma tac_twp_alloc Δ s E j K v Φ : (∀ l, match envs_app false (Esnoc Enil j (l ↦ v)) Δ with | Some Δ' => envs_entails Δ' (WP fill K (Val $ LitV $ LitLoc l) @ s; E [{ Φ }]) | None => False end) → envs_entails Δ (WP fill K (Alloc (Val v)) @ s; E [{ Φ }]). Proof. rewrite envs_entails_unseal=> HΔ. rewrite -twp_bind. eapply wand_apply; first by apply wand_entails, twp_alloc. rewrite left_id. apply forall_intro=> l. specialize (HΔ l). destruct (envs_app _ _ _) as [Δ''|] eqn:HΔ'; [ | contradiction ]. rewrite envs_app_sound //; simpl. apply wand_intro_l. by rewrite (sep_elim_l (l ↦ v)%I) right_id wand_elim_r. Qed. Lemma tac_wp_free Δ Δ' s E i K l v Φ : MaybeIntoLaterNEnvs 1 Δ Δ' → envs_lookup i Δ' = Some (false, l ↦ v)%I → (let Δ'' := envs_delete false i false Δ' in envs_entails Δ'' (WP fill K (Val $ LitV LitUnit) @ s; E {{ Φ }})) → envs_entails Δ (WP fill K (Free (LitV l)) @ s; E {{ Φ }}). Proof. rewrite envs_entails_unseal=> ? Hlk Hfin. rewrite -wp_bind. eapply wand_apply; first by apply wand_entails, wp_free. rewrite into_laterN_env_sound -later_sep envs_lookup_split //; simpl. rewrite -Hfin wand_elim_r (envs_lookup_sound' _ _ _ _ _ Hlk). apply later_mono, sep_mono_r, wand_intro_r. rewrite right_id //. Qed. Lemma tac_twp_free Δ s E i K l v Φ : envs_lookup i Δ = Some (false, l ↦ v)%I → (let Δ' := envs_delete false i false Δ in envs_entails Δ' (WP fill K (Val $ LitV LitUnit) @ s; E [{ Φ }])) → envs_entails Δ (WP fill K (Free (LitV l)) @ s; E [{ Φ }]). Proof. rewrite envs_entails_unseal=> Hlk Hfin. rewrite -twp_bind. eapply wand_apply; first by apply wand_entails, twp_free. rewrite envs_lookup_split //; simpl. rewrite -Hfin wand_elim_r (envs_lookup_sound' _ _ _ _ _ Hlk). apply sep_mono_r, wand_intro_r. rewrite right_id //. Qed. Lemma tac_wp_load Δ Δ' s E i K b l q v Φ : MaybeIntoLaterNEnvs 1 Δ Δ' → envs_lookup i Δ' = Some (b, l ↦{q} v)%I → envs_entails Δ' (WP fill K (Val v) @ s; E {{ Φ }}) → envs_entails Δ (WP fill K (Load (LitV l)) @ s; E {{ Φ }}). Proof. rewrite envs_entails_unseal=> ?? Hi. rewrite -wp_bind. eapply wand_apply; first by apply wand_entails, wp_load. rewrite into_laterN_env_sound -later_sep envs_lookup_split //; simpl. apply later_mono. destruct b; simpl. * iIntros "[#$ He]". iIntros "_". iApply Hi. iApply "He". iFrame "#". * by apply sep_mono_r, wand_mono. Qed. Lemma tac_twp_load Δ s E i K b l q v Φ : envs_lookup i Δ = Some (b, l ↦{q} v)%I → envs_entails Δ (WP fill K (Val v) @ s; E [{ Φ }]) → envs_entails Δ (WP fill K (Load (LitV l)) @ s; E [{ Φ }]). Proof. rewrite envs_entails_unseal=> ? Hi. rewrite -twp_bind. eapply wand_apply; first by apply wand_entails, twp_load. rewrite envs_lookup_split //; simpl. destruct b; simpl. - iIntros "[#$ He]". iIntros "_". iApply Hi. iApply "He". iFrame "#". - iIntros "[$ He]". iIntros "Hl". iApply Hi. iApply "He". iFrame "Hl". Qed. Lemma tac_wp_store Δ Δ' s E i K l v v' Φ : MaybeIntoLaterNEnvs 1 Δ Δ' → envs_lookup i Δ' = Some (false, l ↦ v)%I → match envs_simple_replace i false (Esnoc Enil i (l ↦ v')) Δ' with | Some Δ'' => envs_entails Δ'' (WP fill K (Val $ LitV LitUnit) @ s; E {{ Φ }}) | None => False end → envs_entails Δ (WP fill K (Store (LitV l) (Val v')) @ s; E {{ Φ }}). Proof. rewrite envs_entails_unseal=> ???. destruct (envs_simple_replace _ _ _) as [Δ''|] eqn:HΔ''; [ | contradiction ]. rewrite -wp_bind. eapply wand_apply; first by eapply wand_entails, 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. Qed. Lemma tac_twp_store Δ s E i K l v v' Φ : envs_lookup i Δ = Some (false, l ↦ v)%I → match envs_simple_replace i false (Esnoc Enil i (l ↦ v')) Δ with | Some Δ' => envs_entails Δ' (WP fill K (Val $ LitV LitUnit) @ s; E [{ Φ }]) | None => False end → envs_entails Δ (WP fill K (Store (LitV l) v') @ s; E [{ Φ }]). Proof. rewrite envs_entails_unseal. intros. destruct (envs_simple_replace _ _ _) as [Δ''|] eqn:HΔ''; [ | contradiction ]. rewrite -twp_bind. eapply wand_apply; first by eapply wand_entails, twp_store. rewrite envs_simple_replace_sound //; simpl. rewrite right_id. by apply sep_mono_r, wand_mono. Qed. Lemma tac_wp_xchg Δ Δ' s E i K l v v' Φ : MaybeIntoLaterNEnvs 1 Δ Δ' → envs_lookup i Δ' = Some (false, l ↦ v)%I → match envs_simple_replace i false (Esnoc Enil i (l ↦ v')) Δ' with | Some Δ'' => envs_entails Δ'' (WP fill K (Val $ v) @ s; E {{ Φ }}) | None => False end → envs_entails Δ (WP fill K (Xchg (LitV l) (Val v')) @ s; E {{ Φ }}). Proof. rewrite envs_entails_unseal=> ???. destruct (envs_simple_replace _ _ _) as [Δ''|] eqn:HΔ''; [ | contradiction ]. rewrite -wp_bind. eapply wand_apply; first by eapply wand_entails, wp_xchg. 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_xchg Δ s E i K l v v' Φ : envs_lookup i Δ = Some (false, l ↦ v)%I → match envs_simple_replace i false (Esnoc Enil i (l ↦ v')) Δ with | Some Δ' => envs_entails Δ' (WP fill K (Val $ v) @ s; E [{ Φ }]) | None => False end → envs_entails Δ (WP fill K (Xchg (LitV l) v') @ s; E [{ Φ }]). Proof. rewrite envs_entails_unseal. intros. destruct (envs_simple_replace _ _ _) as [Δ''|] eqn:HΔ''; [ | contradiction ]. rewrite -twp_bind. eapply wand_apply; first by eapply wand_entails, twp_xchg. rewrite envs_simple_replace_sound //; simpl. rewrite right_id. by apply sep_mono_r, wand_mono. Qed. Lemma tac_wp_cmpxchg Δ Δ' s E i K l v v1 v2 Φ : MaybeIntoLaterNEnvs 1 Δ Δ' → envs_lookup i Δ' = Some (false, l ↦ v)%I → vals_compare_safe v v1 → match envs_simple_replace i false (Esnoc Enil i (l ↦ v2)) Δ' with | Some Δ'' => v = v1 → envs_entails Δ'' (WP fill K (Val $ PairV v (LitV $ LitBool true)) @ s; E {{ Φ }}) | None => False end → (v ≠ v1 → envs_entails Δ' (WP fill K (Val $ PairV v (LitV $ LitBool false)) @ s; E {{ Φ }})) → envs_entails Δ (WP fill K (CmpXchg (LitV l) (Val v1) (Val v2)) @ s; E {{ Φ }}). Proof. rewrite envs_entails_unseal=> ??? Hsuc Hfail. destruct (envs_simple_replace _ _ _ _) as [Δ''|] eqn:HΔ''; [ | contradiction ]. destruct (decide (v = v1)) as [Heq|Hne]. - rewrite -wp_bind. eapply wand_apply. { eapply wand_entails, wp_cmpxchg_suc; eauto. } 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 wand_entails, wp_cmpxchg_fail; eauto. } 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_cmpxchg Δ s E i K l v v1 v2 Φ : envs_lookup i Δ = Some (false, l ↦ v)%I → vals_compare_safe v v1 → match envs_simple_replace i false (Esnoc Enil i (l ↦ v2)) Δ with | Some Δ' => v = v1 → envs_entails Δ' (WP fill K (Val $ PairV v (LitV $ LitBool true)) @ s; E [{ Φ }]) | None => False end → (v ≠ v1 → envs_entails Δ (WP fill K (Val $ PairV v (LitV $ LitBool false)) @ s; E [{ Φ }])) → envs_entails Δ (WP fill K (CmpXchg (LitV l) v1 v2) @ s; E [{ Φ }]). Proof. rewrite envs_entails_unseal=> ?? Hsuc Hfail. destruct (envs_simple_replace _ _ _ _) as [Δ''|] eqn:HΔ''; [ | contradiction ]. destruct (decide (v = v1)) as [Heq|Hne]. - rewrite -twp_bind. eapply wand_apply. { eapply wand_entails, twp_cmpxchg_suc; eauto. } 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 wand_entails, twp_cmpxchg_fail; eauto. } rewrite /= {1}envs_lookup_split //; simpl. apply sep_mono_r. apply wand_mono; auto. Qed. Lemma tac_wp_cmpxchg_fail Δ Δ' s E i K l q v v1 v2 Φ : MaybeIntoLaterNEnvs 1 Δ Δ' → envs_lookup i Δ' = Some (false, l ↦{q} v)%I → v ≠ v1 → vals_compare_safe v v1 → envs_entails Δ' (WP fill K (Val $ PairV v (LitV $ LitBool false)) @ s; E {{ Φ }}) → envs_entails Δ (WP fill K (CmpXchg (LitV l) v1 v2) @ s; E {{ Φ }}). Proof. rewrite envs_entails_unseal=> ?????. rewrite -wp_bind. eapply wand_apply; first by apply wand_entails, wp_cmpxchg_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_cmpxchg_fail Δ s E i K l q v v1 v2 Φ : envs_lookup i Δ = Some (false, l ↦{q} v)%I → v ≠ v1 → vals_compare_safe v v1 → envs_entails Δ (WP fill K (Val $ PairV v (LitV $ LitBool false)) @ s; E [{ Φ }]) → envs_entails Δ (WP fill K (CmpXchg (LitV l) v1 v2) @ s; E [{ Φ }]). Proof. rewrite envs_entails_unseal. intros. rewrite -twp_bind. eapply wand_apply; first by apply wand_entails, twp_cmpxchg_fail. (* [//] solves some evars and enables further simplification. *) rewrite envs_lookup_split /= // /=. by do 2 f_equiv. Qed. Lemma tac_wp_cmpxchg_suc Δ Δ' s E i K l v v1 v2 Φ : MaybeIntoLaterNEnvs 1 Δ Δ' → envs_lookup i Δ' = Some (false, l ↦ v)%I → v = v1 → vals_compare_safe v v1 → match envs_simple_replace i false (Esnoc Enil i (l ↦ v2)) Δ' with | Some Δ'' => envs_entails Δ'' (WP fill K (Val $ PairV v (LitV $ LitBool true)) @ s; E {{ Φ }}) | None => False end → envs_entails Δ (WP fill K (CmpXchg (LitV l) v1 v2) @ s; E {{ Φ }}). Proof. rewrite envs_entails_unseal=> ?????; subst. destruct (envs_simple_replace _ _ _) as [Δ''|] eqn:HΔ''; [ | contradiction ]. rewrite -wp_bind. eapply wand_apply. { eapply wand_entails, wp_cmpxchg_suc; eauto. } 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_cmpxchg_suc Δ s E i K l v v1 v2 Φ : envs_lookup i Δ = Some (false, l ↦ v)%I → v = v1 → vals_compare_safe v v1 → match envs_simple_replace i false (Esnoc Enil i (l ↦ v2)) Δ with | Some Δ' => envs_entails Δ' (WP fill K (Val $ PairV v (LitV $ LitBool true)) @ s; E [{ Φ }]) | None => False end → envs_entails Δ (WP fill K (CmpXchg (LitV l) v1 v2) @ s; E [{ Φ }]). Proof. rewrite envs_entails_unseal=>????; subst. destruct (envs_simple_replace _ _ _) as [Δ''|] eqn:HΔ''; [ | contradiction ]. rewrite -twp_bind. eapply wand_apply. { eapply wand_entails, twp_cmpxchg_suc; eauto. } rewrite envs_simple_replace_sound //; simpl. rewrite right_id. by apply sep_mono_r, wand_mono. Qed. Lemma tac_wp_faa Δ Δ' s E i K l z1 z2 Φ : MaybeIntoLaterNEnvs 1 Δ Δ' → envs_lookup i Δ' = Some (false, l ↦ LitV z1)%I → match envs_simple_replace i false (Esnoc Enil i (l ↦ LitV (LitInt (z1 + z2)))) Δ' with | Some Δ'' => envs_entails Δ'' (WP fill K (Val $ LitV z1) @ s; E {{ Φ }}) | None => False end → envs_entails Δ (WP fill K (FAA (LitV l) (LitV z2)) @ s; E {{ Φ }}). Proof. rewrite envs_entails_unseal=> ???. destruct (envs_simple_replace _ _ _) as [Δ''|] eqn:HΔ''; [ | contradiction ]. rewrite -wp_bind. eapply wand_apply; first by apply wand_entails, (wp_faa _ _ _ z1 z2). 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_faa Δ s E i K l z1 z2 Φ : envs_lookup i Δ = Some (false, l ↦ LitV z1)%I → match envs_simple_replace i false (Esnoc Enil i (l ↦ LitV (LitInt (z1 + z2)))) Δ with | Some Δ' => envs_entails Δ' (WP fill K (Val $ LitV z1) @ s; E [{ Φ }]) | None => False end → envs_entails Δ (WP fill K (FAA (LitV l) (LitV z2)) @ s; E [{ Φ }]). Proof. rewrite envs_entails_unseal=> ??. destruct (envs_simple_replace _ _ _) as [Δ'|] eqn:HΔ'; [ | contradiction ]. rewrite -twp_bind. eapply wand_apply; first by apply wand_entails, (twp_faa _ _ _ z1 z2). rewrite envs_simple_replace_sound //; simpl. rewrite right_id. by apply sep_mono_r, wand_mono. Qed. End heap. (** The tactic [wp_apply_core lem tac_suc tac_fail] evaluates [lem] to a hypothesis [H] that can be applied, and then runs [wp_bind_core K; tac_suc H] for every possible evaluation context [K]. - The tactic [tac_suc] should do [iApplyHyp H] to actually apply the hypothesis, but can perform other operations in addition (see [wp_apply] and [awp_apply] below). - The tactic [tac_fail cont] is called when [tac_suc H] fails for all evaluation contexts [K], and can perform further operations before invoking [cont] to try again. TC resolution of [lem] premises happens *after* [tac_suc H] got executed. *) Ltac wp_apply_core lem tac_suc tac_fail := first [iPoseProofCore lem as false (fun H => lazymatch goal with | |- envs_entails _ (wp ?s ?E ?e ?Q) => reshape_expr e ltac:(fun K e' => wp_bind_core K; tac_suc H) | |- envs_entails _ (twp ?s ?E ?e ?Q) => reshape_expr e ltac:(fun K e' => twp_bind_core K; tac_suc H) | _ => fail 1 "wp_apply: not a 'wp'" end) |tac_fail ltac:(fun _ => wp_apply_core lem tac_suc tac_fail) |let P := type of lem in fail "wp_apply: cannot apply" lem ":" P ]. Tactic Notation "wp_apply" open_constr(lem) := wp_apply_core lem ltac:(fun H => iApplyHyp H; try iNext; try wp_expr_simpl) ltac:(fun cont => fail). Tactic Notation "wp_smart_apply" open_constr(lem) := wp_apply_core lem ltac:(fun H => iApplyHyp H; try iNext; try wp_expr_simpl) ltac:(fun cont => wp_pure _; []; cont ()). Tactic Notation "wp_apply" open_constr(lem) "as" constr(pat) := wp_apply lem; last iIntros pat. Tactic Notation "wp_apply" open_constr(lem) "as" "(" simple_intropattern(x1) ")" constr(pat) := wp_apply lem; last iIntros ( x1 ) pat. Tactic Notation "wp_apply" open_constr(lem) "as" "(" simple_intropattern(x1) simple_intropattern(x2) ")" constr(pat) := wp_apply lem; last iIntros ( x1 x2 ) pat. Tactic Notation "wp_apply" open_constr(lem) "as" "(" simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3) ")" constr(pat) := wp_apply lem; last iIntros ( x1 x2 x3 ) pat. Tactic Notation "wp_apply" open_constr(lem) "as" "(" simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")" constr(pat) := wp_apply lem; last iIntros ( x1 x2 x3 x4 ) pat. Tactic Notation "wp_apply" open_constr(lem) "as" "(" simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5) ")" constr(pat) := wp_apply lem; last iIntros ( x1 x2 x3 x4 x5 ) pat. Tactic Notation "wp_apply" open_constr(lem) "as" "(" simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5) simple_intropattern(x6) ")" constr(pat) := wp_apply lem; last iIntros ( x1 x2 x3 x4 x5 x6 ) pat. Tactic Notation "wp_apply" 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) := wp_apply lem; last iIntros ( x1 x2 x3 x4 x5 x6 x7 ) pat. Tactic Notation "wp_apply" 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) := wp_apply lem; last iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 ) pat. Tactic Notation "wp_apply" 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) simple_intropattern(x9) ")" constr(pat) := wp_apply lem; last iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 ) pat. Tactic Notation "wp_apply" 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) simple_intropattern(x9) simple_intropattern(x10) ")" constr(pat) := wp_apply lem; last iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 ) pat. Tactic Notation "wp_smart_apply" open_constr(lem) "as" constr(pat) := wp_smart_apply lem; last iIntros pat. Tactic Notation "wp_smart_apply" open_constr(lem) "as" "(" simple_intropattern(x1) ")" constr(pat) := wp_smart_apply lem; last iIntros ( x1 ) pat. Tactic Notation "wp_smart_apply" open_constr(lem) "as" "(" simple_intropattern(x1) simple_intropattern(x2) ")" constr(pat) := wp_smart_apply lem; last iIntros ( x1 x2 ) pat. Tactic Notation "wp_smart_apply" open_constr(lem) "as" "(" simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3) ")" constr(pat) := wp_smart_apply lem; last iIntros ( x1 x2 x3 ) pat. Tactic Notation "wp_smart_apply" open_constr(lem) "as" "(" simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")" constr(pat) := wp_smart_apply lem; last iIntros ( x1 x2 x3 x4 ) pat. Tactic Notation "wp_smart_apply" open_constr(lem) "as" "(" simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5) ")" constr(pat) := wp_smart_apply lem; last iIntros ( x1 x2 x3 x4 x5 ) pat. Tactic Notation "wp_smart_apply" open_constr(lem) "as" "(" simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5) simple_intropattern(x6) ")" constr(pat) := wp_smart_apply lem; last iIntros ( x1 x2 x3 x4 x5 x6 ) pat. Tactic Notation "wp_smart_apply" 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) := wp_smart_apply lem; last iIntros ( x1 x2 x3 x4 x5 x6 x7 ) pat. Tactic Notation "wp_smart_apply" 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) := wp_smart_apply lem; last iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 ) pat. Tactic Notation "wp_smart_apply" 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) simple_intropattern(x9) ")" constr(pat) := wp_smart_apply lem; last iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 ) pat. Tactic Notation "wp_smart_apply" 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) simple_intropattern(x9) simple_intropattern(x10) ")" constr(pat) := wp_smart_apply lem; last iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 ) pat. (** Tactic tailored for atomic triples: the first, simple one just runs [iAuIntro] on the goal, as atomic triples always have an atomic update as their premise. The second one additionaly does some framing: it gets rid of [Hs] from the context, reducing clutter. You get them all back in the continuation of the atomic operation. *) Tactic Notation "awp_apply" open_constr(lem) := (* [pm_prettify] is needed to clean up telescopes. *) wp_apply_core lem ltac:(fun H => iApplyHyp H; pm_prettify) ltac:(fun cont => fail); last iAuIntro. Tactic Notation "awp_apply" open_constr(lem) "without" constr(Hs) := (* Convert "list of hypothesis" into specialization pattern. *) let Hs := words Hs in let Hs := eval vm_compute in (INamed <$> Hs) in wp_apply_core lem ltac:(fun H => iApply (wp_frame_wand with [SGoal $ SpecGoal GSpatial false [] Hs false]); [iAccu|iApplyHyp H; pm_prettify]) ltac:(fun cont => fail); last iAuIntro. 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"]; pm_reduce; lazymatch goal with | |- False => fail 1 "wp_alloc:" H "not fresh" | _ => iDestructHyp Htmp as H; wp_finish end in wp_pures; (** The code first tries to use allocation lemma for a single reference, ie, [tac_wp_alloc] (respectively, [tac_twp_alloc]). If that fails, it tries to use the lemma [tac_wp_allocN] (respectively, [tac_twp_allocN]) for allocating an array. Notice that we could have used the array allocation lemma also for single references. However, that would produce the resource l ↦∗ [v] instead of l ↦ v for single references. These are logically equivalent assertions but are not equal. *) lazymatch goal with | |- envs_entails _ (wp ?s ?E ?e ?Q) => let process_single _ := first [reshape_expr e ltac:(fun K e' => eapply (tac_wp_alloc _ _ _ _ Htmp K)) |fail 1 "wp_alloc: cannot find 'Alloc' in" e]; [tc_solve |finish ()] in let process_array _ := first [reshape_expr e ltac:(fun K e' => eapply (tac_wp_allocN _ _ _ _ Htmp K)) |fail 1 "wp_alloc: cannot find 'Alloc' in" e]; [idtac|tc_solve |finish ()] in (process_single ()) || (process_array ()) | |- envs_entails _ (twp ?s ?E ?e ?Q) => let process_single _ := first [reshape_expr e ltac:(fun K e' => eapply (tac_twp_alloc _ _ _ Htmp K)) |fail 1 "wp_alloc: cannot find 'Alloc' in" e]; finish () in let process_array _ := first [reshape_expr e ltac:(fun K e' => eapply (tac_twp_allocN _ _ _ Htmp K)) |fail 1 "wp_alloc: cannot find 'Alloc' in" e]; [idtac |finish ()] in (process_single ()) || (process_array ()) | _ => fail "wp_alloc: not a 'wp'" end. Tactic Notation "wp_alloc" ident(l) := wp_alloc l as "?". Tactic Notation "wp_free" := let solve_pointsto _ := let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in iAssumptionCore || fail "wp_free: cannot find" l "↦ ?" in wp_pures; lazymatch goal with | |- envs_entails _ (wp ?s ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => eapply (tac_wp_free _ _ _ _ _ K)) |fail 1 "wp_free: cannot find 'Free' in" e]; [tc_solve |solve_pointsto () |pm_reduce; wp_finish] | |- envs_entails _ (twp ?s ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => eapply (tac_twp_free _ _ _ _ K)) |fail 1 "wp_free: cannot find 'Free' in" e]; [solve_pointsto () |pm_reduce; wp_finish] | _ => fail "wp_free: not a 'wp'" end. Tactic Notation "wp_load" := let solve_pointsto _ := let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in iAssumptionCore || fail "wp_load: cannot find" l "↦ ?" in wp_pures; lazymatch goal with | |- envs_entails _ (wp ?s ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => eapply (tac_wp_load _ _ _ _ _ K)) |fail 1 "wp_load: cannot find 'Load' in" e]; [tc_solve |solve_pointsto () |wp_finish] | |- envs_entails _ (twp ?s ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => eapply (tac_twp_load _ _ _ _ K)) |fail 1 "wp_load: cannot find 'Load' in" e]; [solve_pointsto () |wp_finish] | _ => fail "wp_load: not a 'wp'" end. Tactic Notation "wp_store" := let solve_pointsto _ := let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in iAssumptionCore || fail "wp_store: cannot find" l "↦ ?" in wp_pures; lazymatch goal with | |- envs_entails _ (wp ?s ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => eapply (tac_wp_store _ _ _ _ _ K)) |fail 1 "wp_store: cannot find 'Store' in" e]; [tc_solve |solve_pointsto () |pm_reduce; first [wp_seq|wp_finish]] | |- envs_entails _ (twp ?s ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => eapply (tac_twp_store _ _ _ _ K)) |fail 1 "wp_store: cannot find 'Store' in" e]; [solve_pointsto () |pm_reduce; first [wp_seq|wp_finish]] | _ => fail "wp_store: not a 'wp'" end. Tactic Notation "wp_xchg" := let solve_pointsto _ := let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in iAssumptionCore || fail "wp_xchg: cannot find" l "↦ ?" in wp_pures; lazymatch goal with | |- envs_entails _ (wp ?s ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => eapply (tac_wp_xchg _ _ _ _ _ K)) |fail 1 "wp_xchg: cannot find 'Xchg' in" e]; [tc_solve |solve_pointsto () |pm_reduce; first [wp_seq|wp_finish]] | |- envs_entails _ (twp ?s ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => eapply (tac_twp_xchg _ _ _ _ K)) |fail 1 "wp_xchg: cannot find 'Xchg' in" e]; [solve_pointsto () |pm_reduce; first [wp_seq|wp_finish]] | _ => fail "wp_xchg: not a 'wp'" end. Tactic Notation "wp_cmpxchg" "as" simple_intropattern(H1) "|" simple_intropattern(H2) := let solve_pointsto _ := let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in iAssumptionCore || fail "wp_cmpxchg: cannot find" l "↦ ?" in wp_pures; lazymatch goal with | |- envs_entails _ (wp ?s ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => eapply (tac_wp_cmpxchg _ _ _ _ _ K)) |fail 1 "wp_cmpxchg: cannot find 'CmpXchg' in" e]; [tc_solve |solve_pointsto () |try solve_vals_compare_safe |pm_reduce; intros H1; wp_finish |intros H2; wp_finish] | |- envs_entails _ (twp ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => eapply (tac_twp_cmpxchg _ _ _ _ K)) |fail 1 "wp_cmpxchg: cannot find 'CmpXchg' in" e]; [solve_pointsto () |try solve_vals_compare_safe |pm_reduce; intros H1; wp_finish |intros H2; wp_finish] | _ => fail "wp_cmpxchg: not a 'wp'" end. Tactic Notation "wp_cmpxchg_fail" := let solve_pointsto _ := let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in iAssumptionCore || fail "wp_cmpxchg_fail: cannot find" l "↦ ?" in wp_pures; lazymatch goal with | |- envs_entails _ (wp ?s ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => eapply (tac_wp_cmpxchg_fail _ _ _ _ _ K)) |fail 1 "wp_cmpxchg_fail: cannot find 'CmpXchg' in" e]; [tc_solve |solve_pointsto () |try (simpl; congruence) (* value inequality *) |try solve_vals_compare_safe |wp_finish] | |- envs_entails _ (twp ?s ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => eapply (tac_twp_cmpxchg_fail _ _ _ _ K)) |fail 1 "wp_cmpxchg_fail: cannot find 'CmpXchg' in" e]; [solve_pointsto () |try (simpl; congruence) (* value inequality *) |try solve_vals_compare_safe |wp_finish] | _ => fail "wp_cmpxchg_fail: not a 'wp'" end. Tactic Notation "wp_cmpxchg_suc" := let solve_pointsto _ := let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in iAssumptionCore || fail "wp_cmpxchg_suc: cannot find" l "↦ ?" in wp_pures; lazymatch goal with | |- envs_entails _ (wp ?s ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => eapply (tac_wp_cmpxchg_suc _ _ _ _ _ K)) |fail 1 "wp_cmpxchg_suc: cannot find 'CmpXchg' in" e]; [tc_solve |solve_pointsto () |try (simpl; congruence) (* value equality *) |try solve_vals_compare_safe |pm_reduce; wp_finish] | |- envs_entails _ (twp ?s ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => eapply (tac_twp_cmpxchg_suc _ _ _ _ K)) |fail 1 "wp_cmpxchg_suc: cannot find 'CmpXchg' in" e]; [solve_pointsto () |try (simpl; congruence) (* value equality *) |try solve_vals_compare_safe |pm_reduce; wp_finish] | _ => fail "wp_cmpxchg_suc: not a 'wp'" end. Tactic Notation "wp_faa" := let solve_pointsto _ := let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in iAssumptionCore || fail "wp_faa: cannot find" l "↦ ?" in wp_pures; lazymatch goal with | |- envs_entails _ (wp ?s ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => eapply (tac_wp_faa _ _ _ _ _ K)) |fail 1 "wp_faa: cannot find 'FAA' in" e]; [tc_solve |solve_pointsto () |pm_reduce; wp_finish] | |- envs_entails _ (twp ?s ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => eapply (tac_twp_faa _ _ _ _ K)) |fail 1 "wp_faa: cannot find 'FAA' in" e]; [solve_pointsto () |pm_reduce; wp_finish] | _ => fail "wp_faa: not a 'wp'" end. iris-iris-4.2.0/iris_heap_lang/proph_erasure.v000066400000000000000000001040271460620107300214430ustar00rootroot00000000000000From iris.program_logic Require Export adequacy. From iris.heap_lang Require Export lang notation tactics. From iris.prelude Require Import options. (** This file contains the proof that prophecies can be safely erased from programs. We erase a program by replacing prophecy identifiers with the unit values and respectively adapt the [NewProph] and [Resolve] expressions. We prove that if a program [e] is safe with respect to a (pure) postcondition [φ], then program [erase e] is also safe with respect to [φ]. *) Implicit Types e : expr. Implicit Types v w : val. Implicit Types l : loc. Implicit Types n m : Z. Implicit Types i : nat. Definition erase_base_lit (l : base_lit) : base_lit := match l with | LitProphecy p => LitPoison | _ => l end. Definition erase_resolve (e0 e1 e2 : expr) : expr := Fst (Fst (e0, e1, e2)). Definition erased_new_proph : expr := (λ: <>, #LitPoison)%V #(). Fixpoint erase_expr (e : expr) : expr := match e with | Val v => Val (erase_val v) | Var x => Var x | Rec f x e => Rec f x (erase_expr e) | App e1 e2 => App (erase_expr e1) (erase_expr e2) | UnOp op e => UnOp op (erase_expr e) | BinOp op e1 e2 => BinOp op (erase_expr e1) (erase_expr e2) | If e0 e1 e2 => If (erase_expr e0) (erase_expr e1) (erase_expr e2) | Pair e1 e2 => Pair (erase_expr e1) (erase_expr e2) | Fst e => Fst (erase_expr e) | Snd e => Snd (erase_expr e) | InjL e => InjL (erase_expr e) | InjR e => InjR (erase_expr e) | Case e0 e1 e2 => Case (erase_expr e0) (erase_expr e1) (erase_expr e2) | Fork e => Fork (erase_expr e) | AllocN e1 e2 => AllocN (erase_expr e1) (erase_expr e2) | Free e => Free (erase_expr e) | Load e => Load (erase_expr e) | Xchg e1 e2 => Xchg (erase_expr e1) (erase_expr e2) | Store e1 e2 => Store (erase_expr e1) (erase_expr e2) | CmpXchg e0 e1 e2 => CmpXchg (erase_expr e0) (erase_expr e1) (erase_expr e2) | FAA e1 e2 => FAA (erase_expr e1) (erase_expr e2) | NewProph => erased_new_proph | Resolve e0 e1 e2 => erase_resolve (erase_expr e0) (erase_expr e1) (erase_expr e2) end with erase_val (v : val) : val := match v with | LitV l => LitV (erase_base_lit l) | RecV f x e => RecV f x (erase_expr e) | PairV v1 v2 => PairV (erase_val v1) (erase_val v2) | InjLV v => InjLV (erase_val v) | InjRV v => InjRV (erase_val v) end. Lemma erase_expr_subst x v e : erase_expr (subst x v e) = subst x (erase_val v) (erase_expr e) with erase_val_subst x v (w : val) : erase_expr (subst x v w) = subst x (erase_val v) (erase_val w). Proof. - destruct e; simpl; try case_decide; rewrite ?erase_expr_subst ?erase_val_subst; auto. - by destruct v. Qed. Lemma erase_expr_subst' x v e : erase_expr (subst' x v e) = subst' x (erase_val v) (erase_expr e). Proof. destruct x; eauto using erase_expr_subst. Qed. Lemma erase_val_subst' x v (w : val) : erase_expr (subst x v w) = subst x (erase_val v) (erase_val w). Proof. destruct x; eauto using erase_val_subst. Qed. Fixpoint erase_ectx_item (Ki : ectx_item) : list ectx_item := match Ki with | AppLCtx v2 => [AppLCtx (erase_val v2)] | AppRCtx e1 => [AppRCtx (erase_expr e1)] | UnOpCtx op => [UnOpCtx op] | BinOpLCtx op v2 => [BinOpLCtx op (erase_val v2)] | BinOpRCtx op e1 => [BinOpRCtx op (erase_expr e1)] | IfCtx e1 e2 => [IfCtx (erase_expr e1) (erase_expr e2)] | PairLCtx v2 => [PairLCtx (erase_val v2)] | PairRCtx e1 => [PairRCtx (erase_expr e1)] | FstCtx => [FstCtx] | SndCtx => [SndCtx] | InjLCtx => [InjLCtx] | InjRCtx => [InjRCtx] | CaseCtx e1 e2 => [CaseCtx (erase_expr e1) (erase_expr e2)] | AllocNLCtx v2 => [AllocNLCtx (erase_val v2)] | AllocNRCtx e1 => [AllocNRCtx (erase_expr e1)] | FreeCtx => [FreeCtx] | LoadCtx => [LoadCtx] | XchgLCtx v2 => [XchgLCtx (erase_val v2)] | XchgRCtx e1 => [XchgRCtx (erase_expr e1)] | StoreLCtx v2 => [StoreLCtx (erase_val v2)] | StoreRCtx e1 => [StoreRCtx (erase_expr e1)] | CmpXchgLCtx v1 v2 => [CmpXchgLCtx (erase_val v1) (erase_val v2)] | CmpXchgMCtx e0 v2 => [CmpXchgMCtx (erase_expr e0) (erase_val v2)] | CmpXchgRCtx e0 e1 => [CmpXchgRCtx (erase_expr e0) (erase_expr e1)] | FaaLCtx v2 => [FaaLCtx (erase_val v2)] | FaaRCtx e1 => [FaaRCtx (erase_expr e1)] | ResolveLCtx ctx v1 v2 => erase_ectx_item ctx ++ [PairLCtx (erase_val v1); PairLCtx (erase_val v2); FstCtx; FstCtx] | ResolveMCtx e0 v2 => [PairRCtx (erase_expr e0); PairLCtx (erase_val v2); FstCtx; FstCtx] | ResolveRCtx e0 e1 => [PairRCtx (erase_expr e0, erase_expr e1); FstCtx; FstCtx] end. Definition erase_ectx (K : ectx heap_ectx_lang) : ectx heap_ectx_lang := mbind erase_ectx_item K. Definition erase_tp (tp : list expr) : list expr := erase_expr <$> tp. Definition erase_heap (h : gmap loc (option val)) : gmap loc (option val) := (λ ov : option val, erase_val <$> ov) <$> h. Definition erase_state (σ : state) : state := {| heap := erase_heap (heap σ); used_proph_id := ∅ |}. Definition erase_cfg (ρ : cfg heap_lang) : cfg heap_lang := (erase_tp ρ.1, erase_state ρ.2). Lemma erase_to_val e v : to_val (erase_expr e) = Some v → ∃ v', to_val e = Some v' ∧ erase_val v' = v. Proof. destruct e; naive_solver. Qed. Lemma erase_not_val e : to_val e = None → to_val (erase_expr e) = None. Proof. by destruct e. Qed. Lemma erase_ectx_app K K' : erase_ectx (K ++ K') = erase_ectx K ++ erase_ectx K'. Proof. by rewrite /erase_ectx bind_app. Qed. Lemma erase_ectx_expr K e : erase_expr (fill K e) = fill (erase_ectx K) (erase_expr e). Proof. revert e. induction K as [|Ki K IHK] using rev_ind; simplify_eq/=; first done. intros e. rewrite !erase_ectx_app !fill_app /= -IHK {IHK}. induction Ki; rewrite /= ?fill_app /= /erase_resolve; eauto with f_equal. Qed. Lemma val_is_unboxed_erased v : val_is_unboxed (erase_val v) ↔ val_is_unboxed v. Proof. destruct v; rewrite /= /lit_is_unboxed; repeat (done || simpl; case_match). Qed. Lemma vals_compare_safe_erase v1 v2 : vals_compare_safe (erase_val v1) (erase_val v2) ↔ vals_compare_safe v1 v2. Proof. rewrite /vals_compare_safe !val_is_unboxed_erased. done. Qed. Lemma erase_val_inj_iff v1 v2 : vals_compare_safe v1 v2 → erase_val v1 = erase_val v2 ↔ v1 = v2. Proof. destruct v1, v2; rewrite /= /lit_is_unboxed; repeat (done || (by intros [[] | []]) || simpl; case_match). Qed. (** if [un_op_eval] succeeds on erased value, the so should it on the original value. *) Lemma un_op_eval_erase op v v' : un_op_eval op (erase_val v) = Some v' ↔ ∃ w, un_op_eval op v = Some w ∧ erase_val w = v'. Proof. destruct op; simpl; repeat case_match; naive_solver. Qed. (** if [bin_op_eval] succeeds on erased value, then so should it on the original value. *) Lemma bin_op_eval_erase op v1 v2 v' : bin_op_eval op (erase_val v1) (erase_val v2) = Some v' ↔ ∃ w, bin_op_eval op v1 v2 = Some w ∧ erase_val w = v'. Proof. rewrite /bin_op_eval /bin_op_eval_int /bin_op_eval_bool /bin_op_eval_loc; split; [intros ?|intros (?&?&?)]; repeat (case_match; simplify_eq/=); eauto. - eexists _; split; eauto; simpl. erewrite bool_decide_ext; first by eauto. rewrite erase_val_inj_iff; done. - by assert (vals_compare_safe v1 v2) by by apply vals_compare_safe_erase. - by erewrite bool_decide_ext; last apply erase_val_inj_iff. - by assert (vals_compare_safe (erase_val v1) (erase_val v2)) by by apply vals_compare_safe_erase. Qed. Lemma lookup_erase_heap_None h l : erase_heap h !! l = None ↔ h !! l = None. Proof. rewrite lookup_fmap; by destruct (h !! l). Qed. Lemma lookup_erase_heap h l : erase_heap h !! l = (λ ov, erase_val <$> ov) <$> h !! l. Proof. by rewrite lookup_fmap. Qed. Lemma erase_heap_insert_Some h l v : erase_heap (<[l := Some v]> h) = <[l := Some $ erase_val v]> (erase_heap h). Proof. by rewrite /erase_heap fmap_insert. Qed. Lemma erase_heap_insert_None h l v : erase_heap (<[l := None]> h) = <[l := None]> (erase_heap h). Proof. by rewrite /erase_heap fmap_insert. Qed. Lemma fmap_heap_array (f : val → val) l vs : (λ ov : option val, f <$> ov) <$> heap_array l vs = heap_array l (f <$> vs). Proof. revert l; induction vs as [|v vs IHvs]; intros l; first by rewrite /= fmap_empty. by rewrite /= -!insert_union_singleton_l !fmap_insert IHvs. Qed. Lemma erase_heap_array l i v h : erase_heap (heap_array l (replicate i v) ∪ h) = heap_array l (replicate i (erase_val v)) ∪ erase_heap h. Proof. apply map_eq => l'. rewrite /erase_heap lookup_fmap !lookup_union -fmap_replicate - fmap_heap_array !lookup_fmap. by destruct (heap_array l (replicate i v) !! l'); destruct (h !! l'). Qed. Lemma erase_state_init l n v σ: erase_state (state_init_heap l n v σ) = state_init_heap l n (erase_val v) (erase_state σ). Proof. by rewrite /erase_state /state_init_heap /= erase_heap_array. Qed. Definition base_steps_to_erasure_of (e1 : expr) (σ1 : state) (e2 : expr) (σ2 : state) (efs : list expr) := ∃ κ' e2' σ2' efs', base_step e1 σ1 κ' e2' σ2' efs' ∧ erase_expr e2' = e2 ∧ erase_state σ2' = σ2 ∧ erase_tp efs' = efs. Lemma erased_base_step_base_step_rec f x e v σ : base_steps_to_erasure_of ((rec: f x := e)%V v) σ (subst' x (erase_val v) (subst' f (rec: f x := erase_expr e) (erase_expr e))) (erase_state σ) []. Proof. by repeat econstructor; rewrite !erase_expr_subst'. Qed. Lemma erased_base_step_base_step_NewProph σ : base_steps_to_erasure_of NewProph σ #LitPoison (erase_state σ) []. Proof. eexists _, _, _, _; split; first eapply new_proph_id_fresh; done. Qed. Lemma erased_base_step_base_step_AllocN n v σ l : (0 < n)%Z → (∀ i : Z, (0 ≤ i)%Z → (i < n)%Z → erase_heap (heap σ) !! (l +ₗ i) = None) → base_steps_to_erasure_of (AllocN #n v) σ #l (state_init_heap l n (erase_val v) (erase_state σ)) []. Proof. eexists _, _, _, _; simpl; split; first econstructor; try setoid_rewrite <- lookup_erase_heap_None; rewrite ?erase_heap_insert /=; eauto using erase_state_init. Qed. Lemma erased_base_step_base_step_Free l v σ : erase_heap (heap σ) !! l = Some (Some v) → base_steps_to_erasure_of (Free #l) σ #() {| heap := <[l:=None]> (erase_heap (heap σ)); used_proph_id := ∅ |} []. Proof. intros Hl. rewrite lookup_erase_heap in Hl. destruct (heap σ !! l) as [[|]|] eqn:?; simplify_eq/=. eexists _, _, _, _; simpl; split; first econstructor; repeat split; eauto. rewrite /state_upd_heap /erase_state /= erase_heap_insert_None //. Qed. Lemma erased_base_step_base_step_Load l σ v : erase_heap (heap σ) !! l = Some (Some v) → base_steps_to_erasure_of (! #l) σ v (erase_state σ) []. Proof. intros Hl. rewrite lookup_erase_heap in Hl. destruct (heap σ !! l) as [[|]|] eqn:?; simplify_eq/=. eexists _, _, _, _; simpl; split; first econstructor; eauto. Qed. Lemma erased_base_step_base_step_Xchg l v w σ : erase_heap (heap σ) !! l = Some (Some v) → base_steps_to_erasure_of (Xchg #l w) σ v {| heap := <[l:=Some $ erase_val w]> (erase_heap (heap σ)); used_proph_id := ∅ |} []. Proof. intros Hl. rewrite lookup_erase_heap in Hl. destruct (heap σ !! l) as [[|]|] eqn:?; simplify_eq/=. eexists _, _, _, _; simpl; split; first econstructor; repeat split; eauto. rewrite /state_upd_heap /erase_state /= erase_heap_insert_Some //. Qed. Lemma erased_base_step_base_step_Store l v w σ : erase_heap (heap σ) !! l = Some (Some v) → base_steps_to_erasure_of (#l <- w) σ #() {| heap := <[l:=Some $ erase_val w]> (erase_heap (heap σ)); used_proph_id := ∅ |} []. Proof. intros Hl. rewrite lookup_erase_heap in Hl. destruct (heap σ !! l) as [[|]|] eqn:?; simplify_eq/=. eexists _, _, _, _; simpl; split; first econstructor; repeat split; eauto. rewrite /state_upd_heap /erase_state /= erase_heap_insert_Some //. Qed. Lemma erased_base_step_base_step_CmpXchg l v w σ vl : erase_heap (heap σ) !! l = Some (Some vl) → vals_compare_safe vl (erase_val v) → base_steps_to_erasure_of (CmpXchg #l v w) σ (vl, #(bool_decide (vl = erase_val v)))%V (if bool_decide (vl = erase_val v) then {| heap := <[l:=Some $ erase_val w]> (erase_heap (heap σ)); used_proph_id := ∅ |} else erase_state σ) []. Proof. intros Hl Hvl. rewrite lookup_erase_heap in Hl. destruct (heap σ !! l) as [[u|]|] eqn:?; simplify_eq/=. rewrite -> vals_compare_safe_erase in Hvl. destruct (decide (u = v)) as [->|Hneq]. - eexists _, _, _, _; simpl; split. { econstructor; eauto. } rewrite !bool_decide_eq_true_2; eauto using erase_val_inj_iff; []. rewrite -?erase_heap_insert_Some. split_and!; auto. - eexists _, _, _, _; simpl; split. { econstructor; eauto. } rewrite !bool_decide_eq_false_2; eauto; []. by rewrite erase_val_inj_iff. Qed. Lemma erased_base_step_base_step_FAA l n m σ : erase_heap (heap σ) !! l = Some (Some #n) → base_steps_to_erasure_of (FAA #l #m) σ #n {| heap := <[l:= Some #(n + m)]> (erase_heap (heap σ)); used_proph_id := ∅ |} []. Proof. intros Hl. rewrite lookup_erase_heap in Hl. destruct (heap σ !! l) as [[[[]| | | |]|]|] eqn:?; simplify_eq/=. repeat econstructor; first by eauto. by rewrite /state_upd_heap /erase_state /= erase_heap_insert_Some. Qed. (** When the erased program makes a base step, so does the original program. *) Lemma erased_base_step_base_step e1 σ1 κ e2 σ2 efs: base_step (erase_expr e1) (erase_state σ1) κ e2 σ2 efs → base_steps_to_erasure_of e1 σ1 e2 σ2 efs. Proof. intros Hhstep. inversion Hhstep; simplify_eq/=; repeat match goal with | H : _ = erase_expr ?e |- _ => destruct e; simplify_eq/= | H : _ = erase_val ?v |- _ => destruct v; simplify_eq/= | H : _ = erase_base_lit ?l |- _ => destruct l; simplify_eq/= | H : context [erased_new_proph] |- _ => unfold erased_new_proph in H | H : un_op_eval _ (erase_val _) = Some _ |- _ => apply un_op_eval_erase in H as [? [? ?]] | H : bin_op_eval _ (erase_val _) (erase_val _) = Some _ |- _ => apply bin_op_eval_erase in H as [? [? ?]] | H : val_is_unboxed (erase_val _) |- _ => apply -> val_is_unboxed_erased in H end; simplify_eq/=; try (by repeat econstructor); eauto using erased_base_step_base_step_rec, erased_base_step_base_step_NewProph, erased_base_step_base_step_AllocN, erased_base_step_base_step_Free, erased_base_step_base_step_Load, erased_base_step_base_step_Xchg, erased_base_step_base_step_Store, erased_base_step_base_step_CmpXchg, erased_base_step_base_step_FAA. Qed. Lemma fill_to_resolve e v1 v2 K e' : to_val e' = None → Resolve e v1 v2 = fill K e' → K = [] ∨ ∃ K' Ki, K = K' ++ [ResolveLCtx Ki v1 v2]. Proof. intros Hnv Hrs; simpl in *. assert (∀ v K, fill K e' ≠ v) as Hcontr. { intros w K' Hw. assert (to_val (of_val w) = to_val (fill K' e')) as He' by (by rewrite Hw). rewrite fill_not_val in He'; by eauto. } destruct K as [|Ki K _] using rev_ind; first by left. rewrite fill_app in Hrs. destruct Ki; simplify_eq/=; eauto; try exfalso; eapply Hcontr; eauto. Qed. Lemma projs_pure_steps (v0 v1 v2 : val) : rtc pure_step (Fst (Fst (v0, v1, v2))) v0. Proof. etrans; first apply (rtc_pure_step_ctx (fill [PairLCtx _; FstCtx; FstCtx])). { apply rtc_once. apply pure_base_step_pure_step. split; first repeat econstructor. intros ????? Hhstep; inversion Hhstep; simplify_eq/=; eauto. } simpl. etrans; first apply (rtc_pure_step_ctx (fill [FstCtx; FstCtx])). { apply rtc_once. apply pure_base_step_pure_step. split; first repeat econstructor. intros ????? Hhstep; inversion Hhstep; simplify_eq/=; eauto. } simpl. etrans; first apply (rtc_pure_step_ctx (fill [FstCtx])). { apply rtc_once. apply pure_base_step_pure_step. split; first repeat econstructor. intros ????? Hhstep; inversion Hhstep; simplify_eq/=; eauto. } simpl. apply rtc_once. apply pure_base_step_pure_step. split; first repeat econstructor. intros ????? Hhstep; inversion Hhstep; simplify_eq/=; eauto. Qed. Lemma Resolve_3_vals_base_stuck v0 v1 v2 σ κ e σ' efs : ¬ base_step (Resolve v0 v1 v2) σ κ e σ' efs. Proof. intros Hhstep. inversion Hhstep; simplify_eq/=. apply (eq_None_not_Some (to_val (Val v0))); last eauto. by eapply val_base_stuck. Qed. Lemma Resolve_3_vals_unsafe (v0 v1 v2 : val) σ : ¬ not_stuck (Resolve v0 v1 v2) σ. Proof. assert(∀ w K e, Val w = fill K e → is_Some (to_val e)) as Hvfill. { intros ? K ? Heq; eapply (fill_val K); rewrite /= -Heq; eauto. } apply not_not_stuck. split; first done. intros ???? [K e1' e2' Hrs Hhstep]; simplify_eq/=. destruct K as [|Ki K _] using rev_ind. { simplify_eq/=. eapply Resolve_3_vals_base_stuck; eauto. } rewrite fill_app in Hrs. destruct Ki; simplify_eq/=. - rename select ectx_item into Ki. pose proof (fill_item_val Ki (fill K e1')) as Hnv. apply fill_val in Hnv as [? Hnv]; last by rewrite -Hrs; eauto. by erewrite val_base_stuck in Hnv. - edestruct Hvfill as [? Heq]; eauto. by erewrite val_base_stuck in Heq. - edestruct Hvfill as [? Heq]; eauto. by erewrite val_base_stuck in Heq. Qed. (** [(e1, σ1)] takes a [prim_step] to [(e2', σ2')] forking threads [efs'] such that [σ2] is the erasure of [σ2'] and [efs] is the erasure of [efs']. Furthermore, [e2] takes [pure_steps] to match up with [e2]. It is crucial for us that [e2] takes [pure_step]s because we need to know that [e2] does not get stuck and that the steps are deterministic. Essentially, the main part of the erasure proof's argument is that if the erased program takes steps, then the original program also takes matching steps. This however, does not entirely hold. In cases where the erasure of [Resovle] takes a step, the original program immediately produces the value while the erased program has to still perform projections [Fst] to get the result (see the [Resolve] case of [erase_expr]). For this purpose, we prove that in those cases (and also in general) the erased program also takes a number of (possibly zero) steps so that the original and the erased programs are matched up again. *) Definition prim_step_matched_by_erased_steps e1 σ1 e2 σ2 efs := ∃ e2' σ2' κ' efs' e2'', prim_step e1 σ1 κ' e2' σ2' efs' ∧ rtc pure_step e2 e2'' ∧ erase_expr e2' = e2'' ∧ erase_state σ2' = σ2 ∧ erase_tp efs' = efs. Lemma prim_step_matched_by_erased_steps_ectx K e1 σ1 e2 σ2 efs : prim_step_matched_by_erased_steps e1 σ1 e2 σ2 efs → prim_step_matched_by_erased_steps (fill K e1) σ1 (fill (erase_ectx K) e2) σ2 efs. Proof. intros (?&?&?&?&?&?&?&?&?&?); simplify_eq/=. eexists _, _, _, _, _; repeat split. - by apply fill_prim_step. - rewrite erase_ectx_expr. by eapply (rtc_pure_step_ctx (fill (erase_ectx K))). Qed. Definition is_Resolve (e : expr) := match e with Resolve _ _ _ => True | _ => False end. Global Instance is_Resolve_dec e : Decision (is_Resolve e). Proof. destruct e; solve_decision. Qed. Lemma non_resolve_prim_step_matched_by_erased_steps_ectx_item Ki e1 e1' σ1 e2 σ2 efs : to_val e1' = None → ¬ is_Resolve e1 → not_stuck e1 σ1 → erase_expr e1 = fill_item Ki e1' → (∀ e1, erase_expr e1 = e1' → not_stuck e1 σ1 → prim_step_matched_by_erased_steps e1 σ1 e2 σ2 efs) → prim_step_matched_by_erased_steps e1 σ1 (fill_item Ki e2) σ2 efs. Proof. intros Hnv Hnr Hsf He1 IH. destruct Ki; simplify_eq/=; repeat match goal with | H : erase_expr ?e = _ |- _ => destruct e; simplify_eq/=; try done | H : context [erased_new_proph] |- _ => rewrite /erased_new_proph in H; simplify_eq/= | |- prim_step_matched_by_erased_steps ?e _ _ _ _ => let tac K e := lazymatch K with | [] => fail | _ => apply (prim_step_matched_by_erased_steps_ectx K); apply IH; [done| by eapply (not_stuck_fill_inv (fill K))] end in reshape_expr e tac end. Qed. Lemma prim_step_matched_by_erased_steps_ectx_item Ki K e1 e1' σ1 e2 σ2 efs κ : base_step e1' (erase_state σ1) κ e2 σ2 efs → not_stuck e1 σ1 → erase_expr e1 = fill_item Ki (fill K e1') → (∀ K' e1, length K' ≤ length K → erase_expr e1 = (fill K' e1') → not_stuck e1 σ1 → prim_step_matched_by_erased_steps e1 σ1 (fill K' e2) σ2 efs) → prim_step_matched_by_erased_steps e1 σ1 (fill_item Ki (fill K e2)) σ2 efs. Proof. intros Hhstp Hsf He1 IH; simpl in *. (** Case split on whether e1 is a [Resolve] expression. *) destruct (decide (is_Resolve e1)); last first. { (** e1 is not a [Resolve] expression. *) eapply non_resolve_prim_step_matched_by_erased_steps_ectx_item; [|by eauto..]. by eapply fill_not_val, val_base_stuck. } (** e1 is a [Resolve] expression. *) destruct Ki; simplify_eq/=; repeat match goal with | H : erase_expr ?e = ?e' |- _ => progress match e' with | fill _ _ => idtac | _ => destruct e; simplify_eq/= end end; try done. destruct K as [|Ki K _] using rev_ind; simplify_eq/=; [|]. { (* case where (Fst (erase_expr e1_1, erase_expr e1_2, erase_expr e1_3)) *) (* takes a base_step; it is impossible! *) by inversion Hhstp; simplify_eq. } rewrite /erase_resolve fill_app /= in He1; simplify_eq/=. destruct Ki; simplify_eq/=; rewrite fill_app /=. destruct K as [|Ki K _] using rev_ind; simplify_eq/=; [|]. { (* case where (erase_expr e1_1, erase_expr e1_2, erase_expr e1_3) *) (* takes a base_step; it is impossible! *) inversion Hhstp. } rewrite fill_app /= in He1. destruct Ki; simplify_eq/=; rewrite fill_app /=. - destruct K as [|Ki K _] using rev_ind; simplify_eq/=; [|]. { (** [Resolve v0 v1 v2] is not safe! *) inversion Hhstp; simplify_eq/=. repeat match goal with | H : erase_expr ?e = _ |- _ => destruct e; simplify_eq/= | H : _ = erase_expr ?e |- _ => destruct e; simplify_eq/= end. by exfalso; eapply Resolve_3_vals_unsafe. } rewrite fill_app /= in He1. destruct Ki; simplify_eq/=; rewrite fill_app /=. + (** e1 is of the form ([Resolve] e10 e11 v0) and e11 takes a prim_step. *) destruct Hsf as [[? ?]| (?&?&?&?&Hrpstp)]; first done; simpl in *. inversion Hrpstp as [??? Hrs ? Hhstp']; simplify_eq/=. repeat match goal with | H : erase_expr ?e = ?e' |- _ => progress match e' with | fill _ _ => idtac | _ => destruct e; simplify_eq/= end end. edestruct fill_to_resolve as [?|[K' [Ki HK]]]; eauto; [by eapply val_base_stuck| |]; simplify_eq/=. * (** e1 is of the form ([Resolve] e10 e11 v0) and e11 takes a base_step. *) inversion Hhstp'; simplify_eq. edestruct (IH K) as (?&?&?&?&?&Hpstp&?&?&?&?); [rewrite !app_length /=; lia|done|by eapply base_step_not_stuck|]; simplify_eq/=. apply base_reducible_prim_step in Hpstp; simpl in *; last by rewrite /base_reducible /=; eauto 10. epose (λ H, base_step_to_val _ _ _ (Val _) _ _ _ _ _ _ _ H Hpstp) as Hhstv; edestruct Hhstv as [? ?%of_to_val]; [done|eauto|]; simplify_eq. eexists _, _, _, _, _; repeat split; first (by apply base_prim_step; econstructor; eauto); auto. etrans. { by apply (rtc_pure_step_ctx (fill [PairLCtx _; PairLCtx _; FstCtx; FstCtx])). } apply projs_pure_steps. * (** e1 is of the form ([Resolve] e10 v v0) and e10 takes a (non-head) prim_step. *) rewrite fill_app in Hrs; simplify_eq/=. edestruct (IH K) as (?&?&?&?&?&Hpstp&Hprstps&?&?&?); [rewrite !app_length; lia|done| |]. { change (fill_item Ki) with (fill [Ki]). by rewrite -fill_app; eapply prim_step_not_stuck, Ectx_step. } simplify_eq/=. change (fill_item Ki) with (fill [Ki]) in Hpstp. rewrite -fill_app in Hpstp. eapply base_reducible_prim_step_ctx in Hpstp as [e2'' [He2'' Hpstp]]; last by eexists _; eauto. simplify_eq/=. eexists _, _, _, _, _; repeat split. -- apply (fill_prim_step [ResolveLCtx _ _ _]); eapply Ectx_step; eauto. -- simpl; rewrite fill_app in Hprstps. by apply (rtc_pure_step_ctx (fill [PairLCtx _; PairLCtx _; FstCtx; FstCtx])). + (** e1 is of the form ([Resolve] e1_ e1_2 v) and e1_2 takes a prim_step. *) repeat match goal with | H : erase_expr ?e = ?e' |- _ => progress match e' with | fill _ _ => idtac | _ => destruct e; simplify_eq/= end end. apply (prim_step_matched_by_erased_steps_ectx [ResolveMCtx _ _]). apply IH; [rewrite !app_length /=; lia|done| by eapply (not_stuck_fill_inv (fill [ResolveMCtx _ _])); simpl]. - (** e1 is of the form ([Resolve] e1_ e1_2 e13) and e1_3 takes a prim_step. *) apply (prim_step_matched_by_erased_steps_ectx [ResolveRCtx _ _]). apply IH; [rewrite !app_length /=; lia|done| by eapply (not_stuck_fill_inv (fill [ResolveRCtx _ _])); simpl]. Qed. Lemma erased_prim_step_prim_step e1 σ1 κ e2 σ2 efs: prim_step (erase_expr e1) (erase_state σ1) κ e2 σ2 efs → not_stuck e1 σ1 → prim_step_matched_by_erased_steps e1 σ1 e2 σ2 efs. Proof. intros Hstp He1sf. inversion Hstp as [K e1' e2' He1 ? Hhstp]; clear Hstp; simplify_eq/=. set (len := length K); assert (length K = len) as Hlen by done; clearbody len. revert K Hlen e1 He1 He1sf. induction len as [m IHm]using lt_wf_ind; intros K Hlen e1 He1 He1sf; simplify_eq. destruct K as [|Ki K _] using rev_ind; simplify_eq/=. { apply erased_base_step_base_step in Hhstp as (?&?&?&?&?&<-&?&<-). eexists _, _, _, _, _; repeat split; first (by apply base_prim_step); auto using rtc_refl. } rewrite app_length in IHm; simpl in *. rewrite fill_app /=; rewrite fill_app /= in He1. eapply prim_step_matched_by_erased_steps_ectx_item; eauto; []. { intros K' **; simpl in *. apply (IHm (length K')); auto with lia. } Qed. Lemma base_step_erased_prim_step_CmpXchg v1 v2 σ l vl: heap σ !! l = Some (Some vl) → vals_compare_safe vl v1 → ∃ e2' σ2' ef', prim_step (CmpXchg #l (erase_val v1) (erase_val v2)) (erase_state σ) [] e2' σ2' ef'. Proof. intros Hl Hv. destruct (bool_decide (vl = v1)) eqn:Heqvls. - do 3 eexists; apply base_prim_step; econstructor; [|by apply vals_compare_safe_erase|by eauto]. by rewrite /erase_state /state_upd_heap /= lookup_erase_heap Hl. - do 3 eexists; apply base_prim_step; econstructor; [|by apply vals_compare_safe_erase|by eauto]. by rewrite /erase_state /state_upd_heap /= lookup_erase_heap Hl. Qed. Lemma base_step_erased_prim_step_resolve e w σ : (∃ e2' σ2' ef', prim_step (erase_expr e) (erase_state σ) [] e2' σ2' ef') → ∃ e2' σ2' ef', prim_step (erase_resolve (erase_expr e) #LitPoison (erase_val w)) (erase_state σ) [] e2' σ2' ef'. Proof. intros (?&?&?&?). by eexists _, _, _; apply (fill_prim_step [PairLCtx _; PairLCtx _;FstCtx; FstCtx]). Qed. Lemma base_step_erased_prim_step_un_op σ op v v': un_op_eval op v = Some v' → ∃ e2' σ2' ef', prim_step (UnOp op (erase_val v)) (erase_state σ) [] e2' σ2' ef'. Proof. do 3 eexists; apply base_prim_step; econstructor. apply un_op_eval_erase; eauto. Qed. Lemma base_step_erased_prim_step_bin_op σ op v1 v2 v': bin_op_eval op v1 v2 = Some v' → ∃ e2' σ2' ef', prim_step (BinOp op (erase_val v1) (erase_val v2)) (erase_state σ) [] e2' σ2' ef'. Proof. do 3 eexists; apply base_prim_step; econstructor. apply bin_op_eval_erase; eauto. Qed. Lemma base_step_erased_prim_step_allocN σ l n v: (0 < n)%Z → (∀ i : Z, (0 ≤ i)%Z → (i < n)%Z → heap σ !! (l +ₗ i) = None) → ∃ e2' σ2' ef', prim_step (AllocN #n (erase_val v)) (erase_state σ) [] e2' σ2' ef'. Proof. do 3 eexists; apply base_prim_step; econstructor; eauto. intros; rewrite lookup_erase_heap_None; eauto. Qed. Lemma base_step_erased_prim_step_free σ l v : heap σ !! l = Some (Some v) → ∃ e2' σ2' ef', prim_step (Free #l) (erase_state σ) [] e2' σ2' ef'. Proof. intros Hw. do 3 eexists; apply base_prim_step; econstructor. rewrite /erase_state /state_upd_heap /= lookup_erase_heap Hw; eauto. Qed. Lemma base_step_erased_prim_step_load σ l v: heap σ !! l = Some (Some v) → ∃ e2' σ2' ef', prim_step (! #l) (erase_state σ) [] e2' σ2' ef'. Proof. do 3 eexists; apply base_prim_step; econstructor. rewrite /erase_state /state_upd_heap /= lookup_erase_heap. by destruct lookup; simplify_eq. Qed. Lemma base_step_erased_prim_step_xchg σ l v w : heap σ !! l = Some (Some v) → ∃ e2' σ2' ef', prim_step (Xchg #l (erase_val w)) (erase_state σ) [] e2' σ2' ef'. Proof. intros Hl. do 3 eexists; apply base_prim_step; econstructor. rewrite /erase_state /state_upd_heap /= lookup_erase_heap Hl; eauto. Qed. Lemma base_step_erased_prim_step_store σ l v w : heap σ !! l = Some (Some v) → ∃ e2' σ2' ef', prim_step (#l <- erase_val w) (erase_state σ) [] e2' σ2' ef'. Proof. intros Hw. do 3 eexists; apply base_prim_step; econstructor. rewrite /erase_state /state_upd_heap /= lookup_erase_heap Hw; eauto. Qed. Lemma base_step_erased_prim_step_FAA σ l n n': heap σ !! l = Some (Some #n) → ∃ e2' σ2' ef', prim_step (FAA #l #n') (erase_state σ) [] e2' σ2' ef'. Proof. intros Hl. do 3 eexists; apply base_prim_step. econstructor. by rewrite /erase_state /state_upd_heap /= lookup_erase_heap Hl. Qed. (** [Resolve] is translated as a projection out of a triple. Therefore, when resolve takes a head step, the erasure of [Resolve] takes a prim step inside the triple. *) Lemma base_step_erased_prim_step e1 σ1 κ e2 σ2 ef: base_step e1 σ1 κ e2 σ2 ef → ∃ e2' σ2' ef', prim_step (erase_expr e1) (erase_state σ1) [] e2' σ2' ef'. Proof. induction 1; simplify_eq/=; eauto using base_step_erased_prim_step_CmpXchg, base_step_erased_prim_step_resolve, base_step_erased_prim_step_un_op, base_step_erased_prim_step_bin_op, base_step_erased_prim_step_allocN, base_step_erased_prim_step_free, base_step_erased_prim_step_load, base_step_erased_prim_step_store, base_step_erased_prim_step_xchg, base_step_erased_prim_step_FAA; by do 3 eexists; apply base_prim_step; econstructor. Qed. Lemma reducible_erased_reducible e σ : reducible e σ → reducible (erase_expr e) (erase_state σ). Proof. intros (?&?&?&?&Hpstp); simpl in *. inversion Hpstp; simplify_eq/=. rewrite erase_ectx_expr. edestruct base_step_erased_prim_step as (?&?&?&?); first done; simpl in *. eexists _, _, _, _; eapply fill_prim_step; eauto. Qed. Lemma pure_step_tp_safe t1 t2 e1 σ : (∀ e2, e2 ∈ t2 → not_stuck e2 σ) → pure_steps_tp t1 (erase_tp t2) → e1 ∈ t1 → not_stuck e1 (erase_state σ). Proof. intros Ht2 Hpr [i He1]%elem_of_list_lookup_1. eapply Forall2_lookup_l in Hpr as [e2' [He2' Hpr]]; simpl in *; eauto. rewrite /erase_tp list_lookup_fmap in He2'. destruct (t2 !! i) eqn:He2; simplify_eq/=. apply elem_of_list_lookup_2, Ht2 in He2. clear -Hpr He2. inversion Hpr as [|??? [? _]]; simplify_eq. - destruct He2 as [[? ?%of_to_val]|]; simplify_eq/=; first by left; eauto. by right; apply reducible_erased_reducible. - right; eauto using reducible_no_obs_reducible. Qed. (** This is the top-level erasure theorem: erasure preserves adequacy. *) Theorem erasure e σ φ : adequate NotStuck e σ φ → adequate NotStuck (erase_expr e) (erase_state σ) (λ v σ, ∃ v' σ', erase_val v' = v ∧ erase_state σ' = σ ∧ φ v' σ'). Proof. simpl; intros Hade; simpl in *. cut (∀ t2 σ2, rtc erased_step ([erase_expr e], erase_state σ) (t2, σ2) → (∃ t2' t2'' σ2', rtc erased_step ([e], σ) (t2'', σ2') ∧ t2' = erase_tp t2'' ∧ σ2 = erase_state σ2' ∧ pure_steps_tp t2 t2')). { intros Hreach; split; simpl in *. - intros ? ? ? Hrtc; edestruct (Hreach _ _ Hrtc) as (t2'&t2''&σ2'&Hos&Ht2'&Hσ2&Hptp); simplify_eq/=. apply Forall2_cons_inv_l in Hptp as (oe&t3&Hoe%rtc_pure_step_val&_&?); destruct t2''; simplify_eq/=. apply erase_to_val in Hoe as (?&?%of_to_val&?); simplify_eq. pose proof (adequate_result _ _ _ _ Hade _ _ _ Hos); eauto. - intros ? ? ? Hs Hrtc He2; edestruct (Hreach _ _ Hrtc) as (t2'&t2''&σ2'&Hos&Ht2'&Hσ2&Hptp); simplify_eq/=. eapply pure_step_tp_safe; [|done..]. intros e2' He2'. apply (adequate_not_stuck _ _ _ _ Hade _ _ _ eq_refl Hos He2'). } intros t2 σ2 [n Hstps]%rtc_nsteps; simpl in *; revert t2 σ2 Hstps. induction n as [|n IHn]. { intros t2 σ2 Hstps; inversion Hstps; simplify_eq /=. repeat econstructor. } intros t2 σ2 Hstps. apply nsteps_inv_r in Hstps as [[t3 σ3] [Hstps Hρ]]; simpl in *. destruct (IHn _ _ Hstps) as (t2'&t2''&σ2'&Hostps&?&?&Hprstps); simplify_eq. edestruct @erased_step_pure_step_tp as [[? Hint]|Hext]; simplify_eq/=; eauto 10; [|done..]. destruct Hext as (i&ei&t2'&efs&e'&κ&Hi1&Ht2&Hpstp); simplify_eq/=. rewrite /erase_tp list_lookup_fmap in Hi1. destruct (t2'' !! i) as [eio|] eqn:Heq; simplify_eq/=. edestruct erased_prim_step_prim_step as (eio' & σ3 & κ' & efs' & ee & Heiopstp & Hprstps' & ?&?&?); first done; last simplify_eq/=. { eapply adequate_not_stuck; eauto using elem_of_list_lookup_2. } eexists _, _, _; repeat split. { etrans; first done. apply rtc_once; eexists. eapply step_insert; eauto. } rewrite /erase_tp fmap_app. rewrite list_fmap_insert/=. apply Forall2_app; last done. apply Forall2_same_length_lookup; split. { apply Forall2_length in Hprstps; rewrite fmap_length in Hprstps. by rewrite !insert_length fmap_length. } intros j x y. destruct (decide (i = j)); simplify_eq. { rewrite !list_lookup_insert ?fmap_length; eauto using lookup_lt_Some; []. by intros ? ?; simplify_eq. } rewrite !list_lookup_insert_ne // list_lookup_fmap. intros ? ?. eapply Forall2_lookup_lr; eauto. by rewrite /erase_tp list_lookup_fmap. Qed. iris-iris-4.2.0/iris_heap_lang/tactics.v000066400000000000000000000111441460620107300202140ustar00rootroot00000000000000From stdpp Require Import fin_maps. From iris.heap_lang Require Export lang. From iris.prelude Require Import options. Import heap_lang. (** The tactic [reshape_expr e tac] decomposes the expression [e] into an evaluation context [K] and a subexpression [e']. It calls the tactic [tac K e'] for each possible decomposition until [tac] succeeds. *) Ltac reshape_expr e tac := (* Note that the current context is spread into a list of fully-constructed items [K], and a list of pairs of values [vs] (prophecy identifier and resolution value) that is only non-empty if a [ResolveLCtx] item (maybe having several levels) is in the process of being constructed. Note that a fully-constructed item is inserted into [K] by calling [add_item], and that is only the case when a non-[ResolveLCtx] item is built. When [vs] is non-empty, [add_item] also wraps the item under several [ResolveLCtx] constructors: one for each pair in [vs]. *) let rec go K vs e := match e with | _ => lazymatch vs with [] => tac K e | _ => fail end | App ?e (Val ?v) => add_item (AppLCtx v) vs K e | App ?e1 ?e2 => add_item (AppRCtx e1) vs K e2 | UnOp ?op ?e => add_item (UnOpCtx op) vs K e | BinOp ?op ?e (Val ?v) => add_item (BinOpLCtx op v) vs K e | BinOp ?op ?e1 ?e2 => add_item (BinOpRCtx op e1) vs K e2 | If ?e0 ?e1 ?e2 => add_item (IfCtx e1 e2) vs K e0 | Pair ?e (Val ?v) => add_item (PairLCtx v) vs K e | Pair ?e1 ?e2 => add_item (PairRCtx e1) vs K e2 | Fst ?e => add_item FstCtx vs K e | Snd ?e => add_item SndCtx vs K e | InjL ?e => add_item InjLCtx vs K e | InjR ?e => add_item InjRCtx vs K e | Case ?e0 ?e1 ?e2 => add_item (CaseCtx e1 e2) vs K e0 | AllocN ?e (Val ?v) => add_item (AllocNLCtx v) vs K e | AllocN ?e1 ?e2 => add_item (AllocNRCtx e1) vs K e2 | Free ?e => add_item FreeCtx vs K e | Load ?e => add_item LoadCtx vs K e | Store ?e (Val ?v) => add_item (StoreLCtx v) vs K e | Store ?e1 ?e2 => add_item (StoreRCtx e1) vs K e2 | Xchg ?e (Val ?v) => add_item (XchgLCtx v) vs K e | Xchg ?e1 ?e2 => add_item (XchgRCtx e1) vs K e2 | CmpXchg ?e0 (Val ?v1) (Val ?v2) => add_item (CmpXchgLCtx v1 v2) vs K e0 | CmpXchg ?e0 ?e1 (Val ?v2) => add_item (CmpXchgMCtx e0 v2) vs K e1 | CmpXchg ?e0 ?e1 ?e2 => add_item (CmpXchgRCtx e0 e1) vs K e2 | FAA ?e (Val ?v) => add_item (FaaLCtx v) vs K e | FAA ?e1 ?e2 => add_item (FaaRCtx e1) vs K e2 | Resolve ?ex (Val ?v1) (Val ?v2) => go K ((v1,v2) :: vs) ex | Resolve ?ex ?e1 (Val ?v2) => add_item (ResolveMCtx ex v2) vs K e1 | Resolve ?ex ?e1 ?e2 => add_item (ResolveRCtx ex e1) vs K e2 end with add_item Ki vs K e := lazymatch vs with | [] => go (Ki :: K) (@nil (val * val)) e | (?v1,?v2) :: ?vs => add_item (ResolveLCtx Ki v1 v2) vs K e end in go (@nil ectx_item) (@nil (val * val)) e. (** The tactic [inv_base_step] performs inversion on hypotheses of the shape [base_step]. The tactic will discharge head-reductions starting from values, and simplifies hypothesis related to conversions from and to values, and finite map operations. This tactic is slightly ad-hoc and tuned for proving our lifting lemmas. *) Ltac inv_base_step := repeat match goal with | _ => progress simplify_map_eq/= (* simplify memory stuff *) | H : to_val _ = Some _ |- _ => apply of_to_val in H | H : base_step ?e _ _ _ _ _ |- _ => try (is_var e; fail 1); (* inversion yields many goals if [e] is a variable and should thus better be avoided. *) inversion H; subst; clear H end. Create HintDb base_step. Global Hint Extern 0 (base_reducible _ _) => eexists _, _, _, _; simpl : base_step. Global Hint Extern 0 (base_reducible_no_obs _ _) => eexists _, _, _; simpl : base_step. (* [simpl apply] is too stupid, so we need extern hints here. *) Global Hint Extern 1 (base_step _ _ _ _ _ _) => econstructor : base_step. Global Hint Extern 0 (base_step (CmpXchg _ _ _) _ _ _ _ _) => eapply CmpXchgS : base_step. Global Hint Extern 0 (base_step (AllocN _ _) _ _ _ _ _) => apply alloc_fresh : base_step. Global Hint Extern 0 (base_step NewProph _ _ _ _ _) => apply new_proph_id_fresh : base_step. iris-iris-4.2.0/iris_heap_lang/total_adequacy.v000066400000000000000000000017731460620107300215700ustar00rootroot00000000000000From iris.proofmode Require Import proofmode. From iris.base_logic.lib Require Import mono_nat. From iris.program_logic Require Export total_adequacy. From iris.heap_lang Require Export adequacy. From iris.heap_lang Require Import proofmode notation. From iris.prelude Require Import options. Definition heap_total Σ `{!heapGpreS Σ} s e σ φ : (∀ `{!heapGS_gen HasNoLc Σ}, ⊢ inv_heap_inv -∗ WP e @ s; ⊤ [{ v, ⌜φ v⌝ }]) → sn erased_step ([e], σ). Proof. intros Hwp; eapply (twp_total _ _); iIntros (?) "". iMod (gen_heap_init σ.(heap)) as (?) "[Hh _]". iMod (inv_heap_init loc (option val)) as (?) ">Hi". iMod (proph_map_init [] σ.(used_proph_id)) as (?) "Hp". iMod (mono_nat_own_alloc 0) as (γ) "[Hsteps _]". iModIntro. iExists (λ σ ns κs _, (gen_heap_interp σ.(heap) ∗ proph_map_interp κs σ.(used_proph_id) ∗ mono_nat_auth_own γ 1 ns)%I), id, (λ _, True%I), _; iFrame. by iApply (Hwp (HeapGS _ _ _ _ _ _ _ _)). Qed. iris-iris-4.2.0/iris_unstable/000077500000000000000000000000001460620107300162715ustar00rootroot00000000000000iris-iris-4.2.0/iris_unstable/.keep000066400000000000000000000000001460620107300172040ustar00rootroot00000000000000iris-iris-4.2.0/iris_unstable/algebra/000077500000000000000000000000001460620107300176665ustar00rootroot00000000000000iris-iris-4.2.0/iris_unstable/algebra/list.v000066400000000000000000000551271460620107300210420ustar00rootroot00000000000000(** This file is still experimental. See its tracking issue https://gitlab.mpi-sws.org/iris/iris/-/issues/407 for details on remaining issues before stabilization. *) From stdpp Require Export list. From iris.algebra Require Export cmra list. From iris.algebra Require Import updates local_updates big_op. From iris.prelude Require Import options. (* CMRA. Only works if [A] has a unit! *) Section cmra. Context {A : ucmra}. Implicit Types l : list A. Local Arguments op _ _ !_ !_ / : simpl nomatch. Local Instance list_op_instance : Op (list A) := fix go l1 l2 := let _ : Op _ := @go in match l1, l2 with | [], _ => l2 | _, [] => l1 | x :: l1, y :: l2 => x ⋅ y :: l1 ⋅ l2 end. Local Instance list_pcore_instance : PCore (list A) := λ l, Some (core <$> l). Local Instance list_valid_instance : Valid (list A) := Forall (λ x, ✓ x). Local Instance list_validN_instance : ValidN (list A) := λ n, Forall (λ x, ✓{n} x). Lemma cons_valid l x : ✓ (x :: l) ↔ ✓ x ∧ ✓ l. Proof. apply Forall_cons. Qed. Lemma cons_validN n l x : ✓{n} (x :: l) ↔ ✓{n} x ∧ ✓{n} l. Proof. apply Forall_cons. Qed. Lemma app_valid l1 l2 : ✓ (l1 ++ l2) ↔ ✓ l1 ∧ ✓ l2. Proof. apply Forall_app. Qed. Lemma app_validN n l1 l2 : ✓{n} (l1 ++ l2) ↔ ✓{n} l1 ∧ ✓{n} l2. Proof. apply Forall_app. Qed. Lemma list_lookup_valid l : ✓ l ↔ ∀ i, ✓ (l !! i). Proof. rewrite {1}/valid /list_valid_instance Forall_lookup; split. - intros Hl i. by destruct (l !! i) as [x|] eqn:?; [apply (Hl i)|]. - intros Hl i x Hi. move: (Hl i); by rewrite Hi. Qed. Lemma list_lookup_validN n l : ✓{n} l ↔ ∀ i, ✓{n} (l !! i). Proof. rewrite {1}/validN /list_validN_instance Forall_lookup; split. - intros Hl i. by destruct (l !! i) as [x|] eqn:?; [apply (Hl i)|]. - intros Hl i x Hi. move: (Hl i); by rewrite Hi. Qed. Lemma list_lookup_op l1 l2 i : (l1 ⋅ l2) !! i = l1 !! i ⋅ l2 !! i. Proof. revert i l2. induction l1 as [|x l1]; intros [|i] [|y l2]; by rewrite /= ?left_id_L ?right_id_L. Qed. Lemma list_lookup_core l i : core l !! i = core (l !! i). Proof. rewrite /core /= list_lookup_fmap. destruct (l !! i); by rewrite /= ?Some_core. Qed. Lemma list_lookup_included l1 l2 : l1 ≼ l2 ↔ ∀ i, l1 !! i ≼ l2 !! i. Proof. split. { intros [l Hl] i. exists (l !! i). by rewrite Hl list_lookup_op. } revert l1. induction l2 as [|y l2 IH]=>-[|x l1] Hl. - by exists []. - destruct (Hl 0) as [[z|] Hz]; inversion Hz. - by exists (y :: l2). - destruct (IH l1) as [l3 ?]; first (intros i; apply (Hl (S i))). destruct (Hl 0) as [[z|] Hz]; inversion_clear Hz; simplify_eq/=. + exists (z :: l3); by constructor. + exists (core x :: l3); constructor; by rewrite ?cmra_core_r. Qed. Definition list_cmra_mixin : CmraMixin (list A). Proof. apply cmra_total_mixin. - eauto. - intros n l l1 l2; rewrite !list_dist_lookup=> Hl i. by rewrite !list_lookup_op Hl. - intros n l1 l2 Hl; by rewrite /core /= Hl. - intros n l1 l2; rewrite !list_dist_lookup !list_lookup_validN=> Hl ? i. by rewrite -Hl. - intros l. rewrite list_lookup_valid. setoid_rewrite list_lookup_validN. setoid_rewrite cmra_valid_validN. naive_solver. - intros n x. rewrite !list_lookup_validN. auto using cmra_validN_S. - intros l1 l2 l3; rewrite list_equiv_lookup=> i. by rewrite !list_lookup_op assoc. - intros l1 l2; rewrite list_equiv_lookup=> i. by rewrite !list_lookup_op comm. - intros l; rewrite list_equiv_lookup=> i. by rewrite list_lookup_op list_lookup_core cmra_core_l. - intros l; rewrite list_equiv_lookup=> i. by rewrite !list_lookup_core cmra_core_idemp. - intros l1 l2; rewrite !list_lookup_included=> Hl i. rewrite !list_lookup_core. by apply cmra_core_mono. - intros n l1 l2. rewrite !list_lookup_validN. setoid_rewrite list_lookup_op. eauto using cmra_validN_op_l. - intros n l. induction l as [|x l IH]=> -[|y1 l1] [|y2 l2] Hl Heq; (try by exfalso; inversion Heq). + by exists [], []. + exists [], (x :: l); inversion Heq; by repeat constructor. + exists (x :: l), []; inversion Heq; by repeat constructor. + destruct (IH l1 l2) as (l1'&l2'&?&?&?), (cmra_extend n x y1 y2) as (y1'&y2'&?&?&?); [by inversion_clear Heq; inversion_clear Hl..|]. exists (y1' :: l1'), (y2' :: l2'); repeat constructor; auto. Qed. Canonical Structure listR := Cmra (list A) list_cmra_mixin. Global Instance list_unit_instance : Unit (list A) := []. Definition list_ucmra_mixin : UcmraMixin (list A). Proof. split. - constructor. - by intros l. - by constructor. Qed. Canonical Structure listUR := Ucmra (list A) list_ucmra_mixin. Global Instance list_cmra_discrete : CmraDiscrete A → CmraDiscrete listR. Proof. split; [apply _|]=> l; rewrite list_lookup_valid list_lookup_validN=> Hl i. by apply cmra_discrete_valid. Qed. Lemma list_core_id' l : (∀ x, x ∈ l → CoreId x) → CoreId l. Proof. intros Hyp. constructor. apply list_equiv_lookup=> i. rewrite list_lookup_core. destruct (l !! i) eqn:E; last done. by eapply Hyp, elem_of_list_lookup_2. Qed. Global Instance list_core_id l : (∀ x : A, CoreId x) → CoreId l. Proof. intros Hyp; by apply list_core_id'. Qed. End cmra. Global Arguments listR : clear implicits. Global Arguments listUR : clear implicits. Global Instance list_singletonM {A : ucmra} : SingletonM nat A (list A) := λ n x, replicate n ε ++ [x]. Section properties. Context {A : ucmra}. Implicit Types l : list A. Implicit Types x y z : A. Local Arguments op _ _ !_ !_ / : simpl nomatch. Local Arguments cmra_op _ !_ !_ / : simpl nomatch. Local Arguments ucmra_op _ !_ !_ / : simpl nomatch. Lemma list_lookup_opM l mk i : (l ⋅? mk) !! i = l !! i ⋅ (mk ≫= (.!! i)). Proof. destruct mk; by rewrite /= ?list_lookup_op ?right_id_L. Qed. Global Instance list_op_nil_l : LeftId (=) (@nil A) op. Proof. done. Qed. Global Instance list_op_nil_r : RightId (=) (@nil A) op. Proof. by intros []. Qed. Lemma list_op_app l1 l2 l3 : (l1 ++ l3) ⋅ l2 = (l1 ⋅ take (length l1) l2) ++ (l3 ⋅ drop (length l1) l2). Proof. revert l2 l3. induction l1 as [|x1 l1]=> -[|x2 l2] [|x3 l3]; f_equal/=; auto. Qed. Lemma list_op_app_le l1 l2 l3 : length l2 ≤ length l1 → (l1 ++ l3) ⋅ l2 = (l1 ⋅ l2) ++ l3. Proof. intros ?. by rewrite list_op_app take_ge // drop_ge // right_id_L. Qed. Lemma list_drop_op l1 l2 i: drop i l1 ⋅ drop i l2 = drop i (l1 ⋅ l2). Proof. apply list_eq. intros j. rewrite list_lookup_op !lookup_drop -list_lookup_op. done. Qed. Lemma list_take_op l1 l2 i: take i l1 ⋅ take i l2 = take i (l1 ⋅ l2). Proof. apply list_eq. intros j. rewrite list_lookup_op. destruct (decide (j < i)%nat). - by rewrite !lookup_take // -list_lookup_op. - by rewrite !lookup_take_ge //; lia. Qed. Lemma list_lookup_validN_Some n l i x : ✓{n} l → l !! i ≡{n}≡ Some x → ✓{n} x. Proof. move=> /list_lookup_validN /(_ i)=> Hl Hi; move: Hl. by rewrite Hi. Qed. Lemma list_lookup_valid_Some l i x : ✓ l → l !! i ≡ Some x → ✓ x. Proof. move=> /list_lookup_valid /(_ i)=> Hl Hi; move: Hl. by rewrite Hi. Qed. Lemma list_length_op l1 l2 : length (l1 ⋅ l2) = max (length l1) (length l2). Proof. revert l2. induction l1; intros [|??]; f_equal/=; auto. Qed. Lemma replicate_valid n (x : A) : ✓ x → ✓ replicate n x. Proof. apply Forall_replicate. Qed. Global Instance list_singletonM_ne i : NonExpansive (singletonM (M:=list A) i). Proof. intros n l1 l2 ?. apply Forall2_app; by repeat constructor. Qed. Global Instance list_singletonM_proper i : Proper ((≡) ==> (≡)) (singletonM (M:=list A) i) := ne_proper _. Lemma elem_of_list_singletonM i z x : z ∈ ({[i := x]} : list A) → z = ε ∨ z = x. Proof. rewrite elem_of_app elem_of_list_singleton elem_of_replicate. naive_solver. Qed. Lemma list_lookup_singletonM i x : ({[ i := x ]} : list A) !! i = Some x. Proof. induction i; by f_equal/=. Qed. Lemma list_lookup_singletonM_lt i i' x: (i' < i)%nat → ({[ i := x ]} : list A) !! i' = Some ε. Proof. move: i'. induction i; intros [|i']; naive_solver auto with lia. Qed. Lemma list_lookup_singletonM_gt i i' x: (i < i')%nat → ({[ i := x ]} : list A) !! i' = None. Proof. move: i'. induction i; intros [|i']; naive_solver auto with lia. Qed. 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 lia. Qed. Lemma list_singletonM_validN n i x : ✓{n} ({[ i := x ]} : list A) ↔ ✓{n} x. Proof. rewrite list_lookup_validN. split. { move=> /(_ i). by rewrite list_lookup_singletonM. } intros Hx j; destruct (decide (i = j)); subst. - by rewrite list_lookup_singletonM. - destruct (list_lookup_singletonM_ne i j x) as [Hi|Hi]; first done; rewrite Hi; by try apply (ucmra_unit_validN (A:=A)). Qed. Lemma list_singletonM_valid i x : ✓ ({[ i := x ]} : list A) ↔ ✓ x. Proof. rewrite !cmra_valid_validN. by setoid_rewrite list_singletonM_validN. Qed. Lemma list_singletonM_length i x : length {[ i := x ]} = S i. Proof. rewrite /singletonM /list_singletonM app_length replicate_length /=; lia. Qed. Lemma list_singletonM_core i (x : A) : core {[ i := x ]} ≡@{list A} {[ i := core x ]}. Proof. rewrite /singletonM /list_singletonM. by rewrite {1}/core /= fmap_app fmap_replicate (core_id_core _). Qed. Lemma list_singletonM_op i (x y : A) : {[ i := x ]} ⋅ {[ i := y ]} ≡@{list A} {[ i := x ⋅ y ]}. Proof. rewrite /singletonM /list_singletonM /=. induction i; constructor; rewrite ?left_id; auto. Qed. Lemma list_alter_singletonM f i x : alter f i ({[i := x]} : list A) = {[i := f x]}. Proof. rewrite /singletonM /list_singletonM /=. induction i; f_equal/=; auto. Qed. Global Instance list_singletonM_core_id i (x : A) : CoreId x → CoreId {[ i := x ]}. Proof. by rewrite !core_id_total list_singletonM_core=> ->. Qed. Lemma list_singletonM_snoc l x: {[length l := x]} ⋅ l ≡ l ++ [x]. Proof. elim: l => //= ?? <-. by rewrite left_id. Qed. Lemma list_singletonM_included i x l: {[i := x]} ≼ l ↔ (∃ x', l !! i = Some x' ∧ x ≼ x'). Proof. rewrite list_lookup_included. split. { move /(_ i). rewrite list_lookup_singletonM option_included_total. naive_solver. } intros (y&Hi&?) j. destruct (Nat.lt_total j i) as [?|[->|?]]. - rewrite list_lookup_singletonM_lt //. destruct (lookup_lt_is_Some_2 l j) as [z Hz]. { trans i; eauto using lookup_lt_Some. } rewrite Hz. by apply Some_included_mono, ucmra_unit_least. - rewrite list_lookup_singletonM Hi. by apply Some_included_mono. - rewrite list_lookup_singletonM_gt //. apply: ucmra_unit_least. Qed. (* Update *) Lemma list_singletonM_updateP (P : A → Prop) (Q : list A → Prop) x : 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 (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. move: (Hv i) Hv'. by destruct i, lf; rewrite /= ?right_id. Qed. Lemma list_singletonM_updateP' (P : A → Prop) x : x ~~>: P → [x] ~~>: λ k, ∃ y, k = [y] ∧ P y. Proof. eauto using list_singletonM_updateP. Qed. Lemma list_singletonM_update x y : x ~~> y → [x] ~~> [y]. Proof. rewrite !cmra_update_updateP; eauto using list_singletonM_updateP with subst. Qed. Lemma app_updateP (P1 P2 Q : list A → Prop) l1 l2 : l1 ~~>: P1 → l2 ~~>: P2 → (∀ k1 k2, P1 k1 → P2 k2 → length l1 = length k1 ∧ Q (k1 ++ k2)) → l1 ++ l2 ~~>: Q. Proof. rewrite !cmra_total_updateP=> Hup1 Hup2 HQ n lf. rewrite list_op_app app_validN=> -[??]. destruct (Hup1 n (take (length l1) lf)) as (k1&?&?); auto. destruct (Hup2 n (drop (length l1) lf)) as (k2&?&?); auto. exists (k1 ++ k2). rewrite list_op_app app_validN. by destruct (HQ k1 k2) as [<- ?]. Qed. Lemma app_update l1 l2 k1 k2 : length l1 = length k1 → l1 ~~> k1 → l2 ~~> k2 → l1 ++ l2 ~~> k1 ++ k2. Proof. rewrite !cmra_update_updateP; eauto using app_updateP with subst. Qed. Lemma cons_updateP (P1 : A → Prop) (P2 Q : list A → Prop) x l : x ~~>: P1 → l ~~>: P2 → (∀ y k, P1 y → P2 k → Q (y :: k)) → x :: l ~~>: Q. Proof. intros. eapply (app_updateP _ _ _ [x]); naive_solver eauto using list_singletonM_updateP'. Qed. Lemma cons_updateP' (P1 : A → Prop) (P2 : list A → Prop) x l : x ~~>: P1 → l ~~>: P2 → x :: l ~~>: λ k, ∃ y k', k = y :: k' ∧ P1 y ∧ P2 k'. Proof. eauto 10 using cons_updateP. Qed. Lemma cons_update x y l k : x ~~> y → l ~~> k → x :: l ~~> y :: k. Proof. rewrite !cmra_update_updateP; eauto using cons_updateP with subst. Qed. Lemma list_middle_updateP (P : A → Prop) (Q : list A → Prop) l1 x l2 : x ~~>: P → (∀ y, P y → Q (l1 ++ y :: l2)) → l1 ++ x :: l2 ~~>: Q. Proof. intros. eapply app_updateP. - by apply cmra_update_updateP. - by eapply cons_updateP', cmra_update_updateP. - naive_solver. Qed. Lemma list_middle_update l1 l2 x y : x ~~> y → l1 ++ x :: l2 ~~> l1 ++ y :: l2. Proof. rewrite !cmra_update_updateP=> ?; eauto using list_middle_updateP with subst. Qed. (* FIXME Lemma list_middle_local_update l1 l2 x y ml : x ~l~> y @ ml ≫= (.!! length l1) → l1 ++ x :: l2 ~l~> l1 ++ y :: l2 @ ml. Proof. intros [Hxy Hxy']; split. - intros n; rewrite !list_lookup_validN=> Hl i; move: (Hl i). destruct (lt_eq_lt_dec i (length l1)) as [[?|?]|?]; subst. + by rewrite !list_lookup_opM !lookup_app_l. + rewrite !list_lookup_opM !list_lookup_middle // !Some_op_opM; apply (Hxy n). + rewrite !(cons_middle _ l1 l2) !assoc. rewrite !list_lookup_opM !lookup_app_r !app_length //=; lia. - intros n mk; rewrite !list_lookup_validN !list_dist_lookup => Hl Hl' i. move: (Hl i) (Hl' i). destruct (lt_eq_lt_dec i (length l1)) as [[?|?]|?]; subst. + by rewrite !list_lookup_opM !lookup_app_l. + rewrite !list_lookup_opM !list_lookup_middle // !Some_op_opM !inj_iff. apply (Hxy' n). + rewrite !(cons_middle _ l1 l2) !assoc. rewrite !list_lookup_opM !lookup_app_r !app_length //=; lia. Qed. Lemma list_singleton_local_update i x y ml : x ~l~> y @ ml ≫= (.!! i) → {[ i := x ]} ~l~> {[ i := y ]} @ ml. Proof. intros; apply list_middle_local_update. by rewrite replicate_length. Qed. *) Lemma list_alloc_singletonM_local_update x l : ✓ x → (l, ε) ~l~> (l ++ [x], {[length l := x]}). Proof. move => ?. have -> : ({[length l := x]} ≡@{list A} {[length l := x]} ⋅ ε) by rewrite right_id. rewrite -list_singletonM_snoc. apply op_local_update => ??. rewrite list_singletonM_snoc app_validN cons_validN. split_and? => //; [| constructor]. by apply cmra_valid_validN. Qed. Lemma list_lookup_local_update l k l' k': (∀ i, (l !! i, k !! i) ~l~> (l' !! i, k' !! i)) → (l, k) ~l~> (l', k'). Proof. intros Hup. apply local_update_unital=> n z Hlv Hl. assert (∀ i, ✓{n} (l' !! i) /\ l' !! i ≡{n}≡ (k' ⋅ z) !! i) as Hup'. { intros i. destruct (Hup i n (Some (z !! i))); simpl in *. - by apply list_lookup_validN. - rewrite -list_lookup_op. by apply list_dist_lookup. - by rewrite list_lookup_op. } split; [apply list_lookup_validN | apply list_dist_lookup]. all: intros i; by destruct (Hup' i). Qed. Lemma list_alter_local_update i f g l k: (l !! i, k !! i) ~l~> (f <$> (l !! i), g <$> (k !! i)) → (l, k) ~l~> (alter f i l, alter g i k). Proof. intros Hup. apply list_lookup_local_update. intros i'. destruct (decide (i = i')) as [->|]. - rewrite !list_lookup_alter //. - rewrite !list_lookup_alter_ne //. Qed. (* The "⋅ (replicate ... ++ ...)" part is needed because `m` could be shorter than `l`. *) Lemma app_l_local_update l k k' m m': (k, drop (length l) m) ~l~> (k', m') → (l ++ k, m) ~l~> (l ++ k', take (length l) m ⋅ (replicate (length l) ε ++ m')). Proof. move /(local_update_unital _) => HUp. apply local_update_unital => n mm /(app_validN _) [Hlv Hkv] Heq. move: (HUp n (drop (length l) mm) Hkv). intros [Hk'v Hk'eq]; first by rewrite list_drop_op -Heq drop_app_le // drop_ge //. split; first by apply app_validN. rewrite Hk'eq. apply list_dist_lookup. intros i. rewrite !list_lookup_op. destruct (decide (i < length l)%nat) as [HLt|HGe]. - rewrite !lookup_app_l //; last by rewrite replicate_length. rewrite lookup_take; last done. rewrite lookup_replicate_2; last done. rewrite comm assoc -list_lookup_op. rewrite (mixin_cmra_comm _ list_cmra_mixin) -Heq. rewrite lookup_app_l; last done. apply lookup_lt_is_Some in HLt as [? HEl]. by rewrite HEl -Some_op ucmra_unit_right_id. - assert (length l ≤ i)%nat as HLe by lia. rewrite !lookup_app_r //; last by rewrite replicate_length. rewrite replicate_length. rewrite lookup_take_ge; last done. replace (mm !! _) with (drop (length l) mm !! (i - length l)%nat); last by rewrite lookup_drop; congr (mm !! _); lia. rewrite -assoc -list_lookup_op. symmetry. clear. move: n. apply equiv_dist. apply: ucmra_unit_left_id. Qed. Lemma app_l_local_update' l k k' m: (k, ε) ~l~> (k', m) → (l ++ k, ε) ~l~> (l ++ k', replicate (length l) ε ++ m). Proof. remember (app_l_local_update l k k' ε m) as HH eqn:HeqHH. clear HeqHH. move: HH. by rewrite take_nil drop_nil ucmra_unit_left_id. Qed. Lemma app_local_update l m: ✓ m → (l, ε) ~l~> (l ++ m, replicate (length l) ε ++ m). Proof. move: (app_l_local_update' l [] m m). rewrite app_nil_r. move=> H Hvm. apply H. apply local_update_unital=> n z _. rewrite ucmra_unit_left_id. move=><-. rewrite ucmra_unit_right_id. split; last done. by apply cmra_valid_validN. Qed. (* The "replicate ..." part is needed because `m'` could be shorter than `l`. *) Lemma app_r_local_update l l' k m m': length l = length l' → (l, take (length l) m) ~l~> (l', m') → (l ++ k, m) ~l~> (l' ++ k, replicate (length l) ε ⋅ m' ++ drop (length l) m). Proof. move=> HLen /(local_update_unital _) HUp. apply local_update_unital=> n mm /(app_validN _) [Hlv Hkv] Heq. move: (HUp n (take (length l) mm) Hlv). intros [Hl'v Hl'eq]; first by rewrite list_take_op -Heq take_app_le // take_ge //. split; first by apply app_validN. assert (k ≡{n}≡ (drop (length l) (m ⋅ mm))) as -> by rewrite -Heq drop_app_le // drop_ge //. move: HLen. rewrite Hl'eq. clear. move=> HLen. assert (length m' ≤ length l)%nat as HLen'. { by rewrite list_length_op in HLen; lia. } rewrite list_op_app list_length_op replicate_length max_l; last lia. rewrite list_drop_op -assoc. rewrite HLen. move: HLen'. remember (length l) as o. clear. rewrite list_length_op. remember (length _ `max` length _)%nat as o'. assert (m' ⋅ take o' mm ≡{n}≡ replicate o' ε ⋅ (m' ⋅ take o' mm)) as <-; last done. subst. remember (m' ⋅ take _ _) as m''. remember (length m' `max` length (take o mm))%nat as o''. assert (o'' ≤ length m'')%nat as HLen. { by subst; rewrite list_length_op !take_length; lia. } move: HLen. clear. intros HLen. move: n. apply equiv_dist, list_equiv_lookup. intros i. rewrite list_lookup_op. remember length as L eqn:HeqL. destruct (decide (i < L m''))%nat as [E|E]. - subst. apply lookup_lt_is_Some in E as [? HEl]. rewrite HEl. destruct (replicate _ _ !! _) eqn:Z; last done. apply lookup_replicate in Z as [-> _]. by rewrite -Some_op ucmra_unit_left_id. - rewrite lookup_ge_None_2. { rewrite lookup_ge_None_2 //. by rewrite replicate_length; lia. } rewrite -HeqL. lia. Qed. Lemma app_r_local_update' l l' k k': length l = length l' → (l, ε) ~l~> (l', k') → (l ++ k, ε) ~l~> (l' ++ k, k'). Proof. move=> HLen /(local_update_unital _) HUp. apply local_update_unital=> n mz /(app_validN _) [Hlv Hkv]. move: (HUp n l). rewrite !ucmra_unit_left_id. intros [Hk'v Hk'eq] <-; [done|done|]. split; first by apply app_validN. move: HLen. rewrite Hk'eq. clear. move=> HLen. assert (length k' ≤ length l)%nat as Hk'Len by (rewrite HLen list_length_op; lia). rewrite (mixin_cmra_comm _ list_cmra_mixin k' (l ++ k)). rewrite list_op_app_le; last done. by rewrite (mixin_cmra_comm _ list_cmra_mixin l k'). Qed. End properties. (** Functor *) Global Instance list_fmap_cmra_morphism {A B : ucmra} (f : A → B) `{!CmraMorphism f} : CmraMorphism (fmap f : list A → list B). Proof. split; try apply _. - intros n l. rewrite !list_lookup_validN=> Hl i. rewrite list_lookup_fmap. by apply (cmra_morphism_validN (fmap f : option A → option B)). - intros l. apply Some_proper. rewrite -!list_fmap_compose. apply list_fmap_equiv_ext=>???. apply cmra_morphism_core, _. - intros l1 l2. apply list_equiv_lookup=>i. by rewrite list_lookup_op !list_lookup_fmap list_lookup_op cmra_morphism_op. Qed. Program Definition listURF (F : urFunctor) : urFunctor := {| urFunctor_car A _ B _ := listUR (urFunctor_car F A B); urFunctor_map A1 _ A2 _ B1 _ B2 _ fg := listO_map (urFunctor_map F fg) |}. Next Obligation. by intros F A1 ? A2 ? B1 ? B2 ? n f g Hfg; apply listO_map_ne, urFunctor_map_ne. Qed. Next Obligation. intros F A ? B ? x. rewrite /= -{2}(list_fmap_id x). apply list_fmap_equiv_ext=>???. apply urFunctor_map_id. Qed. Next Obligation. intros F A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x. rewrite /= -list_fmap_compose. apply list_fmap_equiv_ext=>???; apply urFunctor_map_compose. Qed. Global Instance listURF_contractive F : urFunctorContractive F → urFunctorContractive (listURF F). Proof. by intros ? A1 ? A2 ? B1 ? B2 ? n f g Hfg; apply listO_map_ne, urFunctor_map_contractive. Qed. Program Definition listRF (F : urFunctor) : rFunctor := {| rFunctor_car A _ B _ := listR (urFunctor_car F A B); rFunctor_map A1 _ A2 _ B1 _ B2 _ fg := listO_map (urFunctor_map F fg) |}. Solve Obligations with apply listURF. Global Instance listRF_contractive F : urFunctorContractive F → rFunctorContractive (listRF F). Proof. apply listURF_contractive. Qed. iris-iris-4.2.0/iris_unstable/base_logic/000077500000000000000000000000001460620107300203605ustar00rootroot00000000000000iris-iris-4.2.0/iris_unstable/base_logic/algebra.v000066400000000000000000000013011460620107300221370ustar00rootroot00000000000000(** This is just an integration file for [iris_staging.algebra.list]; both should be stabilized together. *) From iris.algebra Require Import cmra. From iris.unstable.algebra Require Import list. From iris.base_logic Require Import bi derived. From iris.prelude Require Import options. Section upred. Context {M : ucmra}. (* 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). Section list_cmra. Context {A : ucmra}. Implicit Types l : list A. Lemma list_validI l : ✓ l ⊣⊢ ∀ i, ✓ (l !! i). Proof. uPred.unseal; constructor=> n x ?. apply list_lookup_validN. Qed. End list_cmra. End upred. iris-iris-4.2.0/iris_unstable/base_logic/mono_list.v000066400000000000000000000155221460620107300225570ustar00rootroot00000000000000(** This file is still experimental. See its tracking issue https://gitlab.mpi-sws.org/iris/iris/-/issues/439 for details on remaining issues before stabilization. *) (** Ghost state for a append-only list, wrapping the [mono_listR] RA. This provides three assertions: - an authoritative proposition [mono_list_auth_own γ q l] for the authoritative list [l] - a persistent assertion [mono_list_lb_own γ l] witnessing that the authoritative list is at least [l] - a persistent assertion [mono_list_idx_own γ i a] witnessing that the index [i] is [a] in the authoritative list. The key rules are [mono_list_lb_own_valid], which asserts that an auth at [l] and a lower-bound at [l'] imply that [l' `prefix_of` l], and [mono_list_update], which allows one to grow the auth element by appending only. At any time the auth list can be "snapshotted" with [mono_list_lb_own_get] to produce a persistent lower-bound. *) From iris.proofmode Require Import tactics. From iris.algebra.lib Require Import mono_list. From iris.bi.lib Require Import fractional. From iris.base_logic.lib Require Export own. From iris.prelude Require Import options. Class mono_listG (A : Type) Σ := MonoListG { mono_list_inG : inG Σ (mono_listR (leibnizO A)) }. Local Existing Instance mono_list_inG. Definition mono_listΣ (A : Type) : gFunctors := #[GFunctor (mono_listR (leibnizO A))]. Global Instance subG_mono_listΣ {A Σ} : subG (mono_listΣ A) Σ → (mono_listG A) Σ. Proof. solve_inG. Qed. Local Definition mono_list_auth_own_def `{!mono_listG A Σ} (γ : gname) (q : Qp) (l : list A) : iProp Σ := own γ (●ML{#q} (l : listO (leibnizO A))). Local Definition mono_list_auth_own_aux : seal (@mono_list_auth_own_def). Proof. by eexists. Qed. Definition mono_list_auth_own := mono_list_auth_own_aux.(unseal). Local Definition mono_list_auth_own_unseal : @mono_list_auth_own = @mono_list_auth_own_def := mono_list_auth_own_aux.(seal_eq). Global Arguments mono_list_auth_own {A Σ _} γ q l. Local Definition mono_list_lb_own_def `{!mono_listG A Σ} (γ : gname) (l : list A) : iProp Σ := own γ (◯ML (l : listO (leibnizO A))). Local Definition mono_list_lb_own_aux : seal (@mono_list_lb_own_def). Proof. by eexists. Qed. Definition mono_list_lb_own := mono_list_lb_own_aux.(unseal). Local Definition mono_list_lb_own_unseal : @mono_list_lb_own = @mono_list_lb_own_def := mono_list_lb_own_aux.(seal_eq). Global Arguments mono_list_lb_own {A Σ _} γ l. Definition mono_list_idx_own `{!mono_listG A Σ} (γ : gname) (i : nat) (a : A) : iProp Σ := ∃ l : list A, ⌜ l !! i = Some a ⌝ ∗ mono_list_lb_own γ l. Local Ltac unseal := rewrite /mono_list_idx_own ?mono_list_auth_own_unseal /mono_list_auth_own_def ?mono_list_lb_own_unseal /mono_list_lb_own_def. Section mono_list_own. Context `{!mono_listG A Σ}. Implicit Types (l : list A) (i : nat) (a : A). Global Instance mono_list_auth_own_timeless γ q l : Timeless (mono_list_auth_own γ q l). Proof. unseal. apply _. Qed. Global Instance mono_list_lb_own_timeless γ l : Timeless (mono_list_lb_own γ l). Proof. unseal. apply _. Qed. Global Instance mono_list_lb_own_persistent γ l : Persistent (mono_list_lb_own γ l). Proof. unseal. apply _. Qed. Global Instance mono_list_idx_own_timeless γ i a : Timeless (mono_list_idx_own γ i a) := _. Global Instance mono_list_idx_own_persistent γ i a : Persistent (mono_list_idx_own γ i a) := _. Global Instance mono_list_auth_own_fractional γ l : Fractional (λ q, mono_list_auth_own γ q l). Proof. unseal. intros p q. by rewrite -own_op -mono_list_auth_dfrac_op. Qed. Global Instance mono_list_auth_own_as_fractional γ q l : AsFractional (mono_list_auth_own γ q l) (λ q, mono_list_auth_own γ q l) q. Proof. split; [auto|apply _]. Qed. Lemma mono_list_auth_own_agree γ q1 q2 l1 l2 : mono_list_auth_own γ q1 l1 -∗ mono_list_auth_own γ q2 l2 -∗ ⌜(q1 + q2 ≤ 1)%Qp ∧ l1 = l2⌝. Proof. unseal. iIntros "H1 H2". by iCombine "H1 H2" gives %?%mono_list_auth_dfrac_op_valid_L. Qed. Lemma mono_list_auth_own_exclusive γ l1 l2 : mono_list_auth_own γ 1 l1 -∗ mono_list_auth_own γ 1 l2 -∗ False. Proof. iIntros "H1 H2". iDestruct (mono_list_auth_own_agree with "H1 H2") as %[]; done. Qed. Lemma mono_list_auth_lb_valid γ q l1 l2 : mono_list_auth_own γ q l1 -∗ mono_list_lb_own γ l2 -∗ ⌜ (q ≤ 1)%Qp ∧ l2 `prefix_of` l1 ⌝. Proof. unseal. iIntros "Hauth Hlb". by iCombine "Hauth Hlb" gives %?%mono_list_both_dfrac_valid_L. Qed. Lemma mono_list_lb_valid γ l1 l2 : mono_list_lb_own γ l1 -∗ mono_list_lb_own γ l2 -∗ ⌜ l1 `prefix_of` l2 ∨ l2 `prefix_of` l1 ⌝. Proof. unseal. iIntros "H1 H2". by iCombine "H1 H2" gives %?%mono_list_lb_op_valid_L. Qed. Lemma mono_list_idx_agree γ i a1 a2 : mono_list_idx_own γ i a1 -∗ mono_list_idx_own γ i a2 -∗ ⌜ a1 = a2 ⌝. Proof. iDestruct 1 as (l1 Hl1) "H1". iDestruct 1 as (l2 Hl2) "H2". iDestruct (mono_list_lb_valid with "H1 H2") as %Hpre. iPureIntro. destruct Hpre as [Hpre|Hpre]; eapply prefix_lookup_Some in Hpre; eauto; congruence. Qed. Lemma mono_list_auth_idx_lookup γ q l i a : mono_list_auth_own γ q l -∗ mono_list_idx_own γ i a -∗ ⌜ l !! i = Some a ⌝. Proof. iIntros "Hauth". iDestruct 1 as (l1 Hl1) "Hl1". iDestruct (mono_list_auth_lb_valid with "Hauth Hl1") as %[_ Hpre]. iPureIntro. eapply prefix_lookup_Some in Hpre; eauto; congruence. Qed. Lemma mono_list_lb_own_get γ q l : mono_list_auth_own γ q l ⊢ mono_list_lb_own γ l. Proof. intros. unseal. by apply own_mono, mono_list_included. Qed. Lemma mono_list_lb_own_le {γ l} l' : l' `prefix_of` l → mono_list_lb_own γ l ⊢ mono_list_lb_own γ l'. Proof. unseal. intros. by apply own_mono, mono_list_lb_mono. Qed. Lemma mono_list_idx_own_get {γ l} i a : l !! i = Some a → mono_list_lb_own γ l -∗ mono_list_idx_own γ i a. Proof. iIntros (Hli) "Hl". iExists l. by iFrame. Qed. Lemma mono_list_own_alloc l : ⊢ |==> ∃ γ, mono_list_auth_own γ 1 l ∗ mono_list_lb_own γ l. Proof. unseal. setoid_rewrite <- own_op. by apply own_alloc, mono_list_both_valid_L. Qed. Lemma mono_list_auth_own_update {γ l} l' : l `prefix_of` l' → mono_list_auth_own γ 1 l ==∗ mono_list_auth_own γ 1 l' ∗ mono_list_lb_own γ l'. Proof. iIntros (?) "Hauth". iAssert (mono_list_auth_own γ 1 l') with "[> Hauth]" as "Hauth". { unseal. iApply (own_update with "Hauth"). by apply mono_list_update. } iModIntro. iSplit; [done|]. by iApply mono_list_lb_own_get. Qed. Lemma mono_list_auth_own_update_app {γ l} l' : mono_list_auth_own γ 1 l ==∗ mono_list_auth_own γ 1 (l ++ l') ∗ mono_list_lb_own γ (l ++ l'). Proof. by apply mono_list_auth_own_update, prefix_app_r. Qed. End mono_list_own. iris-iris-4.2.0/iris_unstable/heap_lang/000077500000000000000000000000001460620107300202075ustar00rootroot00000000000000iris-iris-4.2.0/iris_unstable/heap_lang/interpreter.v000066400000000000000000001063651460620107300227540ustar00rootroot00000000000000(** This file is still experimental. See its tracking issue https://gitlab.mpi-sws.org/iris/iris/-/issues/405 for details on remaining issues before stabilization. *) (** A verified interpreter for HeapLang. This file defines a function [exec (fuel:nat) (e:expr) : val + Error] which runs a HeapLang expression to [inl v] if [e] terminates in a value [v], or returns [inr msg] with a structured error message [msg] if [e] gets stuck at some point. Use [pretty msg] to turn the message into a readable string. The point of this interpreter is to allow you to test your code or small snippets of HeapLang code and see what the semantics does. We prove it correct so that you can trust that the interpreter actually reflects the semantics, particularly when it says the program is stuck. The interpreter also goes through some pain to report specific error messages on failure, although these explanations are of course not verified. We prove a correctness theorem [exec_spec] about [exec] summarizing its guarantees. It distinguishes two cases: 1. If [exec] returns [inl v], then [e] can execute to [v] according to [rtc erased_step] (following the semantics of HeapLang). 2. If [exec] returns [inr (Stuck msg)], then [e] can execute to some [e'] that is stuck according to the HeapLang semantics, so [e] really does "go wrong". [msg] is a human-readable string describing how [e] got stuck. 3. Finally, [exec] can also fail due to running out of fuel or encountering an unsupported prophecy variable operation, in which case it returns a distinct error case and the correctness theorem provides no guarantees. The interpreter is _sequential_ and _deterministic_, which means it has some limitations. It will ignore forked threads and continue to execute the main thread, which may cause some programs to live-lock that would otherwise make progress under a fair scheduler. Determinism creates a subtle difference between the interpreter and the semantics. The interpreter only guarantees properties of one execution while the semantics and any safety property proven using Iris conceptually regard all executions. Concretely, consider this program: [let: "x" := ref #0 in !(LitLoc 1)]. There is one execution where this program terminates in [#0], and many where the allocation results in some other location and it is stuck. The interpeter happens to allocate starting at [LitLoc 1] and will say it produces [#0]. This is technically correct but not useful - there is a stuck execution the interpreter didn't find. The only non-determinism in sequential HeapLang is allocation, so we believe only strange programs like this that correctly "guess" the interpreter's allocations are affected. The interpreter is heavily based on Sydney Gibson's MEng thesis: https://pdos.csail.mit.edu/papers/gibsons-meng.pdf. That thesis includes an interpreter for sequential GooseLang, a fork of HeapLang. *) From stdpp Require Import gmap. From iris.heap_lang Require Export lang. From iris.heap_lang Require Import tactics pretty. From iris.prelude Require Import options. Local Ltac invc H := inversion H; subst; clear H. (** Errors are tagged to give [exec] a stronger specification. [Stuck s] is distinguished from the other cases because it comes with a proof that the expression is eventually stuck. *) Inductive Error := | Stuck (s:string) | Unsupported (s:string) | OutOfFuel. Global Instance error_pretty : Pretty Error := λ err, match err with | Stuck s => "stuck: " +:+ s | Unsupported s => "unsupported operation: " +:+ s | OutOfFuel => "out of fuel" end. Module interp_monad. Record interp_state := InterpState { lang_state : state; next_loc : Z; forked_threads : list expr; }. Add Printing Constructor interp_state. Definition modify_lang_state (f: state → state): interp_state → interp_state := λ s, InterpState (f s.(lang_state)) s.(next_loc) (s.(forked_threads)). Definition add_forked_thread (e: expr) : interp_state → interp_state := λ s, InterpState s.(lang_state) s.(next_loc) (s.(forked_threads) ++ [e]). Definition interp_state_alloc (n: Z) : interp_state → interp_state := λ s, InterpState s.(lang_state) (n + s.(next_loc)) s.(forked_threads). Inductive state_wf (s: interp_state): Prop := { state_wf_holds (l: loc) : (s.(next_loc) ≤ l.(loc_car))%Z → s.(lang_state).(heap) !! l = None; }. Definition InterpretM (A:Type) : Type := interp_state → (A+Error) * interp_state. Definition init_state : state := {| heap := ∅; used_proph_id := ∅ |}. Definition init_interp_state : interp_state := InterpState init_state 1 []. (** [run] runs an interpreter monad value starting from an empty initial state. *) Local Definition run {A} (f: InterpretM A) : A + Error := (f init_interp_state).1. Lemma init_interp_state_wf : state_wf init_interp_state. Proof. constructor; rewrite /init_interp_state //=. Qed. (* basic monad *) Global Instance interp_ret : MRet InterpretM := λ A (x:A), λ s, (inl x, s). Global Instance interp_bind : MBind InterpretM := λ A B (f: A → InterpretM B) (x: InterpretM A), λ s, let (r, s') := x s in match r with | inl x' => f x' s' | inr e => (inr e, s') end. Global Instance interp_fmap : FMap InterpretM := λ A B (f: A → B) (x: InterpretM A), λ s, let (r, s') := x s in match r with | inl x' => (inl (f x'), s') | inr e => (inr e, s') end. (* state+error-specific monadic constants *) Definition interp_modify (f: interp_state → interp_state): InterpretM () := λ s, (inl (), f s). Definition interp_modify_state (f: state → state): InterpretM () := interp_modify (modify_lang_state f). Definition interp_read {A} (f: state → A): InterpretM A := λ s, (inl (f s.(lang_state)), s). Definition interp_error {A} (msg: string) : InterpretM A := λ s, (inr (Stuck msg), s). Definition interp_alloc (n:Z): InterpretM loc := λ s, (inl {| loc_car := s.(next_loc)|}, interp_state_alloc n s). Definition read_loc (method: string) (vl: val) : InterpretM (loc*val) := match vl with | LitV (LitLoc l) => mv ← interp_read (λ σ, σ.(heap) !! l); match mv with | Some (Some v) => mret (l, v) | Some None => interp_error $ method +:+ ": use after free at location: " +:+ pretty l | None => interp_error $ method +:+ ": unallocated location: " +:+ pretty l end | _ => interp_error $ method +:+ ": applied to non-loc " +:+ pretty vl end. Lemma error_not_inl {A} {msg s} {v: A} {s'} : interp_error msg s = (inl v, s') → False. Proof. by inversion 1. Qed. Lemma mret_inv {A} (v: A) s v' s' : mret (M:=InterpretM) v s = (inl v', s') → v = v' ∧ s = s'. Proof. by inversion 1. Qed. Lemma interp_bind_inv A B (x: InterpretM A) (f: A → InterpretM B) r s s' : (x ≫= f) s = (r, s') → (∃ e, x s = (inr e, s') ∧ r = inr e) ∨ (∃ s0 x', x s = (inl x', s0) ∧ f x' s0 = (r, s')). Proof. rewrite /mbind /interp_bind. repeat case_match; inversion 1; subst; eauto. Qed. Lemma interp_bind_inl_inv A B (x: InterpretM A) (f: A → InterpretM B) (r: B) s s' : (x ≫= f) s = (inl r, s') → ∃ s0 x', x s = (inl x', s0) ∧ f x' s0 = (inl r, s'). Proof. intros [(e & ? & ?) | (s0 & x' & H1 & H2)]%interp_bind_inv. - congruence. - rewrite H1. eexists _, _; eauto. Qed. Lemma interp_fmap_inv {A B} (f: A → B) x s v s' : (fmap (M:=InterpretM) f x) s = (inl v, s') → ∃ v0, v = f v0 ∧ x s = (inl v0, s'). Proof. rewrite /fmap /interp_fmap. repeat case_match; inversion 1; subst; eauto. Qed. Lemma read_loc_inv method vl s l v s' : read_loc method vl s = (inl (l, v), s') → vl = LitV (LitLoc l) ∧ s' = s ∧ s.(lang_state).(heap) !! l = Some (Some v). Proof. rewrite /read_loc. destruct vl as [l' | | | | ]; try by inversion 1. destruct l' as [| | | | l' |]; intro H; try by inversion H. apply interp_bind_inl_inv in H as (s0 & mv & Heq1 & Heq2). destruct mv as [mv|]; try by inversion Heq2. destruct mv; inversion Heq2; subst; clear Heq2. inversion Heq1; subst; clear Heq1. eauto. Qed. Ltac errored := lazymatch goal with | H: interp_error _ _ = (inl _, _) |- _ => solve [ exfalso; apply (error_not_inl H) ] | H: (inr _, _) = (inl _, _) |- _ => solve [ exfalso; inversion H ] end. Ltac success := repeat lazymatch goal with | H: mret _ _ = (inl _, _) |- _ => let Heqv := fresh "Heqv" in let Heqs := fresh "Heqs" in apply mret_inv in H as [Heqv Heqs]; subst | H: (_ ≫= (λ x, _)) _ = (inl _, _) |- _ => let s := fresh "s" in let x := fresh x in let Heq1 := fresh "Heq" in let Heq2 := fresh "Heq" in apply interp_bind_inl_inv in H as (s & x & Heq1 & Heq2); subst | H: (_ <$> _) _ = (inl ?v, _) |- _ => let s := fresh "s" in let v_tmp := fresh "v" in rename v into v_tmp; apply interp_fmap_inv in H as (v & -> & H) | H: interp_modify _ _ = (inl _, _) |- _ => invc H | H: interp_modify_state _ _ = (inl _, _) |- _ => invc H | H: interp_read _ _ = (inl _, _) |- _ => invc H | H: read_loc _ _ _ = (inl _, _) |- _ => apply read_loc_inv in H as (-> & -> & H) end; subst. Lemma interp_bind_inr_inv {A B} (x: InterpretM A) (f: A → InterpretM B) r s s' : (x ≫= f) s = (inr r, s') → (x s = (inr r, s')) ∨ (∃ s0 x', x s = (inl x', s0) ∧ f x' s0 = (inr r, s')). Proof. rewrite /mbind /interp_bind. repeat case_match; intros; simplify_eq/=; eauto. Qed. Lemma interp_fmap_inr_inv {A B} (f: A → B) (x: InterpretM A) s e s' : (f <$> x) s = (inr e, s') → x s = (inr e, s'). Proof. rewrite /fmap /interp_fmap. repeat case_match; intros; simplify_eq/=; auto. Qed. Lemma read_loc_inr_inv method vl s err s' : read_loc method vl s = (inr err, s') → s = s' ∧ match vl with | LitV (LitLoc l) => ∀ v, s.(lang_state).(heap) !! l ≠ Some (Some v) | _ => True end. Proof. rewrite /read_loc. repeat case_match; subst; try solve [ inversion 1; subst; auto ]. intros H. apply interp_bind_inr_inv in H as [H|(s0&x& Hexec1 & Hexec2)]; success. - invc H. - repeat case_match; invc Hexec2. + intuition congruence. + intuition congruence. Qed. Ltac failure := repeat match goal with | H: (_ ≫= _) _ = (inr _, _) |- _ => let s := fresh "s" in let x := fresh "x" in let Heq := fresh "Heq" in apply interp_bind_inr_inv in H as [H | (s & x & Heq & H)] | H: interp_error _ _ = (inr _, _) |- _ => invc H | H: mret _ _ = (inr _, _) |- _ => solve [ inversion H ] | H: interp_modify _ _ = (inr _, _) |- _ => solve [ inversion H ] | H: interp_modify_state _ _ = (inr _, _) |- _ => solve [ inversion H ] | H: (_ <$> _) _ = (inr _, _) |- _ => apply interp_fmap_inr_inv in H | H: read_loc _ _ _ = (inr _, _) |- _ => apply read_loc_inr_inv in H as [-> H] end; subst. End interp_monad. Import interp_monad. Section interpreter. (* to make the below definition work with strings as well we add an instance of [Pretty string] *) Local Instance pretty_string : Pretty string := λ s, s. Local Definition pretty_app (s: string) {A} `{Pretty A} (x:A) : string := s +:+ pretty x. Infix "+" := pretty_app. (* We explain errors which in the semantics are represented by a pure function returning None; to sanity-check these definitions, we prove they cover exactly the cases where the underlying operation returns None. *) Definition option_opposites {A B} (m1 : option A) (m2 : option B) := is_Some m1 ↔ m2 = None. Lemma option_opposites_alt {A B} (m1 : option A) (m2 : option B) : option_opposites m1 m2 ↔ match m1, m2 with | Some _, None => True | None , Some _ => True | _ , _ => False end. Proof. rewrite /option_opposites is_Some_alt. repeat case_match; intuition congruence. Qed. (** produce an error message for [un_op_eval] *) Definition explain_un_op_fail op v : option string := match op with | NegOp => match v with | LitV (LitInt _) => None | LitV (LitBool _) => None | _ => Some $ "~ (NegOp) can only be applied to integers and booleans, got " + v end | MinusUnOp => match v with | LitV (LitInt _) => None | _ => Some $ "unary - (MinusUnOp) can only be applied to integers, got " + v end end. Lemma explain_un_op_fail_wf op v : option_opposites (explain_un_op_fail op v) (un_op_eval op v). Proof. apply option_opposites_alt. rewrite /explain_un_op_fail /un_op_eval. repeat case_match; simplify_eq/=; auto. Qed. Definition explain_unboxed v : option string := match v with | LitV l | InjLV (LitV l) | InjRV (LitV l) => match l with | LitPoison => Some "poison values (from erasing prophecies) cannot be compared" | LitProphecy _ => Some "prophecies cannot be compared" | _ => None end | InjLV _ | InjRV _ => Some "sum values can only be compared if they contain literals" | PairV _ _ => Some "pairs are large and considered boxed, must compare by field" | RecV _ _ _ => Some "closures are large and cannot be compared" end. Lemma explain_unboxed_wf v : match explain_unboxed v with | Some _ => ~val_is_unboxed v | None => val_is_unboxed v end. Proof. rewrite /explain_unboxed /val_is_unboxed /lit_is_unboxed. repeat case_match; intuition congruence. Qed. Definition explain_vals_compare_safe_fail v1 v2 : option string := match explain_unboxed v1, explain_unboxed v2 with | Some msg1, Some msg2 => Some $ "one of " + v1 + " and " + v2 + " must be unboxed to compare: " + v1 + ": " + msg1 + ", " + v2 + ": " + msg2 | _, _ => None end. (** [explain_vals_compare_safe_fail] gives an explanation when [vals_compare_safe] would be false (that is, when v1 and v2 cannot be compared) *) Lemma explain_vals_compare_safe_fail_wf v1 v2 : is_Some (explain_vals_compare_safe_fail v1 v2) ↔ ~vals_compare_safe v1 v2. Proof. cut (explain_vals_compare_safe_fail v1 v2 = None ↔ vals_compare_safe v1 v2). { rewrite is_Some_alt. destruct (explain_vals_compare_safe_fail _ _); intuition congruence. } rewrite /explain_vals_compare_safe_fail /vals_compare_safe. pose proof (explain_unboxed_wf v1). pose proof (explain_unboxed_wf v2). destruct (explain_unboxed v1), (explain_unboxed v2); intuition congruence. Qed. (** produce an error message for [bin_op_eval] *) Definition explain_bin_op_fail op v1 v2 : option string := if decide (op = EqOp) then (explain_vals_compare_safe_fail v1 v2) else match v1, v2 with | LitV (LitInt _), LitV (LitInt _) => match op with | OffsetOp => Some $ "cannot add to integer " + v1 + " with +ₗ (only locations)" | _ => None end | LitV (LitBool b1), LitV (LitBool b2) => match bin_op_eval_bool op b1 b2 with | Some _ => None | None => Some $ "non-boolean operator applied to booleans " + op end | LitV (LitLoc _), _ => match op, v2 with | OffsetOp, LitV (LitInt _) => None | OffsetOp, _ => Some $ "can only call +ₗ on integers, got " + v2 | LeOp, LitV (LitLoc _) => None | LeOp, _ => Some $ "cannot use ≤ on location " + v1 + " and " + v2 | LtOp, LitV (LitLoc _) => None | LtOp, _ => Some $ "cannot use < on location " + v1 + " and " + v2 | _, _ => Some $ "the only supported operations on locations are " + " +ₗ #i, ≤ #l and < #l; got " + op + " " + v2 end | _, _ => Some $ "mismatched types of values " + v1 + " and " + v2 end. Lemma explain_bin_op_fail_wf op v1 v2 : option_opposites (explain_bin_op_fail op v1 v2) (bin_op_eval op v1 v2). Proof. apply option_opposites_alt. rewrite /explain_bin_op_fail /bin_op_eval /bin_op_eval_int /bin_op_eval_bool /bin_op_eval_loc. repeat (case_match; simplify_eq/=; auto). - pose proof (explain_vals_compare_safe_fail_wf v1 v2). intuition eauto. - pose proof (explain_vals_compare_safe_fail_wf v1 v2) as Hwf. replace (explain_vals_compare_safe_fail v1 v2) in Hwf. rewrite -> is_Some_alt in Hwf. intuition eauto. Qed. (* define a shorthand for readability below *) Local Notation error := interp_error. Fixpoint interpret (fuel:nat) (e: expr) {struct fuel} : InterpretM val := match fuel with | 0 => λ s, (inr OutOfFuel, s) | S fuel' => let interp := interpret fuel' in match e with (* lambda calculus *) | Val v => mret v | Var x => error $ "free var: " + x | Rec f x e => mret (RecV f x e) | App f e => v2 ← interp e; f ← interp f; match f with | RecV f x e1 => interp (subst' x v2 (subst' f (RecV f x e1) e1)) | _ => error $ "attempt to call non-function " +:+ pretty f end (* mostly boring pure operations (sums, products, unary/binary ops) *) | Pair e1 e2 => v2 ← interp e2; v1 ← interp e1; mret (PairV v1 v2) | InjL e => InjLV <$> interp e | InjR e => InjRV <$> interp e | UnOp op e => v ← interp e; match un_op_eval op v with | Some v => mret v | None => error $ "un-op failed: " + match explain_un_op_fail op v with | Some msg => msg | None => "" (* impossible *) end end | BinOp op e1 e2 => v2 ← interp e2; v1 ← interp e1; match bin_op_eval op v1 v2 with | Some v => mret v | None => error $ "bin-op failed: " + match explain_bin_op_fail op v1 v2 with | Some msg => msg | None => "" (* impossible *) end end | If e e1 e2 => cond ← interp e; match cond with | LitV (LitBool b) => interp (if b then e1 else e2) | _ => error $ "if: non-bool condition " + cond end | Fst e => v ← interp e; match v with | PairV v1 _ => mret v1 | _ => error $ "fst: called on non-pair " + v end | Snd e => v ← interp e; match v with | PairV _ v2 => mret v2 | _ => error $ "snd: called on non-pair " + v end | Case e e1 e2 => v ← interp e; match v with | InjLV v => interp (App e1 (Val v)) | InjRV v => interp (App e2 (Val v)) | _ => error $ "case: called on non-sum " + v end | Fork e => _ ← interp_modify (add_forked_thread e); mret (LitV LitUnit) (* heap manipulation *) | AllocN ne e => v ← interp e; nv ← interp ne; match nv with | LitV (LitInt n) => if decide (0 < n)%Z then l ← interp_alloc n; _ ← interp_modify_state (state_init_heap l n v); mret (LitV (LitLoc l)) else (error $ if decide (n = 0) then "alloc: cannot allocate 0 elements" else "alloc: negative number of elements (first argument) " + n) | _ => error $ "alloc: number of elements (first argument) " + nv end | Load e => vl ← interp e; l_v0 ← read_loc "load" vl; let '(_, v0) := l_v0 in mret v0 | Free e => vl ← interp e; l_v0 ← read_loc "free" vl; let '(l, _) := l_v0 in _ ← interp_modify_state (state_upd_heap <[l:=None]>); mret (LitV LitUnit) | Store el e => w ← interp e; vl ← interp el; l_v0 ← read_loc "store" vl; let '(l, _) := l_v0 in _ ← interp_modify_state (state_upd_heap <[l:=Some w]>); mret (LitV LitUnit) | Xchg el e => w ← interp e; vl ← interp el; l_v0 ← read_loc "xchg" vl; let '(l, v0) := l_v0 in _ ← interp_modify_state (state_upd_heap <[l:=Some w]>); mret v0 | CmpXchg e e1 e2 => v2 ← interp e2; v1 ← interp e1; vl ← interp e; l_v0 ← read_loc "cmpxchg" vl; let '(l, vl) := l_v0 in let b := bool_decide (vl = v1) in if decide (vals_compare_safe vl v1) then _ ← interp_modify_state (λ σ, if b then state_upd_heap <[l:=Some v2]> σ else σ); mret (PairV vl (LitV (LitBool b))) else error $ "cmpxchg: failed comparison: " + default "" (explain_vals_compare_safe_fail vl v1) | FAA el e => v ← interp e; vl ← interp el; l_v0 ← read_loc "faa" vl; let '(l, v0) := l_v0 in match v0, v with | LitV (LitInt i1), LitV (LitInt i2) => _ ← interp_modify_state (state_upd_heap <[l:=Some (LitV (LitInt (i1 + i2)))]>); mret (LitV (LitInt i1)) (* check constant passed to FAA only if heap value is an integer *) | LitV (LitInt _), _ => error $ "faa: increment " + v + " is not an integer" | _, _ => error $ "faa: called on non-integer heap value: " + v0 end (* unsupported prophecy variable operations *) | NewProph => λ s, (inr (Unsupported "NewProph"), s) | Resolve _ _ _ => λ s, (inr (Unsupported "Resolve"), s) end end. End interpreter. (** * Theory for proving steps are sound. *) Lemma atomic_step e σ e' σ' : base_step e σ [] e' σ' [] → ∀ tp, rtc erased_step (e :: tp, σ) (e' :: tp, σ'). Proof. intros ? tp. apply rtc_once. exists []. eapply (step_atomic e σ e' σ' [] [] tp); simpl; auto. - rewrite app_nil_r //. - eapply (Ectx_step []); eauto. Qed. Lemma step_inv ts1 σ1 κ ts2 σ2 : step (Λ:=heap_lang) (ts1, σ1) κ (ts2, σ2) → ∃ (t1 : list expr) (e1 : expr) (t2 : list expr) (e2 : expr) (efs: list expr), ts1 = t1 ++ e1 :: t2 ∧ ts2 = t1 ++ e2 :: t2 ++ efs ∧ prim_step e1 σ1 κ e2 σ2 efs. Proof. inversion 1. simplify_eq. eauto 10. Qed. Lemma fill_step K (e: expr) σ tp κ e' σ' tp' : step (e :: tp, σ) κ (e' :: tp', σ') → step (fill K e :: tp, σ) κ (fill K e' :: tp', σ'). Proof. intros Hstep. apply step_inv in Hstep as (t1 & e1 & t2 & e2 & efs & Heq1 & Heq2 & Hprim_step). pose proof Hprim_step as H. apply (fill_prim_step K) in H. simpl in H. destruct t1 as [|e0 t1]. - simplify_eq/=. eapply (step_atomic _ _ _ _ efs [] t2); eauto. - simplify_eq/=. eapply (step_atomic _ _ _ _ efs (fill K e0 :: t1) t2); eauto. Qed. Lemma fill_erased_step (e: expr) σ tp e' σ' tp' K : erased_step (e :: tp, σ) (e' :: tp', σ') → erased_step (fill K e :: tp, σ) (fill K e' :: tp', σ'). Proof. rewrite /erased_step. intros [κ Hstep]. exists κ. apply fill_step; auto. Qed. Lemma step_cons_no_destroy (e: expr) tp σ κ ρ2 : step (e :: tp, σ) κ ρ2 → ∃ e' tp' σ', ρ2 = (e' :: tp', σ'). Proof. destruct ρ2 as [ts' σ']. intros (t1&?&?&?&?&?&?&?)%step_inv; subst. destruct t1; simplify_eq/=; eauto. Qed. Lemma language_nsteps_inv_r (Λ: language) n ρ1 κs ρ2 : language.nsteps (Λ:=Λ) (S n) ρ1 κs ρ2 → ∃ ρ' κ κs', step ρ1 κ ρ' ∧ κs = κ ++ κs' ∧ language.nsteps n ρ' κs' ρ2. Proof. inversion 1; subst; eauto 10. Qed. Lemma fill_erased_steps (e: expr) σ tp e' σ' tp' K : rtc erased_step (e :: tp, σ) (e' :: tp', σ') → rtc erased_step (fill K e :: tp, σ) (fill K e' :: tp', σ'). Proof. rewrite !erased_steps_nsteps. destruct 1 as (n & κs & Hsteps). generalize dependent e. generalize dependent tp. generalize dependent σ. generalize dependent e'. generalize dependent tp'. generalize dependent σ'. generalize dependent κs. induction n as [|n IHn]; intros ??????? Hsteps. - invc Hsteps. exists 0, []. constructor. - apply language_nsteps_inv_r in Hsteps as (ρ2 & κ & κs' & (Hstep & -> & Hsteps)). (* here is the crucial step: to apply [fill_step] need to know that [ρ2] has the right structure, which comes from threads not getting destroyed *) edestruct step_cons_no_destroy as (e''&tp''&σ''&Heq); eauto; subst. apply (fill_step K) in Hstep. apply IHn in Hsteps as (n'&κs&?). exists (S n'), (κ ++ κs). econstructor; eauto. Qed. Section interpret_ok. Tactic Notation "step" "by" tactic1(t) := etrans; [ solve [ t ] | simpl ]. Ltac change_to_fill e := reshape_expr e ltac:(fun K e' => (* find a non-trivial context *) lazymatch K with | [_] => change e with (fill K e') end). Ltac step_ctx := lazymatch goal with | |- rtc erased_step (?e :: _, _) _ => change_to_fill e; step by (apply fill_erased_steps; eauto) end. Ltac step_atomic := step by (apply atomic_step; eauto using base_step); try reflexivity. Lemma state_wf_init_alloc (v0 : val) (s : interp_state) (n : Z) : (0 ≤ n)%Z → state_wf s → state_wf (modify_lang_state (λ σ : state, state_init_heap {| loc_car := next_loc s |} n v0 σ) (interp_state_alloc n s)). Proof. intros Hn. constructor; rewrite /modify_lang_state /interp_state_alloc /=; intros l ?. apply fin_maps.lookup_union_None; split. - destruct (heap_array _ _ !! l) eqn:Hlookup; auto. apply heap_array_lookup in Hlookup as (j & w & Hle & ? & ? & Hlookup); subst. apply lookup_replicate in Hlookup as [? ?]; subst. simpl in *. lia. - apply state_wf_holds; auto. lia. Qed. Lemma state_wf_same_dom s f : (dom (f s.(lang_state)).(heap) = dom s.(lang_state).(heap)) → state_wf s → state_wf (modify_lang_state f s). Proof. intros Hdom_eq Hwf. constructor; rewrite /modify_lang_state /= => l ?. apply (fin_map_dom.not_elem_of_dom (D:=gset loc)). rewrite Hdom_eq. apply fin_map_dom.not_elem_of_dom. apply state_wf_holds; auto. Qed. Lemma state_wf_upd s l mv0 v' : state_wf s → heap (lang_state s) !! l = Some mv0 → state_wf (modify_lang_state (λ σ : state, state_upd_heap <[l:=v']> σ) s). Proof. intros Hwf Heq. apply state_wf_same_dom; auto. rewrite fin_map_dom.dom_insert_L. apply (fin_map_dom.elem_of_dom_2 (D:=gset loc)) in Heq. set_solver. Qed. Lemma interpret_wf fuel (e: expr) s v s' : state_wf s → interpret fuel e s = (inl v, s') → state_wf s'. Proof. revert e s v s'. induction fuel as [|fuel]; simpl; intros e s v s' **; [ errored | ]. destruct e; try errored; success; eauto; (repeat case_match; subst; try errored; success; eauto using state_wf_upd). - match goal with | H: interp_alloc _ _ = (_, _) |- _ => invc H end. apply state_wf_init_alloc; eauto. lia. - apply state_wf_same_dom; eauto. - constructor; intros. simpl. apply state_wf_holds; auto. Qed. Local Hint Resolve interpret_wf : core. Lemma interpret_sound fuel e s v s' : state_wf s → interpret fuel e s = (inl v, s') → rtc erased_step (e :: s.(forked_threads), s.(lang_state)) (Val v :: s'.(forked_threads), s'.(lang_state)). Proof. revert e s v s'. induction fuel as [|fuel]; simpl; intros e s v s' **; [ errored | ]. destruct e; try errored; success; cbn [forked_threads lang_state]; repeat match goal with | H: (match ?x with | _ => _ end _ = (inl _, _)) |- _ => let Heqn := fresh "Heqn" in destruct x eqn:Heqn; try errored; [idtac] | _ => progress success | _ => step_ctx | _ => step_atomic end. - (* Val *) reflexivity. - (* App *) eauto. - (* If *) lazymatch goal with | |- context[LitBool ?b] => destruct b; step_atomic; eauto end. - (* Case *) lazymatch goal with | |- context[Case (Val ?v)] => destruct v; try errored; step_atomic; eauto end. - (* AllocN *) lazymatch goal with | H: interp_alloc _ _ = _ |- _ => invc H end. eapply atomic_step. constructor; auto; intros. simpl. apply state_wf_holds; eauto. simpl; lia. - (* Fork *) eapply rtc_once. exists []. lazymatch goal with | |- context[Fork ?e] => eapply (step_atomic _ _ _ _ [e] []); simpl; eauto end. apply base_prim_step; simpl. eauto using base_step. Qed. (** * Theory for expressions that are stuck after some execution steps. *) Definition eventually_stuck (e: expr) tp σ tp' σ' := ∃ e'', rtc erased_step (e :: tp, σ) (e'':: tp', σ') ∧ stuck e'' σ'. (** a stuck expression is eventually stuck *) Lemma eventually_stuck_now (e: expr) tp σ : stuck e σ → eventually_stuck e tp σ tp σ. Proof. intros. exists e. split; [ reflexivity | auto ]. Qed. (** we can "peel off" some number of execution steps before proving that an expression is stuck *) Lemma eventually_stuck_steps e tp σ tp0 σ0 e' tp' σ' : rtc erased_step (e :: tp, σ) (e' :: tp0, σ0) → eventually_stuck e' tp0 σ0 tp' σ' → eventually_stuck e tp σ tp' σ'. Proof. intros Hsteps (e'' & Hsteps' & Hstuck). eexists. split; [ etrans; eauto | eauto ]. Qed. (** [eventually_stuck] respects evaluation contexts *) Lemma eventually_stuck_fill K e tp σ tp' σ' : eventually_stuck e tp σ tp' σ' → eventually_stuck (fill K e) tp σ tp' σ'. Proof. intros (e' & Hsteps & Hstuck). eexists (fill K e'). split. - apply fill_erased_steps; auto. - apply stuck_fill; auto. Qed. Local Hint Resolve interpret_sound : core. (* peel off execution steps and use above automation to prove the [rtc erased_steps] premise *) Ltac stuck_steps := eapply eventually_stuck_steps; [ repeat step_ctx; (step_atomic || reflexivity) |]. (* automate using hypotheses about stuckness inside an evaluation context *) Ltac stuck_fill := lazymatch goal with | |- eventually_stuck ?e _ _ _ _ => change_to_fill e; apply eventually_stuck_fill; solve [ eauto ] end. (** We need more complicated theory to handle expressions that are stuck now, because there is no [base_step] they can take. *) (* [terminal_expr e] holds when e cannot be the result of taking a context step. Slightly more formally, e doesn't have the shape [fill K e'] where e' is reducible. *) Definition terminal_expr e := ∀ K e', to_val e' = None → e = fill K e' → K = [] ∧ e' = e. Lemma stuck_not_val e σ : to_val e = None → (∀ (κs: list observation) (e': expr) (σ': state) (efs: list expr), prim_step e σ κs e' σ' efs → False) → stuck e σ. Proof. rewrite /stuck /irreducible. intuition. Qed. Local Hint Resolve val_base_stuck : core. (* This theorem expresses the point of [terminal_expr e]: a terminal_expr is stuck if it can't take a head step, because there's *) Lemma terminal_expr_stuck e σ : to_val e = None → terminal_expr e → (∀ κ e' σ' efs, base_step e σ κ e' σ' efs → False) → stuck e σ. Proof. intros Hnot_val Hterminal Hno_base_step. apply stuck_not_val; first done; intros * Hstep. invc Hstep; simpl in *. lazymatch type of Hnot_val with | to_val (fill ?K ?e1') = None => edestruct (Hterminal K e1') as [-> ?]; eauto end. Qed. Lemma fill_not_val' K e v : to_val e = None → Val v = fill K e → False. Proof. intros H Hfill. apply (fill_not_val K) in H; simpl in *. rewrite -Hfill /= in H. congruence. Qed. (* to prove [terminal_expr], we work by contradiction in the case where [K] is non-empty; to deal with [fill], which is a fold left, we express a non-empty list as [l ++ [x]] rather than the usual [x::l]. *) Lemma list_rev_case {A} (l: list A) : l = [] ∨ ∃ x l', l = l' ++ [x]. Proof. induction l using rev_ind; eauto. Qed. Ltac ctx_case K Ki := let K' := fresh "K" in destruct (list_rev_case K) as [->| (Ki & K' & ->)]; [by auto|]; rewrite ?fill_app /=. Ltac prove_terminal := lazymatch goal with | |- terminal_expr _ => let K := fresh "K" in let e := fresh "e" in let Ki := fresh "Ki" in intros K e; ctx_case K Ki; destruct Ki; let H := fresh in intros ? H; invc H; solve [ exfalso; eauto using fill_not_val' ] | _ => fail "not a terminal_expr goal" end. (* demo the [prove_terminal] tactic *) Lemma fill_app_inv v1 v2 : terminal_expr (App (Val v1) (Val v2)). Proof. prove_terminal. Qed. Ltac stuck_now := apply eventually_stuck_now, terminal_expr_stuck; [done |prove_terminal |let H := fresh "Hstep" in intros * H; try (inversion H; congruence) ]. Lemma interpret_complete fuel : ∀ e s msg s', ∀ (Hwf: state_wf s), interpret fuel e s = (inr (Stuck msg), s') → eventually_stuck e s.(forked_threads) s.(lang_state) s'.(forked_threads) s'.(lang_state). Proof. induction fuel as [|fuel]; simpl; intros e s msg s' **; [congruence|]. destruct e; failure; stuck_steps; try stuck_fill; try (repeat case_match; failure; try stuck_now; let n := numgoals in guard n <= 1); simplify_eq. - (* App *) stuck_steps. eauto. - (* If *) repeat case_match; failure; try stuck_now. + stuck_steps; eauto. + stuck_steps; eauto. - (* Case *) repeat case_match; failure; try stuck_now. + stuck_steps; eauto. + stuck_steps; eauto. - (* CmpXchg *) success. stuck_now. - (* FAA *) lazymatch goal with | H: read_loc _ _ _ = (inl ?p, _) |- _ => destruct p as [l v] end. success. repeat case_match; failure; stuck_now. Qed. End interpret_ok. Definition exec (fuel:nat) (e: expr) : val + Error := interp_monad.run (interpret fuel e). Theorem exec_spec fuel e : match exec fuel e with | inl v => (* if the interpreter runs to completion, it produces a valid execution of [e] *) ∃ tp' σ', rtc erased_step ([e], init_state) ([Val v] ++ tp', σ') | inr (Stuck _) => (* if the interpreter produces a "stuck" error message, [e] can get stuck *) ∃ e' tp' σ', rtc erased_step ([e], init_state) ([e'] ++ tp', σ') ∧ stuck e' σ' | inr _ => (* If the interpreter fails otherwise (due to running out of fuel or an unsupported prophecy variable operation), then it provides no guarantees. *) True end. Proof. rewrite /exec /interp_monad.run. destruct (interpret fuel e init_interp_state) as [r s] eqn:Hinterpret. destruct r as [v | [msg|msg|] ]; simpl; auto. - apply interpret_sound in Hinterpret; eauto using init_interp_state_wf. - apply interpret_complete in Hinterpret; auto using init_interp_state_wf. destruct Hinterpret as (e' & Hexec & Hstuck); eauto. Qed. iris-iris-4.2.0/make-package000077500000000000000000000016521460620107300156660ustar00rootroot00000000000000#!/bin/bash set -e # Helper script to build and/or install just one package out of this repository. # Assumes that all the other packages it depends on have been installed already! PROJECT="$1" shift COQFILE="_CoqProject.$PROJECT" MAKEFILE="Makefile.package.$PROJECT" if ! grep -E -q "^$PROJECT/" _CoqProject; then echo "No files in $PROJECT/ found in _CoqProject; this does not seem to be a valid project name." exit 1 fi # Generate _CoqProject file and Makefile rm -f "$COQFILE" # Get the right "-Q" line. grep -E "^-Q $PROJECT[ /]" _CoqProject >> "$COQFILE" # Get everything until the first empty line except for the "-Q" lines. sed -n '/./!q;p' _CoqProject | grep -E -v "^-Q " >> "$COQFILE" # Get the files. grep -E "^$PROJECT/" _CoqProject >> "$COQFILE" # Now we can run coq_makefile. "${COQBIN}coq_makefile" -f "$COQFILE" -o "$MAKEFILE" # Run build make -f "$MAKEFILE" "$@" # Cleanup rm -f ".$MAKEFILE.d" "$MAKEFILE"* iris-iris-4.2.0/test-normalizer.sed000066400000000000000000000002651460620107300172650ustar00rootroot00000000000000# locations in Fail, depends on local file path /^File/d # Ltac2 printing changed (https://github.com/coq/coq/pull/18560) s/StringToIdent\.([a-zA-Z]+) \((.*)\)/StringToIdent.\1 \2/ iris-iris-4.2.0/tests/000077500000000000000000000000001460620107300145705ustar00rootroot00000000000000iris-iris-4.2.0/tests/algebra.ref000066400000000000000000000000001460620107300166510ustar00rootroot00000000000000iris-iris-4.2.0/tests/algebra.v000066400000000000000000000065151460620107300163630ustar00rootroot00000000000000From iris.algebra Require Import auth excl lib.gmap_view. From iris.base_logic.lib Require Import invariants. From iris.prelude Require Import options. Section test_dist_equiv_mode. (* check that the mode for [Dist] does not trigger https://github.com/coq/coq/issues/14441. From https://gitlab.mpi-sws.org/iris/iris/-/merge_requests/700#note_69303. *) Lemma list_dist_lookup {A : ofe} n (l1 l2 : list A) : l1 ≡{n}≡ l2 ↔ ∀ i, l1 !! i ≡{n}≡ l2 !! i. Abort. (* analogous test for [Equiv] and https://github.com/coq/coq/issues/14441. From https://gitlab.mpi-sws.org/iris/iris/-/merge_requests/700#note_69303. *) Lemma list_equiv_lookup_ofe {A : ofe} (l1 l2 : list A) : l1 ≡ l2 ↔ ∀ i, l1 !! i ≡ l2 !! i. Abort. End test_dist_equiv_mode. (** Make sure that the same [Equivalence] instance is picked for Leibniz OFEs with carriers that are definitionally equal. See also https://gitlab.mpi-sws.org/iris/iris/issues/299 *) Definition tag := nat. Canonical Structure tagO := leibnizO tag. Goal tagO = natO. Proof. reflexivity. Qed. Global Instance test_cofe {Σ} : Cofe (iPrePropO Σ) := _. Section tests. Context `{!invGS_gen hlc Σ}. Program Definition test : (iPropO Σ -n> iPropO Σ) -n> (iPropO Σ -n> iPropO Σ) := λ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 : ∃ R, @Reflexive Prop R ∧ R = iff. Proof. eexists. split. - apply _. - reflexivity. Qed. (** Regression test for . *) Definition testR := authR (prodUR (prodUR (optionUR (exclR unitO)) (optionUR (exclR unitO))) (optionUR (agreeR (boolO)))). Section test_prod. Context `{!inG Σ testR}. Lemma test_prod_persistent γ : Persistent (PROP:=iPropI Σ) (own γ (◯((None, None), Some (to_agree true)))). Proof. apply _. Qed. End test_prod. (** Make sure the [auth]/[gmap_view] notation does not mix up its arguments. *) Definition auth_check {A : ucmra} : auth A = authO A := eq_refl. Definition gmap_view_check {K : Type} `{Countable K} {V : cmra} : gmap_view K V = gmap_viewO K V := eq_refl. Lemma uncurry_ne_test {A B C : ofe} (f : A → B → C) : NonExpansive2 f → NonExpansive (uncurry f). Proof. apply _. Qed. Lemma uncurry3_ne_test {A B C D : ofe} (f : A → B → C → D) : NonExpansive3 f → NonExpansive (uncurry3 f). Proof. apply _. Qed. Lemma uncurry4_ne_test {A B C D E : ofe} (f : A → B → C → D → E) : NonExpansive4 f → NonExpansive (uncurry4 f). Proof. apply _. Qed. Lemma curry_ne_test {A B C : ofe} (f : A * B → C) : NonExpansive f → NonExpansive2 (curry f). Proof. apply _. Qed. Lemma curry3_ne_test {A B C D : ofe} (f : A * B * C → D) : NonExpansive f → NonExpansive3 (curry3 f). Proof. apply _. Qed. Lemma curry4_ne_test {A B C D E : ofe} (f : A * B * C * D → E) : NonExpansive f → NonExpansive4 (curry4 f). Proof. apply _. Qed. iris-iris-4.2.0/tests/atomic.ref000066400000000000000000000253651460620107300165550ustar00rootroot00000000000000"test_awp_apply" : string 1 goal H : atomic_heap Σ : gFunctors heapGS0 : heapGS Σ atomic_heapGS0 : atomic_heapGS Σ Q : iProp Σ l : loc v : val ============================ "HQ" : Q "Hl" : l ↦ v --------------------------------------∗ AACC <{ ∃∃ (v0 : val) (q : dfrac), l ↦{q} v0, ABORT Q ∗ l ↦ v }> @ ⊤ ∖ ∅, ∅ <{ l ↦{q} v0, COMM Q }> "test_awp_apply_without" : string 1 goal H : atomic_heap Σ : gFunctors heapGS0 : heapGS Σ atomic_heapGS0 : atomic_heapGS Σ Q : iProp Σ l : loc v : val ============================ "Hl" : l ↦ v --------------------------------------∗ AACC <{ ∃∃ (v0 : val) (q : dfrac), l ↦{q} v0, ABORT l ↦ v }> @ ⊤ ∖ ∅, ∅ <{ l ↦{q} v0, COMM Q -∗ Q }> "printing" : string 1 goal Σ : gFunctors heapGS0 : heapGS Σ P : val → iProp Σ ============================ ⊢ <<{ ∀∀ x : val, P x }>> code @ ∅ <<{ ∃∃ y : val, P y | RET #() }>> 1 goal Σ : gFunctors heapGS0 : heapGS Σ P : val → iProp Σ Φ : language.val heap_lang → iProp Σ ============================ "AU" : AU <{ ∃∃ x : val, P x }> @ ⊤, ∅ <{ ∀∀ y : val, P y, COMM Φ #() }> --------------------------------------∗ WP code {{ v, Φ v }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ P : val → iProp Σ Φ : language.val heap_lang → iProp Σ ============================ _ : AACC <{ ∃∃ x : val, P x, ABORT AU <{ ∃∃ x : val, P x }> @ ⊤, ∅ <{ ∀∀ y : val, P y, COMM Φ #() }> }> @ ⊤, ∅ <{ ∀∀ y : val, P y, COMM Φ #() }> --------------------------------------∗ WP code {{ v, Φ v }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc ============================ ⊢ <<{ ∀∀ x : val, l ↦ x }>> code @ ∅ <<{ l ↦ x | RET #() }>> 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc Φ : language.val heap_lang → iProp Σ ============================ "AU" : AU <{ ∃∃ x : val, l ↦ x }> @ ⊤ ∖ ∅, ∅ <{ l ↦ x, COMM Φ #() }> --------------------------------------∗ WP code {{ v, Φ v }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc Φ : language.val heap_lang → iProp Σ ============================ _ : AACC <{ ∃∃ x : val, l ↦ x, ABORT AU <{ ∃∃ x : val, l ↦ x }> @ ⊤ ∖ ∅, ∅ <{ l ↦ x, COMM Φ #() }> }> @ ⊤ ∖ ∅, ∅ <{ l ↦ x, COMM Φ #() }> --------------------------------------∗ WP code {{ v, Φ v }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc ============================ ⊢ <<{ l ↦ #() }>> code @ ∅ <<{ ∃∃ y : val, l ↦ y | RET #() }>> 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc Φ : language.val heap_lang → iProp Σ ============================ "AU" : AU <{ l ↦ #() }> @ ⊤ ∖ ∅, ∅ <{ ∀∀ y : val, l ↦ y, COMM Φ #() }> --------------------------------------∗ WP code {{ v, Φ v }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc Φ : language.val heap_lang → iProp Σ ============================ _ : AACC <{ l ↦ #(), ABORT AU <{ l ↦ #() }> @ ⊤ ∖ ∅, ∅ <{ ∀∀ y : val, l ↦ y, COMM Φ #() }> }> @ ⊤ ∖ ∅, ∅ <{ ∀∀ y : val, l ↦ y, COMM Φ #() }> --------------------------------------∗ WP code {{ v, Φ v }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc ============================ ⊢ <<{ l ↦ #() }>> code @ ∅ <<{ l ↦ #() | RET #() }>> 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc Φ : language.val heap_lang → iProp Σ ============================ "AU" : AU <{ l ↦ #() }> @ ⊤ ∖ ∅, ∅ <{ l ↦ #(), COMM Φ #() }> --------------------------------------∗ WP code {{ v, Φ v }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc Φ : language.val heap_lang → iProp Σ ============================ _ : AACC <{ l ↦ #(), ABORT AU <{ l ↦ #() }> @ ⊤ ∖ ∅, ∅ <{ l ↦ #(), COMM Φ #() }> }> @ ⊤ ∖ ∅, ∅ <{ l ↦ #(), COMM Φ #() }> --------------------------------------∗ WP code {{ v, Φ v }} "Now come the long pre/post tests" : string 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc ============================ ⊢ <<{ ∀∀ x : val, l ↦ x ∗ l ↦ x }>> code @ ∅ <<{ ∃ y : val, l ↦ y | RET #() }>> 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc Φ : language.val heap_lang → iProp Σ ============================ "AU" : AU <{ ∃∃ x : val, l ↦ x ∗ l ↦ x }> @ ⊤ ∖ ∅, ∅ <{ ∃ y : val, l ↦ y, COMM Φ #() }> --------------------------------------∗ WP code {{ v, Φ v }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc ============================ ⊢ <<{ ∀∀ x : val, l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x }>> code @ ∅ <<{ ∃∃ y : val, l ↦ y | RET #() }>> 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc Φ : language.val heap_lang → iProp Σ ============================ "AU" : AU <{ ∃∃ x : val, l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x }> @ ⊤ ∖ ∅, ∅ <{ ∀∀ y : val, l ↦ y, COMM Φ #() }> --------------------------------------∗ WP code {{ v, Φ v }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc ============================ ⊢ <<{ ∀∀ xx : val, l ↦ xx ∗ l ↦ xx ∗ l ↦ xx }>> code @ ∅ <<{ ∃∃ yyyy : val, l ↦ yyyy ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx | RET #() }>> 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc Φ : language.val heap_lang → iProp Σ ============================ _ : AU <{ ∃∃ xx : val, l ↦ xx ∗ l ↦ xx ∗ l ↦ xx }> @ ⊤ ∖ ∅, ∅ <{ ∀∀ yyyy : val, l ↦ yyyy ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx, COMM Φ #() }> --------------------------------------∗ WP code {{ v, Φ v }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc ============================ ⊢ <<{ ∀∀ x : val, l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x }>> code @ ∅ <<{ l ↦ x | RET #() }>> 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc Φ : language.val heap_lang → iProp Σ ============================ "AU" : AU <{ ∃∃ x : val, l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x }> @ ⊤ ∖ ∅, ∅ <{ l ↦ x, COMM Φ #() }> --------------------------------------∗ WP code {{ v, Φ v }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc x : val ============================ ⊢ <<{ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x }>> code @ ∅ <<{ ∃∃ y : val, l ↦ y | RET #() }>> 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc x : val Φ : language.val heap_lang → iProp Σ ============================ "AU" : AU <{ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x }> @ ⊤ ∖ ∅, ∅ <{ ∀∀ y : val, l ↦ y, COMM Φ #() }> --------------------------------------∗ WP code {{ v, Φ v }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc x : val ============================ ⊢ <<{ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x }>> code @ ∅ <<{ l ↦ #() | RET #() }>> 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc x : val Φ : language.val heap_lang → iProp Σ ============================ "AU" : AU <{ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x }> @ ⊤ ∖ ∅, ∅ <{ l ↦ #(), COMM Φ #() }> --------------------------------------∗ WP code {{ v, Φ v }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc xx, yyyy : val ============================ ⊢ <<{ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx }>> code @ ∅ <<{ l ↦ yyyy | RET #() }>> 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc xx, yyyy : val Φ : language.val heap_lang → iProp Σ ============================ "AU" : AU <{ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx }> @ ⊤ ∖ ∅, ∅ <{ l ↦ yyyy, COMM Φ #() }> --------------------------------------∗ WP code {{ v, Φ v }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc xx, yyyy : val ============================ ⊢ <<{ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx }>> code @ ∅ <<{ l ↦ yyyy ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx | RET #() }>> 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc xx, yyyy : val Φ : language.val heap_lang → iProp Σ ============================ "AU" : AU <{ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx }> @ ⊤ ∖ ∅, ∅ <{ l ↦ yyyy ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx, COMM Φ #() }> --------------------------------------∗ WP code {{ v, Φ v }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ P : val → iProp Σ ============================ ⊢ <<{ ∀∀ x : val, P x }>> code @ ∅ <<{ ∃∃ y : val, P y | z : val, RET z; P z }>> 1 goal Σ : gFunctors heapGS0 : heapGS Σ P : val → iProp Σ ============================ ⊢ <<{ ∀∀ x : val, P x }>> code @ ∅ <<{ ∃∃ y : val, P y | RET y; P y }>> 1 goal Σ : gFunctors heapGS0 : heapGS Σ P : val → iProp Σ ============================ ⊢ <<{ ∀∀ x : val, P x }>> code @ ∅ <<{ P x | RET x; P x }>> 1 goal Σ : gFunctors heapGS0 : heapGS Σ P : val → iProp Σ ============================ ⊢ <<{ P #() }>> code @ ∅ <<{ ∃∃ y : val, P y | RET y; P y }>> 1 goal Σ : gFunctors heapGS0 : heapGS Σ P : iProp Σ ============================ ⊢ <<{ P }>> code @ ∅ <<{ P | RET #42; P }>> "Prettification" : string 1 goal Σ : gFunctors heapGS0 : heapGS Σ P : val → iProp Σ Φ : language.val heap_lang → iProp Σ ============================ "AU" : ∃ x : val, P x ∗ (P x ={∅,⊤}=∗ AU <{ ∃∃ x0 : val, P x0 }> @ ⊤ ∖ ∅, ∅ <{ ∀∀ y : val, P y, COMM Φ #() }>) ∧ ∀ x0 : val, P x0 ={∅,⊤}=∗ Φ #() --------------------------------------∗ WP ! #0 @ ∅ {{ v, |={∅,⊤}=> Φ v }} iris-iris-4.2.0/tests/atomic.v000066400000000000000000000125461460620107300162430ustar00rootroot00000000000000From iris.bi Require Import atomic. From iris.proofmode Require Import tactics. From iris.program_logic Require Export atomic. From iris.heap_lang Require Import proofmode notation atomic_heap. From iris.prelude Require Import options. Unset Mangle Names. Section general_bi_tests. Context `{BiFUpd PROP} {TA TB : tele} (Eo Ei : coPset). (** We can quantify over telescopes *inside* Iris and use them with atomic updates. *) Definition AU_tele_quantify_iris : Prop := ⊢ ∀ (TA TB : tele) (α : TA → PROP) (β Φ : TA → TB → PROP), atomic_update Eo Ei α β Φ. (** iAuIntro works. *) Lemma au_intro_1 (P : PROP) (α : TA → PROP) (β Φ : TA → TB → PROP) : P -∗ atomic_update Eo Ei α β Φ. Proof. iIntros "HP". iAuIntro. Abort. End general_bi_tests. Section tests. Context `{!atomic_heap, !heapGS Σ, !atomic_heapGS Σ}. Import atomic_heap.notation. Check "test_awp_apply". Lemma test_awp_apply (Q : iProp Σ) (l : loc) v : Q -∗ l ↦ v -∗ WP !#l {{ _, Q }}. Proof. iIntros "HQ Hl". awp_apply load_spec. Show. iAaccIntro with "Hl"; eauto with iFrame. Qed. Check "test_awp_apply_without". Lemma test_awp_apply_without (Q : iProp Σ) (l : loc) v : Q -∗ l ↦ v -∗ WP !#l {{ _, Q }}. Proof. iIntros "HQ Hl". awp_apply load_spec without "HQ". Show. iAaccIntro with "Hl"; eauto with iFrame. Qed. End tests. (* Test if AWP and the AU obtained from AWP print (and also tests that all the AWP variants parse and type-check). *) Check "printing". Section printing. Context `{!heapGS Σ}. Definition code : expr := #(). (* Without private postcondition or RET binders *) Lemma print_both_quant (P : val → iProp Σ) : ⊢ <<{ ∀∀ x, P x }>> code @ ∅ <<{ ∃∃ y, P y | RET #() }>>. Proof. Show. iIntros (Φ) "AU". rewrite difference_empty_L. Show. iPoseProof (aupd_aacc with "AU") as "?". Show. Abort. Lemma print_first_quant l : ⊢ <<{ ∀∀ x, l ↦ x }>> code @ ∅ <<{ l ↦ x | RET #() }>>. Proof. Show. iIntros (Φ) "AU". Show. iPoseProof (aupd_aacc with "AU") as "?". Show. Abort. Lemma print_second_quant l : ⊢ <<{ l ↦ #() }>> code @ ∅ <<{ ∃∃ y, l ↦ y | RET #() }>>. Proof. Show. iIntros (Φ) "AU". Show. iPoseProof (aupd_aacc with "AU") as "?". Show. Abort. Lemma print_no_quant l : ⊢ <<{ l ↦ #() }>> code @ ∅ <<{ l ↦ #() | RET #() }>>. Proof. Show. iIntros (Φ) "AU". Show. iPoseProof (aupd_aacc with "AU") as "?". Show. Abort. Check "Now come the long pre/post tests". Lemma print_both_quant_long l : ⊢ <<{ ∀∀ x, l ↦ x ∗ l ↦ x }>> code @ ∅ <<{ ∃ y, l ↦ y | RET #() }>>. Proof. Show. iIntros (Φ) "AU". Show. Abort. Lemma print_both_quant_longpre l : ⊢ <<{ ∀∀ x, l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x }>> code @ ∅ <<{ ∃∃ y, l ↦ y | RET #() }>>. Proof. Show. iIntros (Φ) "AU". Show. Abort. Lemma print_both_quant_longpost l : ⊢ <<{ ∀∀ xx, l ↦ xx ∗ l ↦ xx ∗ l ↦ xx }>> code @ ∅ <<{ ∃∃ yyyy, l ↦ yyyy ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx | RET #() }>>. Proof. Show. iIntros (Φ) "?". Show. Abort. Lemma print_first_quant_long l : ⊢ <<{ ∀∀ x, l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x }>> code @ ∅ <<{ l ↦ x | RET #() }>>. Proof. Show. iIntros (Φ) "AU". Show. Abort. Lemma print_second_quant_long l x : ⊢ <<{ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x }>> code @ ∅ <<{ ∃∃ y, l ↦ y | RET #() }>>. Proof. Show. iIntros (Φ) "AU". Show. Abort. Lemma print_no_quant_long l x : ⊢ <<{ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x ∗ l ↦ x }>> code @ ∅ <<{ l ↦ #() | RET #() }>>. Proof. Show. iIntros (Φ) "AU". Show. Abort. Lemma print_no_quant_longpre l xx yyyy : ⊢ <<{ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx }>> code @ ∅ <<{ l ↦ yyyy | RET #() }>>. Proof. Show. iIntros (Φ) "AU". Show. Abort. Lemma print_no_quant_longpost l xx yyyy : ⊢ <<{ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx }>> code @ ∅ <<{ l ↦ yyyy ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx ∗ l ↦ xx | RET #() }>>. Proof. Show. iIntros (Φ) "AU". Show. Abort. (* With private postcondition. (Makes no big difference for the AU so we only print the initial triple here.) *) Lemma print_all (P : val → iProp Σ) : ⊢ <<{ ∀∀ x, P x }>> code @ ∅ <<{ ∃∃ y, P y | z, RET z; P z }>>. Proof. Show. Abort. Lemma print_no_ret (P : val → iProp Σ) : ⊢ <<{ ∀∀ x, P x }>> code @ ∅ <<{ ∃∃ y, P y | RET y; P y }>>. Proof. Show. Abort. Lemma print_no_ex_ret (P : val → iProp Σ) : ⊢ <<{ ∀∀ x, P x }>> code @ ∅ <<{ P x | RET x; P x }>>. Proof. Show. Abort. Lemma print_no_all_ret (P : val → iProp Σ) : ⊢ <<{ P #() }>> code @ ∅ <<{ ∃∃ y, P y | RET y; P y }>>. Proof. Show. Abort. Lemma print_no_all_ex_ret (P : iProp Σ) : ⊢ <<{ P }>> code @ ∅ <<{ P | RET #42; P }>>. Proof. Show. Abort. (* misc *) Check "Prettification". Lemma iMod_prettify (P : val → iProp Σ) : ⊢ <<{ ∀∀ x, P x }>> !#0 @ ∅ <<{ ∃∃ y, P y | RET #() }>>. Proof. iIntros (Φ) "AU". iMod "AU". Show. Abort. End printing. iris-iris-4.2.0/tests/bi.ref000066400000000000000000000007721460620107300156660ustar00rootroot00000000000000The command has indeed failed with message: In environment PROP : bi m : gmap nat nat The term "m" has type "gmap nat nat" while it is expected to have type "gmap nat Z" (cannot unify "nat" and "Z"). The command has indeed failed with message: Unable to satisfy the following constraints: In environment: PROP : bi P : PROP ?p : "Persistent (|==> P)" The command has indeed failed with message: Unable to satisfy the following constraints: In environment: PROP : bi P : PROP ?p : "Persistent (■ P)" iris-iris-4.2.0/tests/bi.v000066400000000000000000000062101460620107300153500ustar00rootroot00000000000000From iris.bi Require Import bi plainly big_op. Unset Mangle Names. (** See https://gitlab.mpi-sws.org/iris/iris/-/merge_requests/610 *) Lemma test_impl_persistent_1 `{!BiPlainly PROP, !BiPersistentlyImplPlainly PROP} : Persistent (PROP:=PROP) (True → True). Proof. apply _. Qed. Lemma test_impl_persistent_2 `{!BiPlainly PROP, !BiPersistentlyImplPlainly PROP} : Persistent (PROP:=PROP) (True → True → True). Proof. apply _. Qed. (* Test that the right scopes are used. *) Lemma test_bi_scope {PROP : bi} : True. Proof. (* [ True] is implicitly in %I scope. *) pose proof (bi.wand_iff_refl (PROP:=PROP) ( True)). Abort. (** Some basic tests to make sure patterns work in big ops. *) Definition big_sepM_pattern_value {PROP : bi} (m : gmap nat (nat * nat)) : PROP := [∗ map] '(x,y) ∈ m, ⌜ 10 = x ⌝. Definition big_sepM_pattern_value_tt {PROP : bi} (m : gmap nat ()) : PROP := [∗ map] '() ∈ m, True. Inductive foo := Foo (n : nat). Definition big_sepM_pattern_value_custom {PROP : bi} (m : gmap nat foo) : PROP := [∗ map] '(Foo x) ∈ m, ⌜ 10 = x ⌝. Definition big_sepM_pattern_key {PROP : bi} (m : gmap (nat * nat) nat) : PROP := [∗ map] '(k,_) ↦ _ ∈ m, ⌜ 10 = k ⌝. Definition big_sepM_pattern_both {PROP : bi} (m : gmap (nat * nat) (nat * nat)) : PROP := [∗ map] '(k,_) ↦ '(_,y) ∈ m, ⌜ k = y ⌝. Definition big_sepM2_pattern {PROP : bi} (m1 m2 : gmap nat (nat * nat)) : PROP := [∗ map] '(x,_);'(_,y) ∈ m1;m2, ⌜ x = y ⌝. (** This fails, Coq will infer [x] to have type [Z] due to the equality, and then sees a type mismatch with [m : gmap nat nat]. *) Fail Definition big_sepM_implicit_type {PROP : bi} (m : gmap nat nat) : PROP := [∗ map] x ∈ m, ⌜ 10%Z = x ⌝. (** With a cast, we can force Coq to type check the body with [x : nat] and thereby insert the [nat] to [Z] coercion in the body. *) Definition big_sepM_cast {PROP : bi} (m : gmap nat nat) : PROP := [∗ map] (x:nat) ∈ m, ⌜ 10%Z = x ⌝. Section big_sepM_implicit_type. Implicit Types x : nat. (** And we can do the same with an [Implicit Type]. *) Definition big_sepM_implicit_type {PROP : bi} (m : gmap nat nat) : PROP := [∗ map] x ∈ m, ⌜ 10%Z = x ⌝. End big_sepM_implicit_type. (** This tests that [bupd] is [Typeclasses Opaque]. If [bupd] were transparent, Coq would unify [bupd_instance] with [persistently]. *) Goal ∀ {PROP : bi} (P : PROP), ∃ bupd_instance, Persistent (@bupd PROP bupd_instance P). Proof. intros. eexists _. Fail apply _. Abort. (* Similarly for [plainly]. *) Goal ∀ {PROP : bi} (P : PROP), ∃ plainly_instance, Persistent (@plainly PROP plainly_instance P). Proof. intros. eexists _. Fail apply _. Abort. Section internal_eq_ne. Context `{!BiInternalEq PROP} {A : ofe} (a : A). Goal NonExpansive (λ x, (a ≡ x : PROP)%I). Proof. solve_proper. Qed. (* The ones below rely on [SolveProperSubrelation] *) Context `{!OfeDiscrete A}. Goal NonExpansive (λ x, (⌜a ≡ x⌝ : PROP)%I). Proof. solve_proper. Qed. Context `{!LeibnizEquiv A}. Goal NonExpansive (λ x, (⌜a = x⌝ : PROP)%I). Proof. solve_proper. Qed. End internal_eq_ne. iris-iris-4.2.0/tests/bi_ascii_parsing.ref000066400000000000000000000001361460620107300205530ustar00rootroot00000000000000"test1" : string True%I (⊢ True) "test2" : string False%I True%I (False ⊢ True) iris-iris-4.2.0/tests/bi_ascii_parsing.v000066400000000000000000000013201460620107300202400ustar00rootroot00000000000000Require Import Coq.Strings.String. Require Import iris.bi.bi. Require Import iris.bi.ascii. Local Open Scope string_scope. (* this file demonstrates that the [|-] notation does not conflict with the ltac notation. *) Section with_bi. Context {PROP : bi}. Variables P Q R : PROP. Local Open Scope stdpp_scope. Ltac pg := match goal with | |- ?X => idtac X end. Ltac foo g := lazymatch g with | |- ?T => idtac T | ?U |- ?T => idtac U T end. Ltac bar := match goal with | |- ?G => foo G end. Check "test1". Lemma test1 : |-@{PROP} True. Proof. bar. pg. Abort. Check "test2". Lemma test2 : False |-@{PROP} True. Proof. bar. pg. Abort. End with_bi. iris-iris-4.2.0/tests/fixpoint.ref000066400000000000000000000000001460620107300171140ustar00rootroot00000000000000iris-iris-4.2.0/tests/fixpoint.v000066400000000000000000000016661460620107300166300ustar00rootroot00000000000000From iris.bi Require Import lib.fixpoint. From iris.proofmode Require Import proofmode. From iris.prelude Require Import options. Section fixpoint. Context {PROP : bi} `{!BiInternalEq PROP} {A : ofe} (F : (A → PROP) → (A → PROP)) `{!BiMonoPred F}. Definition L := bi_least_fixpoint F. Definition G := bi_greatest_fixpoint F. (* Make sure the lemmas [iApply] without having to repeat the induction predicate [Φ]. See https://gitlab.mpi-sws.org/iris/iris/-/merge_requests/967 for details. *) Lemma ind_test (a : A) : ∀ x, L x -∗ x ≡ a. Proof. iApply (least_fixpoint_ind F); first by solve_proper. Undo. iApply (least_fixpoint_ind_wf F); first by solve_proper. Undo. Abort. Lemma coind_test (a : A) : ∀ x, x ≡ a -∗ G x. Proof. iApply (greatest_fixpoint_coind F); first by solve_proper. Undo. iApply (greatest_fixpoint_paco F); first by solve_proper. Undo. Abort. End fixpoint. iris-iris-4.2.0/tests/gset.ref000066400000000000000000000000001460620107300162160ustar00rootroot00000000000000iris-iris-4.2.0/tests/gset.v000066400000000000000000000012051460620107300157170ustar00rootroot00000000000000From iris.algebra Require Import gset. Lemma test_op (X Y : gset nat) : X ⊆ Y → X ⋅ Y = Y. Proof. set_solver. Qed. Lemma test_included (X Y : gset nat) : X ≼ Y → X ∪ Y = Y ∧ X ∩ Y = X. Proof. set_solver. Qed. Lemma test_disj_included (X Y : gset nat) : GSet X ≼ GSet Y → X ∪ Y = Y ∧ X ∩ Y = X. Proof. set_solver. Qed. Lemma test_disj_equiv n : GSet (∅ : gset nat) ≡ GSet {[n]} → False. Proof. set_solver. Qed. Lemma test_disj_eq n : GSet (∅ : gset nat) = GSet {[n]} → False. Proof. set_solver. Qed. Lemma test_disj_valid (X Y : gset nat) : ✓ (GSet X ⋅ GSet Y) → X ∩ Y = ∅. Proof. set_solver. Qed. iris-iris-4.2.0/tests/heap_lang.ref000066400000000000000000000161221460620107300172060ustar00rootroot00000000000000"heap_e_spec" : string 1 goal Σ : gFunctors heapGS0 : heapGS Σ E : coPset ============================ ⊢ WP let: "x" := ref #1 in "x" <- ! "x" + #1;; ! "x" @ E {{ v, ⌜v = #2⌝ }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ E : coPset l : loc ============================ _ : l ↦ #1 --------------------------------------∗ WP #l <- #1 + #1;; ! #l @ E {{ v, ⌜v = #2⌝ }} "heap_e2_spec" : string 1 goal Σ : gFunctors heapGS0 : heapGS Σ 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 goal Σ : gFunctors heapGS0 : heapGS Σ E : coPset l, l' : loc ============================ "Hl" : l ↦ #1 _ : l' ↦ #1 --------------------------------------∗ WP #l <- #1 + #1;; ! #l @ E [{ v, ⌜v = #2⌝ }] "heap_e7_spec" : string 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc ============================ _ : ▷ l ↦ #0 --------------------------------------∗ WP CmpXchg #l #0 #1 {{ _, l ↦ #1 }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc ============================ _ : l ↦ #1 --------------------------------------∗ |={⊤}=> l ↦ #1 "wp_load_fail" : string The command has indeed failed with message: Tactic failure: wp_load: cannot find 'Load' in (Fork #()). The command has indeed failed with message: Tactic failure: wp_load: cannot find 'Load' in (Fork #()). "wp_load_no_ptsto" : string The command has indeed failed with message: Tactic failure: wp_load: cannot find l ↦ ?. "wp_store_fail" : string The command has indeed failed with message: Tactic failure: wp_store: cannot find 'Store' in (Fork #()). The command has indeed failed with message: Tactic failure: wp_store: cannot find 'Store' in (Fork #()). "wp_store_no_ptsto" : string The command has indeed failed with message: Tactic failure: wp_store: cannot find l ↦ ?. "(t)wp_bind_fail" : string The command has indeed failed with message: Tactic failure: wp_bind: cannot find (! ?e)%E in (Val #()). The command has indeed failed with message: Tactic failure: wp_bind: cannot find (! ?e)%E in (Val #()). 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc ============================ "Hl1" : l ↦{#1 / 2} #0 "Hl2" : l ↦{#1 / 2} #0 --------------------------------------∗ |={⊤}=> True 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc ============================ --------------------------------------∗ |={⊤}=> True "wp_nonclosed_value" : string The command has indeed failed with message: Tactic failure: wp_pure: cannot find ?y in (Var "x") or ?y is not a redex. 1 goal Σ : gFunctors heapGS0 : heapGS Σ ============================ --------------------------------------∗ WP "x" {{ _, True }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ n : Z H : (0 < n)%Z Φ : val → iPropI Σ l : loc ============================ "HΦ" : ∀ l0 : loc, l0 ↦∗ replicate (Z.to_nat n) #0 -∗ Φ #l0 _ : l ↦∗ replicate (Z.to_nat n) #0 --------------------------------------∗ |={⊤}=> Φ #l "test_array_fraction_destruct" : string 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc vs : list val ============================ "Hl1" : l ↦∗{#1 / 2} vs "Hl2" : l ↦∗{#1 / 2} vs --------------------------------------∗ l ↦∗{#1 / 2} vs ∗ l ↦∗{#1 / 2} vs "test_wp_finish_fupd" : string 1 goal Σ : gFunctors heapGS0 : heapGS Σ v : val ============================ --------------------------------------∗ |={⊤}=> True "test_twp_finish_fupd" : string 1 goal Σ : gFunctors heapGS0 : heapGS Σ v : val ============================ --------------------------------------∗ |={⊤}=> True "test_heaplang_not_unfolded" : string 1 goal Σ : gFunctors heapGS0 : heapGS_gen HasLc Σ ============================ @bi_emp_valid (uPredI (iResUR Σ)) (@fupd (bi_car (uPredI (iResUR Σ))) (@bi_fupd_fupd _ (@uPred_bi_fupd HasLc Σ (@iris_invGS HasLc heap_lang Σ (@heapGS_irisGS HasLc Σ heapGS0)))) (@top coPset coPset_top) (@top coPset coPset_top) (@bi_pure (uPredI (iResUR Σ)) True)) "test_wp_pure_credit_succeed" : string 1 goal Σ : gFunctors heapGS0 : heapGS Σ P : iProp Σ ============================ "Hcred" : £ 1 --------------------------------------∗ |={⊤}=> ▷ P ={∅}=∗ P "test_wp_pure_credit_fail" : string The command has indeed failed with message: Tactic failure: wp_pure: "Hcred" is not fresh. 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc v : val Φ : val → iPropI Σ ============================ "Hl" : l ↦□ v --------------------------------------□ "HΦ" : ▷ (True -∗ Φ v) --------------------------------------∗ WP ! #l {{ v, Φ v }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ dq : dfrac l : loc v : val Φ : val → iPropI Σ ============================ "Hl" : l ↦{dq} v "HΦ" : True -∗ Φ v --------------------------------------∗ WP ! #l [{ v, Φ v }] 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc v1 : val q1 : Qp v2 : val q2 : Qp v3 : val q3 : Qp v4 : val q4 : Qp H : ((✓ (DfracOwn q3 ⋅ DfracOwn q4) ∧ v3 = v4) ∧ ✓ (DfracOwn q2 ⋅ (DfracOwn q3 ⋅ DfracOwn q4)) ∧ v2 = v3) ∧ ✓ (DfracOwn q1 ⋅ (DfracOwn q2 ⋅ (DfracOwn q3 ⋅ DfracOwn q4))) ∧ v1 = v2 ============================ --------------------------------------∗ ⌜(q1 + (q2 + (q3 + q4)) ≤ 1)%Qp⌝ ∗ ⌜v1 = v2⌝ ∗ ⌜ v2 = v3⌝ ∗ ⌜v3 = v4⌝ 1 goal Σ : gFunctors heapGS0 : heapGS Σ l : loc I : val → Prop Heq : ∀ v : val, I v ↔ I #true ============================ ⊢ l ↦_(λ _ : val, I #true) □ "wp_iMod_fupd_atomic" : string 2 goals Σ : gFunctors heapGS0 : heapGS Σ E1, E2 : coPset P : iProp Σ ============================ Atomic (stuckness_to_atomicity NotStuck) (#() #()) goal 2 is: "H" : P --------------------------------------∗ WP #() #() @ E2 {{ _, |={E2,E1}=> True }} "wp_iInv_atomic" : string 2 goals Σ : gFunctors heapGS0 : heapGS Σ N : namespace E : coPset P : iProp Σ H : ↑N ⊆ E ============================ Atomic (stuckness_to_atomicity NotStuck) (#() #()) goal 2 is: "H" : ▷ P "Hclose" : ▷ P ={E ∖ ↑N,E}=∗ emp --------------------------------------∗ WP #() #() @ E ∖ ↑N {{ _, |={E ∖ ↑N,E}=> True }} "wp_iInv_atomic_acc" : string 2 goals Σ : gFunctors heapGS0 : heapGS Σ N : namespace E : coPset P : iProp Σ H : ↑N ⊆ E ============================ Atomic (stuckness_to_atomicity NotStuck) (#() #()) goal 2 is: "H" : ▷ P --------------------------------------∗ WP #() #() @ E ∖ ↑N {{ _, |={E ∖ ↑N}=> ▷ P ∗ True }} "not_cmpxchg" : string The command has indeed failed with message: Tactic failure: wp_cmpxchg_suc: cannot find 'CmpXchg' in (#() #()). iris-iris-4.2.0/tests/heap_lang.v000066400000000000000000000362101460620107300166770ustar00rootroot00000000000000From iris.base_logic.lib Require Import gen_inv_heap invariants. From iris.program_logic Require Export weakestpre total_weakestpre. From iris.heap_lang Require Import lang adequacy total_adequacy proofmode notation. From iris.prelude Require Import options. (* For printing tests we want stable names. *) Unset Mangle Names. Section tests. Context `{!heapGS Σ}. Implicit Types P Q : iProp Σ. Implicit Types Φ : val → iProp Σ. Definition simpl_test : ⌜(10 = 4 + 6)%nat⌝ -∗ WP let: "x" := ref #1 in "x" <- !"x";; !"x" {{ v, ⌜v = #1⌝ }}. Proof. iIntros "?". wp_alloc l. repeat wp_pure || wp_load || wp_store. match goal with | |- context [ (10 = 4 + 6)%nat ] => done end. Qed. Definition val_scope_test_1 := SOMEV (#(), #()). Definition heap_e : expr := let: "x" := ref #1 in "x" <- !"x" + #1 ;; !"x". Check "heap_e_spec". Lemma heap_e_spec E : ⊢ WP heap_e @ E {{ v, ⌜v = #2⌝ }}. Proof. iIntros "". rewrite /heap_e. Show. wp_alloc l as "?". wp_pures. wp_bind (!_)%E. wp_load. Show. (* No fupd was added *) wp_store. by wp_load. Qed. Definition heap_e2 : expr := let: "x" := ref #1 in let: "y" := ref #1 in "x" <- !"x" + #1 ;; !"x". Check "heap_e2_spec". Lemma heap_e2_spec E : ⊢ WP heap_e2 @ E [{ v, ⌜v = #2⌝ }]. Proof. iIntros "". rewrite /heap_e2. wp_alloc l as "Hl". Show. wp_alloc l'. do 2 wp_pure. wp_bind (!_)%E. wp_load. Show. (* No fupd was added *) wp_store. wp_load. done. Qed. Definition heap_e3 : expr := let: "x" := #true in let: "f" := λ: "z", "z" + #1 in if: "x" then "f" #0 else "f" #1. Lemma heap_e3_spec E : ⊢ WP heap_e3 @ E [{ v, ⌜v = #1⌝ }]. Proof. iIntros "". rewrite /heap_e3. by repeat (wp_pure _). Qed. Definition heap_e4 : expr := let: "x" := (let: "y" := ref (ref #1) in ref "y") in ! ! !"x". Lemma heap_e4_spec : ⊢ WP heap_e4 [{ v, ⌜ v = #1 ⌝ }]. Proof. rewrite /heap_e4. wp_alloc l. wp_alloc l'. wp_alloc l''. by repeat wp_load. Qed. Definition heap_e5 : expr := let: "x" := ref (ref #1) in ! ! "x" + FAA (!"x") (#10 + #1). Lemma heap_e5_spec E : ⊢ WP heap_e5 @ E [{ v, ⌜v = #13⌝ }]. Proof. rewrite /heap_e5. wp_alloc l. wp_alloc l'. wp_load. wp_faa. do 2 wp_load. by wp_pures. Qed. Definition heap_e6 : val := λ: "v", "v" = "v". Lemma heap_e6_spec (v : val) : val_is_unboxed v → ⊢ WP heap_e6 v {{ w, ⌜ w = #true ⌝ }}. Proof. intros ?. wp_lam. wp_op. by case_bool_decide. Qed. Definition heap_e7 : val := λ: "v", CmpXchg "v" #0 #1. Lemma heap_e7_spec_total l : l ↦ #0 -∗ WP heap_e7 #l [{_, l ↦ #1 }]. Proof. iIntros. wp_lam. wp_cmpxchg_suc. auto. Qed. Check "heap_e7_spec". Lemma heap_e7_spec l : ▷^2 l ↦ #0 -∗ WP heap_e7 #l {{_, l ↦ #1 }}. Proof. iIntros. wp_lam. Show. wp_cmpxchg_suc. Show. auto. Qed. Definition FindPred : val := rec: "pred" "x" "y" := let: "yp" := "y" + #1 in if: "yp" < "x" then "pred" "x" "yp" else "y". Definition Pred : val := λ: "x", if: "x" ≤ #0 then -FindPred (-"x" + #2) #0 else FindPred "x" #0. Lemma FindPred_spec n1 n2 E Φ : (n1 < n2)%Z → Φ #(n2 - 1) -∗ WP FindPred #n2 #n1 @ E [{ Φ }]. Proof. iIntros (Hn) "HΦ". iInduction (Z.gt_wf n2 n1) as [n1' _] "IH" forall (Hn). wp_rec. wp_pures. case_bool_decide; wp_if. - iApply ("IH" with "[%] [%] HΦ"); lia. - by assert (n1' = n2 - 1)%Z as -> by lia. Qed. Lemma Pred_spec n E Φ : Φ #(n - 1) -∗ WP Pred #n @ E [{ Φ }]. Proof. iIntros "HΦ". wp_lam. wp_op. case_bool_decide. - wp_smart_apply FindPred_spec; first lia. wp_pures. by replace (n - 1)%Z with (- (-n + 2 - 1))%Z by lia. - wp_smart_apply FindPred_spec; eauto with lia. Qed. Lemma Pred_user E : ⊢ WP let: "x" := Pred #42 in Pred "x" @ E [{ v, ⌜v = #40⌝ }]. Proof. iIntros "". wp_apply Pred_spec. by wp_smart_apply Pred_spec. Qed. Definition Id : val := rec: "go" "x" := if: "x" = #0 then #() else "go" ("x" - #1). (** These tests specially test the handling of the [vals_compare_safe] side-condition of the [=] operator. *) Lemma Id_wp (n : nat) : ⊢ WP Id #n {{ v, ⌜ v = #() ⌝ }}. Proof. iInduction n as [|n] "IH"; wp_rec; wp_pures; first done. by replace (S n - 1)%Z with (n:Z) by lia. Qed. Lemma Id_twp (n : nat) : ⊢ WP Id #n [{ v, ⌜ v = #() ⌝ }]. Proof. iInduction n as [|n] "IH"; wp_rec; wp_pures; first done. by replace (S n - 1)%Z with (n:Z) by lia. Qed. Definition compare_pointers : val := λ: <>, let: "x" := ref #0 in let: "y" := ref #0 in ("x", "y", "x" ≤ "y"). Lemma wp_compare_pointers E : ⊢ WP compare_pointers #() @ E [{ v, ∃ l1 l2 : loc, ⌜v = (#l1, #l2, #(bool_decide (loc_car l1 ≤ loc_car l2)))%V⌝ }]. Proof. rewrite /compare_pointers. wp_pures. wp_alloc l1 as "H1". wp_alloc l2 as "H2". wp_pures. by eauto. Qed. (* Make sure [wp_bind] works even when it changes nothing. *) Lemma wp_bind_nop (e : expr) : ⊢ WP e + #0 {{ _, True }}. Proof. wp_bind (e + #0)%E. Abort. Lemma wp_bind_nop (e : expr) : ⊢ WP e + #0 [{ _, True }]. Proof. wp_bind (e + #0)%E. Abort. Check "wp_load_fail". Lemma wp_load_fail : ⊢ WP Fork #() {{ _, True }}. Proof. Fail wp_load. Abort. Lemma twp_load_fail : ⊢ WP Fork #() [{ _, True }]. Proof. Fail wp_load. Abort. Check "wp_load_no_ptsto". Lemma wp_load_fail_no_ptsto (l : loc) : ⊢ WP ! #l {{ _, True }}. Proof. Fail wp_load. Abort. Check "wp_store_fail". Lemma wp_store_fail : ⊢ WP Fork #() {{ _, True }}. Proof. Fail wp_store. Abort. Lemma twp_store_fail : ⊢ WP Fork #() [{ _, True }]. Proof. Fail wp_store. Abort. Check "wp_store_no_ptsto". Lemma wp_store_fail_no_ptsto (l : loc) : ⊢ WP #l <- #0 {{ _, True }}. Proof. Fail wp_store. Abort. Check "(t)wp_bind_fail". Lemma wp_bind_fail : ⊢ WP of_val #() {{ v, True }}. Proof. Fail wp_bind (!_)%E. Abort. Lemma twp_bind_fail : ⊢ WP of_val #() [{ v, True }]. Proof. Fail wp_bind (!_)%E. Abort. Lemma wp_apply_evar e P : P -∗ (∀ Q Φ, Q -∗ WP e {{ Φ }}) -∗ WP e {{ _, True }}. Proof. iIntros "HP HW". wp_apply "HW". iExact "HP". Qed. Lemma wp_pures_val (b : bool) : ⊢ WP of_val #b {{ _, True }}. Proof. wp_pures. done. Qed. Lemma twp_pures_val (b : bool) : ⊢ WP of_val #b [{ _, True }]. Proof. wp_pures. done. Qed. Lemma wp_cmpxchg l v : val_is_unboxed v → l ↦ v -∗ WP CmpXchg #l v v {{ _, True }}. Proof. iIntros (?) "?". wp_cmpxchg as ? | ?; done. Qed. Lemma wp_xchg l (v₁ v₂ : val) : {{{ l ↦ v₁ }}} Xchg #l v₂ {{{ RET v₁; l ↦ v₂ }}}. Proof. iIntros (Φ) "Hl HΦ". wp_xchg. iApply "HΦ" => //. Qed. Lemma twp_xchg l (v₁ v₂ : val) : l ↦ v₁ -∗ WP Xchg #l v₂ [{ v₁, l ↦ v₂ }]. Proof. iIntros "Hl". wp_xchg => //. Qed. Lemma wp_xchg_inv N l (v : val) : {{{ inv N (∃ v, l ↦ v) }}} Xchg #l v {{{ v', RET v'; True }}}. Proof. iIntros (Φ) "Hl HΦ". iInv "Hl" as (v') "Hl" "Hclose". wp_xchg. iApply "HΦ". iApply "Hclose". iExists _ => //. Qed. Lemma wp_alloc_split : ⊢ WP Alloc #0 {{ _, True }}. Proof. wp_alloc l as "[Hl1 Hl2]". Show. done. Qed. Lemma wp_alloc_drop : ⊢ WP Alloc #0 {{ _, True }}. Proof. wp_alloc l as "_". Show. done. Qed. Check "wp_nonclosed_value". Lemma wp_nonclosed_value : ⊢ WP let: "x" := #() in (λ: "y", "x")%V #() {{ _, True }}. Proof. wp_let. wp_lam. Fail wp_pure _. Show. Abort. Lemma wp_alloc_array n : (0 < n)%Z → ⊢ {{{ True }}} AllocN #n #0 {{{ l, RET #l; l ↦∗ replicate (Z.to_nat n) #0 }}}. Proof. iIntros (? Φ) "!> _ HΦ". wp_alloc l as "?"; first done. by iApply "HΦ". Qed. Lemma twp_alloc_array n : (0 < n)%Z → ⊢ [[{ True }]] AllocN #n #0 [[{ l, RET #l; l ↦∗ replicate (Z.to_nat n) #0 }]]. Proof. iIntros (? Φ) "!> _ HΦ". wp_alloc l as "?"; first done. Show. by iApply "HΦ". Qed. Lemma wp_load_array l : {{{ l ↦∗ [ #0;#1;#2 ] }}} !(#l +ₗ #1) {{{ RET #1; True }}}. Proof. iIntros (Φ) "Hl HΦ". wp_op. wp_apply (wp_load_offset _ _ _ _ 1 with "Hl"); first done. iIntros "Hl". by iApply "HΦ". Qed. Check "test_array_fraction_destruct". Lemma test_array_fraction_destruct l vs : l ↦∗ vs -∗ l ↦∗{#1/2} vs ∗ l ↦∗{#1/2} vs. Proof. iIntros "[Hl1 Hl2]". Show. by iFrame. Qed. Lemma test_array_fraction_combine l vs : l ↦∗{#1/2} vs -∗ l↦∗{#1/2} vs -∗ l ↦∗ vs. Proof. iIntros "Hl1 Hl2". iSplitL "Hl1"; by iFrame. Qed. Lemma test_array_app l vs1 vs2 : l ↦∗ (vs1 ++ vs2) -∗ l ↦∗ (vs1 ++ vs2). Proof. iIntros "H". iDestruct (array_app with "H") as "[H1 H2]". iApply array_app. iSplitL "H1"; done. Qed. Lemma test_array_app_split l vs1 vs2 : l ↦∗ (vs1 ++ vs2) -∗ l ↦∗{#1/2} (vs1 ++ vs2). Proof. iIntros "[$ _]". (* splits the fraction, not the app *) Qed. Lemma test_wp_free l v : {{{ l ↦ v }}} Free #l {{{ RET #(); True }}}. Proof. iIntros (Φ) "Hl HΦ". wp_free. iApply "HΦ". done. Qed. Lemma test_twp_free l v : [[{ l ↦ v }]] Free #l [[{ RET #(); True }]]. Proof. iIntros (Φ) "Hl HΦ". wp_free. iApply "HΦ". done. Qed. Check "test_wp_finish_fupd". Lemma test_wp_finish_fupd (v : val) : ⊢ WP of_val v {{ v, |={⊤}=> True }}. Proof. wp_pures. Show. (* No second fupd was added. *) Abort. Check "test_twp_finish_fupd". Lemma test_twp_finish_fupd (v : val) : ⊢ WP of_val v [{ v, |={⊤}=> True }]. Proof. wp_pures. Show. (* No second fupd was added. *) Abort. Check "test_heaplang_not_unfolded". Lemma test_heaplang_not_unfolded : ⊢@{iPropI Σ} |={⊤}=> True. Proof. cbn. Set Printing All. Show. Unset Printing All. Abort. Check "test_wp_pure_credit_succeed". Lemma test_wp_pure_credit_succeed P : ⊢ WP #42 + #420 {{ v, ▷ P ={∅}=∗ P }}. Proof. wp_pure credit:"Hcred". Show. iIntros "!> HP". iMod (lc_fupd_elim_later with "Hcred HP"). auto. Qed. Check "test_wp_pure_credit_fail". Lemma test_wp_pure_credit_fail : ⊢ True -∗ WP #42 + #420 {{ v, True }}. Proof. iIntros "Hcred". Fail wp_pure credit:"Hcred". Abort. End tests. Section pointsto_tests. Context `{!heapGS Σ}. (* Test that the different versions of pointsto work with the tactics, parses, and prints correctly. *) (* Loading from a persistent points-to predicate in the _persistent_ context. *) Lemma persistent_pointsto_load_persistent l v : {{{ l ↦□ v }}} ! #l {{{ RET v; True }}}. Proof. iIntros (Φ) "#Hl HΦ". Show. wp_load. by iApply "HΦ". Qed. (* Loading from a persistent points-to predicate in the _spatial_ context. *) Lemma persistent_pointsto_load_spatial l v : {{{ l ↦□ v }}} ! #l {{{ RET v; True }}}. Proof. iIntros (Φ) "Hl HΦ". wp_load. by iApply "HΦ". Qed. Lemma persistent_pointsto_twp_load_persistent l v : [[{ l ↦□ v }]] ! #l [[{ RET v; True }]]. Proof. iIntros (Φ) "#Hl HΦ". wp_load. by iApply "HΦ". Qed. Lemma persistent_pointsto_twp_load_spatial l v : [[{ l ↦□ v }]] ! #l [[{ RET v; True }]]. Proof. iIntros (Φ) "Hl HΦ". wp_load. by iApply "HΦ". Qed. Lemma persistent_pointsto_load l (n : nat) : {{{ l ↦ #n }}} Store #l (! #l + #5) ;; ! #l {{{ RET #(n + 5); l ↦□ #(n + 5) }}}. Proof. iIntros (Φ) "Hl HΦ". wp_load. wp_store. iMod (pointsto_persist with "Hl") as "#Hl". wp_load. by iApply "HΦ". Qed. (* Loading from the general pointsto for any [dfrac]. *) Lemma general_pointsto dq l v : [[{ l ↦{dq} v }]] ! #l [[{ RET v; True }]]. Proof. iIntros (Φ) "Hl HΦ". Show. wp_load. by iApply "HΦ". Qed. (* Make sure that we can split a pointsto containing an evar. *) Lemma pointsto_evar_iSplit l v : l ↦{#1 / 2} v -∗ ∃ q, l ↦{#1 / 2 + q} v. Proof. iIntros "H". iExists _. iSplitL; first by iAssumption. Abort. Lemma pointsto_frame_1 l v q1 q2 : l ↦{#q1} v -∗ l ↦{#q2} v -∗ l ↦{#q1 + q2} v. Proof. iIntros "H1 H2". iFrame "H1". iExact "H2". Qed. Lemma pointsto_frame_2 l v q : l ↦{#q/2} v -∗ l ↦{#q/2} v -∗ l ↦{#q} v. Proof. iIntros "H1 H2". iFrame "H1". iExact "H2". Qed. Lemma pointsto_combine_2 l v1 q1 v2 q2 : l ↦{#q1} v1 -∗ l ↦{#q2} v2 -∗ l ↦{#(q1 + q2)} v1 ∗ ⌜q1 + q2 ≤ 1⌝%Qp ∗ ⌜v1 = v2⌝. Proof. iIntros "H1 H2". by iCombine "H1 H2" as "$" gives %[? ->]. Qed. Lemma pointsto_combine_3 l v1 q1 v2 q2 v3 q3 : l ↦{#q1} v1 -∗ l ↦{#q2} v2 -∗ l ↦{#q3} v3 -∗ l ↦{#(q1 + (q2 + q3))} v1 ∗ ⌜q1 + (q2 + q3) ≤ 1⌝%Qp ∗ ⌜v1 = v2⌝ ∗ ⌜v2 = v3⌝. Proof. iIntros "H1 H2 H3". by iCombine "H1 H2 H3" as "$" gives %[[_ ->] [? ->]]. Qed. Lemma pointsto_combine_4 l v1 q1 v2 q2 v3 q3 v4 q4 : l ↦{#q1} v1 -∗ l ↦{#q2} v2 -∗ l ↦{#q3} v3 -∗ l ↦{#q4} v4 -∗ l ↦{#(q1 + (q2 + (q3 + q4)))} v1 ∗ ⌜q1 + (q2 + (q3 + q4)) ≤ 1⌝%Qp ∗ ⌜v1 = v2⌝ ∗ ⌜v2 = v3⌝ ∗ ⌜v3 = v4⌝. Proof. iIntros "H1 H2 H3 H4". iCombine "H1 H2 H3 H4" as "$" gives %H. Show. by destruct H as [[[_ ->] [_ ->]] [? ->]]. Qed. End pointsto_tests. Section inv_pointsto_tests. Context `{!heapGS Σ}. (* Make sure these parse and type-check. *) Lemma inv_pointsto_own_test (l : loc) : ⊢ l ↦_(λ _, True) #5. Abort. Lemma inv_pointsto_test (l : loc) : ⊢ l ↦_(λ _, True) □. Abort. (* Make sure [setoid_rewrite] works. *) Lemma inv_pointsto_setoid_rewrite (l : loc) (I : val → Prop) : (∀ v, I v ↔ I #true) → ⊢ l ↦_(λ v, I v) □. Proof. iIntros (Heq). setoid_rewrite Heq. Show. Abort. End inv_pointsto_tests. Section atomic. Context `{!heapGS Σ}. Implicit Types P Q : iProp Σ. (* These tests check if a side-condition for [Atomic] is generated *) Check "wp_iMod_fupd_atomic". Lemma wp_iMod_fupd_atomic E1 E2 P : (|={E1,E2}=> P) -∗ WP #() #() @ E1 {{ _, True }}. Proof. iIntros "H". iMod "H". Show. Abort. Check "wp_iInv_atomic". Lemma wp_iInv_atomic N E P : ↑ N ⊆ E → inv N P -∗ WP #() #() @ E {{ _, True }}. Proof. iIntros (?) "H". iInv "H" as "H" "Hclose". Show. Abort. Check "wp_iInv_atomic_acc". Lemma wp_iInv_atomic_acc N E P : ↑ N ⊆ E → inv N P -∗ WP #() #() @ E {{ _, True }}. Proof. (* Test if a side-condition for [Atomic] is generated *) iIntros (?) "H". iInv "H" as "H". Show. Abort. End atomic. Section error_tests. Context `{!heapGS Σ}. Check "not_cmpxchg". Lemma not_cmpxchg : ⊢ WP #() #() {{ _, True }}. Proof. Fail wp_cmpxchg_suc. Abort. End error_tests. (* Test a closed proof *) Lemma heap_e_adequate σ : adequate NotStuck heap_e σ (λ v _, v = #2). Proof. eapply (heap_adequacy heapΣ). iIntros (?) "_". by iApply heap_e_spec. Qed. Lemma heap_e_totally_adequate σ : sn erased_step ([heap_e], σ). Proof. eapply (heap_total heapΣ NotStuck _ _ (const True)). iIntros (?) "_". rewrite /heap_e /=. wp_alloc l. wp_load. wp_store. wp_load. auto. Qed. iris-iris-4.2.0/tests/heap_lang_interpreter.ref000066400000000000000000000017461460620107300216370ustar00rootroot00000000000000"ex1" : string = inl #() : val + Error "ex3" : string = inl #2 : val + Error "ex4" : string = inl #(Loc 2) : val + Error "ex5" : string = inl #false : val + Error "ex6" : string = inl #2 : val + Error "fail app non-function" : string = inr (Stuck "attempt to call non-function #2") : val + Error "fail loc order" : string = inr (Stuck "bin-op failed: cannot use < on location #(loc 1) and #1") : val + Error "fail compare pairs" : string = inr (Stuck "bin-op failed: one of (#0, #1) and (#0, #1) must be unboxed to compare: (#0, #1): pairs are large and considered boxed, must compare by field, (#0, #1): pairs are large and considered boxed, must compare by field") : val + Error "fail free var" : string = inr (Stuck "free var: x") : val + Error "fail out of fuel" : string = inl (rec: "foo" <> := "foo" #())%V : val + Error iris-iris-4.2.0/tests/heap_lang_interpreter.v000066400000000000000000000032121460620107300213160ustar00rootroot00000000000000From iris.heap_lang Require Import notation. From iris.unstable.heap_lang Require Import interpreter. Example test_1 : exec 1000 ((λ: "x", "x" + #1) #2) = inl #3. Proof. reflexivity. Qed. Check "ex1". Eval vm_compute in exec 1000 (let: "x" := ref #() in let: "y" := ref #() in !"y"). Check "ex3". (** eval order *) Eval vm_compute in exec 1000 (let: "x" := ref #1 in let: "y" := ref #2 in ("y" <- !"x", (* this runs first, so the result is 2 *) "x" <- !"y");; !"x"). (* print a location *) Check "ex4". Eval vm_compute in exec 1000 (ref #();; ref #()). Check "ex5". Eval vm_compute in exec 1000 (let: "x" := ref #() in let: "y" := ref #() in "x" = "y"). (* a bad case where the interpreter runs a program which is actually stuck, because this program guesses an allocation that happens to be correct in the interpreter *) Check "ex6". Eval vm_compute in exec 1000 (let: "x" := ref #1 in #(LitLoc {|loc_car := 1|}) <- #2;; !"x"). (** * Failing executions *) Check "fail app non-function". Eval vm_compute in exec 1000 (#2 #4). (* locations can only be compared with other locations *) Check "fail loc order". Eval vm_compute in exec 1000 (let: "x" := ref #() in let: "y" := #1 in "x" < "y"). Check "fail compare pairs". Eval vm_compute in exec 1000 ((#0, #1) = (#0, #1)). Check "fail free var". Eval vm_compute in exec 100 "x". Check "fail out of fuel". (** infinite loop *) Eval vm_compute in exec 100 (rec: "foo" <> := "foo" #()). iris-iris-4.2.0/tests/heap_lang_printing.ref000066400000000000000000000106061460620107300211210ustar00rootroot000000000000001 goal Σ : gFunctors heapGS0 : heapGS Σ ============================ --------------------------------------∗ WP let: "f" := λ: "x", "x" in ref ("f" #10) {{ _, True }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ 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 goal Σ : gFunctors heapGS0 : heapGS Σ fun1, fun2, fun3 : expr ============================ --------------------------------------∗ WP fun1 #() {{ v, WP let: "val1" := v in let: "val2" := fun2 "val1" in let: "val3" := fun3 "val2" in if: "val1" = "val2" then "val" else "val3" {{ _, True }} }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ fun1, fun2, fun3 : expr long_post : iPropI Σ ============================ --------------------------------------∗ WP let: "val1" := fun1 #() in let: "val2" := fun2 "val1" in let: "v" := fun3 "v" in if: "v" = "v" then "v" else "v" {{ _, long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ fun1, fun2, fun3 : expr long_post : iPropI Σ ============================ --------------------------------------∗ WP fun1 #() {{ v, WP let: "val1" := v in let: "val2" := fun2 "val1" in let: "v" := fun3 "v" in if: "v" = "v" then "v" else "v" {{ _, long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post }} }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ l1 : loc fun2, fun3 : expr long_post : iPropI Σ N : namespace E_long : coPset H : ↑N ⊆ E_long ============================ "Hinv" : inv N True --------------------------------------∗ WP let: "val1" := ! #l1 in let: "val2" := fun2 "val1" in let: "v" := fun3 "v" in if: "v" = "v" then "v" else "v" @ E_long {{ _, long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ l1 : loc fun2, fun3 : expr long_post : iPropI Σ N : namespace E_long : coPset H : ↑N ⊆ E_long ============================ "Hinv" : inv N True --------------------------------------∗ WP ! #l1 @ E_long {{ v, WP let: "val1" := v in let: "val2" := fun2 "val1" in let: "v" := fun3 "v" in if: "v" = "v" then "v" else "v" @ E_long {{ _, long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post }} }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ l1 : loc fun2, fun3 : expr long_post : iPropI Σ N : namespace E_long : coPset H : ↑N ⊆ E_long ============================ --------------------------------------∗ WP ! #l1 @ E_long ∖ ↑N {{ v, |={E_long ∖ ↑N}=> ▷ True ∗ WP let: "val1" := v in let: "val2" := fun2 "val1" in let: "v" := fun3 "v" in if: "v" = "v" then "v" else "v" @ E_long {{ _, long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post }} }} 1 goal Σ : gFunctors heapGS0 : heapGS Σ 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 }}} 1 goal Σ : gFunctors heapGS0 : heapGS Σ fun1, fun2, fun3 : expr E_mask_is_long_too : coPset ============================ {{{ True }}} let: "val1" := fun1 #() in let: "val2" := fun2 "val1" in let: "val3" := fun3 "val2" in if: "val1" = "val2" then "val" else "val3" @ E_mask_is_long_too {{{ (x y : val) (z : Z), RET (x, y, #z); True }}} 1 goal Σ : gFunctors heapGS0 : heapGS Σ fun1, fun2, fun3 : expr long_post : iPropI Σ E_mask_is_long_too : coPset ============================ {{{ True }}} let: "val1" := fun1 #() in let: "val2" := fun2 "val1" in let: "val3" := fun3 "val2" in if: "val1" = "val2" then "val" else "val3" @ E_mask_is_long_too {{{ (x y : val) (z : Z), RET (x, y, #z); long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post }}} iris-iris-4.2.0/tests/heap_lang_printing.v000066400000000000000000000057721460620107300206220ustar00rootroot00000000000000From iris.base_logic.lib Require Import gen_inv_heap invariants. From iris.program_logic Require Export weakestpre total_weakestpre. 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. From iris.prelude Require Import options. Unset Mangle Names. Section printing_tests. Context `{!heapGS Σ}. Lemma ref_print : True -∗ WP let: "f" := (λ: "x", "x") in ref ("f" #10) {{ _, True }}. Proof. iIntros "_". Show. Abort. (* 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. wp_bind (fun1 #()). Show. Abort. Lemma wp_print_long_expr (fun1 fun2 fun3 : expr) long_post : True -∗ WP let: "val1" := fun1 #() in let: "val2" := fun2 "val1" in let: "v" := fun3 "v" in if: "v" = "v" then "v" else "v" {{ _, long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post }}. Proof. iIntros "_". Show. wp_bind (fun1 #()). Show. Abort. Lemma wp_print_long_expr (l1 : loc) (fun2 fun3 : expr) long_post N E_long : ↑N ⊆ E_long → inv N True -∗ WP let: "val1" := ! #l1 in let: "val2" := fun2 "val1" in let: "v" := fun3 "v" in if: "v" = "v" then "v" else "v" @ E_long {{ _, long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post }}. Proof. iIntros (?) "Hinv". Show. wp_bind (! #l1)%E. Show. iInv "Hinv" as "_". 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. Lemma texan_triple_long_expr_mask (fun1 fun2 fun3 : expr) E_mask_is_long_too : {{{ True }}} let: "val1" := fun1 #() in let: "val2" := fun2 "val1" in let: "val3" := fun3 "val2" in if: "val1" = "val2" then "val" else "val3" @ E_mask_is_long_too {{{ (x y : val) (z : Z), RET (x, y, #z); True }}}. Proof. Show. Abort. Lemma texan_triple_long_expr_mask_post (fun1 fun2 fun3 : expr) long_post E_mask_is_long_too : {{{ True }}} let: "val1" := fun1 #() in let: "val2" := fun2 "val1" in let: "val3" := fun3 "val2" in if: "val1" = "val2" then "val" else "val3" @ E_mask_is_long_too {{{ (x y : val) (z : Z), RET (x, y, #z); long_post ∗ long_post ∗ long_post ∗ long_post ∗ long_post }}}. Proof. Show. Abort. End printing_tests. iris-iris-4.2.0/tests/heap_lang_printing2.ref000066400000000000000000000013451460620107300212030ustar00rootroot000000000000001 goal Σ : gFunctors heapGS0 : heapGS Σ P, Q : iProp Σ ============================ P ={⊤}=∗ Q 1 goal Σ : gFunctors heapGS0 : heapGS Σ 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 goal Σ : gFunctors heapGS0 : heapGS Σ 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 }}} iris-iris-4.2.0/tests/heap_lang_printing2.v000066400000000000000000000020231460620107300206660ustar00rootroot00000000000000(* Test another way of importing heap_lang modules that used to break printing *) From iris.proofmode Require Import tactics. From iris.heap_lang Require Export primitive_laws notation. From iris.heap_lang Require Import proofmode notation. From iris.prelude Require Import options. Unset Mangle Names. Section printing_tests. Context `{!heapGS Σ}. Lemma vs_print (P Q : iProp Σ) : P ={⊤}=∗ Q. Proof. Show. Abort. 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 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. iris-iris-4.2.0/tests/heap_lang_proph.ref000066400000000000000000000000001460620107300204020ustar00rootroot00000000000000iris-iris-4.2.0/tests/heap_lang_proph.v000066400000000000000000000053711460620107300201130ustar00rootroot00000000000000From iris.program_logic Require Export weakestpre total_weakestpre. From iris.heap_lang Require Import lang adequacy proofmode notation. From iris.prelude Require Import options. Section tests. Context `{!heapGS Σ}. Implicit Types P Q : iProp Σ. Implicit Types Φ : val → iProp Σ. Lemma test_resolve1 E (l : loc) (n : Z) (p : proph_id) (vs : list (val * val)) (v : val) : l ↦ #n -∗ proph p vs -∗ WP Resolve (CmpXchg #l #n (#n + #1)) #p v @ E {{ v, ⌜v = (#n, #true)%V⌝ ∗ ∃vs, proph p vs ∗ l ↦ #(n+1) }}. Proof. iIntros "Hl Hp". wp_pures. wp_apply (wp_resolve with "Hp"); first done. wp_cmpxchg_suc. iIntros "!>" (ws ->) "Hp". eauto with iFrame. Qed. Lemma test_resolve1' E (l : loc) (n : Z) (p : proph_id) (vs : list (val * val)) (v : val) : l ↦ #n -∗ proph p vs -∗ WP Resolve (CmpXchg #l #n (#n + #1)) #p v @ E {{ v, ⌜v = (#n, #true)%V⌝ ∗ ∃vs, proph p vs ∗ l ↦ #(n+1) }}. Proof. iIntros "Hl Hp". wp_pures. wp_apply (wp_resolve_cmpxchg_suc with "[$Hp $Hl]"); first by left. iIntros "Hpost". iDestruct "Hpost" as (ws ->) "Hp". eauto with iFrame. Qed. Lemma test_resolve2 E (l : loc) (n m : Z) (p : proph_id) (vs : list (val * val)) : proph p vs -∗ WP Resolve (#n + #m - (#n + #m)) #p #() @ E {{ v, ⌜v = #0⌝ ∗ ∃vs, proph p vs }}. Proof. iIntros "Hp". wp_pures. wp_apply (wp_resolve with "Hp"); first done. wp_pures. iIntros "!>" (ws ->) "Hp". rewrite Z.sub_diag. eauto with iFrame. Qed. Lemma test_resolve3 s E (p1 p2 : proph_id) (vs1 vs2 : list (val * val)) (n : Z) : {{{ proph p1 vs1 ∗ proph p2 vs2 }}} Resolve (Resolve (#n - #n) #p2 #2) #p1 #1 @ s; E {{{ RET #0 ; ∃ vs1' vs2', ⌜vs1 = (#0, #1)::vs1' ∧ vs2 = (#0, #2)::vs2'⌝ ∗ proph p1 vs1' ∗ proph p2 vs2' }}}. Proof. iIntros (Φ) "[Hp1 Hp2] HΦ". wp_apply (wp_resolve with "Hp1"); first done. wp_apply (wp_resolve with "Hp2"); first done. wp_op. iIntros "!>" (vs2' ->) "Hp2". iIntros (vs1' ->) "Hp1". rewrite Z.sub_diag. iApply "HΦ". iExists vs1', vs2'. eauto with iFrame. Qed. Lemma test_resolve4 s E (p1 p2 : proph_id) (vs1 vs2 : list (val * val)) (n : Z) : {{{ proph p1 vs1 ∗ proph p2 vs2 }}} Resolve (Resolve (#n - #n) ((λ: "x", "x") #p2) (#0 + #2)) ((λ: "x", "x") #p1) (#0 + #1) @ s; E {{{ RET #0 ; ∃ vs1' vs2', ⌜vs1 = (#0, #1)::vs1' ∧ vs2 = (#0, #2)::vs2'⌝ ∗ proph p1 vs1' ∗ proph p2 vs2' }}}. Proof. iIntros (Φ) "[Hp1 Hp2] HΦ". wp_pures. wp_apply (wp_resolve with "Hp1"); first done. wp_apply (wp_resolve with "Hp2"); first done. wp_op. iIntros "!>" (vs2' ->) "Hp2". iIntros (vs1' ->) "Hp1". rewrite Z.sub_diag. iApply "HΦ". iExists vs1', vs2'. eauto with iFrame. Qed. End tests. iris-iris-4.2.0/tests/heapprop.ref000066400000000000000000000000001460620107300170720ustar00rootroot00000000000000iris-iris-4.2.0/tests/heapprop.v000066400000000000000000000251231460620107300166000ustar00rootroot00000000000000From stdpp Require Import gmap. From iris.bi Require Import interface. From iris.proofmode Require Import tactics. From iris.prelude Require Import options. (** This file constructs a simple non step-indexed linear separation logic as predicates over heaps (modeled as maps from integer locations to integer values). It shows that Iris's [bi] canonical structure can be inhabited, and the Iris proof mode can be used to prove lemmas in this separation logic. *) Definition loc := Z. Definition val := Z. Record heapProp := HeapProp { heapProp_holds :> gmap loc val → Prop; }. Global Arguments heapProp_holds : simpl never. Add Printing Constructor heapProp. Section ofe. Inductive heapProp_equiv' (P Q : heapProp) : Prop := { heapProp_in_equiv : ∀ σ, P σ ↔ Q σ }. Local Instance heapProp_equiv : Equiv heapProp := heapProp_equiv'. Local Instance heapProp_equivalence : Equivalence (≡@{heapProp}). Proof. split; repeat destruct 1; constructor; naive_solver. Qed. Canonical Structure heapPropO := discreteO heapProp. End ofe. (** logical entailement *) Inductive heapProp_entails (P Q : heapProp) : Prop := { heapProp_in_entails : ∀ σ, P σ → Q σ }. (** logical connectives *) Local Definition heapProp_emp_def : heapProp := {| heapProp_holds σ := σ = ∅ |}. Local Definition heapProp_emp_aux : seal (@heapProp_emp_def). Proof. by eexists. Qed. Definition heapProp_emp := unseal heapProp_emp_aux. Local Definition heapProp_emp_unseal : @heapProp_emp = @heapProp_emp_def := seal_eq heapProp_emp_aux. Local Definition heapProp_pure_def (φ : Prop) : heapProp := {| heapProp_holds _ := φ |}. Local Definition heapProp_pure_aux : seal (@heapProp_pure_def). Proof. by eexists. Qed. Definition heapProp_pure := unseal heapProp_pure_aux. Local Definition heapProp_pure_unseal : @heapProp_pure = @heapProp_pure_def := seal_eq heapProp_pure_aux. Local Definition heapProp_and_def (P Q : heapProp) : heapProp := {| heapProp_holds σ := P σ ∧ Q σ |}. Local Definition heapProp_and_aux : seal (@heapProp_and_def). Proof. by eexists. Qed. Definition heapProp_and := unseal heapProp_and_aux. Local Definition heapProp_and_unseal: @heapProp_and = @heapProp_and_def := seal_eq heapProp_and_aux. Local Definition heapProp_or_def (P Q : heapProp) : heapProp := {| heapProp_holds σ := P σ ∨ Q σ |}. Local Definition heapProp_or_aux : seal (@heapProp_or_def). Proof. by eexists. Qed. Definition heapProp_or := unseal heapProp_or_aux. Local Definition heapProp_or_unseal: @heapProp_or = @heapProp_or_def := seal_eq heapProp_or_aux. Local Definition heapProp_impl_def (P Q : heapProp) : heapProp := {| heapProp_holds σ := P σ → Q σ |}. Local Definition heapProp_impl_aux : seal (@heapProp_impl_def). Proof. by eexists. Qed. Definition heapProp_impl := unseal heapProp_impl_aux. Local Definition heapProp_impl_unseal : @heapProp_impl = @heapProp_impl_def := seal_eq heapProp_impl_aux. Local Definition heapProp_forall_def {A} (Ψ : A → heapProp) : heapProp := {| heapProp_holds σ := ∀ a, Ψ a σ |}. Local Definition heapProp_forall_aux : seal (@heapProp_forall_def). Proof. by eexists. Qed. Definition heapProp_forall {A} := unseal heapProp_forall_aux A. Local Definition heapProp_forall_unseal : @heapProp_forall = @heapProp_forall_def := seal_eq heapProp_forall_aux. Local Definition heapProp_exist_def {A} (Ψ : A → heapProp) : heapProp := {| heapProp_holds σ := ∃ a, Ψ a σ |}. Local Definition heapProp_exist_aux : seal (@heapProp_exist_def). Proof. by eexists. Qed. Definition heapProp_exist {A} := unseal heapProp_exist_aux A. Local Definition heapProp_exist_unseal : @heapProp_exist = @heapProp_exist_def := seal_eq heapProp_exist_aux. Local Definition heapProp_sep_def (P Q : heapProp) : heapProp := {| heapProp_holds σ := ∃ σ1 σ2, σ = σ1 ∪ σ2 ∧ σ1 ##ₘ σ2 ∧ P σ1 ∧ Q σ2 |}. Local Definition heapProp_sep_aux : seal (@heapProp_sep_def). Proof. by eexists. Qed. Definition heapProp_sep := unseal heapProp_sep_aux. Local Definition heapProp_sep_unseal: @heapProp_sep = @heapProp_sep_def := seal_eq heapProp_sep_aux. Local Definition heapProp_wand_def (P Q : heapProp) : heapProp := {| heapProp_holds σ := ∀ σ', σ ##ₘ σ' → P σ' → Q (σ ∪ σ') |}. Local Definition heapProp_wand_aux : seal (@heapProp_wand_def). Proof. by eexists. Qed. Definition heapProp_wand := unseal heapProp_wand_aux. Local Definition heapProp_wand_unseal: @heapProp_wand = @heapProp_wand_def := seal_eq heapProp_wand_aux. Local Definition heapProp_persistently_def (P : heapProp) : heapProp := heapProp_pure (heapProp_entails heapProp_emp P). Local Definition heapProp_persistently_aux : seal (@heapProp_persistently_def). Proof. by eexists. Qed. Definition heapProp_persistently := unseal heapProp_persistently_aux. Local Definition heapProp_persistently_unseal: @heapProp_persistently = @heapProp_persistently_def := seal_eq heapProp_persistently_aux. (** Iris's [bi] class requires the presence of a later modality, but for non step-indexed logics, it can be defined as the identity. *) Definition heapProp_later (P : heapProp) : heapProp := P. Local Definition heapProp_unseal := (heapProp_emp_unseal, heapProp_pure_unseal, heapProp_and_unseal, heapProp_or_unseal, heapProp_impl_unseal, heapProp_forall_unseal, heapProp_exist_unseal, heapProp_sep_unseal, heapProp_wand_unseal, heapProp_persistently_unseal). Ltac unseal := rewrite !heapProp_unseal /=. Section mixins. (** Enable [simpl] locally, which is useful for proofs in the model. *) Local Arguments heapProp_holds !_ _ /. Lemma heapProp_bi_mixin : BiMixin heapProp_entails heapProp_emp heapProp_pure heapProp_and heapProp_or heapProp_impl (@heapProp_forall) (@heapProp_exist) heapProp_sep heapProp_wand. Proof. split. - (* [PreOrder heapProp_entails] *) split; repeat destruct 1; constructor; naive_solver. - (* [P ≡ Q ↔ (P ⊢ Q) ∧ (Q ⊢ P)] *) intros P Q; split. + intros [HPQ]; split; split; naive_solver. + intros [[HPQ] [HQP]]; split; naive_solver. - (* [Proper (iff ==> dist n) bi_pure] *) unseal=> n φ1 φ2 Hφ; split; naive_solver. - (* [NonExpansive2 bi_and] *) unseal=> n P1 P2 [HP] Q1 Q2 [HQ]; split; naive_solver. - (* [NonExpansive2 bi_or] *) unseal=> n P1 P2 [HP] Q1 Q2 [HQ]; split; naive_solver. - (* [NonExpansive2 bi_impl] *) unseal=> n P1 P2 [HP] Q1 Q2 [HQ]; split; naive_solver. - (* [Proper (pointwise_relation _ (dist n) ==> dist n) (bi_forall A)] *) unseal=> A n Φ1 Φ2 HΦ; split=> σ /=; split=> ? x; by apply HΦ. - (* [Proper (pointwise_relation _ (dist n) ==> dist n) (bi_exist A)] *) unseal=> A n Φ1 Φ2 HΦ; split=> σ /=; split=> -[x ?]; exists x; by apply HΦ. - (* [NonExpansive2 bi_sep] *) unseal=> n P1 P2 [HP] Q1 Q2 [HQ]; split; naive_solver. - (* [NonExpansive2 bi_wand] *) unseal=> n P1 P2 [HP] Q1 Q2 [HQ]; split; naive_solver. - (* [φ → P ⊢ ⌜ φ ⌝] *) unseal=> φ P ?; by split. - (* [(φ → True ⊢ P) → ⌜ φ ⌝ ⊢ P] *) unseal=> φ P HP; split=> σ ?. by apply HP. - (* [P ∧ Q ⊢ P] *) unseal=> P Q; split=> σ [??]; done. - (* [P ∧ Q ⊢ Q] *) unseal=> P Q; split=> σ [??]; done. - (* [(P ⊢ Q) → (P ⊢ R) → P ⊢ Q ∧ R] *) unseal=> P Q R [HPQ] [HPR]; split=> σ; split; auto. - (* [P ⊢ P ∨ Q] *) unseal=> P Q; split=> σ; by left. - (* [Q ⊢ P ∨ Q] *) unseal=> P Q; split=> σ; by right. - (* [(P ⊢ R) → (Q ⊢ R) → P ∨ Q ⊢ R] *) unseal=> P Q R [HPQ] [HQR]; split=> σ [?|?]; auto. - (* [(P ∧ Q ⊢ R) → P ⊢ Q → R] *) unseal=> P Q R HPQR; split=> σ ??. by apply HPQR. - (* [(P ⊢ Q → R) → P ∧ Q ⊢ R] *) unseal=> P Q R HPQR; split=> σ [??]. by apply HPQR. - (* [(∀ a, P ⊢ Ψ a) → P ⊢ ∀ a, Ψ a] *) unseal=> A P Ψ HPΨ; split=> σ ? a. by apply HPΨ. - (* [(∀ a, Ψ a) ⊢ Ψ a] *) unseal=> A Ψ a; split=> σ ?; done. - (* [Ψ a ⊢ ∃ a, Ψ a] *) unseal=> A Ψ a; split=> σ ?. by exists a. - (* [(∀ a, Φ a ⊢ Q) → (∃ a, Φ a) ⊢ Q] *) unseal=> A Φ Q HΦQ; split=> σ [a ?]. by apply (HΦQ a). - (* [(P ⊢ Q) → (P' ⊢ Q') → P ∗ P' ⊢ Q ∗ Q'] *) unseal=> P P' Q Q' [HPQ] [HP'Q']; split; naive_solver. - (* [P ⊢ emp ∗ P] *) unseal=> P; split=> σ ? /=. eexists ∅, σ. rewrite left_id_L. split_and!; done || apply map_disjoint_empty_l. - (* [emp ∗ P ⊢ P] *) unseal=> P; split; intros ? (?&σ&->&?&->&?). by rewrite left_id_L. - (* [P ∗ Q ⊢ Q ∗ P] *) unseal=> P Q; split; intros ? (σ1&σ2&->&?&?&?). exists σ2, σ1. by rewrite map_union_comm. - (* [(P ∗ Q) ∗ R ⊢ P ∗ (Q ∗ R)] *) unseal=> P Q R; split; intros ? (?&σ3&->&?&(σ1&σ2&->&?&?&?)&?). exists σ1, (σ2 ∪ σ3). split_and!; [by rewrite assoc_L|solve_map_disjoint|done|]. exists σ2, σ3; split_and!; [done|solve_map_disjoint|done..]. - (* [(P ∗ Q ⊢ R) → P ⊢ Q -∗ R] *) unseal=> P Q R [HPQR]; split=> σ1 ? σ2 ??. apply HPQR. by exists σ1, σ2. - (* [(P ⊢ Q -∗ R) → P ∗ Q ⊢ R] *) unseal=> P Q R [HPQR]; split; intros ? (σ1&σ2&->&?&?&?). by apply HPQR. Qed. Lemma heapProp_bi_persistently_mixin : BiPersistentlyMixin heapProp_entails heapProp_emp heapProp_and (@heapProp_exist) heapProp_sep heapProp_persistently. Proof. eapply bi_persistently_mixin_discrete, heapProp_bi_mixin; [done|..]. - (* [(emp ⊢ ∃ x, Φ x) → ∃ x, emp ⊢ Φ x] *) unseal. intros A Φ [H]. destruct (H ∅) as [x ?]; [done|]. exists x. by split=> σ ->. - by rewrite heapProp_persistently_unseal. Qed. Lemma heapProp_bi_later_mixin : BiLaterMixin heapProp_entails heapProp_pure heapProp_or heapProp_impl (@heapProp_forall) (@heapProp_exist) heapProp_sep heapProp_persistently heapProp_later. Proof. eapply bi_later_mixin_id; [done|apply heapProp_bi_mixin]. Qed. End mixins. Canonical Structure heapPropI : bi := {| bi_ofe_mixin := ofe_mixin_of heapProp; bi_bi_mixin := heapProp_bi_mixin; bi_bi_persistently_mixin := heapProp_bi_persistently_mixin; bi_bi_later_mixin := heapProp_bi_later_mixin |}. Global Instance heapProp_pure_forall : BiPureForall heapPropI. Proof. intros A φ. rewrite /bi_forall /bi_pure /=. unseal. by split. Qed. Lemma heapProp_proofmode_test {A} (P Q R : heapProp) (Φ Ψ : A → heapProp) : P ∗ Q -∗ □ R -∗ □ (R -∗ ∃ x, Φ x) -∗ ∃ x, Φ x ∗ Φ x ∗ P ∗ Q. Proof. iIntros "[HP HQ] #HR #HRΦ". iDestruct ("HRΦ" with "HR") as (x) "#HΦ". iExists x. iFrame. by iSplitL. Qed. iris-iris-4.2.0/tests/heapprop_affine.ref000066400000000000000000000000001460620107300204020ustar00rootroot00000000000000iris-iris-4.2.0/tests/heapprop_affine.v000066400000000000000000000277451460620107300201240ustar00rootroot00000000000000From stdpp Require Import gmap. From iris.bi Require Import interface. From iris.proofmode Require Import tactics. From iris.prelude Require Import options. (** This file constructs a simple non step-indexed affine separation logic as predicates over heaps (modeled as maps from integer locations to integer values). It shows that Iris's [bi] canonical structure can be inhabited, and the Iris proof mode can be used to prove lemmas in this separation logic. *) Definition loc := Z. Definition val := Z. Record heapProp := HeapProp { heapProp_holds :> gmap loc val → Prop; heapProp_closed σ1 σ2 : heapProp_holds σ1 → σ1 ⊆ σ2 → heapProp_holds σ2; }. Global Arguments heapProp_holds : simpl never. Add Printing Constructor heapProp. Section ofe. Inductive heapProp_equiv' (P Q : heapProp) : Prop := { heapProp_in_equiv : ∀ σ, P σ ↔ Q σ }. Local Instance heapProp_equiv : Equiv heapProp := heapProp_equiv'. Local Instance heapProp_equivalence : Equivalence (≡@{heapProp}). Proof. split; repeat destruct 1; constructor; naive_solver. Qed. Canonical Structure heapPropO := discreteO heapProp. End ofe. (** logical entailement *) Inductive heapProp_entails (P Q : heapProp) : Prop := { heapProp_in_entails : ∀ σ, P σ → Q σ }. (** logical connectives *) Local Program Definition heapProp_pure_def (φ : Prop) : heapProp := {| heapProp_holds _ := φ |}. Solve Obligations with done. Local Definition heapProp_pure_aux : seal (@heapProp_pure_def). Proof. by eexists. Qed. Definition heapProp_pure := unseal heapProp_pure_aux. Local Definition heapProp_pure_unseal : @heapProp_pure = @heapProp_pure_def := seal_eq heapProp_pure_aux. Definition heapProp_emp : heapProp := heapProp_pure True. Local Program Definition heapProp_and_def (P Q : heapProp) : heapProp := {| heapProp_holds σ := P σ ∧ Q σ |}. Solve Obligations with naive_solver eauto using heapProp_closed. Local Definition heapProp_and_aux : seal (@heapProp_and_def). Proof. by eexists. Qed. Definition heapProp_and := unseal heapProp_and_aux. Local Definition heapProp_and_unseal: @heapProp_and = @heapProp_and_def := seal_eq heapProp_and_aux. Local Program Definition heapProp_or_def (P Q : heapProp) : heapProp := {| heapProp_holds σ := P σ ∨ Q σ |}. Solve Obligations with naive_solver eauto using heapProp_closed. Local Definition heapProp_or_aux : seal (@heapProp_or_def). Proof. by eexists. Qed. Definition heapProp_or := unseal heapProp_or_aux. Local Definition heapProp_or_unseal: @heapProp_or = @heapProp_or_def := seal_eq heapProp_or_aux. Local Program Definition heapProp_impl_def (P Q : heapProp) : heapProp := {| heapProp_holds σ := ∀ σ', σ ⊆ σ' → P σ' → Q σ' |}. Next Obligation. intros P Q σ1 σ2 HPQ ? σ' ?; simpl in *. apply HPQ. by etrans. Qed. Local Definition heapProp_impl_aux : seal (@heapProp_impl_def). Proof. by eexists. Qed. Definition heapProp_impl := unseal heapProp_impl_aux. Local Definition heapProp_impl_unseal : @heapProp_impl = @heapProp_impl_def := seal_eq heapProp_impl_aux. Local Program Definition heapProp_forall_def {A} (Ψ : A → heapProp) : heapProp := {| heapProp_holds σ := ∀ a, Ψ a σ |}. Solve Obligations with naive_solver eauto using heapProp_closed. Local Definition heapProp_forall_aux : seal (@heapProp_forall_def). Proof. by eexists. Qed. Definition heapProp_forall {A} := unseal heapProp_forall_aux A. Local Definition heapProp_forall_unseal : @heapProp_forall = @heapProp_forall_def := seal_eq heapProp_forall_aux. Local Program Definition heapProp_exist_def {A} (Ψ : A → heapProp) : heapProp := {| heapProp_holds σ := ∃ a, Ψ a σ |}. Solve Obligations with naive_solver eauto using heapProp_closed. Local Definition heapProp_exist_aux : seal (@heapProp_exist_def). Proof. by eexists. Qed. Definition heapProp_exist {A} := unseal heapProp_exist_aux A. Local Definition heapProp_exist_unseal : @heapProp_exist = @heapProp_exist_def := seal_eq heapProp_exist_aux. Local Program Definition heapProp_sep_def (P Q : heapProp) : heapProp := {| heapProp_holds σ := ∃ σ1 σ2, σ = σ1 ∪ σ2 ∧ σ1 ##ₘ σ2 ∧ P σ1 ∧ Q σ2 |}. Next Obligation. intros P Q σ1 σ2 (σ11 & σ12 & -> & ? & ? & ?) ?. assert (σ11 ⊆ σ2) by (by etrans; [apply map_union_subseteq_l|]). exists σ11, (σ2 ∖ σ11). split_and!; [| |done|]. - by rewrite map_difference_union. - by apply map_disjoint_difference_r. - eapply heapProp_closed; [done|]. apply map_union_reflecting_l with σ11; [done|..]. + by apply map_disjoint_difference_r. + by rewrite map_difference_union. Qed. Local Definition heapProp_sep_aux : seal (@heapProp_sep_def). Proof. by eexists. Qed. Definition heapProp_sep := unseal heapProp_sep_aux. Local Definition heapProp_sep_unseal: @heapProp_sep = @heapProp_sep_def := seal_eq heapProp_sep_aux. Local Program Definition heapProp_wand_def (P Q : heapProp) : heapProp := {| heapProp_holds σ := ∀ σ', σ ##ₘ σ' → P σ' → Q (σ ∪ σ') |}. Next Obligation. intros P Q σ1 σ2 HPQ ? σ' ??; simpl in *. apply heapProp_closed with (σ1 ∪ σ'); [by eauto using map_disjoint_weaken_l|]. by apply map_union_mono_r. Qed. Local Definition heapProp_wand_aux : seal (@heapProp_wand_def). Proof. by eexists. Qed. Definition heapProp_wand := unseal heapProp_wand_aux. Local Definition heapProp_wand_unseal: @heapProp_wand = @heapProp_wand_def := seal_eq heapProp_wand_aux. Local Definition heapProp_persistently_def (P : heapProp) : heapProp := heapProp_pure (heapProp_entails heapProp_emp P). Local Definition heapProp_persistently_aux : seal (@heapProp_persistently_def). Proof. by eexists. Qed. Definition heapProp_persistently := unseal heapProp_persistently_aux. Local Definition heapProp_persistently_unseal: @heapProp_persistently = @heapProp_persistently_def := seal_eq heapProp_persistently_aux. (** Iris's [bi] class requires the presence of a later modality, but for non step-indexed logics, it can be defined as the identity. *) Definition heapProp_later (P : heapProp) : heapProp := P. Local Definition heapProp_unseal := (heapProp_pure_unseal, heapProp_and_unseal, heapProp_or_unseal, heapProp_impl_unseal, heapProp_forall_unseal, heapProp_exist_unseal, heapProp_sep_unseal, heapProp_wand_unseal, heapProp_persistently_unseal). Ltac unseal := rewrite !heapProp_unseal /=. Section mixins. (** Enable [simpl] locally, which is useful for proofs in the model. *) Local Arguments heapProp_holds !_ _ /. Lemma heapProp_bi_mixin : BiMixin heapProp_entails heapProp_emp heapProp_pure heapProp_and heapProp_or heapProp_impl (@heapProp_forall) (@heapProp_exist) heapProp_sep heapProp_wand. Proof. split. - (* [PreOrder heapProp_entails] *) split; repeat destruct 1; constructor; naive_solver. - (* [P ≡ Q ↔ (P ⊢ Q) ∧ (Q ⊢ P)] *) intros P Q; split. + intros [HPQ]; split; split; naive_solver. + intros [[HPQ] [HQP]]; split; naive_solver. - (* [Proper (iff ==> dist n) bi_pure] *) unseal=> n φ1 φ2 Hφ; split; naive_solver. - (* [NonExpansive2 bi_and] *) unseal=> n P1 P2 [HP] Q1 Q2 [HQ]; split; naive_solver. - (* [NonExpansive2 bi_or] *) unseal=> n P1 P2 [HP] Q1 Q2 [HQ]; split; naive_solver. - (* [NonExpansive2 bi_impl] *) unseal=> n P1 P2 [HP] Q1 Q2 [HQ]; split; naive_solver. - (* [Proper (pointwise_relation _ (dist n) ==> dist n) (bi_forall A)] *) unseal=> A n Φ1 Φ2 HΦ; split=> σ /=; split=> ? x; by apply HΦ. - (* [Proper (pointwise_relation _ (dist n) ==> dist n) (bi_exist A)] *) unseal=> A n Φ1 Φ2 HΦ; split=> σ /=; split=> -[x ?]; exists x; by apply HΦ. - (* [NonExpansive2 bi_sep] *) unseal=> n P1 P2 [HP] Q1 Q2 [HQ]; split; naive_solver. - (* [NonExpansive2 bi_wand] *) unseal=> n P1 P2 [HP] Q1 Q2 [HQ]; split; naive_solver. - (* [φ → P ⊢ ⌜ φ ⌝] *) unseal=> φ P ?; by split. - (* [(φ → True ⊢ P) → ⌜ φ ⌝ ⊢ P] *) unseal=> φ P HP; split=> σ ?. by apply HP. - (* [P ∧ Q ⊢ P] *) unseal=> P Q; split=> σ [??]; done. - (* [P ∧ Q ⊢ Q] *) unseal=> P Q; split=> σ [??]; done. - (* [(P ⊢ Q) → (P ⊢ R) → P ⊢ Q ∧ R] *) unseal=> P Q R [HPQ] [HPR]; split=> σ; split; auto. - (* [P ⊢ P ∨ Q] *) unseal=> P Q; split=> σ; by left. - (* [Q ⊢ P ∨ Q] *) unseal=> P Q; split=> σ; by right. - (* [(P ⊢ R) → (Q ⊢ R) → P ∨ Q ⊢ R] *) unseal=> P Q R [HPQ] [HQR]; split=> σ [?|?]; auto. - (* [(P ∧ Q ⊢ R) → P ⊢ Q → R] *) unseal=> P Q R HPQR; split=> σ ? σ' ??. apply HPQR. split; eauto using heapProp_closed. - (* [(P ⊢ Q → R) → P ∧ Q ⊢ R] *) unseal=> P Q R HPQR; split=> σ [??]. by eapply HPQR. - (* [(∀ a, P ⊢ Ψ a) → P ⊢ ∀ a, Ψ a] *) unseal=> A P Ψ HPΨ; split=> σ ? a. by apply HPΨ. - (* [(∀ a, Ψ a) ⊢ Ψ a] *) unseal=> A Ψ a; split=> σ ?; done. - (* [Ψ a ⊢ ∃ a, Ψ a] *) unseal=> A Ψ a; split=> σ ?. by exists a. - (* [(∀ a, Φ a ⊢ Q) → (∃ a, Φ a) ⊢ Q] *) unseal=> A Φ Q HΦQ; split=> σ [a ?]. by apply (HΦQ a). - (* [(P ⊢ Q) → (P' ⊢ Q') → P ∗ P' ⊢ Q ∗ Q'] *) unseal=> P P' Q Q' [HPQ] [HP'Q']; split; naive_solver. - (* [P ⊢ emp ∗ P] *) unfold heapProp_emp; unseal=> P; split=> σ ? /=. eexists ∅, σ. rewrite left_id_L. split_and!; done || apply map_disjoint_empty_l. - (* [emp ∗ P ⊢ P] *) unfold heapProp_emp; unseal=> P; split; intros ? (?&σ&->&?&_&?). eapply heapProp_closed; [done|]. by apply map_union_subseteq_r. - (* [P ∗ Q ⊢ Q ∗ P] *) unseal=> P Q; split; intros ? (σ1&σ2&->&?&?&?). exists σ2, σ1. by rewrite map_union_comm. - (* [(P ∗ Q) ∗ R ⊢ P ∗ (Q ∗ R)] *) unseal=> P Q R; split; intros ? (?&σ3&->&?&(σ1&σ2&->&?&?&?)&?). exists σ1, (σ2 ∪ σ3). split_and!; [by rewrite assoc_L|solve_map_disjoint|done|]. exists σ2, σ3; split_and!; [done|solve_map_disjoint|done..]. - (* [(P ∗ Q ⊢ R) → P ⊢ Q -∗ R] *) unseal=> P Q R [HPQR]; split=> σ1 ? σ2 ??. apply HPQR. by exists σ1, σ2. - (* [(P ⊢ Q -∗ R) → P ∗ Q ⊢ R] *) unseal=> P Q R [HPQR]; split; intros ? (σ1&σ2&->&?&?&?). by apply HPQR. Qed. Lemma heapProp_bi_persistently_mixin : BiPersistentlyMixin heapProp_entails heapProp_emp heapProp_and (@heapProp_exist) heapProp_sep heapProp_persistently. Proof. eapply bi_persistently_mixin_discrete, heapProp_bi_mixin; [done|..]. - (* The "existential property" [(emp ⊢ ∃ x, Φ x) → ∃ x, emp ⊢ Φ x]. For an affine BI the proof relies on there being a smallest resource/the unit (here the empty heap [∅]). *) unfold heapProp_emp. unseal. intros A Φ [H]. destruct (H ∅) as [x ?]; [done|]. exists x. split=> σ _. eapply heapProp_closed; [done|]. by apply map_empty_subseteq. - by rewrite heapProp_persistently_unseal. Qed. Lemma heapProp_bi_later_mixin : BiLaterMixin heapProp_entails heapProp_pure heapProp_or heapProp_impl (@heapProp_forall) (@heapProp_exist) heapProp_sep heapProp_persistently heapProp_later. Proof. eapply bi_later_mixin_id; [done|apply heapProp_bi_mixin]. Qed. End mixins. Canonical Structure heapPropI : bi := {| bi_ofe_mixin := ofe_mixin_of heapProp; bi_bi_mixin := heapProp_bi_mixin; bi_bi_persistently_mixin := heapProp_bi_persistently_mixin; bi_bi_later_mixin := heapProp_bi_later_mixin |}. Global Instance heapProp_pure_forall : BiPureForall heapPropI. Proof. intros A φ. rewrite /bi_forall /bi_pure /=. unseal. by split. Qed. Global Instance heapProp_affine : BiAffine heapPropI. Proof. exact: bi.True_intro. Qed. Lemma heapProp_proofmode_test {A} (P Q Q' R : heapProp) (Φ Ψ : A → heapProp) : P ∗ Q ∗ Q' -∗ (* [Q'] is not used, to demonstrate affinity *) □ R -∗ □ (R -∗ ∃ x, Φ x) -∗ ∃ x, Φ x ∗ Φ x ∗ P ∗ Q. Proof. iIntros "(HP & HQ & HQ') #HR #HRΦ". iDestruct ("HRΦ" with "HR") as (x) "#HΦ". iExists x. iFrame. by iSplitL. Qed. iris-iris-4.2.0/tests/ipm_paper.ref000066400000000000000000000031541460620107300172450ustar00rootroot00000000000000"sep_exist" : string 1 goal M : ucmra A : Type P, R : iProp Ψ : A → iProp x : A ============================ "HP" : P "HΨ" : Ψ x "HR" : R --------------------------------------∗ Ψ x ∗ P 1 goal M : ucmra A : Type P, R : iProp Ψ : A → iProp x : A ============================ "HΨ" : Ψ x --------------------------------------∗ Ψ x 1 goal M : ucmra A : Type P, R : iProp Ψ : A → iProp x : A ============================ "HP" : P "HR" : R --------------------------------------∗ P "sep_exist_short" : string 1 goal M : ucmra A : Type P, R : iProp Ψ : A → iProp ============================ "HP" : P "HΨ" : ∃ a : A, Ψ a "HR" : R --------------------------------------∗ ∃ a : A, Ψ a ∗ P "read_spec" : string 1 goal Σ : gFunctors heapGS0 : heapGS Σ 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 goal Σ : gFunctors heapGS0 : heapGS Σ 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) --------------------------------------∗ |={⊤ ∖ ↑N}=> ▷ I γ l ∗ ∃ m : nat, ⌜#c = #m ∧ n ≤ m⌝ ∧ C l m iris-iris-4.2.0/tests/ipm_paper.v000066400000000000000000000212751460620107300167420ustar00rootroot00000000000000(** 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.proofmode Require Import tactics. From iris.base_logic Require Import base_logic. From iris.deprecated.program_logic Require Import hoare. From iris.heap_lang Require Import proofmode notation. From iris.prelude Require Import options. Unset Mangle Names. (** The proofs from Section 3.1 *) Section demo. Context {M : ucmra}. Notation iProp := (uPred M). (* The version in Coq *) Lemma and_exist A (P R: Prop) (Ψ: A → Prop) : P ∧ (∃ a, Ψ a) ∧ R → ∃ a, P ∧ Ψ a. Proof. intros [HP [HΨ HR]]. destruct HΨ as [x HΨ]. exists x. split. - assumption. - assumption. 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. 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]]". 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) : P ∗ (∃ a, Ψ a) ∗ R ⊢ ∃ a, Ψ a ∗ P. Proof. by iIntros "[$ [??]]". Qed. End demo. (** The proofs from Section 3.2 *) (** In the Iris development we often write specifications directly using weakest preconditions, in sort of `CPS` style, so that they can be applied easier when proving client code. A version of [list_reverse] in that style can be found in the file [theories/tests/list_reverse.v]. *) Section list_reverse. Context `{!heapGS Σ}. Notation iProp := (iProp Σ). Implicit Types l : loc. Fixpoint is_list (hd : val) (xs : list val) : iProp := match xs with | [] => ⌜hd = NONEV⌝ | x :: xs => ∃ l hd', ⌜hd = SOMEV #l⌝ ∗ l ↦ (x,hd') ∗ is_list hd' xs end%I. Definition rev : val := rec: "rev" "hd" "acc" := match: "hd" with NONE => "acc" | SOME "l" => let: "tmp1" := Fst !"l" in let: "tmp2" := Snd !"l" in "l" <- ("tmp1", "acc");; "rev" "tmp2" "hd" end. Lemma rev_acc_ht hd acc xs ys : ⊢ {{ is_list hd xs ∗ is_list acc ys }} rev hd acc {{ w, is_list w (reverse xs ++ ys) }}. Proof. iIntros "!> [Hxs Hys]". iLöb as "IH" forall (hd acc xs ys). wp_rec; wp_let. destruct xs as [|x xs]; iSimplifyEq. - (* nil *) by wp_match. - (* cons *) iDestruct "Hxs" as (l hd') "(% & Hx & Hxs)"; iSimplifyEq. wp_match. wp_load. wp_load. wp_store. rewrite reverse_cons -assoc. iApply ("IH" $! hd' (InjRV #l) xs (x :: ys) with "Hxs [Hx Hys]"). iExists l, acc; by iFrame. Qed. Lemma rev_ht hd xs : ⊢ {{ is_list hd xs }} rev hd NONEV {{ w, is_list w (reverse xs) }}. Proof. iIntros "!> Hxs". rewrite -(right_id_L [] (++) (reverse xs)). iApply (rev_acc_ht hd NONEV with "[Hxs]"); simpl; by iFrame. Qed. End list_reverse. (** The proofs from Section 5 *) (** This part contains a formalization of the monotone counter, but with an explicit contruction of the monoid, as we have also done in the proof mode paper. This should simplify explaining and understanding what is happening. A version that uses the authoritative monoid and natural number monoid under max can be found in [theories/heap_lang/lib/counter.v]. *) Definition newcounter : val := λ: <>, ref #0. Definition incr : val := rec: "incr" "l" := let: "n" := !"l" in if: CAS "l" "n" (#1 + "n") then #() else "incr" "l". Definition read : val := λ: "l", !"l". (** The CMRA we need. *) Inductive M := Auth : nat → M | Frag : nat → M | Bot. Section M. Local Arguments cmra_op _ !_ !_/. Local Arguments op _ _ !_ !_/. Local Arguments core _ _ !_/. Canonical Structure M_O : ofe := leibnizO M. Local Instance M_valid : Valid M := λ x, x ≠ Bot. Local Instance M_op : Op M := λ x y, match x, y with | Auth n, Frag j | Frag j, Auth n => if decide (j ≤ n) then Auth n else Bot | Frag i, Frag j => Frag (max i j) | _, _ => Bot end. Local Instance M_pcore : PCore M := λ x, Some match x with Auth j | Frag j => Frag j | _ => Bot end. Local Instance M_unit : Unit M := Frag 0. Definition M_ra_mixin : RAMixin M. Proof. apply ra_total_mixin; try solve_proper || eauto. - intros [n1|i1|] [n2|i2|] [n3|i3|]; repeat (simpl; case_decide); f_equal/=; lia. - intros [n1|i1|] [n2|i2|]; repeat (simpl; case_decide); f_equal/=; lia. - intros [n|i|]; repeat (simpl; case_decide); f_equal/=; lia. - by intros [n|i|]. - intros [n1|i1|] y [[n2|i2|] ?]; exists (core y); simplify_eq/=; repeat (simpl; case_decide); f_equal/=; lia. - intros [n1|i1|] [n2|i2|]; simpl; by try case_decide. Qed. Canonical Structure M_R : cmra := discreteR M M_ra_mixin. Global Instance M_discrete : CmraDiscrete M_R. Proof. apply discrete_cmra_discrete. Qed. Definition M_ucmra_mixin : UcmraMixin M. Proof. split; try (done || apply _). intros [?|?|]; simpl; try case_decide; f_equal/=; lia. Qed. Canonical Structure M_UR : ucmra := Ucmra M M_ucmra_mixin. Global Instance frag_core_id n : CoreId (Frag n). Proof. by constructor. Qed. Lemma auth_frag_valid j n : ✓ (Auth n ⋅ Frag j) → j ≤ n. Proof. simpl. case_decide; first done. by intros []. Qed. Lemma auth_frag_op (j n : nat) : j ≤ n → Auth n = Auth n ⋅ Frag j. Proof. intros. by rewrite /= decide_True. Qed. Lemma M_update n : Auth n ~~> Auth (S n). Proof. apply cmra_discrete_total_update=>-[m|j|] /= ?; repeat case_decide; done || lia. Qed. End M. Class counterG Σ := CounterG { counter_tokG : inG Σ M_UR }. Local Existing Instance counter_tokG. Definition counterΣ : gFunctors := #[GFunctor (constRF M_UR)]. Global Instance subG_counterΣ {Σ} : subG counterΣ Σ → counterG Σ. Proof. intros [?%subG_inG _]%subG_inv. split; apply _. Qed. Section counter_proof. Context `{!heapGS Σ, !counterG Σ}. Implicit Types l : loc. Definition I (γ : gname) (l : loc) : iProp Σ := (∃ c : nat, l ↦ #c ∗ own γ (Auth c))%I. Definition C (l : loc) (n : nat) : iProp Σ := (∃ N γ, inv N (I γ l) ∧ own γ (Frag n))%I. (** The main proofs. *) Global Instance C_persistent l n : Persistent (C l n). Proof. apply _. Qed. Lemma newcounter_spec : ⊢ {{ True }} newcounter #() {{ v, ∃ l, ⌜v = #l⌝ ∧ C l 0 }}. Proof. iIntros "!> _ /=". rewrite /newcounter /=. wp_lam. wp_alloc l as "Hl". iMod (own_alloc (Auth 0)) as (γ) "Hγ"; first done. rewrite (auth_frag_op 0 0) //; iDestruct "Hγ" as "[Hγ Hγf]". set (N:= nroot .@ "counter"). iMod (inv_alloc N _ (I γ l) with "[Hl Hγ]") as "#?". { iIntros "!>". iExists 0. by iFrame. } iModIntro. rewrite /C; eauto 10. Qed. Lemma incr_spec l n : ⊢ {{ C l n }} incr #l {{ v, ⌜v = #()⌝ ∧ C l (S n) }}. Proof. iIntros "!> Hl /=". iLöb as "IH". wp_rec. iDestruct "Hl" as (N γ) "[#Hinv Hγf]". wp_bind (! _)%E. iInv "Hinv" as (c) "[Hl Hγ]". wp_load. iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|]. wp_let. wp_op. wp_bind (CmpXchg _ _ _). iInv "Hinv" as (c') ">[Hl Hγ]". destruct (decide (c' = c)) as [->|]. - iCombine "Hγ" "Hγf" as "Hγ". iDestruct (own_valid with "Hγ") as %?%auth_frag_valid; rewrite -auth_frag_op //. iMod (own_update with "Hγ") as "Hγ"; first apply M_update. rewrite (auth_frag_op (S n) (S c)); last lia; iDestruct "Hγ" as "[Hγ Hγf]". wp_cmpxchg_suc. iModIntro. iSplitL "Hl Hγ". { iNext. iExists (S c). rewrite Nat2Z.inj_succ Z.add_1_l. by iFrame. } wp_pures. by iFrame "#∗". - wp_cmpxchg_fail; first (intros [=]; abstract lia). iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c'; by iFrame|]. wp_pures. iApply "IH". iFrame "#∗". 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_lam. Show. iInv "Hinv" as (c) "[Hl Hγ]". wp_load. Show. iDestruct (own_valid γ (Auth c ⋅ Frag n) with "[-]") as %H%auth_frag_valid. { iApply own_op. by iFrame. } rewrite (auth_frag_op c c); last lia; iDestruct "Hγ" as "[Hγ Hγf']". iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|]. rewrite /C; eauto 10 with lia. Qed. End counter_proof. iris-iris-4.2.0/tests/iprop.ref000066400000000000000000000000001460620107300164050ustar00rootroot00000000000000iris-iris-4.2.0/tests/iprop.v000066400000000000000000000015541460620107300161150ustar00rootroot00000000000000(** Make sure these universe constraints do not conflict with Iris's definition of [gFunctors]: See [!782](https://gitlab.mpi-sws.org/iris/iris/-/merge_requests/782) *) From Coq Require Import Logic.Eqdep. (** A [sigT] that is partially applied and template-polymorphic causes universe inconsistency errors, which is why [sigT] should be avoided for the definition of [gFunctors]. The following constructs a partially applied [sigT] that generates bad universe constraints. This causes a universe inconsistency when [gFunctors] are to be defined with [sigT]. *) Definition foo := eq_dep ((Type -> Type) -> Type) (sigT (A:=Type -> Type)). From iris.base_logic Require Import iprop. Lemma bi_ofeO_iProp Σ : bi_ofeO (iPropI Σ) = iPropO Σ. Proof. reflexivity. Qed. Lemma bi_cofe_iProp Σ : bi_cofe (iPropI Σ) = @uPred_cofe (iResUR Σ). Proof. reflexivity. Qed. iris-iris-4.2.0/tests/iris_notation.ref000066400000000000000000000000001460620107300201350ustar00rootroot00000000000000iris-iris-4.2.0/tests/iris_notation.v000066400000000000000000000032441460620107300176430ustar00rootroot00000000000000From iris.algebra Require Import frac. From iris.proofmode Require Import tactics monpred. From iris.base_logic Require Import base_logic lib.fancy_updates. Section base_logic_tests. Context {M : ucmra}. Implicit Types P Q R : uPred M. (* Test scopes for bupd *) Definition use_bupd_uPred (n : nat) : uPred M := □ |==> ∃ m : nat , ⌜ n = 2 ⌝. Definition use_plainly_uPred (n : nat) : uPred M := ■ |==> ∃ m : nat , ⌜ n = 2 ⌝. (* Test scopes inside big-ops *) Definition big_op_scope_uPred_1 (xs : list nat) : uPred M := [∗ list] _ ↦ x ∈ xs, True. Definition big_op_scope_uPred_2 (xs : list nat) : uPred M := [∗ list] x; y ∈ xs; xs, True. Definition big_op_scope_uPred_3 (m : gmap nat nat) : uPred M := [∗ map] _ ↦ x ∈ m, True. Definition big_op_scope_uPred_4 (m : gmap nat nat) : uPred M := [∗ map] x; y ∈ m; m, True. End base_logic_tests. Section iris_tests. Context `{!invGS_gen hlc Σ}. Implicit Types P Q R : iProp Σ. (* Test scopes for bupd and fupd *) Definition use_bupd_iProp (n : nat) : iProp Σ := □ |==> ∃ m : nat , ⌜ n = 2 ⌝. Definition use_fupd_iProp (n : nat) : iProp Σ := □ |={⊤}=> ∃ m : nat , ⌜ n = 2 ⌝. (* Test scopes inside big-ops *) Definition big_op_scope_iProp_1 (xs : list nat) : iProp Σ := [∗ list] _ ↦ x ∈ xs, True. Definition big_op_scope_iProp_2 (xs : list nat) : iProp Σ := [∗ list] x; y ∈ xs; xs, True. Definition big_op_scope_iProp_3 (m : gmap nat nat) : iProp Σ := [∗ map] _ ↦ x ∈ m, True. Definition big_op_scope_iProp_4 (m : gmap nat nat) : iProp Σ := [∗ map] x; y ∈ m; m, True. End iris_tests. iris-iris-4.2.0/tests/later_credits_paper.ref000066400000000000000000000000001460620107300212670ustar00rootroot00000000000000iris-iris-4.2.0/tests/later_credits_paper.v000066400000000000000000000134101460620107300207710ustar00rootroot00000000000000From iris.proofmode Require Import tactics. From iris.base_logic Require Import invariants ghost_var. From iris.heap_lang Require Import proofmode notation. From iris.prelude Require Import options. (** * This file showcases the basic usage of later credits. *) (** The examples are taken from the later credits paper at ICFP'22, "Later Credits: Resourceful Reasoning for the Later Modality", available at . *) (** Overview of important connectives, tactics, and lemmas for later credits: - the resource [£ n] denotes ownership of n later credits, i.e., the right to eliminate [n] laters at a fancy update, - the lemma [lc_fupd_elim_later] allows to strip a later off a hypothesis ["H"] using a credit ["Hcred" : £ 1], assuming that the goal is a fancy update. Example usage: [iMod (lc_fupd_elim_later with "Hcred H") as "H".] - the lemma [lc_fupd_add_later] allows to add a later in front of the goal, if the current goal is a fancy update, using one credit ["Hcred" : £ 1]. The later can subsequently be introduced with [iNext] to strip laters off multiple hypotheses. Example usage: [iApply (lc_fupd_add_later with "Hcred").] - the lemma [lc_split] shows that [£ (n + m) ⊣⊢ £ n ∗ £ m], i.e., later credits compose via addition. This is also automatically applied by [iSplit] and [iDestruct]. - the HeapLang-specific [wp_pure cred:"Hcred"] tactic takes a single pure step (just like [wp_pure]) and generates a new hypothesis ["Hcred" : £ 1] asserting ownership of a single later credit that can subsequently be used with the lemmas described above. *) (** This is the small example from the end of Section 2 (page 9) of the paper. Using later credits in this example is not strictly necessary, but it demonstrates how they can be used. *) Lemma mini_later_credits_example `{!heapGS Σ} N (f : val) l : (** Assume we have some specification for f... *) (∀ v, ⊢ {{{ ∃ n: nat, ⌜v = LitV n⌝}}} f v {{{ (n' : nat), RET #n'; True }}}) → (** ... and an invariant managing [l] *) inv N (∃ n : nat, l ↦ LitV n) -∗ (** Our program stores the result of calling [f] to [l]. *) {{{ True }}} #l <- f (#41 + #1) {{{ v, RET v; True }}}. Proof. (** We will use a later credit to strip the later we get over the contents of the invariant when opening it. This is not strictly necessary (timelessness would also work here), but it is nevertheless instructive. *) iIntros (Hs) "#Hpre". iIntros (Φ) "!> _ Hpost". wp_bind (_ + _)%E. (** We generate a later credit ["Hcred" : £ 1] from executing a pure step. [wp_pure credit:"Hcred"] behaves like [wp_pure] in executing a pure step, but additionally provides a new hypothesis ["Hcred" : £ 1]. [£ 1] denotes ownership of the right to eliminate one later. *) wp_pure credit:"Hcred". (** We now use the specification for [f]. *) wp_bind (f _). iApply Hs. { iExists 42. done. } iNext. iIntros (n') "_". (** Now we open the invariant... *) iInv "Hpre" as "Hl". (** and get [Hl : ▷ (∃ n : nat, l ↦ #n)]. *) (** We can use the later credit we just obtained to eliminate the later. Later credits can be used to eliminate laters at fancy updates, in general away from a weakest precondition. [lc_fupd_elim_later] can be used to transform a hypothesis [▷ P] to [P] using one credit [£1]. *) iMod (lc_fupd_elim_later with "Hcred Hl") as "Hl". iDestruct "Hl" as "(%n & Hl)". (** now we can execute the store using the [l ↦ _]. *) wp_store. iModIntro. iSplitL "Hl". { eauto with iFrame. } by iApply "Hpost". Qed. (** Now for a slightly more complicated example involving nested invariants. This is an instance of the example outlined in the introduction (page 4) of the paper. Of course, we again consider a very simple proof that might appear toyish, but with challenges that might well appear as part of much more complicated proof setups. *) Lemma nested_invariants_example `{!heapGS Σ} `{!ghost_varG Σ loc} γ (l : loc) : (** Assume that the location [l] is managed through another indirection with a ghost variable [γ], a situation you might well encounter as part of more complicated proof setups. The ownership of the location [l] itself is kept inside a nested invariant. *) inv (nroot .@ "1") (∃ l : loc, inv (nroot .@ "2") (∃ n : nat, l ↦ #n) ∗ ghost_var γ (1/2) l) -∗ (** One half of [γ] is kept outside the invariant to keep knowledge about the location [l]. We also assume to get one later credit, perhaps from a preceding pure step or from a totally different part of the program. *) {{{ ghost_var γ (1/2) l ∗ £ 1 }}} #l <- #42 {{{ v, RET v; True }}}. Proof. iIntros "#Hinv". iIntros (Φ) "!> (Hv & Hcred) Hpost". (** We open the outer invariant... *) iInv "Hinv" as "(%l' & #Hinv' & >Hv')". (** and use timelessness to strip the later over ["Hv'"]. But we cannot do the same for ["Hinv'"], the knowledge about the nested invariant, because it is not timeless. And we also cannot take any program step to strip the later here! *) iCombine "Hv Hv'" gives %[_ <-]. (** Instead, we use the later credit to strip the later in front of the invariant. Here we make use of [lc_fupd_add_later], which adds a later to the goal using one credit, if the current goal is a fancy update. *) iApply fupd_wp. iApply (lc_fupd_add_later with "Hcred"). (** We can use this to strip laters off multiple hypotheses now. *) iIntros "!>!>". (** Now we are ready to open the nested invariant! *) iInv "Hinv'" as "(%n & >Hl)". (** And finally we can take a program step. *) wp_store. iModIntro. iSplitL "Hl". { iNext. iExists 42. done. } iModIntro. iSplitL "Hv'". { iNext. eauto with iFrame. } by iApply "Hpost". Qed. iris-iris-4.2.0/tests/list_reverse.ref000066400000000000000000000014261460620107300177770ustar00rootroot000000000000001 goal Σ : gFunctors heapGS0 : heapGS Σ 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 goal Σ : gFunctors heapGS0 : heapGS Σ acc : val ys : list val Φ : val → iPropI Σ ============================ "Hys" : is_list acc ys "HΦ" : ∀ w : val, is_list w ys -∗ Φ w --------------------------------------∗ WP match: InjLV #() with InjL <> => acc | InjR "l" => let: "tmp1" := Fst ! "l" in let: "tmp2" := Snd ! "l" in "l" <- ("tmp1", acc);; rev "tmp2" (InjLV #()) end [{ v, Φ v }] iris-iris-4.2.0/tests/list_reverse.v000066400000000000000000000031751460620107300174730ustar00rootroot00000000000000(** Correctness of in-place list reversal *) From iris.proofmode Require Export tactics. From iris.program_logic Require Export total_weakestpre weakestpre. From iris.heap_lang Require Export lang. From iris.heap_lang Require Import proofmode notation. From iris.prelude Require Import options. Unset Mangle Names. Section list_reverse. Context `{!heapGS Σ}. Implicit Types l : loc. Fixpoint is_list (hd : val) (xs : list val) : iProp Σ := match xs with | [] => ⌜hd = NONEV⌝ | x :: xs => ∃ l hd', ⌜hd = SOMEV #l⌝ ∗ l ↦ (x,hd') ∗ is_list hd' xs end%I. Definition rev : val := rec: "rev" "hd" "acc" := match: "hd" with NONE => "acc" | SOME "l" => let: "tmp1" := Fst !"l" in let: "tmp2" := Snd !"l" in "l" <- ("tmp1", "acc");; "rev" "tmp2" "hd" end. Lemma rev_acc_wp hd acc xs ys : [[{ is_list hd xs ∗ is_list acc ys }]] rev hd acc [[{ w, RET w; is_list w (reverse xs ++ ys) }]]. Proof. iIntros (Φ) "[Hxs Hys] HΦ". Show. iInduction xs as [|x xs] "IH" forall (hd acc ys Φ); iSimplifyEq; wp_rec; wp_let. - Show. wp_match. by iApply "HΦ". - iDestruct "Hxs" as (l hd' ->) "[Hx Hxs]". wp_load. wp_load. wp_store. iApply ("IH" $! hd' (SOMEV #l) (x :: ys) with "Hxs [Hx Hys]"); simpl. { iExists l, acc; by iFrame. } iIntros (w). rewrite cons_middle assoc -reverse_cons. iApply "HΦ". Qed. Lemma rev_wp hd xs : [[{ is_list hd xs }]] rev hd NONEV [[{ w, RET w; is_list w (reverse xs) }]]. Proof. iIntros (Φ) "Hxs HΦ". iApply (rev_acc_wp hd NONEV xs [] with "[$Hxs //]"). iIntros (w). rewrite right_id_L. iApply "HΦ". Qed. End list_reverse. iris-iris-4.2.0/tests/lock.ref000066400000000000000000000004351460620107300162200ustar00rootroot00000000000000"wp_lock_client_spin" : string 1 goal Σ : gFunctors heapGS0 : heapGS Σ spin_lockG0 : spin_lockG Σ ============================ ⊢ WP let: "l" := ref #10 in let: "lock" := newlock #() in acquire "lock";; "l" <- #42;; release "lock" {{ _, True }} iris-iris-4.2.0/tests/lock.v000066400000000000000000000052331460620107300157120ustar00rootroot00000000000000From iris.heap_lang Require Import proofmode notation adequacy lib.spin_lock. From iris.prelude Require Import options. (* For printing tests we want stable names. *) Unset Mangle Names. (** Make sure the lock type class works to write generic clients and specifications. *) Section lock_gen. Context `{!lock}. Definition lock_client_gen : expr := let: "l" := ref #10 in let: "lock" := newlock #() in acquire "lock";; "l" <- #42;; release "lock". Lemma wp_lock_client_gen `{!heapGS Σ, !lockG Σ} : ⊢ WP lock_client_gen {{ _, True }}. Proof. unfold lock_client_gen. wp_alloc l as "Hl". wp_smart_apply (newlock_spec (∃ n : Z, l ↦ #n) with "[Hl]") as (lk γ) "#Hlock"; first by eauto. wp_smart_apply (acquire_spec with "Hlock") as "(Hlocked & %v & Hloc)". wp_store. wp_smart_apply (release_spec with "[$Hlock $Hlocked Hloc]"); by eauto. Qed. End lock_gen. (** Make sure the lock type class works to write clients and specifications for specific locks (here: spin lock). *) Section lock_spin. Local Existing Instance spin_lock. Definition lock_client_spin : expr := let: "l" := ref #10 in let: "lock" := newlock #() in acquire "lock";; "l" <- #42;; release "lock". (* Making sure that using [spin_lockG] here works, not just [lockG]. *) Check "wp_lock_client_spin". Lemma wp_lock_client_spin `{!heapGS Σ, !spin_lockG Σ} : ⊢ WP lock_client_spin {{ _, True }}. Proof. unfold lock_client_spin. (* This should not unfold the [newlock], [acquire], and [release] projections. That is, it should not show [spin_lock.]. *) simpl. Show. wp_alloc l as "Hl". wp_smart_apply (newlock_spec (∃ n : Z, l ↦ #n) with "[Hl]") as (lk γ) "#Hlock"; first by eauto. wp_smart_apply (acquire_spec with "Hlock") as "(Hlocked & %v & Hloc)". wp_store. wp_smart_apply (release_spec with "[$Hlock $Hlocked Hloc]"); by eauto. Qed. End lock_spin. (** Making sure that the [lockG/spin_lockG] conditions are resolved when using adequacy. For the generic client, we need to instantiate it with a specific lock for that to make sense. *) Section lock_adequacy. Local Existing Instance spin_lock. Lemma lock_client_gen_adequate σ : adequate NotStuck lock_client_gen σ (λ _ _, True). Proof. set (Σ := #[heapΣ; spin_lockΣ]). apply (heap_adequacy Σ); iIntros (?) "_". iApply wp_lock_client_gen. Qed. Lemma lock_client_spin_adequate σ : adequate NotStuck lock_client_spin σ (λ _ _, True). Proof. set (Σ := #[heapΣ; spin_lockΣ]). apply (heap_adequacy Σ); iIntros (?) "_". iApply wp_lock_client_gen. Qed. End lock_adequacy. iris-iris-4.2.0/tests/monpred.ref000066400000000000000000000005601460620107300167330ustar00rootroot00000000000000"monPred_unseal_test_1" : string 1 goal I : biIndex M : ucmra P, Q : uPredI M R : monPred i : I ============================ (P ∗ Q) ∗ R i ⊣⊢ False "monPred_unseal_test_2" : string 1 goal I : biIndex M : ucmra P, Q : uPredI M R : monPred ============================ ⎡ upred.uPred_sep_def P Q ⎤ ∗ R ⊣⊢ False iris-iris-4.2.0/tests/monpred.v000066400000000000000000000013201460620107300164170ustar00rootroot00000000000000From stdpp Require Import strings. From iris.base_logic Require Import bi. From iris.bi Require Import embedding monpred. Section tests_unseal. Context {I : biIndex} (M : ucmra). Local Notation monPred := (monPred I (uPredI M)). Check "monPred_unseal_test_1". Lemma monPred_unseal_test_1 P Q (R : monPred) : ⎡ P ∗ Q ⎤ ∗ R ⊣⊢ False. Proof. intros. split=> i. monPred.unseal. (** Make sure [∗] on uPred is not unfolded *) Show. Abort. Check "monPred_unseal_test_2". Lemma monPred_unseal_test_2 P Q (R : monPred) : ⎡ P ∗ Q ⎤ ∗ R ⊣⊢ False. Proof. uPred.unseal. (** Make sure [∗] on monPred is not unfolded *) Show. Abort. End tests_unseal. iris-iris-4.2.0/tests/mosel_paper.ref000066400000000000000000000057241460620107300176040ustar00rootroot000000000000001 goal PROP : bi A : Type P : PROP Φ, Ψ : A → PROP ============================ "HP" : P "H" : ∃ a : A, Φ a ∨ Ψ a --------------------------------------∗ ∃ a : A, P ∗ Φ a ∨ P ∗ Ψ a 1 goal PROP : bi A : Type P : PROP Φ, Ψ : A → PROP x : A ============================ "HP" : P "H1" : Φ x --------------------------------------∗ ∃ a : A, P ∗ Φ a ∨ P ∗ Ψ a 1 goal PROP : bi A : Type P : PROP Φ, Ψ : A → PROP x : A ============================ "HP" : P "H2" : Ψ x --------------------------------------∗ ∃ a : A, P ∗ Φ a ∨ P ∗ Ψ a 1 goal PROP : bi A : Type P : PROP Φ, Ψ : A → PROP ============================ "HP" : P "H" : ∃ a : A, Φ a ∨ Ψ a --------------------------------------∗ ∃ a : A, P ∗ Φ a ∨ P ∗ Ψ a 1 goal PROP : bi A : Type P : PROP Φ, Ψ : A → PROP ============================ "H" : ∃ a : A, Φ a ∨ Ψ a --------------------------------------∗ ∃ x : A, Φ x ∨ Ψ x 1 goal PROP : bi A : Type P : PROP Φ, Ψ : A → PROP x : A ============================ "HP" : P "H1" : Φ x --------------------------------------∗ Φ x 1 goal PROP : bi A : Type P : PROP Φ, Ψ : A → PROP x : A ============================ "HP" : P "H2" : Ψ x --------------------------------------∗ P ∗ Ψ x 1 goal PROP : bi A : Type P : PROP Φ, Ψ : A → PROP ============================ "HP" : P --------------------------------------□ "H" : ∃ a : A, Φ a ∨ Ψ a --------------------------------------∗ ∃ a : A, Φ a ∨ P ∗ P ∗ Ψ a 1 goal PROP : bi A : Type P : PROP Φ, Ψ : A → PROP x : A ============================ "HP" : P --------------------------------------□ "H2" : Ψ x --------------------------------------∗ P ∗ P ∗ Ψ x 1 goal PROP : bi A : Type P, Q : PROP ============================ "HP" : P "HQ" : Q --------------------------------------□ □ (P ∗ Q) 1 goal I : biIndex PROP : bi Φ, Ψ : monPred I PROP ============================ "H1" : Φ "H2" : Φ -∗ Ψ --------------------------------------∗ Ψ 1 goal I : biIndex PROP : bi Φ, Ψ : monPred I PROP ============================ --------------------------------------∗ ∀ i : I, Φ i ∗ (Φ -∗ Ψ) i -∗ Ψ i 1 goal I : biIndex PROP : bi Φ : monPred I PROP P, Q : PROP ============================ "H2" : ⎡ P ⎤ --------------------------------------□ "H1" : ⎡ P -∗ Q ⎤ "H3" : Φ --------------------------------------∗ ⎡ P ∗ Q ⎤ 1 goal I : biIndex PROP : bi Φ : monPred I PROP P, Q : PROP ============================ "H2" : ⎡ P ⎤ --------------------------------------□ "H1" : ⎡ P -∗ Q ⎤ "H3" : Φ --------------------------------------∗ ⎡ Q ⎤ iris-iris-4.2.0/tests/mosel_paper.v000066400000000000000000000044501460620107300172700ustar00rootroot00000000000000(** 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.bi Require Import monpred. From iris.proofmode Require Import tactics monpred. From iris.prelude Require Import options. Unset Mangle Names. 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) : 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 ⎤ -∗ Φ -∗ ⎡ P ∗ Q ⎤. Proof. iIntros "H1 #H2 H3". Show. iFrame "H2". Show. iApply "H1". iAssumption. Qed. iris-iris-4.2.0/tests/mra.ref000066400000000000000000000001531460620107300160440ustar00rootroot00000000000000"mra_test_eq" : string 1 goal X, Y : gset nat H : X = Y ============================ X = Y iris-iris-4.2.0/tests/mra.v000066400000000000000000000010231460620107300155320ustar00rootroot00000000000000From stdpp Require Import propset gmap strings. From iris Require Import algebra.mra. Unset Mangle Names. Notation gset_mra K:= (mra (⊆@{gset K})). (* Check if we indeed get [=], i.e., the right [Inj] instance is used. *) Check "mra_test_eq". Lemma mra_test_eq X Y : to_mra X ≡@{gset_mra nat} to_mra Y → X = Y. Proof. intros ?%(inj _). Show. done. Qed. Notation propset_mra K := (mra (⊆@{propset K})). Lemma mra_test_equiv X Y : to_mra X ≡@{propset_mra nat} to_mra Y → X ≡ Y. Proof. intros ?%(inj _). done. Qed. iris-iris-4.2.0/tests/one_shot.ref000066400000000000000000000020351460620107300171040ustar00rootroot000000000000001 goal Σ : gFunctors heapGS0 : heapGS Σ 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 goal Σ : gFunctors heapGS0 : heapGS Σ 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: InjRV #m' with InjL <> => assert: #false | InjR "m" => assert: #m = "m" end {{ _, True }} Closed under the global context iris-iris-4.2.0/tests/one_shot.v000066400000000000000000000131231460620107300165750ustar00rootroot00000000000000From iris.algebra Require Import excl agree csum. From iris.proofmode Require Import tactics. From iris.program_logic Require Export weakestpre. From iris.deprecated.program_logic Require Import hoare. From iris.heap_lang Require Export lang. From iris.heap_lang Require Import assert proofmode notation adequacy. From iris.heap_lang.lib Require Import par. From iris.prelude Require Import options. (** This is the introductory example from the "Iris from the Ground Up" journal paper. *) Unset Mangle Names. Definition one_shot_example : val := λ: <>, let: "x" := ref NONE in ( (* tryset *) (λ: "n", CAS "x" NONE (SOME "n")), (* check *) (λ: <>, let: "y" := !"x" in λ: <>, match: "y" with NONE => #() | SOME "n" => match: !"x" with NONE => assert: #false | SOME "m" => assert: "n" = "m" end end)). Definition one_shotR := csumR (exclR unitO) (agreeR ZO). Definition Pending : one_shotR := Cinl (Excl ()). Definition Shot (n : Z) : one_shotR := Cinr (to_agree n). Class one_shotG Σ := { one_shot_inG : inG Σ one_shotR }. Local Existing Instance one_shot_inG. Definition one_shotΣ : gFunctors := #[GFunctor one_shotR]. Global Instance subG_one_shotΣ {Σ} : subG one_shotΣ Σ → one_shotG Σ. Proof. solve_inG. Qed. Section proof. Local Set Default Proof Using "Type*". Context `{!heapGS Σ, !one_shotG Σ}. Definition one_shot_inv (γ : gname) (l : loc) : iProp Σ := (l ↦ NONEV ∗ own γ Pending ∨ ∃ n : Z, l ↦ SOMEV #n ∗ own γ (Shot n))%I. Lemma wp_one_shot (Φ : val → iProp Σ) : (∀ f1 f2 : val, (∀ n : Z, □ WP f1 #n {{ w, ⌜w = #true⌝ ∨ ⌜w = #false⌝ }}) ∗ □ WP f2 #() {{ g, □ WP (of_val g) #() {{ _, True }} }} -∗ Φ (f1,f2)%V) (* FIXME: Once we depend on Coq 8.13, make WP notation use [v closed binder] so that we can add a type annotation at the [g] binder here. *) ⊢ WP one_shot_example #() {{ Φ }}. Proof. iIntros "Hf /=". pose proof (nroot .@ "N") as N. wp_lam. wp_alloc l as "Hl". iMod (own_alloc Pending) as (γ) "Hγ"; first done. iMod (inv_alloc N _ (one_shot_inv γ l) with "[Hl Hγ]") as "#HN". { iNext. iLeft. by iSplitL "Hl". } wp_pures. iModIntro. iApply "Hf"; iSplit. - iIntros (n) "!>". wp_lam. wp_pures. wp_bind (CmpXchg _ _ _). 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). } wp_cmpxchg_suc. iModIntro. iSplitL; last (wp_pures; by eauto). iNext; iRight; iExists n; by iFrame. + wp_cmpxchg_fail. iModIntro. iSplitL; last (wp_pures; by eauto). rewrite /one_shot_inv; eauto 10. - iIntros "!> /=". wp_lam. wp_bind (! _)%E. 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γ]". + iExists NONEV. iFrame. eauto. + iExists (SOMEV #m). iFrame. eauto. } iDestruct "Hv" as (v) "[Hl Hv]". wp_load. 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. + Show. iSplit. * iLeft; by iSplitL "Hl". * eauto. + iSplit. * iRight; iExists m; by iSplitL "Hl". * eauto. } iSplitL "Hinv"; first by eauto. iModIntro. wp_pures. iIntros "!> !>". wp_lam. iDestruct "Hv" as "[%|Hv]"; last iDestruct "Hv" as (m) "[% Hγ']"; subst; wp_match; [done|]. wp_bind (! _)%E. iInv N as "[[Hl >Hγ]|H]"; last iDestruct "H" as (m') "[Hl Hγ]". { by iCombine "Hγ Hγ'" gives %?. } wp_load. Show. iCombine "Hγ Hγ'" gives %?%to_agree_op_inv_L; subst. iModIntro. iSplitL "Hl". { iNext; iRight; by eauto. } wp_smart_apply wp_assert. wp_pures. by case_bool_decide. Qed. Lemma ht_one_shot (Φ : val → iProp Σ) : ⊢ {{ True }} one_shot_example #() {{ ff, (∀ n : Z, {{ True }} Fst ff #n {{ w, ⌜w = #true⌝ ∨ ⌜w = #false⌝ }}) ∗ {{ True }} Snd ff #() {{ g, {{ True }} g #() {{ _, True }} }} }}. Proof. iIntros "!> _". iApply wp_one_shot. iIntros (f1 f2) "[#Hf1 #Hf2]"; iSplit. - iIntros (n) "!> _". wp_smart_apply "Hf1". - iIntros "!> _". wp_smart_apply (wp_wand with "Hf2"). by iIntros (v) "#? !> _". Qed. End proof. (* Have a client with a closed proof. *) Definition client : expr := let: "ff" := one_shot_example #() in (Fst "ff" #5 ||| let: "check" := Snd "ff" #() in "check" #()). Section client. Context `{!heapGS Σ, !one_shotG Σ, !spawnG Σ}. Lemma client_safe : ⊢ WP client {{ _, True }}. Proof using Type*. rewrite /client. wp_apply wp_one_shot. iIntros (f1 f2) "[#Hf1 #Hf2]". wp_let. wp_smart_apply wp_par. - wp_smart_apply "Hf1". - wp_proj. wp_bind (f2 _)%E. iApply wp_wand; first by iExact "Hf2". iIntros (check) "Hcheck". wp_pures. iApply "Hcheck". - auto. Qed. End client. (** Put together all library functors. *) Definition clientΣ : gFunctors := #[ heapΣ; one_shotΣ; spawnΣ ]. (** This lemma implicitly shows that these functors are enough to meet all library assumptions. *) Lemma client_adequate σ : adequate NotStuck client σ (λ _ _, True). Proof. apply (heap_adequacy clientΣ)=> ?. iIntros "_". iApply client_safe. Qed. (* Since we check the output of the test files, this means our test suite will fail if we ever accidentally add an axiom to anything used by this proof. *) Print Assumptions client_adequate. iris-iris-4.2.0/tests/one_shot_once.ref000066400000000000000000000020771460620107300201160ustar00rootroot000000000000001 goal Σ : gFunctors heapGS0 : heapGS Σ one_shotG0 : one_shotG Σ N : namespace l : loc γ : gname Φ : val → iPropI Σ ============================ "HN" : inv N (one_shot_inv γ l) --------------------------------------□ "Hl" : l ↦ InjLV #() _ : own γ (Pending (1 / 2)) --------------------------------------∗ one_shot_inv γ l ∗ (⌜InjLV #() = InjLV #()⌝ ∨ ∃ n : Z, ⌜InjLV #() = InjRV #n⌝ ∗ own γ (Shot n)) 1 goal Σ : gFunctors heapGS0 : heapGS Σ one_shotG0 : one_shotG Σ N : namespace l : loc γ : gname Φ : val → iPropI Σ m, m' : Z ============================ "HN" : inv N (one_shot_inv γ l) "Hγ'" : own γ (Shot m) --------------------------------------□ "HΦ" : True -∗ Φ #() "Hl" : l ↦ InjRV #m' "Hγ" : own γ (Shot m') --------------------------------------∗ |={⊤ ∖ ↑N}=> ▷ one_shot_inv γ l ∗ WP let: "y'" := InjRV #m' in match: InjRV #m with InjL <> => #() | InjR <> => assert: InjRV #m = "y'" end {{ v, Φ v }} iris-iris-4.2.0/tests/one_shot_once.v000066400000000000000000000134151460620107300176050ustar00rootroot00000000000000From iris.algebra Require Import frac agree csum. From iris.proofmode Require Import tactics. From iris.program_logic Require Export weakestpre. From iris.heap_lang Require Export lang. From iris.heap_lang Require Import assert proofmode notation adequacy. From iris.heap_lang.lib Require Import par. From iris.prelude Require Import options. (** This is the introductory example from Ralf's PhD thesis. The difference to [one_shot] is that [set] asserts to be called only once. *) Unset Mangle Names. Definition one_shot_example : val := λ: <>, let: "x" := ref NONE in ( (* set *) (λ: "n", assert: CAS "x" NONE (SOME "n")), (* check *) (λ: <>, let: "y" := !"x" in λ: <>, let: "y'" := !"x" in match: "y" with NONE => #() | SOME <> => assert: "y" = "y'" end)). Definition one_shotR := csumR fracR (agreeR ZO). Definition Pending (q : Qp) : one_shotR := Cinl q. Definition Shot (n : Z) : one_shotR := Cinr (to_agree n). Class one_shotG Σ := { one_shot_inG : inG Σ one_shotR }. Local Existing Instance one_shot_inG. Definition one_shotΣ : gFunctors := #[GFunctor one_shotR]. Global Instance subG_one_shotΣ {Σ} : subG one_shotΣ Σ → one_shotG Σ. Proof. solve_inG. Qed. Section proof. Local Set Default Proof Using "Type*". Context `{!heapGS Σ, !one_shotG Σ}. Definition one_shot_inv (γ : gname) (l : loc) : iProp Σ := (l ↦ NONEV ∗ own γ (Pending (1/2)%Qp) ∨ ∃ n : Z, l ↦ SOMEV #n ∗ own γ (Shot n))%I. Local Hint Extern 0 (environments.envs_entails _ (one_shot_inv _ _)) => unfold one_shot_inv : core. Lemma pending_split γ q : own γ (Pending q) ⊣⊢ own γ (Pending (q/2)) ∗ own γ (Pending (q/2)). Proof. rewrite /Pending. rewrite -own_op -Cinl_op. rewrite frac_op Qp.div_2 //. Qed. Lemma pending_shoot γ n : own γ (Pending 1%Qp) ==∗ own γ (Shot n). Proof. iIntros "Hγ". iMod (own_update with "Hγ") as "$"; last done. by apply cmra_update_exclusive with (y:=Shot n). Qed. Lemma one_shot : {{{ True }}} one_shot_example #() {{{ (f1 f2 : val) (T : iProp Σ), RET (f1,f2); T ∗ (∀ n : Z, {{{ T }}} f1 #n {{{ RET #(); True }}}) ∗ {{{ True }}} f2 #() {{{ (g : val), RET g; {{{ True }}} g #() {{{ RET #(); True }}} }}} }}}. Proof. iIntros "%Φ _ HΦ /=". pose proof (nroot .@ "N") as N. wp_lam. wp_alloc l as "Hl". iMod (own_alloc (Pending 1%Qp)) as (γ) "Hγ"; first done. iDestruct (pending_split with "Hγ") as "[Hγ1 Hγ2]". iMod (inv_alloc N _ (one_shot_inv γ l) with "[Hl Hγ2]") as "#HN". { iNext. iLeft. by iFrame. } wp_pures. iModIntro. iApply ("HΦ" $! _ _ (own γ (Pending (1/2)%Qp))). iSplitL; first done. iSplit. - clear Φ. iIntros "%n !> %Φ Hγ1 HΦ". wp_pures. iApply wp_assert. wp_pures. wp_bind (CmpXchg _ _ _). iInv N as ">[[Hl Hγ2]|H]"; last iDestruct "H" as (m) "[Hl Hγ']". + iDestruct (pending_split with "[$Hγ1 $Hγ2]") as "Hγ". iMod (pending_shoot _ n with "Hγ") as "Hγ". wp_cmpxchg_suc. iModIntro. iSplitR "HΦ". * iNext; iRight; iExists n; by iFrame. * wp_pures. iSplitR; first done. by iApply "HΦ". + by iCombine "Hγ1 Hγ'" gives %?. - clear Φ. iIntros "!> %Φ _ HΦ /=". wp_lam. wp_bind (! _)%E. iInv N as ">Hγ". iAssert (∃ v, l ↦ v ∗ (⌜v = NONEV⌝ ∗ own γ (Pending (1/2)%Qp) ∨ ∃ 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γ]". + iExists NONEV. iFrame. eauto. + iExists (SOMEV #m). iFrame. eauto. } iDestruct "Hv" as (v) "[Hl Hv]". wp_load. 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. + Show. iSplit. * iLeft; by iSplitL "Hl". * eauto. + iSplit. * iRight; iExists m; by iSplitL "Hl". * eauto. } iSplitL "Hinv"; first by eauto. iModIntro. wp_pures. iApply "HΦ". clear Φ. iIntros "!> %Φ !> _ HΦ". wp_lam. wp_bind (! _)%E. iInv N as "Hinv". iDestruct "Hv" as "[%|Hv]"; last iDestruct "Hv" as (m) "[% Hγ']"; subst. + iDestruct "Hinv" as "[[Hl >Hγ]|H]"; last iDestruct "H" as (m') "[Hl Hγ]"; wp_load; iModIntro; (iSplitL "Hl Hγ"; first by eauto with iFrame); wp_pures; by iApply "HΦ". + iDestruct "Hinv" as "[[Hl >Hγ]|H]"; last iDestruct "H" as (m') "[Hl Hγ]". { by iCombine "Hγ Hγ'" gives %?. } wp_load. Show. iCombine "Hγ Hγ'" gives %?%to_agree_op_inv_L; subst. iModIntro. iSplitL "Hl Hγ"; first by eauto with iFrame. wp_pures. iApply wp_assert. wp_op. iSplitR; first by case_bool_decide. by iApply "HΦ". Qed. End proof. (* Have a client with a closed proof. *) Definition client : expr := let: "ff" := one_shot_example #() in (Fst "ff" #5 ||| let: "check" := Snd "ff" #() in "check" #()). Section client. Context `{!heapGS Σ, !one_shotG Σ, !spawnG Σ}. Lemma client_safe : ⊢ WP client {{ _, True }}. Proof using Type*. rewrite /client. wp_apply one_shot; first done. iIntros (f1 f2 T) "(HT & #Hf1 & #Hf2)". wp_let. wp_smart_apply (wp_par (λ _, True)%I (λ _, True)%I with "[HT]"). - wp_smart_apply ("Hf1" with "HT"). by eauto. - wp_proj. wp_bind (f2 _)%E. wp_apply "Hf2"; first done. iIntros (check) "Hcheck". wp_pures. iApply "Hcheck"; by auto. - auto. Qed. End client. (** Put together all library functors. *) Definition clientΣ : gFunctors := #[ heapΣ; one_shotΣ; spawnΣ ]. (** This lemma implicitly shows that these functors are enough to meet all library assumptions. *) Lemma client_adequate σ : adequate NotStuck client σ (λ _ _, True). Proof. apply (heap_adequacy clientΣ)=> ?. iIntros "_". iApply client_safe. Qed. iris-iris-4.2.0/tests/proofmode.ref000066400000000000000000000722351460620107300172710ustar00rootroot00000000000000"demo_0" : string 1 goal PROP : bi BiPersistentlyForall0 : BiPersistentlyForall PROP P, Q : PROP ============================ "H2" : ∀ x : nat, ⌜x = 0⌝ ∨ ⌜x = 1⌝ --------------------------------------□ "H" : □ (P ∨ Q) --------------------------------------∗ Q ∨ P 1 goal PROP : bi BiPersistentlyForall0 : BiPersistentlyForall PROP P, Q : PROP ============================ "H2" : ∀ x : nat, ⌜x = 0⌝ ∨ ⌜x = 1⌝ _ : P --------------------------------------□ Q ∨ P "test_iStopProof" : string 1 goal PROP : bi Q : PROP ============================ "H1" : emp --------------------------------------□ "H2" : Q --------------------------------------∗ Q 1 goal PROP : bi Q : PROP ============================ □ emp ∗ Q ⊢ Q "test_iDestruct_and_emp" : string 1 goal PROP : bi P, Q : PROP Persistent0 : Persistent P Persistent1 : Persistent Q ============================ _ : P _ : Q --------------------------------------□ (P ∗ Q) "test_iDestruct_spatial" : string 1 goal PROP : bi Q : PROP ============================ "HQ" : Q --------------------------------------∗ Q "test_iDestruct_spatial_affine" : string 1 goal PROP : bi Q : PROP Affine0 : Affine Q ============================ "HQ" : Q --------------------------------------∗ Q "test_iDestruct_exists_not_exists" : string The command has indeed failed with message: Tactic failure: iExistDestruct: cannot destruct P. "test_iDestruct_exists_intuitionistic" : string 1 goal PROP : bi P : PROP Φ : nat → PROP y : nat ============================ "H" : Φ y ∧ P --------------------------------------□ P "test_iDestruct_exists_anonymous" : string 1 goal PROP : bi P : PROP Φ : nat → PROP H : nat ============================ "HΦ" : ∃ x : nat, Φ x --------------------------------------∗ ∃ x : nat, Φ x "test_iDestruct_nameless_exist" : string 1 goal PROP : bi Φ : nat → PROP __unknown : nat ============================ "H" : Φ __unknown --------------------------------------∗ ∃ x : nat, Φ x "test_iIntros_nameless_forall" : string 1 goal PROP : bi Φ : nat → PROP __unknown : nat ============================ "H" : ∀ x : nat, Φ x --------------------------------------∗ Φ __unknown "test_iIntros_nameless_pure_forall" : string 1 goal PROP : bi BiPureForall0 : BiPureForall PROP φ : nat → Prop __unknown : nat ============================ "H" : ∀ x : nat, ⌜φ x⌝ --------------------------------------∗ ⌜φ __unknown⌝ "test_iIntros_forall_pure" : string 1 goal PROP : bi Ψ : nat → PROP x : nat ============================ --------------------------------------∗ Ψ x → Ψ x "test_iIntros_pure_names" : string 1 goal PROP : bi H : True P : PROP x, y : nat H0 : x = y ============================ --------------------------------------∗ P -∗ P The command has indeed failed with message: No applicable tactic. The command has indeed failed with message: Tactic failure: iElaborateSelPat: "HQ" not found. The command has indeed failed with message: Tactic failure: iElaborateSelPat: "HQ" not found. "test_iSpecialize_pure_error" : string The command has indeed failed with message: Tactic failure: iSpecialize: P not pure. "test_iSpecialize_pure_error" : string The command has indeed failed with message: Tactic failure: iSpecialize: cannot solve φ using done. "test_iSpecialize_done_error" : string The command has indeed failed with message: Tactic failure: iSpecialize: cannot solve P using done. The command has indeed failed with message: Tactic failure: iSpecialize: Q not persistent. "test_iSpecialize_impl_pure" : string 1 goal PROP : bi φ : Prop P, Q : PROP H : φ ============================ --------------------------------------∗ ⌜φ⌝ 1 goal PROP : bi φ : Prop P, Q : PROP H : φ ============================ "H1" : P --------------------------------------□ ⌜φ⌝ "test_iSpecialize_impl_pure_affine" : string 1 goal PROP : bi BiAffine0 : BiAffine PROP φ : Prop P, Q : PROP H : φ ============================ --------------------------------------∗ ⌜φ⌝ 1 goal PROP : bi BiAffine0 : BiAffine PROP φ : Prop P, Q : PROP H : φ ============================ "H1" : P --------------------------------------□ ⌜φ⌝ "test_iSpecialize_impl_pure" : string 1 goal PROP : bi φ : Prop P, Q : PROP H : φ ============================ --------------------------------------∗ ⌜φ⌝ 1 goal PROP : bi φ : Prop P, Q : PROP H : φ ============================ "H1" : P --------------------------------------□ ⌜φ⌝ "test_iSpecialize_impl_pure_affine" : string 1 goal PROP : bi BiAffine0 : BiAffine PROP φ : Prop P, Q : PROP H : φ ============================ --------------------------------------∗ ⌜φ⌝ 1 goal PROP : bi BiAffine0 : BiAffine PROP φ : Prop P, Q : PROP H : φ ============================ "H1" : P --------------------------------------□ ⌜φ⌝ "test_iAssert_intuitionistic" : string The command has indeed failed with message: Tactic failure: iSpecialize: (|==> P)%I not persistent. "test_iFrame_disjunction_4_evars" : string The command has indeed failed with message: Tactic failure: iFrame: cannot frame (Φ 0 1). "test_iFrame_conjunction_3" : string 1 goal PROP : bi P, Q : PROP Absorbing0 : Absorbing Q ============================ "HQ" : Q --------------------------------------∗ False "test_iFrame_exists_instantiate" : string 1 goal PROP : bi Φ, Ψ : nat → PROP P, Q : PROP ============================ "HP" : P "HΦ" : Φ 0 "HQ" : Q --------------------------------------∗ ∃ x : nat, Φ x ∗ P ∗ Q 1 goal PROP : bi Φ, Ψ : nat → PROP P, Q : PROP ============================ "HΦ" : Φ 0 "HQ" : Q --------------------------------------∗ ∃ x : nat, Φ x ∗ Q 1 goal PROP : bi Φ, Ψ : nat → PROP P, Q : PROP ============================ "HQ" : Q --------------------------------------∗ Q "test_wrong_instantiation" : string 1 goal PROP : bi Φ : nat → PROP ============================ --------------------------------------∗ ⌜1 = 0⌝ ∗ ⌜0 = 1⌝ "test_iFrame_no_instantiate_under_forall" : string 1 goal PROP : bi P : nat → PROP ============================ _ : P 0 --------------------------------------□ ∀ x : nat, ∃ a : nat, P a ∗ ⌜a = x⌝ "test_iFrame_no_instantiate_under_wand" : string 1 goal PROP : bi P : nat → PROP ============================ _ : P 0 --------------------------------------□ P 1 -∗ ∃ a : nat, P a ∗ ⌜a = 1⌝ "test_iFrame_no_instantiate_under_impl" : string 1 goal PROP : bi P : nat → PROP ============================ _ : P 0 --------------------------------------□ P 1 → ∃ a : nat, P a ∗ ⌜a = 1⌝ "test_iFrame_affinely_emp" : string 1 goal PROP : bi P : PROP ============================ "H" : P --------------------------------------□ ∃ _ : nat, emp "test_iFrame_affinely_True" : string 1 goal PROP : bi BiAffine0 : BiAffine PROP P : PROP ============================ "H" : P --------------------------------------□ ∃ _ : nat, True "test_iFrame_or_1" : string 1 goal PROP : bi P1, P2, P3 : PROP ============================ --------------------------------------∗ ▷ ∃ _ : nat, emp "test_iFrame_or_2" : string 1 goal PROP : bi P1, P2, P3 : PROP ============================ --------------------------------------∗ ▷ ∃ x : nat, emp ∧ ⌜x = 0⌝ ∨ emp "test_iFrame_or_3" : string 1 goal PROP : bi P1, P2, P3 : PROP ============================ --------------------------------------∗ ▷ ∃ x : nat, ⌜x = 0⌝ "test_iFrame_or_affine_1" : string 1 goal PROP : bi BiAffine0 : BiAffine PROP P1, P2, P3 : PROP ============================ --------------------------------------∗ ▷ ∃ _ : nat, True "test_iFrame_or_affine_2" : string 1 goal PROP : bi BiAffine0 : BiAffine PROP P1, P2, P3 : PROP ============================ --------------------------------------∗ ▷ ∃ _ : nat, True "test_iCombine_nested_no_gives" : string The command has indeed failed with message: Tactic failure: iCombine: cannot find 'gives' clause for hypotheses ["HP"; "HQ"]. The command has indeed failed with message: Tactic failure: iCombine: cannot find 'gives' clause for hypotheses ["HP"; "HQ"]. "test_iInduction_multiple_IHs" : string 1 goal PROP : bi l, t1 : tree Φ : tree → PROP ============================ "Hleaf" : Φ leaf "Hnode" : ∀ l0 r : tree, Φ l0 -∗ Φ r -∗ Φ (node l0 r) "IH" : Φ l "IH1" : Φ t1 --------------------------------------□ Φ (node l t1) The command has indeed failed with message: Tactic failure: iSpecialize: cannot instantiate (∀ _ : φ, P -∗ False)%I with P. The command has indeed failed with message: Tactic failure: iSpecialize: cannot instantiate (⌜φ⌝ → P -∗ False)%I with P. "test_iNext_plus_3" : string 1 goal PROP : bi P, Q : PROP n, m, k : nat ============================ --------------------------------------∗ ▷^(S n + S m) emp "test_specialize_nested_intuitionistic" : string 1 goal PROP : bi φ : Prop P, P2, Q, R1, R2 : PROP H : φ ============================ "HP" : P "HQ" : P -∗ Q --------------------------------------□ "HR" : R2 --------------------------------------∗ R2 "test_iSimpl_in" : string 1 goal PROP : bi x, y : nat ============================ "H" : ⌜S (S (S x)) = y⌝ --------------------------------------∗ ⌜S (S (S x)) = y⌝ 1 goal PROP : bi x, y, z : nat ============================ "H1" : ⌜S (S (S x)) = y⌝ "H2" : ⌜S y = z⌝ --------------------------------------∗ ⌜S (S (S x)) = y⌝ 1 goal PROP : bi x, y, z : nat ============================ "H1" : ⌜S (S (S x)) = y⌝ --------------------------------------□ "H2" : ⌜(1 + y)%nat = z⌝ --------------------------------------∗ ⌜S (S (S x)) = y⌝ "test_iSimpl_in4" : string The command has indeed failed with message: Tactic failure: iEval: %: unsupported selection pattern. "test_iRename" : string 1 goal PROP : bi P : PROP ============================ "X" : P --------------------------------------□ P "test_iFrame_later_1" : string 1 goal PROP : bi P, Q : PROP ============================ --------------------------------------∗ ▷ emp "test_iFrame_later_2" : string 1 goal PROP : bi P, Q : PROP ============================ --------------------------------------∗ ▷ emp The command has indeed failed with message: Tactic failure: iFrame: cannot frame Q. The command has indeed failed with message: No applicable tactic. The command has indeed failed with message: No applicable tactic. "test_and_sep_affine_bi" : string 1 goal PROP : bi BiAffine0 : BiAffine PROP P, Q : PROP ============================ _ : □ P _ : Q --------------------------------------∗ □ P "test_big_sepL_simpl" : string 1 goal PROP : bi x : nat l : list nat P : PROP ============================ "HP" : P _ : [∗ list] y ∈ l, ⌜y = y⌝ _ : [∗ list] y ∈ (x :: l), ⌜y = y⌝ --------------------------------------∗ P 1 goal PROP : bi x : nat l : list nat P : PROP ============================ "HP" : P _ : [∗ list] y ∈ l, ⌜y = y⌝ _ : ⌜x = x⌝ ∗ ([∗ list] y ∈ l, ⌜y = y⌝) --------------------------------------∗ P "test_big_sepL2_simpl" : string 1 goal PROP : bi x1, x2 : nat l1, l2 : list nat P : PROP ============================ "HP" : P _ : [∗ list] y1;y2 ∈ [];l2, ⌜y1 = y2⌝ _ : [∗ list] y1;y2 ∈ (x1 :: l1);((x2 :: l2) ++ l2), ⌜y1 = y2⌝ --------------------------------------∗ P ∨ ([∗ list] _;_ ∈ (x1 :: l1);(x2 :: l2), True) 1 goal PROP : bi x1, x2 : nat l1, l2 : list nat P : PROP ============================ "HP" : P _ : [∗ list] y1;y2 ∈ [];l2, ⌜y1 = y2⌝ _ : ⌜x1 = x2⌝ ∗ ([∗ list] y1;y2 ∈ l1;(l2 ++ l2), ⌜y1 = y2⌝) --------------------------------------∗ P ∨ True ∗ ([∗ list] _;_ ∈ l1;l2, True) "test_big_sepL2_iDestruct" : string 1 goal PROP : bi Φ : nat → nat → PROP x1, x2 : nat l1, l2 : list nat ============================ _ : Φ x1 x2 _ : [∗ list] y1;y2 ∈ l1;l2, Φ y1 y2 --------------------------------------∗ Φ x1 x2 "test_reducing_after_iDestruct" : string 1 goal PROP : bi ============================ "H" : □ True --------------------------------------∗ True "test_reducing_after_iApply" : string 1 goal PROP : bi ============================ "H" : emp --------------------------------------□ □ emp "test_reducing_after_iApply_late_evar" : string 1 goal PROP : bi ============================ "H" : emp --------------------------------------□ □ emp "test_wandM" : string 1 goal PROP : bi mP : option PROP Q, R : PROP ============================ "HPQ" : mP -∗? Q "HQR" : Q -∗ R "HP" : default emp mP --------------------------------------∗ R 1 goal PROP : bi mP : option PROP Q, R : PROP ============================ "HP" : default emp mP --------------------------------------∗ default emp mP "test_iApply_prettification3" : string 1 goal PROP : bi Ψ, Φ : nat → PROP HP : ∀ (f : nat → nat) (y : nat), TCEq f (λ x : nat, x + 10) → Ψ (f 1) -∗ Φ y ============================ "H" : Ψ 11 --------------------------------------∗ Ψ (1 + 10) 1 goal PROP : bi BiAffine0 : BiAffine PROP P, Q : PROP H : Laterable Q ============================ "HP" : ▷ P "HQ" : Q --------------------------------------∗ ▷ P ∗ Q "test_iRevert_pure" : string 1 goal PROP : bi φ : Prop P : PROP ============================ "H" : ⌜φ⌝ -∗ P --------------------------------------∗ ⌜φ⌝ -∗ P "test_iRevert_order_and_names" : string 1 goal PROP : bi ============================ --------------------------------------∗ ∀ P1 P2, P1 -∗ P2 -∗ P1 ∗ P2 "test_iRevert_pure_affine" : string 1 goal PROP : bi BiAffine0 : BiAffine PROP φ : Prop P : PROP ============================ "H" : ⌜φ⌝ -∗ P --------------------------------------∗ ⌜φ⌝ -∗ P "test_iFrame_not_add_emp_for_intuitionistically" : string 1 goal PROP : bi BiAffine0 : BiAffine PROP P : PROP ============================ "H" : P --------------------------------------□ ∃ _ : nat, True "test_iIntros_auto_name_used_later" : string The command has indeed failed with message: x is already used. "elim_mod_accessor" : string 1 goal PROP : bi BiFUpd0 : BiFUpd PROP X : Type E1, E2 : coPset.coPset α, β : X → PROP γ : X → option PROP ============================ "Hacc" : ∃ x : X, α x ∗ (β x ={E2,E1}=∗ default emp (γ x)) --------------------------------------∗ |={E2,E1}=> True "print_long_line_1" : string 1 goal PROP : bi 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 goal PROP : bi 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 goal PROP : bi 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 goal PROP : bi 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 goal PROP : bi BiFUpd0 : BiFUpd PROP PPPPPPPPPPPPPPPPP, QQQQQQQQQQQQQQQQQQ : PROP ============================ --------------------------------------∗ PPPPPPPPPPPPPPPPP → QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ "long_impl_nested" : string 1 goal PROP : bi BiFUpd0 : BiFUpd PROP PPPPPPPPPPPPPPPPP, QQQQQQQQQQQQQQQQQQ : PROP ============================ --------------------------------------∗ PPPPPPPPPPPPPPPPP → QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ → QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ "long_wand" : string 1 goal PROP : bi BiFUpd0 : BiFUpd PROP PPPPPPPPPPPPPPPPP, QQQQQQQQQQQQQQQQQQ : PROP ============================ --------------------------------------∗ PPPPPPPPPPPPPPPPP -∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ "long_wand_nested" : string 1 goal PROP : bi BiFUpd0 : BiFUpd PROP PPPPPPPPPPPPPPPPP, QQQQQQQQQQQQQQQQQQ : PROP ============================ --------------------------------------∗ PPPPPPPPPPPPPPPPP -∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ -∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ "long_fupd" : string 1 goal PROP : bi BiFUpd0 : BiFUpd PROP E : coPset.coPset PPPPPPPPPPPPPPPPP, QQQQQQQQQQQQQQQQQQ : PROP ============================ --------------------------------------∗ PPPPPPPPPPPPPPPPP ={E}=∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ "long_fupd_nested" : string 1 goal PROP : bi BiFUpd0 : BiFUpd PROP E1, E2 : coPset.coPset PPPPPPPPPPPPPPPPP, QQQQQQQQQQQQQQQQQQ : PROP ============================ --------------------------------------∗ PPPPPPPPPPPPPPPPP ={E1,E2}=∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ={E1,E2}=∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ "iStopProof_not_proofmode" : string The command has indeed failed with message: Tactic failure: iStopProof: proofmode not started. "iAlways_spatial_non_empty" : string The command has indeed failed with message: Tactic failure: iModIntro: spatial context is non-empty. "iDestruct_bad_name" : string The command has indeed failed with message: Tactic failure: iRename: "HQ" not found. "iIntros_dup_name" : string The command has indeed failed with message: Tactic failure: iIntro: "HP" not fresh. The command has indeed failed with message: x is already used. "iIntros_pure_not_forall" : string The command has indeed failed with message: Tactic failure: iIntro: cannot turn (P -∗ Q)%I into a universal quantifier. "iSplitL_one_of_many" : string The command has indeed failed with message: Tactic failure: iSplitL: hypotheses ["HPx"] not found. The command has indeed failed with message: Tactic failure: iSplitL: hypotheses ["HPx"] not found. "iSplitR_one_of_many" : string The command has indeed failed with message: Tactic failure: iSplitR: hypotheses ["HPx"] not found. The command has indeed failed with message: Tactic failure: iSplitR: hypotheses ["HPx"] not found. "iSplitL_non_splittable" : string The command has indeed failed with message: Tactic failure: iSplitL: P not a separating conjunction. "iSplitR_non_splittable" : string The command has indeed failed with message: Tactic failure: iSplitR: P not a separating conjunction. "iCombine_fail" : string The command has indeed failed with message: Tactic failure: iCombine: hypotheses ["HP3"] not found. "iSpecialize_bad_name1_fail" : string The command has indeed failed with message: Tactic failure: iSpecialize: "H" not found. "iSpecialize_bad_name2_fail" : string The command has indeed failed with message: Tactic failure: iSpecialize: "H" not found. "iSpecialize_autoframe_fail" : string The command has indeed failed with message: Tactic failure: iSpecialize: premise P cannot be solved by framing. The command has indeed failed with message: Tactic failure: iSpecialize: premise P cannot be solved by framing. "iSpecialize_autoframe_fail2" : string The command has indeed failed with message: Tactic failure: iSpecialize: premise Q cannot be solved by framing. The command has indeed failed with message: Tactic failure: iSpecialize: premise Q cannot be solved by framing. "iExact_fail" : string The command has indeed failed with message: Tactic failure: iExact: "HQ" not found. The command has indeed failed with message: Tactic failure: iExact: "HQ" : Q does not match goal. The command has indeed failed with message: Tactic failure: iExact: remaining hypotheses not affine and the goal not absorbing. "iClear_fail" : string The command has indeed failed with message: Tactic failure: iElaborateSelPat: "HP" not found. The command has indeed failed with message: Tactic failure: iClear: "HP" : P not affine and the goal not absorbing. "iSpecializeArgs_fail" : string The command has indeed failed with message: In environment PROP : bi 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: Tactic failure: iStartProof: not a BI assertion: (0 = 0). "iPoseProof_fail" : string The command has indeed failed with message: Tactic failure: iPoseProof: (0 = 0) not a BI assertion. The command has indeed failed with message: Tactic failure: iRename: "H" not fresh. "iPoseProof_not_found_fail" : string The command has indeed failed with message: Tactic failure: iPoseProof: "Hx" not found. "iPoseProof_not_found_fail2" : string The command has indeed failed with message: Tactic failure: iSpecialize: hypotheses ["HQ"] not found. "iPoseProofCoreHyp_not_found_fail" : string The command has indeed failed with message: Tactic failure: iPoseProof: "Hx" not found. "iPoseProofCoreHyp_not_fresh_fail" : string The command has indeed failed with message: Tactic failure: iPoseProof: "H1" not fresh. "iRevert_fail" : string The command has indeed failed with message: Tactic failure: iElaborateSelPat: "H" not found. "iDestruct_fail" : string The command has indeed failed with message: Tactic failure: iDestruct: "[{HP}]" has just a single conjunct. The command has indeed failed with message: Tactic failure: iDestruct: "// H" is not supported due to IDone. The command has indeed failed with message: Tactic failure: iDestruct: "HP //" should contain exactly one proper introduction pattern. The command has indeed failed with message: Tactic failure: iDestruct: "[HP HQ HR]" has too many conjuncts. The command has indeed failed with message: Tactic failure: iDestruct: "[HP|HQ|HR]" has too many disjuncts. The command has indeed failed with message: Tactic failure: iDestruct: "[HP]" has just a single conjunct. The command has indeed failed with message: Tactic failure: iDestruct: in "[HP HQ|HR]" a disjunct has multiple patterns. "iOrDestruct_fail" : string The command has indeed failed with message: Tactic failure: iOrDestruct: "H'" or "H2" not fresh. The command has indeed failed with message: Tactic failure: iOrDestruct: "H1" or "H'" not fresh. "iApply_fail" : string The command has indeed failed with message: Tactic failure: iApply: cannot apply P. "iApply_fail_not_affine_1" : string The command has indeed failed with message: Tactic failure: iApply: remaining hypotheses not affine and the goal not absorbing. "iIntros_fail_nonempty_spatial" : string The command has indeed failed with message: Tactic failure: iIntro: introducing non-persistent "HP" : P into non-empty spatial context. "iIntros_fail_not_fresh" : string The command has indeed failed with message: Tactic failure: iIntro: "HP" not fresh. "iIntros_fail_nothing_to_introduce" : string The command has indeed failed with message: Tactic failure: iIntro: could not introduce "HQ" , goal is not a wand or implication. "iApply_fail_not_affine_2" : string The command has indeed failed with message: Tactic failure: iApply: remaining hypotheses not affine and the goal not absorbing. "iAssumption_fail_not_affine_1" : string The command has indeed failed with message: Tactic failure: iAssumption: remaining hypotheses not affine and the goal not absorbing. "iAssumption_fail_not_affine_2" : string The command has indeed failed with message: Tactic failure: iAssumption: remaining hypotheses not affine and the goal not absorbing. "iRevert_wrong_var" : string The command has indeed failed with message: Tactic failure: iRevert: k1 not in scope. The command has indeed failed with message: Tactic failure: iRevert: k1 not in scope. "iRevert_dup_var" : string The command has indeed failed with message: Tactic failure: iRevert: k not in scope. "iRevert_dep_var_coq" : string The command has indeed failed with message: k is used in hypothesis Hk. "iRevert_dep_var" : string The command has indeed failed with message: Tactic failure: iRevert: k is used in hypothesis "Hk". "iLöb_no_BiLöb" : string The command has indeed failed with message: Tactic failure: iLöb: no 'BiLöb' instance found. "iMod_mask_mismatch" : string The command has indeed failed with message: Tactic failure: "Goal and eliminated modality must have the same mask. Use [iMod (fupd_mask_subseteq E2)] to adjust the mask of your goal to [E2]". The command has indeed failed with message: Tactic failure: "Goal and eliminated modality must have the same mask. Use [iMod (fupd_mask_subseteq E2)] to adjust the mask of your goal to [E2]". "iModIntro_mask_mismatch" : string The command has indeed failed with message: Tactic failure: "Only non-mask-changing update modalities can be introduced directly. Use [iApply fupd_mask_intro] to introduce mask-changing update modalities". The command has indeed failed with message: Tactic failure: "Only non-mask-changing update modalities can be introduced directly. Use [iApply fupd_mask_intro] to introduce mask-changing update modalities". "iRevert_wrong_sel_pat" : string The command has indeed failed with message: Tactic failure: sel_pat.parse: the term n is expected to be a selection pattern (usually a string), but has unexpected type nat. "iInduction_wrong_sel_pat" : string The command has indeed failed with message: Tactic failure: sel_pat.parse: the term m is expected to be a selection pattern (usually a string), but has unexpected type nat. "test_iIntros_let_entails_fail" : string The command has indeed failed with message: Tactic failure: iStartProof: goal is a `let`, use `simpl`, `intros x`, `iIntros (x)`, or `iIntros "%x". "test_iIntros_let_wand_fail" : string The command has indeed failed with message: Tactic failure: iStartProof: goal is a `let`, use `simpl`, `intros x`, `iIntros (x)`, or `iIntros "%x". "test_pure_name" : string 1 goal PROP : bi P : PROP φ1, φ2 : Prop Himpl : φ1 → φ2 HP2 : φ1 ============================ "HP" : P --------------------------------------∗ P ∗ ⌜φ2⌝ "test_not_fresh" : string The command has indeed failed with message: H is already used. "test_iRename_select1" : string The command has indeed failed with message: No matching clauses for match. "test_iDestruct_select2" : string The command has indeed failed with message: Tactic failure: iPure: (φ n) not pure. "test_iDestruct_select_no_backtracking" : string The command has indeed failed with message: Tactic failure: iIntuitionistic: Q not persistent. "test_iDestruct_intuitionistic_not_fresh" : string The command has indeed failed with message: Tactic failure: iIntuitionistic: "H" not fresh. "test_iDestruct_spatial_not_fresh" : string The command has indeed failed with message: Tactic failure: iSpatial: "H" not fresh. "test_iInduction_Forall" : string 1 goal PROP : bi P : ntree → PROP l : list ntree ============================ "H" : ∀ l0 : list ntree, (∀ x : ntree, ⌜x ∈ l0⌝ → P x) -∗ P (Tree l0) "IH" : [∗ list] x ∈ l, □ P x --------------------------------------□ P (Tree l) "test_iInduction_Forall_fail" : string The command has indeed failed with message: Tactic failure: iInduction: cannot import IH (my_Forall (λ t : ntree, "H" : ∀ l : list ntree, ([∗ list] x ∈ l, P x) -∗ P (Tree l) --------------------------------------□ P t) l) into proof mode context (IntoIH instance missing). iris-iris-4.2.0/tests/proofmode.v000066400000000000000000002203261460620107300167560ustar00rootroot00000000000000From iris.algebra Require Import gmap. From iris.bi Require Import laterable. From iris.proofmode Require Import tactics intro_patterns. From iris.prelude Require Import options. Unset Mangle Names. Section tests. Context {PROP : bi}. Implicit Types P Q R : PROP. Lemma test_eauto_iSplit_emp_wand_iff P : emp ⊢ P ∗-∗ P. Proof. eauto 6. Qed. Lemma test_eauto_iSplit_wand_iff P : ⊢ P ∗-∗ P. Proof. eauto. Qed. (** We get the [⊢] automatically from the notation in [stdpp_scope]. *) Lemma test_eauto_iSplit_wand_iff_std_scope P : P ∗-∗ P. Proof. eauto. Qed. Fixpoint test_fixpoint (n : nat) {struct n} : True → emp ⊢@{PROP} ⌜ (n + 0)%nat = n ⌝. Proof. case: n => [|n] /=; first (iIntros (_) "_ !%"; reflexivity). iIntros (_) "_". by iDestruct (test_fixpoint with "[//]") as %->. Qed. Check "demo_0". Lemma demo_0 `{!BiPersistentlyForall PROP} 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. 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". (* also simplifies the [∧ False] and [∨ False] *) (* split takes a list of hypotheses just for the LHS *) iSplitL "H3". - by iFrame "H3". - iSplitL "HQ"; first iAssumption. by iSplitL "H1". Qed. Lemma test_pure_space_separated P1 : ⌜True⌝ ∗ P1 -∗ P1. Proof. (* [% H] should be parsed as two separate patterns and not the pure name [H] *) iIntros "[% H] //". 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. Check "test_iStopProof". Lemma test_iStopProof Q : emp -∗ Q -∗ Q. Proof. iIntros "#H1 H2". Show. iStopProof. Show. by rewrite bi.sep_elim_r. Qed. Lemma test_iRewrite `{!BiInternalEq PROP} {A : ofe} (x y : A) P : □ (∀ z, P -∗ (z ≡ y)) -∗ (P -∗ P ∧ (x,x) ≡ (y,x)). Proof. iIntros "#H1 H2". iRewrite (internal_eq_sym x x with "[# //]"). iRewrite -("H1" $! _ with "[- //]"). auto. Qed. Lemma test_iRewrite_dom `{!BiInternalEq PROP} {A : ofe} (m1 m2 : gmap nat A) : m1 ≡ m2 ⊢@{PROP} ⌜ dom m1 = dom m2 ⌝. Proof. iIntros "H". by iRewrite "H". Qed. Check "test_iDestruct_and_emp". Lemma test_iDestruct_and_emp P Q `{!Persistent P, !Persistent Q} : P ∧ emp -∗ emp ∧ Q -∗ (P ∗ Q). Proof. iIntros "[#? _] [_ #?]". Show. auto. Qed. Lemma test_iIntros_persistent P Q `{!Persistent Q} : ⊢ (P → Q → P ∧ Q). Proof. iIntros "H1 #H2". by iFrame "∗#". Qed. Lemma test_iDestruct_intuitionistic_1 P Q `{!Persistent P}: Q ∗ □ (Q -∗ P) -∗ P ∗ Q. Proof. iIntros "[HQ #HQP]". iDestruct ("HQP" with "HQ") as "#HP". by iFrame. Qed. Lemma test_iDestruct_intuitionistic_2 P Q `{!Persistent P, !Affine P}: Q ∗ (Q -∗ P) -∗ P. Proof. iIntros "[HQ HQP]". iDestruct ("HQP" with "HQ") as "#HP". done. Qed. Lemma test_iDestruct_specialize_wand P Q : Q -∗ Q -∗ □ (Q -∗ P) -∗ P ∗ P. Proof. iIntros "HQ1 HQ2 #HQP". (* [iDestruct] does not consume "HQP" because a wand is instantiated *) iDestruct ("HQP" with "HQ1") as "HP1". iDestruct ("HQP" with "HQ2") as "HP2". iFrame. Qed. Lemma test_iPoseProof_specialize_wand P Q : Q -∗ Q -∗ □ (Q -∗ P) -∗ P ∗ P. Proof. iIntros "HQ1 HQ2 #HQP". (* [iPoseProof] does not consume "HQP" because a wand is instantiated *) iPoseProof ("HQP" with "HQ1") as "HP1". iPoseProof ("HQP" with "HQ2") as "HP2". iFrame. Qed. Lemma test_iDestruct_pose_forall (Φ : nat → PROP) : □ (∀ x, Φ x) -∗ Φ 0 ∗ Φ 1. Proof. iIntros "#H". (* [iDestruct] does not consume "H" because quantifiers are instantiated *) iDestruct ("H" $! 0) as "$". iDestruct ("H" $! 1) as "$". Qed. Lemma test_iDestruct_or P Q : □ (P ∨ Q) -∗ Q ∨ P. Proof. iIntros "#H". (* [iDestruct] consumes "H" because no quantifiers/wands are instantiated *) iDestruct "H" as "[H|H]". - by iRight. - by iLeft. Qed. Lemma test_iPoseProof_or P Q : □ (P ∨ Q) -∗ (Q ∨ P) ∗ (P ∨ Q). Proof. iIntros "#H". (* [iPoseProof] does not consume "H" despite that no quantifiers/wands are instantiated. This makes it different from [iDestruct]. *) iPoseProof "H" as "[HP|HQ]". - iFrame "H". by iRight. - iFrame "H". by iLeft. Qed. Lemma test_iDestruct_intuitionistic_affine_bi `{!BiAffine PROP} P Q `{!Persistent P}: Q ∗ (Q -∗ P) -∗ P ∗ Q. Proof. iIntros "[HQ HQP]". iDestruct ("HQP" with "HQ") as "#HP". by iFrame. Qed. Check "test_iDestruct_spatial". Lemma test_iDestruct_spatial Q : □ Q -∗ Q. Proof. iIntros "#HQ". iDestruct "HQ" as "-#HQ". Show. done. Qed. Check "test_iDestruct_spatial_affine". Lemma test_iDestruct_spatial_affine Q `{!Affine Q} : □ Q -∗ Q. Proof. iIntros "#-#HQ". (* Since [Q] is affine, it should not add an modality *) Show. done. Qed. Lemma test_iDestruct_spatial_noop Q : Q -∗ Q. Proof. iIntros "-#HQ". done. Qed. Lemma test_iDestruct_exists (Φ: nat → PROP) : (∃ y, Φ y) -∗ ∃ n, Φ n. Proof. iIntros "H". iDestruct "H" as (y) "H". by iExists y. Qed. Lemma test_iDestruct_exists_automatic (Φ: nat → PROP) : (∃ y, Φ y) -∗ ∃ n, Φ n. Proof. iIntros "H". iDestruct "H" as (?) "H". (* the automatic name should by [y] *) by iExists y. Qed. Lemma test_iDestruct_exists_automatic_multiple (Φ: nat → PROP) : (∃ y n baz, Φ (y+n+baz)) -∗ ∃ n, Φ n. Proof. iDestruct 1 as (???) "H". by iExists (y+n+baz). Qed. Lemma test_iDestruct_exists_freshen (y:nat) (Φ: nat → PROP) : (∃ y, Φ y) -∗ ∃ n, Φ n. Proof. iIntros "H". iDestruct "H" as (?) "H". (* the automatic name is the freshened form of [y] *) by iExists y0. Qed. Check "test_iDestruct_exists_not_exists". Lemma test_iDestruct_exists_not_exists P : P -∗ P. Proof. Fail iDestruct 1 as (?) "H". Abort. Lemma test_iDestruct_exists_explicit_name (Φ: nat → PROP) : (∃ y, Φ y) -∗ ∃ n, Φ n. Proof. (* give an explicit name that isn't the binder name *) iDestruct 1 as (foo) "?". by iExists foo. Qed. Lemma test_iDestruct_exists_pure (Φ: nat → Prop) : ⌜∃ y, Φ y⌝ ⊢@{PROP} ∃ n, ⌜Φ n⌝. Proof. iDestruct 1 as (?) "H". by iExists y. Qed. Lemma test_iDestruct_exists_and_pure (H: True) P : ⌜False⌝ ∧ P -∗ False. Proof. (* this automatic name uses [fresh H] as a sensible default (it's a hypothesis in [Prop] and the user cannot supply a name in their code) *) iDestruct 1 as (?) "H". contradict H0. Qed. Check "test_iDestruct_exists_intuitionistic". Lemma test_iDestruct_exists_intuitionistic P (Φ: nat → PROP) : □ (∃ y, Φ y ∧ P) -∗ P. Proof. iDestruct 1 as (?) "#H". Show. iDestruct "H" as "[_ $]". Qed. Lemma test_iDestruct_exists_freshen_local_name (Φ: nat → PROP) : let y := 0 in □ (∃ y, Φ y) -∗ ∃ n, Φ (y+n). Proof. iIntros (y) "#H". iDestruct "H" as (?) "H". iExists y0; auto. Qed. (* regression test for #337 *) Check "test_iDestruct_exists_anonymous". Lemma test_iDestruct_exists_anonymous P Φ : (∃ _:nat, P) ∗ (∃ x:nat, Φ x) -∗ P ∗ ∃ x, Φ x. Proof. iIntros "[HP HΦ]". (* this should not use [x] as the default name for the unnamed binder *) iDestruct "HP" as (?) "$". Show. iDestruct "HΦ" as (x) "HΦ". by iExists x. Qed. Definition an_exists P : PROP := (∃ (an_exists_name:nat), ▷^an_exists_name P)%I. (* should use the name from within [an_exists] *) Lemma test_iDestruct_exists_automatic_def P : an_exists P -∗ ∃ k, ▷^k P. Proof. iDestruct 1 as (?) "H". by iExists an_exists_name. Qed. (* use an Iris intro pattern [% H] rather than (?) to indicate iExistDestruct *) Lemma test_exists_intro_pattern_anonymous P (Φ: nat → PROP) : P ∗ (∃ y:nat, Φ y) -∗ ∃ x, P ∗ Φ x. Proof. iIntros "[HP1 [% HP2]]". iExists y. iFrame "HP1 HP2". Qed. Lemma test_iIntros_pure (ψ φ : Prop) P : ψ → ⊢ ⌜ φ ⌝ → P → ⌜ φ ∧ ψ ⌝ ∧ P. Proof. iIntros (??) "H". auto. Qed. (** The following tests check that [AsIdentName Φ ?name] works for the case that [Φ] is not a lambda, but a variable. It should use name [__unknown]. *) Check "test_iDestruct_nameless_exist". Lemma test_iDestruct_nameless_exist (Φ : nat → PROP) : bi_exist Φ ⊢@{PROP} ∃ x, Φ x. Proof. iDestruct 1 as (?) "H". Show. auto. Qed. Check "test_iIntros_nameless_forall". Lemma test_iIntros_nameless_forall (Φ : nat → PROP) : (∀ x, Φ x) ⊢@{PROP} bi_forall Φ. Proof. iIntros "H" (?). Show. done. Qed. Check "test_iIntros_nameless_pure_forall". Lemma test_iIntros_nameless_pure_forall `{!BiPureForall PROP} (φ : nat → Prop) : (∀ x, ⌜ φ x ⌝) ⊢@{PROP} ⌜ ∀ x, φ x ⌝. Proof. iIntros "H" (?). Show. done. Qed. Check "test_iIntros_forall_pure". Lemma test_iIntros_forall_pure (Ψ: nat → PROP) : ⊢ ∀ x : nat, Ψ x → Ψ x. Proof. iIntros "%". (* should be a trivial implication now *) Show. auto. Qed. Lemma test_iIntros_pure_not `{!BiPureForall PROP} : ⊢@{PROP} ⌜ ¬False ⌝. Proof. by iIntros (?). Qed. Lemma test_fast_iIntros `{!BiInternalEq PROP} P Q : ⊢ ∀ x y z : nat, ⌜x = plus 0 x⌝ → ⌜y = 0⌝ → ⌜z = 0⌝ → P → □ Q → foo (x ≡ x). 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_iIntros_automatic_name (Φ: nat → PROP) : ∀ y, Φ y -∗ ∃ x, Φ x. Proof. iIntros (?) "H". by iExists y. Qed. Lemma test_iIntros_automatic_name_proofmode_intro (Φ: nat → PROP) : ∀ y, Φ y -∗ ∃ x, Φ x. Proof. iIntros "% H". by iExists y. Qed. (* even an object-level forall should get the right name *) Lemma test_iIntros_object_forall P : P -∗ ∀ (y:unit), P. Proof. iIntros "H". iIntros (?). destruct y. iAssumption. Qed. Lemma test_iIntros_object_proofmode_intro (Φ: nat → PROP) : ⊢ ∀ y, Φ y -∗ ∃ x, Φ x. Proof. iIntros "% H". by iExists y. Qed. Check "test_iIntros_pure_names". Lemma test_iIntros_pure_names (H:True) P : ∀ x y : nat, ⊢ ⌜ x = y ⌝ → P -∗ P. Proof. iIntros (???). (* the pure hypothesis should get a sensible [H0] as its name *) Show. auto. Qed. Definition tc_opaque_test : PROP := tc_opaque (∀ x : nat, ⌜ x = x ⌝)%I. Lemma test_iIntros_tc_opaque : ⊢ tc_opaque_test. Proof. by iIntros (x). Qed. Definition tc_opaque_test_sep : PROP := tc_opaque (emp ∗ emp)%I. Lemma test_iDestruct_tc_opaque_sep : tc_opaque_test_sep -∗ tc_opaque_test_sep. Proof. iIntros "[H1 H2]". by iSplitL. Qed. Lemma test_iApply_evar P Q R : (∀ Q, Q -∗ P) -∗ R -∗ P. Proof. iIntros "H1 H2". iApply "H1". iExact "H2". Qed. Lemma test_iApply_1 (P Q : PROP) : (▷ P -∗ Q) -∗ P -∗ Q. Proof. iIntros "H HP". iApply ("H" with "HP"). Qed. Lemma test_iApply_2 `{!BiAffine PROP} (P Q : PROP) : (▷ P → Q) -∗ P -∗ Q. Proof. iIntros "H HP". iApply ("H" with "HP"). Qed. Lemma test_iApply_3 `{!BiAffine PROP} (P Q : PROP) : (P → Q) -∗ P -∗ Q. Proof. iIntros "H HP". iApply ("H" with "HP"). 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_persistent_auto_frame P Q : Persistent P → P ∗ (P -∗ Q) ⊢ P ∗ Q. Proof. iIntros "% [? H]". iSpecialize ("H" with "[# $]"). iFrame. Qed. Lemma test_iSpecialize_pure (φ : Prop) Q R : φ → (⌜φ⌝ -∗ Q) → ⊢ Q. Proof. iIntros (HP HPQ). iDestruct (HPQ $! HP) as "?". done. Qed. Lemma test_iSpecialize_pure_done (φ: Prop) Q : φ → (⌜φ⌝ -∗ Q) ⊢ Q. Proof. iIntros (HP) "HQ". iApply ("HQ" with "[% //]"). Qed. Check "test_iSpecialize_pure_error". Lemma test_iSpecialize_not_pure_error P Q : (P -∗ Q) ⊢ Q. Proof. iIntros "HQ". Fail iSpecialize ("HQ" with "[%]"). Abort. Check "test_iSpecialize_pure_error". Lemma test_iSpecialize_pure_done_error (φ: Prop) Q : (⌜φ⌝ -∗ Q) ⊢ Q. Proof. iIntros "HQ". Fail iSpecialize ("HQ" with "[% //]"). Abort. Check "test_iSpecialize_done_error". Lemma test_iSpecialize_done_error P Q : (P -∗ Q) ⊢ Q. Proof. iIntros "HQ". Fail iSpecialize ("HQ" with "[//]"). Abort. Lemma test_iSpecialize_Coq_entailment P Q R : (⊢ P) → (P -∗ Q) → (⊢ Q). Proof. iIntros (HP HPQ). iDestruct (HPQ $! HP) as "?". done. Qed. Lemma test_iSpecialize_intuitionistic P Q R : □ P -∗ □ (P -∗ P -∗ P -∗ P -∗ □ P -∗ P -∗ Q) -∗ R -∗ R ∗ □ (P ∗ Q). Proof. iIntros "#HP #H HR". (* Test that [H] remains in the intuitionistic context *) iSpecialize ("H" with "HP"). iSpecialize ("H" with "[HP]"); first done. iSpecialize ("H" with "[]"); first done. iSpecialize ("H" with "[-HR]"); first done. iSpecialize ("H" with "[#]"); first done. iFrame "HR". iSpecialize ("H" with "[-]"); first done. by iFrame "#". Qed. Lemma test_iSpecialize_intuitionistic_2 P Q R : □ P -∗ □ (P -∗ P -∗ P -∗ P -∗ □ P -∗ P -∗ Q) -∗ R -∗ R ∗ □ (P ∗ Q). Proof. iIntros "#HP #H HR". (* Test that [H] remains in the intuitionistic context *) iSpecialize ("H" with "HP") as #. iSpecialize ("H" with "[HP]") as #; first done. iSpecialize ("H" with "[]") as #; first done. iSpecialize ("H" with "[-HR]") as #; first done. iSpecialize ("H" with "[#]") as #; first done. iFrame "HR". iSpecialize ("H" with "[-]") as #; first done. by iFrame "#". Qed. Lemma test_iSpecialize_intuitionistic_3 P Q R : P -∗ □ (P -∗ Q) -∗ □ (P -∗ Q) -∗ □ (Q -∗ R) -∗ P ∗ □ (Q ∗ R). Proof. iIntros "HP #H1 #H2 #H3". (* Should fail, [Q] is not persistent *) Fail iSpecialize ("H1" with "HP") as #. (* Should succeed, [ Q] is persistent *) iSpecialize ("H2" with "HP") as #. (* Should succeed, despite [R] not being persistent, no spatial premises are needed to prove [Q] *) iSpecialize ("H3" with "H2") as #. by iFrame "#". Qed. Check "test_iSpecialize_impl_pure". Lemma test_iSpecialize_impl_pure (φ : Prop) P Q : φ → □ (⌜φ⌝ → P) -∗ (⌜φ⌝ → Q) -∗ P ∗ Q. Proof. iIntros (?) "#H1 H2". (* Adds an affine modality *) iSpecialize ("H1" with "[]"). { Show. done. } iSpecialize ("H2" with "[]"). { Show. done. } Restart. Proof. iIntros (?) "#H1 H2". (* Solving it directly as a pure goal also works. *) iSpecialize ("H1" with "[% //]"). iSpecialize ("H2" with "[% //]"). by iFrame. Abort. Check "test_iSpecialize_impl_pure_affine". Lemma test_iSpecialize_impl_pure_affine `{!BiAffine PROP} (φ : Prop) P Q : φ → □ (⌜φ⌝ → P) -∗ (⌜φ⌝ → Q) -∗ P ∗ Q. Proof. iIntros (?) "#H1 H2". (* Does not add an affine modality *) iSpecialize ("H1" with "[]"). { Show. done. } iSpecialize ("H2" with "[]"). { Show. done. } Restart. Proof. iIntros (?) "#H1 H2". (* Solving it directly as a pure goal also works. *) iSpecialize ("H1" with "[% //]"). iSpecialize ("H2" with "[% //]"). by iFrame. Abort. Check "test_iSpecialize_impl_pure". Lemma test_iSpecialize_forall_pure (φ : Prop) P Q : φ → □ (∀ _ : φ, P) -∗ (∀ _ : φ, Q) -∗ P ∗ Q. Proof. iIntros (?) "#H1 H2". (* Adds an affine modality *) iSpecialize ("H1" with "[]"). { Show. done. } iSpecialize ("H2" with "[]"). { Show. done. } Restart. Proof. iIntros (?) "#H1 H2". (* Solving it directly as a pure goal also works. *) iSpecialize ("H1" with "[% //]"). iSpecialize ("H2" with "[% //]"). by iFrame. Abort. Check "test_iSpecialize_impl_pure_affine". Lemma test_iSpecialize_forall_pure_affine `{!BiAffine PROP} (φ : Prop) P Q : φ → □ (∀ _ : φ, P) -∗ (∀ _ : φ, Q) -∗ P ∗ Q. Proof. iIntros (?) "#H1 H2". (* Does not add an affine modality *) iSpecialize ("H1" with "[]"). { Show. done. } iSpecialize ("H2" with "[]"). { Show. done. } Restart. Proof. iIntros (?) "#H1 H2". (* Solving it directly as a pure goal also works. *) iSpecialize ("H1" with "[% //]"). iSpecialize ("H2" with "[% //]"). by iFrame. Abort. Check "test_iAssert_intuitionistic". Lemma test_iAssert_intuitionistic `{!BiBUpd PROP} P : □ P -∗ □ |==> P. Proof. iIntros "#HP". (* Test that [HPupd1] ends up in the intuitionistic context *) iAssert (|==> P)%I with "[]" as "#HPupd1"; first done. (* This should not work, [|==> P] is not persistent. *) Fail iAssert (|==> P)%I with "[#]" as "#HPupd2"; first done. done. Qed. Lemma test_iSpecialize_evar P : (∀ R, R -∗ R) -∗ P -∗ P. Proof. iIntros "H HP". iApply ("H" with "[HP]"). done. Qed. Lemma test_iPure_intro_emp R `{!Affine R} : R -∗ emp. Proof. iIntros "HR". by iPureIntro. 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_iPure_intro (φ : nat → Prop) P Q R `{!Affine P, !Persistent Q, !Affine R} : φ 0 → P -∗ Q → R -∗ ∃ x : nat, ⌜ φ x ⌝ ∧ ⌜ φ x ⌝. Proof. iIntros (?) "HP #HQ HR". iPureIntro; eauto. Qed. Lemma test_iPure_intro_2 (φ : nat → Prop) P Q R `{!Persistent Q} : φ 0 → P -∗ Q → R -∗ ∃ x : nat, ⌜ φ x ⌝ ∗ ⌜ φ x ⌝. Proof. iIntros (?) "HP #HQ HR". iPureIntro; eauto. Qed. (* Ensure that [% ...] works as a pattern when the left-hand side of and/sep is pure. *) Lemma test_pure_and_sep_destruct_affine `{!BiAffine PROP} (φ : Prop) P : ⌜φ⌝ ∧ (⌜φ⌝ ∗ P) -∗ P. Proof. iIntros "[% [% $]]". Qed. Lemma test_pure_and_sep_destruct_1 (φ : Prop) P : ⌜φ⌝ ∧ ( ⌜φ⌝ ∗ P) -∗ P. Proof. iIntros "[% [% $]]". Qed. Lemma test_pure_and_sep_destruct_2 (φ : Prop) P : ⌜φ⌝ ∧ (⌜φ⌝ ∗ P) -∗ P. Proof. iIntros "[% [% $]]". Qed. (* Ensure that [% %] also works when the conjunction is *inside* ⌜...⌝ *) Lemma test_pure_inner_and_destruct : ⌜False ∧ True⌝ ⊢@{PROP} False. Proof. iIntros "[% %]". done. Qed. (* Ensure that [% %] works as a pattern for an existential with a pure body. *) Lemma test_exist_pure_destruct_1 : (∃ x, ⌜ x = 0 ⌝) ⊢@{PROP} True. Proof. iIntros "[% %]". done. Qed. (* Also test nested existentials where the type of the 2nd depends on the first (which could cause trouble if we do things in the wrong order) *) Lemma test_exist_pure_destruct_2 : (∃ x (_:x=0), True) ⊢@{PROP} True. Proof. iIntros "(% & % & $)". 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. (* Test for issue #288 *) Lemma test_iExists_unused : ⊢ ∃ P : PROP, ∃ x : nat, P. Proof. iExists _. iExists 10. iAssert emp%I as "H"; first done. iExact "H". 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 `{Set_ A C} P : ⊢ ∃ x1 x2 : gset positive, P -∗ P. 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 `{!BiInternalEq PROP} {A : ofe} (φ : Prop) (y z : A) : φ → ⌜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_disjunction_3_evars (Φ : nat → PROP) P1 P2 P3 P4 : BiAffine PROP → let n := 5 in let R := λ a, Nat.iter n (λ P, (P1 ∗ P2 ∗ P3 ∗ P4 ∗ Φ a) ∨ P)%I (Φ a) in P1 ⊢ ∃ a, R a. Proof. intros ?. simpl. iIntros "HP1". iExists _. Timeout 1 iFrame. (* The combination of evars and nested disjunctions used to cause excessive backtracking during the construction of [Frame] instances, which made [iFrame] very slow. Above [Timeout] ensures [iFrame] now performs acceptably in this situation *) Abort. Check "test_iFrame_disjunction_4_evars". Lemma test_iFrame_disjunction_4_evars (Φ : nat → nat → PROP) P : Φ 0 1 ⊢ ∃ n m, (Φ n m ∗ Φ 0 1) ∨ (P ∗ Φ m n). Proof. iIntros "HΦ1". iExists _, _. Fail iFrame "HΦ1". (* During the construction of [Frame] instances for disjunctions, [Frame] instances for each of the sides should be constructed _exactly_ once. This test shows that after finding a way to frame "HΦ1" on the left-hand side of the disjunction (and instantiating [n = 0] and [m = 1]) the second way of framing "HΦ1" in the left-hand side is not considered, even though this would cause the framing to be succesful on the right-hand side. Considering multiple successes can cause exponential blowups, see above *) Abort. 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. Check "test_iFrame_conjunction_3". Lemma test_iFrame_conjunction_3 P Q `{!Absorbing Q} : P -∗ Q -∗ ((P ∗ False) ∧ Q). Proof. iIntros "HP HQ". iFrame "HP". (* [iFrame] should simplify [False ∧ Q] to just [False]. *) Show. Abort. Lemma test_iFrame_conjunction_4_evars (Φ : nat → PROP) P1 P2 P3 P4 P5 : BiAffine PROP → let n := 5 in let R := λ a, Nat.iter n (λ P, (P1 ∗ P2 ∗ P3 ∗ P4 ∗ Φ a) ∧ P)%I (P1 ∗ P2 ∗ P3 ∗ P4 ∗ Φ a)%I in P5 ⊢ ∃ a, R a. Proof. intros ?. simpl. iIntros "HP1". iExists _. Timeout 1 iFrame. (* The combination of evars and nested conjunctions used to cause excessive backtracking during the construction of [Frame] instances, which made [iFrame] very slow. Above [Timeout] ensures [iFrame] now performs acceptably in this situation *) Abort. Check "test_iFrame_exists_instantiate". Lemma test_iFrame_exists_instantiate (Φ Ψ : nat → PROP) P Q : P ∗ Φ 0 ∗ Ψ 1 ∗ Q ⊢ ∃ n, Φ n ∗ ∃ m, Ψ m ∗ P ∗ Q. Proof. iIntros "(HP & HΦ & HΨ & HQ)". iFrame "HΨ". (* instantiates the inner existential quantifier [m] *) Show. iFrame "HP". (* keeps the outer existential quantifier [n] around *) Show. iFrame "HΦ". (* instantiates the outer existential quantifier [n] *) Show. done. Qed. Check "test_wrong_instantiation". Lemma test_wrong_instantiation (Φ : nat → PROP) : Φ 0 ∗ Φ 1 ⊢ ∃ n m, Φ n ∗ Φ m ∗ ⌜n = 0⌝ ∗ ⌜m = 1⌝. Proof. iIntros "[HΦ1 HΦ2]". iFrame. Show. Abort. Lemma test_iFrame_nary_exists (Φ Ψ : nat → PROP) P Q : let n := 10 in let R := Nat.iter n (λ P, ∃ n : nat, P ∗ ⌜n = 0⌝)%I (∃ m, Φ m ∗ P)%I in P ∗ Φ 0 ⊢ R. Proof. simpl. (* This test asserts that the [Frame] instance for existential quantifiers performs acceptably when the number of quantifiers becomes larger. A naive implementation of this functionality would face an exponential slowdown. *) iIntros "[HP HΦ]". Timeout 1 iFrame "HP". Timeout 1 iFrame "HΦ". repeat (iExists 0; iSplit); eauto. Qed. Lemma test_iFrame_exists_under_definition (Φ : nat → PROP) : let P := (∃ n m, Φ m ∗ Φ n ∗ ⌜n = 0⌝ ∗ ⌜m = 1⌝)%I in Φ 0 ∗ Φ 1 ⊢ P. Proof. iIntros (P) "[HΦ1 HΦ2]". by iFrame. Qed. Check "test_iFrame_no_instantiate_under_forall". Lemma test_iFrame_no_instantiate_under_forall (P : nat → PROP) : □ P 0 ⊢ P 0 ∗ (∀ m : nat, ∃ n, P n ∗ ⌜n = m⌝ ∗ P 0). Proof. iIntros "#$". Show. (* [P 0] should get framed, [∃ n, P n] should remain untouched *) Abort. Check "test_iFrame_no_instantiate_under_wand". Lemma test_iFrame_no_instantiate_under_wand (P : nat → PROP) : □ P 0 ⊢ P 0 ∗ (P 1 -∗ ∃ n, P n ∗ ⌜n = 1⌝ ∗ P 0). Proof. iIntros "#$". Show. (* [P 0] should get framed, [∃ n, P n] should remain untouched *) Abort. Check "test_iFrame_no_instantiate_under_impl". Lemma test_iFrame_no_instantiate_under_impl (P : nat → PROP) : □ P 0 ⊢ P 0 ∗ (P 1 → ∃ n, P n ∗ ⌜n = 1⌝ ∗ P 0). Proof. iIntros "#$". Show. (* [P 0] should get framed, [∃ n, P n] should remain untouched *) Abort. Lemma test_iFrame_later `{!BiAffine PROP} P Q : P -∗ Q -∗ ▷ P ∗ Q. Proof. iIntros "H1 H2". by iFrame "H1". Qed. Lemma test_iFrame_affinely_1 P Q `{!Affine P} : P -∗ Q -∗ (P ∗ Q). Proof. iIntros "HP HQ". iFrame "HQ". by iModIntro. Qed. Lemma test_iFrame_affinely_2 P Q `{!Affine P, !Affine Q} : P -∗ Q -∗ (P ∗ Q). Proof. iIntros "HP HQ". iModIntro. iFrame "HQ". done. Qed. Check "test_iFrame_affinely_emp". Lemma test_iFrame_affinely_emp P : □ P -∗ ∃ _ : nat, P. (* The ∃ makes sure [iFrame] does not solve the goal and we can [Show] the result *) Proof. iIntros "#H". iFrame "H". Show. (* This should become [∃ _ : nat, emp]. *) by iExists 1. Qed. Check "test_iFrame_affinely_True". Lemma test_iFrame_affinely_True `{!BiAffine PROP} P : □ P -∗ ∃ x : nat, P. Proof. iIntros "#H". iFrame "H". Show. (* This should become [∃ _ : nat, True]. Since we are in an affine BI, no unnecessary [emp]s should be created. *) by iExists 1. Qed. Check "test_iFrame_or_1". Lemma test_iFrame_or_1 P1 P2 P3 : P1 ∗ P2 ∗ P3 -∗ P1 ∗ ▷ (P2 ∗ ∃ x, (P3 ∗ ⌜x = 0⌝) ∨ P3). Proof. iIntros "($ & $ & $)". Show. (* By framing [P3], the disjunction becomes [ ⌜x = 0⌝ ∨ emp]. The [iFrame] tactic simplifies disjunctions if one side is trivial. In a general BI, it can only turn [Q ∨ emp] into [emp]---without information loss---if [Q] is affine. Here, we have [Q := ⌜x = 0⌝], which is trivially affine (i.e., [QuickAffine]), and the disjunction is thus simplified to [emp]. *) by iExists 0. Qed. Check "test_iFrame_or_2". Lemma test_iFrame_or_2 P1 P2 P3 : P1 ∗ P2 ∗ P3 -∗ P1 ∗ ▷ (P2 ∗ ∃ x, (P3 ∧ ⌜x = 0⌝) ∨ P3). Proof. iIntros "($ & $ & $)". Show. (* By framing [P3], the disjunction becomes [emp ∧ ⌜x = 0⌝ ∨ emp]. Since [emp ∧ ⌜x = 0⌝] is not trivially affine (i.e., not [QuickAffine]) it is not simplified to [emp]. *) iExists 0. auto. Qed. Check "test_iFrame_or_3". Lemma test_iFrame_or_3 P1 P2 P3 : P1 ∗ P2 ∗ P3 -∗ P1 ∗ ▷ (P2 ∗ ∃ x, (P3 ∗ ⌜x = 0⌝) ∨ (False ∗ P3)). Proof. iIntros "($ & $ & $)". Show. (* After framing [P3], the disjunction becomes [⌜x = 0⌝ ∨ False]. The simplification of disjunctions by [iFrame] will now get rid of the [∨ False], to just [⌜x = 0⌝] *) by iExists 0. Qed. Check "test_iFrame_or_affine_1". Lemma test_iFrame_or_affine_1 `{!BiAffine PROP} P1 P2 P3 : P1 ∗ P2 ∗ P3 -∗ P1 ∗ ▷ (P2 ∗ ∃ x, (P3 ∗ ⌜x = 0⌝) ∨ P3). Proof. iIntros "($ & $ & $)". Show. (* If the BI is affine, the disjunction should be turned into [True]. *) by iExists 0. Qed. Check "test_iFrame_or_affine_2". Lemma test_iFrame_or_affine_2 `{!BiAffine PROP} P1 P2 P3 : P1 ∗ P2 ∗ P3 -∗ P1 ∗ ▷ (P2 ∗ ∃ x, (P3 ∧ ⌜x = 0⌝) ∨ P3). Proof. iIntros "($ & $ & $)". Show. (* If the BI is affine, the disjunction should be turned into [True]. *) by iExists 0. Qed. Lemma test_iAssert_modality P : ◇ False -∗ ▷ P. Proof. iIntros "HF". iAssert ( False)%I with "[> -]" as %[]. by iMod "HF". Qed. Lemma test_iMod_affinely_timeless P `{!Timeless P} : ▷ P -∗ ◇ P. Proof. iIntros "H". iMod "H". done. Qed. Lemma test_iAssumption_False P : False -∗ P. Proof. iIntros "H". done. Qed. Lemma test_iAssumption_coq_1 P Q : (⊢ Q) → P -∗ Q. Proof. iIntros (HQ) "_". iAssumption. Qed. Lemma test_iAssumption_coq_2 P Q : (⊢ □ Q) → P -∗ ▷ Q. Proof. iIntros (HQ) "_". iAssumption. 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. Check "test_iCombine_nested_no_gives". Lemma test_iCombine_nested_no_gives P Q : P -∗ Q -∗ (P ∗ Q). Proof. iIntros "HP HQ". Fail iCombine "HP HQ" gives "Htriv". Fail iCombine "HP HQ" as "HPQ" gives "Htriv". iCombine "HP HQ" as "HPQ". iExact "HPQ". Qed. Lemma test_iCombine_nested_gives1 P Q R : CombineSepGives P Q R → P -∗ Q -∗ R. Proof. move => HPQR. iIntros "HP HQ". iCombine "HP HQ" gives "#HR". iExact "HR". Qed. Lemma test_iCombine_nested_gives2 n P Q R : CombineSepGives P Q R → ▷^n ◇ P -∗ ▷^n ◇ Q -∗ ▷^n ◇ (P ∗ Q) ∗ ▷^n ◇ R. Proof. move => HPQR. iIntros "HP HQ". iCombine "HP HQ" as "HPQ" gives "#HR". iSplitL "HPQ"; first iExact "HPQ". iExact "HR". 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 text_iNext_Next `{!BiInternalEq PROP} {A B : ofe} (f : A -n> A) x y : Next x ≡ Next y -∗ (Next (f x) ≡ Next (f y) : PROP). Proof. iIntros "H". iNext. by iRewrite "H". Qed. Lemma test_iFrame_persistent (P Q : PROP) : □ P -∗ Q -∗ (P ∗ P) ∗ (P ∗ Q ∨ Q). Proof. iIntros "#HP". iFrame "HP". iIntros "$". Qed. Lemma test_iSplit_persistently P Q : □ P -∗ (P ∗ P). 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_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 `{!BiLöb PROP} P : ⊢ ∃ n, ▷^n P. Proof. iLöb as "IH". iDestruct "IH" as (n) "IH". by iExists (S n). Qed. Lemma test_iLöb_forall `{!BiLöb PROP} P (n : nat) : P ⊢ ⌜ n = n ⌝. Proof. iIntros "HP". iLöb as "IH" forall (n) "HP". Restart. Proof. iIntros "HP". iLöb as "IH" forall "HP". Restart. Proof. iIntros "HP". iLöb as "IH" forall (n). Restart. Proof. iIntros "HP". iLöb as "IH". Abort. 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 lia. Qed. Lemma test_iInduction_using (m : gmap nat nat) (Φ : nat → nat → PROP) y : ([∗ map] x ↦ i ∈ m, Φ y x) -∗ ([∗ map] x ↦ i ∈ m, emp ∗ Φ y x). Proof. iIntros "Hm". iInduction m as [|i x m] "IH" using map_ind forall(y). - by rewrite !big_sepM_empty. - rewrite !big_sepM_insert //. iDestruct "Hm" as "[$ ?]". by iApply "IH". Qed. (* From https://gitlab.mpi-sws.org/iris/iris/-/issues/534 *) Lemma test_iInduction_big_sepL_impl' {A} (Φ Ψ : nat → A → PROP) (l1 l2 : list A) : length l1 = length l2 → ([∗ list] k↦x ∈ l1, Φ k x) -∗ □ (∀ k x1 x2, ⌜l1 !! k = Some x1⌝ -∗ ⌜l2 !! k = Some x2⌝ -∗ Φ k x1 -∗ Ψ k x2) -∗ [∗ list] k↦x ∈ l2, Ψ k x. Proof. iIntros (Hlen) "Hl #Himpl". iInduction l1 as [|x1 l1] "IH" forall (Φ Ψ l2 Hlen). Abort. Inductive tree := leaf | node (l r: tree). Check "test_iInduction_multiple_IHs". Lemma test_iInduction_multiple_IHs (t: tree) (Φ : tree → PROP) : □ Φ leaf -∗ □ (∀ l r, Φ l -∗ Φ r -∗ Φ (node l r)) -∗ Φ t. Proof. iIntros "#Hleaf #Hnode". iInduction t as [|l r] "IH". - iExact "Hleaf". - Show. (* should have "IH" and "IH1", since [node] has two trees *) iApply ("Hnode" with "IH IH1"). Qed. Lemma test_iIntros_start_proof : ⊢@{PROP} True. 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_entails 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_iPoseProof_let_wand 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_iPoseProof_let_entails_pm_intro_pat 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_entails P : ∀ Q, let R := emp%I in P ⊢ R -∗ Q -∗ P ∗ Q. Proof. iIntros (Q R) "$ _ $". Qed. Lemma test_iIntros_let_wand P : ∀ Q, let R := emp%I in P -∗ R -∗ Q -∗ P ∗ Q. Proof. iIntros (Q R) "$ _ $". Qed. Lemma lemma_for_test_apply_entails_below_let (Φ : nat → PROP) : let Q := Φ 5 in Q ⊢ Q. Proof. iIntros (?) "?". done. Qed. Lemma test_apply_entails_below_let (Φ : nat → PROP) : Φ 5 -∗ Φ 5. Proof. iIntros "?". iApply lemma_for_test_apply_entails_below_let. done. Qed. Lemma lemma_for_test_apply_wand_below_let (Φ : nat → PROP) : let Q := Φ 5 in Q -∗ Q. Proof. iIntros (?) "?". done. Qed. Lemma test_apply_wand_below_let (Φ : nat → PROP) : Φ 5 -∗ Φ 5. Proof. iIntros "?". iApply lemma_for_test_apply_wand_below_let. done. Qed. Lemma test_iNext_iRewrite `{!BiInternalEq PROP} P Q : ▷ (Q ≡ P) -∗ ▷ Q -∗ ▷ P. Proof. iIntros "#HPQ HQ !>". iNext. by iRewrite "HPQ" in "HQ". Qed. Lemma test_iIntros_modalities `{!BiPersistentlyForall PROP} `(!Absorbing P) : ⊢ (▷ ∀ x : nat, ⌜ x = 0 ⌝ → ⌜ x = 0 ⌝ -∗ False -∗ P -∗ P). 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_iIntros_leibniz_equiv `{!BiInternalEq PROP} {A : ofe} (x y : A) : Discrete x → LeibnizEquiv A → x ≡ y ⊢@{PROP} ⌜x = y⌝. Proof. intros ??. iIntros (->). (* test that the [IntoPure] instance converts [≡] into [=] *) done. Qed. Lemma test_iIntros_leibniz_equiv_prod `{!BiInternalEq PROP} {A B : ofe} (a1 a2 : A) (b1 b2 : B) : Discrete a1 → Discrete b1 → LeibnizEquiv A → LeibnizEquiv B → (a1, b1) ≡ (a2, b2) ⊢@{PROP} ⌜a1 = a2⌝. Proof. intros ????. iIntros ([-> _]%pair_eq). (* another test that the [IntoPure] instance converts [≡] into [=], also under combinators *) done. Qed. Lemma test_iPureIntro_leibniz_equiv `{!BiInternalEq PROP} {A : ofe} `{!LeibnizEquiv A} (x y : A) : (x ≡ y) → ⊢@{PROP} x ≡ y. Proof. intros Heq. iPureIntro. (* test that the [FromPure] instance does _not_ convert [≡] into [=] *) exact Heq. Qed. Lemma test_iDestruct_rewrite_not_consume P (x1 x2 : nat) : (P -∗ ⌜ x1 = x2 ⌝) → P -∗ ⌜ x1 = x2 ⌝ ∗ P. Proof. iIntros (lemma) "HP". iDestruct (lemma with "HP") as "->". auto. (* Make sure that "HP" has not been consumed; [auto] would fail otherwise. *) Qed. Lemma test_iNext_affine `{!BiInternalEq PROP} P Q : ▷ (Q ≡ P) -∗ ▷ Q -∗ ▷ P. Proof. iIntros "#HPQ HQ !>". iNext. by iRewrite "HPQ" in "HQ". Qed. Lemma test_iAlways P Q R : □ P -∗ Q → R -∗ P ∗ □ Q. Proof. iIntros "#HP #HQ HR". iSplitL. - iModIntro. done. - iModIntro. 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. 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. 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 demo_laterN_forall {A} (Φ Ψ: A → PROP) n: (∀ x, ▷^n Φ x) -∗ ▷^n (∀ x, Φ x). Proof. iIntros "H" (w). iApply ("H" $! w). 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 : φ → ( ⌜φ⌝ -∗ P) ⊢ P. Proof. iIntros (Hφ) "H". by iSpecialize ("H" with "[% //]"). Qed. Lemma test_assert_affine_pure (φ : Prop) P : φ → P ⊢ P ∗ ⌜φ⌝. Proof. iIntros (Hφ). iAssert ( ⌜φ⌝)%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_specialize_very_nested (φ : Prop) P P2 Q R1 R2 : φ → P -∗ P2 -∗ ( ⌜ φ ⌝ -∗ P2 -∗ Q) -∗ (P -∗ Q -∗ R1) -∗ (R1 -∗ True -∗ R2) -∗ R2. Proof. iIntros (?) "HP HP2 HQ H1 H2". by iApply ("H2" with "(H1 HP (HQ [% //] [-])) [//]"). Qed. Lemma test_specialize_very_very_nested P1 P2 P3 P4 P5 : □ P1 -∗ □ (P1 -∗ P2) -∗ (P2 -∗ P2 -∗ P3) -∗ (P3 -∗ P4) -∗ (P4 -∗ P5) -∗ P5. Proof. iIntros "#H #H1 H2 H3 H4". by iSpecialize ("H4" with "(H3 (H2 (H1 H) (H1 H)))"). Qed. Check "test_specialize_nested_intuitionistic". Lemma test_specialize_nested_intuitionistic (φ : Prop) P P2 Q R1 R2 : φ → □ P -∗ □ (P -∗ Q) -∗ (Q -∗ Q -∗ R2) -∗ R2. Proof. iIntros (?) "#HP #HQ HR". iSpecialize ("HR" with "(HQ HP) (HQ HP)"). Show. done. Qed. Lemma test_specialize_intuitionistic P Q : □ P -∗ □ (P -∗ Q) -∗ □ Q. Proof. iIntros "#HP #HQ". iSpecialize ("HQ" with "HP"). done. Qed. Lemma test_iEval x y : ⌜ (y + x)%nat = 1 ⌝ ⊢@{PROP} ⌜ S (x + y) = 2%nat ⌝. Proof. iIntros (H). iEval (rewrite (Nat.add_comm x y) // H). done. Qed. Lemma test_iEval_precedence : True ⊢ True : PROP. Proof. iIntros. (* Ensure that in [iEval (a); b], b is not parsed as part of the argument of [iEval]. *) iEval (rewrite /=); iPureIntro; exact I. Qed. Check "test_iSimpl_in". Lemma test_iSimpl_in x y : ⌜ (3 + x)%nat = y ⌝ ⊢@{PROP} ⌜ S (S (S x)) = y ⌝. Proof. iIntros "H". iSimpl in "H". Show. done. Qed. Lemma test_iSimpl_in_2 x y z : ⌜ (3 + x)%nat = y ⌝ ⊢@{PROP} ⌜ (1 + y)%nat = z ⌝ -∗ ⌜ S (S (S x)) = y ⌝. Proof. iIntros "H1 H2". iSimpl in "H1 H2". Show. done. Qed. Lemma test_iSimpl_in3 x y z : ⌜ (3 + x)%nat = y ⌝ ⊢@{PROP} ⌜ (1 + y)%nat = z ⌝ -∗ ⌜ S (S (S x)) = y ⌝. Proof. iIntros "#H1 H2". iSimpl in "#". Show. done. Qed. Check "test_iSimpl_in4". Lemma test_iSimpl_in4 x y : ⌜ (3 + x)%nat = y ⌝ ⊢@{PROP} ⌜ S (S (S x)) = y ⌝. Proof. iIntros "H". Fail iSimpl in "%". by iSimpl in "H". Qed. Check "test_iRename". Lemma test_iRename P : □P -∗ P. Proof. iIntros "#H". iRename "H" into "X". Show. iExact "X". Qed. (** [iTypeOf] is an internal tactic for the proofmode *) Lemma test_iTypeOf Q R φ : □ Q ∗ R ∗ ⌜φ⌝ -∗ True. Proof. iIntros "(#HQ & H)". lazymatch iTypeOf "HQ" with | Some (true, Q) => idtac | ?x => fail "incorrect iTypeOf HQ" x end. lazymatch iTypeOf "H" with | Some (false, (R ∗ ⌜φ⌝)%I) => idtac | ?x => fail "incorrect iTypeOf H" x end. lazymatch iTypeOf "missing" with | None => idtac | ?x => fail "incorrect iTypeOf missing" x end. Abort. Lemma test_iPureIntro_absorbing (φ : Prop) : φ → ⊢@{PROP} ⌜φ⌝. 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. - (* Verify that [iAssumption] instantiates the evar for the existential [R] to become [P], and in particular, that it does not make it [False]. *) reflexivity. Qed. (** Prior to 0b84351c this used to loop, now [iAssumption] fails. *) Lemma test_iAssumption_False_no_loop : ∃ R, R ⊢ ∀ P, P. Proof. eexists. iIntros "H" (P). (* Make sure that [iAssumption] does not perform False elimination on hypotheses that are evars. *) Fail iAssumption. (* And neither does [done]. *) Fail done. (* But we can of course achieve that using an explicit proof. *) iExFalso. iExact "H". Qed. Lemma test_apply_affine_impl `{!BiPlainly PROP} (P : PROP) : P -∗ (∀ Q : PROP, ■ (Q -∗ 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, ■ (Q -∗ Q) -∗ ■ (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, ⌜ y = y ⌝) -∗ ([∗ list] y ∈ x :: l, ⌜ 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, ⌜ y1 = y2 ⌝) -∗ ([∗ list] y1;y2 ∈ x1 :: l1; (x2 :: l2) ++ l2, ⌜ 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) -∗ Φ 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. Check "test_iApply_prettification3". Lemma test_iApply_prettification3 (Ψ Φ : nat → PROP) : (∀ f y, TCEq f (λ x, x + 10) → Ψ (f 1) -∗ Φ y) → Ψ 11 -∗ Φ 10. Proof. iIntros (HP) "H". iApply HP. (* should be [Ψ (1 + 10)], without a beta redex *) Show. iApply "H". Qed. Lemma test_iDestruct_clear P Q R : P -∗ (Q ∗ R) -∗ True. Proof. iIntros "HP HQR". iDestruct "HQR" as "{HP} [HQ HR]". done. Qed. Lemma test_iSpecialize_bupd `{!BiBUpd PROP} A (a : A) (P : A -> PROP) : (|==> ∀ x, P x) ⊢ |==> P a. Proof. iIntros "H". iSpecialize ("H" $! a). done. Qed. Lemma test_iSpecialize_fupd `{!BiFUpd PROP} A (a : A) (P : A -> PROP) E1 E2 : (|={E1, E2}=> ∀ x, P x) ⊢ |={E1, E2}=> P a. Proof. iIntros "H". iSpecialize ("H" $! a). done. Qed. Lemma test_iDestruct_and_bupd `{!BiBUpd PROP} (P Q : PROP) : (|==> P ∧ Q) ⊢ |==> P. Proof. iIntros "[P _]". done. Qed. Lemma test_iDestruct_and_fupd `{!BiFUpd PROP} (P Q : PROP) E1 E2 : (|={E1, E2}=> P ∧ Q) ⊢ |={E1, E2}=> P. Proof. iIntros "[P _]". done. Qed. Lemma test_iModIntro_make_laterable `{!BiAffine PROP} (P Q : PROP) : Laterable Q → P -∗ Q -∗ make_laterable (▷ P ∗ Q). Proof. iIntros (?) "HP HQ". iModIntro. Show. by iFrame. Qed. Lemma test_iExfalso_start_proof P : 0 = 1 → ⊢ P. Proof. intros. iExFalso. done. Qed. Check "test_iRevert_pure". Lemma test_iRevert_pure (φ : Prop) P : φ → ( ⌜ φ ⌝ -∗ P) -∗ P. Proof. (* Check that iRevert creates a wand instead of an implication *) iIntros (Hφ) "H". iRevert (Hφ). Show. done. Qed. Check "test_iRevert_order_and_names". Lemma test_iRevert_order_and_names P1 P2 : P1 -∗ P2 -∗ P1 ∗ P2. Proof. iIntros "H1 H2". iRevert (P1 P2) "H1 H2". (* Check that the reverts are performed in the right order (i.e., reverse), and that the names [P1] and [P2] are used in the goal. *) Show. auto with iFrame. Qed. Check "test_iRevert_pure_affine". Lemma test_iRevert_pure_affine `{!BiAffine PROP} (φ : Prop) P : φ → (⌜ φ ⌝ -∗ P) -∗ P. Proof. (* If the BI is affine, no affine modality should be added *) iIntros (Hφ) "H". iRevert (Hφ). Show. done. Qed. (* Check that when framing things under the □ modality, we do not add [emp] in affine BIs. *) Check "test_iFrame_not_add_emp_for_intuitionistically". Lemma test_iFrame_not_add_emp_for_intuitionistically `{!BiAffine PROP} (P : PROP) : □ P -∗ ∃ _ : nat, □ P. Proof. iIntros "#H". iFrame "H". Show. by iExists 0. Qed. Lemma test_auto_iff P : ⊢ P ↔ P. Proof. auto. Qed. Lemma test_auto_wand_iff P : ⊢ P ∗-∗ P. Proof. auto. Qed. Check "test_iIntros_auto_name_used_later". Lemma test_iIntros_auto_name_used_later (Φ: nat → PROP) : ⊢ ∀ x y, Φ (x+y). Proof. (* This test documents a difference between [intros ...] and [iIntros (...)]: the latter will pick [x] as the name for the [?] here (matching the name in the goal) and then fail later when another [x] is attempted to be introduced. [intros] will somehow realize that [x] is coming later, and pick a different name for the [?]. *) Fail iIntros (? x). Abort. End tests. Section parsing_tests. Context {PROP : bi}. Implicit Types P : PROP. (** Test notations for (bi)entailment and internal equality. These tests are especially extensive because of past problems such as https://gitlab.mpi-sws.org/iris/iris/-/issues/302. *) Lemma test_bi_emp_valid : ⊢@{PROP} True. Proof. naive_solver. Qed. Lemma test_bi_emp_valid_parens : (⊢@{PROP} True) ∧ ((⊢@{PROP} True)). Proof. naive_solver. Qed. Lemma test_bi_emp_valid_parens_space_open : ( ⊢@{PROP} True). Proof. naive_solver. Qed. Lemma test_bi_emp_valid_parens_space_close : (⊢@{PROP} True ). Proof. naive_solver. Qed. Lemma test_entails_annot_sections P : (P ⊢@{PROP} P) ∧ (⊢@{PROP}) P P ∧ (P ⊢.) P ∧ (.⊢ P) P ∧ (P ⊣⊢@{PROP} P) ∧ (⊣⊢@{PROP}) P P ∧ (P ⊣⊢.) P ∧ (.⊣⊢ P) P. Proof. naive_solver. Qed. Lemma test_entails_annot_sections_parens P : ((P ⊢@{PROP} P)) ∧ ((⊢@{PROP})) P P ∧ ((P ⊢.)) P ∧ ((.⊢ P)) P ∧ ((P ⊣⊢@{PROP} P)) ∧ ((⊣⊢@{PROP})) P P ∧ ((P ⊣⊢.)) P ∧ ((.⊣⊢ P)) P. Proof. naive_solver. Qed. Lemma test_entails_annot_sections_space_open P : ( P ⊢@{PROP} P) ∧ ( P ⊢.) P ∧ ( P ⊣⊢@{PROP} P) ∧ ( P ⊣⊢.) P. Proof. naive_solver. Qed. Lemma test_entails_annot_sections_space_close P : (P ⊢@{PROP} P ) ∧ (⊢@{PROP} ) P P ∧ (.⊢ P ) P ∧ (P ⊣⊢@{PROP} P ) ∧ (⊣⊢@{PROP} ) P P ∧ (.⊣⊢ P ) P. Proof. naive_solver. Qed. Lemma test_bi_internal_eq_annot_sections `{!BiInternalEq PROP} P : ⊢@{PROP} P ≡@{PROP} P ∧ (≡@{PROP}) P P ∧ (P ≡.) P ∧ (.≡ P) P ∧ ((P ≡@{PROP} P)) ∧ ((≡@{PROP})) P P ∧ ((P ≡.)) P ∧ ((.≡ P)) P ∧ ( P ≡@{PROP} P) ∧ ( P ≡.) P ∧ (P ≡@{PROP} P ) ∧ (≡@{PROP} ) P P ∧ (.≡ P ) P. Proof. naive_solver. Qed. End parsing_tests. Section printing_tests. Context {PROP : bi} `{!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). Proof. iStartProof. Show. Abort. Check "long_impl_nested". Lemma long_impl_nested (PPPPPPPPPPPPPPPPP QQQQQQQQQQQQQQQQQQ : PROP) : ⊢ PPPPPPPPPPPPPPPPP → (QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ) → (QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ). Proof. iStartProof. Show. Abort. Check "long_wand". Lemma long_wand (PPPPPPPPPPPPPPPPP QQQQQQQQQQQQQQQQQQ : PROP) : ⊢ PPPPPPPPPPPPPPPPP -∗ (QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ). Proof. iStartProof. Show. Abort. Check "long_wand_nested". Lemma long_wand_nested (PPPPPPPPPPPPPPPPP QQQQQQQQQQQQQQQQQQ : PROP) : ⊢ PPPPPPPPPPPPPPPPP -∗ (QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ) -∗ (QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ). 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 : bi}. Implicit Types P Q R : PROP. Check "iStopProof_not_proofmode". Lemma iStopProof_not_proofmode : 10 = 10. Proof. Fail iStopProof. Abort. Check "iAlways_spatial_non_empty". Lemma iAlways_spatial_non_empty P : P -∗ □ emp. Proof. iIntros "HP". Fail iModIntro. 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 "iIntros_pure_not_forall". Lemma iIntros_pure_not_forall P Q : P -∗ Q. Proof. Fail iIntros (?). Abort. Check "iSplitL_one_of_many". Lemma iSplitL_one_of_many P : P -∗ P -∗ P ∗ P. Proof. iIntros "HP1 HP2". Fail iSplitL "HP1 HPx". Fail iSplitL "HPx HP1". Abort. Check "iSplitR_one_of_many". Lemma iSplitR_one_of_many P : P -∗ P -∗ P ∗ P. Proof. iIntros "HP1 HP2". Fail iSplitR "HP1 HPx". Fail iSplitR "HPx HP1". Abort. Check "iSplitL_non_splittable". Lemma iSplitL_non_splittable P : ⊢ P. Proof. Fail iSplitL "". Abort. Check "iSplitR_non_splittable". Lemma iSplitR_non_splittable P : ⊢ P. Proof. Fail iSplitR "". Abort. Check "iCombine_fail". Lemma iCombine_fail P: P -∗ P -∗ P ∗ P. Proof. iIntros "HP1 HP2". Fail iCombine "HP1 HP3" as "HP". Abort. Check "iSpecialize_bad_name1_fail". Lemma iSpecialize_bad_name1_fail P Q: (P -∗ Q) -∗ P -∗ Q. Proof. iIntros "HW HP". Fail iSpecialize ("H" with "HP"). Abort. Check "iSpecialize_bad_name2_fail". Lemma iSpecialize_bad_name2_fail P Q: (P -∗ Q) -∗ P -∗ Q. Proof. iIntros "HW HP". Fail iSpecialize ("HW" with "H"). Abort. Check "iSpecialize_autoframe_fail". Lemma iSpecialize_autoframe_fail P Q : (P -∗ Q) -∗ Q. Proof. iIntros "H". Fail iSpecialize ("H" with "[$]"). Fail iApply ("H" with "[$]"). Abort. Check "iSpecialize_autoframe_fail2". Lemma iSpecialize_autoframe_fail2 P Q R : (P -∗ Q -∗ R) -∗ P -∗ R. Proof. iIntros "H HP". Fail iSpecialize ("H" with "[$] [$]"). Fail iApply ("H" with "[$] [$]"). Abort. Check "iExact_fail". Lemma iExact_fail P Q : P -∗ Q -∗ 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 "iPoseProof_not_found_fail". Lemma iPoseProof_not_found_fail P : P -∗ P. Proof. iIntros "H". Fail iPoseProof "Hx" as "H1". Abort. Check "iPoseProof_not_found_fail2". Lemma iPoseProof_not_found_fail2 P Q (H: P -∗ Q) : P -∗ Q. Proof. iIntros "HP". Fail iPoseProof (H with "[HQ]") as "H". Abort. Check "iPoseProofCoreHyp_not_found_fail". Lemma iPoseProofCoreHyp_not_found_fail P : P -∗ P -∗ P. Proof. iIntros "H". Fail iPoseProofCoreHyp "Hx" as "H1". Abort. Check "iPoseProofCoreHyp_not_fresh_fail". Lemma iPoseProofCoreHyp_not_fresh_fail P : P -∗ P -∗ P. Proof. iIntros "H0 H1". Fail iPoseProofCoreHyp "H0" as "H1". Abort. Check "iRevert_fail". Lemma iRevert_fail P : P -∗ P. Proof. Fail iRevert "H". Abort. Check "iDestruct_fail". Lemma iDestruct_fail P : P -∗ P. Proof. iIntros "HP". Fail iDestruct "HP" as "[{HP}]". (* IDone is unsupported (see issue #380) *) Fail iDestruct "HP" as "// H". (* fails due to not having "one proper intro pattern" (see issue #380) *) Fail iDestruct "HP" as "HP //". (* both of these work *) iDestruct "HP" as "HP /=". iDestruct "HP" as "/= HP". Fail iDestruct "HP" as "[HP HQ HR]". Fail iDestruct "HP" as "[HP|HQ|HR]". Fail iDestruct "HP" as "[HP]". Fail iDestruct "HP" as "[HP HQ|HR]". Abort. Check "iOrDestruct_fail". Lemma iOrDestruct_fail P : (P ∨ P) -∗ P -∗ P. Proof. iIntros "H H'". Fail iOrDestruct "H" as "H'" "H2". Fail iOrDestruct "H" as "H1" "H'". Abort. Check "iApply_fail". Lemma iApply_fail P Q : P -∗ Q. Proof. iIntros "HP". Fail iApply "HP". Abort. Check "iApply_fail_not_affine_1". Lemma iApply_fail_not_affine_1 P Q : P -∗ Q -∗ Q. Proof. iIntros "HP HQ". Fail iApply "HQ". Abort. Check "iIntros_fail_nonempty_spatial". Lemma iIntro_fail_nonempty_spatial P Q : P -∗ P → Q. Proof. Fail iIntros "? HP". Abort. Check "iIntros_fail_not_fresh". Lemma iIntro_fail_not_fresh P Q : P -∗ P -∗ Q. Proof. Fail iIntros "HP HP". Abort. Check "iIntros_fail_nothing_to_introduce". Lemma iIntro_fail_nothing_to_introduce P Q : P -∗ Q. Proof. Fail iIntros "HP HQ". Abort. Check "iApply_fail_not_affine_2". Lemma iApply_fail_not_affine_2 P Q R : P -∗ R -∗ (R -∗ Q) -∗ Q. Proof. iIntros "HP HR HQ". Fail iApply ("HQ" with "HR"). Abort. Check "iAssumption_fail_not_affine_1". Lemma iAssumption_fail_not_affine_1 P Q : P -∗ Q -∗ Q. Proof. iIntros "HP HQ". Fail iAssumption. Abort. Check "iAssumption_fail_not_affine_2". Lemma iAssumption_fail_not_affine_2 P Q : (⊢ Q) → P -∗ Q. Proof. iIntros (HQ) "HP". Fail iAssumption. Abort. Check "iRevert_wrong_var". Lemma iRevert_wrong_var (k : nat) (Φ : nat → PROP) : ⊢ Φ (S k). Proof. Fail iRevert (k1). Fail iLöb as "IH" forall (k1). Abort. Check "iRevert_dup_var". Lemma iRevert_dup_var (k : nat) (Φ : nat → PROP) : ⊢ Φ (S k). Proof. Fail iRevert (k k). Abort. Check "iRevert_dep_var_coq". Lemma iRevert_dep_var_coq (k : nat) (Φ : nat → PROP) : k = 0 → ⊢ Φ (S k). Proof. intros Hk. Fail iRevert (k). Abort. Check "iRevert_dep_var". Lemma iRevert_dep_var (k : nat) (Φ : nat → PROP) : Φ k -∗ Φ (S k). Proof. iIntros "Hk". Fail iRevert (k). Abort. Check "iLöb_no_BiLöb". Lemma iLöb_no_BiLöb P : ⊢ P. Proof. Fail iLöb as "IH". Abort. Check "iMod_mask_mismatch". Lemma iMod_mask_mismatch `{!BiFUpd PROP} E1 E2 (P : PROP) : (|={E2}=> P) ⊢ |={E1}=> P. Proof. Fail iIntros ">HP". iIntros "HP". Fail iMod "HP". Abort. Check "iModIntro_mask_mismatch". Lemma iMod_mask_mismatch `{!BiFUpd PROP} E1 E2 (P : PROP) : ⊢ |={E1,E2}=> P. Proof. Fail iModIntro. Fail iIntros "!>". Abort. Check "iRevert_wrong_sel_pat". Lemma iRevert_wrong_sel_pat (n m : nat) (P Q : nat → PROP) : ⌜ n = m ⌝ -∗ P n -∗ P m. Proof. Fail iRevert n. Abort. Check "iInduction_wrong_sel_pat". Lemma iInduction_wrong_sel_pat (n m : nat) (P Q : nat → PROP) : ⌜ n = m ⌝ -∗ P n -∗ P m. Proof. Fail iInduction n as [|n] "IH" forall m. Abort. Check "test_iIntros_let_entails_fail". Lemma test_iIntros_let_entails_fail P : let Q := (P ∗ P)%I in Q ⊢ Q. Proof. Fail iIntros "Q". Abort. Check "test_iIntros_let_wand_fail". Lemma test_iIntros_let_wand_fail P : let Q := (P ∗ P)%I in Q -∗ Q. Proof. Fail iIntros "Q". Abort. End error_tests. Section pure_name_tests. Context {PROP : bi}. Implicit Types P Q R : PROP. Check "test_pure_name". Lemma test_pure_name P (φ1 φ2 : Prop) (Himpl : φ1 → φ2) : P ∗ ⌜φ1⌝ -∗ P ∗ ⌜φ2⌝. Proof. iIntros "[HP %HP2]". Show. iFrame. iPureIntro. exact (Himpl HP2). Qed. Lemma test_iIntros_forall_pure_named (Ψ: nat → PROP) : (∀ x : nat, Ψ x) ⊢ ∀ x : nat, Ψ x. Proof. iIntros "HP". iIntros "%y". iApply ("HP" $! y). Qed. Check "test_not_fresh". Lemma test_not_fresh P (φ : Prop) (H : φ) : P ∗ ⌜ φ ⌝ -∗ P ∗ ⌜ φ ⌝. Proof. Fail iIntros "[H %H]". Abort. Lemma test_exists_intro_pattern P (Φ: nat → PROP) : P ∗ (∃ y:nat, Φ y) -∗ ∃ x, P ∗ Φ x. Proof. iIntros "[HP1 [%yy HP2]]". iExists yy. iFrame "HP1 HP2". Qed. End pure_name_tests. Section tactic_tests. Context {PROP : bi}. Implicit Types P Q R : PROP. Implicit Types φ : nat → PROP. Implicit Types Ψ : nat → nat → PROP. Check "test_iRename_select1". Lemma test_iRename_select1 P Q : □ (P -∗ Q) -∗ □ P -∗ □ Q. Proof. iIntros "#? #?". iRename select P into "H1". (* The following fails since there are no matching hypotheses. *) Fail iRename select (_ ∗ _)%I into "?". iRename select (_ -∗ _)%I into "H2". iDestruct ("H2" with "H1") as "$". Qed. Lemma test_iRename_select2 P Q : (P -∗ Q) -∗ P -∗ Q. Proof. iIntros "??". iRename select P into "H1". iRename select (_ -∗ _)%I into "H2". by iApply "H2". Qed. Lemma test_iDestruct_select1 P Q : (P ∗ Q) -∗ Q ∗ P. Proof. iIntros "?". iDestruct select (_ ∗ _)%I as "[$ $]". Qed. Check "test_iDestruct_select2". Lemma test_iDestruct_select2 φ P : (∃ x, P ∗ φ x) -∗ ∃ x, φ x ∗ P. Proof. iIntros "?". (* The following fails since [Φ n] is not pure. *) Fail iDestruct select (∃ _, _)%I as (n) "[H1 %]". iDestruct select (∃ _, _)%I as (n) "[H1 H2]". iExists n. iFrame. Qed. Lemma test_iDestruct_select3 Ψ P : (∃ x y, P ∗ Ψ x y) -∗ ∃ x y, Ψ x y ∗ P. Proof. iIntros "?". iDestruct select (∃ _, _)%I as (n m) "[H1 H2]". iExists n, m. iFrame. Qed. Lemma test_iDestruct_select4 φ : □ (∃ x, φ x) -∗ □ (∃ x, φ x). Proof. iIntros "#?". iDestruct select (∃ _, _)%I as (n) "H". by iExists n. Qed. Lemma test_iDestruct_select5 (φ : nat → Prop) P : P -∗ ⌜∃ n, φ n⌝ -∗ ∃ n, P ∗ ⌜φ n⌝ ∗ ⌜φ n⌝. Proof. iIntros "??". iDestruct select ⌜_⌝%I as %[n H]. iExists n. iFrame. by iSplit. Qed. Check "test_iDestruct_select_no_backtracking". Lemma test_iDestruct_select_no_backtracking P Q : □ P -∗ Q -∗ Q. Proof. iIntros "??". (* The following must fail since the pattern will match [Q], which cannot be introduced in the intuitionistic context. This demonstrates that tactics based on [iSelect] only act on the last hypothesis of the intuitionistic or spatial context that matches the pattern, and they do not backtrack if the requested action fails on the hypothesis. *) Fail iDestruct select _ as "#X". done. Qed. Lemma test_iDestruct_select_several_match P Q R : □ P -∗ □ Q -∗ □ R -∗ □ R. Proof. iIntros "???". (* This demonstrates that the last matching hypothesis is used for all the tactics based on [iSelect]. *) iDestruct select (□ _)%I as "$". Qed. Lemma test_iRevert_select_iClear_select P Q R : □ P -∗ □ Q -∗ □ R -∗ □ R. Proof. iIntros "???". iClear select (□ P)%I. iRevert select _. iClear select _. iIntros "$". Qed. Lemma test_iFrame_select P Q R : P -∗ (Q ∗ R) -∗ P ∗ Q ∗ R. Proof. iIntros "??". iFrame select (_ ∗ _)%I. iFrame select _. Qed. Lemma test_iDestruct_split_reuse_name P Q : P ∗ Q -∗ P ∗ Q. Proof. iIntros "H". iDestruct "H" as "[? H]". Undo. iDestruct "H" as "[H ?]". Undo. auto. Qed. Lemma test_iDestruct_split_reuse_name_2 P Q R : (P ∗ Q) ∗ R -∗ (P ∗ Q) ∗ R. Proof. iIntros "H". iDestruct "H" as "[[H H'] ?]". Undo. auto. Qed. Check "test_iDestruct_intuitionistic_not_fresh". Lemma test_iDestruct_intuitionistic_not_fresh P Q : P -∗ □ Q -∗ False. Proof. iIntros "H H'". Fail iDestruct "H'" as "#H". Abort. Check "test_iDestruct_spatial_not_fresh". Lemma test_iDestruct_spatial_not_fresh P Q : P -∗ Q -∗ False. Proof. iIntros "H H'". Fail iDestruct "H'" as "-#H". Abort. Lemma test_iIntros_subgoals (m : gmap nat nat) i x : ⊢@{PROP} ⌜kmap (M2 :=gmap nat) id m !! i = Some x⌝ → True. Proof. iStartProof. iIntros (?%lookup_kmap_Some). Abort. End tactic_tests. Section mutual_induction. Context {PROP : bi}. Implicit Types P Q R : PROP. Implicit Types φ : nat → PROP. Implicit Types Ψ : nat → nat → PROP. Unset Elimination Schemes. Inductive ntree := Tree : list ntree → ntree. (** The common induction principle for finitely branching trees. By default, Coq generates a too weak induction principle, so we have to prove it by hand. *) Lemma ntree_ind (φ : ntree → Prop) : (∀ l, Forall φ l → φ (Tree l)) → ∀ t, φ t. Proof. intros Hrec. fix REC 1. intros [l]. apply Hrec. clear Hrec. induction l as [|t l IH]; constructor; auto. Qed. (** Now let's test that we can derive the internal induction principle for finitely branching trees in separation logic. There are many variants of the induction principle, but we pick the variant with an induction hypothesis of the form [∀ x, ⌜ x ∈ l ⌝ → ...]. This is most interesting, since the proof mode generates a version with [[∗ list]]. *) Check "test_iInduction_Forall". Lemma test_iInduction_Forall (P : ntree → PROP) : □ (∀ l, (∀ x, ⌜ x ∈ l ⌝ → P x) -∗ P (Tree l)) -∗ ∀ t, P t. Proof. iIntros "#H" (t). iInduction t as [] "IH". Show. (* make sure that the induction hypothesis is exactly what we want *) iApply "H". iIntros (x ?). by iApply (big_sepL_elem_of with "IH"). Qed. (** Now let us define a custom version of [Forall], called [my_Forall], and use that in the variant [ntree_ind_alt] of the induction principle. The proof mode does not support [my_Forall], so we test if [iInduction] generates a proper error message. *) Inductive my_Forall {A} (φ : A → Prop) : list A → Prop := | my_Forall_nil : my_Forall φ [] | my_Forall_cons x l : φ x → my_Forall φ l → my_Forall φ (x :: l). Lemma ntree_ind_alt (φ : ntree → Prop) : (∀ l, my_Forall φ l → φ (Tree l)) → ∀ t, φ t. Proof. intros Hrec. fix REC 1. intros [l]. apply Hrec. clear Hrec. induction l as [|t l IH]; constructor; auto. Qed. Check "test_iInduction_Forall_fail". Lemma test_iInduction_Forall_fail (P : ntree → PROP) : □ (∀ l, ([∗ list] x ∈ l, P x) -∗ P (Tree l)) -∗ ∀ t, P t. Proof. iIntros "#H" (t). Fail iInduction t as [] "IH" using ntree_ind_alt. Abort. End mutual_induction. Section FrameDisjUnion. Context {PROP : bi}. Implicit Types P Q R : PROP. (** Making sure that [iFrame] does not diverge on evars gmultisets by turning them into disjoint union of new evars. *) Lemma test_iFrame_gmultiset_divergence `{Countable A} P Q : P ⊢ ∃ X : gmultiset A, [∗ mset] y ∈ X, Q. Proof. iIntros "?". iExists _. (* Makes no progress since there is nothing to do. *) Timeout 1 iFrame. Abort. (** Making sure that we can still frame in disjoint unions. *) Lemma test_iFrame_gmultiset_functionality `{Countable A} (X Y: gmultiset A) Q : ([∗ mset] y ∈ X, Q) ∗ ([∗ mset] y ∈ Y, Q) ⊢ [∗ mset] y ∈ X ⊎ Y, Q. Proof. iIntros "?". solve [iFrame]. Restart. Proof. iIntros "[??]". solve [iFrame]. Qed. End FrameDisjUnion. iris-iris-4.2.0/tests/proofmode_ascii.ref000066400000000000000000000120051460620107300204260ustar00rootroot000000000000001 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ cinvG0 : cinvG Σ na_invG0 : na_invG Σ N : namespace P : iProp Σ ============================ "H" : inv N ( P) "H2" : ▷ P --------------------------------------□ |={⊤ ∖ ↑N}=> ▷ P ∗ (|={⊤}=> ▷ P) 1 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ cinvG0 : cinvG Σ na_invG0 : na_invG Σ N : namespace P : iProp Σ ============================ "H" : inv N ( P) "H2" : ▷ P --------------------------------------□ "Hclose" : ▷ P ={⊤ ∖ ↑N,⊤}=∗ emp --------------------------------------∗ |={⊤ ∖ ↑N,⊤}=> ▷ P 1 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ cinvG0 : cinvG Σ na_invG0 : na_invG Σ γ : gname p : Qp N : namespace P : iProp Σ ============================ _ : cinv N γ ( P) "HP" : ▷ P --------------------------------------□ "Hown" : cinv_own γ p --------------------------------------∗ |={⊤ ∖ ↑N}=> ▷ P ∗ (|={⊤}=> cinv_own γ p ∗ ▷ P) 1 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ cinvG0 : cinvG Σ na_invG0 : na_invG Σ γ : gname p : Qp N : namespace P : iProp Σ ============================ _ : cinv N γ ( P) "HP" : ▷ P --------------------------------------□ "Hown" : cinv_own γ p "Hclose" : ▷ P ={⊤ ∖ ↑N,⊤}=∗ emp --------------------------------------∗ |={⊤ ∖ ↑N,⊤}=> cinv_own γ p ∗ ▷ P 1 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ cinvG0 : cinvG Σ na_invG0 : na_invG Σ t : na_inv_pool_name N : namespace E1, E2 : coPset P : iProp Σ H : ↑N ⊆ E2 ============================ _ : na_inv t N ( P) "HP" : ▷ P --------------------------------------□ "Hown1" : na_own t E1 "Hown2" : na_own t (E2 ∖ ↑N) --------------------------------------∗ |={⊤}=> (▷ P ∗ na_own t (E2 ∖ ↑N)) ∗ (na_own t E2 ={⊤}=∗ na_own t E1 ∗ na_own t E2 ∗ ▷ P) 1 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ cinvG0 : cinvG Σ na_invG0 : na_invG Σ t : na_inv_pool_name N : namespace E1, E2 : coPset P : iProp Σ H : ↑N ⊆ E2 ============================ _ : na_inv t N ( P) "HP" : ▷ P --------------------------------------□ "Hown1" : na_own t E1 "Hown2" : na_own t (E2 ∖ ↑N) "Hclose" : ▷ P ∗ na_own t (E2 ∖ ↑N) ={⊤}=∗ na_own t E2 --------------------------------------∗ |={⊤}=> na_own t E1 ∗ na_own t E2 ∗ ▷ P "test_iInv_12" : string The command has indeed failed with message: Tactic failure: iInv: selector 34 is not of the right type . The command has indeed failed with message: Tactic failure: iInv: invariant nroot not found. The command has indeed failed with message: Tactic failure: iInv: invariant "H2" not found. "test_iInv" : string 1 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ I : biIndex N : namespace E : coPset 𝓟 : iProp Σ H : ↑N ⊆ E ============================ "HP" : ⎡ ▷ 𝓟 ⎤ --------------------------------------∗ |={E ∖ ↑N}=> ⎡ ▷ 𝓟 ⎤ ∗ (|={E}=> emp) "test_iInv_with_close" : string 1 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ I : biIndex N : namespace E : coPset 𝓟 : iProp Σ H : ↑N ⊆ E ============================ "HP" : ⎡ ▷ 𝓟 ⎤ "Hclose" : ⎡ ▷ 𝓟 ={E ∖ ↑N,E}=∗ emp ⎤ --------------------------------------∗ |={E ∖ ↑N,E}=> emp "p1" : string 1 goal PROP : bi ============================ forall P (_ : True), bi_entails P P "p2" : string 1 goal PROP : bi ============================ forall P, and True (bi_entails P P) "p3" : string 1 goal PROP : bi ============================ ex (fun P => bi_entails P P) "p4" : string 1 goal PROP : bi ============================ bi_emp_valid (bi_exist (fun x : nat => bi_pure (eq x O))) "p5" : string 1 goal PROP : bi ============================ bi_emp_valid (bi_exist (fun _ : nat => bi_pure (forall y : nat, eq y y))) "p6" : string 1 goal PROP : bi ============================ ex (unique (fun z : nat => bi_emp_valid (bi_exist (fun _ : nat => bi_sep (bi_pure (forall y : nat, eq y y)) (bi_pure (eq z O)))))) "p7" : string 1 goal PROP : bi ============================ forall (a : nat) (_ : eq a O) (y : nat), bi_entails (bi_pure True) (bi_pure (ge y O)) "p8" : string 1 goal PROP : bi ============================ forall (a : nat) (_ : eq a O) (y : nat), bi_emp_valid (bi_pure (ge y O)) "p9" : string 1 goal PROP : bi ============================ forall (a : nat) (_ : eq a O) (_ : nat), bi_emp_valid (bi_forall (fun z : nat => bi_pure (ge z O))) iris-iris-4.2.0/tests/proofmode_ascii.v000066400000000000000000000257471460620107300201400ustar00rootroot00000000000000From 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. From iris.prelude Require Import options. From iris.bi Require Import ascii. Unset Mangle Names. (* Remove this and the [Set Printing Raw Literals.] below once we require Coq 8.14. *) Set Warnings "-unknown-option". Section base_logic_tests. Context {M : ucmra}. Implicit Types P Q R : uPred M. Lemma test_random_stuff (P1 P2 P3 : nat -> uPred M) : |- forall (x y : nat) a b, x ≡ y -> <#> (uPred_ownM (a ⋅ b) -* (exists y1 y2 c, P1 ((x + y1) + y2) /\ True /\ <#> uPred_ownM c) -* <#> |> (forall z, P2 z ∨ True -> P2 z) -* |> (forall n m : nat, P1 n -> <#> (True /\ P2 n -> <#> (⌜n = n⌝ <-> P3 n))) -* |> ⌜x = 0⌝ \/ exists x z, |> P3 (x + z) ** uPred_ownM b ** uPred_ownM (core b)). 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; first done. iApply "H2". iLeft. iApply "H2". by iRight. - done. Qed. Lemma test_iFrame_pure (x y z : M) : ✓ x -> ⌜y ≡ z⌝ |-@{uPredI M} ✓ x /\ ✓ x /\ y ≡ z. 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 (uPredI _). iIntros "$". Qed. Lemma test_iStartProof_4 P : P -* P. Proof. iStartProof (uPredI _). iStartProof (uPred _). iIntros "$". Qed. End base_logic_tests. Section iris_tests. Context `{!invGS_gen hlc Σ, !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 ( P) ={⊤}=* |> P. Proof. iIntros "#H". iInv N as "#H2". Show. iModIntro. iSplit; auto. Qed. Lemma test_iInv_0_with_close N P: inv N ( 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 ( P) ={E}=* |> P. Proof. iIntros (?) "#H". iInv N as "#H2". iModIntro. iSplit; auto. Qed. Lemma test_iInv_2 γ p N P: cinv N γ ( 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 γ ( 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 γ ( 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 ( 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 ( 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 ( 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 ( 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 ( 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 ( 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 ( 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 ( P) ={⊤}=* |> P. Proof. let H := iFresh in (iIntros H; iInv H as "#H2"). auto. Qed. (* error messages *) Check "test_iInv_12". Lemma test_iInv_12 N P: inv N ( 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. Theorem test_iApply_inG `{!inG Σ A} γ (x x' : A) : x' ≼ x -> own γ x -* own γ x'. Proof. intros. by iApply own_mono. Qed. End iris_tests. Section monpred_tests. Context `{!invGS_gen hlc Σ}. Context {I : biIndex}. Local Notation monPred := (monPred I (iPropI Σ)). Local Notation monPredI := (monPredI I (iPropI Σ)). Implicit Types P Q R : monPred. Implicit Types 𝓟 𝓠 𝓡 : iProp Σ. Check "test_iInv". Lemma test_iInv N E 𝓟 : ↑N ⊆ E -> ⎡inv N 𝓟⎤ |-@{monPredI} |={E}=> emp. Proof. iIntros (?) "Hinv". iInv N as "HP". Show. iFrame "HP". auto. Qed. Check "test_iInv_with_close". 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. (** Test specifically if certain things parse correctly. *) Section parsing_tests. Context {PROP : bi}. Implicit Types P : PROP. Lemma test_bi_emp_valid : |-@{PROP} True. Proof. naive_solver. Qed. Lemma test_bi_emp_valid_parens : (|-@{PROP} True) /\ ((|-@{PROP} True)). Proof. naive_solver. Qed. Lemma test_bi_emp_valid_parens_space_open : ( |-@{PROP} True). Proof. naive_solver. Qed. Lemma test_bi_emp_valid_parens_space_close : (|-@{PROP} True ). Proof. naive_solver. Qed. Lemma test_entails_annot_sections P : (P |-@{PROP} P) /\ (|-@{PROP}) P P /\ (P -|-@{PROP} P) /\ (-|-@{PROP}) P P. Proof. naive_solver. Qed. Lemma test_entails_annot_sections_parens P : ((P |-@{PROP} P)) /\ ((|-@{PROP})) P P /\ ((P -|-@{PROP} P)) /\ ((-|-@{PROP})) P P. Proof. naive_solver. Qed. Lemma test_entails_annot_sections_space_open P : ( P |-@{PROP} P) /\ ( P -|-@{PROP} P). Proof. naive_solver. Qed. Lemma test_entails_annot_sections_space_close P : (P |-@{PROP} P ) /\ (|-@{PROP} ) P P /\ (P -|-@{PROP} P ) /\ (-|-@{PROP} ) P P. Proof. naive_solver. Qed. (* Make sure these all parse as they should. To make the [Check] print correctly, we need to set and reset the printing settings each time. *) Check "p1". Lemma p1 : forall P, True -> P |- P. Proof. Unset Printing Notations. Set Printing Raw Literals. Show. Set Printing Notations. Unset Printing Raw Literals. Abort. Check "p2". Lemma p2 : forall P, True /\ (P |- P). Proof. Unset Printing Notations. Set Printing Raw Literals. Show. Set Printing Notations. Unset Printing Raw Literals. Abort. Check "p3". Lemma p3 : exists P, P |- P. Proof. Unset Printing Notations. Set Printing Raw Literals. Show. Set Printing Notations. Unset Printing Raw Literals. Abort. Check "p4". Lemma p4 : |-@{PROP} exists (x : nat), ⌜x = 0⌝. Proof. Unset Printing Notations. Set Printing Raw Literals. Show. Set Printing Notations. Unset Printing Raw Literals. Abort. Check "p5". Lemma p5 : |-@{PROP} exists (x : nat), ⌜forall y : nat, y = y⌝. Proof. Unset Printing Notations. Set Printing Raw Literals. Show. Set Printing Notations. Unset Printing Raw Literals. Abort. Check "p6". Lemma p6 : exists! (z : nat), |-@{PROP} exists (x : nat), ⌜forall y : nat, y = y⌝ ** ⌜z = 0⌝. Proof. Unset Printing Notations. Set Printing Raw Literals. Show. Set Printing Notations. Unset Printing Raw Literals. Abort. Check "p7". Lemma p7 : forall (a : nat), a = 0 -> forall y, True |-@{PROP} ⌜y >= 0⌝. Proof. Unset Printing Notations. Set Printing Raw Literals. Show. Set Printing Notations. Unset Printing Raw Literals. Abort. Check "p8". Lemma p8 : forall (a : nat), a = 0 -> forall y, |-@{PROP} ⌜y >= 0⌝. Proof. Unset Printing Notations. Set Printing Raw Literals. Show. Set Printing Notations. Unset Printing Raw Literals. Abort. Check "p9". Lemma p9 : forall (a : nat), a = 0 -> forall y : nat, |-@{PROP} forall z : nat, ⌜z >= 0⌝. Proof. Unset Printing Notations. Set Printing Raw Literals. Show. Set Printing Notations. Unset Printing Raw Literals. Abort. End parsing_tests. iris-iris-4.2.0/tests/proofmode_iris.ref000066400000000000000000000165451460620107300203210ustar00rootroot000000000000001 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ cinvG0 : cinvG Σ na_invG0 : na_invG Σ N : namespace P : iProp Σ ============================ "H" : inv N ( P) "H2" : ▷ P --------------------------------------□ |={⊤ ∖ ↑N}=> ▷ P ∗ (|={⊤}=> ▷ P) 1 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ cinvG0 : cinvG Σ na_invG0 : na_invG Σ N : namespace P : iProp Σ ============================ "H" : inv N ( P) "H2" : ▷ P --------------------------------------□ "Hclose" : ▷ P ={⊤ ∖ ↑N,⊤}=∗ emp --------------------------------------∗ |={⊤ ∖ ↑N,⊤}=> ▷ P 1 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ cinvG0 : cinvG Σ na_invG0 : na_invG Σ γ : gname p : Qp N : namespace P : iProp Σ ============================ cinv N γ ( P) ∗ cinv_own γ p ={⊤}=∗ cinv_own γ p ∗ ▷ P 1 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ cinvG0 : cinvG Σ na_invG0 : na_invG Σ γ : gname p : Qp N : namespace P : iProp Σ ============================ _ : cinv N γ ( P) "HP" : ▷ P --------------------------------------□ "Hown" : cinv_own γ p --------------------------------------∗ |={⊤ ∖ ↑N}=> ▷ P ∗ (|={⊤}=> cinv_own γ p ∗ ▷ P) "test_iInv_2_with_close" : string 1 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ cinvG0 : cinvG Σ na_invG0 : na_invG Σ γ : gname p : Qp N : namespace P : iProp Σ ============================ _ : cinv N γ ( P) "HP" : ▷ P --------------------------------------□ "Hown" : cinv_own γ p "Hclose" : ▷ P ={⊤ ∖ ↑N,⊤}=∗ emp --------------------------------------∗ |={⊤ ∖ ↑N,⊤}=> cinv_own γ p ∗ ▷ P "test_iInv_4" : string 1 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ cinvG0 : cinvG Σ na_invG0 : na_invG Σ t : na_inv_pool_name N : namespace E1, E2 : coPset P : iProp Σ H : ↑N ⊆ E2 ============================ _ : na_inv t N ( P) "HP" : ▷ P --------------------------------------□ "Hown1" : na_own t E1 "Hown2" : na_own t (E2 ∖ ↑N) --------------------------------------∗ |={⊤}=> (▷ P ∗ na_own t (E2 ∖ ↑N)) ∗ (na_own t E2 ={⊤}=∗ na_own t E1 ∗ na_own t E2 ∗ ▷ P) "test_iInv_4_with_close" : string 1 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ cinvG0 : cinvG Σ na_invG0 : na_invG Σ t : na_inv_pool_name N : namespace E1, E2 : coPset P : iProp Σ H : ↑N ⊆ E2 ============================ _ : na_inv t N ( P) "HP" : ▷ P --------------------------------------□ "Hown1" : na_own t E1 "Hown2" : na_own t (E2 ∖ ↑N) "Hclose" : ▷ P ∗ na_own t (E2 ∖ ↑N) ={⊤}=∗ na_own t E2 --------------------------------------∗ |={⊤}=> na_own t E1 ∗ na_own t E2 ∗ ▷ P "test_iInv_12" : string The command has indeed failed with message: Tactic failure: iInv: selector 34 is not of the right type . The command has indeed failed with message: Tactic failure: iInv: invariant nroot not found. The command has indeed failed with message: Tactic failure: iInv: invariant "H2" not found. "test_iInv_accessor_variable" : string The command has indeed failed with message: Tactic failure: Missing intro pattern for accessor variable. The command has indeed failed with message: Tactic failure: Missing intro pattern for accessor variable. The command has indeed failed with message: Tactic failure: Missing intro pattern for accessor variable. The command has indeed failed with message: Tactic failure: Missing intro pattern for accessor variable. "test_frac_split_combine" : string 1 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ cinvG0 : cinvG Σ na_invG0 : na_invG Σ inG0 : inG Σ fracR γ : gname ============================ "H1" : own γ (1 / 2)%Qp "H2" : own γ (1 / 2)%Qp --------------------------------------∗ own γ 1%Qp 1 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ cinvG0 : cinvG Σ na_invG0 : na_invG Σ inG0 : inG Σ fracR γ : gname ============================ "H" : own γ 1%Qp --------------------------------------∗ own γ 1%Qp "test_iDestruct_mod_not_fresh" : string The command has indeed failed with message: Tactic failure: iMod: "H" not fresh. "test_iIntros_lc" : string 1 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ cinvG0 : cinvG Σ na_invG0 : na_invG Σ n, m : nat ============================ "Hlc1" : £ (S n) "Hlc2" : £ m --------------------------------------∗ £ (S n) "lc_iSplit_lc" : string 2 goals hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ cinvG0 : cinvG Σ na_invG0 : na_invG Σ n, m : nat ============================ "Hlc1" : £ (S n) --------------------------------------∗ £ (S n) goal 2 is: "Hlc2" : £ m --------------------------------------∗ £ m "test_iCombine_pointsto_no_beta" : string 1 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ cinvG0 : cinvG Σ na_invG0 : na_invG Σ ghost_varG0 : ghost_varG Σ nat l : gname v : nat q1, q2 : Qp ============================ "H" : ghost_var l (q1 + q2) v --------------------------------------∗ ghost_var l (q1 + q2) v "iMod_WP_mask_mismatch" : string The command has indeed failed with message: Tactic failure: "Goal and eliminated modality must have the same mask. Use [iApply fupd_wp; iMod (fupd_mask_subseteq E2)] to adjust the mask of your goal to [E2]". The command has indeed failed with message: Tactic failure: "Goal and eliminated modality must have the same mask. Use [iApply fupd_wp; iMod (fupd_mask_subseteq E2)] to adjust the mask of your goal to [E2]". "iMod_WP_atomic_mask_mismatch" : string The command has indeed failed with message: Tactic failure: "Goal and eliminated modality must have the same mask. Use [iMod (fupd_mask_subseteq E2)] to adjust the mask of your goal to [E2]". The command has indeed failed with message: Tactic failure: "Goal and eliminated modality must have the same mask. Use [iMod (fupd_mask_subseteq E2)] to adjust the mask of your goal to [E2]". "iFrame_WP_no_instantiate" : string 1 goal hlc : has_lc Λ : language Σ : gFunctors irisGS_gen0 : irisGS_gen hlc Λ Σ e : expr Λ Φ : nat → iProp Σ ============================ _ : Φ 0 --------------------------------------□ WP e {{ _, ∃ n : nat, Φ n }} "test_iInv" : string 1 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ I : biIndex N : namespace E : coPset 𝓟 : iProp Σ H : ↑N ⊆ E ============================ "HP" : ⎡ ▷ 𝓟 ⎤ --------------------------------------∗ |={E ∖ ↑N}=> ⎡ ▷ 𝓟 ⎤ ∗ (|={E}=> emp) "test_iInv_with_close" : string 1 goal hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ I : biIndex N : namespace E : coPset 𝓟 : iProp Σ H : ↑N ⊆ E ============================ "HP" : ⎡ ▷ 𝓟 ⎤ "Hclose" : ⎡ ▷ 𝓟 ={E ∖ ↑N,E}=∗ emp ⎤ --------------------------------------∗ |={E ∖ ↑N,E}=> emp iris-iris-4.2.0/tests/proofmode_iris.v000066400000000000000000000274001460620107300200020ustar00rootroot00000000000000From iris.algebra Require Import frac. 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 ghost_var. From iris.program_logic Require Import weakestpre. From iris.prelude Require Import options. Unset Mangle Names. Set Default Proof Using "Type*". Section base_logic_tests. Context {M : ucmra}. 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)). 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; first 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 (uPredI _). iIntros "$". Qed. Lemma test_iStartProof_4 P : P -∗ P. Proof. iStartProof (uPredI _). iStartProof (uPred _). iIntros "$". Qed. End base_logic_tests. Section iris_tests. Context `{!invGS_gen hlc Σ, !cinvG Σ, !na_invG Σ}. Implicit Types P Q R : iProp Σ. Lemma test_except_0_inv N P : ▷ False -∗ inv N P. Proof. iIntros "H". by iMod "H". (* works because invariants are [IsExcept0] *) Qed. 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 ( P) ={⊤}=∗ ▷ P. Proof. iIntros "#H". iInv N as "#H2". Show. iModIntro. iSplit; auto. Qed. Lemma test_iInv_0_with_close N P: inv N ( 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 ( P) ={E}=∗ ▷ P. Proof. iIntros (?) "#H". iInv N as "#H2". iModIntro. iSplit; auto. Qed. Lemma test_iInv_2 γ p N P: cinv N γ ( P) ∗ cinv_own γ p ={⊤}=∗ cinv_own γ p ∗ ▷ P. Proof. Show. iIntros "(#?&?)". iInv N as "(#HP&Hown)". Show. iModIntro. iSplit; auto with iFrame. Qed. Check "test_iInv_2_with_close". Lemma test_iInv_2_with_close γ p N P: cinv N γ ( 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 γ ( 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. Check "test_iInv_4". Lemma test_iInv_4 t N E1 E2 P: ↑N ⊆ E2 → na_inv t N ( 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. Check "test_iInv_4_with_close". Lemma test_iInv_4_with_close t N E1 E2 P: ↑N ⊆ E2 → na_inv t N ( 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 ( 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 ( 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 ( 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 ( 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 ( 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 ( P) ={⊤}=∗ ▷ P. Proof. let H := iFresh in (iIntros H; iInv H as "#H2"). auto. Qed. (* error messages *) Check "test_iInv_12". Lemma test_iInv_12 N P: inv N ( 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. (* Test [iInv] with accessor variables. *) Section iInv_accessor_variables. (** We consider a kind of invariant that does not take a proposition, but a predicate. The invariant accessor gives the predicate existentially. *) Context (INV : (bool → iProp Σ) → iProp Σ). Context `{!∀ Φ, IntoAcc (INV Φ) True True (fupd ⊤ ∅) (fupd ∅ ⊤) Φ Φ (λ b, Some (INV Φ))}. Check "test_iInv_accessor_variable". Lemma test_iInv_accessor_variable Φ : INV Φ ={⊤}=∗ INV Φ. Proof. iIntros "HINV". (* There are 4 variants of [iInv] that we have to test *) (* No selection pattern, no closing view shift *) Fail iInv "HINV" as "HINVinner". iInv "HINV" as (b) "HINVinner"; rename b into b_exists. Undo. (* Both sel.pattern and closing view shift *) Fail iInv "HINV" with "[//]" as "HINVinner" "Hclose". iInv "HINV" with "[//]" as (b) "HINVinner" "Hclose"; rename b into b_exists. Undo. (* Sel.pattern but no closing view shift *) Fail iInv "HINV" with "[//]" as "HINVinner". iInv "HINV" with "[//]" as (b) "HINVinner"; rename b into b_exists. Undo. (* Closing view shift, no selection pattern *) Fail iInv "HINV" as "HINVinner" "Hclose". iInv "HINV" as (b) "HINVinner" "Hclose"; rename b into b_exists. by iApply "Hclose". Qed. End iInv_accessor_variables. Theorem test_iApply_inG `{!inG Σ A} γ (x x' : A) : x' ≼ x → own γ x -∗ own γ x'. Proof. intros. by iApply own_mono. Qed. Check "test_frac_split_combine". Lemma test_frac_split_combine `{!inG Σ fracR} γ : own γ 1%Qp -∗ own γ 1%Qp. Proof. iIntros "[H1 H2]". Show. iCombine "H1 H2" as "H". Show. iExact "H". Qed. Check "test_iDestruct_mod_not_fresh". Lemma test_iDestruct_mod_not_fresh P Q : P -∗ (|={⊤}=> Q) -∗ (|={⊤}=> False). Proof. iIntros "H H'". Fail iDestruct "H'" as ">H". Abort. (** Make sure that the splitting rule for [+] gets preferred over the one for [S]. See issue #470. *) Check "test_iIntros_lc". Lemma test_iIntros_lc n m : £ (S n + m) -∗ £ (S n). Proof. iIntros "[Hlc1 Hlc2]". Show. iExact "Hlc1". Qed. Check "lc_iSplit_lc". Lemma lc_iSplit_lc n m : £ (S n) -∗ £ m -∗ £ (S n + m). Proof. iIntros "Hlc1 Hlc2". iSplitL "Hlc1". Show. all: done. Qed. (** Make sure [iCombine] doesn't leave behind beta redexes. *) Check "test_iCombine_pointsto_no_beta". Lemma test_iCombine_ghost_var_no_beta `{!ghost_varG Σ nat} l (v : nat) q1 q2 : ghost_var l q1 v -∗ ghost_var l q2 v -∗ ghost_var l (q1+q2) v. Proof. iIntros "H1 H2". iCombine "H1 H2" as "H". Show. done. Qed. End iris_tests. Section WP_tests. Context `{!irisGS_gen hlc Λ Σ}. Implicit Types P Q R : iProp Σ. Check "iMod_WP_mask_mismatch". Lemma iMod_WP_mask_mismatch E1 E2 P (e : expr Λ) : (|={E2}=> P) ⊢ WP e @ E1 {{ _, True }}. Proof. Fail iIntros ">HP". iIntros "HP". Fail iMod "HP". iApply fupd_wp; iMod (fupd_mask_subseteq E2). Abort. Check "iMod_WP_atomic_mask_mismatch". Lemma iMod_WP_atomic_mask_mismatch E1 E2 E2' P (e : expr Λ) : (|={E2,E2'}=> P) ⊢ WP e @ E1 {{ _, True }}. Proof. Fail iIntros ">HP". iIntros "HP". Fail iMod "HP". iMod (fupd_mask_subseteq E2). Abort. Check "iFrame_WP_no_instantiate". Lemma iFrame_WP_no_instantiate (e : expr Λ) (Φ : nat → iProp Σ) : □ Φ 0 ⊢ WP e {{ _, Φ 0 ∗ ∃ n, Φ n }}. Proof. iIntros "#$". (* [Φ 0] should get framed, [∃ n, Φ n] should remain untouched *) Show. Abort. End WP_tests. Section monpred_tests. Context `{!invGS_gen hlc Σ}. Context {I : biIndex}. Local Notation monPred := (monPred I (iPropI Σ)). Local Notation monPredI := (monPredI I (iPropI Σ)). Implicit Types P Q R : monPred. Implicit Types 𝓟 𝓠 𝓡 : iProp Σ. Check "test_iInv". Lemma test_iInv N E 𝓟 : ↑N ⊆ E → ⎡inv N 𝓟⎤ ⊢@{monPredI} |={E}=> emp. Proof. iIntros (?) "Hinv". iInv N as "HP". Show. iFrame "HP". auto. Qed. Check "test_iInv_with_close". 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. iris-iris-4.2.0/tests/proofmode_monpred.ref000066400000000000000000000034221460620107300210050ustar00rootroot000000000000001 goal I : biIndex PROP : bi P, Q : monPred i : I ============================ "HW" : (P -∗ Q) i --------------------------------------∗ (P -∗ Q) i 1 goal I : biIndex PROP : bi P, Q : monPred i, j : I ============================ "HW" : (P -∗ Q) j "HP" : P j --------------------------------------∗ Q j 1 goal I : biIndex PROP : bi P, Q : monPred Objective0 : Objective Q 𝓟, 𝓠 : PROP ============================ "H2" : ∀ i, Q i "H3" : 𝓟 "H4" : 𝓠 --------------------------------------∗ ∀ i, 𝓟 ∗ 𝓠 ∗ Q i 1 goal I : biIndex PROP : bi FU : BiFUpd PROP P, Q : monPred i : I ============================ --------------------------------------∗ (Q -∗ emp) i 1 goal I : biIndex PROP : bi FU : BiFUpd PROP P : monPred i : I ============================ --------------------------------------∗ ∀ _ : (), ∃ _ : (), emp The command has indeed failed with message: Tactic failure: iFrame: cannot frame (P i). 1 goal I : biIndex hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ N : namespace 𝓟 : iProp Σ ============================ "H" : ⎡ inv N ( 𝓟) ⎤ "H2" : ⎡ ▷ 𝓟 ⎤ --------------------------------------□ |={⊤ ∖ ↑N}=> ⎡ ▷ 𝓟 ⎤ ∗ (|={⊤}=> ⎡ ▷ 𝓟 ⎤) 1 goal I : biIndex hlc : has_lc Σ : gFunctors invGS_gen0 : invGS_gen hlc Σ N : namespace 𝓟 : iProp Σ ============================ "H" : ⎡ inv N ( 𝓟) ⎤ "H2" : ⎡ ▷ 𝓟 ⎤ --------------------------------------□ "Hclose" : ⎡ ▷ 𝓟 ={⊤ ∖ ↑N,⊤}=∗ emp ⎤ --------------------------------------∗ |={⊤ ∖ ↑N,⊤}=> ⎡ ▷ 𝓟 ⎤ iris-iris-4.2.0/tests/proofmode_monpred.v000066400000000000000000000173771460620107300205140ustar00rootroot00000000000000From iris.bi.lib Require Import fractional. From iris.proofmode Require Import tactics monpred. From iris.base_logic.lib Require Import invariants ghost_var. From iris.prelude Require Import options. Unset Mangle Names. Section tests. Context {I : biIndex} {PROP : bi}. Local Notation monPred := (monPred I PROP). Local Notation monPredI := (monPredI 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 monPredI. iIntros "$". Qed. Lemma test_iStartProof_4 P : P -∗ P. Proof. iStartProof monPredI. 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 `{!BiInternalEq PROP} P : ⊢@{monPredI} P ≡ P. 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⎤) ⊢@{monPredI} ⎡P -∗ Q⎤. Proof. iIntros "H HP". by iApply "H". Qed. Lemma test_objectively `{!BiPersistentlyForall PROP} P Q : emp -∗ P -∗ Q -∗ (P ∗ Q). Proof. iIntros "#? HP HQ". iModIntro. by iSplitL "HP". Qed. Lemma test_objectively_absorbing `{!BiPersistentlyForall PROP} P Q R `{!Absorbing P} : emp -∗ P -∗ Q -∗ R -∗ (P ∗ Q). Proof. iIntros "#? HP HQ HR". iModIntro. by iSplitL "HP". Qed. Lemma test_objectively_affine `{!BiPersistentlyForall PROP} P Q R `{!Affine R} : emp -∗ P -∗ Q -∗ R -∗ (P ∗ Q). Proof. iIntros "#? HP HQ HR". iModIntro. by iSplitL "HP". Qed. Lemma test_iModIntro_embed P `{!Affine Q} 𝓟 𝓠 : □ P -∗ Q -∗ ⎡𝓟⎤ -∗ ⎡𝓠⎤ -∗ ⎡ 𝓟 ∗ 𝓠 ⎤. Proof. iIntros "#H1 _ H2 H3". iModIntro. iFrame. Qed. Lemma test_iModIntro_embed_objective P `{!Objective Q} 𝓟 𝓠 : □ P -∗ Q -∗ ⎡𝓟⎤ -∗ ⎡𝓠⎤ -∗ ⎡ ∀ i, 𝓟 ∗ 𝓠 ∗ Q i ⎤. Proof. iIntros "#H1 H2 H3 H4". iModIntro. 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. Lemma test_monPred_at_and_pure P i j : (monPred_in j ∧ P) i ⊢ ⌜ j ⊑ i ⌝ ∧ P i. Proof. iDestruct 1 as "[% $]". done. Qed. Lemma test_monPred_at_sep_pure P i j : (monPred_in j ∗ P) i ⊢ ⌜ j ⊑ i ⌝ ∧ P i. Proof. iDestruct 1 as "[% ?]". auto. Qed. Context (FU : BiFUpd PROP). Lemma test_apply_fupd_intro_mask_subseteq E1 E2 P : E2 ⊆ E1 → P -∗ |={E1,E2}=> |={E2,E1}=> P. Proof. iIntros. by iApply @fupd_mask_intro_subseteq. Qed. Lemma test_apply_fupd_mask_subseteq E1 E2 P : E2 ⊆ E1 → P -∗ |={E1,E2}=> |={E2,E1}=> P. Proof. iIntros. iFrame. by iApply @fupd_mask_subseteq. 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. Section tests_iprop. Context {I : biIndex} `{!invGS_gen hlc Σ}. Local Notation monPred := (monPred I (iPropI Σ)). Local Notation monPredI := (monPredI I (iPropI Σ)). Implicit Types P Q R : monPred. Implicit Types 𝓟 𝓠 𝓡 : iProp Σ. Lemma test_iInv_0 N 𝓟 : embed (B:=monPred) (inv N ( 𝓟)) ={⊤}=∗ ⎡▷ 𝓟⎤. Proof. iIntros "#H". iInv N as "#H2". Show. iModIntro. iSplit=>//. iModIntro. iModIntro; auto. Qed. Lemma test_iInv_0_with_close N 𝓟 : embed (B:=monPred) (inv N ( 𝓟)) ={⊤}=∗ ⎡▷ 𝓟⎤. Proof. iIntros "#H". iInv N as "#H2" "Hclose". Show. iMod ("Hclose" with "H2"). iModIntro. iModIntro. by iNext. Qed. Lemma test_iPoseProof `{inG Σ A} P γ (x y : A) : x ~~> y → P ∗ ⎡own γ x⎤ ==∗ ⎡own γ y⎤. Proof. iIntros (?) "[_ Hγ]". iPoseProof (own_update with "Hγ") as "H"; first done. by iMod "H". Qed. Lemma test_embed_fractional `{!ghost_varG Σ A} γ q (a : A) : ⎡ghost_var γ q a⎤ ⊢@{monPredI} ⎡ghost_var γ (q/2) a⎤ ∗ ⎡ghost_var γ (q/2) a⎤. Proof. iIntros "[$ $]". Qed. Lemma test_embed_combine `{!ghost_varG Σ A} γ q (a1 a2 : A) : ▷ ⎡ghost_var γ (q/2) a1⎤ ∗ ▷ ⎡ghost_var γ (q/2) a2⎤ ⊢@{monPredI} ▷⎡ghost_var γ q a1⎤ ∗ ▷ ⌜a1 = a2⌝. Proof. iIntros "[H1 H2]". iCombine "H1 H2" as "$" gives "#H". iNext. by iDestruct "H" as %[_ ->]. Qed. End tests_iprop. iris-iris-4.2.0/tests/proofmode_siprop.ref000066400000000000000000000000001460620107300206420ustar00rootroot00000000000000iris-iris-4.2.0/tests/proofmode_siprop.v000066400000000000000000000012721460620107300203470ustar00rootroot00000000000000From iris.proofmode Require Import tactics. From iris.si_logic Require Import bi. From iris.prelude Require Import options. Section si_logic_tests. Implicit Types P Q R : siProp. Lemma test_everything_persistent P : P -∗ P. Proof. by iIntros "#HP". Qed. Lemma test_everything_affine P : P -∗ True. Proof. by iIntros "_". Qed. Lemma test_iIntro_impl P Q R : ⊢ P → Q ∧ R → P ∧ R. Proof. iIntros "#HP #[HQ HR]". auto. Qed. Lemma test_iApply_impl_1 P Q R : ⊢ P → (P → Q) → Q. Proof. iIntros "HP HPQ". by iApply "HPQ". Qed. Lemma test_iApply_impl_2 P Q R : ⊢ P → (P → Q) → Q. Proof. iIntros "#HP #HPQ". by iApply "HPQ". Qed. End si_logic_tests. iris-iris-4.2.0/tests/siprop.ref000066400000000000000000000007631460620107300166100ustar00rootroot00000000000000"unseal_test" : string 1 goal P, Q : siProp Φ : nat → siProp ============================ siprop.siProp_and_def P (siprop.siProp_and_def (siprop.siProp_later_def Q) (siprop.siProp_exist_def (λ x : nat, Φ x))) ⊣⊢ siprop.siProp_exist_def (λ x : nat, siprop.siProp_or_def (siprop.siProp_and_def P (siprop.siProp_and_def (siprop.siProp_later_def Q) (siprop.siProp_pure_def True))) (Φ x)) iris-iris-4.2.0/tests/siprop.v000066400000000000000000000006501460620107300162740ustar00rootroot00000000000000From stdpp Require Import strings. From iris.si_logic Require Import bi. Unset Mangle Names. Check "unseal_test". Lemma unseal_test (P Q : siProp) (Φ : nat → siProp) : P ∧ ▷ Q ∧ (∃ x, Φ x) ⊣⊢ ∃ x, P ∗ ▷ Q ∧ emp ∨ Φ x. Proof. siProp.unseal. Show. Abort. (** Make sure that [siProp]s are parsed in [bi_scope]. *) Definition test : siProp := ▷ True. Definition testI : siPropI := ▷ True. iris-iris-4.2.0/tests/string_ident.ref000066400000000000000000000007421460620107300177620ustar00rootroot00000000000000"test_invalid_ident" : string The command has indeed failed with message: Uncaught Ltac2 exception: StringToIdent.InvalidIdent "has a space" "test_not_string" : string The command has indeed failed with message: Uncaught Ltac2 exception: StringToIdent.NotStringLiteral constr:(4) "test_not_literal" : string The command has indeed failed with message: Uncaught Ltac2 exception: StringToIdent.NotStringLiteral constr:(s) "test_string_to_ident_not_fresh" : string iris-iris-4.2.0/tests/string_ident.v000066400000000000000000000020041460620107300174440ustar00rootroot00000000000000From iris.proofmode Require Import string_ident. From Coq Require Import Strings.String. From stdpp Require Import base. Local Open Scope string. Lemma test_basic_ident : ∀ (n:nat), n = n. Proof. let x := fresh in intros x; rename_by_string x "n". exact (eq_refl n). Qed. Check "test_invalid_ident". Lemma test_invalid_ident : ∀ (n:nat), True. Proof. Fail let x := fresh in intros x; rename_by_string x "has a space". Abort. Check "test_not_string". Lemma test_not_string : ∀ (n:nat), True. Proof. Fail let x := fresh in intros x; rename_by_string x 4. Abort. Check "test_not_literal". Lemma test_not_literal (s:string) : ∀ (n:nat), True. Proof. Fail let x := fresh in intros x; rename_by_string x s. Abort. Check "test_string_to_ident_not_fresh". Lemma test_string_to_ident_not_fresh (n:nat) : ∀ (n:nat), nat. Proof. (* we want to check that this [string_to_ident "n"] call succeeds even with [n] in the context *) string_to_ident_cps "n" ltac:(fun x => let x := fresh x in intros x). Abort. iris-iris-4.2.0/tests/telescopes.ref000066400000000000000000000047101460620107300174360ustar00rootroot000000000000001 goal PROP : bi 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 goal PROP : bi BiFUpd0 : BiFUpd PROP X : tele E1, E2 : coPset α, β, γ1, γ2 : X → PROP ============================ accessor E1 E2 α β γ1 -∗ accessor E1 E2 α β (λ.. x : X, γ1 x ∨ γ2 x) 1 goal PROP : bi BiFUpd0 : BiFUpd PROP X : tele E1, E2 : coPset α, β, γ1, γ2 : X → PROP x : X ============================ "Hγ1" : γ1 x --------------------------------------∗ (λ.. x0 : X, γ1 x0 ∨ γ2 x0) x 1 goal PROP : bi BiFUpd0 : BiFUpd PROP X : tele E1, E2 : coPset α, β, γ1, γ2 : X → PROP x : X ============================ "Hγ1" : γ1 x --------------------------------------∗ γ1 x ∨ γ2 x 1 goal PROP : bi BiFUpd0 : BiFUpd PROP E1, E2 : coPset ============================ "H" : ∃ x x0 : nat, ⌜x = x0⌝ ∗ (True ={E2,E1}=∗ ⌜x ≠ x0⌝) --------------------------------------∗ |={E2,E1}=> False "test1_test" : string 1 goal PROP : bi x : nat ============================ "H" : ∃ x0 : nat, ⌜x = x0⌝ --------------------------------------∗ ▷ False 1 goal PROP : bi x : nat ============================ "H" : ∃ x0 : nat, ⌜x = x0⌝ --------------------------------------∗ ▷ False "test2_test" : string 1 goal PROP : bi ============================ "H" : ∃ x x0 : nat, ⌜x = x0⌝ --------------------------------------∗ False 1 goal PROP : bi x : nat ============================ "H" : ∃ x0 : nat, ⌜x = x0⌝ --------------------------------------∗ False 1 goal PROP : bi x : nat ============================ "H" : ▷ ∃ x0 : nat, ⌜x = x0⌝ --------------------------------------∗ ▷ False "test3_test" : string 1 goal PROP : bi x : nat ============================ "H" : ∃ x0 : nat, ⌜x = x0⌝ --------------------------------------∗ ▷ False 1 goal PROP : bi x : nat ============================ "H" : ◇ ∃ x0 : nat, ⌜x = x0⌝ --------------------------------------∗ ▷ False iris-iris-4.2.0/tests/telescopes.v000066400000000000000000000160221460620107300171260ustar00rootroot00000000000000From stdpp Require Import coPset namespaces. From iris.proofmode Require Import tactics. From iris.prelude Require Import options. Unset Mangle Names. Section basic_tests. Context {PROP : bi}. Implicit Types P Q R : PROP. Lemma test_iIntros_tforall {TT : tele} (Φ : TT → PROP) : ⊢ ∀.. x, Φ x -∗ Φ x. Proof. iIntros (x) "H". done. Qed. Lemma test_iPoseProof_tforall {TT : tele} P (Φ : TT → PROP) : (∀.. x, P ⊢ Φ x) → P -∗ ∀.. x, Φ x. Proof. iIntros (H1) "H2"; iIntros (x). iPoseProof (H1) as "H1". by iApply "H1". Qed. Lemma test_iApply_tforall {TT : tele} P (Φ : TT → PROP) : (∀.. x, P -∗ Φ x) -∗ P -∗ ∀.. x, Φ x. Proof. iIntros "H1 H2" (x). by iApply "H1". Qed. Lemma test_iAssumption_tforall {TT : tele} (Φ : TT → PROP) : (∀.. x, Φ x) -∗ ∀.. x, Φ x. Proof. iIntros "H" (x). iAssumption. Qed. Lemma test_exist_texist_auto_name {TT : tele} (Φ : TT → PROP) : (∃.. y, Φ y) -∗ ∃.. x, Φ x. Proof. iDestruct 1 as (?) "H". by iExists y. Qed. Lemma test_pure_texist {TT : tele} (φ : TT → Prop) : (∃.. x, ⌜ φ x ⌝) -∗ ∃.. x, ⌜ φ x ⌝ : PROP. Proof. iIntros (H) "!%". done. Qed. Lemma test_pure_tforall `{!BiPureForall PROP} {TT : tele} (φ : TT → Prop) : (∀.. x, ⌜ φ x ⌝) -∗ ∀.. x, ⌜ φ x ⌝ : PROP. Proof. iIntros (H) "!%". done. Qed. Lemma test_pure_tforall_persistent `{!BiPersistentlyForall PROP} {TT : tele} (Φ : TT → PROP) : (∀.. x, (Φ x)) -∗ ∀.. x, Φ x. Proof. iIntros "#H !>" (x). done. Qed. Lemma test_pure_texists_intuitionistic {TT : tele} (Φ : TT → PROP) : (∃.. x, □ (Φ x)) -∗ □ ∃.. x, Φ x. Proof. iDestruct 1 as (x) "#H". iExists (x). done. Qed. Lemma test_iMod_tforall {TT : tele} P (Φ : TT → PROP) : ◇ P -∗ (∀.. x, Φ x) -∗ ∀.. x, ◇ (P ∗ Φ x). Proof. iIntros ">H1 H2" (x) "!> {$H1}". done. Qed. Lemma test_timeless_tforall {TT : tele} (φ : TT → Prop) : ▷ (∀.. x, ⌜ φ x ⌝) -∗ ◇ ∀.. x, ⌜ φ x ⌝ : PROP. Proof. iIntros ">H1 !>". done. Qed. Lemma test_timeless_texist {TT : tele} (φ : TT → Prop) : ▷ (∃.. x, ⌜ φ x ⌝) -∗ ◇ ∃.. x, ⌜ φ x ⌝ : PROP. Proof. iIntros ">H1 !>". done. Qed. Lemma test_add_model_texist `{!BiBUpd PROP} {TT : tele} P Q (Φ : TT → PROP) : (|==> P) -∗ (P -∗ Q) -∗ ∀.. x, |==> Q ∗ (Φ x -∗ Φ x). Proof. iIntros "H1 H2". iDestruct ("H2" with "[> $H1]") as "$". auto. Qed. Lemma test_iFrame_tforall {TT : tele} P (Φ : TT → PROP) : P -∗ ∀.. x, P ∗ (Φ x -∗ Φ x). Proof. iIntros "$". auto. Qed. Lemma test_iFrame_texist {TT : tele} P (Φ : TT → PROP) : P -∗ (∃.. x, Φ x) -∗ ∃.. x, P ∗ Φ x. Proof. iIntros "$". auto. Qed. End basic_tests. 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. Lemma acc_mono_disj E1 E2 α β γ1 γ2 : accessor E1 E2 α β γ1 -∗ accessor E1 E2 α β (λ.. x, γ1 x ∨ γ2 x). Proof. Show. iApply acc_mono. iIntros (x) "Hγ1". Show. rewrite ->tele_app_bind. Show. iLeft. done. Qed. End tests. Section printing_tests. Context {PROP : bi} `{!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, ⌜a = b⌝ | True | ⌜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 : bi} {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 : bi} {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 : bi} {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 : bi} : TEST1 {{ ∃ a b : nat, ⌜a = b⌝ }} ⊢@{PROP} ▷ False. Proof. iIntros "H". iDestruct "H" as (x) "H". Show. Restart. Proof. iIntros "H". unfold test1. iDestruct "H" as (x) "H". Show. Abort. Check "test2_test". Lemma test2_test {PROP : bi} : TEST2 {{ ∃ a b : nat, ⌜a = b⌝ }} ⊢@{PROP} ▷ False. Proof. iIntros "H". iModIntro. Show. iDestruct "H" as (x) "H". Show. Restart. Proof. iIntros "H". iDestruct "H" as (x) "H". Show. Abort. Check "test3_test". Lemma test3_test {PROP : bi} : TEST3 {{ ∃ a b : nat, ⌜a = b⌝ }} ⊢@{PROP} ▷ False. Proof. iIntros "H". iMod "H". iDestruct "H" as (x) "H". Show. Restart. Proof. iIntros "H". iDestruct "H" as (x) "H". Show. Abort. End telescopes_and_tactics. Lemma tele_universe {PROP : bi} (TT : tele@{bi.Quant}) (P : TT → PROP) : bi_texist P ⊣⊢ bi_exist P. Proof. apply bi_texist_exist. Qed. iris-iris-4.2.0/tests/tree_sum.ref000066400000000000000000000000001460620107300170770ustar00rootroot00000000000000iris-iris-4.2.0/tests/tree_sum.v000066400000000000000000000037351460620107300166120ustar00rootroot00000000000000From iris.proofmode Require Export tactics. From iris.program_logic Require Export weakestpre total_weakestpre. From iris.heap_lang Require Export lang. From iris.heap_lang Require Import proofmode notation. From iris.prelude Require Import options. Inductive tree := | leaf : Z → tree | node : tree → tree → tree. Fixpoint is_tree `{!heapGS Σ} (v : val) (t : tree) : iProp Σ := match t with | leaf n => ⌜v = InjLV #n⌝ | node tl tr => ∃ (ll lr : loc) (vl vr : val), ⌜v = InjRV (#ll,#lr)⌝ ∗ ll ↦ vl ∗ is_tree vl tl ∗ lr ↦ vr ∗ is_tree vr tr end%I. Fixpoint sum (t : tree) : Z := match t with | leaf n => n | node tl tr => sum tl + sum tr end. Definition sum_loop : val := rec: "sum_loop" "t" "l" := match: "t" with InjL "n" => "l" <- "n" + !"l" | InjR "tt" => "sum_loop" !(Fst "tt") "l" ;; "sum_loop" !(Snd "tt") "l" end. Definition sum' : val := λ: "t", let: "l" := ref #0 in sum_loop "t" "l";; !"l". Lemma sum_loop_wp `{!heapGS Σ} v t l (n : Z) : [[{ l ↦ #n ∗ is_tree v t }]] sum_loop v #l [[{ RET #(); l ↦ #(sum t + n) ∗ is_tree v t }]]. Proof. iIntros (Φ) "[Hl Ht] HΦ". iInduction t as [n'|tl ? tr] "IH" forall (v l n Φ); simpl; wp_rec; wp_let. - iDestruct "Ht" as "%"; subst. wp_load. wp_store. by iApply ("HΦ" with "[$Hl]"). - iDestruct "Ht" as (ll lr vl vr ->) "(Hll & Htl & Hlr & Htr)". wp_load. wp_apply ("IH" with "Hl Htl"). iIntros "[Hl Htl]". wp_load. wp_apply ("IH1" with "Hl Htr"). iIntros "[Hl Htr]". iApply "HΦ". iSplitL "Hl". { by replace (sum tl + sum tr + n)%Z with (sum tr + (sum tl + n))%Z by lia. } iExists ll, lr, vl, vr. by iFrame. Qed. Lemma sum_wp `{!heapGS Σ} v t : [[{ is_tree v t }]] sum' v [[{ RET #(sum t); is_tree v t }]]. Proof. iIntros (Φ) "Ht HΦ". rewrite /sum' /=. wp_lam. wp_alloc l as "Hl". wp_smart_apply (sum_loop_wp with "[$Hl $Ht]"). rewrite Z.add_0_r. iIntros "[Hl Ht]". wp_load. by iApply "HΦ". Qed. iris-iris-4.2.0/tex/000077500000000000000000000000001460620107300142265ustar00rootroot00000000000000iris-iris-4.2.0/tex/.gitignore000066400000000000000000000002101460620107300162070ustar00rootroot00000000000000*.pdf *.aux *.log *.out *.synctex.gz *.txss *.thm *.toc *.bbl *.blg *.bcf *.run.xml *.fdb_latexmk *.fls _*_.tex auto/*.el *.rubbercache iris-iris-4.2.0/tex/Makefile000066400000000000000000000001131460620107300156610ustar00rootroot00000000000000all: latexmk iris -pdf loop: latexmk iris -pdf -pvc clean: latexmk -c iris-iris-4.2.0/tex/algebra.tex000066400000000000000000000403371460620107300163540ustar00rootroot00000000000000\section{Algebraic Structures} \subsection{OFE} The model of Iris lives in the category of \emph{Ordered Families of Equivalences} (OFEs). This definition varies slightly from the original one in~\cite{catlogic}. \begin{defn} An \emph{ordered family of equivalences} (OFE) is a tuple $(\ofe, ({\nequiv{n}} \subseteq \ofe \times \ofe)_{n \in \nat})$ satisfying \begin{align*} \All n. (\nequiv{n}) ~& \text{is an equivalence relation} \tagH{ofe-equiv} \\ \All n, m.& n \geq m \Ra (\nequiv{n}) \subseteq (\nequiv{m}) \tagH{ofe-mono} \\ \All x, y.& x = y \Lra (\All n. x \nequiv{n} y) \tagH{ofe-limit} \end{align*} \end{defn} The key intuition behind OFEs is that elements $x$ and $y$ are $n$-equivalent, notation $x \nequiv{n} y$, if they are \emph{equivalent for $n$ steps of computation}, \ie if they cannot be distinguished by a program running for no more than $n$ steps. In other words, as $n$ increases, $\nequiv{n}$ becomes more and more refined (\ruleref{ofe-mono})---and in the limit, it agrees with plain equality (\ruleref{ofe-limit}). Notice that OFEs are just a different presentation of bisected 1-bounded ultrametric spaces, where the family of equivalence relations gives rise to the distance function (two elements that are equal for $n$ steps are no more than $2^{-n}$ apart). \begin{defn} An element $x \in \ofe$ of an OFE is called \emph{discrete} if \[ \All y \in \ofe. x \nequiv{0} y \Ra x = y\] An OFE $A$ is called \emph{discrete} if all its elements are discrete. For a set $X$, we write $\Delta X$ for the discrete OFE with $x \nequiv{n} x' \eqdef x = x'$ \end{defn} \begin{defn} A function $f : \ofe \to \ofeB$ between two OFEs is \emph{non-expansive} (written $f : \ofe \nfn \ofeB$) if \[\All n, x \in \ofe, y \in \ofe. x \nequiv{n} y \Ra f(x) \nequiv{n} f(y) \] It is \emph{contractive} if \[ \All n, x \in \ofe, y \in \ofe. (\All m < n. x \nequiv{m} y) \Ra f(x) \nequiv{n} f(y) \] \end{defn} Intuitively, applying a non-expansive function to some data will not suddenly introduce differences between seemingly equal data. Elements that cannot be distinguished by programs within $n$ steps remain indistinguishable after applying $f$. \begin{defn} The category $\OFEs$ consists of OFEs as objects, and non-expansive functions as arrows. \end{defn} Note that $\OFEs$ is bicartesian closed, \ie it has all sums, products and exponentials as well as an initial and a terminal object. In particular: \begin{defn} Given two OFEs $\ofe$ and $\ofeB$, the set of non-expansive functions $\set{f : \ofe \nfn \ofeB}$ is itself an OFE with \begin{align*} f \nequiv{n} g \eqdef{}& \All x \in \ofe. f(x) \nequiv{n} g(x) \end{align*} \end{defn} \begin{defn} A (bi)functor $F : \OFEs \to \OFEs$ is called \emph{locally non-expansive} if its action $F_1$ on arrows is itself a non-expansive map. Similarly, $F$ is called \emph{locally contractive} if $F_1$ is a contractive map. \end{defn} The function space $(-) \nfn (-)$ is a locally non-expansive bifunctor. Note that the composition of non-expansive (bi)functors is non-expansive, and the composition of a non-expansive and a contractive (bi)functor is contractive. One very important OFE is the OFE of \emph{step-indexed propositions}: For every step-index, such a proposition either holds or does not hold. Moreover, if a propositions holds for some $n$, it also has to hold for all smaller step-indices. \begin{align*} \SProp \eqdef{}& \psetdown{\nat} \\ \eqdef{}& \setComp{X \in \pset{\nat}}{ \All n, m. n \geq m \Ra n \in X \Ra m \in X } \\ X \nequiv{n} Y \eqdef{}& \All m \leq n. m \in X \Lra m \in Y \\ X \nincl{n} Y \eqdef{}& \All m \leq n. m \in X \Ra m \in Y \end{align*} \subsection{COFE} COFEs are \emph{complete OFEs}, which means that we can take limits of arbitrary chains. \begin{defn}[Chain] Given some set $\cofe$ and an indexed family $({\nequiv{n}} \subseteq \cofe \times \cofe)_{n \in \nat}$ of equivalence relations, a \emph{chain} $c \in \Chains(\cofe)$ is a function $c : \nat \to \cofe$ such that $\All n, m. n \leq m \Ra c (m) \nequiv{n} c (n)$. \end{defn} \begin{defn} A \emph{complete ordered family of equivalences} (COFE) is a tuple $(\cofe : \OFEs, \lim : \Chains(\cofe) \to \cofe)$ satisfying \begin{align*} \All n, c.& \lim(c) \nequiv{n} c(n) \tagH{cofe-compl} \end{align*} \end{defn} \begin{defn} The category $\COFEs$ consists of COFEs as objects, and non-expansive functions as arrows. \end{defn} The function space $\ofe \nfn \cofeB$ is a COFE if $\cofeB$ is a COFE (\ie the domain $\ofe$ can actually be just an OFE). $\SProp$ as defined above is complete, \ie it is a COFE. Completeness is necessary to take fixed-points. \begin{thm}[Banach's fixed-point] \label{thm:banach} Given an inhabited COFE $\ofe$ and a contractive function $f : \ofe \to \ofe$, there exists a unique fixed-point $\fixp_T f$ such that $f(\fixp_T f) = \fixp_T f$. Moreover, this theorem also holds if $f$ is just non-expansive, and $f^k$ is contractive for an arbitrary $k$. \end{thm} \begin{thm}[America and Rutten~\cite{America-Rutten:JCSS89,birkedal:metric-space}] \label{thm:america_rutten} Let $1$ be the discrete COFE on the unit type: $1 \eqdef \Delta \{ () \}$. Given a locally contractive bifunctor $G : \COFEs^{\textrm{op}} \times \COFEs \to \COFEs$, and provided that \(G(1, 1)\) is inhabited, then there exists a unique\footnote{Uniqueness is not proven in Coq.} COFE $\ofe$ such that $G(\ofe^{\textrm{op}}, \ofe) \cong \ofe$ (\ie the two are isomorphic in $\COFEs$). \end{thm} \subsection{RA} \begin{defn} A \emph{resource algebra} (RA) is a tuple \\ $(\monoid, \mvalFull : \monoid \to \mProp, \mcore{{-}}: \monoid \to \maybe\monoid, (\mtimes) : \monoid \times \monoid \to \monoid)$ satisfying: \begin{align*} \All \melt, \meltB, \meltC.& (\melt \mtimes \meltB) \mtimes \meltC = \melt \mtimes (\meltB \mtimes \meltC) \tagH{ra-assoc} \\ \All \melt, \meltB.& \melt \mtimes \meltB = \meltB \mtimes \melt \tagH{ra-comm} \\ \All \melt.& \mcore\melt \in \monoid \Ra \mcore\melt \mtimes \melt = \melt \tagH{ra-core-id} \\ \All \melt.& \mcore\melt \in \monoid \Ra \mcore{\mcore\melt} = \mcore\melt \tagH{ra-core-idem} \\ \All \melt, \meltB.& \mcore\melt \in \monoid \land \melt \mincl \meltB \Ra \mcore\meltB \in \monoid \land \mcore\melt \mincl \mcore\meltB \tagH{ra-core-mono} \\ \All \melt, \meltB.& \mvalFull(\melt \mtimes \meltB) \Ra \mvalFull(\melt) \tagH{ra-valid-op} \\ \text{where}\qquad %\qquad\\ \maybe\monoid \eqdef{}& \monoid \uplus \set{\mnocore} \qquad\qquad\qquad \melt^? \mtimes \mnocore \eqdef \mnocore \mtimes \melt^? \eqdef \melt^? \\ \melt \mincl \meltB \eqdef{}& \Exists \meltC \in \monoid. \meltB = \melt \mtimes \meltC \tagH{ra-incl} \end{align*} \end{defn} Here, $\mProp$ is the set of (meta-level) propositions. Think of \texttt{Prop} in Coq or $\mathbb{B}$ in classical mathematics. RAs are closely related to \emph{Partial Commutative Monoids} (PCMs), with two key differences: \begin{enumerate} \item The composition operation on RAs is total (as opposed to the partial composition operation of a PCM), but there is a specific subset of \emph{valid} elements that is compatible with the composition operation (\ruleref{ra-valid-op}). These valid elements are identified by the \emph{validity predicate} $\mvalFull$. This take on partiality is necessary when defining the structure of \emph{higher-order} ghost state, \emph{cameras}, in the next subsection. \item Instead of a single unit that is an identity to every element, we allow for an arbitrary number of units, via a function $\mcore{{-}}$ assigning to an element $\melt$ its \emph{(duplicable) core} $\mcore\melt$, as demanded by \ruleref{ra-core-id}. We further demand that $\mcore{{-}}$ is idempotent (\ruleref{ra-core-idem}) and monotone (\ruleref{ra-core-mono}) with respect to the \emph{extension order}, defined similarly to that for PCMs (\ruleref{ra-incl}). Notice that the codomain of the core is $\maybe\monoid$, a set that adds a dummy element $\mnocore$ to $\monoid$. % (This corresponds to the option type.) Thus, the core can be \emph{partial}: not all elements need to have a unit. We use the metavariable $\maybe\melt$ to indicate elements of $\maybe\monoid$. We also lift the composition $(\mtimes)$ to $\maybe\monoid$. Partial cores help us to build interesting composite RAs from smaller primitives. Notice also that the core of an RA is a strict generalization of the unit that any PCM must provide, since $\mcore{{-}}$ can always be picked as a constant function. \end{enumerate} \begin{defn} It is possible to do a \emph{frame-preserving update} from $\melt \in \monoid$ to $\meltsB \subseteq \monoid$, written $\melt \mupd \meltsB$, if \[ \All \maybe{\melt_\f} \in \maybe\monoid. \mvalFull(\melt \mtimes \maybe{\melt_\f}) \Ra \Exists \meltB \in \meltsB. \mvalFull(\meltB \mtimes \maybe{\melt_\f}) \] We further define $\melt \mupd \meltB \eqdef \melt \mupd \set\meltB$. \end{defn} The proposition $\melt \mupd \meltsB$ says that every element $\maybe{\melt_\f}$ compatible with $\melt$ (we also call such elements \emph{frames}), must also be compatible with some $\meltB \in \meltsB$. Notice that $\maybe{\melt_\f}$ could be $\mnocore$, so the frame-preserving update can also be applied to elements that have \emph{no} frame. Intuitively, this means that whatever assumptions the rest of the program is making about the state of $\gname$, if these assumptions are compatible with $\melt$, then updating to $\meltB$ will not invalidate any of these assumptions. Since Iris ensures that the global ghost state is valid, this means that we can soundly update the ghost state from $\melt$ to a non-deterministically picked $\meltB \in \meltsB$. \subsection{Cameras} \begin{defn} A \emph{camera} is a tuple $(\monoid : \OFEs, \mval : \monoid \nfn \SProp, \mcore{{-}}: \monoid \nfn \maybe\monoid,\\ (\mtimes) : \monoid \times \monoid \nfn \monoid)$ satisfying: \begin{align*} \All \melt, \meltB, \meltC.& (\melt \mtimes \meltB) \mtimes \meltC = \melt \mtimes (\meltB \mtimes \meltC) \tagH{camera-assoc} \\ \All \melt, \meltB.& \melt \mtimes \meltB = \meltB \mtimes \melt \tagH{camera-comm} \\ \All \melt.& \mcore\melt \in \monoid \Ra \mcore\melt \mtimes \melt = \melt \tagH{camera-core-id} \\ \All \melt.& \mcore\melt \in \monoid \Ra \mcore{\mcore\melt} = \mcore\melt \tagH{camera-core-idem} \\ \All \melt, \meltB.& \mcore\melt \in \monoid \land \melt \mincl \meltB \Ra \mcore\meltB \in \monoid \land \mcore\melt \mincl \mcore\meltB \tagH{camera-core-mono} \\ \All \melt, \meltB.& \mval(\melt \mtimes \meltB) \subseteq \mval(\melt) \tagH{camera-valid-op} \\ \All n, \melt, \meltB_1, \meltB_2.& \omit\rlap{$n \in \mval(\melt) \land \melt \nequiv{n} \meltB_1 \mtimes \meltB_2 \Ra {}$} \\ &\Exists \meltC_1, \meltC_2. \melt = \meltC_1 \mtimes \meltC_2 \land \meltC_1 \nequiv{n} \meltB_1 \land \meltC_2 \nequiv{n} \meltB_2 \tagH{camera-extend} \\ \text{where}\qquad\qquad\\ \melt \mincl \meltB \eqdef{}& \Exists \meltC. \meltB = \melt \mtimes \meltC \tagH{camera-incl} \\ \melt \mincl[n] \meltB \eqdef{}& \Exists \meltC. \meltB \nequiv{n} \melt \mtimes \meltC \tagH{camera-inclN} \end{align*} \end{defn} This is a natural generalization of RAs over OFEs\footnote{The reader may wonder why on earth we call them ``cameras''. The reason, which may not be entirely convincing, is that ``camera'' was originally just used as a comfortable pronunciation of ``CMRA'', the name used in earlier Iris papers. CMRA was originally supposed to be an acronym for ``complete metric resource algebras'' (or something like that), but we were never very satisfied with it and thus ended up never spelling it out. To make matters worse, the ``complete'' part of CMRA is now downright misleading, for whereas previously the carrier of a CMRA was required to be a COFE (complete OFE), we have relaxed that restriction and permit it to be an (incomplete) OFE. For these reasons, we have decided to stick with the name ``camera'', for purposes of continuity, but to drop any pretense that it stands for something.}. All operations have to be non-expansive, and the validity predicate $\mval$ can now also depend on the step-index. We define the plain $\mvalFull$ as the ``limit'' of the step-indexed approximation: \[ \mvalFull(\melt) \eqdef \All n. n \in \mval(\melt) \] \paragraph{The extension axiom (\ruleref{camera-extend}).} Notice that the existential quantification in this axiom is \emph{constructive}, \ie it is a sigma type in Coq. The purpose of this axiom is to compute $\melt_1$, $\melt_2$ completing the following square: % RJ FIXME: Needs some magic to fix the baseline of the $\nequiv{n}$, or so \begin{center} \begin{tikzpicture}[every edge/.style={draw=none}] \node (a) at (0, 0) {$\melt$}; \node (b) at (1.7, 0) {$\meltB$}; \node (b12) at (1.7, -1) {$\meltB_1 \mtimes \meltB_2$}; \node (a12) at (0, -1) {$\melt_1 \mtimes \melt_2$}; \path (a) edge node {$\nequiv{n}$} (b); \path (a12) edge node {$\nequiv{n}$} (b12); \path (a) edge node [rotate=90] {$=$} (a12); \path (b) edge node [rotate=90] {$=$} (b12); \end{tikzpicture}\end{center} where the $n$-equivalence at the bottom is meant to apply to the pairs of elements, \ie we demand $\melt_1 \nequiv{n} \meltB_1$ and $\melt_2 \nequiv{n} \meltB_2$. In other words, extension carries the decomposition of $\meltB$ into $\meltB_1$ and $\meltB_2$ over the $n$-equivalence of $\melt$ and $\meltB$, and yields a corresponding decomposition of $\melt$ into $\melt_1$ and $\melt_2$. This operation is needed to prove that $\later$ commutes with separating conjunction: \begin{mathpar} \axiom{\later (\prop * \propB) \Lra \later\prop * \later\propB} \end{mathpar} \begin{defn} An element $\munit$ of a camera $\monoid$ is called the \emph{unit} of $\monoid$ if it satisfies the following conditions: \begin{enumerate}[itemsep=0pt] \item $\munit$ is valid: \\ $\All n. n \in \mval(\munit)$ \item $\munit$ is a left-identity of the operation: \\ $\All \melt \in M. \munit \mtimes \melt = \melt$ \item $\munit$ is its own core: \\ $\mcore\munit = \munit$ \end{enumerate} \end{defn} \begin{lem}\label{lem:camera-unit-total-core} If $\monoid$ has a unit $\munit$, then the core $\mcore{{-}}$ is total, \ie $\All\melt. \mcore\melt \in \monoid$. \end{lem} \begin{defn} It is possible to do a \emph{frame-preserving update} from $\melt \in \monoid$ to $\meltsB \subseteq \monoid$, written $\melt \mupd \meltsB$, if \[ \All n, \maybe{\melt_\f}. n \in \mval(\melt \mtimes \maybe{\melt_\f}) \Ra \Exists \meltB \in \meltsB. n \in\mval(\meltB \mtimes \maybe{\melt_\f}) \] We further define $\melt \mupd \meltB \eqdef \melt \mupd \set\meltB$. \end{defn} Note that for RAs, this and the RA-based definition of a frame-preserving update coincide. \begin{defn} A camera $\monoid$ is \emph{discrete} if it satisfies the following conditions: \begin{enumerate}[itemsep=0pt] \item $\monoid$ is a discrete COFE \item $\mval$ ignores the step-index: \\ $\All \melt \in \monoid. 0 \in \mval(\melt) \Ra \All n. n \in \mval(\melt)$ \end{enumerate} \end{defn} Note that every RA is a discrete camera, by picking the discrete COFE for the equivalence relation. Furthermore, discrete cameras can be turned into RAs by ignoring their COFE structure, as well as the step-index of $\mval$. \begin{defn}[Camera homomorphism] A function $f : \monoid_1 \to \monoid_2$ between two cameras is \emph{a camera homomorphism} if it satisfies the following conditions: \begin{enumerate}[itemsep=0pt] \item $f$ is non-expansive \item $f$ commutes with composition:\\ $\All \melt_1 \in \monoid_1, \melt_2 \in \monoid_1. f(\melt_1) \mtimes f(\melt_2) = f(\melt_1 \mtimes \melt_2)$ \item $f$ commutes with the core:\\ $\All \melt \in \monoid_1. \mcore{f(\melt)} = f(\mcore{\melt})$ \item $f$ preserves validity: \\ $\All n, \melt \in \monoid_1. n \in \mval(\melt) \Ra n \in \mval(f(\melt))$ \end{enumerate} \end{defn} \begin{defn} The category $\CMRAs$ consists of cameras as objects, and camera homomorphisms as arrows. \end{defn} Note that every object/arrow in $\CMRAs$ is also an object/arrow of $\OFEs$. The notion of a locally non-expansive (or contractive) bifunctor naturally generalizes to bifunctors between these categories. %TODO: Discuss how we probably have a commuting square of functors between Set, RA, CMRA, COFE. %%% Local Variables: %%% mode: latex %%% TeX-master: "iris" %%% End: iris-iris-4.2.0/tex/base-logic.tex000066400000000000000000000367411460620107300167700ustar00rootroot00000000000000\section{Base Logic} \label{sec:base-logic} The base logic is parameterized by an arbitrary camera $\monoid$ having a unit $\munit$. By \lemref{lem:camera-unit-total-core}, this means that the core of $\monoid$ is a total function, so we will treat it as such in the following. This defines the structure of resources that can be owned. As usual for higher-order logics, you can furthermore pick a \emph{signature} $\Sig = (\SigType, \SigFn, \SigAx)$ to add more types, symbols and axioms to the language. You have to make sure that $\SigType$ includes the base types: \[ \SigType \supseteq \{ \textlog{M}, \Prop \} \] Elements of $\SigType$ are ranged over by $\sigtype$. Each function symbol in $\SigFn$ has an associated \emph{arity} comprising a natural number $n$ and an ordered list of $n+1$ types $\type$ (the grammar of $\type$ is defined below, and depends only on $\SigType$). We write \[ \sigfn : \type_1, \dots, \type_n \to \type_{n+1} \in \SigFn \] to express that $\sigfn$ is a function symbol with the indicated arity. Furthermore, $\SigAx$ is a set of \emph{axioms}, that is, terms $\term$ of type $\Prop$. Again, the grammar of terms and their typing rules are defined below, and depends only on $\SigType$ and $\SigFn$, not on $\SigAx$. Elements of $\SigAx$ are ranged over by $\sigax$. \subsection{Grammar}\label{sec:grammar} \paragraph{Syntax.} Iris syntax is built up from a signature $\Sig$ and a countably infinite set $\Var$ of variables (ranged over by metavariables $\var$, $\varB$, $\varC$). Below, $\melt$ ranges over $\monoid$ and $i$ ranges over $\set{1,2}$. \begin{align*} \type \bnfdef{}& \sigtype \mid 0 \mid 1 \mid \type + \type \mid \type \times \type \mid \type \to \type \\[0.4em] \term, \prop, \pred \bnfdef{}& \var \mid \sigfn(\term_1, \dots, \term_n) \mid \textlog{abort}\; \term \mid () \mid (\term, \term) \mid \pi_i\; \term \mid \Lam \var:\type.\term \mid \term(\term) \mid \\& \textlog{inj}_i\; \term \mid \textlog{match}\; \term \;\textlog{with}\; \Ret\textlog{inj}_1\; \var. \term \mid \Ret\textlog{inj}_2\; \var. \term \;\textlog{end} \mid % \melt \mid \mcore\term \mid \term \mtimes \term \mid \\& \FALSE \mid \TRUE \mid \term =_\type \term \mid \prop \Ra \prop \mid \prop \land \prop \mid \prop \lor \prop \mid \prop * \prop \mid \prop \wand \prop \mid \\& \MU \var:\type. \term \mid \Exists \var:\type. \prop \mid \All \var:\type. \prop \mid %\\& \ownM{\term} \mid \mval(\term) \mid \always\prop \mid \plainly\prop \mid {\later\prop} \mid \upd \prop \end{align*} Well-typedness forces recursive definitions to be \emph{guarded}: In $\MU \var. \term$, the variable $\var$ can only appear under the later $\later$ modality. Furthermore, the type of the definition must be \emph{complete}. The type $\Prop$ is complete, and if $\type$ is complete, then so is $\type' \to \type$. Note that the modalities $\upd$, $\always$, $\plainly$ and $\later$ bind more tightly than $*$, $\wand$, $\land$, $\lor$, and $\Ra$. \paragraph{Variable conventions.} We assume that, if a term occurs multiple times in a rule, its free variables are exactly those binders which are available at every occurrence. \subsection{Types}\label{sec:types} Iris terms are simply-typed. The judgment $\vctx \proves \wtt{\term}{\type}$ expresses that, in variable context $\vctx$, the term $\term$ has type $\type$. A variable context, $\vctx = x_1:\type_1, \dots, x_n:\type_n$, declares a list of variables and their types. In writing $\vctx, x:\type$, we presuppose that $x$ is not already declared in $\vctx$. \judgment[Well-typed terms]{\vctx \proves_\Sig \wtt{\term}{\type}} \begin{mathparpagebreakable} %%% variables and function symbols \axiom{x : \type \proves \wtt{x}{\type}} \and \infer{\vctx \proves \wtt{\term}{\type}} {\vctx, x:\type' \proves \wtt{\term}{\type}} \and \infer{\vctx, x:\type', y:\type' \proves \wtt{\term}{\type}} {\vctx, x:\type' \proves \wtt{\term[x/y]}{\type}} \and \infer{\vctx_1, x:\type', y:\type'', \vctx_2 \proves \wtt{\term}{\type}} {\vctx_1, x:\type'', y:\type', \vctx_2 \proves \wtt{\term[y/x,x/y]}{\type}} \and \infer{ \vctx \proves \wtt{\term_1}{\type_1} \and \cdots \and \vctx \proves \wtt{\term_n}{\type_n} \and \sigfn : \type_1, \dots, \type_n \to \type_{n+1} \in \SigFn }{ \vctx \proves \wtt {\sigfn(\term_1, \dots, \term_n)} {\type_{n+1}} } %%% empty, unit, products, sums \and \infer{\vctx \proves \wtt\term{0}} {\vctx \proves \wtt{\textlog{abort}\; \term}\type} \and \axiom{\vctx \proves \wtt{()}{1}} \and \infer{\vctx \proves \wtt{\term}{\type_1} \and \vctx \proves \wtt{\termB}{\type_2}} {\vctx \proves \wtt{(\term,\termB)}{\type_1 \times \type_2}} \and \infer{\vctx \proves \wtt{\term}{\type_1 \times \type_2} \and i \in \{1, 2\}} {\vctx \proves \wtt{\pi_i\,\term}{\type_i}} \and \infer{\vctx \proves \wtt\term{\type_i} \and i \in \{1, 2\}} {\vctx \proves \wtt{\textlog{inj}_i\;\term}{\type_1 + \type_2}} \and \infer{\vctx \proves \wtt\term{\type_1 + \type_2} \and \vctx, \var:\type_1 \proves \wtt{\term_1}\type \and \vctx, \varB:\type_2 \proves \wtt{\term_2}\type} {\vctx \proves \wtt{\textlog{match}\; \term \;\textlog{with}\; \Ret\textlog{inj}_1\; \var. \term_1 \mid \Ret\textlog{inj}_2\; \varB. \term_2 \;\textlog{end}}{\type}} %%% functions \and \infer{\vctx, x:\type \proves \wtt{\term}{\type'}} {\vctx \proves \wtt{\Lam x. \term}{\type \to \type'}} \and \infer {\vctx \proves \wtt{\term}{\type \to \type'} \and \wtt{\termB}{\type}} {\vctx \proves \wtt{\term(\termB)}{\type'}} %%% monoids \and \infer{}{\vctx \proves \wtt\melt{\textlog{M}}} \and \infer{\vctx \proves \wtt\melt{\textlog{M}}}{\vctx \proves \wtt{\mcore\melt}{\textlog{M}}} \and \infer{\vctx \proves \wtt{\melt}{\textlog{M}} \and \vctx \proves \wtt{\meltB}{\textlog{M}}} {\vctx \proves \wtt{\melt \mtimes \meltB}{\textlog{M}}} %%% props and predicates \\ \axiom{\vctx \proves \wtt{\FALSE}{\Prop}} \and \axiom{\vctx \proves \wtt{\TRUE}{\Prop}} \and \infer{\vctx \proves \wtt{\term}{\type} \and \vctx \proves \wtt{\termB}{\type}} {\vctx \proves \wtt{\term =_\type \termB}{\Prop}} \and \infer{\vctx \proves \wtt{\prop}{\Prop} \and \vctx \proves \wtt{\propB}{\Prop}} {\vctx \proves \wtt{\prop \Ra \propB}{\Prop}} \and \infer{\vctx \proves \wtt{\prop}{\Prop} \and \vctx \proves \wtt{\propB}{\Prop}} {\vctx \proves \wtt{\prop \land \propB}{\Prop}} \and \infer{\vctx \proves \wtt{\prop}{\Prop} \and \vctx \proves \wtt{\propB}{\Prop}} {\vctx \proves \wtt{\prop \lor \propB}{\Prop}} \and \infer{\vctx \proves \wtt{\prop}{\Prop} \and \vctx \proves \wtt{\propB}{\Prop}} {\vctx \proves \wtt{\prop * \propB}{\Prop}} \and \infer{\vctx \proves \wtt{\prop}{\Prop} \and \vctx \proves \wtt{\propB}{\Prop}} {\vctx \proves \wtt{\prop \wand \propB}{\Prop}} \and \infer{ \vctx, \var:\type \proves \wtt{\term}{\type} \and \text{$\var$ is guarded in $\term$} \and \text{$\type$ is complete and inhabited} }{ \vctx \proves \wtt{\MU \var:\type. \term}{\type} } \and \infer{\vctx, x:\type \proves \wtt{\prop}{\Prop}} {\vctx \proves \wtt{\Exists x:\type. \prop}{\Prop}} \and \infer{\vctx, x:\type \proves \wtt{\prop}{\Prop}} {\vctx \proves \wtt{\All x:\type. \prop}{\Prop}} \and \infer{\vctx \proves \wtt{\melt}{\textlog{M}}} {\vctx \proves \wtt{\ownM{\melt}}{\Prop}} \and \infer{\vctx \proves \wtt{\melt}{\type} \and \text{$\type$ is a camera}} {\vctx \proves \wtt{\mval(\melt)}{\Prop}} \and \infer{\vctx \proves \wtt{\prop}{\Prop}} {\vctx \proves \wtt{\always\prop}{\Prop}} \and \infer{\vctx \proves \wtt{\prop}{\Prop}} {\vctx \proves \wtt{\plainly\prop}{\Prop}} \and \infer{\vctx \proves \wtt{\prop}{\Prop}} {\vctx \proves \wtt{\later\prop}{\Prop}} \and \infer{ \vctx \proves \wtt{\prop}{\Prop} }{ \vctx \proves \wtt{\upd \prop}{\Prop} } \end{mathparpagebreakable} \subsection{Proof Rules} \label{sec:proof-rules} The judgment $\vctx \mid \prop \proves \propB$ says that with free variables $\vctx$, proposition $\propB$ holds whenever assumption $\prop$ holds. Most of the rules will entirely omit the variable contexts $\vctx$. In this case, we assume the same arbitrary context is used for every constituent of the rules. %Furthermore, an arbitrary \emph{boxed} proposition context $\always\pfctx$ may be added to every constituent. Axioms $\vctx \mid \prop \provesIff \propB$ indicate that both $\vctx \mid \prop \proves \propB$ and $\vctx \mid \propB \proves \prop$ are proof rules of the logic. \judgment{\vctx \mid \prop \proves \propB} \paragraph{Laws of intuitionistic higher-order logic with equality.} This is entirely standard. \begin{mathparpagebreakable} \infer[Asm] {} {\prop \proves \prop} \and \infer[Cut] {\prop \proves \propB \and \propB \proves \propC} {\prop \proves \propC} \and \infer[Eq] {\vctx,\var:\type \proves \wtt\propB\Prop \\ \vctx\mid\prop \proves \propB[\term/\var] \\ \vctx\mid\prop \proves \term =_\type \term'} {\vctx\mid\prop \proves \propB[\term'/\var]} \and \infer[Refl] {} {\TRUE \proves \term =_\type \term} \and \infer[$\bot$E] {} {\FALSE \proves \prop} \and \infer[$\top$I] {} {\prop \proves \TRUE} \and \infer[$\wedge$I] {\prop \proves \propB \\ \prop \proves \propC} {\prop \proves \propB \land \propC} \and \infer[$\wedge$EL] {\prop \proves \propB \land \propC} {\prop \proves \propB} \and \infer[$\wedge$ER] {\prop \proves \propB \land \propC} {\prop \proves \propC} \and \infer[$\vee$IL] {\prop \proves \propB } {\prop \proves \propB \lor \propC} \and \infer[$\vee$IR] {\prop \proves \propC} {\prop \proves \propB \lor \propC} \and \infer[$\vee$E] {\prop \proves \propC \\ \propB \proves \propC} {\prop \lor \propB \proves \propC} \and \infer[$\Ra$I] {\prop \land \propB \proves \propC} {\prop \proves \propB \Ra \propC} \and \infer[$\Ra$E] {\prop \proves \propB \Ra \propC \\ \prop \proves \propB} {\prop \proves \propC} \and \infer[$\forall$I] { \vctx,\var : \type\mid\prop \proves \propB} {\vctx\mid\prop \proves \All \var: \type. \propB} \and \infer[$\forall$E] {\vctx\mid\prop \proves \All \var :\type. \propB \\ \vctx \proves \wtt\term\type} {\vctx\mid\prop \proves \propB[\term/\var]} \\ \infer[$\exists$I] {\vctx\mid\prop \proves \propB[\term/\var] \\ \vctx \proves \wtt\term\type} {\vctx\mid\prop \proves \exists \var: \type. \propB} \and \infer[$\exists$E] {\vctx,\var : \type\mid\prop \proves \propB} {\vctx\mid\Exists \var: \type. \prop \proves \propB} % \and % \infer[$\lambda$] % {} % {\pfctx \proves (\Lam\var: \type. \prop)(\term) =_{\type\to\type'} \prop[\term/\var]} % \and % \infer[$\mu$] % {} % {\pfctx \proves \mu\var: \type. \prop =_{\type} \prop[\mu\var: \type. \prop/\var]} \end{mathparpagebreakable} Furthermore, we have the usual $\eta$ and $\beta$ laws for projections, $\textlog{abort}$, sum elimination, $\lambda$ and $\mu$. \paragraph{Laws of (affine) bunched implications.} \begin{mathpar} \begin{array}{rMcMl} \TRUE * \prop &\provesIff& \prop \\ \prop * \propB &\proves& \propB * \prop \\ (\prop * \propB) * \propC &\proves& \prop * (\propB * \propC) \end{array} \and \infer[$*$-mono] {\prop_1 \proves \propB_1 \and \prop_2 \proves \propB_2} {\prop_1 * \prop_2 \proves \propB_1 * \propB_2} \and \inferB[$\wand$I-E] {\prop * \propB \proves \propC} {\prop \proves \propB \wand \propC} \end{mathpar} \paragraph{Laws for the plainness modality.} \begin{mathpar} \infer[$\plainly$-mono] {\prop \proves \propB} {\plainly{\prop} \proves \plainly{\propB}} \and \infer[$\plainly$-E]{} {\plainly\prop \proves \always\prop} \and \begin{array}[c]{rMcMl} (\plainly P \Ra \plainly Q) &\proves& \plainly (\plainly P \Ra Q) \\ \plainly ( ( P \Ra Q) \land (Q \Ra P ) ) &\proves& P =_{\Prop} Q \end{array} \and \begin{array}[c]{rMcMl} \plainly{\prop} &\proves& \plainly\plainly\prop \\ \All x. \plainly{\prop} &\proves& \plainly{\All x. \prop} \\ \plainly{\Exists x. \prop} &\proves& \Exists x. \plainly{\prop} \end{array} %\and %\infer[PropExt]{}{\plainly ( ( P \Ra Q) \land (Q \Ra P ) ) \proves P =_{\Prop} Q} \end{mathpar} \paragraph{Laws for the persistence modality.} \begin{mathpar} \inferhref{$\always$-mono}{pers-mono} {\prop \proves \propB} {\always{\prop} \proves \always{\propB}} \and \inferhref{$\always$-E}{pers-elim} {} {\always\prop \proves \prop} \and \begin{array}[c]{rMcMl} (\plainly P \Ra \always Q) &\proves& \always (\plainly P \Ra Q) \\ \always{\prop} \land \propB &\proves& \always{\prop} * \propB \end{array} \and \begin{array}[c]{rMcMl} \always{\prop} &\proves& \always\always\prop \\ \All x. \always{\prop} &\proves& \always{\All x. \prop} \\ \always{\Exists x. \prop} &\proves& \Exists x. \always{\prop} \end{array} \end{mathpar} \paragraph{Laws for the later modality.} \begin{mathpar} \inferhref{$\later$-mono}{later-mono} {\prop \proves \propB} {\later\prop \proves \later{\propB}} \and \inferhref{$\later$-I}{later-intro} {} {\prop \proves \later\prop} \and \begin{array}[c]{rMcMl} \All x. \later\prop &\proves& \later{\All x.\prop} \\ \later\Exists x. \prop &\proves& \later\FALSE \lor {\Exists x.\later\prop} \\ \later\prop &\proves& \later\FALSE \lor (\later\FALSE \Ra \prop) \end{array} \and \begin{array}[c]{rMcMl} \later{(\prop * \propB)} &\provesIff& \later\prop * \later\propB \\ \always{\later\prop} &\provesIff& \later\always{\prop} \\ \plainly{\later\prop} &\provesIff& \later\plainly{\prop} \end{array} \end{mathpar} \paragraph{Laws for resources and validity.} \begin{mathpar} \begin{array}{rMcMl} \ownM{\melt} * \ownM{\meltB} &\provesIff& \ownM{\melt \mtimes \meltB} \\ \ownM\melt &\proves& \always{\ownM{\mcore\melt}} \\ \TRUE &\proves& \ownM{\munit} \\ \later\ownM\melt &\proves& \Exists\meltB. \ownM\meltB \land \later(\melt = \meltB) \end{array} % \and % \infer[valid-intro] % {\melt \in \mval} % {\TRUE \vdash \mval(\melt)} % \and % \infer[valid-elim] % {\melt \notin \mval_0} % {\mval(\melt) \proves \FALSE} \and \begin{array}{rMcMl} \ownM{\melt} &\proves& \mval(\melt) \\ \mval(\melt \mtimes \meltB) &\proves& \mval(\melt) \\ \mval(\melt) &\proves& \plainly\mval(\melt) \end{array} \end{mathpar} \paragraph{Laws for the basic update modality.} \begin{mathpar} \inferH{upd-mono} {\prop \proves \propB} {\upd\prop \proves \upd\propB} \inferhref{upd-I}{upd-intro} {}{\prop \proves \upd \prop} \inferH{upd-trans} {} {\upd \upd \prop \proves \upd \prop} \inferH{upd-frame} {}{\propB * \upd\prop \proves \upd (\propB * \prop)} \inferH{upd-update} {\melt \mupd \meltsB} {\ownM\melt \proves \upd \Exists\meltB\in\meltsB. \ownM\meltB} \inferH{upd-plainly} {} {\upd\plainly\prop \proves \prop} \end{mathpar} The premise in \ruleref{upd-update} is a \emph{meta-level} side-condition that has to be proven about $a$ and $B$. %\ralf{Trouble is, we do not actually have $\in$ inside the logic...} \subsection{Consistency} The consistency statement of the logic reads as follows: For any $n$, we have \begin{align*} \lnot(\TRUE \proves (\later)^n\spac\FALSE) \end{align*} where $(\later)^n$ is short for $\later$ being nested $n$ times. The reason we want a stronger consistency than the usual $\lnot(\TRUE \proves \FALSE)$ is our modalities: it should be impossible to derive a contradiction below the modalities. For $\always$ and $\plainly$, this follows from the elimination rules. For updates, we use the fact that $\upd\FALSE \proves \upd\plainly\FALSE \proves \FALSE$. However, there is no elimination rule for $\later$, so we declare that it is impossible to derive a contradiction below any number of laters. %%% Local Variables: %%% mode: latex %%% TeX-master: "iris" %%% End: iris-iris-4.2.0/tex/bib.bib000066400000000000000000003433721460620107300154540ustar00rootroot00000000000000 @inproceedings{liang-feng, author = {Liang, Hongjin and Feng, Xinyu}, title = {Modular Verification of Linearizability with Non-fixed Linearization Points}, booktitle = {PLDI}, year = {2013} } @INPROCEEDINGS{hlrg, author = {Ming Fu and Yong Li and Xinyu Feng and Zhong Shao and Yu Zhang}, title = {Reasoning about optimistic concurrency using a program logic for history}, booktitle = {CONCUR}, year = {2010}, pages = {388--402}, } @Book{Milner1999, author={Robin Milner}, title={Communicating and Mobile Systems: the $\pi$-Calculus}, publisher={Cambridge University Press}, year={1999}, } @article{Walker:IC1995, Author = {David Walker}, Journal = {Inf. Comput.}, Number = {2}, Pages = {253--271}, Title = {Objects in the pi-Calculus}, Volume = {116}, Year = {1995}} @inproceedings{jensen-fsl, author = {Jensen, Jonas Braband and Birkedal, Lars}, title = {Fictional Separation Logic}, booktitle = {ESOP}, year = {2012}, } @article{America-Rutten:JCSS89, Author = {Pierre America and Jan Rutten}, Journal = {JCSS}, Number = {3}, Pages = {343--375}, Title = {Solving Reflexive Domain Equations in a Category of Complete Metric Spaces}, Volume = {39}, Year = {1989}} @Misc{Sieczkowski+:tutorial14, author = {Filip Sieczkowski and Ale\v{s} Bizjak and Yannick Zakowski and Lars Birkedal}, title = {Modular Reasoning about Concurrent Higher-Order Imperative Programs: a {Coq} Tutorial}, howpublished = {\url{http://users-cs.au.dk/birke/modures/tutorial/index.html}}, year = 2014 } @inproceedings{birkedal:popl11, author = "Lars Birkedal and Bernhard Reus and Jan Schwinghammer and Kristian St{\o}vring and Jacob Thamsborg and Hongseok Yang", title = "Step-Indexed {Kripke} Models over Recursive Worlds", booktitle = "POPL", year = 2011, } @inproceedings{parkinson+:popl08, author = "Matthew Parkinson and Gavin Bierman", title = "Separation Logic, Abstraction and Inheritance", booktitle = "POPL", year = 2008, } @Unpublished{mogelberg:2009, author = {Rasmus E. M{\o}gelberg}, title = {A Nominal Relational Model for Local Variables}, note = {Manuscript}, month = {may}, year = 2009, annote = {Available at: \url{http://www.itu.dk/people/mogel/papers/nom-rel-model.pdf}} } @InProceedings{mogelberg-simpson:07, author = {Rasmus E. M{\o}gelberg and Alex Simpson}, title = {Relational Parametricity for Computational Effects}, booktitle = {LICS}, year = 2007} @inproceedings{parkinson05, author = {M. J. Parkinson and G. M. Bierman}, title = {Separation logic and abstraction}, booktitle = {POPL}, year = {2005}, pages = {247--258}, } @phdthesis{parkinson_thesis, author = "Matthew Parkinson", title = "Local Reasoning for Java", school = "University of Cambridge", month = "November", year = "2005" } @Article{honsell+:variable-typed, author = {Furio Honsell and Ian A. Mason and Scott Smith and Carolyn Talcott}, title = {A Variable Typed Logic of Effects}, journal = {Inf. Comput.}, year = {1995}, volume = {119}, number = {1}, pages = {55--90}, } @article{sumii-pierce:jacm, author = {Eijiro Sumii and Benjamin Pierce}, title = {A Bisimulation for Type Abstraction and Recursion}, journal = {JACM}, volume = 54, number = 5, year = 2007, pages = {1--43}, } @inproceedings{banerjee-naumann:ecoop05, author = "Anindya Banerjee and David A. Naumann", title = "State based ownership, reentrance, and encapsulation", booktitle = {ECOOP}, year = 2005, } @InProceedings{koutavas-wand:popl06, author = {Vasileios Koutavas and Mitchell Wand}, title = {Small Bisimulations for Reasoning About Higher-Order Imperative Programs}, booktitle = {POPL}, year = {2006}, } @Misc{appendix, title = {Appendix and {Coq} development. {Anonymous} supplementary material submitted with the paper.}, key = {A} } @inproceedings{dreyer+:icfp10, author = {Derek Dreyer and Georg Neis and Lars Birkedal}, title = {The Impact of Higher-Order State and Control Effects on Local Relational Reasoning}, year = 2010, booktitle = {ICFP}, } @InProceedings{thamsborg+:icfp11, author = {Jacob Thamsborg and Lars Birkedal}, title = {A {Kripke} Logical Relation for Effect-Based Program Transformations}, booktitle = {ICFP}, year = 2011, } @inproceedings{hur+:popl11, author = {Chung-Kil Hur and Derek Dreyer}, title = {A {Kripke} Logical Relation Between {ML} and Assembly}, year = {2011}, booktitle = {POPL}, } @inproceedings{nakano:lics00, author = "Hiroshi Nakano", title = {A modality for recursion}, booktitle = {LICS}, year = "2000", } @InProceedings{birkedal+:fossacs09, author = {Lars Birkedal and Kristian St\o{}vring and Jacob Thamsborg}, title = {Realizability Semantics of Parametric Polymorphism, General References, and Recursive Types}, booktitle = {FOSSACS}, year = {2009}, } @inproceedings{plotkin-abadi, AUTHOR = {Gordon Plotkin and Mart\'in Abadi}, TITLE = {A logic for parametric polymorphism}, BOOKTITLE = {TLCA}, year = 1993, } @InCollection{pitts:attapl, author = {Andrew Pitts}, title = {Typed Operational Reasoning}, booktitle = {Advanced Topics in Types and Programming Languages}, year = 2005, publisher = {MIT Press}, chapter = {7}, editor = {B. C. Pierce}, } @Article{yoshida+:lmcs08, author = {Nobuko Yoshida and Kohei Honda and Martin Berger}, title = {Logical Reasoning for Higher-Order Functions with Local State}, journal = {LMCS}, year = {2008}, volume = {4}, number = {4:2}, } @Article{BirkedalL:semslt-lmcs, author = {L. Birkedal and N. Torp-Smith and H. Yang}, title = {Semantics of Separation-logic Typing and Higher-order Frame Rules for {Algol}-like Languages}, journal = {LMCS}, volume = {2}, number = {5:1}, year = 2006, } @Article{BirkedalL:parsepl-journal, author = {L. Birkedal and H. Yang}, title = {Relational Parametricity and Separation Logic}, journal = {Logical Methods in Computer Science}, year = 2008, volume = 4, number = {2:6}, pages = {1--27}, month = {may}} @InProceedings{BirkedalL:bihsl, author = {B. Biering and L. Birkedal and N. Torp-Smith}, title = {BI Hyperdoctrines and Higher-order Separation Logic}, booktitle = {ESOP}, year = 2005, } @InProceedings{Schwinghammer-nested-triples-conf, author = {J. Schwinghammer and L. Birkedal and B. Reus and H. Yang}, title = {Nested {H}oare Triples and Frame Rules for Higher-order Store}, booktitle = {CSL}, year = 2009, } @inproceedings{krishnaswami-tldi09, author = {Neelakantan R. Krishnaswami and Jonathan Aldrich and Lars Birkedal and Kasper Svendsen and Alexandre Buisse}, title = {Design patterns in separation logic}, booktitle = {TLDI}, year = {2009}, } @inproceedings{nanevski+:esop07, author = {Aleksandar Nanevski and Amal Ahmed and Greg Morrisett and Lars Birkedal}, title = {Abstract Predicates and Mutable {ADTs in Hoare Type Theory}}, booktitle = {ESOP}, year = {2007}, } @inproceedings{petersen-htt, author = {Rasmus Lerchedahl Petersen and Lars Birkedal and Aleksandar Nanevski and Greg Morrisett}, title = {A Realizability Model for Impredicative {H}oare Type Theory}, booktitle = {ESOP}, year = {2008}, } @InProceedings{ohearn+:popl04, author = "Peter W. O'Hearn and Hongseok Yang and John C. Reynolds", title = "Separation and Information Hiding", booktitle = "POPL", year = "2004", } @InProceedings{Birkedal:Reus:Schwinghammer:Yang:08, author = "Lars Birkedal and Bernhard Reus and Jan Schwinghammer and Hongseok Yang", title = "A Simple Model of Separation Logic for Higher-order Store", booktitle = "{ICALP'08}", pages = "348--360", year = "2008" } @InProceedings{Banerjee:Naumann:Rosenberg:08, author = "Anindya Banerjee and David Naumann and Stan Rosenberg", title = "Regional Logic for Local Reasoning about Global Invariants", booktitle = "ECOOP", year = "2008", url = "\url{http://www.cs.stevens.edu/~naumann/publications/node2.html}", } @Article{yang:relational, title = "Relational Separation Logic", author = "Hongseok Yang", journal = "TCS", year = "2007", number = "1--3", volume = "375", pages = "308--334", } @IProceedings{birkedal+:ho-frame-rules, author = {Lars Birkedal and Noah Torp-Smith and Hongseok Yang}, title = {Semantics of Separation-logic Typing and Higher-order Frame Rules}, booktitle = {Proc. of LICS'05}, year = {2005}, pages = {260-269} } @InProceedings{aydemir+:popl08, author = {Brian Aydemir and Arthur Chargu\'{e}raud and Benjamin C. Pierce and Randy Pollack and Stephanie Weirich}, title = {Engineering Formal Metatheory}, booktitle = "POPL", year = 2008 } @Article{birkedal+:lmcs06, author = {Lars Birkedal and Noah Torp-Smith and Hongseok Yang}, title = {Semantics of Separation-logic Typing and Higher-order Frame Rules}, journal = {LMCS}, year = {2006}, volume = {2}, number = {5:1}, } @Article{birkedal-yang, author = {Lars Birkedal and Hongseok Yang}, title = {Relational Parametricity and Separation Logic}, journal = {LMCS}, year = {2008}, volume = {4}, number = {2:6}, } @Article{reynolds:types, author = {John C. Reynolds}, title = {Types, Abstraction, and Parametric Polymorphism}, journal = {Information Processing}, year = 1983, } @inproceedings{reynolds:separation, author = "John C. Reynolds", title = "Separation logic: A logic for shared mutable data structures", booktitle = "LICS", year = "2002", } @InProceedings{birkedal-yang-fossacs, title = "Relational Parametricity and Separation Logic", author = "Lars Birkedal and Hongseok Yang", year = "2007", booktitle = "FOSSACS", pages = "", volume = "4423", series = "Lecture Notes in Computer Science", editor = "Helmut Seidl", } @InProceedings{reus-schwinghammer:csl06, author = {Bernhard Reus and Jan Schwinghammer}, title = {Separation Logic for Higher-order Store}, booktitle = {CSL}, year = "2006", } @InProceedings{Birkedal:Torp-Smith:Reynolds:04, author = "Lars Birkedal and Noah Torp-Smith and John C. Reynolds", title = "Local Reasoning about a Copying Garbage Collector", booktitle = "Conference Record of the 31st Annual {ACM} Symposium on Principles of Programming Languages", publisher = "ACM Press", year = 2004, series = "ACM SIGPLAN Notices", pages = "220--231", } @InProceedings{Thielecke:06, author = "Hayo Thielecke", title = "Frame rules from answer types for code pointers", booktitle = "Conference Record of the 33rd Annual ACM Symposium on Principles of Programming Languages", publisher = "ACM Press", pages = "309--319", year = 2006, } @Article{Reus:Schwinghammer:MSCS, author = {Bernhard Reus and Jan Schwinghammer}, title = {Denotational Semantics for a Program Logic of Objects}, journal = {Mathematical Structures in Computer Science}, year = 2006, volume = 16, number = 2, pages = {313--358}, month = {April}, } @InProceedings{Reus:Streicher:05, author = {Bernhard Reus and Thomas Streicher}, title = {About {Hoare} Logics for Higher-Order Store}, booktitle = {International Colloquium on Automata, Languages and Programming (ICALP'05)}, pages = "1337--1348", year = 2005, series = {Lecture Notes in Computer Science}, publisher = {Springer} } @InProceedings{Reddy:88, author = "Uday S. Reddy", title = "Objects as Closures: Abstract Semantics of Object-oriented Languages", pages = "289--297", editor = "Jerome Chailloux", booktitle = "Proceedings of the {ACM} Conference on {LISP} and Functional Programming", month = jul, year = 1988, publisher = "ACM Press", } @InCollection{OHearn:Tennent:92, author = "Peter W. O'Hearn and Robert D. Tennent", title = "Semantics of Local Variables", pages = "217--238", booktitle = "Applications of Categories in Computer Science", editor = "M. P. Fourman and P. T. Johnstone and A. M. Pitts", year = "1992", publisher = "Cambridge University Press", series = "London Mathematical Society Lecture Note Series", volume = "177", } @InProceedings{Morrisett:Ahmed:Fluet, author = {Greg Morrisett and Amal Ahmed and Matthew Fluet}, title = {L3: A Linear Language with Locations}, booktitle = {Proceedings of the 7th International Conference on Typed Lambda Calculi and Applications (TLCA '05)}, year = 2005, volume = 3461, series = {Lecture Notes in Computer Science}, publisher = {Springer} } @InProceedings{Ahmed:Fluet:Morrisett:05, author = {Amal Ahmed and Matthew Fluet and Greg Morrisett}, title = {A Step-Indexed Model of Substructural State}, booktitle = {Proceedings of the 10th ACM SIGPLAN International Conference on Functional Programming (ICFP '05)}, year = 2005, note = {To appear} } @TechReport{Aboul-Hosn:Kozen:05, author = {Kamal Aboul-Hosn and Dexter Kozen}, title = {Relational Semantics of Local Variable Scoping}, institution = {Computer Science Department, Cornell University}, year = 2005, number = {2005-2000}, month = jul, } @Article{Abadi:Cardelli:95, author = "Mart{\'\i}n Abadi and Luca Cardelli", title = "A theory of primitive objects: Second-order systems", journal = "Science of Computer Programming", volume = "25", number = "2-3", pages = "81--116", month = dec, year = "1995", } @Book{Davey:Priestley:02, author = "Brian A. Davey and Hilary A. Priestley", publisher = "Cambridge University Press", title = "Introduction to Lattices and Order", edition = "Second", year = 2002, } @Article{Mason:Smith:Talcott:96, author = "Ian A. Mason and Scott F. Smith and Carolyn L. Talcott", title = "From Operational Semantics to Domain Theory", journal = "Information and Computation", volume = "128", number = "1", year = "1996", pages = "26--47", } @InCollection{Talcott:98, author = "Carolyn L. Talcott", title = "Reasoning about Functions with Effects", pages = "347--390", editor = "Andrew D. Gordon and Andrew M. Pitts", booktitle = "Higher Order Operational Techniques in Semantics", publisher = "Cambridge University Press", series = "Publications of the Newton Institute", year = "1998", } @Book{Abadi:Cardelli:96, author = "Mart{\'\i}n Abadi and Luca Cardelli", title = "A Theory of Objects", publisher = "Springer", year = "1996", } @Article{Abadi:Cardelli:96a, title = "A Theory of Primitive Objects: Untyped and First-Order Systems", author = "Mart{\'\i}n Abadi and Luca Cardelli", pages = "78--102", journal = "Information and Computation", month = mar, year = "1996", volume = "125", number = "2", } @InProceedings{Mitchell:84, author = "John C. Mitchell", title = "Coercion and type inference", booktitle = "Conference Record of the 11th Annual ACM Symposium on Principles of Programming Languages", pages = "175--185", publisher = "ACM Press", month = jan, year = 1984, } @InProceedings{Reynolds:80, author = "John C. Reynolds", title = "Using category theory to design implicit conversions and generic operators", booktitle = "Proceedings of the Aarhus Workshop on Semantics-Directed Compiler Generation", editor = "Neil D. Jones", month = jan, year = 1980, publisher = "Springer", series = "Lecture Notes in Computer Science", number = 94, pages = "211--258", } @Article{OHearn:Reynolds:00, author = "Peter W. O'Hearn and John C. Reynolds", title = "From Algol to Polymorphic Linear Lambda-calculus", journal = "Journal of the ACM", volume = "47", number = "1", pages = "167--223", month = jan, year = "2000", } @InProceedings{Abadi:Cardelli:Curien:93, author = "Mart\'{\i}n Abadi and Luca Cardelli and Pierre-Louis Curien", title = "Formal Parametric Polymorphism", booktitle = "Conference Record of the 20th Annual ACM SIGPLAN-SIGACT Symposium on Principles of Programming Languages", pages = "157--170", year = "1993", } @InProceedings{Abadi:Cardelli:Plotkin:94, author = "Gordon D. Plotkin and Mart\'{\i}n Abadi and Luca Cardelli", title = "Subtyping and Parametricity", booktitle = "Proceedings of 9th Annual IEEE Symposium on Logic in Computer Science", pages = "310--319", month = jul, year = "1994", publisher = {IEEE Computer Society Press}, } @InProceedings{Abadi:Cardelli:Viswanathan:96, author = "Mart{\'\i}n Abadi and Luca Cardelli and Ramesh Viswanathan", title = "An interpretation of objects and object types", booktitle = "Conference record of the 23rd Symposium on Principles of Programming Languages", year = "1996", pages = "396--409", publisher = {{ACM} Press}, } @InProceedings{Abadi:Leino:97, author = {Mart{\'\i}n Abadi and K.~R.~M.~Leino}, title = {A Logic of Object-oriented Programs}, booktitle = {Proceedings of Theory and Practice of Software Development}, pages = {682--696}, year = {1997}, editor = {Michel Bidoit and Max Dauchet}, volume = {1214}, series = {Lecture Notes in Computer Science}, publisher = {Springer}, } @InProceedings{Abadi:Pierce:Plotkin:89, author = "Mart\'{\i}n Abadi and Benjamin C. Pierce and Gordon D. Plotkin", title = "Faithful Ideal Models for Recursive Polymorphic Types", booktitle = "Proceedings of 4th Annual IEEE Symposium on Logic in Computer Science", pages = "216--225", month = jun, year = "1989", publisher = {IEEE Computer Society Press}, } @InProceedings{Abadi:Plotkin:90, author = {Mart\'{\i}n Abadi and Gordon D. Plotkin}, title = {A PER Model of Polymorphism and Recursive Types}, booktitle = {Proceedings of 5th Annual IEEE Symposium on Logic in Computer Science}, pages = {355--365}, year = {1990}, publisher = {IEEE Computer Society Press}, } @InProceedings{Abadi:Plotkin:93, author = "Gordon D. Plotkin and Mart\'{\i}n Abadi", title = "A logic for parametric polymorphism", booktitle = "International Conference on Typed Lambda Calculi and Applications", year = "1993", editor = "M. Bezem and J. F. Groote", series = "Lecture Notes in Computer Science", number = "664", pages = "361--375", month = mar, } @InProceedings{Abramsky:Ghica:Murawski:Ong:Stark:04, author = {Samson Abramsky and Dan Ghica and Andrzej Murawski and Luke Ong and Ian Stark}, title = {Nominal Games and Full Abstraction for the Nu-Calculus}, booktitle = {Proceedings of the 19th Annual IEEE Symposium on Logic in Computer Science}, pages = {150--159}, year = 2004, publisher = {IEEE Computer Society Press}, } @InCollection{Abramsky:Jung:94, author = {Samson Abramsky and Achim Jung}, booktitle = {Handbook of Logic in Computer Science}, title = {Domain Theory}, publisher = {Clarendon Press}, pages = {1--168}, year = 1994, editor = {S. Abramsky and D. M. Gabbay and T. S. E. Maibaum}, volume = 3 } @InProceedings{Abramsky:McCusker:97, author = {Samson Abramsky and Guy McCusker}, title = {Game Semantics}, booktitle = {Logic and Computation. Proceedings of the 1997 Marktoberdorf Summer School}, year = {1998}, editor = {H. Schwichtenberg and U. Berger}, publisher = {Springer}, } @InProceedings{Abramsky:McCusker:Honda:98, title = "A Fully Abstract Game Semantics for General References", author = "Samson Abramsky and Kohei Honda and Guy {McCusker}", booktitle = "Proceedings 13th Annual IEEE Symposium on Logic in Computer Science", publisher = "IEEE Computer Society Press", pages = {334--344}, year = "1998", } @inproceedings{Aceto:Huettel:Ingolfsdottir:Kleist:00, author = {Luca Aceto and Hans H{\"u}ttel and Anna Ing{\'o}lfsd{\'o}ttir and Josva Kleist}, title = {Relating semantic models for the object calculus}, booktitle = {Electronic Notes in Theoretical Computer Science}, volume = {7}, editor = {C. Palamidessi and J. Parrow}, year = {2000} } @InProceedings{Ahmed:Appel:Virga:02, author = {Amal J. Ahmed and Andrew W. Appel and Roberto Virga}, title = {A Stratified Semantics of General References Embeddable in Higher-Order Logic}, booktitle = {Proceedings of 17th Annual IEEE Symposium Logic in Computer Science}, publisher = "IEEE Computer Society Press", pages = {75--86}, year = {2002}, } @Unpublished{Ahmed:Appel:Virga:03, author = {Amal J. Ahmed and Andrew W. Appel and Roberto Virga}, title = {An Indexed Model of Impredicative Polymorphism and Mutable References}, note = {Princeton University}, month = {January}, year = {2003}, } @Article{Amadio:91, author = "R. M. Amadio", title = "Recursion over realizability structures", journal = "Information and Computation", volume = "91", number = "1", pages = "55--86", year = "1991", } @InProceedings{Amadio:Cardelli:91, author = "Roberto M. Amadio and Luca Cardelli", title = "Subtyping Recursive Types", pages = "104--118", booktitle = "Conference Record of the 18th Annual {ACM} Symposium on Principles of Programming Languages", month = jan, year = "1991", note = "Journal version in \cite{Amadio:Cardelli:93}", } @Article{Amadio:Cardelli:93, author = "Roberto M. Amadio and Luca Cardelli", title = "Subtyping Recursive Types", journal = "ACM Transactions on Programming Languages and Systems", volume = "15", number = "4", pages = "575--631", year = "1993", } @inProceedings{Andersen:Pedersen:Huettel:Kleist:97, author = "Dan S. Andersen and Lars H. Pedersen and Hans H{\"u}ttel and Josva Kleist", title = "Objects, Types and Modal Logics", booktitle = "Proceedings of {FOOL4}", year = "1997", month = nov, url = "citeseer.nj.nec.com/andersen96objects.html", } @inproceedings{mellies-vouillon, author = "Paul-Andr{\'e} Melli{\`e}s and J{\'e}r{\^o}me Vouillon", title = {Recursive polymorphic types and parametricity in an operational framework}, booktitle = {LICS}, year = "2005", } @Article{appel-mcallester, author = {Andrew Appel and David McAllester}, title = {An Indexed Model of Recursive Types for Foundational Proof-Carrying Code}, journal = {TOPLAS}, year = {2001}, volume = {23}, number = {5}, pages = {657--683}, } @InProceedings{appel+:vmm, author = {Andrew Appel and Paul-Andr{\'e} Melli{\`e}s and Christopher Richards and J{\'e}r{\^o}me Vouillon}, title = {A Very Modal Model of a Modern, Major, General Type System}, booktitle = {POPL}, year = 2007 } @InProceedings{dockins+:mfps08, author = {Robert Dockins and Andrew W. Appel and Aquinas Hobor}, title = {Multimodal Separation Logic for Reasoning About Operational Semantics}, booktitle = {MFPS}, year = {2008}, } @Article{Apt:Plotkin:86, title = "Countable Nondeterminism and Random Assignment", author = "Krzysztof R. Apt and Gordon D. Plotkin", area = "Programming Languages and Systems", pages = "724--767", journal = "Journal of the ACM", month = oct, year = "1986", volume = "33", number = "4", } @Article{DiGianantonio:Honsell:Plotkin:95, title = "Uncountable Limits and the lambda Calculus", author = "Pietro {di Gianantonio} and Furio Honsell and Gordon D. Plotkin", journal = "Nordic Journal of Computing", year = 1995, number = 2, volume = 2, pages = "126--145", } @Article{Apt:81, author = "Krzysztof R. Apt", title = "Ten Years of {Hoare}'s Logic: {A} Survey --- Part {I}", journal = "ACM Transactions on Programming Languages and Systems", volume = "3", number = "4", pages = "431--483", month = oct, year = "1981", } @Book{Arnold:Gosling:Holmes:00, author = "Ken Arnold and James Gosling and David Holmes", key = "Arnold \& Gosling", title = "The {Java} Programming Language", publisher = "Addison-Wesley", year = "2000", edition = "Third", } @InProceedings{Banerjee:Naumann:02, author = "Anindya Banerjee and David A. Naumann", title = "Representation independence, confinement and access control", pages = "166--177", month = jan, year = "2002", booktitle = "Proceedings of the 29th ACM SIGPLAN-SIGACT symposium on Principles of Programming Languages", publisher = "IEEE Computer Society Press", } @InCollection{Barendregt:92, author = {Henk P. Barendregt}, title = {Lambda Calculi with Types}, booktitle = {Handbook of Logic in Computer Science}, pages = {117--309}, publisher = {Oxford University Press}, year = 1992, editor = {Samson Abramsky and Dov Gabbay and T.~S.~E. Maibaum}, volume = 2, chapter = 2 } @InProceedings{ahmed:esop06, author = {Amal Ahmed}, title = {Step-Indexed Syntactic Logical Relations for Recursive and Quantified Types}, booktitle = {ESOP}, year = 2006, } @InProceedings{ahmed+:popl09, author = {Amal Ahmed and Derek Dreyer and Andreas Rossberg}, title = {State-Dependent Representation Independence}, booktitle = {POPL}, year = {2009}, } @InProceedings{dreyer+:lics09, author = {Derek Dreyer and Amal Ahmed and Lars Birkedal}, title = {Logical Step-Indexed Logical Relations}, booktitle = {LICS}, year = {2009}, } @InProceedings{benton:popl04, author = {Nick Benton}, title = {Simple Relational Correctness Proofs for Static Analyses and Program Transformations}, booktitle = {POPL}, year = {2004}, } @InProceedings{benton-leperchey, author = {Nick Benton and Benjamin Leperchey}, title = {Relational Reasoning in a Nominal Semantics for Storage}, booktitle = {TLCA}, year = {2005}, } @Article{Birkedal:Harper:99, author = "Lars Birkedal and Robert W. Harper", title = "Constructing interpretations of recursive types in an operational setting", journal = "Information and Computation", year = "1999", volume = "155", pages = "3--63", } @Article{Blass:Gurevich:00, author = "Andreas Blass and Yuri Gurevich", title = "The Underlying Logic of {Hoare} Logic", journal = "Bulletin of the European Association for Theoretical Computer Science", volume = "70", pages = "82--110", month = feb, year = "2000", url = "\url{http://research.microsoft.com/~gurevich/Opera/142.ps}", } @InProceedings{Bodirsky:Gaertner:Oertzen:Schwinghammer:01, author = {Manuel Bodirsky and Tobias G\"artner and Timo von Oertzen and Jan Schwinghammer}, title = {Computing the Density of Regular Languages}, pages = {23--35}, month = aug, address = {Helsinki}, booktitle = {Proceedings of the Student Session of the European Summer School in Logic, Language, and Information}, year = {2001}, } @Misc{Bodirsky:Gaertner:Oertzen:Schwinghammer:LongRun, author = {Manuel Bodirsky and Tobias G\"artner and Timo von Oertzen and Jan Schwinghammer}, year = {2002}, title = {Long-run properties of periodic probabilistic systems}, howpublished = {Manuscript}, } @Misc{Bodirsky:Gaertner:Oertzen:Schwinghammer:Periods, author = {Manuel Bodirsky and Tobias G\"artner and Timo von Oertzen and Jan Schwinghammer}, title = {Periodic Sequences of Group Elements}, year = {2002}, howpublished = {Manuscript}, } @InProceedings{Bono:Bugliesi:99, author = {Viviana Bono and Michele Bugliesi}, title = {Interpretations of Extensible Objects and Types}, booktitle = {Proceedings of the 12th Int. Symposium on Fundamentals of Computing}, pages = {112--123}, year = {1999}, volume = {1684}, series = {Lecture Notes in Computer Science}, publisher = {Springer}, } @InProceedings{Bono:Patel:Shmatikov:Mitchell:99, author = "Viviana Bono and Amit J. Patel and Vitaly Shmatikov and John C. Mitchell", title = "A Core Calculus of Classes and Objects", booktitle = "15th Conference on the Mathematical Foundations of Programming Semantics", series = "Electronic Notes in Computer Science", volume = "20", year = "1999", month = apr, } @Article{Boudol:04, author = {G{\'}erard Boudol}, title = {The recursive record semantics of objects revisited}, journal = {Journal of Functional Programming}, year = {2004}, volume = {14}, number = {3}, pages = {263-315}, month = may, } @Article{Bracha:Odersky:Stoutamire:Wadler:98, author = "Gilad Bracha and Martin Odersky and David Stoutamire and Philip Wadler", title = "Making the Future Safe for the Past: Adding Genericity to the {Java} Programming Language", journal = "ACM SIG{\-}PLAN Notices", volume = "33", number = "10", pages = "183--200", month = oct, year = "1998", } @InProceedings{Bracha:Ungar:04, author = {Gilad Bracha and David Ungar}, title = {Mirrors: Design Principles for Meta-level Facilities of Object-Oriented Programming Languages}, booktitle = {Proceedings of the ACM Conference on Object-Oriented Programming, Systems, Languages and Applications}, year = {2004}, month = oct, publisher = {ACM Press}, } @Article{Breazu-Tannen:EtAl:91, author = "Val {Breazu-Tannen} and Thierry Coquand and Gunter Gunter and Andre Scedrov", title = "Inheritance as Implicit Coercion", journal = "Information and Computation", month = jul, year = "1991", number = "1", volume = "93", pages = "172--221", } @Book{Bruce:02, author = "Kim B. Bruce", title = "Foundations of Object-Oriented Languages: Types and Semantics", publisher = "MIT Press", year = "2002", } @Article{Bruce:94, author = "Kim B. Bruce", title = "A Paradigmatic Object-Oriented Programming Language: Design, Static Typing and Semantics", journal = "Journal of Functional Programming", volume = "4", number = "2", month = apr, pages = "127--206", year = "1994", } @article {Bruce:Cardelli:Pierce:99, author = "Kim B. Bruce and Luca Cardelli and Benjamin C. Pierce", title = "Comparing Object Encodings", journal = "Information and Computation", year = 1999, month = nov, volume = 155, number = "1/2", pages = "108--133", } @Article{Bruce:etal:95, author = "Kim B. Bruce and Luca Cardelli and Giuseppe Castagna and {The Hopkins Objects Group} and Gary T. Leavens and Benjamin Pierce", title = "On Binary Methods", journal = "Theory and Practice of Object Systems", publisher = "John Wiley and Sons, Inc.", year = "1995", pages = "221--242", volume = "1", number = "3", } @Book{Castagna:97, author = "Giuseppe Castagna", title = "Object-Oriented Programming: {A} Unified Foundation", publisher = "Birkhauser", year = 1997, series = "Progress in Theoretical Computer Science", } @Article{Bugliesi:Delzanno:Liquori:Martelli:00, author = "Michele Bugliesi and Giorgio Delzanno and Luigi Liquori and Maurizio Martelli", title = "Object Calculi in Linear Logic", journal = "Journal of Logic and Computation", volume = 10, number = 1, pages = "75 --104", month = feb, year = "2000", } @InProceedings{Calcagno+:lics09, author={Cristiano Calcagno and Peter W. O'Hearn and Hongseok Yang}, title={Local Action and Abstract Separation Logic}, booktitle={LICS}, year={2007}, } @InProceedings{Calcagno:Ishtiaq:OHearn:00, author = "Cristiano Calcagno and Samin Ishtiaq and Peter W. O'Hearn", title = "Semantic Analysis of Pointer Aliasing, Allocation and Disposal in {H}oare Logic", booktitle = "Proceedings of 2nd International Conference on Principles and Practice of Declarative Programming", year = "2000", pages = "190--201", editor = "Maurizio Gabbrielli and Frank Pfenning", series = "Lecture Notes in Computer Science", publisher = {Springer}, } @InProceedings{Canning:Cook:Hill:Olthoff:Mitchell:89, author = "P. Canning and W. Cook and W. Hill and W. Olthoff and J. Mitchell", title = "{F}-bounded polymorphism for object-oriented programming", booktitle = "Proceedings 4th International Conference on Functional Programming Languages and Computer Architecture", year = "1989", publisher = "ACM Press", pages = "273--280", } @InCollection{Cardelli:84, author = "Luca Cardelli", title = "A Semantics of Multiple Inheritance", booktitle = "Semantics of Data Types", editor = "Gilles Kahn and David MacQueen and Gordon Plotkin", series = "Lecture Notes in Computer Science", volume = "173", pages = "51--67", year = "1984", month = jun, publisher = "Springer", abstract-url = "http://www.luca.demon.co.uk/Papers.html#Inheritance", note = "Full version in \cite{Cardelli:88}" } @Article{Cardelli:88, author = "Luca Cardelli", title = "A Semantics of Multiple Inheritance", journal = "Information and Computation", volume = "76", number = "2/3", month = feb, year = "1988", pages = "138--164", } @Article{Cardelli:Martini:Mitchell:Scedrov:94, author = "Luca Cardelli and Simone Martini and John C. Mitchell and Andre Scedrov", title = "An Extension of {S}ystem {F} with Subtyping", journal = "Information and Computation", volume = "109", number = "1--2", pages = "4--56", year = "1994", } @Article{Cardelli:Wegner:85, author = "Luca Cardelli and Peter Wegner", title = "On Understanding Types, Data Abstraction, and Polymorphism", journal = "ACM Computing Surveys", volume = "17", number = "4", pages = "471--522", month = dec, year = "1985", } @InProceedings{Cardone:89, title = "Relational Semantics for Recursive Types and Bounded Quantification", author = "Felice Cardone", editor = "Giorgio Ausiello and Mariangiola Dezani-Ciancaglini and Simona Ronchi Della Rocca", booktitle = "16th International Colloquium Automata, Languages and Programming", month = jul, year = "1989", series = "Lecture Notes in Computer Science", volume = "372", publisher = "Springer", pages = "164--178", } @Article{Clarke:79, author = "E. M. Clarke", year = "1979", title = "Programming Language Constructs for which it it Impossible to obtain good {Hoare} Axiom Systems", journal = "Journal of the ACM", volume = "26", number = "1", pages = "129--147", } @Article{Cook:78, author = {Stephen A. Cook}, title = {Soundness and Completeness of an Axiom System for Program Verification}, journal = {{SIAM} Journal on Computing}, year = {1978}, volume = {7}, number = {1}, pages = {70--90}, } @PhdThesis{Cook:89, author = "William R. Cook", title = "A Denotational Semantics of Inheritance", school = "Department of Computer Science, Brown University", type = "Ph.{D}. Thesis", month = may, year = "1989", } @Article{Cook:Palsberg:94, author = "William Cook and Jens Palsberg", title = "A Denotational Semantics of Inheritance and its Correctness", journal = "Information and Computation", pages = "329--350", year = "1994", month = nov, number = "2", volume = "114", } @article{Coquand:Gunter:Winskel:89, author = "Thierry Coquand and Carl A. Gunter and Glynn Winskel", title = "Domain Theoretic Models of Polymorphism", journal = "Information and Computation", volume = "81", number = "2", pages = "123--167", year = "1989", url = "citeseer.nj.nec.com/coquand89domain.html" } @incollection{Cousot:90, author = {Patrick Cousot}, title = {Methods and Logics for Proving Programs}, pages = {843--993}, editor = {Jan {van Leeuwen}}, chapter = 15, booktitle = {Formal Models and Semantics}, volume = {B}, series = {Handbook of Theoretical Computer Science}, publisher = {Elsevier}, year = 1990, } @TechReport{Crary:99, author = {Karl Crary}, title = {Simple, Efficient Object Encoding using Intersection Types}, institution = {Carnegie Mellon University}, year = {1999}, month = jan, number = {CMU-CS-99-100}, } @InCollection{Curien:Ghelli:94, author = "Pierre-Louis Curien and Giorgio Ghelli", title = "Coherence of Subsumption, Minimum Subtyping and Type-Checking in ${F}_{\leq}$", editor = "Carl A. Gunter and John C. Mitchell", booktitle = "Theoretical Aspects of Object-Oriented Programming: Types, Semantics, and Language Design", series = "Foundations of Computing Series", pages = "247--292", publisher = "MIT Press", year = "1994", } @InProceedings{Eifrig:Smith:Trifonov:95, author = "Jonathan Eifrig and Scott Smith and Valery Trifonov", title = "Type Inference for Recursively Constrained Types and its Application to {OOP}", booktitle = "Proceedings of the 1995 Mathematical Foundations of Programming Semantics Conference", series = "Electronic Notes in Theoretical Computer Science", publisher = "Elsevier", volume = "1", year = "1995", fullurl = "http://www.elsevier.nl/locate/entcs/volume1.html", } @Article{Eifrig:Smith:Trifonov:Zwarico:95, author = "Jonathan Eifrig and Scott Smith and Valery Trifonov and Amy Zwarico", title = "An Interpretation of Typed {OOP} in a Language with State", journal = "Lisp and Symbolic Computation", volume = 8, number = 4, pages = "357--397", month = dec, year = 1995, } @Article{Erkok:Launchbury:00, author = "Levent Erk{\"o}k and John Launchbury", title = "Recursive monadic bindings", journal = "ACM SIG{\-}PLAN Notices", volume = "35", number = "9", pages = "174--185", month = sep, year = "2000", } @MastersThesis{Fecher:99, author = {Harald Fecher}, title = {Denotational Semantics of Untyped Object-Based Programming Languages}, school = {Technische Universit{\"a}t Darmstadt}, year = {1999}, } @Article{Filinski:94, author = "Andrzej Filinski", title = "Recursion from Iteration", journal = "{LISP} and Symbolic Computation", volume = "7", number = "1", pages = "11--37", month = jan, year = "1994", } @InProceedings{Findler:Felleisen:01, author = "Robert Bruce Findler and Matthias Felleisen", title = "Contract Soundness for Object-Oriented Languages", booktitle = "OOPSLA '01 Conference Proceedings", year = "2001", month = oct, pages = "1--15", } @InProceedings{Findler:Felleisen:02, author = {Robert Bruce Findler and Matthias Felleisen}, title = {Contracts for Higher-Order Functions}, booktitle = {Proceedings of the 2002 International Conference on Functional Programming}, OPTpages = {}, year = {2002}, OPTseries = {}, month = oct, } @Article{felleisen-hieb, author = {Matthias Felleisen and Robert Hieb}, title = {The revised report on the syntactic theories of sequential control and state}, journal = {TCS}, year = {1992}, volume = {103}, number = {2}, pages = {235--271}, } @PhdThesis{Fiore:94, author = {Marcelo P. Fiore}, title = {Axiomatic Domain Theory in Categories of Partial Maps}, school = {University of Edinburgh}, year = {1994}, note = {LFCS report ECS-LFCS-94-307}, } @Book{Fiore:96, author = {Marcelo P. Fiore}, title = {Axiomatic Domain Theory in Categories of Partial Maps}, publisher = {Cambridge University Press}, year = 1996, series = {Distinguished Dissertations in Computer Science} } @Article{FioreEtAl:96, author = "Marcelo Fiore and Achim Jung and Eugenio Moggi and Peter O'Hearn and Jon Riecke and Giuseppe Rosolini and Ian Stark", title = "Domains and Denotational Semantics: History, Accomplishments and Open Problems", journal = "Bulletin of the European Association for Theoretical Computer Science", volume = "59", pages = "227--256", month = jun, year = "1996", } @Article{Fisher:Honsell:Mitchell:94, author = "Kathleen Fisher and Furio Honsell and John C. Mitchell", title = "A lambda calculus of objects and method specialization", journal = "Nordic Journal of Computing", year = "1994", volume = "1", pages = "3--37", } @Article{Fisher:Mitchell95, title = "The Development of Type Systems for Object-Oriented Languages", author = "Kathleen Fisher and John C. Mitchell", journal = "Theory and Practice of Object Sytems", pages = "189--220", year = "1995", volume = "1", number = "3", } @InProceedings{Fisher:Mitchell:95, author = "Kathleen Fisher and John C. Mitchell", title = "A Delegation-based Object Calculus with Subtyping", booktitle = "Fundamentals of Computation Theory (FCT'95)", series = "Lecture Notes in Computer Science", volume = "965", pages = "42--61", year = "1995", publisher = {Springer}, } @Article{Fisher:Mitchell:98, author = "Kathleen Fisher and John C. Mitchell", title = "On the Relationship Between Classes, Objects and Data Abstraction", journal = "Theory and Practice of Object Systems", year = "1998", volume = "4", number = "1", pages = "3--25", } @InProceedings{Floyd:67, author = "Robert W. Floyd", title = "Assigning Meanings to Programs", booktitle = "Proceedings of Mathematical Aspects of Computer Science", month = apr, year = "1967", pages = "19--32", editor = "Jacob T. Schwartz", volume = "19", series = "Proceedings of Symposia in Applied Mathematics", publisher = "American Mathematical Society", } @InProceedings{Freyd:91, author = "Peter J. Freyd", title = "Algebraically Complete Categories", editor = "A. Carboni and M. C. Pedicchio and G. Rosolini", booktitle = "Proceedings of 1990 Como Category Theory Conference", series = "Lecture Notes in Mathematics", volume = "1488", pages = "95--104", publisher = "Springer", year = "1991", } @Article{Freyd:Rosolini:Mulry:Scott:92, author = "Peter Freyd and Giuseppe Rosolini and Philip Mulry and Dana Scott", title = "Extensional {PERs}", journal = "Information and Computation", volume = "98", number = "2", special = "Selected Papers from 5th Ann.\ IEEE Symp.\ on Logic in Computer Science, LICS'90, Philadelphia, PA, USA, 4--7 June 1990", pages = "211--227", year = "1992", } @Book{GangOfFourBook, author = "Erich Gamma and Richard Helm and Ralph Johnson and John Vlissides", title = "Design Patterns: Elements of Reusable Object-Oriented Software", publisher = "Addison Wesley", year = "1995", } @Article{Gapeyev:Levin:Pierce:00, author = "Vladimir Gapeyev and Michael Y. Levin and Benjamin C. Pierce", title = "Recursive subtyping revealed (functional pearl)", journal = "ACM SIG{\-}PLAN Notices", volume = "35", number = "9", pages = "221--231", month = sep, year = "2000", url = "http://www.acm.org/pubs/citations/proceedings/fp/351240/p221-gapeyev/", } @InCollection{Abadi:Leino:04, author = {Mart{\'\i}n Abadi and K.~R.~M.~Leino}, title = {A Logic of Object-Oriented Programs}, booktitle = {Verification: Theory and Practice. Essays Dedicated to Zohar Manna on the Occasion of His 64th Birthday }, pages = {11--41}, publisher = {Springer}, series = {Lecture Notes in Computer Science}, volumne = {2772}, year = {2004}, editor = {Nachum Dershowitz}, } @Book{Girard:Lafont:Taylor:89, author = "Jean-Yves Girard and Yves Lafont and Paul Taylor", title = "Proofs and Types", publisher = "Cambridge University Press", series = "Cambridge Tracts in Theoretical Computer Science", year = "1989", volume = "7", } @Misc{Glimming:05, author = {Johan Glimming}, title = {\emph{Dialgebraic Semantics of Typed Object Calculi}}, year = 2005, month = {May}, howpublished = {Licentiate thesis, Stockholm University} } @inproceedings{Glimming:Ghani:04, author = {Johan Glimming and Neil Ghani}, title = {Difunctorial Semantics of Object Calculus}, booktitle = {Proceedings {WOOD} '04: Workshop on Object-Oriented Developments}, series = {Electronic Notes in Theoretical Computer Science}, publisher = {Elsevier}, year = 2004, note = {To appear}, } @InProceedings{Goerdt:88, title = "Hoare Calculi for Higher-Type Control Structures and Their Completeness in the Sense of~{Cook}", author = "Andreas Goerdt", booktitle = "Mathematical Foundations of Computer Science 1988", editor = "Michael P. Chytil and Ladislav Janiga and V{\'a}clav Koubek", month = sep, year = "1988", series = "Lecture Notes in Computer Science", volume = "324", publisher = "Springer", pages = "329--338", } @InCollection{Gordon:98, author = {Andrew~D.~Gordon}, title = {Operational equivalences for untyped and polymorphic object calculi}, booktitle = {\cite{Gordon:Pitts:98}}, pages = {9--54}, year = {1998}, } @inproceedings{Gordon:Hankin:00, author = {Andrew D. Gordon and Paul D. Hankin}, title = {A Concurrent Object Calculus: Reduction and Typing}, booktitle = {Proceedings {HLCL}'98}, series = {Electronic Notes in Theoretical Computer Science}, publisher = {Elsevier}, volume = {16}, issue = {3}, editor = {Uwe Nestmann and Benjamin C. Pierce}, year = {2000} } @InProceedings{Gordon:Hankin:Lassen:97, author = "Andrew D. Gordon and Paul D. Hankin and S{\o}ren. B. Lassen", title = "Compilation and Equivalence of Imperative Objects", booktitle = "Proceedings of FST+TCS'97", series = "Lecture Notes in Computer Science", pages = {74--87}, volume = {1346}, month = dec, year = "1997", } @book{Gordon:Pitts:98, editor = {Andrew D. Gordon and Andrew M. Pitts}, title = {Higher Order Operational Techniques in Semantics}, publisher = {Cambridge University Press}, series = {Publications of the Newton Institute}, year = 1998, } @InProceedings{Gordon:Rees:96, author = {Andrew~D.~Gordon and Gareth~D.~Rees}, title = {Bisimilarity for a First-Order Calculus of Objects with Subtyping}, booktitle = {Conference Record of the 23rd Symposium on Principles of Programming Languages}, pages = {386--395}, year = {1996}, month = jan, } @Book{Gosling:Joy:Steele:Bracha:04, author = {James Gosling and Bill Joy and Guy Steele and Gilad Bracha}, title = {The Java Language Specification}, publisher = {Addison-Wesley}, year = {2004}, edition = {Third}, } @InProceedings{Goubault-Larrecq:Lasota:Nowak:02, author = "Jean {Goubault-Larrecq} and Slawomir Lasota and David Nowak", title = "Logical Relations for Monadic Types", booktitle = "Proc.\ 16th Int.\ Workshop Computer Science Logic (CSL 2002)", volume = "2471", pages = "553--568", series = "Lecture Notes in Computer Science", year = "2002", publisher = "Springer", } @InProceedings{Goubault-Larrecq:Lasota:Nowak:Zhang:04, author = "Jean {Goubault-Larrecq} and Slawomir Lasota and David Nowak and Yu Zhang", title = "Complete Lax Logical Relations for Cryptographic Lambda-Calculi", booktitle = "Proc.\ 18th Int.\ Workshop Computer Science Logic (CSL 2004)", volume = "3210", series = "Lecture Notes in Computer Science", pages = "400--414", year = "2004", publisher = "Springer", } @InProceedings{Halpern:84, author = "Joseph Y. Halpern", title = "A Good {H}oare Axiom System for an {A}lgol-Like Language", booktitle = "Conference Record of the Eleventh Annual {ACM} Symposium on Principles of Programming Languages", publisher = "ACM Press", month = jan, year = "1984", pages = "262--271", } @Article{Hasegawa:94, title = "Categorical data types in parametric polymorphism", author = "Ryu Hasegawa", pages = "71--109", journal = "Mathematical Structures in Computer Science", month = mar, year = "1994", volume = "4", number = "1", } @Book{Haskell98, editor = {Simon {Peyton Jones}}, title = {Haskell 98 Language and Libraries. The Revised Report}, publisher = {Cambridge University Press}, year = {2003}, OPTmonth = {April}, } @InProceedings{Hensel:Huismann:Jacobs:Tews:98, title = "Reasoning about Classes in Object-Oriented Languages: Logical Models and Tools", author = "Ulrich Hensel and Marieke Huisman and Bart Jacobs and Hendrik Tews", booktitle = "Programming Languages and Systems---{ESOP}'98, 7th European Symposium on Programming", editor = "Chris Hankin", month = mar, year = "1998", series = "Lecture Notes in Computer Science", volume = "1381", pages = "105--121", publisher = {Springer}, } @Article{Hoare:69, author = "C. A. R. Hoare", title = "{An Axiomatic Basis of Computer Programming}", journal = "Communications of the ACM", year = "1969", volume = "12", pages = "576--580", publisher = "ACM Press", } @Article{Hofmann:Pierce:94, author = "Martin Hofmann and Benjamin Pierce", title = "A Unifying Type-Theoretic Framework for Objects", journal = "Journal of Functional Programming", volume = "5", number = "4", pages = "593--635", month = oct, year = "1995", } @Article{Hofmann:Pierce:95, author = "Martin Hofmann and Benjamin C. Pierce", title = "A Unifying Type-Theoretic Framework for Objects", journal = "Journal of Functional Programming", month = oct, year = "1995", volume = "5", number = "4", pages = "593--635", } @Article{Hofmann:Pierce:96, author = {Martin Hofmann and Benjamin Pierce}, title = {Positive Subtyping}, journal = {Information and Computation}, year = {1996}, volume = {126}, number = {1}, pages = {11--33}, } @Misc{Hofmann:Tang:02, author = {Francis Tang and Martin Hofmann}, title = {Generation of Verification Conditions for {Abadi} and {Leino}'s Logic of Objects}, howpublished = {Presented at 9th International Workshop on Foundations of Object-Oriented Languages}, month = jan, year = {2002}, } @InProceedings{Berger:Honda:Yoshida:05, author = "Martin Berger and Kohei Honda and Nobuko Yoshida", title = "A Logical Analysis of Aliasing in Imperative Higher-Order Functions", booktitle = "Proceedings of the 10th {ACM} {SIGPLAN} International Conference on Functional Programming ({ICFP} '05)", publisher = "ACM Press", year = "2005", notes = "To appear", } @InProceedings{Honda:Yoshida:Berger:05, author = {Kohei Honda and Nobuko Yoshida and Martin Berger}, title = {An Observationally Complete Program Logic for Imperative Higher-Order Functions}, booktitle = {{LICS'05}}, pages = {270--279}, year = 2005, } @Article{Honda:04, author = "Kohei Honda", title = "From process logic to program logic", journal = "ACM SIG{\-}PLAN Notices", volume = "39", number = "9", pages = "163--174", month = sep, year = "2004", } @Article{Honsell:Pravato:Rocca:98, title = "{Structured Operational Semantics} of a fragment of the language {Scheme}", author = "Furio Honsell and Alberto Pravato and Simona Ronchi Della Rocca", pages = "335--365", journal = "Journal of Functional Programming", month = jul, year = "1998", volume = "8", number = "4", } @InProceedings{Igarashi:Pierce:00, author = {Atsushi Igarashi and Benjamin C. Pierce}, title = {On inner Classes}, booktitle = {Proceedings of the European Conference on Object-Oriented Programming}, pages = {129--153}, year = {2000}, volume = {1850}, series = {Lecture Notes in Computer Science}, publisher = {Springer}, } @Article{Ishtiaq:OHearn:01, author = "Samin S. Ishtiaq and Peter W. O'Hearn", title = "{BI} as an Assertion Language for Mutable Data Structures", journal = "ACM SIG{\-}PLAN Notices", volume = "36", number = "3", pages = "14--26", month = mar, year = "2001", } @inproceedings{Jacobs:00, author = {Bart Jacobs}, title = {Subtypes and bounded quantification from a fibred perspective}, booktitle = {Electronic Notes in Theoretical Computer Science}, volume = {1}, editor = {S. Brookes, M. Main, A. Melton and M. Mislove}, year = {2000}, publisher = {Elsevier}, } @InCollection{Jacobs:96, author = "Bart P. F. Jacobs", title = "Objects and classes, coalgebraically", editor = "B. Freitag and C. B. Jones and C. Lengauer and H. J. Schek", booktitle = "Object-Orientation with Parallelism and Persistence", pages = "83--103", publisher = "Kluwer Academic Publishers", year = "1996", url = "http://www.cwi.nl/pub/CWIreports/AP/CS-R9536.ps.Z", } @InProceedings{Jacobs:Poll:01, author = "Bart Jacobs and Erik Poll", title = "A Logic for the {Java} Modeling Language {JML}", series = "Lecture Notes in Computer Science", volume = "2029", pages = "284--299", year = "2001", booktitle = "Fundamental Approaches to Software Engineering (FASE'2001)", publisher = "Springer", } @Article{Jacobs:Poll:03, author = "Bart Jacobs and Erik Poll", title = "Coalgebras and monads in the semantics of {Java}", journal = "Theoretical Computer Science", volume = "291", number = "3", pages = "329--349", year = "2003", } @Article{Jacobs:Rutten:97, author = "Bart Jacobs and Jan Rutten", title = "A Tutorial on (Co)Algebras and (Co)Induction", journal = "Bulletin of the European Association for Theoretical Computer Science", volume = "62", pages = "222--259", month = jun, year = "1997", } @inproceedings{Jeffrey:Rathke:02, author = {Alan Jeffrey and Julian Rathke}, year = {2002}, title = {A fully abstract may testing semantics for concurrent objects}, booktitle = {Proceedings $17^{th}$ Annual Symposium on Logic in Computer Science}, publisher = {IEEE Computer Society Press}, pages = {101--112} } @inproceedings{Jeffrey:Rathke:99, author = {Alan Jeffrey and Julian Rathke}, title = {Towards a theory of bisimulation for local names}, booktitle = {Proc. LICS'99, 14th Annual Symposium on Logic in Computer Science}, year = {1999}, publisher = {IEEE Computer Society Press}, pages = {56--66}, } @InCollection{Kamin:Reddy:94, author = "Samuel N. Kamin and Uday S. Reddy", title = "Two Semantic Models of Object-Oriented Languages", booktitle = "Theoretical Aspects of Object-Oriented Programming: Types, Semantics, and Language Design", editor = "Carl A. Gunter and John C. Mitchell", publisher = "MIT Press", pages = "464--495", year = "1994", } @Book{Kernighan:Ritchie:88, author = {Brian Kernighan and Dennis Ritchie}, title = {The {C} Programming Language}, publisher = {Prentice-Hall}, year = {1988}, edition = {Second}, } @InProceedings{Kleist:Sangiorgi:98, author = "Josva Kleist and Davide Sangiorgi", title = "Imperative Objects and Mobile Processes", pages = "285--303", booktitle = "Programming Concepts and Methods", year = "1998", editor = "David Gries and Willem-Paul {de Roever}", } @article{Kleymann:99, author = "Thomas Kleymann", title = "Hoare Logic and Auxiliary Variables", journal = "Formal Aspects of Computing", volume = "11", number = "5", pages = "541--566", year = "1999", month = dec, } @InProceedings{Laeufer:95, author = "L{\"{a}}ufer, K.", title = "A Framework for Higher-Order Functions in {C}++", booktitle = "Proceedings of Conference on Object-Oriented Technologies", year = 1995, address = "Monterey, CA", month = jun, pages = "103--116", } @InProceedings{Laird:02, author = {James Laird}, title = {A Categorical Semantics of Higher-Order Store}, booktitle = {Proceedings of the 9th Conference on Category Theory and Computer Science, CTCS '02}, pages = {1--18}, year = {2003}, editor = {Rick Blute and Peter Selinger}, volume = {69}, series = {Electronic notes in Theoretical Computer Science}, publisher = {Elsevier}, } @Article{Landin:64, author = "Peter J. Landin", title = "The Mechanical Evaluation of Expressions", journal = "Computer Journal", volume = "6", number = "4", month = jan, year = "1964", pages = "308--320", } @InProceedings{Leino:98, title = "Recursive Object Types in a Logic of Object-Oriented Programs", author = "K. Rustan M. Leino", booktitle = "7th European Symposium on Programming", editor = "Chris Hankin", month = mar, year = "1998", series = "Lecture Notes in Computer Science", publisher = {Springer}, volume = "1381", pages = "170--184", } @InProceedings{Levy:02, author = "Paul Blain Levy", title = "Possible World Semantics for General Storage in Call-By-Value", booktitle = "CSL: 16th Workshop on Computer Science Logic", series = "Lecture Notes in Computer Science", volume = "2471", editor = "Julian Bradfield", publisher = "Springer", year = "2002", } @Book{Levy:04, author = {Paul Blain Levy}, title = {Call-By-Push-Value. A Functional/Imperative Synthesis}, publisher = {Kluwer}, year = {2004}, volume = {2}, series = {Semantic Structures in Computation}, } @Article{Liang:Bracha:98, author = "Sheng Liang and Gilad Bracha", title = "Dynamic Class Loading in the {Java Virtual Machine}", pages = "36--44", booktitle = "Proceedings of the 13th Conference on Object-Oriented Programming, Systems, Languages, and Applications", month = oct, journal = "ACM SIGPLAN Notices", volume = "33", number = "10", publisher = "ACM Press", year = "1998", } @Article{Liskov:Wing:94, author = "Barbara H. Liskov and Jeannette M. Wing", title = "A Behavioral Notion of Subtyping", journal = "ACM Transactions on Programming Languages and Systems", volume = "16", number = "6", pages = "1811--1841", month = nov, year = "1994", } @PhdThesis{Longley:95, author = "John Longley", title = "Realizability toposes and language semantics", school = "University of Edinburgh", year = "1995", } @Article{Longo:Moggi:91, author = "Giuseppe Longo and Eugenio Moggi", title = "Constructive Natural Deduction and its `$\omega$-set' Interpretation", journal = "Mathematical Structures in Computer Science", pages = "215--254", volume = "1", number = "2", month = jul, year = "1991", } @InProceedings{Ma:Reynolds:92, author = "QingMing Ma and John C. Reynolds", title = "Types, Abstraction, and Parametric Polymorphism, Part 2", booktitle = "Proceedings 7th International Conference on Mathematical Foundations of Programming Semantics", editor = "Stephen Brookes and Michael Main and Austin Melton and Michael Mislove and David A. Schmidt", series = "Lecture Notes in Computer Science", volume = "598", publisher = "Springer", year = "1992", pages = "1--40", } @Book{MacLane:97, author = {Saunders {Mac Lane}}, title = {Categories for the Working Mathematician}, series = {Graduate Texts in Mathematics}, volume = {5}, publisher = {Springer}, year = {1997}, } @Article{MacQueen:Plotkin:Sethi:86, author = "David B. MacQueen and Gordon D. Plotkin and Ravi Sethi", title = "An Ideal Model for Recursive Polymorphic Types", journal = "Information and Control", month = oct, volume = "71", number = "1--2", year = "1986", pages = "95--130", } @InProceedings{Meyer:Sieber:88, author = "Albert R. Meyer and K. Sieber", title = "Towards Fully Abstract Semantics for Local Variables: Preliminary Report", pages = "191--203", booktitle = "Conference Record of the Fifteenth Annual {ACM} Symposium on Principles of Programming Languages", year = "1988", publisher = "ACM Press", month = jan, } @Article{Milner:78, author = "Robin Milner", journal = "Journal of Computer and System Science", pages = "348--375", title = "A Theory of Type Polymorphism in Programming Languages", volume = "17", number = "3", year = "1978", } @InProceedings{Mitchell:90, author = "John C. Mitchell", title = "Toward a Typed Foundation for Method Specialization and Inheritance", booktitle = "Conference Record of the 17th Annual {ACM} Symposium on Principles of Programming Languages", publisher = {ACM Press}, year = "1990", pages = "109--124", month = jan, } @InCollection{Mitchell:91, author = "John C. Mitchell", title = "On the Equivalence of Data Representations", editor = "V. Lifschitz", booktitle = "Artificial Intelligence and Mathematical Theory of Computation: Papers in Honor of {John McCarthy}", publisher = "Academic Press", pages = "305--330", year = "1991", } @Book{Mitchell:96, author = "John C. Mitchell", title = "Foundations for Programming Languages", publisher = "MIT Press", year = "1996", } @Article{Mitchell:Moggi:91, author = "John C. Mitchell and Eugenio Moggi", title = "{K}ripke-Style Models for Typed Lambda Calculus", journal = "Annals of Pure and Applied Logic", volume = "51", number = "1--2", pages = "99--124", year = "1991", } @Article{Mitchell:Plotkin:88, author = "John C. Mitchell and Gordon D. Plotkin", title = "Abstract Types Have Existential Type", journal = "ACM Transactions on Programming Languages and Systems", volume = "10", number = "3", pages = "470--502", month = jul, year = "1988", } @InProceedings{Mitchell:Scedrov:93, author = "John C. Mitchell and Andre Scedrov", title = "Notes on Sconing and Relators", publisher = "Springer", series = "Lecture Notes in Computer Science", volume = "702", pages = "352--378", year = "1993", booktitle = "Computer Science Logic '92, Selected Papers", editor = {Egon B{\"o}rger and Gerhard J{\"a}ger and Hans Kleine B{\"u}ning and Simone Martini and Michael M. Richter}, } @InProceedings{Mitchell:Viswanathan:96, title = "Effective Models of Polymorphism, Subtyping and Recursion (Extended Abstract)", author = "John C. Mitchell and Ramesh Viswanathan", editor = "Friedhelm {Meyer auf der Heide} and Burkhard Monien", booktitle = "23rd International Colloquium on Automata, Languages and Programming", month = jul, year = "1996", series = "Lecture Notes in Computer Science", publisher = "Springer", volume = "1099", pages = "170--181", } @Article{Moggi:Sabry:04, author = "Eugenio Moggi and Amr Sabry", title = "An Abstract Monadic Semantics for Value Recursion", journal = "Theoretical Informatics and Applications", volume = "38", number = "4", special = "Selected Papers from 5th Int.\ Wksh.\ on Fixed Points in Comp.\ Sci., FICS 2003, Warsaw, Poland, 12--13 Apr.\ 2003", pages = "375--400", year = "2004", } @Misc{Niehren:Schwinghammer:Smolka:Futures, author = {Joachim Niehren and Jan Schwinghammer and Gert Smolka}, title = {Concurrent Computation in a Lambda Calculus with Futures}, year = {2003}, howpublished = {Draft}, } @inproceedings{Nipkow:Oheimb:02, author={David von Oheimb and Tobias Nipkow}, title={Hoare Logic for {NanoJava}: Auxiliary Variables, Side Effects and Virtual Methods Revisited}, booktitle={Formal Methods Europe (FME 2002)}, editor={L.-H. Eriksson and P. Lindsay}, publisher={Springer}, series={LNCS}, volume=2391, pages={89-105}, year={2002}, } @Article{OHearn:03, author = {Peter W. O'Hearn}, title = {On Bunched Typing}, journal = {Journal of Functional Programming}, year = {2003}, pages = {747--796}, volume = {13}, number = "4", } @Article{OHearn:98, author = {Peter W. O'Hearn}, title = {Polymorphism, Objects and Abstract Types}, journal = {{SIGACT} News}, year = {1998}, volume = {29}, number = {4}, pages = {39--50}, month = dec, } @Article{OHearn:Pym:99, author = {Peter W. O'Hearn and David J. Pym}, title = {The Logic of Bunched Implications}, journal = {Bulletin of Symbolic Logic}, year = {1999}, volume = {5}, number = {2}, pages = {215--244}, month = jun, } @Article{OHearn:Reddy:99, author = {Peter W. O'Hearn and Uday S. Reddy}, title = {Objects, interference and the Yoneda embedding}, journal = {Theoretical Computer Science}, year = {1999}, volume = {228}, number = {1--2}, pages = {253--282}, } @InProceedings{OHearn:Reynolds:Yang:01, author = {Peter W. O'Hearn and John C. Reynolds and Hongseok Yang}, title = {Local Reasoning about Programs that Alter Data Structures}, booktitle = {Proceedings Computer Science Logic (CSL'01)}, pages = {1--18}, year = {2001}, editor = {L. Fribourg}, volume = {2142}, series = {Lecture Notes in Computer Science}, publisher = {Springer}, } @Article{OHearn:Tennent:95, title = "Parametricity and Local Variables", author = "Peter W. O'Hearn and Robert D. Tennent", pages = "658--709", journal = "Journal of the ACM", month = may, year = "1995", volume = "42", number = "3", } @Book{OHearn:Tennent:97, editor = "Peter W. O'Hearn and Robert D. Tennent", title = "{{A}lgol-Like Languages, Vols {I} and {II}}", publisher = "Birkhauser", year = "1997", series = "Progress in Theoretical Computer Science", } @Article{Ohori:Buneman:89, key = "Ohori \& Buneman", author = "Atsushi Ohori and Peter Buneman", title = "Static Type Inference for Parametric Classes", journal = "ACM SIGPLAN Notices", volume = "24", number = "10", month = oct, year = "1989", pages = "445--456", editor = "Norman Meyerowitz", note = "OOPSLA '89 Conference Proceedings", } @PhdThesis{Oles:82, title = "A Category-theoretic approach to the semantics of programming languages", author = "Frank Joseph Oles", year = "1982", school = "Syracuse University", } @Article{Palsberg:95, title = "Efficient Inference of Object Types", author = "Jens Palsberg", pages = "198--209", journal = "Information and Computation", month = dec, year = "1995", volume = "123", number = "2", } @Book{Paulson:87, author = "Larry C. Paulson", title = "Logic and Computation : Interactive proof with Cambridge {LCF}", series = "Cambridge Tracts in Theoretical Computer Science", volume = "2", year = "1987", publisher = "Cambridge University Press", } @TechReport{Phoa:92, author = "Wesley Phoa", title = "An Introduction to Fibrations, Topos Theory, the Effective Topos and Modest Sets", number = "ECS-LFCS-92-208", institution = "Department of Computer Science, University of Edinburgh", year = "1992", } @Book{Pierce:02, author = "Benjamin C. Pierce", title = "Types and Programming Languages", publisher = "The MIT Press", year = "2002", } @Book{Pierce:91, author = "Benjamin C. Pierce", title = "Basic Category Theory for Computer Scientists", publisher = "MIT Press", year = "1991", } @Article{Pierce:Turner:94, author = "Benjamin C. Pierce and David N. Turner", title = "Simple Type-Theoretic Foundations for Object-Oriented Programming", journal = "Journal of Functional Programming", volume = "4", number = "2", pages = "207--247", year = "1994", } @Article{Pierik:deBoer:05, author = {Cees Pierik and Frank S. de Boer}, title = {A Proof Outline Logic for Object-Oriented Programming}, journal = {Theoretical Computer Science}, year = {2005}, note = {To appear}, } @InProceedings{Pitts:87, author = "Andrew M. Pitts", title = "Polymorphism is Set Theoretic, Constructively", booktitle = "Category Theory and Computer Science", editor = "D. H. Pitt and A. Poign\'{e} and David E. Rydeheard", series = "Lecture Notes in Computer Science", publisher = "Springer", volume = "283", year = "1987", } @ARTICLE{pitts:relational, AUTHOR={Andrew M. Pitts}, TITLE={Relational Properties of Domains}, JOURNAL={Information and Computation}, VOLUME=127, YEAR=1996, PAGES={66--90}, } @InProceedings{Pitts:Stark:93, author = "Andrew M. Pitts and Ian D. B. Stark", title = "Observable Properties of Higher Order Functions That Dynamically Create Local Names, or: What's new?", booktitle = "Proceedings 18th International Symposium on Mathematical Foundations of Computer Science", editor = "Andrzej M. Borzyszkowski and Stefan Sokolowski", series = "Lecture Notes in Computer Science", volume = "711", publisher = "Springer", year = "1993", pages = "122--141", } @InProceedings{pitts-stark:state, author = "Andrew Pitts and Ian Stark", title = "Operational Reasoning for Functions with Local State", booktitle = "HOOTS", year = "1998", } @InProceedings{chin+:popl08, author = {Wei-Ngan Chin and Cristina David and Huu Hai Nguyen and Shengchao Qin}, title = {Enhancing Modular {OO} Verification with Separation Logic}, booktitle = "POPL", year = 2008, } @Unpublished{Plotkin:83, author = {Gordon D. Plotkin}, title = {Domain Theory}, note = "Pisa notes", year = {1983}, } @Article{Plotkin:Smyth:82, author = "Michael B. Smyth and Gordon D. Plotkin", title = "The Category-theoretic Solution of Recursive Domain Equations", journal = "SIAM J. Comput.", volume = "11", number = "4", pages = "761--783", year = "1982", } @InProceedings{Poetzsch-Heffter:Mueller:98, author = "Arnd Poetzsch-Heffter and Peter M{\"u}ller", title = "Logical Foundations for Typed Object-Oriented Languages", editor = "David Gries and Willem-Paul {De~Roever}", booktitle = "Proceedings {IFIP} Working Conference on Programming Concepts and Methods", year = "1998", publisher = "Chapman \& Hall", } @InProceedings{Poetzsch-Heffter:Mueller:99, key = "Poetzsch-Heffter \& M{\"u}ller", author = "Arnd Poetzsch-Heffter and Peter M{\"u}ller", title = "A Programming Logic for Sequential {J}ava", booktitle = "European Symposium on Programming", editor = "S. D. Swierstra", series = "Lecture Notes in Computer Science", publisher = "Springer", volume = "1576", pages = "162--176", year = "1999", } @Article{Pym:OHearn:Yang:04, author = "David J. Pym and Peter W. O'Hearn and Hongseok Yang", title = "Possible worlds and resources: the semantics of {BI}", journal = "Theoretical Computer Science", volume = "315", number = "1", pages = "257--305", day = "5", month = may, year = "2004", } @Article{Reddy:02, author = {Uday S.~Reddy}, title = {Objects and classes in Algol-like languages}, journal = {Information and Computation}, year = {2002}, volume = {172}, number = {1}, pages = {63--97}, month = {January}, } @Article{Reddy:96, author = "Uday S. Reddy", title = "Global State Considered Unnecessary: An Introduction to Object-Based Semantics", journal = "{LISP} and Symbolic Computation", volume = "9", number = "1", pages = "7--76", month = feb, year = "1996", } @Misc{Reddy:98, author = {Uday S. Reddy}, title = {Objects and Classes in {Algol}-like Languages}, year = {1998}, note = {Presented at {FOOL} 5 workshop}, } @Article{Reddy:Yang:04, author = {Uday S. Reddy and Hongseok Yang}, title = {Correctness of Data Representations Involving Heap Data Structures}, journal = {Science of Computer Programming}, year = {2004}, volume = {50}, number = {1--3}, pages = {129--160}, month = {March}, } @Article{Remy:Vouillon:98, author = "Didier R{\'e}my and J{\'e}r{\^o}me Vouillon", title = "Objective {ML}: An effective object-oriented extension to {ML}", journal = "Theory And Practice of Object Systems", year = 1998, volume = "4", number = "1", pages = "27--50", } @InProceedings{Reus:02, author = {Bernhard Reus}, title = {Class-based versus Object-based: A Denotational Comparison}, booktitle = {Proceedings of 9th International Conference on Algebraic Methodology And Software Technology}, series = "Lecture Notes in Computer Science", publisher = "Springer", editor = {H{\'}el{\`}ene Kirchner and Christophe Ringeissen}, volume = {2422}, pages = {473--488}, year = {2002}, } @INPROCEEDINGS{Reus:03, author = {B.~Reus}, title = {Modular Semantics and Logics of Classes}, booktitle = "Computer Science Logic", pages = "456--469", editor = "Matthias Baatz and Johann A.~Makowsky", publisher = "Springer", Series = "Lecture Notes in Computer Science", volume = "2803", year = "2003" } @Unpublished{Reus:99, author = {Bernhard Reus}, title = {Realizability Models for Type Theories}, note = {Draft of a Tutorial for the {R}ealizability {W}orkshop'99 in {T}rento}, month = nov, year = {2000}, } @TechReport{Reus:Schwinghammer:04, author = {Bernhard Reus and Jan Schwinghammer}, title = {Denotational Semantics for {Abadi} and {Leino}'s Logic of Objects}, institution = {Informatics, University of Sussex}, year = {2004}, number = {2004:03}, } @InProceedings{Reus:Schwinghammer:05, author = {Bernhard Reus and Jan Schwinghammer}, title = {Denotational Semantics for {Abadi} and {Leino}'s Logic of Objects}, booktitle = {Proceedings of the European Symposium on Programming}, year = {2005}, pages = {264--279}, editor = {Mooly Sagiv}, series = {Lecture Notes in Computer Science}, volume = {3444}, publisher = {Springer}, } @InProceedings{Reus:Streicher:02, author = {Bernhard Reus and Thomas Streicher}, title = {Semantics and Logic of Object Calculi}, booktitle = {Proceedings of 17th Annual IEEE Symposium Logic in Computer Science}, publisher = {IEEE Computer Society Press}, year = {2002}, pages = {113--124}, } @Article{Reus:Streicher:04, author = {Bernhard Reus and Thomas Streicher}, title = {Semantics and Logic of Object Calculi}, journal = {Theoretical Computer Science}, year = {2004}, volume = {316}, publisher = "Elsevier", pages = {191--213}, } @INPROCEEDINGS{Reus:Wirsing:Hennicker:01, Author = "B.~Reus and M.~Wirsing and R.~Hennicker", Title = "{A Hoare-Calculus for Verifying Java Realizations of OCL-Constrained Design Models}", Booktitle = "FASE 2001", Year = 2001, Editor = "Heinrich Hussmann", Publisher = "Springer", Volume = 2029, Pages = "300--317", Series = "Lecture Notes in Computer Science", } @incollection{Reynolds:02a, author = "Reynolds, John C.", title = "What do Types Mean? --- {From} Intrinsic to Extrinsic Semantics", booktitle = "Essays on Programming Methodology", editor = "Annabelle McIver and Carroll Morgan", publisher = "Springer", year = "2002", } @InProceedings{Reynolds:02, author = "John C. Reynolds", title = "Separation Logic: {A} Logic for Shared Mutable Data Structures", pages = "55--74", booktitle = "LICS'02", year = "2002" } @InProceedings{hobor+:esop08, author = {Aquinas Hobor and Andrew Appel and Francesco {Zappa Nardelli}}, title = {Oracle Semantics for Concurrent Separation Logic}, booktitle = {ESOP}, year = {2008}, pages = {353--367}, } @InProceedings{stovring+:popl07, author = {Kristian St\o{}vring and Soren Lassen}, title = {A Complete, Co-Inductive Syntactic Theory of Sequential Control and State}, booktitle = {POPL}, year = {2007}, } @InProceedings{lassen+:lics08, author = {Soren B. Lassen and Paul Blain Levy}, title = {Typed Normal Form Bisimulation for Parametric Polymorphism}, booktitle = {LICS}, year = {2008}, } @inproceedings{meyer-sieber-1988, author = "Albert R. Meyer and Kurt Sieber", title = "Towards fully abstract semantics for local variables", booktitle = {POPL}, year = 1988, } @InProceedings{pottier:lics08, author = {Fran\c{c}ois Pottier}, title = {Hiding local state in direct style: a higher-order anti-frame rule}, booktitle = {LICS}, year = {2008}, } @InProceedings{hobor+:popl10, author = {Aquinas Hobor and Robert Dockins and Andrew Appel}, title = {A Theory of Indirection via Approximation}, booktitle = {POPL}, year = {2010}, } @InProceedings{Dockins+:aplas09, author={Robert Dockins and Aquinas Hobor and Andrew W. Appel}, title={A Fresh Look at Separation Algebras and Share Accounting}, booktitle={APLAS}, year={2009}, pages={161--177}, } @InProceedings{Balabonski+:flops14, author={Thibaut Balabonski and Fran\c{c}ois Pottier and Jonathan Protzenko}, title={Type Soundness and Race Freedom for {M}ezzo}, booktitle={FLOPS}, year={2014}, } @Article{Pottier:jfp13, author={Fran\c{c}ois Pottier}, title={Syntactic soundness proof of a type-and-capability system with hidden state}, journal={JFP}, volume={23}, number={1}, pages={38--144}, year={2013}, } @Unpublished{pottier:generalized, author = {Fran\c{c}ois Pottier}, title = {Generalizing the higher-order frame and anti-frame rules}, note = {Unpublished}, year = {2009}, mon = jul, } @inproceedings{pilkiewicz+:monotonic, author = {Alexandre Pilkiewicz and Fran\c{c}ois Pottier}, title = {The Essence of Monotonic State}, booktitle = {TLDI}, year = 2011, } @InProceedings{schwinghammer+:antiframe, author = {Jan Schwinghammer and Hongseok Yang and Lars Birkedal and Fran\c{c}ois Pottier and Bernhard Reus}, title = {A Semantic Foundation for Hidden State}, booktitle = {FOSSACS}, year = 2010, } @InProceedings{chargueraud+:icfp08, author = {Arthur Chargu\'eraud and Fran\c{c}ois Pottier}, title = {Functional translation of a calculus of capabilities}, booktitle = {ICFP}, year = {2008}, } @InProceedings{benton+:tldi09, author = {Nick Benton and Nicolas Tabareau}, title = {Compiling functional types to relational specifications for low level imperative code}, booktitle = {TLDI}, year = {2009}, } @InProceedings{benton+:icfp09, author = {Nick Benton and Chung-Kil Hur}, title = {Biorthogonality, Step-Indexing and Compiler Correctness}, booktitle = {ICFP}, year = 2009} @InProceedings{benton-tabareau-tldi2009, author = {Nick Benton and Nicolas Tabareau}, title = {Compiling Functional Types to Relational Specifications for Low Level Imperative Code}, booktitle = {TLDI}, year = {2009}, } @article{DBLP:journals/iandc/AbramskyJM00, author = {Samson Abramsky and Radha Jagadeesan and Pasquale Malacaria}, title = {Full Abstraction for PCF}, journal = {Inf. Comput.}, volume = {163}, number = {2}, year = {2000}, pages = {409-470}, bibsource = {DBLP, http://dblp.uni-trier.de} } @article{DBLP:journals/iandc/HylandO00, author = {J. M. E. Hyland and C.-H. Luke Ong}, title = {On Full Abstraction for PCF: I, II, and III}, journal = {Inf. Comput.}, volume = {163}, number = {2}, year = {2000}, pages = {285-408}, bibsource = {DBLP, http://dblp.uni-trier.de} } @Unpublished{koutavas-lassen, author = {V. Koutavas and S. Lassen}, title = {Fun with Fully Abstract Operational Game Semantics for General References}, note = {Unpublished}, month = feb, year = 2008 } @InProceedings{murawski+:lics11, author = {Andrzej S. Murawski and Nikos Tzevelekos}, title = {Game semantics for good general references}, booktitle = {LICS}, year = {2011}, } @inproceedings{laird:icalp07, author = {James Laird}, title = {A Fully Abstract Trace Semantics for General References}, booktitle = {ICALP}, year = {2007} } @inproceedings{DBLP:conf/fossacs/Laird04, author = {James Laird}, title = {A Game Semantics of Local Names and Good Variables}, booktitle = {Foundations of Software Science and Computation Structures, 7th International Conference, FOSSACS 2004, Held as Part of the Joint European Conferences on Theory and Practice of Software, ETAPS 2004, Barcelona, Spain, March 29 - April 2, 2004, Proceedings}, year = {2004}, publisher = {Springer}, series = {Lecture Notes in Computer Science}, volume = {2987}, pages = {289-303}, ee = {http://springerlink.metapress.com/openurl.asp?genre=article{\&}issn=0302-9743{\&}volume=2987{\&}spage=289}, bibsource = {DBLP, http://dblp.uni-trier.de} } @inproceedings{lassen+:csl07, author = {Soren B. Lassen and Paul Blain Levy}, title = {Typed Normal Form Bisimulation}, booktitle = {CSL}, year = {2007} } @inproceedings{DBLP:conf/fossacs/MurawskiT09, author = {Andrzej S. Murawski and Nikos Tzevelekos}, title = {Full Abstraction for Reduced ML}, booktitle = {FOSSACS}, year = {2009} } @article{DBLP:journals/tcs/MurawskiW08, author = {Andrzej S. Murawski and Igor Walukiewicz}, title = {Third-order {Idealized Algol} with iteration is decidable}, journal = {TCS}, volume = {390}, number = {2--3}, year = {2008}, pages = {214--229} } @inproceedings{DBLP:conf/icalp/GhicaM00, author = {Dan R. Ghica and Guy McCusker}, title = {Reasoning about {Idealized Algol} Using Regular Languages}, booktitle = {ICALP}, year = {2000} } @inproceedings{DBLP:conf/galop/Murawski05, author = {Andrzej S. Murawski}, title = {Functions with local state: from regularity to undecidability}, booktitle = {GALOP}, year = {2005} } @inproceedings{DBLP:conf/icalp/MurawskiOW05, author = {Andrzej S. Murawski and C.-H. Luke Ong and Igor Walukiewicz}, title = {{Idealized Algol} with Ground Recursion, and DPDA Equivalence}, booktitle = {ICALP 2005}, year = 2005 } @article{murawski-rml-badvars, author = {Andrzej S. Murawski}, title = {Functions with local state: regularity and undecidability}, journal = {TCS}, volume = {338}, number = {1--3}, year = {2005}, pages = {315--349} } @inproceedings{DBLP:conf/lics/McCusker96, author = {Guy McCusker}, title = {Games and Full Abstraction for FPC}, booktitle = {LICS}, year = {1996}, pages = {174-183}, bibsource = {DBLP, http://dblp.uni-trier.de} } @inproceedings{DBLP:conf/fossacs/AbramskyJ03, author = {Samson Abramsky and Radha Jagadeesan}, title = {A Game Semantics for Generic Polymorphism}, booktitle = {Foundations of Software Science and Computational Structures, 6th International Conference, FOSSACS 2003 Held as Part of the Joint European Conference on Theory and Practice of Software, ETAPS 2003, Warsaw, Poland, April 7-11, 2003, Proceedings}, publisher = {Springer}, series = {Lecture Notes in Computer Science}, volume = {2620}, year = {2003}, pages = {1-22}, ee = {http://link.springer.de/link/service/series/0558/bibs/2620/26200001.htm}, bibsource = {DBLP, http://dblp.uni-trier.de} } @inproceedings{DBLP:conf/lics/LongoMS93, author = {Giuseppe Longo and Kathleen Milsted and Sergei Soloviev}, title = {The Genericity Theorem and the Notion of Parametricity in the Polymorphic lambda-calculus (Extended Abstract)}, booktitle = {LICS}, year = {1993} } @inproceedings{DBLP:conf/lics/AbramskyHM98, author = {Samson Abramsky and Kohei Honda and Guy McCusker}, title = {A Fully Abstract Game Semantics for General References}, booktitle = {LICS}, year = {1998}, } @inproceedings{abramsky-mccusker-lecturenotes, author = {Samson Abramsky and Guy McCusker}, title = {Game Semantics}, booktitle = {Proceedings of the 1997 Marktoberdorf Summer School}, year = {1998} } @inproceedings{DBLP:conf/lics/Hughes97, author = {Dominic J. D. Hughes}, title = {Games and Definability for System F}, booktitle = {LICS}, year = {1997} } @Unpublished{laird:icalpsubmission, author = {James Laird}, title = {Game Semantics for Call-by-Value Polymorphism}, note = {Manuscript}, month = {March}, year = 2010 } @article{DBLP:journals/entcs/AbramskyM96, author = {Samson Abramsky and Guy McCusker}, title = {Linearity, Sharing and State: a fully abstract game semantics for {Idealized Algol} with active expressions}, journal = {Electr. Notes Theor. Comput. Sci.}, volume = {3}, year = {1996} } @InProceedings{ohearn-reddy-95, author = {Peter O'Hearn and Uday Reddy}, title = {Objects, Interference, and the {Y}oneda Embedding}, booktitle = {MFPS}, year = 1995} @InProceedings{pitts:96, author = {Andrew M. Pitts}, title = {Reasoning about Local Variables with Operationally-Based Logical Relations}, booktitle = {LICS}, year = 1996} @InProceedings{sumii:csl09, author = {Eijiro Sumii}, title = {A Complete Characterization of Observational Equivalence in Polymorphic $\lambda$-Calculus with General References}, booktitle = {CSL}, year = 2009} @inproceedings{sangiorgi+:lics07, title = {Environmental Bisimulations for Higher-Order Languages}, author = {Davide Sangiorgi and Naoki Kobayashi and Eijiro Sumii}, booktitle = {LICS}, year = 2007, } @inproceedings{bohr-birkedal-2006, author = "Nina Bohr and Lars Birkedal", title = {Relational reasoning for recursive types and references}, booktitle = {APLAS}, year = 2006, } @PhdThesis{bohr:thesis, author = {Nina Bohr}, title = {Advances in Reasoning Principles for Contextual Equivalence and Termination}, school = {IT University of Copenhagen}, year = {2007}, } @article{sumii-pierce-jacm, author = {Eijiro Sumii and Benjamin Pierce}, title = {A Bisimulation for Type Abstraction and Recursion}, journal = {Journal of the ACM}, volume = 54, number = 5, year = 2007, pages = {1--43}, } @inproceedings{koutavas-wand-2006, author = {Vasileios Koutavas and Mitchell Wand}, title = {Small Bisimulations for Reasoning About Higher-Order Imperative Programs}, booktitle = {POPL}, year = {2006}, } @PhDthesis{ahmed:thesis, title = {Semantics of Types for Mutable State}, author = "Amal Ahmed", school = "Princeton University", year = 2004 } @Article{johann+:impact, author = {Patricia Johann and Janis Voigtl\"ander}, title = {The Impact of \emph{seq} on Free Theorems-Based Program Transformations}, journal = {Fundamenta Informaticae}, year = {2006}, volume = {69}, number = {1--2}, pages = {63--102}, } @InProceedings{johann+:lics10, author = {Patricia Johann and Alex Simpson and Janis Voigtl\"ander}, title = {A Generic Operational Metatheory for Algebraic Effects}, booktitle = {LICS}, year = {2010}, } @InProceedings{laird:lics97, author = {James Laird}, title = {Full Abstraction for Functional Languages with Control}, booktitle = {LICS}, year = {1997}, } @Article{krivine:realize, author = {Jean-Louis Krivine}, title = {Classical logic, storage operators and second-order lambda-calculus}, journal = {Annals of Pure and Applied Logic}, year = {1994}, volume = {68}, pages = {53--78}, } @InProceedings{friedman-haynes, author = {Daniel Friedman and Christopher Haynes}, title = {Constraining control}, booktitle = {POPL}, year = {1985}, } @InProceedings{dreyer+:popl10, author = {Derek Dreyer and Georg Neis and Andreas Rossberg and Lars Birkedal}, title = {A Relational Modal Logic for Higher-Order Stateful {ADTs}}, booktitle = {POPL}, year = {2010}, } @Article{mason-talcott, author = {Ian Mason and Carolyn Talcott}, title = {Equivalence in functional languages with effects}, journal = {JFP}, year = {1991}, volume = {1}, number = {3}, pages = {287--327}, } @InProceedings{thielecke:esop00, author = {Hayo Thielecke}, title = {On Exceptions versus Continuations in the Presence of State}, booktitle = {ESOP}, year = {2000}, } @Article{johann:shortcut, author = {Patricia Johann}, title = {Short Cut Fusion is Correct}, journal = {JFP}, year = {2003}, volume = {13}, number = {4}, pages = {797--814}, } @InProceedings{neis+:icfp09, author = {Georg Neis and Derek Dreyer and Andreas Rossberg}, title = {Non-Parametric Parametricity}, booktitle = {ICFP}, year = {2009}, } @Article{neis+:jfp11, author = {Georg Neis and Derek Dreyer and Andreas Rossberg}, title = {Non-Parametric Parametricity}, journal = {JFP}, year = {2011}, volume = {21}, number = {4\&5}, pages = {497--562}, } @Article{dreyer+:lmcs11, author = {Derek Dreyer and Amal Ahmed and Lars Birkedal}, title = {Logical Step-Indexed Logical Relations}, journal = {LMCS}, year = {2011}, volume = {7}, number = {2:16}, pages = {1--37}, month = jun, } @InProceedings{lassen:lics05, author = {Soren Lassen}, title = {Eager Normal Form Bisimulation}, booktitle = {LICS}, year = {2005}, } @inproceedings{reynolds-1983, author = "John C. Reynolds", title = "Types, abstraction and parametric polymorphism", booktitle = "Information Processing", year = 1983, } @Article{pierce-sangiorgi, author = {Benjamin C. Pierce and Davide Sangiorgi}, title = {Behavioral Equivalence in the Polymorphic Pi-Calculus}, journal = {Journal of the ACM}, year = {2000}, volume = {47}, number = {3}, pages = {531--586}, } @InProceedings{gotsman+:aplas07, author = {Alexey Gotsman and Josh Berdine and Byron Cook and Noam Rinetzky and Mooly Sagiv}, title = {Local Reasoning About Storable Locks and Threads}, booktitle = {APLAS}, year = {2007}, } @InProceedings{buisse+:mfps11, author = {Alexandre Buisse and Lars Birkedal and Kristian St\o{}vring}, title = {A Step-Indexed {Kripke} Model of Separation Logic for Storable Locks}, booktitle = {MFPS}, year = {2011}, } @Article{sangiorgi:lazy-lambda, author = {Davide Sangiorgi}, title = {The Lazy Lambda Calculus in a Concurrency Scenario}, journal = {Information and Computation}, year = {1994}, volume = {111}, number = {1}, pages = {120--153}, } @inproceedings{wadler:free-theorems, author = "Philip Wadler", title = "Theorems for free!", booktitle = {FPCA}, year = 1989, } @InProceedings{birkedal+:lics11, author = {Lars Birkedal and Rasmus Ejlers M\o{}gelberg and Jan Schwinghammer and Kristian St\o{}vring}, title = {First steps in synthetic guarded domain theory: step-indexing in the topos of trees}, booktitle = {LICS}, year = {2011}, } @InProceedings{ahmed+:icfp11, author = {Amal Ahmed and Matthias Blume}, title = {An Equivalence-Preserving {CPS} Translation via Multi-Language Semantics}, booktitle = {ICFP}, year = 2011, } @Article{uustalu+:njc99, author = {Tarmo Uustalu and Varmo Vene}, title = {Mendler-style Inductive Types, Categorically}, journal = {Nordic Journal of Computing}, year = {1999}, volume = {6}, number = {3}, pages = {343--361}, } @Article{mendler:pal91, author = {Nax P. Mendler}, title = {Inductive Types and Type Constraints in the Second-Order Lambda-Calculus}, journal = {Annals of Pure and Applied Logic}, year = {1991}, volume = {51}, number = {1--2}, pages = {159--172}, } @InProceedings{koutavas+:mfps11, author = {Vasileios Koutavas and Paul Blain Levy and Eijiro Sumii}, title = {From Applicative to Environmental Bisimulation}, booktitle = {MFPS}, year = 2011, } @InCollection{abramsky:applicative, author = {Samson Abramsky}, title = {The Lazy Lambda Calculus}, booktitle = {Research Topics in Functional Programming}, pages = {65--117}, editor = {D. A. Turner}, year = 1990, } @InProceedings{vafeiadis:mfps11, author = {Viktor Vafeiadis}, title = {Concurrent separation logic and operational semantics}, booktitle = {MFPS}, year = 2011, } @InProceedings{hur+:popl12, author = {Chung-Kil Hur and Derek Dreyer and Georg Neis and Viktor Vafeiadis}, title = {The Marriage of Bisimulations and {Kripke} Logical Relations}, booktitle = {POPL}, year = {2012}, } @InProceedings{le+:pldi14, author = {Vu Le and Mehrdad Afshari and Zhengdong Su}, title = {Compiler Validation via Equivalence Modulo Inputs}, booktitle = {PLDI}, year = {2014}, } @Article{leroy:compcert, author = {Xavier Leroy}, title = {A formally verified compiler back-end}, journal = {Journal of Automated Reasoning}, year = {2009}, volume = {43}, number = {4}, pages = {363--446}, } @InProceedings{perconti+:esop14, author = {James T. Perconti and Amal Ahmed}, title = {Verifying an Open Compiler Using Multi-Language Semantics}, booktitle = {ESOP}, year = {2014}, } @InProceedings{matthews+:popl07, author = {Jacob Matthews and Robert Bruce Findler}, title = {Operational Semantics for Multi-Language Programs}, booktitle = {POPL}, year = {2007}, } @InProceedings{beringer+:esop14, author = {Lennart Beringer and Gordon Stewart and Robert Dockins and Andrew W. Appel}, title = {Verified Compilation for Shared-Memory {C}}, booktitle = {ESOP}, year = {2014}, } @inproceedings{caresl, title={Unifying refinement and {Hoare}-style reasoning in a logic for higher-order concurrency}, author={Aaron Turon and Derek Dreyer and Lars Birkedal}, booktitle={ICFP}, year={2013}, pages = {377--390}, } @InProceedings{fcsl, author = {Aleksandar Nanevski and Ruy Ley-Wild and Ilya Sergey and Germ\'an Andr\'es Delbianco}, title = {Communicating State Transition Systems for Fine-Grained Concurrent Resources}, booktitle = {ESOP}, year = {2014}, pages = {290--310}, } @InProceedings{tada, author = {Pedro {da Rocha Pinto} and Thomas Dinsdale-Young and Philippa Gardner}, title = {{TaDA}: A Logic for Time and Data Abstraction}, booktitle = {ECOOP}, year = {2014}, pages = {207--231}, } @InProceedings{icap, author = {Kasper Svendsen and Lars Birkedal}, title = {Impredicative Concurrent Abstract Predicates}, booktitle = {ESOP}, year = {2014}, pages = {149--168}, } @InProceedings{krishnaswami+:icfp12, author = {Neelakantan R. Krishnaswami and Aaron Turon and Derek Dreyer and Deepak Garg}, title = {Superficially substructural types}, booktitle = {ICFP}, year = {2012}, } @inproceedings{cap, title={Concurrent abstract predicates}, author={Dinsdale-Young, T. and Dodds, M. and Gardner, P. and Parkinson, M. and Vafeiadis, V.}, booktitle={ECOOP}, year={2010}, pages = {504--528}, } @inproceedings{scsl, author = {Ley-Wild, Ruy and Nanevski, Aleksandar}, booktitle = {POPL}, title = {Subjective Auxiliary State for Coarse-Grained Concurrency}, year = {2013} } @InProceedings{views, author = {Thomas Dinsdale-Young and Lars Birkedal and Philippa Gardner and Matthew J. Parkinson and Hongseok Yang}, title = {Views: Compositional reasoning for concurrent programs}, booktitle = {POPL}, year = {2013}, } @article{rg, author = {Jones, C. B.}, title = {Tentative steps toward a development method for interfering programs}, journal = {TOPLAS}, volume = {5}, number = {4}, year = {1983}, pages = {596--619}, publisher = {ACM}, } @inproceedings{lrg, author = {Feng, Xinyu}, title = {Local rely-guarantee reasoning}, booktitle = {POPL}, year = {2009}, pages = {315--327}, } @inproceedings{rgsep, title={A marriage of rely/guarantee and separation logic}, author={Vafeiadis, V. and Parkinson, M.}, booktitle={CONCUR}, year={2007}, pages = {256--271}, } @InProceedings{Parkinson+:popl07, author={Matthew J. Parkinson and Richard Bornat and Peter W. O'Hearn}, title={Modular verification of a non-blocking stack}, booktitle={POPL}, year={2007}, } @article{ohearn:csl, title={Resources, concurrency, and local reasoning}, author={O'Hearn, P.W.}, journal={TCS}, volume={375}, number={1}, pages={271--307}, year={2007}, } @InProceedings{Elmas+:tacas10, author={Tayfun Elmas and Shaz Qadeer and Ali Sezgin and Omer Subasi and Serdar Tasiran}, title={Simplifying Linearizability Proofs with Reduction and Abstraction}, booktitle={TACAS}, year={2010}, } @InProceedings{Elmas+:popl09, author={Tayfun Elmas and Shaz Qadeer and Serdar Tasiran}, title={A calculus of atomic actions}, booktitle={POPL}, year={2009}, } @article{linearizability, author = {Herlihy, Maurice P. and Wing, Jeannette M.}, title = {Linearizability: a correctness condition for concurrent objects}, journal = {TOPLAS}, volume = {12}, number = {3}, year = {1990}, pages = {463--492}, publisher = {ACM}, } @inproceedings{blaming, title = {Blaming the client: On data refinement in the presence of pointers}, author = {Filipovi\'{c}, Ivana and O’Hearn, Peter and Torp-Smith, Noah and Yang, Hongseok}, year = 2009, booktitle = {FACS}, } @InProceedings{jacobs-piessens, author = {Bart Jacobs and Frank Piessens}, title = {Expressive modular fine-grained concurrency specification}, booktitle = {POPL}, year = 2011, } @Misc{Jacobs:personalcommunication2014, author = {Bart Jacobs}, title = {Personal communication}, year = {2014}, } @InProceedings{turon+:popl13, author = {Aaron Turon and Jacob Thamsborg and Amal Ahmed and Lars Birkedal and Derek Dreyer}, title = {Logical relations for fine-grained concurrency}, booktitle = {POPL}, year = {2013}, } @InProceedings{elimination-stack, author = {D. Hendler and N. Shavit and L. Yerushalmi}, title = {A Scalable Lock-Free Stack Algorithm}, booktitle = {SPAA}, year = 2004 } @Article{lamport:sc, author={Leslie Lamport}, title={How to Make a Multiprocessor Computer That Correctly Executes Multiprocess Programs}, journal={IEEE Trans.\ Comput.}, year={1979}, volume={28}, number={9}, pages={690--691}, } @InProceedings{sagl, author = {Xinyu Feng and Rodrigo Ferreira and Zhong Shao}, title = {On the relationship between concurrent separation logic and assume-guarantee reasoning}, booktitle = {ESOP}, year = {2007}, pages = {173--188}, } @Article{owicki-gries:ghost-state, author = {Susan Owicki and David Gries}, title = {Verifying Properties of Parallel Programs: An Axiomatic Approach}, journal = {CACM}, year = {1976}, volume = {19}, number = {5}, pages = {279--285}, } @InProceedings{cohen+:imr, author = {Cohen, Ernie and Alkassar, Eyad and Boyarinov, Vladimir and Dahlweid, Markus and Degenbaev, Ulan and Hillebrand, Mark and Langenstein, Bruno and Leinenbach, Dirk and Moskal, Micha\l and Obua, Steven and Paul, Wolfgang and Pentchev, Hristo and Petrova, Elena and Santen, Thomas and Schirmer, Norbert and Schmaltz, Sabine and Schulte, Wolfram and Shadrin, Andrey and Tobies, Stephan and Tsyban, Alexandra and Tverdyshev, Sergey}, title = {Invariants, Modularity, and Rights}, booktitle = {PSI}, year = {2009}, pages = {43--55}, volume = {5947}, series = {LNCS}, } @Article{ashcroft:invariants, author = {Edward A. Ashcroft}, title = {Proving assertions about parallel programs}, journal = {J. Comput. Syst. Sci.}, year = {1975}, volume = {10}, number = {1}, pages = {110--135}, } @PhdThesis{vafeiadis-thesis, author = {Viktor Vafeiadis}, title = {Modular fine-grained concurrency verification}, school = {University of Cambridge}, year = {2007}, } @article{abadi+:speculation, author = {Mart{\'{\i}}n Abadi and Leslie Lamport}, title = {The Existence of Refinement Mappings}, journal = {TCS}, year = {1991}, volume = {82}, number = {2}, pages = {253--284}, url = {http://dx.doi.org/10.1016/0304-3975(91)90224-P}, doi = {10.1016/0304-3975(91)90224-P}, timestamp = {Wed, 29 Oct 2014 20:04:49 +0100}, biburl = {http://dblp.uni-trier.de/rec/bib/journals/tcs/AbadiL91}, bibsource = {dblp computer science bibliography, http://dblp.org} } @inproceedings{hocap, author = {Kasper Svendsen and Lars Birkedal and Matthew J. Parkinson}, title = {Modular Reasoning about Separation of Concurrent Data Structures}, booktitle = {{ESOP}}, pages = {169--188}, year = {2013}, timestamp = {Mon, 18 Feb 2013 15:03:29 +0100}, biburl = {http://dblp.uni-trier.de/rec/bib/conf/esop/SvendsenBP13}, bibsource = {dblp computer science bibliography, http://dblp.org} } @report{catlogic, author = {Lars Birkedal and Ale\v{s} Bizjak}, title = {A Taste of Categorical Logic --- Tutorial Notes}, month = oct, year = {2014}, note = {Available at \url{http://users-cs.au.dk/birke/modures/tutorial/categorical-logic-tutorial-notes.pdf}} } @article{dodds:higher-order-sync, author = {Mike Dodds and Suresh Jagannathan and Matthew J. Parkinson and Kasper Svendsen and Lars Birkedal}, title = {Verifying Custom Synchronization Constructs Using Higher-Order Separation Logic}, journal = {TOPLAS}, volume = {38}, number = {2}, pages = {4}, year = {2016}, url = {http://doi.acm.org/10.1145/2818638}, doi = {10.1145/2818638}, timestamp = {Fri, 29 Jan 2016 12:43:32 +0100}, biburl = {http://dblp.uni-trier.de/rec/bib/journals/toplas/DoddsJPSB16}, bibsource = {dblp computer science bibliography, http://dblp.org} } @inproceedings{iris, author = {Ralf Jung and David Swasey and Filip Sieczkowski and Kasper Svendsen and Aaron Turon and Lars Birkedal and Derek Dreyer}, title = {Iris: Monoids and Invariants as an Orthogonal Basis for Concurrent Reasoning}, booktitle = {POPL}, pages = {637--650}, year = {2015}, } @phdthesis{krebbers:phd, author = {Robbert Krebbers}, title = {The C standard formalized in Coq}, year = {2015}, school = {Radboud University}, } @inproceedings{garillot:gonthier:mahboubi:rideau:09, author = {Fran{\c{c}}ois Garillot and Georges Gonthier and Assia Mahboubi and Laurence Rideau}, title = {Packaging Mathematical Structures}, booktitle = {TPHOLs}, pages = {327--342}, series = {LNCS}, volume = {5674}, year = {2009}, } @article{spitters:weegen:11, author = {Bas Spitters and Eelis van der Weegen}, title = {Type classes for mathematics in type theory}, journal = {MSCS}, volume = {21}, number = {4}, pages = {795--825}, year = {2011}, } @article{sozeau:09, author = {Matthieu Sozeau}, title = {A New Look at Generalized Rewriting in Type Theory}, journal = {JFR}, volume = {2}, number = {1}, pages = {41--62}, year = {2009}, } @InProceedings{malecha:esop2016, author = {Gregory Malecha and Jesper Bengtson}, title = {Easy and efficient automation through reflective tactics}, booktitle = {ESOP}, year = 2016, } @inproceedings{gps, author = {Aaron Turon and Viktor Vafeiadis and Derek Dreyer}, title = {{GPS:} navigating weak memory with ghosts, protocols, and separation}, booktitle = {OOPSLA}, pages = {691--707}, year = {2014}, url = {http://doi.acm.org/10.1145/2660193.2660243}, doi = {10.1145/2660193.2660243}, timestamp = {Thu, 16 Oct 2014 09:16:18 +0200}, biburl = {http://dblp.uni-trier.de/rec/bib/conf/oopsla/TuronVD14}, bibsource = {dblp computer science bibliography, http://dblp.org} } @article{birkedal:metric-space, author = {Lars Birkedal and Kristian St{\o}vring and Jacob Thamsborg}, title = {The category-theoretic solution of recursive metric-space equations}, journal = {TCS}, volume = {411}, number = {47}, pages = {4102--4122}, year = {2010}, url = {http://dx.doi.org/10.1016/j.tcs.2010.07.010}, doi = {10.1016/j.tcs.2010.07.010}, timestamp = {Tue, 07 Dec 2010 16:23:22 +0100}, biburl = {http://dblp.uni-trier.de/rec/bib/journals/tcs/BirkedalST10}, bibsource = {dblp computer science bibliography, http://dblp.org} } @inproceedings{gotsman:storable-locks, author = {Alexey Gotsman and Josh Berdine and Byron Cook and Noam Rinetzky and Mooly Sagiv}, title = {Local Reasoning for Storable Locks and Threads}, booktitle = {APLAS}, pages = {19--37}, year = {2007}, url = {http://dx.doi.org/10.1007/978-3-540-76637-7_3}, doi = {10.1007/978-3-540-76637-7_3}, timestamp = {Thu, 29 Nov 2007 12:28:33 +0100}, biburl = {http://dblp.uni-trier.de/rec/bib/conf/aplas/GotsmanBCRS07}, bibsource = {dblp computer science bibliography, http://dblp.org} } @article{birkedal:storable-locks, author = {Alexandre Buisse and Lars Birkedal and Kristian St{\o}vring}, title = {Step-Indexed {Kripke} Model of Separation Logic for Storable Locks}, journal = {ENTCS}, volume = {276}, pages = {121--143}, year = {2011}, url = {http://dx.doi.org/10.1016/j.entcs.2011.09.018}, doi = {10.1016/j.entcs.2011.09.018}, timestamp = {Mon, 14 Nov 2011 15:35:16 +0100}, biburl = {http://dblp.uni-trier.de/rec/bib/journals/entcs/BuisseBS11}, bibsource = {dblp computer science bibliography, http://dblp.org} } @inproceedings{unification_hints, author = {Andrea Asperti and Wilmer Ricciotti and Claudio Sacerdoti Coen and Enrico Tassi}, title = {Hints in Unification}, booktitle = {TPHOLs}, pages = {84--98}, year = {2009}, series = {LNCS}, volume = {5674}, } @inproceedings{bedrock, author = {Adam Chlipala}, title = {The {Bedrock} structured programming system: combining generative metaprogramming and {Hoare} logic in an extensible program verifier}, booktitle = {ICFP}, pages = {391--402}, year = {2013}, } @inproceedings{modures, author = {Filip Sieczkowski and Ales Bizjak and Lars Birkedal}, title = {{ModuRes}: {A} {Coq} Library for Modular Reasoning About Concurrent Higher-Order Imperative Programming Languages}, booktitle = {ITP}, pages = {375--390}, year = {2015}, series = {LNCS}, volume = {9236}, } @inproceedings{fcsl-coq, author = {Ilya Sergey and Aleksandar Nanevski and Anindya Banerjee}, title = {Mechanized verification of fine-grained concurrent programs}, booktitle = {PLDI}, pages = {77--87}, year = {2015}, url = {http://doi.acm.org/10.1145/2737924.2737964}, doi = {10.1145/2737924.2737964}, timestamp = {Fri, 05 Jun 2015 07:31:54 +0200}, biburl = {http://dblp.uni-trier.de/rec/bib/conf/pldi/SergeyNB15}, bibsource = {dblp computer science bibliography, http://dblp.org} } @book{app:14, editor = {Andrew W. Appel}, title = "{Program Logics for Certified Compilers}", year = {2014}, publisher = {Cambridge University Press} } @inproceedings{charge, author = {Jesper Bengtson and Jonas Braband Jensen and Lars Birkedal}, title = "{Charge! - {A} Framework for Higher-Order Separation Logic in {C}oq}", booktitle = {ITP}, year = {2012}, pages = {315--331}, series = {LNCS}, volume = {7406}, } @inproceedings{jensen:benton:kennedy:13, author = {Jonas Braband Jensen and Nick Benton and Andrew Kennedy}, title = {High-level separation logic for low-level code}, booktitle = {POPL}, pages = {301--314}, year = {2013}, } @inproceedings{tuch:klein:norrish:07, author = {Harvey Tuch and Gerwin Klein and Michael Norrish}, title = {Types, bytes, and separation logic}, booktitle = {POPL}, year = {2007}, pages = {97--108}, } @inproceedings{iris2, author = {Ralf Jung and Robbert Krebbers and Lars Birkedal and Derek Dreyer}, title = {Higher-order ghost state}, booktitle = {ICFP}, pages = {256--269}, year = {2016}, } @Article{iris-ground-up, author={Ralf Jung and Robbert Krebbers and Jacques-Henri Jourdan and Ale\v{s} Bizjak and Lars Birkedal and Derek Dreyer}, title={Iris from the Ground Up}, journal={Submitted to JFP}, year = {2017}, } @article{Loeb, ISSN = {00224812}, URL = {http://www.jstor.org/stable/2266895}, author = {Martin H. Löb}, journal = {The Journal of Symbolic Logic}, number = {2}, pages = {115--118}, publisher = {Association for Symbolic Logic}, title = {Solution of a Problem of Leon Henkin}, volume = {20}, year = {1955} } @article{iris:prophecy, author = {Ralf Jung and Rodolphe Lepigre and Gaurav Parthasarathy and Marianna Rapoport and Amin Timany and Derek Dreyer and Bart Jacobs}, title = {The future is ours: prophecy variables in separation logic}, journal = {{PACMPL}}, volume = {4}, number = {{POPL}}, doi = {10.1145/3371113}, pages = {45:1--45:32}, year = {2020} } iris-iris-4.2.0/tex/constructions.tex000066400000000000000000000412271460620107300176730ustar00rootroot00000000000000\section{OFE and COFE Constructions} \subsection{Trivial Pointwise Lifting} The (C)OFE structure on many types can be easily obtained by pointwise lifting of the structure of the components. This is what we do for option $\maybe\cofe$, product $(M_i)_{i \in I}$ (with $I$ some finite index set), sum $\cofe + \cofe'$ and finite partial functions $K \fpfn \monoid$ (with $K$ infinite countable). \subsection{Next (Type-Level Later)} Given an OFE $\cofe$, we define $\latert\cofe$ as follows (using a datatype-like notation to define the type): \begin{align*} \latert\cofe \eqdef{}& \latertinj(x:\cofe) \\ \latertinj(x) \nequiv{n} \latertinj(y) \eqdef{}& n = 0 \lor x \nequiv{n-1} y \end{align*} Note that in the definition of the carrier $\latert\cofe$, $\latertinj$ is a constructor (like the constructors in Coq), \ie this is short for $\setComp{\latertinj(x)}{x \in \cofe}$. $\latert(-)$ is a locally \emph{contractive} functor from $\OFEs$ to $\OFEs$. \subsection{Uniform Predicates} Given a camera $\monoid$, we define the COFE $\UPred(\monoid)$ of \emph{uniform predicates} over $\monoid$ as follows: \begin{align*} \monoid \monnra \SProp \eqdef{}& \setComp{\pred: \monoid \nfn \SProp} {\All n, \melt, \meltB. \melt \mincl[n] \meltB \Ra \pred(\melt) \nincl{n} \pred(\meltB)} \\ \UPred(\monoid) \eqdef{}& \faktor{\monoid \monnra \SProp}{\equiv} \\ \pred \equiv \predB \eqdef{}& \All m, \melt. m \in \mval(\melt) \Ra (m \in \pred(\melt) \iff m \in \predB(\melt)) \\ \pred \nequiv{n} \predB \eqdef{}& \All m \le n, \melt. m \in \mval(\melt) \Ra (m \in \pred(\melt) \iff m \in \predB(\melt)) \end{align*} You can think of uniform predicates as monotone, step-indexed predicates over a camera that ``ignore'' invalid elements (as defined by the quotient). $\UPred(-)$ is a locally non-expansive functor from $\CMRAs$ to $\COFEs$. It is worth noting that the above quotient admits canonical representatives. More precisely, one can show that every equivalence class contains exactly one element $P_0$ such that: \begin{align*} \All n, \melt. (\mval(\melt) \nincl{n} P_0(\melt)) \Ra n \in P_0(\melt) \tagH{UPred-canonical} \end{align*} Intuitively, this says that $P_0$ trivially holds whenever the resource is invalid. Starting from any element $P$, one can find this canonical representative by choosing $P_0(\melt) := \setComp{n}{n \in \mval(\melt) \Ra n \in P(\melt)}$. Hence, as an alternative definition of $\UPred$, we could use the set of canonical representatives. This alternative definition would save us from using a quotient. However, the definitions of the various connectives would get more complicated, because we have to make sure they all verify \ruleref{UPred-canonical}, which sometimes requires some adjustments. We would moreover need to prove one more property for every logical connective. \clearpage \section{RA and Camera Constructions} \subsection{Product} \label{sec:prodm} Given a family $(M_i)_{i \in I}$ of cameras ($I$ finite), we construct a camera for the product $\prod_{i \in I} M_i$ by lifting everything pointwise. Frame-preserving updates on the $M_i$ lift to the product: \begin{mathpar} \inferH{prod-update} {\melt \mupd_{M_i} \meltsB} {\mapinsert i \melt f \mupd \setComp{ \mapinsert i \meltB f}{\meltB \in \meltsB}} \end{mathpar} \subsection{Sum} \label{sec:summ} The \emph{sum camera} $\monoid_1 \csumm \monoid_2$ for any cameras $\monoid_1$ and $\monoid_2$ is defined as (again, we use a datatype-like notation): \begin{align*} \monoid_1 \csumm \monoid_2 \eqdef{}& \cinl(\melt_1:\monoid_1) \mid \cinr(\melt_2:\monoid_2) \mid \mundef \\ \mval(\mundef) \eqdef{}& \emptyset \\ \mval(\cinl(\melt)) \eqdef{}& \mval_1(\melt) \\ \cinl(\melt_1) \mtimes \cinl(\meltB_1) \eqdef{}& \cinl(\melt_1 \mtimes \meltB_1) \\ % \munit \mtimes \ospending \eqdef{}& \ospending \mtimes \munit \eqdef \ospending \\ % \munit \mtimes \osshot(\melt) \eqdef{}& \osshot(\melt) \mtimes \munit \eqdef \osshot(\melt) \\ \mcore{\cinl(\melt_1)} \eqdef{}& \begin{cases}\mnocore & \text{if $\mcore{\melt_1} = \mnocore$} \\ \cinl({\mcore{\melt_1}}) & \text{otherwise} \end{cases} \end{align*} Above, $\mval_1$ refers to the validity of $\monoid_1$. The validity, composition and core for $\cinr$ are defined symmetrically. The remaining cases of the composition and core are all $\mundef$. Notice that we added the artificial ``invalid'' (or ``undefined'') element $\mundef$ to this camera just in order to make certain compositions of elements (in this case, $\cinl$ and $\cinr$) invalid. The step-indexed equivalence is inductively defined as follows: \begin{mathpar} \infer{x \nequiv{n} y}{\cinl(x) \nequiv{n} \cinl(y)} \infer{x \nequiv{n} y}{\cinr(x) \nequiv{n} \cinr(y)} \axiom{\mundef \nequiv{n} \mundef} \end{mathpar} We obtain the following frame-preserving updates, as well as their symmetric counterparts: \begin{mathpar} \inferH{sum-update} {\melt \mupd_{M_1} \meltsB} {\cinl(\melt) \mupd \setComp{ \cinl(\meltB)}{\meltB \in \meltsB}} \inferH{sum-swap} {\All \melt_\f \in M, n. n \notin \mval(\melt \mtimes \melt_\f) \and \mvalFull(\meltB)} {\cinl(\melt) \mupd \cinr(\meltB)} \end{mathpar} Crucially, the second rule allows us to \emph{swap} the ``side'' of the sum that the camera is on if $\mval$ has \emph{no possible frame}. \subsection{Option} The definition of the camera/RA axioms already lifted the composition operation on $\monoid$ to one on $\maybe\monoid$. We can easily extend this to a full camera by defining a suitable core, namely \begin{align*} \mcore{\mnocore} \eqdef{}& \mnocore & \\ \mcore{\maybe\melt} \eqdef{}& \mcore\melt & \text{If $\maybe\melt \neq \mnocore$} \end{align*} Notice that this core is total, as the result always lies in $\maybe\monoid$ (rather than in $\maybe{\mathord{\maybe\monoid}}$). \subsection{Finite Partial Functions} \label{sec:fpfnm} Given some infinite countable $K$ and some camera $\monoid$, the set of finite partial functions $K \fpfn \monoid$ is equipped with a camera structure by lifting everything pointwise. We obtain the following frame-preserving updates: \begin{mathpar} \inferH{fpfn-alloc-strong} {\text{$G \subseteq K$ infinite} \and \mvalFull(\melt)} {\emptyset \mupd \setComp{\mapsingleton i \melt}{i \in G}} \inferH{fpfn-alloc} {\mvalFull(\melt)} {\emptyset \mupd \setComp{\mapsingleton i \melt}{i \in K}} \inferH{fpfn-update} {\melt \mupd_\monoid \meltsB} {\mapinsert i \melt f] \mupd \setComp{ \mapinsert i \meltB f}{\meltB \in \meltsB}} \end{mathpar} Above, $\mvalFull$ refers to the (full) validity of $\monoid$. $K \fpfn (-)$ is a locally non-expansive functor from $\CMRAs$ to $\CMRAs$. \subsection{Agreement} Given some OFE $\cofe$, we define the camera $\agm(\cofe)$ as follows: \begin{align*} \agm(\cofe) \eqdef{}& \setComp{\melt \in \finpset\cofe}{\melt \neq \emptyset} /\ {\sim} \\[-0.2em] \melt \nequiv{n} \meltB \eqdef{}& (\All x \in \melt. \Exists y \in \meltB. x \nequiv{n} y) \land (\All y \in \meltB. \Exists x \in \melt. x \nequiv{n} y) \\ \textnormal{where }& \melt \sim \meltB \eqdef{} \All n. \melt \nequiv{n} \meltB \\ ~\\ % \All n \in {\melt.V}.\, \melt.x \nequiv{n} \meltB.x \\ \mval(\melt) \eqdef{}& \setComp{n}{ \All x, y \in \melt. x \nequiv{n} y } \\ \mcore\melt \eqdef{}& \melt \\ \melt \mtimes \meltB \eqdef{}& \melt \cup \meltB \end{align*} %Note that the carrier $\agm(\cofe)$ is a \emph{record} consisting of the two fields $c$ and $V$. $\agm(-)$ is a locally non-expansive functor from $\OFEs$ to $\CMRAs$. We define a non-expansive injection $\aginj$ into $\agm(\cofe)$ as follows: \[ \aginj(x) \eqdef \set{x} \] There are no interesting frame-preserving updates for $\agm(\cofe)$, but we can show the following: \begin{mathpar} \axiomH{ag-val}{\mvalFull(\aginj(x))} \axiomH{ag-dup}{\aginj(x) = \aginj(x)\mtimes\aginj(x)} \axiomH{ag-agree}{n \in \mval(\aginj(x) \mtimes \aginj(y)) \Ra x \nequiv{n} y} \end{mathpar} \subsection{Exclusive Camera} Given an OFE $\cofe$, we define a camera $\exm(\cofe)$ such that at most one $x \in \cofe$ can be owned: \begin{align*} \exm(\cofe) \eqdef{}& \exinj(\cofe) \mid \mundef \\ \mval(\melt) \eqdef{}& \setComp{n}{\melt \notnequiv{n} \mundef} \end{align*} All cases of composition go to $\mundef$. \begin{align*} \mcore{\exinj(x)} \eqdef{}& \mnocore & \mcore{\mundef} \eqdef{}& \mundef \end{align*} Remember that $\mnocore$ is the ``dummy'' element in $\maybe\monoid$ indicating (in this case) that $\exinj(x)$ has no core. The step-indexed equivalence is inductively defined as follows: \begin{mathpar} \infer{x \nequiv{n} y}{\exinj(x) \nequiv{n} \exinj(y)} \axiom{\mundef \nequiv{n} \mundef} \end{mathpar} $\exm(-)$ is a locally non-expansive functor from $\OFEs$ to $\CMRAs$. We obtain the following frame-preserving update: \begin{mathpar} \inferH{ex-update}{} {\exinj(x) \mupd \exinj(y)} \end{mathpar} \subsection{Fractions} We define an RA structure on the rational numbers in $(0, 1]$ as follows: \begin{align*} \fracm \eqdef{}& \fracinj(\mathbb{Q} \cap (0, 1]) \mid \mundef \\ \mvalFull(\melt) \eqdef{}& \melt \neq \mundef \\ \fracinj(q_1) \mtimes \fracinj(q_2) \eqdef{}& \fracinj(q_1 + q_2) \quad \text{if $q_1 + q_2 \leq 1$} \\ \mcore{\fracinj(x)} \eqdef{}& \bot \\ \mcore{\mundef} \eqdef{}& \mundef \end{align*} All remaining cases of composition go to $\mundef$. Frequently, we will write just $x$ instead of $\fracinj(x)$. The most important property of this RA is that $1$ has no frame. This is useful in combination with \ruleref{sum-swap}, and also when used with pairs: \begin{mathpar} \inferH{pair-frac-change}{} {(1, a) \mupd (1, b)} \end{mathpar} %TODO: These need syncing with Coq % \subsection{Finite Powerset Monoid} % Given an infinite set $X$, we define a monoid $\textdom{PowFin}$ with carrier $\mathcal{P}^{\textrm{fin}}(X)$ as follows: % \[ % \melt \cdot \meltB \;\eqdef\; \melt \cup \meltB \quad \mbox{if } \melt \cap \meltB = \emptyset % \] % We obtain: % \begin{mathpar} % \inferH{PowFinUpd}{} % {\emptyset \mupd \{ \{x\} \mid x \in X \}} % \end{mathpar} % \begin{proof}[Proof of \ruleref{PowFinUpd}] % Assume some frame $\melt_\f \sep \emptyset$. Since $\melt_\f$ is finite and $X$ is infinite, there exists an $x \notin \melt_\f$. % Pick that for the result. % \end{proof} % The powerset monoids is cancellative. % \begin{proof}[Proof of cancellativity] % Let $\melt_\f \mtimes \melt = \melt_\f \mtimes \meltB \neq \mzero$. % So we have $\melt_\f \sep \melt$ and $\melt_\f \sep \meltB$, and we have to show $\melt = \meltB$. % Assume $x \in \melt$. Hence $x \in \melt_\f \mtimes \melt$ and thus $x \in \melt_\f \mtimes \meltB$. % By disjointness, $x \notin \melt_\f$ and hence $x \in meltB$. % The other direction works the same way. % \end{proof} \subsection{Authoritative} \label{sec:auth-camera} Given a camera $M$, we construct $\authm(M)$ modeling someone owning an \emph{authoritative} element $\melt$ of $M$, and others potentially owning fragments $\meltB \mincl \melt$ of $\melt$. We assume that $M$ has a unit $\munit$, and hence its core is total. (If $M$ is an exclusive monoid, the construction is very similar to a half-ownership monoid with two asymmetric halves.) \begin{align*} \authm(M) \eqdef{}& \maybe{\exm(M)} \times M \\ \mval( (x, \meltB ) ) \eqdef{}& \setComp{ n }{ (x = \mnocore \land n \in \mval(\meltB)) \lor (\Exists \melt. x = \exinj(\melt) \land \meltB \mincl_n \melt \land n \in \mval(\melt)) } \\ (x_1, \meltB_1) \mtimes (x_2, \meltB_2) \eqdef{}& (x_1 \mtimes x_2, \meltB_2 \mtimes \meltB_2) \\ \mcore{(x, \meltB)} \eqdef{}& (\mnocore, \mcore\meltB) \\ (x_1, \meltB_1) \nequiv{n} (x_2, \meltB_2) \eqdef{}& x_1 \nequiv{n} x_2 \land \meltB_1 \nequiv{n} \meltB_2 \end{align*} Note that $(\mnocore, \munit)$ is the unit and asserts no ownership whatsoever, but $(\exinj(\munit), \munit)$ asserts that the authoritative element is $\munit$. Let $\melt, \meltB \in M$. We write $\authfull \melt$ for full ownership $(\exinj(\melt), \munit)$ and $\authfrag \meltB$ for fragmental ownership $(\mnocore, \meltB)$ and $\authfull \melt , \authfrag \meltB$ for combined ownership $(\exinj(\melt), \meltB)$. The frame-preserving update involves the notion of a \emph{local update}: \begin{defn} It is possible to do a \emph{local update} from $\melt_1$ and $\meltB_1$ to $\melt_2$ and $\meltB_2$, written $(\melt_1, \meltB_1) \lupd (\melt_2, \meltB_2)$, if \[ \All n, \maybe{\melt_\f}. n \in \mval(\melt_1) \land \melt_1 \nequiv{n} \meltB_1 \mtimes \maybe{\melt_\f} \Ra n \in \mval(\melt_2) \land \melt_2 \nequiv{n} \meltB_2 \mtimes \maybe{\melt_\f} \] \end{defn} In other words, the idea is that for every possible frame $\maybe{\melt_\f}$ completing $\meltB_1$ to $\melt_1$, the same frame also completes $\meltB_2$ to $\melt_2$. We then obtain \begin{mathpar} \inferH{auth-update} {(\melt_1, \meltB_1) \lupd (\melt_2, \meltB_2)} {\authfull \melt_1 , \authfrag \meltB_1 \mupd \authfull \melt_2 , \authfrag \meltB_2} \end{mathpar} \subsection{STS with Tokens} \label{sec:sts-camera} Given a state-transition system~(STS, \ie a directed graph) $(\STSS, {\stsstep} \subseteq \STSS \times \STSS)$, a set of tokens $\STST$, and a labeling $\STSL: \STSS \ra \wp(\STST)$ of \emph{protocol-owned} tokens for each state, we construct an RA modeling an authoritative current state and permitting transitions given a \emph{bound} on the current state and a set of \emph{locally-owned} tokens. The construction follows the idea of STSs as described in CaReSL \cite{caresl}. We first lift the transition relation to $\STSS \times \wp(\STST)$ (implementing a \emph{law of token conservation}) and define a stepping relation for the \emph{frame} of a given token set: \begin{align*} (s, T) \stsstep (s', T') \eqdef{}& s \stsstep s' \land \STSL(s) \uplus T = \STSL(s') \uplus T' \\ s \stsfstep{T} s' \eqdef{}& \Exists T_1, T_2. T_1 \disj \STSL(s) \cup T \land (s, T_1) \stsstep (s', T_2) \end{align*} We further define \emph{closed} sets of states (given a particular set of tokens) as well as the \emph{closure} of a set: \begin{align*} \STSclsd(S, T) \eqdef{}& \All s \in S. \STSL(s) \disj T \land \left(\All s'. s \stsfstep{T} s' \Ra s' \in S\right) \\ \upclose(S, T) \eqdef{}& \setComp{ s' \in \STSS}{\Exists s \in S. s \stsftrans{T} s' } \end{align*} The STS RA is defined as follows \begin{align*} \monoid \eqdef{}& \STSauth(s:\STSS, T:\wp(\STST) \mid \STSL(s) \disj T) \mid{}\\& \STSfrag(S: \wp(\STSS), T: \wp(\STST) \mid \STSclsd(S, T) \land S \neq \emptyset) \mid \mundef \\ \mvalFull(\melt) \eqdef{}& \melt \neq \mundef \\ \STSfrag(S_1, T_1) \mtimes \STSfrag(S_2, T_2) \eqdef{}& \STSfrag(S_1 \cap S_2, T_1 \cup T_2) \qquad\qquad\qquad \text{if $T_1 \disj T_2$ and $S_1 \cap S_2 \neq \emptyset$} \\ \STSfrag(S, T) \mtimes \STSauth(s, T') \eqdef{}& \STSauth(s, T') \mtimes \STSfrag(S, T) \eqdef \STSauth(s, T \cup T') \qquad \text{if $T \disj T'$ and $s \in S$} \\ \mcore{\STSfrag(S, T)} \eqdef{}& \STSfrag(\upclose(S, \emptyset), \emptyset) \\ \mcore{\STSauth(s, T)} \eqdef{}& \STSfrag(\upclose(\set{s}, \emptyset), \emptyset) \end{align*} The remaining cases are all $\mundef$. We will need the following frame-preserving update: \begin{mathpar} \inferH{sts-step}{(s, T) \ststrans (s', T')} {\STSauth(s, T) \mupd \STSauth(s', T')} \inferH{sts-weaken} {\STSclsd(S_2, T_2) \and S_1 \subseteq S_2 \and T_2 \subseteq T_1} {\STSfrag(S_1, T_1) \mupd \STSfrag(S_2, T_2)} \end{mathpar} \paragraph{The core is not a homomorphism.} The core of the STS construction is only satisfying the RA axioms because we are \emph{not} demanding the core to be a homomorphism---all we demand is for the core to be monotone with respect the \ruleref{ra-incl}. In other words, the following does \emph{not} hold for the STS core as defined above: \[ \mcore\melt \mtimes \mcore\meltB = \mcore{\melt\mtimes\meltB} \] To see why, consider the following STS: \newcommand\st{\textlog{s}} \newcommand\tok{\textlog{t}} \begin{center} \begin{tikzpicture}[every node/.style=sts_state] \node at (0,0) (s1) {$\st_1$}; \node at (3,0) (s2) {$\st_2$}; \node at (9,0) (s3) {$\st_3$}; \node at (6,0) (s4) {$\st_4$\\$[\tok_1, \tok_2]$}; \path[sts_arrows] (s2) edge (s4); \path[sts_arrows] (s3) edge (s4); \end{tikzpicture} \end{center} Now consider the following two elements of the STS RA: \[ \melt \eqdef \STSfrag(\set{\st_1,\st_2}, \set{\tok_1}) \qquad\qquad \meltB \eqdef \STSfrag(\set{\st_1,\st_3}, \set{\tok_2}) \] We have: \begin{mathpar} {\melt\mtimes\meltB = \STSfrag(\set{\st_1}, \set{\tok_1, \tok_2})} {\mcore\melt = \STSfrag(\set{\st_1, \st_2, \st_4}, \emptyset)} {\mcore\meltB = \STSfrag(\set{\st_1, \st_3, \st_4}, \emptyset)} {\mcore\melt \mtimes \mcore\meltB = \STSfrag(\set{\st_1, \st_4}, \emptyset) \neq \mcore{\melt \mtimes \meltB} = \STSfrag(\set{\st_1}, \emptyset)} \end{mathpar} %%% Local Variables: %%% mode: latex %%% TeX-master: "iris" %%% End: iris-iris-4.2.0/tex/derived.tex000066400000000000000000000467421460620107300164070ustar00rootroot00000000000000\section{Derived Constructions} \subsection{Cancellable Invariants} Iris invariants as described in \Sref{sec:invariants} are persistent---once established, they hold forever. However, based on them, it is possible to \emph{encode} a form of invariants that can be ``cancelled'' again. First, we need some ghost state: \begin{align*} \textdom{CInvTok} \eqdef{}& \fracm \end{align*} Now we define: \begin{align*} \CInvTok{\gname}{q} \eqdef{}& \ownGhost\gname{q} \\ \CInv{\gname}{\namesp}{\prop} \eqdef{}& \knowInv\namesp{\prop \lor \ownGhost\gname{1}} \end{align*} It is then straightforward to prove: \begin{mathpar} \inferH{CInv-new}{} {\later\prop \vs[\bot] \Exists \gname. \CInvTok\gname{1} * \always\CInv\gname\namesp\prop} \inferH{CInv-acc}{} {\CInv\gname\namesp\prop \proves \Acc[\namesp][\emptyset]{\CInvTok\gname{q}}{\later\prop}} \inferH{CInv-cancel}{} {\CInv\gname\namesp\prop \proves \CInvTok\gname{1} \vs[\namesp] \later\prop} \end{mathpar} Cancellable invariants are useful, for example, when reasoning about data structures that will be deallocated: Every reference to the data structure comes with a fraction of the token, and when all fractions have been gathered, \ruleref{CInv-cancel} is used to cancel the invariant, after which the data structure can be deallocated. \subsection{Non-atomic (``Thread-Local'') Invariants} Sometimes it is necessary to maintain invariants that we need to open non-atomically. Clearly, for this mechanism to be sound we need something that prevents us from opening the same invariant twice, something like the masks that avoid reentrancy on the ``normal'', atomic invariants. The idea is to use tokens\footnote{Very much like the tokens that are used to encode ``normal'', atomic invariants} that guard access to non-atomic invariants. Having the token $\NaTokE\pid\mask$ indicates that we can open all invariants in $\mask$. The $\pid$ here is the name of the \emph{invariant pool}. This mechanism allows us to have multiple, independent pools of invariants that all have their own namespaces. One way to think about non-atomic invariants is as ``thread-local invariants'', where every pool is a thread. Every thread thus has its own, independent set of invariants. Every thread threads through all the tokens for its own pool, so that each invariant can only be opened in the thread it belongs to. As a consequence, they can be kept open around any sequence of expressions (\ie there is no restriction to atomic expressions) -- after all, there cannot be any races with other threads. Concretely, this is the monoid structure we need: \begin{align*} \textdom{PId} \eqdef{}& \GName \\ \textdom{NaTok} \eqdef{}& \finpset{\InvName} \times \pset{\InvName} \end{align*} For every pool, there is a set of tokens designating which invariants are \emph{enabled} (closed). This corresponds to the mask of ``normal'' invariants. We re-use the structure given by namespaces for non-atomic invariants. Furthermore, there is a \emph{finite} set of invariants that is \emph{disabled} (open). Owning tokens is defined as follows: \begin{align*} \NaTokE\pid\mask \eqdef{}& \ownGhost{\pid}{ (\emptyset, \mask) } \\ \NaTok\pid \eqdef{}& \NaTokE\pid\top \end{align*} Next, we define non-atomic invariants. To simplify this construction,we piggy-back into ``normal'' invariants. \begin{align*} \NaInv\pid\namesp\prop \eqdef{}& \Exists \iname\in\namesp. \knowInv\namesp{\prop * \ownGhost\pid{(\set{\iname},\emptyset)} \lor \NaTokE\pid{\set{\iname}}} \end{align*} We easily obtain: \begin{mathpar} \axiomH{NAInv-new-pool} {\TRUE \vs[\bot] \Exists\pid. \NaTok\pid} \axiomH{NAInv-tok-split} {\NaTokE\pid{\mask_1 \uplus \mask_2} \Lra \NaTokE\pid{\mask_1} * \NaTokE\pid{\mask_2}} \axiomH{NAInv-new-inv} {\later\prop \vs[\namesp] \always\NaInv\pid\namesp\prop} \axiomH{NAInv-acc} {\NaInv\pid\namesp\prop \proves \Acc[\namesp]{\NaTokE\pid\namesp}{\later\prop}} \end{mathpar} from which we can derive \begin{mathpar} \infer {\namesp \subseteq \mask} {\NaInv\pid\namesp\prop \proves \Acc[\namesp]{\NaTokE\pid\mask}{\later\prop * \NaTokE\pid{\mask \setminus \namesp}}} \end{mathpar} \subsection{Boxes} The idea behind the \emph{boxes} is to have a proposition $\prop$ that is actually split into a number of pieces, each of which can be taken out and back in separately. In some sense, this is a replacement for having an ``authoritative PCM of Iris propositions itself''. It is similar to the pattern involving saved propositions that was used for the barrier~\cite{iris2}, but more complicated because there are some operations that we want to perform without a later. Roughly, the idea is that a \emph{box} is a container for a proposition $\prop$. A box consists of a bunch of \emph{slices} which decompose $\prop$ into a separating conjunction of the propositions $\propB_\sname$ governed by the individual slices. Each slice is either \emph{full} (it right now contains $\propB_\sname$), or \emph{empty} (it does not contain anything currently). The proposition governing the box keeps track of the state of all the slices that make up the box. The crux is that opening and closing of a slice can be done even if we only have ownership of the boxes ``later'' ($\later$). The interface for boxes is as follows: The two core propositions are: $\BoxSlice\namesp\prop\sname$, saying that there is a slice in namespace $\namesp$ with name $\sname$ and content $\prop$; and $\ABox\namesp\prop{f}$, saying that $f$ describes the slices of a box in namespace $\namesp$, such that all the slices together contain $\prop$. Here, $f$ is of type $\nat \fpfn \BoxState$ mapping names to states, where $\BoxState \eqdef \set{\BoxFull, \BoxEmp}$. \begin{mathpar} \inferH{Box-create}{} {\TRUE \vs[\namesp] \ABox\namesp\TRUE\emptyset} \inferH{Slice-insert-empty}{} {\lateropt b\ABox\namesp\prop{f} \vs[\namesp] \Exists\sname \notin \dom(f). \always\BoxSlice\namesp\propB\sname * \lateropt b\ABox\namesp{\prop * \propB}{\mapinsert\sname\BoxEmp{f}}} \inferH{Slice-delete-empty} {f(\sname) = \BoxEmp} {\BoxSlice\namesp\propB\sname \proves \lateropt b\ABox\namesp\prop{f} \vs[\namesp] \Exists \prop'. \lateropt b(\later(\prop = \prop' * \propB) * \ABox\namesp{\prop'}{\mapinsert\sname\bot{f}})} \inferH{Slice-fill} {f(\sname) = \BoxEmp} {\BoxSlice\namesp\propB\sname \proves \lateropt b\propB * \later\ABox\namesp\prop{f} \vs[\namesp] \lateropt b\ABox\namesp\prop{\mapinsert\sname\BoxFull{f}}} \inferH{Slice-empty} {f(\sname) = \BoxFull} {\BoxSlice\namesp\propB\sname \proves \lateropt b\ABox\namesp\prop{f} \vs[\namesp] \later\propB * \lateropt b\ABox\namesp\prop{\mapinsert\sname\BoxEmp{f}}} \inferH{Box-fill} {\All\sname\in\dom(f). f(\sname) = \BoxEmp} {\later\prop * \ABox\namesp\prop{f} \vs[\namesp] \ABox\namesp\prop{\mapinsertComp\sname\BoxFull{\sname\in\dom(f)}{f}}} \inferH{Box-empty} {\All\sname\in\dom(f). f(\sname) = \BoxFull} {\ABox\namesp\prop{f} \vs[\namesp] \later\prop * \ABox\namesp\prop{\mapinsertComp\sname\BoxEmp{\sname\in\dom(f)}{f}}} \end{mathpar} Above, $\lateropt b \prop$ is syntactic sugar for $\later\prop$ (if $b$ is $1$) or $\prop$ (if $b$ is $0$). This is essentially an \emph{optional later}, indicating that the lemmas can be applied with \textlog{Box} being owned now or later, and that ownership is returned the same way. \begingroup \paragraph{Model.} \newcommand\BoxM{\textdom{Box}} \newcommand\SliceInv{\textlog{SliceInv}} The above rules are validated by the following model. We need a camera as follows: \begin{align*} \BoxState \eqdef{}& \BoxFull + \BoxEmp \\ \BoxM \eqdef{}& \authm(\maybe{\exm(\BoxState)}) \times \maybe{\agm(\latert \iProp)} \end{align*} Now we can define the propositions: \begin{align*} \SliceInv(\sname, \prop) \eqdef{}& \Exists b. \ownGhost\sname{(\authfull b, \munit)} * ((b = \BoxFull) \Ra \prop) \\ \BoxSlice\namesp\prop\sname \eqdef{}& \ownGhost\sname{(\munit, \prop)} * \knowInv\namesp{\SliceInv(\sname,\prop)} \\ \ABox\namesp\prop{f} \eqdef{}& \Exists \propB : \nat \to \Prop. \later\left( \prop = \Sep_{\sname \in \dom(f)} \propB(\sname) \right ) * {}\\ & \Sep_{\sname \in \dom(f)} \ownGhost\sname{(\authfrag f(\sname), \propB(\sname))} * \knowInv\namesp{\SliceInv(\sname,\propB(\sname))} \end{align*} \endgroup % Model paragraph \paragraph{Derived rules.} Here are some derived rules: \begin{mathpar} \inferH{Slice-insert-full}{} {\later\propB * \lateropt b\ABox\namesp\prop{f} \vs[\namesp] \Exists\sname \notin \dom(f). \always\BoxSlice\namesp\propB\sname * \lateropt b\ABox\namesp{\prop * \propB}{\mapinsert\sname\BoxFull{f}}} \inferH{Slice-delete-full} {f(\sname) = \BoxFull} {\BoxSlice\namesp\propB\sname \proves \lateropt b \ABox\namesp\prop{f} \vs[\namesp] \later\propB * \Exists \prop'. \lateropt b (\later(\prop = \prop' * \propB) * \ABox\namesp{\prop'}{\mapinsert\sname\bot{f}})} \inferH{Slice-split} {f(\sname) = s} {\kern-4ex\BoxSlice\namesp{\propB_1 * \propB_2}\sname \proves \lateropt b \ABox\namesp\prop{f} \vs[\namesp] \Exists \sname_1 \notin \dom(f), \sname_2 \notin \dom(f). \sname_1 \neq \sname_2 \land {}\\\kern5ex \always\BoxSlice\namesp{\propB_1}{\sname_1} * \always\BoxSlice\namesp{\propB_2}{\sname_2} * \lateropt b \ABox\namesp\prop{\mapinsert{\sname_2}{s}{\mapinsert{\sname_1}{s}{\mapinsert\sname\bot{f}}}}} \inferH{Slice-merge} {\sname_1 \neq \sname_2 \and f(\sname_1) = f(\sname_2) = s} {\BoxSlice\namesp{\propB_1}{\sname_1}, \BoxSlice\namesp{\propB_2}{\sname_2} \proves \lateropt b \ABox\namesp\prop{f} \vs[\namesp] \Exists \sname \notin \dom(f) \setminus \set{\sname_1, \sname_2}. {}\\\kern5ex \always\BoxSlice\namesp{\propB_1 * \propB_2}\sname * \lateropt b \ABox\namesp\prop{\mapinsert\sname{s}{\mapinsert{\sname_2}{\bot}{\mapinsert{\sname_1}{\bot}{f}}}}} \end{mathpar} % TODO: These need syncing with Coq % \subsection{STSs with interpretation}\label{sec:stsinterp} % Building on \Sref{sec:stsmon}, after constructing the monoid $\STSMon{\STSS}$ for a particular STS, we can use an invariant to tie an interpretation, $\pred : \STSS \to \Prop$, to the STS's current state, recovering CaReSL-style reasoning~\cite{caresl}. % An STS invariant asserts authoritative ownership of an STS's current state and that state's interpretation: % \begin{align*} % \STSInv(\STSS, \pred, \gname) \eqdef{}& \Exists s \in \STSS. \ownGhost{\gname}{(s, \STSS, \emptyset):\STSMon{\STSS}} * \pred(s) \\ % \STS(\STSS, \pred, \gname, \iname) \eqdef{}& \knowInv{\iname}{\STSInv(\STSS, \pred, \gname)} % \end{align*} % We can specialize \ruleref{NewInv}, \ruleref{InvOpen}, and \ruleref{InvClose} to STS invariants: % \begin{mathpar} % \inferH{NewSts} % {\infinite(\mask)} % {\later\pred(s) \vs[\mask] \Exists \iname \in \mask, \gname. \STS(\STSS, \pred, \gname, \iname) * \ownGhost{\gname}{(s, \STST \setminus \STSL(s)) : \STSMon{\STSS}}} % \and % \axiomH{StsOpen} % { \STS(\STSS, \pred, \gname, \iname) \vdash \ownGhost{\gname}{(s_0, T) : \STSMon{\STSS}} \vsE[\{\iname\}][\emptyset] \Exists s\in \upclose(\{s_0\}, T). \later\pred(s) * \ownGhost{\gname}{(s, \upclose(\{s_0\}, T), T):\STSMon{\STSS}}} % \and % \axiomH{StsClose} % { \STS(\STSS, \pred, \gname, \iname), (s, T) \ststrans (s', T') \proves \later\pred(s') * \ownGhost{\gname}{(s, S, T):\STSMon{\STSS}} \vs[\emptyset][\{\iname\}] \ownGhost{\gname}{(s', T') : \STSMon{\STSS}} } % \end{mathpar} % \begin{proof} % \ruleref{NewSts} uses \ruleref{NewGhost} to allocate $\ownGhost{\gname}{(s, \upclose(s, T), T) : \STSMon{\STSS}}$ where $T \eqdef \STST \setminus \STSL(s)$, and \ruleref{NewInv}. % \ruleref{StsOpen} just uses \ruleref{InvOpen} and \ruleref{InvClose} on $\iname$, and the monoid equality $(s, \upclose(\{s_0\}, T), T) = (s, \STSS, \emptyset) \mtimes (\munit, \upclose(\{s_0\}, T), T)$. % \ruleref{StsClose} applies \ruleref{StsStep} and \ruleref{InvClose}. % \end{proof} % Using these view shifts, we can prove STS variants of the invariant rules \ruleref{Inv} and \ruleref{VSInv}~(compare the former to CaReSL's island update rule~\cite{caresl}): % \begin{mathpar} % \inferH{Sts} % {\All s \in \upclose(\{s_0\}, T). \hoare{\later\pred(s) * P}{\expr}{\Ret \val. \Exists s', T'. (s, T) \ststrans (s', T') * \later\pred(s') * Q}[\mask] % \and \physatomic{\expr}} % { \STS(\STSS, \pred, \gname, \iname) \vdash \hoare{\ownGhost{\gname}{(s_0, T):\STSMon{\STSS}} * P}{\expr}{\Ret \val. \Exists s', T'. \ownGhost{\gname}{(s', T'):\STSMon{\STSS}} * Q}[\mask \uplus \{\iname\}]} % \and % \inferH{VSSts} % {\forall s \in \upclose(\{s_0\}, T).\; \later\pred(s) * P \vs[\mask_1][\mask_2] \exists s', T'.\; (s, T) \ststrans (s', T') * \later\pred(s') * Q} % { \STS(\STSS, \pred, \gname, \iname) \vdash \ownGhost{\gname}{(s_0, T):\STSMon{\STSS}} * P \vs[\mask_1 \uplus \{\iname\}][\mask_2 \uplus \{\iname\}] \Exists s', T'. \ownGhost{\gname}{(s', T'):\STSMon{\STSS}} * Q} % \end{mathpar} % \begin{proof}[Proof of \ruleref{Sts}]\label{pf:sts} % We have to show % \[\hoare{\ownGhost{\gname}{(s_0, T):\STSMon{\STSS}} * P}{\expr}{\Ret \val. \Exists s', T'. \ownGhost{\gname}{(s', T'):\STSMon{\STSS}} * Q}[\mask \uplus \{\iname\}]\] % where $\val$, $s'$, $T'$ are free in $Q$. % First, by \ruleref{ACsq} with \ruleref{StsOpen} and \ruleref{StsClose} (after moving $(s, T) \ststrans (s', T')$ into the view shift using \ruleref{VSBoxOut}), it suffices to show % \[\hoareV{\Exists s\in \upclose(\{s_0\}, T). \later\pred(s) * \ownGhost{\gname}{(s, \upclose(\{s_0\}, T), T)} * P}{\expr}{\Ret \val. \Exists s, T, S, s', T'. (s, T) \ststrans (s', T') * \later\pred(s') * \ownGhost{\gname}{(s, S, T):\STSMon{\STSS}} * Q(\val, s', T')}[\mask]\] % Now, use \ruleref{Exist} to move the $s$ from the precondition into the context and use \ruleref{Csq} to (i)~fix the $s$ and $T$ in the postcondition to be the same as in the precondition, and (ii)~fix $S \eqdef \upclose(\{s_0\}, T)$. % It remains to show: % \[\hoareV{s\in \upclose(\{s_0\}, T) * \later\pred(s) * \ownGhost{\gname}{(s, \upclose(\{s_0\}, T), T)} * P}{\expr}{\Ret \val. \Exists s', T'. (s, T) \ststrans (s', T') * \later\pred(s') * \ownGhost{\gname}{(s, \upclose(\{s_0\}, T), T)} * Q(\val, s', T')}[\mask]\] % Finally, use \ruleref{BoxOut} to move $s\in \upclose(\{s_0\}, T)$ into the context, and \ruleref{Frame} on $\ownGhost{\gname}{(s, \upclose(\{s_0\}, T), T)}$: % \[s\in \upclose(\{s_0\}, T) \vdash \hoare{\later\pred(s) * P}{\expr}{\Ret \val. \Exists s', T'. (s, T) \ststrans (s', T') * \later\pred(s') * Q(\val, s', T')}[\mask]\] % This holds by our premise. % \end{proof} % % \begin{proof}[Proof of \ruleref{VSSts}] % % This is similar to above, so we only give the proof in short notation: % % \hproof{% % % Context: $\knowInv\iname{\STSInv(\STSS, \pred, \gname)}$ \\ % % \pline[\mask_1 \uplus \{\iname\}]{ % % \ownGhost\gname{(s_0, T)} * P % % } \\ % % \pline[\mask_1]{% % % \Exists s. \later\pred(s) * \ownGhost\gname{(s, S, T)} * P % % } \qquad by \ruleref{StsOpen} \\ % % Context: $s \in S \eqdef \upclose(\{s_0\}, T)$ \\ % % \pline[\mask_2]{% % % \Exists s', T'. \later\pred(s') * Q(s', T') * \ownGhost\gname{(s, S, T)} % % } \qquad by premiss \\ % % Context: $(s, T) \ststrans (s', T')$ \\ % % \pline[\mask_2 \uplus \{\iname\}]{ % % \ownGhost\gname{(s', T')} * Q(s', T') % % } \qquad by \ruleref{StsClose} % % } % % \end{proof} % \subsection{Authoritative monoids with interpretation}\label{sec:authinterp} % Building on \Sref{sec:auth}, after constructing the monoid $\auth{M}$ for a cancellative monoid $M$, we can tie an interpretation, $\pred : \mcarp{M} \to \Prop$, to the authoritative element of $M$, recovering reasoning that is close to the sharing rule in~\cite{krishnaswami+:icfp12}. % Let $\pred_\bot$ be the extension of $\pred$ to $\mcar{M}$ with $\pred_\bot(\mzero) = \FALSE$. % Now define % \begin{align*} % \AuthInv(M, \pred, \gname) \eqdef{}& \exists \melt \in \mcar{M}.\; \ownGhost{\gname}{\authfull \melt:\auth{M}} * \pred_\bot(\melt) \\ % \Auth(M, \pred, \gname, \iname) \eqdef{}& M~\textlog{cancellative} \land \knowInv{\iname}{\AuthInv(M, \pred, \gname)} % \end{align*} % The frame-preserving updates for $\auth{M}$ gives rise to the following view shifts: % \begin{mathpar} % \inferH{NewAuth} % {\infinite(\mask) \and M~\textlog{cancellative}} % {\later\pred_\bot(a) \vs[\mask] \exists \iname \in \mask, \gname.\; \Auth(M, \pred, \gname, \iname) * \ownGhost{\gname}{\authfrag a : \auth{M}}} % \and % \axiomH{AuthOpen} % {\Auth(M, \pred, \gname, \iname) \vdash \ownGhost{\gname}{\authfrag \melt : \auth{M}} \vsE[\{\iname\}][\emptyset] \exists \melt_\f.\; \later\pred_\bot(\melt \mtimes \melt_\f) * \ownGhost{\gname}{\authfull \melt \mtimes \melt_\f, \authfrag a:\auth{M}}} % \and % \axiomH{AuthClose} % {\Auth(M, \pred, \gname, \iname) \vdash \later\pred_\bot(\meltB \mtimes \melt_\f) * \ownGhost{\gname}{\authfull a \mtimes \melt_\f, \authfrag a:\auth{M}} \vs[\emptyset][\{\iname\}] \ownGhost{\gname}{\authfrag \meltB : \auth{M}} } % \end{mathpar} % These view shifts in turn can be used to prove variants of the invariant rules: % \begin{mathpar} % \inferH{Auth} % {\forall \melt_\f.\; \hoare{\later\pred_\bot(a \mtimes \melt_\f) * P}{\expr}{\Ret\val. \exists \meltB.\; \later\pred_\bot(\meltB\mtimes \melt_\f) * Q}[\mask] % \and \physatomic{\expr}} % {\Auth(M, \pred, \gname, \iname) \vdash \hoare{\ownGhost{\gname}{\authfrag a:\auth{M}} * P}{\expr}{\Ret\val. \exists \meltB.\; \ownGhost{\gname}{\authfrag \meltB:\auth{M}} * Q}[\mask \uplus \{\iname\}]} % \and % \inferH{VSAuth} % {\forall \melt_\f.\; \later\pred_\bot(a \mtimes \melt_\f) * P \vs[\mask_1][\mask_2] \exists \meltB.\; \later\pred_\bot(\meltB \mtimes \melt_\f) * Q(\meltB)} % {\Auth(M, \pred, \gname, \iname) \vdash % \ownGhost{\gname}{\authfrag a:\auth{M}} * P \vs[\mask_1 \uplus \{\iname\}][\mask_2 \uplus \{\iname\}] % \exists \meltB.\; \ownGhost{\gname}{\authfrag \meltB:\auth{M}} * Q(\meltB)} % \end{mathpar} % \subsection{Ghost heap} % \label{sec:ghostheap}% % FIXME use the finmap provided by the global ghost ownership, instead of adding our own % We define a simple ghost heap with fractional permissions. % Some modules require a few ghost names per module instance to properly manage ghost state, but would like to expose to clients a single logical name (avoiding clutter). % In such cases we use these ghost heaps. % We seek to implement the following interface: % \newcommand{\GRefspecmaps}{\textsf{GMapsTo}}% % \begin{align*} % \exists& {\fgmapsto[]} : \textsort{Val} \times \mathbb{Q}_{>} \times \textsort{Val} \ra \textsort{Prop}.\;\\ % & \All x, q, v. x \fgmapsto[q] v \Ra x \fgmapsto[q] v \land q \in (0, 1] \\ % &\forall x, q_1, q_2, v, w.\; x \fgmapsto[q_1] v * x \fgmapsto[q_2] w \Leftrightarrow x \fgmapsto[q_1 + q_2] v * v = w\\ % & \forall v.\; \TRUE \vs[\emptyset] \exists x.\; x \fgmapsto[1] v \\ % & \forall x, v, w.\; x \fgmapsto[1] v \vs[\emptyset] x \fgmapsto[1] w % \end{align*} % We write $x \fgmapsto v$ for $\exists q.\; x \fgmapsto[q] v$ and $x \gmapsto v$ for $x \fgmapsto[1] v$. % Note that $x \fgmapsto v$ is duplicable but cannot be boxed (as it depends on resources); \ie we have $x \fgmapsto v \Lra x \fgmapsto v * x \fgmapsto v$ but not $x \fgmapsto v \Ra \always x \fgmapsto v$. % To implement this interface, allocate an instance $\gname_G$ of $\FHeap(\Val)$ and define % \[ % x \fgmapsto[q] v \eqdef % \begin{cases} % \ownGhost{\gname_G}{x \mapsto (q, v)} & \text{if $q \in (0, 1]$} \\ % \FALSE & \text{otherwise} % \end{cases} % \] % The view shifts in the specification follow immediately from \ruleref{GhostUpd} and the frame-preserving updates in~\Sref{sec:fheapm}. % The first implication is immediate from the definition. % The second implication follows by case distinction on $q_1 + q_2 \in (0, 1]$. %%% Local Variables: %%% mode: latex %%% TeX-master: "iris" %%% End: iris-iris-4.2.0/tex/extended-logic.tex000066400000000000000000000502051460620107300176450ustar00rootroot00000000000000\section{Extensions of the Base Logic} In this section we discuss some additional constructions that we define within and on top of the base logic. These are not ``extensions'' in the sense that they change the proof power of the logic, they just form useful derived principles. \subsection{Derived Rules about Base Connectives} We collect here some important and frequently used derived proof rules. \begin{mathparpagebreakable} \infer{} {\prop \Ra \propB \proves \prop \wand \propB} \infer{} {\prop * \Exists\var.\propB \provesIff \Exists\var. \prop * \propB} \infer{} {\prop * \All\var.\propB \proves \All\var. \prop * \propB} \end{mathparpagebreakable} Verifying that existential quantifiers commute with separating conjunction requires an intermediate step using a magic wand: From $P * \exists x, Q \vdash \Exists x. P * Q$ we can deduce $\Exists x. Q \vdash P \wand \Exists x. P * Q$ and then proceed via $\exists$-elimination. \subsection{Derived Rules about Modalities} Iris comes with 4 built-in modalities ($\always$, $\plainly$, $\upd$ and $\later$) and, as we will see, plenty of derived modalities. However, almost all of them fall into one of two categories (except for $\later$, as we will see): they are either \emph{always-style} modalities (``something holds in all/many (future) worlds'') or \emph{eventually-style} modalities (``something holds in a possible (future) world''). \emph{Eventually-style modalities} are characterized by being easy to ``add''/introduce, but hard to ``remove''/eliminate. Consider, for example, the basic update modality $\upd$: we have $\prop \proves \upd\prop$ (\ruleref{upd-intro}), but the inverse direction does not hold. Instead, from \ruleref{upd-mono} and \ruleref{upd-trans}, we can derive the following elimination principle: \begin{mathpar} \infer[upd-E] {\prop \proves \upd\propB} {\upd\prop \proves \upd\propB} \end{mathpar} In other words, we can remove an $\upd$ in front of an assumption \emph{if} the goal is itself wrapped in $\upd$. Another way to view this rule is to think of it as a \emph{bind rule}. Indeed, together with \ruleref{upd-intro}, this rule shows that $\upd$ forms a monad. \emph{Always-style modalities}, on the other hand, are easy to ``remove''/eliminate, but hard to ``add''/introduce. The most widely used example of that in Iris is the persistence modality $\always$: we have $\always\prop \proves \prop$ (\ruleref{pers-elim}), but the inverse direction does not hold. Instead, from \ruleref{pers-mono} and $\always{\prop} \proves \always\always\prop$, we can derive the following introduction principle: \begin{mathpar} \infer[$\always$-I] {\always\prop \proves \propB} {\always\prop \proves \always\propB} \end{mathpar} In other words, we can remove an $\always$ from the goal \emph{if} all our assumptions are wrapped in $\always$. This matches the algebraic structure of a comonad. In particular, both eventually-style and always-style modalities are \emph{idempotent}: we have $\upd\upd\prop \provesIff \upd\prop$ and $\always\always\prop \provesIff \always\prop$. Beyond this, all modalities come with plenty of rules that show how they commute around other connectives and modalities. And, of course, they come with a few ``defining rules'' that give the modalities their individual meaning, \ie for the update modality, that would be \ruleref{upd-update}. In the following, we briefly discuss each of the modalities. \paragraph{Update modality.} As already mentioned, the update modality is an eventually-style modality: \begin{mathpar} \inferhref{upd-E}{upd-elim} {\prop \proves \upd\propB} {\upd\prop \proves \upd\propB} \inferH{upd-idemp} {}{\upd\upd\prop \provesIff \upd\prop} \end{mathpar} Beyond this (and the obvious variant of \ruleref{upd-frame} that exploits commutativity of separating conjunction), there are no outstandingly interesting derived rules. \paragraph{Persistence modality.} As already mentioned, the persistence modality is an always-style modality: \begin{mathpar} \inferhref{$\always$-I}{pers-intro} {\always\prop \proves \propB} {\always\prop \proves \always\propB} \inferhref{$\always$-idemp}{pers-idemp} {}{\always\always\prop \provesIff \always\prop} \end{mathpar} Some further interesting derived rules include: \begin{mathparpagebreakable} \infer{} {\always(\prop\land\propB) \provesIff \always\prop \land \always\propB} \infer{} {\always(\prop\lor\propB) \provesIff \always\prop \lor \always\propB} \infer{} {\always\TRUE \provesIff \TRUE} \infer{} {\always\FALSE \provesIff \FALSE} \\ \infer{} {\always(\prop*\propB) \provesIff \always\prop * \always\propB} \infer{} {\always\prop*\propB \provesIff \always\prop \land \propB} \infer{} {\always(\prop \wand \propB) \provesIff \always(\prop \Ra \propB)} \\ \infer{} {\always(\prop \Ra \propB) \proves \always\prop \Ra \always\propB} \infer{} {\always(\prop \wand \propB) \proves \always\prop \wand \always\propB} \end{mathparpagebreakable} In particular, the persistence modality commutes around conjunction, disjunction, separating conjunction as well as universal and existential quantification. Commuting around conjunction can be derived from the primitive rule that says it commutes around universal quantification (as conjunction is equivalent to a universal quantification of a Boolean), and similar for disjunction. $\TRUE \provesIff \always\TRUE$ (which is basically persistence ``commuting around'' the nullary operator $\TRUE$) can be derived via $\always$ commuting with universal quantification ranging over the empty type. A similar rule holds for $\FALSE$. Moreover, if (at least) one conjunct is below the persistence modality, then conjunction and separating conjunction coincide. \paragraph{Plainness modality.} The plainness modality is very similar to the persistence modality (in fact, we have $\plainly\prop \proves \always\prop$, but the inverse does not hold). It is always-style: \begin{mathpar} \infer[$\plainly$-I] {\plainly\prop \proves \propB} {\plainly\prop \proves \plainly\propB} \infer{}{\plainly\plainly\prop \provesIff \plainly\prop} \end{mathpar} It also commutes around separating conjunction, conjunction, disjunction, universal and existential quantification (and $\TRUE$ and $\FALSE$). The key difference to the persistence modality $\always$ is that $\plainly$ provides a \emph{propositional extensionality} principle: \[ \plainly ( ( P \Ra Q) \land (Q \Ra P ) ) \proves P =_{\Prop} Q \] In contrast, $\always$ permits using some forms of ghost state ($\ownM\melt \proves \always{\ownM{\mcore\melt}}$). Having both of these principles for the same modality would lead to a contradiction: imagine we have an RA with elements $\melt$, $\meltB$ such that $\mcore\melt$ is incompatible with $\meltB$ (\ie $\neg\mvalFull(\mcore\melt \mtimes \meltB)$). Then we can prove: \[ \ownM{\mcore\melt} \proves \always\ownM{\mcore\melt} \proves \always ( ( \FALSE \Ra \ownM\meltB ) \land ( \ownM\meltB \Ra \FALSE ) ) \] The first implication is trivial, the second implication follows because $\always\ownM{\mcore\melt} \land \ownM\meltB \proves \ownM{\mcore\melt} * \ownM\meltB \proves \mval(\mcore\melt \mtimes \meltB)$. But now, if we had propositional extensionality for $\always$ the way we do for $\plainly$, we could deduce $\FALSE =_{\Prop} \ownM\meltB$, and that is clearly wrong. This issue arises because $\always$, as we have seen, still lets us use some resources from the context, while propositional equality has to hold completely disregarding current resources. \paragraph{Later modality.} The later modality is the ``odd one out'' in the sense that it is neither eventually-style nor always-style, because it is not idempotent:% \footnote{This means $\later$ is neither a monad nor a comonad---it does form an applicative functor, though.} with $\later$, the number of times the modality is applied matters, and we can get rid of \emph{exactly one} layer of $\later$ in the assumptions only by doing the same in the conclusion (\ruleref{later-mono}). Some derived rules: \begin{mathparpagebreakable} \inferhref{L{\"o}b}{Loeb} {} {(\later\prop\Ra\prop) \proves \prop} \infer{} {\later(\prop \Ra \propB) \proves \later\prop \Ra \later\propB} \infer{} {\later(\prop \wand \propB) \proves \later\prop \wand \later\propB} \\ \infer{} {\later(\prop\land\propB) \provesIff \later\prop \land \later\propB} \infer{} {\later(\prop\lor\propB) \provesIff \later\prop \lor \later\propB} \infer{\text{$\type$ is inhabited}} {\later(\Exists x:\type. \prop) \provesIff \Exists x:\type. \later\prop} \infer{} {\later\TRUE \provesIff \TRUE} \infer{} {\later(\prop*\propB) \provesIff \later\prop * \later\propB} \infer{} {\later\always\prop \provesIff \always\later\prop} \infer{} {\later\plainly\prop \provesIff \plainly\later\prop} \end{mathparpagebreakable} Noteworthy here is the fact that Löb induction (\ruleref{Loeb}) can be derived from $\later$-introduction and the fact that we can take fixed-points of functions where the recursive occurrences are below $\later$~\cite{Loeb}.% \footnote{Also see \url{https://en.wikipedia.org/wiki/L\%C3\%B6b\%27s_theorem}.} Also, $\later$ commutes over separating conjunction, conjunction, disjunction, universal quantification and \emph{non-empty} existential quantification, as well as both the persistence and the plainness modality. \subsection{Persistent Propositions} We call a proposition $\prop$ \emph{persistent} if $\prop \proves \always\prop$. These are propositions that ``do not own anything'', so we can (and will) treat them like ``normal'' intuitionistic propositions. Of course, $\always\prop$ is persistent for any $\prop$. Furthermore, by the proof rules given in \Sref{sec:proof-rules}, $\TRUE$, $\FALSE$, $t = t'$ as well as $\ownGhost\gname{\mcore\melt}$ and $\mval(\melt)$ are persistent. Persistence is preserved by conjunction, disjunction, separating conjunction as well as universal and existential quantification and $\later$. \subsection{Timeless Propositions and Except-0} \label{sec:timeless-props} One of the troubles of working in a step-indexed logic is the ``later'' modality $\later$. It turns out that we can somewhat mitigate this trouble by working below the following \emph{except-0} modality: \[ \diamond \prop \eqdef \later\FALSE \lor \prop \] Except-0 satisfies the usual laws of a ``monadic'' modality (similar to, \eg the update modalities): \begin{mathpar} \inferH{ex0-mono} {\prop \proves \propB} {\diamond\prop \proves \diamond\propB} \axiomH{ex0-intro} {\prop \proves \diamond\prop} \axiomH{ex0-idem} {\diamond\diamond\prop \proves \diamond\prop} \begin{array}[c]{rMcMl} \diamond{(\prop * \propB)} &\provesIff& \diamond\prop * \diamond\propB \\ \diamond{(\prop \land \propB)} &\provesIff& \diamond\prop \land \diamond\propB \\ \diamond{(\prop \lor \propB)} &\provesIff& \diamond\prop \lor \diamond\propB \end{array} \begin{array}[c]{rMcMl} \diamond{\All x. \prop} &\provesIff& \All x. \diamond{\prop} \\ \diamond{\Exists x. \prop} &\provesIff& \Exists x. \diamond{\prop} \\ \diamond\always{\prop} &\provesIff& \always\diamond{\prop} \\ \diamond\later\prop &\proves& \later{\prop} \end{array} \end{mathpar} In particular, from \ruleref{ex0-mono} and \ruleref{ex0-idem} we can derive a ``bind''-like elimination rule: \begin{mathpar} \inferH{ex0-elim} {\prop \proves \diamond\propB} {\diamond\prop \proves \diamond\propB} \end{mathpar} This modality is useful because there is a class of propositions which we call \emph{timeless} propositions, for which we have \[ \timeless{\prop} \eqdef \later\prop \proves \diamond\prop \] In other words, when working below the except-0 modality, we can \emph{strip away} the later from timeless propositions (using \ruleref{ex0-elim}): \begin{mathpar} \inferH{ex0-timeless-strip}{\timeless{\prop} \and \prop \proves \diamond\propB} {\later\prop \proves \diamond\propB} \end{mathpar} In fact, it turns out that we can strip away later from timeless propositions even when working under the later modality: \begin{mathpar} \inferH{later-timeless-strip}{\timeless{\prop} \and \prop \proves \later \propB} {\later\prop \proves \later\propB} \end{mathpar} This follows from $\later \prop \proves \later\FALSE \lor \prop$, and then by straightforward disjunction elimination. The following rules identify the class of timeless propositions: \begin{mathparpagebreakable} \infer {\vctx \proves \timeless{\prop} \and \vctx \proves \timeless{\propB}} {\vctx \proves \timeless{\prop \land \propB}} \infer {\vctx \proves \timeless{\prop} \and \vctx \proves \timeless{\propB}} {\vctx \proves \timeless{\prop \lor \propB}} \infer {\vctx \proves \timeless{\prop} \and \vctx \proves \timeless{\propB}} {\vctx \proves \timeless{\prop * \propB}} \infer {\vctx \proves \timeless{\prop}} {\vctx \proves \timeless{\always\prop}} \infer {\vctx \proves \timeless{\propB}} {\vctx \proves \timeless{\prop \Ra \propB}} \infer {\vctx \proves \timeless{\propB}} {\vctx \proves \timeless{\prop \wand \propB}} \infer {\vctx,\var:\type \proves \timeless{\prop}} {\vctx \proves \timeless{\All\var:\type.\prop}} \infer {\vctx,\var:\type \proves \timeless{\prop}} {\vctx \proves \timeless{\Exists\var:\type.\prop}} \axiom{\timeless{\TRUE}} \axiom{\timeless{\FALSE}} \infer {\text{$\term$ or $\term'$ is a discrete OFE element}} {\timeless{\term =_\type \term'}} \infer {\text{$\melt$ is a discrete OFE element}} {\timeless{\ownM\melt}} \infer {\text{$\melt$ is an element of a discrete camera}} {\timeless{\mval(\melt)}} \end{mathparpagebreakable} \subsection{Dynamic Composable Higher-Order Resources} \label{sec:composable-resources} The base logic described in \Sref{sec:base-logic} works over an arbitrary camera $\monoid$ defining the structure of the resources. It turns out that we can generalize this further and permit picking cameras ``$\iFunc(\Prop)$'' that depend on the structure of propositions themselves. Of course, $\Prop$ is just the syntactic type of propositions; for this to make sense we have to look at the semantics. Furthermore, there is a composability problem with the given logic: if we have one proof performed with camera $\monoid_1$, and another proof carried out with a \emph{different} camera $\monoid_2$, then the two proofs are actually carried out in two \emph{entirely separate logics} and hence cannot be combined. Finally, in many cases just having a single ``instance'' of a camera available for reasoning is not enough. For example, when reasoning about a dynamically allocated data structure, every time a new instance of that data structure is created, we will want a fresh resource governing the state of this particular instance. While it would be possible to handle this problem whenever it comes up, it turns out to be useful to provide a general solution. The purpose of this section is to describe how we solve these issues. \paragraph{Picking the resources.} The key ingredient that we will employ on top of the base logic is to give some more fixed structure to the resources. To instantiate the logic with dynamic higher-order ghost state, the user picks a family of locally contractive bifunctors $(\iFunc_i : \COFEs^\op \times \COFEs \to \CMRAs)_{i \in \mathcal{I}}$. (This is in contrast to the base logic, where the user picks a single, fixed camera that has a unit.) From this, we construct the bifunctor defining the overall resources as follows: \begin{align*} \GName \eqdef{}& \nat \\ \textdom{ResF}(\ofe^\op, \ofe) \eqdef{}& \prod_{i \in \mathcal I} \GName \fpfn \iFunc_i(\ofe^\op, \ofe) \end{align*} We will motivate both the use of a product and the finite partial function below. $\textdom{ResF}(\ofe^\op, \ofe)$ is a camera by lifting the individual cameras pointwise, and it has a unit (using the empty finite partial function). Furthermore, since the $\iFunc_i$ are locally contractive, so is $\textdom{ResF}$. Now we can write down the recursive domain equation: \[ \iPreProp \cong \UPred(\textdom{ResF}(\iPreProp, \iPreProp)) \] Here, $\iPreProp$ is a COFE defined as the fixed-point of a locally contractive bifunctor, which exists and is unique up to isomorphism by \thmref{thm:america_rutten}, so we obtain some object $\iPreProp$ such that: \begin{align*} \Res &\eqdef \textdom{ResF}(\iPreProp, \iPreProp) \\ \iProp &\eqdef \UPred(\Res) \\ \wIso &: \iProp \nfn \iPreProp \\ \wIso^{-1} &: \iPreProp \nfn \iProp \\ \wIso(\wIso^{-1}(x)) &\eqdef x \\ \wIso^{-1}(\wIso(x)) &\eqdef x \end{align*} Now we can instantiate the base logic described in \Sref{sec:base-logic} with $\Res$ as the chosen camera: \[ \Sem{\Prop} \eqdef \UPred(\Res) \] We obtain that $\Sem{\Prop} = \iProp$. Effectively, we just defined a way to instantiate the base logic with $\Res$ as the camera of resources, while providing a way for $\Res$ to depend on $\iPreProp$, which is isomorphic to $\Sem\Prop$. We thus obtain all the rules of \Sref{sec:base-logic}, and furthermore, we can use the maps $\wIso$ and $\wIso^{-1}$ \emph{in the logic} to convert between logical propositions $\Sem\Prop$ and the domain $\iPreProp$ which is used in the construction of $\Res$ -- so from elements of $\iPreProp$, we can construct elements of $\Sem{\textlog M}$, which are the elements that can be owned in our logic. \paragraph{Proof composability.} To make our proofs composable, we \emph{generalize} our proofs over the family of functors. This is possible because we made $\Res$ a \emph{product} of all the cameras picked by the user, and because we can actually work with that product ``pointwise''. So instead of picking a \emph{concrete} family, proofs will assume to be given an \emph{arbitrary} family of functors, plus a proof that this family \emph{contains the functors they need}. Composing two proofs is then merely a matter of conjoining the assumptions they make about the functors. Since the logic is entirely parametric in the choice of functors, there is no trouble reasoning without full knowledge of the family of functors. Only when the top-level proof is completed we will ``close'' the proof by picking a concrete family that contains exactly those functors the proof needs. \paragraph{Dynamic resources.} Finally, the use of finite partial functions lets us have as many instances of any camera as we could wish for: Because there can only ever be finitely many instances already allocated, it is always possible to create a fresh instance with any desired (valid) starting state. This is best demonstrated by giving some proof rules. So let us first define the notion of ghost ownership that we use in this logic. Assuming that the family of functors contains the functor $\Sigma_i$ at index $i$, and furthermore assuming that $\monoid_i = \Sigma_i(\iPreProp, \iPreProp)$, given some $\melt \in \monoid_i$ we define: \[ \ownGhost\gname{\melt:\monoid_i} \eqdef \ownM{(\ldots, \emptyset, i:\mapsingleton \gname \melt, \emptyset, \ldots)} \] This is ownership of the pair (element of the product over all the functors) that has the empty finite partial function in all components \emph{except for} the component corresponding to index $i$, where we own the element $\melt$ at index $\gname$ in the finite partial function. We can show the following properties for this form of ownership: \begin{mathparpagebreakable} \inferH{res-alloc}{\text{$G$ infinite} \and \melt \in \mval_{M_i}} { \TRUE \proves \upd \Exists\gname\in G. \ownGhost\gname{\melt : M_i} } \and \inferH{res-update} {\melt \mupd_{M_i} B} {\ownGhost\gname{\melt : M_i} \proves \upd \Exists \meltB\in B. \ownGhost\gname{\meltB : M_i}} \inferH{res-empty} {\text{$\munit$ is a unit of $M_i$}} {\TRUE \proves \upd \ownGhost\gname\munit} \axiomH{res-op} {\ownGhost\gname{\melt : M_i} * \ownGhost\gname{\meltB : M_i} \provesIff \ownGhost\gname{\melt\mtimes\meltB : M_i}} \axiomH{res-valid} {\ownGhost\gname{\melt : M_i} \Ra \mval_{M_i}(\melt)} \inferH{res-timeless} {\text{$\melt$ is a discrete OFE element}} {\timeless{\ownGhost\gname{\melt : M_i}}} \end{mathparpagebreakable} Below, we will always work within (an instance of) the logic as described here. Whenever a camera is used in a proof, we implicitly assume it to be available in the global family of functors. We will typically leave the $M_i$ implicit when asserting ghost ownership, as the type of $\melt$ will be clear from the context. %%% Local Variables: %%% mode: latex %%% TeX-master: "iris" %%% End: iris-iris-4.2.0/tex/heaplang.sty000066400000000000000000000071011460620107300165450ustar00rootroot00000000000000\NeedsTeXFormat{LaTeX2e}[1999/12/01] \ProvidesPackage{heaplang} \RequirePackage{marvosym} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % CONCRETE LANGUAGE SYNTAX AND SEMANTICS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newcommand{\textlang}[1]{\texttt{#1}} \newcommand{\ProphId}{\textdom{ProphId}} \newcommand{\langkw}[1]{\textlang{\bfseries #1}} \newcommand{\langv}[1]{\ensuremath{\mathit{#1}}} % Yes, this makes language-level variables look like logic-level variables. but we still distinguish locally bound variables from global definitions. \newcommand{\lvar}{\langv{\var}} \newcommand{\lvarB}{\langv{\varB}} \newcommand{\lvarC}{\langv{\varC}} \newcommand{\lvarF}{\langv{f}} \newcommand{\loc}{\ell} \newcommand{\prophid}{p} \newcommand{\stateHeap}{\textproj{heap}} \newcommand{\stateProphs}{\textproj{prophs}} \def\Let#1=#2in{\langkw{let} \spac #1 \mathrel{=} #2 \spac \langkw{in} \spac} \def\If#1then{\langkw{if} \spac #1 \spac \langkw{then} \spac} \def\Else{\spac\langkw{else} \spac} \def\Rec#1#2={\langkw{rec}\spac\operatorname{#1}#2 \mathrel{=} } \def\Skip{\langkw{skip}} \def\Assert{\operatorname{\langkw{assert}}} \def\Inl{\operatorname{\langkw{inl}}} \def\Inr{\operatorname{\langkw{inr}}} \def\Fst{\operatorname{\langkw{fst}}} \def\Snd{\operatorname{\langkw{snd}}} \def\True{\langkw{true}} \def\False{\langkw{false}} \def\NewProph{\langkw{newproph}} \def\ResolveWith#1at#2to#3{\langkw{resolve}\spac\langkw{with}\spac#1\spac\langkw{at}\spac#2\spac\langkw{to}\spac#3} \def\Resolve#1to#2{\langkw{resolve}\spac#1\spac\langkw{to}\spac#2} \def\Match#1with#2=>#3|#4=>#5end{\langkw{match}\spac#1\spac\langkw{with}\spac#2\Ra#3\mid#4\Ra#5\spac\langkw{end}} \def\MatchML#1with#2=>#3|#4=>#5end#6{{\arraycolsep=1.4pt\begin{array}[t]{rll}% \multicolumn{3}{l}{\langkw{match}\spac#1\spac\langkw{with}}\\% &\Ra#3\\|&\Ra#5\\% \multicolumn{3}{l}{\langkw{end}#6}% \end{array}}} \def\MatchMLL#1with#2=>#3|#4=>#5|#6=>#7end#8{{\arraycolsep=1.4pt\begin{array}[t]{rll}% \multicolumn{3}{l}{\langkw{match}\spac#1\spac\langkw{with}}\\% &\Ra#3\\|&\Ra#5\\|&\Ra#7\\% \multicolumn{3}{l}{\langkw{end}#8}% \end{array}}} \def\MatchS#1with#2=>#3end{ \langkw{match}\spac#1\spac\langkw{with}\spac#2\Ra#3\spac\langkw{end}} \newcommand\AllocN{\operatorname{\langkw{AllocN}}} \newcommand\Alloc{\operatorname{\langkw{ref}}} % syntax rendering consistent with Coq \newcommand\Free{\operatorname{\langkw{Free}}} \newcommand\CAS{\operatorname{\langkw{CAS}}} \newcommand\CmpXchg{\operatorname{\langkw{CmpXchg}}} \newcommand\Xchg{\operatorname{\langkw{Xchg}}} \newcommand\FAA{\operatorname{\langkw{FAA}}} \newcommand\deref{\mathop{!}} \let\gets\leftarrow \newcommand*\Fork[1]{\langkw{fork}\spac\set{#1}} \newcommand{\fold}{\langkw{fold}\spac} \newcommand{\unfold}{\langkw{unfold}\spac} \newcommand{\HLOp}{\circledcirc} \newcommand{\Ptradd}{\mathop{+_{\langkw{L}}}} \newcommand{\TT}{()} \newcommand*\poison{\text{\Biohazard}} \newcommand\valeq{\cong} \newcommand\valne{\ncong} \newcommand\litCompareSafe{\textlog{lit\_compare\_safe}} \newcommand\valCompareSafe{\textlog{val\_compare\_safe}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % VALUE AND EXPRESSION DISAMBIGUATION %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newcommand\valForm{{\langkw{v}}} \def\RecV#1#2={\langkw{rec}_\valForm\spac\operatorname{#1}#2 \mathrel{=} } \def\InlV{\Inl_\valForm} \def\InrV{\Inr_\valForm} \newcommand\exprForm{{\langkw{e}}} \def\RecE#1#2={\langkw{rec}_\exprForm\spac\operatorname{#1}#2 \mathrel{=} } \def\InlE{\Inl_\exprForm} \def\InrE{\Inr_\exprForm} iris-iris-4.2.0/tex/heaplang.tex000066400000000000000000000306151460620107300165340ustar00rootroot00000000000000\section{HeapLang} \label{sec:heaplang} So far, we have treated the programming language we work on entirely generically. In this section we present the default language that ships with Iris, HeapLang. HeapLang is an ML-like languages with a higher-order heap, unstructured concurrency, some common atomic operations, and prophecy variables. It is an instance of the language interface (\Sref{sec:language}), so we only define a per-thread small-step operational semantics---the thread-pool semantics are given in in \Sref{sec:language:concurrent}. \subsection{HeapLang syntax and operational semantics} The grammar of HeapLang, and in particular its set \Expr{} of \emph{expressions} and \Val{} of \emph{values}, is defined as follows: \begin{align*} \val,\valB \in \Val \bnfdef{}& z \mid \True \mid \False \mid \TT \mid \poison \mid \loc \mid \prophid \mid {}& (z \in \integer, \loc \in \Loc, \prophid \in \ProphId) \\& \RecV\lvarF(\lvar)= \expr \mid (\val,\valB)_\valForm \mid \InlV(\val) \mid \InrV(\val) \\ \expr \in \Expr \bnfdef{}& \val \mid \lvar \mid \RecE\lvarF(\lvar)= \expr \mid \expr_1(\expr_2) \mid {}\\ & \HLOp_1 \expr \mid \expr_1 \HLOp_2 \expr_2 \mid \If \expr then \expr_1 \Else \expr_2 \mid {}\\ & (\expr_1,\expr_2)_\exprForm \mid \Fst(\expr) \mid \Snd(\expr) \mid {}\\ & \InlE(\expr) \mid \InrE(\expr) \mid \Match \expr with \Inl => \expr_1 | \Inr => \expr_2 end \mid {}\\ & \AllocN(\expr_1,\expr_2) \mid \Free(\expr) \mid \deref \expr \mid \expr_1 \gets \expr_2 \mid \CmpXchg(\expr_1, \expr_2, \expr_3) \mid \Xchg(\expr_1, \expr_2) \mid \FAA(\expr_1, \expr_2) \mid \kern-30ex{}\\ & \Fork \expr \mid \NewProph \mid \ResolveWith \expr_1 at \expr_2 to \expr_3 \\ \HLOp_1 \bnfdef{}& - \mid \ldots ~~\text{(list incomplete)} \\ \HLOp_2 \bnfdef{}& + \mid - \mid \Ptradd \mid \mathop{=} \mid \ldots ~~\text{(list incomplete)} \end{align*} (Note that \langkw{match} contains a literal $|$ that is not part of the BNF but part of HeapLang syntax.) To simplify the formalization, the only binders occur in \langkw{rec}. \langkw{match} has a closure in each arm which will be applied to the value of the left/right variant, respectively. (See the syntactic sugar defined later.) Recursive abstractions, pairs, and the injections exist both as a value form and an expression form. The expression forms will reduce to the value form once all their arguments are values. Conceptually, one can think of that as corresponding to ``boxing'' that most functional language implementations do. We will leave away the disambiguating subscript when it is clear from the context or does not matter. All of this lets us define $\ofval$ as simply applying the value injection (the very first syntactic form of $\Expr$), which makes a lot of things in Coq much simpler. $\toval$ is defined recursively in the obvious way. \langkw{AllocN} takes as first argument the number of heap cells to allocate (must be strictly positive), and as second argument the default value to use for these heap cells. This lets one allocate arrays. $\Ptradd$ implements pointer arithmetic (the left operand must be a pointer, the right operand an integer), which is used to access array elements. For our set of states and observations, we pick \begin{align*} \loc \ni \Loc \eqdef{}& \integer \\ \prophid \ni \ProphId \eqdef{}& \integer \\ \sigma \ni \State \eqdef{}& \record{\begin{aligned} \stateHeap:{}& \Loc \fpfn \Val,\\ \stateProphs:{}& \pset{\ProphId} \end{aligned}} \\ \obs \ni \Obs \eqdef{}& \ProphId \times (\Val \times \Val) \end{align*} The HeapLang operational semantics is defined via the use of \emph{evaluation contexts}: \begin{align*} \lctx \in \Lctx \bnfdef{}& \bullet \mid \Lctx_{>} \\ \lctx_{>} \in \Lctx_{>} \bnfdef{}& \expr(\lctx) \mid \lctx (\val) \mid {}\\ & \HLOp_1 \lctx \mid \expr \HLOp_2 \lctx \mid \lctx \HLOp_2 \val \mid \If \lctx then \expr_1 \Else \expr_2 \mid {}\\ & (\expr, \lctx) \mid (\lctx, \val) \mid \Fst(\lctx) \mid \Snd(\lctx) \mid {}\\ & \Inl(\lctx) \mid \Inr(\lctx) \mid \Match \lctx with \Inl => \expr_1 | \Inr => \expr_2 end \mid {}\\ & \AllocN(\expr, \lctx) \mid \AllocN(\lctx, \val) \mid \Free(\lctx) \mid \deref \lctx \mid \expr \gets \lctx \mid \lctx \gets \val \mid {}\\ & \CmpXchg(\expr_1, \expr_2, \lctx) \mid \CmpXchg(\expr_1, \lctx, \val_3) \mid \CmpXchg(\lctx, \val_2, \val_3) \mid {}\\ & \Xchg(\expr, \lctx) \mid \Xchg(\lctx, \val) \mid \FAA(\expr, \lctx) \mid \FAA(\lctx, \val) \mid {}\\ & \ResolveWith \expr_1 at \expr_2 to \lctx \mid \ResolveWith \expr_1 at \lctx to \val_3 \mid {}\\ & \ResolveWith \lctx_{>} at \val_2 to \val_3 \end{align*} Note that we use right-to-left evaluation order. This means in a curried function call $f(x)(y)$, we know syntactically the arguments will all evaluate before $f$ gets to do anything, which makes specifying curried calls a lot easier. The \langkw{resolve} evaluation context for the leftmost expression (the nested expression that executes atomically together with the prophecy resolution) is special: it must not be empty; only further nested evaluation contexts are allowed. \langkw{resolve} takes care of reducing the expression once the nested contexts are taken care of, and at that point it requires the expression to reduce to a value in exactly one step. Hence we define $\Lctx_{>}$ for non-empty evaluation contexts. For more details on prophecy variables, see \cite{iris:prophecy}. This lets us define the primitive reduction relation in terms of a ``head step'' reduction; see \figref{fig:heaplang-reduction-pure} and \figref{fig:heaplang-reduction-impure}. Comparison (both for $\CmpXchg$ and the binary comparison operator) is a bit tricky and uses a helper judgment (\figref{fig:heaplang-valeq}). Basically, two values can only be compared if at least one of them is ``compare-safe''. Compare-safe values are basic literals (integers, Booleans, locations, unit) as well as $\Inl$ and $\Inr$ of those literals. The intention of this is to forbid directly comparing large values such as pairs, which could not be done in a single atomic step on a real machine. \begin{figure}[p] \judgment[Per-thread reduction]{\expr_1, \state_1 \step [\vec\obs] \expr_2, \state_2, \vec\expr} \begin{mathpar} \infer {\expr_1, \state_1 \hstep [\vec\obs] \expr_2, \state_2, \vec\expr} {\fillctx\lctx[\expr_1], \state_1 \step[\vec\obs] \fillctx\lctx[\expr_2], \state_2, \vec\expr} \end{mathpar} \judgment[``Head'' reduction (pure)]{\expr_1, \state_1 \hstep [\vec\obs] \expr_2, \state_2, \vec\expr} \newcommand\alignheader{\kern-30ex} \begin{align*} &\alignheader\textbf{``Boxing'' reductions} \\ (\RecE\lvarF(\lvar)= \expr, \state) \hstep[\nil]{}& (\RecV\lvarF(\lvar)= \expr, \state, \nil) \\ ((\val_1, \val_2)_\exprForm, \state) \hstep[\nil]{}& ((\val_1, \val_2)_\valForm, \state, \nil) \\ (\InlE(\val), \state) \hstep[\nil]{}& (\InlV(\val), \state, \nil) \\ (\InrE(\val), \state) \hstep[\nil]{}& (\InrV(\val), \state, \nil) \\ &\alignheader\textbf{Pure reductions} \\ ((\RecV\lvarF(\lvar)= \expr)(\val), \state) \hstep[\nil]{}& (\subst {\subst \expr \lvarF {(\Rec\lvarF(\lvar)= \expr)}} \lvar \val, \state, \nil) \\ (-_{\HLOp} z, \state) \hstep[\nil]{}& (-z, \state, \nil) \\ (z_1 +_{\HLOp} z_2, \state) \hstep[\nil]{}& (z_1 + z_2, \state, \nil) \\ (z_1 -_{\HLOp} z_2, \state) \hstep[\nil]{}& (z_1 - z_2, \state, \nil) \\ (\loc \Ptradd z, \state) \hstep[\nil]{}& (\loc + z, \state, \nil) \\ (\val_1 =_{\HLOp} \val_2, \state) \hstep[\nil]{}& (\True, \state, \nil) &&\text{if $\val_1 \valeq \val_2$} \\ (\val_1 =_{\HLOp} \val_2, \state) \hstep[\nil]{}& (\False, \state, \nil) &&\text{if $\val_1 \valne \val_2$} \\ (\If \True then \expr_1 \Else \expr_2, \state) \hstep[\nil]{}& (\expr_1, \state, \nil) \\ (\If \False then \expr_1 \Else \expr_2, \state) \hstep[\nil]{}& (\expr_2, \state, \nil) \\ (\Fst((\val_1, \val_2)_\valForm), \state) \hstep[\nil]{}& (\val_1, \state, \nil) \\ (\Snd((\val_1, \val_2)_\valForm), \state) \hstep[\nil]{}& (\val_2, \state, \nil) \\ (\Match \InlV(\val) with \Inl => \expr_1 | \Inr => \expr_2 end, \state) \hstep[\nil]{}& (\expr_1(\val), \state, \nil) \\ (\Match \InrV(\val) with \Inl => \expr_1 | \Inr => \expr_2 end, \state) \hstep[\nil]{}& (\expr_2(\val), \state, \nil) \end{align*} \caption{HeapLang pure and boxed reduction rules. \\ \small The $\HLOp$ subscript indicates that this is the HeapLang operator, not the mathematical operator.} \label{fig:heaplang-reduction-pure} \end{figure} \begin{figure} \judgment[``Head'' reduction (impure)]{\expr_1, \state_1 \hstep [\vec\obs] \expr_2, \state_2, \vec\expr} \newcommand\alignheader{\kern-30ex} \begin{align*} &\alignheader\textbf{Heap reductions} \\ (\AllocN(z, \val), \state) \hstep[\nil]{}& (\loc, \mapinsert {[\loc,\loc+z)} \val {\state:\stateHeap}, \nil) &&\text{if $z>0$ and \(\All i \expr_1 | \Inr(\lvarB) => \expr_2 end \eqdef {}& \Match \expr with \Inl => \Lam\lvar. \expr_1 | \Inr => \Lam\lvarB. \expr_2 end \\ \Alloc(\expr) \eqdef{}& \AllocN(1,\expr) \\ \CAS(\expr_1, \expr_2, \expr_3) \eqdef{}& \Snd(\CmpXchg(\expr_1, \expr_2, \expr_3)) \\ \Resolve \expr_1 to \expr_2 \eqdef{}& \ResolveWith \Skip at \expr_1 to \expr_2 \end{align*} %%% Local Variables: %%% mode: latex %%% TeX-master: "iris" %%% End: iris-iris-4.2.0/tex/iris.sty000066400000000000000000000411741460620107300157440ustar00rootroot00000000000000\NeedsTeXFormat{LaTeX2e}[1999/12/01] \ProvidesPackage{iris} \RequirePackage{faktor} \RequirePackage{tikz} \RequirePackage{scalerel} \RequirePackage{array} \RequirePackage{dashbox} \RequirePackage{tensor} \RequirePackage{xparse} \RequirePackage{xifthen} \RequirePackage{mathtools} \usetikzlibrary{shapes} \usetikzlibrary{arrows} \usetikzlibrary{calc} \usetikzlibrary{arrows.meta} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% FONTS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newcommand{\textdom}[1]{\textit{#1}} % for domains/sets/types \newcommand{\textproj}[1]{\textsc{#1}} % for projections/fields \newcommand{\textlog}[1]{\textsf{\upshape #1}} % for mathematical/logic-level identifiers (make sure we do not inherit italic shape from the environment) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% MATH SYMBOLS & NOTATION & IDENTIFIERS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newcommand{\nat}{\mathbb{N}} \newcommand{\integer}{\mathbb{Z}} \DeclareMathOperator*{\Sep}{\scalerel*{\ast}{\sum}} % big-star \newcommand*{\disj}[1][]{\mathrel{\#_{#1}}} \newcommand\pord{\sqsubseteq} \makeatletter% \@ifundefined{dplus}{% \newcommand\dplus{\mathbin{+\kern-1.0ex+}} }{} \makeatother% \newcommand\fmap{\mathrel{\langle\$\rangle}} \newcommand{\upclose}{\mathord{\uparrow}} \newcommand{\ALT}{\ |\ } \newcommand{\spac}{\nobreak\hskip 0.2em plus 0.1em} % a space \def\All #1.{\forall #1.\spac}% \def\Exists #1.{\exists #1.\spac}% \def\Ret #1.{#1.\spac}% \newcommand{\any}{{\rule[-.2ex]{1ex}{.4pt}}}% % For some reason \paragraph gives the weirdest errors ("missing \item"). \newcommand{\judgment}[2][]{\bigskip\noindent\textit{#1}\hspace{\stretch{1}}\fbox{$#2$}\nopagebreak} \newcommand{\pfn}{\rightharpoonup} \newcommand\fpfn{\xrightharpoonup{\smash{\raisebox{-.3ex}{\ensuremath{\scriptstyle\kern-0.25ex\textlog{fin}\kern-0.1ex}}}}} \newcommand{\la}{\leftarrow} \newcommand{\ra}{\rightarrow} \newcommand{\Ra}{\Rightarrow} \newcommand{\Lra}{\Leftrightarrow} \newcommand\monra[1][]{\xrightarrow{\smash{\raisebox{-.3ex}{\ensuremath{\scriptstyle\kern-0.15ex\textlog{mon}_{#1}\kern-0.05ex}}}}} \newcommand\monnra{\xrightarrow{\smash{\raisebox{-.3ex}{\ensuremath{\scriptstyle\kern-0.15ex\textlog{mon,ne}\kern-0.05ex}}}}} \newcommand\nfn{\xrightarrow{\smash{\raisebox{-.3ex}{\ensuremath{\scriptstyle\kern-0.15ex\textlog{ne}\kern-0.05ex}}}}} \newcommand{\eqdef}{\triangleq} \newcommand{\bnfdef}{\vcentcolon\vcentcolon=} \newcommand{\maybe}[1]{#1^?} \newcommand*\setComp[2]{\left\{#1\spac\middle|\spac#2\right\}} \newcommand*\set[1]{\left\{#1\right\}} \newcommand*\record[1]{\left\{\spac#1\spac\right\}} \newcommand*\recordComp[2]{\left\{\spac#1\spac\middle|\spac#2\spac\right\}} \newenvironment{inbox}[1][]{ \begin{array}[#1]{@{}l@{}} }{ \end{array} } \newcommand{\op}{\textlog{op}} \newcommand{\dom}{\textlog{dom}} \newcommand{\cod}{\textlog{cod}} \renewcommand{\lim}{\textlog{lim}} \renewcommand{\min}{\textlog{min}} \newcommand{\Chains}{\textdom{Chains}} \newcommand{\pset}[1]{\wp(#1)} % Powerset \newcommand{\psetdown}[1]{\wp^\downarrow(#1)} \newcommand{\finpset}[1]{\wp^\textlog{fin}(#1)} \newcommand{\pmultiset}[1]{\wp^{+}(#1)} \newcommand{\finpmultiset}[1]{\wp^{\textlog{fin},+}(#1)} \newcommand{\Func}{F} % functor \newcommand{\subst}[3]{{#1}[{#3} / {#2}]} \newcommand{\mapelem}[2]{#1\mathop{\la}#2} \newcommand{\mapinsert}[3]{#3\!\left[\mapelem{#1}{#2}\right]} \newcommand{\mapdelete}[2]{#2\setminus\set{#1}} \newcommand{\mapsingleton}[2]{\mapinsert{#1}{#2}{\,}} \newcommand{\mapinsertComp}[4] {\mapinsert{#1}{#2 \spac\middle|\spac #3}{#4}} \newcommand{\mapComp}[3] {\mapinsertComp{#1}{#2}{#3}{}} \newcommand{\nil}{\epsilon} % displaced dot \newcommand{\dispdot}[2][.2ex]{\dot{\raisebox{0pt}[\dimexpr\height+#1][\depth]{$#2$}}}% \dispdot[]{} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% MODEL-SPECIFIC SYMBOLS & NOTATION & IDENTIFIERS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newcommand{\wIso}{\xi} \newcommand{\rs}{r} \newcommand{\rsB}{s} \newcommand{\rss}{R} \newcommand{\pres}{\pi} \newcommand{\wld}{w} \newcommand{\ghostRes}{g} %% Various pieces of syntax \newcommand{\wsat}[3]{#1 \models_{#2} #3} \newcommand{\wsatpre}{\textdom{pre-wsat}} \newcommand{\wtt}[2]{#1 : #2} % well-typed term \newcommand{\nequiv}[1]{\ensuremath{\mathrel{\stackrel{#1}{=}}}} \newcommand{\nincl}[1]{\ensuremath{\mathrel{\stackrel{#1}{\subseteq}}}} \newcommand{\notnequiv}[1]{\ensuremath{\mathrel{\stackrel{#1}{\neq}}}} \newcommand{\nequivset}[2]{\ensuremath{\mathrel{\stackrel{#1}{=}_{#2}}}} \newcommand{\nequivB}[1]{\ensuremath{\mathrel{\stackrel{#1}{\equiv}}}} \newcommand{\latert}{\mathord{\blacktriangleright}} \newcommand{\latertinj}{\textlog{next}} \newcommand{\Sem}[1]{\llbracket #1 \rrbracket} \newcommand{\sembox}[1]{\hfill \normalfont \mbox{\fbox{\(#1\)}}} \newcommand{\typedsection}[2]{\subsubsection*{\rm\em #1 \sembox{#2}}} %% Some commonly used identifiers \newcommand{\SProp}{\textdom{SProp}} \newcommand{\UPred}{\textdom{UPred}} \newcommand{\mProp}{\textdom{Prop}} % meta-level prop \newcommand{\iProp}{\textdom{iProp}} \newcommand{\iPreProp}{\textdom{iPreProp}} \newcommand{\Wld}{\textdom{Wld}} \newcommand{\Res}{\textdom{Res}} % List \newcommand{\List}{\ensuremath{\textdom{List}}} \newcommand{\ofe}{T} \newcommand{\ofeB}{U} \newcommand{\cofe}{\ofe} \newcommand{\cofeB}{\ofeB} \newcommand{\OFEs}{\mathbf{OFE}} % category of OFEs \newcommand{\COFEs}{\mathbf{COFE}} % category of COFEs \newcommand{\iFunc}{\Sigma} \newcommand{\fix}{\textdom{fix}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % CMRA (RESOURCE ALGEBRA) SYMBOLS & NOTATION & IDENTIFIERS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newcommand{\monoid}{M} \newcommand{\mval}{\mathcal{V}} \newcommand{\mvalFull}{\overline{\mathcal{V}}} \newcommand{\melt}{a} \newcommand{\meltB}{b} \newcommand{\meltC}{c} \newcommand{\melts}{A} \newcommand{\meltsB}{B} \newcommand{\f}{\textlog{f}} % used as subscript, for "frame" \newcommand{\munit}{\varepsilon} \newcommand{\mcore}[1]{{\mid}#1{\mid}} % using "|" here makes LaTeX diverge. WTF. \newcommand{\bigmcore}[1]{{\big|}#1{\big|}} % using "|" here makes LaTeX diverge. WTF. \newcommand{\mnocore}{\bot} \newcommand{\mtimes}{\mathbin{\cdot}} \newcommand{\mundef}{\lightning} \newcommand{\exclusive}{\textlog{exclusive}} \newcommand{\mupd}{\rightsquigarrow} \newcommand{\lupd}{\rightsquigarrow_{\textlog{L}}} \newcommand{\mincl}[1][]{% \ensuremath{\mathrel{\vbox{\offinterlineskip\ialign{% \hfil##\hfil\cr \ensuremath{\scriptstyle #1}\cr \noalign{\kern-0.25ex} $\preccurlyeq$\cr }}}}} \newcommand{\CMRAs}{\mathbf{Camera}} % category of Cameras/CMRAs %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% LOGIC SYMBOLS & NOTATION & IDENTIFIERS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newcommand{\Sig}{\mathcal{S}} \newcommand{\SigType}{\mathcal{T}} \newcommand{\SigFn}{\mathcal{F}} \newcommand{\SigAx}{\mathcal{A}} \newcommand{\sigtype}{T} \newcommand{\sigfn}{F} \newcommand{\sigax}{A} \newcommand{\type}{\tau} \newcommand{\typeB}{\sigma} \newcommand{\var}{x} \newcommand{\varB}{y} \newcommand{\varC}{z} \newcommand{\term}{t} \newcommand{\termB}{u} \newcommand{\venv}{\rho} \newcommand{\vctx}{\Gamma} \newcommand{\pfctx}{\Theta} \newcommand{\prop}{P} \newcommand{\propB}{Q} \newcommand{\propC}{R} % pure propositions \newcommand{\pprop}{\phi} \newcommand{\ppropB}{\psi} \newcommand{\pred}{\varPhi} \newcommand{\predB}{\Psi} \newcommand{\predC}{\Zeta} \newcommand{\gname}{\gamma} \newcommand{\iname}{\iota} \newcommand{\mask}{\mathcal{E}} \newcommand{\namesp}{\mathcal{N}} \newcommand{\namecl}[1]{{#1^{\kern0.2ex\uparrow}}} \newcommand{\fixp}{\mathit{fix}} %% various pieces of Syntax \def\MU #1.{\mu #1.\spac}% \def\Lam #1.{\lambda #1.\spac}% \newcommand{\proves}{\vdash} \newcommand{\provesIff}{\mathrel{\dashv\vdash}} \newcommand{\wand}{\mathrel{-\!\!\ast}} \newcommand{\wandIff}{\mathrel{\ast\!\!{-}\!\!\ast}} % oh my... I have to wrap the "-" in a \mathrm, otherwise all hell breaks lose... \newcommand{\fmapsto}[1][]{\xmapsto{\smash{\raisebox{-.15ex}{\ensuremath{\scriptstyle #1}}}}} \newcommand{\gmapsto}{\hookrightarrow}% \newcommand{\fgmapsto}[1][\mathrm{-}]{\xhookrightarrow{#1}}% \NewDocumentCommand\wpre{O{} m O{} m}% {\textlog{wp}^{#1}_{#3}\spac#2\spac{\left\{#4\right\}}} \newcommand{\stateinterp}{S} \newcommand\stuckness{s} \newcommand\NotStuck{\textlog{NotStuck}} \newcommand\MaybeStuck{\textlog{Stuck}} \newcommand{\later}{\mathop{{\triangleright}}} \newcommand*{\lateropt}[1]{\mathop{{\later}^{#1}}} \newcommand{\always}{\mathop{\boxempty}} \newcommand{\plainly}{\mathop{\blacksquare}} \newcommand{\pers}{\mathop{\boxdot}} %% Invariants and Ghost ownership % PDS: Was 0pt inner, 2pt outer. % \boxedassert [tikzoptions] contents [name] \tikzstyle{boxedassert_border} = [sharp corners,line width=0.2pt] \NewDocumentCommand \boxedassert {O{} m o}{% \tikz[baseline=(m.base)]{ % \node[rectangle, draw,inner sep=0.8pt,anchor=base,#1] (m) {${#2}\mathstrut$}; \node[rectangle,inner sep=0.8pt,outer sep=0.2pt,anchor=base] (m) {${\,#2\,}\mathstrut$}; \draw[#1,boxedassert_border] ($(m.south west) + (0,0.65pt)$) rectangle ($(m.north east) + (0, 0.7pt)$); }\IfNoValueF{#3}{^{\,#3}}% } \newcommand*{\knowInv}[2]{\boxedassert{#2}[#1]} \newcommand*{\invM}[2]{\textlog{Inv}^{#1}\left(#2\right)} \newcommand*{\ownGhost}[2]{\boxedassert[densely dashed]{#2}[#1]} \newcommand*{\ownM}[1]{\textlog{Own}\left(#1\right)} \newcommand*{\ownPhys}[1]{\textlog{Phy}(#1)} %% View Shifts \NewDocumentCommand \vsGen {O{} m O{}}% {\mathrel{% \ifthenelse{\equal{#3}{}}{% % Just one mask, or none {#2}_{#1}% }{% % Two masks \tensor*[_{#1}]{#2}{_{#3}} }% }}% \NewDocumentCommand \vs {O{} O{}} {\vsGen[#1]{\Rrightarrow}[#2]} \NewDocumentCommand \bvs {O{} O{}} {\vsGen[#1]{\dispdot[0.02ex]{\Rrightarrow}}[#2]} \NewDocumentCommand \vsL {O{} O{}} {\vsGen[#1]{\Lleftarrow}[#2]} \NewDocumentCommand \vsE {O{} O{}} % {\vsGen[#1]{\Lleftarrow\!\!\!\Rrightarrow}[#2]} \NewDocumentCommand \pvs {O{} O{}} {\mathord{\vsGen[#1]{{\mid\kern-0.5ex\Rrightarrow\kern-0.25ex}}[#2]\kern0.2ex}} \newcommand\vsWand{{\displaystyle\equiv\kern-1.6ex-\kern-1.5ex\smash{\scalerel*{\vphantom-\ast}{\sum}}\kern-0.2ex}} \NewDocumentCommand \vsW {O{} O{}} {\vsGen[#1]{\vsWand}[#2]} \newcommand\vsWandStep{{\displaystyle\raisebox{0.106ex}{\scaleobj{0.82}{\later}}\kern-1.65ex\equiv\kern-1.6ex-\kern-1.5ex\smash{\scalerel*{\vphantom-\ast}{\sum}}\kern-0.2ex}} \NewDocumentCommand \vsWS {O{} O{}} {\vsGen[#1]{\vsWandStep}[#2]} % for now, the update modality looks like a pvs without masks. \NewDocumentCommand \upd {} {\mathop{\dispdot[-0.2ex]{\mid\kern-0.4ex\Rrightarrow\kern-0.25ex}}} \NewDocumentCommand\Acc{O{} O{} m m}{#3 \mathrel{~\vsGen[#1]{\propto}[#2]~} #4} %% Later credits \newcommand{\laterCredit}[1]{\text{\textsterling}\hskip 0.1em \ensuremath{#1}} \newcommand{\laterCreditSupply}[1]{\text{\textsterling}_{\!\bullet}\hskip 0.1em \ensuremath{#1}} % macro for oversetting a character with custom spacing % \makeatletter % \newcommand{\osetCharacter}[3][0ex]{% % \mathrel{\mathop{#3}\limits^{ % \vbox to#1{\kern-2\ex@ % \hbox{$\scriptstyle#2$}\vss}}}} % \makeatother \newcommand{\creditUpd}{\mathop{\pvs^{\!\!\textsterling}}} \newcommand{\LaterCreditsFlag}{\textsf{UseLaterCredits}} %% Hoare Triples % needs extra {...} for some weird reason \newcommand{\curlybracket}[1]{{\left\{#1\right\}}} \NewDocumentCommand \hoare {m m m O{}}{ \curlybracket{#1}\spac #2 \spac \curlybracket{#3}_{#4}% } % \hoareV[t] pre c post [mask] \NewDocumentCommand \hoareV {O{c} m m m O{}}{ {\begin{aligned}[#1] &\curlybracket{#2} \\ &\quad{#3} \\ &\curlybracket{#4}_{#5} \end{aligned}}% } % \hoareHV[t] pre c post [mask] \NewDocumentCommand \hoareHV {O{c} m m m O{}}{ {\begin{aligned}[#1] &\curlybracket{#2} \spac {#3} \\ &\curlybracket{#4}_{#5} \end{aligned}}% } % \hoareVH[t] pre c post [mask] \NewDocumentCommand \hoareVH {O{c} m m m O{}}{ {\begin{aligned}[#1] &\curlybracket{#2} \\ & {#3}\spac \curlybracket{#4}_{#5} \end{aligned}}% } %% Logical atomicity %Limit bracket width to 2ex \newcommand{\anglebracket}[1]{{\scaleleftright[2ex]{\langle}{#1}{\rangle}}} \NewDocumentCommand \ahoare {m m m O{}}{ \anglebracket{#1}\spac #2 \spac \anglebracket{#3}_{#4}% } \NewDocumentCommand \ahoareV {O{c} m m m O{}}{ {\begin{aligned}[#1] &\anglebracket{#2} \\ &\quad{#3} \\ &{\anglebracket{#4}}_{#5} \end{aligned}}% } \NewDocumentCommand \ahoareHV {O{c} m m m O{}}{ {\begin{aligned}[#1] &\anglebracket{#2}\; {#3} \\ &{\anglebracket{#4}}_{#5} \end{aligned}}% } %% Some commonly used identifiers \newcommand{\inhabited}[1]{\textlog{inhabited}(#1)} \newcommand{\infinite}{\textlog{infinite}} \newcommand{\timeless}[1]{\textlog{timeless}(#1)} \newcommand{\persistent}[1]{\textlog{persistent}(#1)} \newcommand\InvName{\textdom{InvName}} \newcommand\GName{\textdom{GName}} \newcommand{\Prop}{\textdom{iProp}} \newcommand{\Pred}{\textdom{Pred}} \newcommand{\TRUE}{\textlog{True}} \newcommand{\FALSE}{\textlog{False}} \newcommand{\EMP}{\textlog{Emp}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % GENERIC LANGUAGE SYNTAX AND SEMANTICS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newcommand{\expr}{e} \newcommand{\val}{v} \newcommand{\valB}{w} \newcommand{\state}{\sigma} \newcommand{\step}[1][]{\xrightarrow{{#1}}_{\textlog{t}}} \newcommand{\hstep}[1][]{\xrightarrow{{#1}}_{\textlog{h}}} \newcommand{\tpstep}[1][]{\xrightarrow{{#1}}_{\textlog{tp}}} \newcommand{\tpsteps}[1][]{\xrightarrow{{#1}}\mathrel{\vphantom{\to}^{*}_{\textlog{tp}}}} \newcommand{\lctx}{K} \newcommand{\Lctx}{\textdom{Ctx}} \newcommand{\obs}{\kappa} \newcommand{\State}{\kern-0.05em\textdom{State}} \newcommand{\Val}{\kern-0.2em\textdom{Val}} \newcommand{\Loc}{\kern-0.05em\textdom{Loc}} \newcommand{\Expr}{\kern-0.05em\textdom{Expr}} \newcommand{\Var}{\kern-0.2em\textdom{Var}} \newcommand{\Obs}{\kern-0.1em\textdom{Obs}} \newcommand{\ThreadPool}{\kern-0.05em\textdom{ThreadPool}} \newcommand{\toval}{\textlog{expr\any to\any val}} \newcommand{\ofval}{\textlog{val\any to\any expr}} \newcommand{\atomic}{\textlog{atomic}} \newcommand{\stronglyAtomic}{\textlog{strongly\any{}atomic}} \newcommand{\red}{\textlog{red}} \newcommand{\Lang}{\Lambda} \newcommand{\tpool}{T} \newcommand{\cfg}[2]{{#1};{#2}} \def\fillctx#1[#2]{#1 {[}\, #2\,{]} } %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % STANDARD DERIVED CONSTRUCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newcommand{\unittt}{()} \newcommand{\unitty}{1} % Agreement \newcommand{\agm}{\ensuremath{\textdom{Ag}}} \newcommand{\aginj}{\textlog{ag}} % Fraction \newcommand{\fracm}{\ensuremath{\textdom{Frac}}} \newcommand{\fracinj}{\textlog{frac}} % Exclusive \newcommand{\exm}{\ensuremath{\textdom{Ex}}} \newcommand{\exinj}{\textlog{ex}} % Auth \newcommand{\authm}{\textdom{Auth}} \newcommand{\authinj}{\textlog{auth}} \newcommand{\authfull}{\mathord{\bullet}} \newcommand{\authfrag}{\mathord{\circ}} \newcommand{\AuthInv}{\textsf{AuthInv}} \newcommand{\Auth}{\textsf{Auth}} % Sum \newcommand{\csumm}{\mathrel{+_{\!\mundef}}} \newcommand{\cinl}{\textsf{inl}} \newcommand{\cinr}{\textsf{inr}} % STSs \newcommand{\STSCtx}{\textlog{StsCtx}} \newcommand{\STSInv}{\textlog{StsInv}} \newcommand{\STSSt}{\textlog{StsSt}} \newcommand{\STSclsd}{\textlog{closed}} \newcommand{\STSauth}{\textlog{auth}} \newcommand{\STSfrag}{\textlog{frag}} \newcommand{\STSS}{\mathcal{S}} % states \newcommand{\STST}{\mathcal{T}} % tokens \newcommand{\STSL}{\mathcal{L}} % labels \newcommand{\stsstep}{\ra} \newcommand{\ststrans}{\ra^{*}}% the relation relevant to the STS rules \newcommand{\stsfstep}[1]{\xrightarrow{#1}} \newcommand{\stsftrans}[1]{\stsfstep{#1}^{*}} \newcommand{\stsinterp}{\varphi} \tikzstyle{sts_state} = [rectangle, rounded corners, draw, minimum size=1.2cm, align=center] \tikzstyle{sts_arrows} = [->,arrows={->[scale=1.5]},every node/.style={font=\sffamily\small}] %% Stored Propositions \newcommand{\mapstoprop}{\mathrel{\kern-0.5ex\tikz[baseline=(m)]{\node at (0,0) (m){}; \draw[line cap=round] (0,0.16) -- (0,-0.004);}\kern-1.5ex\Ra}} %% Cancellable invariants \newcommand\CInv[3]{\textlog{CInv}^{#1,#2}(#3)} \newcommand*\CInvTok[2]{{[}\textlog{CInv}:#1{]}_{#2}} %% Non-atomic invariants \newcommand*\pid{p} \newcommand\NaInv[3]{\textlog{NaInv}^{#1.#2}(#3)} \newcommand*\NaTok[1]{{[}\textlog{NaInv}:#1{]}} \newcommand*\NaTokE[2]{{[}\textlog{NaInv}:#1.#2{]}} %% Boxes \newcommand*\sname{\iota} \newcommand*\BoxState{\textdom{BoxState}} \newcommand*\BoxFull{\textlog{full}} \newcommand*\BoxEmp{\textlog{empty}} \newcommand*\BoxSlice[3]{\textlog{BoxSlice}(#1, #2, #3)} \newcommand*\ABox[3]{\textlog{Box}(#1, #2, #3)} \endinput iris-iris-4.2.0/tex/iris.tex000066400000000000000000000035331460620107300157220ustar00rootroot00000000000000\documentclass[10pt]{article} \usepackage{lmodern} \usepackage[T1]{fontenc} \usepackage[utf8]{inputenc} \usepackage[english]{babel} \usepackage[babel=true]{microtype} \usepackage{geometry} \usepackage[backend=biber]{biblatex} \bibliography{bib} \input{setup} \title{\bfseries The Iris 4.2 Reference} \author{\url{https://iris-project.org/}} \begin{document} \maketitle \thispagestyle{empty} \vfill \begin{abstract} This document formally describes the Iris program logic. Every result in this document has been fully verified in Coq. The latest versions of this document and the Coq formalization can be found in the git repository at \url{https://gitlab.mpi-sws.org/iris/iris}. For further information, visit the Iris project website at \url{https://iris-project.org}. \end{abstract} \clearpage\begingroup \tableofcontents \endgroup \clearpage\begingroup \section{Iris from the Ground Up} In \citetitle{iris-ground-up}~\cite{iris-ground-up}, we describe Iris~3.1 in a bottom-up way. That paper is hence much more suited as an introduction to the model of Iris than this reference, which mostly contains definitions, not explanations or examples. For a list of changes in Iris since then, please consult our changelog at \url{https://gitlab.mpi-sws.org/iris/iris/blob/master/CHANGELOG.md}. \endgroup \clearpage\begingroup \input{algebra} \endgroup \clearpage\begingroup \input{constructions} \endgroup \clearpage\begingroup \input{base-logic} \endgroup \clearpage\begingroup \input{model} \endgroup \clearpage\begingroup \input{extended-logic} \endgroup \clearpage\begingroup \input{language} \endgroup \clearpage\begingroup \input{program-logic} \endgroup \clearpage\begingroup \input{derived} \endgroup \clearpage\begingroup \input{paradoxes} \endgroup \clearpage\begingroup \input{heaplang} \endgroup \clearpage\begingroup \printbibliography \endgroup \end{document} iris-iris-4.2.0/tex/language.tex000066400000000000000000000103701460620107300165340ustar00rootroot00000000000000\section{Language} \label{sec:language} A \emph{language} $\Lang$ consists of a set \Expr{} of \emph{expressions} (metavariable $\expr$), a set \Val{} of \emph{values} (metavariable $\val$), a set $\Obs$ of \emph{observations}\footnote{See \url{https://gitlab.mpi-sws.org/iris/iris/merge_requests/173} for how observations are useful to encode prophecy variables.} (or ``observable events'') and a set $\State$ of \emph{states} (metavariable $\state$) such that \begin{itemize}[itemsep=0pt] \item There exist functions $\ofval : \Val \to \Expr$ and $\toval : \Expr \pfn \Val$ (notice the latter is partial), such that \begin{mathpar} {\All \expr, \val. \toval(\expr) = \val \Ra \ofval(\val) = \expr} \and {\All\val. \toval(\ofval(\val)) = \val} \end{mathpar} \item There exists a \emph{primitive reduction relation} \[(-,- \;\step[-]\; -,-,-) \subseteq (\Expr \times \State) \times \List(\Obs) \times (\Expr \times \State \times \List(\Expr))\] A reduction $\expr_1, \state_1 \step[\vec\obs] \expr_2, \state_2, \vec\expr$ indicates that, when $\expr_1$ in state $\state_1$ reduces to $\expr_2$ with new state $\state_2$, the new threads in the list $\vec\expr$ is forked off and the observations $\vec\obs$ are made. We will write $\expr_1, \state_1 \step \expr_2, \state_2$ for $\expr_1, \state_1 \step[()] \expr_2, \state_2, ()$, \ie when no threads are forked off and no observations are made. \\ \item All values are stuck: \[ \expr, \_ \step \_, \_, \_ \Ra \toval(\expr) = \bot \] \end{itemize} \begin{defn} An expression $\expr$ and state $\state$ are \emph{reducible} (written $\red(\expr, \state)$) if \[ \Exists \vec\obs, \expr_2, \state_2, \vec\expr. \expr,\state \step[\vec\obs] \expr_2,\state_2,\vec\expr \] \end{defn} \begin{defn} An expression $\expr$ is \emph{weakly atomic} if it reduces in one step to something irreducible: \[ \atomic(\expr) \eqdef \All\state_1, \vec\obs, \expr_2, \state_2, \vec\expr. \expr, \state_1 \step[\vec\obs] \expr_2, \state_2, \vec\expr \Ra \lnot \red(\expr_2, \state_2) \] It is \emph{strongly atomic} if it reduces in one step to a value: \[ \stronglyAtomic(\expr) \eqdef \All\state_1, \vec\obs, \expr_2, \state_2, \vec\expr. \expr, \state_1 \step[\vec\obs] \expr_2, \state_2, \vec\expr \Ra \toval(\expr_2) \neq \bot \] \end{defn} We need two notions of atomicity to accommodate both kinds of weakest preconditions that we will define later: If the weakest precondition ensures that the program cannot get stuck, weak atomicity is sufficient. Otherwise, we need strong atomicity. \begin{defn}[Context] A function $\lctx : \Expr \to \Expr$ is a \emph{context} if the following conditions are satisfied: \begin{enumerate}[itemsep=0pt] \item $\lctx$ does not turn non-values into values:\\ $$\All\expr. \toval(\expr) = \bot \Ra \toval(\lctx(\expr)) = \bot $$ \item One can perform reductions below $\lctx$:\\ $$\All \expr_1, \state_1, \vec\obs, \expr_2, \state_2, \vec\expr. \expr_1, \state_1 \step[\vec\obs] \expr_2,\state_2,\vec\expr \Ra \lctx(\expr_1), \state_1 \step[\vec\obs] \lctx(\expr_2),\state_2,\vec\expr $$ \item Reductions stay below $\lctx$ until there is a value in the hole:\\ \begin{align*} &\All \expr_1', \state_1, \vec\obs, \expr_2, \state_2, \vec\expr. \toval(\expr_1') = \bot \land \lctx(\expr_1'), \state_1 \step[\vec\obs] \expr_2,\state_2,\vec\expr \Ra {}\\ &\qquad \Exists\expr_2'. \expr_2 = \lctx(\expr_2') \land \expr_1', \state_1 \step[\vec\obs] \expr_2',\state_2,\vec\expr \end{align*} \end{enumerate} \end{defn} \subsection{Concurrent Language} \label{sec:language:concurrent} For any language $\Lang$, we define the corresponding thread-pool semantics. \paragraph{Machine syntax} \[ \tpool \in \ThreadPool \eqdef \List(\Expr) \] \judgment[Machine reduction]{\cfg{\tpool}{\state} \tpstep[\vec\obs] \cfg{\tpool'}{\state'}} \begin{mathpar} \infer {\expr_1, \state_1 \step[\vec\obs] \expr_2, \state_2, \vec\expr} {\cfg{\tpool \dplus [\expr_1] \dplus \tpool'}{\state_1} \tpstep[\vec\obs] \cfg{\tpool \dplus [\expr_2] \dplus \tpool' \dplus \vec\expr}{\state_2}} \end{mathpar} We use $\tpsteps[-]$ for the reflexive transitive closure of $\tpstep[-]$, as usual concatenating the lists of observations of the individual steps. %%% Local Variables: %%% mode: latex %%% TeX-master: "iris" %%% End: iris-iris-4.2.0/tex/listproc.sty000066400000000000000000000241501460620107300166300ustar00rootroot00000000000000%% %% This is file `listproc.sty', %% generated with the docstrip utility. %% %% The original source files were: %% %% listproc.dtx (with options: `package') %% %% Copyright (C) 2011 by Jesse A. Tov %% %% This file may be distributed and/or modified under the conditions of the %% LaTeX Project Public License, either version 1.2 of this license or (at %% your option) any later version. The latest version of this license is %% in: %% %% http://www.latex-project.org/lppl.txt %% %% and version 1.2 or later is part of all distributions of LaTeX %% version 1999/12/01 or later. %% \NeedsTeXFormat{LaTeX2e}[1999/12/01] \ProvidesPackage{listproc}[2011/03/26 v0.1 (list processing)] \newcommand\newlist{\@lstp@def{}\newcommand} \newcommand\renewlist{\@lstp@def{}\renewcommand} \newcommand\deflist{\@lstp@def{}\def} \newcommand\gdeflist{\@lstp@def\global\def} \newcommand\@lstp@def[4]{% #2#3{}% \@for\lstp@def@temp:=#4\do{% \eSnocTo\lstp@def@temp#3% }% #1\let#3#3% \let\lstp@def@temp\@undefined } \newtoks\lstp@ta \newtoks\lstp@tb \newcommand\ConsTo{\@lstp@ConsTo\relax\def} \newcommand\gConsTo{\@lstp@ConsTo\global\def} \newcommand\eConsTo{\@lstp@ConsTo\relax\edef} \newcommand\xConsTo{\@lstp@ConsTo\global\edef} \newcommand\@lstp@ConsTo[4]{% \long#2\lstp@temp{#3}% \lstp@ta=\expandafter{\expandafter\listitem\expandafter{\lstp@temp}}% \lstp@tb=\expandafter{#4}% #1\edef#4{\the\lstp@ta\the\lstp@tb}% } \newcommand\SnocTo{\@lstp@SnocTo\relax\def} \newcommand\gSnocTo{\@lstp@SnocTo\global\def} \newcommand\eSnocTo{\@lstp@SnocTo\relax\edef} \newcommand\xSnocTo{\@lstp@SnocTo\global\edef} \newcommand\@lstp@SnocTo[4]{% \long#2\lstp@temp{#3}% \lstp@ta=\expandafter{\expandafter\listitem\expandafter{\lstp@temp}}% \lstp@tb=\expandafter{#4}% #1\edef#4{\the\lstp@tb\the\lstp@ta}% } \newcommand\AppendTo{\@lstp@AppendTo\relax} \newcommand\gAppendTo{\@lstp@AppendTo\global} \newcommand\@lstp@AppendTo[3]{% \lstp@ta=\expandafter{#2}% \lstp@tb=\expandafter{#3}% #1\edef#3{\the\lstp@ta\the\lstp@tb}% } \long\def\@LopOff\listitem#1#2\@LopOff#3#4{% #3{#1}% #4{#2}% } \newcommand\@lstp@LopTo[4]{\expandafter\@LopOff#3\@LopOff{#1\def#4}{#2\def#3}} \newcommand\@lstp@RestTo[3]{\expandafter\@LopOff#2\@LopOff{\@gobble}{#1\def#3}} \newcommand\LopTo{\@lstp@LopTo\relax\relax} \newcommand\gLopTo{\@lstp@LopTo\global\global} \newcommand\glLopTo{\@lstp@LopTo\global\relax} \newcommand\lgLopTo{\@lstp@LopTo\relax\global} \newcommand\FirstTo{\@lstp@LopTo\relax\@gobblethree} \newcommand\gFirstTo{\@lstp@LopTo\global\@gobblethree} \newcommand\RestTo{\@lstp@RestTo\relax} \newcommand\gRestTo{\@lstp@RestTo\global} \newcommand*\IfList[1]{% {% \expandafter\@IfList#1\@IfList }% } \def\@IfList#1#2\@IfList{% \ifx\listitem#1\relax \aftergroup\@firstoftwo \else \aftergroup\@secondoftwo \fi } \def\@forList#1:=#2\do#3{% \long\def\lstp@for@listitem##1{% \long\def#1{##1}% #3% \let\listitem\lstp@for@listitem% }% \let\listitem\lstp@for@listitem% #2% \let\listitem\@undefined% } \newcommand\SetToListLength[2]{% \lstp@length{#2}{\value{#1}}% } \newcommand\lstp@length[2]{% #2=0 % \long\def\listitem##1{\advance#2 by1 }% #1\let\listitem\@undefined% } \newcommand\MapListTo{\@lstp@MapListTo\relax} \newcommand\gMapListTo{\@lstp@MapListTo\global} \newcommand\MapAndAppendTo{\@lstp@MapAndAppendTo\relax} \newcommand\gMapAndAppendTo{\@lstp@MapAndAppendTo\global} \newcommand\@lstp@MapListTo[4]{% \let\lstp@map@temp#3% #1\let#4\empty% \@lstp@MapAndAppendTo{#1}{#2}\lstp@map@temp#4% \let\lstp@map@temp\@undefined% } \newcommand\@lstp@MapAndAppendTo[4]{% \long\def\listitem##1{\@lstp@SnocTo{#1}\def{#2}{#4}}% #3% \let\listitem\@undefined% } \newcommand\lstp@insert[3]{% \edef\lstp@insert@temp@a{#2{#1}}% \let\lstp@insert@temp@i#3% \let#3\empty \long\def\lstp@insert@listitem##1{% \edef\lstp@insert@temp@b{#2{##1}}% \ifnum\lstp@insert@temp@a<\lstp@insert@temp@b \SnocTo{#1}{#3}% \let\listitem\lstp@insert@listitem@done \else \let\listitem\lstp@insert@listitem \fi \SnocTo{##1}{#3}% }% \long\def\lstp@insert@listitem@done##1{\SnocTo{##1}{#3}}% \let\listitem\lstp@insert@listitem \lstp@insert@temp@i% \ifx\listitem\lstp@insert@listitem% \SnocTo{#1}{#3}% \fi% \let\lstp@insert@temp@i\@undefined% \let\listitem\@undefined% } \providecommand\@apply@group[2]{#1#2} \newcommand\SortList[2][\@apply@group{}]{% \let\lstp@sort@temp@i#2% \let#2\empty \long\def\lstp@sort@listitem##1{% \lstp@insert{##1}{#1}{#2}% \let\listitem\lstp@sort@listitem }% \let\listitem\lstp@sort@listitem \lstp@sort@temp@i \let\lstp@sort@temp@i\@undefined \let\listitem\@undefined } \newcounter{lstp@ifsucc} \newcommand\lstp@ifsucc[2]{% \setcounter{lstp@ifsucc}{#1}% \addtocounter{lstp@ifsucc}{1}% \ifnum#2=\value{lstp@ifsucc}% \let\@lstp@ifsucc@kont\@firstoftwo \else \let\@lstp@ifsucc@kont\@secondoftwo \fi \@lstp@ifsucc@kont } \newcommand\CompressList[2][\@apply@group{}]{% \let\lstp@compress@temp@i#2% \let#2\empty \def\lstp@compress@add@single{% \expandafter\SnocTo\expandafter {\expandafter\@single\expandafter{\lstp@compress@temp@a}}{#2}% }% \def\lstp@compress@add@range{% \expandafter\expandafter\expandafter\SnocTo \expandafter\expandafter\expandafter{% \expandafter\expandafter\expandafter\@range \expandafter\expandafter\expandafter{% \expandafter\lstp@compress@temp@a\expandafter}% \expandafter{\lstp@compress@temp@b}}#2% }% \long\def\lstp@compress@listitem@start##1{% \def\lstp@compress@temp@a{##1}% \edef\lstp@compress@temp@a@key{#1{##1}}% \let\listitem\lstp@compress@listitem@single }% \long\def\lstp@compress@listitem@single##1{% \def\lstp@compress@temp@b{##1}% \edef\lstp@compress@temp@b@key{#1{##1}}% \ifnum\lstp@compress@temp@a@key=\lstp@compress@temp@b@key \let\listitem\lstp@compress@listitem@single \else \lstp@ifsucc{\lstp@compress@temp@a@key}{\lstp@compress@temp@b@key} {\let\listitem\lstp@compress@listitem@range} {\lstp@compress@add@single \let\lstp@compress@temp@a\lstp@compress@temp@b \let\lstp@compress@temp@a@key\lstp@compress@temp@b@key \let\listitem\lstp@compress@listitem@single}% \fi }% \long\def\lstp@compress@listitem@range##1{% \def\lstp@compress@temp@c{##1}% \edef\lstp@compress@temp@c@key{#1{##1}}% \ifnum\lstp@compress@temp@b@key=\lstp@compress@temp@c@key \let\listitem\lstp@compress@listitem@range \else \lstp@ifsucc{\lstp@compress@temp@b@key}{\lstp@compress@temp@c@key} {% \let\lstp@compress@temp@b\lstp@compress@temp@c \let\lstp@compress@temp@b@key\lstp@compress@temp@c@key \let\listitem\lstp@compress@listitem@range } {% \lstp@compress@add@range \let\lstp@compress@temp@a\lstp@compress@temp@c \let\lstp@compress@temp@a@key\lstp@compress@temp@c@key \let\listitem\lstp@compress@listitem@single }% \fi }% \let\listitem\lstp@compress@listitem@start \lstp@compress@temp@i \ifx\listitem\lstp@compress@listitem@single \lstp@compress@add@single \else \ifx\listitem\lstp@compress@listitem@range \lstp@compress@add@range \fi \fi \let\lstp@compress@temp@a\@undefined \let\lstp@compress@temp@b\@undefined \let\lstp@compress@temp@c\@undefined \let\lstp@compress@temp@a@key\@undefined \let\lstp@compress@temp@b@key\@undefined \let\lstp@compress@temp@c@key\@undefined \let\lstp@compress@temp@i\@undefined \let\listitem\@undefined } \newcommand\FormatListSepTwo{ and } \newcommand\FormatListSepMore{, } \newcommand\FormatListSepLast{, and } \newcounter{lstp@FormatList@length} \newcounter{lstp@FormatList@posn} \newcommand\FormatList[4]{{% \deflist\lstp@FormatList@list{#4}% \SetToListLength{lstp@FormatList@length}\lstp@FormatList@list% \setcounter{lstp@FormatList@posn}{0}% \ifnum\value{lstp@FormatList@length}=1% #1% \else% #2% \fi% \def\listitem##1{% \addtocounter{lstp@FormatList@posn}{1}% \ifnum1<\value{lstp@FormatList@posn}% \ifnum2=\value{lstp@FormatList@length}% \FormatListSepTwo \else \ifnum\value{lstp@FormatList@length}=\value{lstp@FormatList@posn}% \FormatListSepLast \else \FormatListSepMore \fi \fi \fi #3{##1}% }% \lstp@FormatList@list }} \newcommand\ListExpr[1]{\@lstp@ListExpr{#1}\relax} \newcommand\ListExprTo[2]{\@lstp@ListExpr{#1}{\def#2}} \newcommand\gListExprTo[2]{\@lstp@ListExpr{#1}{\gdef#2}} \newcommand\@lstp@defbinop[2]{% \newcommand#1[2]{% \Eval{##1}\let\@lstp@tmp\@lstp@acc {\Eval{##2}}% #2\@lstp@tmp\@lstp@acc }% } \newcommand\@lstp@defunop[2]{% \newcommand#1[1]{% \Eval{##1}% #2\@lstp@acc\@lstp@acc }% } \newcommand\@lstp@definplaceunopopt[3][]{% \newcommand#2[2][#1]{% \Eval{##2}% #3[##1]\@lstp@acc \global\let\@lstp@acc\@lstp@acc }% } \newcommand\@lstp@ListExpr[2]{% {% \gdef\@lstp@acc{}% \def\Eval##1{% \IfList{##1}{% \global\let\@lstp@acc##1% }{% \@lstp@ifListOp##1\@lstp@ifListOp{% ##1% }{% \xdef\@lstp@acc{##1}% }% }% }% \def\Q##1{\gdef\@lstp@acc{##1}}% \def\Nil{\global\let\@lstp@acc\empty}% \def\List##1{\gdeflist\@lstp@acc{##1}}% \@lstp@defbinop\Cons\xConsTo \@lstp@defbinop\Snoc\xSnocTo \@lstp@defunop\First\gFirstTo \@lstp@defunop\Rest\gRestTo \@lstp@defbinop\Append\gAppendTo \@lstp@definplaceunopopt[\@apply@group{}]\Sort\SortList \@lstp@definplaceunopopt[\@apply@group{}]\Compress\CompressList \newcommand\Map[2]{% \Eval{##2}% \gMapListTo{##1}\@lstp@acc\@lstp@acc }% \Eval{#1}% }% \def\@lstp@finish##1{#2{##1}}% \expandafter\@lstp@finish\expandafter{\@lstp@acc}% } \def\@lstp@ifListOp#1#2\@lstp@ifListOp{% \@lstp@ifInToks#1{ \Q\Nil\List\Cons\Snoc\Append \First\Rest\Sort\Compress\Map } } \newcommand\@lstp@ifInToks[2]{% {% \def\@tester##1#1##2\@tester{% \ifx\@notfound##2\relax \aftergroup\@secondoftwo \else \aftergroup\@firstoftwo \fi }% \@tester#2\@lstp@ifInToks#1\@notfound\@tester }% } \endinput %% %% End of file `listproc.sty'. iris-iris-4.2.0/tex/locallabel.sty000066400000000000000000000104651460620107300170670ustar00rootroot00000000000000% Locallabel % % Copyright (C) 2001, 2002, 2003 Didier Rmy % % Author : Didier Remy % Version : 1.1.1 % Bug Reports : to author % Web Site : http://pauillac.inria.fr/~remy/latex/ % % Locallabel is free software; you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by % the Free Software Foundation; either version 2, or (at your option) % any later version. % % Locallabel is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details % (http://pauillac.inria.fr/~remy/license/GPL). % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % File locallabel.sty (LaTeX macros) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% Identification \NeedsTeXFormat{LaTeX2e} \ProvidesPackage{locallabel} [2001/23/02 v0.92 Locallabel] %% Preliminary declarations %% Options %% More declarations %% We use two counters: The global counter is incremented at each reset. %% Its value is the ``group'' of a local. %% The local counter is the last numeric value of a bound label in the %% current group. The value of a label #1 is globally set to %% \csname llb@\the\c@llb@global-#1\endcsname %% The global command \csname llb@\the\c@llb@global-#1*\endcsname is %% use to ensure that a label is only bound once. Usually a label is %% bound and declared at the same time with \llabel. It may also be bound in %% advance, with \lbind, for instance so as to control the numbering. %% Then, another \llabel must be used to declare it in the text. %% If no \lbind has been used before, the \llabel calls \lbind implicitlt. \newcounter{llb@global} \newcounter{llb@local} \newcommand \llb@find [1] {\expandafter \ifx \csname llb@\the\c@llb@global-#1\endcsname \relax \message {*** Local label #1 undefined in this context}% \edef \llb@current {#1??}% \else \edef \llb@current {\csname llb@\the\c@llb@global-#1\endcsname}% \fi} \newcommand \llb@make [1] {\expandafter \ifx \csname llb@\the\c@llb@global-#1\endcsname \relax \stepcounter{llb@local}\relax \expandafter \xdef \csname llb@\the\c@llb@global-#1\endcsname {\the\c@llb@local}% \edef \llb@current {\the\c@llb@local}% \else \expandafter \ifx \csname llb@\the\c@llb@global-#1*\endcsname \relax \message {*** Local label #1 already defined in this countext!}% \edef \llb@current {\csname llb@\the\c@llb@global-#1\endcsname ??}% \else \expandafter \global \expandafter \let \csname llb@\the\c@llb@global-#1*\endcsname \relax \edef \llb@current {\csname llb@\the\c@llb@global-#1\endcsname} \fi \fi } %%% Redefine those macros to change typsetting \newcommand \thelocallabel {\the \c@llb@local} \newcommand \LlabelTypeset [1] {(\textrm {\bfseries #1})} \newcommand \LrefTypeset [1] {(\textrm {#1)}} \newcommand \glabel [1]{\LlabelTypeset{\softtarget {#1}{#1}}} \newcommand \gref [1]{\LrefTypeset{\softlink {#1}{#1}}} %%% To reset all local labels---which just increment a global prefix. \newcommand \locallabelreset[1][0]% {\stepcounter {llb@global}\setcounter {llb@local}{#1}} %%% Make a new local label, typeset it, and bind to the given name \def \llb@relax {\relax} \newcommand {\llabel}[2][\relax]% {\llb@make{#2}% \def \@test {#1}\ifx \@test\llb@relax\else \edef \@currentlabel {\the\c@llb@local}% \def \@test {#1}\ifx \@test\empty \def \@test{#2}\fi \label{\@test}% \fi% \LlabelTypeset {\softtarget{llb@\the\c@llb@global-#2}{\llb@current}}} %%% Retreive the local label of given name and type set it. \newcommand \lref [1] {\llb@find {#1}% \LrefTypeset {\softlink {llb@\the\c@llb@global-#1}{\llb@current}}} %%% Make a new local label and bind it to the given name but do not typeset %%% it. Typesetting may then be done with \llabel non locally. Useful to %%% control the order of numberring. \newcommand \lbind [1] {\llb@make {#1}% \expandafter \global \expandafter \let \csname llb@\the\c@llb@global-#1*\endcsname \empty} \AtBeginDocument {% \@ifundefined{softlink}{\let \softlink \@secondoftwo}{}% \@ifundefined{softtarget}{\let \softtarget \@secondoftwo}{}% } iris-iris-4.2.0/tex/model.tex000066400000000000000000000176231460620107300160610ustar00rootroot00000000000000\section{Model and Semantics} \label{sec:model} The semantics closely follows the ideas laid out in~\cite{catlogic}. \paragraph{Semantic domains.} The semantic domains are interpreted as follows: \[ \begin{array}[t]{@{}l@{\ }c@{\ }l@{}} \Sem{\Prop} &\eqdef& \UPred(\monoid) \\ \Sem{\textlog{M}} &\eqdef& \monoid \\ \Sem{0} &\eqdef& \Delta \emptyset \\ \Sem{1} &\eqdef& \Delta \{ () \} \end{array} \qquad\qquad \begin{array}[t]{@{}l@{\ }c@{\ }l@{}} \Sem{\type + \type'} &\eqdef& \Sem{\type} + \Sem{\type'} \\ \Sem{\type \times \type'} &\eqdef& \Sem{\type} \times \Sem{\type'} \\ \Sem{\type \to \type'} &\eqdef& \Sem{\type} \nfn \Sem{\type'} \\ \end{array} \] For the remaining base types $\type$ defined by the signature $\Sig$, we pick an object $X_\type$ in $\OFEs$ and define \[ \Sem{\type} \eqdef X_\type \] For each function symbol $\sigfn : \type_1, \dots, \type_n \to \type_{n+1} \in \SigFn$, we pick a function $\Sem{\sigfn} : \Sem{\type_1} \times \dots \times \Sem{\type_n} \nfn \Sem{\type_{n+1}}$. \judgment[Interpretation of propositions.]{\Sem{\vctx \proves \term : \Prop} : \Sem{\vctx} \nfn \UPred(\monoid)} Remember that $\UPred(\monoid)$ is isomorphic to $\monoid \monra \SProp$. We are thus going to define the propositions as mapping camera elements to sets of step-indices. \begin{align*} \Sem{\vctx \proves t =_\type u : \Prop}_\venv &\eqdef \Lam \any. \setComp{n}{\Sem{\vctx \proves t : \type}_\venv \nequiv{n} \Sem{\vctx \proves u : \type}_\venv} \\ \Sem{\vctx \proves \FALSE : \Prop}_\venv &\eqdef \Lam \any. \emptyset \\ \Sem{\vctx \proves \TRUE : \Prop}_\venv &\eqdef \Lam \any. \nat \\ \Sem{\vctx \proves \prop \land \propB : \Prop}_\venv &\eqdef \Lam \melt. \Sem{\vctx \proves \prop : \Prop}_\venv(\melt) \cap \Sem{\vctx \proves \propB : \Prop}_\venv(\melt) \\ \Sem{\vctx \proves \prop \lor \propB : \Prop}_\venv &\eqdef \Lam \melt. \Sem{\vctx \proves \prop : \Prop}_\venv(\melt) \cup \Sem{\vctx \proves \propB : \Prop}_\venv(\melt) \\ \Sem{\vctx \proves \prop \Ra \propB : \Prop}_\venv &\eqdef \Lam \melt. \setComp{n}{\begin{aligned} \All m, \meltB.& m \leq n \land \melt \mincl \meltB \land m \in \mval(\meltB) \Ra {} \\ & m \in \Sem{\vctx \proves \prop : \Prop}_\venv(\meltB) \Ra {}\\& m \in \Sem{\vctx \proves \propB : \Prop}_\venv(\meltB)\end{aligned}}\\ \Sem{\vctx \proves \All \var : \type. \prop : \Prop}_\venv &\eqdef \Lam \melt. \setComp{n}{ \All v \in \Sem{\type}. n \in \Sem{\vctx, \var : \type \proves \prop : \Prop}_{\mapinsert \var v \venv}(\melt) } \\ \Sem{\vctx \proves \Exists \var : \type. \prop : \Prop}_\venv &\eqdef \Lam \melt. \setComp{n}{ \Exists v \in \Sem{\type}. n \in \Sem{\vctx, \var : \type \proves \prop : \Prop}_{\mapinsert \var v \venv}(\melt) } \end{align*} \begin{align*} \Sem{\vctx \proves \prop * \propB : \Prop}_\venv &\eqdef \Lam\melt. \setComp{n}{\begin{aligned}\Exists \meltB_1, \meltB_2. &\melt \nequiv{n} \meltB_1 \mtimes \meltB_2 \land {}\\& n \in \Sem{\vctx \proves \prop : \Prop}_\venv(\meltB_1) \land n \in \Sem{\vctx \proves \propB : \Prop}_\venv(\meltB_2)\end{aligned}} \\ \Sem{\vctx \proves \prop \wand \propB : \Prop}_\venv &\eqdef \Lam \melt. \setComp{n}{\begin{aligned} \All m, \meltB.& m \leq n \land m \in \mval(\melt\mtimes\meltB) \Ra {} \\ & m \in \Sem{\vctx \proves \prop : \Prop}_\venv(\meltB) \Ra {}\\& m \in \Sem{\vctx \proves \propB : \Prop}_\venv(\melt\mtimes\meltB)\end{aligned}} \\ \Sem{\vctx \proves \ownM{\term} : \Prop}_\venv &\eqdef \Lam\meltB. \setComp{n}{\Sem{\vctx \proves \term : \textlog{M}}_\venv \mincl[n] \meltB} \\ \Sem{\vctx \proves \mval(\term) : \Prop}_\venv &\eqdef \Lam\any. \mval(\Sem{\vctx \proves \term : \textlog{M}}_\venv) \\ \Sem{\vctx \proves \always{\prop} : \Prop}_\venv &\eqdef \Lam\melt. \Sem{\vctx \proves \prop : \Prop}_\venv(\mcore\melt) \\ \Sem{\vctx \proves \plainly{\prop} : \Prop}_\venv &\eqdef \Lam\melt. \Sem{\vctx \proves \prop : \Prop}_\venv(\munit) \\ \Sem{\vctx \proves \later{\prop} : \Prop}_\venv &\eqdef \Lam\melt. \setComp{n}{n = 0 \lor n-1 \in \Sem{\vctx \proves \prop : \Prop}_\venv(\melt)}\\ \Sem{\vctx \proves \upd\prop : \Prop}_\venv &\eqdef \Lam\melt. \setComp{n}{\begin{aligned} \All m, \melt'. & m \leq n \land m \in \mval(\melt \mtimes \melt') \Ra {}\\& \Exists \meltB. m \in \mval(\meltB \mtimes \melt') \land m \in \Sem{\vctx \proves \prop :\Prop}_\venv(\meltB) \end{aligned} } \end{align*} For every definition, we have to show all the side-conditions: The maps have to be non-expansive and monotone. \judgment[Interpretation of non-propositional terms]{\Sem{\vctx \proves \term : \type} : \Sem{\vctx} \nfn \Sem{\type}} \begin{align*} \Sem{\vctx \proves x : \type}_\venv &\eqdef \venv(x) \\ \Sem{\vctx \proves \sigfn(\term_1, \dots, \term_n) : \type_{n+1}}_\venv &\eqdef \Sem{\sigfn}(\Sem{\vctx \proves \term_1 : \type_1}_\venv, \dots, \Sem{\vctx \proves \term_n : \type_n}_\venv) \\ \Sem{\vctx \proves \Lam \var:\type. \term : \type \to \type'}_\venv &\eqdef \Lam \termB : \Sem{\type}. \Sem{\vctx, \var : \type \proves \term : \type}_{\mapinsert \var \termB \venv} \\ \Sem{\vctx \proves \term(\termB) : \type'}_\venv &\eqdef \Sem{\vctx \proves \term : \type \to \type'}_\venv(\Sem{\vctx \proves \termB : \type}_\venv) \\ \Sem{\vctx \proves \MU \var:\type. \term : \type}_\venv &\eqdef \fixp_{\Sem{\type}}(\Lam \termB : \Sem{\type}. \Sem{\vctx, x : \type \proves \term : \type}_{\mapinsert \var \termB \venv}) \\ ~\\ \Sem{\vctx \proves \textlog{abort}\;\term : \type}_\venv &\eqdef \mathit{abort}_{\Sem\type}(\Sem{\vctx \proves \term:0}_\venv) \\ \Sem{\vctx \proves () : 1}_\venv &\eqdef () \\ \Sem{\vctx \proves (\term_1, \term_2) : \type_1 \times \type_2}_\venv &\eqdef (\Sem{\vctx \proves \term_1 : \type_1}_\venv, \Sem{\vctx \proves \term_2 : \type_2}_\venv) \\ \Sem{\vctx \proves \pi_i\; \term : \type_i}_\venv &\eqdef \pi_i(\Sem{\vctx \proves \term : \type_1 \times \type_2}_\venv) \\ \Sem{\vctx \proves \textlog{inj}_i\;\term : \type_1 + \type_2}_\venv &\eqdef \mathit{inj}_i(\Sem{\vctx \proves \term : \type_i}_\venv) \\ \Sem{\vctx \proves \textlog{match}\; \term \;\textlog{with}\; \Ret\textlog{inj}_1\; \var_1. \term_1 \mid \Ret\textlog{inj}_2\; \var_2. \term_2 \;\textlog{end} : \type }_\venv &\eqdef \Sem{\vctx, \var_i:\type_i \proves \term_i : \type}_{\mapinsert{\var_i}\termB \venv} \\ &\qquad \text{where $\Sem{\vctx \proves \term : \type_1 + \type_2}_\venv = \mathit{inj}_i(\termB)$} \\ ~\\ \Sem{ \melt : \textlog{M} }_\venv &\eqdef \melt \\ \Sem{\vctx \proves \mcore\term : \textlog{M}}_\venv &\eqdef \mcore{\Sem{\vctx \proves \term : \textlog{M}}_\venv} \\ \Sem{\vctx \proves \term \mtimes \termB : \textlog{M}}_\venv &\eqdef \Sem{\vctx \proves \term : \textlog{M}}_\venv \mtimes \Sem{\vctx \proves \termB : \textlog{M}}_\venv \end{align*} % An environment $\vctx$ is interpreted as the set of finite partial functions $\rho$, with $\dom(\rho) = \dom(\vctx)$ and $\rho(x)\in\Sem{\vctx(x)}$. Above, $\fixp$ is Banach's fixed-point (see \thmref{thm:banach}), and $\mathit{abort}_T$ is the unique function $\emptyset \to T$. \paragraph{Logical entailment.} We can now define \emph{semantic} logical entailment. \typedsection{Interpretation of entailment}{\Sem{\vctx \mid \pfctx \proves \prop} : \mProp} \[ \Sem{\vctx \mid \prop \proves \propB} \eqdef \begin{aligned}[t] \MoveEqLeft \forall n \in \nat.\; \forall \rs \in \monoid.\; \forall \venv \in \Sem{\vctx},\; \\& n \in \mval(\rs) \land n \in \Sem{\vctx \proves \prop : \Prop}_\venv(\rs) \Ra n \in \Sem{\vctx \proves \propB : \Prop}_\venv(\rs) \end{aligned} \] The following soundness theorem connects syntactic and semantic entailment. It is proven by showing that all the syntactic proof rules of \Sref{sec:base-logic} can be validated in the model. \[ \vctx \mid \prop \proves \propB \Ra \Sem{\vctx \mid \prop \proves \propB} \] It now becomes straight-forward to show consistency of the logic. %%% Local Variables: %%% mode: latex %%% TeX-master: "iris" %%% End: iris-iris-4.2.0/tex/paradoxes.tex000066400000000000000000000342541460620107300167460ustar00rootroot00000000000000\section{Logical Paradoxes} \newcommand{\starttoken}{\textsc{s}} \newcommand{\finishtoken}{\textsc{f}} In this section we provide proofs of some logical inconsistencies that arise when slight changes are made to the Iris logic. \subsection{Saved Propositions without a Later} \label{sec:saved-prop-no-later} As a preparation for the proof about invariants in \Sref{app:section:invariants-without-a-later}, we show that omitting the later modality from a variant of \emph{saved propositions} leads to a contradiction. Saved propositions have been introduced in prior work~\cite{dodds:higher-order-sync,iris2} to prove correctness of synchronization primitives; we will explain all that is necessary here. The counterexample assumes a higher-order logic with separating conjunction, magic wand and the modalities $\always$ and $\upd$ satisfying the rules in \Sref{sec:base-logic}. \begin{thm} \label{thm:counterexample-1} If there exists a type $\GName$ and a proposition $\_ \Mapsto \_ : \GName \to \Prop \to \Prop$ associating names $\gamma : \GName$ to propositions and satisfying: \begin{align} \proves{}& \upd \Exists \gname : \GName. \gname \Mapsto P(\gname) \tagH{sprop-alloc} \\ \gname \Mapsto P \proves{}& \always (\gname \Mapsto P) \tagH{sprop-persist} \\ \gname \Mapsto \prop * \gname \Mapsto \propB \proves{} & \prop \Lra \propB \tagH{sprop-agree} \end{align} then $\proves\upd \FALSE$. \end{thm} The type $\GName$ should be thought of as the type of ``locations'' and $\gname \Mapsto P$ should be read as stating that location $\gname$ ``stores'' proposition $P$. Notice that these are immutable locations, so the maps-to proposition is persistent. The rule \ruleref{sprop-alloc} is then thought of as allocation, and the rule \ruleref{sprop-agree} states that a given location $\gname$ can only store \emph{one} proposition, so multiple witnesses covering the same location must agree. %Compared to saved propositions in prior work, \ruleref{sprop-alloc} is stronger since the stored proposition can depend on the name being allocated. %\derek{Can't we cut the above sentence? This makes it sound like we are doing something weird that we ought not to be since prior work didn't do it. But in fact, I thought that in our construction we do not really need to rely on this feature at all! So I'm confused.} The conclusion of \ruleref{sprop-agree} usually is guarded by a $\later$. The point of this theorem is to show that said later is \emph{essential}, as removing it introduces inconsistency. % The key to proving \thmref{thm:counterexample-1} is the following proposition: \begin{defn} $A(\gname) \eqdef \Exists \prop : \Prop. \always\lnot \prop \land \gname \Mapsto \prop$. \end{defn} Intuitively, $A(\gname)$ says that the saved proposition named $\gname$ does \emph{not} hold, \ie we can disprove it. Using \ruleref{sprop-persist}, it is immediate that $A(\gname)$ is persistent. Now, by applying \ruleref{sprop-alloc} with $A$, we obtain a proof of $\prop \eqdef \gname \Mapsto A(\gname)$: this says that the proposition named $\gname$ is the proposition saying that it, itself, does not hold. In other words, $\prop$ says that the proposition named $\gname$ expresses its own negation. Unsurprisingly, that leads to a contradiction, as is shown in the following lemma: \begin{lem} \label{lem:saved-prop-counterexample-not-agname} We have $\gname \Mapsto A(\gname) \proves \always\lnot A(\gname)$ and $\gname \Mapsto A(\gname) \proves A(\gname)$. \end{lem} \begin{proof}%[\lemref{lem:saved-prop-counterexample-not-agname}] \leavevmode \begin{itemize} \item First we show $\gname \Mapsto A(\gname) \proves \always\lnot A(\gname)$. Since $\gname \Mapsto A(\gname)$ is persistent it suffices to show $\gname \Mapsto A(\gname) \proves \lnot A(\gname)$. Suppose $\gname \Mapsto A(\gname)$ and $A(\gname)$. Then by definition of \(A\) there is a $\prop$ such that $\always \lnot \prop$ and $\gname \Mapsto \prop$. By \ruleref{sprop-agree} we have $\prop \Lra A(\gname)$ and so from $\lnot \prop$ we get $\lnot A(\gname)$, which leads to a contradiction with $A(\gname)$. \item Using the first item we can now prove $\gname \Mapsto A(\gname) \proves A(\gname)$. We need to prove \begin{align*} \Exists \prop : \Prop. \always \lnot \prop \land \gname \Mapsto \prop. \end{align*} We do so by picking $\prop$ to be $A(\gname)$, which leaves us to prove \(\always \lnot A(\gname) \land \gname \Mapsto A(\gname)\). The last conjunct holds by assumption, and the first conjunct follows from the previous item of this lemma. \end{itemize} \end{proof} With this lemma in hand, the proof of \thmref{thm:counterexample-1} is simple. \begin{proof}[Proof of \thmref{thm:counterexample-1}] Using the previous lemmas we have \begin{align*} \proves \All \gname. \lnot (\gname \Mapsto A(\gname)). \end{align*} Together with the rule \ruleref{sprop-alloc} we thus derive $\upd \FALSE$. \end{proof} \subsection{Invariants without a Later} \label{app:section:invariants-without-a-later} Now we come to the main paradox: if we remove the $\later$ from \ruleref{inv-open}, the logic becomes inconsistent. The theorem is stated as general as possible so that it also applies to previous, less powerful versions of Iris. \begin{thm} \label{thm:counterexample-2} Assume a higher-order separation logic with $\always$ and an update modality with a binary mask ${\pvs}_{\set{0,1}}$ (think: empty mask and full mask) satisfying strong monad rules with respect to separating conjunction and such that: \begin{mathpar} \inferhref{weaken-mask}{eq:update-weaken-mask} {}{{\pvs}_0 \prop \proves {\pvs}_1 \prop} \end{mathpar} \noindent Assume a type $\InvName$ and a proposition $\knowInv{\cdot}{\cdot} : \InvName \to \Prop \to \Prop$ satisfying: % \begin{mathpar} \inferhref{inv-alloc}{eq:inv-alloc} {} {\prop \proves {\pvs}_1 \Exists \iname. \knowInv \iname \prop} \and \inferhref{inv-persist}{eq:inv-persistent} {} {\knowInv \iname \prop \proves \always \knowInv \iname \prop} \and \inferhref{inv-open-nolater}{eq:inv-open} {\prop * \propB \proves {\pvs}_0 (\prop * \propC) } {\knowInv \iname \prop * \propB \proves {\pvs}_1 \propC} \end{mathpar} \noindent Finally, assume the existence of a type $\GName$ and two tokens $\ownGhost{\cdot}{\starttoken} : \GName \to \Prop$ and $\ownGhost{\cdot}{\finishtoken}: \GName \to \Prop$ parameterized by $\GName$ and satisfying the following properties: \begin{mathpar} \inferhref{start-alloc}{eq:start-alloc} {}{\proves {\pvs}_0 \Exists \gname. \ownGhost \gname \starttoken} \and \inferhref{start-finish}{eq:start-finish} {}{\ownGhost \gname \starttoken \proves {\pvs}_0 \ownGhost \gname \finishtoken} \and \inferhref{start-not-finished}{eq:start-not-finished} {}{\ownGhost \gname \starttoken * \ownGhost \gname \finishtoken \proves \FALSE} \and \inferhref{finished-dup}{eq:finished-dup} {}{\ownGhost \gname \finishtoken \proves \ownGhost \gname \finishtoken * \ownGhost \gname \finishtoken} \end{mathpar} \noindent Then $\TRUE \proves{\pvs}_1 \FALSE$. \end{thm} The core of the proof is defining the $\Mapsto$ from the previous counterexample using invariants. Then, using the standard proof rules for invariants, we show that it satisfies \ruleref{sprop-alloc} and \ruleref{sprop-persist}. Furthermore, assuming the rule for opening invariants without a $\later$, we can prove a slightly weaker version of \ruleref{sprop-agree}, which is sufficient for deriving a contradiction. % Taking ${\pvs}_0$ and ${\pvs}_1$ to be the fancy update modalities $\pvs[\emptyset]$ % and $\pvs[\nat]$, respectively, we can see that Iris % \emph{almost} satisfies these axioms. First, to implement the tokens, % we can use the RA with the carrier % $\{\mundef,\epsilon,\starttoken,\finishtoken\}$ and operation % $\epsilon \mtimes x = x \mtimes \epsilon = x$, % $\finishtoken \mtimes \finishtoken = \finishtoken$ and otherwise % $x \mtimes y = \mundef$. Then, observe that the rules for % $\knowInv{\cdot}{\cdot}$ are special cases of (derivable) invariant % rules in Iris. The fly in the ointment is the \ruleref{eq:inv-open} % rule: in Iris, this rule would protect each occurrence of $\prop$ % in the premise of the rule with a $\later$, whereas here they are % unprotected. We start by defining $\Mapsto$ satisfying (almost) the assumptions of \lemref{lem:counterexample-invariants-saved-prop-agree}. % \begin{defn} We define $\_ \Mapsto \_ : \GName \to \Prop \to \Prop$ as: % \begin{align*} \gname \Mapsto \prop \eqdef \Exists \iname. \knowInv \iname {\ownGhost \gname \starttoken \lor \ownGhost \gname \finishtoken * \always \prop}. \end{align*} \end{defn} Note that using \ruleref{eq:inv-persistent}, it is immediate that $\gname \Mapsto \prop$ is persistent. We use the tokens $\ownGhost \gname \starttoken$ and $\ownGhost \gname \finishtoken$ to model invariants that can be initialized ``lazily'': $\ownGhost \gname \starttoken$ indicates that the invariant is still not initialized, whereas the duplicable $\ownGhost \gname \finishtoken$ indicates it has been initialized with a resource satisfying $\prop$.% %\footnote{We would usually require the token to be persistent, but it turns out the proof also works with the weaker assumption of duplicability.} % RK: cut the footnote, it takes space. Maybe restore later % TODO, explain this ... We can show variants of \ruleref{sprop-agree} and \ruleref{sprop-alloc} for the defined $\Mapsto$. \begin{lem} \label{lem:counterexample-invariants-saved-prop-alloc} We have \(\proves {\pvs}_1 \Exists \gname. \gname \Mapsto \prop(\gname)\). \end{lem} \begin{proof} We have to show the allocation rule \[\proves {\pvs}_1 \Exists \gname. \gname \Mapsto \prop.\] From \ruleref{eq:start-alloc} we have a $\gname$ such that ${\pvs}_0 \ownGhost \gname \starttoken$ holds and hence from \ruleref{eq:update-weaken-mask} we have ${\pvs}_1\ownGhost\gname \starttoken$. Since we are proving a goal of the form ${\pvs}_1 R$ we may assume $\ownGhost \gname \starttoken$. Thus for any $\prop$ we have ${\pvs}_1\left(\ownGhost{\gname}{\starttoken} \lor \ownGhost \gname \finishtoken * \prop\right)$. Again since our goal is still of the form ${\pvs}_1$ we may assume $\ownGhost{\gname}{\starttoken} \lor \ownGhost \gname \finishtoken * \always \prop$. The rule \ruleref{eq:inv-alloc} then gives us precisely what we need. \end{proof} % \begin{lem} \label{lem:counterexample-invariants-saved-prop-agree} We have \( \gname \Mapsto \prop * \gname \Mapsto \propB * \always \prop \proves {\pvs}_1 \always \propB \) and thus \( \gname \Mapsto \prop * \gname \Mapsto \propB \proves ({\pvs}_1 \always \prop) \Lra ({\pvs}_1 \always \propB). \) \end{lem} \begin{proof}~%[\lemref{lem:counterexample-invariants-saved-prop-agree}] \begin{itemize} \item We first show \[\gname \Mapsto \prop * \gname \Mapsto \propB * \always \prop \proves {\pvs}_1 \always \propB.\] We use \ruleref{eq:inv-open} to open the invariant in $\gname \Mapsto \prop$ and consider two cases: % \begin{enumerate} \item $\ownGhost \gname \starttoken$(the invariant is ``uninitialized'') : In this case, we use \ruleref{eq:start-finish} to ``initialize'' the invariant and obtain $\ownGhost{\gname}{\finishtoken}$. Then we duplicate $\ownGhost \gname \finishtoken$, and use it together with $\always \prop$ to close the invariant. \item $\ownGhost \gname \finishtoken * \always \prop$ (the invariant is ``initialized''): In this case we duplicate $\ownGhost \gname \finishtoken$, and use a copy to close the invariant. \end{enumerate} % After closing the invariant, we have obtained $\ownGhost \gname \finishtoken$. Hence, it is sufficient to prove \[ \ownGhost{\gname}{\finishtoken} * \gname \Mapsto \prop * \gname \Mapsto \propB * \always \prop \proves {\pvs}_1 \always \propB.\] We proceed by using \ruleref{eq:inv-open} to open the other invariant in $\gname \Mapsto \propB$, and we again consider two cases: \begin{enumerate} \item $\ownGhost{\gname}{\starttoken}$ (the invariant is ``uninitialized''): As witnessed by \ruleref{eq:start-not-finished}, this cannot happen, so we derive a contradiction. Notice that this is a key point of the proof: because the two invariants ($\gname \Mapsto \prop$ and $\gname \Mapsto \propB$) \emph{share} the ghost name $\gname$, initializing one of them is enough to show that the other one has been initialized. Essentially, this is an indirect way of saying that really, we have been opening the same invariant two times. \item $\ownGhost{\gname}{\finishtoken} * \always \propB$ (the invariant is ``initialized''): Since $\always \propB$ is duplicable we use one copy to close the invariant, and retain another to prove ${\pvs}_1 \always \propB$. \end{enumerate} \item By applying the above twice, we easily obtain \[ \gname \Mapsto \prop * \gname \Mapsto \propB \proves ({\pvs}_1 \always \prop) \Lra ({\pvs}_1 \always \propB) \] \end{itemize} \end{proof} % When allocating $\gname \Mapsto \prop(\gname)$ in \lemref{lem:counterexample-invariants-saved-prop-alloc}, we will start off in ``state'' $\ownGhost \gname \starttoken$, and once we have $P$ in \lemref{lem:counterexample-invariants-saved-prop-agree} we use \ruleref{eq:start-finish} to transition to $\ownGhost\gname \finishtoken$, obtaining ourselves a copy of said token. % Finally, we use this token with $\gname \Mapsto \propB$ to obtain a proof of $\propB$. Intuitively, \lemref{lem:counterexample-invariants-saved-prop-agree} shows that we can ``convert'' a proof from $\prop$ to $\propB$. We are now in a position to replay the counterexample from \Sref{sec:saved-prop-no-later}. The only difference is that because \lemref{lem:counterexample-invariants-saved-prop-agree} is slightly weaker than the rule \ruleref{sprop-agree} of \thmref{thm:counterexample-1}, we need to use ${\pvs}_1 \FALSE$ in place of $\FALSE$ in the definition of the predicate $A$: we let \( A(\gname) \eqdef \Exists \prop : \Prop. \always (\prop \Ra {\pvs}_1 \FALSE) \land \gname \Mapsto \prop\) and replay the proof that we have presented above. %TODO: What about executing a view shift under a later? %%% Local Variables: %%% mode: latex %%% TeX-master: "iris" %%% End: iris-iris-4.2.0/tex/pftools.sty000066400000000000000000000121161460620107300164560ustar00rootroot00000000000000\NeedsTeXFormat{LaTeX2e}[1999/12/01] \ProvidesPackage{pftools} \@ifundefined{basedir}{% \RequirePackage{locallabel} }{% \RequirePackage{\basedir locallabel} }% \RequirePackage{Tabbing} % Avoid the standard tabbing environment. Its \< conflicts with the semantic package. \RequirePackage{xparse} \RequirePackage{xcolor} %% COLOR DEFINITIONS \definecolor{rescolor}{HTML}{005504} \definecolor{prescolor}{HTML}{d16100} % "persistent" resources. also good: b35f00, maybe: c84e00 \definecolor{codecolor}{HTML}{2767c0} %% Biimplication inference rules % \biimp above below % The double lines obtained by the simpler % "\mprset{fraction={===}}" overlap the conclusion (e.g., the % mask E_M in an atomic triple). \newcommand*{\biimp}[2]{% \hbox{% \ooalign{% $\genfrac{}{}{1.6pt}1{#1}{#2}$\cr% $\color{white}\genfrac{}{}{0.8pt}1{\phantom{#1}}{\phantom{#2}}$% }% }% } \newcommand{\BIIMP}{\mprset{myfraction=\biimp}} %% inferH is infer with hyperlinked names. % \savelabel lab text: Arrange for \ref{lab} to print text and to link to the current spot. \newcommand*{\savelabel}[2]{% % Think @currentlabel : text ref. \edef\@currentlabel{#2}% Save text \phantomsection% Correct hyper reference link \label{#1}% Print text and store name↦text. } % \textlabel label text: Print and label text. \newcommand*{\textlabel}[2]{{#2}\savelabel{#1}{\detokenize{#2}}} % added \detokenize to make "Löb" title work % \rulenamestyle visible \newcommand*{\rulenamestyle}[1]{{\textsc{#1}}} % From mathpartir.sty. % \ruleref [discharged] lab \def\optionaldischarge#1{% \if\relax\detokenize{#1}\relax\else\ensuremath{^{#1}}\fi} \newcommand*{\ruleref}[2][]{\textmd{\rulenamestyle{\ref{#2}}}\optionaldischarge{#1}} \newcommand*{\fakeruleref}[2][]{\rulenamestyle{#2}\optionaldischarge{#1}} % \rulename label \newcommand*{\rulename}[1]{\rulenamestyle{\textlabel{#1}{#1}}} % \inferhref name lab premise conclusion \newcommand*{\inferhref}[4]{% \inferrule*[lab=\textlabel{#2}{#1},vcenter]{#3}{#4}% } % \infernH name premise conclusion, if name a valid label. \newcommand*{\inferH}[3]{\inferhref{#1}{#1}{#2}{#3}} \newcommand*{\axiom}[2][]{\infer[#1]{}{#2}} \newcommand*{\axiomhref}[3]{\inferhref{#1}{#2}{}{#3}} \newcommand*{\axiomH}[2]{\inferH{#1}{}{#2}} \newcommand*{\axiomname}[2]{\inferrule*[lab=#1]{}{#2}} \newcommand*{\inferhrefB}[4]{{\BIIMP\inferhref{#1}{#2}{#3}{#4}}} \newcommand*{\inferB}[3][]{{\BIIMP\infer[#1]{#2}{#3}}} \newcommand*{\inferHB}[3]{{\BIIMP\inferH{#1}{#2}{#3}}} \newcommand*{\taghref}[2]{\label{#2}\tag{\textsc{#1}}} \newcommand*{\tagH}[1]{\taghref{#1}{#1}} % The sanity checks in \lbind and \llabel % don't work properly in amsmath environments % which perhaps lay out their contents more % than once. Use \lbind in such cases. % Sigh. \newcommand*{\tagL}[1]{\lbind{#1}\tag*{\llabel{#1}}} \newcommand*\ind[1][\quad\quad]{#1\TAB=\TAB+} \newcommand*\unind{\TAB-} \newcommand\IND[1][\quad\quad]{\\*\ind[#1]} \newcommand\UNIND{\unind \\} % Attribution: http://tex.stackexchange.com/questions/119473/tabbing-and-line-wrapping \newlength\pf@width \newcommand*{\CMT}[1]{% \setlength\pf@width{\linewidth}% \addtolength\pf@width{\@totalleftmargin}% \addtolength\pf@width{-\dimen\@curtab}% \parbox[t]{\pf@width}{\nobelowdisplayskip{#1}\ifhmode\strut\fi}} % \res overwrites \langkw to not change the color \newcommand*\res[1]{{\makeatletter\@namedef{langkw}##1{\textlang{##1}}\makeatother% \color{rescolor}\ensuremath{#1}}} %When \left\{ … \right\} looks ugly, remember Dave says you want \bracket. %2020-05-08 RJ: actually this looks much better than \bracket... (switching triples to \left...\right now, too) \NewDocumentCommand{\RES}{s m O{}}{% \ensuremath{\displaystyle{\res{{\left\{% \IfBooleanTF{#1}{\begin{inbox}[l]#2\end{inbox}}{#2}% \right\}}_{#3}}}}} \NewDocumentCommand{\ARES}{m O{}}{% ${\displaystyle{\bracket\langle\rangle{\color{rescolor}{#1}}}_{#2}}$} \newcommand*{\COMMENT}[1]{\text{#1}} % \res overwrites \langkw to not change the color \newcommand*{\CODE}[1]{% {{\makeatletter\@namedef{langkw}##1{\textlang{##1}}\makeatother% \color{codecolor}\ensuremath{\displaystyle{#1}}}}} \NewDocumentCommand{\GOAL}{s m}{% \textbf{Goal:} ${\displaystyle{\res{\IfBooleanTF{#1}{\begin{inbox}[t]#2\end{inbox}}{#2}}}}$} % \newcommand*{\SUFF}[1]{% % Suff: ${\displaystyle{#1}}$} % \newcommand*{\PFHAVE}[1]{% % Have: ${\displaystyle{#1}}$} % Persistent resources % (extra {...} to contain effect of \color) \newcommand\PRES[1]{\ensuremath{{\color{prescolor}#1}}} % Define abbreviation \newcommand{\ABBRV}[2]{\ensuremath{{\llabel{#1}} \spac #2}} \let\pf@origqedhere\qedhere \def\pf@setup{% % A version of \qedhere that accounts for tabbing. \def\qedhere{\TAB`\pf@origqedhere}% } \newcommand*{\TAGL}[1]{\TAB`\llabel{#1}} % The starred version lacks leading and trailing vertical space. \newenvironment{proofoutline*} {\partopsep=\z@skip \topsep=\z@skip% avoid initial space \parskip\z@skip% avoid trailing space \pf@setup\par\begingroup\Tabbing\ignorespaces} {\endTabbing\endgroup\unskip\ignorespacesafterend} \newenvironment{proofoutline} {\pf@setup\par\begingroup\Tabbing\ignorespaces} {\endTabbing\endgroup\ignorespacesafterend} \endinput iris-iris-4.2.0/tex/program-logic.tex000066400000000000000000001116131460620107300175150ustar00rootroot00000000000000\section{Program Logic} \label{sec:program-logic} This section describes how to build a program logic for an arbitrary language (\cf \Sref{sec:language}) on top of the base logic. So in the following, we assume that some language $\Lang$ was fixed. Furthermore, we work in the logic with higher-order ghost state as described in \Sref{sec:composable-resources}. \subsection{Later Credits} Introducing a later modality is easy (see~\ruleref{later-intro}), but eliminating them can be tricky. Laters often appear in the middle of our proofs after unfolding a circular construction (\eg by opening an invariant, see~\secref{sec:invariants}). In these cases, we get to assume $\later \prop$, but we really want $\prop$ to continue in the proof. Iris offers us four options to do so. We have seen two of them already: timeless propositions (see~\secref{sec:timeless-props}) and the commuting rules for later. Together, they can be used to turn $\later \prop$ into $\prop$, or to delay when we have to deal with the later modality by commuting it inward (\eg{} over an existential quantifer and a separating conjunction). Another option, which we will encounter in~\secref{sec:weakest-pre}, is taking program steps: every program step allows us to eliminate (at least) one later (see~\ruleref{wp-lift-step}). We now introduce the fourth option: \emph{later credits}. Later credits turn the right to eliminate a later into an ownable separation-logic resource $\laterCredit{n}$, where $n$ is the number of laters that we can eliminate. \paragraph{Resources} We assume that the camera \[ \textdom{LaterCredits} \eqdef{} \authm{(\nat^{+})} \] is available (\ie{} part of $\Sigma$), where $\nat^{+}$ is the RA derived from the monoid $\nat$ with operation $+$, and that an instance of it has been created and made globally available at the beginning of verification under the name $\gname_{\textdom{Credits}}$. We define the following notations for the fragments and authoritative part: \begin{mathpar} \laterCredit{n} \eqdef{} \ownGhost{\gname_{\textdom{Credits}}}{\authfrag{n}} \laterCreditSupply{n} \eqdef{} \ownGhost{\gname_{\textdom{Credits}}}{\authfull{n}} \end{mathpar} This definition satisfies the following laws: \begin{mathpar} \inferH{Credit-Split}{}{\laterCredit{(n + m)} \Leftrightarrow \laterCredit{n} * \laterCredit{m}} \inferH{Credit-Timeless}{}{\timeless{\laterCredit{n}}}\\ \inferH{Credit-SupplyBound}{}{\laterCreditSupply{m} * \laterCredit{n} \proves m \geq n} \inferH{Credit-SupplyDecr}{}{\laterCreditSupply{(n + m)} * \laterCredit{n} \proves \pvs \laterCreditSupply{m}} \inferH{Credit-SupplyExcl}{}{\laterCreditSupply{m_1} * \laterCreditSupply{m_2} \proves \FALSE} \end{mathpar} \paragraph{Later Elimination Update}% \label{sec:later-credits} To eliminate laters by \emph{spending} later credits $\laterCredit{n}$, we define a \emph{later-elimination update} $\creditUpd{}\prop$ on top of the basic update modality. It satisfies all the properties of basic updates, except for \ruleref{upd-plainly}, but with the additional rule \begin{mathpar} \inferH{credit-upd-use} {} {\later \prop * \laterCredit{1} \proves \creditUpd{} \prop} \end{mathpar} \ruleref{credit-upd-use} allows to \emph{spend} one credit in exchange for stripping one later off of $\prop$. The later-elimination update is defined by guarded recursion: \begin{align*} \creditUpd{}&\eqdef \MU~\mathit{upd}. \Lam \prop. \All n. \laterCreditSupply{n} \wand \upd{} (\laterCreditSupply{n} * \prop) \lor (\Exists m < n. \laterCreditSupply{m} * \later \mathit{upd}(\prop)) \end{align*} It threads through the authoritative resource $\laterCreditSupply{n}$, the credit supply, to control how many credits can be spent in total. The basic update ensures that the later elimination update inherits the ability to update resources. In the first disjunct (the \enquote{base case}), no credits are spent. In the second disjunct (the \enquote{recursive case}), a later can be eliminated before going into recursion. To take the second disjunct, the credit supply $\laterCreditSupply{n}$ has to be decreased, which means giving up at least $\laterCredit{1}$. The later-elimination update satisfies the following laws: \begin{mathpar} \inferH{credit-upd-mono} {\prop \proves \propB} {\creditUpd\prop \proves \creditUpd\propB} \inferH{credit-upd-intro} {}{\prop \proves \creditUpd \prop} \inferH{credit-upd-trans} {} {\creditUpd \creditUpd \prop \proves \creditUpd \prop} \inferH{credit-upd-frame} {}{\propB * \creditUpd\prop \proves \creditUpd (\propB * \prop)} \inferH{credit-upd-update} %{} %{\upd\creditUpd{} \prop \proves \creditUpd{} \prop} {\melt \mupd \meltsB} {\ownM\melt \proves \creditUpd \Exists\meltB\in\meltsB. \ownM\meltB} \inferH{credit-upd-later} {} {\laterCredit{1} * \later \creditUpd{} \prop \proves \creditUpd{} \prop} %\inferH{credit-upd-use} %{} %{\later \prop * \laterCredit{1} \proves \creditUpd{} \prop} \end{mathpar} The rule \ruleref{credit-upd-use} shown above can be derived from \ruleref{credit-upd-later} and \ruleref{credit-upd-intro}. Note the absence of a rule corresponding to \ruleref{upd-plainly}, which is not validated by the model. As some existing Iris developments rely on \ruleref{upd-plainly}, we parameterize the logic by a boolean constant $\LaterCreditsFlag$ that determines whether the later-elimination update is used instead of the basic update, in particular in the definition of fancy updates below. \subsection{World Satisfaction, Invariants, Fancy Updates} \label{sec:invariants} To introduce invariants into our logic, we will define weakest precondition to explicitly thread through the proof that all the invariants are maintained throughout program execution. However, in order to be able to access invariants, we will also have to provide a way to \emph{temporarily disable} (or ``open'') them. To this end, we use tokens that manage which invariants are currently enabled. We assume to have the following four cameras available: \begin{align*} \InvName \eqdef{}& \nat \\ \textdom{Inv} \eqdef{}& \authm(\InvName \fpfn \agm(\latert \iPreProp)) \\ \textdom{En} \eqdef{}& \pset{\InvName} \\ \textdom{Dis} \eqdef{}& \finpset{\InvName} \end{align*} The last two are the tokens used for managing invariants, $\textdom{Inv}$ is the monoid used to manage the invariants themselves. We assume that at the beginning of the verification, instances named $\gname_{\textdom{Inv}}$, $\gname_{\textdom{En}}$ and $\gname_{\textdom{Dis}}$ of these cameras have been created, such that these names are globally known. \paragraph{World Satisfaction.} We can now define the proposition $W$ (\emph{world satisfaction}) which ensures that the enabled invariants are actually maintained: \begin{align*} W \eqdef{}& \Exists I : \InvName \fpfn \Prop. \begin{array}[t]{@{} l} \ownGhost{\gname_{\textdom{Inv}}}{\authfull \mapComp {\iname} {\aginj(\latertinj(\wIso(I(\iname))))} {\iname \in \dom(I)}} * \\ \Sep_{\iname \in \dom(I)} \left( \later I(\iname) * \ownGhost{\gname_{\textdom{Dis}}}{\set{\iname}} \lor \ownGhost{\gname_{\textdom{En}}}{\set{\iname}} \right) \end{array} \end{align*} \paragraph{Invariants.} The following proposition states that an invariant with name $\iname$ exists and maintains proposition $\prop$: \[ \invM\iname\prop \eqdef \ownGhost{\gname_{\textdom{Inv}}} {\authfrag \mapsingleton \iname {\aginj(\latertinj(\wIso(\prop)))}} \] \paragraph{Fancy Updates and View Shifts.} Next, we define \emph{fancy updates}, which are essentially the same as the basic updates of the base logic ($\Sref{sec:base-logic}$) or later-elimination updates (\Sref{sec:later-credits}), except that they also have access to world satisfaction and can enable and disable invariants. Depending on how the logic is parameterized with the $\LaterCreditsFlag$, fancy updates are defined on top the basic update or the later-elimination update. This influences which rules fancy updates satisfy: either fancy updates can be used to eliminate later credits, or they satisfy certain interaction laws with the plainly modality. \[ \pvs[\mask_1][\mask_2] \prop \eqdef \begin{cases} W * \ownGhost{\gname_{\textdom{En}}}{\mask_1} \wand \creditUpd\diamond (W * \ownGhost{\gname_{\textdom{En}}}{\mask_2} * \prop) & \text{if } \LaterCreditsFlag = \textsf{true}\\ W * \ownGhost{\gname_{\textdom{En}}}{\mask_1} \wand \upd\diamond (W * \ownGhost{\gname_{\textdom{En}}}{\mask_2} * \prop) & \text{if } \LaterCreditsFlag = \textsf{false}\\ \end{cases} \] Here, $\mask_1$ and $\mask_2$ are the \emph{masks} of the view update, defining which invariants have to be (at least!) available before and after the update. Masks are sets of natural numbers, \ie they are subsets of $\mathbb{N}$.% \footnote{Actually, in the Coq development masks are restricted to a class of sets of natural numbers that contains all finite sets and is closed under union, intersection, difference and complement. The restriction is necessary for engineering reasons to still obtain representation independence: two masks should be \emph{propositionally} equal iff they contain the same invariant names.} We use $\top$ as symbol for the largest possible mask, $\nat$, and $\bot$ for the smallest possible mask $\emptyset$. We will write $\pvs[\mask] \prop$ for $\pvs[\mask][\mask]\prop$. % Fancy updates satisfy the following basic proof rules: \begin{mathparpagebreakable} \infer[fup-mono] {\prop \proves \propB} {\pvs[\mask_1][\mask_2] \prop \proves \pvs[\mask_1][\mask_2] \propB} \infer[fup-intro-mask] {\mask_2 \subseteq \mask_1} {\prop \proves \pvs[\mask_1][\mask_2]\pvs[\mask_2][\mask_1] \prop} \infer[fup-trans] {} {\pvs[\mask_1][\mask_2] \pvs[\mask_2][\mask_3] \prop \proves \pvs[\mask_1][\mask_3] \prop} \infer[fup-upd] {}{\upd\prop \proves \pvs[\mask] \prop} \infer[fup-frame] {}{\propB * \pvs[\mask_1][\mask_2]\prop \proves \pvs[\mask_1 \uplus \mask_\f][\mask_2 \uplus \mask_\f] \propB * \prop} \inferH{fup-update} {\melt \mupd \meltsB} {\ownM\melt \proves \pvs[\mask] \Exists\meltB\in\meltsB. \ownM\meltB} \infer[fup-timeless] {\timeless\prop} {\later\prop \proves \pvs[\mask] \prop} \infer[fup-credit-use] {\LaterCreditsFlag = \textsf{true}} {\laterCredit{1} * \later \pvs[\mask_1][\mask_2] \prop \proves \pvs[\mask_1][\mask_2] \prop} \end{mathparpagebreakable} (There are no rules related to invariants here. Those rules will be discussed later, in \Sref{sec:namespaces}.) We can further define the notions of \emph{view shifts} and \emph{linear view shifts}: \begin{align*} \prop \vsW[\mask_1][\mask_2] \propB \eqdef{}& \prop \wand \pvs[\mask_1][\mask_2] \propB \\ \prop \vs[\mask_1][\mask_2] \propB \eqdef{}& \always(\prop \wand \pvs[\mask_1][\mask_2] \propB) \\ \prop \vs[\mask] \propB \eqdef{}& \prop \vs[\mask][\mask] \propB \end{align*} These two are useful when writing down specifications and for comparing with previous versions of Iris, but for reasoning, it is typically easier to just work directly with fancy updates. Still, just to give an idea of what view shifts ``are'', here are some proof rules for them: \begin{mathparpagebreakable} \inferH{vs-update} {\melt \mupd \meltsB} {\ownGhost\gname{\melt} \vs[\emptyset] \exists \meltB \in \meltsB.\; \ownGhost\gname{\meltB}} \and \inferH{vs-trans} {\prop \vs[\mask_1][\mask_2] \propB \and \propB \vs[\mask_2][\mask_3] \propC} {\prop \vs[\mask_1][\mask_3] \propC} \and \inferH{vs-imp} {\always{(\prop \Ra \propB)}} {\prop \vs[\emptyset] \propB} \and \inferH{vs-mask-frame} {\prop \vs[\mask_1][\mask_2] \propB} {\prop \vs[\mask_1 \uplus \mask'][\mask_2 \uplus \mask'] \propB} \and \inferH{vs-frame} {\prop \vs[\mask_1][\mask_2] \propB} {\prop * \propC \vs[\mask_1][\mask_2] \propB * \propC} \and \inferH{vs-timeless} {\timeless{\prop}} {\later \prop \vs[\emptyset] \prop} \and \inferHB{vs-disj} {\prop \vs[\mask_1][\mask_2] \propC \and \propB \vs[\mask_1][\mask_2] \propC} {\prop \lor \propB \vs[\mask_1][\mask_2] \propC} \and \inferHB{vs-exist} {\All \var. (\prop \vs[\mask_1][\mask_2] \propB)} {(\Exists \var. \prop) \vs[\mask_1][\mask_2] \propB} \and \inferHB{vs-always} {\always\propB \proves \prop \vs[\mask_1][\mask_2] \propC} {\prop \land \always{\propB} \vs[\mask_1][\mask_2] \propC} \and \inferH{vs-false} {} {\FALSE \vs[\mask_1][\mask_2] \prop } \end{mathparpagebreakable} \subsection{Weakest Precondition} \label{sec:weakest-pre} Finally, we can define the core piece of the program logic, the proposition that reasons about program behavior: Weakest precondition, from which Hoare triples will be derived. \paragraph{Defining weakest precondition.} We assume that everything making up the definition of the language, \ie values, expressions, states, the conversion functions, reduction relation and all their properties, are suitably reflected into the logic (\ie they are part of the signature $\Sig$). We further assume (as a parameter) a predicate $\stateinterp : \State \times \mathbb N \times \List(\Obs) \times \mathbb N \to \iProp$ that interprets the machine state as an Iris proposition, a predicate $\pred_F: \Val \to \iProp$ that serves as postcondition for forked-off threads, and a function $n_\rhd: \mathbb N \to \mathbb N$ specifying the number of additional laters and later credits used for each physical step. The state interpretation can depend on the current physical state, the number of steps since the begining of the execution, the list of \emph{future} observations as well as the total number of \emph{forked} threads (that is one less that the total number of threads). It should be monotone with respect to the step counter: $\stateinterp(\state, n_s, \vec\obs, n_t) \vs[\emptyset] \stateinterp(\state, n_s + 1, \vec\obs, n_t)$. This can be instantiated, for example, with ownership of an authoritative RA to tie the physical state to fragments that are used for user-level proofs. Finally, weakest precondition takes a parameter $\stuckness \in \set{\NotStuck, \MaybeStuck}$ indicating whether program execution is allowed to get stuck. \begin{align*} \textdom{wp}(\stateinterp, \pred_F, \stuckness) \eqdef{}& \MU \textdom{wp\any rec}. \Lam \mask, \expr, \pred. \\ & (\Exists\val. \toval(\expr) = \val \land \pvs[\mask] \pred(\val)) \lor {}\\ & \Bigl(\toval(\expr) = \bot \land \All \state, n_s, \vec\obs, \vec\obs', n_t. \stateinterp(\state, n_s, \vec\obs \dplus \vec\obs', n_t) \vsW[\mask][\emptyset] {}\\ &\qquad (s = \NotStuck \Ra \red(\expr, \state)) * \All \expr', \state', \vec\expr. (\expr, \state \step[\vec\obs] \expr', \state', \vec\expr) \wand \laterCredit{(n_\rhd(n_s)+1)} \wand {}\\ &\qquad\qquad (\pvs[\emptyset]\later\pvs[\emptyset])^{n_\rhd(n_s)+1} \pvs[\emptyset][\mask]\stateinterp(\state', n_s + 1, \vec\obs', n + |\vec\expr|) * \textdom{wp\any rec}(\mask, \expr', \pred) * {}\\ &\qquad\qquad\qquad \Sep_{\expr'' \in \vec\expr} \textdom{wp\any rec}(\top, \expr'', \pred_F)\Bigr) \\ \wpre[\stateinterp;\pred_F]\expr[\stuckness;\mask]{\Ret\val. \prop} \eqdef{}& \textdom{wp}(\stateinterp,\pred_F,\stuckness)(\mask, \expr, \Lam\val.\prop) \end{align*} The $\stateinterp$ and $\pred_F$ will always be set by the context; typically, when instantiating Iris with a language, we also pick the corresponding state interpretation $\stateinterp$ and fork-postcondition $\pred_F$. All proof rules leave $\stateinterp$ and $\pred_F$ unchanged. If we leave away the mask $\mask$, we assume it to default to $\top$. If we leave away the stuckness $\stuckness$, it defaults to $\NotStuck$. \paragraph{Laws of weakest precondition.} The following rules can all be derived: \begin{mathpar} \infer[wp-value] {}{\prop[\val/\var] \proves \wpre{\val}[\stuckness;\mask]{\Ret\var.\prop}} \infer[wp-mono] {\mask_1 \subseteq \mask_2 \and \vctx,\var:\textlog{val}\mid\prop \proves \propB \and (\stuckness_2 = \MaybeStuck \lor \stuckness_1 = \stuckness_2)} {\vctx\mid\wpre\expr[\stuckness_1;\mask_1]{\Ret\var.\prop} \proves \wpre\expr[\stuckness_2;\mask_2]{\Ret\var.\propB}} \infer[fup-wp] {}{\pvs[\mask] \wpre\expr[\stuckness;\mask]{\Ret\var.\prop} \proves \wpre\expr[\stuckness;\mask]{\Ret\var.\prop}} \infer[wp-fup] {}{\wpre\expr[\stuckness;\mask]{\Ret\var.\pvs[\stuckness;\mask] \prop} \proves \wpre\expr[\stuckness;\mask]{\Ret\var.\prop}} \infer[wp-atomic] {\stuckness = \NotStuck \Ra \atomic(\expr) \and \stuckness = \MaybeStuck \Ra \stronglyAtomic(\expr)} {\pvs[\mask_1][\mask_2] \wpre\expr[\stuckness;\mask_2]{\Ret\var. \pvs[\mask_2][\mask_1]\prop} \proves \wpre\expr[\stuckness;\mask_1]{\Ret\var.\prop}} \infer[wp-frame] {}{\propB * \wpre\expr[\stuckness;\mask]{\Ret\var.\prop} \proves \wpre\expr[\stuckness;\mask]{\Ret\var.\propB*\prop}} \infer[wp-frame-step] {\toval(\expr) = \bot \and \mask_2 \subseteq \mask_1} {\wpre\expr[\stuckness;\mask_2]{\Ret\var.\prop} * \pvs[\mask_1][\mask_2]\later\pvs[\mask_2][\mask_1]\propB \proves \wpre\expr[\stuckness;\mask_1]{\Ret\var.\propB*\prop}} \infer[wp-frame-n-steps] {\toval(\expr) = \bot \and \mask_2 \subseteq \mask_1} {{ {\begin{inbox} ~~(\All \state, n_s, \vec\obs, n_t. \stateinterp(\state, n_s, \vec\obs, n_t) \vsW[\mask_1, \emptyset] n \leq n_\rhd(n_s) + 1) \land {}\\ ~~\wpre\expr[\stuckness;\mask_2]{\Ret\var.\prop} * \pvs[\mask_1][\mask_2](\later\pvs[\emptyset])^n\pvs[\mask_2][\mask_1]\propB {}\\ \proves \wpre\expr[\stuckness;\mask_1]{\Ret\var.\propB*\prop} \end{inbox}} }} \infer[wp-bind] {\text{$\lctx$ is a context}} {\wpre\expr[\stuckness;\mask]{\Ret\var. \wpre{\lctx(\ofval(\var))}[\stuckness;\mask]{\Ret\varB.\prop}} \proves \wpre{\lctx(\expr)}[\stuckness;\mask]{\Ret\varB.\prop}} \end{mathpar} We will also want a rule that connect weakest preconditions to the operational semantics of the language. This basically just copies the second branch (the non-value case) of the definition of weakest preconditions. \begin{mathpar} \inferH{wp-lift-step} {\toval(\expr_1) = \bot} { {\begin{inbox} % for some crazy reason, LaTeX is actually sensitive to the space between the "{ {" here and the "} }" below... ~~\All \state_1,\vec\obs,\vec\obs',n. \stateinterp(\state_1,n_s,\vec\obs \dplus \vec\obs', n_t) \vsW[\mask][\emptyset] (\stuckness = \NotStuck \Ra \red(\expr_1,\state_1)) * {}\\ \qquad~ \All \expr_2, \state_2, \vec\expr. (\expr_1, \state_1 \step[\vec\obs] \expr_2, \state_2, \vec\expr) \wand \laterCredit{(n_\rhd(n_s) + 1)} \wand (\pvs[\emptyset]\later\pvs[\emptyset])^{n_\rhd(n_s)}\pvs[\emptyset][\mask] {}\\ \qquad\qquad\left(\stateinterp(\state_2,n_s+1,\vec\obs',n_t+|\vec\expr|) * \wpre[\stateinterp;\pred_F]{\expr_2}[\stuckness;\mask]{\Ret\var.\prop} * \Sep_{\expr_\f \in \vec\expr} \wpre[\stateinterp\pred_F]{\expr_\f}[\stuckness;\top]{\pred_F}\right) {}\\ \proves \wpre[\stateinterp\pred_F]{\expr_1}[\stuckness;\mask]{\Ret\var.\prop} \end{inbox}} } \end{mathpar} \paragraph{Adequacy of weakest precondition.} \newcommand\metaprop{p} \newcommand\consstate{C} The purpose of the adequacy statement is to show that our notion of weakest preconditions is \emph{realistic} in the sense that it actually has anything to do with the actual behavior of the program. The most general form of the adequacy statement is about proving properties of an arbitrary program execution. \begin{thm}[Adequacy] Assume we are given some $\vec\expr_1$, $\state_1$, $\vec\obs$, $\tpool_2$, $\state_2$ such that $(\vec\expr_1, \state_1) \tpsteps[\vec\obs] (\tpool_2, \state_2)$. Moreover, assume we are given a stuckness parameter $\stuckness$ and \emph{meta-level} property $\metaprop$ that we want to show. To verify that $\metaprop$ holds, it is sufficient to show the following Iris entailment: \begin{align*} &\TRUE \proves \pvs[\top] \Exists \stateinterp, \vec\pred, \pred_F. \stateinterp(\state_1,0,\vec\obs,0) * \left(\Sep_{\expr,\pred \in \vec\expr_1,\vec\pred} \wpre[\stateinterp;\pred_F]{\expr}[\stuckness;\top]{x.\; \pred(x)}\right) * \left(\consstate^{\stateinterp;\vec\pred;\pred_F}_{\stuckness}(\tpool_2, \state_2) \vs[\top][\emptyset] \hat{\metaprop}\right) \end{align*} where $\consstate$ describes states that are consistent with the state interpretation and postconditions: \begin{align*} \consstate^{\stateinterp;\vec\pred;\pred_F}_{\stuckness}(\tpool_2, \state_2) \eqdef{}&\Exists \vec\expr_2, \tpool_2'. \tpool_2 = \vec\expr_2 \dplus \tpool_2' * {}\\ &\quad |\vec\expr_1| = |\vec\expr_2| *{}\\ &\quad (s = \NotStuck \Ra \All \expr \in \tpool_2. \toval(\expr) \neq \bot \lor \red(\expr, \state_2) ) *{}\\ &\quad \stateinterp(\state_2, (), |\tpool_2'|) *{}\\ &\quad \left(\Sep_{\expr,\pred \in \vec\expr_2,\vec\pred} \toval(\expr) \ne \bot \wand \pred(\toval(\expr))\right) *{}\\ &\quad \left(\Sep_{\expr \in \tpool_2'} \toval(\expr) \ne \bot \wand \pred_F(\toval(\expr))\right) \end{align*} The $\hat\metaprop$ here arises because we need a way to talk about $\metaprop$ inside Iris. To this end, we assume that the signature $\Sig$ contains some assertion $\hat{\metaprop}$: \[ \hat{\metaprop} : \Prop \in \SigFn \] Furthermore, we assume that the \emph{interpretation} $\Sem{\hat{\metaprop}}$ of $\hat{\metaprop}$ reflects $\metaprop$ (also see \Sref{sec:model}): \[\begin{array}{rMcMl} \Sem{\hat{\metaprop}} &:& \Sem\Prop \\ \Sem{\hat{\metaprop}} &\eqdef& \Lam \any. \setComp{n}{\metaprop} \end{array}\] The signature can of course state arbitrary additional properties of $\hat{\metaprop}$, as long as they are proven sound. \end{thm} In other words, to show that $\metaprop$ holds, we have to prove an entailment in Iris that, starting from the empty context, chooses some state interpretation, postconditions for the initial threads, forked-thread postcondition and stuckness and then proves: \begin{itemize} \item the initial state interpretation, \item a weakest-precondition, \item and a view shift showing the desired $\hat\metaprop$ under the extra assumption $\consstate(\tpool_2, \state_2)$. \end{itemize} Notice that the state interpretation and the postconditions are chosen \emph{after} doing a fancy update, which allows them to depend on the names of ghost variables that are picked in that initial fancy update. This gives us a chance to allocate some ``global'' ghost state that state interpretation and postcondition can refer to (\eg the name $\gname_{\textdom{Credits}}$). $\consstate^{\stateinterp;\vec\pred;\pred_F}_{\stuckness}(\tpool_2, \state_2)$ says that: \begin{itemize} \item The final thread-pool $\tpool_2$ contains the final state of the initial threads $\vec\expr_2$, and any number of additional forked threads in $\tpool_2'$. \item If this is a stuck-free weakest precondition, then all threads in the final thread-pool are either values or are reducible in the final state $\state_2$. \item The state interpretation $\stateinterp$ holds for the final state. \item If one of the initial threads reduced to a value, the corresponding post-condition $\pred \in \vec\pred$ holds for that value. \item If any other thread reduced to a value, the forked-thread post-condition $\pred_F$ holds for that value. \end{itemize} ~\par As an example for how to use this adequacy theorem, let us say we wanted to prove that a program $\expr_1$ for which we derived a $\NotStuck$ weakest-precondition cannot get stuck: \begin{cor}[Stuck-freedom] Assume we are given some $\expr_1$ such that the following holds: \[ \TRUE \proves \All\state_1, \vec\obs. \pvs[\top] \Exists \stateinterp, \pred, \pred_F. \stateinterp(\state_1,0,\vec\obs,0) * \wpre[\stateinterp;\pred_F]{\expr_1}[\NotStuck;\top]{x.\; \pred(x)} \] Then it is the case that: \[ \All \state_1, \vec\obs, \tpool_2, \state_2. ([\expr_1], \state_1) \tpsteps[\vec\obs] (\tpool_2, \state_2) \Ra \All \expr \in \tpool_2. \toval(\expr) \neq \bot \lor \red(\expr, \state_2) \] \end{cor} To prove the conclusion of this corollary, we assume some $\state_1, \vec\obs, \tpool_2, \state_2$ and $([\expr_1], \state_1) \tpsteps[\vec\obs] (\tpool_2, \state_2)$, and we instantiate the main theorem with this execution and $\metaprop \eqdef \All \expr \in \tpool_2. \toval(\expr) \neq \bot \lor \red(\expr, \state_2)$. We can then show the premise of adequacy using the Iris entailment that we assumed in the corollary and: \[ \TRUE \proves \consstate^{\stateinterp;[\pred];\pred_F}_{\NotStuck}(\tpool_2, \state_2) \vs[\top][\emptyset] \metaprop \] This proof, just like the following, also exploits that we can freely swap between meta-level universal quantification ($\All x. \TRUE \proves \prop$) and quantification in Iris ($\TRUE \proves \All x. \prop$). ~\par Similarly we could show that the postcondition makes adequate statements about the possible final value of the main thread: \begin{cor}[Adequate postcondition] Assume we are given some $\expr_1$ and a set $V \subseteq \Val$ such that the following holds (assuming we can talk about sets like $V$ inside the logic): \[ \TRUE \proves \All\state_1, \vec\obs. \pvs[\top] \Exists \stateinterp, \pred_F. \stateinterp(\state_1,0,\vec\obs,0) * \wpre[\stateinterp;\pred_F]{\expr_1}[\stuckness;\top]{x.\; x \in V} \] Then it is the case that: \[ \All \state_1, \vec\obs, \val_2, \tpool_2, \state_2. ([\expr_1], \state_1) \tpsteps[\vec\obs] ([\ofval(\val_2)] \dplus \tpool_2, \state_2) \Ra \val_2 \in V \] \end{cor} To show this, we assume some $\state_1, \vec\obs, \val_2, \tpool_2, \state_2$ such that $([\expr_1], \state_1) \tpsteps[\vec\obs] ([\ofval(\val_2)] \dplus \tpool_2, \state_2)$, and we instantiate adequacy with this execution and $\metaprop \eqdef \val_2 \in \Val$. Then we only have to show: $$\TRUE \proves \consstate^{\stateinterp;[(\Lam \val. \val \in \Val)];\pred_F}_{\stuckness}([\ofval(\val_2)] \dplus \tpool_2, \state_2) \vs[\top][\emptyset] \val_2 \in \Val $$ ~\par As a final example, we could use adequacy to show that the state $\state$ of the program is always in some set $\Sigma \subseteq \State$: \begin{cor}[Adequate state interpretation] Assume we are given some $\expr_1$ and a set $\Sigma \subseteq \State$ such that the following holds (assuming we can talk about sets like $\Sigma$ inside the logic): \[ \TRUE \proves \All\state_1, \vec\obs. \pvs[\top] \Exists \stateinterp, \pred, \pred_F. \stateinterp(\state_1,0,\vec\obs,0) * \wpre[\stateinterp;\pred_F]{\expr_1}[\stuckness;\top]{\pred} * (\All \state_2, n_s, n_t. \stateinterp(\state_2,n_s,(),n_t) \!\vs[\top][\emptyset] \state_2 \in \Sigma) \] Then it is the case that: \[ \All \state_1, \vec\obs, \tpool_2, \state_2. ([\expr_1], \state_1) \tpsteps[\vec\obs] (\tpool_2, \state_2) \Ra \state_2 \in \Sigma \] \end{cor} To show this, we assume some $\state_1, \vec\obs, \tpool_2, \state_2$ such that $([\expr_1], \state_1) \tpsteps[\vec\obs] (\tpool_2, \state_2)$, and we instantiate adequacy with this execution and $\metaprop \eqdef \state_2 \in \Sigma$. Then we have to show: \[ (\All \state_2, n_s, n_t. \stateinterp(\state_2,n_s,(),n_t) \!\vs[\top][\emptyset] \state_2 \in \Sigma) \proves \consstate^{\stateinterp;[\pred];\pred_F}_{\stuckness}(\tpool_2, \state_2) \vs[\top][\emptyset] \state_2 \in \Sigma \] \paragraph{Hoare triples.} It turns out that weakest precondition is actually quite convenient to work with, in particular when performing these proofs in Coq. Still, for a more traditional presentation, we can easily derive the notion of a Hoare triple: \[ \hoare{\prop}{\expr}{\Ret\val.\propB}[\mask] \eqdef \always{(\prop \wand \wpre{\expr}[\mask]{\Ret\val.\propB})} \] We assume the state interpretation $\stateinterp$ to be fixed by the context. We only give some of the proof rules for Hoare triples here, since we usually do all our reasoning directly with weakest preconditions and use Hoare triples only to write specifications. \begin{mathparpagebreakable} \inferH{Ht-ret} {} {\hoare{\TRUE}{\valB}{\Ret\val. \val = \valB}[\mask]} \and \inferH{Ht-bind} {\text{$\lctx$ is a context} \and \hoare{\prop}{\expr}{\Ret\val. \propB}[\mask] \\ \All \val. \hoare{\propB}{\lctx(\val)}{\Ret\valB.\propC}[\mask]} {\hoare{\prop}{\lctx(\expr)}{\Ret\valB.\propC}[\mask]} \and \inferH{Ht-csq} {\prop \vs \prop' \\ \hoare{\prop'}{\expr}{\Ret\val.\propB'}[\mask] \\ \All \val. \propB' \vs \propB} {\hoare{\prop}{\expr}{\Ret\val.\propB}[\mask]} \and % \inferH{Ht-mask-weaken} % {\hoare{\prop}{\expr}{\Ret\val. \propB}[\mask]} % {\hoare{\prop}{\expr}{\Ret\val. \propB}[\mask \uplus \mask']} % \\\\ \inferH{Ht-frame} {\hoare{\prop}{\expr}{\Ret\val. \propB}[\mask]} {\hoare{\prop * \propC}{\expr}{\Ret\val. \propB * \propC}[\mask]} \and % \inferH{Ht-frame-step} % {\hoare{\prop}{\expr}{\Ret\val. \propB}[\mask] \and \toval(\expr) = \bot \and \mask_2 \subseteq \mask_2 \\\\ \propC_1 \vs[\mask_1][\mask_2] \later\propC_2 \and \propC_2 \vs[\mask_2][\mask_1] \propC_3} % {\hoare{\prop * \propC_1}{\expr}{\Ret\val. \propB * \propC_3}[\mask \uplus \mask_1]} % \and \inferH{Ht-atomic} {\prop \vs[\mask \uplus \mask'][\mask] \prop' \\ \hoare{\prop'}{\expr}{\Ret\val.\propB'}[\mask] \\ \All\val. \propB' \vs[\mask][\mask \uplus \mask'] \propB \\ \atomic(\expr) } {\hoare{\prop}{\expr}{\Ret\val.\propB}[\mask \uplus \mask']} \and \inferH{Ht-false} {} {\hoare{\FALSE}{\expr}{\Ret \val. \prop}[\mask]} \and \inferHB{Ht-disj} {\hoare{\prop}{\expr}{\Ret\val.\propC}[\mask] \and \hoare{\propB}{\expr}{\Ret\val.\propC}[\mask]} {\hoare{\prop \lor \propB}{\expr}{\Ret\val.\propC}[\mask]} \and \inferHB{Ht-exist} {\All \var. \hoare{\prop}{\expr}{\Ret\val.\propB}[\mask]} {\hoare{\Exists \var. \prop}{\expr}{\Ret\val.\propB}[\mask]} \and \inferHB{Ht-box} {\always\propB \proves \hoare{\prop}{\expr}{\Ret\val.\propC}[\mask]} {\hoare{\prop \land \always{\propB}}{\expr}{\Ret\val.\propC}[\mask]} \end{mathparpagebreakable} \subsection{Invariant Namespaces} \label{sec:namespaces} In \Sref{sec:invariants}, we defined a proposition $\invM\iname\prop$ expressing knowledge (\ie the proposition is persistent) that $\prop$ is maintained as invariant with name $\iname$. The concrete name $\iname$ is picked when the invariant is allocated, so it cannot possibly be statically known -- it will always be a variable that's threaded through everything. However, we hardly care about the actual, concrete name. All we need to know is that this name is \emph{different} from the names of other invariants that we want to open at the same time. Keeping track of the $n^2$ mutual inequalities that arise with $n$ invariants quickly gets in the way of the actual proof. To solve this issue, instead of remembering the exact name picked for an invariant, we will keep track of the \emph{namespace} the invariant was allocated in. Namespaces are sets of invariants, following a tree-like structure: Think of the name of an invariant as a sequence of identifiers, much like a fully qualified Java class name. A \emph{namespace} $\namesp$ then is like a Java package: it is a sequence of identifiers that we think of as \emph{containing} all invariant names that begin with this sequence. For example, \texttt{org.mpi-sws.iris} is a namespace containing the invariant name \texttt{org.mpi-sws.iris.heap}. The crux is that all namespaces contain infinitely many invariants, and hence we can \emph{freely pick} the namespace an invariant is allocated in -- no further, unpredictable choice has to be made. Furthermore, we will often know that namespaces are \emph{disjoint} just by looking at them. The namespaces $\namesp.\texttt{iris}$ and $\namesp.\texttt{gps}$ are disjoint no matter the choice of $\namesp$. As a result, there is often no need to track disjointness of namespaces, we just have to pick the namespaces that we allocate our invariants in accordingly. Formally speaking, let $\namesp \in \textlog{InvNamesp} \eqdef \List(\nat)$ be the type of \emph{invariant namespaces}. We use the notation $\namesp.\iname$ for the namespace $[\iname] \dplus \namesp$. (In other words, the list is ``backwards''. This is because cons-ing to the list, like the dot does above, is easier to deal with in Coq than appending at the end.) The elements of a namespaces are \emph{structured invariant names} (think: Java fully qualified class name). They, too, are lists of $\nat$, the same type as namespaces. In order to connect this up to the definitions of \Sref{sec:invariants}, we need a way to map structured invariant names to $\InvName$, the type of ``plain'' invariant names. Any injective mapping $\textlog{namesp\_inj}$ will do; and such a mapping has to exist because $\List(\nat)$ is countable and $\InvName$ is infinite. Whenever needed, we (usually implicitly) coerce $\namesp$ to its encoded suffix-closure, \ie to the set of encoded structured invariant names contained in the namespace: \[\namecl\namesp \eqdef \setComp{\iname}{\Exists \namesp'. \iname = \textlog{namesp\_inj}(\namesp' \dplus \namesp)}\] We will overload the notation for invariant propositions for using namespaces instead of names: \[ \invM\namesp\prop \eqdef \Exists \iname \in \namecl\namesp. \invM\iname{\prop} \] We can now derive the following rules (this involves unfolding the definition of fancy updates): \begin{mathpar} \axiomH{inv-persist}{\invM\namesp\prop \proves \always\invM\namesp\prop} \axiomH{inv-alloc}{\later\prop \proves \pvs[\emptyset] \invM\namesp\prop} \inferH{inv-open} {\namesp \subseteq \mask} {\invM\namesp\prop \vs[\mask][\mask\setminus\namesp] \later\prop * (\later\prop \vsW[\mask\setminus\namesp][\mask] \TRUE)} \inferH{inv-open-timeless} {\namesp \subseteq \mask \and \timeless\prop} {\invM\namesp\prop \vs[\mask][\mask\setminus\namesp] \prop * (\prop \vsW[\mask\setminus\namesp][\mask] \TRUE)} \end{mathpar} \subsection{Accessors} The two rules \ruleref{inv-open} and \ruleref{inv-open-timeless} above may look a little surprising, in the sense that it is not clear on first sight how they would be applied. The rules are the first \emph{accessors} that show up in this document. Accessors are propositions of the form \[ \prop \vs[\mask_1][\mask_2] \Exists\var. \propB * (\All\varB. \propB' \vsW[\mask_2][\mask_1] \propC) \] One way to think about such propositions is as follows: Given some accessor, if during our verification we have the proposition $\prop$ and the mask $\mask_1$ available, we can use the accessor to \emph{access} $\propB$ and obtain the witness $\var$. We call this \emph{opening} the accessor, and it changes the mask to $\mask_2$. Additionally, opening the accessor provides us with $\All\varB. \propB' \vsW[\mask_2][\mask_1] \propC$, a \emph{linear view shift} (\ie a view shift that can only be used once). This linear view shift tells us that in order to \emph{close} the accessor again and go back to mask $\mask_1$, we have to pick some $\varB$ and establish the corresponding $\propB'$. After closing, we will obtain $\propC$. Using \ruleref{vs-trans} and \ruleref{Ht-atomic} (or the corresponding proof rules for fancy updates and weakest preconditions), we can show that it is possible to open an accessor around any view shift and any \emph{atomic} expression: \begin{mathpar} \inferH{Acc-vs} {\prop \vs[\mask_1][\mask_2] \Exists\var. \propB * (\All\varB. \propB' \vsW[\mask_2][\mask_1] \propC) \and \All\var. \propB * \prop_F \vs[\mask_2] \Exists\varB. \propB' * \prop_F} {\prop * \prop_F \vs[\mask_1] \propC * \prop_F} \inferH{Acc-Ht} {\prop \vs[\mask_1][\mask_2] \Exists\var. \propB * (\All\varB. \propB' \vsW[\mask_2][\mask_1] \propC) \and \All\var. \hoare{\propB * \prop_F}\expr{\Exists\varB. \propB' * \prop_F}[\mask_2] \and \atomic(\expr)} {\hoare{\prop * \prop_F}\expr{\propC * \prop_F}[\mask_1]} \end{mathpar} Furthermore, in the special case that $\mask_1 = \mask_2$, the accessor can be opened around \emph{any} expression. For this reason, we also call such accessors \emph{non-atomic}. The reasons accessors are useful is that they let us talk about ``opening X'' (\eg ``opening invariants'') without having to care what X is opened around. Furthermore, as we construct more sophisticated and more interesting things that can be opened (\eg invariants that can be ``cancelled'', or STSs), accessors become a useful interface that allows us to mix and match different abstractions in arbitrary ways. For the symmetric case where $\prop = \propC$ and $\propB = \propB'$, we use the following notation that avoids repetition: \[ \Acc[\mask_1][\mask_2]\prop{\Ret x. \propB} \eqdef \prop \vs[\mask_1][\mask_2] \Exists\var. \propB * (\propB \vsW[\mask_2][\mask_1] \prop) \] This accessor is ``idempotent'' in the sense that it does not actually change the state. After applying it, we get our $\prop$ back so we end up where we started. \paragraph{Accessor-style invariants.} In fact, the user-visible notion of invariants $\knowInv\namesp\prop$ is defined via \ruleref{inv-open}: \begin{align*} \knowInv\namesp\prop \eqdef \always\All\mask. \pvs[\mask][\mask\setminus\namesp] \later\prop * (\later\prop \vsW[\mask\setminus\namesp][\mask] \TRUE) \end{align*} All the invariant laws shown above for $\invM\namesp\prop$ also hold for $\knowInv\namesp\prop$, but we can also show some additional laws that would otherwise not hold: \begin{mathpar} \inferH{inv-combine} {\namesp_1 \disj \namesp_2 \and \namesp_1 \cup \namesp_2 \subseteq \namesp} {\knowInv{\namesp_1}{\prop_1} * \knowInv{\namesp_2}{\prop_2} \vdash \knowInv{\namesp}{\prop_1 * \prop_2}} \inferH{inv-split} {} {\knowInv{\namesp}{\prop_1 * \prop_2} \vdash \knowInv{\namesp}{\prop_1} * \knowInv{\namesp}{\prop_2}} \inferH{inv-alter} {} {\later\always(\prop \wand \propB * (\propB \wand \prop)) \vdash \knowInv\namesp\prop \wand \knowInv\namesp\propB} \end{mathpar} %%% Local Variables: %%% mode: latex %%% TeX-master: "iris" %%% End: iris-iris-4.2.0/tex/setup.tex000066400000000000000000000072101460620107300161100ustar00rootroot00000000000000 \makeatletter% \@ifundefined{basedir}{% \newcommand\basedir{}% }{}% \makeatother% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% PACKAGES %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %\usepackage{amsmath} \usepackage{amsfonts} \usepackage{amsthm} \usepackage{amssymb} \usepackage{stmaryrd} \usepackage{mathpartir} \usepackage{\basedir pftools} \usepackage{\basedir iris} \usepackage{\basedir heaplang} \usepackage{xcolor} % for print version \usepackage{graphicx} \usepackage{enumitem} \usepackage{semantic} \usepackage{csquotes} \usepackage{hyperref} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% SETUP %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \SetSymbolFont{stmry}{bold}{U}{stmry}{m}{n} % this fixes warnings when \boldsymbol is used with stmaryrd included \extrarowheight=\jot % else, arrays are scrunched compared to, say, aligned \newcolumntype{.}{@{}} % Array {rMcMl} modifies array {rcl}, putting mathrel-style spacing % around the centered column. (We used this, for example, in laying % out some of Iris' axioms. Generally, aligned is simpler but aligned % does not work in mathpar because \\ inherits mathpar's 2em vskip.) % The capital M stands for THICKMuskip. The smaller medmuskip would be % right for mathbin-style spacing. \newcolumntype{M}{@{\mskip\thickmuskip}} \definecolor{StringRed}{rgb}{.637,0.082,0.082} \definecolor{CommentGreen}{rgb}{0.0,0.55,0.3} \definecolor{KeywordBlue}{rgb}{0.0,0.3,0.55} \definecolor{LinkColor}{rgb}{0.55,0.0,0.3} \definecolor{CiteColor}{rgb}{0.55,0.0,0.3} \definecolor{HighlightColor}{rgb}{0.0,0.0,0.0} \definecolor{grey}{rgb}{0.5,0.5,0.5} \definecolor{red}{rgb}{1,0,0} \hypersetup{% linktocpage=true, pdfstartview=FitV, breaklinks=true, pageanchor=true, pdfpagemode=UseOutlines, plainpages=false, bookmarksnumbered, bookmarksopen=true, bookmarksopenlevel=3, hypertexnames=true, pdfhighlight=/O, colorlinks=true,linkcolor=LinkColor,citecolor=CiteColor, urlcolor=LinkColor } %\theoremstyle{definition} %\newtheorem{prop}{Prop} \newtheorem{defn}{Definition} \newtheorem{cor}{Corollary} \newtheorem{conj}{Conj} \newtheorem{lem}{Lemma} \newtheorem{thm}{Theorem} \newtheorem{exercise}{Exercise} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% GENERIC MACROS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newcommand*{\Sref}[1]{\hyperref[#1]{\S\ref*{#1}}} \newcommand*{\secref}[1]{\hyperref[#1]{Section~\ref*{#1}}} \newcommand*{\lemref}[1]{\hyperref[#1]{Lemma~\ref*{#1}}} \newcommand*{\thmref}[1]{\hyperref[#1]{Theorem~\ref*{#1}}} \newcommand{\corref}[1]{\hyperref[#1]{Cor.~\ref*{#1}}} \newcommand*{\defref}[1]{\hyperref[#1]{Definition~\ref*{#1}}} \newcommand*{\egref}[1]{\hyperref[#1]{Example~\ref*{#1}}} \newcommand*{\appendixref}[1]{\hyperref[#1]{Appendix~\ref*{#1}}} \newcommand*{\figref}[1]{\hyperref[#1]{Figure~\ref*{#1}}} \newcommand*{\tabref}[1]{\hyperref[#1]{Table~\ref*{#1}}} \newcommand{\changes}{{\bf\color{red}{Changes}}} \newcommand{\TODO}{\vskip 4pt {\color{red}\bf TODO}} \newcommand{\ie}{\emph{i.e.,} } \newcommand{\cf}{\emph{c.f.} } \newcommand{\eg}{\emph{e.g.,} } \newcommand{\etal}{\emph{et~al.}} \newcommand{\wrt}{w.r.t.~} \newcommand{\aaron}[1]{{\color{red}\textbf{AT: #1}}} \newcommand{\derek}[1]{{\color{red}\textbf{DD: #1}}} \newcommand{\lars}[1]{{\color{red}\textbf{LB: #1}}} \newcommand{\kasper}[1]{{\color{red}\textbf{KS: #1}}} \newcommand{\ralf}[1]{{\color{red}\textbf{RJ: #1}}} \newcommand{\dave}[1]{{\color{red}\textbf{PDS: #1}}} \newcommand{\hush}[1]{} \newcommand{\relaxguys}{% \let\aaron\hush% \let\derek\hush% \let\lars\hush% \let\kasper\hush% \let\ralf\hush% \let\dave\hush% } iris-iris-4.2.0/tex/test.tex000066400000000000000000000111561460620107300157330ustar00rootroot00000000000000\documentclass[10pt]{article} \usepackage{lmodern} \usepackage[T1]{fontenc} \usepackage[utf8]{inputenc} \input{setup} \title{The Iris TeX Test Document} \begin{document} \maketitle Here we put a bunch of uses of the macros in \texttt{iris.sty} that we can visually test to ensure they still work when those macros are changed. \section{Logic notation, Hoare triples} \begin{mathpar} { \hoare{P}{\expr}{Q} } { \ahoare{P}{\expr}{Q} } \end{mathpar} { \newcommand{\mapstoDisk}{\mapsto_d} \newcommand{\mapstoOp}{\mapsto_{\mathit{op}}} \newcommand{\mapstoLftd}{\mapsto_d^{\mathrm{lftd}}} \begin{align*} \hoareV{ \begin{aligned} &\dom(m) = \dom(m') * {} \\ &\left( \Sep_{(a,o) \in m} a \mapstoLftd o \right) * % \left( \Sep_{(a,o') \in m'} a \mapstoOp o' \right) \end{aligned}} % {\mathit{op}.\texttt{Commit}()}% {\left( \Sep_{(a,o) \in m} a \mapstoDisk o \right) \lor \left( \Sep_{(a,o') \in m'} a \mapstoDisk o' \right) } \end{align*} \begin{align*} \ahoareV{ \begin{aligned} &\dom(m) = \dom(m') * {} \\ &\left( \Sep_{(a,o) \in m} a \mapstoLftd o \right) * % \left( \Sep_{(a,o') \in m'} a \mapstoOp o' \right) \end{aligned}} % {\mathit{op}.\texttt{Commit}()}% {\left( \Sep_{(a,o) \in m} a \mapstoDisk o \right) \lor \left( \Sep_{(a,o') \in m'} a \mapstoDisk o' \right) } \end{align*} } \section{Proof outlines} \newcommand\oneshotm{\ensuremath{\textdom{OneShot}}} \newcommand\ospending{\textlog{pending}} \newcommand\osshot{\textlog{shot}} \newcommand\newoneshot{\textlang{mk\_oneshot}} \newcommand\OSset{\textlang{set}} \newcommand\OScheck{\textlang{check}} \begin{proofoutline*} \CODE{\Let \lvar = \Alloc(\Inl(0)) in } \\ \RES{\lvar \mapsto \Inl(0) * \ownGhost\gname{\ospending(1)}}[\top] \quad\COMMENT{(\textsc{hoare-alloc}, \textsc{ghost-alloc})} \\ \RES{\lvar \mapsto \Inl(0) * \ownGhost\gname{\ospending(1/2)} * \ownGhost\gname{\ospending(1/2)}}[\top] \quad\COMMENT{(\textsc{ghost-op})} \\ \RES{\knowInv\namesp{I} * \ownGhost\gname{\ospending(1/2)}}[\top] \quad\COMMENT{(\textsc{inv-alloc1})} \\ \qquad\COMMENT{where $I\eqdef (\lvar \mapsto \Inl(0) * \ownGhost\gname{\ospending(1/2)}) \lor (\Exists n. \lvar \mapsto \Inr(n) * \ownGhost\gname{\osshot(n)})$} \\ \COMMENT{Pick $T \eqdef \ownGhost\gname{\ospending(1/2)}$. We have to prove $T$ (easy) and two Hoare triples. (\textsc{hoare-ctx})} \\ \\ \CODE{\{~~ \OSset ={}\Lam \lvar n. } \IND \RES{\knowInv\namesp{I} * T}[\top] \IND \RES{I * T}[\top\setminus\namesp] \quad\COMMENT{(\textsc{hoare-inv-timeless})} \\ \RES{\lvar \mapsto \Inl(0) * \ownGhost\gname{\ospending(1/2)} * \ownGhost\gname{\ospending(1/2)}}[\top\setminus\namesp] \quad\COMMENT{(\textsc{ghost-op}, \textsc{ghost-valid})} \\ \CODE{\Let (\_, b) = \CmpXchg(\lvar, \Inl(0), \Inr(\lvar n)) in} \\ \RES{\lvar \mapsto \Inr(n) * \ownGhost\gname{\osshot(n)} * b = \True}[\top\setminus\namesp] \quad\COMMENT{(\textsc{hoare-cmpx-suc}, \textsc{ghost-op}, \textsc{ghost-update})} \\ \RES{I * b = \True}[\top\setminus\namesp] \UNIND \RES{\knowInv\namesp{I} * b = \True}[\top] \\ \CODE{\Assert(b)} \quad\COMMENT{(\textsc{hoare-assert})} \\ \RES{\TRUE}[\top] \UNIND \\ \CODE{~~~ \OScheck ={} \Lam\any. } \IND \RES{\knowInv\namesp{I}}[\top] \IND \RES{I}[\top\setminus\namesp] \CODE{\Let \lvarB = \deref \lvar in} \RES{I * \prop}[\top\setminus\namesp] \quad\COMMENT{(\textsc{hoare-inv-timeless}, \textsc{hoare-load}, \textsc{ghost-op})} \\ \qquad\COMMENT{where $\prop \eqdef y = \Inl(0) \lor (\Exists n. y = \Inr(n) * \ownGhost\gname{\osshot(n)})$} \UNIND \RES{\knowInv\namesp{I} * \prop}[\top] \IND \CODE{\Lam\any.} \\ \RES{\knowInv\namesp{I} * \prop}[\top] \IND \RES{I * \prop}[\top\setminus\namesp] \quad\COMMENT{(\textsc{hoare-inv-timeless})} \\ \CODE{\Let \lvarB' = \deref\lvar in} \quad\COMMENT{~~(\textsc{hoare-load})} \\ \RES{I * \bigl( y = \Inl(0) \lor (\Exists n. \lvarB = \lvarB' = \Inr(n)) \bigr) }[\top\setminus\namesp] \quad\COMMENT{(\textsc{ghost-op}, \textsc{ghost-valid})} \UNIND \RES{\knowInv\namesp{I} * \bigl( y = \Inl(0) \lor (\Exists n. \lvarB = \lvarB' = \Inr(n)) \bigr)}[\top] \\ \CODE{\MatchML \lvarB with \Inl(\any) => () | \Inr(\any) => \Assert(\lvarB = \lvarB') \quad\COMMENT{~~~~(\textsc{hoare-assert})} end {} }\\ \RES{\TRUE}[\top] \UNIND \CODE{\}} \end{proofoutline*} \end{document} iris-iris-4.2.0/tex/upload000077500000000000000000000002121460620107300154330ustar00rootroot00000000000000#!/bin/sh set -e cd "$(dirname "$(readlink -e "$0")")" latexmk -pdf iris scp iris.pdf mpi-contact:plv.mpi-sws.org/iris/appendix-4.2.pdf