diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 9010d5aae859e700b70737dfb4872b1b1e982ff3..f24ff612b2834e2e4593af3fe8fdaa2eb5b5359a 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -4,9 +4,10 @@ buildjob:
tags:
- coq
script:
- - 'make -j8 TIMED=y 2>&1 | tee build-log.txt'
+ - coqc -v
+ - 'time make -j8 TIMED=y 2>&1 | tee build-log.txt'
- 'grep Axiom build-log.txt && exit 1'
- - 'cat build-log.txt | egrep "[a-zA-Z0-9_/-]+ \(user: [0-9]" > build-time.txt'
+ - 'cat build-log.txt | egrep "[a-zA-Z0-9_/-]+ \(user: [0-9]" | tee build-time.txt'
only:
- master
- jh_simplified_resources
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000000000000000000000000000000000000..3853fde1690ea8e268ab7956ecda3c129f0d6197
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,20 @@
+In this changelog, we document "large-ish" changes to Iris that affect even the
+way the logic is used on paper. We also mention some significant changes in the
+Coq development, but not every API-breaking change is listed. Changes marked
+[#] still need to be ported to the Iris Documentation LaTeX file.
+
+## Iris 2.0
+
+This version accompanies the final ICFP paper.
+
+* [# algebra] Make the core of an RA or CMRA a partial function.
+* [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.
+
+## Iris 2.0-rc1
+
+This is the Coq development and Iris Documentation as submitted to ICFP.
diff --git a/ProofMode.md b/ProofMode.md
index d08a5408a95058aa6ca22270eb60c26f9a1bab60..5a086022abc189210c9db55f233ac297e6876661 100644
--- a/ProofMode.md
+++ b/ProofMode.md
@@ -1,227 +1,203 @@
-The proof mode has the following major features:
+Tactic overview
+===============
+
+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
+- `iApply trm` : match the conclusion of the current goal against the
+ conclusion of `tetrmrm` and generates goals for the premises of `trm`. See
+ proof mode terms below.
+
+Context management
+------------------
+
+- `iIntros (x1 ... xn) "ipat1 ... ipatn"` : introduce universal quantifiers
+ using Coq introduction patterns `x1 ... xn` and implications/wands using proof
+ mode introduction patterns `ipat1 ... ipatn`.
+- `iClear "H1 ... Hn"` : clear the hypothesis `H1 ... Hn`. The symbol `★` can
+ be used to clear entire spatial context.
+- `iRevert (x1 ... xn) "H1 ... Hn"` : revert the proof mode hypotheses
+ `H1 ... Hn` into wands, as well as the Coq level hypotheses/variables
+ `x1 ... xn` into universal quantifiers. The symbol `★` can be used to revert
+ the entire spatial context.
+- `iRename "H1" into "H2"` : rename the hypothesis `H1` into `H2`.
+- `iSpecialize trm` : instantiate universal quantifiers and eliminate
+ implications/wands of a hypothesis `trm`. See proof mode terms below.
+- `iPoseProof trm as "H"` : put `trm` into the context as a new hypothesis `H`.
+- `iAssert P with "spat" as "ipat"` : create a new goal with conclusion `P` and
+ put `P` in the context of the original goal. The specialization pattern
+ `spat` specifies which hypotheses will be consumed by proving `P` and the
+ introduction pattern `ipat` specifies how to eliminate `P`.
+
+Introduction of logical connectives
+-----------------------------------
+
+- `iPureIntro` : turn a pure goal into a Coq goal. This tactic works for goals
+ of the shape `■φ`, `a ≡ b` on discrete COFEs, and `✓ a` on discrete CMRAs.
+
+- `iLeft` : left introduction of disjunction.
+- `iRight` : right introduction of disjunction.
+
+- `iSplit` : introduction of a conjunction, or separating conjunction provided
+ one of the operands is persistent.
+- `iSplitL "H1 ... Hn"` : introduction of a separating conjunction. The
+ hypotheses `H1 ... Hn` are used for the left conjunct, and the remaining ones
+ for the right conjunct.
+- `iSplitR "H0 ... Hn"` : symmetric version of the above.
+- `iExist t1, .., tn` : introduction of an existential quantifier.
+
+Elimination of logical connectives
+----------------------------------
+
+- `iExFalso` : Ex falso sequitur quod libet.
+- `iDestruct trm as (x1 ... xn) "spat1 ... spatn"` : elimination of existential
+ quantifiers using Coq introduction patterns `x1 ... xn` and elimination of
+ object level connectives using the proof mode introduction patterns
+ `ipat1 ... ipatn`.
+- `iDestruct trm as %cpat` : elimination of a pure hypothesis using the Coq
+ introduction pattern `cpat`.
+
+Separating logic specific tactics
+---------------------------------
+
+- `iFrame "H0 ... Hn"` : cancel the hypotheses `H0 ... Hn` in the goal.
+- `iCombine "H1" "H2" as "H"` : turns `H1 : P1` and `H2 : P2` into
+ `H : P1 ★ P2`.
+
+The later modality
+------------------
+- `iNext` : introduce a later by stripping laters from all hypotheses.
+- `iLöb (x1 ... xn) as "IH"` : perform Löb induction by generalizing over the
+ Coq level variables `x1 ... xn` and the entire spatial context.
+
+Rewriting
+---------
+
+- `iRewrite trm` : rewrite an equality in the conclusion.
+- `iRewrite trm in "H"` : rewrite an equality in the hypothesis `H`.
+
+Iris
+----
+
+- `iPvsIntro` : introduction of a primitive view shift. Generates a goal if
+ the masks are not syntactically equal.
+- `iPvs trm as (x1 ... xn) "ipat"` : runs a primitive view shift `trm`.
+- `iInv N as (x1 ... xn) "ipat"` : open the invariant `N`.
+- `iInv> N as (x1 ... xn) "ipat"` : open the invariant `N` and establish that
+ it is timeless so no laters have to be added.
+- `iTimeless "H"` : strip a later of a timeless hypotheses `H` in case the
+ conclusion is a primitive view shifts or weakest precondition.
+
+Miscellaneous
+-------------
+
+- The tactic `done` is extended so that it also performs `iAssumption` and
+ introduces pure connectives.
+- 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, always and later modalities,
+ primitive view shifts, and pure connectives.
+
+Introduction patterns
+=====================
+
+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.
+- `_` : remove the hypothesis.
+- `$` : frame the hypothesis in the goal.
+- `# ipat` : move the hypothesis to the persistent context.
+- `%` : move the hypothesis to the pure Coq context (anonymously).
+- `[ipat ipat]` : (separating) conjunction elimination.
+- `[ipat|ipat]` : disjunction elimination.
+- `[]` : false elimination.
+
+Apart from this, there are the following introduction patterns that can only
+appear at the top level:
+
+- `!` : introduce a box (provided that the spatial context is empty).
+- `>` : introduce a later (which strips laters from all hypotheses).
+- `{H1 ... Hn}` : clear `H1 ... Hn`.
+- `{$H1 ... $Hn}` : frame `H1 ... Hn` (this pattern can be mixed with the
+ previous pattern, e.g., `{$H1 H2 $H3}`).
+- `/=` : perform `simpl`.
+- `*` : introduce all universal quantifiers.
+- `**` : introduce all universal quantifiers, as well as all arrows and wands.
+
+For example, given:
-=== Intro patterns ===
+ ∀ x, x = 0 ⊢ □ (P → False ∨ □ (Q ∧ ▷ R) -★ P ★ ▷ (R ★ Q ∧ x = pred 2)).
+
+You can write
+
+ iIntros (x) "% ! $ [[] | #[HQ HR]] /= >".
+
+which results in:
+
+ x : nat
+ H : x = 0
+ ______________________________________(1/1)
+ "HQ" : Q
+ "HR" : R
+ --------------------------------------â–¡
+ R ★ Q ∧ x = 1
-Similar to Coq's intro tactic, the Iris iIntros tactic can take a list of intro patterns to perform destructions on the fly. Apart from the standard intro patterns (like "?" for creating an anonymous hypothesis, "[p p]" for eliminating a (separating) conjunction, "[p|p]" for eliminating a disjunction, and "[]" for eliminating False, it supports:
- # pat : move the hypothesis to the persistent context
- % : move the hypothesis to the pure Coq context
- as an anonymous assumption
- ! : introduce a box (this pattern can only appear at the
- to-level, and can be used only if the spatial context
- is empty)
+Specialization patterns
+=======================
-So, for example, given:
+Since we are reasoning in a spatial logic, when eliminating a lemma or
+hypotheses 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
+so called specification patterns to express this splitting:
- ∀ x, x = 0 → □ (P → □ (Q ∧ ▷ R) -★ ▷ (P ★ R ★ Q ∧ x = 0))
+- `H` : use the hypothesis `H` (it should match the premise exactly). If `H` is
+ spatial, it will be consumed.
+- `[H1 ... Hn]` : generate a goal with the spatial hypotheses `H1 ... Hn` and
+ all persistent hypotheses. The hypotheses `H1 ... Hn` will be consumed.
+- `[-H1 ... Hn]` : negated form of the above pattern
+- `=>[H1 ... Hn]` : same as the above pattern, but can only be used if the goal
+ is a primitive view shift, in which case the view shift will be kept in the
+ goal of the premise too.
+- `[#]` : This pattern can be used when eliminating `P -★ Q` when either `P` or
+ `Q` is persistent. In this case, all hypotheses are available in the goal for
+ the premise as none will be consumed.
+- `[%]` : This pattern can be used when eliminating `P -★ Q` when `P` is pure.
+ It will generate a Coq goal for `P` and does not consume any hypotheses.
+- `*` : instantiate all top-level universal quantifiers with meta variables.
-You can write: iIntros {x} "% ! HP #[HQ HR]", which results in:
+For example, given:
- H : x = 0
- ______________________________________(1/1)
-​​​ "HQ" : Q
- "HR" : â–· R
- --------------------------------------â–¡
-​​ "HP" : P
- --------------------------------------★
- ▷ (P ★ R ★ Q ∧ x = 0)
+ H : □ P -★ P 2 -★ x = 0 -★ Q1 ∗ Q2
-(Syntax subject to improvements :))
+You can write:
-(Due to limitations of Ltac, introductions for universal quantifiers always have to appear at the beginning and cannot be mixed).
+ iDestruct ("H" with "[#] [H1 H2] [%]") as "[H4 H5]".
+Proof mode terms
+================
+
+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.
-=== Extensibility ===
+The syntax for the arguments, called _proof mode terms_, of these tactics is:
-The destruction patterns "[p p]" and "[p|p]" do not just work for (separating) conjunctions and disjunctions. For example, when having:
+ (H $! t1 ... tn with "spat1 .. spatn")
- "H" : l ↦{q} v
+Here, `H` can be both a hypothesis, as well as 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 to eliminate implications and wands.
-You can write iDestruct "H" as "[H1 H2]" to split the fractional maps to connective into:
+Proof mode terms can be written down using the following short hands too:
- "H1" : l ↦{q/2} v
- "H2" : l ↦{q/2} v
+ (H with "spat1 .. spatn")
+ (H $! t1 ... tn)
+ H
-The proof mode can be extended using type classes to support all kinds of "destructable" connectives.
-
-I am using type classes for extensibility in many places. The core proof mode thus works for uPred M with any cmra M, and is not tied to the entire Iris logic.
-
-
-=== Later ===
-
-The proof mode has a tactic iNext to introduce a later. This tactic will remove a later in the conclusion, and removes laters in all hypotheses. In the above example, when having:
-
-​​​ "HQ" : Q
- "HR" : â–· R
- --------------------------------------â–¡
-​​ "HP" : P
- --------------------------------------★
- ▷ (P ★ R ★ Q ∧ x = 0)
-
-The tactic iNext will remove the later in HR and in the goal. All other hypotheses are left as if. The iNext tactic is extensible; my means of declaring appropriate type class instances you can also make it strip laters below certain connectives (like below ★).
-
-Apart from that, tactics like iDestruct are able to distribute laters. So, when having:
-
- H : ▷ (P ★ Q)
-
-iDestruct will turn it into H1 : â–· P and H2 â–· Q. This can of course be tweaked by declaring type class instances.
-
-
-=== Separating conjunction and framing ===
-
-When proving a separating conjunction P ★ Q, one has to split the spatial hypotheses. The Iris tactics iSplitL and iSplitR take a list of hypotheses that have to be used to prove the conjunct on the left, respectively, the right, the goal for other other conjunct will have all remaining hypotheses.
-
-Apart from that, there is the tactic iFrame which takes a list of hypotheses to frame in the goal. For example, having:
-
- "HQ" : Q
- "HR" : R
- --------------------------------------â–¡
-​​ "HP" : P
- --------------------------------------★
- P ★ R ★ Q ∧ x = 0
-
-The tactic iFrame "HQ HP" will turn the goal into "R ★ x = 0". Note that persistent hypotheses are kept, only spatial hypotheses disappear. So in the example ,"HQ" is kept, but "HP" is gone, after framing.
-
-The iFrame tactic is able to frame under quantifiers and primitive viewshifts. None of this is hard coded, but instead, the tactic can be extended by declaring appropriate type classes, for example, to make it frame under weakest precondition.
-
-
-=== Apply and specialization patterns ===
-
-Given an hypothesis that is an implication:
-
- ​​"H" : P_0 -★ ... -★ P_n -★ R
-
-One cannot just "apply" this hypothesis (as in ordinary Coq) since we are in a spatial logic. So, when applying a lemma you have to specify which hypotheses are used for which premises. For this, Iris has the following, so called, specialization patterns:
-
- H : use hypothesis H (it should match the premise exactly)
- [H1 ... Hn] : use hypotheses H1 ... Hn
- -[H1 ... Hn] : use all hypotheses but H1 ... Hn
- (you can write - instead of -[])
- # : determine that the premise is persistent, in this
- case all hypotheses can be used (and do not
- disappear)
-
-So, in the above you may write:
-
- iApply "H" "[H1 H2] # H3"
-
-This means: create a goal with hypotheses H1 and H2 for the first premise, establish that the second premise is persistent and use all hypotheses for that one, and match the third premise with H3 exactly.
-
-These specialization patterns can be used for many more tactics, for example, you can write:
-
- iDestruct "H" "spec_pattern" as "intro_pattern"
- iSpecialize "H" "spec_pattern"
- iPoseProof "H" "spec_pattern" as "H2"
-
-I noticed that these specialization patterns are not enough, so there are even more. Take the following lemma:
-
- own_valid : ∀ γ a, own γ a ⊢ ✓ a
-
-Given "H" : own γ a you may want to write:
-
- iPoseProof own_valid "H" as "Hvalid"
-
-But in this case "H" will disappear (and you would loose information). So, there are also the following specialization patterns:
-
- H ! : use hypothesis H and establish that the range of
- the applied/specialized hypothesis/lemma is persistent
- - ! : dito, but generate a goal to prove the premise in which
- all hypotheses can be used.
-
-So, in the above you can write:
-
- iPoseProof own_valid "H !" as "Hvalid"
-
-(Yet again, suggestions for improvement of syntax are welcome, as well as a less ad-hoc solution).
-
-Note that many tactics (like iDestruct, iSpecialize, iPoseProof) work for on both hypotheses and lemmas. These may be an entailments, equivalences, arrows, wands, or bi-implications.
-
-
-=== View shifts ===
-
-Many of the Iris tactics (such as iLeft and iRight for introducing disjunctions, iExists for introducing existential quantifiers, and iFrame for framing) work under primitive view shifts.
-
-Next to that, there is the tactic iPvs that can be used to eliminate a primitive view shift (for example, to allocate ghost state or an invariant, or to perform frame preserving updates). The syntax is:
-
- iPvs "hyp" "spec_pattern" as "intro_pattern"
-
-Allocating ghost state is as simple as:
-
- iPvs (own_alloc OneShotPending) as {γ} "Hγ".
-
-Allocating an invariant is as simple as:
-
- iPvs (inv_alloc N _ (one_shot_inv γ l))
- "[Hl Hγ]" as "#HN".
-
-This creates a goal in which you have to prove ▷ one_shot_inv γ l using the hypotheses Hl and Hγ. The as "#HN" moves the allocated invariant to the persistent context.
-
-The iApply tactic also works under primitive viewshifts, so given:
-
- "H" : P -★ Q
-
-The tactic iApply "H" will turn the goal |={E}=> Q into |={E}=> P (and gets rid of "H" depending on whether H is spatial or not).
-
-Apart from that, I have implemented tactics:
-
-+ iTimeless "H": to strip of a later of a timeless hypotheses (type classes are used to establish timelessness)
-+ iPvsAssert P as "intro_pat" with "single_spec_pat": to assert a view shift and then eliminate it
-+ iInv "N" as "intro_pat" : to open the invariant N
-
-All of these tactics also work in case the goal is a weakest precondition. In fact, it works for any connective that is declared as a "frame shifting assertion" (an abstraction that Ralf came up with to characterize connectives around which you can view shift).
-
-
-=== Symbolic execution ===
-
-The proof mode has tactics:
-
- wp_store
- wp_alloc l as "Hl"
- wp_load
- wp_seq
-
-to perform interactive symbolic execution (and similar for many of the programming language connectives). For example, to prove:
-
- WP let: "x" := ref InjL #0 in ... {{ Φ }}
-
-The tactic wp_alloc l as "Hl" will generate a hypotheses "Hl" : l ↦ InjLV #0" and change the goal into:
-
- WP let: "x" := %l in ... {{ Φ }}
-
-Apart from that, it strips laters (since we have performed a step). Next, the tactic wp_let will reduce the let binding (and once more, strip laters when possible).
-
-Most of these tactics are improvements of the tactics that we already had, but are better integrated into the proof mode.
-
-Notably, there is also the tactic:
-
- wp_apply lem "spec_pattern"
-
-Which given a goal WP e {{ Φ }} will look for a redex on which lem matches, and uses the bind rule to apply the lemma. This tactic is very useful to use lemmas corresponding to specifications of earlier proven connectives (see heap_lang/lib/barrier/client.v for example).
-
-
-=== Rewriting ===
-
-We have an internalized equality in the logic (which is defined in the model in terms of the distance relation on COFEs). I have implemented the tactics iRewrite "Heq" and iRewrite "Heq" in "H" to rewrite using the internalized equality. These tactic heavily piggy back on the Coq setoid rewrite machinery to establish non-expansiveness of the connectives involved.
-
-
-=== Error messages ===
-
-I have put some effort in making the tactics of the proof mode generate sensible error messages (instead of just failing with some arbitrary error message from the underlying Coq tactic). This turned out to be pretty difficult due to Ltac's backtracking semantics (and most of all, many of its oddities...)
-
-
-=== Implementation ===
-
-The basic idea of the implementation is surprisingly simple. The proof mode is just syntactic sugar for a judgment:
-
- Δ_persistent ; Δ_spatial ⊢ Q
-
-(See the file proofmode/notation.v. Warning: it uses unicode whitespace characters to make pretty printing work).
-
-The basic forms of all tactics are just Coq lemmas, for example, wand introduction corresponds to the following lemma:
-
- Lemma tac_wand_intro Δ Δ' i P Q :
- envs_app false (Esnoc Enil i P) Δ = Some Δ' →
- Δ' ⊢ Q →
- Δ ⊢ (P -★ Q).
-
-Next to that, I am using Ltac and logic programming with type classes to tie everything together. The proof mode is implemented entirely in Coq and does not involve any OCaml plugins.
diff --git a/README.md b/README.md
index b0e4de15eefaf4dac8e91fe09d9624e49cf1c776..d4b01a8aa43de7f7d1cb149d774eaf2da2d31d18 100644
--- a/README.md
+++ b/README.md
@@ -6,7 +6,7 @@ This is the Coq development of the [Iris Project](http://plv.mpi-sws.org/iris/).
This version is known to compile with:
- - Coq 8.5pl1
+ - Coq 8.5pl2
- Ssreflect 1.6
For development, better make sure you have a version of Ssreflect that includes
@@ -42,7 +42,7 @@ running:
as described in <http://doi.acm.org/10.1145/2818638>.
* The folder `proofmode` contains the Iris proof mode, which extends Coq with
contexts for persistent and spatial Iris assertions. It also contains tactics
- for interactive proofs in Iris.
+ for interactive proofs in Iris. Documentation can be found in `ProofMode.md`.
* The folder `tests` contains modules we use to test our infrastructure.
Users of the Iris Coq library should *not* depend on these modules; they may
change or disappear without any notice.
diff --git a/_CoqProject b/_CoqProject
index e5adcf5cd279a82038e8a49c99363344892ed051..473926602eadb226fce69a2b79883589ea58f292 100644
--- a/_CoqProject
+++ b/_CoqProject
@@ -1,7 +1,7 @@
-Q . iris
prelude/option.v
prelude/fin_map_dom.v
-prelude/bsets.v
+prelude/bset.v
prelude/fin_maps.v
prelude/vector.v
prelude/pmap.v
@@ -28,14 +28,15 @@ prelude/finite.v
prelude/numbers.v
prelude/nmap.v
prelude/zmap.v
-prelude/co_pset.v
+prelude/coPset.v
prelude/lexico.v
-prelude/sets.v
+prelude/set.v
prelude/decidable.v
prelude/list.v
prelude/error.v
prelude/functions.v
prelude/hlist.v
+prelude/sorting.v
algebra/cmra.v
algebra/cmra_big_op.v
algebra/cmra_tactics.v
@@ -58,9 +59,11 @@ algebra/frac.v
algebra/csum.v
algebra/list.v
algebra/updates.v
+algebra/local_updates.v
+algebra/gset.v
+algebra/coPset.v
program_logic/model.v
program_logic/adequacy.v
-program_logic/hoare_lifting.v
program_logic/lifting.v
program_logic/invariants.v
program_logic/viewshifts.v
@@ -88,7 +91,6 @@ heap_lang/wp_tactics.v
heap_lang/lifting.v
heap_lang/derived.v
heap_lang/notation.v
-heap_lang/substitution.v
heap_lang/heap.v
heap_lang/lib/spawn.v
heap_lang/lib/par.v
@@ -106,6 +108,8 @@ tests/one_shot.v
tests/joining_existentials.v
tests/proofmode.v
tests/barrier_client.v
+tests/list_reverse.v
+tests/tree_sum.v
proofmode/coq_tactics.v
proofmode/pviewshifts.v
proofmode/environments.v
diff --git a/algebra/agree.v b/algebra/agree.v
index a62b288f26eaad80b7dc805c42eba32bdddfcb69..a85d59e8f795968981919624de76fdc98b47ae0c 100644
--- a/algebra/agree.v
+++ b/algebra/agree.v
@@ -3,7 +3,7 @@ From iris.algebra Require Import upred.
Local Hint Extern 10 (_ ≤ _) => omega.
Record agree (A : Type) : Type := Agree {
- agree_car :> nat → A;
+ agree_car : nat → A;
agree_is_valid : nat → Prop;
agree_valid_S n : agree_is_valid (S n) → agree_is_valid n
}.
@@ -15,7 +15,7 @@ Section agree.
Context {A : cofeT}.
Instance agree_validN : ValidN (agree A) := λ n x,
- agree_is_valid x n ∧ ∀ n', n' ≤ n → x n ≡{n'}≡ x n'.
+ agree_is_valid x n ∧ ∀ n', n' ≤ n → agree_car x n ≡{n'}≡ agree_car x n'.
Instance agree_valid : Valid (agree A) := λ x, ∀ n, ✓{n} x.
Lemma agree_valid_le n n' (x : agree A) :
@@ -24,12 +24,13 @@ Proof. induction 2; eauto using agree_valid_S. Qed.
Instance agree_equiv : Equiv (agree A) := λ x y,
(∀ n, agree_is_valid x n ↔ agree_is_valid y n) ∧
- (∀ n, agree_is_valid x n → x n ≡{n}≡ y n).
+ (∀ n, agree_is_valid x n → agree_car x n ≡{n}≡ agree_car y n).
Instance agree_dist : Dist (agree A) := λ n x y,
(∀ n', n' ≤ n → agree_is_valid x n' ↔ agree_is_valid y n') ∧
- (∀ n', n' ≤ n → agree_is_valid x n' → x n' ≡{n'}≡ y n').
+ (∀ n', n' ≤ n → agree_is_valid x n' → agree_car x n' ≡{n'}≡ agree_car y n').
Program Instance agree_compl : Compl (agree A) := λ c,
- {| agree_car n := c n n; agree_is_valid n := agree_is_valid (c n) n |}.
+ {| agree_car n := agree_car (c n) n;
+ agree_is_valid n := agree_is_valid (c n) n |}.
Next Obligation.
intros c n ?. apply (chain_cauchy c n (S n)), agree_valid_S; auto.
Qed.
@@ -44,20 +45,15 @@ Proof.
+ by intros x y Hxy; split; intros; symmetry; apply Hxy; auto; apply Hxy.
+ intros x y z Hxy Hyz; split; intros n'; intros.
* trans (agree_is_valid y n'). by apply Hxy. by apply Hyz.
- * trans (y n'). by apply Hxy. by apply Hyz, Hxy.
+ * trans (agree_car y n'). by apply Hxy. by apply Hyz, Hxy.
- intros n x y Hxy; split; intros; apply Hxy; auto.
- intros n c; apply and_wlog_r; intros;
symmetry; apply (chain_cauchy c); naive_solver.
Qed.
Canonical Structure agreeC := CofeT (agree A) agree_cofe_mixin.
-Lemma agree_car_ne n (x y : agree A) : ✓{n} x → x ≡{n}≡ y → x n ≡{n}≡ y n.
-Proof. by intros [??] Hxy; apply Hxy. Qed.
-Lemma agree_cauchy n (x : agree A) i : ✓{n} x → i ≤ n → x n ≡{i}≡ x i.
-Proof. by intros [? Hx]; apply Hx. Qed.
-
Program Instance agree_op : Op (agree A) := λ x y,
- {| agree_car := x;
+ {| agree_car := agree_car x;
agree_is_valid n := agree_is_valid x n ∧ agree_is_valid y n ∧ x ≡{n}≡ y |}.
Next Obligation. naive_solver eauto using agree_valid_S, dist_S. Qed.
Instance agree_pcore : PCore (agree A) := Some.
@@ -127,13 +123,19 @@ Proof. by constructor. Qed.
Program Definition to_agree (x : A) : agree A :=
{| agree_car n := x; agree_is_valid n := True |}.
Solve Obligations with done.
+
Global Instance to_agree_ne n : Proper (dist n ==> dist n) to_agree.
Proof. intros x1 x2 Hx; split; naive_solver eauto using @dist_le. Qed.
Global Instance to_agree_proper : Proper ((≡) ==> (≡)) to_agree := ne_proper _.
+
Global Instance to_agree_inj n : Inj (dist n) (dist n) (to_agree).
Proof. by intros x y [_ Hxy]; apply Hxy. Qed.
-Lemma to_agree_car n (x : agree A) : ✓{n} x → to_agree (x n) ≡{n}≡ x.
-Proof. intros [??]; split; naive_solver eauto using agree_valid_le. Qed.
+
+Lemma to_agree_uninj n (x : agree A) : ✓{n} x → ∃ y : A, to_agree y ≡{n}≡ x.
+Proof.
+ intros [??]. exists (agree_car x n).
+ split; naive_solver eauto using agree_valid_le.
+Qed.
(** Internalized properties *)
Lemma agree_equivI {M} a b : to_agree a ≡ to_agree b ⊣⊢ (a ≡ b : uPred M).
@@ -148,7 +150,7 @@ Arguments agreeC : clear implicits.
Arguments agreeR : clear implicits.
Program Definition agree_map {A B} (f : A → B) (x : agree A) : agree B :=
- {| agree_car n := f (x n); agree_is_valid := agree_is_valid x;
+ {| agree_car n := f (agree_car x n); agree_is_valid := agree_is_valid x;
agree_valid_S := agree_valid_S _ x |}.
Lemma agree_map_id {A} (x : agree A) : agree_map id x = x.
Proof. by destruct x. Qed.
diff --git a/algebra/auth.v b/algebra/auth.v
index 4e33a44a74cbd2d3ce0863d0b95a6f98ba84e780..d9fa09e152742fe889072b811e75fc6ffa7f44da 100644
--- a/algebra/auth.v
+++ b/algebra/auth.v
@@ -1,5 +1,5 @@
-From iris.algebra Require Export excl updates.
-From iris.algebra Require Import upred.
+From iris.algebra Require Export excl local_updates.
+From iris.algebra Require Import upred updates.
Local Arguments valid _ _ !_ /.
Local Arguments validN _ _ _ !_ /.
@@ -127,7 +127,7 @@ Proof.
- by split; simpl; rewrite ?cmra_core_l.
- by split; simpl; rewrite ?cmra_core_idemp.
- intros ??; rewrite! auth_included; intros [??].
- by split; simpl; apply cmra_core_preserving.
+ by split; simpl; apply cmra_core_mono.
- assert (∀ n (a b1 b2 : A), b1 ⋅ b2 ≼{n} a → b1 ≼{n} a).
{ intros n a b1 b2 <-; apply cmra_includedN_l. }
intros n [[[a1|]|] b1] [[[a2|]|] b2];
@@ -183,8 +183,7 @@ Lemma auth_both_op a b : Auth (Excl' a) b ≡ ◠a ⋅ ◯ b.
Proof. by rewrite /op /auth_op /= left_id. Qed.
Lemma auth_update a af b :
- a ~l~> b @ Some af →
- â— (a â‹… af) â‹… â—¯ a ~~> â— (b â‹… af) â‹… â—¯ b.
+ a ~l~> b @ Some af → ◠(a ⋅ af) ⋅ ◯ a ~~> ◠(b ⋅ af) ⋅ ◯ b.
Proof.
intros [Hab Hab']; apply cmra_total_update.
move=> n [[[?|]|] bf1] // =>-[[bf2 Ha] ?]; do 2 red; simpl in *.
@@ -192,6 +191,11 @@ Proof.
exists bf2. rewrite -assoc.
apply (Hab' _ (Some _)); auto. by rewrite /= assoc.
Qed.
+Lemma auth_update_no_frame a b : a ~l~> b @ Some ∅ → ◠a ⋅ ◯ a ~~> ◠b ⋅ ◯ b.
+Proof.
+ intros. rewrite -{1}(right_id _ _ a) -{1}(right_id _ _ b).
+ by apply auth_update.
+Qed.
End cmra.
Arguments authR : clear implicits.
@@ -222,9 +226,9 @@ Instance auth_map_cmra_monotone {A B : ucmraT} (f : A → B) :
Proof.
split; try apply _.
- intros n [[[a|]|] b]; rewrite /= /cmra_validN /=; try
- naive_solver eauto using includedN_preserving, validN_preserving.
+ naive_solver eauto using cmra_monotoneN, validN_preserving.
- by intros [x a] [y b]; rewrite !auth_included /=;
- intros [??]; split; simpl; apply: included_preserving.
+ intros [??]; split; simpl; apply: cmra_monotone.
Qed.
Definition authC_map {A B} (f : A -n> B) : authC A -n> authC B :=
CofeMor (auth_map f).
diff --git a/algebra/cmra.v b/algebra/cmra.v
index 177c51ec9f91ba22b84a3484fb0f3f00afe5f0ef..a388fc743e13b18b44abb721d60e912c754d373b 100644
--- a/algebra/cmra.v
+++ b/algebra/cmra.v
@@ -48,7 +48,7 @@ Record CMRAMixin A `{Dist A, Equiv A, PCore A, Op A, Valid A, ValidN A} := {
mixin_cmra_comm : Comm (≡) (⋅);
mixin_cmra_pcore_l x cx : pcore x = Some cx → cx ⋅ x ≡ x;
mixin_cmra_pcore_idemp x cx : pcore x = Some cx → pcore cx ≡ Some cx;
- mixin_cmra_pcore_preserving x y cx :
+ mixin_cmra_pcore_mono x y cx :
x ≼ y → pcore x = Some cx → ∃ cy, pcore y = Some cy ∧ cx ≼ cy;
mixin_cmra_validN_op_l n x y : ✓{n} (x ⋅ y) → ✓{n} x;
mixin_cmra_extend n x y1 y2 :
@@ -113,9 +113,9 @@ Section cmra_mixin.
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_preserving x y cx :
+ 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_preserving _ (cmra_mixin A)). Qed.
+ 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 :
@@ -217,10 +217,10 @@ Class CMRADiscrete (A : cmraT) := {
Class CMRAMonotone {A B : cmraT} (f : A → B) := {
cmra_monotone_ne n :> Proper (dist n ==> dist n) f;
validN_preserving n x : ✓{n} x → ✓{n} f x;
- included_preserving x y : x ≼ y → f x ≼ f y
+ cmra_monotone x y : x ≼ y → f x ≼ f y
}.
Arguments validN_preserving {_ _} _ {_} _ _ _.
-Arguments included_preserving {_ _} _ {_} _ _ _.
+Arguments cmra_monotone {_ _} _ {_} _ _ _.
(** * Properties **)
Section cmra.
@@ -364,18 +364,18 @@ 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_preserving' x y cx :
+Lemma cmra_pcore_mono' x y cx :
x ≼ y → pcore x ≡ Some cx → ∃ cy, pcore y = Some cy ∧ cx ≼ cy.
Proof.
intros ? (cx'&?&Hcx)%equiv_Some_inv_r'.
- destruct (cmra_pcore_preserving x y cx') as (cy&->&?); auto.
+ destruct (cmra_pcore_mono x y cx') as (cy&->&?); auto.
exists cy; by rewrite Hcx.
Qed.
-Lemma cmra_pcore_preservingN' n x y cx :
+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_preserving x (x â‹… z) cx')
+ 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. }
@@ -384,14 +384,14 @@ Proof.
Qed.
Lemma cmra_included_pcore x cx : pcore x = Some cx → cx ≼ x.
Proof. exists x. by rewrite cmra_pcore_l. Qed.
-Lemma cmra_preservingN_l n x y z : x ≼{n} y → z ⋅ x ≼{n} z ⋅ y.
+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_preserving_l x y z : x ≼ y → z ⋅ x ≼ z ⋅ y.
+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_preservingN_r n x y z : x ≼{n} y → x ⋅ z ≼{n} y ⋅ z.
-Proof. by intros; rewrite -!(comm _ z); apply cmra_preservingN_l. Qed.
-Lemma cmra_preserving_r x y z : x ≼ y → x ⋅ z ≼ y ⋅ z.
-Proof. by intros; rewrite -!(comm _ z); apply cmra_preserving_l. 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_included_dist_l n x1 x2 x1' :
x1 ≼ x2 → x1' ≡{n}≡ x1 → ∃ x2', x1' ≼ x2' ∧ x2' ≡{n}≡ x2.
@@ -412,10 +412,10 @@ Section total_core.
Proof.
destruct (cmra_total x) as [cx Hcx]. by rewrite /core /= Hcx cmra_pcore_idemp.
Qed.
- Lemma cmra_core_preserving x y : x ≼ y → core x ≼ core y.
+ Lemma cmra_core_mono x y : x ≼ y → core x ≼ core y.
Proof.
intros; destruct (cmra_total x) as [cx Hcx].
- destruct (cmra_pcore_preserving x y cx) as (cy&Hcy&?); auto.
+ destruct (cmra_pcore_mono x y cx) as (cy&Hcy&?); auto.
by rewrite /core /= Hcx Hcy.
Qed.
@@ -461,10 +461,10 @@ Section total_core.
Proof.
split; [|apply _]. by intros x; exists (core x); rewrite cmra_core_r.
Qed.
- Lemma cmra_core_preservingN n x y : x ≼{n} y → core x ≼{n} core y.
+ Lemma cmra_core_monoN n x y : x ≼{n} y → core x ≼{n} core y.
Proof.
intros [z ->].
- apply cmra_included_includedN, cmra_core_preserving, cmra_included_l.
+ apply cmra_included_includedN, cmra_core_mono, cmra_included_l.
Qed.
End total_core.
@@ -519,7 +519,7 @@ Section ucmra.
Global Instance cmra_unit_total : CMRATotal A.
Proof.
- intros x. destruct (cmra_pcore_preserving' ∅ x ∅) as (cx&->&?);
+ intros x. destruct (cmra_pcore_mono' ∅ x ∅) as (cx&->&?);
eauto using ucmra_unit_least, (persistent ∅).
Qed.
End ucmra.
@@ -538,7 +538,7 @@ Section cmra_total.
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_preserving : ∀ x y : A, x ≼ y → core x ≼ core y).
+ 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 →
@@ -551,7 +551,7 @@ Section cmra_total.
- 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_preserving Hx. move: Hxy.
+ - intros x y cx Hxy%core_mono Hx. move: Hxy.
rewrite /core /= Hx /=. case (total y)=> [cy ->]; eauto.
Qed.
End cmra_total.
@@ -565,16 +565,16 @@ Proof.
split.
- apply _.
- move=> n x Hx /=. by apply validN_preserving, validN_preserving.
- - move=> x y Hxy /=. by apply included_preserving, included_preserving.
+ - move=> x y Hxy /=. by apply cmra_monotone, cmra_monotone.
Qed.
Section cmra_monotone.
Context {A B : cmraT} (f : A → B) `{!CMRAMonotone f}.
Global Instance cmra_monotone_proper : Proper ((≡) ==> (≡)) f := ne_proper _.
- Lemma includedN_preserving n x y : x ≼{n} y → f x ≼{n} f y.
+ Lemma cmra_monotoneN n x y : x ≼{n} y → f x ≼{n} f y.
Proof.
intros [z ->].
- apply cmra_included_includedN, (included_preserving f), cmra_included_l.
+ apply cmra_included_includedN, (cmra_monotone f), cmra_included_l.
Qed.
Lemma valid_preserving x : ✓ x → ✓ f x.
Proof. rewrite !cmra_valid_validN; eauto using validN_preserving. Qed.
@@ -677,7 +677,7 @@ Record RAMixin A `{Equiv A, PCore A, Op A, Valid A} := {
ra_comm : Comm (≡) (⋅);
ra_pcore_l x cx : pcore x = Some cx → cx ⋅ x ≡ x;
ra_pcore_idemp x cx : pcore x = Some cx → pcore cx ≡ Some cx;
- ra_pcore_preserving x y cx :
+ ra_pcore_mono x y cx :
x ≼ y → pcore x = Some cx → ∃ cy, pcore y = Some cy ∧ cx ≼ cy;
ra_valid_op_l x y : ✓ (x ⋅ y) → ✓ x
}.
@@ -715,7 +715,7 @@ Section ra_total.
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_preserving : ∀ x y : A, x ≼ y → core x ≼ core y).
+ 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.
@@ -725,7 +725,7 @@ Section ra_total.
- 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_preserving Hx. move: Hxy.
+ - intros x y cx Hxy%core_mono Hx. move: Hxy.
rewrite /core /= Hx /=. case (total y)=> [cy ->]; eauto.
Qed.
End ra_total.
@@ -878,8 +878,8 @@ Section prod.
- 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_preserving (x.1) (y.1) (cx.1)) as (z1&?&?); auto.
- destruct (cmra_pcore_preserving (x.2) (y.2) (cx.2)) as (z2&?&?); auto.
+ 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 *.
@@ -942,7 +942,7 @@ Proof.
split; first apply _.
- by intros n x [??]; split; simpl; apply validN_preserving.
- intros x y; rewrite !prod_included=> -[??] /=.
- by split; apply included_preserving.
+ by split; apply cmra_monotone.
Qed.
Program Definition prodRF (F1 F2 : rFunctor) : rFunctor := {|
@@ -1043,7 +1043,7 @@ Section option.
- intros mx my; setoid_rewrite option_included.
intros [->|(x&y&->&->&[?|?])]; simpl; eauto.
+ destruct (pcore x) as [cx|] eqn:?; eauto.
- destruct (cmra_pcore_preserving x y cx) as (?&?&?); eauto 10.
+ destruct (cmra_pcore_mono x y cx) as (?&?&?); eauto 10.
+ destruct (pcore x) as [cx|] eqn:?; eauto.
destruct (cmra_pcore_proper x y cx) as (?&?&?); eauto 10.
- intros n [x|] [y|]; rewrite /validN /option_validN /=;
@@ -1102,7 +1102,7 @@ Proof.
split; first apply _.
- intros n [x|] ?; rewrite /cmra_validN //=. by apply (validN_preserving f).
- intros mx my; rewrite !option_included.
- intros [->|(x&y&->&->&[?|Hxy])]; simpl; eauto 10 using @included_preserving.
+ intros [->|(x&y&->&->&[?|Hxy])]; simpl; eauto 10 using @cmra_monotone.
right; exists (f x), (f y). by rewrite {4}Hxy; eauto.
Qed.
Program Definition optionURF (F : rFunctor) : urFunctor := {|
diff --git a/algebra/coPset.v b/algebra/coPset.v
new file mode 100644
index 0000000000000000000000000000000000000000..adaa01d0add074c073b09bcb3bd3bf07984f7657
--- /dev/null
+++ b/algebra/coPset.v
@@ -0,0 +1,56 @@
+From iris.algebra Require Export cmra.
+From iris.algebra Require Import updates local_updates.
+From iris.prelude Require Export collections coPset.
+
+(** This is pretty much the same as algebra/gset, but I was not able to
+generalize the construction without breaking canonical structures. *)
+
+Inductive coPset_disj :=
+ | CoPset : coPset → coPset_disj
+ | CoPsetBot : coPset_disj.
+
+Section coPset.
+ Arguments op _ _ !_ !_ /.
+ Canonical Structure coPset_disjC := leibnizC coPset_disj.
+
+ Instance coPset_disj_valid : Valid coPset_disj := λ X,
+ match X with CoPset _ => True | CoPsetBot => False end.
+ Instance coPset_disj_empty : Empty coPset_disj := CoPset ∅.
+ Instance coPset_disj_op : 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.
+ Instance coPset_disj_pcore : 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_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.
+
+ Lemma coPset_disj_ucmra_mixin : UCMRAMixin coPset_disj.
+ Proof. split; try apply _ || done. intros [X|]; coPset_disj_solve. Qed.
+ Canonical Structure coPset_disjUR :=
+ discreteUR coPset_disj coPset_disj_ra_mixin coPset_disj_ucmra_mixin.
+End coPset.
diff --git a/algebra/cofe.v b/algebra/cofe.v
index 826db73562ec90fe213ce57cf59d628019473621..3d43b09e74edd725186d30275af741ed72d3bb97 100644
--- a/algebra/cofe.v
+++ b/algebra/cofe.v
@@ -208,12 +208,45 @@ Section fixpoint.
End fixpoint.
(** Function space *)
-Record cofeMor (A B : cofeT) : Type := CofeMor {
+Definition cofe_fun (A : Type) (B : cofeT) := A → B.
+
+Section cofe_fun.
+ Context {A : Type} {B : cofeT}.
+ Instance cofe_fun_equiv : Equiv (cofe_fun A B) := λ f g, ∀ x, f x ≡ g x.
+ Instance cofe_fun_dist : Dist (cofe_fun A B) := λ n f g, ∀ x, f x ≡{n}≡ g x.
+ Program Definition cofe_fun_chain `(c : chain (cofe_fun A B))
+ (x : A) : chain B := {| chain_car n := c n x |}.
+ Next Obligation. intros c x n i ?. by apply (chain_cauchy c). Qed.
+ Program Instance cofe_fun_compl : Compl (cofe_fun A B) := λ c x,
+ compl (cofe_fun_chain c x).
+ Definition cofe_fun_cofe_mixin : CofeMixin (cofe_fun 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).
+ - by intros n f g ? x; apply dist_S.
+ - intros n c x. apply (conv_compl n (cofe_fun_chain c x)).
+ Qed.
+ Canonical Structure cofe_funC := CofeT (cofe_fun A B) cofe_fun_cofe_mixin.
+End cofe_fun.
+
+Arguments cofe_funC : clear implicits.
+Notation "A -c> B" :=
+ (cofe_funC A B) (at level 99, B at level 200, right associativity).
+Instance cofe_fun_inhabited {A} {B : cofeT} `{Inhabited B} :
+ Inhabited (A -c> B) := populate (λ _, inhabitant).
+
+(** Non-expansive function space *)
+Record cofe_mor (A B : cofeT) : Type := CofeMor {
cofe_mor_car :> A → B;
cofe_mor_ne n : Proper (dist n ==> dist n) cofe_mor_car
}.
Arguments CofeMor {_ _} _ {_}.
-Add Printing Constructor cofeMor.
+Add Printing Constructor cofe_mor.
Existing Instance cofe_mor_ne.
Notation "'λne' x .. y , t" :=
@@ -222,20 +255,20 @@ Notation "'λne' x .. y , t" :=
Section cofe_mor.
Context {A B : cofeT}.
- Global Instance cofe_mor_proper (f : cofeMor A B) : Proper ((≡) ==> (≡)) f.
+ Global Instance cofe_mor_proper (f : cofe_mor A B) : Proper ((≡) ==> (≡)) f.
Proof. apply ne_proper, cofe_mor_ne. Qed.
- Instance cofe_mor_equiv : Equiv (cofeMor A B) := λ f g, ∀ x, f x ≡ g x.
- Instance cofe_mor_dist : Dist (cofeMor A B) := λ n f g, ∀ x, f x ≡{n}≡ g x.
- Program Definition fun_chain `(c : chain (cofeMor A B)) (x : A) : chain B :=
- {| chain_car n := c n x |}.
+ Instance cofe_mor_equiv : Equiv (cofe_mor A B) := λ f g, ∀ x, f x ≡ g x.
+ Instance cofe_mor_dist : Dist (cofe_mor A B) := λ n f g, ∀ x, f x ≡{n}≡ g x.
+ Program Definition cofe_mor_chain `(c : chain (cofe_mor A B))
+ (x : A) : chain B := {| chain_car n := c n x |}.
Next Obligation. intros c x n i ?. by apply (chain_cauchy c). Qed.
- Program Instance cofe_mor_compl : Compl (cofeMor A B) := λ c,
- {| cofe_mor_car x := compl (fun_chain c x) |}.
+ Program Instance cofe_mor_compl : Compl (cofe_mor A B) := λ c,
+ {| cofe_mor_car x := compl (cofe_mor_chain c x) |}.
Next Obligation.
- intros c n x y Hx. by rewrite (conv_compl n (fun_chain c x))
- (conv_compl n (fun_chain c y)) /= Hx.
+ intros c n x y Hx. by rewrite (conv_compl n (cofe_mor_chain c x))
+ (conv_compl n (cofe_mor_chain c y)) /= Hx.
Qed.
- Definition cofe_mor_cofe_mixin : CofeMixin (cofeMor A B).
+ Definition cofe_mor_cofe_mixin : CofeMixin (cofe_mor A B).
Proof.
split.
- intros f g; split; [intros Hfg n k; apply equiv_dist, Hfg|].
@@ -246,23 +279,24 @@ Section cofe_mor.
+ by intros f g h ?? x; trans (g x).
- by intros n f g ? x; apply dist_S.
- intros n c x; simpl.
- by rewrite (conv_compl n (fun_chain c x)) /=.
+ by rewrite (conv_compl n (cofe_mor_chain c x)) /=.
Qed.
- Canonical Structure cofe_mor : cofeT := CofeT (cofeMor A B) cofe_mor_cofe_mixin.
+ Canonical Structure cofe_morC := CofeT (cofe_mor A B) cofe_mor_cofe_mixin.
Global Instance cofe_mor_car_ne n :
Proper (dist n ==> dist n ==> dist n) (@cofe_mor_car A B).
Proof. intros f g Hfg x y Hx; rewrite Hx; apply Hfg. Qed.
Global Instance cofe_mor_car_proper :
Proper ((≡) ==> (≡) ==> (≡)) (@cofe_mor_car A B) := ne_proper_2 _.
- Lemma cofe_mor_ext (f g : cofeMor A B) : f ≡ g ↔ ∀ x, f x ≡ g x.
+ Lemma cofe_mor_ext (f g : cofe_mor A B) : f ≡ g ↔ ∀ x, f x ≡ g x.
Proof. done. Qed.
End cofe_mor.
-Arguments cofe_mor : clear implicits.
-Infix "-n>" := cofe_mor (at level 45, right associativity).
-Instance cofe_more_inhabited {A B : cofeT} `{Inhabited B} :
- Inhabited (A -n> B) := populate (CofeMor (λ _, inhabitant)).
+Arguments cofe_morC : clear implicits.
+Notation "A -n> B" :=
+ (cofe_morC A B) (at level 99, B at level 200, right associativity).
+Instance cofe_mor_inhabited {A B : cofeT} `{Inhabited B} :
+ Inhabited (A -n> B) := populate (λne _, inhabitant).
(** Identity and composition and constant function *)
Definition cid {A} : A -n> A := CofeMor id.
@@ -406,7 +440,7 @@ Proof.
Qed.
Program Definition cofe_morCF (F1 F2 : cFunctor) : cFunctor := {|
- cFunctor_car A B := cofe_mor (cFunctor_car F1 B A) (cFunctor_car F2 A B);
+ cFunctor_car A B := cFunctor_car F1 B A -n> cFunctor_car F2 A B;
cFunctor_map A1 A2 B1 B2 fg :=
cofe_morC_map (cFunctor_map F1 (fg.2, fg.1)) (cFunctor_map F2 fg)
|}.
diff --git a/algebra/csum.v b/algebra/csum.v
index c4f87af3d22a83e13e5c650a445c088664a593e9..a1d053517d42620852e5384082054203d5233705 100644
--- a/algebra/csum.v
+++ b/algebra/csum.v
@@ -1,5 +1,5 @@
-From iris.algebra Require Export cmra updates.
-From iris.algebra Require Import upred.
+From iris.algebra Require Export cmra.
+From iris.algebra Require Import upred updates local_updates.
Local Arguments pcore _ _ !_ /.
Local Arguments cmra_pcore _ !_ /.
Local Arguments validN _ _ _ !_ /.
@@ -202,10 +202,10 @@ Proof.
- 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_preserving a a' ca) as (ca'&->&?); auto.
+ 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_preserving b b' cb) as (cb'&->&?); auto.
+ 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'.
@@ -330,7 +330,7 @@ Proof.
- intros n [a|b|]; simpl; auto using validN_preserving.
- intros x y; rewrite !csum_included.
intros [->|[(a&a'&->&->&?)|(b&b'&->&->&?)]]; simpl;
- eauto 10 using included_preserving.
+ eauto 10 using cmra_monotone.
Qed.
Program Definition csumRF (Fa Fb : rFunctor) : rFunctor := {|
diff --git a/algebra/dra.v b/algebra/dra.v
index ce053438cce74bb4699c754957398e8a0d03cd2a..059729ff008246b40701209fa586afc270d88133 100644
--- a/algebra/dra.v
+++ b/algebra/dra.v
@@ -20,7 +20,7 @@ Record DRAMixin A `{Equiv A, Core A, Disjoint A, Op A, Valid A} := {
mixin_dra_core_disjoint_l x : ✓ x → core x ⊥ x;
mixin_dra_core_l x : ✓ x → core x ⋅ x ≡ x;
mixin_dra_core_idemp x : ✓ x → core (core x) ≡ core x;
- mixin_dra_core_preserving x y :
+ mixin_dra_core_mono x y :
∃ z, ✓ x → ✓ y → x ⊥ y → core (x ⋅ y) ≡ core x ⋅ z ∧ ✓ z ∧ core x ⊥ z
}.
Structure draT := DRAT {
@@ -78,9 +78,9 @@ Section dra_mixin.
Proof. apply (mixin_dra_core_l _ (dra_mixin A)). Qed.
Lemma dra_core_idemp x : ✓ x → core (core x) ≡ core x.
Proof. apply (mixin_dra_core_idemp _ (dra_mixin A)). Qed.
- Lemma dra_core_preserving x y :
+ Lemma dra_core_mono x y :
∃ z, ✓ x → ✓ y → x ⊥ y → core (x ⋅ y) ≡ core x ⋅ z ∧ ✓ z ∧ core x ⊥ z.
- Proof. apply (mixin_dra_core_preserving _ (dra_mixin A)). Qed.
+ Proof. apply (mixin_dra_core_mono _ (dra_mixin A)). Qed.
End dra_mixin.
Record validity (A : draT) := Validity {
@@ -166,7 +166,7 @@ Proof.
naive_solver eauto using dra_core_l, dra_core_disjoint_l.
- intros [x px ?]; split; naive_solver eauto using dra_core_idemp.
- intros [x px ?] [y py ?] [[z pz ?] [? Hy]]; simpl in *.
- destruct (dra_core_preserving x z) as (z'&Hz').
+ destruct (dra_core_mono x z) as (z'&Hz').
unshelve eexists (Validity z' (px ∧ py ∧ pz) _); [|split; simpl].
{ intros (?&?&?); apply Hz'; tauto. }
+ tauto.
diff --git a/algebra/gmap.v b/algebra/gmap.v
index 948d7f97ed0ee5f07d0cb23b5f0a418e7fa4d1d5..c0e59099a938be9bfa46d84683d27cbc8e32a458 100644
--- a/algebra/gmap.v
+++ b/algebra/gmap.v
@@ -1,6 +1,6 @@
-From iris.algebra Require Export cmra updates.
+From iris.algebra Require Export cmra.
From iris.prelude Require Export gmap.
-From iris.algebra Require Import upred.
+From iris.algebra Require Import upred updates local_updates.
Section cofe.
Context `{Countable K} {A : cofeT}.
@@ -134,7 +134,7 @@ Proof.
- 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_preserving.
+ 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 m1 m2 Hm Hm12.
@@ -205,15 +205,12 @@ Qed.
Lemma singleton_valid i x : ✓ ({[ i := x ]} : gmap K A) ↔ ✓ x.
Proof. rewrite !cmra_valid_validN. by setoid_rewrite singleton_validN. Qed.
-Lemma insert_singleton_opN n m i x :
- m !! i = None → <[i:=x]> m ≡{n}≡ {[ i := x ]} ⋅ m.
+Lemma insert_singleton_op m i x : m !! i = None → <[i:=x]> m = {[ i := x ]} ⋅ m.
Proof.
- intros Hi j; destruct (decide (i = j)) as [->|].
- - by rewrite lookup_op lookup_insert lookup_singleton Hi right_id.
- - by rewrite lookup_op lookup_insert_ne // lookup_singleton_ne // left_id.
+ 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 insert_singleton_op m i x : m !! i = None → <[i:=x]> m ≡ {[ i := x ]} ⋅ m.
-Proof. rewrite !equiv_dist; naive_solver eauto using insert_singleton_opN. Qed.
Lemma core_singleton (i : K) (x : A) cx :
pcore x = Some cx → core ({[ i := x ]} : gmap K A) = {[ i := cx ]}.
@@ -252,9 +249,9 @@ Proof.
* by rewrite Hi lookup_op lookup_singleton lookup_delete.
* by rewrite lookup_op lookup_singleton_ne // lookup_delete_ne // left_id.
Qed.
-Lemma dom_op m1 m2 : dom (gset K) (m1 ⋅ m2) ≡ dom _ m1 ∪ dom _ m2.
+Lemma dom_op m1 m2 : dom (gset K) (m1 ⋅ m2) = dom _ m1 ∪ dom _ m2.
Proof.
- apply elem_of_equiv; intros i; rewrite elem_of_union !elem_of_dom.
+ apply elem_of_equiv_L=> i; rewrite elem_of_union !elem_of_dom.
unfold is_Some; setoid_rewrite lookup_op.
destruct (m1 !! i), (m2 !! i); naive_solver.
Qed.
@@ -303,8 +300,8 @@ Section freshness.
{ rewrite -not_elem_of_union -dom_op -not_elem_of_union; apply is_fresh. }
exists (<[i:=x]>m); split.
{ by apply HQ; last done; apply not_elem_of_dom. }
- rewrite insert_singleton_opN; last by apply not_elem_of_dom.
- rewrite -assoc -insert_singleton_opN;
+ rewrite insert_singleton_op; last by apply not_elem_of_dom.
+ rewrite -assoc -insert_singleton_op;
last by apply not_elem_of_dom; rewrite dom_op not_elem_of_union.
by apply insert_validN; [apply cmra_valid_validN|].
Qed.
@@ -402,7 +399,7 @@ Proof.
split; try apply _.
- by intros n m ? i; rewrite lookup_fmap; apply (validN_preserving _).
- intros m1 m2; rewrite !lookup_included=> Hm i.
- by rewrite !lookup_fmap; apply: included_preserving.
+ by rewrite !lookup_fmap; apply: cmra_monotone.
Qed.
Definition gmapC_map `{Countable K} {A B} (f: A -n> B) :
gmapC K A -n> gmapC K B := CofeMor (fmap f : gmapC K A → gmapC K B).
diff --git a/algebra/gset.v b/algebra/gset.v
index 79958aa8f2bccba5d0a260f12a8bca6375e1e7f8..c60bd02cd2eb8cd673f0a4ef89341ecfc098ddd9 100644
--- a/algebra/gset.v
+++ b/algebra/gset.v
@@ -1,46 +1,89 @@
-From iris.algebra Require Export gmap.
-From iris.algebra Require Import excl.
-From iris.prelude Require Import mapset.
+From iris.algebra Require Export cmra.
+From iris.algebra Require Import updates local_updates.
+From iris.prelude Require Export collections gmap.
-Definition gsetC K `{Countable K} := gmapC K (exclC unitC).
-
-Definition to_gsetC `{Countable K} (X : gset K) : gsetC K :=
- to_gmap (Excl ()) X.
+Inductive gset_disj K `{Countable K} :=
+ | GSet : gset K → gset_disj K
+ | GSetBot : gset_disj K.
+Arguments GSet {_ _ _} _.
+Arguments GSetBot {_ _ _}.
Section gset.
-Context `{Countable K}.
-Implicit Types X Y : gset K.
-
-Lemma to_gsetC_empty : to_gsetC (∅ : gset K) = ∅.
-Proof. apply to_gmap_empty. Qed.
-Lemma to_gsetC_union X Y : X ⊥ Y → to_gsetC X ⋅ to_gsetC Y = to_gsetC (X ∪ Y).
-Proof.
- intros HXY; apply: map_eq=> i; rewrite /to_gsetC /=.
- rewrite lookup_op !lookup_to_gmap. repeat case_option_guard; set_solver.
-Qed.
-Lemma to_gsetC_valid X : ✓ to_gsetC X.
-Proof. intros i. rewrite /to_gsetC lookup_to_gmap. by case_option_guard. Qed.
-Lemma to_gsetC_valid_op X Y : ✓ (to_gsetC X ⋅ to_gsetC Y) ↔ X ⊥ Y.
-Proof.
- split; last (intros; rewrite to_gsetC_union //; apply to_gsetC_valid).
- intros HXY i ??; move: (HXY i); rewrite lookup_op !lookup_to_gmap.
- rewrite !option_guard_True //.
-Qed.
-
-Context `{Fresh K (gset K), !FreshSpec K (gset K)}.
-Lemma updateP_alloc_strong (Q : gsetC K → Prop) (I : gset K) X :
- (∀ i, i ∉ X → i ∉ I → Q (to_gsetC ({[i]} ∪ X))) → to_gsetC X ~~>: Q.
-Proof.
- intros; apply updateP_alloc_strong with I (Excl ()); [done|]=> i.
- rewrite /to_gsetC lookup_to_gmap_None -to_gmap_union_singleton; eauto.
-Qed.
-Lemma updateP_alloc (Q : gsetC K → Prop) X :
- (∀ i, i ∉ X → Q (to_gsetC ({[i]} ∪ X))) → to_gsetC X ~~>: Q.
-Proof. move=>??. eapply updateP_alloc_strong with (I:=∅); by eauto. Qed.
-Lemma updateP_alloc_strong' (I : gset K) X :
- to_gsetC X ~~>: λ Y : gsetC K, ∃ i, Y = to_gsetC ({[ i ]} ∪ X) ∧ i ∉ I ∧ i ∉ X.
-Proof. eauto using updateP_alloc_strong. Qed.
-Lemma updateP_alloc' X :
- to_gsetC X ~~>: λ Y : gsetC K, ∃ i, Y = to_gsetC ({[ i ]} ∪ X) ∧ i ∉ X.
-Proof. eauto using updateP_alloc. Qed.
-End gset.
\ No newline at end of file
+ Context `{Countable K}.
+ Arguments op _ _ !_ !_ /.
+
+ Canonical Structure gset_disjC := leibnizC (gset_disj K).
+
+ Instance gset_disj_valid : Valid (gset_disj K) := λ X,
+ match X with GSet _ => True | GSetBot => False end.
+ Instance gset_disj_empty : Empty (gset_disj K) := GSet ∅.
+ Instance gset_disj_op : 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.
+ Instance gset_disj_pcore : 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_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.
+
+ Lemma gset_disj_ucmra_mixin : UCMRAMixin (gset_disj K).
+ Proof. split; try apply _ || done. intros [X|]; gset_disj_solve. Qed.
+ Canonical Structure gset_disjUR :=
+ discreteUR (gset_disj K) gset_disj_ra_mixin gset_disj_ucmra_mixin.
+
+ Context `{Fresh K (gset K), !FreshSpec K (gset K)}.
+ Arguments op _ _ _ _ : simpl never.
+
+ Lemma gset_alloc_updateP_strong (Q : gset_disj K → Prop) (I : gset K) X :
+ (∀ i, i ∉ X → i ∉ I → Q (GSet ({[i]} ∪ X))) → GSet X ~~>: Q.
+ Proof.
+ intros HQ; apply cmra_discrete_updateP=> ? /gset_disj_valid_inv_l [Y [->?]].
+ destruct (exist_fresh (X ∪ Y ∪ I)) as [i ?].
+ exists (GSet ({[ i ]} ∪ X)); split.
+ - apply HQ; set_solver by eauto.
+ - apply gset_disj_valid_op. set_solver by eauto.
+ Qed.
+ Lemma gset_alloc_updateP (Q : gset_disj K → Prop) X :
+ (∀ i, i ∉ X → Q (GSet ({[i]} ∪ X))) → GSet X ~~>: Q.
+ Proof. move=>??. eapply gset_alloc_updateP_strong with (I:=∅); by eauto. Qed.
+ Lemma gset_alloc_updateP_strong' (I : gset K) X :
+ GSet X ~~>: λ Y, ∃ i, Y = GSet ({[ i ]} ∪ X) ∧ i ∉ I ∧ i ∉ X.
+ Proof. eauto using gset_alloc_updateP_strong. Qed.
+ Lemma gset_alloc_updateP' X : GSet X ~~>: λ Y, ∃ i, Y = GSet ({[ i ]} ∪ X) ∧ i ∉ X.
+ Proof. eauto using gset_alloc_updateP. Qed.
+
+ Lemma gset_alloc_local_update X i Xf :
+ i ∉ X → i ∉ Xf → GSet X ~l~> GSet ({[i]} ∪ X) @ Some (GSet Xf).
+ Proof.
+ intros ??; apply local_update_total; split; simpl.
+ - rewrite !gset_disj_valid_op; set_solver.
+ - intros mZ ?%gset_disj_valid_op HXf.
+ rewrite -gset_disj_union -?assoc ?HXf ?cmra_opM_assoc; set_solver.
+ Qed.
+End gset.
+
+Arguments gset_disjR _ {_ _}.
+Arguments gset_disjUR _ {_ _}.
diff --git a/algebra/iprod.v b/algebra/iprod.v
index 06fc17e017ffb67521709121085b8c17e22ad9dd..312017cea454555ce4d2e965ba03bdc6a7e4e26d 100644
--- a/algebra/iprod.v
+++ b/algebra/iprod.v
@@ -114,7 +114,7 @@ Section iprod_cmra.
- by intros f x; rewrite iprod_lookup_op iprod_lookup_core cmra_core_l.
- by intros f x; rewrite iprod_lookup_core cmra_core_idemp.
- intros f1 f2; rewrite !iprod_included_spec=> Hf x.
- by rewrite iprod_lookup_core; apply cmra_core_preserving, Hf.
+ by rewrite iprod_lookup_core; apply cmra_core_mono, Hf.
- intros n f1 f2 Hf x; apply cmra_validN_op_l with (f2 x), Hf.
- intros n f f1 f2 Hf Hf12.
set (g x := cmra_extend n (f x) (f1 x) (f2 x) (Hf x) (Hf12 x)).
@@ -282,7 +282,7 @@ Proof.
split; first apply _.
- intros n g Hg x; rewrite /iprod_map; apply (validN_preserving (f _)), Hg.
- intros g1 g2; rewrite !iprod_included_spec=> Hf x.
- rewrite /iprod_map; apply (included_preserving _), Hf.
+ rewrite /iprod_map; apply (cmra_monotone _), Hf.
Qed.
Definition iprodC_map `{Finite A} {B1 B2 : A → cofeT}
diff --git a/algebra/list.v b/algebra/list.v
index 44f4c440608ffbea6a1515910785ea0b2a29a562..3ab4d27c259f3b75a130ae1163f0814ff01d522b 100644
--- a/algebra/list.v
+++ b/algebra/list.v
@@ -1,6 +1,6 @@
-From iris.algebra Require Export cmra updates.
+From iris.algebra Require Export cmra.
From iris.prelude Require Export list.
-From iris.algebra Require Import upred.
+From iris.algebra Require Import upred updates local_updates.
Section cofe.
Context {A : cofeT}.
@@ -187,7 +187,7 @@ Section cmra.
- 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_preserving.
+ 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 Hl';
@@ -374,7 +374,7 @@ Proof.
- intros n l. rewrite !list_lookup_validN=> Hl i. rewrite list_lookup_fmap.
by apply (validN_preserving (fmap f : option A → option B)).
- intros l1 l2. rewrite !list_lookup_included=> Hl i. rewrite !list_lookup_fmap.
- by apply (included_preserving (fmap f : option A → option B)).
+ by apply (cmra_monotone (fmap f : option A → option B)).
Qed.
Program Definition listURF (F : urFunctor) : urFunctor := {|
diff --git a/algebra/local_updates.v b/algebra/local_updates.v
new file mode 100644
index 0000000000000000000000000000000000000000..efc3df3dec8179042bec984ca195b669491d3e8f
--- /dev/null
+++ b/algebra/local_updates.v
@@ -0,0 +1,100 @@
+From iris.algebra Require Export cmra.
+
+(** * Local updates *)
+Record local_update {A : cmraT} (mz : option A) (x y : A) := {
+ local_update_valid n : ✓{n} (x ⋅? mz) → ✓{n} (y ⋅? mz);
+ local_update_go n mz' :
+ ✓{n} (x ⋅? mz) → x ⋅? mz ≡{n}≡ x ⋅? mz' → y ⋅? mz ≡{n}≡ y ⋅? mz'
+}.
+Notation "x ~l~> y @ mz" := (local_update mz x y) (at level 70).
+Instance: Params (@local_update) 1.
+
+Section updates.
+Context {A : cmraT}.
+Implicit Types x y : A.
+
+Global Instance local_update_proper :
+ Proper ((≡) ==> (≡) ==> (≡) ==> iff) (@local_update A).
+Proof.
+ cut (Proper ((≡) ==> (≡) ==> (≡) ==> impl) (@local_update A)).
+ { intros Hproper; split; by apply Hproper. }
+ intros mz mz' Hmz x x' Hx y y' Hy [Hv Hup]; constructor; setoid_subst; auto.
+Qed.
+
+Global Instance local_update_preorder mz : PreOrder (@local_update A mz).
+Proof.
+ split.
+ - intros x; by split.
+ - intros x1 x2 x3 [??] [??]; split; eauto.
+Qed.
+
+Lemma exclusive_local_update `{!Exclusive x} y mz : ✓ y → x ~l~> y @ mz.
+Proof.
+ split; intros n.
+ - move=> /exclusiveN_opM ->. by apply cmra_valid_validN.
+ - intros mz' ? Hmz.
+ by rewrite (exclusiveN_opM n x mz) // (exclusiveN_opM n x mz') -?Hmz.
+Qed.
+
+Lemma op_local_update x1 x2 y mz :
+ x1 ~l~> x2 @ Some (y ⋅? mz) → x1 ⋅ y ~l~> x2 ⋅ y @ mz.
+Proof.
+ intros [Hv1 H1]; split.
+ - intros n. rewrite !cmra_opM_assoc. move=> /Hv1 /=; auto.
+ - intros n mz'. rewrite !cmra_opM_assoc. move=> Hv /(H1 _ (Some _) Hv) /=; auto.
+Qed.
+
+Lemma alloc_local_update x y mz :
+ (∀ n, ✓{n} (x ⋅? mz) → ✓{n} (x ⋅ y ⋅? mz)) → x ~l~> x ⋅ y @ mz.
+Proof.
+ split; first done.
+ intros n mz' _. by rewrite !(comm _ x) !cmra_opM_assoc=> ->.
+Qed.
+
+Lemma local_update_total `{CMRADiscrete A} x y mz :
+ x ~l~> y @ mz ↔
+ (✓ (x ⋅? mz) → ✓ (y ⋅? mz)) ∧
+ (∀ mz', ✓ (x ⋅? mz) → x ⋅? mz ≡ x ⋅? mz' → y ⋅? mz ≡ y ⋅? mz').
+Proof.
+ split.
+ - destruct 1. split; intros until 0;
+ rewrite !(cmra_discrete_valid_iff 0) ?(timeless_iff 0); auto.
+ - intros [??]; split; intros until 0;
+ rewrite -!cmra_discrete_valid_iff -?timeless_iff; auto.
+Qed.
+End updates.
+
+(** * Product *)
+Lemma prod_local_update {A B : cmraT} (x y : A * B) mz :
+ x.1 ~l~> y.1 @ fst <$> mz → x.2 ~l~> y.2 @ snd <$> mz →
+ x ~l~> y @ mz.
+Proof.
+ intros [Hv1 H1] [Hv2 H2]; split.
+ - intros n [??]; destruct mz; split; auto.
+ - intros n mz' [??] [??].
+ specialize (H1 n (fst <$> mz')); specialize (H2 n (snd <$> mz')).
+ destruct mz, mz'; split; naive_solver.
+Qed.
+
+(** * Option *)
+Lemma option_local_update {A : cmraT} (x y : A) mmz :
+ x ~l~> y @ mjoin mmz →
+ Some x ~l~> Some y @ mmz.
+Proof.
+ intros [Hv H]; split; first destruct mmz as [[?|]|]; auto.
+ intros n mmz'. specialize (H n (mjoin mmz')).
+ destruct mmz as [[]|], mmz' as [[]|]; inversion_clear 2; constructor; auto.
+Qed.
+
+(** * Natural numbers *)
+Lemma nat_local_update (x y : nat) mz : x ~l~> y @ mz.
+Proof.
+ split; first done.
+ compute -[plus]; destruct mz as [z|]; intros n [z'|]; lia.
+Qed.
+
+Lemma mnat_local_update (x y : mnat) mz : x ≤ y → x ~l~> y @ mz.
+Proof.
+ split; first done.
+ compute -[max]; destruct mz as [z|]; intros n [z'|]; lia.
+Qed.
diff --git a/algebra/sts.v b/algebra/sts.v
index 7950bf8cd6d86e902b095eadae399e52c6c64539..ee8570ccdf2f38826f155bf53a0738af122dbd40 100644
--- a/algebra/sts.v
+++ b/algebra/sts.v
@@ -1,4 +1,4 @@
-From iris.prelude Require Export sets.
+From iris.prelude Require Export set.
From iris.algebra Require Export cmra.
From iris.algebra Require Import dra.
Local Arguments valid _ _ !_ /.
@@ -58,7 +58,7 @@ Proof.
eauto with sts; set_solver.
Qed.
Global Instance framestep_proper : Proper ((≡) ==> (=) ==> (=) ==> iff) frame_step.
-Proof. by intros ?? [??] ??????; split; apply framestep_mono. Qed.
+Proof. move=> ?? /collection_equiv_spec [??]; split; by apply framestep_mono. Qed.
Instance closed_proper' : Proper ((≡) ==> (≡) ==> impl) closed.
Proof. destruct 3; constructor; intros until 0; setoid_subst; eauto. Qed.
Global Instance closed_proper : Proper ((≡) ==> (≡) ==> iff) closed.
@@ -70,14 +70,19 @@ Proof.
eapply elem_of_mkSet, rtc_l; [eapply Frame_step with T1 T2|]; eauto with sts.
Qed.
Global Instance up_proper : Proper ((=) ==> (≡) ==> (≡)) up.
-Proof. by intros ??? ?? [??]; split; apply up_preserving. Qed.
+Proof.
+ by move=> ??? ?? /collection_equiv_spec [??]; 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; last done. move =>s1 s2 Hs. simpl in HT. by apply up_preserving.
Qed.
Global Instance up_set_proper : Proper ((≡) ==> (≡) ==> (≡)) up_set.
-Proof. by intros S1 S2 [??] T1 T2 [??]; split; apply up_set_preserving. Qed.
+Proof.
+ move=> S1 S2 /collection_equiv_spec [??] T1 T2 /collection_equiv_spec [??];
+ split; by apply up_set_preserving.
+Qed.
(** ** Properties of closure under frame steps *)
Lemma closed_steps S T s1 s2 :
@@ -144,8 +149,8 @@ Lemma up_non_empty s T : up s T ≢ ∅.
Proof. eapply non_empty_inhabited, elem_of_up. Qed.
Lemma up_closed S T : closed S T → up_set S T ≡ S.
Proof.
- intros; split; auto using subseteq_up_set; intros s.
- unfold up_set; rewrite elem_of_bind; intros (s'&Hstep&?).
+ intros ?; apply collection_equiv_spec; 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.
@@ -363,8 +368,8 @@ 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_mkSet Hsup Hs']]]. split; first done.
+ - move=>s [HS1 HSf]. split. by apply HS1. by apply subseteq_up_set.
+ - move=>s [HS1 [s' [/elem_of_mkSet Hsup Hs']]]. split; first done.
eapply closed_steps, Hsup; first done. set_solver +Hs'.
Qed.
diff --git a/algebra/updates.v b/algebra/updates.v
index 36851cff296cf454fa3c2b37acde7c6041bcea32..012b53aaf66606f877c73f55928fbf253fc5b368 100644
--- a/algebra/updates.v
+++ b/algebra/updates.v
@@ -1,14 +1,5 @@
From iris.algebra Require Export cmra.
-(** * Local updates *)
-Record local_update {A : cmraT} (mz : option A) (x y : A) := {
- local_update_valid n : ✓{n} (x ⋅? mz) → ✓{n} (y ⋅? mz);
- local_update_go n mz' :
- ✓{n} (x ⋅? mz) → x ⋅? mz ≡{n}≡ x ⋅? mz' → y ⋅? mz ≡{n}≡ y ⋅? mz'
-}.
-Notation "x ~l~> y @ mz" := (local_update mz x y) (at level 70).
-Instance: Params (@local_update) 1.
-
(** * Frame preserving updates *)
(* This quantifies over [option A] for the frame. That is necessary to
make the following hold:
@@ -24,18 +15,10 @@ Definition cmra_update {A : cmraT} (x y : A) := ∀ n mz,
Infix "~~>" := cmra_update (at level 70).
Instance: Params (@cmra_update) 1.
-(** ** CMRAs *)
-Section cmra.
+Section updates.
Context {A : cmraT}.
Implicit Types x y : A.
-Global Instance local_update_proper :
- Proper ((≡) ==> (≡) ==> (≡) ==> iff) (@local_update A).
-Proof.
- cut (Proper ((≡) ==> (≡) ==> (≡) ==> impl) (@local_update A)).
- { intros Hproper; split; by apply Hproper. }
- intros mz mz' Hmz x x' Hx y y' Hy [Hv Hup]; constructor; setoid_subst; auto.
-Qed.
Global Instance cmra_updateP_proper :
Proper ((≡) ==> pointwise_relation _ iff ==> iff) (@cmra_updateP A).
Proof.
@@ -48,38 +31,6 @@ Proof.
rewrite /cmra_update=> x x' Hx y y' Hy; split=> ? n mz ?; setoid_subst; auto.
Qed.
-(** ** Local updates *)
-Global Instance local_update_preorder mz : PreOrder (@local_update A mz).
-Proof.
- split.
- - intros x; by split.
- - intros x1 x2 x3 [??] [??]; split; eauto.
-Qed.
-
-Lemma exclusive_local_update `{!Exclusive x} y mz : ✓ y → x ~l~> y @ mz.
-Proof.
- split; intros n.
- - move=> /exclusiveN_opM ->. by apply cmra_valid_validN.
- - intros mz' ? Hmz.
- by rewrite (exclusiveN_opM n x mz) // (exclusiveN_opM n x mz') -?Hmz.
-Qed.
-
-Lemma op_local_update x1 x2 y mz :
- x1 ~l~> x2 @ Some (y ⋅? mz) → x1 ⋅ y ~l~> x2 ⋅ y @ mz.
-Proof.
- intros [Hv1 H1]; split.
- - intros n. rewrite !cmra_opM_assoc. move=> /Hv1 /=; auto.
- - intros n mz'. rewrite !cmra_opM_assoc. move=> Hv /(H1 _ (Some _) Hv) /=; auto.
-Qed.
-
-Lemma alloc_local_update x y mz :
- (∀ n, ✓{n} (x ⋅? mz) → ✓{n} (x ⋅ y ⋅? mz)) → x ~l~> x ⋅ y @ mz.
-Proof.
- split; first done.
- intros n mz' _. by rewrite !(comm _ x) !cmra_opM_assoc=> ->.
-Qed.
-
-(** ** Frame preserving updates *)
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.
@@ -163,7 +114,7 @@ Section total_updates.
naive_solver eauto using 0.
Qed.
End total_updates.
-End cmra.
+End updates.
(** * Transport *)
Section cmra_transport.
@@ -182,17 +133,6 @@ Section prod.
Context {A B : cmraT}.
Implicit Types x : A * B.
- Lemma prod_local_update x y mz :
- x.1 ~l~> y.1 @ fst <$> mz → x.2 ~l~> y.2 @ snd <$> mz →
- x ~l~> y @ mz.
- Proof.
- intros [Hv1 H1] [Hv2 H2]; split.
- - intros n [??]; destruct mz; split; auto.
- - intros n mz' [??] [??].
- specialize (H1 n (fst <$> mz')); specialize (H2 n (snd <$> mz')).
- destruct mz, mz'; split; naive_solver.
- Qed.
-
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.
@@ -216,15 +156,6 @@ Section option.
Context {A : cmraT}.
Implicit Types x y : A.
- Lemma option_local_update x y mmz :
- x ~l~> y @ mjoin mmz →
- Some x ~l~> Some y @ mmz.
- Proof.
- intros [Hv H]; split; first destruct mmz as [[?|]|]; auto.
- intros n mmz'. specialize (H n (mjoin mmz')).
- destruct mmz as [[]|], mmz' as [[]|]; inversion_clear 2; constructor; auto.
- Qed.
-
Lemma option_updateP (P : A → Prop) (Q : option A → Prop) x :
x ~~>: P → (∀ y, P y → Q (Some y)) → Some x ~~>: Q.
Proof.
@@ -239,16 +170,3 @@ Section option.
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.
-
-(** * Natural numbers *)
-Lemma nat_local_update (x y : nat) mz : x ~l~> y @ mz.
-Proof.
- split; first done.
- compute -[plus]; destruct mz as [z|]; intros n [z'|]; lia.
-Qed.
-
-Lemma mnat_local_update (x y : mnat) mz : x ≤ y → x ~l~> y @ mz.
-Proof.
- split; first done.
- compute -[max]; destruct mz as [z|]; intros n [z'|]; lia.
-Qed.
diff --git a/algebra/upred.v b/algebra/upred.v
index 6072149717cad4add9421669ba4a36eafe5d7a47..a8fe0398abf3342910385840c277f2de42a4863b 100644
--- a/algebra/upred.v
+++ b/algebra/upred.v
@@ -50,18 +50,25 @@ Section cofe.
End cofe.
Arguments uPredC : clear implicits.
-Instance uPred_ne' {M} (P : uPred M) n : Proper (dist n ==> iff) (P n).
+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.
Instance uPred_proper {M} (P : uPred M) n : Proper ((≡) ==> iff) (P n).
-Proof. by intros x1 x2 Hx; apply uPred_ne', equiv_dist. Qed.
+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.
+ eapply uPred_closed; eauto using cmra_validN_le.
+Qed.
(** functor *)
Program Definition uPred_map {M1 M2 : ucmraT} (f : M2 -n> M1)
`{!CMRAMonotone f} (P : uPred M1) :
uPred M2 := {| uPred_holds n x := P n (f x) |}.
-Next Obligation. naive_solver eauto using uPred_mono, includedN_preserving. Qed.
+Next Obligation. naive_solver eauto using uPred_mono, cmra_monotoneN. Qed.
Next Obligation. naive_solver eauto using uPred_closed, validN_preserving. Qed.
Instance uPred_map_ne {M1 M2 : ucmraT} (f : M2 -n> M1)
@@ -205,7 +212,7 @@ Program Definition uPred_wand_def {M} (P Q : uPred M) : uPred M :=
Next Obligation.
intros M P Q n x1 x1' HPQ ? n3 x3 ???; simpl in *.
apply uPred_mono with (x1 â‹… x3);
- eauto using cmra_validN_includedN, cmra_preservingN_r, cmra_includedN_le.
+ eauto using cmra_validN_includedN, cmra_monoN_r, cmra_includedN_le.
Qed.
Next Obligation. naive_solver. Qed.
Definition uPred_wand_aux : { x | x = @uPred_wand_def }. by eexists. Qed.
@@ -216,7 +223,7 @@ Definition uPred_wand_eq :
Program Definition uPred_always_def {M} (P : uPred M) : uPred M :=
{| uPred_holds n x := P n (core x) |}.
Next Obligation.
- intros M; naive_solver eauto using uPred_mono, @cmra_core_preservingN.
+ intros M; naive_solver eauto using uPred_mono, @cmra_core_monoN.
Qed.
Next Obligation. naive_solver eauto using uPred_closed, @cmra_core_validN. Qed.
Definition uPred_always_aux : { x | x = @uPred_always_def }. by eexists. Qed.
@@ -1031,7 +1038,7 @@ Qed.
Lemma always_ownM (a : M) : Persistent a → □ uPred_ownM a ⊣⊢ uPred_ownM a.
Proof.
split=> n x /=; split; [by apply always_elim|unseal; intros Hx]; simpl.
- rewrite -(persistent_core a). by apply cmra_core_preservingN.
+ rewrite -(persistent_core a). by apply cmra_core_monoN.
Qed.
Lemma ownM_something : True ⊢ ∃ a, uPred_ownM a.
Proof. unseal; split=> n x ??. by exists x; simpl. Qed.
diff --git a/algebra/upred_big_op.v b/algebra/upred_big_op.v
index ed9b36a3c718076a71cb16c7fdfef5cb212d429c..85e2b334696d2fa2a0af9d1c6bee29394ef9840f 100644
--- a/algebra/upred_big_op.v
+++ b/algebra/upred_big_op.v
@@ -120,15 +120,12 @@ Section gmap.
- apply big_sep_mono', Forall2_fmap, Forall_Forall2.
apply Forall_forall=> -[i x] ? /=. by apply HΦ, elem_of_map_to_list.
Qed.
- Lemma big_sepM_proper Φ Ψ m1 m2 :
- m1 ≡ m2 → (∀ k x, m1 !! k = Some x → m2 !! k = Some x → Φ k x ⊣⊢ Ψ k x) →
- ([★ map] k ↦ x ∈ m1, Φ k x) ⊣⊢ ([★ map] k ↦ x ∈ m2, Ψ k x).
+ 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.
- (* FIXME: Coq bug since 8.5pl1. Without the @ in [@lookup_weaken] it gives
- File "./algebra/upred_big_op.v", line 114, characters 4-131:
- Anomaly: Uncaught exception Univ.AlreadyDeclared. Please report. *)
- intros [??] ?; apply (anti_symm (⊢)); apply big_sepM_mono;
- eauto using equiv_entails, equiv_entails_sym, @lookup_weaken.
+ intros ?; apply (anti_symm (⊢)); apply big_sepM_mono;
+ eauto using equiv_entails, equiv_entails_sym, lookup_weaken.
Qed.
Global Instance big_sepM_ne m n :
@@ -194,7 +191,7 @@ Section gmap.
⊣⊢ (Ψ i x b ★ [★ map] k↦y ∈ m, Ψ k y (f k)).
Proof.
intros. rewrite big_sepM_insert // fn_lookup_insert.
- apply sep_proper, big_sepM_proper; auto=> k y ??.
+ apply sep_proper, big_sepM_proper; auto=> k y ?.
by rewrite fn_lookup_insert_ne; last set_solver.
Qed.
Lemma big_sepM_fn_insert' (Φ : K → uPred M) m i x P :
@@ -278,8 +275,8 @@ Section gset.
X ≡ Y → (∀ x, x ∈ X → x ∈ Y → Φ x ⊣⊢ Ψ x) →
([★ set] x ∈ X, Φ x) ⊣⊢ ([★ set] x ∈ Y, Ψ x).
Proof.
- intros [??] ?; apply (anti_symm (⊢)); apply big_sepS_mono;
- eauto using equiv_entails, equiv_entails_sym.
+ move=> /collection_equiv_spec [??] ?; apply (anti_symm (⊢));
+ apply big_sepS_mono; eauto using equiv_entails, equiv_entails_sym.
Qed.
Lemma big_sepS_ne X n :
diff --git a/benchmark/gitlab-extract.py b/benchmark/gitlab-extract.py
index 8be4a51da8d585c47cbe0bb42c079d6c1c10b299..5e9db68f8ef00751be052bca57ad6b10d659ca73 100755
--- a/benchmark/gitlab-extract.py
+++ b/benchmark/gitlab-extract.py
@@ -61,9 +61,8 @@ for commit in parse_log.parse_git_commits(args.commits):
# no build
continue
build = first(sorted(builds.json(), key = lambda b: -int(b['id'])))
- assert build is not None
- if build['status'] == 'failed':
- # build failed
+ if build is None or build['status'] == 'failed':
+ # build failed (or missing...??)
continue
if build['status'] == 'running':
# build still running, don't fetch this or any later commit
diff --git a/docs/algebra.tex b/docs/algebra.tex
index e6fd00b9e673228b5da8c05ee650e48657cfadd7..c22f0baa7a314ce5dd47baf87a313cb3484f29a8 100644
--- a/docs/algebra.tex
+++ b/docs/algebra.tex
@@ -64,57 +64,70 @@ Note that the composition of non-expansive (bi)functors is non-expansive, and th
\begin{defn}
A \emph{resource algebra} (RA) is a tuple \\
- $(\monoid, \mval \subseteq \monoid, \mcore{-}:
- \monoid \to \monoid, (\mtimes) : \monoid \times \monoid \to \monoid)$ satisfying
+ $(\monoid, \mval \subseteq \monoid, \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 \mtimes \melt = \melt \tagH{ra-core-id} \\
- \All \melt.& \mcore{\mcore\melt} = \mcore\melt \tagH{ra-core-idem} \\
- \All \melt, \meltB.& \melt \mincl \meltB \Ra \mcore\melt \mincl \mcore\meltB \tagH{ra-core-mono} \\
+ \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.& (\melt \mtimes \meltB) \in \mval \Ra \melt \in \mval \tagH{ra-valid-op} \\
\text{where}\qquad %\qquad\\
- \melt \mincl \meltB \eqdef{}& \Exists \meltC. \meltB = \melt \mtimes \meltC \tagH{ra-incl}
+ \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}
\noindent
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 operation (\ruleref{ra-valid-op}).
-\item Instead of a single unit that is an identity to every element, there is a function $\mcore{-}$ assigning to every 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 usual \emph{extension order}, which is defined similar to PCMs (\ruleref{ra-incl}).
+\item The composition operation on RAs is total (as opposed to the partial composition operation of a PCM), but there is a specific subset $\mval$ of \emph{valid} elements that is compatible with the composition operation (\ruleref{ra-valid-op}).
- This idea of a core is closely related to the concept of \emph{multi-unit separation algebras}~\cite{Dockins+:aplas09}, with the key difference that the core is a \emph{function} defining a \emph{canonical} ``unit'' $\mcore\melt$ for every element~$\melt$.
+This take on partiality is necessary when defining the structure of \emph{higher-order} ghost state, CMRAs, 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 domain 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 \melt_\f. \melt \mtimes \melt_\f \in \mval \Ra \Exists \meltB \in \meltsB. \meltB \mtimes \melt_\f \in \mval \]
+ \[ \All \maybe{\melt_\f} \in \maybe\monoid. \melt \mtimes \maybe{\melt_\f} \in \mval \Ra \Exists \meltB \in \meltsB. \meltB \mtimes \maybe{\melt_\f} \in \mval \]
We further define $\melt \mupd \meltB \eqdef \melt \mupd \set\meltB$.
\end{defn}
-The assertion $\melt \mupd \meltsB$ says that every element $\melt_\f$ compatible with $\melt$ (we also call such elements \emph{frames}), must also be compatible with some $\meltB \in \meltsB$.
+The assertion $\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{CMRA}
\begin{defn}
- A \emph{CMRA} is a tuple $(\monoid : \COFEs, (\mval_n \subseteq \monoid)_{n \in \mathbb{N}}, \mcore{-}: \monoid \nfn \monoid, (\mtimes) : \monoid \times \monoid \nfn \monoid)$ satisfying
+ A \emph{CMRA} is a tuple $(\monoid : \COFEs, (\mval_n \subseteq \monoid)_{n \in \mathbb{N}},\\ \mcore{{-}}: \monoid \nfn \maybe\monoid, (\mtimes) : \monoid \times \monoid \nfn \monoid)$ satisfying:
\begin{align*}
\All n, \melt, \meltB.& \melt \nequiv{n} \meltB \land \melt\in\mval_n \Ra \meltB\in\mval_n \tagH{cmra-valid-ne} \\
- \All n, m.& n \geq m \Ra V_n \subseteq V_m \tagH{cmra-valid-mono} \\
+ \All n, m.& n \geq m \Ra \mval_n \subseteq \mval_m \tagH{cmra-valid-mono} \\
\All \melt, \meltB, \meltC.& (\melt \mtimes \meltB) \mtimes \meltC = \melt \mtimes (\meltB \mtimes \meltC) \tagH{cmra-assoc} \\
\All \melt, \meltB.& \melt \mtimes \meltB = \meltB \mtimes \melt \tagH{cmra-comm} \\
- \All \melt.& \mcore\melt \mtimes \melt = \melt \tagH{cmra-core-id} \\
- \All \melt.& \mcore{\mcore\melt} = \mcore\melt \tagH{cmra-core-idem} \\
- \All \melt, \meltB.& \melt \mincl \meltB \Ra \mcore\melt \mincl \mcore\meltB \tagH{cmra-core-mono} \\
+ \All \melt.& \mcore\melt \in \monoid \Ra \mcore\melt \mtimes \melt = \melt \tagH{cmra-core-id} \\
+ \All \melt.& \mcore\melt \in \monoid \Ra \mcore{\mcore\melt} = \mcore\melt \tagH{cmra-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{cmra-core-mono} \\
\All n, \melt, \meltB.& (\melt \mtimes \meltB) \in \mval_n \Ra \melt \in \mval_n \tagH{cmra-valid-op} \\
\All n, \melt, \meltB_1, \meltB_2.& \omit\rlap{$\melt \in \mval_n \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{cmra-extend} \\
\text{where}\qquad\qquad\\
- \melt \mincl \meltB \eqdef{}& \Exists \meltC. \meltB = \melt \mtimes \meltC \tagH{cmra-incl}\\
+ \melt \mincl \meltB \eqdef{}& \Exists \meltC. \meltB = \melt \mtimes \meltC \tagH{cmra-incl} \\
\melt \mincl[n] \meltB \eqdef{}& \Exists \meltC. \meltB \nequiv{n} \melt \mtimes \meltC \tagH{cmra-inclN}
\end{align*}
\end{defn}
@@ -143,12 +156,10 @@ The purpose of this axiom is to compute $\melt_1$, $\melt_2$ completing the foll
\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 existential quantification and separating conjunction:
+This operation is needed to prove that $\later$ commutes with separating conjunction:
\begin{mathpar}
- \axiom{\later(\Exists\var:\type. \prop) \Lra \Exists\var:\type. \later\prop}
- \and\axiom{\later (\prop * \propB) \Lra \later\prop * \later\propB}
+ \axiom{\later (\prop * \propB) \Lra \later\prop * \later\propB}
\end{mathpar}
-(This assumes that the type $\type$ is non-empty.)
\begin{defn}
An element $\munit$ of a CMRA $\monoid$ is called the \emph{unit} of $\monoid$ if it satisfies the following conditions:
@@ -157,12 +168,17 @@ This operation is needed to prove that $\later$ commutes with existential quanti
\item $\munit$ is a left-identity of the operation: \\
$\All \melt \in M. \munit \mtimes \melt = \melt$
\item $\munit$ is a discrete COFE element
+ \item $\munit$ is its own core: \\ $\mcore\munit = \munit$
\end{enumerate}
\end{defn}
+\begin{lem}\label{lem:cmra-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, \melt_\f. \melt \mtimes \melt_\f \in \mval_n \Ra \Exists \meltB \in \meltsB. \meltB \mtimes \melt_\f \in \mval_n \]
+ \[ \All n, \maybe{\melt_\f}. \melt \mtimes \maybe{\melt_\f} \in \mval_n \Ra \Exists \meltB \in \meltsB. \meltB \mtimes \maybe{\melt_\f} \in \mval_n \]
We further define $\melt \mupd \meltB \eqdef \melt \mupd \set\meltB$.
\end{defn}
@@ -193,7 +209,7 @@ Furthermore, discrete CMRAs can be turned into RAs by ignoring their COFE struct
\begin{defn}
The category $\CMRAs$ consists of CMRAs as objects, and monotone functions as arrows.
\end{defn}
-Note that $\CMRAs$ is a subcategory of $\COFEs$.
+Note that every object/arrow in $\CMRAs$ is also an object/arrow of $\COFEs$.
The notion of a locally non-expansive (or contractive) bifunctor naturally generalizes to bifunctors between these categories.
diff --git a/docs/constructions.tex b/docs/constructions.tex
index 03e331a135ecd68c13ec52e3e1e2f0010b340c68..cf4114d7b525dea873d4bb0b180db09f46df1f42 100644
--- a/docs/constructions.tex
+++ b/docs/constructions.tex
@@ -59,6 +59,35 @@ Frame-preserving updates on the $M_i$ lift to the product:
{f[i \mapsto \melt] \mupd \setComp{ f[i \mapsto \meltB]}{\meltB \in \meltsB}}
\end{mathpar}
+\subsection{Sum}
+\label{sec:summ}
+
+The \emph{sum CMRA} $\monoid_1 \csumm \monoid_2$ for any CMRAs $\monoid_1$ and $\monoid_2$ is defined as:
+\begin{align*}
+ \monoid_1 \csumm \monoid_2 \eqdef{}& \cinl(\melt_1:\monoid_1) \mid \cinr(\melt_2:\monoid_2) \mid \bot \\
+ \mval_n \eqdef{}& \setComp{\cinl(\melt_1)\!}{\!\melt_1 \in \mval'_n}
+ \cup \setComp{\cinr(\melt_2)\!}{\!\melt_2 \in \mval''_n} \\
+ \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*}
+The composition and core for $\cinr$ are defined symmetrically.
+The remaining cases of the composition and core are all $\bot$.
+Above, $\mval'$ refers to the validity of $\monoid_1$, and $\mval''$ to the validity of $\monoid_2$.
+
+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, n. \melt \mtimes \melt_\f \notin \mval'_n \and \meltB \in \mval''}
+ {\cinl(\melt) \mupd \cinr(\meltB)}
+\end{mathpar}
+Crucially, the second rule allows us to \emph{swap} the ``side'' of the sum that the CMRA is on if $\mval$ has \emph{no possible frame}.
+
\subsection{Finite partial function}
\label{sec:fpfnm}
@@ -118,59 +147,17 @@ There are no interesting frame-preserving updates for $\agm(\cofe)$, but we can
\axiomH{ag-agree}{\aginj(x) \mtimes \aginj(y) \in \mval_n \Ra x \nequiv{n} y}
\end{mathpar}
-\subsection{One-shot}
-
-The purpose of the one-shot CMRA is to lazily initialize the state of a ghost location.
-Given some CMRA $\monoid$, we define $\oneshotm(\monoid)$ as follows:
-\begin{align*}
- \oneshotm(\monoid) \eqdef{}& \ospending + \osshot(\monoid) + \munit + \bot \\
- \mval_n \eqdef{}& \set{\ospending, \munit} \cup \setComp{\osshot(\melt)}{\melt \in \mval_n}
-\\%\end{align*}
-%\begin{align*}
- \osshot(\melt) \mtimes \osshot(\meltB) \eqdef{}& \osshot(\melt \mtimes \meltB) \\
- \munit \mtimes \ospending \eqdef{}& \ospending \mtimes \munit \eqdef \ospending \\
- \munit \mtimes \osshot(\melt) \eqdef{}& \osshot(\melt) \mtimes \munit \eqdef \osshot(\melt)
-\end{align*}%
-Notice that $\oneshotm(\monoid)$ is a disjoint sum with the four constructors (injections) $\ospending$, $\osshot$, $\munit$ and $\bot$.
-The remaining cases of composition go to $\bot$.
-\begin{align*}
- \mcore{\ospending} \eqdef{}& \munit & \mcore{\osshot(\melt)} \eqdef{}& \mcore\melt \\
- \mcore{\munit} \eqdef{}& \munit & \mcore{\bot} \eqdef{}& \bot
-\end{align*}
-The step-indexed equivalence is inductively defined as follows:
-\begin{mathpar}
- \axiom{\ospending \nequiv{n} \ospending}
-
- \infer{\melt \nequiv{n} \meltB}{\osshot(\melt) \nequiv{n} \osshot(\meltB)}
-
- \axiom{\munit \nequiv{n} \munit}
-
- \axiom{\bot \nequiv{n} \bot}
-\end{mathpar}
-$\oneshotm(-)$ is a locally non-expansive functor from $\CMRAs$ to $\CMRAs$.
-
-We obtain the following frame-preserving updates:
-\begin{mathpar}
- \inferH{oneshot-shoot}
- {\melt \in \mval}
- {\ospending \mupd \osshot(\melt)}
-
- \inferH{oneshot-update}
- {\melt \mupd \meltsB}
- {\osshot(\melt) \mupd \setComp{\osshot(\meltB)}{\meltB \in \meltsB}}
-\end{mathpar}
\subsection{Exclusive CMRA}
Given a cofe $\cofe$, we define a CMRA $\exm(\cofe)$ such that at most one $x \in \cofe$ can be owned:
\begin{align*}
- \exm(\cofe) \eqdef{}& \exinj(\cofe) + \munit + \bot \\
- \mval_n \eqdef{}& \setComp{\melt\in\exm(\cofe)}{\melt \neq \bot} \\
- \munit \mtimes \exinj(x) \eqdef{}& \exinj(x) \mtimes \munit \eqdef \exinj(x)
+ \exm(\cofe) \eqdef{}& \exinj(\cofe) + \bot \\
+ \mval_n \eqdef{}& \setComp{\melt\in\exm(\cofe)}{\melt \neq \bot}
\end{align*}
-The remaining cases of composition go to $\bot$.
+All cases of composition go to $\bot$.
\begin{align*}
- \mcore{\exinj(x)} \eqdef{}& \munit & \mcore{\munit} \eqdef{}& \munit &
+ \mcore{\exinj(x)} \eqdef{}& \mnocore &
\mcore{\bot} \eqdef{}& \bot
\end{align*}
The step-indexed equivalence is inductively defined as follows:
diff --git a/docs/iris.sty b/docs/iris.sty
index fe64b4e90ac11fe9a53c47a4269b948610819e75..c95c30e234666529908eb1cfc76aa0555699ecb4 100644
--- a/docs/iris.sty
+++ b/docs/iris.sty
@@ -35,7 +35,7 @@
\newcommand{\upclose}{\mathord{\uparrow}}
\newcommand{\ALT}{\ |\ }
-\newcommand{\spac}{\,} % a space
+\newcommand{\spac}{\:} % a space
\def\All #1.{\forall #1.\spac}%
\def\Exists #1.{\exists #1.\spac}%
@@ -56,6 +56,8 @@
\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\}}
@@ -67,6 +69,7 @@
\end{array}
}
+\newcommand{\op}{\textrm{op}}
\newcommand{\dom}{\mathrm{dom}}
\newcommand{\cod}{\mathrm{cod}}
\newcommand{\chain}{\mathrm{chain}}
@@ -112,8 +115,6 @@
%% Some commonly used identifiers
-\newcommand{\op}{\textrm{op}}
-
\newcommand{\SProp}{\textdom{SProp}}
\newcommand{\UPred}{\textdom{UPred}}
\newcommand{\mProp}{\textdom{Prop}} % meta-level prop
@@ -144,10 +145,9 @@
\newcommand{\f}{\mathrm{f}} % for "frame"
-\newcommand{\mcar}[1]{|#1|}
-\newcommand{\mcarp}[1]{\mcar{#1}^{+}}
\newcommand{\munit}{\varepsilon}
-\newcommand{\mcore}[1]{\llparenthesis#1\rrparenthesis}
+\newcommand{\mcore}[1]{{\mid}#1{\mid}} % using "|" here makes LaTeX diverge. WTF.
+\newcommand{\mnocore}\top
\newcommand{\mtimes}{\mathbin{\cdot}}
\newcommand{\mupd}{\rightsquigarrow}
@@ -328,6 +328,9 @@
% STANDARD DERIVED CONSTRUCTIONS
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\newcommand{\unittt}{()}
+\newcommand{\unit}{1}
+
% Agreement
\newcommand{\agm}{\ensuremath{\textmon{Ag}}}
\newcommand{\aginj}{\textlog{ag}}
@@ -347,6 +350,11 @@
\newcommand{\AuthInv}{\textsf{AuthInv}}
\newcommand{\Auth}{\textsf{Auth}}
+% Sum
+\newcommand{\csumm}{\mathrel{+_{\!\bot}}}
+\newcommand{\cinl}{\textsf{inl}}
+\newcommand{\cinr}{\textsf{inr}}
+
% One-Shot
\newcommand{\oneshotm}{\ensuremath{\textmon{OneShot}}}
\newcommand{\ospending}{\textlog{pending}}
diff --git a/docs/logic.tex b/docs/logic.tex
index 24a8ca03a3b930e2aa59ea06e32d44bfc309a6bb..94b627f16a121040314d985cb3ea23dab7e99a6e 100644
--- a/docs/logic.tex
+++ b/docs/logic.tex
@@ -10,18 +10,6 @@ A \emph{language} $\Lang$ consists of a set \textdom{Expr} of \emph{expressions}
A reduction $\expr_1, \state_1 \step \expr_2, \state_2, \expr_\f$ indicates that, when $\expr_1$ reduces to $\expr$, a \emph{new thread} $\expr_\f$ is forked off.
\item All values are stuck:
\[ \expr, \_ \step \_, \_, \_ \Ra \toval(\expr) = \bot \]
-\item There is a predicate defining \emph{atomic} expressions satisfying
-\let\oldcr\cr
-\begin{mathpar}
- {\All\expr. \atomic(\expr) \Ra \toval(\expr) = \bot} \and
- {{
- \begin{inbox}
-\All\expr_1, \state_1, \expr_2, \state_2, \expr_\f. \atomic(\expr_1) \land \expr_1, \state_1 \step \expr_2, \state_2, \expr_\f \Ra {}\\\qquad\qquad\qquad\quad~~ \Exists \val_2. \toval(\expr_2) = \val_2
- \end{inbox}
-}}
-\end{mathpar}
-In other words, atomic expression \emph{reduce in one step to a value}.
-It does not matter whether they fork off an arbitrary expression.
\end{itemize}
\begin{defn}
@@ -29,6 +17,11 @@ It does not matter whether they fork off an arbitrary expression.
\[ \Exists \expr_2, \state_2, \expr_\f. \expr,\state \step \expr_2,\state_2,\expr_\f \]
\end{defn}
+\begin{defn}
+ An expression $\expr$ is said to be \emph{atomic} if it reduces in one step to a value:
+ \[ \All\state_1, \expr_2, \state_2, \expr_\f. \expr, \state_1 \step \expr_2, \state_2, \expr_\f \Ra \Exists \val_2. \toval(\expr_2) = \val_2 \]
+\end{defn}
+
\begin{defn}[Context]
A function $\lctx : \textdom{Expr} \to \textdom{Expr}$ is a \emph{context} if the following conditions are satisfied:
\begin{enumerate}[itemsep=0pt]
@@ -68,8 +61,8 @@ For any language $\Lang$, we define the corresponding thread-pool semantics.
To instantiate Iris, you need to define the following parameters:
\begin{itemize}
-\item A language $\Lang$
-\item A locally contractive bifunctor $\iFunc : \COFEs \to \CMRAs$ defining the ghost state, such that for all COFEs $A$, the CMRA $\iFunc(A)$ has a unit
+\item A language $\Lang$, and
+\item a locally contractive bifunctor $\iFunc : \COFEs \to \CMRAs$ defining the ghost state, such that for all COFEs $A$, the CMRA $\iFunc(A)$ has a unit. (By \lemref{lem:cmra-unit-total-core}, this means that the core of $\iFunc(A)$ is a total function.)
\end{itemize}
\noindent
@@ -141,7 +134,7 @@ Recursive predicates must be \emph{guarded}: in $\MU \var. \term$, the variable
Note that $\always$ and $\later$ bind more tightly than $*$, $\wand$, $\land$, $\lor$, and $\Ra$.
We will write $\pvs[\term] \prop$ for $\pvs[\term][\term] \prop$.
If we omit the mask, then it is $\top$ for weakest precondition $\wpre\expr{\Ret\var.\prop}$ and $\emptyset$ for primitive view shifts $\pvs \prop$.
-\ralf{$\top$ is not a term in the logic. Neither is any of the operations on masks that we use in the rules for weakestpre.}
+%FIXME $\top$ is not a term in the logic. Neither is any of the operations on masks that we use in the rules for weakestpre.
Some propositions are \emph{timeless}, which intuitively means that step-indexing does not affect them.
This is a \emph{meta-level} assertion about propositions, defined as follows:
diff --git a/docs/model.tex b/docs/model.tex
index d8595b6bae293ca094ea2efda9123c55edea95df..f6ce778183b83d9714185250e1a298940cf0736e 100644
--- a/docs/model.tex
+++ b/docs/model.tex
@@ -46,14 +46,13 @@ We introduce an additional logical connective $\ownM\melt$, which will later be
For every definition, we have to show all the side-conditions: The maps have to be non-expansive and monotone.
-
\subsection{Iris model}
\paragraph{Semantic domain of assertions.}
The first complicated task in building a model of full Iris is defining the semantic model of $\Prop$.
We start by defining the functor that assembles the CMRAs we need to the global resource CMRA:
\begin{align*}
- \textdom{ResF}(\cofe^\op, \cofe) \eqdef{}& \record{\wld: \agm(\latert \cofe), \pres: \exm(\textdom{State}), \ghostRes: \iFunc(\cofe^\op, \cofe)}
+ \textdom{ResF}(\cofe^\op, \cofe) \eqdef{}& \record{\wld: \mathbb{N} \fpfn \agm(\latert \cofe), \pres: \exm(\textdom{State}), \ghostRes: \iFunc(\cofe^\op, \cofe)}
\end{align*}
Remember that $\iFunc$ is the user-chosen bifunctor from $\COFEs$ to $\CMRAs$.
$\textdom{ResF}(\cofe^\op, \cofe)$ is a CMRA by lifting the individual CMRAs pointwise.
@@ -87,7 +86,7 @@ We only have to define the interpretation of the missing connectives, the most i
\wsatpre(n, \mask, \state, \rss, \rs) & \eqdef \begin{inbox}[t]
\rs \in \mval_{n+1} \land \rs.\pres = \exinj(\sigma) \land
\dom(\rss) \subseteq \mask \cap \dom( \rs.\wld) \land {}\\
- \All\iname \in \mask, \prop. (\rs.\wld)(\iname) \nequiv{n+1} \aginj(\latertinj(\wIso(\prop))) \Ra n \in \prop(\rss(\iname))
+ \All\iname \in \mask, \prop \in \iProp. (\rs.\wld)(\iname) \nequiv{n+1} \aginj(\latertinj(\wIso(\prop))) \Ra n \in \prop(\rss(\iname))
\end{inbox}\\
\wsat{\state}{\mask}{\rs} &\eqdef \set{0}\cup\setComp{n+1}{\Exists \rss : \mathbb{N} \fpfn \textdom{Res}. \wsatpre(n, \mask, \state, \rss, \rs \mtimes \prod_\iname \rss(\iname))}
\end{align*}
@@ -95,7 +94,7 @@ We only have to define the interpretation of the missing connectives, the most i
\typedsection{Primitive view-shift}{\mathit{pvs}_{-}^{-}(-) : \Delta(\pset{\mathbb{N}}) \times \Delta(\pset{\mathbb{N}}) \times \iProp \nfn \iProp}
\begin{align*}
\mathit{pvs}_{\mask_1}^{\mask_2}(\prop) &= \Lam \rs. \setComp{n}{\begin{aligned}
- \All \rs_\f, m, \mask_\f, \state.& 0 < m \leq n \land (\mask_1 \cup \mask_2) \disj \mask_\f \land k \in \wsat\state{\mask_1 \cup \mask_\f}{\rs \mtimes \rs_\f} \Ra {}\\&
+ \All \rs_\f, k, \mask_\f, \state.& 0 < k \leq n \land (\mask_1 \cup \mask_2) \disj \mask_\f \land k \in \wsat\state{\mask_1 \cup \mask_\f}{\rs \mtimes \rs_\f} \Ra {}\\&
\Exists \rsB. k \in \prop(\rsB) \land k \in \wsat\state{\mask_2 \cup \mask_\f}{\rsB \mtimes \rs_\f}
\end{aligned}}
\end{align*}
diff --git a/heap_lang/derived.v b/heap_lang/derived.v
index 3c8150335c516b2c975230625e30986f6567fa6d..7344167581e707950ee0f3e8f0c7e4f6f7edd8ee 100644
--- a/heap_lang/derived.v
+++ b/heap_lang/derived.v
@@ -17,31 +17,31 @@ Implicit Types P Q : iProp heap_lang Σ.
Implicit Types Φ : val → iProp heap_lang Σ.
(** Proof rules for the sugar *)
-Lemma wp_lam E x ef e v Φ :
- to_val e = Some v →
+Lemma wp_lam E x ef e Φ :
+ is_Some (to_val e) → Closed (x :b: []) ef →
▷ WP subst' x e ef @ E {{ Φ }} ⊢ WP App (Lam x ef) e @ E {{ Φ }}.
Proof. intros. by rewrite -(wp_rec _ BAnon) //. Qed.
-Lemma wp_let E x e1 e2 v Φ :
- to_val e1 = Some v →
+Lemma wp_let E x e1 e2 Φ :
+ is_Some (to_val e1) → Closed (x :b: []) e2 →
▷ WP subst' x e1 e2 @ E {{ Φ }} ⊢ WP Let x e1 e2 @ E {{ Φ }}.
Proof. apply wp_lam. Qed.
-Lemma wp_seq E e1 e2 v Φ :
- to_val e1 = Some v →
+Lemma wp_seq E e1 e2 Φ :
+ is_Some (to_val e1) → Closed [] e2 →
▷ WP e2 @ E {{ Φ }} ⊢ WP Seq e1 e2 @ E {{ Φ }}.
-Proof. intros ?. by rewrite -wp_let. Qed.
+Proof. intros ??. by rewrite -wp_let. Qed.
Lemma wp_skip E Φ : ▷ Φ (LitV LitUnit) ⊢ WP Skip @ E {{ Φ }}.
-Proof. rewrite -wp_seq // -wp_value //. Qed.
+Proof. rewrite -wp_seq; last eauto. by rewrite -wp_value. Qed.
-Lemma wp_match_inl E e0 v0 x1 e1 x2 e2 Φ :
- to_val e0 = Some v0 →
+Lemma wp_match_inl E e0 x1 e1 x2 e2 Φ :
+ is_Some (to_val e0) → Closed (x1 :b: []) e1 →
▷ WP subst' x1 e0 e1 @ E {{ Φ }} ⊢ WP Match (InjL e0) x1 e1 x2 e2 @ E {{ Φ }}.
Proof. intros. by rewrite -wp_case_inl // -[X in _ ⊢ X]later_intro -wp_let. Qed.
-Lemma wp_match_inr E e0 v0 x1 e1 x2 e2 Φ :
- to_val e0 = Some v0 →
+Lemma wp_match_inr E e0 x1 e1 x2 e2 Φ :
+ is_Some (to_val e0) → Closed (x2 :b: []) e2 →
▷ WP subst' x2 e0 e2 @ E {{ Φ }} ⊢ WP Match (InjR e0) x1 e1 x2 e2 @ E {{ Φ }}.
Proof. intros. by rewrite -wp_case_inr // -[X in _ ⊢ X]later_intro -wp_let. Qed.
diff --git a/heap_lang/heap.v b/heap_lang/heap.v
index a9dad272987643ed1ffb41ec4bd1763108e43596..65de4c44875bb15a58ad31bfb256a225b92706c6 100644
--- a/heap_lang/heap.v
+++ b/heap_lang/heap.v
@@ -8,6 +8,7 @@ Import uPred.
a finmap as their state. Or maybe even beyond "as their state", i.e. arbitrary
predicates over finmaps instead of just ownP. *)
+Definition heapN : namespace := nroot .@ "heap".
Definition heapUR : ucmraT := gmapUR loc (prodR fracR (dec_agreeR val)).
(** The CMRA we need. *)
@@ -22,7 +23,7 @@ Definition to_heap : state → heapUR := fmap (λ v, (1%Qp, DecAgree v)).
Definition of_heap : heapUR → state := omap (maybe DecAgree ∘ snd).
Section definitions.
- Context `{i : heapG Σ}.
+ Context `{heapG Σ}.
Definition heap_mapsto_def (l : loc) (q : Qp) (v: val) : iPropG heap_lang Σ :=
auth_own heap_name {[ l := (q, DecAgree v) ]}.
@@ -33,12 +34,12 @@ Section definitions.
Definition heap_inv (h : heapUR) : iPropG heap_lang Σ :=
ownP (of_heap h).
- Definition heap_ctx (N : namespace) : iPropG heap_lang Σ :=
- auth_ctx heap_name N heap_inv.
+ Definition heap_ctx : iPropG heap_lang Σ :=
+ auth_ctx heap_name heapN heap_inv.
Global Instance heap_inv_proper : Proper ((≡) ==> (⊣⊢)) heap_inv.
Proof. solve_proper. Qed.
- Global Instance heap_ctx_persistent N : PersistentP (heap_ctx N).
+ Global Instance heap_ctx_persistent : PersistentP heap_ctx.
Proof. apply _. Qed.
End definitions.
@@ -53,7 +54,6 @@ Notation "l ↦ v" := (heap_mapsto l 1 v) (at level 20) : uPred_scope.
Section heap.
Context {Σ : gFunctors}.
- Implicit Types N : namespace.
Implicit Types P Q : iPropG heap_lang Σ.
Implicit Types Φ : val → iPropG heap_lang Σ.
Implicit Types σ : state.
@@ -103,13 +103,13 @@ Section heap.
Hint Resolve heap_store_valid.
(** Allocation *)
- Lemma heap_alloc N E σ :
- authG heap_lang Σ heapUR → nclose N ⊆ E →
- ownP σ ={E}=> ∃ _ : heapG Σ, heap_ctx N ∧ [★ map] l↦v ∈ σ, l ↦ v.
+ Lemma heap_alloc E σ :
+ authG heap_lang Σ heapUR → nclose heapN ⊆ E →
+ ownP σ ={E}=> ∃ _ : heapG Σ, heap_ctx ∧ [★ map] l↦v ∈ σ, l ↦ v.
Proof.
intros. rewrite -{1}(from_to_heap σ). etrans.
{ rewrite [ownP _]later_intro.
- apply (auth_alloc (ownP ∘ of_heap) N E); auto using to_heap_valid. }
+ apply (auth_alloc (ownP ∘ of_heap) heapN E); auto using to_heap_valid. }
apply pvs_mono, exist_elim=> γ.
rewrite -(exist_intro (HeapG _ _ γ)) /heap_ctx; apply and_mono_r.
rewrite heap_mapsto_eq /heap_mapsto_def /heap_name.
@@ -149,47 +149,47 @@ Section heap.
(** Weakest precondition *)
(* FIXME: try to reduce usage of wp_pvs. We're losing view shifts here. *)
- Lemma wp_alloc N E e v Φ :
- to_val e = Some v → nclose N ⊆ E →
- heap_ctx N ★ ▷ (∀ l, l ↦ v ={E}=★ Φ (LitV (LitLoc l))) ⊢ WP Alloc e @ E {{ Φ }}.
+ Lemma wp_alloc E e v Φ :
+ to_val e = Some v → nclose heapN ⊆ E →
+ heap_ctx ★ ▷ (∀ l, l ↦ v ={E}=★ Φ (LitV (LitLoc l))) ⊢ WP Alloc e @ E {{ Φ }}.
Proof.
- iIntros {??} "[#Hinv HΦ]". rewrite /heap_ctx.
+ iIntros (<-%of_to_val ?) "[#Hinv HΦ]". rewrite /heap_ctx.
iPvs (auth_empty heap_name) as "Hheap".
- iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); simpl; eauto.
- iFrame "Hinv Hheap". iIntros {h}. rewrite left_id.
+ iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); eauto with fsaV.
+ iFrame "Hinv Hheap". iIntros (h). rewrite left_id.
iIntros "[% Hheap]". rewrite /heap_inv.
- iApply wp_alloc_pst; first done. iFrame "Hheap". iNext.
- iIntros {l} "[% Hheap]"; iPvsIntro; iExists {[ l := (1%Qp, DecAgree v) ]}.
+ iApply wp_alloc_pst. iFrame "Hheap". iNext.
+ iIntros (l) "[% Hheap]"; iPvsIntro; iExists {[ l := (1%Qp, DecAgree v) ]}.
rewrite -of_heap_insert -(insert_singleton_op h); last by apply of_heap_None.
iFrame "Hheap". iSplitR; first iPureIntro.
{ by apply alloc_unit_singleton_local_update; first apply of_heap_None. }
iIntros "Hheap". iApply "HΦ". by rewrite heap_mapsto_eq /heap_mapsto_def.
Qed.
- Lemma wp_load N E l q v Φ :
- nclose N ⊆ E →
- heap_ctx N ★ ▷ l ↦{q} v ★ ▷ (l ↦{q} v ={E}=★ Φ v)
+ Lemma wp_load E l q v Φ :
+ nclose heapN ⊆ E →
+ heap_ctx ★ ▷ l ↦{q} v ★ ▷ (l ↦{q} v ={E}=★ Φ v)
⊢ WP Load (Lit (LitLoc l)) @ E {{ Φ }}.
Proof.
- iIntros {?} "[#Hh [Hl HΦ]]".
+ iIntros (?) "[#Hh [Hl HΦ]]".
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
- iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); simpl; eauto.
- iFrame "Hh Hl". iIntros {h} "[% Hl]". rewrite /heap_inv.
+ iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); eauto with fsaV.
+ iFrame "Hh Hl". iIntros (h) "[% Hl]". rewrite /heap_inv.
iApply (wp_load_pst _ (<[l:=v]>(of_heap h)));first by rewrite lookup_insert.
rewrite of_heap_singleton_op //. iFrame "Hl".
iIntros "> Hown". iPvsIntro. iExists _; iSplit; first done.
rewrite of_heap_singleton_op //. by iFrame.
Qed.
- Lemma wp_store N E l v' e v Φ :
- to_val e = Some v → nclose N ⊆ E →
- heap_ctx N ★ ▷ l ↦ v' ★ ▷ (l ↦ v ={E}=★ Φ (LitV LitUnit))
+ Lemma wp_store E l v' e v Φ :
+ to_val e = Some v → nclose heapN ⊆ E →
+ heap_ctx ★ ▷ l ↦ v' ★ ▷ (l ↦ v ={E}=★ Φ (LitV LitUnit))
⊢ WP Store (Lit (LitLoc l)) e @ E {{ Φ }}.
Proof.
- iIntros {??} "[#Hh [Hl HΦ]]".
+ iIntros (<-%of_to_val ?) "[#Hh [Hl HΦ]]".
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
- iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); simpl; eauto.
- iFrame "Hh Hl". iIntros {h} "[% Hl]". rewrite /heap_inv.
+ iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); eauto with fsaV.
+ iFrame "Hh Hl". iIntros (h) "[% Hl]". rewrite /heap_inv.
iApply (wp_store_pst _ (<[l:=v']>(of_heap h))); rewrite ?lookup_insert //.
rewrite insert_insert !of_heap_singleton_op; eauto. iFrame "Hl".
iIntros "> Hown". iPvsIntro. iExists {[l := (1%Qp, DecAgree v)]}; iSplit.
@@ -197,30 +197,30 @@ Section heap.
rewrite of_heap_singleton_op //; eauto. by iFrame.
Qed.
- Lemma wp_cas_fail N E l q v' e1 v1 e2 v2 Φ :
- to_val e1 = Some v1 → to_val e2 = Some v2 → v' ≠v1 → nclose N ⊆ E →
- heap_ctx N ★ ▷ l ↦{q} v' ★ ▷ (l ↦{q} v' ={E}=★ Φ (LitV (LitBool false)))
+ Lemma wp_cas_fail E l q v' e1 v1 e2 v2 Φ :
+ to_val e1 = Some v1 → to_val e2 = Some v2 → v' ≠v1 → nclose heapN ⊆ E →
+ heap_ctx ★ ▷ l ↦{q} v' ★ ▷ (l ↦{q} v' ={E}=★ Φ (LitV (LitBool false)))
⊢ WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}.
Proof.
- iIntros {????} "[#Hh [Hl HΦ]]".
+ iIntros (<-%of_to_val <-%of_to_val ??) "[#Hh [Hl HΦ]]".
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
- iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); simpl; eauto 10.
- iFrame "Hh Hl". iIntros {h} "[% Hl]". rewrite /heap_inv.
+ iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); eauto with fsaV.
+ iFrame "Hh Hl". iIntros (h) "[% Hl]". rewrite /heap_inv.
iApply (wp_cas_fail_pst _ (<[l:=v']>(of_heap h))); rewrite ?lookup_insert //.
rewrite of_heap_singleton_op //. iFrame "Hl".
iIntros "> Hown". iPvsIntro. iExists _; iSplit; first done.
rewrite of_heap_singleton_op //. by iFrame.
Qed.
- Lemma wp_cas_suc N E l e1 v1 e2 v2 Φ :
- to_val e1 = Some v1 → to_val e2 = Some v2 → nclose N ⊆ E →
- heap_ctx N ★ ▷ l ↦ v1 ★ ▷ (l ↦ v2 ={E}=★ Φ (LitV (LitBool true)))
+ Lemma wp_cas_suc E l e1 v1 e2 v2 Φ :
+ to_val e1 = Some v1 → to_val e2 = Some v2 → nclose heapN ⊆ E →
+ heap_ctx ★ ▷ l ↦ v1 ★ ▷ (l ↦ v2 ={E}=★ Φ (LitV (LitBool true)))
⊢ WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}.
Proof.
- iIntros {???} "[#Hh [Hl HΦ]]".
+ iIntros (<-%of_to_val <-%of_to_val ?) "[#Hh [Hl HΦ]]".
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
- iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); simpl; eauto 10.
- iFrame "Hh Hl". iIntros {h} "[% Hl]". rewrite /heap_inv.
+ iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); eauto with fsaV.
+ iFrame "Hh Hl". iIntros (h) "[% Hl]". rewrite /heap_inv.
iApply (wp_cas_suc_pst _ (<[l:=v1]>(of_heap h))); rewrite ?lookup_insert //.
rewrite insert_insert !of_heap_singleton_op; eauto. iFrame "Hl".
iIntros "> Hown". iPvsIntro. iExists {[l := (1%Qp, DecAgree v2)]}; iSplit.
diff --git a/heap_lang/lang.v b/heap_lang/lang.v
index d184fa8fdc0d4d2432f1f888d739e3a0ecbf8712..881e486cc2d0b59fc0da2ec654792352496b8ab6 100644
--- a/heap_lang/lang.v
+++ b/heap_lang/lang.v
@@ -19,7 +19,6 @@ Inductive bin_op : Set :=
Inductive binder := BAnon | BNamed : string → binder.
Delimit Scope binder_scope with bind.
Bind Scope binder_scope with binder.
-
Definition cons_binder (mx : binder) (X : list string) : list string :=
match mx with BAnon => X | BNamed x => x :: X end.
Infix ":b:" := cons_binder (at level 60, right associativity).
@@ -33,82 +32,73 @@ Proof.
destruct mx; rewrite /= ?elem_of_cons; naive_solver.
Qed.
-(** A typeclass for whether a variable is bound in a given
- context. Making this a typeclass means we can use typeclass search
- to program solving these constraints, so this becomes extensible.
- Also, since typeclass search runs *after* unification, Coq has already
- inferred the X for us; if we were to go for embedded proof terms ot
- tactics, Coq would do things in the wrong order. *)
-Class VarBound (x : string) (X : list string) :=
- var_bound : bool_decide (x ∈ X).
-(* There is no need to restrict this hint to terms without evars, [vm_compute]
-will fail in case evars are arround. *)
-Hint Extern 0 (VarBound _ _) => vm_compute; exact I : typeclass_instances.
-
-Instance var_bound_proof_irrel x X : ProofIrrel (VarBound x X).
-Proof. rewrite /VarBound. apply _. Qed.
-Instance set_unfold_var_bound x X P :
- SetUnfold (x ∈ X) P → SetUnfold (VarBound x X) P.
-Proof.
- constructor. by rewrite /VarBound bool_decide_spec (set_unfold (x ∈ X) P).
-Qed.
-
-Inductive expr (X : list string) :=
+Inductive expr :=
(* Base lambda calculus *)
- (* Var is the only place where the terms contain a proof. The fact that they
- contain a proof at all is suboptimal, since this means two seeminlgy
- convertible terms could differ in their proofs. However, this also has
- some advantages:
- * We can make the [X] an index, so we can do non-dependent match.
- * In expr_weaken, we can push the proof all the way into Var, making
- sure that proofs never block computation. *)
- | Var (x : string) `{VarBound x X}
- | Rec (f x : binder) (e : expr (f :b: x :b: X))
- | App (e1 e2 : expr X)
+ | Var (x : string)
+ | Rec (f x : binder) (e : expr)
+ | App (e1 e2 : expr)
(* Base types and their operations *)
| Lit (l : base_lit)
- | UnOp (op : un_op) (e : expr X)
- | BinOp (op : bin_op) (e1 e2 : expr X)
- | If (e0 e1 e2 : expr X)
+ | UnOp (op : un_op) (e : expr)
+ | BinOp (op : bin_op) (e1 e2 : expr)
+ | If (e0 e1 e2 : expr)
(* Products *)
- | Pair (e1 e2 : expr X)
- | Fst (e : expr X)
- | Snd (e : expr X)
+ | Pair (e1 e2 : expr)
+ | Fst (e : expr)
+ | Snd (e : expr)
(* Sums *)
- | InjL (e : expr X)
- | InjR (e : expr X)
- | Case (e0 : expr X) (e1 : expr X) (e2 : expr X)
+ | InjL (e : expr)
+ | InjR (e : expr)
+ | Case (e0 : expr) (e1 : expr) (e2 : expr)
(* Concurrency *)
- | Fork (e : expr X)
+ | Fork (e : expr)
(* Heap *)
- | Alloc (e : expr X)
- | Load (e : expr X)
- | Store (e1 : expr X) (e2 : expr X)
- | CAS (e0 : expr X) (e1 : expr X) (e2 : expr X).
+ | Alloc (e : expr)
+ | Load (e : expr)
+ | Store (e1 : expr) (e2 : expr)
+ | CAS (e0 : expr) (e1 : expr) (e2 : expr).
Bind Scope expr_scope with expr.
Delimit Scope expr_scope with E.
-Arguments Var {_} _ {_}.
-Arguments Rec {_} _ _ _%E.
-Arguments App {_} _%E _%E.
-Arguments Lit {_} _.
-Arguments UnOp {_} _ _%E.
-Arguments BinOp {_} _ _%E _%E.
-Arguments If {_} _%E _%E _%E.
-Arguments Pair {_} _%E _%E.
-Arguments Fst {_} _%E.
-Arguments Snd {_} _%E.
-Arguments InjL {_} _%E.
-Arguments InjR {_} _%E.
-Arguments Case {_} _%E _%E _%E.
-Arguments Fork {_} _%E.
-Arguments Alloc {_} _%E.
-Arguments Load {_} _%E.
-Arguments Store {_} _%E _%E.
-Arguments CAS {_} _%E _%E _%E.
+Arguments Rec _ _ _%E.
+Arguments App _%E _%E.
+Arguments Lit _.
+Arguments UnOp _ _%E.
+Arguments BinOp _ _%E _%E.
+Arguments If _%E _%E _%E.
+Arguments Pair _%E _%E.
+Arguments Fst _%E.
+Arguments Snd _%E.
+Arguments InjL _%E.
+Arguments InjR _%E.
+Arguments Case _%E _%E _%E.
+Arguments Fork _%E.
+Arguments Alloc _%E.
+Arguments Load _%E.
+Arguments Store _%E _%E.
+Arguments CAS _%E _%E _%E.
+
+Fixpoint is_closed (X : list string) (e : expr) : bool :=
+ match e with
+ | Var x => bool_decide (x ∈ X)
+ | Rec f x e => is_closed (f :b: x :b: X) e
+ | Lit _ => true
+ | UnOp _ e | Fst e | Snd e | InjL e | InjR e | Fork e | Alloc e | Load e =>
+ is_closed X e
+ | App e1 e2 | BinOp _ e1 e2 | Pair e1 e2 | Store e1 e2 =>
+ is_closed X e1 && is_closed X e2
+ | If e0 e1 e2 | Case e0 e1 e2 | CAS e0 e1 e2 =>
+ is_closed X e0 && is_closed X e1 && is_closed X e2
+ end.
+
+Class Closed (X : list string) (e : expr) := closed : is_closed X e.
+Instance closed_proof_irrel env e : ProofIrrel (Closed env e).
+Proof. rewrite /Closed. apply _. Qed.
+Instance closed_decision env e : Decision (Closed env e).
+Proof. rewrite /Closed. apply _. Qed.
Inductive val :=
- | RecV (f x : binder) (e : expr (f :b: x :b: []))
+ | RecV (f x : binder) (e : expr) `{!Closed (f :b: x :b: []) e}
| LitV (l : base_lit)
| PairV (v1 v2 : val)
| InjLV (v : val)
@@ -120,18 +110,19 @@ Arguments PairV _%V _%V.
Arguments InjLV _%V.
Arguments InjRV _%V.
-Fixpoint of_val (v : val) : expr [] :=
+Fixpoint of_val (v : val) : expr :=
match v with
- | RecV f x e => Rec f x e
+ | RecV f x e _ => Rec f x e
| LitV l => Lit l
| PairV v1 v2 => Pair (of_val v1) (of_val v2)
| InjLV v => InjL (of_val v)
| InjRV v => InjR (of_val v)
end.
-Fixpoint to_val (e : expr []) : option val :=
+Fixpoint to_val (e : expr) : option val :=
match e with
- | Rec f x e => Some (RecV f x e)
+ | Rec f x e =>
+ if decide (Closed (f :b: x :b: []) e) then Some (RecV f x e) else None
| Lit l => Some (LitV l)
| Pair e1 e2 => v1 ↠to_val e1; v2 ↠to_val e2; Some (PairV v1 v2)
| InjL e => InjLV <$> to_val e
@@ -144,28 +135,28 @@ Definition state := gmap loc val.
(** Evaluation contexts *)
Inductive ectx_item :=
- | AppLCtx (e2 : expr [])
+ | AppLCtx (e2 : expr)
| AppRCtx (v1 : val)
| UnOpCtx (op : un_op)
- | BinOpLCtx (op : bin_op) (e2 : expr [])
+ | BinOpLCtx (op : bin_op) (e2 : expr)
| BinOpRCtx (op : bin_op) (v1 : val)
- | IfCtx (e1 e2 : expr [])
- | PairLCtx (e2 : expr [])
+ | IfCtx (e1 e2 : expr)
+ | PairLCtx (e2 : expr)
| PairRCtx (v1 : val)
| FstCtx
| SndCtx
| InjLCtx
| InjRCtx
- | CaseCtx (e1 : expr []) (e2 : expr [])
+ | CaseCtx (e1 : expr) (e2 : expr)
| AllocCtx
| LoadCtx
- | StoreLCtx (e2 : expr [])
+ | StoreLCtx (e2 : expr)
| StoreRCtx (v1 : val)
- | CasLCtx (e1 : expr []) (e2 : expr [])
- | CasMCtx (v0 : val) (e2 : expr [])
+ | CasLCtx (e1 : expr) (e2 : expr)
+ | CasMCtx (v0 : val) (e2 : expr)
| CasRCtx (v0 : val) (v1 : val).
-Definition fill_item (Ki : ectx_item) (e : expr []) : expr [] :=
+Definition fill_item (Ki : ectx_item) (e : expr) : expr :=
match Ki with
| AppLCtx e2 => App e e2
| AppRCtx v1 => App (of_val v1) e
@@ -182,7 +173,7 @@ Definition fill_item (Ki : ectx_item) (e : expr []) : expr [] :=
| CaseCtx e1 e2 => Case e e1 e2
| AllocCtx => Alloc e
| LoadCtx => Load e
- | StoreLCtx e2 => Store e e2
+ | StoreLCtx e2 => Store e e2
| StoreRCtx v1 => Store (of_val v1) e
| CasLCtx e1 e2 => CAS e e1 e2
| CasMCtx v0 e2 => CAS (of_val v0) e e2
@@ -190,79 +181,30 @@ Definition fill_item (Ki : ectx_item) (e : expr []) : expr [] :=
end.
(** Substitution *)
-(** We have [subst' e BAnon v = e] to deal with anonymous binders *)
-Lemma wexpr_rec_prf {X Y} (H : X `included` Y) {f x} :
- f :b: x :b: X `included` f :b: x :b: Y.
-Proof. set_solver. Qed.
-
-Program Fixpoint wexpr {X Y} (H : X `included` Y) (e : expr X) : expr Y :=
- match e return expr Y with
- | Var x _ => @Var _ x _
- | Rec f x e => Rec f x (wexpr (wexpr_rec_prf H) e)
- | App e1 e2 => App (wexpr H e1) (wexpr H e2)
- | Lit l => Lit l
- | UnOp op e => UnOp op (wexpr H e)
- | BinOp op e1 e2 => BinOp op (wexpr H e1) (wexpr H e2)
- | If e0 e1 e2 => If (wexpr H e0) (wexpr H e1) (wexpr H e2)
- | Pair e1 e2 => Pair (wexpr H e1) (wexpr H e2)
- | Fst e => Fst (wexpr H e)
- | Snd e => Snd (wexpr H e)
- | InjL e => InjL (wexpr H e)
- | InjR e => InjR (wexpr H e)
- | Case e0 e1 e2 => Case (wexpr H e0) (wexpr H e1) (wexpr H e2)
- | Fork e => Fork (wexpr H e)
- | Alloc e => Alloc (wexpr H e)
- | Load e => Load (wexpr H e)
- | Store e1 e2 => Store (wexpr H e1) (wexpr H e2)
- | CAS e0 e1 e2 => CAS (wexpr H e0) (wexpr H e1) (wexpr H e2)
- end.
-Solve Obligations with set_solver.
-
-Definition wexpr' {X} (e : expr []) : expr X := wexpr (included_nil _) e.
-
-Definition of_val' {X} (v : val) : expr X := wexpr (included_nil _) (of_val v).
-
-Lemma wsubst_rec_true_prf {X Y x} (H : X `included` x :: Y) {f y}
- (Hfy : BNamed x ≠f ∧ BNamed x ≠y) :
- f :b: y :b: X `included` x :: f :b: y :b: Y.
-Proof. set_solver. Qed.
-Lemma wsubst_rec_false_prf {X Y x} (H : X `included` x :: Y) {f y}
- (Hfy : ¬(BNamed x ≠f ∧ BNamed x ≠y)) :
- f :b: y :b: X `included` f :b: y :b: Y.
-Proof. move: Hfy=>/not_and_l [/dec_stable|/dec_stable]; set_solver. Qed.
-
-Program Fixpoint wsubst {X Y} (x : string) (es : expr [])
- (H : X `included` x :: Y) (e : expr X) : expr Y :=
- match e return expr Y with
- | Var y _ => if decide (x = y) then wexpr' es else @Var _ y _
+Fixpoint subst (x : string) (es : expr) (e : expr) : expr :=
+ match e with
+ | Var y => if decide (x = y) then es else Var y
| Rec f y e =>
- Rec f y $ match decide (BNamed x ≠f ∧ BNamed x ≠y) return _ with
- | left Hfy => wsubst x es (wsubst_rec_true_prf H Hfy) e
- | right Hfy => wexpr (wsubst_rec_false_prf H Hfy) e
- end
- | App e1 e2 => App (wsubst x es H e1) (wsubst x es H e2)
+ Rec f y $ if decide (BNamed x ≠f ∧ BNamed x ≠y) then subst x es e else e
+ | App e1 e2 => App (subst x es e1) (subst x es e2)
| Lit l => Lit l
- | UnOp op e => UnOp op (wsubst x es H e)
- | BinOp op e1 e2 => BinOp op (wsubst x es H e1) (wsubst x es H e2)
- | If e0 e1 e2 => If (wsubst x es H e0) (wsubst x es H e1) (wsubst x es H e2)
- | Pair e1 e2 => Pair (wsubst x es H e1) (wsubst x es H e2)
- | Fst e => Fst (wsubst x es H e)
- | Snd e => Snd (wsubst x es H e)
- | InjL e => InjL (wsubst x es H e)
- | InjR e => InjR (wsubst x es H e)
- | Case e0 e1 e2 =>
- Case (wsubst x es H e0) (wsubst x es H e1) (wsubst x es H e2)
- | Fork e => Fork (wsubst x es H e)
- | Alloc e => Alloc (wsubst x es H e)
- | Load e => Load (wsubst x es H e)
- | Store e1 e2 => Store (wsubst x es H e1) (wsubst x es H e2)
- | CAS e0 e1 e2 => CAS (wsubst x es H e0) (wsubst x es H e1) (wsubst x es H e2)
+ | UnOp op e => UnOp op (subst x es e)
+ | BinOp op e1 e2 => BinOp op (subst x es e1) (subst x es e2)
+ | If e0 e1 e2 => If (subst x es e0) (subst x es e1) (subst x es e2)
+ | Pair e1 e2 => Pair (subst x es e1) (subst x es e2)
+ | Fst e => Fst (subst x es e)
+ | Snd e => Snd (subst x es e)
+ | InjL e => InjL (subst x es e)
+ | InjR e => InjR (subst x es e)
+ | Case e0 e1 e2 => Case (subst x es e0) (subst x es e1) (subst x es e2)
+ | Fork e => Fork (subst x es e)
+ | Alloc e => Alloc (subst x es e)
+ | Load e => Load (subst x es e)
+ | Store e1 e2 => Store (subst x es e1) (subst x es e2)
+ | CAS e0 e1 e2 => CAS (subst x es e0) (subst x es e1) (subst x es e2)
end.
-Solve Obligations with set_solver.
-Definition subst {X} (x : string) (es : expr []) (e : expr (x :: X)) : expr X :=
- wsubst x es (λ z, id) e.
-Definition subst' {X} (mx : binder) (es : expr []) : expr (mx :b: X) → expr X :=
+Definition subst' (mx : binder) (es : expr) : expr → expr :=
match mx with BNamed x => subst x es | BAnon => id end.
(** The stepping relation *)
@@ -283,9 +225,10 @@ Definition bin_op_eval (op : bin_op) (l1 l2 : base_lit) : option base_lit :=
| _, _, _ => None
end.
-Inductive head_step : expr [] → state → expr [] → state → option (expr []) → Prop :=
+Inductive head_step : expr → state → expr → state → option (expr) → Prop :=
| BetaS f x e1 e2 v2 e' σ :
to_val e2 = Some v2 →
+ Closed (f :b: x :b: []) e1 →
e' = subst' x (of_val v2) (subst' f (Rec f x e1) e1) →
head_step (App (Rec f x e1) e2) σ e' σ None
| UnOpS op l l' σ :
@@ -330,90 +273,15 @@ Inductive head_step : expr [] → state → expr [] → state → option (expr [
σ !! l = Some v1 →
head_step (CAS (Lit $ LitLoc l) e1 e2) σ (Lit $ LitBool true) (<[l:=v2]>σ) None.
-(** Atomic expressions *)
-Definition atomic (e: expr []) : bool :=
- match e with
- | Alloc e => bool_decide (is_Some (to_val e))
- | Load e => bool_decide (is_Some (to_val e))
- | Store e1 e2 => bool_decide (is_Some (to_val e1) ∧ is_Some (to_val e2))
- | CAS e0 e1 e2 =>
- bool_decide (is_Some (to_val e0) ∧ is_Some (to_val e1) ∧ is_Some (to_val e2))
- (* Make "skip" atomic *)
- | App (Rec _ _ (Lit _)) (Lit _) => true
- | _ => false
- end.
-
-(** Substitution *)
-Lemma var_proof_irrel X x H1 H2 : @Var X x H1 = @Var X x H2.
-Proof. f_equal. by apply (proof_irrel _). Qed.
-
-Lemma wexpr_id X (H : X `included` X) e : wexpr H e = e.
-Proof. induction e; f_equal/=; auto. by apply (proof_irrel _). Qed.
-Lemma wexpr_proof_irrel X Y (H1 H2 : X `included` Y) e : wexpr H1 e = wexpr H2 e.
-Proof.
- revert Y H1 H2; induction e; simpl; auto using var_proof_irrel with f_equal.
-Qed.
-Lemma wexpr_wexpr X Y Z (H1 : X `included` Y) (H2 : Y `included` Z) H3 e :
- wexpr H2 (wexpr H1 e) = wexpr H3 e.
-Proof.
- revert Y Z H1 H2 H3.
- induction e; simpl; auto using var_proof_irrel with f_equal.
-Qed.
-Lemma wexpr_wexpr' X Y Z (H1 : X `included` Y) (H2 : Y `included` Z) e :
- wexpr H2 (wexpr H1 e) = wexpr (transitivity H1 H2) e.
-Proof. apply wexpr_wexpr. Qed.
-
-Lemma wsubst_proof_irrel X Y x es (H1 H2 : X `included` x :: Y) e :
- wsubst x es H1 e = wsubst x es H2 e.
-Proof.
- revert Y H1 H2; induction e; simpl; intros; repeat case_decide;
- auto using var_proof_irrel, wexpr_proof_irrel with f_equal.
-Qed.
-Lemma wexpr_wsubst X Y Z x es (H1: X `included` x::Y) (H2: Y `included` Z) H3 e:
- wexpr H2 (wsubst x es H1 e) = wsubst x es H3 e.
-Proof.
- revert Y Z H1 H2 H3.
- induction e; intros; repeat (case_decide || simplify_eq/=);
- unfold wexpr'; auto using var_proof_irrel, wexpr_wexpr with f_equal.
-Qed.
-Lemma wsubst_wexpr X Y Z x es (H1: X `included` Y) (H2: Y `included` x::Z) H3 e:
- wsubst x es H2 (wexpr H1 e) = wsubst x es H3 e.
-Proof.
- revert Y Z H1 H2 H3.
- induction e; intros; repeat (case_decide || simplify_eq/=);
- auto using var_proof_irrel, wexpr_wexpr with f_equal.
-Qed.
-Lemma wsubst_wexpr' X Y Z x es (H1: X `included` Y) (H2: Y `included` x::Z) e:
- wsubst x es H2 (wexpr H1 e) = wsubst x es (transitivity H1 H2) e.
-Proof. apply wsubst_wexpr. Qed.
-
-Lemma wsubst_closed X Y x es (H1 : X `included` x :: Y) H2 (e : expr X) :
- x ∉ X → wsubst x es H1 e = wexpr H2 e.
-Proof.
- revert Y H1 H2.
- induction e; intros; repeat (case_decide || simplify_eq/=);
- auto using var_proof_irrel, wexpr_proof_irrel with f_equal set_solver.
- exfalso; set_solver.
-Qed.
-Lemma wsubst_closed_nil x es H (e : expr []) : wsubst x es H e = e.
-Proof.
- rewrite -{2}(wexpr_id _ (reflexivity []) e).
- apply wsubst_closed, not_elem_of_nil.
-Qed.
-
(** Basic properties about the language *)
Lemma to_of_val v : to_val (of_val v) = Some v.
-Proof. by induction v; simplify_option_eq. Qed.
+Proof.
+ by induction v; simplify_option_eq; repeat f_equal; try apply (proof_irrel _).
+Qed.
Lemma of_to_val e v : to_val e = Some v → of_val v = e.
Proof.
- revert e v. cut (∀ X (e : expr X) (H : X = ∅) v,
- to_val (eq_rect _ expr e _ H) = Some v → of_val v = eq_rect _ expr e _ H).
- { intros help e v. apply (help ∅ e eq_refl). }
- intros X e; induction e; intros HX ??; simplify_option_eq;
- repeat match goal with
- | IH : ∀ _ : ∅ = ∅, _ |- _ => specialize (IH eq_refl); simpl in IH
- end; auto with f_equal.
+ revert v; induction e; intros v ?; simplify_option_eq; auto with f_equal.
Qed.
Instance of_val_inj : Inj (=) (=) of_val.
@@ -426,29 +294,12 @@ Lemma fill_item_val Ki e :
is_Some (to_val (fill_item Ki e)) → is_Some (to_val e).
Proof. intros [v ?]. destruct Ki; simplify_option_eq; eauto. Qed.
-Lemma val_stuck e1 σ1 e2 σ2 ef :
- head_step e1 σ1 e2 σ2 ef → to_val e1 = None.
+Lemma val_stuck e1 σ1 e2 σ2 ef : head_step e1 σ1 e2 σ2 ef → to_val e1 = None.
Proof. destruct 1; naive_solver. Qed.
-Lemma atomic_not_val e : atomic e → to_val e = None.
-Proof. by destruct e. Qed.
-
-Lemma atomic_fill_item Ki e : atomic (fill_item Ki e) → is_Some (to_val e).
-Proof.
- intros. destruct Ki; simplify_eq/=; destruct_and?;
- repeat (case_match || contradiction); eauto.
-Qed.
-
-Lemma atomic_step e1 σ1 e2 σ2 ef :
- atomic e1 → head_step e1 σ1 e2 σ2 ef → is_Some (to_val e2).
-Proof.
- destruct 2; simpl; rewrite ?to_of_val; try by eauto. subst.
- unfold subst'; repeat (case_match || contradiction || simplify_eq/=); eauto.
-Qed.
-
Lemma head_ctx_step_val Ki e σ1 e2 σ2 ef :
head_step (fill_item Ki e) σ1 e2 σ2 ef → is_Some (to_val e).
-Proof. destruct Ki; inversion_clear 1; simplify_option_eq; eauto. Qed.
+Proof. destruct Ki; inversion_clear 1; simplify_option_eq; by eauto. Qed.
Lemma fill_item_no_val_inj Ki1 Ki2 e1 e2 :
to_val e1 = None → to_val e2 = None →
@@ -465,6 +316,25 @@ Lemma alloc_fresh e v σ :
to_val e = Some v → head_step (Alloc e) σ (Lit (LitLoc l)) (<[l:=v]>σ) None.
Proof. by intros; apply AllocS, (not_elem_of_dom (D:=gset _)), is_fresh. Qed.
+(** Closed expressions *)
+Lemma is_closed_weaken X Y e : is_closed X e → X `included` Y → is_closed Y e.
+Proof. revert X Y; induction e; naive_solver (eauto; set_solver). Qed.
+
+Lemma is_closed_weaken_nil X e : is_closed [] e → is_closed X e.
+Proof. intros. by apply is_closed_weaken with [], included_nil. Qed.
+
+Lemma is_closed_subst X e x es : is_closed 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 is_closed_nil_subst e x es : is_closed [] e → subst x es e = e.
+Proof. intros. apply is_closed_subst with []; set_solver. Qed.
+
+Lemma is_closed_of_val X v : is_closed X (of_val v).
+Proof. apply is_closed_weaken_nil. induction v; simpl; auto. Qed.
+
(** Equality and other typeclass stuff *)
Instance base_lit_dec_eq (l1 l2 : base_lit) : Decision (l1 = l2).
Proof. solve_decision. Defined.
@@ -472,63 +342,33 @@ Instance un_op_dec_eq (op1 op2 : un_op) : Decision (op1 = op2).
Proof. solve_decision. Defined.
Instance bin_op_dec_eq (op1 op2 : bin_op) : Decision (op1 = op2).
Proof. solve_decision. Defined.
-
-Fixpoint expr_beq {X Y} (e : expr X) (e' : expr Y) : bool :=
- match e, e' with
- | Var x _, Var x' _ => bool_decide (x = x')
- | Rec f x e, Rec f' x' e' =>
- bool_decide (f = f') && bool_decide (x = x') && expr_beq e e'
- | App e1 e2, App e1' e2' | Pair e1 e2, Pair e1' e2' |
- Store e1 e2, Store e1' e2' => expr_beq e1 e1' && expr_beq e2 e2'
- | Lit l, Lit l' => bool_decide (l = l')
- | UnOp op e, UnOp op' e' => bool_decide (op = op') && expr_beq e e'
- | BinOp op e1 e2, BinOp op' e1' e2' =>
- bool_decide (op = op') && expr_beq e1 e1' && expr_beq e2 e2'
- | If e0 e1 e2, If e0' e1' e2' | Case e0 e1 e2, Case e0' e1' e2' |
- CAS e0 e1 e2, CAS e0' e1' e2' =>
- expr_beq e0 e0' && expr_beq e1 e1' && expr_beq e2 e2'
- | Fst e, Fst e' | Snd e, Snd e' | InjL e, InjL e' | InjR e, InjR e' |
- Fork e, Fork e' | Alloc e, Alloc e' | Load e, Load e' => expr_beq e e'
- | _, _ => false
- end.
-Lemma expr_beq_correct {X} (e1 e2 : expr X) : expr_beq e1 e2 ↔ e1 = e2.
-Proof.
- split.
- * revert e2; induction e1; intros [] * ?; simpl in *;
- destruct_and?; subst; repeat f_equal/=; auto; try apply proof_irrel.
- * intros ->. induction e2; naive_solver.
-Qed.
-Instance expr_dec_eq {X} (e1 e2 : expr X) : Decision (e1 = e2).
-Proof.
- refine (cast_if (decide (expr_beq e1 e2))); by rewrite -expr_beq_correct.
-Defined.
+Instance expr_dec_eq (e1 e2 : expr) : Decision (e1 = e2).
+Proof. solve_decision. Defined.
Instance val_dec_eq (v1 v2 : val) : Decision (v1 = v2).
Proof.
refine (cast_if (decide (of_val v1 = of_val v2))); abstract naive_solver.
Defined.
-Instance expr_inhabited X : Inhabited (expr X) := populate (Lit LitUnit).
+Instance expr_inhabited : Inhabited (expr) := populate (Lit LitUnit).
Instance val_inhabited : Inhabited val := populate (LitV LitUnit).
Canonical Structure stateC := leibnizC state.
Canonical Structure valC := leibnizC val.
-Canonical Structure exprC X := leibnizC (expr X).
+Canonical Structure exprC := leibnizC expr.
End heap_lang.
(** Language *)
Program Instance heap_ectxi_lang :
EctxiLanguage
- (heap_lang.expr []) heap_lang.val heap_lang.ectx_item heap_lang.state := {|
+ (heap_lang.expr) heap_lang.val heap_lang.ectx_item heap_lang.state := {|
of_val := heap_lang.of_val; to_val := heap_lang.to_val;
- fill_item := heap_lang.fill_item;
- atomic := heap_lang.atomic; head_step := heap_lang.head_step;
+ fill_item := heap_lang.fill_item; head_step := heap_lang.head_step
|}.
Solve Obligations with eauto using heap_lang.to_of_val, heap_lang.of_to_val,
- heap_lang.val_stuck, heap_lang.atomic_not_val, heap_lang.atomic_step,
- heap_lang.fill_item_val, heap_lang.atomic_fill_item,
- heap_lang.fill_item_no_val_inj, heap_lang.head_ctx_step_val.
+ heap_lang.val_stuck, heap_lang.fill_item_val, heap_lang.fill_item_no_val_inj,
+ heap_lang.head_ctx_step_val.
-Canonical Structure heap_lang := ectx_lang (heap_lang.expr []).
+Canonical Structure heap_lang := ectx_lang (heap_lang.expr).
(* Prefer heap_lang names over ectx_language names. *)
Export heap_lang.
diff --git a/heap_lang/lib/assert.v b/heap_lang/lib/assert.v
index 236c7aacee4e636614530f0ca3362edd48c37949..3cc335765624ebfc9f5598ccb39d62b5ec3d1ae9 100644
--- a/heap_lang/lib/assert.v
+++ b/heap_lang/lib/assert.v
@@ -1,23 +1,16 @@
-From iris.heap_lang Require Export derived.
-From iris.heap_lang Require Import wp_tactics substitution notation.
+From iris.proofmode Require Import tactics.
+From iris.heap_lang Require Import proofmode notation.
-Definition Assert {X} (e : expr X) : expr X :=
- if: e then #() else #0 #0. (* #0 #0 is unsafe *)
+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.
+Global Opaque assert.
-Instance do_wexpr_assert {X Y} (H : X `included` Y) e er :
- WExpr H e er → WExpr H (Assert e) (Assert er) := _.
-Instance do_wsubst_assert {X Y} x es (H : X `included` x :: Y) e er :
- WSubst x es H e er → WSubst x es H (Assert e) (Assert er).
-Proof. intros; red. by rewrite /Assert /wsubst -/wsubst; f_equal/=. Qed.
-Typeclasses Opaque Assert.
-
-Lemma wp_assert {Σ} (Φ : val → iProp heap_lang Σ) :
- ▷ Φ #() ⊢ WP Assert #true {{ Φ }}.
-Proof. by rewrite -wp_if_true -wp_value. Qed.
-
-Lemma wp_assert' {Σ} (Φ : val → iProp heap_lang Σ) e :
- WP e {{ v, v = #true ∧ ▷ Φ #() }} ⊢ WP Assert e {{ Φ }}.
+Lemma wp_assert {Σ} E (Φ : val → iProp heap_lang Σ) e `{!Closed [] e} :
+ WP e @ E {{ v, v = #true ∧ ▷ Φ #() }} ⊢ WP assert: e @ E {{ Φ }}.
Proof.
- rewrite /Assert. wp_focus e; apply wp_mono=>v.
- apply uPred.pure_elim_l=>->. apply wp_assert.
+ iIntros "HΦ". rewrite /assert. wp_let. wp_seq.
+ iApply wp_wand_r; iFrame "HΦ"; iIntros (v) "[% ?]"; subst.
+ wp_if. done.
Qed.
diff --git a/heap_lang/lib/barrier/barrier.v b/heap_lang/lib/barrier/barrier.v
index b3b5902ff78e354ed8fb17153283c40c6b3071fa..b9ebaf60b3ffb601d1e1430c81b02760b515d31b 100644
--- a/heap_lang/lib/barrier/barrier.v
+++ b/heap_lang/lib/barrier/barrier.v
@@ -1,7 +1,7 @@
From iris.heap_lang Require Export notation.
Definition newbarrier : val := λ: <>, ref #0.
-Definition signal : val := λ: "x", '"x" <- #1.
+Definition signal : val := λ: "x", "x" <- #1.
Definition wait : val :=
- rec: "wait" "x" := if: !'"x" = #1 then #() else '"wait" '"x".
+ rec: "wait" "x" := if: !"x" = #1 then #() else "wait" "x".
Global Opaque newbarrier signal wait.
diff --git a/heap_lang/lib/barrier/proof.v b/heap_lang/lib/barrier/proof.v
index 645347ed9e860958497881ee44fe655931ceaaf4..879ac67ca45340116ee364ed291821299a213aab 100644
--- a/heap_lang/lib/barrier/proof.v
+++ b/heap_lang/lib/barrier/proof.v
@@ -21,8 +21,7 @@ Proof. destruct H as (?&?&?). split; apply _. Qed.
(** Now we come to the Iris part of the proof. *)
Section proof.
-Context {Σ : gFunctors} `{!heapG Σ, !barrierG Σ}.
-Context (heapN N : namespace).
+Context `{!heapG Σ, !barrierG Σ} (N : namespace).
Implicit Types I : gset gname.
Local Notation iProp := (iPropG heap_lang Σ).
@@ -42,7 +41,7 @@ Definition barrier_inv (l : loc) (P : iProp) (s : state) : iProp :=
(l ↦ s ★ ress (state_to_prop s P) (state_I s))%I.
Definition barrier_ctx (γ : gname) (l : loc) (P : iProp) : iProp :=
- (■(heapN ⊥ N) ★ heap_ctx heapN ★ sts_ctx γ N (barrier_inv l P))%I.
+ (■(heapN ⊥ N) ★ heap_ctx ★ sts_ctx γ N (barrier_inv l P))%I.
Definition send (l : loc) (P : iProp) : iProp :=
(∃ γ, barrier_ctx γ l P ★ sts_ownS γ low_states {[ Send ]})%I.
@@ -81,7 +80,7 @@ Lemma ress_split i i1 i2 Q R1 R2 P I :
(Q -★ R1 ★ R2) ★ ress P I
⊢ ress P ({[i1;i2]} ∪ I ∖ {[i]}).
Proof.
- iIntros {????} "(#HQ&#H1&#H2&HQR&H)"; iDestruct "H" as {Ψ} "[HPΨ HΨ]".
+ iIntros (????) "(#HQ&#H1&#H2&HQR&H)"; iDestruct "H" as (Ψ) "[HPΨ HΨ]".
iDestruct (big_sepS_delete _ _ i with "HΨ") as "[#HΨi HΨ]"; first done.
iExists (<[i1:=R1]> (<[i2:=R2]> Ψ)). iSplitL "HQR HPΨ".
- iPoseProof (saved_prop_agree i Q (Ψ i) with "[#]") as "Heq"; first by iSplit.
@@ -96,15 +95,14 @@ Qed.
(** Actual proofs *)
Lemma newbarrier_spec (P : iProp) (Φ : val → iProp) :
heapN ⊥ N →
- heap_ctx heapN ★ (∀ l, recv l P ★ send l P -★ Φ #l)
- ⊢ WP newbarrier #() {{ Φ }}.
+ heap_ctx ★ (∀ l, recv l P ★ send l P -★ Φ #l) ⊢ WP newbarrier #() {{ Φ }}.
Proof.
- iIntros {HN} "[#? HΦ]".
+ iIntros (HN) "[#? HΦ]".
rewrite /newbarrier. wp_seq. wp_alloc l as "Hl".
iApply "HΦ".
- iPvs (saved_prop_alloc (F:=idCF) _ P) as {γ} "#?".
+ iPvs (saved_prop_alloc (F:=idCF) _ P) as (γ) "#?".
iPvs (sts_alloc (barrier_inv l P) _ N (State Low {[ γ ]}) with "[-]")
- as {γ'} "[#? Hγ']"; eauto.
+ as (γ') "[#? Hγ']"; eauto.
{ iNext. rewrite /barrier_inv /=. iFrame.
iExists (const P). rewrite !big_sepS_singleton /=. eauto. }
iAssert (barrier_ctx γ' l P)%I as "#?".
@@ -125,14 +123,14 @@ Lemma signal_spec l P (Φ : val → iProp) :
send l P ★ P ★ Φ #() ⊢ WP signal #l {{ Φ }}.
Proof.
rewrite /signal /send /barrier_ctx.
- iIntros "(Hs&HP&HΦ)"; iDestruct "Hs" as {γ} "[#(%&Hh&Hsts) Hγ]". wp_let.
+ iIntros "(Hs&HP&HΦ)"; iDestruct "Hs" as (γ) "[#(%&Hh&Hsts) Hγ]". wp_let.
iSts γ as [p I]; iDestruct "Hγ" as "[Hl Hr]".
wp_store. iPvsIntro. destruct p; [|done].
iExists (State High I), (∅ : set token).
iSplit; [iPureIntro; by eauto using signal_step|].
iSplitR "HΦ"; [iNext|by auto].
rewrite {2}/barrier_inv /ress /=; iFrame "Hl".
- iDestruct "Hr" as {Ψ} "[Hr Hsp]"; iExists Ψ; iFrame "Hsp".
+ iDestruct "Hr" as (Ψ) "[Hr Hsp]"; iExists Ψ; iFrame "Hsp".
iIntros "> _"; by iApply "Hr".
Qed.
@@ -140,7 +138,7 @@ Lemma wait_spec l P (Φ : val → iProp) :
recv l P ★ (P -★ Φ #()) ⊢ WP wait #l {{ Φ }}.
Proof.
rename P into R; rewrite /recv /barrier_ctx.
- iIntros "[Hr HΦ]"; iDestruct "Hr" as {γ P Q i} "(#(%&Hh&Hsts)&Hγ&#HQ&HQR)".
+ iIntros "[Hr HΦ]"; iDestruct "Hr" as (γ P Q i) "(#(%&Hh&Hsts)&Hγ&#HQ&HQR)".
iLöb as "IH". wp_rec. wp_focus (! _)%E.
iSts γ as [p I]; iDestruct "Hγ" as "[Hl Hr]".
wp_load. iPvsIntro. destruct p.
@@ -155,7 +153,7 @@ Proof.
return to the client *)
iExists (State High (I ∖ {[ i ]})), (∅ : set token).
iSplit; [iPureIntro; by eauto using wait_step|].
- iDestruct "Hr" as {Ψ} "[HΨ Hsp]".
+ iDestruct "Hr" as (Ψ) "[HΨ Hsp]".
iDestruct (big_sepS_delete _ _ i with "Hsp") as "[#HΨi Hsp]"; first done.
iAssert (▷ Ψ i ★ ▷ [★ set] j ∈ I ∖ {[i]}, Ψ j)%I with "[HΨ]" as "[HΨ HΨ']".
{ iNext. iApply (big_sepS_delete _ _ i); first done. by iApply "HΨ". }
@@ -171,12 +169,12 @@ Lemma recv_split E l P1 P2 :
nclose N ⊆ E → recv l (P1 ★ P2) ={E}=> recv l P1 ★ recv l P2.
Proof.
rename P1 into R1; rename P2 into R2. rewrite {1}/recv /barrier_ctx.
- iIntros {?}. iDestruct 1 as {γ P Q i} "(#(%&Hh&Hsts)&Hγ&#HQ&HQR)".
+ iIntros (?). iDestruct 1 as (γ P Q i) "(#(%&Hh&Hsts)&Hγ&#HQ&HQR)".
iApply pvs_trans'.
iSts γ as [p I]; iDestruct "Hγ" as "[Hl Hr]".
- iPvs (saved_prop_alloc_strong _ (R1: ∙%CF iProp) I) as {i1} "[% #Hi1]".
+ iPvs (saved_prop_alloc_strong _ (R1: ∙%CF iProp) I) as (i1) "[% #Hi1]".
iPvs (saved_prop_alloc_strong _ (R2: ∙%CF iProp) (I ∪ {[i1]}))
- as {i2} "[Hi2' #Hi2]"; iDestruct "Hi2'" as %Hi2; iPvsIntro.
+ as (i2) "[Hi2' #Hi2]"; iDestruct "Hi2'" as %Hi2; iPvsIntro.
rewrite ->not_elem_of_union, elem_of_singleton in Hi2; destruct Hi2.
iExists (State p ({[i1; i2]} ∪ I ∖ {[i]})).
iExists ({[Change i1; Change i2 ]}).
@@ -199,7 +197,7 @@ Qed.
Lemma recv_weaken l P1 P2 : (P1 -★ P2) ⊢ recv l P1 -★ recv l P2.
Proof.
rewrite /recv.
- iIntros "HP HP1"; iDestruct "HP1" as {γ P Q i} "(#Hctx&Hγ&Hi&HP1)".
+ iIntros "HP HP1"; iDestruct "HP1" as (γ P Q i) "(#Hctx&Hγ&Hi&HP1)".
iExists γ, P, Q, i. iFrame "Hctx Hγ Hi".
iIntros "> HQ". by iApply "HP"; iApply "HP1".
Qed.
diff --git a/heap_lang/lib/barrier/specification.v b/heap_lang/lib/barrier/specification.v
index c56f4d8a8b296217511efabbab1530e424f31801..0eb0937ec10795af9224c30be01c4734078e31fd 100644
--- a/heap_lang/lib/barrier/specification.v
+++ b/heap_lang/lib/barrier/specification.v
@@ -9,22 +9,22 @@ Context {Σ : gFunctors} `{!heapG Σ} `{!barrierG Σ}.
Local Notation iProp := (iPropG heap_lang Σ).
-Lemma barrier_spec (heapN N : namespace) :
+Lemma barrier_spec (N : namespace) :
heapN ⊥ N →
∃ recv send : loc → iProp -n> iProp,
- (∀ P, heap_ctx heapN ⊢ {{ True }} newbarrier #() {{ v,
- ∃ l : loc, v = #l ★ recv l P ★ send l P }}) ∧
+ (∀ P, heap_ctx ⊢ {{ True }} newbarrier #()
+ {{ v, ∃ l : loc, v = #l ★ recv l P ★ send l P }}) ∧
(∀ l P, {{ send l P ★ P }} signal #l {{ _, True }}) ∧
(∀ l P, {{ recv l P }} wait #l {{ _, P }}) ∧
(∀ l P Q, recv l (P ★ Q) ={N}=> recv l P ★ recv l Q) ∧
(∀ l P Q, (P -★ Q) ⊢ recv l P -★ recv l Q).
Proof.
intros HN.
- exists (λ l, CofeMor (recv heapN N l)), (λ l, CofeMor (send heapN N l)).
+ exists (λ l, CofeMor (recv N l)), (λ l, CofeMor (send N l)).
split_and?; simpl.
- - iIntros {P} "#? ! _". iApply (newbarrier_spec _ _ P); eauto.
- - iIntros {l P} "! [Hl HP]". by iApply signal_spec; iFrame "Hl HP".
- - iIntros {l P} "! Hl". iApply wait_spec; iFrame "Hl"; eauto.
+ - iIntros (P) "#? ! _". iApply (newbarrier_spec _ P); eauto.
+ - iIntros (l P) "! [Hl HP]". by iApply signal_spec; iFrame "Hl HP".
+ - iIntros (l P) "! Hl". iApply wait_spec; iFrame "Hl"; eauto.
- intros; by apply recv_split.
- apply recv_weaken.
Qed.
diff --git a/heap_lang/lib/counter.v b/heap_lang/lib/counter.v
index 62e3abe0a85707b296598aea94a423cc44c79762..bd7c6a9754e3cf785a0ad743a3286ca27ec50d95 100644
--- a/heap_lang/lib/counter.v
+++ b/heap_lang/lib/counter.v
@@ -8,9 +8,9 @@ Import uPred.
Definition newcounter : val := λ: <>, ref #0.
Definition inc : val :=
rec: "inc" "l" :=
- let: "n" := !'"l" in
- if: CAS '"l" '"n" (#1 + '"n") then #() else '"inc" '"l".
-Definition read : val := λ: "l", !'"l".
+ let: "n" := !"l" in
+ if: CAS "l" "n" (#1 + "n") then #() else "inc" "l".
+Definition read : val := λ: "l", !"l".
Global Opaque newcounter inc get.
(** The CMRA we need. *)
@@ -20,27 +20,26 @@ Instance inGF_counterG `{H : inGFs heap_lang Σ counterGF} : counterG Σ.
Proof. destruct H; split; apply _. Qed.
Section proof.
-Context {Σ : gFunctors} `{!heapG Σ, !counterG Σ}.
-Context (heapN : namespace).
+Context `{!heapG Σ, !counterG Σ} (N : namespace).
Local Notation iProp := (iPropG heap_lang Σ).
Definition counter_inv (l : loc) (n : mnat) : iProp := (l ↦ #n)%I.
Definition counter (l : loc) (n : nat) : iProp :=
- (∃ N γ, heapN ⊥ N ∧ heap_ctx heapN ∧
- auth_ctx γ N (counter_inv l) ∧ auth_own γ (n:mnat))%I.
+ (∃ γ, heapN ⊥ N ∧ heap_ctx ∧
+ auth_ctx γ N (counter_inv l) ∧ auth_own γ (n:mnat))%I.
(** The main proofs. *)
Global Instance counter_persistent l n : PersistentP (counter l n).
Proof. apply _. Qed.
-Lemma newcounter_spec N (R : iProp) Φ :
+Lemma newcounter_spec (R : iProp) Φ :
heapN ⊥ N →
- heap_ctx heapN ★ (∀ l, counter l 0 -★ Φ #l) ⊢ WP newcounter #() {{ Φ }}.
+ heap_ctx ★ (∀ l, counter l 0 -★ Φ #l) ⊢ WP newcounter #() {{ Φ }}.
Proof.
- iIntros {?} "[#Hh HΦ]". rewrite /newcounter. wp_seq. wp_alloc l as "Hl".
+ iIntros (?) "[#Hh HΦ]". rewrite /newcounter. wp_seq. wp_alloc l as "Hl".
iPvs (auth_alloc (counter_inv l) N _ (O:mnat) with "[Hl]")
- as {γ} "[#? Hγ]"; try by auto.
+ as (γ) "[#? Hγ]"; try by auto.
iPvsIntro. iApply "HΦ". rewrite /counter; eauto 10.
Qed.
@@ -48,13 +47,14 @@ Lemma inc_spec l j (Φ : val → iProp) :
counter l j ★ (counter l (S j) -★ Φ #()) ⊢ WP inc #l {{ Φ }}.
Proof.
iIntros "[Hl HΦ]". iLöb as "IH". wp_rec.
- iDestruct "Hl" as {N γ} "(% & #? & #Hγ & Hγf)".
- wp_focus (! _)%E; iApply (auth_fsa (counter_inv l) (wp_fsa _) _ N); auto.
- iIntros "{$Hγ $Hγf}"; iIntros {j'} "[% Hl] /="; rewrite {2}/counter_inv.
+ iDestruct "Hl" as (γ) "(% & #? & #Hγ & Hγf)".
+ wp_focus (! _)%E.
+ iApply (auth_fsa (counter_inv l) (wp_fsa _) _ N); auto with fsaV.
+ iIntros "{$Hγ $Hγf}"; iIntros (j') "[% Hl] /="; rewrite {2}/counter_inv.
wp_load; iPvsIntro; iExists j; iSplit; [done|iIntros "{$Hl} Hγf"].
- wp_let; wp_op.
- wp_focus (CAS _ _ _); iApply (auth_fsa (counter_inv l) (wp_fsa _) _ N); auto.
- iIntros "{$Hγ $Hγf}"; iIntros {j''} "[% Hl] /="; rewrite {2}/counter_inv.
+ wp_let; wp_op. wp_focus (CAS _ _ _).
+ iApply (auth_fsa (counter_inv l) (wp_fsa _) _ N); auto with fsaV.
+ iIntros "{$Hγ $Hγf}"; iIntros (j'') "[% Hl] /="; rewrite {2}/counter_inv.
destruct (decide (j `max` j'' = j `max` j')) as [Hj|Hj].
- wp_cas_suc; first (by do 3 f_equal); iPvsIntro.
iExists (1 + j `max` j')%nat; iSplit.
@@ -62,7 +62,7 @@ Proof.
rewrite {2}/counter_inv !mnat_op_max (Nat.max_l (S _)); last abstract lia.
rewrite Nat2Z.inj_succ -Z.add_1_l.
iIntros "{$Hl} Hγf". wp_if.
- iPvsIntro; iApply "HΦ"; iExists N, γ; repeat iSplit; eauto.
+ iPvsIntro; iApply "HΦ"; iExists γ; repeat iSplit; eauto.
iApply (auth_own_mono with "Hγf"). apply mnat_included. abstract lia.
- wp_cas_fail; first (rewrite !mnat_op_max; by intros [= ?%Nat2Z.inj]).
iPvsIntro. iExists j; iSplit; [done|iIntros "{$Hl} Hγf"].
@@ -73,9 +73,10 @@ Lemma read_spec l j (Φ : val → iProp) :
counter l j ★ (∀ i, ■(j ≤ i)%nat → counter l i -★ Φ #i)
⊢ WP read #l {{ Φ }}.
Proof.
- iIntros "[Hc HΦ]". iDestruct "Hc" as {N γ} "(% & #? & #Hγ & Hγf)".
- rewrite /read. wp_let. iApply (auth_fsa (counter_inv l) (wp_fsa _) _ N); auto.
- iIntros "{$Hγ $Hγf}"; iIntros {j'} "[% Hl] /=".
+ iIntros "[Hc HΦ]". iDestruct "Hc" as (γ) "(% & #? & #Hγ & Hγf)".
+ rewrite /read. wp_let.
+ iApply (auth_fsa (counter_inv l) (wp_fsa _) _ N); auto with fsaV.
+ iIntros "{$Hγ $Hγf}"; iIntros (j') "[% Hl] /=".
wp_load; iPvsIntro; iExists (j `max` j'); iSplit.
{ iPureIntro; apply mnat_local_update; abstract lia. }
rewrite !mnat_op_max -Nat.max_assoc Nat.max_idempotent; iIntros "{$Hl} Hγf".
diff --git a/heap_lang/lib/lock.v b/heap_lang/lib/lock.v
index 3edac7433880fda1fce7734d2f239f25ad68cec7..bc755b1dba7c1d3e8816bef515d3689b8c8a6d8d 100644
--- a/heap_lang/lib/lock.v
+++ b/heap_lang/lib/lock.v
@@ -6,8 +6,8 @@ Import uPred.
Definition newlock : val := λ: <>, ref #false.
Definition acquire : val :=
rec: "acquire" "l" :=
- if: CAS '"l" #false #true then #() else '"acquire" '"l".
-Definition release : val := λ: "l", '"l" <- #false.
+ if: CAS "l" #false #true then #() else "acquire" "l".
+Definition release : val := λ: "l", "l" <- #false.
Global Opaque newlock acquire release.
(** The CMRA we need. *)
@@ -18,19 +18,18 @@ Instance inGF_lockG `{H : inGFs heap_lang Σ lockGF} : lockG Σ.
Proof. destruct H. split. apply: inGF_inG. Qed.
Section proof.
-Context {Σ : gFunctors} `{!heapG Σ, !lockG Σ}.
-Context (heapN : namespace).
+Context `{!heapG Σ, !lockG Σ} (N : namespace).
Local Notation iProp := (iPropG heap_lang Σ).
Definition lock_inv (γ : gname) (l : loc) (R : iProp) : iProp :=
(∃ b : bool, l ↦ #b ★ if b then True else own γ (Excl ()) ★ R)%I.
Definition is_lock (l : loc) (R : iProp) : iProp :=
- (∃ N γ, heapN ⊥ N ∧ heap_ctx heapN ∧ inv N (lock_inv γ l R))%I.
+ (∃ γ, heapN ⊥ N ∧ heap_ctx ∧ inv N (lock_inv γ l R))%I.
Definition locked (l : loc) (R : iProp) : iProp :=
- (∃ N γ, heapN ⊥ N ∧ heap_ctx heapN ∧
- inv N (lock_inv γ l R) ∧ own γ (Excl ()))%I.
+ (∃ γ, heapN ⊥ N ∧ heap_ctx ∧
+ inv N (lock_inv γ l R) ∧ own γ (Excl ()))%I.
Global Instance lock_inv_ne n γ l : Proper (dist n ==> dist n) (lock_inv γ l).
Proof. solve_proper. Qed.
@@ -44,39 +43,39 @@ Global Instance is_lock_persistent l R : PersistentP (is_lock l R).
Proof. apply _. Qed.
Lemma locked_is_lock l R : locked l R ⊢ is_lock l R.
-Proof. rewrite /is_lock. iDestruct 1 as {N γ} "(?&?&?&_)"; eauto. Qed.
+Proof. rewrite /is_lock. iDestruct 1 as (γ) "(?&?&?&_)"; eauto. Qed.
-Lemma newlock_spec N (R : iProp) Φ :
+Lemma newlock_spec (R : iProp) Φ :
heapN ⊥ N →
- heap_ctx heapN ★ R ★ (∀ l, is_lock l R -★ Φ #l) ⊢ WP newlock #() {{ Φ }}.
+ heap_ctx ★ R ★ (∀ l, is_lock l R -★ Φ #l) ⊢ WP newlock #() {{ Φ }}.
Proof.
- iIntros {?} "(#Hh & HR & HΦ)". rewrite /newlock.
+ iIntros (?) "(#Hh & HR & HΦ)". rewrite /newlock.
wp_seq. wp_alloc l as "Hl".
- iPvs (own_alloc (Excl ())) as {γ} "Hγ"; first done.
+ iPvs (own_alloc (Excl ())) as (γ) "Hγ"; first done.
iPvs (inv_alloc N _ (lock_inv γ l R) with "[-HΦ]") as "#?"; first done.
{ iIntros ">". iExists false. by iFrame. }
- iPvsIntro. iApply "HΦ". iExists N, γ; eauto.
+ iPvsIntro. iApply "HΦ". iExists γ; eauto.
Qed.
Lemma acquire_spec l R (Φ : val → iProp) :
is_lock l R ★ (locked l R -★ R -★ Φ #()) ⊢ WP acquire #l {{ Φ }}.
Proof.
- iIntros "[Hl HΦ]". iDestruct "Hl" as {N γ} "(%&#?&#?)".
+ iIntros "[Hl HΦ]". iDestruct "Hl" as (γ) "(%&#?&#?)".
iLöb as "IH". wp_rec. wp_focus (CAS _ _ _)%E.
- iInv N as { [] } "[Hl HR]".
+ iInv N as ([]) "[Hl HR]".
- wp_cas_fail. iPvsIntro; iSplitL "Hl".
+ iNext. iExists true; eauto.
+ wp_if. by iApply "IH".
- wp_cas_suc. iPvsIntro. iDestruct "HR" as "[Hγ HR]". iSplitL "Hl".
+ iNext. iExists true; eauto.
- + wp_if. iApply ("HΦ" with "[-HR] HR"). iExists N, γ; eauto.
+ + wp_if. iApply ("HΦ" with "[-HR] HR"). iExists γ; eauto.
Qed.
Lemma release_spec R l (Φ : val → iProp) :
locked l R ★ R ★ Φ #() ⊢ WP release #l {{ Φ }}.
Proof.
- iIntros "(Hl&HR&HΦ)"; iDestruct "Hl" as {N γ} "(% & #? & #? & Hγ)".
- rewrite /release. wp_let. iInv N as {b} "[Hl _]".
+ iIntros "(Hl&HR&HΦ)"; iDestruct "Hl" as (γ) "(% & #? & #? & Hγ)".
+ rewrite /release. wp_let. iInv N as (b) "[Hl _]".
wp_store. iPvsIntro. iFrame "HΦ". iNext. iExists false. by iFrame.
Qed.
End proof.
diff --git a/heap_lang/lib/par.v b/heap_lang/lib/par.v
index 05e0f1cfecc5d44e9f70ea8c026b34a12cd52c3b..1d9cca643ee1a94959fa85bfcb199cfad0ffd5d4 100644
--- a/heap_lang/lib/par.v
+++ b/heap_lang/lib/par.v
@@ -2,47 +2,43 @@ From iris.heap_lang Require Export spawn.
From iris.heap_lang Require Import proofmode notation.
Import uPred.
-Definition par {X} : expr X :=
- λ: "fs",
- let: "handle" := ^spawn (Fst '"fs") in
- let: "v2" := Snd '"fs" #() in
- let: "v1" := ^join '"handle" in
- Pair '"v1" '"v2".
-Notation Par e1 e2 := (par (Pair (λ: <>, e1) (λ: <>, e2)))%E.
-Infix "||" := Par : expr_scope.
+Definition parN : namespace := nroot .@ "par".
-Instance do_wexpr_par {X Y} (H : X `included` Y) : WExpr H par par := _.
-Instance do_wsubst_par {X Y} x es (H : X `included` x :: Y) :
- WSubst x es H par par := do_wsubst_closed _ x es H _.
+Definition par : val :=
+ λ: "fs",
+ let: "handle" := spawn (Fst "fs") in
+ let: "v2" := Snd "fs" #() in
+ let: "v1" := join "handle" in
+ Pair "v1" "v2".
+Notation "e1 || e2" := (par (Pair (λ: <>, e1) (λ: <>, e2)))%E : expr_scope.
Global Opaque par.
Section proof.
-Context {Σ : gFunctors} `{!heapG Σ, !spawnG Σ}.
-Context (heapN N : namespace).
+Context `{!heapG Σ, !spawnG Σ}.
Local Notation iProp := (iPropG heap_lang Σ).
Lemma par_spec (Ψ1 Ψ2 : val → iProp) e (f1 f2 : val) (Φ : val → iProp) :
- heapN ⊥ N → to_val e = Some (f1,f2)%V →
- (heap_ctx heapN ★ WP f1 #() {{ Ψ1 }} ★ WP f2 #() {{ Ψ2 }} ★
+ to_val e = Some (f1,f2)%V →
+ (heap_ctx ★ WP f1 #() {{ Ψ1 }} ★ WP f2 #() {{ Ψ2 }} ★
∀ v1 v2, Ψ1 v1 ★ Ψ2 v2 -★ ▷ Φ (v1,v2)%V)
⊢ WP par e {{ Φ }}.
Proof.
- iIntros {??} "(#Hh&Hf1&Hf2&HΦ)".
+ iIntros (?) "(#Hh&Hf1&Hf2&HΦ)".
rewrite /par. wp_value. iPvsIntro. wp_let. wp_proj.
- wp_apply spawn_spec; try wp_done. iFrame "Hf1 Hh".
- iIntros {l} "Hl". wp_let. wp_proj. wp_focus (f2 _).
- iApply wp_wand_l; iFrame "Hf2"; iIntros {v} "H2". wp_let.
- wp_apply join_spec; iFrame "Hl". iIntros {w} "H1".
+ wp_apply (spawn_spec parN); try wp_done; try solve_ndisj; iFrame "Hf1 Hh".
+ iIntros (l) "Hl". wp_let. wp_proj. wp_focus (f2 _).
+ iApply wp_wand_l; iFrame "Hf2"; iIntros (v) "H2". wp_let.
+ wp_apply join_spec; iFrame "Hl". iIntros (w) "H1".
iSpecialize ("HΦ" with "* [-]"); first by iSplitL "H1". by wp_let.
Qed.
-Lemma wp_par (Ψ1 Ψ2 : val → iProp) (e1 e2 : expr []) (Φ : val → iProp) :
- heapN ⊥ N →
- (heap_ctx heapN ★ WP e1 {{ Ψ1 }} ★ WP e2 {{ Ψ2 }} ★
+Lemma wp_par (Ψ1 Ψ2 : val → iProp)
+ (e1 e2 : expr) `{!Closed [] e1, Closed [] e2} (Φ : val → iProp) :
+ (heap_ctx ★ WP e1 {{ Ψ1 }} ★ WP e2 {{ Ψ2 }} ★
∀ v1 v2, Ψ1 v1 ★ Ψ2 v2 -★ ▷ Φ (v1,v2)%V)
⊢ WP e1 || e2 {{ Φ }}.
Proof.
- iIntros {?} "(#Hh&H1&H2&H)". iApply (par_spec Ψ1 Ψ2); auto.
+ iIntros "(#Hh&H1&H2&H)". iApply (par_spec Ψ1 Ψ2); try wp_done.
iFrame "Hh H". iSplitL "H1"; by wp_let.
Qed.
End proof.
diff --git a/heap_lang/lib/spawn.v b/heap_lang/lib/spawn.v
index 75a09b4422c3a3db8fc3a356227ff43ff3224a20..221ca9b806b725b91727bb981ab7a9d573687ede 100644
--- a/heap_lang/lib/spawn.v
+++ b/heap_lang/lib/spawn.v
@@ -5,13 +5,13 @@ Import uPred.
Definition spawn : val :=
λ: "f",
- let: "c" := ref (InjL #0) in
- Fork ('"c" <- InjR ('"f" #())) ;; '"c".
+ let: "c" := ref NONE in
+ Fork ("c" <- SOME ("f" #())) ;; "c".
Definition join : val :=
rec: "join" "c" :=
- match: !'"c" with
- InjR "x" => '"x"
- | InjL <> => '"join" '"c"
+ match: !"c" with
+ SOME "x" => "x"
+ | NONE => "join" "c"
end.
Global Opaque spawn join.
@@ -28,16 +28,15 @@ Proof. destruct H as (?&?). split. apply: inGF_inG. Qed.
(** Now we come to the Iris part of the proof. *)
Section proof.
-Context {Σ : gFunctors} `{!heapG Σ, !spawnG Σ}.
-Context (heapN N : namespace).
+Context `{!heapG Σ, !spawnG Σ} (N : namespace).
Local Notation iProp := (iPropG heap_lang Σ).
Definition spawn_inv (γ : gname) (l : loc) (Ψ : val → iProp) : iProp :=
- (∃ lv, l ↦ lv ★ (lv = InjLV #0 ∨
- ∃ v, lv = InjRV v ★ (Ψ v ∨ own γ (Excl ()))))%I.
+ (∃ lv, l ↦ lv ★ (lv = NONEV ∨
+ ∃ v, lv = SOMEV v ★ (Ψ v ∨ own γ (Excl ()))))%I.
Definition join_handle (l : loc) (Ψ : val → iProp) : iProp :=
- (heapN ⊥ N ★ ∃ γ, heap_ctx heapN ★ own γ (Excl ()) ★
+ (heapN ⊥ N ★ ∃ γ, heap_ctx ★ own γ (Excl ()) ★
inv N (spawn_inv γ l Ψ))%I.
Typeclasses Opaque join_handle.
@@ -53,35 +52,35 @@ Proof. solve_proper. Qed.
Lemma spawn_spec (Ψ : val → iProp) e (f : val) (Φ : val → iProp) :
to_val e = Some f →
heapN ⊥ N →
- heap_ctx heapN ★ WP f #() {{ Ψ }} ★ (∀ l, join_handle l Ψ -★ Φ #l)
+ heap_ctx ★ WP f #() {{ Ψ }} ★ (∀ l, join_handle l Ψ -★ Φ #l)
⊢ WP spawn e {{ Φ }}.
Proof.
- iIntros {<-%of_to_val ?} "(#Hh&Hf&HΦ)". rewrite /spawn.
+ iIntros (<-%of_to_val ?) "(#Hh & Hf & HΦ)". rewrite /spawn.
wp_let. wp_alloc l as "Hl". wp_let.
- iPvs (own_alloc (Excl ())) as {γ} "Hγ"; first done.
+ iPvs (own_alloc (Excl ())) as (γ) "Hγ"; first done.
iPvs (inv_alloc N _ (spawn_inv γ l Ψ) with "[Hl]") as "#?"; first done.
- { iNext. iExists (InjLV #0). iFrame; eauto. }
+ { iNext. iExists NONEV. iFrame; eauto. }
wp_apply wp_fork. iSplitR "Hf".
- - iPvsIntro. wp_seq. iPvsIntro. iApply "HΦ"; rewrite /join_handle. eauto.
- - wp_focus (f _). iApply wp_wand_l; iFrame "Hf"; iIntros {v} "Hv".
- iInv N as {v'} "[Hl _]"; first wp_done.
- wp_store. iPvsIntro; iSplit; [iNext|done].
- iExists (InjRV v); iFrame; eauto.
+ - iPvsIntro. wp_seq. iPvsIntro. iApply "HΦ". rewrite /join_handle. eauto.
+ - wp_focus (f _). iApply wp_wand_l. iFrame "Hf"; iIntros (v) "Hv".
+ iInv N as (v') "[Hl _]".
+ wp_store. iPvsIntro. iSplit; [iNext|done].
+ iExists (SOMEV v). iFrame. eauto.
Qed.
Lemma join_spec (Ψ : val → iProp) l (Φ : val → iProp) :
join_handle l Ψ ★ (∀ v, Ψ v -★ Φ v) ⊢ WP join #l {{ Φ }}.
Proof.
- rewrite /join_handle; iIntros "[[% H] Hv]"; iDestruct "H" as {γ} "(#?&Hγ&#?)".
- iLöb as "IH". wp_rec. wp_focus (! _)%E. iInv N as {v} "[Hl Hinv]".
+ rewrite /join_handle; iIntros "[[% H] Hv]". iDestruct "H" as (γ) "(#?&Hγ&#?)".
+ iLöb as "IH". wp_rec. wp_focus (! _)%E. iInv N as (v) "[Hl Hinv]".
wp_load. iDestruct "Hinv" as "[%|Hinv]"; subst.
- iPvsIntro; iSplitL "Hl"; [iNext; iExists _; iFrame; eauto|].
wp_match. iApply ("IH" with "Hγ Hv").
- - iDestruct "Hinv" as {v'} "[% [HΨ|Hγ']]"; simplify_eq/=.
+ - iDestruct "Hinv" as (v') "[% [HΨ|Hγ']]"; simplify_eq/=.
+ iPvsIntro; iSplitL "Hl Hγ".
{ iNext. iExists _; iFrame; eauto. }
wp_match. by iApply "Hv".
- + iCombine "Hγ" "Hγ'" as "Hγ". iDestruct (own_valid with "Hγ") as %[].
+ + iCombine "Hγ" "Hγ'" as "Hγ". iDestruct (@own_valid with "Hγ") as %[].
Qed.
End proof.
diff --git a/heap_lang/lifting.v b/heap_lang/lifting.v
index ea1e9076f1321ecbc02b81de65cc1fda023af8d5..24eb4d3a6c6fe8c986870c08711745eea10f24e1 100644
--- a/heap_lang/lifting.v
+++ b/heap_lang/lifting.v
@@ -10,7 +10,7 @@ Section lifting.
Context {Σ : iFunctor}.
Implicit Types P Q : iProp heap_lang Σ.
Implicit Types Φ : val → iProp heap_lang Σ.
-Implicit Types ef : option (expr []).
+Implicit Types ef : option expr.
(** Bind. This bundles some arguments that wp_ectx_bind leaves as indices. *)
Lemma wp_bind {E e} K Φ :
@@ -23,20 +23,15 @@ Lemma wp_bindi {E e} Ki Φ :
Proof. exact: weakestpre.wp_bind. Qed.
(** Base axioms for core primitives of the language: Stateful reductions. *)
-Lemma wp_alloc_pst E σ e v Φ :
- to_val e = Some v →
+Lemma wp_alloc_pst E σ v Φ :
▷ ownP σ ★ ▷ (∀ l, σ !! l = None ∧ ownP (<[l:=v]>σ) ={E}=★ Φ (LitV (LitLoc l)))
- ⊢ WP Alloc e @ E {{ Φ }}.
+ ⊢ WP Alloc (of_val v) @ E {{ Φ }}.
Proof.
- iIntros {?} "[HP HΦ]".
- (* TODO: This works around ssreflect bug #22. *)
- set (φ (e' : expr []) σ' ef := ∃ l,
- ef = None ∧ e' = Lit (LitLoc l) ∧ σ' = <[l:=v]>σ ∧ σ !! l = None).
- iApply (wp_lift_atomic_head_step (Alloc e) φ σ); try (by simpl; eauto);
- [by intros; subst φ; inv_head_step; eauto 8|].
- iFrame "HP". iNext. iIntros {v2 σ2 ef} "[Hφ HP]".
- iDestruct "Hφ" as %(l & -> & [= <-]%of_to_val_flip & -> & ?); simpl.
- iSplit; last done. iApply "HΦ"; by iSplit.
+ iIntros "[HP HΦ]".
+ iApply (wp_lift_atomic_head_step (Alloc (of_val v)) σ); eauto with fsaV.
+ iFrame "HP". iNext. iIntros (v2 σ2 ef) "[% HP]". inv_head_step.
+ match goal with H: _ = of_val v2 |- _ => apply (inj of_val (LitV _)) in H end.
+ subst v2. iSplit; last done. iApply "HΦ"; by iSplit.
Qed.
Lemma wp_load_pst E σ l v Φ :
@@ -44,36 +39,37 @@ Lemma wp_load_pst E σ l v Φ :
▷ ownP σ ★ ▷ (ownP σ ={E}=★ Φ v) ⊢ WP Load (Lit (LitLoc l)) @ E {{ Φ }}.
Proof.
intros. rewrite -(wp_lift_atomic_det_head_step σ v σ None) ?right_id //;
- last (by intros; inv_head_step; eauto using to_of_val); simpl; by eauto.
+ last (by intros; inv_head_step; eauto using to_of_val). solve_atomic.
Qed.
-Lemma wp_store_pst E σ l e v v' Φ :
- to_val e = Some v → σ !! l = Some v' →
+Lemma wp_store_pst E σ l v v' Φ :
+ σ !! l = Some v' →
▷ ownP σ ★ ▷ (ownP (<[l:=v]>σ) ={E}=★ Φ (LitV LitUnit))
- ⊢ WP Store (Lit (LitLoc l)) e @ E {{ Φ }}.
+ ⊢ WP Store (Lit (LitLoc l)) (of_val v) @ E {{ Φ }}.
Proof.
- intros. rewrite-(wp_lift_atomic_det_head_step σ (LitV LitUnit) (<[l:=v]>σ) None)
- ?right_id //; last (by intros; inv_head_step; eauto); simpl; by eauto.
+ intros ?.
+ rewrite-(wp_lift_atomic_det_head_step σ (LitV LitUnit) (<[l:=v]>σ) None)
+ ?right_id //; last (by intros; inv_head_step; eauto). solve_atomic.
Qed.
-Lemma wp_cas_fail_pst E σ l e1 v1 e2 v2 v' Φ :
- to_val e1 = Some v1 → to_val e2 = Some v2 → σ !! l = Some v' → v' ≠v1 →
+Lemma wp_cas_fail_pst E σ l v1 v2 v' Φ :
+ σ !! l = Some v' → v' ≠v1 →
▷ ownP σ ★ ▷ (ownP σ ={E}=★ Φ (LitV $ LitBool false))
- ⊢ WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}.
+ ⊢ WP CAS (Lit (LitLoc l)) (of_val v1) (of_val v2) @ E {{ Φ }}.
Proof.
- intros. rewrite -(wp_lift_atomic_det_head_step σ (LitV $ LitBool false) σ None)
- ?right_id //; last (by intros; inv_head_step; eauto);
- simpl; by eauto 10.
+ intros ??.
+ rewrite -(wp_lift_atomic_det_head_step σ (LitV $ LitBool false) σ None)
+ ?right_id //; last (by intros; inv_head_step; eauto). solve_atomic.
Qed.
-Lemma wp_cas_suc_pst E σ l e1 v1 e2 v2 Φ :
- to_val e1 = Some v1 → to_val e2 = Some v2 → σ !! l = Some v1 →
+Lemma wp_cas_suc_pst E σ l v1 v2 Φ :
+ σ !! l = Some v1 →
▷ ownP σ ★ ▷ (ownP (<[l:=v2]>σ) ={E}=★ Φ (LitV $ LitBool true))
- ⊢ WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}.
+ ⊢ WP CAS (Lit (LitLoc l)) (of_val v1) (of_val v2) @ E {{ Φ }}.
Proof.
- intros. rewrite -(wp_lift_atomic_det_head_step σ (LitV $ LitBool true)
- (<[l:=v2]>σ) None) ?right_id //; last (by intros; inv_head_step; eauto);
- simpl; by eauto 10.
+ intros ?. rewrite -(wp_lift_atomic_det_head_step σ (LitV $ LitBool true)
+ (<[l:=v2]>σ) None) ?right_id //; last (by intros; inv_head_step; eauto).
+ solve_atomic.
Qed.
(** Base axioms for core primitives of the language: Stateless reductions *)
@@ -85,12 +81,13 @@ Proof.
rewrite later_sep -(wp_value_pvs _ _ (Lit _)) //.
Qed.
-Lemma wp_rec E f x erec e1 e2 v2 Φ :
+Lemma wp_rec E f x erec e1 e2 Φ :
e1 = Rec f x erec →
- to_val e2 = Some v2 →
+ is_Some (to_val e2) →
+ Closed (f :b: x :b: []) erec →
▷ WP subst' x e2 (subst' f e1 erec) @ E {{ Φ }} ⊢ WP App e1 e2 @ E {{ Φ }}.
Proof.
- intros -> ?. rewrite -(wp_lift_pure_det_head_step (App _ _)
+ intros -> [v2 ?] ?. rewrite -(wp_lift_pure_det_head_step (App _ _)
(subst' x e2 (subst' f (Rec f x erec) erec)) None) //= ?right_id;
intros; inv_head_step; eauto.
Qed.
@@ -125,35 +122,35 @@ Proof.
?right_id //; intros; inv_head_step; eauto.
Qed.
-Lemma wp_fst E e1 v1 e2 v2 Φ :
- to_val e1 = Some v1 → to_val e2 = Some v2 →
+Lemma wp_fst E e1 v1 e2 Φ :
+ to_val e1 = Some v1 → is_Some (to_val e2) →
▷ (|={E}=> Φ v1) ⊢ WP Fst (Pair e1 e2) @ E {{ Φ }}.
Proof.
- intros. rewrite -(wp_lift_pure_det_head_step (Fst _) e1 None)
+ intros ? [v2 ?]. rewrite -(wp_lift_pure_det_head_step (Fst _) e1 None)
?right_id -?wp_value_pvs //; intros; inv_head_step; eauto.
Qed.
-Lemma wp_snd E e1 v1 e2 v2 Φ :
- to_val e1 = Some v1 → to_val e2 = Some v2 →
+Lemma wp_snd E e1 e2 v2 Φ :
+ is_Some (to_val e1) → to_val e2 = Some v2 →
▷ (|={E}=> Φ v2) ⊢ WP Snd (Pair e1 e2) @ E {{ Φ }}.
Proof.
- intros. rewrite -(wp_lift_pure_det_head_step (Snd _) e2 None)
+ intros [v1 ?] ?. rewrite -(wp_lift_pure_det_head_step (Snd _) e2 None)
?right_id -?wp_value_pvs //; intros; inv_head_step; eauto.
Qed.
-Lemma wp_case_inl E e0 v0 e1 e2 Φ :
- to_val e0 = Some v0 →
+Lemma wp_case_inl E e0 e1 e2 Φ :
+ is_Some (to_val e0) →
▷ WP App e1 e0 @ E {{ Φ }} ⊢ WP Case (InjL e0) e1 e2 @ E {{ Φ }}.
Proof.
- intros. rewrite -(wp_lift_pure_det_head_step (Case _ _ _)
+ intros [v0 ?]. rewrite -(wp_lift_pure_det_head_step (Case _ _ _)
(App e1 e0) None) ?right_id //; intros; inv_head_step; eauto.
Qed.
-Lemma wp_case_inr E e0 v0 e1 e2 Φ :
- to_val e0 = Some v0 →
+Lemma wp_case_inr E e0 e1 e2 Φ :
+ is_Some (to_val e0) →
▷ WP App e2 e0 @ E {{ Φ }} ⊢ WP Case (InjR e0) e1 e2 @ E {{ Φ }}.
Proof.
- intros. rewrite -(wp_lift_pure_det_head_step (Case _ _ _)
+ intros [v0 ?]. rewrite -(wp_lift_pure_det_head_step (Case _ _ _)
(App e2 e0) None) ?right_id //; intros; inv_head_step; eauto.
Qed.
End lifting.
diff --git a/heap_lang/notation.v b/heap_lang/notation.v
index 0ebbc77e5189c290a93a4ff320116e1e7d953a35..05e173432ec7b604ec1ba7fbc5f8a765c6edd02b 100644
--- a/heap_lang/notation.v
+++ b/heap_lang/notation.v
@@ -24,6 +24,8 @@ Coercion LitLoc : loc >-> base_lit.
Coercion App : expr >-> Funclass.
Coercion of_val : val >-> expr.
+Coercion Var : string >-> expr.
+
Coercion BNamed : string >-> binder.
Notation "<>" := BAnon : binder_scope.
@@ -32,9 +34,6 @@ properly. *)
Notation "# l" := (LitV l%Z%V) (at level 8, format "# l").
Notation "# l" := (Lit l%Z%V) (at level 8, format "# l") : expr_scope.
-Notation "' x" := (Var x) (at level 8, format "' x") : expr_scope.
-Notation "^ e" := (wexpr' e) (at level 8, format "^ e") : expr_scope.
-
(** Syntax inspired by Coq/Ocaml. Constructions with higher precedence come
first. *)
Notation "( e1 , e2 , .. , en )" := (Pair .. (Pair e1 e2) .. en) : expr_scope.
@@ -58,6 +57,7 @@ Notation "e1 - e2" := (BinOp MinusOp e1%E e2%E)
Notation "e1 ≤ e2" := (BinOp LeOp e1%E e2%E) (at level 70) : expr_scope.
Notation "e1 < e2" := (BinOp LtOp e1%E e2%E) (at level 70) : expr_scope.
Notation "e1 = e2" := (BinOp EqOp e1%E e2%E) (at level 70) : expr_scope.
+Notation "e1 ≠e2" := (UnOp NegOp (BinOp EqOp e1%E e2%E)) (at level 70) : 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.
@@ -100,6 +100,10 @@ Notation "'let:' x := e1 'in' e2" := (LamV x%bind e2%E e1%E)
Notation "e1 ;; e2" := (LamV BAnon e2%E e1%E)
(at level 100, e2 at level 200, format "e1 ;; e2") : val_scope.
+(* Shortcircuit Boolean connectives *)
+Notation "e1 && e2" := (If e1%E e2%E (Lit (LitBool false))) : expr_scope.
+Notation "e1 || e2" := (If e1%E (Lit (LitBool true)) e2%E) : expr_scope.
+
(** Notations for option *)
Notation NONE := (InjL #()).
Notation SOME x := (InjR x).
@@ -110,6 +114,6 @@ Notation SOMEV x := (InjRV x).
Notation "'match:' e0 'with' 'NONE' => e1 | 'SOME' x => e2 'end'" :=
(Match e0 BAnon e1 x%bind e2)
(e0, e1, x, e2 at level 200) : expr_scope.
-Notation "'match:' e0 'with' 'SOME' x => e2 | 'NONE' => e1 | 'end'" :=
+Notation "'match:' e0 'with' 'SOME' x => e2 | 'NONE' => e1 'end'" :=
(Match e0 BAnon e1 x%bind e2)
(e0, e1, x, e2 at level 200, only parsing) : expr_scope.
diff --git a/heap_lang/proofmode.v b/heap_lang/proofmode.v
index c24b2fbd4902959fa09dff246bc3aaa325e08e2a..68f480a12d057f378f9e49a0453b5bbbcfc9eae6 100644
--- a/heap_lang/proofmode.v
+++ b/heap_lang/proofmode.v
@@ -6,8 +6,7 @@ Import uPred.
Ltac wp_strip_later ::= iNext.
Section heap.
-Context {Σ : gFunctors} `{heapG Σ}.
-Implicit Types N : namespace.
+Context `{heapG Σ}.
Implicit Types P Q : iPropG heap_lang Σ.
Implicit Types Φ : val → iPropG heap_lang Σ.
Implicit Types Δ : envs (iResUR heap_lang (globalF Σ)).
@@ -16,9 +15,9 @@ Global Instance into_sep_mapsto l q v :
IntoSep false (l ↦{q} v) (l ↦{q/2} v) (l ↦{q/2} v).
Proof. by rewrite /IntoSep heap_mapsto_op_split. Qed.
-Lemma tac_wp_alloc Δ Δ' N E j e v Φ :
- to_val e = Some v →
- (Δ ⊢ heap_ctx N) → nclose N ⊆ E →
+Lemma tac_wp_alloc Δ Δ' E j e v Φ :
+ to_val e = Some v →
+ (Δ ⊢ heap_ctx) → nclose heapN ⊆ E →
IntoLaterEnvs Δ Δ' →
(∀ l, ∃ Δ'',
envs_app false (Esnoc Enil j (l ↦ v)) Δ' = Some Δ'' ∧
@@ -32,8 +31,8 @@ Proof.
by rewrite right_id HΔ'.
Qed.
-Lemma tac_wp_load Δ Δ' N E i l q v Φ :
- (Δ ⊢ heap_ctx N) → nclose N ⊆ E →
+Lemma tac_wp_load Δ Δ' E i l q v Φ :
+ (Δ ⊢ heap_ctx) → nclose heapN ⊆ E →
IntoLaterEnvs Δ Δ' →
envs_lookup i Δ' = Some (false, l ↦{q} v)%I →
(Δ' ⊢ |={E}=> Φ v) →
@@ -44,9 +43,9 @@ Proof.
by apply later_mono, sep_mono_r, wand_mono.
Qed.
-Lemma tac_wp_store Δ Δ' Δ'' N E i l v e v' Φ :
+Lemma tac_wp_store Δ Δ' Δ'' E i l v e v' Φ :
to_val e = Some v' →
- (Δ ⊢ heap_ctx N) → nclose N ⊆ E →
+ (Δ ⊢ heap_ctx) → nclose heapN ⊆ E →
IntoLaterEnvs Δ Δ' →
envs_lookup i Δ' = Some (false, l ↦ v)%I →
envs_simple_replace i false (Esnoc Enil i (l ↦ v')) Δ' = Some Δ'' →
@@ -58,9 +57,9 @@ Proof.
rewrite right_id. by apply later_mono, sep_mono_r, wand_mono.
Qed.
-Lemma tac_wp_cas_fail Δ Δ' N E i l q v e1 v1 e2 v2 Φ :
+Lemma tac_wp_cas_fail Δ Δ' E i l q v e1 v1 e2 v2 Φ :
to_val e1 = Some v1 → to_val e2 = Some v2 →
- (Δ ⊢ heap_ctx N) → nclose N ⊆ E →
+ (Δ ⊢ heap_ctx) → nclose heapN ⊆ E →
IntoLaterEnvs Δ Δ' →
envs_lookup i Δ' = Some (false, l ↦{q} v)%I → v ≠v1 →
(Δ' ⊢ |={E}=> Φ (LitV (LitBool false))) →
@@ -71,9 +70,9 @@ Proof.
by apply later_mono, sep_mono_r, wand_mono.
Qed.
-Lemma tac_wp_cas_suc Δ Δ' Δ'' N E i l v e1 v1 e2 v2 Φ :
+Lemma tac_wp_cas_suc Δ Δ' Δ'' E i l v e1 v1 e2 v2 Φ :
to_val e1 = Some v1 → to_val e2 = Some v2 →
- (Δ ⊢ heap_ctx N) → nclose N ⊆ E →
+ (Δ ⊢ heap_ctx) → nclose heapN ⊆ E →
IntoLaterEnvs Δ Δ' →
envs_lookup i Δ' = Some (false, l ↦ v)%I → v = v1 →
envs_simple_replace i false (Esnoc Enil i (l ↦ v2)) Δ' = Some Δ'' →
@@ -101,11 +100,11 @@ Tactic Notation "wp_alloc" ident(l) "as" constr(H) :=
[reshape_expr e ltac:(fun K e' =>
match eval hnf in e' with Alloc _ => wp_bind K end)
|fail 1 "wp_alloc: cannot find 'Alloc' in" e];
- eapply tac_wp_alloc with _ _ H _;
+ eapply tac_wp_alloc with _ H _;
[let e' := match goal with |- to_val ?e' = _ => e' end in
wp_done || fail "wp_alloc:" e' "not a value"
|iAssumption || fail "wp_alloc: cannot find heap_ctx"
- |solve_ndisj
+ |solve_ndisj || fail "wp_alloc: cannot open heap invariant"
|apply _
|first [intros l | fail 1 "wp_alloc:" l "not fresh"];
eexists; split;
@@ -126,10 +125,10 @@ Tactic Notation "wp_load" :=
|fail 1 "wp_load: cannot find 'Load' in" e];
eapply tac_wp_load;
[iAssumption || fail "wp_load: cannot find heap_ctx"
- |solve_ndisj
+ |solve_ndisj || fail "wp_load: cannot open heap invariant"
|apply _
|let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in
- iAssumptionCore || fail "wp_cas_fail: cannot find" l "↦ ?"
+ iAssumptionCore || fail "wp_load: cannot find" l "↦ ?"
|wp_finish]
| _ => fail "wp_load: not a 'wp'"
end.
@@ -145,7 +144,7 @@ Tactic Notation "wp_store" :=
[let e' := match goal with |- to_val ?e' = _ => e' end in
wp_done || fail "wp_store:" e' "not a value"
|iAssumption || fail "wp_store: cannot find heap_ctx"
- |solve_ndisj
+ |solve_ndisj || fail "wp_store: cannot open heap invariant"
|apply _
|let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in
iAssumptionCore || fail "wp_store: cannot find" l "↦ ?"
@@ -167,7 +166,7 @@ Tactic Notation "wp_cas_fail" :=
|let e' := match goal with |- to_val ?e' = _ => e' end in
wp_done || fail "wp_cas_fail:" e' "not a value"
|iAssumption || fail "wp_cas_fail: cannot find heap_ctx"
- |solve_ndisj
+ |solve_ndisj || fail "wp_cas_fail: cannot open heap invariant"
|apply _
|let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in
iAssumptionCore || fail "wp_cas_fail: cannot find" l "↦ ?"
@@ -189,7 +188,7 @@ Tactic Notation "wp_cas_suc" :=
|let e' := match goal with |- to_val ?e' = _ => e' end in
wp_done || fail "wp_cas_suc:" e' "not a value"
|iAssumption || fail "wp_cas_suc: cannot find heap_ctx"
- |solve_ndisj
+ |solve_ndisj || fail "wp_cas_suc: cannot open heap invariant"
|apply _
|let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in
iAssumptionCore || fail "wp_cas_suc: cannot find" l "↦ ?"
diff --git a/heap_lang/substitution.v b/heap_lang/substitution.v
deleted file mode 100644
index 75ea52bef9f13ad4486746b4bac00e28441ba0d6..0000000000000000000000000000000000000000
--- a/heap_lang/substitution.v
+++ /dev/null
@@ -1,197 +0,0 @@
-From iris.heap_lang Require Export lang.
-Import heap_lang.
-
-(** The tactic [simpl_subst] performs substitutions in the goal. Its behavior
-can be tuned by declaring [WExpr] and [WSubst] instances. *)
-
-(** * Weakening *)
-Class WExpr {X Y} (H : X `included` Y) (e : expr X) (er : expr Y) :=
- do_wexpr : wexpr H e = er.
-Hint Mode WExpr + + + + - : typeclass_instances.
-
-(* Variables *)
-Hint Extern 0 (WExpr _ (Var ?y) _) =>
- apply var_proof_irrel : typeclass_instances.
-
-(* Rec *)
-Instance do_wexpr_rec_true {X Y f y e} {H : X `included` Y} er :
- WExpr (wexpr_rec_prf H) e er → WExpr H (Rec f y e) (Rec f y er) | 10.
-Proof. intros; red; f_equal/=. by etrans; [apply wexpr_proof_irrel|]. Qed.
-
-(* Values *)
-Instance do_wexpr_wexpr X Y Z (H1 : X `included` Y) (H2 : Y `included` Z) e er :
- WExpr (transitivity H1 H2) e er → WExpr H2 (wexpr H1 e) er | 0.
-Proof. by rewrite /WExpr wexpr_wexpr'. Qed.
-Instance do_wexpr_closed_closed (H : [] `included` []) e : WExpr H e e | 1.
-Proof. apply wexpr_id. Qed.
-Instance do_wexpr_closed_wexpr Y (H : [] `included` Y) e :
- WExpr H e (wexpr' e) | 2.
-Proof. apply wexpr_proof_irrel. Qed.
-
-(* Boring connectives *)
-Section do_wexpr.
-Context {X Y : list string} (H : X `included` Y).
-Notation W := (WExpr H).
-
-(* Ground terms *)
-Global Instance do_wexpr_lit l : W (Lit l) (Lit l).
-Proof. done. Qed.
-Global Instance do_wexpr_app e1 e2 e1r e2r :
- W e1 e1r → W e2 e2r → W (App e1 e2) (App e1r e2r).
-Proof. intros; red; f_equal/=; apply: do_wexpr. Qed.
-Global Instance do_wexpr_unop op e er : W e er → W (UnOp op e) (UnOp op er).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wexpr_binop op e1 e2 e1r e2r :
- W e1 e1r → W e2 e2r → W (BinOp op e1 e2) (BinOp op e1r e2r).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wexpr_if e0 e1 e2 e0r e1r e2r :
- W e0 e0r → W e1 e1r → W e2 e2r → W (If e0 e1 e2) (If e0r e1r e2r).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wexpr_pair e1 e2 e1r e2r :
- W e1 e1r → W e2 e2r → W (Pair e1 e2) (Pair e1r e2r).
-Proof. by intros ??; red; f_equal/=. Qed.
-Global Instance do_wexpr_fst e er : W e er → W (Fst e) (Fst er).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wexpr_snd e er : W e er → W (Snd e) (Snd er).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wexpr_injL e er : W e er → W (InjL e) (InjL er).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wexpr_injR e er : W e er → W (InjR e) (InjR er).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wexpr_case e0 e1 e2 e0r e1r e2r :
- W e0 e0r → W e1 e1r → W e2 e2r → W (Case e0 e1 e2) (Case e0r e1r e2r).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wexpr_fork e er : W e er → W (Fork e) (Fork er).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wexpr_alloc e er : W e er → W (Alloc e) (Alloc er).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wexpr_load e er : W e er → W (Load e) (Load er).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wexpr_store e1 e2 e1r e2r :
- W e1 e1r → W e2 e2r → W (Store e1 e2) (Store e1r e2r).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wexpr_cas e0 e1 e2 e0r e1r e2r :
- W e0 e0r → W e1 e1r → W e2 e2r → W (CAS e0 e1 e2) (CAS e0r e1r e2r).
-Proof. by intros; red; f_equal/=. Qed.
-End do_wexpr.
-
-(** * WSubstitution *)
-Class WSubst {X Y} (x : string) (es : expr []) H (e : expr X) (er : expr Y) :=
- do_wsubst : wsubst x es H e = er.
-Hint Mode WSubst + + + + + + - : typeclass_instances.
-
-Lemma do_wsubst_closed (e: ∀ {X}, expr X) {X Y} x es (H : X `included` x :: Y) :
- (∀ X, WExpr (included_nil X) e e) → WSubst x es H e e.
-Proof.
- rewrite /WSubst /WExpr=> He. rewrite -(He X) wsubst_wexpr'.
- by rewrite (wsubst_closed _ _ _ _ _ (included_nil _)); last set_solver.
-Qed.
-
-(* Variables *)
-Lemma do_wsubst_var_eq {X Y x es} {H : X `included` x :: Y} `{VarBound x X} er :
- WExpr (included_nil _) es er → WSubst x es H (Var x) er.
-Proof.
- intros; red; simpl. case_decide; last done.
- by etrans; [apply wexpr_proof_irrel|].
-Qed.
-Hint Extern 0 (WSubst ?x ?v _ (Var ?y) _) => first
- [ apply var_proof_irrel
- | apply do_wsubst_var_eq ] : typeclass_instances.
-
-(** Rec *)
-Lemma do_wsubst_rec_true {X Y x es f y e} {H : X `included` x :: Y}
- (Hfy : BNamed x ≠f ∧ BNamed x ≠y) er :
- WSubst x es (wsubst_rec_true_prf H Hfy) e er →
- WSubst x es H (Rec f y e) (Rec f y er).
-Proof.
- intros ?; red; f_equal/=; case_decide; last done.
- by etrans; [apply wsubst_proof_irrel|].
-Qed.
-Lemma do_wsubst_rec_false {X Y x es f y e} {H : X `included` x :: Y}
- (Hfy : ¬(BNamed x ≠f ∧ BNamed x ≠y)) er :
- WExpr (wsubst_rec_false_prf H Hfy) e er →
- WSubst x es H (Rec f y e) (Rec f y er).
-Proof.
- intros; red; f_equal/=; case_decide; first done.
- by etrans; [apply wexpr_proof_irrel|].
-Qed.
-
-Ltac bool_decide_no_check := apply (bool_decide_unpack _); vm_cast_no_check I.
-Hint Extern 0 (WSubst ?x ?v _ (Rec ?f ?y ?e) _) =>
- match eval vm_compute in (bool_decide (BNamed x ≠f ∧ BNamed x ≠y)) with
- | true => eapply (do_wsubst_rec_true ltac:(bool_decide_no_check))
- | false => eapply (do_wsubst_rec_false ltac:(bool_decide_no_check))
- end : typeclass_instances.
-
-(* Values *)
-Instance do_wsubst_wexpr X Y Z x es
- (H1 : X `included` Y) (H2 : Y `included` x :: Z) e er :
- WSubst x es (transitivity H1 H2) e er → WSubst x es H2 (wexpr H1 e) er | 0.
-Proof. by rewrite /WSubst wsubst_wexpr'. Qed.
-Instance do_wsubst_closed_closed x es (H : [] `included` [x]) e :
- WSubst x es H e e | 1.
-Proof. apply wsubst_closed_nil. Qed.
-Instance do_wsubst_closed_wexpr Y x es (H : [] `included` x :: Y) e :
- WSubst x es H e (wexpr' e) | 2.
-Proof. apply wsubst_closed, not_elem_of_nil. Qed.
-
-(* Boring connectives *)
-Section wsubst.
-Context {X Y} (x : string) (es : expr []) (H : X `included` x :: Y).
-Notation Sub := (WSubst x es H).
-
-(* Ground terms *)
-Global Instance do_wsubst_lit l : Sub (Lit l) (Lit l).
-Proof. done. Qed.
-Global Instance do_wsubst_app e1 e2 e1r e2r :
- Sub e1 e1r → Sub e2 e2r → Sub (App e1 e2) (App e1r e2r).
-Proof. intros; red; f_equal/=; apply: do_wsubst. Qed.
-Global Instance do_wsubst_unop op e er : Sub e er → Sub (UnOp op e) (UnOp op er).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wsubst_binop op e1 e2 e1r e2r :
- Sub e1 e1r → Sub e2 e2r → Sub (BinOp op e1 e2) (BinOp op e1r e2r).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wsubst_if e0 e1 e2 e0r e1r e2r :
- Sub e0 e0r → Sub e1 e1r → Sub e2 e2r → Sub (If e0 e1 e2) (If e0r e1r e2r).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wsubst_pair e1 e2 e1r e2r :
- Sub e1 e1r → Sub e2 e2r → Sub (Pair e1 e2) (Pair e1r e2r).
-Proof. by intros ??; red; f_equal/=. Qed.
-Global Instance do_wsubst_fst e er : Sub e er → Sub (Fst e) (Fst er).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wsubst_snd e er : Sub e er → Sub (Snd e) (Snd er).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wsubst_injL e er : Sub e er → Sub (InjL e) (InjL er).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wsubst_injR e er : Sub e er → Sub (InjR e) (InjR er).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wsubst_case e0 e1 e2 e0r e1r e2r :
- Sub e0 e0r → Sub e1 e1r → Sub e2 e2r → Sub (Case e0 e1 e2) (Case e0r e1r e2r).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wsubst_fork e er : Sub e er → Sub (Fork e) (Fork er).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wsubst_alloc e er : Sub e er → Sub (Alloc e) (Alloc er).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wsubst_load e er : Sub e er → Sub (Load e) (Load er).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wsubst_store e1 e2 e1r e2r :
- Sub e1 e1r → Sub e2 e2r → Sub (Store e1 e2) (Store e1r e2r).
-Proof. by intros; red; f_equal/=. Qed.
-Global Instance do_wsubst_cas e0 e1 e2 e0r e1r e2r :
- Sub e0 e0r → Sub e1 e1r → Sub e2 e2r → Sub (CAS e0 e1 e2) (CAS e0r e1r e2r).
-Proof. by intros; red; f_equal/=. Qed.
-End wsubst.
-
-(** * The tactic *)
-Lemma do_subst {X} (x: string) (es: expr []) (e: expr (x :: X)) (er: expr X) :
- WSubst x es (λ _, id) e er → subst x es e = er.
-Proof. done. Qed.
-
-Ltac simpl_subst :=
- repeat match goal with
- | |- context [subst ?x ?es ?e] => progress rewrite (@do_subst _ x es e)
- | |- _ => progress csimpl
- end.
-Arguments wexpr : simpl never.
-Arguments subst : simpl never.
-Arguments wsubst : simpl never.
diff --git a/heap_lang/tactics.v b/heap_lang/tactics.v
index 336f4043f8888ba97b9a8cdffbc1e07bd3f3058b..da060db51554e3dd23928e7676e1ddd7cda84891 100644
--- a/heap_lang/tactics.v
+++ b/heap_lang/tactics.v
@@ -1,7 +1,248 @@
-From iris.heap_lang Require Export substitution.
+From iris.heap_lang Require Export lang.
From iris.prelude Require Import fin_maps.
Import heap_lang.
+(** We define an alternative representation of expressions in which the
+embedding of values and closed expressions is explicit. By reification of
+expressions into this type we can implementation substitution, closedness
+checking, atomic checking, and conversion into values, by computation. *)
+Module W.
+Inductive expr :=
+ | Val (v : val)
+ | ClosedExpr (e : heap_lang.expr) `{!Closed [] e}
+ (* Base lambda calculus *)
+ | Var (x : string)
+ | Rec (f x : binder) (e : expr)
+ | App (e1 e2 : expr)
+ (* Base types and their operations *)
+ | Lit (l : base_lit)
+ | 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)
+ (* Concurrency *)
+ | Fork (e : expr)
+ (* Heap *)
+ | Alloc (e : expr)
+ | Load (e : expr)
+ | Store (e1 : expr) (e2 : expr)
+ | CAS (e0 : expr) (e1 : expr) (e2 : expr).
+
+Fixpoint to_expr (e : expr) : heap_lang.expr :=
+ match e with
+ | Val v => of_val v
+ | ClosedExpr e _ => e
+ | Var x => heap_lang.Var x
+ | Rec f x e => heap_lang.Rec f x (to_expr e)
+ | App e1 e2 => heap_lang.App (to_expr e1) (to_expr e2)
+ | Lit l => heap_lang.Lit l
+ | UnOp op e => heap_lang.UnOp op (to_expr e)
+ | BinOp op e1 e2 => heap_lang.BinOp op (to_expr e1) (to_expr e2)
+ | If e0 e1 e2 => heap_lang.If (to_expr e0) (to_expr e1) (to_expr e2)
+ | Pair e1 e2 => heap_lang.Pair (to_expr e1) (to_expr e2)
+ | Fst e => heap_lang.Fst (to_expr e)
+ | Snd e => heap_lang.Snd (to_expr e)
+ | InjL e => heap_lang.InjL (to_expr e)
+ | InjR e => heap_lang.InjR (to_expr e)
+ | Case e0 e1 e2 => heap_lang.Case (to_expr e0) (to_expr e1) (to_expr e2)
+ | Fork e => heap_lang.Fork (to_expr e)
+ | Alloc e => heap_lang.Alloc (to_expr e)
+ | Load e => heap_lang.Load (to_expr e)
+ | Store e1 e2 => heap_lang.Store (to_expr e1) (to_expr e2)
+ | CAS e0 e1 e2 => heap_lang.CAS (to_expr e0) (to_expr e1) (to_expr e2)
+ end.
+
+Ltac of_expr e :=
+ lazymatch e with
+ | heap_lang.Var ?x => constr:(Var x)
+ | heap_lang.Rec ?f ?x ?e => let e := of_expr e in constr:(Rec f x e)
+ | heap_lang.App ?e1 ?e2 =>
+ let e1 := of_expr e1 in let e2 := of_expr e2 in constr:(App e1 e2)
+ | heap_lang.Lit ?l => constr:(Lit l)
+ | heap_lang.UnOp ?op ?e => let e := of_expr e in constr:(UnOp op e)
+ | heap_lang.BinOp ?op ?e1 ?e2 =>
+ let e1 := of_expr e1 in let e2 := of_expr e2 in constr:(BinOp op e1 e2)
+ | heap_lang.If ?e0 ?e1 ?e2 =>
+ let e0 := of_expr e0 in let e1 := of_expr e1 in let e2 := of_expr e2 in
+ constr:(If e0 e1 e2)
+ | heap_lang.Pair ?e1 ?e2 =>
+ let e1 := of_expr e1 in let e2 := of_expr e2 in constr:(Pair e1 e2)
+ | heap_lang.Fst ?e => let e := of_expr e in constr:(Fst e)
+ | heap_lang.Snd ?e => let e := of_expr e in constr:(Snd e)
+ | heap_lang.InjL ?e => let e := of_expr e in constr:(InjL e)
+ | heap_lang.InjR ?e => let e := of_expr e in constr:(InjR e)
+ | heap_lang.Case ?e0 ?e1 ?e2 =>
+ let e0 := of_expr e0 in let e1 := of_expr e1 in let e2 := of_expr e2 in
+ constr:(Case e0 e1 e2)
+ | heap_lang.Fork ?e => let e := of_expr e in constr:(Fork e)
+ | heap_lang.Alloc ?e => let e := of_expr e in constr:(Alloc e)
+ | heap_lang.Load ?e => let e := of_expr e in constr:(Load e)
+ | heap_lang.Store ?e1 ?e2 =>
+ let e1 := of_expr e1 in let e2 := of_expr e2 in constr:(Store e1 e2)
+ | heap_lang.CAS ?e0 ?e1 ?e2 =>
+ let e0 := of_expr e0 in let e1 := of_expr e1 in let e2 := of_expr e2 in
+ constr:(CAS e0 e1 e2)
+ | to_expr ?e => e
+ | of_val ?v => constr:(Val v)
+ | _ => constr:(ltac:(
+ match goal with H : Closed [] e |- _ => exact (@ClosedExpr e H) end))
+ end.
+
+Fixpoint is_closed (X : list string) (e : expr) : bool :=
+ match e with
+ | Val _ | ClosedExpr _ _ => true
+ | Var x => bool_decide (x ∈ X)
+ | Rec f x e => is_closed (f :b: x :b: X) e
+ | Lit _ => true
+ | UnOp _ e | Fst e | Snd e | InjL e | InjR e | Fork e | Alloc e | Load e =>
+ is_closed X e
+ | App e1 e2 | BinOp _ e1 e2 | Pair e1 e2 | Store e1 e2 =>
+ is_closed X e1 && is_closed X e2
+ | If e0 e1 e2 | Case e0 e1 e2 | CAS e0 e1 e2 =>
+ is_closed X e0 && is_closed X e1 && is_closed X e2
+ end.
+Lemma is_closed_correct X e : is_closed X e → heap_lang.is_closed X (to_expr e).
+Proof.
+ revert X.
+ induction e; naive_solver eauto using is_closed_of_val, is_closed_weaken_nil.
+Qed.
+
+(* We define [to_val (ClosedExpr _)] to be [None] since [ClosedExpr]
+constructors are only generated for closed expressions of which we know nothing
+about apart from being closed. Notice that the reverse implication of
+[to_val_Some] thus does not hold. *)
+Fixpoint to_val (e : expr) : option val :=
+ match e with
+ | Val v => Some v
+ | Rec f x e =>
+ if decide (is_closed (f :b: x :b: []) e) is left H
+ then Some (@RecV f x (to_expr e) (is_closed_correct _ _ H)) else None
+ | Lit l => Some (LitV l)
+ | Pair e1 e2 => v1 ↠to_val e1; v2 ↠to_val e2; Some (PairV v1 v2)
+ | InjL e => InjLV <$> to_val e
+ | InjR e => InjRV <$> to_val e
+ | _ => None
+ end.
+Lemma to_val_Some e v :
+ to_val e = Some v → heap_lang.to_val (to_expr e) = Some v.
+Proof.
+ revert v. induction e; intros; simplify_option_eq; rewrite ?to_of_val; auto.
+ - do 2 f_equal. apply proof_irrel.
+ - exfalso. unfold Closed in *; eauto using is_closed_correct.
+Qed.
+Lemma to_val_is_Some e :
+ is_Some (to_val e) → is_Some (heap_lang.to_val (to_expr e)).
+Proof. intros [v ?]; exists v; eauto using to_val_Some. Qed.
+
+Fixpoint subst (x : string) (es : expr) (e : expr) : expr :=
+ match e with
+ | Val v => Val v
+ | ClosedExpr e H => @ClosedExpr e H
+ | Var y => if decide (x = y) then es else Var y
+ | Rec f y e =>
+ Rec f y $ if decide (BNamed x ≠f ∧ BNamed x ≠y) then subst x es e else e
+ | App e1 e2 => App (subst x es e1) (subst x es e2)
+ | Lit l => Lit l
+ | UnOp op e => UnOp op (subst x es e)
+ | BinOp op e1 e2 => BinOp op (subst x es e1) (subst x es e2)
+ | If e0 e1 e2 => If (subst x es e0) (subst x es e1) (subst x es e2)
+ | Pair e1 e2 => Pair (subst x es e1) (subst x es e2)
+ | Fst e => Fst (subst x es e)
+ | Snd e => Snd (subst x es e)
+ | InjL e => InjL (subst x es e)
+ | InjR e => InjR (subst x es e)
+ | Case e0 e1 e2 => Case (subst x es e0) (subst x es e1) (subst x es e2)
+ | Fork e => Fork (subst x es e)
+ | Alloc e => Alloc (subst x es e)
+ | Load e => Load (subst x es e)
+ | Store e1 e2 => Store (subst x es e1) (subst x es e2)
+ | CAS e0 e1 e2 => CAS (subst x es e0) (subst x es e1) (subst x es e2)
+ end.
+Lemma to_expr_subst x er e :
+ to_expr (subst x er e) = heap_lang.subst x (to_expr er) (to_expr e).
+Proof.
+ induction e; simpl; repeat case_decide;
+ f_equal; auto using is_closed_nil_subst, is_closed_of_val, eq_sym.
+Qed.
+
+Definition atomic (e : expr) :=
+ match e with
+ | Alloc e => bool_decide (is_Some (to_val e))
+ | Load e => bool_decide (is_Some (to_val e))
+ | Store e1 e2 => bool_decide (is_Some (to_val e1) ∧ is_Some (to_val e2))
+ | CAS e0 e1 e2 =>
+ bool_decide (is_Some (to_val e0) ∧ is_Some (to_val e1) ∧ is_Some (to_val e2))
+ (* Make "skip" atomic *)
+ | App (Rec _ _ (Lit _)) (Lit _) => true
+ | _ => false
+ end.
+Lemma atomic_correct e : atomic e → language.atomic (to_expr e).
+Proof.
+ intros He. apply ectx_language_atomic.
+ - intros σ e' σ' ef.
+ destruct e; simpl; try done; repeat (case_match; try done);
+ inversion 1; rewrite ?to_of_val; eauto. subst.
+ unfold subst'; repeat (case_match || contradiction || simplify_eq/=); eauto.
+ - intros [|Ki K] e' Hfill Hnotval; [done|exfalso].
+ apply (fill_not_val K), eq_None_not_Some in Hnotval. apply Hnotval. simpl.
+ revert He. destruct e; simpl; try done; repeat (case_match; try done);
+ rewrite ?bool_decide_spec;
+ destruct Ki; inversion Hfill; subst; clear Hfill;
+ try naive_solver eauto using to_val_is_Some.
+ move=> _ /=; destruct decide as [|Nclosed]; [by eauto | by destruct Nclosed].
+Qed.
+End W.
+
+Ltac solve_closed :=
+ match goal with
+ | |- Closed ?X ?e =>
+ let e' := W.of_expr e in change (Closed X (W.to_expr e'));
+ apply W.is_closed_correct; vm_compute; exact I
+ end.
+Hint Extern 0 (Closed _ _) => solve_closed : typeclass_instances.
+
+Ltac solve_to_val :=
+ try match goal with
+ | |- context E [language.to_val ?e] =>
+ let X := context E [to_val e] in change X
+ end;
+ match goal with
+ | |- to_val ?e = Some ?v =>
+ let e' := W.of_expr e in change (to_val (W.to_expr e') = Some v);
+ apply W.to_val_Some; simpl; unfold W.to_expr; reflexivity
+ | |- is_Some (to_val ?e) =>
+ let e' := W.of_expr e in change (is_Some (to_val (W.to_expr e')));
+ apply W.to_val_is_Some, (bool_decide_unpack _); vm_compute; exact I
+ end.
+
+Ltac solve_atomic :=
+ match goal with
+ | |- language.atomic ?e =>
+ let e' := W.of_expr e in change (language.atomic (W.to_expr e'));
+ apply W.atomic_correct; vm_compute; exact I
+ end.
+Hint Extern 0 (language.atomic _) => solve_atomic : fsaV.
+
+(** Substitution *)
+Ltac simpl_subst :=
+ simpl;
+ repeat match goal with
+ | |- context [subst ?x ?er ?e] =>
+ let er' := W.of_expr er in let e' := W.of_expr e in
+ change (subst x er e) with (subst x (W.to_expr er') (W.to_expr e'));
+ rewrite <-(W.to_expr_subst x); simpl (* ssr rewrite is slower *)
+ end;
+ unfold W.to_expr.
+Arguments W.to_expr : simpl never.
+Arguments subst : simpl never.
+
(** The tactic [inv_head_step] performs inversion on hypotheses of the
shape [head_step]. The tactic will discharge head-reductions starting
from values, and simplifies hypothesis related to conversions from and
@@ -25,13 +266,12 @@ Ltac reshape_val e tac :=
let rec go e :=
match e with
| of_val ?v => v
- | wexpr' ?e => reshape_val e tac
| Rec ?f ?x ?e => constr:(RecV f x e)
| Lit ?l => constr:(LitV l)
| Pair ?e1 ?e2 =>
- let v1 := reshape_val e1 in let v2 := reshape_val e2 in constr:(PairV v1 v2)
- | InjL ?e => let v := reshape_val e in constr:(InjLV v)
- | InjR ?e => let v := reshape_val e in constr:(InjRV v)
+ let v1 := go e1 in let v2 := go e2 in constr:(PairV v1 v2)
+ | InjL ?e => let v := go e in constr:(InjLV v)
+ | InjR ?e => let v := go e in constr:(InjRV v)
end in let v := go e in first [tac v | fail 2].
Ltac reshape_expr e tac :=
diff --git a/heap_lang/wp_tactics.v b/heap_lang/wp_tactics.v
index d32240a1ddb4b8224e63407669c0d34e16cf50fa..361b83a3a61a055095cf72f16f8c079a77a0a698 100644
--- a/heap_lang/wp_tactics.v
+++ b/heap_lang/wp_tactics.v
@@ -1,5 +1,5 @@
From iris.algebra Require Export upred_tactics.
-From iris.heap_lang Require Export tactics derived substitution.
+From iris.heap_lang Require Export tactics derived.
Import uPred.
(** wp-specific helper tactics *)
@@ -9,7 +9,15 @@ Ltac wp_bind K :=
| _ => etrans; [|fast_by apply (wp_bind K)]; simpl
end.
-Ltac wp_done := rewrite /= ?to_of_val; fast_done.
+(* Solves side-conditions generated by the wp tactics *)
+Ltac wp_done :=
+ match goal with
+ | |- Closed _ _ => solve_closed
+ | |- is_Some (to_val _) => solve_to_val
+ | |- to_val _ = Some _ => solve_to_val
+ | |- language.to_val _ = Some _ => solve_to_val
+ | _ => fast_done
+ end.
(* sometimes, we will have to do a final view shift, so only apply
pvs_intro if we obtain a consecutive wp *)
diff --git a/prelude/base.v b/prelude/base.v
index c4c2eb8227a2d20700f5554db1a3a476ad273268..b046cf8e814a59f69444b04f98611140c266b996 100644
--- a/prelude/base.v
+++ b/prelude/base.v
@@ -250,6 +250,12 @@ Lemma and_wlog_r (P Q : Prop) : P → (P → Q) → (P ∧ Q).
Proof. tauto. Qed.
Lemma impl_transitive (P Q R : Prop) : (P → Q) → (Q → R) → (P → R).
Proof. tauto. Qed.
+Lemma forall_proper {A} (P Q : A → Prop) :
+ (∀ x, P x ↔ Q x) → (∀ x, P x) ↔ (∀ x, Q x).
+Proof. firstorder. Qed.
+Lemma exist_proper {A} (P Q : A → Prop) :
+ (∀ x, P x ↔ Q x) → (∃ x, P x) ↔ (∃ x, Q x).
+Proof. firstorder. Qed.
Instance: Comm (↔) (@eq A).
Proof. red; intuition. Qed.
@@ -393,6 +399,8 @@ Proof. now intros -> ?. Qed.
Instance unit_equiv : Equiv unit := λ _ _, True.
Instance unit_equivalence : Equivalence (@equiv unit _).
Proof. repeat split. Qed.
+Instance unit_leibniz : LeibnizEquiv unit.
+Proof. intros [] []; reflexivity. Qed.
Instance unit_inhabited: Inhabited unit := populate ().
(** ** Products *)
@@ -588,7 +596,7 @@ Notation "(∩ x )" := (λ y, intersection y x) (only parsing) : C_scope.
Class Difference A := difference: A → A → A.
Instance: Params (@difference) 2.
-Infix "∖" := difference (at level 40) : C_scope.
+Infix "∖" := difference (at level 40, left associativity) : C_scope.
Notation "(∖)" := difference (only parsing) : C_scope.
Notation "( x ∖)" := (difference x) (only parsing) : C_scope.
Notation "(∖ x )" := (λ y, difference y x) (only parsing) : C_scope.
@@ -870,30 +878,7 @@ Notation "<[ k := a ]{ Γ }>" := (insertE Γ k a)
Arguments insertE _ _ _ _ _ _ !_ _ !_ / : simpl nomatch.
-(** * Ordered structures *)
-(** We do not use a setoid equality in the following interfaces to avoid the
-need for proofs that the relations and operations are proper. Instead, we
-define setoid equality generically [λ X Y, X ⊆ Y ∧ Y ⊆ X]. *)
-Class EmptySpec A `{Empty A, SubsetEq A} : Prop := subseteq_empty X : ∅ ⊆ X.
-Class JoinSemiLattice A `{SubsetEq A, Union A} : Prop := {
- join_semi_lattice_pre :>> PreOrder (⊆);
- union_subseteq_l X Y : X ⊆ X ∪ Y;
- union_subseteq_r X Y : Y ⊆ X ∪ Y;
- union_least X Y Z : X ⊆ Z → Y ⊆ Z → X ∪ Y ⊆ Z
-}.
-Class MeetSemiLattice A `{SubsetEq A, Intersection A} : Prop := {
- meet_semi_lattice_pre :>> PreOrder (⊆);
- intersection_subseteq_l X Y : X ∩ Y ⊆ X;
- intersection_subseteq_r X Y : X ∩ Y ⊆ Y;
- intersection_greatest X Y Z : Z ⊆ X → Z ⊆ Y → Z ⊆ X ∩ Y
-}.
-Class Lattice A `{SubsetEq A, Union A, Intersection A} : Prop := {
- lattice_join :>> JoinSemiLattice A;
- lattice_meet :>> MeetSemiLattice A;
- lattice_distr X Y Z : (X ∪ Y) ∩ (X ∪ Z) ⊆ X ∪ (Y ∩ Z)
-}.
-
-(** ** Axiomatization of collections *)
+(** * Axiomatization of collections *)
(** The class [SimpleCollection A C] axiomatizes a collection of type [C] with
elements of type [A]. *)
Class SimpleCollection A C `{ElemOf A C,
@@ -908,13 +893,6 @@ Class Collection A C `{ElemOf A C, Empty C, Singleton A C,
elem_of_intersection X Y (x : A) : x ∈ X ∩ Y ↔ x ∈ X ∧ x ∈ Y;
elem_of_difference X Y (x : A) : x ∈ X ∖ Y ↔ x ∈ X ∧ x ∉ Y
}.
-Class CollectionOps A C `{ElemOf A C, Empty C, Singleton A C, Union C,
- Intersection C, Difference C, IntersectionWith A C, Filter A C} : Prop := {
- collection_ops :>> Collection A C;
- elem_of_intersection_with (f : A → A → option A) X Y (x : A) :
- x ∈ intersection_with f X Y ↔ ∃ x1 x2, x1 ∈ X ∧ x2 ∈ Y ∧ f x1 x2 = Some x;
- elem_of_filter X P `{∀ x, Decision (P x)} x : x ∈ filter P X ↔ P x ∧ x ∈ X
-}.
(** We axiomative a finite collection as a collection whose elements can be
enumerated as a list. These elements, given by the [elements] function, may be
diff --git a/prelude/bsets.v b/prelude/bset.v
similarity index 100%
rename from prelude/bsets.v
rename to prelude/bset.v
diff --git a/prelude/co_pset.v b/prelude/coPset.v
similarity index 93%
rename from prelude/co_pset.v
rename to prelude/coPset.v
index a91bb62f2a324990a4a7036bce07b2e71ce0df73..9e37b07d05b7479608af74e3588599e5d1ecc0b7 100644
--- a/prelude/co_pset.v
+++ b/prelude/coPset.v
@@ -1,7 +1,16 @@
(* Copyright (c) 2012-2015, Robbert Krebbers. *)
(* This file is distributed under the terms of the BSD license. *)
-(** This files implements an efficient implementation of finite/cofinite sets
-of positive binary naturals [positive]. *)
+(** This files implements the type [coPset] of efficient finite/cofinite sets
+of positive binary naturals [positive]. These sets are:
+
+- Closed under union, intersection and set complement.
+- Closed under splitting of cofinite sets.
+
+Also, they enjoy various nice properties, such as decidable equality and set
+membership, as well as extensional equality (i.e. [X = Y ↔ ∀ x, x ∈ X ↔ x ∈ Y]).
+
+Since [positive]s are bitstrings, we encode [coPset]s as trees that correspond
+to the decision function that map bitstrings to bools. *)
From iris.prelude Require Export collections.
From iris.prelude Require Import pmap gmap mapset.
Local Open Scope positive_scope.
@@ -159,7 +168,6 @@ Instance coPset_difference : Difference coPset := λ X Y,
let (t1,Ht1) := X in let (t2,Ht2) := Y in
(t1 ∩ coPset_opp_raw t2) ↾ coPset_intersection_wf _ _ Ht1 (coPset_opp_wf _).
-Instance coPset_elem_of_dec (p : positive) (X : coPset) : Decision (p ∈ X) := _.
Instance coPset_collection : Collection positive coPset.
Proof.
split; [split| |].
@@ -173,12 +181,28 @@ Proof.
by rewrite elem_to_Pset_intersection,
elem_to_Pset_opp, andb_True, negb_True.
Qed.
+
Instance coPset_leibniz : LeibnizEquiv coPset.
Proof.
intros X Y; rewrite elem_of_equiv; intros HXY.
apply (sig_eq_pi _), coPset_eq; try apply proj2_sig.
intros p; apply eq_bool_prop_intro, (HXY p).
Qed.
+
+Instance coPset_elem_of_dec (p : positive) (X : coPset) : Decision (p ∈ X) := _.
+Instance coPset_equiv_dec (X Y : coPset) : Decision (X ≡ Y).
+Proof. refine (cast_if (decide (X = Y))); abstract (by fold_leibniz). Defined.
+Instance mapset_disjoint_dec (X Y : coPset) : Decision (X ⊥ Y).
+Proof.
+ refine (cast_if (decide (X ∩ Y = ∅)));
+ abstract (by rewrite disjoint_intersection_L).
+Defined.
+Instance mapset_subseteq_dec (X Y : coPset) : Decision (X ⊆ Y).
+Proof.
+ refine (cast_if (decide (X ∪ Y = Y))); abstract (by rewrite subseteq_union_L).
+Defined.
+
+(** * Top *)
Lemma coPset_top_subseteq (X : coPset) : X ⊆ ⊤.
Proof. done. Qed.
Hint Resolve coPset_top_subseteq.
@@ -213,9 +237,9 @@ Proof.
refine (cast_if (decide (coPset_finite (`X)))); by rewrite coPset_finite_spec.
Defined.
-(** * Pick element from infitinite sets *)
-(* just depth-first search: using this to pick elements results in very
-unbalanced trees. *)
+(** * Pick element from infinite sets *)
+(* Implemented using depth-first search, which results in very unbalanced
+trees. *)
Fixpoint coPpick_raw (t : coPset_raw) : option positive :=
match t with
| coPLeaf true | coPNode true _ _ => Some 1
diff --git a/prelude/collections.v b/prelude/collections.v
index 1f7c67af6a199a63ffd0daa805e2c14f86e0d02b..7762ce91a3398701a4cb186635d3d664a4afa9f2 100644
--- a/prelude/collections.v
+++ b/prelude/collections.v
@@ -3,136 +3,92 @@
(** This file collects definitions and theorems on collections. Most
importantly, it implements some tactics to automatically solve goals involving
collections. *)
-From iris.prelude Require Export base tactics orders.
+From iris.prelude Require Export orders list.
-Instance collection_disjoint `{ElemOf A C} : Disjoint C := λ X Y,
- ∀ x, x ∈ X → x ∈ Y → False.
+Instance collection_equiv `{ElemOf A C} : Equiv C := λ X Y,
+ ∀ x, x ∈ X ↔ x ∈ Y.
Instance collection_subseteq `{ElemOf A C} : SubsetEq C := λ X Y,
∀ x, x ∈ X → x ∈ Y.
-Typeclasses Opaque collection_disjoint collection_subseteq.
+Instance collection_disjoint `{ElemOf A C} : Disjoint C := λ X Y,
+ ∀ x, x ∈ X → x ∈ Y → False.
+Typeclasses Opaque collection_equiv collection_subseteq collection_disjoint.
-(** * Basic theorems *)
-Section simple_collection.
+(** * Setoids *)
+Section setoids_simple.
Context `{SimpleCollection A C}.
- Implicit Types x y : A.
- Implicit Types X Y : C.
- Lemma elem_of_empty x : x ∈ ∅ ↔ False.
- Proof. split. apply not_elem_of_empty. done. Qed.
- Lemma elem_of_union_l x X Y : x ∈ X → x ∈ X ∪ Y.
- Proof. intros. apply elem_of_union. auto. Qed.
- Lemma elem_of_union_r x X Y : x ∈ Y → x ∈ X ∪ Y.
- Proof. intros. apply elem_of_union. auto. Qed.
- Global Instance: EmptySpec C.
- Proof. firstorder auto. Qed.
- Global Instance: JoinSemiLattice C.
- Proof. firstorder auto. Qed.
- Global Instance: AntiSymm (≡) (@collection_subseteq A C _).
- Proof. done. Qed.
- Lemma elem_of_subseteq X Y : X ⊆ Y ↔ ∀ x, x ∈ X → x ∈ Y.
- Proof. done. Qed.
- Lemma elem_of_equiv X Y : X ≡ Y ↔ ∀ x, x ∈ X ↔ x ∈ Y.
- Proof. firstorder. Qed.
- Lemma elem_of_equiv_alt X Y :
- X ≡ Y ↔ (∀ x, x ∈ X → x ∈ Y) ∧ (∀ x, x ∈ Y → x ∈ X).
- Proof. firstorder. Qed.
- Lemma elem_of_equiv_empty X : X ≡ ∅ ↔ ∀ x, x ∉ X.
- Proof. firstorder. Qed.
- Lemma elem_of_disjoint X Y : X ⊥ Y ↔ ∀ x, x ∈ X → x ∈ Y → False.
- Proof. done. Qed.
-
- Global Instance disjoint_sym : Symmetric (@disjoint C _).
- Proof. intros ??. rewrite !elem_of_disjoint; naive_solver. Qed.
- Lemma disjoint_empty_l Y : ∅ ⊥ Y.
- Proof. rewrite elem_of_disjoint; intros x; by rewrite elem_of_empty. Qed.
- Lemma disjoint_empty_r X : X ⊥ ∅.
- Proof. rewrite (symmetry_iff _); apply disjoint_empty_l. Qed.
- Lemma disjoint_singleton_l x Y : {[ x ]} ⊥ Y ↔ x ∉ Y.
+ Global Instance collection_equivalence: @Equivalence C (≡).
Proof.
- rewrite elem_of_disjoint; setoid_rewrite elem_of_singleton; naive_solver.
+ split.
+ - done.
+ - intros X Y ? x. by symmetry.
+ - intros X Y Z ?? x; by trans (x ∈ Y).
Qed.
- Lemma disjoint_singleton_r y X : X ⊥ {[ y ]} ↔ y ∉ X.
- Proof. rewrite (symmetry_iff (⊥)). apply disjoint_singleton_l. Qed.
- Lemma disjoint_union_l X1 X2 Y : X1 ∪ X2 ⊥ Y ↔ X1 ⊥ Y ∧ X2 ⊥ Y.
+ Global Instance singleton_proper : Proper ((=) ==> (≡)) (singleton (B:=C)).
+ Proof. apply _. Qed.
+ Global Instance elem_of_proper :
+ Proper ((=) ==> (≡) ==> iff) (@elem_of A C _) | 5.
+ Proof. by intros x ? <- X Y. Qed.
+ Global Instance disjoint_proper: Proper ((≡) ==> (≡) ==> iff) (@disjoint C _).
Proof.
- rewrite !elem_of_disjoint; setoid_rewrite elem_of_union; naive_solver.
+ intros X1 X2 HX Y1 Y2 HY; apply forall_proper; intros x. by rewrite HX, HY.
Qed.
- Lemma disjoint_union_r X Y1 Y2 : X ⊥ Y1 ∪ Y2 ↔ X ⊥ Y1 ∧ X ⊥ Y2.
- Proof. rewrite !(symmetry_iff (⊥) X). apply disjoint_union_l. Qed.
-
- Lemma collection_positive_l X Y : X ∪ Y ≡ ∅ → X ≡ ∅.
+ Global Instance union_proper : Proper ((≡) ==> (≡) ==> (≡)) (@union C _).
+ Proof. intros X1 X2 HX Y1 Y2 HY x. rewrite !elem_of_union. f_equiv; auto. Qed.
+ Global Instance union_list_proper: Proper ((≡) ==> (≡)) (union_list (A:=C)).
+ Proof. by induction 1; simpl; try apply union_proper. Qed.
+ Global Instance subseteq_proper : Proper ((≡) ==> (≡) ==> iff) ((⊆) : relation C).
Proof.
- rewrite !elem_of_equiv_empty. setoid_rewrite elem_of_union. naive_solver.
+ intros X1 X2 HX Y1 Y2 HY. apply forall_proper; intros x. by rewrite HX, HY.
Qed.
- Lemma collection_positive_l_alt X Y : X ≢ ∅ → X ∪ Y ≢ ∅.
- Proof. eauto using collection_positive_l. Qed.
- Lemma elem_of_singleton_1 x y : x ∈ {[y]} → x = y.
- Proof. by rewrite elem_of_singleton. Qed.
- Lemma elem_of_singleton_2 x y : x = y → x ∈ {[y]}.
- Proof. by rewrite elem_of_singleton. Qed.
- Lemma elem_of_subseteq_singleton x X : x ∈ X ↔ {[ x ]} ⊆ X.
+End setoids_simple.
+
+Section setoids.
+ Context `{Collection A C}.
+
+ (** * Setoids *)
+ Global Instance intersection_proper :
+ Proper ((≡) ==> (≡) ==> (≡)) (@intersection C _).
Proof.
- split.
- - intros ??. rewrite elem_of_singleton. by intros ->.
- - intros Ex. by apply (Ex x), elem_of_singleton.
+ intros X1 X2 HX Y1 Y2 HY x. by rewrite !elem_of_intersection, HX, HY.
Qed.
-
- Global Instance singleton_proper : Proper ((=) ==> (≡)) (singleton (B:=C)).
- Proof. by repeat intro; subst. Qed.
- Global Instance elem_of_proper :
- Proper ((=) ==> (≡) ==> iff) (@elem_of A C _) | 5.
- Proof. intros ???; subst. firstorder. Qed.
- Global Instance disjoint_proper: Proper ((≡) ==> (≡) ==> iff) (@disjoint C _).
- Proof. intros ??????. by rewrite !elem_of_disjoint; setoid_subst. Qed.
- Lemma elem_of_union_list Xs x : x ∈ ⋃ Xs ↔ ∃ X, X ∈ Xs ∧ x ∈ X.
+ Global Instance difference_proper :
+ Proper ((≡) ==> (≡) ==> (≡)) (@difference C _).
Proof.
- split.
- - induction Xs; simpl; intros HXs; [by apply elem_of_empty in HXs|].
- setoid_rewrite elem_of_cons. apply elem_of_union in HXs. naive_solver.
- - intros [X []]. induction 1; simpl; [by apply elem_of_union_l |].
- intros. apply elem_of_union_r; auto.
+ intros X1 X2 HX Y1 Y2 HY x. by rewrite !elem_of_difference, HX, HY.
Qed.
- Lemma non_empty_singleton x : ({[ x ]} : C) ≢ ∅.
- Proof. intros [E _]. by apply (elem_of_empty x), E, elem_of_singleton. Qed.
- Lemma not_elem_of_singleton x y : x ∉ {[ y ]} ↔ x ≠y.
- Proof. by rewrite elem_of_singleton. Qed.
- Lemma not_elem_of_union x X Y : x ∉ X ∪ Y ↔ x ∉ X ∧ x ∉ Y.
- Proof. rewrite elem_of_union. tauto. Qed.
+End setoids.
- Section leibniz.
- Context `{!LeibnizEquiv C}.
- Lemma elem_of_equiv_L X Y : X = Y ↔ ∀ x, x ∈ X ↔ x ∈ Y.
- Proof. unfold_leibniz. apply elem_of_equiv. Qed.
- Lemma elem_of_equiv_alt_L X Y :
- X = Y ↔ (∀ x, x ∈ X → x ∈ Y) ∧ (∀ x, x ∈ Y → x ∈ X).
- Proof. unfold_leibniz. apply elem_of_equiv_alt. Qed.
- Lemma elem_of_equiv_empty_L X : X = ∅ ↔ ∀ x, x ∉ X.
- Proof. unfold_leibniz. apply elem_of_equiv_empty. Qed.
- Lemma collection_positive_l_L X Y : X ∪ Y = ∅ → X = ∅.
- Proof. unfold_leibniz. apply collection_positive_l. Qed.
- Lemma collection_positive_l_alt_L X Y : X ≠∅ → X ∪ Y ≠∅.
- Proof. unfold_leibniz. apply collection_positive_l_alt. Qed.
- Lemma non_empty_singleton_L x : {[ x ]} ≠∅.
- Proof. unfold_leibniz. apply non_empty_singleton. Qed.
- End leibniz.
+Section setoids_monad.
+ Context `{CollectionMonad M}.
- Section dec.
- Context `{∀ X Y : C, Decision (X ⊆ Y)}.
- Global Instance elem_of_dec_slow (x : A) (X : C) : Decision (x ∈ X) | 100.
- Proof.
- refine (cast_if (decide_rel (⊆) {[ x ]} X));
- by rewrite elem_of_subseteq_singleton.
- Defined.
- End dec.
-End simple_collection.
+ Global Instance collection_fmap_proper {A B} :
+ Proper (pointwise_relation _ (=) ==> (≡) ==> (≡)) (@fmap M _ A B).
+ Proof.
+ intros f1 f2 Hf X1 X2 HX x. rewrite !elem_of_fmap. f_equiv; intros z.
+ by rewrite HX, Hf.
+ Qed.
+ Global Instance collection_bind_proper {A B} :
+ Proper (((=) ==> (≡)) ==> (≡) ==> (≡)) (@mbind M _ A B).
+ Proof.
+ intros f1 f2 Hf X1 X2 HX x. rewrite !elem_of_bind. f_equiv; intros z.
+ by rewrite HX, (Hf z z).
+ Qed.
+ Global Instance collection_join_proper {A} :
+ Proper ((≡) ==> (≡)) (@mjoin M _ A).
+ Proof.
+ intros X1 X2 HX x. rewrite !elem_of_join. f_equiv; intros z. by rewrite HX.
+ Qed.
+End setoids_monad.
(** * Tactics *)
(** The tactic [set_unfold] transforms all occurrences of [(∪)], [(∩)], [(∖)],
[(<$>)], [∅], [{[_]}], [(≡)], and [(⊆)] into logically equivalent propositions
involving just [∈]. For example, [A → x ∈ X ∪ ∅] becomes [A → x ∈ X ∨ False].
-This transformation is implemented using type classes instead of [rewrite]ing
-to ensure that we traverse each term at most once. *)
+This transformation is implemented using type classes instead of setoid
+rewriting to ensure that we traverse each term at most once and to be able to
+deal with occurences of the set operations under binders. *)
Class SetUnfold (P Q : Prop) := { set_unfold : P ↔ Q }.
Arguments set_unfold _ _ {_}.
Hint Mode SetUnfold + - : typeclass_instances.
@@ -140,7 +96,7 @@ Hint Mode SetUnfold + - : typeclass_instances.
Class SetUnfoldSimpl (P Q : Prop) := { set_unfold_simpl : SetUnfold P Q }.
Hint Extern 0 (SetUnfoldSimpl _ _) => csimpl; constructor : typeclass_instances.
-Instance set_unfold_fallthrough P : SetUnfold P P | 1000. done. Qed.
+Instance set_unfold_default P : SetUnfold P P | 1000. done. Qed.
Definition set_unfold_1 `{SetUnfold P Q} : P → Q := proj1 (set_unfold P Q).
Definition set_unfold_2 `{SetUnfold P Q} : Q → P := proj2 (set_unfold P Q).
@@ -188,7 +144,7 @@ Section set_unfold_simple.
Implicit Types X Y : C.
Global Instance set_unfold_empty x : SetUnfold (x ∈ ∅) False.
- Proof. constructor; apply elem_of_empty. Qed.
+ Proof. constructor. split. apply not_elem_of_empty. done. Qed.
Global Instance set_unfold_singleton x y : SetUnfold (x ∈ {[ y ]}) (x = y).
Proof. constructor; apply elem_of_singleton. Qed.
Global Instance set_unfold_union x X Y P Q :
@@ -202,47 +158,48 @@ Section set_unfold_simple.
Global Instance set_unfold_equiv_empty_l X (P : A → Prop) :
(∀ x, SetUnfold (x ∈ X) (P x)) → SetUnfold (∅ ≡ X) (∀ x, ¬P x) | 5.
Proof.
- intros ?; constructor.
- rewrite (symmetry_iff equiv), elem_of_equiv_empty; naive_solver.
+ intros ?; constructor. unfold equiv, collection_equiv.
+ pose proof not_elem_of_empty; naive_solver.
Qed.
Global Instance set_unfold_equiv_empty_r (P : A → Prop) :
(∀ x, SetUnfold (x ∈ X) (P x)) → SetUnfold (X ≡ ∅) (∀ x, ¬P x) | 5.
- Proof. constructor. rewrite elem_of_equiv_empty; naive_solver. Qed.
+ Proof.
+ intros ?; constructor. unfold equiv, collection_equiv.
+ pose proof not_elem_of_empty; naive_solver.
+ Qed.
Global Instance set_unfold_equiv (P Q : A → Prop) :
(∀ x, SetUnfold (x ∈ X) (P x)) → (∀ x, SetUnfold (x ∈ Y) (Q x)) →
SetUnfold (X ≡ Y) (∀ x, P x ↔ Q x) | 10.
- Proof. constructor. rewrite elem_of_equiv; naive_solver. Qed.
+ Proof. constructor. apply forall_proper; naive_solver. Qed.
Global Instance set_unfold_subseteq (P Q : A → Prop) :
(∀ x, SetUnfold (x ∈ X) (P x)) → (∀ x, SetUnfold (x ∈ Y) (Q x)) →
SetUnfold (X ⊆ Y) (∀ x, P x → Q x).
- Proof. constructor. rewrite elem_of_subseteq; naive_solver. Qed.
+ Proof. constructor. apply forall_proper; naive_solver. Qed.
Global Instance set_unfold_subset (P Q : A → Prop) :
(∀ x, SetUnfold (x ∈ X) (P x)) → (∀ x, SetUnfold (x ∈ Y) (Q x)) →
- SetUnfold (X ⊂ Y) ((∀ x, P x → Q x) ∧ ¬∀ x, P x ↔ Q x).
+ SetUnfold (X ⊂ Y) ((∀ x, P x → Q x) ∧ ¬∀ x, Q x → P x).
Proof.
- constructor. rewrite subset_spec, elem_of_subseteq, elem_of_equiv.
- repeat f_equiv; naive_solver.
+ constructor. unfold strict.
+ repeat f_equiv; apply forall_proper; naive_solver.
Qed.
Global Instance set_unfold_disjoint (P Q : A → Prop) :
(∀ x, SetUnfold (x ∈ X) (P x)) → (∀ x, SetUnfold (x ∈ Y) (Q x)) →
SetUnfold (X ⊥ Y) (∀ x, P x → Q x → False).
- Proof. constructor. rewrite elem_of_disjoint. naive_solver. Qed.
+ Proof. constructor. unfold disjoint, collection_disjoint. naive_solver. Qed.
Context `{!LeibnizEquiv C}.
Global Instance set_unfold_equiv_same_L X : SetUnfold (X = X) True | 1.
Proof. done. Qed.
Global Instance set_unfold_equiv_empty_l_L X (P : A → Prop) :
(∀ x, SetUnfold (x ∈ X) (P x)) → SetUnfold (∅ = X) (∀ x, ¬P x) | 5.
- Proof.
- constructor. rewrite (symmetry_iff eq), elem_of_equiv_empty_L; naive_solver.
- Qed.
+ Proof. constructor. unfold_leibniz. by apply set_unfold_equiv_empty_l. Qed.
Global Instance set_unfold_equiv_empty_r_L (P : A → Prop) :
(∀ x, SetUnfold (x ∈ X) (P x)) → SetUnfold (X = ∅) (∀ x, ¬P x) | 5.
- Proof. constructor. rewrite elem_of_equiv_empty_L; naive_solver. Qed.
+ Proof. constructor. unfold_leibniz. by apply set_unfold_equiv_empty_r. Qed.
Global Instance set_unfold_equiv_L (P Q : A → Prop) :
(∀ x, SetUnfold (x ∈ X) (P x)) → (∀ x, SetUnfold (x ∈ Y) (Q x)) →
SetUnfold (X = Y) (∀ x, P x ↔ Q x) | 10.
- Proof. constructor. rewrite elem_of_equiv_L; naive_solver. Qed.
+ Proof. constructor. unfold_leibniz. by apply set_unfold_equiv. Qed.
End set_unfold_simple.
Section set_unfold.
@@ -253,14 +210,14 @@ Section set_unfold.
Global Instance set_unfold_intersection x X Y P Q :
SetUnfold (x ∈ X) P → SetUnfold (x ∈ Y) Q → SetUnfold (x ∈ X ∩ Y) (P ∧ Q).
Proof.
- intros ??; constructor. by rewrite elem_of_intersection,
- (set_unfold (x ∈ X) P), (set_unfold (x ∈ Y) Q).
+ intros ??; constructor. rewrite elem_of_intersection.
+ by rewrite (set_unfold (x ∈ X) P), (set_unfold (x ∈ Y) Q).
Qed.
Global Instance set_unfold_difference x X Y P Q :
SetUnfold (x ∈ X) P → SetUnfold (x ∈ Y) Q → SetUnfold (x ∈ X ∖ Y) (P ∧ ¬Q).
Proof.
- intros ??; constructor. by rewrite elem_of_difference,
- (set_unfold (x ∈ X) P), (set_unfold (x ∈ Y) Q).
+ intros ??; constructor. rewrite elem_of_difference.
+ by rewrite (set_unfold (x ∈ X) P), (set_unfold (x ∈ Y) Q).
Qed.
End set_unfold.
@@ -292,9 +249,8 @@ Ltac set_unfold :=
end in
apply set_unfold_2; unfold_hyps; csimpl in *.
-(** Since [firstorder] fails or loops on very small goals generated by
-[set_solver] already. We use the [naive_solver] tactic as a substitute.
-This tactic either fails or proves the goal. *)
+(** Since [firstorder] already fails or loops on very small goals generated by
+[set_solver], we use the [naive_solver] tactic as a substitute. *)
Tactic Notation "set_solver" "by" tactic3(tac) :=
try fast_done;
intros; setoid_subst;
@@ -314,98 +270,295 @@ Hint Extern 1000 (_ ∉ _) => set_solver : set_solver.
Hint Extern 1000 (_ ∈ _) => set_solver : set_solver.
Hint Extern 1000 (_ ⊆ _) => set_solver : set_solver.
-(** * Conversion of option and list *)
-Definition of_option `{Singleton A C, Empty C} (mx : option A) : C :=
- match mx with None => ∅ | Some x => {[ x ]} end.
-Fixpoint of_list `{Singleton A C, Empty C, Union C} (l : list A) : C :=
- match l with [] => ∅ | x :: l => {[ x ]} ∪ of_list l end.
-Section of_option_list.
+(** * Collections with [∪], [∅] and [{[_]}] *)
+Section simple_collection.
Context `{SimpleCollection A C}.
- Lemma elem_of_of_option (x : A) mx: x ∈ of_option mx ↔ mx = Some x.
- Proof. destruct mx; set_solver. Qed.
- Lemma elem_of_of_list (x : A) l : x ∈ of_list l ↔ x ∈ l.
+ Implicit Types x y : A.
+ Implicit Types X Y : C.
+ Implicit Types Xs Ys : list C.
+
+ (** Equality *)
+ Lemma elem_of_equiv X Y : X ≡ Y ↔ ∀ x, x ∈ X ↔ x ∈ Y.
+ Proof. set_solver. Qed.
+ Lemma collection_equiv_spec X Y : X ≡ Y ↔ X ⊆ Y ∧ Y ⊆ X.
+ Proof. set_solver. Qed.
+
+ (** Subset relation *)
+ Global Instance collection_subseteq_antisymm: AntiSymm (≡) ((⊆) : relation C).
+ Proof. intros ??. set_solver. Qed.
+
+ Global Instance collection_subseteq_preorder: PreOrder ((⊆) : relation C).
+ Proof. split. by intros ??. intros ???; set_solver. Qed.
+
+ Lemma subseteq_union X Y : X ⊆ Y ↔ X ∪ Y ≡ Y.
+ Proof. set_solver. Qed.
+ Lemma subseteq_union_1 X Y : X ⊆ Y → X ∪ Y ≡ Y.
+ Proof. by rewrite subseteq_union. Qed.
+ Lemma subseteq_union_2 X Y : X ∪ Y ≡ Y → X ⊆ Y.
+ Proof. by rewrite subseteq_union. Qed.
+
+ Lemma union_subseteq_l X Y : X ⊆ X ∪ Y.
+ Proof. set_solver. Qed.
+ Lemma union_subseteq_r X Y : Y ⊆ X ∪ Y.
+ Proof. set_solver. Qed.
+ Lemma union_least X Y Z : X ⊆ Z → Y ⊆ Z → X ∪ Y ⊆ Z.
+ Proof. set_solver. Qed.
+
+ Lemma elem_of_subseteq X Y : X ⊆ Y ↔ ∀ x, x ∈ X → x ∈ Y.
+ Proof. done. Qed.
+ Lemma elem_of_subset X Y : X ⊂ Y ↔ (∀ x, x ∈ X → x ∈ Y) ∧ ¬(∀ x, x ∈ Y → x ∈ X).
+ Proof. set_solver. Qed.
+
+ (** Union *)
+ Lemma not_elem_of_union x X Y : x ∉ X ∪ Y ↔ x ∉ X ∧ x ∉ Y.
+ Proof. set_solver. Qed.
+ Lemma elem_of_union_l x X Y : x ∈ X → x ∈ X ∪ Y.
+ Proof. set_solver. Qed.
+ Lemma elem_of_union_r x X Y : x ∈ Y → x ∈ X ∪ Y.
+ Proof. set_solver. Qed.
+
+ Lemma union_preserving_l X Y1 Y2 : Y1 ⊆ Y2 → X ∪ Y1 ⊆ X ∪ Y2.
+ Proof. set_solver. Qed.
+ Lemma union_preserving_r X1 X2 Y : X1 ⊆ X2 → X1 ∪ Y ⊆ X2 ∪ Y.
+ Proof. set_solver. Qed.
+ Lemma union_preserving X1 X2 Y1 Y2 : X1 ⊆ X2 → Y1 ⊆ Y2 → X1 ∪ Y1 ⊆ X2 ∪ Y2.
+ Proof. set_solver. Qed.
+
+ Global Instance union_idemp : IdemP ((≡) : relation C) (∪).
+ Proof. intros X. set_solver. Qed.
+ Global Instance union_empty_l : LeftId ((≡) : relation C) ∅ (∪).
+ Proof. intros X. set_solver. Qed.
+ Global Instance union_empty_r : RightId ((≡) : relation C) ∅ (∪).
+ Proof. intros X. set_solver. Qed.
+ Global Instance union_comm : Comm ((≡) : relation C) (∪).
+ Proof. intros X Y. set_solver. Qed.
+ Global Instance union_assoc : Assoc ((≡) : relation C) (∪).
+ Proof. intros X Y Z. set_solver. Qed.
+
+ Lemma empty_union X Y : X ∪ Y ≡ ∅ ↔ X ≡ ∅ ∧ Y ≡ ∅.
+ Proof. set_solver. Qed.
+
+ (** Empty *)
+ Lemma elem_of_equiv_empty X : X ≡ ∅ ↔ ∀ x, x ∉ X.
+ Proof. set_solver. Qed.
+ Lemma elem_of_empty x : x ∈ ∅ ↔ False.
+ Proof. set_solver. Qed.
+ Lemma equiv_empty X : X ⊆ ∅ → X ≡ ∅.
+ Proof. set_solver. Qed.
+ Lemma union_positive_l X Y : X ∪ Y ≡ ∅ → X ≡ ∅.
+ Proof. set_solver. Qed.
+ Lemma union_positive_l_alt X Y : X ≢ ∅ → X ∪ Y ≢ ∅.
+ Proof. set_solver. Qed.
+ Lemma non_empty_inhabited x X : x ∈ X → X ≢ ∅.
+ Proof. set_solver. Qed.
+
+ (** Singleton *)
+ Lemma elem_of_singleton_1 x y : x ∈ {[y]} → x = y.
+ Proof. by rewrite elem_of_singleton. Qed.
+ Lemma elem_of_singleton_2 x y : x = y → x ∈ {[y]}.
+ Proof. by rewrite elem_of_singleton. Qed.
+ Lemma elem_of_subseteq_singleton x X : x ∈ X ↔ {[ x ]} ⊆ X.
+ Proof. set_solver. Qed.
+ Lemma non_empty_singleton x : ({[ x ]} : C) ≢ ∅.
+ Proof. set_solver. Qed.
+ Lemma not_elem_of_singleton x y : x ∉ {[ y ]} ↔ x ≠y.
+ Proof. by rewrite elem_of_singleton. Qed.
+
+ (** Disjointness *)
+ Lemma elem_of_disjoint X Y : X ⊥ Y ↔ ∀ x, x ∈ X → x ∈ Y → False.
+ Proof. done. Qed.
+
+ Global Instance disjoint_sym : Symmetric (@disjoint C _).
+ Proof. intros X Y. set_solver. Qed.
+ Lemma disjoint_empty_l Y : ∅ ⊥ Y.
+ Proof. set_solver. Qed.
+ Lemma disjoint_empty_r X : X ⊥ ∅.
+ Proof. set_solver. Qed.
+ Lemma disjoint_singleton_l x Y : {[ x ]} ⊥ Y ↔ x ∉ Y.
+ Proof. set_solver. Qed.
+ Lemma disjoint_singleton_r y X : X ⊥ {[ y ]} ↔ y ∉ X.
+ Proof. set_solver. Qed.
+ Lemma disjoint_union_l X1 X2 Y : X1 ∪ X2 ⊥ Y ↔ X1 ⊥ Y ∧ X2 ⊥ Y.
+ Proof. set_solver. Qed.
+ Lemma disjoint_union_r X Y1 Y2 : X ⊥ Y1 ∪ Y2 ↔ X ⊥ Y1 ∧ X ⊥ Y2.
+ Proof. set_solver. Qed.
+
+ (** Big unions *)
+ Lemma elem_of_union_list Xs x : x ∈ ⋃ Xs ↔ ∃ X, X ∈ Xs ∧ x ∈ X.
Proof.
split.
- - induction l; simpl; [by rewrite elem_of_empty|].
- rewrite elem_of_union,elem_of_singleton; intros [->|?]; constructor; auto.
- - induction 1; simpl; rewrite elem_of_union, elem_of_singleton; auto.
+ - induction Xs; simpl; intros HXs; [by apply elem_of_empty in HXs|].
+ setoid_rewrite elem_of_cons. apply elem_of_union in HXs. naive_solver.
+ - intros [X []]. induction 1; simpl; [by apply elem_of_union_l |].
+ intros. apply elem_of_union_r; auto.
Qed.
- Global Instance set_unfold_of_option (mx : option A) x :
- SetUnfold (x ∈ of_option mx) (mx = Some x).
- Proof. constructor; apply elem_of_of_option. Qed.
- Global Instance set_unfold_of_list (l : list A) x P :
- SetUnfold (x ∈ l) P → SetUnfold (x ∈ of_list l) P.
- Proof. constructor. by rewrite elem_of_of_list, (set_unfold (x ∈ l) P). Qed.
-End of_option_list.
-
-Section list_unfold.
- Context {A : Type}.
- Implicit Types x : A.
- Implicit Types l : list A.
- Global Instance set_unfold_nil x : SetUnfold (x ∈ []) False.
- Proof. constructor; apply elem_of_nil. Qed.
- Global Instance set_unfold_cons x y l P :
- SetUnfold (x ∈ l) P → SetUnfold (x ∈ y :: l) (x = y ∨ P).
- Proof. constructor. by rewrite elem_of_cons, (set_unfold (x ∈ l) P). Qed.
- Global Instance set_unfold_app x l k P Q :
- SetUnfold (x ∈ l) P → SetUnfold (x ∈ k) Q → SetUnfold (x ∈ l ++ k) (P ∨ Q).
+ Lemma union_list_nil : ⋃ @nil C = ∅.
+ Proof. done. Qed.
+ Lemma union_list_cons X Xs : ⋃ (X :: Xs) = X ∪ ⋃ Xs.
+ Proof. done. Qed.
+ Lemma union_list_singleton X : ⋃ [X] ≡ X.
+ Proof. simpl. by rewrite (right_id ∅ _). Qed.
+ Lemma union_list_app Xs1 Xs2 : ⋃ (Xs1 ++ Xs2) ≡ ⋃ Xs1 ∪ ⋃ Xs2.
Proof.
- intros ??; constructor.
- by rewrite elem_of_app, (set_unfold (x ∈ l) P), (set_unfold (x ∈ k) Q).
+ induction Xs1 as [|X Xs1 IH]; simpl; [by rewrite (left_id ∅ _)|].
+ by rewrite IH, (assoc _).
Qed.
- Global Instance set_unfold_included l k (P Q : A → Prop) :
- (∀ x, SetUnfold (x ∈ l) (P x)) → (∀ x, SetUnfold (x ∈ k) (Q x)) →
- SetUnfold (l `included` k) (∀ x, P x → Q x).
- Proof. by constructor; unfold included; set_unfold. Qed.
-End list_unfold.
-
-(** * Guard *)
-Global Instance collection_guard `{CollectionMonad M} : MGuard M :=
- λ P dec A x, match dec with left H => x H | _ => ∅ end.
-
-Section collection_monad_base.
- Context `{CollectionMonad M}.
- Lemma elem_of_guard `{Decision P} {A} (x : A) (X : M A) :
- x ∈ guard P; X ↔ P ∧ x ∈ X.
+ Lemma union_list_reverse Xs : ⋃ (reverse Xs) ≡ ⋃ Xs.
Proof.
- unfold mguard, collection_guard; simpl; case_match;
- rewrite ?elem_of_empty; naive_solver.
+ induction Xs as [|X Xs IH]; simpl; [done |].
+ by rewrite reverse_cons, union_list_app,
+ union_list_singleton, (comm _), IH.
Qed.
- Lemma elem_of_guard_2 `{Decision P} {A} (x : A) (X : M A) :
- P → x ∈ X → x ∈ guard P; X.
- Proof. by rewrite elem_of_guard. Qed.
- Lemma guard_empty `{Decision P} {A} (X : M A) : guard P; X ≡ ∅ ↔ ¬P ∨ X ≡ ∅.
+ Lemma union_list_preserving Xs Ys : Xs ⊆* Ys → ⋃ Xs ⊆ ⋃ Ys.
+ Proof. induction 1; simpl; auto using union_preserving. Qed.
+ Lemma empty_union_list Xs : ⋃ Xs ≡ ∅ ↔ Forall (≡ ∅) Xs.
Proof.
- rewrite !elem_of_equiv_empty; setoid_rewrite elem_of_guard.
- destruct (decide P); naive_solver.
+ split.
+ - induction Xs; simpl; rewrite ?empty_union; intuition.
+ - induction 1 as [|?? E1 ? E2]; simpl. done. by apply empty_union.
Qed.
- Global Instance set_unfold_guard `{Decision P} {A} (x : A) X Q :
- SetUnfold (x ∈ X) Q → SetUnfold (x ∈ guard P; X) (P ∧ Q).
- Proof. constructor. by rewrite elem_of_guard, (set_unfold (x ∈ X) Q). Qed.
- Lemma bind_empty {A B} (f : A → M B) X :
- X ≫= f ≡ ∅ ↔ X ≡ ∅ ∨ ∀ x, x ∈ X → f x ≡ ∅.
- Proof. set_solver. Qed.
-End collection_monad_base.
-(** * More theorems *)
+ Section leibniz.
+ Context `{!LeibnizEquiv C}.
+
+ Lemma elem_of_equiv_L X Y : X = Y ↔ ∀ x, x ∈ X ↔ x ∈ Y.
+ Proof. unfold_leibniz. apply elem_of_equiv. Qed.
+ Lemma collection_equiv_spec_L X Y : X = Y ↔ X ⊆ Y ∧ Y ⊆ X.
+ Proof. unfold_leibniz. apply collection_equiv_spec. Qed.
+
+ (** Subset relation *)
+ Global Instance collection_subseteq_partialorder :
+ PartialOrder ((⊆) : relation C).
+ Proof. split. apply _. intros ??. unfold_leibniz. apply (anti_symm _). Qed.
+
+ Lemma subseteq_union_L X Y : X ⊆ Y ↔ X ∪ Y = Y.
+ Proof. unfold_leibniz. apply subseteq_union. Qed.
+ Lemma subseteq_union_1_L X Y : X ⊆ Y → X ∪ Y = Y.
+ Proof. unfold_leibniz. apply subseteq_union_1. Qed.
+ Lemma subseteq_union_2_L X Y : X ∪ Y = Y → X ⊆ Y.
+ Proof. unfold_leibniz. apply subseteq_union_2. Qed.
+
+ (** Union *)
+ Global Instance union_idemp_L : IdemP (@eq C) (∪).
+ Proof. intros ?. unfold_leibniz. apply (idemp _). Qed.
+ Global Instance union_empty_l_L : LeftId (@eq C) ∅ (∪).
+ Proof. intros ?. unfold_leibniz. apply (left_id _ _). Qed.
+ Global Instance union_empty_r_L : RightId (@eq C) ∅ (∪).
+ Proof. intros ?. unfold_leibniz. apply (right_id _ _). Qed.
+ Global Instance union_comm_L : Comm (@eq C) (∪).
+ Proof. intros ??. unfold_leibniz. apply (comm _). Qed.
+ Global Instance union_assoc_L : Assoc (@eq C) (∪).
+ Proof. intros ???. unfold_leibniz. apply (assoc _). Qed.
+
+ Lemma empty_union_L X Y : X ∪ Y = ∅ ↔ X = ∅ ∧ Y = ∅.
+ Proof. unfold_leibniz. apply empty_union. Qed.
+
+ (** Empty *)
+ Lemma elem_of_equiv_empty_L X : X = ∅ ↔ ∀ x, x ∉ X.
+ Proof. unfold_leibniz. apply elem_of_equiv_empty. Qed.
+ Lemma equiv_empty_L X : X ⊆ ∅ → X = ∅.
+ Proof. unfold_leibniz. apply equiv_empty. Qed.
+ Lemma union_positive_l_L X Y : X ∪ Y = ∅ → X = ∅.
+ Proof. unfold_leibniz. apply union_positive_l. Qed.
+ Lemma union_positive_l_alt_L X Y : X ≠∅ → X ∪ Y ≠∅.
+ Proof. unfold_leibniz. apply union_positive_l_alt. Qed.
+ Lemma non_empty_inhabited_L x X : x ∈ X → X ≠∅.
+ Proof. unfold_leibniz. apply non_empty_inhabited. Qed.
+
+ (** Singleton *)
+ Lemma non_empty_singleton_L x : {[ x ]} ≠∅.
+ Proof. unfold_leibniz. apply non_empty_singleton. Qed.
+
+ (** Big unions *)
+ Lemma union_list_singleton_L X : ⋃ [X] = X.
+ Proof. unfold_leibniz. apply union_list_singleton. Qed.
+ Lemma union_list_app_L Xs1 Xs2 : ⋃ (Xs1 ++ Xs2) = ⋃ Xs1 ∪ ⋃ Xs2.
+ Proof. unfold_leibniz. apply union_list_app. Qed.
+ Lemma union_list_reverse_L Xs : ⋃ (reverse Xs) = ⋃ Xs.
+ Proof. unfold_leibniz. apply union_list_reverse. Qed.
+ Lemma empty_union_list_L Xs : ⋃ Xs = ∅ ↔ Forall (= ∅) Xs.
+ Proof. unfold_leibniz. by rewrite empty_union_list. Qed.
+ End leibniz.
+
+ Section dec.
+ Context `{∀ (X Y : C), Decision (X ≡ Y)}.
+ Lemma collection_subseteq_inv X Y : X ⊆ Y → X ⊂ Y ∨ X ≡ Y.
+ Proof. destruct (decide (X ≡ Y)); [by right|left;set_solver]. Qed.
+ Lemma collection_not_subset_inv X Y : X ⊄ Y → X ⊈ Y ∨ X ≡ Y.
+ Proof. destruct (decide (X ≡ Y)); [by right|left;set_solver]. Qed.
+
+ Lemma non_empty_union X Y : X ∪ Y ≢ ∅ ↔ X ≢ ∅ ∨ Y ≢ ∅.
+ Proof. rewrite empty_union. destruct (decide (X ≡ ∅)); intuition. Qed.
+ Lemma non_empty_union_list Xs : ⋃ Xs ≢ ∅ → Exists (≢ ∅) Xs.
+ Proof. rewrite empty_union_list. apply (not_Forall_Exists _). Qed.
+
+ Context `{!LeibnizEquiv C}.
+ Lemma collection_subseteq_inv_L X Y : X ⊆ Y → X ⊂ Y ∨ X = Y.
+ Proof. unfold_leibniz. apply collection_subseteq_inv. Qed.
+ Lemma collection_not_subset_inv_L X Y : X ⊄ Y → X ⊈ Y ∨ X = Y.
+ Proof. unfold_leibniz. apply collection_not_subset_inv. Qed.
+ Lemma non_empty_union_L X Y : X ∪ Y ≠∅ ↔ X ≠∅ ∨ Y ≠∅.
+ Proof. unfold_leibniz. apply non_empty_union. Qed.
+ Lemma non_empty_union_list_L Xs : ⋃ Xs ≠∅ → Exists (≠∅) Xs.
+ Proof. unfold_leibniz. apply non_empty_union_list. Qed.
+ End dec.
+End simple_collection.
+
+
+(** * Collections with [∪], [∩], [∖], [∅] and [{[_]}] *)
Section collection.
Context `{Collection A C}.
Implicit Types X Y : C.
- Global Instance: Lattice C.
- Proof. split. apply _. firstorder auto. set_solver. Qed.
- Global Instance difference_proper :
- Proper ((≡) ==> (≡) ==> (≡)) (@difference C _).
- Proof.
- intros X1 X2 HX Y1 Y2 HY; apply elem_of_equiv; intros x.
- by rewrite !elem_of_difference, HX, HY.
- Qed.
- Lemma non_empty_inhabited x X : x ∈ X → X ≢ ∅.
+ (** Intersection *)
+ Lemma subseteq_intersection X Y : X ⊆ Y ↔ X ∩ Y ≡ X.
+ Proof. set_solver. Qed.
+ Lemma subseteq_intersection_1 X Y : X ⊆ Y → X ∩ Y ≡ X.
+ Proof. apply subseteq_intersection. Qed.
+ Lemma subseteq_intersection_2 X Y : X ∩ Y ≡ X → X ⊆ Y.
+ Proof. apply subseteq_intersection. Qed.
+
+ Lemma intersection_subseteq_l X Y : X ∩ Y ⊆ X.
+ Proof. set_solver. Qed.
+ Lemma intersection_subseteq_r X Y : X ∩ Y ⊆ Y.
+ Proof. set_solver. Qed.
+ Lemma intersection_greatest X Y Z : Z ⊆ X → Z ⊆ Y → Z ⊆ X ∩ Y.
+ Proof. set_solver. Qed.
+
+ Lemma intersection_preserving_l X Y1 Y2 : Y1 ⊆ Y2 → X ∩ Y1 ⊆ X ∩ Y2.
Proof. set_solver. Qed.
+ Lemma intersection_preserving_r X1 X2 Y : X1 ⊆ X2 → X1 ∩ Y ⊆ X2 ∩ Y.
+ Proof. set_solver. Qed.
+ Lemma intersection_preserving X1 X2 Y1 Y2 :
+ X1 ⊆ X2 → Y1 ⊆ Y2 → X1 ∩ Y1 ⊆ X2 ∩ Y2.
+ Proof. set_solver. Qed.
+
+ Global Instance intersection_idemp : IdemP ((≡) : relation C) (∩).
+ Proof. intros X; set_solver. Qed.
+ Global Instance intersection_comm : Comm ((≡) : relation C) (∩).
+ Proof. intros X Y; set_solver. Qed.
+ Global Instance intersection_assoc : Assoc ((≡) : relation C) (∩).
+ Proof. intros X Y Z; set_solver. Qed.
+ Global Instance intersection_empty_l : LeftAbsorb ((≡) : relation C) ∅ (∩).
+ Proof. intros X; set_solver. Qed.
+ Global Instance intersection_empty_r: RightAbsorb ((≡) : relation C) ∅ (∩).
+ Proof. intros X; set_solver. Qed.
+
Lemma intersection_singletons x : ({[x]} : C) ∩ {[x]} ≡ {[x]}.
Proof. set_solver. Qed.
+
+ Lemma union_intersection_l X Y Z : X ∪ (Y ∩ Z) ≡ (X ∪ Y) ∩ (X ∪ Z).
+ Proof. set_solver. Qed.
+ Lemma union_intersection_r X Y Z : (X ∩ Y) ∪ Z ≡ (X ∪ Z) ∩ (Y ∪ Z).
+ Proof. set_solver. Qed.
+ Lemma intersection_union_l X Y Z : X ∩ (Y ∪ Z) ≡ (X ∩ Y) ∪ (X ∩ Z).
+ Proof. set_solver. Qed.
+ Lemma intersection_union_r X Y Z : (X ∪ Y) ∩ Z ≡ (X ∩ Z) ∪ (Y ∩ Z).
+ Proof. set_solver. Qed.
+
+ (** Difference *)
Lemma difference_twice X Y : (X ∖ Y) ∖ Y ≡ X ∖ Y.
Proof. set_solver. Qed.
Lemma subseteq_empty_difference X Y : X ⊆ Y → X ∖ Y ≡ ∅.
@@ -418,13 +571,48 @@ Section collection.
Proof. set_solver. Qed.
Lemma difference_intersection_distr_l X Y Z : (X ∩ Y) ∖ Z ≡ X ∖ Z ∩ Y ∖ Z.
Proof. set_solver. Qed.
- Lemma disjoint_union_difference X Y : X ⊥ Y → (X ∪ Y) ∖ X ≡ Y.
+ Lemma difference_disjoint X Y : X ⊥ Y → X ∖ Y ≡ X.
+ Proof. set_solver. Qed.
+
+ (** Disjointness *)
+ Lemma disjoint_intersection X Y : X ⊥ Y ↔ X ∩ Y ≡ ∅.
Proof. set_solver. Qed.
Section leibniz.
Context `{!LeibnizEquiv C}.
+
+ (** Intersection *)
+ Lemma subseteq_intersection_L X Y : X ⊆ Y ↔ X ∩ Y = X.
+ Proof. unfold_leibniz. apply subseteq_intersection. Qed.
+ Lemma subseteq_intersection_1_L X Y : X ⊆ Y → X ∩ Y = X.
+ Proof. unfold_leibniz. apply subseteq_intersection_1. Qed.
+ Lemma subseteq_intersection_2_L X Y : X ∩ Y = X → X ⊆ Y.
+ Proof. unfold_leibniz. apply subseteq_intersection_2. Qed.
+
+ Global Instance intersection_idemp_L : IdemP ((=) : relation C) (∩).
+ Proof. intros ?. unfold_leibniz. apply (idemp _). Qed.
+ Global Instance intersection_comm_L : Comm ((=) : relation C) (∩).
+ Proof. intros ??. unfold_leibniz. apply (comm _). Qed.
+ Global Instance intersection_assoc_L : Assoc ((=) : relation C) (∩).
+ Proof. intros ???. unfold_leibniz. apply (assoc _). Qed.
+ Global Instance intersection_empty_l_L: LeftAbsorb ((=) : relation C) ∅ (∩).
+ Proof. intros ?. unfold_leibniz. apply (left_absorb _ _). Qed.
+ Global Instance intersection_empty_r_L: RightAbsorb ((=) : relation C) ∅ (∩).
+ Proof. intros ?. unfold_leibniz. apply (right_absorb _ _). Qed.
+
Lemma intersection_singletons_L x : {[x]} ∩ {[x]} = {[x]}.
Proof. unfold_leibniz. apply intersection_singletons. Qed.
+
+ Lemma union_intersection_l_L X Y Z : X ∪ (Y ∩ Z) = (X ∪ Y) ∩ (X ∪ Z).
+ Proof. unfold_leibniz; apply union_intersection_l. Qed.
+ Lemma union_intersection_r_L X Y Z : (X ∩ Y) ∪ Z = (X ∪ Z) ∩ (Y ∪ Z).
+ Proof. unfold_leibniz; apply union_intersection_r. Qed.
+ Lemma intersection_union_l_L X Y Z : X ∩ (Y ∪ Z) ≡ (X ∩ Y) ∪ (X ∩ Z).
+ Proof. unfold_leibniz; apply intersection_union_l. Qed.
+ Lemma intersection_union_r_L X Y Z : (X ∪ Y) ∩ Z ≡ (X ∩ Z) ∪ (Y ∩ Z).
+ Proof. unfold_leibniz; apply intersection_union_r. Qed.
+
+ (** Difference *)
Lemma difference_twice_L X Y : (X ∖ Y) ∖ Y = X ∖ Y.
Proof. unfold_leibniz. apply difference_twice. Qed.
Lemma subseteq_empty_difference_L X Y : X ⊆ Y → X ∖ Y = ∅.
@@ -438,8 +626,12 @@ Section collection.
Lemma difference_intersection_distr_l_L X Y Z :
(X ∩ Y) ∖ Z = X ∖ Z ∩ Y ∖ Z.
Proof. unfold_leibniz. apply difference_intersection_distr_l. Qed.
- Lemma disjoint_union_difference_L X Y : X ⊥ Y → (X ∪ Y) ∖ X = Y.
- Proof. unfold_leibniz. apply disjoint_union_difference. Qed.
+ Lemma difference_disjoint_L X Y : X ⊥ Y → X ∖ Y = X.
+ Proof. unfold_leibniz. apply difference_disjoint. Qed.
+
+ (** Disjointness *)
+ Lemma disjoint_intersection_L X Y : X ⊥ Y ↔ X ∩ Y = ∅.
+ Proof. unfold_leibniz. apply disjoint_intersection. Qed.
End leibniz.
Section dec.
@@ -450,13 +642,19 @@ Section collection.
Proof. rewrite elem_of_difference. destruct (decide (x ∈ Y)); tauto. Qed.
Lemma union_difference X Y : X ⊆ Y → Y ≡ X ∪ Y ∖ X.
Proof.
- split; intros x; rewrite !elem_of_union, elem_of_difference; [|intuition].
+ intros ? x; split; rewrite !elem_of_union, elem_of_difference; [|intuition].
destruct (decide (x ∈ X)); intuition.
Qed.
+ Lemma subseteq_disjoint_union X Y : X ⊆ Y ↔ ∃ Z, Y ≡ X ∪ Z ∧ X ⊥ Z.
+ Proof.
+ split; [|set_solver].
+ exists (Y ∖ X); split; [auto using union_difference|set_solver].
+ Qed.
Lemma non_empty_difference X Y : X ⊂ Y → Y ∖ X ≢ ∅.
Proof. intros [HXY1 HXY2] Hdiff. destruct HXY2. set_solver. Qed.
Lemma empty_difference_subseteq X Y : X ∖ Y ≡ ∅ → X ⊆ Y.
Proof. set_solver. Qed.
+
Context `{!LeibnizEquiv C}.
Lemma union_difference_L X Y : X ⊆ Y → Y = X ∪ Y ∖ X.
Proof. unfold_leibniz. apply union_difference. Qed.
@@ -464,85 +662,88 @@ Section collection.
Proof. unfold_leibniz. apply non_empty_difference. Qed.
Lemma empty_difference_subseteq_L X Y : X ∖ Y = ∅ → X ⊆ Y.
Proof. unfold_leibniz. apply empty_difference_subseteq. Qed.
+ Lemma subseteq_disjoint_union_L X Y : X ⊆ Y ↔ ∃ Z, Y = X ∪ Z ∧ X ⊥ Z.
+ Proof. unfold_leibniz. apply subseteq_disjoint_union. Qed.
End dec.
End collection.
-Section collection_ops.
- Context `{CollectionOps A C}.
- Lemma elem_of_intersection_with_list (f : A → A → option A) Xs Y x :
- x ∈ intersection_with_list f Y Xs ↔ ∃ xs y,
- Forall2 (∈) xs Xs ∧ y ∈ Y ∧ foldr (λ x, (≫= f x)) (Some y) xs = Some x.
+(** * Conversion of option and list *)
+Definition of_option `{Singleton A C, Empty C} (mx : option A) : C :=
+ match mx with None => ∅ | Some x => {[ x ]} end.
+Fixpoint of_list `{Singleton A C, Empty C, Union C} (l : list A) : C :=
+ match l with [] => ∅ | x :: l => {[ x ]} ∪ of_list l end.
+
+Section of_option_list.
+ Context `{SimpleCollection A C}.
+ Lemma elem_of_of_option (x : A) mx: x ∈ of_option mx ↔ mx = Some x.
+ Proof. destruct mx; set_solver. Qed.
+ Lemma elem_of_of_list (x : A) l : x ∈ of_list l ↔ x ∈ l.
Proof.
split.
- - revert x. induction Xs; simpl; intros x HXs; [eexists [], x; intuition|].
- rewrite elem_of_intersection_with in HXs; destruct HXs as (x1&x2&?&?&?).
- destruct (IHXs x2) as (xs & y & hy & ? & ?); trivial.
- eexists (x1 :: xs), y. intuition (simplify_option_eq; auto).
- - intros (xs & y & Hxs & ? & Hx). revert x Hx.
- induction Hxs; intros; simplify_option_eq; [done |].
- rewrite elem_of_intersection_with. naive_solver.
- Qed.
-
- Lemma intersection_with_list_ind (P Q : A → Prop) f Xs Y :
- (∀ y, y ∈ Y → P y) →
- Forall (λ X, ∀ x, x ∈ X → Q x) Xs →
- (∀ x y z, Q x → P y → f x y = Some z → P z) →
- ∀ x, x ∈ intersection_with_list f Y Xs → P x.
- Proof.
- intros HY HXs Hf. induction Xs; simplify_option_eq; [done |].
- intros x Hx. rewrite elem_of_intersection_with in Hx.
- decompose_Forall. destruct Hx as (? & ? & ? & ? & ?). eauto.
- Qed.
-End collection_ops.
-
-(** * Sets without duplicates up to an equivalence *)
-Section NoDup.
- Context `{SimpleCollection A B} (R : relation A) `{!Equivalence R}.
-
- Definition elem_of_upto (x : A) (X : B) := ∃ y, y ∈ X ∧ R x y.
- Definition set_NoDup (X : B) := ∀ x y, x ∈ X → y ∈ X → R x y → x = y.
-
- Global Instance: Proper ((≡) ==> iff) (elem_of_upto x).
- Proof. intros ??? E. unfold elem_of_upto. by setoid_rewrite E. Qed.
- Global Instance: Proper (R ==> (≡) ==> iff) elem_of_upto.
- Proof.
- intros ?? E1 ?? E2. split; intros [z [??]]; exists z.
- - rewrite <-E1, <-E2; intuition.
- - rewrite E1, E2; intuition.
- Qed.
- Global Instance: Proper ((≡) ==> iff) set_NoDup.
- Proof. firstorder. Qed.
-
- Lemma elem_of_upto_elem_of x X : x ∈ X → elem_of_upto x X.
- Proof. unfold elem_of_upto. set_solver. Qed.
- Lemma elem_of_upto_empty x : ¬elem_of_upto x ∅.
- Proof. unfold elem_of_upto. set_solver. Qed.
- Lemma elem_of_upto_singleton x y : elem_of_upto x {[ y ]} ↔ R x y.
- Proof. unfold elem_of_upto. set_solver. Qed.
-
- Lemma elem_of_upto_union X Y x :
- elem_of_upto x (X ∪ Y) ↔ elem_of_upto x X ∨ elem_of_upto x Y.
- Proof. unfold elem_of_upto. set_solver. Qed.
- Lemma not_elem_of_upto x X : ¬elem_of_upto x X → ∀ y, y ∈ X → ¬R x y.
- Proof. unfold elem_of_upto. set_solver. Qed.
-
- Lemma set_NoDup_empty: set_NoDup ∅.
- Proof. unfold set_NoDup. set_solver. Qed.
- Lemma set_NoDup_add x X :
- ¬elem_of_upto x X → set_NoDup X → set_NoDup ({[ x ]} ∪ X).
- Proof. unfold set_NoDup, elem_of_upto. set_solver. Qed.
- Lemma set_NoDup_inv_add x X :
- x ∉ X → set_NoDup ({[ x ]} ∪ X) → ¬elem_of_upto x X.
- Proof.
- intros Hin Hnodup [y [??]].
- rewrite (Hnodup x y) in Hin; set_solver.
- Qed.
- Lemma set_NoDup_inv_union_l X Y : set_NoDup (X ∪ Y) → set_NoDup X.
- Proof. unfold set_NoDup. set_solver. Qed.
- Lemma set_NoDup_inv_union_r X Y : set_NoDup (X ∪ Y) → set_NoDup Y.
- Proof. unfold set_NoDup. set_solver. Qed.
-End NoDup.
+ - induction l; simpl; [by rewrite elem_of_empty|].
+ rewrite elem_of_union,elem_of_singleton; intros [->|?]; constructor; auto.
+ - induction 1; simpl; rewrite elem_of_union, elem_of_singleton; auto.
+ Qed.
+ Global Instance set_unfold_of_option (mx : option A) x :
+ SetUnfold (x ∈ of_option mx) (mx = Some x).
+ Proof. constructor; apply elem_of_of_option. Qed.
+ Global Instance set_unfold_of_list (l : list A) x P :
+ SetUnfold (x ∈ l) P → SetUnfold (x ∈ of_list l) P.
+ Proof. constructor. by rewrite elem_of_of_list, (set_unfold (x ∈ l) P). Qed.
+End of_option_list.
+
+Section list_unfold.
+ Context {A : Type}.
+ Implicit Types x : A.
+ Implicit Types l : list A.
+
+ Global Instance set_unfold_nil x : SetUnfold (x ∈ []) False.
+ Proof. constructor; apply elem_of_nil. Qed.
+ Global Instance set_unfold_cons x y l P :
+ SetUnfold (x ∈ l) P → SetUnfold (x ∈ y :: l) (x = y ∨ P).
+ Proof. constructor. by rewrite elem_of_cons, (set_unfold (x ∈ l) P). Qed.
+ Global Instance set_unfold_app x l k P Q :
+ SetUnfold (x ∈ l) P → SetUnfold (x ∈ k) Q → SetUnfold (x ∈ l ++ k) (P ∨ Q).
+ Proof.
+ intros ??; constructor.
+ by rewrite elem_of_app, (set_unfold (x ∈ l) P), (set_unfold (x ∈ k) Q).
+ Qed.
+ Global Instance set_unfold_included l k (P Q : A → Prop) :
+ (∀ x, SetUnfold (x ∈ l) (P x)) → (∀ x, SetUnfold (x ∈ k) (Q x)) →
+ SetUnfold (l `included` k) (∀ x, P x → Q x).
+ Proof. by constructor; unfold included; set_unfold. Qed.
+End list_unfold.
+
+
+(** * Guard *)
+Global Instance collection_guard `{CollectionMonad M} : MGuard M :=
+ λ P dec A x, match dec with left H => x H | _ => ∅ end.
+
+Section collection_monad_base.
+ Context `{CollectionMonad M}.
+ Lemma elem_of_guard `{Decision P} {A} (x : A) (X : M A) :
+ x ∈ guard P; X ↔ P ∧ x ∈ X.
+ Proof.
+ unfold mguard, collection_guard; simpl; case_match;
+ rewrite ?elem_of_empty; naive_solver.
+ Qed.
+ Lemma elem_of_guard_2 `{Decision P} {A} (x : A) (X : M A) :
+ P → x ∈ X → x ∈ guard P; X.
+ Proof. by rewrite elem_of_guard. Qed.
+ Lemma guard_empty `{Decision P} {A} (X : M A) : guard P; X ≡ ∅ ↔ ¬P ∨ X ≡ ∅.
+ Proof.
+ rewrite !elem_of_equiv_empty; setoid_rewrite elem_of_guard.
+ destruct (decide P); naive_solver.
+ Qed.
+ Global Instance set_unfold_guard `{Decision P} {A} (x : A) X Q :
+ SetUnfold (x ∈ X) Q → SetUnfold (x ∈ guard P; X) (P ∧ Q).
+ Proof. constructor. by rewrite elem_of_guard, (set_unfold (x ∈ X) Q). Qed.
+ Lemma bind_empty {A B} (f : A → M B) X :
+ X ≫= f ≡ ∅ ↔ X ≡ ∅ ∨ ∀ x, x ∈ X → f x ≡ ∅.
+ Proof. set_solver. Qed.
+End collection_monad_base.
+
(** * Quantifiers *)
Section quantifiers.
@@ -613,12 +814,13 @@ Section fresh.
apply IH. by rewrite E.
Qed.
+ Lemma exist_fresh X : ∃ x, x ∉ X.
+ Proof. exists (fresh X). apply is_fresh. Qed.
Lemma Forall_fresh_NoDup X xs : Forall_fresh X xs → NoDup xs.
Proof. induction 1; by constructor. Qed.
Lemma Forall_fresh_elem_of X xs x : Forall_fresh X xs → x ∈ xs → x ∉ X.
Proof.
- intros HX; revert x; rewrite <-Forall_forall.
- by induction HX; constructor.
+ intros HX; revert x; rewrite <-Forall_forall. by induction HX; constructor.
Qed.
Lemma Forall_fresh_alt X xs :
Forall_fresh X xs ↔ NoDup xs ∧ ∀ x, x ∈ xs → x ∉ X.
@@ -657,21 +859,12 @@ Section collection_monad.
Global Instance collection_fmap_mono {A B} :
Proper (pointwise_relation _ (=) ==> (⊆) ==> (⊆)) (@fmap M _ A B).
Proof. intros f g ? X Y ?; set_solver by eauto. Qed.
- Global Instance collection_fmap_proper {A B} :
- Proper (pointwise_relation _ (=) ==> (≡) ==> (≡)) (@fmap M _ A B).
- Proof. intros f g ? X Y [??]; split; set_solver by eauto. Qed.
Global Instance collection_bind_mono {A B} :
Proper (((=) ==> (⊆)) ==> (⊆) ==> (⊆)) (@mbind M _ A B).
Proof. unfold respectful; intros f g Hfg X Y ?; set_solver. Qed.
- Global Instance collection_bind_proper {A B} :
- Proper (((=) ==> (≡)) ==> (≡) ==> (≡)) (@mbind M _ A B).
- Proof. unfold respectful; intros f g Hfg X Y [??]; split; set_solver. Qed.
Global Instance collection_join_mono {A} :
Proper ((⊆) ==> (⊆)) (@mjoin M _ A).
Proof. intros X Y ?; set_solver. Qed.
- Global Instance collection_join_proper {A} :
- Proper ((≡) ==> (≡)) (@mjoin M _ A).
- Proof. intros X Y [??]; split; set_solver. Qed.
Lemma collection_bind_singleton {A B} (f : A → M B) x : {[ x ]} ≫= f ≡ f x.
Proof. set_solver. Qed.
@@ -724,7 +917,7 @@ Section finite.
Proper (flip (⊆) ==> impl) (@set_finite A B _).
Proof. intros X Y HX [l Hl]; exists l; set_solver. Qed.
Global Instance set_finite_proper : Proper ((≡) ==> iff) (@set_finite A B _).
- Proof. by intros X Y [??]; split; apply set_finite_subseteq. Qed.
+ Proof. intros X Y HX; apply exist_proper. by setoid_rewrite HX. Qed.
Lemma empty_finite : set_finite ∅.
Proof. by exists []; intros ?; rewrite elem_of_empty. Qed.
Lemma singleton_finite (x : A) : set_finite {[ x ]}.
diff --git a/prelude/fin_collections.v b/prelude/fin_collections.v
index 0fdf95e92131bd9d16cd70d3166cc890176152e7..31738a5d64ba30561ff8bab82316c058c69e828b 100644
--- a/prelude/fin_collections.v
+++ b/prelude/fin_collections.v
@@ -17,6 +17,14 @@ Implicit Types X Y : C.
Lemma fin_collection_finite X : set_finite X.
Proof. by exists (elements X); intros; rewrite elem_of_elements. Qed.
+
+Instance elem_of_dec_slow (x : A) (X : C) : Decision (x ∈ X) | 100.
+Proof.
+ refine (cast_if (decide_rel (∈) x (elements X)));
+ by rewrite <-(elem_of_elements _).
+Defined.
+
+(** * The [elements] operation *)
Global Instance elements_proper: Proper ((≡) ==> (≡ₚ)) (elements (C:=C)).
Proof.
intros ?? E. apply NoDup_Permutation.
@@ -24,6 +32,7 @@ Proof.
- apply NoDup_elements.
- intros. by rewrite !elem_of_elements, E.
Qed.
+
Lemma elements_empty : elements (∅ : C) = [].
Proof.
apply elem_of_nil_inv; intros x.
@@ -49,8 +58,10 @@ Proof.
intros x. rewrite !elem_of_elements; auto.
Qed.
+(** * The [size] operation *)
Global Instance collection_size_proper: Proper ((≡) ==> (=)) (@size C _).
Proof. intros ?? E. apply Permutation_length. by rewrite E. Qed.
+
Lemma size_empty : size (∅ : C) = 0.
Proof. unfold size, collection_size. simpl. by rewrite elements_empty. Qed.
Lemma size_empty_inv (X : C) : size X = 0 → X ≡ ∅.
@@ -62,14 +73,7 @@ Lemma size_empty_iff (X : C) : size X = 0 ↔ X ≡ ∅.
Proof. split. apply size_empty_inv. by intros ->; rewrite size_empty. Qed.
Lemma size_non_empty_iff (X : C) : size X ≠0 ↔ X ≢ ∅.
Proof. by rewrite size_empty_iff. Qed.
-Lemma size_singleton (x : A) : size {[ x ]} = 1.
-Proof. unfold size, collection_size. simpl. by rewrite elements_singleton. Qed.
-Lemma size_singleton_inv X x y : size X = 1 → x ∈ X → y ∈ X → x = y.
-Proof.
- unfold size, collection_size. simpl. rewrite <-!elem_of_elements.
- generalize (elements X). intros [|? l]; intro; simplify_eq/=.
- rewrite (nil_length_inv l), !elem_of_list_singleton by done; congruence.
-Qed.
+
Lemma collection_choose_or_empty X : (∃ x, x ∈ X) ∨ X ≡ ∅.
Proof.
destruct (elements X) as [|x l] eqn:HX; [right|left].
@@ -85,6 +89,15 @@ Proof.
intros Hsz. destruct (collection_choose_or_empty X) as [|HX]; [done|].
contradict Hsz. rewrite HX, size_empty; lia.
Qed.
+
+Lemma size_singleton (x : A) : size {[ x ]} = 1.
+Proof. unfold size, collection_size. simpl. by rewrite elements_singleton. Qed.
+Lemma size_singleton_inv X x y : size X = 1 → x ∈ X → y ∈ X → x = y.
+Proof.
+ unfold size, collection_size. simpl. rewrite <-!elem_of_elements.
+ generalize (elements X). intros [|? l]; intro; simplify_eq/=.
+ rewrite (nil_length_inv l), !elem_of_list_singleton by done; congruence.
+Qed.
Lemma size_1_elem_of X : size X = 1 → ∃ x, X ≡ {[ x ]}.
Proof.
intros E. destruct (size_pos_elem_of X); auto with lia.
@@ -92,6 +105,7 @@ Proof.
- rewrite elem_of_singleton. eauto using size_singleton_inv.
- set_solver.
Qed.
+
Lemma size_union X Y : X ⊥ Y → size (X ∪ Y) = size X + size Y.
Proof.
intros. unfold size, collection_size. simpl. rewrite <-app_length.
@@ -101,30 +115,13 @@ Proof.
intros x; rewrite !elem_of_elements; set_solver.
- intros. by rewrite elem_of_app, !elem_of_elements, elem_of_union.
Qed.
-Instance elem_of_dec_slow (x : A) (X : C) : Decision (x ∈ X) | 100.
-Proof.
- refine (cast_if (decide_rel (∈) x (elements X)));
- by rewrite <-(elem_of_elements _).
-Defined.
-Global Program Instance collection_subseteq_dec_slow (X Y : C) :
- Decision (X ⊆ Y) | 100 :=
- match decide_rel (=) (size (X ∖ Y)) 0 return _ with
- | left _ => left _ | right _ => right _
- end.
-Next Obligation.
- intros X Y E1 x ?; apply dec_stable; intro. destruct (proj1(elem_of_empty x)).
- apply (size_empty_inv _ E1). by rewrite elem_of_difference.
-Qed.
-Next Obligation.
- intros X Y E1 E2; destruct E1. apply size_empty_iff, equiv_empty. intros x.
- rewrite elem_of_difference. intros [E3 ?]. by apply E2 in E3.
-Qed.
Lemma size_union_alt X Y : size (X ∪ Y) = size X + size (Y ∖ X).
Proof.
rewrite <-size_union by set_solver.
setoid_replace (Y ∖ X) with ((Y ∪ X) ∖ X) by set_solver.
rewrite <-union_difference, (comm (∪)); set_solver.
Qed.
+
Lemma subseteq_size X Y : X ⊆ Y → size X ≤ size Y.
Proof. intros. rewrite (union_difference X Y), size_union_alt by done. lia. Qed.
Lemma subset_size X Y : X ⊂ Y → size X < size Y.
@@ -134,6 +131,8 @@ Proof.
cut (size (Y ∖ X) ≠0); [lia |].
by apply size_non_empty_iff, non_empty_difference.
Qed.
+
+(** * Induction principles *)
Lemma collection_wf : wf (strict (@subseteq C _)).
Proof. apply (wf_projected (<) size); auto using subset_size, lt_wf. Qed.
Lemma collection_ind (P : C → Prop) :
@@ -147,6 +146,8 @@ Proof.
apply Hadd. set_solver. apply IH; set_solver.
- by rewrite HX.
Qed.
+
+(** * The [collection_fold] operation *)
Lemma collection_fold_ind {B} (P : B → C → Prop) (f : A → B → B) (b : B) :
Proper ((=) ==> (≡) ==> iff) P →
P b ∅ → (∀ x X r, x ∉ X → P r X → P (f x r) ({[ x ]} ∪ X)) →
@@ -168,6 +169,8 @@ Lemma collection_fold_proper {B} (R : relation B) `{!Equivalence R}
(Hf : ∀ a1 a2 b, R (f a1 (f a2 b)) (f a2 (f a1 b))) :
Proper ((≡) ==> R) (collection_fold f b : C → B).
Proof. intros ?? E. apply (foldr_permutation R f b); auto. by rewrite E. Qed.
+
+(** * Decision procedures *)
Global Instance set_Forall_dec `(P : A → Prop)
`{∀ x, Decision (P x)} X : Decision (set_Forall P X) | 100.
Proof.
@@ -182,6 +185,4 @@ Proof.
abstract (unfold set_Exists; setoid_rewrite <-elem_of_elements;
by rewrite <-Exists_exists).
Defined.
-Global Instance rel_elem_of_dec `{∀ x y, Decision (R x y)} x X :
- Decision (elem_of_upto R x X) | 100 := decide (set_Exists (R x) X).
End fin_collection.
diff --git a/prelude/fin_map_dom.v b/prelude/fin_map_dom.v
index df7520f587bb8851d7bb08ad40d86e505fac7287..afb29ae11ec685fe7e421e7881829156de69dfdb 100644
--- a/prelude/fin_map_dom.v
+++ b/prelude/fin_map_dom.v
@@ -36,8 +36,7 @@ Proof.
Qed.
Lemma dom_empty {A} : dom D (@empty (M A) _) ≡ ∅.
Proof.
- split; intro; [|set_solver].
- rewrite elem_of_dom, lookup_empty. by inversion 1.
+ intros x. rewrite elem_of_dom, lookup_empty, <-not_eq_None_Some. set_solver.
Qed.
Lemma dom_empty_inv {A} (m : M A) : dom D m ≡ ∅ → m = ∅.
Proof.
diff --git a/prelude/fin_maps.v b/prelude/fin_maps.v
index 8fd3120cdf2d0612d7f7a39246eefda2f8e79a15..5f4b4bcae225abf461877c3ff773ae1431d04689 100644
--- a/prelude/fin_maps.v
+++ b/prelude/fin_maps.v
@@ -5,7 +5,7 @@ finite maps and collects some theory on it. Most importantly, it proves useful
induction principles for finite maps and implements the tactic
[simplify_map_eq] to simplify goals involving finite maps. *)
From Coq Require Import Permutation.
-From iris.prelude Require Export relations vector orders.
+From iris.prelude Require Export relations orders vector.
(** * Axiomatization of finite maps *)
(** We require Leibniz equality to be extensional on finite maps. This of
@@ -190,11 +190,6 @@ Proof.
unfold subseteq, map_subseteq, map_relation. split; intros Hm i;
specialize (Hm i); destruct (m1 !! i), (m2 !! i); naive_solver.
Qed.
-Global Instance: EmptySpec (M A).
-Proof.
- intros A m. rewrite !map_subseteq_spec.
- intros i x. by rewrite lookup_empty.
-Qed.
Global Instance: ∀ {A} (R : relation A), PreOrder R → PreOrder (map_included R).
Proof.
split; [intros m i; by destruct (m !! i); simpl|].
diff --git a/prelude/gmap.v b/prelude/gmap.v
index d72514bc28ad831b5291ab7115d55834aee28abf..bf74baaafa5a49f93f2384d51016fa85080e2e59 100644
--- a/prelude/gmap.v
+++ b/prelude/gmap.v
@@ -3,7 +3,7 @@
(** This file implements finite maps and finite sets with keys of any countable
type. The implementation is based on [Pmap]s, radix-2 search trees. *)
From iris.prelude Require Export countable fin_maps fin_map_dom.
-From iris.prelude Require Import pmap mapset sets.
+From iris.prelude Require Import pmap mapset set.
(** * The data structure *)
(** We pack a [Pmap] together with a proof that ensures that all keys correspond
diff --git a/prelude/listset.v b/prelude/listset.v
index 0f8cfe42af13eefe8b1b12f12c5313d66bb175f5..1d2947de09218472df2128df718c55c19c2b2aeb 100644
--- a/prelude/listset.v
+++ b/prelude/listset.v
@@ -28,7 +28,8 @@ Qed.
Lemma listset_empty_alt X : X ≡ ∅ ↔ listset_car X = [].
Proof.
destruct X as [l]; split; [|by intros; simplify_eq/=].
- intros [Hl _]; destruct l as [|x l]; [done|]. feed inversion (Hl x); left.
+ rewrite elem_of_equiv_empty; intros Hl.
+ destruct l as [|x l]; [done|]. feed inversion (Hl x). left.
Qed.
Global Instance listset_empty_dec (X : listset A) : Decision (X ≡ ∅).
Proof.
@@ -42,10 +43,6 @@ Instance listset_intersection: Intersection (listset A) := λ l k,
let (l') := l in let (k') := k in Listset (list_intersection l' k').
Instance listset_difference: Difference (listset A) := λ l k,
let (l') := l in let (k') := k in Listset (list_difference l' k').
-Instance listset_intersection_with: IntersectionWith A (listset A) := λ f l k,
- let (l') := l in let (k') := k in Listset (list_intersection_with f l' k').
-Instance listset_filter: Filter A (listset A) := λ P _ l,
- let (l') := l in Listset (filter P l').
Instance: Collection A (listset A).
Proof.
@@ -62,13 +59,6 @@ Proof.
- intros. apply elem_of_remove_dups.
- intros. apply NoDup_remove_dups.
Qed.
-Global Instance: CollectionOps A (listset A).
-Proof.
- split.
- - apply _.
- - intros ? [?] [?]. apply elem_of_list_intersection_with.
- - intros [?] ??. apply elem_of_list_filter.
-Qed.
End listset.
(** These instances are declared using [Hint Extern] to avoid too
@@ -83,14 +73,10 @@ Hint Extern 1 (Union (listset _)) =>
eapply @listset_union : typeclass_instances.
Hint Extern 1 (Intersection (listset _)) =>
eapply @listset_intersection : typeclass_instances.
-Hint Extern 1 (IntersectionWith _ (listset _)) =>
- eapply @listset_intersection_with : typeclass_instances.
Hint Extern 1 (Difference (listset _)) =>
eapply @listset_difference : typeclass_instances.
Hint Extern 1 (Elements _ (listset _)) =>
eapply @listset_elems : typeclass_instances.
-Hint Extern 1 (Filter _ (listset _)) =>
- eapply @listset_filter : typeclass_instances.
Instance listset_ret: MRet listset := λ A x, {[ x ]}.
Instance listset_fmap: FMap listset := λ A B f l,
diff --git a/prelude/listset_nodup.v b/prelude/listset_nodup.v
index aaa008843ed19d1f3d9a27990fddd118a3e46db2..ab4ac765d5a783edff2d5f335f2fcc1632355a38 100644
--- a/prelude/listset_nodup.v
+++ b/prelude/listset_nodup.v
@@ -29,12 +29,6 @@ Instance listset_nodup_intersection: Intersection C := λ l k,
Instance listset_nodup_difference: Difference C := λ l k,
let (l',Hl) := l in let (k',Hk) := k
in ListsetNoDup _ (NoDup_list_difference _ k' Hl).
-Instance listset_nodup_intersection_with: IntersectionWith A C := λ f l k,
- let (l',Hl) := l in let (k',Hk) := k
- in ListsetNoDup
- (remove_dups (list_intersection_with f l' k')) (NoDup_remove_dups _).
-Instance listset_nodup_filter: Filter A C := λ P _ l,
- let (l',Hl) := l in ListsetNoDup _ (NoDup_filter P _ Hl).
Instance: Collection A C.
Proof.
@@ -49,15 +43,6 @@ Qed.
Global Instance listset_nodup_elems: Elements A C := listset_nodup_car.
Global Instance: FinCollection A C.
Proof. split. apply _. done. by intros [??]. Qed.
-Global Instance: CollectionOps A C.
-Proof.
- split.
- - apply _.
- - intros ? [??] [??] ?. unfold intersection_with, elem_of,
- listset_nodup_intersection_with, listset_nodup_elem_of; simpl.
- rewrite elem_of_remove_dups. by apply elem_of_list_intersection_with.
- - intros [??] ???. apply elem_of_list_filter.
-Qed.
End list_collection.
Hint Extern 1 (ElemOf _ (listset_nodup _)) =>
@@ -74,5 +59,3 @@ Hint Extern 1 (Difference (listset_nodup _)) =>
eapply @listset_nodup_difference : typeclass_instances.
Hint Extern 1 (Elements _ (listset_nodup _)) =>
eapply @listset_nodup_elems : typeclass_instances.
-Hint Extern 1 (Filter _ (listset_nodup _)) =>
- eapply @listset_nodup_filter : typeclass_instances.
diff --git a/prelude/mapset.v b/prelude/mapset.v
index e8d5407b83fad5df2d014325794511c92e0b4511..5a3dd7188e4f8c9f97737f0910996fe2b0bae3a1 100644
--- a/prelude/mapset.v
+++ b/prelude/mapset.v
@@ -34,16 +34,6 @@ Proof.
f_equal. apply map_eq. intros i. apply option_eq. intros []. by apply E.
Qed.
-Global Instance mapset_eq_dec `{∀ m1 m2 : M unit, Decision (m1 = m2)}
- (X1 X2 : mapset M) : Decision (X1 = X2) | 1.
-Proof.
- refine
- match X1, X2 with Mapset m1, Mapset m2 => cast_if (decide (m1 = m2)) end;
- abstract congruence.
-Defined.
-Global Instance mapset_elem_of_dec x (X : mapset M) : Decision (x ∈ X) | 1.
-Proof. solve_decision. Defined.
-
Instance: Collection K (mapset M).
Proof.
split; [split | | ].
@@ -63,8 +53,8 @@ Proof.
intros [m1] [m2] ?. simpl. rewrite lookup_difference_Some.
destruct (m2 !! x) as [[]|]; intuition congruence.
Qed.
-Global Instance: PartialOrder (@subseteq (mapset M) _).
-Proof. split; try apply _. intros ????. apply mapset_eq. intuition. Qed.
+Global Instance: LeibnizEquiv (mapset M).
+Proof. intros ??. apply mapset_eq. Qed.
Global Instance: FinCollection K (mapset M).
Proof.
split.
@@ -77,6 +67,30 @@ Proof.
apply NoDup_fst_map_to_list.
Qed.
+Section deciders.
+ Context `{∀ m1 m2 : M unit, Decision (m1 = m2)}.
+ Global Instance mapset_eq_dec (X1 X2 : mapset M) : Decision (X1 = X2) | 1.
+ Proof.
+ refine
+ match X1, X2 with Mapset m1, Mapset m2 => cast_if (decide (m1 = m2)) end;
+ abstract congruence.
+ Defined.
+ Global Instance mapset_equiv_dec (X1 X2 : mapset M) : Decision (X1 ≡ X2) | 1.
+ Proof. refine (cast_if (decide (X1 = X2))); abstract (by fold_leibniz). Defined.
+ Global Instance mapset_elem_of_dec x (X : mapset M) : Decision (x ∈ X) | 1.
+ Proof. solve_decision. Defined.
+ Global Instance mapset_disjoint_dec (X1 X2 : mapset M) : Decision (X1 ⊥ X2).
+ Proof.
+ refine (cast_if (decide (X1 ∩ X2 = ∅)));
+ abstract (by rewrite disjoint_intersection_L).
+ Defined.
+ Global Instance mapset_subseteq_dec (X1 X2 : mapset M) : Decision (X1 ⊆ X2).
+ Proof.
+ refine (cast_if (decide (X1 ∪ X2 = X2)));
+ abstract (by rewrite subseteq_union_L).
+ Defined.
+End deciders.
+
Definition mapset_map_with {A B} (f : bool → A → option B)
(X : mapset M) : M A → M B :=
let (mX) := X in merge (λ x y,
diff --git a/prelude/orders.v b/prelude/orders.v
index e7a9abbfd5013905aa71cdac48d19e2b54826085..b4d48015619660cf2d4abcda62927a5d4242e842 100644
--- a/prelude/orders.v
+++ b/prelude/orders.v
@@ -1,13 +1,9 @@
(* Copyright (c) 2012-2015, Robbert Krebbers. *)
(* This file is distributed under the terms of the BSD license. *)
-(** This file collects common properties of pre-orders and semi lattices. This
-theory will mainly be used for the theory on collections and finite maps. *)
-From Coq Require Export Sorted.
-From iris.prelude Require Export tactics list.
-
-(** * Arbitrary pre-, parial and total orders *)
(** Properties about arbitrary pre-, partial, and total orders. We do not use
the relation [⊆] because we often have multiple orders on the same structure *)
+From iris.prelude Require Export tactics.
+
Section orders.
Context {A} {R : relation A}.
Implicit Types X Y : A.
@@ -104,499 +100,3 @@ Ltac simplify_order := repeat
assert (R x z) by (by trans y)
end
end.
-
-(** * Sorting *)
-(** Merge sort. Adapted from the implementation of Hugo Herbelin in the Coq
-standard library, but without using the module system. *)
-Section merge_sort.
- Context {A} (R : relation A) `{∀ x y, Decision (R x y)}.
-
- Fixpoint list_merge (l1 : list A) : list A → list A :=
- fix list_merge_aux l2 :=
- match l1, l2 with
- | [], _ => l2
- | _, [] => l1
- | x1 :: l1, x2 :: l2 =>
- if decide_rel R x1 x2 then x1 :: list_merge l1 (x2 :: l2)
- else x2 :: list_merge_aux l2
- end.
- Global Arguments list_merge !_ !_ /.
-
- Local Notation stack := (list (option (list A))).
- Fixpoint merge_list_to_stack (st : stack) (l : list A) : stack :=
- match st with
- | [] => [Some l]
- | None :: st => Some l :: st
- | Some l' :: st => None :: merge_list_to_stack st (list_merge l' l)
- end.
- Fixpoint merge_stack (st : stack) : list A :=
- match st with
- | [] => []
- | None :: st => merge_stack st
- | Some l :: st => list_merge l (merge_stack st)
- end.
- Fixpoint merge_sort_aux (st : stack) (l : list A) : list A :=
- match l with
- | [] => merge_stack st
- | x :: l => merge_sort_aux (merge_list_to_stack st [x]) l
- end.
- Definition merge_sort : list A → list A := merge_sort_aux [].
-End merge_sort.
-
-(** ** Properties of the [Sorted] and [StronglySorted] predicate *)
-Section sorted.
- Context {A} (R : relation A).
-
- Lemma Sorted_StronglySorted `{!Transitive R} l :
- Sorted R l → StronglySorted R l.
- Proof. by apply Sorted.Sorted_StronglySorted. Qed.
- Lemma StronglySorted_unique `{!AntiSymm (=) R} l1 l2 :
- StronglySorted R l1 → StronglySorted R l2 → l1 ≡ₚ l2 → l1 = l2.
- Proof.
- intros Hl1; revert l2. induction Hl1 as [|x1 l1 ? IH Hx1]; intros l2 Hl2 E.
- { symmetry. by apply Permutation_nil. }
- destruct Hl2 as [|x2 l2 ? Hx2].
- { by apply Permutation_nil in E. }
- assert (x1 = x2); subst.
- { rewrite Forall_forall in Hx1, Hx2.
- assert (x2 ∈ x1 :: l1) as Hx2' by (by rewrite E; left).
- assert (x1 ∈ x2 :: l2) as Hx1' by (by rewrite <-E; left).
- inversion Hx1'; inversion Hx2'; simplify_eq; auto. }
- f_equal. by apply IH, (inj (x2 ::)).
- Qed.
- Lemma Sorted_unique `{!Transitive R, !AntiSymm (=) R} l1 l2 :
- Sorted R l1 → Sorted R l2 → l1 ≡ₚ l2 → l1 = l2.
- Proof. auto using StronglySorted_unique, Sorted_StronglySorted. Qed.
-
- Global Instance HdRel_dec x `{∀ y, Decision (R x y)} l :
- Decision (HdRel R x l).
- Proof.
- refine
- match l with
- | [] => left _
- | y :: l => cast_if (decide (R x y))
- end; abstract first [by constructor | by inversion 1].
- Defined.
- Global Instance Sorted_dec `{∀ x y, Decision (R x y)} : ∀ l,
- Decision (Sorted R l).
- Proof.
- refine
- (fix go l :=
- match l return Decision (Sorted R l) with
- | [] => left _
- | x :: l => cast_if_and (decide (HdRel R x l)) (go l)
- end); clear go; abstract first [by constructor | by inversion 1].
- Defined.
- Global Instance StronglySorted_dec `{∀ x y, Decision (R x y)} : ∀ l,
- Decision (StronglySorted R l).
- Proof.
- refine
- (fix go l :=
- match l return Decision (StronglySorted R l) with
- | [] => left _
- | x :: l => cast_if_and (decide (Forall (R x) l)) (go l)
- end); clear go; abstract first [by constructor | by inversion 1].
- Defined.
-
- Context {B} (f : A → B).
- Lemma HdRel_fmap (R1 : relation A) (R2 : relation B) x l :
- (∀ y, R1 x y → R2 (f x) (f y)) → HdRel R1 x l → HdRel R2 (f x) (f <$> l).
- Proof. destruct 2; constructor; auto. Qed.
- Lemma Sorted_fmap (R1 : relation A) (R2 : relation B) l :
- (∀ x y, R1 x y → R2 (f x) (f y)) → Sorted R1 l → Sorted R2 (f <$> l).
- Proof. induction 2; simpl; constructor; eauto using HdRel_fmap. Qed.
- Lemma StronglySorted_fmap (R1 : relation A) (R2 : relation B) l :
- (∀ x y, R1 x y → R2 (f x) (f y)) →
- StronglySorted R1 l → StronglySorted R2 (f <$> l).
- Proof.
- induction 2; csimpl; constructor;
- rewrite ?Forall_fmap; eauto using Forall_impl.
- Qed.
-End sorted.
-
-(** ** Correctness of merge sort *)
-Section merge_sort_correct.
- Context {A} (R : relation A) `{∀ x y, Decision (R x y)} `{!Total R}.
-
- Lemma list_merge_cons x1 x2 l1 l2 :
- list_merge R (x1 :: l1) (x2 :: l2) =
- if decide (R x1 x2) then x1 :: list_merge R l1 (x2 :: l2)
- else x2 :: list_merge R (x1 :: l1) l2.
- Proof. done. Qed.
- Lemma HdRel_list_merge x l1 l2 :
- HdRel R x l1 → HdRel R x l2 → HdRel R x (list_merge R l1 l2).
- Proof.
- destruct 1 as [|x1 l1 IH1], 1 as [|x2 l2 IH2];
- rewrite ?list_merge_cons; simpl; repeat case_decide; auto.
- Qed.
- Lemma Sorted_list_merge l1 l2 :
- Sorted R l1 → Sorted R l2 → Sorted R (list_merge R l1 l2).
- Proof.
- intros Hl1. revert l2. induction Hl1 as [|x1 l1 IH1];
- induction 1 as [|x2 l2 IH2]; rewrite ?list_merge_cons; simpl;
- repeat case_decide;
- constructor; eauto using HdRel_list_merge, HdRel_cons, total_not.
- Qed.
- Lemma merge_Permutation l1 l2 : list_merge R l1 l2 ≡ₚ l1 ++ l2.
- Proof.
- revert l2. induction l1 as [|x1 l1 IH1]; intros l2;
- induction l2 as [|x2 l2 IH2]; rewrite ?list_merge_cons; simpl;
- repeat case_decide; auto.
- - by rewrite (right_id_L [] (++)).
- - by rewrite IH2, Permutation_middle.
- Qed.
-
- Local Notation stack := (list (option (list A))).
- Inductive merge_stack_Sorted : stack → Prop :=
- | merge_stack_Sorted_nil : merge_stack_Sorted []
- | merge_stack_Sorted_cons_None st :
- merge_stack_Sorted st → merge_stack_Sorted (None :: st)
- | merge_stack_Sorted_cons_Some l st :
- Sorted R l → merge_stack_Sorted st → merge_stack_Sorted (Some l :: st).
- Fixpoint merge_stack_flatten (st : stack) : list A :=
- match st with
- | [] => []
- | None :: st => merge_stack_flatten st
- | Some l :: st => l ++ merge_stack_flatten st
- end.
-
- Lemma Sorted_merge_list_to_stack st l :
- merge_stack_Sorted st → Sorted R l →
- merge_stack_Sorted (merge_list_to_stack R st l).
- Proof.
- intros Hst. revert l.
- induction Hst; repeat constructor; naive_solver auto using Sorted_list_merge.
- Qed.
- Lemma merge_list_to_stack_Permutation st l :
- merge_stack_flatten (merge_list_to_stack R st l) ≡ₚ
- l ++ merge_stack_flatten st.
- Proof.
- revert l. induction st as [|[l'|] st IH]; intros l; simpl; auto.
- by rewrite IH, merge_Permutation, (assoc_L _), (comm (++) l).
- Qed.
- Lemma Sorted_merge_stack st :
- merge_stack_Sorted st → Sorted R (merge_stack R st).
- Proof. induction 1; simpl; auto using Sorted_list_merge. Qed.
- Lemma merge_stack_Permutation st : merge_stack R st ≡ₚ merge_stack_flatten st.
- Proof.
- induction st as [|[] ? IH]; intros; simpl; auto.
- by rewrite merge_Permutation, IH.
- Qed.
- Lemma Sorted_merge_sort_aux st l :
- merge_stack_Sorted st → Sorted R (merge_sort_aux R st l).
- Proof.
- revert st. induction l; simpl;
- auto using Sorted_merge_stack, Sorted_merge_list_to_stack.
- Qed.
- Lemma merge_sort_aux_Permutation st l :
- merge_sort_aux R st l ≡ₚ merge_stack_flatten st ++ l.
- Proof.
- revert st. induction l as [|?? IH]; simpl; intros.
- - by rewrite (right_id_L [] (++)), merge_stack_Permutation.
- - rewrite IH, merge_list_to_stack_Permutation; simpl.
- by rewrite Permutation_middle.
- Qed.
- Lemma Sorted_merge_sort l : Sorted R (merge_sort R l).
- Proof. apply Sorted_merge_sort_aux. by constructor. Qed.
- Lemma merge_sort_Permutation l : merge_sort R l ≡ₚ l.
- Proof. unfold merge_sort. by rewrite merge_sort_aux_Permutation. Qed.
- Lemma StronglySorted_merge_sort `{!Transitive R} l :
- StronglySorted R (merge_sort R l).
- Proof. auto using Sorted_StronglySorted, Sorted_merge_sort. Qed.
-End merge_sort_correct.
-
-(** * Canonical pre and partial orders *)
-(** We extend the canonical pre-order [⊆] to a partial order by defining setoid
-equality as [λ X Y, X ⊆ Y ∧ Y ⊆ X]. We prove that this indeed gives rise to a
-setoid. *)
-Instance preorder_equiv `{SubsetEq A} : Equiv A | 20 := λ X Y, X ⊆ Y ∧ Y ⊆ X.
-
-Section preorder.
- Context `{SubsetEq A, !PreOrder (@subseteq A _)}.
-
- Instance preorder_equivalence: @Equivalence A (≡).
- Proof.
- split.
- - done.
- - by intros ?? [??].
- - by intros X Y Z [??] [??]; split; trans Y.
- Qed.
- Global Instance: Proper ((≡) ==> (≡) ==> iff) ((⊆) : relation A).
- Proof.
- unfold equiv, preorder_equiv. intros X1 Y1 ? X2 Y2 ?. split; intro.
- - trans X1. tauto. trans X2; tauto.
- - trans Y1. tauto. trans Y2; tauto.
- Qed.
- Lemma subset_spec (X Y : A) : X ⊂ Y ↔ X ⊆ Y ∧ X ≢ Y.
- Proof.
- split.
- - intros [? HYX]. split. done. contradict HYX. by rewrite <-HYX.
- - intros [? HXY]. split. done. by contradict HXY.
- Qed.
-
- Section dec.
- Context `{∀ X Y : A, Decision (X ⊆ Y)}.
- Global Instance preorder_equiv_dec_slow (X Y : A) :
- Decision (X ≡ Y) | 100 := _.
- Lemma subseteq_inv X Y : X ⊆ Y → X ⊂ Y ∨ X ≡ Y.
- Proof. rewrite subset_spec. destruct (decide (X ≡ Y)); tauto. Qed.
- Lemma not_subset_inv X Y : X ⊄ Y → X ⊈ Y ∨ X ≡ Y.
- Proof. rewrite subset_spec. destruct (decide (X ≡ Y)); tauto. Qed.
- End dec.
-
- Section leibniz.
- Context `{!LeibnizEquiv A}.
- Lemma subset_spec_L X Y : X ⊂ Y ↔ X ⊆ Y ∧ X ≠Y.
- Proof. unfold_leibniz. apply subset_spec. Qed.
- Context `{∀ X Y : A, Decision (X ⊆ Y)}.
- Lemma subseteq_inv_L X Y : X ⊆ Y → X ⊂ Y ∨ X = Y.
- Proof. unfold_leibniz. apply subseteq_inv. Qed.
- Lemma not_subset_inv_L X Y : X ⊄ Y → X ⊈ Y ∨ X = Y.
- Proof. unfold_leibniz. apply not_subset_inv. Qed.
- End leibniz.
-End preorder.
-
-Typeclasses Opaque preorder_equiv.
-Hint Extern 0 (@Equivalence _ (≡)) =>
- class_apply preorder_equivalence : typeclass_instances.
-
-(** * Partial orders *)
-Section partial_order.
- Context `{SubsetEq A, !PartialOrder (@subseteq A _)}.
- Global Instance: LeibnizEquiv A.
- Proof. intros ?? [??]; by apply (anti_symm (⊆)). Qed.
-End partial_order.
-
-(** * Join semi lattices *)
-(** General purpose theorems on join semi lattices. *)
-Section join_semi_lattice.
- Context `{Empty A, JoinSemiLattice A, !EmptySpec A}.
- Implicit Types X Y : A.
- Implicit Types Xs Ys : list A.
-
- Hint Resolve subseteq_empty union_subseteq_l union_subseteq_r union_least.
- Lemma union_subseteq_l_transitive X1 X2 Y : X1 ⊆ X2 → X1 ⊆ X2 ∪ Y.
- Proof. intros. trans X2; auto. Qed.
- Lemma union_subseteq_r_transitive X1 X2 Y : X1 ⊆ X2 → X1 ⊆ Y ∪ X2.
- Proof. intros. trans X2; auto. Qed.
- Hint Resolve union_subseteq_l_transitive union_subseteq_r_transitive.
- Lemma union_preserving_l X Y1 Y2 : Y1 ⊆ Y2 → X ∪ Y1 ⊆ X ∪ Y2.
- Proof. auto. Qed.
- Lemma union_preserving_r X1 X2 Y : X1 ⊆ X2 → X1 ∪ Y ⊆ X2 ∪ Y.
- Proof. auto. Qed.
- Lemma union_preserving X1 X2 Y1 Y2 : X1 ⊆ X2 → Y1 ⊆ Y2 → X1 ∪ Y1 ⊆ X2 ∪ Y2.
- Proof. auto. Qed.
- Lemma union_empty X : X ∪ ∅ ⊆ X.
- Proof. by apply union_least. Qed.
- Global Instance union_proper : Proper ((≡) ==> (≡) ==> (≡)) (@union A _).
- Proof.
- unfold equiv, preorder_equiv.
- split; apply union_preserving; simpl in *; tauto.
- Qed.
- Global Instance: IdemP ((≡) : relation A) (∪).
- Proof. split; eauto. Qed.
- Global Instance: LeftId ((≡) : relation A) ∅ (∪).
- Proof. split; eauto. Qed.
- Global Instance: RightId ((≡) : relation A) ∅ (∪).
- Proof. split; eauto. Qed.
- Global Instance: Comm ((≡) : relation A) (∪).
- Proof. split; auto. Qed.
- Global Instance: Assoc ((≡) : relation A) (∪).
- Proof. split; auto. Qed.
- Lemma subseteq_union X Y : X ⊆ Y ↔ X ∪ Y ≡ Y.
- Proof. repeat split; eauto. intros HXY. rewrite <-HXY. auto. Qed.
- Lemma subseteq_union_1 X Y : X ⊆ Y → X ∪ Y ≡ Y.
- Proof. apply subseteq_union. Qed.
- Lemma subseteq_union_2 X Y : X ∪ Y ≡ Y → X ⊆ Y.
- Proof. apply subseteq_union. Qed.
- Lemma equiv_empty X : X ⊆ ∅ → X ≡ ∅.
- Proof. split; eauto. Qed.
- Global Instance union_list_proper: Proper ((≡) ==> (≡)) (union_list (A:=A)).
- Proof. by induction 1; simpl; try apply union_proper. Qed.
- Lemma union_list_nil : ⋃ @nil A = ∅.
- Proof. done. Qed.
- Lemma union_list_cons X Xs : ⋃ (X :: Xs) = X ∪ ⋃ Xs.
- Proof. done. Qed.
- Lemma union_list_singleton X : ⋃ [X] ≡ X.
- Proof. simpl. by rewrite (right_id ∅ _). Qed.
- Lemma union_list_app Xs1 Xs2 : ⋃ (Xs1 ++ Xs2) ≡ ⋃ Xs1 ∪ ⋃ Xs2.
- Proof.
- induction Xs1 as [|X Xs1 IH]; simpl; [by rewrite (left_id ∅ _)|].
- by rewrite IH, (assoc _).
- Qed.
- Lemma union_list_reverse Xs : ⋃ (reverse Xs) ≡ ⋃ Xs.
- Proof.
- induction Xs as [|X Xs IH]; simpl; [done |].
- by rewrite reverse_cons, union_list_app,
- union_list_singleton, (comm _), IH.
- Qed.
- Lemma union_list_preserving Xs Ys : Xs ⊆* Ys → ⋃ Xs ⊆ ⋃ Ys.
- Proof. induction 1; simpl; auto using union_preserving. Qed.
- Lemma empty_union X Y : X ∪ Y ≡ ∅ ↔ X ≡ ∅ ∧ Y ≡ ∅.
- Proof.
- split.
- - intros HXY. split; apply equiv_empty;
- by trans (X ∪ Y); [auto | rewrite HXY].
- - intros [HX HY]. by rewrite HX, HY, (left_id _ _).
- Qed.
- Lemma empty_union_list Xs : ⋃ Xs ≡ ∅ ↔ Forall (≡ ∅) Xs.
- Proof.
- split.
- - induction Xs; simpl; rewrite ?empty_union; intuition.
- - induction 1 as [|?? E1 ? E2]; simpl. done. by apply empty_union.
- Qed.
-
- Section leibniz.
- Context `{!LeibnizEquiv A}.
- Global Instance: IdemP (=) (∪).
- Proof. intros ?. unfold_leibniz. apply (idemp _). Qed.
- Global Instance: LeftId (=) ∅ (∪).
- Proof. intros ?. unfold_leibniz. apply (left_id _ _). Qed.
- Global Instance: RightId (=) ∅ (∪).
- Proof. intros ?. unfold_leibniz. apply (right_id _ _). Qed.
- Global Instance: Comm (=) (∪).
- Proof. intros ??. unfold_leibniz. apply (comm _). Qed.
- Global Instance: Assoc (=) (∪).
- Proof. intros ???. unfold_leibniz. apply (assoc _). Qed.
- Lemma subseteq_union_L X Y : X ⊆ Y ↔ X ∪ Y = Y.
- Proof. unfold_leibniz. apply subseteq_union. Qed.
- Lemma subseteq_union_1_L X Y : X ⊆ Y → X ∪ Y = Y.
- Proof. unfold_leibniz. apply subseteq_union_1. Qed.
- Lemma subseteq_union_2_L X Y : X ∪ Y = Y → X ⊆ Y.
- Proof. unfold_leibniz. apply subseteq_union_2. Qed.
- Lemma equiv_empty_L X : X ⊆ ∅ → X = ∅.
- Proof. unfold_leibniz. apply equiv_empty. Qed.
- Lemma union_list_singleton_L (X : A) : ⋃ [X] = X.
- Proof. unfold_leibniz. apply union_list_singleton. Qed.
- Lemma union_list_app_L (Xs1 Xs2 : list A) : ⋃ (Xs1 ++ Xs2) = ⋃ Xs1 ∪ ⋃ Xs2.
- Proof. unfold_leibniz. apply union_list_app. Qed.
- Lemma union_list_reverse_L (Xs : list A) : ⋃ (reverse Xs) = ⋃ Xs.
- Proof. unfold_leibniz. apply union_list_reverse. Qed.
- Lemma empty_union_L X Y : X ∪ Y = ∅ ↔ X = ∅ ∧ Y = ∅.
- Proof. unfold_leibniz. apply empty_union. Qed.
- Lemma empty_union_list_L Xs : ⋃ Xs = ∅ ↔ Forall (= ∅) Xs.
- Proof. unfold_leibniz. by rewrite empty_union_list. Qed.
- End leibniz.
-
- Section dec.
- Context `{∀ X Y : A, Decision (X ⊆ Y)}.
- Lemma non_empty_union X Y : X ∪ Y ≢ ∅ ↔ X ≢ ∅ ∨ Y ≢ ∅.
- Proof. rewrite empty_union. destruct (decide (X ≡ ∅)); intuition. Qed.
- Lemma non_empty_union_list Xs : ⋃ Xs ≢ ∅ → Exists (≢ ∅) Xs.
- Proof. rewrite empty_union_list. apply (not_Forall_Exists _). Qed.
- Context `{!LeibnizEquiv A}.
- Lemma non_empty_union_L X Y : X ∪ Y ≠∅ ↔ X ≠∅ ∨ Y ≠∅.
- Proof. unfold_leibniz. apply non_empty_union. Qed.
- Lemma non_empty_union_list_L Xs : ⋃ Xs ≠∅ → Exists (≠∅) Xs.
- Proof. unfold_leibniz. apply non_empty_union_list. Qed.
- End dec.
-End join_semi_lattice.
-
-(** * Meet semi lattices *)
-(** The dual of the above section, but now for meet semi lattices. *)
-Section meet_semi_lattice.
- Context `{MeetSemiLattice A}.
- Implicit Types X Y : A.
- Implicit Types Xs Ys : list A.
-
- Hint Resolve intersection_subseteq_l intersection_subseteq_r
- intersection_greatest.
- Lemma intersection_subseteq_l_transitive X1 X2 Y : X1 ⊆ X2 → X1 ∩ Y ⊆ X2.
- Proof. intros. trans X1; auto. Qed.
- Lemma intersection_subseteq_r_transitive X1 X2 Y : X1 ⊆ X2 → Y ∩ X1 ⊆ X2.
- Proof. intros. trans X1; auto. Qed.
- Hint Resolve intersection_subseteq_l_transitive
- intersection_subseteq_r_transitive.
- Lemma intersection_preserving_l X Y1 Y2 : Y1 ⊆ Y2 → X ∩ Y1 ⊆ X ∩ Y2.
- Proof. auto. Qed.
- Lemma intersection_preserving_r X1 X2 Y : X1 ⊆ X2 → X1 ∩ Y ⊆ X2 ∩ Y.
- Proof. auto. Qed.
- Lemma intersection_preserving X1 X2 Y1 Y2 :
- X1 ⊆ X2 → Y1 ⊆ Y2 → X1 ∩ Y1 ⊆ X2 ∩ Y2.
- Proof. auto. Qed.
- Global Instance: Proper ((≡) ==> (≡) ==> (≡)) (@intersection A _).
- Proof.
- unfold equiv, preorder_equiv. split;
- apply intersection_preserving; simpl in *; tauto.
- Qed.
- Global Instance: IdemP ((≡) : relation A) (∩).
- Proof. split; eauto. Qed.
- Global Instance: Comm ((≡) : relation A) (∩).
- Proof. split; auto. Qed.
- Global Instance: Assoc ((≡) : relation A) (∩).
- Proof. split; auto. Qed.
- Lemma subseteq_intersection X Y : X ⊆ Y ↔ X ∩ Y ≡ X.
- Proof. repeat split; eauto. intros HXY. rewrite <-HXY. auto. Qed.
- Lemma subseteq_intersection_1 X Y : X ⊆ Y → X ∩ Y ≡ X.
- Proof. apply subseteq_intersection. Qed.
- Lemma subseteq_intersection_2 X Y : X ∩ Y ≡ X → X ⊆ Y.
- Proof. apply subseteq_intersection. Qed.
-
- Section leibniz.
- Context `{!LeibnizEquiv A}.
- Global Instance: IdemP (=) (∩).
- Proof. intros ?. unfold_leibniz. apply (idemp _). Qed.
- Global Instance: Comm (=) (∩).
- Proof. intros ??. unfold_leibniz. apply (comm _). Qed.
- Global Instance: Assoc (=) (∩).
- Proof. intros ???. unfold_leibniz. apply (assoc _). Qed.
- Lemma subseteq_intersection_L X Y : X ⊆ Y ↔ X ∩ Y = X.
- Proof. unfold_leibniz. apply subseteq_intersection. Qed.
- Lemma subseteq_intersection_1_L X Y : X ⊆ Y → X ∩ Y = X.
- Proof. unfold_leibniz. apply subseteq_intersection_1. Qed.
- Lemma subseteq_intersection_2_L X Y : X ∩ Y = X → X ⊆ Y.
- Proof. unfold_leibniz. apply subseteq_intersection_2. Qed.
- End leibniz.
-End meet_semi_lattice.
-
-(** * Lower bounded lattices *)
-Section lattice.
- Context `{Empty A, Lattice A, !EmptySpec A}.
-
- Global Instance: LeftAbsorb ((≡) : relation A) ∅ (∩).
- Proof. split. by apply intersection_subseteq_l. by apply subseteq_empty. Qed.
- Global Instance: RightAbsorb ((≡) : relation A) ∅ (∩).
- Proof. intros ?. by rewrite (comm _), (left_absorb _ _). Qed.
- Lemma union_intersection_l (X Y Z : A) : X ∪ (Y ∩ Z) ≡ (X ∪ Y) ∩ (X ∪ Z).
- Proof.
- split; [apply union_least|apply lattice_distr].
- { apply intersection_greatest; auto using union_subseteq_l. }
- apply intersection_greatest.
- - apply union_subseteq_r_transitive, intersection_subseteq_l.
- - apply union_subseteq_r_transitive, intersection_subseteq_r.
- Qed.
- Lemma union_intersection_r (X Y Z : A) : (X ∩ Y) ∪ Z ≡ (X ∪ Z) ∩ (Y ∪ Z).
- Proof. by rewrite !(comm _ _ Z), union_intersection_l. Qed.
- Lemma intersection_union_l (X Y Z : A) : X ∩ (Y ∪ Z) ≡ (X ∩ Y) ∪ (X ∩ Z).
- Proof.
- split.
- - rewrite union_intersection_l.
- apply intersection_greatest.
- { apply union_subseteq_r_transitive, intersection_subseteq_l. }
- rewrite union_intersection_r.
- apply intersection_preserving; auto using union_subseteq_l.
- - apply intersection_greatest.
- { apply union_least; auto using intersection_subseteq_l. }
- apply union_least.
- + apply intersection_subseteq_r_transitive, union_subseteq_l.
- + apply intersection_subseteq_r_transitive, union_subseteq_r.
- Qed.
- Lemma intersection_union_r (X Y Z : A) : (X ∪ Y) ∩ Z ≡ (X ∩ Z) ∪ (Y ∩ Z).
- Proof. by rewrite !(comm _ _ Z), intersection_union_l. Qed.
-
- Section leibniz.
- Context `{!LeibnizEquiv A}.
- Global Instance: LeftAbsorb (=) ∅ (∩).
- Proof. intros ?. unfold_leibniz. apply (left_absorb _ _). Qed.
- Global Instance: RightAbsorb (=) ∅ (∩).
- Proof. intros ?. unfold_leibniz. apply (right_absorb _ _). Qed.
- Lemma union_intersection_l_L (X Y Z : A) : X ∪ (Y ∩ Z) = (X ∪ Y) ∩ (X ∪ Z).
- Proof. unfold_leibniz; apply union_intersection_l. Qed.
- Lemma union_intersection_r_L (X Y Z : A) : (X ∩ Y) ∪ Z = (X ∪ Z) ∩ (Y ∪ Z).
- Proof. unfold_leibniz; apply union_intersection_r. Qed.
- Lemma intersection_union_l_L (X Y Z : A) : X ∩ (Y ∪ Z) ≡ (X ∩ Y) ∪ (X ∩ Z).
- Proof. unfold_leibniz; apply intersection_union_l. Qed.
- Lemma intersection_union_r_L (X Y Z : A) : (X ∪ Y) ∩ Z ≡ (X ∩ Z) ∪ (Y ∩ Z).
- Proof. unfold_leibniz; apply intersection_union_r. Qed.
- End leibniz.
-End lattice.
diff --git a/prelude/sets.v b/prelude/set.v
similarity index 100%
rename from prelude/sets.v
rename to prelude/set.v
diff --git a/prelude/sorting.v b/prelude/sorting.v
new file mode 100644
index 0000000000000000000000000000000000000000..aca5122e060d55dd0843bf35b28c93c3e70366dd
--- /dev/null
+++ b/prelude/sorting.v
@@ -0,0 +1,203 @@
+(* Copyright (c) 2012-2015, Robbert Krebbers. *)
+(* This file is distributed under the terms of the BSD license. *)
+(** Merge sort. Adapted from the implementation of Hugo Herbelin in the Coq
+standard library, but without using the module system. *)
+From Coq Require Export Sorted.
+From iris.prelude Require Export orders list.
+
+Section merge_sort.
+ Context {A} (R : relation A) `{∀ x y, Decision (R x y)}.
+
+ Fixpoint list_merge (l1 : list A) : list A → list A :=
+ fix list_merge_aux l2 :=
+ match l1, l2 with
+ | [], _ => l2
+ | _, [] => l1
+ | x1 :: l1, x2 :: l2 =>
+ if decide_rel R x1 x2 then x1 :: list_merge l1 (x2 :: l2)
+ else x2 :: list_merge_aux l2
+ end.
+ Global Arguments list_merge !_ !_ /.
+
+ Local Notation stack := (list (option (list A))).
+ Fixpoint merge_list_to_stack (st : stack) (l : list A) : stack :=
+ match st with
+ | [] => [Some l]
+ | None :: st => Some l :: st
+ | Some l' :: st => None :: merge_list_to_stack st (list_merge l' l)
+ end.
+ Fixpoint merge_stack (st : stack) : list A :=
+ match st with
+ | [] => []
+ | None :: st => merge_stack st
+ | Some l :: st => list_merge l (merge_stack st)
+ end.
+ Fixpoint merge_sort_aux (st : stack) (l : list A) : list A :=
+ match l with
+ | [] => merge_stack st
+ | x :: l => merge_sort_aux (merge_list_to_stack st [x]) l
+ end.
+ Definition merge_sort : list A → list A := merge_sort_aux [].
+End merge_sort.
+
+(** ** Properties of the [Sorted] and [StronglySorted] predicate *)
+Section sorted.
+ Context {A} (R : relation A).
+
+ Lemma Sorted_StronglySorted `{!Transitive R} l :
+ Sorted R l → StronglySorted R l.
+ Proof. by apply Sorted.Sorted_StronglySorted. Qed.
+ Lemma StronglySorted_unique `{!AntiSymm (=) R} l1 l2 :
+ StronglySorted R l1 → StronglySorted R l2 → l1 ≡ₚ l2 → l1 = l2.
+ Proof.
+ intros Hl1; revert l2. induction Hl1 as [|x1 l1 ? IH Hx1]; intros l2 Hl2 E.
+ { symmetry. by apply Permutation_nil. }
+ destruct Hl2 as [|x2 l2 ? Hx2].
+ { by apply Permutation_nil in E. }
+ assert (x1 = x2); subst.
+ { rewrite Forall_forall in Hx1, Hx2.
+ assert (x2 ∈ x1 :: l1) as Hx2' by (by rewrite E; left).
+ assert (x1 ∈ x2 :: l2) as Hx1' by (by rewrite <-E; left).
+ inversion Hx1'; inversion Hx2'; simplify_eq; auto. }
+ f_equal. by apply IH, (inj (x2 ::)).
+ Qed.
+ Lemma Sorted_unique `{!Transitive R, !AntiSymm (=) R} l1 l2 :
+ Sorted R l1 → Sorted R l2 → l1 ≡ₚ l2 → l1 = l2.
+ Proof. auto using StronglySorted_unique, Sorted_StronglySorted. Qed.
+
+ Global Instance HdRel_dec x `{∀ y, Decision (R x y)} l :
+ Decision (HdRel R x l).
+ Proof.
+ refine
+ match l with
+ | [] => left _
+ | y :: l => cast_if (decide (R x y))
+ end; abstract first [by constructor | by inversion 1].
+ Defined.
+ Global Instance Sorted_dec `{∀ x y, Decision (R x y)} : ∀ l,
+ Decision (Sorted R l).
+ Proof.
+ refine
+ (fix go l :=
+ match l return Decision (Sorted R l) with
+ | [] => left _
+ | x :: l => cast_if_and (decide (HdRel R x l)) (go l)
+ end); clear go; abstract first [by constructor | by inversion 1].
+ Defined.
+ Global Instance StronglySorted_dec `{∀ x y, Decision (R x y)} : ∀ l,
+ Decision (StronglySorted R l).
+ Proof.
+ refine
+ (fix go l :=
+ match l return Decision (StronglySorted R l) with
+ | [] => left _
+ | x :: l => cast_if_and (decide (Forall (R x) l)) (go l)
+ end); clear go; abstract first [by constructor | by inversion 1].
+ Defined.
+
+ Context {B} (f : A → B).
+ Lemma HdRel_fmap (R1 : relation A) (R2 : relation B) x l :
+ (∀ y, R1 x y → R2 (f x) (f y)) → HdRel R1 x l → HdRel R2 (f x) (f <$> l).
+ Proof. destruct 2; constructor; auto. Qed.
+ Lemma Sorted_fmap (R1 : relation A) (R2 : relation B) l :
+ (∀ x y, R1 x y → R2 (f x) (f y)) → Sorted R1 l → Sorted R2 (f <$> l).
+ Proof. induction 2; simpl; constructor; eauto using HdRel_fmap. Qed.
+ Lemma StronglySorted_fmap (R1 : relation A) (R2 : relation B) l :
+ (∀ x y, R1 x y → R2 (f x) (f y)) →
+ StronglySorted R1 l → StronglySorted R2 (f <$> l).
+ Proof.
+ induction 2; csimpl; constructor;
+ rewrite ?Forall_fmap; eauto using Forall_impl.
+ Qed.
+End sorted.
+
+(** ** Correctness of merge sort *)
+Section merge_sort_correct.
+ Context {A} (R : relation A) `{∀ x y, Decision (R x y)} `{!Total R}.
+
+ Lemma list_merge_cons x1 x2 l1 l2 :
+ list_merge R (x1 :: l1) (x2 :: l2) =
+ if decide (R x1 x2) then x1 :: list_merge R l1 (x2 :: l2)
+ else x2 :: list_merge R (x1 :: l1) l2.
+ Proof. done. Qed.
+ Lemma HdRel_list_merge x l1 l2 :
+ HdRel R x l1 → HdRel R x l2 → HdRel R x (list_merge R l1 l2).
+ Proof.
+ destruct 1 as [|x1 l1 IH1], 1 as [|x2 l2 IH2];
+ rewrite ?list_merge_cons; simpl; repeat case_decide; auto.
+ Qed.
+ Lemma Sorted_list_merge l1 l2 :
+ Sorted R l1 → Sorted R l2 → Sorted R (list_merge R l1 l2).
+ Proof.
+ intros Hl1. revert l2. induction Hl1 as [|x1 l1 IH1];
+ induction 1 as [|x2 l2 IH2]; rewrite ?list_merge_cons; simpl;
+ repeat case_decide;
+ constructor; eauto using HdRel_list_merge, HdRel_cons, total_not.
+ Qed.
+ Lemma merge_Permutation l1 l2 : list_merge R l1 l2 ≡ₚ l1 ++ l2.
+ Proof.
+ revert l2. induction l1 as [|x1 l1 IH1]; intros l2;
+ induction l2 as [|x2 l2 IH2]; rewrite ?list_merge_cons; simpl;
+ repeat case_decide; auto.
+ - by rewrite (right_id_L [] (++)).
+ - by rewrite IH2, Permutation_middle.
+ Qed.
+
+ Local Notation stack := (list (option (list A))).
+ Inductive merge_stack_Sorted : stack → Prop :=
+ | merge_stack_Sorted_nil : merge_stack_Sorted []
+ | merge_stack_Sorted_cons_None st :
+ merge_stack_Sorted st → merge_stack_Sorted (None :: st)
+ | merge_stack_Sorted_cons_Some l st :
+ Sorted R l → merge_stack_Sorted st → merge_stack_Sorted (Some l :: st).
+ Fixpoint merge_stack_flatten (st : stack) : list A :=
+ match st with
+ | [] => []
+ | None :: st => merge_stack_flatten st
+ | Some l :: st => l ++ merge_stack_flatten st
+ end.
+
+ Lemma Sorted_merge_list_to_stack st l :
+ merge_stack_Sorted st → Sorted R l →
+ merge_stack_Sorted (merge_list_to_stack R st l).
+ Proof.
+ intros Hst. revert l.
+ induction Hst; repeat constructor; naive_solver auto using Sorted_list_merge.
+ Qed.
+ Lemma merge_list_to_stack_Permutation st l :
+ merge_stack_flatten (merge_list_to_stack R st l) ≡ₚ
+ l ++ merge_stack_flatten st.
+ Proof.
+ revert l. induction st as [|[l'|] st IH]; intros l; simpl; auto.
+ by rewrite IH, merge_Permutation, (assoc_L _), (comm (++) l).
+ Qed.
+ Lemma Sorted_merge_stack st :
+ merge_stack_Sorted st → Sorted R (merge_stack R st).
+ Proof. induction 1; simpl; auto using Sorted_list_merge. Qed.
+ Lemma merge_stack_Permutation st : merge_stack R st ≡ₚ merge_stack_flatten st.
+ Proof.
+ induction st as [|[] ? IH]; intros; simpl; auto.
+ by rewrite merge_Permutation, IH.
+ Qed.
+ Lemma Sorted_merge_sort_aux st l :
+ merge_stack_Sorted st → Sorted R (merge_sort_aux R st l).
+ Proof.
+ revert st. induction l; simpl;
+ auto using Sorted_merge_stack, Sorted_merge_list_to_stack.
+ Qed.
+ Lemma merge_sort_aux_Permutation st l :
+ merge_sort_aux R st l ≡ₚ merge_stack_flatten st ++ l.
+ Proof.
+ revert st. induction l as [|?? IH]; simpl; intros.
+ - by rewrite (right_id_L [] (++)), merge_stack_Permutation.
+ - rewrite IH, merge_list_to_stack_Permutation; simpl.
+ by rewrite Permutation_middle.
+ Qed.
+ Lemma Sorted_merge_sort l : Sorted R (merge_sort R l).
+ Proof. apply Sorted_merge_sort_aux. by constructor. Qed.
+ Lemma merge_sort_Permutation l : merge_sort R l ≡ₚ l.
+ Proof. unfold merge_sort. by rewrite merge_sort_aux_Permutation. Qed.
+ Lemma StronglySorted_merge_sort `{!Transitive R} l :
+ StronglySorted R (merge_sort R l).
+ Proof. auto using Sorted_StronglySorted, Sorted_merge_sort. Qed.
+End merge_sort_correct.
diff --git a/program_logic/auth.v b/program_logic/auth.v
index 9fd82aa0723fecfe6cfa3ed40b224b8bf45669ff..2c169450819a1259c20c058da946a28da790c579 100644
--- a/program_logic/auth.v
+++ b/program_logic/auth.v
@@ -70,8 +70,8 @@ Section auth.
✓ a → nclose N ⊆ E →
▷ φ a ={E}=> ∃ γ, ■(γ ∉ G) ∧ auth_ctx γ N φ ∧ auth_own γ a.
Proof.
- iIntros {??} "Hφ". rewrite /auth_own /auth_ctx.
- iPvs (own_alloc_strong (Auth (Excl' a) a) _ G) as {γ} "[% Hγ]"; first done.
+ iIntros (??) "Hφ". rewrite /auth_own /auth_ctx.
+ iPvs (own_alloc_strong (Auth (Excl' a) a) _ G) as (γ) "[% Hγ]"; first done.
iRevert "Hγ"; rewrite auth_both_op; iIntros "[Hγ Hγ']".
iPvs (inv_alloc N _ (auth_inv γ φ) with "[-Hγ']"); first done.
{ iNext. iExists a. by iFrame. }
@@ -82,8 +82,8 @@ Section auth.
✓ a → nclose N ⊆ E →
▷ φ a ={E}=> ∃ γ, auth_ctx γ N φ ∧ auth_own γ a.
Proof.
- iIntros {??} "Hφ".
- iPvs (auth_alloc_strong N E a ∅ with "Hφ") as {γ} "[_ ?]"; [done..|].
+ iIntros (??) "Hφ".
+ iPvs (auth_alloc_strong N E a ∅ with "Hφ") as (γ) "[_ ?]"; [done..|].
by iExists γ.
Qed.
@@ -100,17 +100,17 @@ Section auth.
■(a ~l~> b @ Some af) ★ ▷ φ (b ⋅ af) ★ (auth_own γ b -★ Ψ x)))
⊢ fsa E Ψ.
Proof.
- iIntros {??} "(#? & Hγf & HΨ)". rewrite /auth_ctx /auth_own.
- iInv N as {a'} "[Hγ Hφ]".
+ iIntros (??) "(#? & Hγf & HΨ)". rewrite /auth_ctx /auth_own.
+ iInv N as (a') "[Hγ Hφ]".
iTimeless "Hγ"; iTimeless "Hγf"; iCombine "Hγ" "Hγf" as "Hγ".
- iDestruct (own_valid _ with "#Hγ") as "Hvalid".
+ iDestruct (@own_valid with "#Hγ") as "Hvalid".
iDestruct (auth_validI _ with "Hvalid") as "[Ha' %]"; simpl; iClear "Hvalid".
- iDestruct "Ha'" as {af} "Ha'"; iDestruct "Ha'" as %Ha'.
+ iDestruct "Ha'" as (af) "Ha'"; iDestruct "Ha'" as %Ha'.
rewrite ->(left_id _ _) in Ha'; setoid_subst.
iApply pvs_fsa_fsa; iApply fsa_wand_r; iSplitL "HΨ Hφ".
{ iApply "HΨ"; by iSplit. }
- iIntros {v}; iDestruct 1 as {b} "(% & Hφ & HΨ)".
- iPvs (own_update _ with "Hγ") as "[Hγ Hγf]"; first eapply auth_update; eauto.
+ iIntros (v); iDestruct 1 as (b) "(% & Hφ & HΨ)".
+ iPvs (@own_update with "Hγ") as "[Hγ Hγf]"; first eapply auth_update; eauto.
iPvsIntro. iSplitL "Hφ Hγ"; last by iApply "HΨ".
iNext. iExists (b â‹… af). by iFrame.
Qed.
diff --git a/program_logic/boxes.v b/program_logic/boxes.v
index d46352a15b4281cac42f34a79e11614f1940fe5c..e81180b7981883bb0940fa9cacbb226e59f36fc8 100644
--- a/program_logic/boxes.v
+++ b/program_logic/boxes.v
@@ -15,11 +15,11 @@ Section box_defs.
Definition slice_name := gname.
- Definition box_own_auth (γ : slice_name)
- (a : auth (option (excl bool))) : iProp := own γ (a, ∅).
+ Definition box_own_auth (γ : slice_name) (a : auth (option (excl bool)))
+ := own γ (a, (∅:option (agree (later (iPrePropG Λ Σ))))).
Definition box_own_prop (γ : slice_name) (P : iProp) : iProp :=
- own γ (∅:auth _, Some (to_agree (Next (iProp_unfold P)))).
+ own γ (∅:auth (option (excl bool)), Some (to_agree (Next (iProp_unfold P)))).
Definition slice_inv (γ : slice_name) (P : iProp) : iProp :=
(∃ b, box_own_auth γ (◠Excl' b) ★ box_own_prop γ P ★ if b then P else True)%I.
@@ -69,9 +69,8 @@ Lemma box_own_auth_update E γ b1 b2 b3 :
Proof.
rewrite /box_own_prop -!own_op own_valid_l prod_validI; iIntros "[[Hb _] Hγ]".
iDestruct "Hb" as % [[[] [= ->]%leibniz_equiv] ?]%auth_valid_discrete.
- iApply (own_update with "Hγ"); apply prod_update; simpl; last reflexivity.
- rewrite -{1}(right_id ∅ _ (Excl' b2)) -{1}(right_id ∅ _ (Excl' b3)).
- by apply auth_update, option_local_update, exclusive_local_update.
+ iApply (@own_update with "Hγ"); apply prod_update; simpl; last reflexivity.
+ by apply auth_update_no_frame, option_local_update, exclusive_local_update.
Qed.
Lemma box_own_agree γ Q1 Q2 :
@@ -94,10 +93,10 @@ Lemma box_insert f P Q :
▷ box N f P ={N}=> ∃ γ, f !! γ = None ★
slice N γ Q ★ ▷ box N (<[γ:=false]> f) (Q ★ P).
Proof.
- iDestruct 1 as {Φ} "[#HeqP Hf]".
+ iDestruct 1 as (Φ) "[#HeqP Hf]".
iPvs (own_alloc_strong (â— Excl' false â‹… â—¯ Excl' false,
Some (to_agree (Next (iProp_unfold Q)))) _ (dom _ f))
- as {γ} "[Hdom Hγ]"; first done.
+ as (γ) "[Hdom Hγ]"; first done.
rewrite pair_split. iDestruct "Hγ" as "[[Hγ Hγ'] #HγQ]".
iDestruct "Hdom" as % ?%not_elem_of_dom.
iPvs (inv_alloc N _ (slice_inv γ Q) with "[Hγ]") as "#Hinv"; first done.
@@ -114,9 +113,9 @@ Lemma box_delete f P Q γ :
slice N γ Q ★ ▷ box N f P ={N}=> ∃ P',
▷ ▷ (P ≡ (Q ★ P')) ★ ▷ box N (delete γ f) P'.
Proof.
- iIntros {?} "[#Hinv H]"; iDestruct "H" as {Φ} "[#HeqP Hf]".
+ iIntros (?) "[#Hinv H]"; iDestruct "H" as (Φ) "[#HeqP Hf]".
iExists ([★ map] γ'↦_ ∈ delete γ f, Φ γ')%I.
- iInv N as {b} "(Hγ & #HγQ &_)"; iPvsIntro; iNext.
+ iInv N as (b) "(Hγ & #HγQ &_)"; iPvsIntro; iNext.
iDestruct (big_sepM_delete _ f _ false with "Hf")
as "[[Hγ' #[HγΦ ?]] ?]"; first done.
iDestruct (box_own_agree γ Q (Φ γ) with "[#]") as "HeqQ"; first by eauto.
@@ -132,8 +131,8 @@ Lemma box_fill f γ P Q :
f !! γ = Some false →
slice N γ Q ★ ▷ Q ★ ▷ box N f P ={N}=> ▷ box N (<[γ:=true]> f) P.
Proof.
- iIntros {?} "(#Hinv & HQ & H)"; iDestruct "H" as {Φ} "[#HeqP Hf]".
- iInv N as {b'} "(Hγ & #HγQ & _)"; iTimeless "Hγ".
+ iIntros (?) "(#Hinv & HQ & H)"; iDestruct "H" as (Φ) "[#HeqP Hf]".
+ iInv N as (b') "(Hγ & #HγQ & _)"; iTimeless "Hγ".
iDestruct (big_sepM_later _ f with "Hf") as "Hf".
iDestruct (big_sepM_delete _ f _ false with "Hf")
as "[[Hγ' #[HγΦ Hinv']] ?]"; first done; iTimeless "Hγ'".
@@ -150,8 +149,8 @@ Lemma box_empty f P Q γ :
f !! γ = Some true →
slice N γ Q ★ ▷ box N f P ={N}=> ▷ Q ★ ▷ box N (<[γ:=false]> f) P.
Proof.
- iIntros {?} "[#Hinv H]"; iDestruct "H" as {Φ} "[#HeqP Hf]".
- iInv N as {b} "(Hγ & #HγQ & HQ)"; iTimeless "Hγ".
+ iIntros (?) "[#Hinv H]"; iDestruct "H" as (Φ) "[#HeqP Hf]".
+ iInv N as (b) "(Hγ & #HγQ & HQ)"; iTimeless "Hγ".
iDestruct (big_sepM_later _ f with "Hf") as "Hf".
iDestruct (big_sepM_delete _ f with "Hf")
as "[[Hγ' #[HγΦ Hinv']] ?]"; first done; iTimeless "Hγ'".
@@ -169,14 +168,14 @@ Qed.
Lemma box_fill_all f P Q : box N f P ★ ▷ P ={N}=> box N (const true <$> f) P.
Proof.
- iIntros "[H HP]"; iDestruct "H" as {Φ} "[#HeqP Hf]".
+ iIntros "[H HP]"; iDestruct "H" as (Φ) "[#HeqP Hf]".
iExists Φ; iSplitR; first by rewrite big_sepM_fmap.
rewrite eq_iff later_iff big_sepM_later; iDestruct ("HeqP" with "HP") as "HP".
iCombine "Hf" "HP" as "Hf".
rewrite big_sepM_fmap; iApply (pvs_big_sepM _ _ f).
iApply (big_sepM_impl _ _ f); iFrame "Hf".
- iAlways; iIntros {γ b' ?} "[(Hγ' & #$ & #$) HΦ]".
- iInv N as {b} "[Hγ _]"; iTimeless "Hγ".
+ iAlways; iIntros (γ b' ?) "[(Hγ' & #$ & #$) HΦ]".
+ iInv N as (b) "[Hγ _]"; iTimeless "Hγ".
iPvs (box_own_auth_update _ γ with "[Hγ Hγ']")
as "[Hγ $]"; first by iFrame.
iPvsIntro; iNext; iExists true. by iFrame.
@@ -186,13 +185,13 @@ Lemma box_empty_all f P Q :
map_Forall (λ _, (true =)) f →
box N f P ={N}=> ▷ P ★ box N (const false <$> f) P.
Proof.
- iDestruct 1 as {Φ} "[#HeqP Hf]".
+ iDestruct 1 as (Φ) "[#HeqP Hf]".
iAssert ([★ map] γ↦b ∈ f, ▷ Φ γ ★ box_own_auth γ (◯ Excl' false) ★
box_own_prop γ (Φ γ) ★ inv N (slice_inv γ (Φ γ)))%I with "|==>[Hf]" as "[HΦ ?]".
{ iApply (pvs_big_sepM _ _ f); iApply (big_sepM_impl _ _ f); iFrame "Hf".
- iAlways; iIntros {γ b ?} "(Hγ' & #$ & #$)".
+ iAlways; iIntros (γ b ?) "(Hγ' & #$ & #$)".
assert (true = b) as <- by eauto.
- iInv N as {b} "(Hγ & _ & HΦ)"; iTimeless "Hγ".
+ iInv N as (b) "(Hγ & _ & HΦ)"; iTimeless "Hγ".
iDestruct (box_own_auth_agree γ b true with "[#]")
as "%"; subst; first by iFrame.
iPvs (box_own_auth_update _ γ true true false with "[Hγ Hγ']")
diff --git a/program_logic/ectx_language.v b/program_logic/ectx_language.v
index 8d275b0f384acb0a7053a00b0bb64fb0751161e6..d7b58df92eac2bd6fbc9ce115420f19454bfd68b 100644
--- a/program_logic/ectx_language.v
+++ b/program_logic/ectx_language.v
@@ -11,7 +11,6 @@ Class EctxLanguage (expr val ectx state : Type) := {
empty_ectx : ectx;
comp_ectx : ectx → ectx → ectx;
fill : ectx → expr → expr;
- atomic : expr → bool;
head_step : expr → state → expr → state → option expr → Prop;
to_of_val v : to_val (of_val v) = Some v;
@@ -34,16 +33,6 @@ Class EctxLanguage (expr val ectx state : Type) := {
to_val e1 = None →
head_step e1' σ1 e2 σ2 ef →
exists K'', K' = comp_ectx K K'';
-
- atomic_not_val e : atomic e → to_val e = None;
- atomic_step e1 σ1 e2 σ2 ef :
- atomic e1 →
- head_step e1 σ1 e2 σ2 ef →
- is_Some (to_val e2);
- atomic_fill e K :
- atomic (fill K e) →
- to_val e = None →
- K = empty_ectx;
}.
Arguments of_val {_ _ _ _ _} _.
@@ -51,7 +40,6 @@ Arguments to_val {_ _ _ _ _} _.
Arguments empty_ectx {_ _ _ _ _}.
Arguments comp_ectx {_ _ _ _ _} _ _.
Arguments fill {_ _ _ _ _} _ _.
-Arguments atomic {_ _ _ _ _} _.
Arguments head_step {_ _ _ _ _} _ _ _ _ _.
Arguments to_of_val {_ _ _ _ _} _.
@@ -62,9 +50,6 @@ Arguments fill_comp {_ _ _ _ _} _ _ _.
Arguments fill_not_val {_ _ _ _ _} _ _ _.
Arguments ectx_positive {_ _ _ _ _} _ _ _.
Arguments step_by_val {_ _ _ _ _} _ _ _ _ _ _ _ _ _ _ _.
-Arguments atomic_not_val {_ _ _ _ _} _ _.
-Arguments atomic_step {_ _ _ _ _} _ _ _ _ _ _ _.
-Arguments atomic_fill {_ _ _ _ _} _ _ _ _.
(* From an ectx_language, we can construct a language. *)
Section ectx_language.
@@ -84,23 +69,12 @@ Section ectx_language.
prim_step e1 σ1 e2 σ2 ef → to_val e1 = None.
Proof. intros [??? -> -> ?]; eauto using fill_not_val, val_stuck. Qed.
- Lemma atomic_prim_step e1 σ1 e2 σ2 ef :
- atomic e1 → prim_step e1 σ1 e2 σ2 ef → is_Some (to_val e2).
- Proof.
- intros Hatomic [K e1' e2' -> -> Hstep].
- assert (K = empty_ectx) as -> by eauto 10 using atomic_fill, val_stuck.
- revert Hatomic; rewrite !fill_empty. eauto using atomic_step.
- Qed.
-
Canonical Structure ectx_lang : language := {|
language.expr := expr; language.val := val; language.state := state;
language.of_val := of_val; language.to_val := to_val;
- language.atomic := atomic;
language.prim_step := prim_step;
language.to_of_val := to_of_val; language.of_to_val := of_to_val;
language.val_stuck := val_prim_stuck;
- language.atomic_not_val := atomic_not_val;
- language.atomic_step := atomic_prim_step
|}.
(* Some lemmas about this language *)
@@ -111,6 +85,16 @@ Section ectx_language.
Lemma head_prim_reducible e σ : head_reducible e σ → reducible e σ.
Proof. intros (e'&σ'&ef&?). eexists e', σ', ef. by apply head_prim_step. Qed.
+ Lemma ectx_language_atomic e :
+ (∀ σ e' σ' ef, head_step e σ e' σ' ef → is_Some (to_val e')) →
+ (∀ K e', e = fill K e' → to_val e' = None → K = empty_ectx) →
+ atomic e.
+ Proof.
+ intros Hatomic_step Hatomic_fill σ e' σ' ef [K e1' e2' -> -> Hstep].
+ assert (K = empty_ectx) as -> by eauto 10 using val_stuck.
+ rewrite fill_empty. eapply Hatomic_step. by rewrite fill_empty.
+ Qed.
+
Lemma head_reducible_prim_step e1 σ1 e2 σ2 ef :
head_reducible e1 σ1 → prim_step e1 σ1 e2 σ2 ef →
head_step e1 σ1 e2 σ2 ef.
diff --git a/program_logic/ectx_lifting.v b/program_logic/ectx_lifting.v
index 0c243cf12d8af60a6bfc78cbb1eafc19b2407a69..48a49739df9dbe8449b2f3e08a4ecb6a0b7bf7c3 100644
--- a/program_logic/ectx_lifting.v
+++ b/program_logic/ectx_lifting.v
@@ -1,6 +1,7 @@
(** Some derived lemmas for ectx-based languages *)
From iris.program_logic Require Export ectx_language weakestpre lifting.
From iris.program_logic Require Import ownership.
+From iris.proofmode Require Import weakestpre.
Section wp.
Context {expr val ectx state} {Λ : EctxLanguage expr val ectx state}.
@@ -17,32 +18,40 @@ Lemma wp_ectx_bind {E e} K Φ :
WP e @ E {{ v, WP fill K (of_val v) @ E {{ Φ }} }} ⊢ WP fill K e @ E {{ Φ }}.
Proof. apply: weakestpre.wp_bind. Qed.
-Lemma wp_lift_head_step E1 E2
- (φ : expr → state → option expr → Prop) Φ e1 σ1 :
+Lemma wp_lift_head_step E1 E2 Φ e1 :
E2 ⊆ E1 → to_val e1 = None →
- head_reducible e1 σ1 →
- (∀ e2 σ2 ef, head_step e1 σ1 e2 σ2 ef → φ e2 σ2 ef) →
- (|={E1,E2}=> ▷ ownP σ1 ★ ▷ ∀ e2 σ2 ef,
- (■φ e2 σ2 ef ∧ ownP σ2) ={E2,E1}=★ WP e2 @ E1 {{ Φ }} ★ wp_fork ef)
+ (|={E1,E2}=> ∃ σ1, ■head_reducible e1 σ1 ∧
+ ▷ ownP σ1 ★ ▷ ∀ e2 σ2 ef, (■head_step e1 σ1 e2 σ2 ef ∧ ownP σ2)
+ ={E2,E1}=★ WP e2 @ E1 {{ Φ }} ★ wp_fork ef)
⊢ WP e1 @ E1 {{ Φ }}.
-Proof. eauto using wp_lift_step. Qed.
+Proof.
+ iIntros (??) "H". iApply (wp_lift_step E1 E2); try done.
+ iPvs "H" as (σ1) "(%&Hσ1&Hwp)". set_solver. iPvsIntro. iExists σ1.
+ iSplit; first by eauto. iFrame. iNext. iIntros (e2 σ2 ef) "[% ?]".
+ iApply "Hwp". by eauto.
+Qed.
-Lemma wp_lift_pure_head_step E (φ : expr → option expr → Prop) Φ e1 :
+Lemma wp_lift_pure_head_step E Φ e1 :
to_val e1 = None →
(∀ σ1, head_reducible e1 σ1) →
- (∀ σ1 e2 σ2 ef, head_step e1 σ1 e2 σ2 ef → σ1 = σ2 ∧ φ e2 ef) →
- (▷ ∀ e2 ef, ■φ e2 ef → WP e2 @ E {{ Φ }} ★ wp_fork ef) ⊢ WP e1 @ E {{ Φ }}.
-Proof. eauto using wp_lift_pure_step. Qed.
+ (∀ σ1 e2 σ2 ef, head_step e1 σ1 e2 σ2 ef → σ1 = σ2) →
+ (▷ ∀ e2 ef σ, ■head_step e1 σ e2 σ ef → WP e2 @ E {{ Φ }} ★ wp_fork ef)
+ ⊢ WP e1 @ E {{ Φ }}.
+Proof.
+ iIntros (???) "H". iApply wp_lift_pure_step; eauto. iNext.
+ iIntros (????). iApply "H". eauto.
+Qed.
-Lemma wp_lift_atomic_head_step {E Φ} e1
- (φ : expr → state → option expr → Prop) σ1 :
+Lemma wp_lift_atomic_head_step {E Φ} e1 σ1 :
atomic e1 →
head_reducible e1 σ1 →
- (∀ e2 σ2 ef, head_step e1 σ1 e2 σ2 ef → φ e2 σ2 ef) →
▷ ownP σ1 ★ ▷ (∀ v2 σ2 ef,
- ■φ (of_val v2) σ2 ef ∧ ownP σ2 -★ (|={E}=> Φ v2) ★ wp_fork ef)
+ ■head_step e1 σ1 (of_val v2) σ2 ef ∧ ownP σ2 -★ (|={E}=> Φ v2) ★ wp_fork ef)
⊢ WP e1 @ E {{ Φ }}.
-Proof. eauto using wp_lift_atomic_step. Qed.
+Proof.
+ iIntros (??) "[? H]". iApply wp_lift_atomic_step; eauto. iFrame. iNext.
+ iIntros (???) "[% ?]". iApply "H". eauto.
+Qed.
Lemma wp_lift_atomic_det_head_step {E Φ e1} σ1 v2 σ2 ef :
atomic e1 →
diff --git a/program_logic/ectxi_language.v b/program_logic/ectxi_language.v
index a40a3c175820eadd8d154cdbfeb09866c8cfd6a8..4a8f62fd85863f80c4946907b42602a29e98fc3d 100644
--- a/program_logic/ectxi_language.v
+++ b/program_logic/ectxi_language.v
@@ -9,7 +9,6 @@ Class EctxiLanguage (expr val ectx_item state : Type) := {
of_val : val → expr;
to_val : expr → option val;
fill_item : ectx_item → expr → expr;
- atomic : expr → bool;
head_step : expr → state → expr → state → option expr → Prop;
to_of_val v : to_val (of_val v) = Some v;
@@ -24,20 +23,11 @@ Class EctxiLanguage (expr val ectx_item state : Type) := {
head_ctx_step_val Ki e σ1 e2 σ2 ef :
head_step (fill_item Ki e) σ1 e2 σ2 ef → is_Some (to_val e);
-
- atomic_not_val e : atomic e → to_val e = None;
- atomic_step e1 σ1 e2 σ2 ef :
- atomic e1 →
- head_step e1 σ1 e2 σ2 ef →
- is_Some (to_val e2);
- atomic_fill_item e Ki :
- atomic (fill_item Ki e) → is_Some (to_val e)
}.
Arguments of_val {_ _ _ _ _} _.
Arguments to_val {_ _ _ _ _} _.
Arguments fill_item {_ _ _ _ _} _ _.
-Arguments atomic {_ _ _ _ _} _.
Arguments head_step {_ _ _ _ _} _ _ _ _ _.
Arguments to_of_val {_ _ _ _ _} _.
@@ -47,9 +37,6 @@ Arguments fill_item_val {_ _ _ _ _} _ _ _.
Arguments fill_item_no_val_inj {_ _ _ _ _} _ _ _ _ _ _ _.
Arguments head_ctx_step_val {_ _ _ _ _} _ _ _ _ _ _ _.
Arguments step_by_val {_ _ _ _ _} _ _ _ _ _ _ _ _ _ _ _.
-Arguments atomic_not_val {_ _ _ _ _} _ _.
-Arguments atomic_step {_ _ _ _ _} _ _ _ _ _ _ _.
-Arguments atomic_fill_item {_ _ _ _ _} _ _ _.
Section ectxi_language.
Context {expr val ectx_item state}
@@ -70,12 +57,6 @@ Section ectxi_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 atomic_fill K e : atomic (fill K e) → to_val e = None → K = [].
- Proof.
- destruct K as [|Ki K]; [done|].
- rewrite eq_None_not_Some=> /= ? []; eauto using atomic_fill_item, fill_val.
- Qed.
-
(* When something does a step, and another decomposition of the same expression
has a non-val [e] in the hole, then [K] is a left sub-context of [K'] - in
other words, [e] also contains the reducible expression *)
@@ -95,10 +76,9 @@ Section ectxi_language.
Global Program Instance : EctxLanguage expr val ectx state :=
(* For some reason, Coq always rejects the record syntax claiming I
fixed fields of different records, even when I did not. *)
- Build_EctxLanguage expr val ectx state of_val to_val [] (++) fill atomic head_step _ _ _ _ _ _ _ _ _ _ _ _.
+ Build_EctxLanguage expr val ectx state of_val to_val [] (++) fill head_step _ _ _ _ _ _ _ _ _.
Solve Obligations with eauto using to_of_val, of_to_val, val_stuck,
- atomic_not_val, atomic_step, fill_not_val, atomic_fill,
- step_by_val, fold_right_app, app_eq_nil.
+ fill_not_val, step_by_val, fold_right_app, app_eq_nil.
Global Instance ectxi_lang_ctx_item Ki :
LanguageCtx (ectx_lang expr) (fill_item Ki).
diff --git a/program_logic/ghost_ownership.v b/program_logic/ghost_ownership.v
index e227bd5ade1f622f7aedd927538dfe060f95ccb3..cd679ccdfbbe142c24487cdc4c060ef39ab91eab 100644
--- a/program_logic/ghost_ownership.v
+++ b/program_logic/ghost_ownership.v
@@ -18,13 +18,14 @@ Context `{i : inG Λ Σ A}.
Implicit Types a : A.
(** * Properties of own *)
-Global Instance own_ne γ n : Proper (dist n ==> dist n) (own γ).
+Global Instance own_ne γ n : Proper (dist n ==> dist n) (@own Λ Σ A _ γ).
Proof. rewrite !own_eq. solve_proper. Qed.
-Global Instance own_proper γ : Proper ((≡) ==> (⊣⊢)) (own γ) := ne_proper _.
+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 -ownG_op to_globalF_op. Qed.
-Global Instance own_mono γ : Proper (flip (≼) ==> (⊢)) (own γ).
+Global Instance own_mono γ : Proper (flip (≼) ==> (⊢)) (@own Λ Σ A _ γ).
Proof. move=>a b [c ->]. rewrite own_op. eauto with I. Qed.
Lemma own_valid γ a : own γ a ⊢ ✓ a.
Proof.
@@ -85,7 +86,7 @@ Section global_empty.
Context `{i : inG Λ Σ (A:ucmraT)}.
Implicit Types a : A.
-Lemma own_empty γ E : True ={E}=> own γ ∅.
+Lemma own_empty γ E : True ={E}=> own γ (∅:A).
Proof.
rewrite ownG_empty !own_eq /own_def.
apply pvs_ownG_update, iprod_singleton_update_empty.
diff --git a/program_logic/global_functor.v b/program_logic/global_functor.v
index 6d534c266cdbfe4c294b128aca05a682e9e1db9d..48403855e61fd192d625c7e54af8377c8c4c33c5 100644
--- a/program_logic/global_functor.v
+++ b/program_logic/global_functor.v
@@ -28,6 +28,7 @@ Class inG (Λ : language) (Σ : gFunctors) (A : cmraT) := InG {
inG_prf : A = projT2 Σ inG_id (iPreProp Λ (globalF Σ))
}.
Arguments inG_id {_ _ _} _.
+Hint Mode inG - - + : typeclass_instances.
Definition to_globalF `{i : inG Λ Σ A} (γ : gname) (a : A) : iGst Λ (globalF Σ) :=
iprod_singleton (inG_id i) {[ γ := cmra_transport inG_prf a ]}.
@@ -39,17 +40,18 @@ Section to_globalF.
Context `{i : inG Λ Σ A}.
Implicit Types a : A.
-Global Instance to_globalF_ne γ n : Proper (dist n ==> dist n) (to_globalF γ).
+Global Instance to_globalF_ne γ n :
+ Proper (dist n ==> dist n) (@to_globalF Λ Σ A _ γ).
Proof. by intros a a' Ha; apply iprod_singleton_ne; rewrite Ha. Qed.
Lemma to_globalF_op γ a1 a2 :
to_globalF γ (a1 ⋅ a2) ≡ to_globalF γ a1 ⋅ to_globalF γ a2.
Proof.
by rewrite /to_globalF iprod_op_singleton op_singleton cmra_transport_op.
Qed.
-Global Instance to_globalF_timeless γ m: Timeless m → Timeless (to_globalF γ m).
+Global Instance to_globalF_timeless γ a : Timeless a → Timeless (to_globalF γ a).
Proof. rewrite /to_globalF; apply _. Qed.
-Global Instance to_globalF_persistent γ m :
- Persistent m → Persistent (to_globalF γ m).
+Global Instance to_globalF_persistent γ a :
+ Persistent a → Persistent (to_globalF γ a).
Proof. rewrite /to_globalF; apply _. Qed.
End to_globalF.
diff --git a/program_logic/hoare.v b/program_logic/hoare.v
index ef46d9880e9e884c5c9b12c95df6108db619cb84..9423942754099e98506a463c9602b6ae5e97bf6f 100644
--- a/program_logic/hoare.v
+++ b/program_logic/hoare.v
@@ -53,7 +53,7 @@ Global Instance ht_mono' E :
Proof. solve_proper. Qed.
Lemma ht_alt E P Φ e : (P ⊢ WP e @ E {{ Φ }}) → {{ P }} e @ E {{ Φ }}.
-Proof. iIntros {Hwp} "! HP". by iApply Hwp. Qed.
+Proof. iIntros (Hwp) "! HP". by iApply Hwp. Qed.
Lemma ht_val E v : {{ True : iProp Λ Σ }} of_val v @ E {{ v', v = v' }}.
Proof. iIntros "! _". by iApply wp_value'. Qed.
@@ -64,7 +64,7 @@ Lemma ht_vs E P P' Φ Φ' e :
Proof.
iIntros "(#Hvs&#Hwp&#HΦ) ! HP". iPvs ("Hvs" with "HP") as "HP".
iApply wp_pvs; iApply wp_wand_r; iSplitL; [by iApply "Hwp"|].
- iIntros {v} "Hv". by iApply "HΦ".
+ iIntros (v) "Hv". by iApply "HΦ".
Qed.
Lemma ht_atomic E1 E2 P P' Φ Φ' e :
@@ -72,10 +72,10 @@ Lemma ht_atomic E1 E2 P P' Φ Φ' e :
(P ={E1,E2}=> P') ∧ {{ P' }} e @ E2 {{ Φ' }} ∧ (∀ v, Φ' v ={E2,E1}=> Φ v)
⊢ {{ P }} e @ E1 {{ Φ }}.
Proof.
- iIntros {??} "(#Hvs&#Hwp&#HΦ) ! HP". iApply (wp_atomic _ E2); auto.
+ iIntros (??) "(#Hvs&#Hwp&#HΦ) ! HP". iApply (wp_atomic _ E2); auto.
iPvs ("Hvs" with "HP") as "HP"; first set_solver. iPvsIntro.
iApply wp_wand_r; iSplitL; [by iApply "Hwp"|].
- iIntros {v} "Hv". by iApply "HΦ".
+ iIntros (v) "Hv". by iApply "HΦ".
Qed.
Lemma ht_bind `{LanguageCtx Λ K} E P Φ Φ' e :
@@ -84,13 +84,13 @@ Lemma ht_bind `{LanguageCtx Λ K} E P Φ Φ' e :
Proof.
iIntros "(#Hwpe&#HwpK) ! HP". iApply wp_bind.
iApply wp_wand_r; iSplitL; [by iApply "Hwpe"|].
- iIntros {v} "Hv". by iApply "HwpK".
+ iIntros (v) "Hv". by iApply "HwpK".
Qed.
Lemma ht_mask_weaken E1 E2 P Φ e :
E1 ⊆ E2 → {{ P }} e @ E1 {{ Φ }} ⊢ {{ P }} e @ E2 {{ Φ }}.
Proof.
- iIntros {?} "#Hwp ! HP". iApply (wp_mask_frame_mono E1 E2); try done.
+ iIntros (?) "#Hwp ! HP". iApply (wp_mask_frame_mono E1 E2); try done.
by iApply "Hwp".
Qed.
@@ -107,7 +107,7 @@ Lemma ht_frame_step_l E E1 E2 P R1 R2 R3 e Φ :
(R1 ={E1,E2}=> ▷ R2) ∧ (R2 ={E2,E1}=> R3) ∧ {{ P }} e @ E {{ Φ }}
⊢ {{ R1 ★ P }} e @ E ∪ E1 {{ λ v, R3 ★ Φ v }}.
Proof.
- iIntros {???} "[#Hvs1 [#Hvs2 #Hwp]] ! [HR HP]".
+ iIntros (???) "[#Hvs1 [#Hvs2 #Hwp]] ! [HR HP]".
iApply (wp_frame_step_l E E1 E2); try done.
iSplitL "HR"; [|by iApply "Hwp"].
iPvs ("Hvs1" with "HR"); first by set_solver.
@@ -119,7 +119,7 @@ Lemma ht_frame_step_r E E1 E2 P R1 R2 R3 e Φ :
(R1 ={E1,E2}=> ▷ R2) ∧ (R2 ={E2,E1}=> R3) ∧ {{ P }} e @ E {{ Φ }}
⊢ {{ P ★ R1 }} e @ (E ∪ E1) {{ λ v, Φ v ★ R3 }}.
Proof.
- iIntros {???} "[#Hvs1 [#Hvs2 #Hwp]]".
+ iIntros (???) "[#Hvs1 [#Hvs2 #Hwp]]".
setoid_rewrite (comm _ _ R3); rewrite (comm _ _ R1).
iApply (ht_frame_step_l _ _ E2); by repeat iSplit.
Qed.
@@ -128,7 +128,7 @@ Lemma ht_frame_step_l' E P R e Φ :
to_val e = None →
{{ P }} e @ E {{ Φ }} ⊢ {{ ▷ R ★ P }} e @ E {{ v, R ★ Φ v }}.
Proof.
- iIntros {?} "#Hwp ! [HR HP]".
+ iIntros (?) "#Hwp ! [HR HP]".
iApply wp_frame_step_l'; try done. iFrame "HR". by iApply "Hwp".
Qed.
@@ -136,7 +136,7 @@ Lemma ht_frame_step_r' E P Φ R e :
to_val e = None →
{{ P }} e @ E {{ Φ }} ⊢ {{ P ★ ▷ R }} e @ E {{ v, Φ v ★ R }}.
Proof.
- iIntros {?} "#Hwp ! [HP HR]".
+ iIntros (?) "#Hwp ! [HP HR]".
iApply wp_frame_step_r'; try done. iFrame "HR". by iApply "Hwp".
Qed.
@@ -145,6 +145,6 @@ Lemma ht_inv N E P Φ R e :
inv N R ★ {{ ▷ R ★ P }} e @ E ∖ nclose N {{ v, ▷ R ★ Φ v }}
⊢ {{ P }} e @ E {{ Φ }}.
Proof.
- iIntros {??} "[#? #Hwp] ! HP". iInv N as "HR". iApply "Hwp". by iSplitL "HR".
+ iIntros (??) "[#? #Hwp] ! HP". iInv N as "HR". iApply "Hwp". by iSplitL "HR".
Qed.
End hoare.
diff --git a/program_logic/hoare_lifting.v b/program_logic/hoare_lifting.v
deleted file mode 100644
index ca9b0ff2ac81403b454cfc3005b8efba65b988d6..0000000000000000000000000000000000000000
--- a/program_logic/hoare_lifting.v
+++ /dev/null
@@ -1,97 +0,0 @@
-From iris.algebra Require Import upred_tactics.
-From iris.program_logic Require Export hoare lifting.
-From iris.program_logic Require Import ownership.
-From iris.proofmode Require Import tactics pviewshifts.
-
-Local Notation "{{ P } } ef ?@ E {{ v , Q } }" :=
- (default True%I ef (λ e, ht E P e (λ v, Q)))
- (at level 20, P, ef, Q at level 200,
- format "{{ P } } ef ?@ E {{ v , Q } }") : uPred_scope.
-Local Notation "{{ P } } ef ?@ E {{ v , Q } }" :=
- (True ⊢ default True ef (λ e, ht E P e (λ v, Q)))
- (at level 20, P, ef, Q at level 200,
- format "{{ P } } ef ?@ E {{ v , Q } }") : C_scope.
-
-Section lifting.
-Context {Λ : language} {Σ : iFunctor}.
-Implicit Types e : expr Λ.
-Implicit Types P Q R : iProp Λ Σ.
-Implicit Types Ψ : val Λ → iProp Λ Σ.
-
-Lemma ht_lift_step E1 E2
- (φ : expr Λ → state Λ → option (expr Λ) → Prop) P P' Φ1 Φ2 Ψ e1 σ1 :
- E2 ⊆ E1 → to_val e1 = None →
- reducible e1 σ1 →
- (∀ e2 σ2 ef, prim_step e1 σ1 e2 σ2 ef → φ e2 σ2 ef) →
- (P ={E1,E2}=> ▷ ownP σ1 ★ ▷ P') ∧
- (∀ e2 σ2 ef, ■φ e2 σ2 ef ★ ownP σ2 ★ P' ={E2,E1}=> Φ1 e2 σ2 ef ★ Φ2 e2 σ2 ef) ∧
- (∀ e2 σ2 ef, {{ Φ1 e2 σ2 ef }} e2 @ E1 {{ Ψ }}) ∧
- (∀ e2 σ2 ef, {{ Φ2 e2 σ2 ef }} ef ?@ ⊤ {{ _, True }})
- ⊢ {{ P }} e1 @ E1 {{ Ψ }}.
-Proof.
- iIntros {?? Hsafe Hstep} "#(#Hvs&HΦ&He2&Hef) ! HP".
- iApply (wp_lift_step E1 E2 φ _ e1 σ1); auto.
- iPvs ("Hvs" with "HP") as "[Hσ HP]"; first set_solver.
- iPvsIntro. iNext. iSplitL "Hσ"; [done|iIntros {e2 σ2 ef} "[#Hφ Hown]"].
- iSpecialize ("HΦ" $! e2 σ2 ef with "[-]"). by iFrame "Hφ HP Hown".
- iPvs "HΦ" as "[H1 H2]"; first by set_solver.
- iPvsIntro. iSplitL "H1".
- - by iApply "He2".
- - destruct ef as [e|]; last done. by iApply ("Hef" $! _ _ (Some e)).
-Qed.
-
-Lemma ht_lift_atomic_step
- E (φ : expr Λ → state Λ → option (expr Λ) → Prop) P e1 σ1 :
- atomic e1 →
- reducible e1 σ1 →
- (∀ e2 σ2 ef, prim_step e1 σ1 e2 σ2 ef → φ e2 σ2 ef) →
- (∀ e2 σ2 ef, {{ ■φ e2 σ2 ef ★ P }} ef ?@ ⊤ {{ _, True }}) ⊢
- {{ ▷ ownP σ1 ★ ▷ P }} e1 @ E {{ v, ∃ σ2 ef, ownP σ2 ★ ■φ (of_val v) σ2 ef }}.
-Proof.
- iIntros {? Hsafe Hstep} "#Hef".
- set (φ' e σ ef := is_Some (to_val e) ∧ φ e σ ef).
- iApply (ht_lift_step E E φ' _ P
- (λ e2 σ2 ef, ownP σ2 ★ ■(φ' e2 σ2 ef))%I
- (λ e2 σ2 ef, ■φ e2 σ2 ef ★ P)%I);
- try by (rewrite /φ'; eauto using atomic_not_val, atomic_step).
- repeat iSplit.
- - by iIntros "! ?".
- - iIntros {e2 σ2 ef} "! (#Hφ&Hown&HP)"; iPvsIntro.
- iSplitL "Hown". by iSplit. iSplit. by iDestruct "Hφ" as %[_ ?]. done.
- - iIntros {e2 σ2 ef} "! [Hown #Hφ]"; iDestruct "Hφ" as %[[v2 <-%of_to_val] ?].
- iApply wp_value'. iExists σ2, ef. by iSplit.
- - done.
-Qed.
-
-Lemma ht_lift_pure_step E (φ : expr Λ → option (expr Λ) → Prop) P P' Ψ e1 :
- to_val e1 = None →
- (∀ σ1, reducible e1 σ1) →
- (∀ σ1 e2 σ2 ef, prim_step e1 σ1 e2 σ2 ef → σ1 = σ2 ∧ φ e2 ef) →
- (∀ e2 ef, {{ ■φ e2 ef ★ P }} e2 @ E {{ Ψ }}) ∧
- (∀ e2 ef, {{ ■φ e2 ef ★ P' }} ef ?@ ⊤ {{ _, True }})
- ⊢ {{ ▷(P ★ P') }} e1 @ E {{ Ψ }}.
-Proof.
- iIntros {? Hsafe Hstep} "[#He2 #Hef] ! HP".
- iApply (wp_lift_pure_step E φ _ e1); auto.
- iNext; iIntros {e2 ef Hφ}. iDestruct "HP" as "[HP HP']"; iSplitL "HP".
- - iApply "He2"; by iSplit.
- - destruct ef as [e|]; last done.
- iApply ("Hef" $! _ (Some e)); by iSplit.
-Qed.
-
-Lemma ht_lift_pure_det_step
- E (φ : expr Λ → option (expr Λ) → Prop) P P' Ψ e1 e2 ef :
- to_val e1 = None →
- (∀ σ1, reducible e1 σ1) →
- (∀ σ1 e2' σ2 ef', prim_step e1 σ1 e2' σ2 ef' → σ1 = σ2 ∧ e2 = e2' ∧ ef = ef')→
- {{ P }} e2 @ E {{ Ψ }} ∧ {{ P' }} ef ?@ ⊤ {{ _, True }}
- ⊢ {{ ▷(P ★ P') }} e1 @ E {{ Ψ }}.
-Proof.
- iIntros {? Hsafe Hdet} "[#He2 #Hef]".
- iApply (ht_lift_pure_step _ (λ e2' ef', e2 = e2' ∧ ef = ef')); eauto.
- iSplit; iIntros {e2' ef'}.
- - iIntros "! [#He ?]"; iDestruct "He" as %[-> ->]. by iApply "He2".
- - destruct ef' as [e'|]; last done.
- iIntros "! [#He ?]"; iDestruct "He" as %[-> ->]. by iApply "Hef".
-Qed.
-End lifting.
diff --git a/program_logic/invariants.v b/program_logic/invariants.v
index 3037ced25dbb01b82e39d3b45851d264d8c93997..4c91e6fa64851b29ef82f4375ece0cdc8747a50d 100644
--- a/program_logic/invariants.v
+++ b/program_logic/invariants.v
@@ -33,7 +33,7 @@ Proof. by rewrite always_always. Qed.
Lemma inv_alloc N E P : nclose N ⊆ E → ▷ P ={E}=> inv N P.
Proof.
intros. rewrite -(pvs_mask_weaken N) //.
- by rewrite inv_eq /inv (pvs_allocI N); last apply coPset_suffixes_infinite.
+ by rewrite inv_eq /inv (pvs_allocI N); last apply nclose_infinite.
Qed.
(** Fairly explicit form of opening invariants *)
@@ -42,7 +42,7 @@ Lemma inv_open E N P :
inv N P ⊢ ∃ E', ■(E ∖ nclose N ⊆ E' ⊆ E) ★
|={E,E'}=> ▷ P ★ (▷ P ={E',E}=★ True).
Proof.
- rewrite inv_eq /inv. iDestruct 1 as {i} "[% #Hi]".
+ rewrite inv_eq /inv. iDestruct 1 as (i) "[% #Hi]".
iExists (E ∖ {[ i ]}). iSplit. { iPureIntro. set_solver. }
iPvs (pvs_openI' with "Hi") as "HP"; [set_solver..|].
iPvsIntro. iSplitL "HP"; first done. iIntros "HP".
@@ -56,13 +56,13 @@ Lemma inv_fsa {A} (fsa : FSA Λ Σ A) `{!FrameShiftAssertion fsaV fsa} E N P Ψ
fsaV → nclose N ⊆ E →
inv N P ★ (▷ P -★ fsa (E ∖ nclose N) (λ a, ▷ P ★ Ψ a)) ⊢ fsa E Ψ.
Proof.
- iIntros {??} "[Hinv HΨ]".
- iDestruct (inv_open E N P with "Hinv") as {E'} "[% Hvs]"; first done.
+ iIntros (??) "[Hinv HΨ]".
+ iDestruct (inv_open E N P with "Hinv") as (E') "[% Hvs]"; first done.
iApply (fsa_open_close E E'); auto; first set_solver.
iPvs "Hvs" as "[HP Hvs]"; first set_solver.
(* TODO: How do I do sth. like [iSpecialize "HΨ HP"]? *)
iPvsIntro. iApply (fsa_mask_weaken _ (E ∖ N)); first set_solver.
iApply fsa_wand_r. iSplitR "Hvs"; first by iApply "HΨ"; simpl.
- iIntros {v} "[HP HΨ]". by iPvs ("Hvs" with "HP"); first set_solver.
+ iIntros (v) "[HP HΨ]". by iPvs ("Hvs" with "HP"); first set_solver.
Qed.
End inv.
diff --git a/program_logic/language.v b/program_logic/language.v
index d361644f255acfb677ebbf59bd3292ca9ebd17c1..33600f6dfce705774c1a66d601f6bfcb7c46e4ae 100644
--- a/program_logic/language.v
+++ b/program_logic/language.v
@@ -6,26 +6,17 @@ Structure language := Language {
state : Type;
of_val : val → expr;
to_val : expr → option val;
- atomic : expr → bool;
prim_step : expr → state → expr → state → option expr → Prop;
to_of_val v : to_val (of_val v) = Some v;
of_to_val e v : to_val e = Some v → of_val v = e;
- val_stuck e σ e' σ' ef : prim_step e σ e' σ' ef → to_val e = None;
- atomic_not_val e : atomic e → to_val e = None;
- atomic_step e1 σ1 e2 σ2 ef :
- atomic e1 →
- prim_step e1 σ1 e2 σ2 ef →
- is_Some (to_val e2)
+ val_stuck e σ e' σ' ef : prim_step e σ e' σ' ef → to_val e = None
}.
Arguments of_val {_} _.
Arguments to_val {_} _.
-Arguments atomic {_} _.
Arguments prim_step {_} _ _ _ _ _.
Arguments to_of_val {_} _.
Arguments of_to_val {_} _ _ _.
Arguments val_stuck {_} _ _ _ _ _ _.
-Arguments atomic_not_val {_} _ _.
-Arguments atomic_step {_} _ _ _ _ _ _ _.
Canonical Structure stateC Λ := leibnizC (state Λ).
Canonical Structure valC Λ := leibnizC (val Λ).
@@ -39,6 +30,8 @@ Section language.
Definition reducible (e : expr Λ) (σ : state Λ) :=
∃ e' σ' ef, prim_step e σ e' σ' ef.
+ Definition atomic (e : expr Λ) : Prop :=
+ ∀ σ e' σ' ef, prim_step e σ e' σ' ef → is_Some (to_val e').
Inductive step (Ï1 Ï2 : cfg Λ) : Prop :=
| step_atomic e1 σ1 e2 σ2 ef t1 t2 :
Ï1 = (t1 ++ e1 :: t2, σ1) →
@@ -50,8 +43,6 @@ Section language.
Proof. intros <-. by rewrite to_of_val. Qed.
Lemma reducible_not_val e σ : reducible e σ → to_val e = None.
Proof. intros (?&?&?&?); eauto using val_stuck. Qed.
- Lemma atomic_of_val v : ¬atomic (of_val v).
- Proof. by intros Hat%atomic_not_val; rewrite to_of_val in Hat. Qed.
Global Instance: Inj (=) (=) (@of_val Λ).
Proof. by intros v v' Hv; apply (inj Some); rewrite -!to_of_val Hv. Qed.
End language.
diff --git a/program_logic/lifting.v b/program_logic/lifting.v
index 843b5b883166abb395bddb0d2f19d0c6f46db755..6b98cf087a3aea1de5f51eb74755aa4bd9e2e7f3 100644
--- a/program_logic/lifting.v
+++ b/program_logic/lifting.v
@@ -1,5 +1,6 @@
From iris.program_logic Require Export weakestpre.
From iris.program_logic Require Import wsat ownership.
+From iris.proofmode Require Import pviewshifts.
Local Hint Extern 10 (_ ≤ _) => omega.
Local Hint Extern 100 (_ ⊥ _) => set_solver.
Local Hint Extern 10 (✓{_} _) =>
@@ -17,41 +18,40 @@ Implicit Types Φ : val Λ → iProp Λ Σ.
Notation wp_fork ef := (default True ef (flip (wp ⊤) (λ _, True)))%I.
-Lemma wp_lift_step E1 E2
- (φ : expr Λ → state Λ → option (expr Λ) → Prop) Φ e1 σ1 :
+Lemma wp_lift_step E1 E2 Φ e1 :
E2 ⊆ E1 → to_val e1 = None →
- reducible e1 σ1 →
- (∀ e2 σ2 ef, prim_step e1 σ1 e2 σ2 ef → φ e2 σ2 ef) →
- (|={E1,E2}=> ▷ ownP σ1 ★ ▷ ∀ e2 σ2 ef,
- (■φ e2 σ2 ef ∧ ownP σ2) ={E2,E1}=★ WP e2 @ E1 {{ Φ }} ★ wp_fork ef)
+ (|={E1,E2}=> ∃ σ1, ■reducible e1 σ1 ∧ ▷ ownP σ1 ★
+ ▷ ∀ e2 σ2 ef, (■prim_step e1 σ1 e2 σ2 ef ∧ ownP σ2)
+ ={E2,E1}=★ WP e2 @ E1 {{ Φ }} ★ wp_fork ef)
⊢ WP e1 @ E1 {{ Φ }}.
Proof.
- intros ? He Hsafe Hstep. rewrite pvs_eq wp_eq.
- uPred.unseal; split=> n r ? Hvs; constructor; auto.
- intros k Ef σ1' rf ???; destruct (Hvs (S k) Ef σ1' rf)
- as (r'&(r1&r2&?&?&Hwp)&Hws); auto; clear Hvs; cofe_subst r'.
+ intros ? He. rewrite pvs_eq wp_eq.
+ uPred.unseal; split=> n r ? Hvs; constructor; auto. intros k Ef σ1' rf ???.
+ destruct (Hvs (S k) Ef σ1' rf) as (r'&(σ1&Hsafe&r1&r2&?&?&Hwp)&Hws);
+ auto; clear Hvs; cofe_subst r'.
destruct (wsat_update_pst k (E2 ∪ Ef) σ1 σ1' r1 (r2 ⋅ rf)) as [-> Hws'].
{ apply equiv_dist. rewrite -(ownP_spec k); auto. }
{ by rewrite assoc. }
constructor; [done|intros e2 σ2 ef ?; specialize (Hws' σ2)].
destruct (λ H1 H2 H3, Hwp e2 σ2 ef k (update_pst σ2 r1) H1 H2 H3 k Ef σ2 rf)
as (r'&(r1'&r2'&?&?&?)&?); auto; cofe_subst r'.
- { split. by eapply Hstep. apply ownP_spec; auto. }
+ { split. done. apply ownP_spec; auto. }
{ rewrite (comm _ r2) -assoc; eauto using wsat_le. }
exists r1', r2'; split_and?; try done. by uPred.unseal; intros ? ->.
Qed.
-Lemma wp_lift_pure_step E (φ : expr Λ → option (expr Λ) → Prop) Φ e1 :
+Lemma wp_lift_pure_step E Φ e1 :
to_val e1 = None →
(∀ σ1, reducible e1 σ1) →
- (∀ σ1 e2 σ2 ef, prim_step e1 σ1 e2 σ2 ef → σ1 = σ2 ∧ φ e2 ef) →
- (▷ ∀ e2 ef, ■φ e2 ef → WP e2 @ E {{ Φ }} ★ wp_fork ef) ⊢ WP e1 @ E {{ Φ }}.
+ (∀ σ1 e2 σ2 ef, prim_step e1 σ1 e2 σ2 ef → σ1 = σ2) →
+ (▷ ∀ e2 ef σ, ■prim_step e1 σ e2 σ ef → WP e2 @ E {{ Φ }} ★ wp_fork ef)
+ ⊢ WP e1 @ E {{ Φ }}.
Proof.
intros He Hsafe Hstep; rewrite wp_eq; uPred.unseal.
split=> n r ? Hwp; constructor; auto.
intros k Ef σ1 rf ???; split; [done|]. destruct n as [|n]; first lia.
intros e2 σ2 ef ?; destruct (Hstep σ1 e2 σ2 ef); auto; subst.
- destruct (Hwp e2 ef k r) as (r1&r2&Hr&?&?); auto.
+ destruct (Hwp e2 ef σ1 k r) as (r1&r2&Hr&?&?); auto.
exists r1,r2; split_and?; try done.
- rewrite -Hr; eauto using wsat_le.
- uPred.unseal; by intros ? ->.
@@ -60,44 +60,31 @@ Qed.
(** Derived lifting lemmas. *)
Import uPred.
-Lemma wp_lift_atomic_step {E Φ} e1
- (φ : expr Λ → state Λ → option (expr Λ) → Prop) σ1 :
+Lemma wp_lift_atomic_step {E Φ} e1 σ1 :
atomic e1 →
reducible e1 σ1 →
- (∀ e2 σ2 ef,
- prim_step e1 σ1 e2 σ2 ef → φ e2 σ2 ef) →
▷ ownP σ1 ★ ▷ (∀ v2 σ2 ef,
- ■φ (of_val v2) σ2 ef ∧ ownP σ2 -★ (|={E}=> Φ v2) ★ wp_fork ef)
+ ■prim_step e1 σ1 (of_val v2) σ2 ef ∧ ownP σ2 -★ (|={E}=> Φ v2) ★ wp_fork ef)
⊢ WP e1 @ E {{ Φ }}.
Proof.
- intros. rewrite -(wp_lift_step E E (λ e2 σ2 ef,
- is_Some (to_val e2) ∧ φ e2 σ2 ef) _ e1 σ1) //;
- try by (eauto using atomic_not_val, atomic_step).
- rewrite -pvs_intro. apply sep_mono, later_mono; first done.
- apply forall_intro=>e2'; apply forall_intro=>σ2'.
- apply forall_intro=>ef; apply wand_intro_l.
- rewrite always_and_sep_l -assoc -always_and_sep_l.
- apply pure_elim_l=>-[[v2 Hv] ?] /=.
- rewrite -pvs_intro -wp_pvs.
- rewrite (forall_elim v2) (forall_elim σ2') (forall_elim ef) pure_equiv //.
- rewrite left_id wand_elim_r -(wp_value _ _ e2' v2) //.
- by erewrite of_to_val.
+ iIntros (Hatom ?) "[Hσ1 Hwp]". iApply (wp_lift_step E E _ e1); eauto using reducible_not_val.
+ iPvsIntro. iExists σ1. repeat iSplit; eauto 10.
+ iFrame. iNext. iIntros (e2 σ2 ef) "[% Hσ2]".
+ edestruct Hatom as [v2 Hv%of_to_val]; eauto. subst e2.
+ iDestruct ("Hwp" $! v2 σ2 ef with "[Hσ2]") as "[HΦ ?]". by eauto.
+ iFrame. iPvs "HΦ". iPvsIntro. iApply wp_value; auto using to_of_val.
Qed.
Lemma wp_lift_atomic_det_step {E Φ e1} σ1 v2 σ2 ef :
atomic e1 →
reducible e1 σ1 →
(∀ e2' σ2' ef', prim_step e1 σ1 e2' σ2' ef' →
- σ2 = σ2' ∧ to_val e2' = Some v2 ∧ ef = ef') →
+ σ2 = σ2' ∧ to_val e2' = Some v2 ∧ ef = ef') →
▷ ownP σ1 ★ ▷ (ownP σ2 -★ (|={E}=> Φ v2) ★ wp_fork ef) ⊢ WP e1 @ E {{ Φ }}.
Proof.
- intros. rewrite -(wp_lift_atomic_step _ (λ e2' σ2' ef',
- σ2 = σ2' ∧ to_val e2' = Some v2 ∧ ef = ef') σ1) //.
- apply sep_mono, later_mono; first done.
- apply forall_intro=>e2'; apply forall_intro=>σ2'; apply forall_intro=>ef'.
- apply wand_intro_l.
- rewrite always_and_sep_l -assoc -always_and_sep_l to_of_val.
- apply pure_elim_l=>-[-> [[->] ->]] /=. by rewrite wand_elim_r.
+ iIntros (?? Hdet) "[Hσ1 Hσ2]". iApply (wp_lift_atomic_step _ σ1); try done.
+ iFrame. iNext. iIntros (v2' σ2' ef') "[% Hσ2']".
+ edestruct Hdet as (->&->%of_to_val%(inj of_val)&->). done. by iApply "Hσ2".
Qed.
Lemma wp_lift_pure_det_step {E Φ} e1 e2 ef :
@@ -106,9 +93,7 @@ Lemma wp_lift_pure_det_step {E Φ} e1 e2 ef :
(∀ σ1 e2' σ2 ef', prim_step e1 σ1 e2' σ2 ef' → σ1 = σ2 ∧ e2 = e2' ∧ ef = ef')→
▷ (WP e2 @ E {{ Φ }} ★ wp_fork ef) ⊢ WP e1 @ E {{ Φ }}.
Proof.
- intros.
- rewrite -(wp_lift_pure_step E (λ e2' ef', e2 = e2' ∧ ef = ef') _ e1) //=.
- apply later_mono, forall_intro=>e'; apply forall_intro=>ef'.
- by apply impl_intro_l, pure_elim_l=>-[-> ->].
+ iIntros (?? Hpuredet) "?". iApply (wp_lift_pure_step E); try done.
+ by intros; eapply Hpuredet. iNext. by iIntros (e' ef' σ (_&->&->)%Hpuredet).
Qed.
End lifting.
diff --git a/program_logic/namespaces.v b/program_logic/namespaces.v
index 7ef9071b7b2dcdca0372f06ce26e449a22d3ba6a..02e2a8dd6ec13c99ecde21d499b38c258b7fa19c 100644
--- a/program_logic/namespaces.v
+++ b/program_logic/namespaces.v
@@ -1,29 +1,43 @@
-From iris.prelude Require Export countable co_pset.
+From iris.prelude Require Export countable coPset.
From iris.algebra Require Export base.
Definition namespace := list positive.
Definition nroot : namespace := nil.
-Definition ndot `{Countable A} (N : namespace) (x : A) : namespace :=
+
+Definition ndot_def `{Countable A} (N : namespace) (x : A) : namespace :=
encode x :: N.
-Coercion nclose (N : namespace) : coPset := coPset_suffixes (encode N).
+Definition ndot_aux : { x | x = @ndot_def }. by eexists. Qed.
+Definition ndot {A A_dec A_count}:= proj1_sig ndot_aux A A_dec A_count.
+Definition ndot_eq : @ndot = @ndot_def := proj2_sig ndot_aux.
+
+Definition nclose_def (N : namespace) : coPset := coPset_suffixes (encode N).
+Definition nclose_aux : { x | x = @nclose_def }. by eexists. Qed.
+Coercion nclose := proj1_sig nclose_aux.
+Definition nclose_eq : @nclose = @nclose_def := proj2_sig nclose_aux.
Infix ".@" := ndot (at level 19, left associativity) : C_scope.
Notation "(.@)" := ndot (only parsing) : C_scope.
Instance ndot_inj `{Countable A} : Inj2 (=) (=) (=) (@ndot A _ _).
-Proof. by intros N1 x1 N2 x2 ?; simplify_eq. Qed.
+Proof. intros N1 x1 N2 x2; rewrite !ndot_eq=> ?; by simplify_eq. Qed.
Lemma nclose_nroot : nclose nroot = ⊤.
-Proof. by apply (sig_eq_pi _). Qed.
+Proof. rewrite nclose_eq. by apply (sig_eq_pi _). Qed.
Lemma encode_nclose N : encode N ∈ nclose N.
-Proof. by apply elem_coPset_suffixes; exists xH; rewrite (left_id_L _ _). Qed.
+Proof.
+ rewrite nclose_eq.
+ by apply elem_coPset_suffixes; exists xH; rewrite (left_id_L _ _).
+Qed.
Lemma nclose_subseteq `{Countable A} N x : nclose (N .@ x) ⊆ nclose N.
Proof.
- intros p; rewrite /nclose !elem_coPset_suffixes; intros [q ->].
- destruct (list_encode_suffix N (N .@ x)) as [q' ?]; [by exists [encode x]|].
+ intros p; rewrite nclose_eq /nclose !ndot_eq !elem_coPset_suffixes.
+ intros [q ->]. destruct (list_encode_suffix N (ndot_def N x)) as [q' ?].
+ { by exists [encode x]. }
by exists (q ++ q')%positive; rewrite <-(assoc_L _); f_equal.
Qed.
Lemma ndot_nclose `{Countable A} N x : encode (N .@ x) ∈ nclose N.
Proof. apply nclose_subseteq with x, encode_nclose. Qed.
+Lemma nclose_infinite N : ¬set_finite (nclose N).
+Proof. rewrite nclose_eq. apply coPset_suffixes_infinite. Qed.
Instance ndisjoint : Disjoint namespace := λ N1 N2,
∃ N1' N2', N1' `suffix_of` N1 ∧ N2' `suffix_of` N2 ∧
@@ -38,12 +52,12 @@ Section ndisjoint.
Proof. intros N1 N2. rewrite /disjoint /ndisjoint; naive_solver. Qed.
Lemma ndot_ne_disjoint N x y : x ≠y → N .@ x ⊥ N .@ y.
- Proof. intros Hxy. exists (N .@ x), (N .@ y); naive_solver. Qed.
+ Proof. intros. exists (N .@ x), (N .@ y); rewrite ndot_eq; naive_solver. Qed.
Lemma ndot_preserve_disjoint_l N1 N2 x : N1 ⊥ N2 → N1 .@ x ⊥ N2.
Proof.
intros (N1' & N2' & Hpr1 & Hpr2 & Hl & Hne). exists N1', N2'.
- split_and?; try done; []. by apply suffix_of_cons_r.
+ split_and?; try done; []. rewrite ndot_eq. by apply suffix_of_cons_r.
Qed.
Lemma ndot_preserve_disjoint_r N1 N2 x : N1 ⊥ N2 → N1 ⊥ N2 .@ x .
@@ -51,7 +65,8 @@ Section ndisjoint.
Lemma ndisj_disjoint N1 N2 : N1 ⊥ N2 → nclose N1 ⊥ nclose N2.
Proof.
- intros (N1' & N2' & [N1'' ->] & [N2'' ->] & Hl & Hne) p; unfold nclose.
+ intros (N1' & N2' & [N1'' ->] & [N2'' ->] & Hl & Hne) p.
+ rewrite nclose_eq /nclose.
rewrite !elem_coPset_suffixes; intros [q ->] [q' Hq]; destruct Hne.
by rewrite !list_encode_app !assoc in Hq; apply list_encode_suffix_eq in Hq.
Qed.
@@ -62,7 +77,7 @@ Section ndisjoint.
End ndisjoint.
(* The hope is that registering these will suffice to solve most goals
-of the form [N1 ⊥ N2] and those of the form [((N1 ⊆ E ∖ N2) ∖ ..) ∖ Nn]. *)
+of the form [N1 ⊥ N2] and those of the form [N1 ⊆ E ∖ N2 ∖ .. ∖ Nn]. *)
Hint Resolve ndisj_subseteq_difference : ndisj.
Hint Extern 0 (_ ⊥ _) => apply ndot_ne_disjoint; congruence : ndisj.
Hint Resolve ndot_preserve_disjoint_l : ndisj.
diff --git a/program_logic/pviewshifts.v b/program_logic/pviewshifts.v
index ea19b2a12b515d0968ebfb9ae271307d1e5b8ced..9cbab38f8cd2baad9df3dca216fde285eec8567c 100644
--- a/program_logic/pviewshifts.v
+++ b/program_logic/pviewshifts.v
@@ -1,5 +1,5 @@
-From iris.prelude Require Export co_pset.
-From iris.algebra Require Export upred_big_op.
+From iris.prelude Require Export coPset.
+From iris.algebra Require Export upred_big_op updates.
From iris.program_logic Require Export model.
From iris.program_logic Require Import ownership wsat.
Local Hint Extern 10 (_ ≤ _) => omega.
@@ -243,6 +243,9 @@ Class FrameShiftAssertion {Λ Σ A} (fsaV : Prop) (fsa : FSA Λ Σ A) := {
fsa_frame_r E P Φ : (fsa E Φ ★ P) ⊢ fsa E (λ a, Φ a ★ P)
}.
+(* Used to solve side-conditions related to [fsaV] *)
+Create HintDb fsaV.
+
Section fsa.
Context {Λ Σ A} (fsa : FSA Λ Σ A) `{!FrameShiftAssertion fsaV fsa}.
Implicit Types Φ Ψ : A → iProp Λ Σ.
diff --git a/program_logic/resources.v b/program_logic/resources.v
index b12df6173c90aab79155eb1b6bc57f8bd210b5a0..1590ee7374bdb68b0b5ddd2fb16d1b7f7b28f680 100644
--- a/program_logic/resources.v
+++ b/program_logic/resources.v
@@ -109,7 +109,7 @@ Proof.
- by intros ?; constructor; rewrite /= cmra_core_l.
- by intros ?; constructor; rewrite /= cmra_core_idemp.
- intros r1 r2; rewrite !res_included.
- by intros (?&?&?); split_and!; apply cmra_core_preserving.
+ by intros (?&?&?); split_and!; apply cmra_core_mono.
- intros n r1 r2 (?&?&?);
split_and!; simpl in *; eapply cmra_validN_op_l; eauto.
- intros n r r1 r2 (?&?&?) [???]; simpl in *.
@@ -212,7 +212,7 @@ Proof.
split; first apply _.
- intros n r (?&?&?); split_and!; simpl; by try apply: validN_preserving.
- by intros r1 r2; rewrite !res_included;
- intros (?&?&?); split_and!; simpl; try apply: included_preserving.
+ intros (?&?&?); split_and!; simpl; try apply: cmra_monotone.
Qed.
Definition resC_map {Λ} {A A' : cofeT} {M M' : ucmraT}
(f : A -n> A') (g : M -n> M') : resC Λ A M -n> resC Λ A' M' :=
diff --git a/program_logic/sts.v b/program_logic/sts.v
index e6ebf515c4b332a25ba3a906d0b76d812dc34f7c..7152d178f7a8b05edf7b179e188792cac0a67661 100644
--- a/program_logic/sts.v
+++ b/program_logic/sts.v
@@ -82,8 +82,8 @@ Section sts.
nclose N ⊆ E →
▷ φ s ={E}=> ∃ γ, sts_ctx γ N φ ∧ sts_own γ s (⊤ ∖ sts.tok s).
Proof.
- iIntros {?} "Hφ". rewrite /sts_ctx /sts_own.
- iPvs (own_alloc (sts_auth s (⊤ ∖ sts.tok s))) as {γ} "Hγ".
+ iIntros (?) "Hφ". rewrite /sts_ctx /sts_own.
+ iPvs (own_alloc (sts_auth s (⊤ ∖ sts.tok s))) as (γ) "Hγ".
{ apply sts_auth_valid; set_solver. }
iExists γ; iRevert "Hγ"; rewrite -sts_op_auth_frag_up; iIntros "[Hγ $]".
iPvs (inv_alloc N _ (sts_inv γ φ) with "[Hφ Hγ]") as "#?"; auto.
@@ -100,16 +100,16 @@ Section sts.
■sts.steps (s, T) (s', T') ★ ▷ φ s' ★ (sts_own γ s' T' -★ Ψ x)))
⊢ fsa E Ψ.
Proof.
- iIntros {??} "(#? & Hγf & HΨ)". rewrite /sts_ctx /sts_ownS /sts_inv /sts_own.
- iInv N as {s} "[Hγ Hφ]"; iTimeless "Hγ".
- iCombine "Hγ" "Hγf" as "Hγ"; iDestruct (own_valid with "#Hγ") as %Hvalid.
+ iIntros (??) "(#? & Hγf & HΨ)". rewrite /sts_ctx /sts_ownS /sts_inv /sts_own.
+ iInv N as (s) "[Hγ Hφ]"; iTimeless "Hγ".
+ iCombine "Hγ" "Hγf" as "Hγ"; iDestruct (@own_valid with "#Hγ") 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.
iRevert "Hγ"; rewrite sts_op_auth_frag //; iIntros "Hγ".
iApply pvs_fsa_fsa; iApply fsa_wand_r; iSplitL "HΨ Hφ".
{ iApply "HΨ"; by iSplit. }
- iIntros {a}; iDestruct 1 as {s' T'} "(% & Hφ & HΨ)".
- iPvs (own_update with "Hγ") as "Hγ"; first eauto using sts_update_auth.
+ iIntros (a); iDestruct 1 as (s' T') "(% & Hφ & HΨ)".
+ iPvs (@own_update with "Hγ") as "Hγ"; first eauto using sts_update_auth.
iRevert "Hγ"; rewrite -sts_op_auth_frag_up; iIntros "[Hγ Hγf]".
iPvsIntro; iSplitL "Hφ Hγ"; last by iApply "HΨ".
iNext; iExists s'; by iFrame.
diff --git a/program_logic/viewshifts.v b/program_logic/viewshifts.v
index c8a39cf0d3e2f1dac5a4d41e8b165c98425a769b..b131eed655aada65465a81287a7533e48ce03cd7 100644
--- a/program_logic/viewshifts.v
+++ b/program_logic/viewshifts.v
@@ -42,7 +42,7 @@ Proof. by apply pvs_timeless. Qed.
Lemma vs_transitive E1 E2 E3 P Q R :
E2 ⊆ E1 ∪ E3 → (P ={E1,E2}=> Q) ∧ (Q ={E2,E3}=> R) ⊢ P ={E1,E3}=> R.
Proof.
- iIntros {?} "#[HvsP HvsQ] ! HP".
+ iIntros (?) "#[HvsP HvsQ] ! HP".
iPvs ("HvsP" with "HP") as "HQ"; first done. by iApply "HvsQ".
Qed.
@@ -63,7 +63,7 @@ Proof. iIntros "#Hvs ! [HP $]". by iApply "Hvs". Qed.
Lemma vs_mask_frame E1 E2 Ef P Q :
Ef ⊥ E1 ∪ E2 → (P ={E1,E2}=> Q) ⊢ P ={E1 ∪ Ef,E2 ∪ Ef}=> Q.
Proof.
- iIntros {?} "#Hvs ! HP". iApply pvs_mask_frame; auto. by iApply "Hvs".
+ iIntros (?) "#Hvs ! HP". iApply pvs_mask_frame; auto. by iApply "Hvs".
Qed.
Lemma vs_mask_frame' E Ef P Q : Ef ⊥ E → (P ={E}=> Q) ⊢ P ={E ∪ Ef}=> Q.
@@ -72,7 +72,7 @@ Proof. intros; apply vs_mask_frame; set_solver. Qed.
Lemma vs_inv N E P Q R :
nclose N ⊆ E → inv N R ★ (▷ R ★ P ={E ∖ nclose N}=> ▷ R ★ Q) ⊢ P ={E}=> Q.
Proof.
- iIntros {?} "#[? Hvs] ! HP". iInv N as "HR". iApply "Hvs". by iSplitL "HR".
+ iIntros (?) "#[? Hvs] ! HP". iInv N as "HR". iApply "Hvs". by iSplitL "HR".
Qed.
Lemma vs_alloc N P : â–· P ={N}=> inv N P.
diff --git a/program_logic/weakestpre.v b/program_logic/weakestpre.v
index c87539c436ddf75373b4c9501ea3c72c7f1a78b1..ab2d859b938a2cc26388a2422e7a5036c588c36a 100644
--- a/program_logic/weakestpre.v
+++ b/program_logic/weakestpre.v
@@ -160,20 +160,25 @@ Lemma wp_atomic E1 E2 e Φ :
E2 ⊆ E1 → atomic e →
(|={E1,E2}=> WP e @ E2 {{ v, |={E2,E1}=> Φ v }}) ⊢ WP e @ E1 {{ Φ }}.
Proof.
- rewrite wp_eq pvs_eq. intros ? He; split=> n r ? Hvs; constructor.
- eauto using atomic_not_val. intros k Ef σ1 rf ???.
- destruct (Hvs (S k) Ef σ1 rf) as (r'&Hwp&?); auto.
- destruct (wp_step_inv E2 Ef (pvs_def E2 E1 ∘ Φ) e k (S k) σ1 r' rf)
- as [Hsafe Hstep]; auto using atomic_not_val; [].
- split; [done|]=> e2 σ2 ef ?.
- destruct (Hstep e2 σ2 ef) as (r2&r2'&?&Hwp'&?); clear Hsafe Hstep; auto.
- destruct Hwp' as [k r2 v Hvs'|k r2 e2 Hgo];
- [|destruct (atomic_step e σ1 e2 σ2 ef); naive_solver].
- rewrite -pvs_eq in Hvs'. apply pvs_trans in Hvs';auto. rewrite pvs_eq in Hvs'.
- destruct (Hvs' k Ef σ2 (r2' ⋅ rf)) as (r3&[]); rewrite ?assoc; auto.
- exists r3, r2'; split_and?; last done.
- - by rewrite -assoc.
- - constructor; apply pvs_intro; auto.
+ rewrite wp_eq pvs_eq. intros ? He; split=> n r ? Hvs.
+ destruct (Some_dec (to_val e)) as [[v <-%of_to_val]|].
+ - eapply wp_pre_value. rewrite pvs_eq.
+ intros k Ef σ rf ???. destruct (Hvs k Ef σ rf) as (r'&Hwp&?); auto.
+ apply wp_value_inv in Hwp. rewrite pvs_eq in Hwp.
+ destruct (Hwp k Ef σ rf) as (r2'&HΦ&?); auto.
+ - apply wp_pre_step. done. intros k Ef σ1 rf ???.
+ destruct (Hvs (S k) Ef σ1 rf) as (r'&Hwp&?); auto.
+ destruct (wp_step_inv E2 Ef (pvs_def E2 E1 ∘ Φ) e k (S k) σ1 r' rf)
+ as [Hsafe Hstep]; auto; [].
+ split; [done|]=> e2 σ2 ef ?.
+ destruct (Hstep e2 σ2 ef) as (r2&r2'&?&Hwp'&?); clear Hsafe Hstep; auto.
+ destruct Hwp' as [k r2 v Hvs'|k r2 e2 Hgo];
+ [|destruct (He σ1 e2 σ2 ef); naive_solver].
+ rewrite -pvs_eq in Hvs'. apply pvs_trans in Hvs';auto. rewrite pvs_eq in Hvs'.
+ destruct (Hvs' k Ef σ2 (r2' ⋅ rf)) as (r3&[]); rewrite ?assoc; auto.
+ exists r3, r2'; split_and?; last done.
+ + by rewrite -assoc.
+ + constructor; apply pvs_intro; auto.
Qed.
Lemma wp_frame_r E e Φ R : WP e @ E {{ Φ }} ★ R ⊢ WP e @ E {{ v, Φ v ★ R }}.
Proof.
diff --git a/program_logic/weakestpre_fix.v b/program_logic/weakestpre_fix.v
index 93b8aa5d39140af09325bdf735cc9616d1a4d299..3642b021c1e913cdb7bcd0a7248bc1ce55bf90ea 100644
--- a/program_logic/weakestpre_fix.v
+++ b/program_logic/weakestpre_fix.v
@@ -13,11 +13,10 @@ wp on paper. We show that the two versions are equivalent. *)
Section def.
Context {Λ : language} {Σ : iFunctor}.
Local Notation iProp := (iProp Λ Σ).
-Local Notation coPsetC := (leibnizC (coPset)).
Program Definition wp_pre
- (wp : coPsetC -n> exprC Λ -n> (valC Λ -n> iProp) -n> iProp)
- (E : coPset) (e1 : expr Λ) (Φ : valC Λ -n> iProp) : iProp :=
+ (wp : coPset -c> expr Λ -c> (val Λ -c> iProp) -c> iProp) :
+ coPset -c> expr Λ -c> (val Λ -c> iProp) -c> iProp := λ E e1 Φ,
{| uPred_holds n r1 := ∀ k Ef σ1 rf,
0 ≤ k < n → E ⊥ Ef →
wsat (S k) (E ∪ Ef) σ1 (r1 ⋅ rf) →
@@ -46,49 +45,32 @@ Next Obligation.
Qed.
Next Obligation. repeat intro; eauto. Qed.
-Lemma wp_pre_contractive' n E e Φ1 Φ2 r
- (wp1 wp2 : coPsetC -n> exprC Λ -n> (valC Λ -n> iProp) -n> iProp) :
- (∀ i : nat, i < n → wp1 ≡{i}≡ wp2) → Φ1 ≡{n}≡ Φ2 →
- wp_pre wp1 E e Φ1 n r → wp_pre wp2 E e Φ2 n r.
+Local Instance pre_wp_contractive : Contractive wp_pre.
Proof.
- intros HI HΦ Hwp k Ef σ1 rf ???.
- destruct (Hwp k Ef σ1 rf) as [Hval Hstep]; auto.
- split.
- { intros v ?. destruct (Hval v) as (r2&?&?); auto.
- exists r2. split; [apply HΦ|]; auto. }
- intros ??. destruct Hstep as [Hred Hpstep]; auto.
- split; [done|]=> e2 σ2 ef ?.
- destruct (Hpstep e2 σ2 ef) as (r2&r2'&?&?&?); [done..|].
- exists r2, r2'; split_and?; auto.
- - apply HI with k; auto.
- assert (wp1 E e2 Φ2 ≡{n}≡ wp1 E e2 Φ1) as HwpΦ by (by rewrite HΦ).
- apply HwpΦ; auto.
- - destruct ef as [ef|]; simpl in *; last done.
- apply HI with k; auto.
-Qed.
-Instance wp_pre_ne n wp E e : Proper (dist n ==> dist n) (wp_pre wp E e).
-Proof.
- split; split;
- eapply wp_pre_contractive'; eauto using dist_le, (symmetry (R:=dist _)).
-Qed.
-
-Definition wp_preC
- (wp : coPsetC -n> exprC Λ -n> (valC Λ -n> iProp) -n> iProp) :
- coPsetC -n> exprC Λ -n> (valC Λ -n> iProp) -n> iProp :=
- CofeMor (λ E : coPsetC, CofeMor (λ e : exprC Λ, CofeMor (wp_pre wp E e))).
-
-Local Instance pre_wp_contractive : Contractive wp_preC.
-Proof.
- split; split; eapply wp_pre_contractive'; auto using (symmetry (R:=dist _)).
+ assert (∀ n E e Φ r
+ (wp1 wp2 : coPset -c> expr Λ -c> (val Λ -c> iProp) -c> iProp),
+ (∀ i : nat, i < n → wp1 ≡{i}≡ wp2) →
+ wp_pre wp1 E e Φ n r → wp_pre wp2 E e Φ n r) as help.
+ { intros n E e Φ r wp1 wp2 HI Hwp k Ef σ1 rf ???.
+ destruct (Hwp k Ef σ1 rf) as [Hval Hstep]; auto.
+ split; first done.
+ intros ??. destruct Hstep as [Hred Hpstep]; auto.
+ split; [done|]=> e2 σ2 ef ?.
+ destruct (Hpstep e2 σ2 ef) as (r2&r2'&?&?&?); [done..|].
+ exists r2, r2'; split_and?; auto.
+ - apply HI with k; auto.
+ - destruct ef as [ef|]; simpl in *; last done.
+ apply HI with k; auto. }
+ split; split; eapply help; auto using (symmetry (R:=dist _)).
Qed.
-Definition wp_fix : coPsetC -n> exprC Λ -n> (valC Λ -n> iProp) -n> iProp :=
- fixpoint wp_preC.
+Definition wp_fix : coPset → expr Λ → (val Λ → iProp) → iProp :=
+ fixpoint wp_pre.
-Lemma wp_fix_unfold E e Φ : wp_fix E e Φ ⊣⊢ wp_preC wp_fix E e Φ.
-Proof. by rewrite /wp_fix -fixpoint_unfold. Qed.
+Lemma wp_fix_unfold E e Φ : wp_fix E e Φ ⊣⊢ wp_pre wp_fix E e Φ.
+Proof. apply (fixpoint_unfold wp_pre). Qed.
-Lemma wp_fix_correct E e (Φ : valC Λ -n> iProp) : wp_fix E e Φ ⊣⊢ wp E e Φ.
+Lemma wp_fix_correct E e (Φ : val Λ → iProp) : wp_fix E e Φ ⊣⊢ wp E e Φ.
Proof.
split=> n r Hr. rewrite wp_eq /wp_def {2}/uPred_holds.
split; revert r E e Φ Hr.
diff --git a/program_logic/wsat.v b/program_logic/wsat.v
index 650238ddd5f910f70db52d1ad6c6e925b097d6a4..53f94b2d2ce145bbfbaab19e7ef5738e67b6fb82 100644
--- a/program_logic/wsat.v
+++ b/program_logic/wsat.v
@@ -1,6 +1,7 @@
-From iris.prelude Require Export co_pset.
+From iris.prelude Require Export coPset.
From iris.program_logic Require Export model.
From iris.algebra Require Export cmra_big_op cmra_tactics.
+From iris.algebra Require Import updates.
Local Hint Extern 10 (_ ≤ _) => omega.
Local Hint Extern 10 (✓{_} _) => solve_validN.
Local Hint Extern 1 (✓{_} gst _) => apply gst_validN.
@@ -51,17 +52,17 @@ Lemma wsat_le n n' E σ r : wsat n E σ r → n' ≤ n → wsat n' E σ r.
Proof.
destruct n as [|n], n' as [|n']; simpl; try by (auto with lia).
intros [rs [Hval Hσ HE Hwld]] ?; exists rs; constructor; auto.
- intros i P ? HiP; destruct (wld (r â‹… big_opM rs) !! i) as [P'|] eqn:HP';
- [apply (inj Some) in HiP|inversion_clear HiP].
+ intros i P ? (P'&HiP&HP')%dist_Some_inv_r'.
+ destruct (to_agree_uninj (S n) P') as [laterP' HlaterP'].
+ { apply (lookup_validN_Some _ (wld (r â‹… big_opM rs)) i); rewrite ?HiP; auto. }
assert (P' ≡{S n}≡ to_agree $ Next $ iProp_unfold $
- iProp_fold $ later_car $ P' (S n)) as HPiso.
- { rewrite iProp_unfold_fold later_eta to_agree_car //.
- apply (lookup_validN_Some _ (wld (r â‹… big_opM rs)) i); rewrite ?HP'; auto. }
- assert (P ≡{n'}≡ iProp_fold (later_car (P' (S n)))) as HPP'.
+ iProp_fold $ later_car $ laterP') as HPiso.
+ { by rewrite iProp_unfold_fold later_eta HlaterP'. }
+ assert (P ≡{n'}≡ iProp_fold (later_car laterP')) as HPP'.
{ apply (inj iProp_unfold), (inj Next), (inj to_agree).
- by rewrite -HiP -(dist_le _ _ _ _ HPiso). }
- destruct (Hwld i (iProp_fold (later_car (P' (S n))))) as (r'&?&?); auto.
- { by rewrite HP' -HPiso. }
+ by rewrite HP' -(dist_le _ _ _ _ HPiso). }
+ destruct (Hwld i (iProp_fold (later_car laterP'))) as (r'&?&?); auto.
+ { by rewrite HiP -HPiso. }
assert (✓{S n} r') by (apply (big_opM_lookup_valid _ rs i); auto).
exists r'; split; [done|]. apply HPP', uPred_closed with n; auto.
Qed.
diff --git a/proofmode/classes.v b/proofmode/classes.v
index b8d444380cc0e820727c3090cb7c5344bf3c6388..50fdd54b659a0806122fbc5ef6221b167a0e6fb1 100644
--- a/proofmode/classes.v
+++ b/proofmode/classes.v
@@ -52,7 +52,7 @@ Global Arguments into_later _ _ {_}.
Class FromLater (P Q : uPred M) := from_later : ▷ Q ⊢ P.
Global Arguments from_later _ _ {_}.
-Global Instance into_later_fallthrough P : IntoLater P P | 1000.
+Global Instance into_later_default P : IntoLater P P | 1000.
Proof. apply later_intro. Qed.
Global Instance into_later_later P : IntoLater (â–· P) P.
Proof. done. Qed.
@@ -222,7 +222,7 @@ Global Instance make_sep_true_l P : MakeSep True P P.
Proof. by rewrite /MakeSep left_id. Qed.
Global Instance make_sep_true_r P : MakeSep P True P.
Proof. by rewrite /MakeSep right_id. Qed.
-Global Instance make_sep_fallthrough P Q : MakeSep P Q (P ★ Q) | 100.
+Global Instance make_sep_default P Q : MakeSep P Q (P ★ Q) | 100.
Proof. done. Qed.
Global Instance frame_sep_l R P1 P2 Q Q' :
Frame R P1 Q → MakeSep Q P2 Q' → Frame R (P1 ★ P2) Q' | 9.
@@ -236,7 +236,7 @@ Global Instance make_and_true_l P : MakeAnd True P P.
Proof. by rewrite /MakeAnd left_id. Qed.
Global Instance make_and_true_r P : MakeAnd P True P.
Proof. by rewrite /MakeAnd right_id. Qed.
-Global Instance make_and_fallthrough P Q : MakeSep P Q (P ★ Q) | 100.
+Global Instance make_and_default P Q : MakeSep P Q (P ★ Q) | 100.
Proof. done. Qed.
Global Instance frame_and_l R P1 P2 Q Q' :
Frame R P1 Q → MakeAnd Q P2 Q' → Frame R (P1 ∧ P2) Q' | 9.
@@ -250,16 +250,23 @@ Global Instance make_or_true_l P : MakeOr True P True.
Proof. by rewrite /MakeOr left_absorb. Qed.
Global Instance make_or_true_r P : MakeOr P True True.
Proof. by rewrite /MakeOr right_absorb. Qed.
-Global Instance make_or_fallthrough P Q : MakeOr P Q (P ∨ Q) | 100.
+Global Instance make_or_default P Q : MakeOr P Q (P ∨ Q) | 100.
Proof. done. Qed.
Global Instance frame_or R P1 P2 Q1 Q2 Q :
Frame R P1 Q1 → Frame R P2 Q2 → MakeOr Q1 Q2 Q → Frame R (P1 ∨ P2) Q.
Proof. rewrite /Frame /MakeOr => <- <- <-. by rewrite -sep_or_l. Qed.
+Global Instance frame_wand R P1 P2 Q2 :
+ Frame R P2 Q2 → Frame R (P1 -★ P2) (P1 -★ Q2).
+Proof.
+ rewrite /Frame=> ?. apply wand_intro_l.
+ by rewrite assoc (comm _ P1) -assoc wand_elim_r.
+Qed.
+
Class MakeLater (P lP : uPred M) := make_later : ▷ P ⊣⊢ lP.
Global Instance make_later_true : MakeLater True True.
Proof. by rewrite /MakeLater later_True. Qed.
-Global Instance make_later_fallthrough P : MakeLater P (â–· P) | 100.
+Global Instance make_later_default P : MakeLater P (â–· P) | 100.
Proof. done. Qed.
Global Instance frame_later R P Q Q' :
@@ -294,10 +301,6 @@ Global Arguments from_exist {_} _ _ {_}.
Global Instance from_exist_exist {A} (Φ: A → uPred M): FromExist (∃ a, Φ a) Φ.
Proof. done. Qed.
-Lemma tac_exist {A} Δ P (Φ : A → uPred M) :
- FromExist P Φ → (∃ a, Δ ⊢ Φ a) → Δ ⊢ P.
-Proof. intros ? [a ?]. rewrite -(from_exist P). eauto using exist_intro'. Qed.
-
Class IntoExist {A} (P : uPred M) (Φ : A → uPred M) :=
into_exist : P ⊢ ∃ x, Φ x.
Global Arguments into_exist {_} _ _ {_}.
@@ -309,4 +312,7 @@ Proof. rewrite /IntoExist=> HP ?. by rewrite HP later_exist. Qed.
Global Instance into_exist_always {A} P (Φ : A → uPred M) :
IntoExist P Φ → IntoExist (□ P) (λ a, □ (Φ a))%I.
Proof. rewrite /IntoExist=> HP. by rewrite HP always_exist. Qed.
+
+Class TimelessElim (Q : uPred M) :=
+ timeless_elim `{!TimelessP P} : ▷ P ★ (P -★ Q) ⊢ Q.
End classes.
diff --git a/proofmode/coq_tactics.v b/proofmode/coq_tactics.v
index e35620930014910c450599f4688884f1663317ff..36f52d72a7ec20f72712fb6ad7cd31d7a0b472fe 100644
--- a/proofmode/coq_tactics.v
+++ b/proofmode/coq_tactics.v
@@ -375,6 +375,16 @@ Proof.
by rewrite right_id always_and_sep_l' wand_elim_r HQ.
Qed.
+Lemma tac_timeless Δ Δ' i p P Q :
+ TimelessElim Q →
+ envs_lookup i Δ = Some (p, ▷ P)%I → TimelessP P →
+ envs_simple_replace i p (Esnoc Enil i P) Δ = Some Δ' →
+ (Δ' ⊢ Q) → Δ ⊢ Q.
+Proof.
+ intros ???? HQ. rewrite envs_simple_replace_sound //; simpl.
+ by rewrite always_if_later right_id HQ timeless_elim.
+Qed.
+
(** * Always *)
Lemma tac_always_intro Δ Q : envs_persistent Δ = true → (Δ ⊢ Q) → Δ ⊢ □ Q.
Proof. intros. by apply: always_intro. Qed.
@@ -453,7 +463,7 @@ Qed.
Class IntoAssert (P : uPred M) (Q : uPred M) (R : uPred M) :=
into_assert : R ★ (P -★ Q) ⊢ Q.
Global Arguments into_assert _ _ _ {_}.
-Lemma into_assert_fallthrough P Q : IntoAssert P Q P.
+Lemma into_assert_default P Q : IntoAssert P Q P.
Proof. by rewrite /IntoAssert wand_elim_r. Qed.
Lemma tac_specialize_assert Δ Δ' Δ1 Δ2' j q lr js R P1 P2 P1' Q :
@@ -719,6 +729,10 @@ Lemma tac_forall_revert {A} Δ (Φ : A → uPred M) :
Proof. intros HΔ a. by rewrite HΔ (forall_elim a). Qed.
(** * Existential *)
+Lemma tac_exist {A} Δ P (Φ : A → uPred M) :
+ FromExist P Φ → (∃ a, Δ ⊢ Φ a) → Δ ⊢ P.
+Proof. intros ? [a ?]. rewrite -(from_exist P). eauto using exist_intro'. Qed.
+
Lemma tac_exist_destruct {A} Δ i p j P (Φ : A → uPred M) Q :
envs_lookup i Δ = Some (p, P) → IntoExist P Φ →
(∀ a, ∃ Δ',
diff --git a/proofmode/invariants.v b/proofmode/invariants.v
index bb080ac1b7dfabed64fb08234b206e2a2983c0ff..46fb3cf1e01432776d1a73f861df26783c7da0b2 100644
--- a/proofmode/invariants.v
+++ b/proofmode/invariants.v
@@ -38,7 +38,7 @@ Tactic Notation "iInvCore" constr(N) "as" constr(H) :=
eapply tac_inv_fsa with _ _ _ _ N H _ _;
[let P := match goal with |- IsFSA ?P _ _ _ _ => P end in
apply _ || fail "iInv: cannot viewshift in goal" P
- |try fast_done (* atomic *)
+ |trivial with fsaV
|solve_ndisj
|iAssumption || fail "iInv: invariant" N "not found"
|env_cbv; reflexivity
@@ -46,25 +46,25 @@ Tactic Notation "iInvCore" constr(N) "as" constr(H) :=
Tactic Notation "iInv" constr(N) "as" constr(pat) :=
let H := iFresh in iInvCore N as H; last iDestruct H as pat.
-Tactic Notation "iInv" constr(N) "as" "{" simple_intropattern(x1) "}"
+Tactic Notation "iInv" constr(N) "as" "(" simple_intropattern(x1) ")"
constr(pat) :=
- let H := iFresh in iInvCore N as H; last iDestruct H as {x1} pat.
-Tactic Notation "iInv" constr(N) "as" "{" simple_intropattern(x1)
- simple_intropattern(x2) "}" constr(pat) :=
- let H := iFresh in iInvCore N as H; last iDestruct H as {x1 x2} pat.
-Tactic Notation "iInv" constr(N) "as" "{" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) "}" constr(pat) :=
- let H := iFresh in iInvCore N as H; last iDestruct H as {x1 x2 x3} pat.
-Tactic Notation "iInv" constr(N) "as" "{" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) "}"
+ let H := iFresh in iInvCore N as H; last iDestruct H as (x1) pat.
+Tactic Notation "iInv" constr(N) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) ")" constr(pat) :=
+ let H := iFresh in iInvCore N as H; last iDestruct H as (x1 x2) pat.
+Tactic Notation "iInv" constr(N) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) ")" constr(pat) :=
+ let H := iFresh in iInvCore N as H; last iDestruct H as (x1 x2 x3) pat.
+Tactic Notation "iInv" constr(N) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")"
constr(pat) :=
- let H := iFresh in iInvCore N as H; last iDestruct H as {x1 x2 x3 x4} pat.
+ let H := iFresh in iInvCore N as H; last iDestruct H as (x1 x2 x3 x4) pat.
Tactic Notation "iInvCore>" constr(N) "as" constr(H) :=
eapply tac_inv_fsa_timeless with _ _ _ _ N H _ _;
[let P := match goal with |- IsFSA ?P _ _ _ _ => P end in
apply _ || fail "iInv: cannot viewshift in goal" P
- |try fast_done (* atomic *)
+ |trivial with fsaV
|solve_ndisj
|iAssumption || fail "iOpenInv: invariant" N "not found"
|let P := match goal with |- TimelessP ?P => P end in
@@ -74,16 +74,16 @@ Tactic Notation "iInvCore>" constr(N) "as" constr(H) :=
Tactic Notation "iInv>" constr(N) "as" constr(pat) :=
let H := iFresh in iInvCore> N as H; last iDestruct H as pat.
-Tactic Notation "iInv>" constr(N) "as" "{" simple_intropattern(x1) "}"
+Tactic Notation "iInv>" constr(N) "as" "(" simple_intropattern(x1) ")"
constr(pat) :=
- let H := iFresh in iInvCore> N as H; last iDestruct H as {x1} pat.
-Tactic Notation "iInv>" constr(N) "as" "{" simple_intropattern(x1)
- simple_intropattern(x2) "}" constr(pat) :=
- let H := iFresh in iInvCore> N as H; last iDestruct H as {x1 x2} pat.
-Tactic Notation "iInv>" constr(N) "as" "{" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) "}" constr(pat) :=
- let H := iFresh in iInvCore> N as H; last iDestruct H as {x1 x2 x3} pat.
-Tactic Notation "iInv>" constr(N) "as" "{" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) "}"
+ let H := iFresh in iInvCore> N as H; last iDestruct H as (x1) pat.
+Tactic Notation "iInv>" constr(N) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) ")" constr(pat) :=
+ let H := iFresh in iInvCore> N as H; last iDestruct H as (x1 x2) pat.
+Tactic Notation "iInv>" constr(N) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) ")" constr(pat) :=
+ let H := iFresh in iInvCore> N as H; last iDestruct H as (x1 x2 x3) pat.
+Tactic Notation "iInv>" constr(N) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")"
constr(pat) :=
- let H := iFresh in iInvCore> N as H; last iDestruct H as {x1 x2 x3 x4} pat.
+ let H := iFresh in iInvCore> N as H; last iDestruct H as (x1 x2 x3 x4) pat.
diff --git a/proofmode/pviewshifts.v b/proofmode/pviewshifts.v
index 20de4de2e2a8fd9684c974273d1e494b5462e4dc..df3203323e96350820f988dab219d639f553fec6 100644
--- a/proofmode/pviewshifts.v
+++ b/proofmode/pviewshifts.v
@@ -30,6 +30,12 @@ Global Instance into_wand_pvs E1 E2 R P Q :
IntoWand R P Q → IntoWand R (|={E1,E2}=> P) (|={E1,E2}=> Q) | 100.
Proof. rewrite /IntoWand=>->. apply wand_intro_l. by rewrite pvs_wand_r. Qed.
+Global Instance timeless_elim_pvs E1 E2 Q : TimelessElim (|={E1,E2}=> Q).
+Proof.
+ intros P ?. rewrite (pvs_timeless E1 P) pvs_frame_r.
+ by rewrite wand_elim_r pvs_trans; last set_solver.
+Qed.
+
Class IsFSA {A} (P : iProp Λ Σ) (E : coPset)
(fsa : FSA Λ Σ A) (fsaV : Prop) (Φ : A → iProp Λ Σ) := {
is_fsa : P ⊣⊢ fsa E Φ;
@@ -48,6 +54,12 @@ Global Instance to_assert_pvs {A} P Q E (fsa : FSA Λ Σ A) fsaV Φ :
Proof.
intros. by rewrite /IntoAssert pvs_frame_r wand_elim_r (is_fsa Q) fsa_pvs_fsa.
Qed.
+Global Instance timeless_elim_fsa {A} Q E (fsa : FSA Λ Σ A) fsaV Φ :
+ IsFSA Q E fsa fsaV Φ → TimelessElim Q.
+Proof.
+ intros ? P ?. rewrite (is_fsa Q) -{2}fsa_pvs_fsa.
+ by rewrite (pvs_timeless _ P) pvs_frame_r wand_elim_r.
+Qed.
Lemma tac_pvs_intro Δ E1 E2 Q : E1 = E2 → (Δ ⊢ Q) → Δ ⊢ |={E1,E2}=> Q.
Proof. intros -> ->. apply pvs_intro. Qed.
@@ -74,26 +86,6 @@ Proof.
intros ? -> ??. rewrite (is_fsa Q) -fsa_pvs_fsa.
eapply tac_pvs_elim; set_solver.
Qed.
-
-Lemma tac_pvs_timeless Δ Δ' E1 E2 i p P Q :
- envs_lookup i Δ = Some (p, ▷ P)%I → TimelessP P →
- envs_simple_replace i p (Esnoc Enil i P) Δ = Some Δ' →
- (Δ' ={E1,E2}=> Q) → Δ ={E1,E2}=> Q.
-Proof.
- intros ??? HQ. rewrite envs_simple_replace_sound //; simpl.
- rewrite always_if_later (pvs_timeless E1 (â–¡?_ P)%I) pvs_frame_r.
- by rewrite right_id wand_elim_r HQ pvs_trans; last set_solver.
-Qed.
-
-Lemma tac_pvs_timeless_fsa {A} (fsa : FSA Λ Σ A) fsaV Δ Δ' E i p P Q Φ :
- IsFSA Q E fsa fsaV Φ →
- envs_lookup i Δ = Some (p, ▷ P)%I → TimelessP P →
- envs_simple_replace i p (Esnoc Enil i P) Δ = Some Δ' →
- (Δ' ⊢ fsa E Φ) → Δ ⊢ Q.
-Proof.
- intros ????. rewrite (is_fsa Q) -fsa_pvs_fsa.
- eauto using tac_pvs_timeless.
-Qed.
End pvs.
Tactic Notation "iPvsIntro" := apply tac_pvs_intro; first try fast_done.
@@ -124,63 +116,42 @@ Tactic Notation "iPvs" open_constr(H) :=
iDestructHelp H as (fun H => iPvsCore H; last iDestruct H as "?").
Tactic Notation "iPvs" open_constr(H) "as" constr(pat) :=
iDestructHelp H as (fun H => iPvsCore H; last iDestruct H as pat).
-Tactic Notation "iPvs" open_constr(H) "as" "{" simple_intropattern(x1) "}"
+Tactic Notation "iPvs" open_constr(H) "as" "(" simple_intropattern(x1) ")"
constr(pat) :=
- iDestructHelp H as (fun H => iPvsCore H; last iDestruct H as { x1 } pat).
-Tactic Notation "iPvs" open_constr(H) "as" "{" simple_intropattern(x1)
- simple_intropattern(x2) "}" constr(pat) :=
- iDestructHelp H as (fun H => iPvsCore H; last iDestruct H as { x1 x2 } pat).
-Tactic Notation "iPvs" open_constr(H) "as" "{" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) "}" constr(pat) :=
- iDestructHelp H as (fun H => iPvsCore H; last iDestruct H as { x1 x2 x3 } pat).
-Tactic Notation "iPvs" open_constr(H) "as" "{" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) "}"
+ iDestructHelp H as (fun H => iPvsCore H; last iDestruct H as ( x1 ) pat).
+Tactic Notation "iPvs" open_constr(H) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) ")" constr(pat) :=
+ iDestructHelp H as (fun H => iPvsCore H; last iDestruct H as ( x1 x2 ) pat).
+Tactic Notation "iPvs" open_constr(H) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) ")" constr(pat) :=
+ iDestructHelp H as (fun H => iPvsCore H; last iDestruct H as ( x1 x2 x3 ) pat).
+Tactic Notation "iPvs" open_constr(H) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")"
constr(pat) :=
iDestructHelp H as (fun H =>
- iPvsCore H; last iDestruct H as { x1 x2 x3 x4 } pat).
-Tactic Notation "iPvs" open_constr(H) "as" "{" simple_intropattern(x1)
+ iPvsCore H; last iDestruct H as ( x1 x2 x3 x4 ) pat).
+Tactic Notation "iPvs" open_constr(H) "as" "(" simple_intropattern(x1)
simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) "}" constr(pat) :=
+ simple_intropattern(x5) ")" constr(pat) :=
iDestructHelp H as (fun H =>
- iPvsCore H; last iDestruct H as { x1 x2 x3 x4 x5 } pat).
-Tactic Notation "iPvs" open_constr(H) "as" "{" simple_intropattern(x1)
+ iPvsCore H; last iDestruct H as ( x1 x2 x3 x4 x5 ) pat).
+Tactic Notation "iPvs" open_constr(H) "as" "(" simple_intropattern(x1)
simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) "}" constr(pat) :=
+ simple_intropattern(x5) simple_intropattern(x6) ")" constr(pat) :=
iDestructHelp H as (fun H =>
- iPvsCore H; last iDestruct H as { x1 x2 x3 x4 x5 x6 } pat).
-Tactic Notation "iPvs" open_constr(H) "as" "{" simple_intropattern(x1)
+ iPvsCore H; last iDestruct H as ( x1 x2 x3 x4 x5 x6 ) pat).
+Tactic Notation "iPvs" open_constr(H) "as" "(" simple_intropattern(x1)
simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7) "}"
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7) ")"
constr(pat) :=
iDestructHelp H as (fun H =>
- iPvsCore H; last iDestruct H as { x1 x2 x3 x4 x5 x6 x7 } pat).
-Tactic Notation "iPvs" open_constr(H) "as" "{" simple_intropattern(x1)
+ iPvsCore H; last iDestruct H as ( x1 x2 x3 x4 x5 x6 x7 ) pat).
+Tactic Notation "iPvs" open_constr(H) "as" "(" simple_intropattern(x1)
simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
- simple_intropattern(x8) "}" constr(pat) :=
+ simple_intropattern(x8) ")" constr(pat) :=
iDestructHelp H as (fun H =>
- iPvsCore H; last iDestruct H as { x1 x2 x3 x4 x5 x6 x7 x8 } pat).
-
-Tactic Notation "iTimeless" constr(H) :=
- match goal with
- | |- _ ⊢ |={_,_}=> _ =>
- eapply tac_pvs_timeless with _ H _ _;
- [env_cbv; reflexivity || fail "iTimeless:" H "not found"
- |let P := match goal with |- TimelessP ?P => P end in
- apply _ || fail "iTimeless: " P "not timeless"
- |env_cbv; reflexivity|simpl]
- | |- _ =>
- eapply tac_pvs_timeless_fsa with _ _ _ _ H _ _ _;
- [let P := match goal with |- IsFSA ?P _ _ _ _ => P end in
- apply _ || fail "iTimeless: " P "not a pvs"
- |env_cbv; reflexivity || fail "iTimeless:" H "not found"
- |let P := match goal with |- TimelessP ?P => P end in
- apply _ || fail "iTimeless: " P "not timeless"
- |env_cbv; reflexivity|simpl]
- end.
-
-Tactic Notation "iTimeless" constr(H) "as" constr(Hs) :=
- iTimeless H; iDestruct H as Hs.
+ iPvsCore H; last iDestruct H as ( x1 x2 x3 x4 x5 x6 x7 x8 ) pat).
Hint Extern 2 (of_envs _ ⊢ _) =>
match goal with |- _ ⊢ (|={_}=> _)%I => iPvsIntro end.
diff --git a/proofmode/sts.v b/proofmode/sts.v
index c0c469b06ba1e2251d26347b869477b95de2aa37..60dfe21befb38c98b0d09be253834313b4c5f2f5 100644
--- a/proofmode/sts.v
+++ b/proofmode/sts.v
@@ -38,7 +38,7 @@ Tactic Notation "iSts" constr(H) "as"
end;
[let P := match goal with |- IsFSA ?P _ _ _ _ => P end in
apply _ || fail "iSts: cannot viewshift in goal" P
- |try fast_done (* atomic *)
+ |auto with fsaV
|iAssumptionCore || fail "iSts:" H "not found"
|iAssumption || fail "iSts: invariant not found"
|solve_ndisj
diff --git a/proofmode/tactics.v b/proofmode/tactics.v
index 63e04aed97486700d750fa3dc2233740f2d4083e..3901386c43ad909a114baeac44a5608ad5a6b1fd 100644
--- a/proofmode/tactics.v
+++ b/proofmode/tactics.v
@@ -194,7 +194,7 @@ Local Tactic Notation "iSpecializePat" constr(H) constr(pat) :=
[env_cbv; reflexivity || fail "iSpecialize:" H1 "not found"
|solve_to_wand H1
|match k with
- | GoalStd => apply into_assert_fallthrough
+ | GoalStd => apply into_assert_default
| GoalPvs => apply _ || fail "iSpecialize: cannot generate pvs goal"
end
|env_cbv; reflexivity || fail "iSpecialize:" Hs "not found"
@@ -274,48 +274,48 @@ Tactic Notation "iRevert" constr(Hs) :=
end in
let Hs := words Hs in go Hs.
-Tactic Notation "iRevert" "{" ident(x1) "}" :=
+Tactic Notation "iRevert" "(" ident(x1) ")" :=
iForallRevert x1.
-Tactic Notation "iRevert" "{" ident(x1) ident(x2) "}" :=
- iForallRevert x2; iRevert { x1 }.
-Tactic Notation "iRevert" "{" ident(x1) ident(x2) ident(x3) "}" :=
- iForallRevert x3; iRevert { x1 x2 }.
-Tactic Notation "iRevert" "{" ident(x1) ident(x2) ident(x3) ident(x4) "}" :=
- iForallRevert x4; iRevert { x1 x2 x3 }.
-Tactic Notation "iRevert" "{" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) "}" :=
- iForallRevert x5; iRevert { x1 x2 x3 x4 }.
-Tactic Notation "iRevert" "{" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) "}" :=
- iForallRevert x6; iRevert { x1 x2 x3 x4 x5 }.
-Tactic Notation "iRevert" "{" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) ident(x7) "}" :=
- iForallRevert x7; iRevert { x1 x2 x3 x4 x5 x6 }.
-Tactic Notation "iRevert" "{" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) ident(x7) ident(x8) "}" :=
- iForallRevert x8; iRevert { x1 x2 x3 x4 x5 x6 x7 }.
-
-Tactic Notation "iRevert" "{" ident(x1) "}" constr(Hs) :=
- iRevert Hs; iRevert { x1 }.
-Tactic Notation "iRevert" "{" ident(x1) ident(x2) "}" constr(Hs) :=
- iRevert Hs; iRevert { x1 x2 }.
-Tactic Notation "iRevert" "{" ident(x1) ident(x2) ident(x3) "}" constr(Hs) :=
- iRevert Hs; iRevert { x1 x2 x3 }.
-Tactic Notation "iRevert" "{" ident(x1) ident(x2) ident(x3) ident(x4) "}"
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ")" :=
+ iForallRevert x2; iRevert ( x1 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ")" :=
+ iForallRevert x3; iRevert ( x1 x2 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4) ")" :=
+ iForallRevert x4; iRevert ( x1 x2 x3 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ")" :=
+ iForallRevert x5; iRevert ( x1 x2 x3 x4 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ")" :=
+ iForallRevert x6; iRevert ( x1 x2 x3 x4 x5 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ident(x7) ")" :=
+ iForallRevert x7; iRevert ( x1 x2 x3 x4 x5 x6 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ident(x7) ident(x8) ")" :=
+ iForallRevert x8; iRevert ( x1 x2 x3 x4 x5 x6 x7 ).
+
+Tactic Notation "iRevert" "(" ident(x1) ")" constr(Hs) :=
+ iRevert Hs; iRevert ( x1 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ")" constr(Hs) :=
+ iRevert Hs; iRevert ( x1 x2 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ")" constr(Hs) :=
+ iRevert Hs; iRevert ( x1 x2 x3 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4) ")"
constr(Hs) :=
- iRevert Hs; iRevert { x1 x2 x3 x4 }.
-Tactic Notation "iRevert" "{" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) "}" constr(Hs) :=
- iRevert Hs; iRevert { x1 x2 x3 x4 x5 }.
-Tactic Notation "iRevert" "{" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) "}" constr(Hs) :=
- iRevert Hs; iRevert { x1 x2 x3 x4 x5 x6 }.
-Tactic Notation "iRevert" "{" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) ident(x7) "}" constr(Hs) :=
- iRevert Hs; iRevert { x1 x2 x3 x4 x5 x6 x7 }.
-Tactic Notation "iRevert" "{" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) ident(x7) ident(x8) "}" constr(Hs) :=
- iRevert Hs; iRevert { x1 x2 x3 x4 x5 x6 x7 x8 }.
+ iRevert Hs; iRevert ( x1 x2 x3 x4 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ")" constr(Hs) :=
+ iRevert Hs; iRevert ( x1 x2 x3 x4 x5 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ")" constr(Hs) :=
+ iRevert Hs; iRevert ( x1 x2 x3 x4 x5 x6 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ident(x7) ")" constr(Hs) :=
+ iRevert Hs; iRevert ( x1 x2 x3 x4 x5 x6 x7 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ident(x7) ident(x8) ")" constr(Hs) :=
+ iRevert Hs; iRevert ( x1 x2 x3 x4 x5 x6 x7 x8 ).
(** * Disjunction *)
Tactic Notation "iLeft" :=
@@ -457,37 +457,37 @@ Local Tactic Notation "iDestructHyp" constr(H) "as" constr(pat) :=
end
in let pat := intro_pat.parse_one pat in go H pat.
-Local Tactic Notation "iDestructHyp" constr(H) "as" "{" simple_intropattern(x1) "}"
+Local Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1) ")"
constr(pat) :=
iExistDestruct H as x1 H; iDestructHyp H as @ pat.
-Local Tactic Notation "iDestructHyp" constr(H) "as" "{" simple_intropattern(x1)
- simple_intropattern(x2) "}" constr(pat) :=
- iExistDestruct H as x1 H; iDestructHyp H as { x2 } pat.
-Local Tactic Notation "iDestructHyp" constr(H) "as" "{" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) "}" constr(pat) :=
- iExistDestruct H as x1 H; iDestructHyp H as { x2 x3 } pat.
-Local Tactic Notation "iDestructHyp" constr(H) "as" "{" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) "}"
+Local Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) ")" constr(pat) :=
+ iExistDestruct H as x1 H; iDestructHyp H as ( x2 ) pat.
+Local Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) ")" constr(pat) :=
+ iExistDestruct H as x1 H; iDestructHyp H as ( x2 x3 ) pat.
+Local Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")"
constr(pat) :=
- iExistDestruct H as x1 H; iDestructHyp H as { x2 x3 x4 } pat.
-Local Tactic Notation "iDestructHyp" constr(H) "as" "{" simple_intropattern(x1)
+ iExistDestruct H as x1 H; iDestructHyp H as ( x2 x3 x4 ) pat.
+Local Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) "}" constr(pat) :=
- iExistDestruct H as x1 H; iDestructHyp H as { x2 x3 x4 x5 } pat.
-Local Tactic Notation "iDestructHyp" constr(H) "as" "{" simple_intropattern(x1)
+ simple_intropattern(x5) ")" constr(pat) :=
+ iExistDestruct H as x1 H; iDestructHyp H as ( x2 x3 x4 x5 ) pat.
+Local Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) "}" constr(pat) :=
- iExistDestruct H as x1 H; iDestructHyp H as { x2 x3 x4 x5 x6 } pat.
-Local Tactic Notation "iDestructHyp" constr(H) "as" "{" simple_intropattern(x1)
+ simple_intropattern(x5) simple_intropattern(x6) ")" constr(pat) :=
+ iExistDestruct H as x1 H; iDestructHyp H as ( x2 x3 x4 x5 x6 ) pat.
+Local Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7) "}"
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7) ")"
constr(pat) :=
- iExistDestruct H as x1 H; iDestructHyp H as { x2 x3 x4 x5 x6 x7 } pat.
-Local Tactic Notation "iDestructHyp" constr(H) "as" "{" simple_intropattern(x1)
+ iExistDestruct H as x1 H; iDestructHyp H as ( x2 x3 x4 x5 x6 x7 ) pat.
+Local Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
- simple_intropattern(x8) "}" constr(pat) :=
- iExistDestruct H as x1 H; iDestructHyp H as { x2 x3 x4 x5 x6 x7 x8 } pat.
+ simple_intropattern(x8) ")" constr(pat) :=
+ iExistDestruct H as x1 H; iDestructHyp H as ( x2 x3 x4 x5 x6 x7 x8 ) pat.
(** * Always *)
Tactic Notation "iAlways":=
@@ -501,8 +501,17 @@ Tactic Notation "iNext":=
|let P := match goal with |- FromLater ?P _ => P end in
apply _ || fail "iNext:" P "does not contain laters"|].
+Tactic Notation "iTimeless" constr(H) :=
+ eapply tac_timeless with _ H _ _;
+ [let Q := match goal with |- TimelessElim ?Q => Q end in
+ apply _ || fail "iTimeless: cannot eliminate later in goal" Q
+ |env_cbv; reflexivity || fail "iTimeless:" H "not found"
+ |let P := match goal with |- TimelessP ?P => P end in
+ apply _ || fail "iTimeless: " P "not timeless"
+ |env_cbv; reflexivity|].
+
(** * Introduction tactic *)
-Local Tactic Notation "iIntro" "{" simple_intropattern(x) "}" := first
+Local Tactic Notation "iIntro" "(" simple_intropattern(x) ")" := first
[ (* (∀ _, _) *) apply tac_forall_intro; intros x
| (* (?P → _) *) eapply tac_impl_intro_pure;
[let P := match goal with |- IntoPure ?P _ => P end in
@@ -542,13 +551,13 @@ Local Tactic Notation "iIntroForall" :=
lazymatch goal with
| |- ∀ _, ?P => fail
| |- ∀ _, _ => intro
- | |- _ ⊢ (∀ x : _, _) => iIntro {x}
+ | |- _ ⊢ (∀ x : _, _) => iIntro (x)
end.
Local Tactic Notation "iIntro" :=
lazymatch goal with
| |- _ → ?P => intro
- | |- _ ⊢ (_ -★ _) => iIntro {?} || let H := iFresh in iIntro #H || iIntro H
- | |- _ ⊢ (_ → _) => iIntro {?} || let H := iFresh in iIntro #H || iIntro H
+ | |- _ ⊢ (_ -★ _) => iIntro (?) || let H := iFresh in iIntro #H || iIntro H
+ | |- _ ⊢ (_ → _) => iIntro (?) || let H := iFresh in iIntro #H || iIntro H
end.
Tactic Notation "iIntros" constr(pat) :=
@@ -571,7 +580,7 @@ Tactic Notation "iIntros" constr(pat) :=
| IName ?H :: ?pats => iIntro H; go pats
| IPersistent IAnom :: ?pats => let H := iFresh in iIntro #H; go pats
| IAnom :: ?pats => let H := iFresh in iIntro H; go pats
- | IAnomPure :: ?pats => iIntro {?}; go pats
+ | IAnomPure :: ?pats => iIntro (?); go pats
| IPersistent ?pat :: ?pats =>
let H := iFresh in iIntro #H; iDestructHyp H as pat; go pats
| ?pat :: ?pats =>
@@ -581,61 +590,61 @@ Tactic Notation "iIntros" constr(pat) :=
in let pats := intro_pat.parse pat in try iProof; go pats.
Tactic Notation "iIntros" := iIntros "**".
-Tactic Notation "iIntros" "{" simple_intropattern(x1) "}" :=
- try iProof; iIntro { x1 }.
-Tactic Notation "iIntros" "{" simple_intropattern(x1)
- simple_intropattern(x2) "}" :=
- iIntros { x1 }; iIntro { x2 }.
-Tactic Notation "iIntros" "{" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) "}" :=
- iIntros { x1 x2 }; iIntro { x3 }.
-Tactic Notation "iIntros" "{" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) "}" :=
- iIntros { x1 x2 x3 }; iIntro { x4 }.
-Tactic Notation "iIntros" "{" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5) "}" :=
- iIntros { x1 x2 x3 x4 }; iIntro { x5 }.
-Tactic Notation "iIntros" "{" simple_intropattern(x1) simple_intropattern(x2)
+Tactic Notation "iIntros" "(" simple_intropattern(x1) ")" :=
+ try iProof; iIntro ( x1 ).
+Tactic Notation "iIntros" "(" simple_intropattern(x1)
+ simple_intropattern(x2) ")" :=
+ iIntros ( x1 ); iIntro ( x2 ).
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) ")" :=
+ iIntros ( x1 x2 ); iIntro ( x3 ).
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) ")" :=
+ iIntros ( x1 x2 x3 ); iIntro ( x4 ).
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5) ")" :=
+ iIntros ( x1 x2 x3 x4 ); iIntro ( x5 ).
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- simple_intropattern(x6) "}" :=
- iIntros { x1 x2 x3 x4 x5 }; iIntro { x6 }.
-Tactic Notation "iIntros" "{" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x6) ")" :=
+ iIntros ( x1 x2 x3 x4 x5 ); iIntro ( x6 ).
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- simple_intropattern(x6) simple_intropattern(x7) "}" :=
- iIntros { x1 x2 x3 x4 x5 x6 }; iIntro { x7 }.
-Tactic Notation "iIntros" "{" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x6) simple_intropattern(x7) ")" :=
+ iIntros ( x1 x2 x3 x4 x5 x6 ); iIntro ( x7 ).
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8) "}" :=
- iIntros { x1 x2 x3 x4 x5 x6 x7 }; iIntro { x8 }.
-
-Tactic Notation "iIntros" "{" simple_intropattern(x1) "}" constr(p) :=
- iIntros { x1 }; iIntros p.
-Tactic Notation "iIntros" "{" simple_intropattern(x1) simple_intropattern(x2)
- "}" constr(p) :=
- iIntros { x1 x2 }; iIntros p.
-Tactic Notation "iIntros" "{" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) "}" constr(p) :=
- iIntros { x1 x2 x3 }; iIntros p.
-Tactic Notation "iIntros" "{" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) "}" constr(p) :=
- iIntros { x1 x2 x3 x4 }; iIntros p.
-Tactic Notation "iIntros" "{" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8) ")" :=
+ iIntros ( x1 x2 x3 x4 x5 x6 x7 ); iIntro ( x8 ).
+
+Tactic Notation "iIntros" "(" simple_intropattern(x1) ")" constr(p) :=
+ iIntros ( x1 ); iIntros p.
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ ")" constr(p) :=
+ iIntros ( x1 x2 ); iIntros p.
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) ")" constr(p) :=
+ iIntros ( x1 x2 x3 ); iIntros p.
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) ")" constr(p) :=
+ iIntros ( x1 x2 x3 x4 ); iIntros p.
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- "}" constr(p) :=
- iIntros { x1 x2 x3 x4 x5 }; iIntros p.
-Tactic Notation "iIntros" "{"simple_intropattern(x1) simple_intropattern(x2)
+ ")" constr(p) :=
+ iIntros ( x1 x2 x3 x4 x5 ); iIntros p.
+Tactic Notation "iIntros" "("simple_intropattern(x1) simple_intropattern(x2)
simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- simple_intropattern(x6) "}" constr(p) :=
- iIntros { x1 x2 x3 x4 x5 x6 }; iIntros p.
-Tactic Notation "iIntros" "{" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x6) ")" constr(p) :=
+ iIntros ( x1 x2 x3 x4 x5 x6 ); iIntros p.
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- simple_intropattern(x6) simple_intropattern(x7) "}" constr(p) :=
- iIntros { x1 x2 x3 x4 x5 x6 x7 }; iIntros p.
-Tactic Notation "iIntros" "{" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x6) simple_intropattern(x7) ")" constr(p) :=
+ iIntros ( x1 x2 x3 x4 x5 x6 x7 ); iIntros p.
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8)
- "}" constr(p) :=
- iIntros { x1 x2 x3 x4 x5 x6 x7 x8 }; iIntros p.
+ ")" constr(p) :=
+ iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 ); iIntros p.
(** * Destruct tactic *)
Tactic Notation "iDestructHelp" open_constr(lem) "as" tactic(tac) :=
@@ -663,37 +672,37 @@ Tactic Notation "iDestructHelp" open_constr(lem) "as" tactic(tac) :=
Tactic Notation "iDestruct" open_constr(H) "as" constr(pat) :=
iDestructHelp H as (fun H => iDestructHyp H as pat).
-Tactic Notation "iDestruct" open_constr(H) "as" "{" simple_intropattern(x1) "}"
+Tactic Notation "iDestruct" open_constr(H) "as" "(" simple_intropattern(x1) ")"
constr(pat) :=
- iDestructHelp H as (fun H => iDestructHyp H as { x1 } pat).
-Tactic Notation "iDestruct" open_constr(H) "as" "{" simple_intropattern(x1)
- simple_intropattern(x2) "}" constr(pat) :=
- iDestructHelp H as (fun H => iDestructHyp H as { x1 x2 } pat).
-Tactic Notation "iDestruct" open_constr(H) "as" "{" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) "}" constr(pat) :=
- iDestructHelp H as (fun H => iDestructHyp H as { x1 x2 x3 } pat).
-Tactic Notation "iDestruct" open_constr(H) "as" "{" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) "}"
+ iDestructHelp H as (fun H => iDestructHyp H as ( x1 ) pat).
+Tactic Notation "iDestruct" open_constr(H) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) ")" constr(pat) :=
+ iDestructHelp H as (fun H => iDestructHyp H as ( x1 x2 ) pat).
+Tactic Notation "iDestruct" open_constr(H) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) ")" constr(pat) :=
+ iDestructHelp H as (fun H => iDestructHyp H as ( x1 x2 x3 ) pat).
+Tactic Notation "iDestruct" open_constr(H) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")"
constr(pat) :=
- iDestructHelp H as (fun H => iDestructHyp H as { x1 x2 x3 x4 } pat).
-Tactic Notation "iDestruct" open_constr(H) "as" "{" simple_intropattern(x1)
+ iDestructHelp H as (fun H => iDestructHyp H as ( x1 x2 x3 x4 ) pat).
+Tactic Notation "iDestruct" open_constr(H) "as" "(" simple_intropattern(x1)
simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) "}" constr(pat) :=
- iDestructHelp H as (fun H => iDestructHyp H as { x1 x2 x3 x4 x5 } pat).
-Tactic Notation "iDestruct" open_constr(H) "as" "{" simple_intropattern(x1)
+ simple_intropattern(x5) ")" constr(pat) :=
+ iDestructHelp H as (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 ) pat).
+Tactic Notation "iDestruct" open_constr(H) "as" "(" simple_intropattern(x1)
simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) "}" constr(pat) :=
- iDestructHelp H as (fun H => iDestructHyp H as { x1 x2 x3 x4 x5 x6 } pat).
-Tactic Notation "iDestruct" open_constr(H) "as" "{" simple_intropattern(x1)
+ simple_intropattern(x5) simple_intropattern(x6) ")" constr(pat) :=
+ iDestructHelp H as (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 x6 ) pat).
+Tactic Notation "iDestruct" open_constr(H) "as" "(" simple_intropattern(x1)
simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7) "}"
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7) ")"
constr(pat) :=
- iDestructHelp H as (fun H => iDestructHyp H as { x1 x2 x3 x4 x5 x6 x7 } pat).
-Tactic Notation "iDestruct" open_constr(H) "as" "{" simple_intropattern(x1)
+ iDestructHelp H as (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 x6 x7 ) pat).
+Tactic Notation "iDestruct" open_constr(H) "as" "(" simple_intropattern(x1)
simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
- simple_intropattern(x8) "}" constr(pat) :=
- iDestructHelp H as (fun H => iDestructHyp H as { x1 x2 x3 x4 x5 x6 x7 x8 } pat).
+ simple_intropattern(x8) ")" constr(pat) :=
+ iDestructHelp H as (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 x6 x7 x8 ) pat).
Tactic Notation "iDestruct" open_constr(H) "as" "%" simple_intropattern(pat) :=
let Htmp := iFresh in iDestruct H as Htmp; last iPure Htmp as pat.
@@ -712,31 +721,31 @@ Local Ltac iLöbHelp IH tac_before tac_after :=
end.
Tactic Notation "iLöb" "as" constr (IH) := iLöbHelp IH idtac idtac.
-Tactic Notation "iLöb" "{" ident(x1) "}" "as" constr (IH) :=
- iLöbHelp IH ltac:(iRevert { x1 }) ltac:(iIntros { x1 }).
-Tactic Notation "iLöb" "{" ident(x1) ident(x2) "}" "as" constr (IH) :=
- iLöbHelp IH ltac:(iRevert { x1 x2 }) ltac:(iIntros { x1 x2 }).
-Tactic Notation "iLöb" "{" ident(x1) ident(x2) ident(x3) "}" "as" constr (IH) :=
- iLöbHelp IH ltac:(iRevert { x1 x2 x3 }) ltac:(iIntros { x1 x2 x3 }).
-Tactic Notation "iLöb" "{" ident(x1) ident(x2) ident(x3) ident(x4) "}" "as"
+Tactic Notation "iLöb" "(" ident(x1) ")" "as" constr (IH) :=
+ iLöbHelp IH ltac:(iRevert ( x1 )) ltac:(iIntros ( x1 )).
+Tactic Notation "iLöb" "(" ident(x1) ident(x2) ")" "as" constr (IH) :=
+ iLöbHelp IH ltac:(iRevert ( x1 x2 )) ltac:(iIntros ( x1 x2 )).
+Tactic Notation "iLöb" "(" ident(x1) ident(x2) ident(x3) ")" "as" constr (IH) :=
+ iLöbHelp IH ltac:(iRevert ( x1 x2 x3 )) ltac:(iIntros ( x1 x2 x3 )).
+Tactic Notation "iLöb" "(" ident(x1) ident(x2) ident(x3) ident(x4) ")" "as"
constr (IH):=
- iLöbHelp IH ltac:(iRevert { x1 x2 x3 x4 }) ltac:(iIntros { x1 x2 x3 x4 }).
-Tactic Notation "iLöb" "{" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) "}" "as" constr (IH) :=
- iLöbHelp IH ltac:(iRevert { x1 x2 x3 x4 x5 })
- ltac:(iIntros { x1 x2 x3 x4 x5 }).
-Tactic Notation "iLöb" "{" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) "}" "as" constr (IH) :=
- iLöbHelp IH ltac:(iRevert { x1 x2 x3 x4 x5 x6 })
- ltac:(iIntros { x1 x2 x3 x4 x5 x6 }).
-Tactic Notation "iLöb" "{" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) ident(x7) "}" "as" constr (IH) :=
- iLöbHelp IH ltac:(iRevert { x1 x2 x3 x4 x5 x6 x7 })
- ltac:(iIntros { x1 x2 x3 x4 x5 x6 x7 }).
-Tactic Notation "iLöb" "{" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) ident(x7) ident(x8) "}" "as" constr (IH) :=
- iLöbHelp IH ltac:(iRevert { x1 x2 x3 x4 x5 x6 x7 x8 })
- ltac:(iIntros { x1 x2 x3 x4 x5 x6 x7 x8 }).
+ iLöbHelp IH ltac:(iRevert ( x1 x2 x3 x4 )) ltac:(iIntros ( x1 x2 x3 x4 )).
+Tactic Notation "iLöb" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ")" "as" constr (IH) :=
+ iLöbHelp IH ltac:(iRevert ( x1 x2 x3 x4 x5 ))
+ ltac:(iIntros ( x1 x2 x3 x4 x5 )).
+Tactic Notation "iLöb" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ")" "as" constr (IH) :=
+ iLöbHelp IH ltac:(iRevert ( x1 x2 x3 x4 x5 x6 ))
+ ltac:(iIntros ( x1 x2 x3 x4 x5 x6 )).
+Tactic Notation "iLöb" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ident(x7) ")" "as" constr (IH) :=
+ iLöbHelp IH ltac:(iRevert ( x1 x2 x3 x4 x5 x6 x7 ))
+ ltac:(iIntros ( x1 x2 x3 x4 x5 x6 x7 )).
+Tactic Notation "iLöb" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ident(x7) ident(x8) ")" "as" constr (IH) :=
+ iLöbHelp IH ltac:(iRevert ( x1 x2 x3 x4 x5 x6 x7 x8 ))
+ ltac:(iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 )).
(** * Assert *)
Tactic Notation "iAssert" open_constr(Q) "with" constr(Hs) "as" constr(pat) :=
@@ -752,7 +761,7 @@ Tactic Notation "iAssert" open_constr(Q) "with" constr(Hs) "as" constr(pat) :=
| [SGoal ?k ?lr ?Hs] =>
eapply tac_assert with _ _ _ lr Hs H Q _; (* (js:=Hs) (j:=H) (P:=Q) *)
[match k with
- | GoalStd => apply into_assert_fallthrough
+ | GoalStd => apply into_assert_default
| GoalPvs => apply _ || fail "iAssert: cannot generate pvs goal"
end
|env_cbv; reflexivity || fail "iAssert:" Hs "not found"
diff --git a/tests/barrier_client.v b/tests/barrier_client.v
index 4d17d5a920579e396c306fb257f0ced2ac34fdaa..ae0d5df08505a7e75841cb1f226ebb37d937ce72 100644
--- a/tests/barrier_client.v
+++ b/tests/barrier_client.v
@@ -5,16 +5,16 @@ From iris.heap_lang Require Import proofmode.
Import uPred.
Definition worker (n : Z) : val :=
- λ: "b" "y", ^wait '"b" ;; !'"y" #n.
-Definition client : expr [] :=
+ λ: "b" "y", wait "b" ;; !"y" #n.
+Definition client : expr :=
let: "y" := ref #0 in
- let: "b" := ^newbarrier #() in
- ('"y" <- (λ: "z", '"z" + #42) ;; ^signal '"b") ||
- (^(worker 12) '"b" '"y" || ^(worker 17) '"b" '"y").
+ let: "b" := newbarrier #() in
+ ("y" <- (λ: "z", "z" + #42) ;; signal "b") ||
+ (worker 12 "b" "y" || worker 17 "b" "y").
Global Opaque worker client.
Section client.
- Context {Σ : gFunctors} `{!heapG Σ, !barrierG Σ, !spawnG Σ} (heapN N : namespace).
+ Context {Σ : gFunctors} `{!heapG Σ, !barrierG Σ, !spawnG Σ} (N : namespace).
Local Notation iProp := (iPropG heap_lang Σ).
Definition y_inv (q : Qp) (l : loc) : iProp :=
@@ -22,38 +22,37 @@ Section client.
Lemma y_inv_split q l : y_inv q l ⊢ (y_inv (q/2) l ★ y_inv (q/2) l).
Proof.
- iDestruct 1 as {f} "[[Hl1 Hl2] #Hf]".
+ iDestruct 1 as (f) "[[Hl1 Hl2] #Hf]".
iSplitL "Hl1"; iExists f; by iSplitL; try iAlways.
Qed.
Lemma worker_safe q (n : Z) (b y : loc) :
- heap_ctx heapN ★ recv heapN N b (y_inv q y)
- ⊢ WP worker n #b #y {{ _, True }}.
+ heap_ctx ★ recv N b (y_inv q y) ⊢ WP worker n #b #y {{ _, True }}.
Proof.
iIntros "[#Hh Hrecv]". wp_lam. wp_let.
wp_apply wait_spec; iFrame "Hrecv".
- iDestruct 1 as {f} "[Hy #Hf]".
+ iDestruct 1 as (f) "[Hy #Hf]".
wp_seq. wp_load.
- iApply wp_wand_r; iSplitR; [iApply "Hf"|by iIntros {v} "_"].
+ iApply wp_wand_r; iSplitR; [iApply "Hf"|by iIntros (v) "_"].
Qed.
- Lemma client_safe : heapN ⊥ N → heap_ctx heapN ⊢ WP client {{ _, True }}.
+ Lemma client_safe : heapN ⊥ N → heap_ctx ⊢ WP client {{ _, True }}.
Proof.
- iIntros {?} "#Hh"; rewrite /client. wp_alloc y as "Hy". wp_let.
- wp_apply (newbarrier_spec heapN N (y_inv 1 y)); first done.
- iFrame "Hh". iIntros {l} "[Hr Hs]". wp_let.
- iApply (wp_par heapN N (λ _, True%I) (λ _, True%I)); first done.
- iFrame "Hh". iSplitL "Hy Hs".
+ iIntros (?) "#Hh"; rewrite /client. wp_alloc y as "Hy". wp_let.
+ wp_apply (newbarrier_spec N (y_inv 1 y)); first done.
+ iFrame "Hh". iIntros (l) "[Hr Hs]". wp_let.
+ iApply (wp_par (λ _, True%I) (λ _, True%I)). iFrame "Hh".
+ iSplitL "Hy Hs".
- (* The original thread, the sender. *)
wp_store. iApply signal_spec; iFrame "Hs"; iSplit; [|done].
- iExists _; iSplitL; [done|]. iAlways; iIntros {n}. wp_let. by wp_op.
+ iExists _; iSplitL; [done|]. iAlways; iIntros (n). wp_let. by wp_op.
- (* The two spawned threads, the waiters. *)
- iSplitL; [|by iIntros {_ _} "_ >"].
+ iSplitL; [|by iIntros (_ _) "_ >"].
iDestruct (recv_weaken with "[] Hr") as "Hr".
{ iIntros "Hy". by iApply (y_inv_split with "Hy"). }
iPvs (recv_split with "Hr") as "[H1 H2]"; first done.
- iApply (wp_par heapN N (λ _, True%I) (λ _, True%I)); eauto.
- iFrame "Hh"; iSplitL "H1"; [|iSplitL "H2"; [|by iIntros {_ _} "_ >"]];
+ iApply (wp_par (λ _, True%I) (λ _, True%I)). iFrame "Hh".
+ iSplitL "H1"; [|iSplitL "H2"; [|by iIntros (_ _) "_ >"]];
iApply worker_safe; by iSplit.
Qed.
End client.
@@ -65,8 +64,8 @@ Section ClosedProofs.
Lemma client_safe_closed σ : {{ ownP σ : iProp }} client {{ v, True }}.
Proof.
iIntros "! Hσ".
- iPvs (heap_alloc (nroot .@ "Barrier") with "Hσ") as {h} "[#Hh _]"; first done.
- iApply (client_safe (nroot .@ "Barrier") (nroot .@ "Heap")); auto with ndisj.
+ iPvs (heap_alloc with "Hσ") as (h) "[#Hh _]"; first done.
+ iApply (client_safe (nroot .@ "barrier")); auto with ndisj.
Qed.
Print Assumptions client_safe_closed.
diff --git a/tests/heap_lang.v b/tests/heap_lang.v
index 61f35795800d3af3edfa4200a8ad71090238b7b5..b259757ffa4bd204caa68a5f4ef2a24e58138166 100644
--- a/tests/heap_lang.v
+++ b/tests/heap_lang.v
@@ -4,13 +4,13 @@ From iris.heap_lang Require Import proofmode notation.
Import uPred.
Section LangTests.
- Definition add : expr [] := (#21 + #21)%E.
+ Definition add : expr := (#21 + #21)%E.
Goal ∀ σ, head_step add σ (#42) σ None.
Proof. intros; do_head_step done. Qed.
- Definition rec_app : expr [] := ((rec: "f" "x" := '"f" '"x") #0)%E.
+ Definition rec_app : expr := ((rec: "f" "x" := "f" "x") #0)%E.
Goal ∀ σ, head_step rec_app σ rec_app σ None.
Proof. intros. rewrite /rec_app. do_head_step done. Qed.
- Definition lam : expr [] := (λ: "x", '"x" + #21)%E.
+ Definition lam : expr := (λ: "x", "x" + #21)%E.
Goal ∀ σ, head_step (lam #21)%E σ add σ None.
Proof. intros. rewrite /lam. do_head_step done. Qed.
End LangTests.
@@ -21,41 +21,41 @@ Section LiftingTests.
Implicit Types P Q : iPropG heap_lang Σ.
Implicit Types Φ : val → iPropG heap_lang Σ.
- Definition heap_e : expr [] :=
- let: "x" := ref #1 in '"x" <- !'"x" + #1 ;; !'"x".
- Lemma heap_e_spec E N :
- nclose N ⊆ E → heap_ctx N ⊢ WP heap_e @ E {{ v, v = #2 }}.
+ Definition heap_e : expr :=
+ let: "x" := ref #1 in "x" <- !"x" + #1 ;; !"x".
+ Lemma heap_e_spec E :
+ nclose heapN ⊆ E → heap_ctx ⊢ WP heap_e @ E {{ v, v = #2 }}.
Proof.
- iIntros {HN} "#?". rewrite /heap_e. iApply (wp_mask_weaken N); first done.
+ iIntros (HN) "#?". rewrite /heap_e.
wp_alloc l. wp_let. wp_load. wp_op. wp_store. by wp_load.
Qed.
- Definition heap_e2 : expr [] :=
+ Definition heap_e2 : expr :=
let: "x" := ref #1 in
let: "y" := ref #1 in
- '"x" <- !'"x" + #1 ;; !'"x".
- Lemma heap_e2_spec E N :
- nclose N ⊆ E → heap_ctx N ⊢ WP heap_e2 @ E {{ v, v = #2 }}.
+ "x" <- !"x" + #1 ;; !"x".
+ Lemma heap_e2_spec E :
+ nclose heapN ⊆ E → heap_ctx ⊢ WP heap_e2 @ E {{ v, v = #2 }}.
Proof.
- iIntros {HN} "#?". rewrite /heap_e2. iApply (wp_mask_weaken N); first done.
+ iIntros (HN) "#?". rewrite /heap_e2.
wp_alloc l. wp_let. wp_alloc l'. wp_let.
wp_load. wp_op. wp_store. wp_load. done.
Qed.
Definition FindPred : val :=
rec: "pred" "x" "y" :=
- let: "yp" := '"y" + #1 in
- if: '"yp" < '"x" then '"pred" '"x" '"yp" else '"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.
+ if: "x" ≤ #0 then -FindPred (-"x" + #2) #0 else FindPred "x" #0.
Global Opaque FindPred Pred.
Lemma FindPred_spec n1 n2 E Φ :
n1 < n2 →
Φ #(n2 - 1) ⊢ WP FindPred #n2 #n1 @ E {{ Φ }}.
Proof.
- iIntros {Hn} "HΦ". iLöb {n1 Hn} as "IH".
+ iIntros (Hn) "HΦ". iLöb (n1 Hn) as "IH".
wp_rec. wp_let. wp_op. wp_let. wp_op=> ?; wp_if.
- iApply ("IH" with "[%] HΦ"). omega.
- iApply pvs_intro. by assert (n1 = n2 - 1) as -> by omega.
@@ -71,7 +71,7 @@ Section LiftingTests.
Qed.
Lemma Pred_user E :
- (True : iProp) ⊢ WP let: "x" := Pred #42 in ^Pred '"x" @ E {{ v, v = #40 }}.
+ (True : iProp) ⊢ WP let: "x" := Pred #42 in Pred "x" @ E {{ v, v = #40 }}.
Proof. iIntros "". wp_apply Pred_spec. wp_let. by wp_apply Pred_spec. Qed.
End LiftingTests.
@@ -82,7 +82,7 @@ Section ClosedProofs.
Lemma heap_e_closed σ : {{ ownP σ : iProp }} heap_e {{ v, v = #2 }}.
Proof.
iProof. iIntros "! Hσ".
- iPvs (heap_alloc nroot with "Hσ") as {h} "[? _]"; first by rewrite nclose_nroot.
- iApply heap_e_spec; last done; by rewrite nclose_nroot.
+ iPvs (heap_alloc with "Hσ") as (h) "[? _]"; first solve_ndisj.
+ by iApply heap_e_spec; first solve_ndisj.
Qed.
End ClosedProofs.
diff --git a/tests/joining_existentials.v b/tests/joining_existentials.v
index 9373ad731f2717e638c6df084d99124b30af5698..36077d52ee263ed97797971fc0777c21f8f99349 100644
--- a/tests/joining_existentials.v
+++ b/tests/joining_existentials.v
@@ -5,38 +5,41 @@ From iris.heap_lang Require Import notation par proofmode.
From iris.proofmode Require Import invariants.
Import uPred.
+Definition one_shotR (Λ : language) (Σ : gFunctors) (F : cFunctor) :=
+ csumR (exclR unitC) (agreeR $ laterC $ F (iPrePropG Λ Σ)).
+Definition Pending {Λ Σ F} : one_shotR Λ Σ F := Cinl (Excl ()).
+Definition Shot {Λ Σ} {F : cFunctor} (x : F (iPropG Λ Σ)) : one_shotR Λ Σ F :=
+ Cinr $ to_agree $ Next $ cFunctor_map F (iProp_fold, iProp_unfold) x.
+
Class oneShotG (Λ : language) (Σ : gFunctors) (F : cFunctor) :=
- one_shot_inG :>
- inG Λ Σ (csumR (exclR unitC) (agreeR $ laterC $ F (iPrePropG Λ Σ))).
+ one_shot_inG :> inG Λ Σ (one_shotR Λ Σ F).
Definition oneShotGF (F : cFunctor) : gFunctor :=
GFunctor (csumRF (exclRF unitC) (agreeRF (â–¶ F))).
Instance inGF_oneShotG `{inGF Λ Σ (oneShotGF F)} : oneShotG Λ Σ F.
Proof. apply: inGF_inG. Qed.
-Definition client eM eW1 eW2 : expr [] :=
+Definition client eM eW1 eW2 : expr :=
let: "b" := newbarrier #() in
- (eM ;; ^signal '"b") || ((^wait '"b" ;; eW1) || (^wait '"b" ;; eW2)).
+ (eM ;; signal "b") || ((wait "b" ;; eW1) || (wait "b" ;; eW2)).
Global Opaque client.
Section proof.
-Context (G : cFunctor).
-Context {Σ : gFunctors} `{!heapG Σ, !barrierG Σ, !spawnG Σ, !oneShotG heap_lang Σ G}.
-Context (heapN N : namespace).
+Context `{!heapG Σ, !barrierG Σ, !spawnG Σ, !oneShotG heap_lang Σ F}.
+Context (N : namespace).
Local Notation iProp := (iPropG heap_lang Σ).
-Local Notation X := (G iProp).
+Local Notation X := (F iProp).
Definition barrier_res γ (Φ : X → iProp) : iProp :=
- (∃ x, own γ (Cinr $ to_agree $
- Next (cFunctor_map G (iProp_fold, iProp_unfold) x)) ★ Φ x)%I.
+ (∃ x, own γ (Shot x) ★ Φ x)%I.
-Lemma worker_spec e γ l (Φ Ψ : X → iProp) :
- recv heapN N l (barrier_res γ Φ) ★ (∀ x, {{ Φ x }} e {{ _, Ψ x }})
+Lemma worker_spec e γ l (Φ Ψ : X → iProp) `{!Closed [] e} :
+ recv N l (barrier_res γ Φ) ★ (∀ x, {{ Φ x }} e {{ _, Ψ x }})
⊢ WP wait #l ;; e {{ _, barrier_res γ Ψ }}.
Proof.
iIntros "[Hl #He]". wp_apply wait_spec; iFrame "Hl".
- iDestruct 1 as {x} "[#Hγ Hx]".
+ iDestruct 1 as (x) "[#Hγ Hx]".
wp_seq. iApply wp_wand_l. iSplitR; [|by iApply "He"].
- iIntros {v} "?"; iExists x; by iSplit.
+ iIntros (v) "?"; iExists x; by iSplit.
Qed.
Context (P : iProp) (Φ Φ1 Φ2 Ψ Ψ1 Ψ2 : X -n> iProp).
@@ -45,55 +48,54 @@ Context {Ψ_join : ∀ x, (Ψ1 x ★ Ψ2 x) ⊢ Ψ x}.
Lemma P_res_split γ : barrier_res γ Φ ⊢ barrier_res γ Φ1 ★ barrier_res γ Φ2.
Proof.
- iDestruct 1 as {x} "[#Hγ Hx]".
+ iDestruct 1 as (x) "[#Hγ Hx]".
iDestruct (Φ_split with "Hx") as "[H1 H2]". by iSplitL "H1"; iExists x; iSplit.
Qed.
Lemma Q_res_join γ : barrier_res γ Ψ1 ★ barrier_res γ Ψ2 ⊢ ▷ barrier_res γ Ψ.
Proof.
iIntros "[Hγ Hγ']";
- iDestruct "Hγ" as {x} "[#Hγ Hx]"; iDestruct "Hγ'" as {x'} "[#Hγ' Hx']".
+ iDestruct "Hγ" as (x) "[#Hγ Hx]"; iDestruct "Hγ'" as (x') "[#Hγ' Hx']".
iAssert (▷ (x ≡ x'))%I as "Hxx" .
{ iCombine "Hγ" "Hγ'" as "Hγ2". iClear "Hγ Hγ'".
rewrite own_valid csum_validI /= agree_validI agree_equivI later_equivI /=.
rewrite -{2}[x]cFunctor_id -{2}[x']cFunctor_id.
- rewrite (ne_proper (cFunctor_map G) (cid, cid) (_ â—Ž _, _ â—Ž _)); last first.
+ rewrite (ne_proper (cFunctor_map F) (cid, cid) (_ â—Ž _, _ â—Ž _)); last first.
{ by split; intro; simpl; symmetry; apply iProp_fold_unfold. }
rewrite !cFunctor_compose. iNext. by iRewrite "Hγ2". }
iNext. iRewrite -"Hxx" in "Hx'".
iExists x; iFrame "Hγ". iApply Ψ_join; by iSplitL "Hx".
Qed.
-Lemma client_spec_new (eM eW1 eW2 : expr []) (eM' eW1' eW2' : expr ("b" :b: [])) :
- heapN ⊥ N → eM' = wexpr' eM → eW1' = wexpr' eW1 → eW2' = wexpr' eW2 →
- heap_ctx heapN ★ P
+Lemma client_spec_new eM eW1 eW2 `{!Closed [] eM, !Closed [] eW1, !Closed [] eW2} :
+ heapN ⊥ N →
+ heap_ctx ★ P
★ {{ P }} eM {{ _, ∃ x, Φ x }}
★ (∀ x, {{ Φ1 x }} eW1 {{ _, Ψ1 x }})
★ (∀ x, {{ Φ2 x }} eW2 {{ _, Ψ2 x }})
- ⊢ WP client eM' eW1' eW2' {{ _, ∃ γ, barrier_res γ Ψ }}.
+ ⊢ WP client eM eW1 eW2 {{ _, ∃ γ, barrier_res γ Ψ }}.
Proof.
- iIntros {HN -> -> ->} "/= (#Hh&HP&#He&#He1&#He2)"; rewrite /client.
- iPvs (own_alloc (Cinl (Excl ()))) as {γ} "Hγ". done.
- wp_apply (newbarrier_spec heapN N (barrier_res γ Φ)); auto.
- iFrame "Hh". iIntros {l} "[Hr Hs]".
+ iIntros (HN) "/= (#Hh&HP&#He&#He1&#He2)"; rewrite /client.
+ iPvs (own_alloc (Pending : one_shotR heap_lang Σ F)) as (γ) "Hγ". done.
+ wp_apply (newbarrier_spec N (barrier_res γ Φ)); auto.
+ iFrame "Hh". iIntros (l) "[Hr Hs]".
set (workers_post (v : val) := (barrier_res γ Ψ1 ★ barrier_res γ Ψ2)%I).
- wp_let. wp_apply (wp_par _ _ (λ _, True)%I workers_post);
- try iFrame "Hh"; first done.
+ wp_let. wp_apply (wp_par (λ _, True)%I workers_post); iFrame "Hh".
iSplitL "HP Hs Hγ"; [|iSplitL "Hr"].
- wp_focus eM. iApply wp_wand_l; iSplitR "HP"; [|by iApply "He"].
- iIntros {v} "HP"; iDestruct "HP" as {x} "HP". wp_let.
- iPvs (own_update _ _ (Cinr (to_agree _)) with "Hγ") as "Hx".
- by apply cmra_update_exclusive.
+ iIntros (v) "HP"; iDestruct "HP" as (x) "HP". wp_let.
+ iPvs (@own_update with "Hγ") as "Hx".
+ { by apply (cmra_update_exclusive (Shot x)). }
iApply signal_spec; iFrame "Hs"; iSplit; last done.
iExists x; auto.
- iDestruct (recv_weaken with "[] Hr") as "Hr"; first by iApply P_res_split.
iPvs (recv_split with "Hr") as "[H1 H2]"; first done.
- wp_apply (wp_par _ _ (λ _, barrier_res γ Ψ1)%I
- (λ _, barrier_res γ Ψ2)%I); try iFrame "Hh"; first done.
+ wp_apply (wp_par (λ _, barrier_res γ Ψ1)%I
+ (λ _, barrier_res γ Ψ2)%I); iFrame "Hh".
iSplitL "H1"; [|iSplitL "H2"].
+ iApply worker_spec; auto.
+ iApply worker_spec; auto.
+ auto.
- - iIntros {_ v} "[_ H]"; iPoseProof (Q_res_join with "H"). auto.
+ - iIntros (_ v) "[_ H]"; iPoseProof (Q_res_join with "H"). auto.
Qed.
End proof.
diff --git a/tests/list_reverse.v b/tests/list_reverse.v
new file mode 100644
index 0000000000000000000000000000000000000000..3655049b00c50949945f3965b84e13137b8110d2
--- /dev/null
+++ b/tests/list_reverse.v
@@ -0,0 +1,53 @@
+(** Correctness of in-place list reversal *)
+From iris.proofmode Require Export tactics.
+From iris.program_logic Require Export hoare.
+From iris.heap_lang Require Import proofmode notation.
+
+Section list_reverse.
+Context `{!heapG Σ}.
+Notation iProp := (iPropG heap_lang Σ).
+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.
+Global Opaque rev.
+
+Lemma rev_acc_wp hd acc xs ys (Φ : val → iProp) :
+ heap_ctx ★ is_list hd xs ★ is_list acc ys ★
+ (∀ w, is_list w (reverse xs ++ ys) -★ Φ w)
+ ⊢ WP rev hd acc {{ Φ }}.
+Proof.
+ iIntros "(#Hh & Hxs & Hys & HΦ)".
+ iLöb (hd acc xs ys Φ) as "IH". wp_rec. wp_let.
+ destruct xs as [|x xs]; iSimplifyEq.
+ - wp_match. by iApply "HΦ".
+ - iDestruct "Hxs" as (l hd') "(% & Hx & Hxs)"; iSimplifyEq.
+ wp_match. wp_load. wp_proj. wp_let. wp_load. wp_proj. wp_let. wp_store.
+ iApply ("IH" $! hd' (SOMEV #l) xs (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 (Φ : val → iProp) :
+ heap_ctx ★ is_list hd xs ★ (∀ w, is_list w (reverse xs) -★ Φ w)
+ ⊢ WP rev hd (InjL #()) {{ Φ }}.
+Proof.
+ iIntros "(#Hh & Hxs & HΦ)".
+ iApply (rev_acc_wp hd NONEV xs []); iFrame "Hh Hxs".
+ iSplit; first done. iIntros (w). rewrite right_id_L. iApply "HΦ".
+Qed.
+End list_reverse.
diff --git a/tests/one_shot.v b/tests/one_shot.v
index 6cd42173339fe1af53a0820c71a1f977046a8307..faaac93142802f4d9b518ff50fa4440cf39bbc83 100644
--- a/tests/one_shot.v
+++ b/tests/one_shot.v
@@ -5,94 +5,92 @@ From iris.proofmode Require Import invariants ghost_ownership.
Import uPred.
Definition one_shot_example : val := λ: <>,
- let: "x" := ref (InjL #0) in (
+ let: "x" := ref NONE in (
(* tryset *) (λ: "n",
- CAS '"x" (InjL #0) (InjR '"n")),
+ CAS "x" NONE (SOME "n")),
(* check *) (λ: <>,
- let: "y" := !'"x" in λ: <>,
- match: '"y" with
- InjL <> => #()
- | InjR "n" =>
- match: !'"x" with
- InjL <> => Assert #false
- | InjR "m" => Assert ('"n" = '"m")
+ let: "y" := !"x" in λ: <>,
+ match: "y" with
+ NONE => #()
+ | SOME "n" =>
+ match: !"x" with
+ NONE => assert: #false
+ | SOME "m" => assert: "n" = "m"
end
end)).
Global Opaque one_shot_example.
-Class one_shotG Σ :=
- one_shot_inG :> inG heap_lang Σ (csumR (exclR unitC)(dec_agreeR Z)).
-Definition one_shotGF : gFunctorList :=
- [GFunctor (constRF (csumR (exclR unitC)(dec_agreeR Z)))].
+Definition one_shotR := csumR (exclR unitC) (dec_agreeR Z).
+Definition Pending : one_shotR := (Cinl (Excl ()) : one_shotR).
+Definition Shot (n : Z) : one_shotR := (Cinr (DecAgree n) : one_shotR).
+
+Class one_shotG Σ := one_shot_inG :> inG heap_lang Σ one_shotR.
+Definition one_shotGF : gFunctorList := [GFunctor (constRF one_shotR)].
Instance inGF_one_shotG Σ : inGFs heap_lang Σ one_shotGF → one_shotG Σ.
Proof. intros [? _]; apply: inGF_inG. Qed.
-Notation Pending := (Cinl (Excl ())).
-
Section proof.
-Context {Σ : gFunctors} `{!heapG Σ, !one_shotG Σ}.
-Context (heapN N : namespace) (HN : heapN ⊥ N).
+Context `{!heapG Σ, !one_shotG Σ} (N : namespace) (HN : heapN ⊥ N).
Local Notation iProp := (iPropG heap_lang Σ).
Definition one_shot_inv (γ : gname) (l : loc) : iProp :=
- (l ↦ InjLV #0 ★ own γ Pending ∨
- ∃ n : Z, l ↦ InjRV #n ★ own γ (Cinr (DecAgree n)))%I.
+ (l ↦ NONEV ★ own γ Pending ∨ ∃ n : Z, l ↦ SOMEV #n ★ own γ (Shot n))%I.
Lemma wp_one_shot (Φ : val → iProp) :
- heap_ctx heapN ★ (∀ f1 f2 : val,
+ heap_ctx ★ (∀ f1 f2 : val,
(∀ n : Z, □ WP f1 #n {{ w, w = #true ∨ w = #false }}) ★
□ WP f2 #() {{ g, □ WP g #() {{ _, True }} }} -★ Φ (f1,f2)%V)
⊢ WP one_shot_example #() {{ Φ }}.
Proof.
iIntros "[#? Hf] /=".
rewrite /one_shot_example. wp_seq. wp_alloc l as "Hl". wp_let.
- iPvs (own_alloc Pending) as {γ} "Hγ"; first done.
+ iPvs (own_alloc Pending) as (γ) "Hγ"; first done.
iPvs (inv_alloc N _ (one_shot_inv γ l) with "[Hl Hγ]") as "#HN"; first done.
{ iNext. iLeft. by iSplitL "Hl". }
iPvsIntro. iApply "Hf"; iSplit.
- - iIntros {n} "!". wp_let.
- iInv> N as "[[Hl Hγ]|H]"; last iDestruct "H" as {m} "[Hl Hγ]".
+ - iIntros (n) "!". wp_let.
+ iInv> N as "[[Hl Hγ]|H]"; last iDestruct "H" as (m) "[Hl Hγ]".
+ wp_cas_suc. iSplitL; [|by iLeft].
- iPvs (own_update with "Hγ") as "Hγ".
- { by apply cmra_update_exclusive with (y:=Cinr (DecAgree n)). }
+ iPvs (@own_update with "Hγ") as "Hγ".
+ { by apply cmra_update_exclusive with (y:=Shot n). }
iPvsIntro; iRight; iExists n; by iSplitL "Hl".
+ wp_cas_fail. rewrite /one_shot_inv; eauto 10.
- iIntros "!". wp_seq. wp_focus (! _)%E. iInv> N as "Hγ".
- iAssert (∃ v, l ↦ v ★ ((v = InjLV #0 ★ own γ Pending) ∨
- ∃ n : Z, v = InjRV #n ★ own γ (Cinr (DecAgree n))))%I with "[-]" as "Hv".
- { iDestruct "Hγ" as "[[Hl Hγ]|Hl]"; last iDestruct "Hl" as {m} "[Hl Hγ]".
- + iExists (InjLV #0). iFrame. eauto.
- + iExists (InjRV #m). iFrame. eauto. }
- iDestruct "Hv" as {v} "[Hl Hv]". wp_load; iPvsIntro.
- iAssert (one_shot_inv γ l ★ (v = InjLV #0 ∨ ∃ n : Z,
- v = InjRV #n ★ own γ (Cinr (DecAgree n))))%I with "[-]" as "[$ #Hv]".
- { iDestruct "Hv" as "[[% ?]|Hv]"; last iDestruct "Hv" as {m} "[% ?]"; subst.
+ iAssert (∃ v, l ↦ v ★ ((v = NONEV ★ own γ Pending) ∨
+ ∃ n : Z, v = SOMEV #n ★ own γ (Shot n)))%I with "[-]" 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; iPvsIntro.
+ iAssert (one_shot_inv γ l ★ (v = NONEV ∨ ∃ n : Z,
+ v = SOMEV #n ★ own γ (Shot n)))%I with "[-]" as "[$ #Hv]".
+ { iDestruct "Hv" as "[[% ?]|Hv]"; last iDestruct "Hv" as (m) "[% ?]"; subst.
+ iSplit. iLeft; by iSplitL "Hl". eauto.
+ iSplit. iRight; iExists m; by iSplitL "Hl". eauto. }
wp_let. iPvsIntro. iIntros "!". wp_seq.
- iDestruct "Hv" as "[%|Hv]"; last iDestruct "Hv" as {m} "[% Hγ']"; subst.
+ iDestruct "Hv" as "[%|Hv]"; last iDestruct "Hv" as (m) "[% Hγ']"; subst.
{ by wp_match. }
wp_match. wp_focus (! _)%E.
- iInv> N as "[[Hl Hγ]|Hinv]"; last iDestruct "Hinv" as {m'} "[Hl Hγ]".
- { iCombine "Hγ" "Hγ'" as "Hγ". by iDestruct (own_valid with "Hγ") as "%". }
+ iInv> N as "[[Hl Hγ]|Hinv]"; last iDestruct "Hinv" as (m') "[Hl Hγ]".
+ { iCombine "Hγ" "Hγ'" as "Hγ". by iDestruct (@own_valid with "Hγ") as %?. }
wp_load; iPvsIntro.
iCombine "Hγ" "Hγ'" as "Hγ".
- iDestruct (own_valid with "#Hγ") as %[=->]%dec_agree_op_inv.
+ iDestruct (@own_valid with "#Hγ") as %[=->]%dec_agree_op_inv.
iSplitL "Hl"; [iRight; by eauto|].
- wp_match. iApply wp_assert'. wp_op=>?; simplify_eq/=; eauto.
+ wp_match. iApply wp_assert. wp_op=>?; simplify_eq/=; eauto.
Qed.
Lemma hoare_one_shot (Φ : val → iProp) :
- heap_ctx heapN ⊢ {{ True }} one_shot_example #()
+ heap_ctx ⊢ {{ 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. iSplit; first done.
- iIntros {f1 f2} "[#Hf1 #Hf2]"; iSplit.
- - iIntros {n} "! _". wp_proj. iApply "Hf1".
+ iIntros (f1 f2) "[#Hf1 #Hf2]"; iSplit.
+ - iIntros (n) "! _". wp_proj. iApply "Hf1".
- iIntros "! _". wp_proj.
- iApply wp_wand_l; iFrame "Hf2". by iIntros {v} "#? ! _".
+ iApply wp_wand_l; iFrame "Hf2". by iIntros (v) "#? ! _".
Qed.
End proof.
diff --git a/tests/proofmode.v b/tests/proofmode.v
index e0694d4b26e8e66002bf0d64507ec29cb56d47c7..7ac9b89561e967ad0703eb8cb86ee56e2c76f4f0 100644
--- a/tests/proofmode.v
+++ b/tests/proofmode.v
@@ -20,12 +20,12 @@ Lemma demo_1 (M : ucmraT) (P1 P2 P3 : nat → uPred M) :
▷ (∀ 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.
+ iIntros (i [|j] a b ?) "! [Ha Hb] H1 #H2 H3"; setoid_subst.
{ iLeft. by iNext. }
iRight.
- iDestruct "H1" as {z1 z2 c} "(H1&_&#Hc)".
+ iDestruct "H1" as (z1 z2 c) "(H1&_&#Hc)".
iPoseProof "Hc" as "foo".
- iRevert {a b} "Ha Hb". iIntros {b a} "Hb {foo} Ha".
+ 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}".
@@ -61,7 +61,7 @@ Definition foo {M} (P : uPred M) := (P → P)%I.
Definition bar {M} : uPred M := (∀ P, foo P)%I.
Lemma demo_4 (M : ucmraT) : True ⊢ @bar M.
-Proof. iIntros. iIntros {P} "HP". done. Qed.
+Proof. iIntros. iIntros (P) "HP". done. Qed.
Lemma demo_5 (M : ucmraT) (x y : M) (P : uPred M) :
(∀ z, P → z ≡ y) ⊢ (P -★ (x,x) ≡ (y,x)).
@@ -76,7 +76,7 @@ Lemma demo_6 (M : ucmraT) (P Q : uPred M) :
True ⊢ ∀ x y z : nat,
x = plus 0 x → y = 0 → z = 0 → P → □ Q → foo (x ≡ x).
Proof.
- iIntros {a} "*".
+ iIntros (a) "*".
iIntros "#Hfoo **".
by iIntros "# _".
Qed.
@@ -90,7 +90,7 @@ Section iris.
E1 ⊆ E2 → E ⊆ E1 →
(|={E1,E}=> ▷ P) ={E2,E ∪ E2 ∖ E1}=> ▷ P.
Proof.
- iIntros {? ?} "Hpvs".
+ iIntros (? ?) "Hpvs".
iPvs "Hpvs"; first set_solver.
done.
Qed.
@@ -99,7 +99,7 @@ Section iris.
nclose N ⊆ E →
(True -★ P -★ inv N Q -★ True -★ R) ⊢ P -★ ▷ Q ={E}=★ R.
Proof.
- iIntros {?} "H HP HQ".
+ iIntros (?) "H HP HQ".
iApply ("H" with "[#] HP |==>[HQ] |==>").
- done.
- by iApply inv_alloc.
diff --git a/tests/tree_sum.v b/tests/tree_sum.v
index b96686ebd14417433a959d3c25b50f0e8e5e6017..6d07b098cde1be59189a4e083999129f6db43a54 100644
--- a/tests/tree_sum.v
+++ b/tests/tree_sum.v
@@ -21,31 +21,30 @@ Fixpoint sum (t : tree) : Z :=
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"
+ 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".
+ sum_loop "t" "l";;
+ !"l".
Global Opaque sum_loop sum'.
-Lemma sum_loop_wp `{!heapG Σ} heapN v t l (n : Z) (Φ : val → iPropG heap_lang Σ) :
- heap_ctx heapN ★ l ↦ #n ★ is_tree v t
+Lemma sum_loop_wp `{!heapG Σ} v t l (n : Z) (Φ : val → iPropG heap_lang Σ) :
+ heap_ctx ★ l ↦ #n ★ is_tree v t
★ (l ↦ #(sum t + n) -★ is_tree v t -★ Φ #())
⊢ WP sum_loop v #l {{ Φ }}.
Proof.
iIntros "(#Hh & Hl & Ht & HΦ)".
- iLöb {v t l n Φ} as "IH". wp_rec; wp_let.
+ iLöb (v t l n Φ) as "IH". wp_rec. wp_let.
destruct t as [n'|tl tr]; simpl in *.
- iDestruct "Ht" as "%"; subst.
wp_match. wp_load. wp_op. wp_store.
by iApply ("HΦ" with "Hl").
- - iDestruct "Ht" as {ll lr vl vr} "(% & Hll & Htl & Hlr & Htr)"; subst.
+ - iDestruct "Ht" as (ll lr vl vr) "(% & Hll & Htl & Hlr & Htr)"; subst.
wp_match. wp_proj. wp_load.
wp_apply ("IH" with "Hl Htl"). iIntros "Hl Htl".
wp_seq. wp_proj. wp_load.
@@ -55,8 +54,8 @@ Proof.
iExists ll, lr, vl, vr. by iFrame.
Qed.
-Lemma sum_wp `{!heapG Σ} heapN v t Φ :
- heap_ctx heapN ★ is_tree v t ★ (is_tree v t -★ Φ #(sum t))
+Lemma sum_wp `{!heapG Σ} v t Φ :
+ heap_ctx ★ is_tree v t ★ (is_tree v t -★ Φ #(sum t))
⊢ WP sum' v {{ Φ }}.
Proof.
iIntros "(#Hh & Ht & HΦ)". rewrite /sum'.