diff --git a/CHANGELOG.md b/CHANGELOG.md index baa924f03902faad3331dd42951266189d6c5043..4619351d5e8ace979b1a82eea10d4f96c1945f9b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,19 +3,43 @@ 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(s). -## Iris 3.1.0 (unfinished) +## Iris 3.1.0 (released 2017-12-19) Changes in and extensions of the theory: -* Add new modality: â– ("plainly"). +* Define `uPred` as a quotient on monotone predicates `M -> SProp`. +* Get rid of some primitive laws; they can be derived: + `True ⊢ â–¡ True` and `â–¡ (P ∧ Q) ⊢ â–¡ (P ∗ Q)` * Camera morphisms have to be homomorphisms, not just monotone functions. * Add a proof that `f` has a fixed point if `f^k` is contractive. * Constructions for least and greatest fixed points over monotone predicates (defined in the logic of Iris using impredicative quantification). * Add a proof of the inverse of `wp_bind`. +* [Experimental feature] Add new modality: â– ("plainly"). +* [Experimental feature] Support verifying code that might get stuck by + distinguishing "non-stuck" vs. "(potentially) stuck" weakest + preconditions. (See [Swasey et al., OOPSLA '17] for examples.) The non-stuck + `WP e @ E {{ Φ }}` ensures that, as `e` runs, it does not get stuck. The stuck + `WP e @ E ?{{ Φ }}` ensures that, as usual, all invariants are preserved while + `e` runs, but it permits execution to get stuck. The former implies the + latter. The full judgment is `WP e @ s; E {{ Φ }}`, where non-stuck WP uses + *stuckness bit* `s = NotStuck` while stuck WP uses `s = MaybeStuck`. Changes in Coq: +* Move the `prelude` folder to its own project: + [coq-std++](https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp) +* Some extensions/improvements of heap_lang: + - Improve handling of pure (non-state-dependent) reductions. + - Add fetch-and-add (`FAA`) operation. + - Add syntax for all Coq's binary operations on `Z`. +* Generalize `saved_prop` to let the user choose the location of the type-level + later. Rename the general form to `saved_anything`. Provide `saved_prop` and + `saved_pred` as special cases. +* Improved big operators: + + They are no longer tied to cameras, but work on any monoid + + The version of big operations over lists was redefined so that it enjoys + more definitional equalities. * Rename some things and change notation: - The unit of a camera: `empty` -> `unit`, `∅` -> `ε` - Disjointness: `⊥` -> `##` @@ -26,6 +50,7 @@ Changes in Coq: - Camera elements such that `core x = x`: `Persistent` -> `CoreId` - Persistent propositions: `PersistentP` -> `Persistent` - The persistent modality: `always` -> `persistently` + - Adequacy for non-stuck weakestpre: `adequate_safe` -> `adequate_not_stuck` - Consistently SnakeCase identifiers: + `CMRAMixin` -> `CmraMixin` + `CMRAT` -> `CmraT` @@ -53,6 +78,8 @@ Changes in Coq: ``` sed 's/\bPersistentP\b/Persistent/g; s/\bTimelessP\b/Timeless/g; s/\bCMRADiscrete\b/CmraDiscrete/g; s/\bCMRAT\b/CmraT/g; s/\bCMRAMixin\b/CmraMixin/g; s/\bUCMRAT\b/UcmraT/g; s/\bUCMRAMixin\b/UcmraMixin/g; s/\bSTS\b/Sts/g' -i $(find -name "*.v") ``` +* `PersistentL` and `TimelessL` (persistence and timelessness of lists of + propositions) are replaces by `TCForall` from std++. * Fix a bunch of consistency issues in the proof mode, and make it overall more usable. In particular: - All proof mode tactics start the proof mode if necessary; `iStartProof` is @@ -74,9 +101,6 @@ sed 's/\bPersistentP\b/Persistent/g; s/\bTimelessP\b/Timeless/g; s/\bCMRADiscret behind a type class opaque definition. Furthermore, this can change the name of anonymous identifiers introduced with the "%" pattern. * Make `ofe_fun` dependently typed, subsuming `iprod`. The latter got removed. -* Generalize `saved_prop` to let the user choose the location of the type-level - later. Rename the general form to `saved_anything`. Provide `saved_prop` and - `saved_pred` as special cases. * Define the generic `fill` operation of the `ectxi_language` construct in terms of a left fold instead of a right fold. This gives rise to more definitional equalities. @@ -85,18 +109,16 @@ sed 's/\bPersistentP\b/Persistent/g; s/\bTimelessP\b/Timeless/g; s/\bCMRADiscret type classes and canonical structures. Also, it now uses explicit mixins. The file `program_logic/ectxi_language` contains some documentation on how to setup Iris for your language. -* Improved big operators: - + They are no longer tied to cameras, but work on any monoid - + The version of big operations over lists was redefined so that it enjoys - more definitional equalities. +* Restore the original, stronger notion of atomicity alongside the weaker + notion. These are `Atomic a e` where the stuckness bit `s` indicates whether + expression `e` is weakly (`a = WeaklyAtomic`) or strongly + (`a = StronglyAtomic`) atomic. * Various improvements to `solve_ndisj`. -* Improve handling of pure (non-state-dependent) reductions in heap_lang. * Use `Hint Mode` to prevent Coq from making arbitrary guesses in the presence of evars, which often led to divergence. There are a few places where type annotations are now needed. -* Move the `prelude` folder to its own project: std++ * The rules `internal_eq_rewrite` and `internal_eq_rewrite_contractive` are now - stated in the logic, i.e. they are `iApply` friendly. + stated in the logic, i.e., they are `iApply`-friendly. ## Iris 3.0.0 (released 2017-01-11) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index dca6c5586c2c615ab2994680109fb3126a597f14..4d5e348b4b64fc1bd2f1f294364c635aba9a01b7 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -1,17 +1,16 @@ -# CONTRIBUTING TO THE IRIS COQ DEVELOPMENT +# Contributing to the Iris Coq Development Discussion about the Iris Coq development happens on the mailing list -[iris-club@lists.mpi-sws.org](https://lists.mpi-sws.org/listinfo/iris-club). -This is also the right place to ask questions. - -If you want to report a bug, please use the -[issue tracker](https://gitlab.mpi-sws.org/FP/iris-coq/issues). You will have -to create an account at the +[iris-club@lists.mpi-sws.org](https://lists.mpi-sws.org/listinfo/iris-club) and +in the [Iris Chat](https://mattermost.mpi-sws.org/iris). This is also the right +place to ask questions. The chat requires an account at the [MPI-SWS GitLab](https://gitlab.mpi-sws.org/users/sign_in) (use the "Register" tab). -To contribute code, please send your MPI-SWS GitLab username to -[Ralf Jung](https://gitlab.mpi-sws.org/jung) to enable personal projects for -your account. Then you can fork the +If you want to report a bug, please use the +[issue tracker](https://gitlab.mpi-sws.org/FP/iris-coq/issues), which also +requires an MPI-SWS GitLab account. To contribute code, please send your +MPI-SWS GitLab username to [Ralf Jung](https://gitlab.mpi-sws.org/jung) to +enable personal projects for your account. Then you can fork the [Iris git repository](https://gitlab.mpi-sws.org/FP/iris-coq/), make your changes in your fork, and create a merge request. diff --git a/README.md b/README.md index 1cfec97a868839746efe746d895bd84c7bba8160..0f48500f3e5357bc33499d54048d2e9838b6613f 100644 --- a/README.md +++ b/README.md @@ -6,34 +6,45 @@ This is the Coq development of the [Iris Project](http://iris-project.org). This version is known to compile with: - - Coq 8.6.1 / 8.7.0 + - Coq 8.6.1 / 8.7.0 / 8.7.1 - Ssreflect 1.6.4 - - A development version of [std++](https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp) + - [std++](https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp) 1.1.0 If you need to work with Coq 8.5, please check out the [iris-3.0 branch](https://gitlab.mpi-sws.org/FP/iris-coq/tree/iris-3.0). -The easiest way to install the correct versions of the dependencies is through -opam. You will need the Coq and Iris opam repositories: +## Installing via opam + +To obtain the latest stable release via opam (1.2.2 or newer), you have to add +the Coq opam repository: opam repo add coq-released https://coq.inria.fr/opam/released + +Then you can do `opam install coq-iris`. + +To obtain a development version, add the Iris opam repository: + opam repo add iris-dev https://gitlab.mpi-sws.org/FP/opam-dev.git -Once you got opam set up, run `make build-dep` to install the right versions -of the dependencies. +## Building from source -## Updating +When building Iris from source, we recommend to use opam (1.2.2 or newer) for +installing Iris's dependencies. This requires the following two repositories: -After doing `git pull`, the development may fail to compile because of outdated -dependencies. To fix that, please run `opam update` followed by -`make build-dep`. + opam repo add coq-released https://coq.inria.fr/opam/released + opam repo add iris-dev https://gitlab.mpi-sws.org/FP/opam-dev.git -## Building Instructions +Once you got opam set up, run `make build-dep` to install the right versions +of the dependencies. Run `make -jN` to build the full development, where `N` is the number of your CPU cores. -## Structure +To update Iris, do `git pull`. After an update, the development may fail to +compile because of outdated dependencies. To fix that, please run `opam update` +followed by `make build-dep`. + +## Directory Structure * The folder [algebra](theories/algebra) contains the COFE and CMRA constructions as well as the solver for recursive domain equations. @@ -66,13 +77,26 @@ CPU cores. A LaTeX version of the core logic definitions and some derived forms is available in [docs/iris.tex](docs/iris.tex). A compiled PDF version of this -document is [available online](http://plv.mpi-sws.org/iris/appendix-3.0.pdf). +document is [available online](http://plv.mpi-sws.org/iris/appendix-3.1.pdf). + +## Case Studies + +The following is a (probably incomplete) list of case studies that use Iris, and +that should be compatible with this version: + +* [Iris Examples](https://gitlab.mpi-sws.org/FP/iris-examples) is where we + collect miscellaneous case studies that do not have their own repository. +* [LambdaRust](https://gitlab.mpi-sws.org/FP/LambdaRust-coq/) is a Coq + formalization of the core Rust type system. +* [Iris Atomic](https://gitlab.mpi-sws.org/FP/iris-atomic/) is an experimental + formalization of logically atomic triples in Iris. ## For Developers: How to update the std++ dependency * Do the change in std++, push it. -* Wait for CI to publish a new std++ version on the opam archive. -* In Iris, change opam to depend on the new version. +* Wait for CI to publish a new std++ version on the opam archive, then run + `opam update iris-dev`. +* In Iris, change the `opam` file to depend on the new version. * Run `make build-dep` (in Iris) to install the new version of std++. -* You may have to do `make clean` as Coq will likely complain about .vo file + You may have to do `make clean` as Coq will likely complain about .vo file mismatches. diff --git a/docs/algebra.tex b/docs/algebra.tex index 3ba0967042888774ba91ee1af53f50d672ba8acc..194c5306686b9e8da4fff05de19ef4c979047a02 100644 --- a/docs/algebra.tex +++ b/docs/algebra.tex @@ -53,6 +53,16 @@ In particular: The function space $(-) \nfn (-)$ is a locally non-expansive bifunctor. Note that the composition of non-expansive (bi)functors is non-expansive, and the composition of a non-expansive and a contractive (bi)functor is contractive. +One very important OFE is the OFE of \emph{step-indexed propositions}: +For every step-index, such a proposition either holds or does not hold. +Moreover, if a propositions holds for some $n$, it also has to hold for all smaller step-indices. +\begin{align*} + \SProp \eqdef{}& \psetdown{\nat} \\ + \eqdef{}& \setComp{X \in \pset{\nat}}{ \All n, m. n \geq m \Ra n \in X \Ra m \in X } \\ + X \nequiv{n} Y \eqdef{}& \All m \leq n. m \in X \Lra m \in Y \\ + X \nincl{n} Y \eqdef{}& \All m \leq n. m \in X \Ra m \in Y +\end{align*} + \subsection{COFE} COFEs are \emph{complete OFEs}, which means that we can take limits of arbitrary chains. @@ -73,18 +83,28 @@ COFEs are \emph{complete OFEs}, which means that we can take limits of arbitrary \end{defn} The function space $\ofe \nfn \cofeB$ is a COFE if $\cofeB$ is a COFE (\ie the domain $\ofe$ can actually be just an OFE). +$\SProp$ as defined above is complete, \ie it is a COFE. Completeness is necessary to take fixed-points. -For once, every \emph{contractive function} $f : \ofe \to \cofeB$ where $\cofeB$ is a COFE and inhabited has a \emph{unique} fixed-point $\fix(f)$ such that $\fix(f) = f(\fix(f))$. -This also holds if $f^k$ is contractive for an arbitrary $k$. -Furthermore, by America and Rutten's theorem~\cite{America-Rutten:JCSS89,birkedal:metric-space}, every contractive (bi)functor from $\COFEs$ to $\COFEs$ has a unique\footnote{Uniqueness is not proven in Coq.} fixed-point. +\begin{thm}[Banach's fixed-point] +\label{thm:banach} +Given an inhabited COFE $\ofe$ and a contractive function $f : \ofe \to \ofe$, there exists a unique fixed-point $\fixp_T f$ such that $f(\fixp_T f) = \fixp_T f$. +Moreover, this theorem also holds if $f$ is just non-expansive, and $f^k$ is contractive for an arbitrary $k$. +\end{thm} + +\begin{thm}[America and Rutten~\cite{America-Rutten:JCSS89,birkedal:metric-space}] +\label{thm:america_rutten} +Let $1$ be the discrete COFE on the unit type: $1 \eqdef \Delta \{ () \}$. +Given a locally contractive bifunctor $G : \COFEs^{\textrm{op}} \times \COFEs \to \COFEs$, and provided that \(G(1, 1)\) is inhabited, +then there exists a unique\footnote{Uniqueness is not proven in Coq.} COFE $\ofe$ such that $G(\ofe^{\textrm{op}}, \ofe) \cong \ofe$ (\ie the two are isomorphic in $\COFEs$). +\end{thm} \subsection{RA} \begin{defn} A \emph{resource algebra} (RA) is a tuple \\ - $(\monoid, \mval \subseteq \monoid, \mcore{{-}}: + $(\monoid, \mvalFull : \monoid \to \mProp, \mcore{{-}}: \monoid \to \maybe\monoid, (\mtimes) : \monoid \times \monoid \to \monoid)$ satisfying: \begin{align*} \All \melt, \meltB, \meltC.& (\melt \mtimes \meltB) \mtimes \meltC = \melt \mtimes (\meltB \mtimes \meltC) \tagH{ra-assoc} \\ @@ -92,18 +112,21 @@ Furthermore, by America and Rutten's theorem~\cite{America-Rutten:JCSS89,birkeda \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} \\ + \All \melt, \meltB.& \mvalFull(\melt \mtimes \meltB) \Ra \mvalFull(\melt) \tagH{ra-valid-op} \\ \text{where}\qquad %\qquad\\ \maybe\monoid \eqdef{}& \monoid \uplus \set{\mnocore} \qquad\qquad\qquad \melt^? \mtimes \mnocore \eqdef \mnocore \mtimes \melt^? \eqdef \melt^? \\ \melt \mincl \meltB \eqdef{}& \Exists \meltC \in \monoid. \meltB = \melt \mtimes \meltC \tagH{ra-incl} \end{align*} \end{defn} -\noindent +Here, $\mProp$ is the set of (meta-level) propositions. +Think of \texttt{Prop} in Coq or $\mathbb{B}$ in classical mathematics. + RAs are closely related to \emph{Partial Commutative Monoids} (PCMs), with two key differences: \begin{enumerate} -\item The composition operation on RAs is total (as opposed to the partial composition operation of a PCM), but there is a specific subset $\mval$ of \emph{valid} elements that is compatible with the composition operation (\ruleref{ra-valid-op}). +\item The composition operation on RAs is total (as opposed to the partial composition operation of a PCM), but there is a specific subset of \emph{valid} elements that is compatible with the composition operation (\ruleref{ra-valid-op}). +These valid elements are identified by the \emph{validity predicate} $\mvalFull$. -This take on partiality is necessary when defining the structure of \emph{higher-order} ghost state, CMRAs, in the next subsection. +This take on partiality is necessary when defining the structure of \emph{higher-order} ghost state, \emph{cameras}, in the next subsection. \item Instead of a single unit that is an identity to every element, we allow for an arbitrary number of units, via a function $\mcore{{-}}$ assigning to an element $\melt$ its \emph{(duplicable) core} $\mcore\melt$, as demanded by \ruleref{ra-core-id}. @@ -122,42 +145,44 @@ Notice also that the core of an RA is a strict generalization of the unit that a \begin{defn} It is possible to do a \emph{frame-preserving update} from $\melt \in \monoid$ to $\meltsB \subseteq \monoid$, written $\melt \mupd \meltsB$, if - \[ \All \maybe{\melt_\f} \in \maybe\monoid. \melt \mtimes \maybe{\melt_\f} \in \mval \Ra \Exists \meltB \in \meltsB. \meltB \mtimes \maybe{\melt_\f} \in \mval \] + \[ \All \maybe{\melt_\f} \in \maybe\monoid. \melt \mtimes \mvalFull(\maybe{\melt_\f}) \Ra \Exists \meltB \in \meltsB. \meltB \mtimes \mvalFull(\maybe{\melt_\f}) \] We further define $\melt \mupd \meltB \eqdef \melt \mupd \set\meltB$. \end{defn} -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$. +The proposition $\melt \mupd \meltsB$ says that every element $\maybe{\melt_\f}$ compatible with $\melt$ (we also call such elements \emph{frames}), must also be compatible with some $\meltB \in \meltsB$. Notice that $\maybe{\melt_\f}$ could be $\mnocore$, so the frame-preserving update can also be applied to elements that have \emph{no} frame. Intuitively, this means that whatever assumptions the rest of the program is making about the state of $\gname$, if these assumptions are compatible with $\melt$, then updating to $\meltB$ will not invalidate any of these assumptions. Since Iris ensures that the global ghost state is valid, this means that we can soundly update the ghost state from $\melt$ to a non-deterministically picked $\meltB \in \meltsB$. -\subsection{CMRA} +\subsection{Cameras} \begin{defn} - A \emph{CMRA} is a tuple $(\monoid : \OFEs, (\mval_n \subseteq \monoid)_{n \in \nat},\\ \mcore{{-}}: \monoid \nfn \maybe\monoid, (\mtimes) : \monoid \times \monoid \nfn \monoid)$ satisfying: + A \emph{camera} is a tuple $(\monoid : \OFEs, \mval : \monoid \nfn \SProp, \mcore{{-}}: \monoid \nfn \maybe\monoid,\\ (\mtimes) : \monoid \times \monoid \nfn \monoid)$ satisfying: \begin{align*} - \All 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 \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 \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} \\ + \All \melt, \meltB, \meltC.& (\melt \mtimes \meltB) \mtimes \meltC = \melt \mtimes (\meltB \mtimes \meltC) \tagH{camera-assoc} \\ + \All \melt, \meltB.& \melt \mtimes \meltB = \meltB \mtimes \melt \tagH{camera-comm} \\ + \All \melt.& \mcore\melt \in \monoid \Ra \mcore\melt \mtimes \melt = \melt \tagH{camera-core-id} \\ + \All \melt.& \mcore\melt \in \monoid \Ra \mcore{\mcore\melt} = \mcore\melt \tagH{camera-core-idem} \\ + \All \melt, \meltB.& \mcore\melt \in \monoid \land \melt \mincl \meltB \Ra \mcore\meltB \in \monoid \land \mcore\melt \mincl \mcore\meltB \tagH{camera-core-mono} \\ + \All \melt, \meltB.& \mval(\melt \mtimes \meltB) \subseteq \mval(\melt) \tagH{camera-valid-op} \\ + \All n, \melt, \meltB_1, \meltB_2.& \omit\rlap{$n \in \mval(\melt) \land \melt \nequiv{n} \meltB_1 \mtimes \meltB_2 \Ra {}$} \\ + &\Exists \meltC_1, \meltC_2. \melt = \meltC_1 \mtimes \meltC_2 \land \meltC_1 \nequiv{n} \meltB_1 \land \meltC_2 \nequiv{n} \meltB_2 \tagH{camera-extend} \\ \text{where}\qquad\qquad\\ - \melt \mincl \meltB \eqdef{}& \Exists \meltC. \meltB = \melt \mtimes \meltC \tagH{cmra-incl} \\ - \melt \mincl[n] \meltB \eqdef{}& \Exists \meltC. \meltB \nequiv{n} \melt \mtimes \meltC \tagH{cmra-inclN} + \melt \mincl \meltB \eqdef{}& \Exists \meltC. \meltB = \melt \mtimes \meltC \tagH{camera-incl} \\ + \melt \mincl[n] \meltB \eqdef{}& \Exists \meltC. \meltB \nequiv{n} \melt \mtimes \meltC \tagH{camera-inclN} \end{align*} \end{defn} -This is a natural generalization of RAs over OFEs. +This is a natural generalization of RAs over OFEs\footnote{The reader may wonder why on earth we call them ``cameras''. +The reason, which may not be entirely convincing, is that ``camera'' was originally just used as a comfortable pronunciation of ``CMRA'', the name used in earlier Iris papers. +CMRA was originally supposed to be an acronym for ``complete metric resource algebras'' (or something like that), but we were never very satisfied with it and thus ended up never spelling it out. +To make matters worse, the ``complete'' part of CMRA is now downright misleading, for whereas previously the carrier of a CMRA was required to be a COFE (complete OFE), we have relaxed that restriction and permit it to be an (incomplete) OFE. +For these reasons, we have decided to stick with the name ``camera'', for purposes of continuity, but to drop any pretense that it stands for something.}. All operations have to be non-expansive, and the validity predicate $\mval$ can now also depend on the step-index. -We define the plain $\mval$ as the ``limit'' of the $\mval_n$: -\[ \mval \eqdef \bigcap_{n \in \nat} \mval_n \] +We define the plain $\mvalFull$ as the ``limit'' of the step-indexed approximation: +\[ \mvalFull(\melt) \eqdef \All n. n \in \mval(\melt) \] -\paragraph{The extension axiom (\ruleref{cmra-extend}).} +\paragraph{The extension axiom (\ruleref{camera-extend}).} Notice that the existential quantification in this axiom is \emph{constructive}, \ie it is a sigma type in Coq. The purpose of this axiom is to compute $\melt_1$, $\melt_2$ completing the following square: @@ -182,40 +207,40 @@ This operation is needed to prove that $\later$ commutes with separating conjunc \end{mathpar} \begin{defn} - An element $\munit$ of a CMRA $\monoid$ is called the \emph{unit} of $\monoid$ if it satisfies the following conditions: + An element $\munit$ of a camera $\monoid$ is called the \emph{unit} of $\monoid$ if it satisfies the following conditions: \begin{enumerate}[itemsep=0pt] - \item $\munit$ is valid: \\ $\All n. \munit \in \mval_n$ + \item $\munit$ is valid: \\ $\All n. n \in \mval(\munit)$ \item $\munit$ is a left-identity of the operation: \\ $\All \melt \in M. \munit \mtimes \melt = \melt$ \item $\munit$ is its own core: \\ $\mcore\munit = \munit$ \end{enumerate} \end{defn} -\begin{lem}\label{lem:cmra-unit-total-core} +\begin{lem}\label{lem:camera-unit-total-core} If $\monoid$ has a unit $\munit$, then the core $\mcore{{-}}$ is total, \ie $\All\melt. \mcore\melt \in \monoid$. \end{lem} \begin{defn} It is possible to do a \emph{frame-preserving update} from $\melt \in \monoid$ to $\meltsB \subseteq \monoid$, written $\melt \mupd \meltsB$, if - \[ \All n, \maybe{\melt_\f}. \melt \mtimes \maybe{\melt_\f} \in \mval_n \Ra \Exists \meltB \in \meltsB. \meltB \mtimes \maybe{\melt_\f} \in \mval_n \] + \[ \All n, \maybe{\melt_\f}. n \in \mval(\melt \mtimes \maybe{\melt_\f}) \Ra \Exists \meltB \in \meltsB. n \in\mval(\meltB \mtimes \maybe{\melt_\f}) \] We further define $\melt \mupd \meltB \eqdef \melt \mupd \set\meltB$. \end{defn} Note that for RAs, this and the RA-based definition of a frame-preserving update coincide. \begin{defn} - A CMRA $\monoid$ is \emph{discrete} if it satisfies the following conditions: + A camera $\monoid$ is \emph{discrete} if it satisfies the following conditions: \begin{enumerate}[itemsep=0pt] \item $\monoid$ is a discrete COFE \item $\mval$ ignores the step-index: \\ - $\All \melt \in \monoid. \melt \in \mval_0 \Ra \All n, \melt \in \mval_n$ + $\All \melt \in \monoid. 0 \in \mval(\melt) \Ra \All n. n \in \mval(\melt)$ \end{enumerate} \end{defn} -Note that every RA is a discrete CMRA, by picking the discrete COFE for the equivalence relation. -Furthermore, discrete CMRAs can be turned into RAs by ignoring their COFE structure, as well as the step-index of $\mval$. +Note that every RA is a discrete camera, by picking the discrete COFE for the equivalence relation. +Furthermore, discrete cameras can be turned into RAs by ignoring their COFE structure, as well as the step-index of $\mval$. -\begin{defn}[CMRA homomorphism] - A function $f : \monoid_1 \to \monoid_2$ between two CMRAs is \emph{a CMRA homomorphism} if it satisfies the following conditions: +\begin{defn}[Camera homomorphism] + A function $f : \monoid_1 \to \monoid_2$ between two cameras is \emph{a camera homomorphism} if it satisfies the following conditions: \begin{enumerate}[itemsep=0pt] \item $f$ is non-expansive \item $f$ commutes with composition:\\ @@ -223,12 +248,12 @@ Furthermore, discrete CMRAs can be turned into RAs by ignoring their COFE struct \item $f$ commutes with the core:\\ $\All \melt \in \monoid_1. \mcore{f(\melt)} = f(\mcore{\melt})$ \item $f$ preserves validity: \\ - $\All n, \melt \in \monoid_1. \melt \in \mval_n \Ra f(\melt) \in \mval_n$ + $\All n, \melt \in \monoid_1. n \in \mval(\melt) \Ra n \in \mval(f(\melt))$ \end{enumerate} \end{defn} \begin{defn} - The category $\CMRAs$ consists of CMRAs as objects, and monotone functions as arrows. + The category $\CMRAs$ consists of cameras as objects, and monotone functions as arrows. \end{defn} Note that every object/arrow in $\CMRAs$ is also an object/arrow of $\OFEs$. The notion of a locally non-expansive (or contractive) bifunctor naturally generalizes to bifunctors between these categories. diff --git a/docs/base-logic.tex b/docs/base-logic.tex index 2a45cae7cbd88a1fc94619caf86a6a06aadb95df..5e7d5418327fbbf5b0bf1c755fa5ba15a46c398b 100644 --- a/docs/base-logic.tex +++ b/docs/base-logic.tex @@ -1,8 +1,8 @@ \section{Base Logic} \label{sec:base-logic} -The base logic is parameterized by an arbitrary CMRA $\monoid$ having a unit $\munit$. -By \lemref{lem:cmra-unit-total-core}, this means that the core of $\monoid$ is a total function, so we will treat it as such in the following. +The base logic is parameterized by an arbitrary camera $\monoid$ having a unit $\munit$. +By \lemref{lem:camera-unit-total-core}, this means that the core of $\monoid$ is a total function, so we will treat it as such in the following. This defines the structure of resources that can be owned. As usual for higher-order logics, you can furthermore pick a \emph{signature} $\Sig = (\SigType, \SigFn, \SigAx)$ to add more types, symbols and axioms to the language. @@ -193,7 +193,7 @@ In writing $\vctx, x:\type$, we presuppose that $x$ is not already declared in $ \infer{\vctx \proves \wtt{\melt}{\textlog{M}}} {\vctx \proves \wtt{\ownM{\melt}}{\Prop}} \and - \infer{\vctx \proves \wtt{\melt}{\type} \and \text{$\type$ is a CMRA}} + \infer{\vctx \proves \wtt{\melt}{\type} \and \text{$\type$ is a camera}} {\vctx \proves \wtt{\mval(\melt)}{\Prop}} \and \infer{\vctx \proves \wtt{\prop}{\Prop}} @@ -212,13 +212,13 @@ In writing $\vctx, x:\type$, we presuppose that $x$ is not already declared in $ } \end{mathparpagebreakable} -\subsection{Proof rules} +\subsection{Proof Rules} \label{sec:proof-rules} The judgment $\vctx \mid \prop \proves \propB$ says that with free variables $\vctx$, proposition $\propB$ holds whenever assumption $\prop$ holds. Most of the rules will entirely omit the variable contexts $\vctx$. In this case, we assume the same arbitrary context is used for every constituent of the rules. -%Furthermore, an arbitrary \emph{boxed} assertion context $\always\pfctx$ may be added to every constituent. +%Furthermore, an arbitrary \emph{boxed} proposition context $\always\pfctx$ may be added to every constituent. Axioms $\vctx \mid \prop \provesIff \propB$ indicate that both $\vctx \mid \prop \proves \propB$ and $\vctx \mid \propB \proves \prop$ are proof rules of the logic. \judgment{\vctx \mid \prop \proves \propB} @@ -448,7 +448,7 @@ Furthermore, we have the usual $\eta$ and $\beta$ laws for projections, $\textlo {\upd\plainly\prop \proves \prop} \end{mathpar} The premise in \ruleref{upd-update} is a \emph{meta-level} side-condition that has to be proven about $a$ and $B$. -%\ralf{Trouble is, we don't actually have $\in$ inside the logic...} +%\ralf{Trouble is, we do not actually have $\in$ inside the logic...} \subsection{Consistency} diff --git a/docs/bib.bib b/docs/bib.bib index 239c73fc4372409f6f18d9ec1aad2e0af4fec1d9..db38003884989ad60c86be1638b61ed6018a5ea4 100644 --- a/docs/bib.bib +++ b/docs/bib.bib @@ -3829,3 +3829,10 @@ year = {2013} pages = {256--269}, year = {2016}, } + +@Article{iris-ground-up, + author={Ralf Jung and Robbert Krebbers and Jacques-Henri Jourdan and Ale\v{s} Bizjak and Lars Birkedal and Derek Dreyer}, + title={Iris from the Ground Up}, + journal={Submitted to JFP}, + year = {2017}, +} diff --git a/docs/constructions.tex b/docs/constructions.tex index 7290dcf39478ff92248f1ed9f096dc9c92131141..8987f87333918745da9f72701f26fa6e41bc4293 100644 --- a/docs/constructions.tex +++ b/docs/constructions.tex @@ -1,11 +1,11 @@ -\section{OFE and COFE constructions} +\section{OFE and COFE Constructions} -\subsection{Trivial pointwise lifting} +\subsection{Trivial Pointwise Lifting} The (C)OFE structure on many types can be easily obtained by pointwise lifting of the structure of the components. This is what we do for option $\maybe\cofe$, product $(M_i)_{i \in I}$ (with $I$ some finite index set), sum $\cofe + \cofe'$ and finite partial functions $K \fpfn \monoid$ (with $K$ infinite countable). -\subsection{Next (type-level later)} +\subsection{Next (Type-Level Later)} Given a OFE $\cofe$, we define $\latert\cofe$ as follows (using a datatype-like notation to define the type): \begin{align*} @@ -19,42 +19,44 @@ $\latert(-)$ is a locally \emph{contractive} functor from $\OFEs$ to $\OFEs$. \subsection{Uniform Predicates} -Given a CMRA $\monoid$, we define the COFE $\UPred(\monoid)$ of \emph{uniform predicates} over $\monoid$ as follows: +Given a camera $\monoid$, we define the COFE $\UPred(\monoid)$ of \emph{uniform predicates} over $\monoid$ as follows: \begin{align*} - \UPred(\monoid) \eqdef{} \setComp{\pred: \nat \times \monoid \to \mProp}{ - \begin{inbox}[c] - (\All n, x, y. \pred(n, x) \land x \nequiv{n} y \Ra \pred(n, y)) \land {}\\ - (\All n, m, x, y. \pred(n, x) \land x \mincl y \land m \leq n \land y \in \mval_m \Ra \pred(m, y)) - \end{inbox} -} +\monoid \monnra \SProp \eqdef{}& \setComp{\pred: \monoid \nfn \SProp} +{\All n, \melt, \meltB. \melt \mincl[n] \meltB \Ra \pred(\melt) \nincl{n} \pred(\meltB)} \\ + \UPred(\monoid) \eqdef{}& \faktor{\monoid \monnra \SProp}{\equiv} \\ + \pred \equiv \predB \eqdef{}& \All m, \melt. m \in \mval(\melt) \Ra (m \in \pred(\melt) \iff m \in \predB(\melt)) \\ + \pred \nequiv{n} \predB \eqdef{}& \All m \le n, \melt. m \in \mval(\melt) \Ra (m \in \pred(\melt) \iff m \in \predB(\melt)) \end{align*} -where $\mProp$ is the set of meta-level propositions, \eg Coq's \texttt{Prop}. +You can think of uniform predicates as monotone, step-indexed predicates over a camera that ``ignore'' invalid elements (as defined by the quotient). + $\UPred(-)$ is a locally non-expansive functor from $\CMRAs$ to $\COFEs$. -One way to understand this definition is to re-write it a little. -We start by defining the COFE of \emph{step-indexed propositions}: For every step-index, the proposition either holds or does not hold. +It is worth noting that the above quotient admits canonical +representatives. More precisely, one can show that every +equivalence class contains exactly one element $P_0$ such that: \begin{align*} - \SProp \eqdef{}& \psetdown{\nat} \\ - \eqdef{}& \setComp{X \in \pset{\nat}}{ \All n, m. n \geq m \Ra n \in X \Ra m \in X } \\ - X \nequiv{n} Y \eqdef{}& \All m \leq n. m \in X \Lra m \in Y + \All n, \melt. (\mval(\melt) \nincl{n} P_0(\melt)) \Ra n \in P_0(\melt) \tagH{UPred-canonical} \end{align*} -Notice that this notion of $\SProp$ is already hidden in the validity predicate $\mval_n$ of a CMRA: -We could equivalently require every CMRA to define $\mval_{-}(-) : \monoid \nfn \SProp$, replacing \ruleref{cmra-valid-ne} and \ruleref{cmra-valid-mono}. +Intuitively, this says that $P_0$ trivially holds whenever the resource is invalid. +Starting from any element $P$, one can find this canonical +representative by choosing $P_0(\melt) := \setComp{n}{n \in \mval(\melt) \Ra n \in P(\melt)}$. + +Hence, as an alternative definition of $\UPred$, we could use the set +of canonical representatives. This alternative definition would +save us from using a quotient. However, the definitions of the various +connectives would get more complicated, because we have to make sure +they all verify \ruleref{UPred-canonical}, which sometimes requires some adjustments. We +would moreover need to prove one more property for every logical +connective. -Now we can rewrite $\UPred(\monoid)$ as monotone step-indexed predicates over $\monoid$, where the definition of a ``monotone'' function here is a little funny. -\begin{align*} - \UPred(\monoid) \cong{}& \monoid \monra \SProp \\ - \eqdef{}& \setComp{\pred: \monoid \nfn \SProp}{\All n, m, x, y. n \in \pred(x) \land x \mincl y \land m \leq n \land y \in \mval_m \Ra m \in \pred(y)} -\end{align*} -The reason we chose the first definition is that it is easier to work with in Coq. \clearpage -\section{RA and CMRA constructions} +\section{RA and Camera Constructions} \subsection{Product} \label{sec:prodm} -Given a family $(M_i)_{i \in I}$ of CMRAs ($I$ finite), we construct a CMRA for the product $\prod_{i \in I} M_i$ by lifting everything pointwise. +Given a family $(M_i)_{i \in I}$ of cameras ($I$ finite), we construct a camera for the product $\prod_{i \in I} M_i$ by lifting everything pointwise. Frame-preserving updates on the $M_i$ lift to the product: \begin{mathpar} @@ -66,21 +68,21 @@ Frame-preserving updates on the $M_i$ lift to the product: \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 (again, we use a datatype-like notation): +The \emph{sum camera} $\monoid_1 \csumm \monoid_2$ for any cameras $\monoid_1$ and $\monoid_2$ is defined as (again, we use a datatype-like notation): \begin{align*} \monoid_1 \csumm \monoid_2 \eqdef{}& \cinl(\melt_1:\monoid_1) \mid \cinr(\melt_2:\monoid_2) \mid \mundef \\ - \mval_n \eqdef{}& \setComp{\cinl(\melt_1)}{\melt_1 \in \mval'_n} - \cup \setComp{\cinr(\melt_2)}{\melt_2 \in \mval''_n} \\ + \mval(\mundef) \eqdef{}& \emptyset \\ + \mval(\cinl(\melt)) \eqdef{}& \mval_1(\melt) \\ \cinl(\melt_1) \mtimes \cinl(\meltB_1) \eqdef{}& \cinl(\melt_1 \mtimes \meltB_1) \\ % \munit \mtimes \ospending \eqdef{}& \ospending \mtimes \munit \eqdef \ospending \\ % \munit \mtimes \osshot(\melt) \eqdef{}& \osshot(\melt) \mtimes \munit \eqdef \osshot(\melt) \\ \mcore{\cinl(\melt_1)} \eqdef{}& \begin{cases}\mnocore & \text{if $\mcore{\melt_1} = \mnocore$} \\ \cinl({\mcore{\melt_1}}) & \text{otherwise} \end{cases} \end{align*} -The composition and core for $\cinr$ are defined symmetrically. +Above, $\mval_1$ refers to the validity of $\monoid_1$. +The validity, composition and core for $\cinr$ are defined symmetrically. The remaining cases of the composition and core are all $\mundef$. -Above, $\mval'$ refers to the validity of $\monoid_1$, and $\mval''$ to the validity of $\monoid_2$. -Notice that we added the artificial ``invalid'' (or ``undefined'') element $\mundef$ to this CMRA just in order to make certain compositions of elements (in this case, $\cinl$ and $\cinr$) invalid. +Notice that we added the artificial ``invalid'' (or ``undefined'') element $\mundef$ to this camera just in order to make certain compositions of elements (in this case, $\cinl$ and $\cinr$) invalid. The step-indexed equivalence is inductively defined as follows: \begin{mathpar} @@ -99,54 +101,54 @@ We obtain the following frame-preserving updates, as well as their symmetric cou {\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''} + {\All \melt_\f \in M, n. n \notin \mval(\melt \mtimes \melt_\f) \and \mvalFull(\meltB)} {\cinl(\melt) \mupd \cinr(\meltB)} \end{mathpar} -Crucially, the second rule allows us to \emph{swap} the ``side'' of the sum that the CMRA is on if $\mval$ has \emph{no possible frame}. +Crucially, the second rule allows us to \emph{swap} the ``side'' of the sum that the camera is on if $\mval$ has \emph{no possible frame}. \subsection{Option} -The definition of the (CM)RA axioms already lifted the composition operation on $\monoid$ to one on $\maybe\monoid$. -We can easily extend this to a full CMRA by defining a suitable core, namely +The definition of the camera/RA axioms already lifted the composition operation on $\monoid$ to one on $\maybe\monoid$. +We can easily extend this to a full camera by defining a suitable core, namely \begin{align*} \mcore{\mnocore} \eqdef{}& \mnocore & \\ \mcore{\maybe\melt} \eqdef{}& \mcore\melt & \text{If $\maybe\melt \neq \mnocore$} \end{align*} Notice that this core is total, as the result always lies in $\maybe\monoid$ (rather than in $\maybe{\mathord{\maybe\monoid}}$). -\subsection{Finite partial function} +\subsection{Finite Partial Functions} \label{sec:fpfnm} -Given some infinite countable $K$ and some CMRA $\monoid$, the set of finite partial functions $K \fpfn \monoid$ is equipped with a CMRA structure by lifting everything pointwise. +Given some infinite countable $K$ and some camera $\monoid$, the set of finite partial functions $K \fpfn \monoid$ is equipped with a camera structure by lifting everything pointwise. We obtain the following frame-preserving updates: \begin{mathpar} \inferH{fpfn-alloc-strong} - {\text{$G$ infinite} \and \melt \in \mval} + {\text{$G$ infinite} \and \mvalFull(\melt)} {\emptyset \mupd \setComp{\mapsingleton \gname \melt}{\gname \in G}} \inferH{fpfn-alloc} - {\melt \in \mval} + {\mvalFull(\melt)} {\emptyset \mupd \setComp{\mapsingleton \gname \melt}{\gname \in K}} \inferH{fpfn-update} {\melt \mupd_\monoid \meltsB} {\mapinsert i \melt f] \mupd \setComp{ \mapinsert i \meltB f}{\meltB \in \meltsB}} \end{mathpar} -Above, $\mval$ refers to the validity of $\monoid$. +Above, $\mvalFull$ refers to the (full) validity of $\monoid$. $K \fpfn (-)$ is a locally non-expansive functor from $\CMRAs$ to $\CMRAs$. \subsection{Agreement} -Given some OFE $\cofe$, we define the CMRA $\agm(\cofe)$ as follows: +Given some OFE $\cofe$, we define the camera $\agm(\cofe)$ as follows: \begin{align*} \agm(\cofe) \eqdef{}& \setComp{\melt \in \finpset\cofe}{\melt \neq \emptyset} /\ {\sim} \\[-0.2em] \melt \nequiv{n} \meltB \eqdef{}& (\All x \in \melt. \Exists y \in \meltB. x \nequiv{n} y) \land (\All y \in \meltB. \Exists x \in \melt. x \nequiv{n} y) \\ \textnormal{where }& \melt \sim \meltB \eqdef{} \All n. \melt \nequiv{n} \meltB \\ ~\\ % \All n \in {\melt.V}.\, \melt.x \nequiv{n} \meltB.x \\ - \mval_n \eqdef{}& \setComp{\melt \in \agm(\cofe)}{ \All x, y \in \melt. x \nequiv{n} y } \\ + \mval(\melt) \eqdef{}& \setComp{n}{ \All x, y \in \melt. x \nequiv{n} y } \\ \mcore\melt \eqdef{}& \melt \\ \melt \mtimes \meltB \eqdef{}& \melt \cup \meltB \end{align*} @@ -158,20 +160,20 @@ We define a non-expansive injection $\aginj$ into $\agm(\cofe)$ as follows: \[ \aginj(x) \eqdef \set{x} \] There are no interesting frame-preserving updates for $\agm(\cofe)$, but we can show the following: \begin{mathpar} - \axiomH{ag-val}{\aginj(x) \in \mval_n} + \axiomH{ag-val}{\mvalFull(\aginj(x))} \axiomH{ag-dup}{\aginj(x) = \aginj(x)\mtimes\aginj(x)} - \axiomH{ag-agree}{\aginj(x) \mtimes \aginj(y) \in \mval_n \Lra x \nequiv{n} y} + \axiomH{ag-agree}{n \in \mval(\aginj(x) \mtimes \aginj(y)) \Ra x \nequiv{n} y} \end{mathpar} -\subsection{Exclusive CMRA} +\subsection{Exclusive Camera} -Given an OFE $\cofe$, we define a CMRA $\exm(\cofe)$ such that at most one $x \in \cofe$ can be owned: +Given an OFE $\cofe$, we define a camera $\exm(\cofe)$ such that at most one $x \in \cofe$ can be owned: \begin{align*} \exm(\cofe) \eqdef{}& \exinj(\cofe) \mid \mundef \\ - \mval_n \eqdef{}& \setComp{\melt\in\exm(\cofe)}{\melt \neq \mundef} + \mval(\melt) \eqdef{}& \setComp{n}{\melt \notnequiv{n} \mundef} \end{align*} All cases of composition go to $\mundef$. \begin{align*} @@ -194,7 +196,25 @@ We obtain the following frame-preserving update: {\exinj(x) \mupd \exinj(y)} \end{mathpar} +\subsection{Fractions} +We define an RA structure on the rational numbers in $(0, 1]$ as follows: +\begin{align*} + \fracm \eqdef{}& \fracinj(\mathbb{Q} \cap (0, 1]) \mid \mundef \\ + \mvalFull(\melt) \eqdef{}& \melt \neq \mundef \\ + \fracinj(q_1) \mtimes \fracinj(q_2) \eqdef{}& \fracinj(q_1 + q_2) \quad \text{if $q_1 + q_2 \leq 1$} \\ + \mcore{\fracinj(x)} \eqdef{}& \bot \\ + \mcore{\mundef} \eqdef{}& \mundef +\end{align*} +All remaining cases of composition go to $\mundef$. +Frequently, we will write just $x$ instead of $\fracinj(x)$. + +The most important property of this RA is that $1$ has no frame. +This is useful in combination with \ruleref{sum-swap}, and also when used with pairs: +\begin{mathpar} + \inferH{pair-frac-change}{} + {(1, a) \mupd (1, b)} +\end{mathpar} %TODO: These need syncing with Coq % \subsection{Finite Powerset Monoid} @@ -225,63 +245,16 @@ We obtain the following frame-preserving update: % \end{proof} -% \subsection{Fractional monoid} -% \label{sec:fracm} - -% Given a monoid $M$, we define a monoid representing fractional ownership of some piece $\melt \in M$. -% The idea is to preserve all the frame-preserving update that $M$ could have, while additionally being able to do \emph{any} update if we own the full state (as determined by the fraction being $1$). -% Let $\fracm{M}$ be the monoid with carrier $(((0, 1] \cap \mathbb{Q}) \times M) \uplus \{\munit\}$ and multiplication -% \begin{align*} -% (q, a) \mtimes (q', a') &\eqdef (q + q', a \mtimes a') \qquad \mbox{if $q+q'\le 1$} \\ -% (q, a) \mtimes \munit &\eqdef (q,a) \\ -% \munit \mtimes (q,a) &\eqdef (q,a). -% \end{align*} - -% We get the following frame-preserving update. -% \begin{mathpar} -% \inferH{FracUpdFull} -% {a, b \in M} -% {(1, a) \mupd (1, b)} -% \and\inferH{FracUpdLocal} -% {a \mupd_M B} -% {(q, a) \mupd \{q\} \times B} -% \end{mathpar} - -% \begin{proof}[Proof of \ruleref{FracUpdFull}] -% Assume some $f \sep (1, a)$. This can only be $f = \munit$, so showing $f \sep (1, b)$ is trivial. -% \end{proof} - -% \begin{proof}[Proof of \ruleref{FracUpdLocal}] -% Assume some $f \sep (q, a)$. If $f = \munit$, then $f \sep (q, b)$ is trivial for any $b \in B$. Just pick the one we obtain by choosing $\munit_M$ as the frame for $a$. - -% In the interesting case, we have $f = (q_\f, a_\f)$. -% Obtain $b$ such that $b \in B \land b \sep a_\f$. -% Then $(q, b) \sep f$, and we are done. -% \end{proof} - -% $\fracm{M}$ is cancellative if $M$ is cancellative. -% \begin{proof}[Proof of cancellativitiy] -% If $\melt_\f = \munit$, we are trivially done. -% So let $\melt_\f = (q_\f, \melt_\f')$. -% If $\melt = \munit$, then $\meltB = \munit$ as otherwise the fractions could not match up. -% Again, we are trivially done. -% Similar so for $\meltB = \munit$. -% So let $\melt = (q_a, \melt')$ and $\meltB = (q_b, \meltB')$. -% We have $(q_\f + q_a, \melt_\f' \mtimes \melt') = (q_\f + q_b, \melt_\f' \mtimes \meltB')$. -% We have to show $q_a = q_b$ and $\melt' = \meltB'$. -% The first is trivial, the second follows from cancellativitiy of $M$. -% \end{proof} - \subsection{Authoritative} -\label{sec:auth-cmra} +\label{sec:auth-camera} -Given a CMRA $M$, we construct $\authm(M)$ modeling someone owning an \emph{authoritative} element $\melt$ of $M$, and others potentially owning fragments $\meltB \mincl \melt$ of $\melt$. +Given a camera $M$, we construct $\authm(M)$ modeling someone owning an \emph{authoritative} element $\melt$ of $M$, and others potentially owning fragments $\meltB \mincl \melt$ of $\melt$. We assume that $M$ has a unit $\munit$, and hence its core is total. (If $M$ is an exclusive monoid, the construction is very similar to a half-ownership monoid with two asymmetric halves.) \begin{align*} \authm(M) \eqdef{}& \maybe{\exm(M)} \times M \\ -\mval_n \eqdef{}& \setComp{ (x, \meltB) \in \authm(M) }{ \meltB \in \mval_n \land (x = \mnocore \lor \Exists \melt. x = \exinj(\melt) \land \meltB \mincl_n \melt) } \\ +\mval( (x, \meltB ) ) \eqdef{}& \setComp{ n }{ n \in \mval(\meltB) \land (x = \mnocore \lor \Exists \melt. x = \exinj(\melt) \land \meltB \mincl_n \melt) } \\ (x_1, \meltB_1) \mtimes (x_2, \meltB_2) \eqdef{}& (x_1 \mtimes x_2, \meltB_2 \mtimes \meltB_2) \\ \mcore{(x, \meltB)} \eqdef{}& (\mnocore, \mcore\meltB) \\ (x_1, \meltB_1) \nequiv{n} (x_2, \meltB_2) \eqdef{}& x_1 \nequiv{n} x_2 \land \meltB_1 \nequiv{n} \meltB_2 @@ -295,7 +268,7 @@ The frame-preserving update involves the notion of a \emph{local update}: \newcommand\lupd{\stackrel{\mathrm l}{\mupd}} \begin{defn} It is possible to do a \emph{local update} from $\melt_1$ and $\meltB_1$ to $\melt_2$ and $\meltB_2$, written $(\melt_1, \meltB_1) \lupd (\melt_2, \meltB_2)$, if - \[ \All n, \maybe{\melt_\f}. \melt_1 \in \mval_n \land \melt_1 \nequiv{n} \meltB_1 \mtimes \maybe{\melt_\f} \Ra \melt_2 \in \mval_n \land \melt_2 \nequiv{n} \meltB_2 \mtimes \maybe{\melt_\f} \] + \[ \All n, \maybe{\melt_\f}. n \in \mval(\melt_1) \land \melt_1 \nequiv{n} \meltB_1 \mtimes \maybe{\melt_\f} \Ra n \in \mval(\melt_2) \land \melt_2 \nequiv{n} \meltB_2 \mtimes \maybe{\melt_\f} \] \end{defn} In other words, the idea is that for every possible frame $\maybe{\melt_\f}$ completing $\meltB_1$ to $\melt_1$, the same frame also completes $\meltB_2$ to $\melt_2$. @@ -306,8 +279,8 @@ We then obtain {\authfull \melt_1 , \authfrag \meltB_1 \mupd \authfull \melt_2 , \authfrag \meltB_2} \end{mathpar} -\subsection{STS with tokens} -\label{sec:sts-cmra} +\subsection{STS with Tokens} +\label{sec:sts-camera} Given a state-transition system~(STS, \ie a directed graph) $(\STSS, {\stsstep} \subseteq \STSS \times \STSS)$, a set of tokens $\STST$, and a labeling $\STSL: \STSS \ra \wp(\STST)$ of \emph{protocol-owned} tokens for each state, we construct an RA modeling an authoritative current state and permitting transitions given a \emph{bound} on the current state and a set of \emph{locally-owned} tokens. @@ -327,7 +300,7 @@ We further define \emph{closed} sets of states (given a particular set of tokens The STS RA is defined as follows \begin{align*} \monoid \eqdef{}& \STSauth(s:\STSS, T:\wp(\STST) \mid \STSL(s) \disj T) \mid{}\\& \STSfrag(S: \wp(\STSS), T: \wp(\STST) \mid \STSclsd(S, T) \land S \neq \emptyset) \mid \mundef \\ - \mval \eqdef{}& \setComp{\melt\in\monoid}{\melt \neq \mundef} \\ + \mvalFull(\melt) \eqdef{}& \melt \neq \mundef \\ \STSfrag(S_1, T_1) \mtimes \STSfrag(S_2, T_2) \eqdef{}& \STSfrag(S_1 \cap S_2, T_1 \cup T_2) \qquad\qquad\qquad \text{if $T_1 \disj T_2$ and $S_1 \cap S_2 \neq \emptyset$} \\ \STSfrag(S, T) \mtimes \STSauth(s, T') \eqdef{}& \STSauth(s, T') \mtimes \STSfrag(S, T) \eqdef \STSauth(s, T \cup T') \qquad \text{if $T \disj T'$ and $s \in S$} \\ \mcore{\STSfrag(S, T)} \eqdef{}& \STSfrag(\upclose(S, \emptyset), \emptyset) \\ diff --git a/docs/derived.tex b/docs/derived.tex index 13474276b789c17bccc6e7215c56fbd459908fb7..95181ccb5de87422772a129a7fa669e5da9fe359 100644 --- a/docs/derived.tex +++ b/docs/derived.tex @@ -1,6 +1,36 @@ -\section{Derived constructions} +\section{Derived Constructions} -\subsection{Non-atomic (``thread-local'') invariants} +\subsection{Cancellable Invariants} + +Iris invariants as described in \Sref{sec:invariants} are persistent---once established, they hold forever. +However, based on them, it is possible to \emph{encode} a form of invariants that can be ``cancelled'' again. + +First, we need some ghost state: +\begin{align*} + \textmon{CInvTok} \eqdef{}& \fracm +\end{align*} + +Now we define: +\begin{align*} + \CInvTok{\gname}{q} \eqdef{}& \ownGhost\gname{q} \\ + \CInv{\gname}{\namesp}{\prop} \eqdef{}& \knowInv\namesp{\prop \lor \ownGhost\gname{1}} +\end{align*} + +It is then straightforward to prove: +\begin{mathpar} + \inferH{CInv-new}{} + {\later\prop \vs[\bot] \Exists \gname. \CInvTok\gname{1} * \always\CInv\gname\namesp\prop} + + \inferH{CInv-acc}{} + {\CInv\gname\namesp\prop \proves \Acc[\namesp][\emptyset]{\CInvTok\gname{q}}{\later\prop}} + + \inferH{CInv-cancel}{} + {\CInv\gname\namesp\prop \proves \CInvTok\gname{1} \vs[\namesp] \later\prop} +\end{mathpar} + +Cancellable invariants are useful, for example, when reasoning about data structures that will be deallocated: Every reference to the data structure comes with a fraction of the token, and when all fractions have been gathered, \ruleref{CInv-cancel} is used to cancel the invariant, after which the data structure can be deallocated. + +\subsection{Non-atomic (``Thread-Local'') Invariants} Sometimes it is necessary to maintain invariants that we need to open non-atomically. Clearly, for this mechanism to be sound we need something that prevents us from opening the same invariant twice, something like the masks that avoid reentrancy on the ``normal'', atomic invariants. @@ -40,16 +70,16 @@ To simplify this construction,we piggy-back into ``normal'' invariants. We easily obtain: \begin{mathpar} - \axiom + \axiomH{NAInv-new-pool} {\TRUE \vs[\bot] \Exists\pid. \NaTok\pid} - \axiom + \axiomH{NAInv-tok-split} {\NaTokE\pid{\mask_1 \uplus \mask_2} \Lra \NaTokE\pid{\mask_1} * \NaTokE\pid{\mask_2}} - \axiom + \axiomH{NAInv-new-inv} {\later\prop \vs[\namesp] \always\NaInv\pid\namesp\prop} - \axiom + \axiomH{NAInv-acc} {\NaInv\pid\namesp\prop \proves \Acc[\namesp]{\NaTokE\pid\namesp}{\later\prop}} \end{mathpar} from which we can derive @@ -61,18 +91,18 @@ from which we can derive \subsection{Boxes} -The idea behind the \emph{boxes} is to have an assertion $\prop$ that is actually split into a number of pieces, each of which can be taken out and back in separately. -In some sense, this is a replacement for having an ``authoritative PCM of Iris assertions itself''. +The idea behind the \emph{boxes} is to have an proposition $\prop$ that is actually split into a number of pieces, each of which can be taken out and back in separately. +In some sense, this is a replacement for having an ``authoritative PCM of Iris propositions itself''. It is similar to the pattern involving saved propositions that was used for the barrier~\cite{iris2}, but more complicated because there are some operations that we want to perform without a later. -Roughly, the idea is that a \emph{box} is a container for an assertion $\prop$. -A box consists of a bunch of \emph{slices} which decompose $\prop$ into a separating conjunction of the assertions $\propB_\sname$ governed by the individual slices. +Roughly, the idea is that a \emph{box} is a container for an proposition $\prop$. +A box consists of a bunch of \emph{slices} which decompose $\prop$ into a separating conjunction of the propositions $\propB_\sname$ governed by the individual slices. Each slice is either \emph{full} (it right now contains $\propB_\sname$), or \emph{empty} (it does not contain anything currently). -The assertion governing the box keeps track of the state of all the slices that make up the box. +The proposition governing the box keeps track of the state of all the slices that make up the box. The crux is that opening and closing of a slice can be done even if we only have ownership of the boxes ``later'' ($\later$). The interface for boxes is as follows: -The two core assertions are: $\BoxSlice\namesp\prop\sname$, saying that there is a slice in namespace $\namesp$ with name $\sname$ and content $\prop$; and $\ABox\namesp\prop{f}$, saying that $f$ describes the slices of a box in namespace $\namesp$, such that all the slices together contain $\prop$. Here, $f$ is of type $\nat \fpfn \BoxState$ mapping names to states, where $\BoxState \eqdef \set{\BoxFull, \BoxEmp}$. +The two core propositions are: $\BoxSlice\namesp\prop\sname$, saying that there is a slice in namespace $\namesp$ with name $\sname$ and content $\prop$; and $\ABox\namesp\prop{f}$, saying that $f$ describes the slices of a box in namespace $\namesp$, such that all the slices together contain $\prop$. Here, $f$ is of type $\nat \fpfn \BoxState$ mapping names to states, where $\BoxState \eqdef \set{\BoxFull, \BoxEmp}$. \begin{mathpar} \inferH{Box-create}{} {\TRUE \vs[\namesp] \ABox\namesp\TRUE\emptyset} @@ -109,13 +139,13 @@ This is essentially an \emph{optional later}, indicating that the lemmas can be \newcommand\SliceInv{\textlog{SliceInv}} The above rules are validated by the following model. -We need a CMRA as follows: +We need a camera as follows: \begin{align*} \BoxState \eqdef{}& \BoxFull + \BoxEmp \\ \BoxM \eqdef{}& \authm(\maybe{\exm(\BoxState)}) \times \maybe{\agm(\latert \iProp)} \end{align*} -Now we can define the assertions: +Now we can define the propositions: \begin{align*} \SliceInv(\sname, \prop) \eqdef{}& \Exists b. \ownGhost\sname{(\authfull b, \munit)} * ((b = \BoxFull) \Ra \prop) \\ \BoxSlice\namesp\prop\sname \eqdef{}& \ownGhost\sname{(\munit, \prop)} * \knowInv\namesp{\SliceInv(\sname,\prop)} \\ diff --git a/docs/ghost-state.tex b/docs/ghost-state.tex index bd10d54efa60000c9290d79789776440300a521a..8d15141405245ee9c6501c9b2338aa4b3bf05b53 100644 --- a/docs/ghost-state.tex +++ b/docs/ghost-state.tex @@ -3,7 +3,7 @@ In this section we discuss some additional constructions that we define within and on top of the base logic. These are not ``extensions'' in the sense that they change the proof power of the logic, they just form useful derived principles. -\subsection{Derived rules about base connectives} +\subsection{Derived Rules about Base Connectives} We collect here some important and frequently used derived proof rules. \begin{mathparpagebreakable} \infer{} @@ -42,9 +42,9 @@ We collect here some important and frequently used derived proof rules. Noteworthy here is the fact that $\prop \proves \later\prop$ can be derived from Löb induction, and $\TRUE \proves \plainly\TRUE$ can be derived via $\plainly$ commuting with universal quantification ranging over the empty type $0$. -\subsection{Persistent assertions} -We call an assertion $\prop$ \emph{persistent} if $\prop \proves \always\prop$. -These are assertions that ``don't own anything'', so we can (and will) treat them like ``normal'' intuitionistic assertions. +\subsection{Persistent Propositions} +We call a proposition $\prop$ \emph{persistent} if $\prop \proves \always\prop$. +These are propositions that ``do not own anything'', so we can (and will) treat them like ``normal'' intuitionistic propositions. Of course, $\always\prop$ is persistent for any $\prop$. Furthermore, by the proof rules given in \Sref{sec:proof-rules}, $\TRUE$, $\FALSE$, $t = t'$ as well as $\ownGhost\gname{\mcore\melt}$ and $\mval(\melt)$ are persistent. @@ -52,15 +52,15 @@ Persistence is preserved by conjunction, disjunction, separating conjunction as -\subsection{Timeless assertions and except-0} +\subsection{Timeless Propositions and Except-0} One of the troubles of working in a step-indexed logic is the ``later'' modality $\later$. It turns out that we can somewhat mitigate this trouble by working below the following \emph{except-0} modality: \[ \diamond \prop \eqdef \later\FALSE \lor \prop \] -This modality is useful because there is a class of assertions which we call \emph{timeless} assertions, for which we have +This modality is useful because there is a class of propositions which we call \emph{timeless} propositions, for which we have \[ \timeless{\prop} \eqdef \later\prop \proves \diamond\prop \] -In other words, when working below the except-0 modality, we can \emph{strip away} the later from timeless assertions. +In other words, when working below the except-0 modality, we can \emph{strip away} the later from timeless propositions. The following rules can be derived about except-0: \begin{mathpar} @@ -88,7 +88,7 @@ The following rules can be derived about except-0: \end{array} \end{mathpar} -The following rules identify the class of timeless assertions: +The following rules identify the class of timeless propositions: \begin{mathparpagebreakable} \infer {\vctx \proves \timeless{\prop} \and \vctx \proves \timeless{\propB}} @@ -135,11 +135,109 @@ The following rules identify the class of timeless assertions: {\timeless{\ownM\melt}} \infer -{\text{$\melt$ is an element of a discrete CMRA}} +{\text{$\melt$ is an element of a discrete camera}} {\timeless{\mval(\melt)}} \end{mathparpagebreakable} +\subsection{Dynamic Composeable Higher-Order Resources} +\label{sec:composeable-resources} + +The base logic described in \Sref{sec:base-logic} works over an arbitrary camera $\monoid$ defining the structure of the resources. +It turns out that we can generalize this further and permit picking cameras ``$\iFunc(\Prop)$'' that depend on the structure of propositions themselves. +Of course, $\Prop$ is just the syntactic type of propositions; for this to make sense we have to look at the semantics. + +Furthermore, there is a composability problem with the given logic: if we have one proof performed with camera $\monoid_1$, and another proof carried out with a \emph{different} camera $\monoid_2$, then the two proofs are actually carried out in two \emph{entirely separate logics} and hence cannot be combined. + +Finally, in many cases just having a single ``instance'' of a camera available for reasoning is not enough. +For example, when reasoning about a dynamically allocated data structure, every time a new instance of that data structure is created, we will want a fresh resource governing the state of this particular instance. +While it would be possible to handle this problem whenever it comes up, it turns out to be useful to provide a general solution. + +The purpose of this section is to describe how we solve these issues. + +\paragraph{Picking the resources.} +The key ingredient that we will employ on top of the base logic is to give some more fixed structure to the resources. +To instantiate the logic with dynamic higher-order ghost state, the user picks a family of locally contractive bifunctors $(\iFunc_i : \OFEs^\op \times \OFEs \to \CMRAs)_{i \in \mathcal{I}}$. +(This is in contrast to the base logic, where the user picks a single, fixed camera that has a unit.) + +From this, we construct the bifunctor defining the overall resources as follows: +\begin{align*} + \GName \eqdef{}& \nat \\ + \textdom{ResF}(\ofe^\op, \ofe) \eqdef{}& \prod_{i \in \mathcal I} \GName \fpfn \iFunc_i(\ofe^\op, \ofe) +\end{align*} +We will motivate both the use of a product and the finite partial function below. +$\textdom{ResF}(\ofe^\op, \ofe)$ is a camera by lifting the individual cameras pointwise, and it has a unit (using the empty finite partial function). +Furthermore, since the $\iFunc_i$ are locally contractive, so is $\textdom{ResF}$. + +Now we can write down the recursive domain equation: +\[ \iPreProp \cong \UPred(\textdom{ResF}(\iPreProp, \iPreProp)) \] +Here, $\iPreProp$ is a COFE defined as the fixed-point of a locally contractive bifunctor, which exists and is unique up to isomorphism by \thmref{thm:america_rutten}, so we obtain some object $\iPreProp$ such that: +\begin{align*} + \Res &\eqdef \textdom{ResF}(\iPreProp, \iPreProp) \\ + \iProp &\eqdef \UPred(\Res) \\ + \wIso &: \iProp \nfn \iPreProp \\ + \wIso^{-1} &: \iPreProp \nfn \iProp \\ + \wIso(\wIso^{-1}(x)) &\eqdef x \\ + \wIso^{-1}(\wIso(x)) &\eqdef x +\end{align*} +Now we can instantiate the base logic described in \Sref{sec:base-logic} with $\Res$ as the chosen camera: +\[ \Sem{\Prop} \eqdef \UPred(\Res) \] +We obtain that $\Sem{\Prop} = \iProp$. +Effectively, we just defined a way to instantiate the base logic with $\Res$ as the camera of resources, while providing a way for $\Res$ to depend on $\iPreProp$, which is isomorphic to $\Sem\Prop$. + +We thus obtain all the rules of \Sref{sec:base-logic}, and furthermore, we can use the maps $\wIso$ and $\wIso^{-1}$ \emph{in the logic} to convert between logical propositions $\Sem\Prop$ and the domain $\iPreProp$ which is used in the construction of $\Res$ -- so from elements of $\iPreProp$, we can construct elements of $\Sem{\textlog M}$, which are the elements that can be owned in our logic. + +\paragraph{Proof composability.} +To make our proofs composeable, we \emph{generalize} our proofs over the family of functors. +This is possible because we made $\Res$ a \emph{product} of all the cameras picked by the user, and because we can actually work with that product ``pointwise''. +So instead of picking a \emph{concrete} family, proofs will assume to be given an \emph{arbitrary} family of functors, plus a proof that this family \emph{contains the functors they need}. +Composing two proofs is then merely a matter of conjoining the assumptions they make about the functors. +Since the logic is entirely parametric in the choice of functors, there is no trouble reasoning without full knowledge of the family of functors. + +Only when the top-level proof is completed we will ``close'' the proof by picking a concrete family that contains exactly those functors the proof needs. + +\paragraph{Dynamic resources.} +Finally, the use of finite partial functions lets us have as many instances of any camera as we could wish for: +Because there can only ever be finitely many instances already allocated, it is always possible to create a fresh instance with any desired (valid) starting state. +This is best demonstrated by giving some proof rules. + +So let us first define the notion of ghost ownership that we use in this logic. +Assuming that the family of functors contains the functor $\Sigma_i$ at index $i$, and furthermore assuming that $\monoid_i = \Sigma_i(\iPreProp, \iPreProp)$, given some $\melt \in \monoid_i$ we define: +\[ \ownGhost\gname{\melt:\monoid_i} \eqdef \ownM{(\ldots, \emptyset, i:\mapsingleton \gname \melt, \emptyset, \ldots)} \] +This is ownership of the pair (element of the product over all the functors) that has the empty finite partial function in all components \emph{except for} the component corresponding to index $i$, where we own the element $\melt$ at index $\gname$ in the finite partial function. + +We can show the following properties for this form of ownership: +\begin{mathparpagebreakable} + \inferH{res-alloc}{\text{$G$ infinite} \and \melt \in \mval_{M_i}} + { \TRUE \proves \upd \Exists\gname\in G. \ownGhost\gname{\melt : M_i} + } + \and + \inferH{res-update} + {\melt \mupd_{M_i} B} + {\ownGhost\gname{\melt : M_i} \proves \upd \Exists \meltB\in B. \ownGhost\gname{\meltB : M_i}} + + \inferH{res-empty} + {\text{$\munit$ is a unit of $M_i$}} + {\TRUE \proves \upd \ownGhost\gname\munit} + + \axiomH{res-op} + {\ownGhost\gname{\melt : M_i} * \ownGhost\gname{\meltB : M_i} \provesIff \ownGhost\gname{\melt\mtimes\meltB : M_i}} + + \axiomH{res-valid} + {\ownGhost\gname{\melt : M_i} \Ra \mval_{M_i}(\melt)} + + \inferH{res-timeless} + {\text{$\melt$ is a discrete OFE element}} + {\timeless{\ownGhost\gname{\melt : M_i}}} +\end{mathparpagebreakable} + +Below, we will always work within (an instance of) the logic as described here. +Whenever a camera is used in a proof, we implicitly assume it to be available in the global family of functors. +We will typically leave the $M_i$ implicit when asserting ghost ownership, as the type of $\melt$ will be clear from the context. + + + + %%% Local Variables: %%% mode: latex diff --git a/docs/iris.sty b/docs/iris.sty index 9ba0f619ee6025bb86dd090ac8e161017be62f73..afae4f8ec0649e9c78557a00f9e53296c701e47a 100644 --- a/docs/iris.sty +++ b/docs/iris.sty @@ -36,7 +36,7 @@ \newcommand{\upclose}{\mathord{\uparrow}} \newcommand{\ALT}{\ |\ } -\newcommand{\spac}{\,} % a space +\newcommand{\spac}{\hskip 0.2em plus 0.1em} % a space \def\All #1.{\forall #1.\spac}% \def\Exists #1.{\exists #1.\spac}% @@ -95,6 +95,9 @@ \newcommand{\nil}{\epsilon} +% displaced dot +\newcommand{\dispdot}[2][.2ex]{\dot{\raisebox{0pt}[\dimexpr\height+#1][\depth]{$#2$}}}% \dispdot[<displace>]{<stuff>} + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% MODEL-SPECIFIC SYMBOLS & NOTATION & IDENTIFIERS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -117,6 +120,7 @@ \newcommand{\wtt}[2]{#1 : #2} % well-typed term \newcommand{\nequiv}[1]{\ensuremath{\mathrel{\stackrel{#1}{=}}}} +\newcommand{\nincl}[1]{\ensuremath{\mathrel{\stackrel{#1}{\subseteq}}}} \newcommand{\notnequiv}[1]{\ensuremath{\mathrel{\stackrel{#1}{\neq}}}} \newcommand{\nequivset}[2]{\ensuremath{\mathrel{\stackrel{#1}{=}_{#2}}}} \newcommand{\nequivB}[1]{\ensuremath{\mathrel{\stackrel{#1}{\equiv}}}} @@ -151,8 +155,8 @@ \newcommand{\ofeB}{U} \newcommand{\cofe}{\ofe} \newcommand{\cofeB}{\ofeB} -\newcommand{\OFEs}{\mathcal{OFE}} % category of OFEs -\newcommand{\COFEs}{\mathcal{COFE}} % category of COFEs +\newcommand{\OFEs}{\mathbf{OFE}} % category of OFEs +\newcommand{\COFEs}{\mathbf{COFE}} % category of COFEs \newcommand{\iFunc}{\Sigma} \newcommand{\fix}{\textdom{fix}} @@ -191,7 +195,7 @@ $\preccurlyeq$\cr }}}}} -\newcommand{\CMRAs}{\mathcal{CMRA}} % category of CMRAs +\newcommand{\CMRAs}{\mathbf{Camera}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% LOGIC SYMBOLS & NOTATION & IDENTIFIERS @@ -216,6 +220,7 @@ \newcommand{\term}{t} \newcommand{\termB}{u} +\newcommand{\venv}{\rho} \newcommand{\vctx}{\Gamma} \newcommand{\pfctx}{\Theta} @@ -241,8 +246,8 @@ \newcommand{\fixp}{\mathit{fix}} %% various pieces of Syntax -\def\MU #1.{\mu\spac #1.\spac}% -\def\Lam #1.{\lambda #1.\spac}% +\def\MU #1.{\mu\,#1.\spac}% +\def\Lam #1.{\lambda\,#1.\spac}% \newcommand{\proves}{\vdash} \newcommand{\provesIff}{\mathrel{\dashv\vdash}} @@ -254,8 +259,14 @@ \newcommand{\gmapsto}{\hookrightarrow}% \newcommand{\fgmapsto}[1][\mathrm{-}]{\xhookrightarrow{#1}}% -\NewDocumentCommand\wpre{m O{} m}% - {\textlog{wp}_{#2}\spac#1\spac{\left\{#3\right\}}} +\NewDocumentCommand\wpre{O{} m O{} m}% + {\textlog{wp}^{#1}_{#3}\spac#2\spac{\left\{#4\right\}}} + +\newcommand{\stateinterp}{S} + +\newcommand\stuckness{s} +\newcommand\NotStuck{\textlog{NotStuck}} +\newcommand\MaybeStuck{\textlog{Stuck}} \newcommand{\later}{\mathop{{\triangleright}}} \newcommand*{\lateropt}[1]{\mathop{{\later}^{#1}}} @@ -290,7 +301,7 @@ }% }}% \NewDocumentCommand \vs {O{} O{}} {\vsGen[#1]{\Rrightarrow}[#2]} -\NewDocumentCommand \bvs {O{} O{}} {\vsGen[#1]{\Rrightarrow_{\mathcal{B}}}[#2]} +\NewDocumentCommand \bvs {O{} O{}} {\vsGen[#1]{\dispdot[0.02ex]{\Rrightarrow}}[#2]} \NewDocumentCommand \vsL {O{} O{}} {\vsGen[#1]{\Lleftarrow}[#2]} \NewDocumentCommand \vsE {O{} O{}} % {\vsGen[#1]{\Lleftarrow\!\!\!\Rrightarrow}[#2]} @@ -300,7 +311,7 @@ \NewDocumentCommand \vsW {O{} O{}} {\vsGen[#1]{\vsWand}[#2]} % for now, the update modality looks like a pvs without masks. -\NewDocumentCommand \upd {} {\mathop{\mid\kern-0.4ex\Rrightarrow\kern-0.25ex}} +\NewDocumentCommand \upd {} {\mathop{\dispdot[-0.2ex]{\mid\kern-0.4ex\Rrightarrow\kern-0.25ex}}} \NewDocumentCommand\Acc{O{} O{} m m}{\langle #3 \vsE #4 \rangle_{#1}^{#2}} @@ -352,7 +363,6 @@ \newcommand{\inhabited}[1]{\textlog{inhabited}(#1)} \newcommand{\timeless}[1]{\textlog{timeless}(#1)} \newcommand{\persistent}[1]{\textlog{persistent}(#1)} -\newcommand{\physatomic}[1]{\textlog{atomic}($#1$)} \newcommand{\infinite}{\textlog{infinite}} \newcommand\InvName{\textdom{InvName}} @@ -380,6 +390,7 @@ \newcommand{\toval}{\mathrm{expr\any to\any val}} \newcommand{\ofval}{\mathrm{val\any to\any expr}} \newcommand{\atomic}{\mathrm{atomic}} +\newcommand{\stronglyAtomic}{\mathrm{strongly\any atomic}} \newcommand{\red}{\mathrm{red}} \newcommand{\Lang}{\Lambda} @@ -402,6 +413,7 @@ % Fraction \newcommand{\fracm}{\ensuremath{\textmon{Frac}}} +\newcommand{\fracinj}{\textlog{frac}} % Exclusive \newcommand{\exm}{\ensuremath{\textmon{Ex}}} @@ -445,6 +457,10 @@ %% Stored Propositions \newcommand{\mapstoprop}{\mathrel{\kern-0.5ex\tikz[baseline=(m)]{\node at (0,0) (m){}; \draw[line cap=round] (0,0.16) -- (0,-0.004);}\kern-1.5ex\Ra}} +%% Cancellable invariants +\newcommand\CInv[3]{\textlog{CInv}^{#1,#2}(#3)} +\newcommand*\CInvTok[2]{{[}\textrm{CInv}:#1{]}_{#2}} + %% Non-atomic invariants \newcommand*\pid{p} \newcommand\NaInv[3]{\textlog{NaInv}^{#1.#2}(#3)} diff --git a/docs/iris.tex b/docs/iris.tex index dfe6a1dbc75fb3121ae453c90d5fc7b91579f9e3..05471a3abcce76c00a712e0e79047070cf16e263 100644 --- a/docs/iris.tex +++ b/docs/iris.tex @@ -32,28 +32,49 @@ The latest versions of this document and the Coq formalization can be found in t For further information, visit the Iris project website at \url{http://plv.mpi-sws.org/iris/}. \end{abstract} -\clearpage +\clearpage\begingroup \tableofcontents +\endgroup + +\clearpage\begingroup +\section{Iris from the Ground Up} +In \citetitle{iris-ground-up}~\cite{iris-ground-up}, we describe Iris~3.1 in a bottom-up way. +That paper is hence much more suited as an introduction to the model of Iris than this reference, which mostly contains definitions, not explanations or examples. +The following differences between Iris as described in \citetitle{iris-ground-up} and the latest version documented here are worth mentioning: +\begin{itemize} +\item As an experimental feature, we added the \emph{plainly modality} $\plainly$. +\item As an experimental feature, weakest preconditions take a \emph{stuckness} $\stuckness$ as parameter, indicating whether the program may get stuck or not. +\end{itemize} +\endgroup \clearpage\begingroup \input{algebra} -\endgroup\clearpage\begingroup +\endgroup +\clearpage\begingroup \input{constructions} -\endgroup\clearpage\begingroup +\endgroup +\clearpage\begingroup \input{base-logic} -\endgroup\clearpage\begingroup +\endgroup +\clearpage\begingroup \input{model} -\endgroup\clearpage\begingroup +\endgroup +\clearpage\begingroup \input{ghost-state} -\endgroup\clearpage\begingroup +\endgroup +\clearpage\begingroup \input{language} -\endgroup\clearpage\begingroup +\endgroup +\clearpage\begingroup \input{program-logic} -\endgroup\clearpage\begingroup +\endgroup +\clearpage\begingroup \input{derived} -\endgroup\clearpage\begingroup +\endgroup +\clearpage\begingroup \input{paradoxes} -\endgroup\clearpage\begingroup +\endgroup +\clearpage\begingroup \printbibliography \endgroup diff --git a/docs/language.tex b/docs/language.tex index f58120942900f2bc5a6f6bed1d42e03c82928804..5e59c5b3e9723dea26ac2e886e864feeb1c038fc 100644 --- a/docs/language.tex +++ b/docs/language.tex @@ -21,9 +21,14 @@ A \emph{language} $\Lang$ consists of a set \Expr{} of \emph{expressions} (metav \end{defn} \begin{defn} - An expression $\expr$ is \emph{atomic} if it reduces in one step to something irreducible: - \[ \All\state_1, \expr_2, \state_2, \vec\expr. \expr, \state_1 \step \expr_2, \state_2, \vec\expr \Ra \lnot \red(\expr_2, \state_2) \] + An expression $\expr$ is \emph{weakly atomic} if it reduces in one step to something irreducible: + \[ \atomic(\expr) \eqdef \All\state_1, \expr_2, \state_2, \vec\expr. \expr, \state_1 \step \expr_2, \state_2, \vec\expr \Ra \lnot \red(\expr_2, \state_2) \] + It is \emph{strongly atomic} if it reduces in one step to a value: + \[ \stronglyAtomic(\expr) \eqdef \All\state_1, \expr_2, \state_2, \vec\expr. \expr, \state_1 \step \expr_2, \state_2, \vec\expr \Ra \toval(\expr_2) \neq \bot \] \end{defn} +We need two notions of atomicity to accommodate both kinds of weakest preconditions that we will define later: +If the weakest precondition ensures that the program cannot get stuck, weak atomicity is sufficient. +Otherwise, we need strong atomicity. \begin{defn}[Context] A function $\lctx : \Expr \to \Expr$ is a \emph{context} if the following conditions are satisfied: @@ -37,7 +42,7 @@ A \emph{language} $\Lang$ consists of a set \Expr{} of \emph{expressions} (metav \end{enumerate} \end{defn} -\subsection{Concurrent language} +\subsection{Concurrent Language} For any language $\Lang$, we define the corresponding thread-pool semantics. diff --git a/docs/model.tex b/docs/model.tex index 6100fb39be49d0689d410ad482466b1962b4a34e..772089a25b3604bd7bd32df939faeb651a3993db 100644 --- a/docs/model.tex +++ b/docs/model.tex @@ -1,4 +1,4 @@ -\section{Model and semantics} +\section{Model and Semantics} \label{sec:model} The semantics closely follows the ideas laid out in~\cite{catlogic}. @@ -26,43 +26,43 @@ For the remaining base types $\type$ defined by the signature $\Sig$, we pick an \] For each function symbol $\sigfn : \type_1, \dots, \type_n \to \type_{n+1} \in \SigFn$, we pick a function $\Sem{\sigfn} : \Sem{\type_1} \times \dots \times \Sem{\type_n} \nfn \Sem{\type_{n+1}}$. -\judgment[Interpretation of assertions.]{\Sem{\vctx \proves \term : \Prop} : \Sem{\vctx} \nfn \UPred(\monoid)} +\judgment[Interpretation of propositions.]{\Sem{\vctx \proves \term : \Prop} : \Sem{\vctx} \nfn \UPred(\monoid)} Remember that $\UPred(\monoid)$ is isomorphic to $\monoid \monra \SProp$. -We are thus going to define the assertions as mapping CMRA elements to sets of step-indices. +We are thus going to define the propositions as mapping camera elements to sets of step-indices. \begin{align*} - \Sem{\vctx \proves t =_\type u : \Prop}_\gamma &\eqdef - \Lam \any. \setComp{n}{\Sem{\vctx \proves t : \type}_\gamma \nequiv{n} \Sem{\vctx \proves u : \type}_\gamma} \\ - \Sem{\vctx \proves \FALSE : \Prop}_\gamma &\eqdef \Lam \any. \emptyset \\ - \Sem{\vctx \proves \TRUE : \Prop}_\gamma &\eqdef \Lam \any. \nat \\ - \Sem{\vctx \proves \prop \land \propB : \Prop}_\gamma &\eqdef - \Lam \melt. \Sem{\vctx \proves \prop : \Prop}_\gamma(\melt) \cap \Sem{\vctx \proves \propB : \Prop}_\gamma(\melt) \\ - \Sem{\vctx \proves \prop \lor \propB : \Prop}_\gamma &\eqdef - \Lam \melt. \Sem{\vctx \proves \prop : \Prop}_\gamma(\melt) \cup \Sem{\vctx \proves \propB : \Prop}_\gamma(\melt) \\ - \Sem{\vctx \proves \prop \Ra \propB : \Prop}_\gamma &\eqdef + \Sem{\vctx \proves t =_\type u : \Prop}_\venv &\eqdef + \Lam \any. \setComp{n}{\Sem{\vctx \proves t : \type}_\venv \nequiv{n} \Sem{\vctx \proves u : \type}_\venv} \\ + \Sem{\vctx \proves \FALSE : \Prop}_\venv &\eqdef \Lam \any. \emptyset \\ + \Sem{\vctx \proves \TRUE : \Prop}_\venv &\eqdef \Lam \any. \nat \\ + \Sem{\vctx \proves \prop \land \propB : \Prop}_\venv &\eqdef + \Lam \melt. \Sem{\vctx \proves \prop : \Prop}_\venv(\melt) \cap \Sem{\vctx \proves \propB : \Prop}_\venv(\melt) \\ + \Sem{\vctx \proves \prop \lor \propB : \Prop}_\venv &\eqdef + \Lam \melt. \Sem{\vctx \proves \prop : \Prop}_\venv(\melt) \cup \Sem{\vctx \proves \propB : \Prop}_\venv(\melt) \\ + \Sem{\vctx \proves \prop \Ra \propB : \Prop}_\venv &\eqdef \Lam \melt. \setComp{n}{\begin{aligned} - \All m, \meltB.& m \leq n \land \melt \mincl \meltB \land \meltB \in \mval_m \Ra {} \\ - & m \in \Sem{\vctx \proves \prop : \Prop}_\gamma(\meltB) \Ra {}\\& m \in \Sem{\vctx \proves \propB : \Prop}_\gamma(\meltB)\end{aligned}}\\ - \Sem{\vctx \proves \All \var : \type. \prop : \Prop}_\gamma &\eqdef - \Lam \melt. \setComp{n}{ \All v \in \Sem{\type}. n \in \Sem{\vctx, \var : \type \proves \prop : \Prop}_{\mapinsert \var v \gamma}(\melt) } \\ - \Sem{\vctx \proves \Exists \var : \type. \prop : \Prop}_\gamma &\eqdef - \Lam \melt. \setComp{n}{ \Exists v \in \Sem{\type}. n \in \Sem{\vctx, \var : \type \proves \prop : \Prop}_{\mapinsert \var v \gamma}(\melt) } + \All m, \meltB.& m \leq n \land \melt \mincl \meltB \land m \in \mval(\meltB) \Ra {} \\ + & m \in \Sem{\vctx \proves \prop : \Prop}_\venv(\meltB) \Ra {}\\& m \in \Sem{\vctx \proves \propB : \Prop}_\venv(\meltB)\end{aligned}}\\ + \Sem{\vctx \proves \All \var : \type. \prop : \Prop}_\venv &\eqdef + \Lam \melt. \setComp{n}{ \All v \in \Sem{\type}. n \in \Sem{\vctx, \var : \type \proves \prop : \Prop}_{\mapinsert \var v \venv}(\melt) } \\ + \Sem{\vctx \proves \Exists \var : \type. \prop : \Prop}_\venv &\eqdef + \Lam \melt. \setComp{n}{ \Exists v \in \Sem{\type}. n \in \Sem{\vctx, \var : \type \proves \prop : \Prop}_{\mapinsert \var v \venv}(\melt) } \end{align*} \begin{align*} - \Sem{\vctx \proves \prop * \propB : \Prop}_\gamma &\eqdef \Lam\melt. \setComp{n}{\begin{aligned}\Exists \meltB_1, \meltB_2. &\melt \nequiv{n} \meltB_1 \mtimes \meltB_2 \land {}\\& n \in \Sem{\vctx \proves \prop : \Prop}_\gamma(\meltB_1) \land n \in \Sem{\vctx \proves \propB : \Prop}_\gamma(\meltB_2)\end{aligned}} + \Sem{\vctx \proves \prop * \propB : \Prop}_\venv &\eqdef \Lam\melt. \setComp{n}{\begin{aligned}\Exists \meltB_1, \meltB_2. &\melt \nequiv{n} \meltB_1 \mtimes \meltB_2 \land {}\\& n \in \Sem{\vctx \proves \prop : \Prop}_\venv(\meltB_1) \land n \in \Sem{\vctx \proves \propB : \Prop}_\venv(\meltB_2)\end{aligned}} \\ - \Sem{\vctx \proves \prop \wand \propB : \Prop}_\gamma &\eqdef + \Sem{\vctx \proves \prop \wand \propB : \Prop}_\venv &\eqdef \Lam \melt. \setComp{n}{\begin{aligned} - \All m, \meltB.& m \leq n \land \melt\mtimes\meltB \in \mval_m \Ra {} \\ - & m \in \Sem{\vctx \proves \prop : \Prop}_\gamma(\meltB) \Ra {}\\& m \in \Sem{\vctx \proves \propB : \Prop}_\gamma(\melt\mtimes\meltB)\end{aligned}} \\ - \Sem{\vctx \proves \ownM{\term} : \Prop}_\gamma &\eqdef \Lam\meltB. \setComp{n}{\Sem{\vctx \proves \term : \textlog{M}}_\gamma \mincl[n] \meltB} \\ - \Sem{\vctx \proves \mval(\term) : \Prop}_\gamma &\eqdef \Lam\any. \setComp{n}{\Sem{\vctx \proves \term : \textlog{M}}_\gamma \in \mval_n} \\ - \Sem{\vctx \proves \always{\prop} : \Prop}_\gamma &\eqdef \Lam\melt. \Sem{\vctx \proves \prop : \Prop}_\gamma(\mcore\melt) \\ - \Sem{\vctx \proves \plainly{\prop} : \Prop}_\gamma &\eqdef \Lam\melt. \Sem{\vctx \proves \prop : \Prop}_\gamma(\munit) \\ - \Sem{\vctx \proves \later{\prop} : \Prop}_\gamma &\eqdef \Lam\melt. \setComp{n}{n = 0 \lor n-1 \in \Sem{\vctx \proves \prop : \Prop}_\gamma(\melt)}\\ - \Sem{\vctx \proves \upd\prop : \Prop}_\gamma &\eqdef \Lam\melt. \setComp{n}{\begin{aligned} - \All m, \melt'. & m \leq n \land (\melt \mtimes \melt') \in \mval_m \Ra {}\\& \Exists \meltB. (\meltB \mtimes \melt') \in \mval_m \land m \in \Sem{\vctx \proves \prop :\Prop}_\gamma(\meltB) + \All m, \meltB.& m \leq n \land m \in \mval(\melt\mtimes\meltB) \Ra {} \\ + & m \in \Sem{\vctx \proves \prop : \Prop}_\venv(\meltB) \Ra {}\\& m \in \Sem{\vctx \proves \propB : \Prop}_\venv(\melt\mtimes\meltB)\end{aligned}} \\ + \Sem{\vctx \proves \ownM{\term} : \Prop}_\venv &\eqdef \Lam\meltB. \setComp{n}{\Sem{\vctx \proves \term : \textlog{M}}_\venv \mincl[n] \meltB} \\ + \Sem{\vctx \proves \mval(\term) : \Prop}_\venv &\eqdef \Lam\any. \mval(\Sem{\vctx \proves \term : \textlog{M}}_\venv) \\ + \Sem{\vctx \proves \always{\prop} : \Prop}_\venv &\eqdef \Lam\melt. \Sem{\vctx \proves \prop : \Prop}_\venv(\mcore\melt) \\ + \Sem{\vctx \proves \plainly{\prop} : \Prop}_\venv &\eqdef \Lam\melt. \Sem{\vctx \proves \prop : \Prop}_\venv(\munit) \\ + \Sem{\vctx \proves \later{\prop} : \Prop}_\venv &\eqdef \Lam\melt. \setComp{n}{n = 0 \lor n-1 \in \Sem{\vctx \proves \prop : \Prop}_\venv(\melt)}\\ + \Sem{\vctx \proves \upd\prop : \Prop}_\venv &\eqdef \Lam\melt. \setComp{n}{\begin{aligned} + \All m, \melt'. & m \leq n \land m \in \mval(\melt \mtimes \melt') \Ra {}\\& \Exists \meltB. m \in \mval(\meltB \mtimes \melt') \land m \in \Sem{\vctx \proves \prop :\Prop}_\venv(\meltB) \end{aligned} } \end{align*} @@ -73,36 +73,36 @@ For every definition, we have to show all the side-conditions: The maps have to \judgment[Interpretation of non-propositional terms]{\Sem{\vctx \proves \term : \type} : \Sem{\vctx} \nfn \Sem{\type}} \begin{align*} - \Sem{\vctx \proves x : \type}_\gamma &\eqdef \gamma(x) \\ - \Sem{\vctx \proves \sigfn(\term_1, \dots, \term_n) : \type_{n+1}}_\gamma &\eqdef \Sem{\sigfn}(\Sem{\vctx \proves \term_1 : \type_1}_\gamma, \dots, \Sem{\vctx \proves \term_n : \type_n}_\gamma) \\ - \Sem{\vctx \proves \Lam \var:\type. \term : \type \to \type'}_\gamma &\eqdef - \Lam \termB : \Sem{\type}. \Sem{\vctx, \var : \type \proves \term : \type}_{\mapinsert \var \termB \gamma} \\ - \Sem{\vctx \proves \term(\termB) : \type'}_\gamma &\eqdef - \Sem{\vctx \proves \term : \type \to \type'}_\gamma(\Sem{\vctx \proves \termB : \type}_\gamma) \\ - \Sem{\vctx \proves \MU \var:\type. \term : \type}_\gamma &\eqdef - \mathit{fix}(\Lam \termB : \Sem{\type}. \Sem{\vctx, x : \type \proves \term : \type}_{\mapinsert \var \termB \gamma}) \\ + \Sem{\vctx \proves x : \type}_\venv &\eqdef \venv(x) \\ + \Sem{\vctx \proves \sigfn(\term_1, \dots, \term_n) : \type_{n+1}}_\venv &\eqdef \Sem{\sigfn}(\Sem{\vctx \proves \term_1 : \type_1}_\venv, \dots, \Sem{\vctx \proves \term_n : \type_n}_\venv) \\ + \Sem{\vctx \proves \Lam \var:\type. \term : \type \to \type'}_\venv &\eqdef + \Lam \termB : \Sem{\type}. \Sem{\vctx, \var : \type \proves \term : \type}_{\mapinsert \var \termB \venv} \\ + \Sem{\vctx \proves \term(\termB) : \type'}_\venv &\eqdef + \Sem{\vctx \proves \term : \type \to \type'}_\venv(\Sem{\vctx \proves \termB : \type}_\venv) \\ + \Sem{\vctx \proves \MU \var:\type. \term : \type}_\venv &\eqdef + \fixp_{\Sem{\type}}(\Lam \termB : \Sem{\type}. \Sem{\vctx, x : \type \proves \term : \type}_{\mapinsert \var \termB \venv}) \\ ~\\ - \Sem{\vctx \proves \textlog{abort}\;\term : \type}_\gamma &\eqdef \mathit{abort}_{\Sem\type}(\Sem{\vctx \proves \term:0}_\gamma) \\ - \Sem{\vctx \proves () : 1}_\gamma &\eqdef () \\ - \Sem{\vctx \proves (\term_1, \term_2) : \type_1 \times \type_2}_\gamma &\eqdef (\Sem{\vctx \proves \term_1 : \type_1}_\gamma, \Sem{\vctx \proves \term_2 : \type_2}_\gamma) \\ - \Sem{\vctx \proves \pi_i\; \term : \type_i}_\gamma &\eqdef \pi_i(\Sem{\vctx \proves \term : \type_1 \times \type_2}_\gamma) \\ - \Sem{\vctx \proves \textlog{inj}_i\;\term : \type_1 + \type_2}_\gamma &\eqdef \mathit{inj}_i(\Sem{\vctx \proves \term : \type_i}_\gamma) \\ - \Sem{\vctx \proves \textlog{match}\; \term \;\textlog{with}\; \Ret\textlog{inj}_1\; \var_1. \term_1 \mid \Ret\textlog{inj}_2\; \var_2. \term_2 \;\textlog{end} : \type }_\gamma &\eqdef - \Sem{\vctx, \var_i:\type_i \proves \term_i : \type}_{\mapinsert{\var_i}\termB \gamma} \\ - &\qquad \text{where $\Sem{\vctx \proves \term : \type_1 + \type_2}_\gamma = \mathit{inj}_i(\termB)$} + \Sem{\vctx \proves \textlog{abort}\;\term : \type}_\venv &\eqdef \mathit{abort}_{\Sem\type}(\Sem{\vctx \proves \term:0}_\venv) \\ + \Sem{\vctx \proves () : 1}_\venv &\eqdef () \\ + \Sem{\vctx \proves (\term_1, \term_2) : \type_1 \times \type_2}_\venv &\eqdef (\Sem{\vctx \proves \term_1 : \type_1}_\venv, \Sem{\vctx \proves \term_2 : \type_2}_\venv) \\ + \Sem{\vctx \proves \pi_i\; \term : \type_i}_\venv &\eqdef \pi_i(\Sem{\vctx \proves \term : \type_1 \times \type_2}_\venv) \\ + \Sem{\vctx \proves \textlog{inj}_i\;\term : \type_1 + \type_2}_\venv &\eqdef \mathit{inj}_i(\Sem{\vctx \proves \term : \type_i}_\venv) \\ + \Sem{\vctx \proves \textlog{match}\; \term \;\textlog{with}\; \Ret\textlog{inj}_1\; \var_1. \term_1 \mid \Ret\textlog{inj}_2\; \var_2. \term_2 \;\textlog{end} : \type }_\venv &\eqdef + \Sem{\vctx, \var_i:\type_i \proves \term_i : \type}_{\mapinsert{\var_i}\termB \venv} \\ + &\qquad \text{where $\Sem{\vctx \proves \term : \type_1 + \type_2}_\venv = \mathit{inj}_i(\termB)$} \\ ~\\ - \Sem{ \melt : \textlog{M} }_\gamma &\eqdef \melt \\ - \Sem{\vctx \proves \mcore\term : \textlog{M}}_\gamma &\eqdef \mcore{\Sem{\vctx \proves \term : \textlog{M}}_\gamma} \\ - \Sem{\vctx \proves \term \mtimes \termB : \textlog{M}}_\gamma &\eqdef - \Sem{\vctx \proves \term : \textlog{M}}_\gamma \mtimes \Sem{\vctx \proves \termB : \textlog{M}}_\gamma + \Sem{ \melt : \textlog{M} }_\venv &\eqdef \melt \\ + \Sem{\vctx \proves \mcore\term : \textlog{M}}_\venv &\eqdef \mcore{\Sem{\vctx \proves \term : \textlog{M}}_\venv} \\ + \Sem{\vctx \proves \term \mtimes \termB : \textlog{M}}_\venv &\eqdef + \Sem{\vctx \proves \term : \textlog{M}}_\venv \mtimes \Sem{\vctx \proves \termB : \textlog{M}}_\venv \end{align*} % An environment $\vctx$ is interpreted as the set of finite partial functions $\rho$, with $\dom(\rho) = \dom(\vctx)$ and $\rho(x)\in\Sem{\vctx(x)}$. -Above, $\mathit{fix}$ is the fixed-point on COFEs, and $\mathit{abort}_T$ is the unique function $\emptyset \to T$. +Above, $\fixp$ is Banach's fixed-point (see \thmref{thm:banach}), and $\mathit{abort}_T$ is the unique function $\emptyset \to T$. \paragraph{Logical entailment.} We can now define \emph{semantic} logical entailment. @@ -115,10 +115,11 @@ We can now define \emph{semantic} logical entailment. \MoveEqLeft \forall n \in \nat.\; \forall \rs \in \monoid.\; -\forall \gamma \in \Sem{\vctx},\; +\forall \venv \in \Sem{\vctx},\; \\& -n \in \Sem{\vctx \proves \prop : \Prop}_\gamma(\rs) -\Ra n \in \Sem{\vctx \proves \propB : \Prop}_\gamma(\rs) +n \in \mval(\rs) \land +n \in \Sem{\vctx \proves \prop : \Prop}_\venv(\rs) +\Ra n \in \Sem{\vctx \proves \propB : \Prop}_\venv(\rs) \end{aligned} \] diff --git a/docs/paradoxes.tex b/docs/paradoxes.tex index 099d1a9e7efdb9c8385c5f7ad573e994d9a4e2bf..8addc115deaa3a393bed534b90d277298a2e11ee 100644 --- a/docs/paradoxes.tex +++ b/docs/paradoxes.tex @@ -1,10 +1,10 @@ -\section{Logical paradoxes} +\section{Logical Paradoxes} \newcommand{\starttoken}{\textsc{s}} \newcommand{\finishtoken}{\textsc{f}} In this section we provide proofs of some logical inconsistencies that arise when slight changes are made to the Iris logic. -\subsection{Saved propositions without a later} +\subsection{Saved Propositions without a Later} \label{sec:saved-prop-no-later} As a preparation for the proof about invariants in \Sref{app:section:invariants-without-a-later}, we show that omitting the later modality from a variant of \emph{saved propositions} leads to a contradiction. @@ -13,7 +13,7 @@ The counterexample assumes a higher-order logic with separating conjunction, mag \begin{thm} \label{thm:counterexample-1} -If there exists a type $\GName$ and an assertion $\_ \Mapsto \_ : \GName \to \Prop \to \Prop$ associating names $\gamma : \GName$ to propositions and satisfying: +If there exists a type $\GName$ and a proposition $\_ \Mapsto \_ : \GName \to \Prop \to \Prop$ associating names $\gamma : \GName$ to propositions and satisfying: \begin{align} \proves{}& \upd \Exists \gname : \GName. \gname \Mapsto P(\gname) \tagH{sprop-alloc} \\ @@ -28,23 +28,23 @@ then $\proves\upd \FALSE$. \end{thm} The type $\GName$ should be thought of as the type of ``locations'' and $\gname \Mapsto P$ should be read as stating that location $\gname$ ``stores'' proposition $P$. -Notice that these are immutable locations, so the maps-to assertion is persistent. +Notice that these are immutable locations, so the maps-to proposition is persistent. The rule \ruleref{sprop-alloc} is then thought of as allocation, and the rule \ruleref{sprop-agree} states that a given location $\gname$ can only store \emph{one} proposition, so multiple witnesses covering the same location must agree. %Compared to saved propositions in prior work, \ruleref{sprop-alloc} is stronger since the stored proposition can depend on the name being allocated. -%\derek{Can't we cut the above sentence? This makes it sound like we are doing something weird that we ought not to be since prior work didn't do it. But in fact, I thought that in our construction we don't really need to rely on this feature at all! So I'm confused.} +%\derek{Can't we cut the above sentence? This makes it sound like we are doing something weird that we ought not to be since prior work didn't do it. But in fact, I thought that in our construction we do not really need to rely on this feature at all! So I'm confused.} The conclusion of \ruleref{sprop-agree} usually is guarded by a $\later$. The point of this theorem is to show that said later is \emph{essential}, as removing it introduces inconsistency. % -The key to proving \thmref{thm:counterexample-1} is the following assertion: +The key to proving \thmref{thm:counterexample-1} is the following proposition: \begin{defn} $A(\gname) \eqdef \Exists \prop : \Prop. \always\lnot \prop \land \gname \Mapsto \prop$. \end{defn} Intuitively, $A(\gname)$ says that the saved proposition named $\gname$ does \emph{not} hold, \ie we can disprove it. Using \ruleref{sprop-persist}, it is immediate that $A(\gname)$ is persistent. -Now, by applying \ruleref{sprop-alloc} with $A$, we obtain a proof of $\prop \eqdef \gname \Mapsto A(\gname)$: this says that the proposition named $\gname$ is the assertion saying that it, itself, doesn't hold. -In other words, $\prop$ says that the assertion named $\gname$ expresses its own negation. +Now, by applying \ruleref{sprop-alloc} with $A$, we obtain a proof of $\prop \eqdef \gname \Mapsto A(\gname)$: this says that the proposition named $\gname$ is the proposition saying that it, itself, does not hold. +In other words, $\prop$ says that the proposition named $\gname$ expresses its own negation. Unsurprisingly, that leads to a contradiction, as is shown in the following lemma: \begin{lem} \label{lem:saved-prop-counterexample-not-agname} We have $\gname \Mapsto A(\gname) \proves \always\lnot A(\gname)$ and $\gname \Mapsto A(\gname) \proves A(\gname)$. \end{lem} \begin{proof}%[\lemref{lem:saved-prop-counterexample-not-agname}] @@ -75,7 +75,7 @@ With this lemma in hand, the proof of \thmref{thm:counterexample-1} is simple. Together with the rule \ruleref{sprop-alloc} we thus derive $\upd \FALSE$. \end{proof} -\subsection{Invariants without a later} +\subsection{Invariants without a Later} \label{app:section:invariants-without-a-later} Now we come to the main paradox: if we remove the $\later$ from \ruleref{inv-open}, the logic becomes inconsistent. @@ -90,7 +90,7 @@ The theorem is stated as general as possible so taht it also applies to previous \end{mathpar} \noindent - Assume a type $\InvName$ and an assertion $\knowInv{\cdot}{\cdot} : \InvName \to \Prop \to \Prop$ satisfying: + Assume a type $\InvName$ and a proposition $\knowInv{\cdot}{\cdot} : \InvName \to \Prop \to \Prop$ satisfying: % \begin{mathpar} \inferhref{inv-alloc}{eq:inv-alloc} diff --git a/docs/program-logic.tex b/docs/program-logic.tex index 3541c1070f23841302de950e763c2ea2c226c1eb..69e41523ba753fe9f9655f6314e1816875a81a05 100644 --- a/docs/program-logic.tex +++ b/docs/program-logic.tex @@ -4,103 +4,7 @@ This section describes how to build a program logic for an arbitrary language (\cf \Sref{sec:language}) on top of the base logic. So in the following, we assume that some language $\Lang$ was fixed. - -\subsection{Dynamic Composeable Higher-Order Resources} -\label{sec:composeable-resources} - -The base logic described in \Sref{sec:base-logic} works over an arbitrary CMRA $\monoid$ defining the structure of the resources. -It turns out that we can generalize this further and permit picking CMRAs ``$\iFunc(\Prop)$'' that depend on the structure of assertions themselves. -Of course, $\Prop$ is just the syntactic type of assertions; for this to make sense we have to look at the semantics. - -Furthermore, there is a composability problem with the given logic: if we have one proof performed with CMRA $\monoid_1$, and another proof carried out with a \emph{different} CMRA $\monoid_2$, then the two proofs are actually carried out in two \emph{entirely separate logics} and hence cannot be combined. - -Finally, in many cases just having a single ``instance'' of a CMRA available for reasoning is not enough. -For example, when reasoning about a dynamically allocated data structure, every time a new instance of that data structure is created, we will want a fresh resource governing the state of this particular instance. -While it would be possible to handle this problem whenever it comes up, it turns out to be useful to provide a general solution. - -The purpose of this section is to describe how we solve these issues. - -\paragraph{Picking the resources.} -The key ingredient that we will employ on top of the base logic is to give some more fixed structure to the resources. -To instantiate the program logic, the user picks a family of locally contractive bifunctors $(\iFunc_i : \OFEs \to \CMRAs)_{i \in \mathcal{I}}$. -(This is in contrast to the base logic, where the user picks a single, fixed CMRA that has a unit.) - -From this, we construct the bifunctor defining the overall resources as follows: -\begin{align*} - \GName \eqdef{}& \nat \\ - \textdom{ResF}(\ofe^\op, \ofe) \eqdef{}& \prod_{i \in \mathcal I} \GName \fpfn \iFunc_i(\ofe^\op, \ofe) -\end{align*} -We will motivate both the use of a product and the finite partial function below. -$\textdom{ResF}(\ofe^\op, \ofe)$ is a CMRA by lifting the individual CMRAs pointwise, and it has a unit (using the empty finite partial functions). -Furthermore, since the $\iFunc_i$ are locally contractive, so is $\textdom{ResF}$. - -Now we can write down the recursive domain equation: -\[ \iPreProp \cong \UPred(\textdom{ResF}(\iPreProp, \iPreProp)) \] -$\iPreProp$ is a COFE defined as the fixed-point of a locally contractive bifunctor. -This fixed-point exists and is unique\footnote{We have not proven uniqueness in Coq.} by America and Rutten's theorem~\cite{America-Rutten:JCSS89,birkedal:metric-space}. -We do not need to consider how the object is constructed. -We only need the isomorphism, given by -\begin{align*} - \Res &\eqdef \textdom{ResF}(\iPreProp, \iPreProp) \\ - \iProp &\eqdef \UPred(\Res) \\ - \wIso &: \iProp \nfn \iPreProp \\ - \wIso^{-1} &: \iPreProp \nfn \iProp -\end{align*} - -Notice that $\iProp$ is the semantic model of assertions for the base logic described in \Sref{sec:base-logic} with $\Res$: -\[ \Sem{\Prop} \eqdef \iProp = \UPred(\Res) \] -Effectively, we just defined a way to instantiate the base logic with $\Res$ as the CMRA of resources, while providing a way for $\Res$ to depend on $\iPreProp$, which is isomorphic to $\Sem\Prop$. - -We thus obtain all the rules of \Sref{sec:base-logic}, and furthermore, we can use the maps $\wIso$ and $\wIso^{-1}$ \emph{in the logic} to convert between logical assertions $\Sem\Prop$ and the domain $\iPreProp$ which is used in the construction of $\Res$ -- so from elements of $\iPreProp$, we can construct elements of $\Sem{\textlog M}$, which are the elements that can be owned in our logic. - -\paragraph{Proof composability.} -To make our proofs composeable, we \emph{generalize} our proofs over the family of functors. -This is possible because we made $\Res$ a \emph{product} of all the CMRAs picked by the user, and because we can actually work with that product ``pointwise''. -So instead of picking a \emph{concrete} family, proofs will assume to be given an \emph{arbitrary} family of functors, plus a proof that this family \emph{contains the functors they need}. -Composing two proofs is then merely a matter of conjoining the assumptions they make about the functors. -Since the logic is entirely parametric in the choice of functors, there is no trouble reasoning without full knowledge of the family of functors. - -Only when the top-level proof is completed we will ``close'' the proof by picking a concrete family that contains exactly those functors the proof needs. - -\paragraph{Dynamic resources.} -Finally, the use of finite partial functions lets us have as many instances of any CMRA as we could wish for: -Because there can only ever be finitely many instances already allocated, it is always possible to create a fresh instance with any desired (valid) starting state. -This is best demonstrated by giving some proof rules. - -So let us first define the notion of ghost ownership that we use in this logic. -Assuming that the family of functors contains the functor $\Sigma_i$ at index $i$, and furthermore assuming that $\monoid_i = \Sigma_i(\iPreProp, \iPreProp)$, given some $\melt \in \monoid_i$ we define: -\[ \ownGhost\gname{\melt:\monoid_i} \eqdef \ownM{(\ldots, \emptyset, i:\mapsingleton \gname \melt, \emptyset, \ldots)} \] -This is ownership of the pair (element of the product over all the functors) that has the empty finite partial function in all components \emph{except for} the component corresponding to index $i$, where we own the element $\melt$ at index $\gname$ in the finite partial function. - -We can show the following properties for this form of ownership: -\begin{mathparpagebreakable} - \inferH{res-alloc}{\text{$G$ infinite} \and \melt \in \mval_{M_i}} - { \TRUE \proves \upd \Exists\gname\in G. \ownGhost\gname{\melt : M_i} - } - \and - \inferH{res-update} - {\melt \mupd_{M_i} B} - {\ownGhost\gname{\melt : M_i} \proves \upd \Exists \meltB\in B. \ownGhost\gname{\meltB : M_i}} - - \inferH{res-empty} - {\text{$\munit$ is a unit of $M_i$}} - {\TRUE \proves \upd \ownGhost\gname\munit} - - \axiomH{res-op} - {\ownGhost\gname{\melt : M_i} * \ownGhost\gname{\meltB : M_i} \provesIff \ownGhost\gname{\melt\mtimes\meltB : M_i}} - - \axiomH{res-valid} - {\ownGhost\gname{\melt : M_i} \Ra \mval_{M_i}(\melt)} - - \inferH{res-timeless} - {\text{$\melt$ is a discrete OFE element}} - {\timeless{\ownGhost\gname{\melt : M_i}}} -\end{mathparpagebreakable} - -Below, we will always work within (an instance of) the logic as described here. -Whenever a CMRA is used in a proof, we implicitly assume it to be available in the global family of functors. -We will typically leave the $M_i$ implicit when asserting ghost ownership, as the type of $\melt$ will be clear from the context. - +Furthermore, we work in the logic with higher-order ghost state as described in \Sref{sec:composeable-resources}. \subsection{World Satisfaction, Invariants, Fancy Updates} @@ -110,7 +14,7 @@ To introduce invariants into our logic, we will define weakest precondition to e However, in order to be able to access invariants, we will also have to provide a way to \emph{temporarily disable} (or ``open'') them. To this end, we use tokens that manage which invariants are currently enabled. -We assume to have the following four CMRAs available: +We assume to have the following four cameras available: \begin{align*} \InvName \eqdef{}& \nat \\ \textmon{Inv} \eqdef{}& \authm(\InvName \fpfn \agm(\latert \iPreProp)) \\ @@ -119,10 +23,10 @@ We assume to have the following four CMRAs available: \end{align*} The last two are the tokens used for managing invariants, $\textmon{Inv}$ is the monoid used to manage the invariants themselves. -We assume that at the beginning of the verification, instances named $\gname_{\textmon{State}}$, $\gname_{\textmon{Inv}}$, $\gname_{\textmon{En}}$ and $\gname_{\textmon{Dis}}$ of these CMRAs have been created, such that these names are globally known. +We assume that at the beginning of the verification, instances named $\gname_{\textmon{State}}$, $\gname_{\textmon{Inv}}$, $\gname_{\textmon{En}}$ and $\gname_{\textmon{Dis}}$ of these cameras have been created, such that these names are globally known. \paragraph{World Satisfaction.} -We can now define the assertion $W$ (\emph{world satisfaction}) which ensures that the enabled invariants are actually maintained: +We can now define the proposition $W$ (\emph{world satisfaction}) which ensures that the enabled invariants are actually maintained: \begin{align*} W \eqdef{}& \Exists I : \InvName \fpfn \Prop. \begin{array}[t]{@{} l} @@ -135,7 +39,7 @@ We can now define the assertion $W$ (\emph{world satisfaction}) which ensures th \end{align*} \paragraph{Invariants.} -The following assertion states that an invariant with name $\iname$ exists and maintains assertion $\prop$: +The following proposition states that an invariant with name $\iname$ exists and maintains proposition $\prop$: \[ \knowInv\iname\prop \eqdef \ownGhost{\gname_{\textmon{Inv}}} {\authfrag \mapsingleton \iname {\aginj(\latertinj(\wIso(\prop)))}} \] @@ -248,55 +152,60 @@ Still, just to give an idea of what view shifts ``are'', here are some proof rul \subsection{Weakest Precondition} -Finally, we can define the core piece of the program logic, the assertion that reasons about program behavior: Weakest precondition, from which Hoare triples will be derived. +Finally, we can define the core piece of the program logic, the proposition that reasons about program behavior: Weakest precondition, from which Hoare triples will be derived. \paragraph{Defining weakest precondition.} We assume that everything making up the definition of the language, \ie values, expressions, states, the conversion functions, reduction relation and all their properties, are suitably reflected into the logic (\ie they are part of the signature $\Sig$). -We further assume (as a parameter) a predicate $I : \State \to \iProp$ that interprets the physical state as an Iris assertion. +We further assume (as a parameter) a predicate $\stateinterp : \State \to \iProp$ that interprets the physical state as an Iris proposition. This can be instantiated, for example, with ownership of an authoritative RA to tie the physical state to fragments that are used for user-level proofs. +Finally, weakest precondition takes a parameter $\stuckness \in \set{\NotStuck, \MaybeStuck}$ indicating whether program execution is allowed to get stuck. \begin{align*} - \textdom{wp} \eqdef{}& \MU \textdom{wp}. \Lam \mask, \expr, \pred. \\ + \textdom{wp}(\stateinterp, \stuckness) \eqdef{}& \MU \textdom{wp\any rec}. \Lam \mask, \expr, \pred. \\ & (\Exists\val. \toval(\expr) = \val \land \pvs[\mask] \pred(\val)) \lor {}\\ - & \Bigl(\toval(\expr) = \bot \land \All \state. I(\state) \vsW[\mask][\emptyset] {}\\ - &\qquad \red(\expr, \state) * \later\All \expr', \state', \vec\expr. (\expr, \state \step \expr', \state', \vec\expr) \vsW[\emptyset][\mask] {}\\ - &\qquad\qquad I(\state') * \textdom{wp}(\mask, \expr', \pred) * \Sep_{\expr'' \in \vec\expr} \textdom{wp}(\top, \expr'', \Lam \any. \TRUE)\Bigr) \\ + & \Bigl(\toval(\expr) = \bot \land \All \state. \stateinterp(\state) \vsW[\mask][\emptyset] {}\\ + &\qquad (s = \NotStuck \Ra \red(\expr, \state)) * \later\All \expr', \state', \vec\expr. (\expr, \state \step \expr', \state', \vec\expr) \vsW[\emptyset][\mask] {}\\ + &\qquad\qquad \stateinterp(\state') * \textdom{wp\any rec}(\mask, \expr', \pred) * \Sep_{\expr'' \in \vec\expr} \textdom{wp\any rec}(\top, \expr'', \Lam \any. \TRUE)\Bigr) \\ % (* value case *) - \wpre\expr[\mask]{\Ret\val. \prop} \eqdef{}& \textdom{wp}(\mask, \expr, \Lam\val.\prop) + \wpre[\stateinterp]\expr[\stuckness;\mask]{\Ret\val. \prop} \eqdef{}& \textdom{wp}(\stateinterp,\stuckness)(\mask, \expr, \Lam\val.\prop) \end{align*} -If we leave away the mask, we assume it to default to $\top$. +The $\stateinterp$ will always be set by the context; typically, when instantiating Iris with a language, we also pick the corresponding state interpretation $\stateinterp$. +All proof rules leave $\stateinterp$ unchanged. +If we leave away the mask $\mask$, we assume it to default to $\top$. +If we leave away the stuckness $\stuckness$, it defaults to $\NotStuck$. \paragraph{Laws of weakest precondition.} The following rules can all be derived: \begin{mathpar} \infer[wp-value] -{}{\prop[\val/\var] \proves \wpre{\val}[\mask]{\Ret\var.\prop}} +{}{\prop[\val/\var] \proves \wpre{\val}[\stuckness;\mask]{\Ret\var.\prop}} \infer[wp-mono] -{\mask_1 \subseteq \mask_2 \and \vctx,\var:\textlog{val}\mid\prop \proves \propB} -{\vctx\mid\wpre\expr[\mask_1]{\Ret\var.\prop} \proves \wpre\expr[\mask_2]{\Ret\var.\propB}} +{\mask_1 \subseteq \mask_2 \and \vctx,\var:\textlog{val}\mid\prop \proves \propB \and (\stuckness_2 = \MaybeStuck \lor \stuckness_1 = \stuckness_2)} +{\vctx\mid\wpre\expr[\stuckness_1;\mask_1]{\Ret\var.\prop} \proves \wpre\expr[\stuckness_2;\mask_2]{\Ret\var.\propB}} \infer[fup-wp] -{}{\pvs[\mask] \wpre\expr[\mask]{\Ret\var.\prop} \proves \wpre\expr[\mask]{\Ret\var.\prop}} +{}{\pvs[\mask] \wpre\expr[\stuckness;\mask]{\Ret\var.\prop} \proves \wpre\expr[\stuckness;\mask]{\Ret\var.\prop}} \infer[wp-fup] -{}{\wpre\expr[\mask]{\Ret\var.\pvs[\mask] \prop} \proves \wpre\expr[\mask]{\Ret\var.\prop}} +{}{\wpre\expr[\stuckness;\mask]{\Ret\var.\pvs[\stuckness;\mask] \prop} \proves \wpre\expr[\stuckness;\mask]{\Ret\var.\prop}} \infer[wp-atomic] -{\physatomic{\expr}} -{\pvs[\mask_1][\mask_2] \wpre\expr[\mask_2]{\Ret\var. \pvs[\mask_2][\mask_1]\prop} - \proves \wpre\expr[\mask_1]{\Ret\var.\prop}} +{\stuckness = \NotStuck \Ra \atomic(\expr) \and + \stuckness = \MaybeStuck \Ra \stronglyAtomic(\expr)} +{\pvs[\mask_1][\mask_2] \wpre\expr[\stuckness;\mask_2]{\Ret\var. \pvs[\mask_2][\mask_1]\prop} + \proves \wpre\expr[\stuckness;\mask_1]{\Ret\var.\prop}} \infer[wp-frame] -{}{\propB * \wpre\expr[\mask]{\Ret\var.\prop} \proves \wpre\expr[\mask]{\Ret\var.\propB*\prop}} +{}{\propB * \wpre\expr[\stuckness;\mask]{\Ret\var.\prop} \proves \wpre\expr[\stuckness;\mask]{\Ret\var.\propB*\prop}} \infer[wp-frame-step] {\toval(\expr) = \bot \and \mask_2 \subseteq \mask_1} -{\wpre\expr[\mask_2]{\Ret\var.\prop} * \pvs[\mask_1][\mask_2]\later\pvs[\mask_2][\mask_1]\propB \proves \wpre\expr[\mask_1]{\Ret\var.\propB*\prop}} +{\wpre\expr[\stuckness;\mask_2]{\Ret\var.\prop} * \pvs[\mask_1][\mask_2]\later\pvs[\mask_2][\mask_1]\propB \proves \wpre\expr[\stuckness;\mask_1]{\Ret\var.\propB*\prop}} \infer[wp-bind] {\text{$\lctx$ is a context}} -{\wpre\expr[\mask]{\Ret\var. \wpre{\lctx(\ofval(\var))}[\mask]{\Ret\varB.\prop}} \proves \wpre{\lctx(\expr)}[\mask]{\Ret\varB.\prop}} +{\wpre\expr[\stuckness;\mask]{\Ret\var. \wpre{\lctx(\ofval(\var))}[\stuckness;\mask]{\Ret\varB.\prop}} \proves \wpre{\lctx(\expr)}[\stuckness;\mask]{\Ret\varB.\prop}} \end{mathpar} We will also want a rule that connect weakest preconditions to the operational semantics of the language. @@ -304,7 +213,7 @@ We will also want a rule that connect weakest preconditions to the operational s \infer[wp-lift-step] {\toval(\expr_1) = \bot} { {\begin{inbox} % for some crazy reason, LaTeX is actually sensitive to the space between the "{ {" here and the "} }" below... - ~~\All \state_1. I(\state_1) \vsW[\mask][\emptyset] \red(\expr_1,\state_1) * {}\\\qquad~~ \later\All \expr_2, \state_2, \vec\expr. (\expr_1, \state_1 \step \expr_2, \state_2, \vec\expr) \vsW[\emptyset][\mask] \Bigl(I(\state_2) * \wpre{\expr_2}[\mask]{\Ret\var.\prop} * \Sep_{\expr_\f \in \vec\expr} \wpre{\expr_\f}[\top]{\Ret\any.\TRUE}\Bigr) {}\\\proves \wpre{\expr_1}[\mask]{\Ret\var.\prop} + ~~\All \state_1. \stateinterp(\state_1) \vsW[\mask][\emptyset] (\stuckness = \NotStuck \Ra \red(\expr_1,\state_1)) * {}\\\qquad~~ \later\All \expr_2, \state_2, \vec\expr. (\expr_1, \state_1 \step \expr_2, \state_2, \vec\expr) \vsW[\emptyset][\mask] \Bigl(\stateinterp(\state_2) * \wpre[\stateinterp]{\expr_2}[\stuckness;\mask]{\Ret\var.\prop} * \Sep_{\expr_\f \in \vec\expr} \wpre[\stateinterp]{\expr_\f}[\stuckness;\top]{\Ret\any.\TRUE}\Bigr) {}\\\proves \wpre[\stateinterp]{\expr_1}[\stuckness;\mask]{\Ret\var.\prop} \end{inbox}} } \end{mathpar} @@ -341,11 +250,11 @@ There are two properties we are looking for: First of all, the postcondition sho Second, a proof of a weakest precondition with any postcondition should imply that the program is \emph{safe}, \ie that it does not get stuck. \begin{defn}[Adequacy] - A program $\expr$ in some initial state $\state$ is \emph{adequate} for a set $V \subseteq \Val$ of legal return values ($\expr, \state \vDash V$) if for all $\tpool', \state'$ such that $([\expr], \state) \tpstep^\ast (\tpool', \state')$ we have + A program $\expr$ in some initial state $\state$ is \emph{adequate} for stuckness $\stuckness$ and a set $V \subseteq \Val$ of legal return values ($\expr, \state \vDash_\stuckness V$) if for all $\tpool', \state'$ such that $([\expr], \state) \tpstep^\ast (\tpool', \state')$ we have \begin{enumerate} -\item Safety: For any $\expr' \in \tpool'$ we have that either $\expr'$ is a +\item Safety: If $\stuckness = \NotStuck$, then for any $\expr' \in \tpool'$ we have that either $\expr'$ is a value, or \(\red(\expr'_i,\state')\): - \[ \All\expr'\in\tpool'. \toval(\expr') \neq \bot \lor \red(\expr', \state') \] + \[ \stuckness = \NotStuck \Ra \All\expr'\in\tpool'. \toval(\expr') \neq \bot \lor \red(\expr', \state') \] Notice that this is stronger than saying that the thread pool can reduce; we actually assert that \emph{every} non-finished thread can take a step. \item Legal return value: If $\tpool'_1$ (the main thread) is a value $\val'$, then $\val' \in V$: \[ \All \val',\tpool''. \tpool' = [\val'] \dplus \tpool'' \Ra \val' \in V \] @@ -363,17 +272,18 @@ The signature can of course state arbitrary additional properties of $\pred$, as The adequacy statement now reads as follows: \begin{align*} &\All \mask, \expr, \val, \state. - \\&( \TRUE \proves {\upd}_\mask \Exists I. I(\state) * \wpre{\expr}[\mask]{x.\; \pred(x)}) \Ra - \\&\expr, \state \vDash V + \\&( \TRUE \proves {\upd}_\mask \Exists \stateinterp. \stateinterp(\state) * \wpre[\stateinterp]{\expr}[\stuckness;\mask]{x.\; \pred(x)}) \Ra + \\&\expr, \state \vDash_\stuckness V \end{align*} Notice that the state invariant $S$ used by the weakest precondition is chosen \emph{after} doing a fancy update, which allows it to depend on the names of ghost variables that are picked in that initial fancy update. \paragraph{Hoare triples.} -It turns out that weakest precondition is actually quite convenient to work with, in particular when perfoming these proofs in Coq. +It turns out that weakest precondition is actually quite convenient to work with, in particular when performing these proofs in Coq. Still, for a more traditional presentation, we can easily derive the notion of a Hoare triple: \[ \hoare{\prop}{\expr}{\Ret\val.\propB}[\mask] \eqdef \always{(\prop \wand \wpre{\expr}[\mask]{\Ret\val.\propB})} \] +We assume the state interpretation $\stateinterp$ to be fixed by the context. We only give some of the proof rules for Hoare triples here, since we usually do all our reasoning directly with weakest preconditions and use Hoare triples only to write specifications. \begin{mathparpagebreakable} @@ -408,7 +318,7 @@ We only give some of the proof rules for Hoare triples here, since we usually do {\prop \vs[\mask \uplus \mask'][\mask] \prop' \\ \hoare{\prop'}{\expr}{\Ret\val.\propB'}[\mask] \\ \All\val. \propB' \vs[\mask][\mask \uplus \mask'] \propB \\ - \physatomic{\expr} + \atomic(\expr) } {\hoare{\prop}{\expr}{\Ret\val.\propB}[\mask \uplus \mask']} \and @@ -444,7 +354,7 @@ We only give some of the proof rules for Hoare triples here, since we usually do \subsection{Invariant Namespaces} \label{sec:namespaces} -In \Sref{sec:invariants}, we defined an assertion $\knowInv\iname\prop$ expressing knowledge (\ie the assertion is persistent) that $\prop$ is maintained as invariant with name $\iname$. +In \Sref{sec:invariants}, we defined a proposition $\knowInv\iname\prop$ expressing knowledge (\ie the proposition is persistent) that $\prop$ is maintained as invariant with name $\iname$. The concrete name $\iname$ is picked when the invariant is allocated, so it cannot possibly be statically known -- it will always be a variable that's threaded through everything. However, we hardly care about the actual, concrete name. All we need to know is that this name is \emph{different} from the names of other invariants that we want to open at the same time. @@ -470,7 +380,7 @@ In order to connect this up to the definitions of \Sref{sec:invariants}, we need Any injective mapping $\textlog{namesp\_inj}$ will do; and such a mapping has to exist because $\List(\nat)$ is countable and $\InvName$ is infinite. Whenever needed, we (usually implicitly) coerce $\namesp$ to its encoded suffix-closure, \ie to the set of encoded structured invariant names contained in the namespace: \[\namecl\namesp \eqdef \setComp{\iname}{\Exists \namesp'. \iname = \textlog{namesp\_inj}(\namesp' \dplus \namesp)}\] -We will overload the notation for invariant assertions for using namespaces instead of names: +We will overload the notation for invariant propositions for using namespaces instead of names: \[ \knowInv\namesp\prop \eqdef \Exists \iname \in \namecl\namesp. \knowInv\iname{\prop} \] We can now derive the following rules (this involves unfolding the definition of fancy updates): \begin{mathpar} @@ -491,11 +401,11 @@ We can now derive the following rules (this involves unfolding the definition of The two rules \ruleref{inv-open} and \ruleref{inv-open-timeless} above may look a little surprising, in the sense that it is not clear on first sight how they would be applied. The rules are the first \emph{accessors} that show up in this document. -Accessors are assertions of the form +Accessors are propositions of the form \[ \prop \vs[\mask_1][\mask_2] \Exists\var. \propB * (\All\varB. \propB' \vsW[\mask_2][\mask_1] \propC) \] -One way to think about such assertions is as follows: -Given some accessor, if during our verification we have the assertion $\prop$ and the mask $\mask_1$ available, we can use the accessor to \emph{access} $\propB$ and obtain the witness $\var$. +One way to think about such propositions is as follows: +Given some accessor, if during our verification we have the proposition $\prop$ and the mask $\mask_1$ available, we can use the accessor to \emph{access} $\propB$ and obtain the witness $\var$. We call this \emph{opening} the accessor, and it changes the mask to $\mask_2$. Additionally, opening the accessor provides us with $\All\varB. \propB' \vsW[\mask_2][\mask_1] \propC$, a \emph{linear view shift} (\ie a view shift that can only be used once). This linear view shift tells us that in order to \emph{close} the accessor again and go back to mask $\mask_1$, we have to pick some $\varB$ and establish the corresponding $\propB'$. @@ -511,7 +421,7 @@ Using \ruleref{vs-trans} and \ruleref{Ht-atomic} (or the corresponding proof rul \inferH{Acc-Ht} {\prop \vs[\mask_1][\mask_2] \Exists\var. \propB * (\All\varB. \propB' \vsW[\mask_2][\mask_1] \propC) \and \All\var. \hoare{\propB * \prop_F}\expr{\Exists\varB. \propB' * \prop_F}[\mask_2] \and - \physatomic\expr} + \atomic(\expr)} {\hoare{\prop * \prop_F}\expr{\propC * \prop_F}[\mask_1]} \end{mathpar} @@ -523,7 +433,7 @@ Furthermore, as we construct more sophisticated and more interesting things that For the special case that $\prop = \propC$ and $\propB = \propB'$, we use the following notation that avoids repetition: \[ \Acc[\mask_1][\mask_2]\prop{\Ret x. \propB} \eqdef \prop \vs[\mask_1][\mask_2] \Exists\var. \propB * (\propB \vsW[\mask_2][\mask_1] \prop) \] -This accessor is ``idempotent'' in the sense that it doesn't actually change the state. After applying it, we get our $\prop$ back so we end up where we started. +This accessor is ``idempotent'' in the sense that it does not actually change the state. After applying it, we get our $\prop$ back so we end up where we started. %%% Local Variables: %%% mode: latex diff --git a/docs/upload b/docs/upload new file mode 100755 index 0000000000000000000000000000000000000000..37ef364af2bea6626ffa1120a0b96f3054da9cc4 --- /dev/null +++ b/docs/upload @@ -0,0 +1,7 @@ +#!/bin/sh +set -e +cd "$(dirname "$(readlink -e "$0")")" + +rub iris +scp iris.pdf mpi-contact:plv.mpi-sws.org/iris/appendix-3.1.pdf + diff --git a/naming.txt b/naming.txt index 191c1664e7b820563ec755f3554a0cf746ce9e0f..ed87ef4c324a8540f23e23e8147d0c83fc2a8646 100644 --- a/naming.txt +++ b/naming.txt @@ -17,7 +17,7 @@ o p q r : iRes = resources -s : state (STSs) +s : state (STSs), stuckness bits t u v : val = values of language diff --git a/opam b/opam index bde38ac3b064e359fdf63c1ac47fb7f31dd95337..65d904f03ec0e40e119343109acca45f3c7dee83 100644 --- a/opam +++ b/opam @@ -11,5 +11,5 @@ install: [make "install"] remove: ["rm" "-rf" "%{lib}%/coq/user-contrib/iris"] depends: [ "coq" { >= "8.7.dev" & < "8.8~" | (= "dev") } - "coq-stdpp" { (= "dev.2017-12-04.1") | (= "dev") } + "coq-stdpp" { (= "1.1.0") | (= "dev") } ] diff --git a/theories/base_logic/base_logic.v b/theories/base_logic/base_logic.v index a4d7185240d7538a7e6da055e8d642b25acf9d58..61c01fb829b08f0b917c77fffc259eadc0faf008 100644 --- a/theories/base_logic/base_logic.v +++ b/theories/base_logic/base_logic.v @@ -4,6 +4,9 @@ From iris.proofmode Require Import tactics. From iris.algebra Require Import proofmode_classes. Set Default Proof Using "Type". +(* The trick of having multiple [uPred] modules, which are all exported in +another [uPred] module is by Jason Gross and described in: +https://sympa.inria.fr/sympa/arc/coq-club/2016-12/msg00069.html *) Module Import uPred. Export upred.uPred. Export derived.uPred. diff --git a/theories/base_logic/double_negation.v b/theories/base_logic/double_negation.v index 5f47c05ecbeff4185ac2249695703b7e93e54c3b..4799e0cc6a795f766f88931f63a3d9ff831ddbfd 100644 --- a/theories/base_logic/double_negation.v +++ b/theories/base_logic/double_negation.v @@ -30,11 +30,11 @@ Import uPred. Lemma laterN_big n a x φ: ✓{n} x → a ≤ n → (â–·^a ⌜φ⌠: uPred M)%I n x → φ. Proof. induction 2 as [| ?? IHle]. - - induction a; repeat (rewrite //= || uPred.unseal). + - induction a; repeat (rewrite //= || uPred.unseal). intros Hlater. apply IHa; auto using cmra_validN_S. - move:Hlater; repeat (rewrite //= || uPred.unseal). + move:Hlater; repeat (rewrite //= || uPred.unseal). - intros. apply IHle; auto using cmra_validN_S. - eapply uPred_closed; eauto using cmra_validN_S. + eapply uPred_mono; eauto using cmra_validN_S. Qed. Lemma laterN_small n a x φ: ✓{n} x → n < a → (â–·^a ⌜φ⌠: uPred M)%I n x. @@ -46,15 +46,15 @@ Proof. - induction n as [| n IHn]; [| move: IHle]; repeat (rewrite //= || uPred.unseal). red; rewrite //=. intros. - eapply (uPred_closed _ _ (S n)); eauto using cmra_validN_S. + eapply (uPred_mono _ _ (S n)); eauto using cmra_validN_S. Qed. (* It is easy to show that most of the basic properties of bupd that - are used throughout Iris hold for nnupd. + are used throughout Iris hold for nnupd. In fact, the first three properties that follow hold for any modality of the form (- -∗ Q) -∗ Q for arbitrary Q. The situation - here is slightly different, because nnupd is of the form + here is slightly different, because nnupd is of the form ∀ n, (- -∗ (Q n)) -∗ (Q n), but the proofs carry over straightforwardly. *) @@ -77,8 +77,8 @@ Proof. Qed. Lemma nnupd_ownM_updateP x (Φ : M → Prop) : x ~~>: Φ → uPred_ownM x =n=> ∃ y, ⌜Φ y⌠∧ uPred_ownM y. -Proof. - intros Hbupd. split. rewrite /uPred_nnupd. repeat uPred.unseal. +Proof. + intros Hbupd. split. rewrite /uPred_nnupd. repeat uPred.unseal. intros n y ? Hown a. red; rewrite //= => n' yf ??. inversion Hown as (x'&Hequiv). @@ -87,18 +87,18 @@ Proof. case (decide (a ≤ n')). - intros Hle Hwand. exfalso. eapply laterN_big; last (uPred.unseal; eapply (Hwand n' (y' â‹… x'))); eauto. - * rewrite comm -assoc. done. - * rewrite comm -assoc. done. - * eexists. split; eapply uPred_mono; red; rewrite //=; eauto. - - intros; assert (n' < a). omega. + * rewrite comm -assoc. done. + * rewrite comm -assoc. done. + * exists y'. split=>//. by exists x'. + - intros; assert (n' < a). omega. move: laterN_small. uPred.unseal. naive_solver. Qed. (* However, the transitivity property seems to be much harder to - prove. This is surprising, because transitivity does hold for + prove. This is surprising, because transitivity does hold for modalities of the form (- -∗ Q) -∗ Q. What goes wrong when we quantify - now over n? + now over n? *) Remark nnupd_trans P: (|=n=> |=n=> P) ⊢ (|=n=> P). @@ -111,7 +111,7 @@ Proof. (* Oops -- the exponents of the later modality don't match up! *) Abort. -(* Instead, we will need to prove this in the model. We start by showing that +(* Instead, we will need to prove this in the model. We start by showing that nnupd is the limit of a the following sequence: (- -∗ False) - ∗ False, @@ -121,12 +121,12 @@ Abort. Then, it is easy enough to show that each of the uPreds in this sequence is transitive. It turns out that this implies that nnupd is transitive. *) - + (* The definition of the sequence above: *) Fixpoint uPred_nnupd_k {M} k (P: uPred M) : uPred M := ((P -∗ â–·^k False) -∗ â–·^k False) ∧ - match k with + match k with O => True | S k' => uPred_nnupd_k k' P end. @@ -138,11 +138,11 @@ Notation "|=n=>_ k Q" := (uPred_nnupd_k k Q) (* One direction of the limiting process is easy -- nnupd implies nnupd_k for each k *) Lemma nnupd_trunc1 k P: (|=n=> P) ⊢ |=n=>_k P. Proof. - induction k. - - rewrite /uPred_nnupd_k /uPred_nnupd. + induction k. + - rewrite /uPred_nnupd_k /uPred_nnupd. rewrite (forall_elim 0) //= right_id //. - simpl. apply and_intro; auto. - rewrite /uPred_nnupd. + rewrite /uPred_nnupd. rewrite (forall_elim (S k)) //=. Qed. @@ -191,11 +191,10 @@ Lemma nnupd_nnupd_k_dist k P: (|=n=> P)%I ≡{k}≡ (|=n=>_k P)%I. assert (n = S k ∨ n < S k) as [->|] by omega. **** eapply laterN_big; eauto; unseal. eapply HnnP; eauto. move: HPF; by unseal. - **** move:nnupd_k_elim. unseal. intros Hnnupdk. + **** move:nnupd_k_elim. unseal. intros Hnnupdk. eapply laterN_big; eauto. unseal. eapply (Hnnupdk n k); first omega; eauto. - exists x, x'. split_and!; eauto. eapply uPred_closed; eauto. - eapply cmra_validN_op_l; eauto. + exists x, x'. split_and!; eauto. eapply uPred_mono; eauto. ** intros HP. eapply IHk; auto. move:HP. unseal. intros (?&?); naive_solver. Qed. @@ -205,13 +204,13 @@ Lemma nnupd_k_intro k P: P ⊢ (|=n=>_k P). Proof. induction k; rewrite //= ?right_id. - apply wand_intro_l. apply wand_elim_l. - - apply and_intro; auto. + - apply and_intro; auto. apply wand_intro_l. apply wand_elim_l. Qed. Lemma nnupd_k_mono k P Q: (P ⊢ Q) → (|=n=>_k P) ⊢ (|=n=>_k Q). Proof. - induction k; rewrite //= ?right_id=>HPQ. + induction k; rewrite //= ?right_id=>HPQ. - do 2 (apply wand_mono; auto). - apply and_mono; auto; do 2 (apply wand_mono; auto). Qed. @@ -229,13 +228,13 @@ Lemma nnupd_k_trans k P: (|=n=>_k |=n=>_k P) ⊢ (|=n=>_k P). Proof. revert P. induction k; intros P. - - rewrite //= ?right_id. apply wand_intro_l. + - rewrite //= ?right_id. apply wand_intro_l. rewrite {1}(nnupd_k_intro 0 (P -∗ False)%I) //= ?right_id. apply wand_elim_r. - rewrite {2}(nnupd_k_unfold k P). apply and_intro. * rewrite (nnupd_k_unfold k P). rewrite and_elim_l. rewrite nnupd_k_unfold. rewrite and_elim_l. - apply wand_intro_l. + apply wand_intro_l. rewrite {1}(nnupd_k_intro (S k) (P -∗ â–·^(S k) (False)%I)). rewrite nnupd_k_unfold and_elim_l. apply wand_elim_r. * do 2 rewrite nnupd_k_weaken //. @@ -264,8 +263,8 @@ Proof. case (decide (a ≤ n')). - intros Hle Hwand. exfalso. eapply laterN_big; last (uPred.unseal; eapply (Hwand n' x')); eauto. - * rewrite comm. done. - * rewrite comm. done. + * rewrite comm. done. + * rewrite comm. done. - intros; assert (n' < a). omega. move: laterN_small. uPred.unseal. naive_solver. @@ -301,23 +300,23 @@ End classical. Lemma nnupd_dne φ: (|=n=> ⌜¬¬ φ → φâŒ: uPred M)%I. Proof. rewrite /uPred_nnupd. apply forall_intro=>n. - apply wand_intro_l. rewrite ?right_id. + apply wand_intro_l. rewrite ?right_id. assert (∀ φ, ¬¬¬¬φ → ¬¬φ) by naive_solver. assert (Hdne: ¬¬ (¬¬φ → φ)) by naive_solver. split. unseal. intros n' ?? Hupd. case (decide (n' < n)). - intros. move: laterN_small. unseal. naive_solver. - - intros. assert (n ≤ n'). omega. + - intros. assert (n ≤ n'). omega. exfalso. specialize (Hupd n' ε). eapply Hdne. intros Hfal. - eapply laterN_big; eauto. + eapply laterN_big; eauto. unseal. rewrite right_id in Hupd *; naive_solver. Qed. (* Nevertheless, we can prove a weaker form of adequacy (which is equvialent to adequacy under classical axioms) directly without passing through the proofs for bupd: *) Lemma adequacy_helper1 P n k x: - ✓{S n + k} x → ¬¬ (Nat.iter (S n) (λ P, |=n=> â–· P)%I P (S n + k) x) + ✓{S n + k} x → ¬¬ (Nat.iter (S n) (λ P, |=n=> â–· P)%I P (S n + k) x) → ¬¬ (∃ x', ✓{n + k} (x') ∧ Nat.iter n (λ P, |=n=> â–· P)%I P (n + k) (x')). Proof. revert k P x. induction n. @@ -331,7 +330,7 @@ Proof. * intros. move:(laterN_small n' (S k) x' False). rewrite //=. unseal. intros Hsmall. eapply Hsmall; eauto. * subst. intros. exfalso. eapply Hf2. exists x'. split; eauto using cmra_validN_S. - - intros k P x Hx. rewrite ?Nat_iter_S_r. + - intros k P x Hx. rewrite ?Nat_iter_S_r. replace (S (S n) + k) with (S n + (S k)) by omega. replace (S n + k) with (n + (S k)) by omega. intros. eapply IHn. replace (S n + S k) with (S (S n) + k) by omega. eauto. @@ -339,7 +338,7 @@ Proof. Qed. Lemma adequacy_helper2 P n k x: - ✓{S n + k} x → ¬¬ (Nat.iter (S n) (λ P, |=n=> â–· P)%I P (S n + k) x) + ✓{S n + k} x → ¬¬ (Nat.iter (S n) (λ P, |=n=> â–· P)%I P (S n + k) x) → ¬¬ (∃ x', ✓{k} (x') ∧ Nat.iter 0 (λ P, |=n=> â–· P)%I P k (x')). Proof. revert x. induction n. diff --git a/theories/base_logic/upred.v b/theories/base_logic/upred.v index e2246a5c391cd3fc32d40ee4a062e1df734a45d1..d6a53085f0c43429507e51677aeeba5db5270ba6 100644 --- a/theories/base_logic/upred.v +++ b/theories/base_logic/upred.v @@ -11,43 +11,46 @@ Local Hint Extern 10 (_ ≤ _) => omega. base_logic.base_logic; that will also give you all the primitive and many derived laws for the logic. *) +(* A good way of understanding this definition of the uPred OFE is to + consider the OFE uPred0 of monotonous SProp predicates. That is, + uPred0 is the OFE of non-expansive functions from M to SProp that + are monotonous with respect to CMRA inclusion. This notion of + monotonicity has to be stated in the SProp logic. Together with the + usual closedness property of SProp, this gives exactly uPred_mono. + + Then, we quotient uPred0 *in the sProp logic* with respect to + equivalence on valid elements of M. That is, we quotient with + respect to the following *sProp* equivalence relation: + P1 ≡ P2 := ∀ x, ✓ x → (P1(x) ↔ P2(x)) (1) + When seen from the ambiant logic, obtaining this quotient requires + definig both a custom Equiv and Dist. + + + It is worth noting that this equivalence relation admits canonical + representatives. More precisely, one can show that every + equivalence class contains exactly one element P0 such that: + ∀ x, (✓ x → P0(x)) → P0(x) (2) + (Again, this assertion has to be understood in sProp). Intuitively, + this says that P0 trivially holds whenever the resource is invalid. + Starting from any element P, one can find this canonical + representative by choosing: + P0(x) := ✓ x → P(x) (3) + + Hence, as an alternative definition of uPred, we could use the set + of canonical representatives (i.e., the subtype of monotonous + sProp predicates that verify (2)). This alternative definition would + save us from using a quotient. However, the definitions of the various + connectives would get more complicated, because we have to make sure + they all verify (2), which sometimes requires some adjustments. We + would moreover need to prove one more property for every logical + connective. + *) + Record uPred (M : ucmraT) : Type := IProp { uPred_holds :> nat → M → Prop; - (* [uPred_mono] is used to prove non-expansiveness (guaranteed by - [uPred_ne]). Therefore, it is important that we do not restrict - it to only valid elements. *) - uPred_mono n x1 x2 : uPred_holds n x1 → x1 ≼{n} x2 → uPred_holds n x2; - - (* We have to restrict this to hold only for valid elements, - otherwise this condition is no longer limit preserving, and uPred - does no longer form a COFE (i.e., [uPred_compl] breaks). This is - because the distance and equivalence on this cofe ignores the - truth value on invalid elements. This, in turn, is required by - the fact that entailment has to ignore invalid elements, which is - itself essential for proving [ownM_valid]. - - We could, actually, remove this restriction and make this - condition apply even to invalid elements: we have proved that - uPred is isomorphic to a sub-COFE of the COFE of predicates that - are monotonous both with respect to the step index and with - respect to x. However, that would essentially require changing - (by making it more complicated) the model of many connectives of - the logic, which we don't want. - This sub-COFE is the sub-COFE of monotonous sProp predicates P - such that the following sProp assertion is valid: - ∀ x, (V(x) → P(x)) → P(x) - Where V is the validity predicate. - - Another way of saying that this is equivalent to this definition of - uPred is to notice that our definition of uPred is equivalent to - quotienting the COFE of monotonous sProp predicates with the - following (sProp) equivalence relation: - P1 ≡ P2 := ∀ x, V(x) → (P1(x) ↔ P2(x)) - whose equivalence classes appear to all have one only canonical - representative such that ∀ x, (V(x) → P(x)) → P(x). - *) - uPred_closed n1 n2 x : uPred_holds n1 x → n2 ≤ n1 → ✓{n2} x → uPred_holds n2 x + uPred_mono n1 n2 x1 x2 : + uPred_holds n1 x1 → x1 ≼{n1} x2 → n2 ≤ n1 → uPred_holds n2 x2 }. Arguments uPred_holds {_} _ _ _ : simpl never. Add Printing Constructor uPred. @@ -81,15 +84,17 @@ Section cofe. Canonical Structure uPredC : ofeT := OfeT (uPred M) uPred_ofe_mixin. Program Definition uPred_compl : Compl uPredC := λ c, - {| uPred_holds n x := c n n x |}. - Next Obligation. naive_solver eauto using uPred_mono. Qed. + {| uPred_holds n x := ∀ n', n' ≤ n → ✓{n'}x → c n' n' x |}. Next Obligation. - intros c n1 n2 x ???; simpl in *. - apply (chain_cauchy c n2 n1); eauto using uPred_closed. + move=> /= c n1 n2 x1 x2 HP Hx12 Hn12 n3 Hn23 Hv. eapply uPred_mono. + eapply HP, cmra_validN_includedN, cmra_includedN_le=>//; lia. + eapply cmra_includedN_le=>//; lia. done. Qed. Global Program Instance uPred_cofe : Cofe uPredC := {| compl := uPred_compl |}. Next Obligation. - intros n c; split=>i x ??; symmetry; apply (chain_cauchy c i n); auto. + intros n c; split=>i x Hin Hv. + etrans; [|by symmetry; apply (chain_cauchy c i n)]. split=>H; [by apply H|]. + repeat intro. apply (chain_cauchy c n' i)=>//. by eapply uPred_mono. Qed. End cofe. Arguments uPredC : clear implicits. @@ -104,8 +109,24 @@ 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. + intros [Hne] ???. eapply Hne; try done. eauto using uPred_mono, cmra_validN_le. +Qed. + +(* Equivalence to the definition of uPred in the appendix. *) +Lemma uPred_alt {M : ucmraT} (P: nat → M → Prop) : + (∀ n1 n2 x1 x2, P n1 x1 → x1 ≼{n1} x2 → n2 ≤ n1 → P n2 x2) ↔ + ( (∀ x n1 n2, n2 ≤ n1 → P n1 x → P n2 x) (* Pointwise down-closed *) + ∧ (∀ n x1 x2, x1 ≡{n}≡ x2 → ∀ m, m ≤ n → P m x1 ↔ P m x2) (* Non-expansive *) + ∧ (∀ n x1 x2, x1 ≼{n} x2 → ∀ m, m ≤ n → P m x1 → P m x2) (* Monotonicity *) + ). +Proof. + (* Provide this lemma to eauto. *) + assert (∀ n1 n2 (x1 x2 : M), n2 ≤ n1 → x1 ≡{n1}≡ x2 → x1 ≼{n2} x2). + { intros ????? H. eapply cmra_includedN_le; last done. by rewrite H. } + (* Now go ahead. *) + split. + - intros Hupred. repeat split; eauto using cmra_includedN_le. + - intros (Hdown & _ & Hmono) **. eapply Hmono; [done..|]. eapply Hdown; done. Qed. (** functor *) @@ -113,7 +134,6 @@ Program Definition uPred_map {M1 M2 : ucmraT} (f : M2 -n> M1) `{!CmraMorphism f} (P : uPred M1) : uPred M2 := {| uPred_holds n x := P n (f x) |}. Next Obligation. naive_solver eauto using uPred_mono, cmra_morphism_monotoneN. Qed. -Next Obligation. naive_solver eauto using uPred_closed, cmra_morphism_validN. Qed. Instance uPred_map_ne {M1 M2 : ucmraT} (f : M2 -n> M1) `{!CmraMorphism f} n : Proper (dist n ==> dist n) (uPred_map f). @@ -168,7 +188,7 @@ Qed. (** logical entailement *) Inductive uPred_entails {M} (P Q : uPred M) : Prop := { uPred_in_entails : ∀ n x, ✓{n} x → P n x → Q n x }. -Hint Resolve uPred_mono uPred_closed : uPred_def. +Hint Resolve uPred_mono : uPred_def. (** logical connectives *) Program Definition uPred_pure_def {M} (φ : Prop) : uPred M := @@ -199,11 +219,10 @@ Program Definition uPred_impl_def {M} (P Q : uPred M) : uPred M := {| uPred_holds n x := ∀ n' x', x ≼ x' → n' ≤ n → ✓{n'} x' → P n' x' → Q n' x' |}. Next Obligation. - intros M P Q n1 x1 x1' HPQ [x2 Hx1'] n2 x3 [x4 Hx3] ?; simpl in *. + intros M P Q n1 n1' x1 x1' HPQ [x2 Hx1'] Hn1 n2 x3 [x4 Hx3] ?; simpl in *. rewrite Hx3 (dist_le _ _ _ _ Hx1'); auto. intros ??. eapply HPQ; auto. exists (x2 â‹… x4); by rewrite assoc. Qed. -Next Obligation. intros M P Q [|n1] [|n2] x; auto with lia. Qed. Definition uPred_impl_aux : seal (@uPred_impl_def). by eexists. Qed. Definition uPred_impl {M} := unseal uPred_impl_aux M. Definition uPred_impl_eq : @@ -235,14 +254,9 @@ Definition uPred_internal_eq_eq: Program Definition uPred_sep_def {M} (P Q : uPred M) : uPred M := {| uPred_holds n x := ∃ x1 x2, x ≡{n}≡ x1 â‹… x2 ∧ P n x1 ∧ Q n x2 |}. Next Obligation. - intros M P Q n x y (x1&x2&Hx&?&?) [z Hy]. + intros M P Q n1 n2 x y (x1&x2&Hx&?&?) [z Hy] Hn. exists x1, (x2 â‹… z); split_and?; eauto using uPred_mono, cmra_includedN_l. - by rewrite Hy Hx assoc. -Qed. -Next Obligation. - intros M P Q n1 n2 x (x1&x2&Hx&?&?) ?; rewrite {1}(dist_le _ _ _ _ Hx) // =>?. - exists x1, x2; ofe_subst; split_and!; - eauto using dist_le, uPred_closed, cmra_validN_op_l, cmra_validN_op_r. + eapply dist_le, Hn. by rewrite Hy Hx assoc. Qed. Definition uPred_sep_aux : seal (@uPred_sep_def). by eexists. Qed. Definition uPred_sep {M} := unseal uPred_sep_aux M. @@ -252,11 +266,10 @@ Program Definition uPred_wand_def {M} (P Q : uPred M) : uPred M := {| uPred_holds n x := ∀ n' x', n' ≤ n → ✓{n'} (x â‹… x') → P n' x' → Q n' (x â‹… x') |}. Next Obligation. - intros M P Q n x1 x1' HPQ ? n3 x3 ???; simpl in *. - apply uPred_mono with (x1 â‹… x3); + intros M P Q n1 n1' x1 x1' HPQ ? Hn n3 x3 ???; simpl in *. + eapply uPred_mono with n3 (x1 â‹… x3); eauto using cmra_validN_includedN, cmra_monoN_r, cmra_includedN_le. Qed. -Next Obligation. naive_solver. Qed. Definition uPred_wand_aux : seal (@uPred_wand_def). by eexists. Qed. Definition uPred_wand {M} := unseal uPred_wand_aux M. Definition uPred_wand_eq : @@ -267,7 +280,7 @@ Definition uPred_wand_eq : because Iris is afine. The following is easier to work with. *) Program Definition uPred_plainly_def {M} (P : uPred M) : uPred M := {| uPred_holds n x := P n ε |}. -Solve Obligations with naive_solver eauto using uPred_closed, ucmra_unit_validN. +Solve Obligations with naive_solver eauto using uPred_mono, ucmra_unit_validN. Definition uPred_plainly_aux : seal (@uPred_plainly_def). by eexists. Qed. Definition uPred_plainly {M} := unseal uPred_plainly_aux M. Definition uPred_plainly_eq : @@ -278,7 +291,6 @@ Program Definition uPred_persistently_def {M} (P : uPred M) : uPred M := Next Obligation. intros M; naive_solver eauto using uPred_mono, @cmra_core_monoN. Qed. -Next Obligation. naive_solver eauto using uPred_closed, @cmra_core_validN. Qed. Definition uPred_persistently_aux : seal (@uPred_persistently_def). by eexists. Qed. Definition uPred_persistently {M} := unseal uPred_persistently_aux M. Definition uPred_persistently_eq : @@ -287,10 +299,7 @@ Definition uPred_persistently_eq : Program Definition uPred_later_def {M} (P : uPred M) : uPred M := {| uPred_holds n x := match n return _ with 0 => True | S n' => P n' x end |}. Next Obligation. - intros M P [|n] x1 x2; eauto using uPred_mono, cmra_includedN_S. -Qed. -Next Obligation. - intros M P [|n1] [|n2] x; eauto using uPred_closed, cmra_validN_S with lia. + intros M P [|n1] [|n2] x1 x2; eauto using uPred_mono, cmra_includedN_S with lia. Qed. Definition uPred_later_aux : seal (@uPred_later_def). by eexists. Qed. Definition uPred_later {M} := unseal uPred_later_aux M. @@ -300,10 +309,9 @@ Definition uPred_later_eq : Program Definition uPred_ownM_def {M : ucmraT} (a : M) : uPred M := {| uPred_holds n x := a ≼{n} x |}. Next Obligation. - intros M a n x1 x [a' Hx1] [x2 ->]. - exists (a' â‹… x2). by rewrite (assoc op) Hx1. + intros M a n1 n2 x1 x [a' Hx1] [x2 Hx] Hn. eapply cmra_includedN_le=>//. + exists (a' â‹… x2). by rewrite Hx(assoc op) Hx1. Qed. -Next Obligation. naive_solver eauto using cmra_includedN_le. Qed. Definition uPred_ownM_aux : seal (@uPred_ownM_def). by eexists. Qed. Definition uPred_ownM {M} := unseal uPred_ownM_aux M. Definition uPred_ownM_eq : @@ -321,13 +329,12 @@ Program Definition uPred_bupd_def {M} (Q : uPred M) : uPred M := {| uPred_holds n x := ∀ k yf, k ≤ n → ✓{k} (x â‹… yf) → ∃ x', ✓{k} (x' â‹… yf) ∧ Q k x' |}. Next Obligation. - intros M Q n x1 x2 HQ [x3 Hx] k yf Hk. + intros M Q n1 n2 x1 x2 HQ [x3 Hx] Hn k yf Hk. rewrite (dist_le _ _ _ _ Hx); last lia. intros Hxy. destruct (HQ k (x3 â‹… yf)) as (x'&?&?); [auto|by rewrite assoc|]. exists (x' â‹… x3); split; first by rewrite -assoc. - apply uPred_mono with x'; eauto using cmra_includedN_l. + eauto using uPred_mono, cmra_includedN_l. Qed. -Next Obligation. naive_solver. Qed. Definition uPred_bupd_aux {M} : seal (@uPred_bupd_def M). by eexists. Qed. Instance uPred_bupd {M} : BUpd (uPred M) := unseal uPred_bupd_aux. Definition uPred_bupd_eq {M} : @@ -420,7 +427,7 @@ Proof. intros P Q R HP HQ. unseal; split=> n x ? [?|?]. by apply HP. by apply HQ. - (* (P ∧ Q ⊢ R) → P ⊢ Q → R. *) intros P Q R. unseal => HQ; split=> n x ?? n' x' ????. apply HQ; - naive_solver eauto using uPred_mono, uPred_closed, cmra_included_includedN. + naive_solver eauto using uPred_mono, cmra_included_includedN. - (* (P ⊢ Q → R) → P ∧ Q ⊢ R *) intros P Q R. unseal=> HP; split=> n x ? [??]. apply HP with n x; auto. - (* (∀ a, P ⊢ Ψ a) → P ⊢ ∀ a, Ψ a *) @@ -463,7 +470,7 @@ Proof. - (* (P ∗ Q ⊢ R) → P ⊢ Q -∗ R *) intros P Q R. unseal=> HPQR; split=> n x ?? n' x' ???; apply HPQR; auto. exists x, x'; split_and?; auto. - eapply uPred_closed with n; eauto using cmra_validN_op_l. + eapply uPred_mono; eauto using cmra_validN_op_l. - (* (P ⊢ Q -∗ R) → P ∗ Q ⊢ R *) intros P Q R. unseal=> HPQR. split; intros n x ? (?&?&?&?&?). ofe_subst. eapply HPQR; eauto using cmra_validN_op_l. @@ -480,11 +487,11 @@ Proof. split; eapply HPQ; eauto using @ucmra_unit_least. - (* (bi_plainly P → bi_persistently Q) ⊢ bi_persistently (bi_plainly P → Q) *) unseal; split=> /= n x ? HPQ n' x' ????. - eapply uPred_mono with (core x), cmra_included_includedN; auto. + eapply uPred_mono with n' (core x)=>//; [|by apply cmra_included_includedN]. apply (HPQ n' x); eauto using cmra_validN_le. - (* (bi_plainly P → bi_plainly Q) ⊢ bi_plainly (bi_plainly P → Q) *) unseal; split=> /= n x ? HPQ n' x' ????. - eapply uPred_mono with ε, cmra_included_includedN; auto. + eapply uPred_mono with n' ε=>//; [|by apply cmra_included_includedN]. apply (HPQ n' x); eauto using cmra_validN_le. - (* P ⊢ bi_plainly emp (ADMISSIBLE) *) by unseal. @@ -529,7 +536,7 @@ Proof. unseal=> HP; split=>-[|n] x ??; [done|apply HP; eauto using cmra_validN_S]. - (* (â–· P → P) ⊢ P *) intros P. unseal; split=> n x ? HP; induction n as [|n IH]; [by apply HP|]. - apply HP, IH, uPred_closed with (S n); eauto using cmra_validN_S. + apply HP, IH, uPred_mono with (S n) x; eauto using cmra_validN_S. - (* (∀ a, â–· Φ a) ⊢ â–· ∀ a, Φ a *) intros A Φ. unseal; by split=> -[|n] x. - (* (â–· ∃ a, Φ a) ⊢ â–· False ∨ (∃ a, â–· Φ a) *) @@ -554,7 +561,7 @@ Proof. - (* â–· P ⊢ â–· False ∨ (â–· False → P) *) intros P. unseal; split=> -[|n] x ? /= HP; [by left|right]. intros [|n'] x' ????; [|done]. - eauto using uPred_closed, uPred_mono, cmra_included_includedN. + eauto using uPred_mono, cmra_included_includedN. Qed. Canonical Structure uPredI (M : ucmraT) : bi := @@ -682,7 +689,7 @@ Proof. by uPred.unseal. Qed. Lemma bupd_intro P : P ==∗ P. Proof. unseal. split=> n x ? HP k yf ?; exists x; split; first done. - apply uPred_closed with n; eauto using cmra_validN_op_l. + apply uPred_mono with n x; eauto using cmra_validN_op_l. Qed. Lemma bupd_mono P Q : (P ⊢ Q) → (|==> P) ==∗ Q. Proof. @@ -698,8 +705,7 @@ Proof. destruct (HP k (x2 â‹… yf)) as (x'&?&?); eauto. { by rewrite assoc -(dist_le _ _ _ _ Hx); last lia. } exists (x' â‹… x2); split; first by rewrite -assoc. - exists x', x2; split_and?; auto. - apply uPred_closed with n; eauto 3 using cmra_validN_op_l, cmra_validN_op_r. + exists x', x2. eauto using uPred_mono, cmra_validN_op_l, cmra_validN_op_r. Qed. Lemma bupd_ownM_updateP x (Φ : M → Prop) : x ~~>: Φ → uPred_ownM x ==∗ ∃ y, ⌜Φ y⌠∧ uPred_ownM y. diff --git a/theories/heap_lang/adequacy.v b/theories/heap_lang/adequacy.v index a184a59657dfd639315dd8aa4416f314160e0bd5..51529438b392a93878e3f21458f0be2b7982d7fd 100644 --- a/theories/heap_lang/adequacy.v +++ b/theories/heap_lang/adequacy.v @@ -14,9 +14,9 @@ Definition heapΣ : gFunctors := #[invΣ; gen_heapΣ loc val]. Instance subG_heapPreG {Σ} : subG heapΣ Σ → heapPreG Σ. Proof. solve_inG. Qed. -Definition heap_adequacy Σ `{heapPreG Σ} e σ φ : - (∀ `{heapG Σ}, WP e {{ v, ⌜φ v⌠}}%I) → - adequate e σ φ. +Definition heap_adequacy Σ `{heapPreG Σ} s e σ φ : + (∀ `{heapG Σ}, WP e @ s; ⊤ {{ v, ⌜φ v⌠}}%I) → + adequate s e σ φ. Proof. intros Hwp; eapply (wp_adequacy _ _); iIntros (?) "". iMod (gen_heap_init σ) as (?) "Hh". diff --git a/theories/heap_lang/lang.v b/theories/heap_lang/lang.v index ac4795d5d88be648a1217a05898330597c93ebf1..45f540eceb521c8268ac27054fa2720bbb402d86 100644 --- a/theories/heap_lang/lang.v +++ b/theories/heap_lang/lang.v @@ -15,7 +15,10 @@ Inductive base_lit : Set := Inductive un_op : Set := | NegOp | MinusUnOp. Inductive bin_op : Set := - | PlusOp | MinusOp | LeOp | LtOp | EqOp. + | PlusOp | MinusOp | MultOp | QuotOp | RemOp (* Arithmetic *) + | AndOp | OrOp | XorOp (* Bitwise *) + | ShiftLOp | ShiftROp (* Shifts *) + | LeOp | LtOp | EqOp. (* Relations *) Inductive binder := BAnon | BNamed : string → binder. Delimit Scope binder_scope with bind. @@ -57,7 +60,8 @@ Inductive expr := | Alloc (e : expr) | Load (e : expr) | Store (e1 : expr) (e2 : expr) - | CAS (e0 : expr) (e1 : expr) (e2 : expr). + | CAS (e0 : expr) (e1 : expr) (e2 : expr) + | FAA (e1 : expr) (e2 : expr). Bind Scope expr_scope with expr. @@ -68,7 +72,7 @@ Fixpoint is_closed (X : list string) (e : expr) : bool := | 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 => + | App e1 e2 | BinOp _ e1 e2 | Pair e1 e2 | Store e1 e2 | FAA 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 @@ -157,9 +161,13 @@ Qed. Instance bin_op_countable : Countable bin_op. Proof. refine (inj_countable' (λ op, match op with - | PlusOp => 0 | MinusOp => 1 | LeOp => 2 | LtOp => 3 | EqOp => 4 + | PlusOp => 0 | MinusOp => 1 | MultOp => 2 | QuotOp => 3 | RemOp => 4 + | AndOp => 5 | OrOp => 6 | XorOp => 7 | ShiftLOp => 8 | ShiftROp => 9 + | LeOp => 10 | LtOp => 11 | EqOp => 12 end) (λ n, match n with - | 0 => PlusOp | 1 => MinusOp | 2 => LeOp | 3 => LtOp | _ => EqOp + | 0 => PlusOp | 1 => MinusOp | 2 => MultOp | 3 => QuotOp | 4 => RemOp + | 5 => AndOp | 6 => OrOp | 7 => XorOp | 8 => ShiftLOp | 9 => ShiftROp + | 10 => LeOp | 11 => LtOp | _ => EqOp end) _); by intros []. Qed. Instance binder_countable : Countable binder. @@ -189,6 +197,7 @@ Proof. | Load e => GenNode 13 [go e] | Store e1 e2 => GenNode 14 [go e1; go e2] | CAS e0 e1 e2 => GenNode 15 [go e0; go e1; go e2] + | FAA e1 e2 => GenNode 16 [go e1; go e2] end). set (dec := fix go e := match e with @@ -210,6 +219,7 @@ Proof. | GenNode 13 [e] => Load (go e) | GenNode 14 [e1; e2] => Store (go e1) (go e2) | GenNode 15 [e0; e1; e2] => CAS (go e0) (go e1) (go e2) + | GenNode 16 [e1; e2] => FAA (go e1) (go e2) | _ => Lit LitUnit (* dummy *) end). refine (inj_countable' enc dec _). intros e. induction e; f_equal/=; auto. @@ -245,7 +255,9 @@ Inductive ectx_item := | StoreRCtx (v1 : val) | CasLCtx (e1 : expr) (e2 : expr) | CasMCtx (v0 : val) (e2 : expr) - | CasRCtx (v0 : val) (v1 : val). + | CasRCtx (v0 : val) (v1 : val) + | FaaLCtx (e2 : expr) + | FaaRCtx (v1 : val). Definition fill_item (Ki : ectx_item) (e : expr) : expr := match Ki with @@ -269,6 +281,8 @@ Definition fill_item (Ki : ectx_item) (e : expr) : expr := | CasLCtx e1 e2 => CAS e e1 e2 | CasMCtx v0 e2 => CAS (of_val v0) e e2 | CasRCtx v0 v1 => CAS (of_val v0) (of_val v1) e + | FaaLCtx e2 => FAA e e2 + | FaaRCtx v1 => FAA (of_val v1) e end. (** Substitution *) @@ -293,6 +307,7 @@ Fixpoint subst (x : string) (es : expr) (e : expr) : expr := | 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) + | FAA e1 e2 => FAA (subst x es e1) (subst x es e2) end. Definition subst' (mx : binder) (es : expr) : expr → expr := @@ -302,18 +317,44 @@ Definition subst' (mx : binder) (es : expr) : expr → expr := Definition un_op_eval (op : un_op) (v : val) : option val := match op, v with | NegOp, LitV (LitBool b) => Some $ LitV $ LitBool (negb b) + | NegOp, LitV (LitInt n) => Some $ LitV $ LitInt (Z.lnot n) | MinusUnOp, LitV (LitInt n) => Some $ LitV $ LitInt (- n) | _, _ => None end. +Definition bin_op_eval_int (op : bin_op) (n1 n2 : Z) : base_lit := + match op with + | PlusOp => LitInt (n1 + n2) + | MinusOp => LitInt (n1 - n2) + | MultOp => LitInt (n1 * n2) + | QuotOp => LitInt (n1 `quot` n2) + | RemOp => LitInt (n1 `rem` n2) + | AndOp => LitInt (Z.land n1 n2) + | OrOp => LitInt (Z.lor n1 n2) + | XorOp => LitInt (Z.lxor n1 n2) + | ShiftLOp => LitInt (n1 ≪ n2) + | ShiftROp => LitInt (n1 ≫ n2) + | LeOp => LitBool (bool_decide (n1 ≤ n2)) + | LtOp => LitBool (bool_decide (n1 < n2)) + | EqOp => LitBool (bool_decide (n1 = n2)) + end. + +Definition bin_op_eval_bool (op : bin_op) (b1 b2 : bool) : option base_lit := + match op with + | PlusOp | MinusOp | MultOp | QuotOp | RemOp => None (* Arithmetic *) + | AndOp => Some (LitBool (b1 && b2)) + | OrOp => Some (LitBool (b1 || b2)) + | XorOp => Some (LitBool (xorb b1 b2)) + | ShiftLOp | ShiftROp => None (* Shifts *) + | LeOp | LtOp => None (* InEquality *) + | EqOp => Some (LitBool (bool_decide (b1 = b2))) + end. + Definition bin_op_eval (op : bin_op) (v1 v2 : val) : option val := - match op, v1, v2 with - | PlusOp, LitV (LitInt n1), LitV (LitInt n2) => Some $ LitV $ LitInt (n1 + n2) - | MinusOp, LitV (LitInt n1), LitV (LitInt n2) => Some $ LitV $ LitInt (n1 - n2) - | LeOp, LitV (LitInt n1), LitV (LitInt n2) => Some $ LitV $ LitBool $ bool_decide (n1 ≤ n2) - | LtOp, LitV (LitInt n1), LitV (LitInt n2) => Some $ LitV $ LitBool $ bool_decide (n1 < n2) - | EqOp, v1, v2 => Some $ LitV $ LitBool $ bool_decide (v1 = v2) - | _, _, _ => None + match v1, v2 with + | LitV (LitInt n1), LitV (LitInt n2) => Some $ LitV $ bin_op_eval_int op n1 n2 + | LitV (LitBool b1), LitV (LitBool b2) => LitV <$> bin_op_eval_bool op b1 b2 + | v1, v2 => guard (op = EqOp); Some $ LitV $ LitBool $ bool_decide (v1 = v2) end. Inductive head_step : expr → state → expr → state → list (expr) → Prop := @@ -364,7 +405,12 @@ Inductive head_step : expr → state → expr → state → list (expr) → Prop | CasSucS l e1 v1 e2 v2 σ : to_val e1 = Some v1 → to_val e2 = Some v2 → σ !! l = Some v1 → - head_step (CAS (Lit $ LitLoc l) e1 e2) σ (Lit $ LitBool true) (<[l:=v2]>σ) []. + head_step (CAS (Lit $ LitLoc l) e1 e2) σ (Lit $ LitBool true) (<[l:=v2]>σ) [] + | FaaS l i1 e2 i2 σ : + to_val e2 = Some (LitV (LitInt i2)) → + σ !! l = Some (LitV (LitInt i1)) → + head_step (FAA (Lit $ LitLoc l) e2) σ (Lit $ LitInt i1) (<[l:=LitV (LitInt (i1 + i2))]>σ) []. + (** Basic properties about the language *) Instance fill_item_inj Ki : Inj (=) (=) (fill_item Ki). diff --git a/theories/heap_lang/lifting.v b/theories/heap_lang/lifting.v index b4d4c21c838160667367d8866169e92e388eb2cc..787070b60f9a6d78095886ae8467e1d290346aa5 100644 --- a/theories/heap_lang/lifting.v +++ b/theories/heap_lang/lifting.v @@ -47,7 +47,7 @@ Ltac inv_head_step := inversion H; subst; clear H end. -Local Hint Extern 0 (atomic _) => solve_atomic. +Local Hint Extern 0 (atomic _ _) => solve_atomic. Local Hint Extern 0 (head_reducible _ _) => eexists _, _, _; simpl. Local Hint Constructors head_step. @@ -62,11 +62,11 @@ Implicit Types efs : list expr. Implicit Types σ : state. (** Base axioms for core primitives of the language: Stateless reductions *) -Lemma wp_fork E e Φ : - â–· Φ (LitV LitUnit) ∗ â–· WP e {{ _, True }} ⊢ WP Fork e @ E {{ Φ }}. +Lemma wp_fork s E e Φ : + â–· Φ (LitV LitUnit) ∗ â–· WP e @ s; ⊤ {{ _, True }} ⊢ WP Fork e @ s; E {{ Φ }}. Proof. rewrite -(wp_lift_pure_det_head_step (Fork e) (Lit LitUnit) [e]) //=; eauto. - - by rewrite -step_fupd_intro // later_sep -(wp_value _ _ (Lit _)) // right_id. + - by rewrite -step_fupd_intro // later_sep -(wp_value _ _ _ (Lit _)) // right_id. - intros; inv_head_step; eauto. Qed. @@ -122,9 +122,9 @@ Global Instance pure_case_inr e0 v e1 e2 `{!IntoVal e0 v} : Proof. solve_pure_exec. Qed. (** Heap *) -Lemma wp_alloc E e v : +Lemma wp_alloc s E e v : IntoVal e v → - {{{ True }}} Alloc e @ E {{{ l, RET LitV (LitLoc l); l ↦ v }}}. + {{{ True }}} Alloc e @ s; E {{{ l, RET LitV (LitLoc l); l ↦ v }}}. Proof. iIntros (<-%of_to_val Φ) "_ HΦ". iApply wp_lift_atomic_head_step_no_fork; auto. iIntros (σ1) "Hσ !>"; iSplit; first by auto. @@ -133,8 +133,8 @@ Proof. iModIntro; iSplit=> //. iFrame. by iApply "HΦ". Qed. -Lemma wp_load E l q v : - {{{ â–· l ↦{q} v }}} Load (Lit (LitLoc l)) @ E {{{ RET v; l ↦{q} v }}}. +Lemma wp_load s E l q v : + {{{ â–· l ↦{q} v }}} Load (Lit (LitLoc l)) @ s; E {{{ RET v; l ↦{q} v }}}. Proof. iIntros (Φ) ">Hl HΦ". iApply wp_lift_atomic_head_step_no_fork; auto. iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?. @@ -143,9 +143,9 @@ Proof. iModIntro; iSplit=> //. iFrame. by iApply "HΦ". Qed. -Lemma wp_store E l v' e v : +Lemma wp_store s E l v' e v : IntoVal e v → - {{{ â–· l ↦ v' }}} Store (Lit (LitLoc l)) e @ E {{{ RET LitV LitUnit; l ↦ v }}}. + {{{ â–· l ↦ v' }}} Store (Lit (LitLoc l)) e @ s; E {{{ RET LitV LitUnit; l ↦ v }}}. Proof. iIntros (<-%of_to_val Φ) ">Hl HΦ". iApply wp_lift_atomic_head_step_no_fork; auto. @@ -155,9 +155,9 @@ Proof. iModIntro. iSplit=>//. by iApply "HΦ". Qed. -Lemma wp_cas_fail E l q v' e1 v1 e2 : +Lemma wp_cas_fail s E l q v' e1 v1 e2 : IntoVal e1 v1 → AsVal e2 → v' ≠v1 → - {{{ â–· l ↦{q} v' }}} CAS (Lit (LitLoc l)) e1 e2 @ E + {{{ â–· l ↦{q} v' }}} CAS (Lit (LitLoc l)) e1 e2 @ s; E {{{ RET LitV (LitBool false); l ↦{q} v' }}}. Proof. iIntros (<-%of_to_val [v2 <-%of_to_val] ? Φ) ">Hl HΦ". @@ -167,9 +167,9 @@ Proof. iModIntro; iSplit=> //. iFrame. by iApply "HΦ". Qed. -Lemma wp_cas_suc E l e1 v1 e2 v2 : +Lemma wp_cas_suc s E l e1 v1 e2 v2 : IntoVal e1 v1 → IntoVal e2 v2 → - {{{ â–· l ↦ v1 }}} CAS (Lit (LitLoc l)) e1 e2 @ E + {{{ â–· l ↦ v1 }}} CAS (Lit (LitLoc l)) e1 e2 @ s; E {{{ RET LitV (LitBool true); l ↦ v2 }}}. Proof. iIntros (<-%of_to_val <-%of_to_val Φ) ">Hl HΦ". @@ -179,4 +179,17 @@ Proof. iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]". iModIntro. iSplit=>//. by iApply "HΦ". Qed. + +Lemma wp_faa s E l i1 e2 i2 : + IntoVal e2 (LitV (LitInt i2)) → + {{{ â–· l ↦ LitV (LitInt i1) }}} FAA (Lit (LitLoc l)) e2 @ s; E + {{{ RET LitV (LitInt i1); l ↦ LitV (LitInt (i1 + i2)) }}}. +Proof. + iIntros (<-%of_to_val Φ) ">Hl HΦ". + iApply wp_lift_atomic_head_step_no_fork; auto. + iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?. + iSplit; first by eauto. iNext; iIntros (v2' σ2 efs Hstep); inv_head_step. + iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]". + iModIntro. iSplit=>//. by iApply "HΦ". +Qed. End lifting. diff --git a/theories/heap_lang/notation.v b/theories/heap_lang/notation.v index 0ee932730a1f67c4a9f79476bbc30b352938d615..3751417fa10d2a6f30996a34389d880a86993bcb 100644 --- a/theories/heap_lang/notation.v +++ b/theories/heap_lang/notation.v @@ -58,16 +58,21 @@ Notation "()" := LitUnit : val_scope. Notation "! e" := (Load e%E) (at level 9, right associativity) : expr_scope. Notation "'ref' e" := (Alloc e%E) (at level 30, right associativity) : expr_scope. -Notation "- e" := (UnOp MinusUnOp e%E) - (at level 35, right associativity) : expr_scope. -Notation "e1 + e2" := (BinOp PlusOp e1%E e2%E) - (at level 50, left associativity) : expr_scope. -Notation "e1 - e2" := (BinOp MinusOp e1%E e2%E) - (at level 50, left associativity) : expr_scope. -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 MinusUnOp e%E) : expr_scope. + +Notation "e1 + e2" := (BinOp PlusOp e1%E e2%E) : expr_scope. +Notation "e1 - e2" := (BinOp MinusOp e1%E e2%E) : expr_scope. +Notation "e1 * e2" := (BinOp MultOp e1%E e2%E) : expr_scope. +Notation "e1 `quot` e2" := (BinOp QuotOp e1%E e2%E) : expr_scope. +Notation "e1 `rem` e2" := (BinOp RemOp e1%E e2%E) : expr_scope. +Notation "e1 ≪ e2" := (BinOp ShiftLOp e1%E e2%E) : expr_scope. +Notation "e1 ≫ e2" := (BinOp ShiftROp e1%E e2%E) : expr_scope. + +Notation "e1 ≤ e2" := (BinOp LeOp e1%E e2%E) : expr_scope. +Notation "e1 < e2" := (BinOp LtOp e1%E e2%E) : expr_scope. +Notation "e1 = e2" := (BinOp EqOp e1%E e2%E) : expr_scope. +Notation "e1 ≠e2" := (UnOp NegOp (BinOp EqOp e1%E e2%E)) : expr_scope. + Notation "~ e" := (UnOp NegOp e%E) (at level 75, right associativity) : expr_scope. (* The unicode ↠is already part of the notation "_ ↠_; _" for bind. *) Notation "e1 <- e2" := (Store e1%E e2%E) (at level 80) : expr_scope. diff --git a/theories/heap_lang/proofmode.v b/theories/heap_lang/proofmode.v index bc0f293de76332435089b43d57022a2425eb5ee7..643cfa12b6a4da9270afffdc1d231112a27c3013 100644 --- a/theories/heap_lang/proofmode.v +++ b/theories/heap_lang/proofmode.v @@ -5,9 +5,9 @@ From iris.heap_lang Require Export tactics lifting. Set Default Proof Using "Type". Import uPred. -Lemma tac_wp_expr_eval `{heapG Σ} Δ E Φ e e' : +Lemma tac_wp_expr_eval `{heapG Σ} Δ s E Φ e e' : e = e' → - envs_entails Δ (WP e' @ E {{ Φ }}) → envs_entails Δ (WP e @ E {{ Φ }}). + envs_entails Δ (WP e' @ s; E {{ Φ }}) → envs_entails Δ (WP e @ s; E {{ Φ }}). Proof. by intros ->. Qed. Ltac wp_expr_eval t := @@ -17,20 +17,20 @@ Ltac wp_expr_eval t := Ltac wp_expr_simpl := wp_expr_eval simpl. Ltac wp_expr_simpl_subst := wp_expr_eval simpl_subst. -Lemma tac_wp_pure `{heapG Σ} Δ Δ' E e1 e2 φ Φ : +Lemma tac_wp_pure `{heapG Σ} Δ Δ' s E e1 e2 φ Φ : PureExec φ e1 e2 → φ → IntoLaterNEnvs 1 Δ Δ' → - envs_entails Δ' (WP e2 @ E {{ Φ }}) → - envs_entails Δ (WP e1 @ E {{ Φ }}). + envs_entails Δ' (WP e2 @ s; E {{ Φ }}) → + envs_entails Δ (WP e1 @ s; E {{ Φ }}). Proof. rewrite /envs_entails=> ??? HΔ'. rewrite into_laterN_env_sound /=. rewrite HΔ' -wp_pure_step_later //. Qed. -Lemma tac_wp_value `{heapG Σ} Δ E Φ e v : +Lemma tac_wp_value `{heapG Σ} Δ s E Φ e v : IntoVal e v → - envs_entails Δ (Φ v) → envs_entails Δ (WP e @ E {{ Φ }}). + envs_entails Δ (Φ v) → envs_entails Δ (WP e @ s; E {{ Φ }}). Proof. rewrite /envs_entails=> ? ->. by apply wp_value. Qed. Ltac wp_value_head := eapply tac_wp_value; [apply _|lazy beta]. @@ -38,11 +38,11 @@ Ltac wp_value_head := eapply tac_wp_value; [apply _|lazy beta]. Tactic Notation "wp_pure" open_constr(efoc) := iStartProof; lazymatch goal with - | |- envs_entails _ (wp ?E ?e ?Q) => + | |- envs_entails _ (wp ?s ?E ?e ?Q) => let e := eval simpl in e in reshape_expr e ltac:(fun K e' => unify e' efoc; - eapply (tac_wp_pure _ _ _ (fill K e')); + eapply (tac_wp_pure _ _ _ _ (fill K e')); [apply _ (* PureExec *) |try fast_done (* The pure condition for PureExec *) |apply _ (* IntoLaters *) @@ -66,10 +66,10 @@ Tactic Notation "wp_proj" := wp_pure (Fst _) || wp_pure (Snd _). Tactic Notation "wp_case" := wp_pure (Case _ _ _). Tactic Notation "wp_match" := wp_case; wp_let. -Lemma tac_wp_bind `{heapG Σ} K Δ E Φ e f : +Lemma tac_wp_bind `{heapG Σ} K Δ s E Φ e f : f = (λ e, fill K e) → (* as an eta expanded hypothesis so that we can `simpl` it *) - envs_entails Δ (WP e @ E {{ v, WP f (of_val v) @ E {{ Φ }} }})%I → - envs_entails Δ (WP fill K e @ E {{ Φ }}). + envs_entails Δ (WP e @ s; E {{ v, WP f (of_val v) @ s; E {{ Φ }} }})%I → + envs_entails Δ (WP fill K e @ s; E {{ Φ }}). Proof. rewrite /envs_entails=> -> ->. by apply: wp_bind. Qed. Ltac wp_bind_core K := @@ -81,7 +81,7 @@ Ltac wp_bind_core K := Tactic Notation "wp_bind" open_constr(efoc) := iStartProof; lazymatch goal with - | |- envs_entails _ (wp ?E ?e ?Q) => + | |- envs_entails _ (wp ?s ?E ?e ?Q) => reshape_expr e ltac:(fun K e' => unify e' efoc; wp_bind_core K) || fail "wp_bind: cannot find" efoc "in" e | _ => fail "wp_bind: not a 'wp'" @@ -94,13 +94,13 @@ Implicit Types P Q : iProp Σ. Implicit Types Φ : val → iProp Σ. Implicit Types Δ : envs (uPredI (iResUR Σ)). -Lemma tac_wp_alloc Δ Δ' E j K e v Φ : +Lemma tac_wp_alloc Δ Δ' s E j K e v Φ : IntoVal e v → IntoLaterNEnvs 1 Δ Δ' → (∀ l, ∃ Δ'', envs_app false (Esnoc Enil j (l ↦ v)) Δ' = Some Δ'' ∧ - envs_entails Δ'' (WP fill K (Lit (LitLoc l)) @ E {{ Φ }})) → - envs_entails Δ (WP fill K (Alloc e) @ E {{ Φ }}). + envs_entails Δ'' (WP fill K (Lit (LitLoc l)) @ s; E {{ Φ }})) → + envs_entails Δ (WP fill K (Alloc e) @ s; E {{ Φ }}). Proof. rewrite /envs_entails=> ?? HΔ. rewrite -wp_bind. eapply wand_apply; first exact: wp_alloc. @@ -109,11 +109,11 @@ Proof. by rewrite right_id HΔ'. Qed. -Lemma tac_wp_load Δ Δ' E i K l q v Φ : +Lemma tac_wp_load Δ Δ' s E i K l q v Φ : IntoLaterNEnvs 1 Δ Δ' → envs_lookup i Δ' = Some (false, l ↦{q} v)%I → - envs_entails Δ' (WP fill K (of_val v) @ E {{ Φ }}) → - envs_entails Δ (WP fill K (Load (Lit (LitLoc l))) @ E {{ Φ }}). + envs_entails Δ' (WP fill K (of_val v) @ s; E {{ Φ }}) → + envs_entails Δ (WP fill K (Load (Lit (LitLoc l))) @ s; E {{ Φ }}). Proof. rewrite /envs_entails=> ???. rewrite -wp_bind. eapply wand_apply; first exact: wp_load. @@ -121,13 +121,13 @@ Proof. by apply later_mono, sep_mono_r, wand_mono. Qed. -Lemma tac_wp_store Δ Δ' Δ'' E i K l v e v' Φ : +Lemma tac_wp_store Δ Δ' Δ'' s E i K l v e v' Φ : IntoVal e v' → IntoLaterNEnvs 1 Δ Δ' → envs_lookup i Δ' = Some (false, l ↦ v)%I → envs_simple_replace i false (Esnoc Enil i (l ↦ v')) Δ' = Some Δ'' → - envs_entails Δ'' (WP fill K (Lit LitUnit) @ E {{ Φ }}) → - envs_entails Δ (WP fill K (Store (Lit (LitLoc l)) e) @ E {{ Φ }}). + envs_entails Δ'' (WP fill K (Lit LitUnit) @ s; E {{ Φ }}) → + envs_entails Δ (WP fill K (Store (Lit (LitLoc l)) e) @ s; E {{ Φ }}). Proof. rewrite /envs_entails=> ?????. rewrite -wp_bind. eapply wand_apply; first by eapply wp_store. @@ -135,12 +135,12 @@ Proof. rewrite right_id. by apply later_mono, sep_mono_r, wand_mono. Qed. -Lemma tac_wp_cas_fail Δ Δ' E i K l q v e1 v1 e2 Φ : +Lemma tac_wp_cas_fail Δ Δ' s E i K l q v e1 v1 e2 Φ : IntoVal e1 v1 → AsVal e2 → IntoLaterNEnvs 1 Δ Δ' → envs_lookup i Δ' = Some (false, l ↦{q} v)%I → v ≠v1 → - envs_entails Δ' (WP fill K (Lit (LitBool false)) @ E {{ Φ }}) → - envs_entails Δ (WP fill K (CAS (Lit (LitLoc l)) e1 e2) @ E {{ Φ }}). + envs_entails Δ' (WP fill K (Lit (LitBool false)) @ s; E {{ Φ }}) → + envs_entails Δ (WP fill K (CAS (Lit (LitLoc l)) e1 e2) @ s; E {{ Φ }}). Proof. rewrite /envs_entails=> ??????. rewrite -wp_bind. eapply wand_apply; first exact: wp_cas_fail. @@ -148,25 +148,39 @@ Proof. by apply later_mono, sep_mono_r, wand_mono. Qed. -Lemma tac_wp_cas_suc Δ Δ' Δ'' E i K l v e1 v1 e2 v2 Φ : +Lemma tac_wp_cas_suc Δ Δ' Δ'' s E i K l v e1 v1 e2 v2 Φ : IntoVal e1 v1 → IntoVal e2 v2 → IntoLaterNEnvs 1 Δ Δ' → envs_lookup i Δ' = Some (false, l ↦ v)%I → v = v1 → envs_simple_replace i false (Esnoc Enil i (l ↦ v2)) Δ' = Some Δ'' → - envs_entails Δ'' (WP fill K (Lit (LitBool true)) @ E {{ Φ }}) → - envs_entails Δ (WP fill K (CAS (Lit (LitLoc l)) e1 e2) @ E {{ Φ }}). + envs_entails Δ'' (WP fill K (Lit (LitBool true)) @ s; E {{ Φ }}) → + envs_entails Δ (WP fill K (CAS (Lit (LitLoc l)) e1 e2) @ s; E {{ Φ }}). Proof. rewrite /envs_entails=> ???????; subst. rewrite -wp_bind. eapply wand_apply; first exact: wp_cas_suc. rewrite into_laterN_env_sound -later_sep envs_simple_replace_sound //; simpl. rewrite right_id. by apply later_mono, sep_mono_r, wand_mono. Qed. + +Lemma tac_wp_faa Δ Δ' Δ'' s E i K l i1 e2 i2 Φ : + IntoVal e2 (LitV (LitInt i2)) → + IntoLaterNEnvs 1 Δ Δ' → + envs_lookup i Δ' = Some (false, l ↦ LitV (LitInt i1))%I → + envs_simple_replace i false (Esnoc Enil i (l ↦ LitV (LitInt (i1 + i2)))) Δ' = Some Δ'' → + envs_entails Δ'' (WP fill K (Lit (LitInt i1)) @ s; E {{ Φ }}) → + envs_entails Δ (WP fill K (FAA (Lit (LitLoc l)) e2) @ s; E {{ Φ }}). +Proof. + rewrite /envs_entails=> ?????; subst. + rewrite -wp_bind. eapply wand_apply; first exact: (wp_faa _ _ _ i1 _ i2). + rewrite into_laterN_env_sound -later_sep envs_simple_replace_sound //; simpl. + rewrite right_id. by apply later_mono, sep_mono_r, wand_mono. +Qed. End heap. Tactic Notation "wp_apply" open_constr(lem) := iPoseProofCore lem as false true (fun H => lazymatch goal with - | |- envs_entails _ (wp ?E ?e ?Q) => + | |- envs_entails _ (wp ?s ?E ?e ?Q) => reshape_expr e ltac:(fun K e' => wp_bind_core K; iApplyHyp H; try iNext; wp_expr_simpl) || lazymatch iTypeOf H with @@ -178,10 +192,10 @@ Tactic Notation "wp_apply" open_constr(lem) := Tactic Notation "wp_alloc" ident(l) "as" constr(H) := iStartProof; lazymatch goal with - | |- envs_entails _ (wp ?E ?e ?Q) => + | |- envs_entails _ (wp ?s ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => - eapply (tac_wp_alloc _ _ _ H K); [apply _|..]) + eapply (tac_wp_alloc _ _ _ _ H K); [apply _|..]) |fail 1 "wp_alloc: cannot find 'Alloc' in" e]; [apply _ |first [intros l | fail 1 "wp_alloc:" l "not fresh"]; @@ -197,9 +211,9 @@ Tactic Notation "wp_alloc" ident(l) := Tactic Notation "wp_load" := iStartProof; lazymatch goal with - | |- envs_entails _ (wp ?E ?e ?Q) => + | |- envs_entails _ (wp ?s ?E ?e ?Q) => first - [reshape_expr e ltac:(fun K e' => eapply (tac_wp_load _ _ _ _ K)) + [reshape_expr e ltac:(fun K e' => eapply (tac_wp_load _ _ _ _ _ K)) |fail 1 "wp_load: cannot find 'Load' in" e]; [apply _ |let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in @@ -211,10 +225,10 @@ Tactic Notation "wp_load" := Tactic Notation "wp_store" := iStartProof; lazymatch goal with - | |- envs_entails _ (wp ?E ?e ?Q) => + | |- envs_entails _ (wp ?s ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => - eapply (tac_wp_store _ _ _ _ _ K); [apply _|..]) + eapply (tac_wp_store _ _ _ _ _ _ K); [apply _|..]) |fail 1 "wp_store: cannot find 'Store' in" e]; [apply _ |let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in @@ -227,10 +241,10 @@ Tactic Notation "wp_store" := Tactic Notation "wp_cas_fail" := iStartProof; lazymatch goal with - | |- envs_entails _ (wp ?E ?e ?Q) => + | |- envs_entails _ (wp ?s ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => - eapply (tac_wp_cas_fail _ _ _ _ K); [apply _|apply _|..]) + eapply (tac_wp_cas_fail _ _ _ _ _ K); [apply _|apply _|..]) |fail 1 "wp_cas_fail: cannot find 'CAS' in" e]; [apply _ |let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in @@ -243,10 +257,10 @@ Tactic Notation "wp_cas_fail" := Tactic Notation "wp_cas_suc" := iStartProof; lazymatch goal with - | |- envs_entails _ (wp ?E ?e ?Q) => + | |- envs_entails _ (wp ?s ?E ?e ?Q) => first [reshape_expr e ltac:(fun K e' => - eapply (tac_wp_cas_suc _ _ _ _ _ K); [apply _|apply _|..]) + eapply (tac_wp_cas_suc _ _ _ _ _ _ K); [apply _|apply _|..]) |fail 1 "wp_cas_suc: cannot find 'CAS' in" e]; [apply _ |let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in @@ -256,3 +270,19 @@ Tactic Notation "wp_cas_suc" := |wp_expr_simpl; try wp_value_head] | _ => fail "wp_cas_suc: not a 'wp'" end. + +Tactic Notation "wp_faa" := + iStartProof; + lazymatch goal with + | |- envs_entails _ (wp ?s ?E ?e ?Q) => + first + [reshape_expr e ltac:(fun K e' => + eapply (tac_wp_faa _ _ _ _ _ _ K); [apply _|..]) + |fail 1 "wp_faa: cannot find 'CAS' in" e]; + [apply _ + |let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in + iAssumptionCore || fail "wp_cas_suc: cannot find" l "↦ ?" + |env_cbv; reflexivity + |wp_expr_simpl; try wp_value_head] + | _ => fail "wp_faa: not a 'wp'" + end. diff --git a/theories/heap_lang/tactics.v b/theories/heap_lang/tactics.v index b047b1a75bacc28e5f7b49d602425d3e01bd83c1..1789ca57080da7b48708345567d2701eafcaed5f 100644 --- a/theories/heap_lang/tactics.v +++ b/theories/heap_lang/tactics.v @@ -34,7 +34,8 @@ Inductive expr := | Alloc (e : expr) | Load (e : expr) | Store (e1 : expr) (e2 : expr) - | CAS (e0 : expr) (e1 : expr) (e2 : expr). + | CAS (e0 : expr) (e1 : expr) (e2 : expr) + | FAA (e1 : expr) (e2 : expr). Fixpoint to_expr (e : expr) : heap_lang.expr := match e with @@ -58,6 +59,7 @@ Fixpoint to_expr (e : expr) : heap_lang.expr := | 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) + | FAA e1 e2 => heap_lang.FAA (to_expr e1) (to_expr e2) end. Ltac of_expr e := @@ -90,6 +92,8 @@ Ltac of_expr e := | 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) + | heap_lang.FAA ?e1 ?e2 => + let e1 := of_expr e1 in let e2 := of_expr e2 in constr:(FAA e1 e2) | to_expr ?e => e | of_val ?v => constr:(Val v (of_val v) (to_of_val v)) | _ => match goal with @@ -106,7 +110,7 @@ Fixpoint is_closed (X : list string) (e : expr) : bool := | 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 => + | App e1 e2 | BinOp _ e1 e2 | Pair e1 e2 | Store e1 e2 | FAA 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 @@ -167,6 +171,7 @@ Fixpoint subst (x : string) (es : expr) (e : expr) : expr := | 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) + | FAA e1 e2 => FAA (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). @@ -182,16 +187,16 @@ Definition is_atomic (e : expr) := | 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)) + | FAA e1 e2 => bool_decide (is_Some (to_val e1) ∧ is_Some (to_val e2)) | Fork _ => true (* Make "skip" atomic *) | App (Rec _ _ (Lit _)) (Lit _) => true | _ => false end. -Lemma is_atomic_correct e : is_atomic e → Atomic (to_expr e). +Lemma is_atomic_correct s e : is_atomic e → Atomic s (to_expr e). Proof. - intros He. apply ectx_language_atomic. - - intros σ e' σ' ef Hstep; simpl in *. - apply language.val_irreducible; revert Hstep. + intros He. apply strongly_atomic_atomic, ectx_language_atomic. + - intros σ e' σ' ef Hstep; simpl in *. revert Hstep. destruct e=> //=; repeat (simplify_eq/=; case_match=>//); inversion 1; simplify_eq/=; rewrite ?to_of_val; eauto. unfold subst'; repeat (simplify_eq/=; case_match=>//); eauto. @@ -227,11 +232,11 @@ Hint Extern 10 (AsVal _) => solve_as_val : typeclass_instances. Ltac solve_atomic := match goal with - | |- Atomic ?e => - let e' := W.of_expr e in change (Atomic (W.to_expr e')); + | |- Atomic ?s ?e => + let e' := W.of_expr e in change (Atomic s (W.to_expr e')); apply W.is_atomic_correct; vm_compute; exact I end. -Hint Extern 10 (Atomic _) => solve_atomic : typeclass_instances. +Hint Extern 10 (Atomic _ _) => solve_atomic : typeclass_instances. (** Substitution *) Ltac simpl_subst := @@ -287,4 +292,6 @@ Ltac reshape_expr e tac := [ reshape_val e1 ltac:(fun v1 => go (CasRCtx v0 v1 :: K) e2) | go (CasMCtx v0 e2 :: K) e1 ]) | CAS ?e0 ?e1 ?e2 => go (CasLCtx e1 e2 :: K) e0 + | FAA ?e1 ?e2 => reshape_val e1 ltac:(fun v1 => go (FaaRCtx v1 :: K) e2) + | FAA ?e1 ?e2 => go (FaaLCtx e2 :: K) e1 end in go (@nil ectx_item) e. diff --git a/theories/program_logic/adequacy.v b/theories/program_logic/adequacy.v index d9ece349e5ca7f764f51084537c0c243a6835d47..81f9f1e30d5d2058c061eec0c6cc8243f39337af 100644 --- a/theories/program_logic/adequacy.v +++ b/theories/program_logic/adequacy.v @@ -34,23 +34,24 @@ Proof. Qed. (* Program logic adequacy *) -Record adequate {Λ} (e1 : expr Λ) (σ1 : state Λ) (φ : val Λ → Prop) := { +Record adequate {Λ} (s : stuckness) (e1 : expr Λ) (σ1 : state Λ) (φ : val Λ → Prop) := { adequate_result t2 σ2 v2 : rtc step ([e1], σ1) (of_val v2 :: t2, σ2) → φ v2; - adequate_safe t2 σ2 e2 : + adequate_not_stuck t2 σ2 e2 : + s = NotStuck → rtc step ([e1], σ1) (t2, σ2) → e2 ∈ t2 → (is_Some (to_val e2) ∨ reducible e2 σ2) }. Theorem adequate_tp_safe {Λ} (e1 : expr Λ) t2 σ1 σ2 φ : - adequate e1 σ1 φ → + adequate NotStuck e1 σ1 φ → rtc step ([e1], σ1) (t2, σ2) → Forall (λ e, is_Some (to_val e)) t2 ∨ ∃ t3 σ3, step (t2, σ2) (t3, σ3). Proof. intros Had ?. destruct (decide (Forall (λ e, is_Some (to_val e)) t2)) as [|Ht2]; [by left|]. apply (not_Forall_Exists _), Exists_exists in Ht2; destruct Ht2 as (e2&?&He2). - destruct (adequate_safe e1 σ1 φ Had t2 σ2 e2) as [?|(e3&σ3&efs&?)]; + destruct (adequate_not_stuck NotStuck e1 σ1 φ Had t2 σ2 e2) as [?|(e3&σ3&efs&?)]; rewrite ?eq_None_not_Some; auto. { exfalso. eauto. } destruct (elem_of_list_split t2 e2) as (t2'&t2''&->); auto. @@ -64,13 +65,15 @@ Implicit Types P Q : iProp Σ. Implicit Types Φ : val Λ → iProp Σ. Implicit Types Φs : list (val Λ → iProp Σ). -Notation world σ := (wsat ∗ ownE ⊤ ∗ state_interp σ)%I. +Notation world' E σ := (wsat ∗ ownE E ∗ state_interp σ)%I (only parsing). +Notation world σ := (world' ⊤ σ) (only parsing). -Notation wptp t := ([∗ list] ef ∈ t, WP ef {{ _, True }})%I. +Notation wptp s t := ([∗ list] ef ∈ t, WP ef @ s; ⊤ {{ _, True }})%I. -Lemma wp_step e1 σ1 e2 σ2 efs Φ : +Lemma wp_step s E e1 σ1 e2 σ2 efs Φ : prim_step e1 σ1 e2 σ2 efs → - world σ1 ∗ WP e1 {{ Φ }} ==∗ â–· |==> â—‡ (world σ2 ∗ WP e2 {{ Φ }} ∗ wptp efs). + world' E σ1 ∗ WP e1 @ s; E {{ Φ }} + ==∗ â–· |==> â—‡ (world' E σ2 ∗ WP e2 @ s; E {{ Φ }} ∗ wptp s efs). Proof. rewrite {1}wp_unfold /wp_pre. iIntros (?) "[(Hw & HE & Hσ) H]". rewrite (val_stuck e1 σ1 e2 σ2 efs) // uPred_fupd_eq. @@ -79,10 +82,10 @@ Proof. iMod ("H" $! e2 σ2 efs with "[%] [$Hw $HE]") as ">($ & $ & $ & $)"; auto. Qed. -Lemma wptp_step e1 t1 t2 σ1 σ2 Φ : +Lemma wptp_step s e1 t1 t2 σ1 σ2 Φ : step (e1 :: t1,σ1) (t2, σ2) → - world σ1 ∗ WP e1 {{ Φ }} ∗ wptp t1 - ==∗ ∃ e2 t2', ⌜t2 = e2 :: t2'⌠∗ â–· |==> â—‡ (world σ2 ∗ WP e2 {{ Φ }} ∗ wptp t2'). + world σ1 ∗ WP e1 @ s; ⊤ {{ Φ }} ∗ wptp s t1 + ==∗ ∃ e2 t2', ⌜t2 = e2 :: t2'⌠∗ â–· |==> â—‡ (world σ2 ∗ WP e2 @ s; ⊤ {{ Φ }} ∗ wptp s t2'). Proof. iIntros (Hstep) "(HW & He & Ht)". destruct Hstep as [e1' σ1' e2' σ2' efs [|? t1'] t2' ?? Hstep]; simplify_eq/=. @@ -93,11 +96,11 @@ Proof. iApply wp_step; eauto with iFrame. Qed. -Lemma wptp_steps n e1 t1 t2 σ1 σ2 Φ : +Lemma wptp_steps s n e1 t1 t2 σ1 σ2 Φ : nsteps step n (e1 :: t1, σ1) (t2, σ2) → - world σ1 ∗ WP e1 {{ Φ }} ∗ wptp t1 ⊢ + world σ1 ∗ WP e1 @ s; ⊤ {{ Φ }} ∗ wptp s t1 ⊢ Nat.iter (S n) (λ P, |==> â–· P) (∃ e2 t2', - ⌜t2 = e2 :: t2'⌠∗ world σ2 ∗ WP e2 {{ Φ }} ∗ wptp t2'). + ⌜t2 = e2 :: t2'⌠∗ world σ2 ∗ WP e2 @ s; ⊤ {{ Φ }} ∗ wptp s t2'). Proof. revert e1 t1 t2 σ1 σ2; simpl; induction n as [|n IH]=> e1 t1 t2 σ1 σ2 /=. { inversion_clear 1; iIntros "?"; eauto 10. } @@ -119,9 +122,9 @@ Proof. by rewrite bupd_frame_l {1}(later_intro R) -later_sep IH. Qed. -Lemma wptp_result n e1 t1 v2 t2 σ1 σ2 φ : +Lemma wptp_result s n e1 t1 v2 t2 σ1 σ2 φ : nsteps step n (e1 :: t1, σ1) (of_val v2 :: t2, σ2) → - world σ1 ∗ WP e1 {{ v, ⌜φ v⌠}} ∗ wptp t1 ⊢ â–·^(S (S n)) ⌜φ v2âŒ. + world σ1 ∗ WP e1 @ s; ⊤ {{ v, ⌜φ v⌠}} ∗ wptp s t1 ⊢ â–·^(S (S n)) ⌜φ v2âŒ. Proof. intros. rewrite wptp_steps // laterN_later. apply: bupd_iter_laterN_mono. iDestruct 1 as (e2 t2' ?) "((Hw & HE & _) & H & _)"; simplify_eq. @@ -129,18 +132,20 @@ Proof. iMod ("H" with "[Hw HE]") as ">(_ & _ & $)"; iFrame; auto. Qed. -Lemma wp_safe e σ Φ : - world σ -∗ WP e {{ Φ }} ==∗ â–· ⌜is_Some (to_val e) ∨ reducible e σâŒ. +Lemma wp_safe E e σ Φ : + world' E σ -∗ WP e @ E {{ Φ }} ==∗ â–· ⌜is_Some (to_val e) ∨ reducible e σâŒ. Proof. rewrite wp_unfold /wp_pre. iIntros "(Hw&HE&Hσ) H". - destruct (to_val e) as [v|] eqn:?; [eauto 10|]. rewrite uPred_fupd_eq. - iMod ("H" with "Hσ [-]") as ">(?&?&%&?)"; eauto 10 with iFrame. + destruct (to_val e) as [v|] eqn:?. + { iIntros "!> !> !%". left. by exists v. } + rewrite uPred_fupd_eq. iMod ("H" with "Hσ [-]") as ">(?&?&%&?)"; first by iFrame. + iIntros "!> !> !%". by right. Qed. Lemma wptp_safe n e1 e2 t1 t2 σ1 σ2 Φ : nsteps step n (e1 :: t1, σ1) (t2, σ2) → e2 ∈ t2 → - world σ1 ∗ WP e1 {{ Φ }} ∗ wptp t1 ⊢ - â–·^(S (S n)) ⌜is_Some (to_val e2) ∨ reducible e2 σ2âŒ. + world σ1 ∗ WP e1 {{ Φ }} ∗ wptp NotStuck t1 + ⊢ â–·^(S (S n)) ⌜is_Some (to_val e2) ∨ reducible e2 σ2âŒ. Proof. intros ? He2. rewrite wptp_steps // laterN_later. apply: bupd_iter_laterN_mono. iDestruct 1 as (e2' t2' ?) "(Hw & H & Htp)"; simplify_eq. @@ -149,9 +154,9 @@ Proof. - iMod (wp_safe with "Hw [Htp]") as "$". by iApply (big_sepL_elem_of with "Htp"). Qed. -Lemma wptp_invariance n e1 e2 t1 t2 σ1 σ2 φ Φ : +Lemma wptp_invariance s n e1 e2 t1 t2 σ1 σ2 φ Φ : nsteps step n (e1 :: t1, σ1) (t2, σ2) → - (state_interp σ2 ={⊤,∅}=∗ ⌜φâŒ) ∗ world σ1 ∗ WP e1 {{ Φ }} ∗ wptp t1 + (state_interp σ2 ={⊤,∅}=∗ ⌜φâŒ) ∗ world σ1 ∗ WP e1 @ s; ⊤ {{ Φ }} ∗ wptp s t1 ⊢ â–·^(S (S n)) ⌜φâŒ. Proof. intros ?. rewrite wptp_steps // bupd_iter_frame_l laterN_later. @@ -162,12 +167,12 @@ Proof. Qed. End adequacy. -Theorem wp_adequacy Σ Λ `{invPreG Σ} e σ φ : +Theorem wp_adequacy Σ Λ `{invPreG Σ} s e σ φ : (∀ `{Hinv : invG Σ}, (|={⊤}=> ∃ stateI : state Λ → iProp Σ, let _ : irisG Λ Σ := IrisG _ _ Hinv stateI in - stateI σ ∗ WP e {{ v, ⌜φ v⌠}})%I) → - adequate e σ φ. + stateI σ ∗ WP e @ s; ⊤ {{ v, ⌜φ v⌠}})%I) → + adequate s e σ φ. Proof. intros Hwp; split. - intros t2 σ2 v2 [n ?]%rtc_nsteps. @@ -176,7 +181,7 @@ Proof. rewrite uPred_fupd_eq in Hwp; iMod (Hwp with "[$Hw $HE]") as ">(Hw & HE & Hwp)". iDestruct "Hwp" as (Istate) "[HI Hwp]". iApply (@wptp_result _ _ (IrisG _ _ Hinv Istate)); eauto with iFrame. - - intros t2 σ2 e2 [n ?]%rtc_nsteps ?. + - destruct s; last done. intros t2 σ2 e2 _ [n ?]%rtc_nsteps ?. eapply (soundness (M:=iResUR Σ) _ (S (S n))). iMod wsat_alloc as (Hinv) "[Hw HE]". specialize (Hwp _). rewrite uPred_fupd_eq in Hwp; iMod (Hwp with "[$Hw $HE]") as ">(Hw & HE & Hwp)". @@ -184,11 +189,11 @@ Proof. iApply (@wptp_safe _ _ (IrisG _ _ Hinv Istate)); eauto with iFrame. Qed. -Theorem wp_invariance Σ Λ `{invPreG Σ} e σ1 t2 σ2 φ : +Theorem wp_invariance Σ Λ `{invPreG Σ} s e σ1 t2 σ2 φ : (∀ `{Hinv : invG Σ}, (|={⊤}=> ∃ stateI : state Λ → iProp Σ, let _ : irisG Λ Σ := IrisG _ _ Hinv stateI in - stateI σ1 ∗ WP e {{ _, True }} ∗ (stateI σ2 ={⊤,∅}=∗ ⌜φâŒ))%I) → + stateI σ1 ∗ WP e @ s; ⊤ {{ _, True }} ∗ (stateI σ2 ={⊤,∅}=∗ ⌜φâŒ))%I) → rtc step ([e], σ1) (t2, σ2) → φ. Proof. diff --git a/theories/program_logic/ectx_language.v b/theories/program_logic/ectx_language.v index 9f00ed60a5e99b9ddfccd639f42a48d3972a4ab7..25a2412795b3c11d821ebb0a93a4d443b6caba93 100644 --- a/theories/program_logic/ectx_language.v +++ b/theories/program_logic/ectx_language.v @@ -100,6 +100,8 @@ Section ectx_language. ∃ e' σ' efs, head_step e σ e' σ' efs. Definition head_irreducible (e : expr Λ) (σ : state Λ) := ∀ e' σ' efs, ¬head_step e σ e' σ' efs. + Definition head_stuck (e : expr Λ) (σ : state Λ) := + to_val e = None ∧ ∀ K e', e = fill K e' → head_irreducible e' σ. (* All non-value redexes are at the root. In other words, all sub-redexes are values. *) @@ -127,6 +129,11 @@ Section ectx_language. Canonical Structure ectx_lang : language := Language ectx_lang_mixin. + Definition head_atomic (a : atomicity) (e : expr Λ) : Prop := + ∀ σ e' σ' efs, + head_step e σ e' σ' efs → + if a is WeaklyAtomic then irreducible e' σ' else is_Some (to_val e'). + (* Some lemmas about this language *) Lemma fill_not_val K e : to_val e = None → to_val (fill K e) = None. Proof. rewrite !eq_None_not_Some. eauto using fill_val. Qed. @@ -158,10 +165,16 @@ Section ectx_language. rewrite -not_reducible -not_head_reducible. eauto using prim_head_reducible. Qed. - Lemma ectx_language_atomic e : - (∀ σ e' σ' efs, head_step e σ e' σ' efs → irreducible e' σ') → - sub_redexes_are_values e → - Atomic e. + Lemma head_stuck_stuck e σ : + head_stuck e σ → sub_redexes_are_values e → stuck e σ. + Proof. + move=>[] ? Hirr ?. split; first done. + apply prim_head_irreducible; last done. + apply (Hirr empty_ectx). by rewrite fill_empty. + Qed. + + Lemma ectx_language_atomic a e : + head_atomic a e → sub_redexes_are_values e → Atomic a e. Proof. intros Hatomic_step Hatomic_fill σ e' σ' efs [K e1' e2' -> -> Hstep]. assert (K = empty_ectx) as -> by eauto 10 using val_head_stuck. diff --git a/theories/program_logic/ectx_lifting.v b/theories/program_logic/ectx_lifting.v index a68162c0134025c25e9aeaad7c237a942df7f34c..1105a2e11104e202ca16c4760167de1627328f83 100644 --- a/theories/program_logic/ectx_lifting.v +++ b/theories/program_logic/ectx_lifting.v @@ -5,59 +5,85 @@ Set Default Proof Using "Type". Section wp. Context {Λ : ectxLanguage} `{irisG Λ Σ} {Hinh : Inhabited (state Λ)}. +Implicit Types s : stuckness. Implicit Types P : iProp Σ. Implicit Types Φ : val Λ → iProp Σ. Implicit Types v : val Λ. Implicit Types e : expr Λ. Hint Resolve head_prim_reducible head_reducible_prim_step. +Hint Resolve (reducible_not_val _ inhabitant). +Hint Resolve head_stuck_stuck. -Lemma wp_lift_head_step {E Φ} e1 : +Lemma wp_lift_head_step {s E Φ} e1 : to_val e1 = None → (∀ σ1, state_interp σ1 ={E,∅}=∗ ⌜head_reducible e1 σ1⌠∗ â–· ∀ e2 σ2 efs, ⌜head_step e1 σ1 e2 σ2 efs⌠={∅,E}=∗ - state_interp σ2 ∗ WP e2 @ E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) - ⊢ WP e1 @ E {{ Φ }}. + state_interp σ2 ∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) + ⊢ WP e1 @ s; E {{ Φ }}. Proof. - iIntros (?) "H". iApply (wp_lift_step E)=>//. iIntros (σ1) "Hσ". - iMod ("H" $! σ1 with "Hσ") as "[% H]"; iModIntro. - iSplit; first by eauto. iNext. iIntros (e2 σ2 efs) "%". - iApply "H". by eauto. + iIntros (?) "H". iApply wp_lift_step=>//. iIntros (σ1) "Hσ". + iMod ("H" with "Hσ") as "[% H]"; iModIntro. + iSplit; first by destruct s; eauto. iNext. iIntros (e2 σ2 efs) "%". + iApply "H"; eauto. Qed. -Lemma wp_lift_pure_head_step {E E' Φ} e1 : +Lemma wp_lift_head_stuck E Φ e : + to_val e = None → + sub_redexes_are_values e → + (∀ σ, state_interp σ ={E,∅}=∗ ⌜head_stuck e σâŒ) + ⊢ WP e @ E ?{{ Φ }}. +Proof. + iIntros (??) "H". iApply wp_lift_stuck; first done. + iIntros (σ) "Hσ". iMod ("H" with "Hσ") as "%". by auto. +Qed. + +Lemma wp_lift_pure_head_step {s E E' Φ} e1 : (∀ σ1, head_reducible e1 σ1) → (∀ σ1 e2 σ2 efs, head_step e1 σ1 e2 σ2 efs → σ1 = σ2) → (|={E,E'}â–·=> ∀ e2 efs σ, ⌜head_step e1 σ e2 σ efs⌠→ - WP e2 @ E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) - ⊢ WP e1 @ E {{ Φ }}. + WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) + ⊢ WP e1 @ s; E {{ Φ }}. Proof using Hinh. iIntros (??) "H". iApply wp_lift_pure_step; eauto. + { by destruct s; auto. } iApply (step_fupd_wand with "H"); iIntros "H". iIntros (????). iApply "H"; eauto. Qed. -Lemma wp_lift_atomic_head_step {E Φ} e1 : +Lemma wp_lift_pure_head_stuck E Φ e : + to_val e = None → + sub_redexes_are_values e → + (∀ σ, head_stuck e σ) → + WP e @ E ?{{ Φ }}%I. +Proof using Hinh. + iIntros (?? Hstuck). iApply wp_lift_head_stuck; [done|done|]. + iIntros (σ) "_". iMod (fupd_intro_mask' E ∅) as "_"; first set_solver. + by auto. +Qed. + +Lemma wp_lift_atomic_head_step {s E Φ} e1 : to_val e1 = None → (∀ σ1, state_interp σ1 ={E}=∗ ⌜head_reducible e1 σ1⌠∗ â–· ∀ e2 σ2 efs, ⌜head_step e1 σ1 e2 σ2 efs⌠={E}=∗ state_interp σ2 ∗ - default False (to_val e2) Φ ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) - ⊢ WP e1 @ E {{ Φ }}. + default False (to_val e2) Φ ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) + ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros (?) "H". iApply wp_lift_atomic_step; eauto. - iIntros (σ1) "Hσ1". iMod ("H" $! σ1 with "Hσ1") as "[% H]"; iModIntro. - iSplit; first by eauto. iNext. iIntros (e2 σ2 efs) "%". iApply "H"; auto. + iIntros (σ1) "Hσ1". iMod ("H" with "Hσ1") as "[% H]"; iModIntro. + iSplit; first by destruct s; auto. iNext. iIntros (e2 σ2 efs) "%". + iApply "H"; auto. Qed. -Lemma wp_lift_atomic_head_step_no_fork {E Φ} e1 : +Lemma wp_lift_atomic_head_step_no_fork {s E Φ} e1 : to_val e1 = None → (∀ σ1, state_interp σ1 ={E}=∗ ⌜head_reducible e1 σ1⌠∗ â–· ∀ e2 σ2 efs, ⌜head_step e1 σ1 e2 σ2 efs⌠={E}=∗ ⌜efs = []⌠∗ state_interp σ2 ∗ default False (to_val e2) Φ) - ⊢ WP e1 @ E {{ Φ }}. + ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros (?) "H". iApply wp_lift_atomic_head_step; eauto. iIntros (σ1) "Hσ1". iMod ("H" $! σ1 with "Hσ1") as "[$ H]"; iModIntro. @@ -65,32 +91,36 @@ Proof. iMod ("H" $! v2 σ2 efs with "[# //]") as "(% & $ & $)"; subst; auto. Qed. -Lemma wp_lift_pure_det_head_step {E E' Φ} e1 e2 efs : +Lemma wp_lift_pure_det_head_step {s E E' Φ} e1 e2 efs : (∀ σ1, head_reducible e1 σ1) → (∀ σ1 e2' σ2 efs', head_step e1 σ1 e2' σ2 efs' → σ1 = σ2 ∧ e2 = e2' ∧ efs = efs') → - (|={E,E'}â–·=> WP e2 @ E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) - ⊢ WP e1 @ E {{ Φ }}. -Proof using Hinh. eauto using wp_lift_pure_det_step. Qed. + (|={E,E'}â–·=> WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) + ⊢ WP e1 @ s; E {{ Φ }}. +Proof using Hinh. + intros. rewrite -(wp_lift_pure_det_step e1 e2 efs); eauto. + destruct s; by auto. +Qed. -Lemma wp_lift_pure_det_head_step_no_fork {E E' Φ} e1 e2 : +Lemma wp_lift_pure_det_head_step_no_fork {s E E' Φ} e1 e2 : to_val e1 = None → (∀ σ1, head_reducible e1 σ1) → (∀ σ1 e2' σ2 efs', head_step e1 σ1 e2' σ2 efs' → σ1 = σ2 ∧ e2 = e2' ∧ [] = efs') → - (|={E,E'}â–·=> WP e2 @ E {{ Φ }}) ⊢ WP e1 @ E {{ Φ }}. + (|={E,E'}â–·=> WP e2 @ s; E {{ Φ }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof using Hinh. intros. rewrite -(wp_lift_pure_det_step e1 e2 []) /= ?right_id; eauto. + destruct s; by auto. Qed. -Lemma wp_lift_pure_det_head_step_no_fork' {E Φ} e1 e2 : +Lemma wp_lift_pure_det_head_step_no_fork' {s E Φ} e1 e2 : to_val e1 = None → (∀ σ1, head_reducible e1 σ1) → (∀ σ1 e2' σ2 efs', head_step e1 σ1 e2' σ2 efs' → σ1 = σ2 ∧ e2 = e2' ∧ [] = efs') → - â–· WP e2 @ E {{ Φ }} ⊢ WP e1 @ E {{ Φ }}. + â–· WP e2 @ s; E {{ Φ }} ⊢ WP e1 @ s; E {{ Φ }}. Proof using Hinh. - intros. rewrite -[(WP e1 @ _ {{ _ }})%I]wp_lift_pure_det_head_step_no_fork //. + intros. rewrite -[(WP e1 @ s; _ {{ _ }})%I]wp_lift_pure_det_head_step_no_fork //. rewrite -step_fupd_intro //. Qed. End wp. diff --git a/theories/program_logic/hoare.v b/theories/program_logic/hoare.v index b1656b7e6e4f8d82f1b99277b08f072fb9a55ec8..f75756fa6f60781987fe52f4739eb84d839c7125 100644 --- a/theories/program_logic/hoare.v +++ b/theories/program_logic/hoare.v @@ -3,126 +3,153 @@ From iris.base_logic.lib Require Export viewshifts. From iris.proofmode Require Import tactics. Set Default Proof Using "Type". -Definition ht `{irisG Λ Σ} (E : coPset) (P : iProp Σ) +Definition ht `{irisG Λ Σ} (s : stuckness) (E : coPset) (P : iProp Σ) (e : expr Λ) (Φ : val Λ → iProp Σ) : iProp Σ := - (â–¡ (P -∗ WP e @ E {{ Φ }}))%I. -Instance: Params (@ht) 4. + (â–¡ (P -∗ WP e @ s; E {{ Φ }}))%I. +Instance: Params (@ht) 5. -Notation "{{ P } } e @ E {{ Φ } }" := (ht E P%I e%E Φ%I) +Notation "{{ P } } e @ s ; E {{ Φ } }" := (ht s E P%I e%E Φ%I) + (at level 20, P, e, Φ at level 200, + format "{{ P } } e @ s ; E {{ Φ } }") : stdpp_scope. +Notation "{{ P } } e @ E {{ Φ } }" := (ht NotStuck E P%I e%E Φ%I) (at level 20, P, e, Φ at level 200, format "{{ P } } e @ E {{ Φ } }") : stdpp_scope. -Notation "{{ P } } e {{ Φ } }" := (ht ⊤ P%I e%E Φ%I) +Notation "{{ P } } e @ E ? {{ Φ } }" := (ht MaybeStuck E P%I e%E Φ%I) + (at level 20, P, e, Φ at level 200, + format "{{ P } } e @ E ? {{ Φ } }") : stdpp_scope. +Notation "{{ P } } e {{ Φ } }" := (ht NotStuck ⊤ P%I e%E Φ%I) (at level 20, P, e, Φ at level 200, format "{{ P } } e {{ Φ } }") : stdpp_scope. +Notation "{{ P } } e ? {{ Φ } }" := (ht MaybeStuck ⊤ P%I e%E Φ%I) + (at level 20, P, e, Φ at level 200, + format "{{ P } } e ? {{ Φ } }") : stdpp_scope. -Notation "{{ P } } e @ E {{ v , Q } }" := (ht E P%I e%E (λ v, Q)%I) +Notation "{{ P } } e @ s ; E {{ v , Q } }" := (ht s E P%I e%E (λ v, Q)%I) + (at level 20, P, e, Q at level 200, + format "{{ P } } e @ s ; E {{ v , Q } }") : stdpp_scope. +Notation "{{ P } } e @ E {{ v , Q } }" := (ht NotStuck E P%I e%E (λ v, Q)%I) (at level 20, P, e, Q at level 200, format "{{ P } } e @ E {{ v , Q } }") : stdpp_scope. -Notation "{{ P } } e {{ v , Q } }" := (ht ⊤ P%I e%E (λ v, Q)%I) +Notation "{{ P } } e @ E ? {{ v , Q } }" := (ht MaybeStuck E P%I e%E (λ v, Q)%I) + (at level 20, P, e, Q at level 200, + format "{{ P } } e @ E ? {{ v , Q } }") : stdpp_scope. +Notation "{{ P } } e {{ v , Q } }" := (ht NotStuck ⊤ P%I e%E (λ v, Q)%I) (at level 20, P, e, Q at level 200, format "{{ P } } e {{ v , Q } }") : stdpp_scope. +Notation "{{ P } } e ? {{ v , Q } }" := (ht MaybeStuck ⊤ P%I e%E (λ v, Q)%I) + (at level 20, P, e, Q at level 200, + format "{{ P } } e ? {{ v , Q } }") : stdpp_scope. Section hoare. Context `{irisG Λ Σ}. +Implicit Types s : stuckness. Implicit Types P Q : iProp Σ. Implicit Types Φ Ψ : val Λ → iProp Σ. Implicit Types v : val Λ. Import uPred. -Global Instance ht_ne E n : - Proper (dist n ==> eq ==> pointwise_relation _ (dist n) ==> dist n) (ht E). +Global Instance ht_ne s E n : + Proper (dist n ==> eq ==> pointwise_relation _ (dist n) ==> dist n) (ht s E). Proof. solve_proper. Qed. -Global Instance ht_proper E : - Proper ((≡) ==> eq ==> pointwise_relation _ (≡) ==> (≡)) (ht E). +Global Instance ht_proper s E : + Proper ((≡) ==> eq ==> pointwise_relation _ (≡) ==> (≡)) (ht s E). Proof. solve_proper. Qed. -Lemma ht_mono E P P' Φ Φ' e : - (P ⊢ P') → (∀ v, Φ' v ⊢ Φ v) → {{ P' }} e @ E {{ Φ' }} ⊢ {{ P }} e @ E {{ Φ }}. -Proof. intros. by apply affinely_mono, persistently_mono, wand_mono, wp_mono. Qed. -Global Instance ht_mono' E : - Proper (flip (⊢) ==> eq ==> pointwise_relation _ (⊢) ==> (⊢)) (ht E). +Lemma ht_mono s E P P' Φ Φ' e : + (P ⊢ P') → (∀ v, Φ' v ⊢ Φ v) → {{ P' }} e @ s; E {{ Φ' }} ⊢ {{ P }} e @ s; E {{ Φ }}. +Proof. by intros; apply affinely_mono, persistently_mono, wand_mono, wp_mono. Qed. +Lemma ht_stuck_mono s1 s2 E P Φ e : + s1 ⊑ s2 → {{ P }} e @ s1; E {{ Φ }} ⊢ {{ P }} e @ s2; E {{ Φ }}. +Proof. by intros; apply affinely_mono, persistently_mono, wand_mono, wp_stuck_mono. Qed. +Global Instance ht_mono' s E : + Proper (flip (⊢) ==> eq ==> pointwise_relation _ (⊢) ==> (⊢)) (ht s E). Proof. solve_proper. Qed. -Lemma ht_alt E P Φ e : (P ⊢ WP e @ E {{ Φ }}) → {{ P }} e @ E {{ Φ }}. +Lemma ht_alt s E P Φ e : (P ⊢ WP e @ s; E {{ Φ }}) → {{ P }} e @ s; E {{ Φ }}. Proof. iIntros (Hwp) "!# HP". by iApply Hwp. Qed. -Lemma ht_val E v : {{ True }} of_val v @ E {{ v', ⌜v = v'⌠}}. +Lemma ht_val s E v : {{ True }} of_val v @ s; E {{ v', ⌜v = v'⌠}}. Proof. iIntros "!# _". by iApply wp_value'. Qed. -Lemma ht_vs E P P' Φ Φ' e : - (P ={E}=> P') ∧ {{ P' }} e @ E {{ Φ' }} ∧ (∀ v, Φ' v ={E}=> Φ v) - ⊢ {{ P }} e @ E {{ Φ }}. +Lemma ht_vs s E P P' Φ Φ' e : + (P ={E}=> P') ∧ {{ P' }} e @ s; E {{ Φ' }} ∧ (∀ v, Φ' v ={E}=> Φ v) + ⊢ {{ P }} e @ s; E {{ Φ }}. Proof. iIntros "(#Hvs & #Hwp & #HΦ) !# HP". iMod ("Hvs" with "HP") as "HP". iApply wp_fupd. iApply (wp_wand with "[HP]"); [by iApply "Hwp"|]. iIntros (v) "Hv". by iApply "HΦ". Qed. -Lemma ht_atomic E1 E2 P P' Φ Φ' e : - Atomic e → - (P ={E1,E2}=> P') ∧ {{ P' }} e @ E2 {{ Φ' }} ∧ (∀ v, Φ' v ={E2,E1}=> Φ v) - ⊢ {{ P }} e @ E1 {{ Φ }}. +Lemma ht_atomic s E1 E2 P P' Φ Φ' e `{!Atomic (stuckness_to_atomicity s) e} : + (P ={E1,E2}=> P') ∧ {{ P' }} e @ s; E2 {{ Φ' }} ∧ (∀ v, Φ' v ={E2,E1}=> Φ v) + ⊢ {{ P }} e @ s; E1 {{ Φ }}. Proof. - iIntros (?) "(#Hvs & #Hwp & #HΦ) !# HP". iApply (wp_atomic _ E2); auto. + iIntros "(#Hvs & #Hwp & #HΦ) !# HP". iApply (wp_atomic _ _ E2); auto. iMod ("Hvs" with "HP") as "HP". iModIntro. iApply (wp_wand with "[HP]"); [by iApply "Hwp"|]. iIntros (v) "Hv". by iApply "HΦ". Qed. -Lemma ht_bind `{LanguageCtx Λ K} E P Φ Φ' e : - {{ P }} e @ E {{ Φ }} ∧ (∀ v, {{ Φ v }} K (of_val v) @ E {{ Φ' }}) - ⊢ {{ P }} K e @ E {{ Φ' }}. +Lemma ht_bind `{LanguageCtx Λ K} s E P Φ Φ' e : + {{ P }} e @ s; E {{ Φ }} ∧ (∀ v, {{ Φ v }} K (of_val v) @ s; E {{ Φ' }}) + ⊢ {{ P }} K e @ s; E {{ Φ' }}. Proof. iIntros "[#Hwpe #HwpK] !# HP". iApply wp_bind. iApply (wp_wand with "[HP]"); [by iApply "Hwpe"|]. iIntros (v) "Hv". by iApply "HwpK". Qed. -Lemma ht_mask_weaken E1 E2 P Φ e : - E1 ⊆ E2 → {{ P }} e @ E1 {{ Φ }} ⊢ {{ P }} e @ E2 {{ Φ }}. +Lemma ht_stuck_weaken s E P Φ e : + {{ P }} e @ s; E {{ Φ }} ⊢ {{ P }} e @ E ?{{ Φ }}. +Proof. + by iIntros "#Hwp !# ?"; iApply wp_stuck_weaken; iApply "Hwp". +Qed. + +Lemma ht_mask_weaken s E1 E2 P Φ e : + E1 ⊆ E2 → {{ P }} e @ s; E1 {{ Φ }} ⊢ {{ P }} e @ s; E2 {{ Φ }}. Proof. - iIntros (?) "#Hwp !# HP". iApply (wp_mask_mono E1 E2); try done. + iIntros (?) "#Hwp !# HP". iApply (wp_mask_mono _ E1 E2); try done. by iApply "Hwp". Qed. -Lemma ht_frame_l E P Φ R e : - {{ P }} e @ E {{ Φ }} ⊢ {{ R ∗ P }} e @ E {{ v, R ∗ Φ v }}. +Lemma ht_frame_l s E P Φ R e : + {{ P }} e @ s; E {{ Φ }} ⊢ {{ R ∗ P }} e @ s; E {{ v, R ∗ Φ v }}. Proof. iIntros "#Hwp !# [$ HP]". by iApply "Hwp". Qed. -Lemma ht_frame_r E P Φ R e : - {{ P }} e @ E {{ Φ }} ⊢ {{ P ∗ R }} e @ E {{ v, Φ v ∗ R }}. +Lemma ht_frame_r s E P Φ R e : + {{ P }} e @ s; E {{ Φ }} ⊢ {{ P ∗ R }} e @ s; E {{ v, Φ v ∗ R }}. Proof. iIntros "#Hwp !# [HP $]". by iApply "Hwp". Qed. -Lemma ht_frame_step_l E1 E2 P R1 R2 e Φ : +Lemma ht_frame_step_l s E1 E2 P R1 R2 e Φ : to_val e = None → E2 ⊆ E1 → - (R1 ={E1,E2}=> â–· |={E2,E1}=> R2) ∧ {{ P }} e @ E2 {{ Φ }} - ⊢ {{ R1 ∗ P }} e @ E1 {{ λ v, R2 ∗ Φ v }}. + (R1 ={E1,E2}=> â–· |={E2,E1}=> R2) ∧ {{ P }} e @ s; E2 {{ Φ }} + ⊢ {{ R1 ∗ P }} e @ s; E1 {{ λ v, R2 ∗ Φ v }}. Proof. iIntros (??) "[#Hvs #Hwp] !# [HR HP]". - iApply (wp_frame_step_l E1 E2); try done. + iApply (wp_frame_step_l _ E1 E2); try done. iSplitL "HR"; [by iApply "Hvs"|by iApply "Hwp"]. Qed. -Lemma ht_frame_step_r E1 E2 P R1 R2 e Φ : +Lemma ht_frame_step_r s E1 E2 P R1 R2 e Φ : to_val e = None → E2 ⊆ E1 → - (R1 ={E1,E2}=> â–· |={E2,E1}=> R2) ∧ {{ P }} e @ E2 {{ Φ }} - ⊢ {{ P ∗ R1 }} e @ E1 {{ λ v, Φ v ∗ R2 }}. + (R1 ={E1,E2}=> â–· |={E2,E1}=> R2) ∧ {{ P }} e @ s; E2 {{ Φ }} + ⊢ {{ P ∗ R1 }} e @ s; E1 {{ λ v, Φ v ∗ R2 }}. Proof. iIntros (??) "[#Hvs #Hwp] !# [HP HR]". - iApply (wp_frame_step_r E1 E2); try done. + iApply (wp_frame_step_r _ E1 E2); try done. iSplitR "HR"; [by iApply "Hwp"|by iApply "Hvs"]. Qed. -Lemma ht_frame_step_l' E P R e Φ : +Lemma ht_frame_step_l' s E P R e Φ : to_val e = None → - {{ P }} e @ E {{ Φ }} ⊢ {{ â–· R ∗ P }} e @ E {{ v, R ∗ Φ v }}. + {{ P }} e @ s; E {{ Φ }} ⊢ {{ â–· R ∗ P }} e @ s; E {{ v, R ∗ Φ v }}. Proof. iIntros (?) "#Hwp !# [HR HP]". iApply wp_frame_step_l'; try done. iFrame "HR". by iApply "Hwp". Qed. -Lemma ht_frame_step_r' E P Φ R e : +Lemma ht_frame_step_r' s E P Φ R e : to_val e = None → - {{ P }} e @ E {{ Φ }} ⊢ {{ P ∗ â–· R }} e @ E {{ v, Φ v ∗ R }}. + {{ P }} e @ s; E {{ Φ }} ⊢ {{ P ∗ â–· R }} e @ s; E {{ v, Φ v ∗ R }}. Proof. iIntros (?) "#Hwp !# [HP HR]". iApply wp_frame_step_r'; try done. iFrame "HR". by iApply "Hwp". diff --git a/theories/program_logic/language.v b/theories/program_logic/language.v index a3704c7029b09f3873f4bd844ad2cfcede647c92..707f9c671861cf99218208bf490f352c8637849f 100644 --- a/theories/program_logic/language.v +++ b/theories/program_logic/language.v @@ -53,6 +53,8 @@ Class LanguageCtx {Λ : language} (K : expr Λ → expr Λ) := { Instance language_ctx_id Λ : LanguageCtx (@id (expr Λ)). Proof. constructor; naive_solver. Qed. +Inductive atomicity := StronglyAtomic | WeaklyAtomic. + Section language. Context {Λ : language}. Implicit Types v : val Λ. @@ -69,22 +71,24 @@ Section language. ∃ e' σ' efs, prim_step e σ e' σ' efs. Definition irreducible (e : expr Λ) (σ : state Λ) := ∀ e' σ' efs, ¬prim_step e σ e' σ' efs. - - (* This (weak) form of atomicity is enough to open invariants when WP ensures - safety, i.e., programs never can get stuck. We have an example in - lambdaRust of an expression that is atomic in this sense, but not in the - stronger sense defined below, and we have to be able to open invariants - around that expression. See `CasStuckS` in - [lambdaRust](https://gitlab.mpi-sws.org/FP/LambdaRust-coq/blob/master/theories/lang/lang.v). *) - Class Atomic (e : expr Λ) : Prop := - atomic σ e' σ' efs : prim_step e σ e' σ' efs → irreducible e' σ'. - - (* To open invariants with a WP that does not ensure safety, we need a - stronger form of atomicity. With the above definition, in case `e` reduces - to a stuck non-value, there is no proof that the invariants have been - established again. *) - Class StronglyAtomic (e : expr Λ) : Prop := - strongly_atomic σ e' σ' efs : prim_step e σ e' σ' efs → is_Some (to_val e'). + Definition stuck (e : expr Λ) (σ : state Λ) := + to_val e = None ∧ irreducible e σ. + + (* [Atomic WeaklyAtomic]: This (weak) form of atomicity is enough to open + invariants when WP ensures safety, i.e., programs never can get stuck. We + have an example in lambdaRust of an expression that is atomic in this + sense, but not in the stronger sense defined below, and we have to be able + to open invariants around that expression. See `CasStuckS` in + [lambdaRust](https://gitlab.mpi-sws.org/FP/LambdaRust-coq/blob/master/theories/lang/lang.v). + + [Atomic StronglyAtomic]: To open invariants with a WP that does not ensure + safety, we need a stronger form of atomicity. With the above definition, + in case `e` reduces to a stuck non-value, there is no proof that the + invariants have been established again. *) + Class Atomic (a : atomicity) (e : expr Λ) : Prop := + atomic σ e' σ' efs : + prim_step e σ e' σ' efs → + if a is WeaklyAtomic then irreducible e' σ' else is_Some (to_val e'). Inductive step (Ï1 Ï2 : cfg Λ) : Prop := | step_atomic e1 σ1 e2 σ2 efs t1 t2 : @@ -105,8 +109,9 @@ Section language. Global Instance of_val_inj : Inj (=) (=) (@of_val Λ). Proof. by intros v v' Hv; apply (inj Some); rewrite -!to_of_val Hv. Qed. - Lemma strongly_atomic_atomic e : StronglyAtomic e → Atomic e. - Proof. unfold StronglyAtomic, Atomic. eauto using val_irreducible. Qed. + Lemma strongly_atomic_atomic e a : + Atomic StronglyAtomic e → Atomic a e. + Proof. unfold Atomic. destruct a; eauto using val_irreducible. Qed. Lemma reducible_fill `{LanguageCtx Λ K} e σ : to_val e = None → reducible (K e) σ → reducible e σ. diff --git a/theories/program_logic/lifting.v b/theories/program_logic/lifting.v index 02eabf2f566e145b19b9fc5388d326c41c60b80d..b014954d09bc41a3792f848e13262537f58ca76c 100644 --- a/theories/program_logic/lifting.v +++ b/theories/program_logic/lifting.v @@ -4,50 +4,77 @@ Set Default Proof Using "Type". Section lifting. Context `{irisG Λ Σ}. +Implicit Types s : stuckness. Implicit Types v : val Λ. Implicit Types e : expr Λ. Implicit Types σ : state Λ. Implicit Types P Q : iProp Σ. Implicit Types Φ : val Λ → iProp Σ. -Lemma wp_lift_step E Φ e1 : +Lemma wp_lift_step s E Φ e1 : to_val e1 = None → (∀ σ1, state_interp σ1 ={E,∅}=∗ - ⌜reducible e1 σ1⌠∗ + ⌜if s is NotStuck then reducible e1 σ1 else True⌠∗ â–· ∀ e2 σ2 efs, ⌜prim_step e1 σ1 e2 σ2 efs⌠={∅,E}=∗ - state_interp σ2 ∗ WP e2 @ E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) - ⊢ WP e1 @ E {{ Φ }}. -Proof. by rewrite wp_unfold /wp_pre=> ->. Qed. + state_interp σ2 ∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) + ⊢ WP e1 @ s; E {{ Φ }}. +Proof. + rewrite wp_unfold /wp_pre=>->. iIntros "H" (σ1) "Hσ". + iMod ("H" with "Hσ") as "(%&?)". iModIntro. iSplit. by destruct s. done. +Qed. + +Lemma wp_lift_stuck E Φ e : + to_val e = None → + (∀ σ, state_interp σ ={E,∅}=∗ ⌜stuck e σâŒ) + ⊢ WP e @ E ?{{ Φ }}. +Proof. + rewrite wp_unfold /wp_pre=>->. iIntros "H" (σ1) "Hσ". + iMod ("H" with "Hσ") as %[? Hirr]. iModIntro. iSplit; first done. + iIntros "!>" (e2 σ2 efs) "%". by case: (Hirr e2 σ2 efs). +Qed. (** Derived lifting lemmas. *) -Lemma wp_lift_pure_step `{Inhabited (state Λ)} E E' Φ e1 : - (∀ σ1, reducible e1 σ1) → +Lemma wp_lift_pure_step `{Inhabited (state Λ)} s E E' Φ e1 : + (∀ σ1, if s is NotStuck then reducible e1 σ1 else to_val e1 = None) → (∀ σ1 e2 σ2 efs, prim_step e1 σ1 e2 σ2 efs → σ1 = σ2) → (|={E,E'}â–·=> ∀ e2 efs σ, ⌜prim_step e1 σ e2 σ efs⌠→ - WP e2 @ E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) - ⊢ WP e1 @ E {{ Φ }}. + WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) + ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros (Hsafe Hstep) "H". iApply wp_lift_step. - { eapply reducible_not_val, (Hsafe inhabitant). } + { specialize (Hsafe inhabitant). destruct s; last done. + by eapply reducible_not_val. } iIntros (σ1) "Hσ". iMod "H". - iMod fupd_intro_mask' as "Hclose"; last iModIntro; first set_solver. - iSplit; [done|]; iNext; iIntros (e2 σ2 efs ?). + iMod fupd_intro_mask' as "Hclose"; last iModIntro; first by set_solver. iSplit. + { iPureIntro. destruct s; done. } + iNext. iIntros (e2 σ2 efs ?). destruct (Hstep σ1 e2 σ2 efs); auto; subst. iMod "Hclose" as "_". iFrame "Hσ". iMod "H". iApply "H"; auto. Qed. +Lemma wp_lift_pure_stuck `{Inhabited (state Λ)} E Φ e : + (∀ σ, stuck e σ) → + True ⊢ WP e @ E ?{{ Φ }}. +Proof. + iIntros (Hstuck) "_". iApply wp_lift_stuck. + - destruct(to_val e) as [v|] eqn:He; last done. + rewrite -He. by case: (Hstuck inhabitant). + - iIntros (σ) "_". iMod (fupd_intro_mask' E ∅) as "_". + by set_solver. by auto. +Qed. + (* Atomic steps don't need any mask-changing business here, one can use the generic lemmas here. *) -Lemma wp_lift_atomic_step {E Φ} e1 : +Lemma wp_lift_atomic_step {s E Φ} e1 : to_val e1 = None → (∀ σ1, state_interp σ1 ={E}=∗ - ⌜reducible e1 σ1⌠∗ + ⌜if s is NotStuck then reducible e1 σ1 else True⌠∗ â–· ∀ e2 σ2 efs, ⌜prim_step e1 σ1 e2 σ2 efs⌠={E}=∗ state_interp σ2 ∗ - default False (to_val e2) Φ ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) - ⊢ WP e1 @ E {{ Φ }}. + default False (to_val e2) Φ ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) + ⊢ WP e1 @ s; E {{ Φ }}. Proof. - iIntros (?) "H". iApply (wp_lift_step E _ e1)=>//; iIntros (σ1) "Hσ1". + iIntros (?) "H". iApply (wp_lift_step s E _ e1)=>//; iIntros (σ1) "Hσ1". iMod ("H" $! σ1 with "Hσ1") as "[$ H]". iMod (fupd_intro_mask' E ∅) as "Hclose"; first set_solver. iModIntro; iNext; iIntros (e2 σ2 efs) "%". iMod "Hclose" as "_". @@ -56,32 +83,34 @@ Proof. by iApply wp_value. Qed. -Lemma wp_lift_pure_det_step `{Inhabited (state Λ)} {E E' Φ} e1 e2 efs : - (∀ σ1, reducible e1 σ1) → +Lemma wp_lift_pure_det_step `{Inhabited (state Λ)} {s E E' Φ} e1 e2 efs : + (∀ σ1, if s is NotStuck then reducible e1 σ1 else to_val e1 = None) → (∀ σ1 e2' σ2 efs', prim_step e1 σ1 e2' σ2 efs' → σ1 = σ2 ∧ e2 = e2' ∧ efs = efs')→ - (|={E,E'}â–·=> WP e2 @ E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) - ⊢ WP e1 @ E {{ Φ }}. + (|={E,E'}â–·=> WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) + ⊢ WP e1 @ s; E {{ Φ }}. Proof. - iIntros (? Hpuredet) "H". iApply (wp_lift_pure_step E); try done. + iIntros (? Hpuredet) "H". iApply (wp_lift_pure_step s E E'); try done. { by intros; eapply Hpuredet. } iApply (step_fupd_wand with "H"); iIntros "H". by iIntros (e' efs' σ (_&->&->)%Hpuredet). Qed. -Lemma wp_pure_step_fupd `{Inhabited (state Λ)} E E' e1 e2 φ Φ : +Lemma wp_pure_step_fupd `{Inhabited (state Λ)} s E E' e1 e2 φ Φ : PureExec φ e1 e2 → φ → - (|={E,E'}â–·=> WP e2 @ E {{ Φ }}) ⊢ WP e1 @ E {{ Φ }}. + (|={E,E'}â–·=> WP e2 @ s; E {{ Φ }}) ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros ([??] Hφ) "HWP". - iApply (wp_lift_pure_det_step with "[HWP]"); [eauto|naive_solver|]. - rewrite bi.big_sepL_nil right_id //. + iApply (wp_lift_pure_det_step with "[HWP]"). + - intros σ. specialize (pure_exec_safe σ). destruct s; eauto using reducible_not_val. + - destruct s; naive_solver. + - by rewrite bi.big_sepL_nil right_id. Qed. -Lemma wp_pure_step_later `{Inhabited (state Λ)} E e1 e2 φ Φ : +Lemma wp_pure_step_later `{Inhabited (state Λ)} s E e1 e2 φ Φ : PureExec φ e1 e2 → φ → - â–· WP e2 @ E {{ Φ }} ⊢ WP e1 @ E {{ Φ }}. + â–· WP e2 @ s; E {{ Φ }} ⊢ WP e1 @ s; E {{ Φ }}. Proof. intros ??. rewrite -wp_pure_step_fupd //. rewrite -step_fupd_intro //. Qed. diff --git a/theories/program_logic/ownp.v b/theories/program_logic/ownp.v index 10bf17c1fb7a8a9023510a71310872ac750ee0ca..538e822924dfa974bfd4de2cf2216499d02b27b9 100644 --- a/theories/program_logic/ownp.v +++ b/theories/program_logic/ownp.v @@ -39,9 +39,9 @@ Instance: Params (@ownP) 3. (* Adequacy *) -Theorem ownP_adequacy Σ `{ownPPreG Λ Σ} e σ φ : - (∀ `{ownPG Λ Σ}, ownP σ ⊢ WP e {{ v, ⌜φ v⌠}}) → - adequate e σ φ. +Theorem ownP_adequacy Σ `{ownPPreG Λ Σ} s e σ φ : + (∀ `{ownPG Λ Σ}, ownP σ ⊢ WP e @ s; ⊤ {{ v, ⌜φ v⌠}}) → + adequate s e σ φ. Proof. intros Hwp. apply (wp_adequacy Σ _). iIntros (?). iMod (own_alloc (â— (Excl' (σ : leibnizC _)) â‹… â—¯ (Excl' σ))) @@ -50,18 +50,18 @@ Proof. iApply (Hwp (OwnPG _ _ _ _ γσ)). by rewrite /ownP. Qed. -Theorem ownP_invariance Σ `{ownPPreG Λ Σ} e σ1 t2 σ2 φ : +Theorem ownP_invariance Σ `{ownPPreG Λ Σ} s e σ1 t2 σ2 φ : (∀ `{ownPG Λ Σ}, - ownP σ1 ={⊤}=∗ WP e {{ _, True }} ∗ |={⊤,∅}=> ∃ σ', ownP σ' ∧ ⌜φ σ'âŒ) → + ownP σ1 ={⊤}=∗ WP e @ s; ⊤ {{ _, True }} ∗ |={⊤,∅}=> ∃ σ', ownP σ' ∧ ⌜φ σ'âŒ) → rtc step ([e], σ1) (t2, σ2) → φ σ2. Proof. - intros Hwp Hsteps. eapply (wp_invariance Σ Λ e σ1 t2 σ2 _)=> //. + intros Hwp Hsteps. eapply (wp_invariance Σ Λ s e σ1 t2 σ2 _)=> //. iIntros (?). iMod (own_alloc (â— (Excl' (σ1 : leibnizC _)) â‹… â—¯ (Excl' σ1))) as (γσ) "[Hσ Hσf]"; first done. iExists (λ σ, own γσ (â— (Excl' (σ:leibnizC _)))). iFrame "Hσ". iMod (Hwp (OwnPG _ _ _ _ γσ) with "[Hσf]") as "[$ H]"; first by rewrite /ownP. - iIntros "!> Hσ". iMod "H" as (σ2') "[Hσf %]". rewrite /ownP. + iIntros "!> Hσ". iMod "H" as (σ2') "[Hσf %]". rewrite/ownP. iDestruct (own_valid_2 with "Hσ Hσf") as %[->%Excl_included%leibniz_equiv _]%auth_valid_discrete_2; auto. Qed. @@ -70,164 +70,220 @@ Qed. (** Lifting *) Section lifting. Context `{ownPG Λ Σ}. + Implicit Types s : stuckness. Implicit Types e : expr Λ. Implicit Types Φ : val Λ → iProp Σ. + Lemma ownP_eq σ1 σ2 : state_interp σ1 -∗ ownP σ2 -∗ ⌜σ1 = σ2âŒ. + Proof. + iIntros "Hσ1 Hσ2"; rewrite/ownP. + by iDestruct (own_valid_2 with "Hσ1 Hσ2") + as %[->%Excl_included%leibniz_equiv _]%auth_valid_discrete_2. + Qed. Lemma ownP_twice σ1 σ2 : ownP σ1 ∗ ownP σ2 ⊢ False. Proof. rewrite /ownP -own_op own_valid. by iIntros (?). Qed. Global Instance ownP_timeless σ : Timeless (@ownP (state Λ) Σ _ σ). Proof. rewrite /ownP; apply _. Qed. - Lemma ownP_lift_step E Φ e1 : - (|={E,∅}=> ∃ σ1, ⌜reducible e1 σ1⌠∗ â–· ownP σ1 ∗ + Lemma ownP_lift_step s E Φ e1 : + (|={E,∅}=> ∃ σ1, ⌜if s is NotStuck then reducible e1 σ1 else to_val e1 = None⌠∗ â–· ownP σ1 ∗ â–· ∀ e2 σ2 efs, ⌜prim_step e1 σ1 e2 σ2 efs⌠-∗ ownP σ2 - ={∅,E}=∗ WP e2 @ E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) - ⊢ WP e1 @ E {{ Φ }}. + ={∅,E}=∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) + ⊢ WP e1 @ s; E {{ Φ }}. Proof. iIntros "H". destruct (to_val e1) as [v|] eqn:EQe1. - apply of_to_val in EQe1 as <-. iApply fupd_wp. - iMod "H" as (σ1) "[Hred _]"; iDestruct "Hred" as %Hred%reducible_not_val. + iMod "H" as (σ1) "[Hred _]"; iDestruct "Hred" as %Hred. + destruct s; last done. apply reducible_not_val in Hred. move: Hred; by rewrite to_of_val. - iApply wp_lift_step; [done|]; iIntros (σ1) "Hσ". - iMod "H" as (σ1' ?) "[>Hσf H]". rewrite /ownP. - iDestruct (own_valid_2 with "Hσ Hσf") - as %[->%Excl_included%leibniz_equiv _]%auth_valid_discrete_2. - iModIntro; iSplit; [done|]; iNext; iIntros (e2 σ2 efs Hstep). - iMod (own_update_2 with "Hσ Hσf") as "[Hσ Hσf]". + iMod "H" as (σ1' ?) "[>Hσf H]". iDestruct (ownP_eq with "Hσ Hσf") as %->. + iModIntro; iSplit; [by destruct s|]; iNext; iIntros (e2 σ2 efs Hstep). + rewrite /ownP; iMod (own_update_2 with "Hσ Hσf") as "[Hσ Hσf]". { by apply auth_update, option_local_update, (exclusive_local_update _ (Excl σ2)). } iFrame "Hσ". iApply ("H" with "[]"); eauto. Qed. - Lemma ownP_lift_pure_step `{Inhabited (state Λ)} E Φ e1 : - (∀ σ1, reducible e1 σ1) → + Lemma ownP_lift_stuck E Φ e : + (|={E,∅}=> ∃ σ, ⌜stuck e σ⌠∗ â–· ownP σ) + ⊢ WP e @ E ?{{ Φ }}. + Proof. + iIntros "H". destruct (to_val e) as [v|] eqn:EQe. + - apply of_to_val in EQe as <-. iApply fupd_wp. + iMod "H" as (σ1) "[H _]". iDestruct "H" as %[Hnv _]. exfalso. + by rewrite to_of_val in Hnv. + - iApply wp_lift_stuck; [done|]. iIntros (σ1) "Hσ". + iMod "H" as (σ1') "(% & >Hσf)". + by iDestruct (ownP_eq with "Hσ Hσf") as %->. + Qed. + + Lemma ownP_lift_pure_step `{Inhabited (state Λ)} s E Φ e1 : + (∀ σ1, if s is NotStuck then reducible e1 σ1 else to_val e1 = None) → (∀ σ1 e2 σ2 efs, prim_step e1 σ1 e2 σ2 efs → σ1 = σ2) → (â–· ∀ e2 efs σ, ⌜prim_step e1 σ e2 σ efs⌠→ - WP e2 @ E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) - ⊢ WP e1 @ E {{ Φ }}. + WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) + ⊢ WP e1 @ s; E {{ Φ }}. Proof. - iIntros (Hsafe Hstep) "H". iApply wp_lift_step. - { eapply reducible_not_val, (Hsafe inhabitant). } + iIntros (Hsafe Hstep) "H"; iApply wp_lift_step. + { specialize (Hsafe inhabitant). destruct s; last done. + by eapply reducible_not_val. } iIntros (σ1) "Hσ". iMod (fupd_intro_mask' E ∅) as "Hclose"; first set_solver. - iModIntro. iSplit; [done|]; iNext; iIntros (e2 σ2 efs ?). + iModIntro; iSplit; [by destruct s|]; iNext; iIntros (e2 σ2 efs ?). destruct (Hstep σ1 e2 σ2 efs); auto; subst. - iMod "Hclose"; iModIntro. iFrame "Hσ". iApply "H"; auto. + by iMod "Hclose"; iModIntro; iFrame; iApply "H". Qed. (** Derived lifting lemmas. *) - Lemma ownP_lift_atomic_step {E Φ} e1 σ1 : - reducible e1 σ1 → + Lemma ownP_lift_atomic_step {s E Φ} e1 σ1 : + (if s is NotStuck then reducible e1 σ1 else to_val e1 = None) → (â–· ownP σ1 ∗ â–· ∀ e2 σ2 efs, ⌜prim_step e1 σ1 e2 σ2 efs⌠-∗ ownP σ2 -∗ - default False (to_val e2) Φ ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) - ⊢ WP e1 @ E {{ Φ }}. + default False (to_val e2) Φ ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) + ⊢ WP e1 @ s; E {{ Φ }}. Proof. - iIntros (?) "[Hσ H]". iApply (ownP_lift_step E _ e1). - iMod (fupd_intro_mask' E ∅) as "Hclose"; first set_solver. iModIntro. - iExists σ1. iFrame "Hσ"; iSplit; eauto. + iIntros (?) "[Hσ H]"; iApply ownP_lift_step. + iMod (fupd_intro_mask' E ∅) as "Hclose"; first set_solver. + iModIntro; iExists σ1; iFrame; iSplit; first by destruct s. iNext; iIntros (e2 σ2 efs) "% Hσ". iDestruct ("H" $! e2 σ2 efs with "[] [Hσ]") as "[HΦ $]"; [by eauto..|]. destruct (to_val e2) eqn:?; last by iExFalso. - iMod "Hclose". iApply wp_value; auto using to_of_val. done. + by iMod "Hclose"; iApply wp_value; auto using to_of_val. Qed. - Lemma ownP_lift_atomic_det_step {E Φ e1} σ1 v2 σ2 efs : - reducible e1 σ1 → + Lemma ownP_lift_atomic_det_step {s E Φ e1} σ1 v2 σ2 efs : + (if s is NotStuck then reducible e1 σ1 else to_val e1 = None) → (∀ e2' σ2' efs', prim_step e1 σ1 e2' σ2' efs' → σ2 = σ2' ∧ to_val e2' = Some v2 ∧ efs = efs') → â–· ownP σ1 ∗ â–· (ownP σ2 -∗ - Φ v2 ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) - ⊢ WP e1 @ E {{ Φ }}. + Φ v2 ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) + ⊢ WP e1 @ s; E {{ Φ }}. + Proof. + iIntros (? Hdet) "[Hσ1 Hσ2]"; iApply ownP_lift_atomic_step; try done. + iFrame; iNext; iIntros (e2' σ2' efs') "% Hσ2'". + edestruct Hdet as (->&Hval&->). done. by rewrite Hval; iApply "Hσ2". + Qed. + + Lemma ownP_lift_atomic_det_step_no_fork {s E e1} σ1 v2 σ2 : + (if s is NotStuck then reducible e1 σ1 else to_val e1 = None) → + (∀ e2' σ2' efs', prim_step e1 σ1 e2' σ2' efs' → + σ2 = σ2' ∧ to_val e2' = Some v2 ∧ [] = efs') → + {{{ â–· ownP σ1 }}} e1 @ s; E {{{ RET v2; ownP σ2 }}}. Proof. - iIntros (? Hdet) "[Hσ1 Hσ2]". iApply (ownP_lift_atomic_step _ σ1); try done. - iFrame. iNext. iIntros (e2' σ2' efs') "% Hσ2'". - edestruct Hdet as (->&Hval&->). done. rewrite Hval. by iApply "Hσ2". + intros. rewrite -(ownP_lift_atomic_det_step σ1 v2 σ2 []); [|done..]. + rewrite bi.big_sepL_nil right_id. by apply bi.wand_intro_r. Qed. - Lemma ownP_lift_pure_det_step `{Inhabited (state Λ)} {E Φ} e1 e2 efs : - (∀ σ1, reducible e1 σ1) → + Lemma ownP_lift_pure_det_step `{Inhabited (state Λ)} {s E Φ} e1 e2 efs : + (∀ σ1, if s is NotStuck then reducible e1 σ1 else to_val e1 = None) → (∀ σ1 e2' σ2 efs', prim_step e1 σ1 e2' σ2 efs' → σ1 = σ2 ∧ e2 = e2' ∧ efs = efs')→ - â–· (WP e2 @ E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) - ⊢ WP e1 @ E {{ Φ }}. + â–· (WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤{{ _, True }}) + ⊢ WP e1 @ s; E {{ Φ }}. Proof. - iIntros (? Hpuredet) "?". iApply (ownP_lift_pure_step E); try done. - by intros; eapply Hpuredet. iNext. by iIntros (e' efs' σ (_&->&->)%Hpuredet). + iIntros (? Hpuredet) "?"; iApply ownP_lift_pure_step=>//. + by apply Hpuredet. by iNext; iIntros (e' efs' σ (_&->&->)%Hpuredet). + Qed. + + Lemma ownP_lift_pure_det_step_no_fork `{Inhabited (state Λ)} {s E Φ} e1 e2 : + (∀ σ1, if s is NotStuck then reducible e1 σ1 else to_val e1 = None) → + (∀ σ1 e2' σ2 efs', prim_step e1 σ1 e2' σ2 efs' → σ1 = σ2 ∧ e2 = e2' ∧ [] = efs') → + â–· WP e2 @ s; E {{ Φ }} ⊢ WP e1 @ s; E {{ Φ }}. + Proof. + intros. rewrite -(wp_lift_pure_det_step e1 e2 []) ?bi.big_sepL_nil ?right_id; eauto. Qed. End lifting. Section ectx_lifting. Import ectx_language. Context {Λ : ectxLanguage} `{ownPG Λ Σ} {Hinh : Inhabited (state Λ)}. + Implicit Types s : stuckness. Implicit Types Φ : val Λ → iProp Σ. Implicit Types e : expr Λ. Hint Resolve head_prim_reducible head_reducible_prim_step. + Hint Resolve (reducible_not_val _ inhabitant). + Hint Resolve head_stuck_stuck. - Lemma ownP_lift_head_step E Φ e1 : + Lemma ownP_lift_head_step s E Φ e1 : (|={E,∅}=> ∃ σ1, ⌜head_reducible e1 σ1⌠∗ â–· ownP σ1 ∗ â–· ∀ e2 σ2 efs, ⌜head_step e1 σ1 e2 σ2 efs⌠-∗ ownP σ2 - ={∅,E}=∗ WP e2 @ E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) - ⊢ WP e1 @ E {{ Φ }}. + ={∅,E}=∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) + ⊢ WP e1 @ s; E {{ Φ }}. Proof. - iIntros "H". iApply (ownP_lift_step E); try done. - iMod "H" as (σ1 ?) "[Hσ1 Hwp]". iModIntro. iExists σ1. - iSplit; first by eauto. iFrame. iNext. iIntros (e2 σ2 efs) "% ?". + iIntros "H". iApply ownP_lift_step. + iMod "H" as (σ1 ?) "[Hσ1 Hwp]". iModIntro. iExists σ1. iSplit. + { destruct s; try by eauto using reducible_not_val. } + iFrame. iNext. iIntros (e2 σ2 efs) "% ?". iApply ("Hwp" with "[]"); eauto. Qed. - Lemma ownP_lift_pure_head_step E Φ e1 : + Lemma ownP_lift_head_stuck E Φ e : + sub_redexes_are_values e → + (|={E,∅}=> ∃ σ, ⌜head_stuck e σ⌠∗ â–· ownP σ) + ⊢ WP e @ E ?{{ Φ }}. + Proof. + iIntros (?) "H". iApply ownP_lift_stuck. iMod "H" as (σ) "[% >Hσ]". + iExists σ. by auto. + Qed. + + Lemma ownP_lift_pure_head_step s E Φ e1 : (∀ σ1, head_reducible e1 σ1) → (∀ σ1 e2 σ2 efs, head_step e1 σ1 e2 σ2 efs → σ1 = σ2) → (â–· ∀ e2 efs σ, ⌜head_step e1 σ e2 σ efs⌠→ - WP e2 @ E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) - ⊢ WP e1 @ E {{ Φ }}. + WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) + ⊢ WP e1 @ s; E {{ Φ }}. Proof using Hinh. - iIntros (??) "H". iApply ownP_lift_pure_step; eauto. iNext. - iIntros (????). iApply "H". eauto. + iIntros (??) "H". iApply ownP_lift_pure_step; eauto. + { by destruct s; auto. } + iNext. iIntros (????). iApply "H"; eauto. Qed. - Lemma ownP_lift_atomic_head_step {E Φ} e1 σ1 : + Lemma ownP_lift_atomic_head_step {s E Φ} e1 σ1 : head_reducible e1 σ1 → â–· ownP σ1 ∗ â–· (∀ e2 σ2 efs, ⌜head_step e1 σ1 e2 σ2 efs⌠-∗ ownP σ2 -∗ - default False (to_val e2) Φ ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) - ⊢ WP e1 @ E {{ Φ }}. + default False (to_val e2) Φ ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) + ⊢ WP e1 @ s; E {{ Φ }}. Proof. - iIntros (?) "[? H]". iApply ownP_lift_atomic_step; eauto. iFrame. iNext. - iIntros (???) "% ?". iApply ("H" with "[]"); eauto. + iIntros (?) "[? H]". iApply ownP_lift_atomic_step; eauto. + { by destruct s; eauto using reducible_not_val. } + iFrame. iNext. iIntros (???) "% ?". iApply ("H" with "[]"); eauto. Qed. - Lemma ownP_lift_atomic_det_head_step {E Φ e1} σ1 v2 σ2 efs : + Lemma ownP_lift_atomic_det_head_step {s E Φ e1} σ1 v2 σ2 efs : head_reducible e1 σ1 → (∀ e2' σ2' efs', head_step e1 σ1 e2' σ2' efs' → σ2 = σ2' ∧ to_val e2' = Some v2 ∧ efs = efs') → - â–· ownP σ1 ∗ â–· (ownP σ2 -∗ Φ v2 ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) - ⊢ WP e1 @ E {{ Φ }}. - Proof. eauto using ownP_lift_atomic_det_step. Qed. + â–· ownP σ1 ∗ â–· (ownP σ2 -∗ Φ v2 ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) + ⊢ WP e1 @ s; E {{ Φ }}. + Proof. + by destruct s; eauto 10 using ownP_lift_atomic_det_step, reducible_not_val. + Qed. - Lemma ownP_lift_atomic_det_head_step_no_fork {E e1} σ1 v2 σ2 : + Lemma ownP_lift_atomic_det_head_step_no_fork {s E e1} σ1 v2 σ2 : head_reducible e1 σ1 → (∀ e2' σ2' efs', head_step e1 σ1 e2' σ2' efs' → σ2 = σ2' ∧ to_val e2' = Some v2 ∧ [] = efs') → - {{{ â–· ownP σ1 }}} e1 @ E {{{ RET v2; ownP σ2 }}}. + {{{ â–· ownP σ1 }}} e1 @ s; E {{{ RET v2; ownP σ2 }}}. Proof. - intros. rewrite -(ownP_lift_atomic_det_head_step σ1 v2 σ2 []); [|done..]. - rewrite /= right_id. by apply bi.wand_intro_r. + intros ???; apply ownP_lift_atomic_det_step_no_fork; eauto. + by destruct s; eauto using reducible_not_val. Qed. - Lemma ownP_lift_pure_det_head_step {E Φ} e1 e2 efs : + Lemma ownP_lift_pure_det_head_step {s E Φ} e1 e2 efs : (∀ σ1, head_reducible e1 σ1) → (∀ σ1 e2' σ2 efs', head_step e1 σ1 e2' σ2 efs' → σ1 = σ2 ∧ e2 = e2' ∧ efs = efs') → - â–· (WP e2 @ E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) - ⊢ WP e1 @ E {{ Φ }}. + â–· (WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }}) + ⊢ WP e1 @ s; E {{ Φ }}. Proof using Hinh. - intros. rewrite -[(WP e1 @ _ {{ _ }})%I]wp_lift_pure_det_step; eauto. + iIntros (??) "H"; iApply wp_lift_pure_det_step; eauto. + by destruct s; eauto using reducible_not_val. Qed. - Lemma ownP_lift_pure_det_head_step_no_fork {E Φ} e1 e2 : - to_val e1 = None → + Lemma ownP_lift_pure_det_head_step_no_fork {s E Φ} e1 e2 : (∀ σ1, head_reducible e1 σ1) → (∀ σ1 e2' σ2 efs', head_step e1 σ1 e2' σ2 efs' → σ1 = σ2 ∧ e2 = e2' ∧ [] = efs') → - â–· WP e2 @ E {{ Φ }} ⊢ WP e1 @ E {{ Φ }}. + â–· WP e2 @ s; E {{ Φ }} ⊢ WP e1 @ s; E {{ Φ }}. Proof using Hinh. - intros. rewrite -(wp_lift_pure_det_step e1 e2 []) /= ?right_id; eauto. + iIntros (??) "H". iApply ownP_lift_pure_det_step_no_fork; eauto. + by destruct s; eauto using reducible_not_val. Qed. End ectx_lifting. diff --git a/theories/program_logic/weakestpre.v b/theories/program_logic/weakestpre.v index 016ef451b209b4fed05c8840d776dd927ad6de37..bfeb71f1cd2b764547579c25558137cd0407e7a5 100644 --- a/theories/program_logic/weakestpre.v +++ b/theories/program_logic/weakestpre.v @@ -10,99 +10,188 @@ Class irisG' (Λstate : Type) (Σ : gFunctors) := IrisG { }. Notation irisG Λ Σ := (irisG' (state Λ) Σ). -Definition wp_pre `{irisG Λ Σ} +Inductive stuckness := NotStuck | MaybeStuck. + +Definition stuckness_le (s1 s2 : stuckness) : bool := + match s1, s2 with + | MaybeStuck, NotStuck => false + | _, _ => true + end. +Instance: PreOrder stuckness_le. +Proof. + split; first by case. move=>s1 s2 s3. by case: s1; case: s2; case: s3. +Qed. +Instance: SqSubsetEq stuckness := stuckness_le. + +Definition stuckness_to_atomicity (s : stuckness) : atomicity := + if s is MaybeStuck then StronglyAtomic else WeaklyAtomic. + +Definition wp_pre `{irisG Λ Σ} (s : stuckness) (wp : coPset -c> expr Λ -c> (val Λ -c> iProp Σ) -c> iProp Σ) : coPset -c> expr Λ -c> (val Λ -c> iProp Σ) -c> iProp Σ := λ E e1 Φ, match to_val e1 with | Some v => |={E}=> Φ v | None => ∀ σ1, - state_interp σ1 ={E,∅}=∗ ⌜reducible e1 σ1⌠∗ + state_interp σ1 ={E,∅}=∗ ⌜if s is NotStuck then reducible e1 σ1 else True⌠∗ â–· ∀ e2 σ2 efs, ⌜prim_step e1 σ1 e2 σ2 efs⌠={∅,E}=∗ state_interp σ2 ∗ wp E e2 Φ ∗ [∗ list] ef ∈ efs, wp ⊤ ef (λ _, True) end%I. -Local Instance wp_pre_contractive `{irisG Λ Σ} : Contractive wp_pre. +Local Instance wp_pre_contractive `{irisG Λ Σ} s : Contractive (wp_pre s). Proof. rewrite /wp_pre=> n wp wp' Hwp E e1 Φ. repeat (f_contractive || f_equiv); apply Hwp. Qed. -Definition wp_def `{irisG Λ Σ} : - coPset → expr Λ → (val Λ → iProp Σ) → iProp Σ := fixpoint wp_pre. +Definition wp_def `{irisG Λ Σ} s : + coPset → expr Λ → (val Λ → iProp Σ) → iProp Σ := fixpoint (wp_pre s). Definition wp_aux : seal (@wp_def). by eexists. Qed. Definition wp := unseal wp_aux. Definition wp_eq : @wp = @wp_def := seal_eq wp_aux. -Arguments wp {_ _ _} _ _%E _. -Instance: Params (@wp) 5. +Arguments wp {_ _ _} _ _ _%E _. +Instance: Params (@wp) 6. -Notation "'WP' e @ E {{ Φ } }" := (wp E e%E Φ) +Notation "'WP' e @ s ; E {{ Φ } }" := (wp s E e%E Φ) + (at level 20, e, Φ at level 200, + format "'[' 'WP' e '/' @ s ; E {{ Φ } } ']'") : bi_scope. +Notation "'WP' e @ E {{ Φ } }" := (wp NotStuck E e%E Φ) (at level 20, e, Φ at level 200, format "'[' 'WP' e '/' @ E {{ Φ } } ']'") : bi_scope. -Notation "'WP' e {{ Φ } }" := (wp ⊤ e%E Φ) +Notation "'WP' e @ E ? {{ Φ } }" := (wp MaybeStuck E e%E Φ) + (at level 20, e, Φ at level 200, + format "'[' 'WP' e '/' @ E ? {{ Φ } } ']'") : bi_scope. +Notation "'WP' e {{ Φ } }" := (wp NotStuck ⊤ e%E Φ) (at level 20, e, Φ at level 200, format "'[' 'WP' e '/' {{ Φ } } ']'") : bi_scope. +Notation "'WP' e ? {{ Φ } }" := (wp MaybeStuck ⊤ e%E Φ) + (at level 20, e, Φ at level 200, + format "'[' 'WP' e '/' ? {{ Φ } } ']'") : bi_scope. -Notation "'WP' e @ E {{ v , Q } }" := (wp E e%E (λ v, Q)) +Notation "'WP' e @ s ; E {{ v , Q } }" := (wp s E e%E (λ v, Q)) + (at level 20, e, Q at level 200, + format "'[' 'WP' e '/' @ s ; E {{ v , Q } } ']'") : bi_scope. +Notation "'WP' e @ E {{ v , Q } }" := (wp NotStuck E e%E (λ v, Q)) (at level 20, e, Q at level 200, format "'[' 'WP' e '/' @ E {{ v , Q } } ']'") : bi_scope. -Notation "'WP' e {{ v , Q } }" := (wp ⊤ e%E (λ v, Q)) +Notation "'WP' e @ E ? {{ v , Q } }" := (wp MaybeStuck E e%E (λ v, Q)) + (at level 20, e, Q at level 200, + format "'[' 'WP' e '/' @ E ? {{ v , Q } } ']'") : bi_scope. +Notation "'WP' e {{ v , Q } }" := (wp NotStuck ⊤ e%E (λ v, Q)) (at level 20, e, Q at level 200, format "'[' 'WP' e '/' {{ v , Q } } ']'") : bi_scope. +Notation "'WP' e ? {{ v , Q } }" := (wp MaybeStuck ⊤ e%E (λ v, Q)) + (at level 20, e, Q at level 200, + format "'[' 'WP' e '/' ? {{ v , Q } } ']'") : bi_scope. (* Texan triples *) +Notation "'{{{' P } } } e @ s ; E {{{ x .. y , 'RET' pat ; Q } } }" := + (â–¡ ∀ Φ, + P -∗ â–· (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ s; E {{ Φ }})%I + (at level 20, x closed binder, y closed binder, + format "{{{ P } } } e @ s ; E {{{ x .. y , RET pat ; Q } } }") : bi_scope. Notation "'{{{' P } } } e @ E {{{ x .. y , 'RET' pat ; Q } } }" := (â–¡ ∀ Φ, P -∗ â–· (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ E {{ Φ }})%I (at level 20, x closed binder, y closed binder, format "{{{ P } } } e @ E {{{ x .. y , RET pat ; Q } } }") : bi_scope. +Notation "'{{{' P } } } e @ E ? {{{ x .. y , 'RET' pat ; Q } } }" := + (â–¡ ∀ Φ, + P -∗ â–· (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ E ?{{ Φ }})%I + (at level 20, x closed binder, y closed binder, + format "{{{ P } } } e @ E ? {{{ x .. y , RET pat ; Q } } }") : bi_scope. Notation "'{{{' P } } } e {{{ x .. y , 'RET' pat ; Q } } }" := (â–¡ ∀ Φ, P -∗ â–· (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e {{ Φ }})%I (at level 20, x closed binder, y closed binder, format "{{{ P } } } e {{{ x .. y , RET pat ; Q } } }") : bi_scope. +Notation "'{{{' P } } } e ? {{{ x .. y , 'RET' pat ; Q } } }" := + (â–¡ ∀ Φ, + P -∗ â–· (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e ?{{ Φ }})%I + (at level 20, x closed binder, y closed binder, + format "{{{ P } } } e ? {{{ x .. y , RET pat ; Q } } }") : bi_scope. +Notation "'{{{' P } } } e @ s ; E {{{ 'RET' pat ; Q } } }" := + (â–¡ ∀ Φ, P -∗ â–· (Q -∗ Φ pat%V) -∗ WP e @ s; E {{ Φ }})%I + (at level 20, + format "{{{ P } } } e @ s ; E {{{ RET pat ; Q } } }") : bi_scope. Notation "'{{{' P } } } e @ E {{{ 'RET' pat ; Q } } }" := (â–¡ ∀ Φ, P -∗ â–· (Q -∗ Φ pat%V) -∗ WP e @ E {{ Φ }})%I (at level 20, format "{{{ P } } } e @ E {{{ RET pat ; Q } } }") : bi_scope. +Notation "'{{{' P } } } e @ E ? {{{ 'RET' pat ; Q } } }" := + (â–¡ ∀ Φ, P -∗ â–· (Q -∗ Φ pat%V) -∗ WP e @ E ?{{ Φ }})%I + (at level 20, + format "{{{ P } } } e @ E ? {{{ RET pat ; Q } } }") : bi_scope. Notation "'{{{' P } } } e {{{ 'RET' pat ; Q } } }" := (â–¡ ∀ Φ, P -∗ â–· (Q -∗ Φ pat%V) -∗ WP e {{ Φ }})%I (at level 20, format "{{{ P } } } e {{{ RET pat ; Q } } }") : bi_scope. +Notation "'{{{' P } } } e ? {{{ 'RET' pat ; Q } } }" := + (â–¡ ∀ Φ, P -∗ â–· (Q -∗ Φ pat%V) -∗ WP e ?{{ Φ }})%I + (at level 20, + format "{{{ P } } } e ? {{{ RET pat ; Q } } }") : bi_scope. +Notation "'{{{' P } } } e @ s ; E {{{ x .. y , 'RET' pat ; Q } } }" := + (∀ Φ : _ → uPred _, + P -∗ â–· (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ s; E {{ Φ }}) + (at level 20, x closed binder, y closed binder, + format "{{{ P } } } e @ s ; E {{{ x .. y , RET pat ; Q } } }") : stdpp_scope. Notation "'{{{' P } } } e @ E {{{ x .. y , 'RET' pat ; Q } } }" := (∀ Φ : _ → uPred _, P -∗ â–· (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ E {{ Φ }}) (at level 20, x closed binder, y closed binder, format "{{{ P } } } e @ E {{{ x .. y , RET pat ; Q } } }") : stdpp_scope. +Notation "'{{{' P } } } e @ E ? {{{ x .. y , 'RET' pat ; Q } } }" := + (∀ Φ : _ → uPred _, + P -∗ â–· (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ E ?{{ Φ }}) + (at level 20, x closed binder, y closed binder, + format "{{{ P } } } e @ E ? {{{ x .. y , RET pat ; Q } } }") : stdpp_scope. Notation "'{{{' P } } } e {{{ x .. y , 'RET' pat ; Q } } }" := (∀ Φ : _ → uPred _, P -∗ â–· (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e {{ Φ }}) (at level 20, x closed binder, y closed binder, format "{{{ P } } } e {{{ x .. y , RET pat ; Q } } }") : stdpp_scope. +Notation "'{{{' P } } } e ? {{{ x .. y , 'RET' pat ; Q } } }" := + (∀ Φ : _ → uPred _, + P -∗ â–· (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e ?{{ Φ }}) + (at level 20, x closed binder, y closed binder, + format "{{{ P } } } e ? {{{ x .. y , RET pat ; Q } } }") : stdpp_scope. +Notation "'{{{' P } } } e @ s ; E {{{ 'RET' pat ; Q } } }" := + (∀ Φ : _ → uPred _, P -∗ â–· (Q -∗ Φ pat%V) -∗ WP e @ s; E {{ Φ }}) + (at level 20, + format "{{{ P } } } e @ s ; E {{{ RET pat ; Q } } }") : stdpp_scope. Notation "'{{{' P } } } e @ E {{{ 'RET' pat ; Q } } }" := (∀ Φ : _ → uPred _, P -∗ â–· (Q -∗ Φ pat%V) -∗ WP e @ E {{ Φ }}) (at level 20, format "{{{ P } } } e @ E {{{ RET pat ; Q } } }") : stdpp_scope. +Notation "'{{{' P } } } e @ E ? {{{ 'RET' pat ; Q } } }" := + (∀ Φ : _ → uPred _, P -∗ â–· (Q -∗ Φ pat%V) -∗ WP e @ E ?{{ Φ }}) + (at level 20, + format "{{{ P } } } e @ E ? {{{ RET pat ; Q } } }") : stdpp_scope. Notation "'{{{' P } } } e {{{ 'RET' pat ; Q } } }" := (∀ Φ : _ → uPred _, P -∗ â–· (Q -∗ Φ pat%V) -∗ WP e {{ Φ }}) (at level 20, format "{{{ P } } } e {{{ RET pat ; Q } } }") : stdpp_scope. +Notation "'{{{' P } } } e ? {{{ 'RET' pat ; Q } } }" := + (∀ Φ : _ → uPred _, P -∗ â–· (Q -∗ Φ pat%V) -∗ WP e ?{{ Φ }}) + (at level 20, + format "{{{ P } } } e ? {{{ RET pat ; Q } } }") : stdpp_scope. Section wp. Context `{irisG Λ Σ}. +Implicit Types s : stuckness. Implicit Types P : iProp Σ. Implicit Types Φ : val Λ → iProp Σ. Implicit Types v : val Λ. Implicit Types e : expr Λ. (* Weakest pre *) -Lemma wp_unfold E e Φ : WP e @ E {{ Φ }} ⊣⊢ wp_pre wp E e Φ. -Proof. rewrite wp_eq. apply (fixpoint_unfold wp_pre). Qed. +Lemma wp_unfold s E e Φ : WP e @ s; E {{ Φ }} ⊣⊢ wp_pre s (wp s) E e Φ. +Proof. rewrite wp_eq. apply (fixpoint_unfold (wp_pre s)). Qed. -Global Instance wp_ne E e n : - Proper (pointwise_relation _ (dist n) ==> dist n) (@wp Λ Σ _ E e). +Global Instance wp_ne s E e n : + Proper (pointwise_relation _ (dist n) ==> dist n) (@wp Λ Σ _ s E e). Proof. revert e. induction (lt_wf n) as [n _ IH]=> e Φ Ψ HΦ. rewrite !wp_unfold /wp_pre. @@ -112,19 +201,19 @@ Proof. do 17 (f_contractive || f_equiv). apply IH; first lia. intros v. eapply dist_le; eauto with omega. Qed. -Global Instance wp_proper E e : - Proper (pointwise_relation _ (≡) ==> (≡)) (@wp Λ Σ _ E e). +Global Instance wp_proper s E e : + Proper (pointwise_relation _ (≡) ==> (≡)) (@wp Λ Σ _ s E e). Proof. by intros Φ Φ' ?; apply equiv_dist=>n; apply wp_ne=>v; apply equiv_dist. Qed. -Lemma wp_value' E Φ v : Φ v ⊢ WP of_val v @ E {{ Φ }}. +Lemma wp_value' s E Φ v : Φ v ⊢ WP of_val v @ s; E {{ Φ }}. Proof. iIntros "HΦ". rewrite wp_unfold /wp_pre to_of_val. auto. Qed. -Lemma wp_value_inv E Φ v : WP of_val v @ E {{ Φ }} ={E}=∗ Φ v. +Lemma wp_value_inv s E Φ v : WP of_val v @ s; E {{ Φ }} ={E}=∗ Φ v. Proof. by rewrite wp_unfold /wp_pre to_of_val. Qed. -Lemma wp_strong_mono E1 E2 e Φ Ψ : - E1 ⊆ E2 → (∀ v, Φ v ={E2}=∗ Ψ v) ∗ WP e @ E1 {{ Φ }} ⊢ WP e @ E2 {{ Ψ }}. +Lemma wp_strong_mono s E1 E2 e Φ Ψ : + E1 ⊆ E2 → (∀ v, Φ v ={E2}=∗ Ψ v) ∗ WP e @ s; E1 {{ Φ }} ⊢ WP e @ s; E2 {{ Ψ }}. Proof. iIntros (?) "[HΦ H]". iLöb as "IH" forall (e). rewrite !wp_unfold /wp_pre. destruct (to_val e) as [v|] eqn:?. @@ -136,128 +225,149 @@ Proof. iMod "Hclose" as "_". by iApply ("IH" with "HΦ"). Qed. -Lemma fupd_wp E e Φ : (|={E}=> WP e @ E {{ Φ }}) ⊢ WP e @ E {{ Φ }}. +Lemma wp_stuck_weaken s E e Φ : + WP e @ s; E {{ Φ }} ⊢ WP e @ E ?{{ Φ }}. +Proof. + iIntros "H". iLöb as "IH" forall (E e Φ). rewrite !wp_unfold /wp_pre. + destruct (to_val e) as [v|]; first iExact "H". + iIntros (σ1) "Hσ". iMod ("H" with "Hσ") as "[#Hred H]". iModIntro. + iSplit; first done. iNext. iIntros (e2 σ2 efs) "#Hstep". + iMod ("H" with "Hstep") as "($ & He2 & Hefs)". iModIntro. + iSplitL "He2"; first by iApply ("IH" with "He2"). iClear "Hred Hstep". + induction efs as [|ef efs IH]; first by iApply big_sepL_nil. + rewrite !big_sepL_cons. iDestruct "Hefs" as "(Hef & Hefs)". + iSplitL "Hef". by iApply ("IH" with "Hef"). exact: IH. +Qed. + +Lemma fupd_wp s E e Φ : (|={E}=> WP e @ s; E {{ Φ }}) ⊢ WP e @ s; E {{ Φ }}. Proof. rewrite wp_unfold /wp_pre. iIntros "H". destruct (to_val e) as [v|] eqn:?. { by iMod "H". } iIntros (σ1) "Hσ1". iMod "H". by iApply "H". Qed. -Lemma wp_fupd E e Φ : WP e @ E {{ v, |={E}=> Φ v }} ⊢ WP e @ E {{ Φ }}. -Proof. iIntros "H". iApply (wp_strong_mono E); try iFrame; auto. Qed. +Lemma wp_fupd s E e Φ : WP e @ s; E {{ v, |={E}=> Φ v }} ⊢ WP e @ s; E {{ Φ }}. +Proof. iIntros "H". iApply (wp_strong_mono s E); try iFrame; auto. Qed. -Lemma wp_atomic E1 E2 e Φ : - Atomic e → - (|={E1,E2}=> WP e @ E2 {{ v, |={E2,E1}=> Φ v }}) ⊢ WP e @ E1 {{ Φ }}. +Lemma wp_atomic s E1 E2 e Φ `{!Atomic (stuckness_to_atomicity s) e} : + (|={E1,E2}=> WP e @ s; E2 {{ v, |={E2,E1}=> Φ v }}) ⊢ WP e @ s; E1 {{ Φ }}. Proof. - iIntros (Hatomic) "H". rewrite !wp_unfold /wp_pre. + iIntros "H". rewrite !wp_unfold /wp_pre. destruct (to_val e) as [v|] eqn:He. { by iDestruct "H" as ">>> $". } iIntros (σ1) "Hσ". iMod "H". iMod ("H" $! σ1 with "Hσ") as "[$ H]". - iModIntro. iNext. iIntros (e2 σ2 efs Hstep). - iMod ("H" with "[//]") as "(Hphy & H & $)". - rewrite !wp_unfold /wp_pre. destruct (to_val e2) as [v2|] eqn:He2. - - iDestruct "H" as ">> $". eauto with iFrame. - - iMod ("H" with "[$]") as "[H _]". - iDestruct "H" as %(? & ? & ? & ?). by edestruct (Hatomic _ _ _ _ Hstep). + iModIntro. iNext. iIntros (e2 σ2 efs Hstep). destruct s. + - iMod ("H" with "[//]") as "(Hphy & H & $)". + rewrite !wp_unfold /wp_pre. destruct (to_val e2) as [v2|] eqn:He2. + + iDestruct "H" as ">> $". by iFrame. + + iMod ("H" with "[$]") as "[H _]". iDestruct "H" as %(? & ? & ? & ?). + by edestruct (atomic _ _ _ _ Hstep). + - destruct (atomic _ _ _ _ Hstep) as [v <-%of_to_val]. + iMod ("H" with "[#]") as "($ & H & $)"; first done. + iMod (wp_value_inv with "H") as ">H". by iApply wp_value'. Qed. -Lemma wp_step_fupd E1 E2 e P Φ : +Lemma wp_step_fupd s E1 E2 e P Φ : to_val e = None → E2 ⊆ E1 → - (|={E1,E2}â–·=> P) -∗ WP e @ E2 {{ v, P ={E1}=∗ Φ v }} -∗ WP e @ E1 {{ Φ }}. + (|={E1,E2}â–·=> P) -∗ WP e @ s; E2 {{ v, P ={E1}=∗ Φ v }} -∗ WP e @ s; E1 {{ Φ }}. Proof. rewrite !wp_unfold /wp_pre. iIntros (-> ?) "HR H". iIntros (σ1) "Hσ". iMod "HR". iMod ("H" with "[$]") as "[$ H]". iModIntro; iNext; iIntros (e2 σ2 efs Hstep). iMod ("H" $! e2 σ2 efs with "[% //]") as "($ & H & $)". - iMod "HR". iModIntro. iApply (wp_strong_mono E2); first done. + iMod "HR". iModIntro. iApply (wp_strong_mono s E2); first done. iSplitR "H"; last iExact "H". iIntros (v) "H". by iApply "H". Qed. -Lemma wp_bind K `{!LanguageCtx K} E e Φ : - WP e @ E {{ v, WP K (of_val v) @ E {{ Φ }} }} ⊢ WP K e @ E {{ Φ }}. +Lemma wp_bind K `{!LanguageCtx K} s E e Φ : + WP e @ s; E {{ v, WP K (of_val v) @ s; E {{ Φ }} }} ⊢ WP K e @ s; E {{ Φ }}. Proof. iIntros "H". iLöb as "IH" forall (E e Φ). rewrite wp_unfold /wp_pre. destruct (to_val e) as [v|] eqn:He. { apply of_to_val in He as <-. by iApply fupd_wp. } rewrite wp_unfold /wp_pre fill_not_val //. iIntros (σ1) "Hσ". iMod ("H" with "[$]") as "[% H]". iModIntro; iSplit. - { iPureIntro. unfold reducible in *. naive_solver eauto using fill_step. } + { iPureIntro. destruct s; last done. + unfold reducible in *. naive_solver eauto using fill_step. } iNext; iIntros (e2 σ2 efs Hstep). destruct (fill_step_inv e σ1 e2 σ2 efs) as (e2'&->&?); auto. iMod ("H" $! e2' σ2 efs with "[//]") as "($ & H & $)". by iApply "IH". Qed. -Lemma wp_bind_inv K `{!LanguageCtx K} E e Φ : - WP K e @ E {{ Φ }} ⊢ WP e @ E {{ v, WP K (of_val v) @ E {{ Φ }} }}. +Lemma wp_bind_inv K `{!LanguageCtx K} s E e Φ : + WP K e @ s; E {{ Φ }} ⊢ WP e @ s; E {{ v, WP K (of_val v) @ s; E {{ Φ }} }}. Proof. iIntros "H". iLöb as "IH" forall (E e Φ). rewrite !wp_unfold /wp_pre. destruct (to_val e) as [v|] eqn:He. { apply of_to_val in He as <-. by rewrite !wp_unfold /wp_pre. } rewrite fill_not_val //. iIntros (σ1) "Hσ". iMod ("H" with "[$]") as "[% H]". iModIntro; iSplit. - { eauto using reducible_fill. } + { destruct s; eauto using reducible_fill. } iNext; iIntros (e2 σ2 efs Hstep). iMod ("H" $! (K e2) σ2 efs with "[]") as "($ & H & $)"; eauto using fill_step. by iApply "IH". Qed. (** * Derived rules *) -Lemma wp_mono E e Φ Ψ : (∀ v, Φ v ⊢ Ψ v) → WP e @ E {{ Φ }} ⊢ WP e @ E {{ Ψ }}. +Lemma wp_mono s E e Φ Ψ : (∀ v, Φ v ⊢ Ψ v) → WP e @ s; E {{ Φ }} ⊢ WP e @ s; E {{ Ψ }}. Proof. - iIntros (HΦ) "H"; iApply (wp_strong_mono E E); auto. + iIntros (HΦ) "H"; iApply (wp_strong_mono s E E); auto. iIntros "{$H}" (v) "?". by iApply HΦ. Qed. -Lemma wp_mask_mono E1 E2 e Φ : E1 ⊆ E2 → WP e @ E1 {{ Φ }} ⊢ WP e @ E2 {{ Φ }}. -Proof. iIntros (?) "H"; iApply (wp_strong_mono E1 E2); auto. iFrame; eauto. Qed. -Global Instance wp_mono' E e : - Proper (pointwise_relation _ (⊢) ==> (⊢)) (@wp Λ Σ _ E e). +Lemma wp_stuck_mono s1 s2 E e Φ : + s1 ⊑ s2 → WP e @ s1; E {{ Φ }} ⊢ WP e @ s2; E {{ Φ }}. +Proof. case: s1; case: s2 => // _. exact: wp_stuck_weaken. Qed. +Lemma wp_mask_mono s E1 E2 e Φ : E1 ⊆ E2 → WP e @ s; E1 {{ Φ }} ⊢ WP e @ s; E2 {{ Φ }}. +Proof. iIntros (?) "H"; iApply (wp_strong_mono s E1 E2); auto. iFrame; eauto. Qed. +Global Instance wp_mono' s E e : + Proper (pointwise_relation _ (⊢) ==> (⊢)) (@wp Λ Σ _ s E e). Proof. by intros Φ Φ' ?; apply wp_mono. Qed. -Lemma wp_value E Φ e v `{!IntoVal e v} : Φ v ⊢ WP e @ E {{ Φ }}. +Lemma wp_value s E Φ e v `{!IntoVal e v} : Φ v ⊢ WP e @ s; E {{ Φ }}. Proof. intros; rewrite -(of_to_val e v) //; by apply wp_value'. Qed. -Lemma wp_value_fupd' E Φ v : (|={E}=> Φ v) ⊢ WP of_val v @ E {{ Φ }}. +Lemma wp_value_fupd' s E Φ v : (|={E}=> Φ v) ⊢ WP of_val v @ s; E {{ Φ }}. Proof. intros. by rewrite -wp_fupd -wp_value'. Qed. -Lemma wp_value_fupd E Φ e v `{!IntoVal e v} : (|={E}=> Φ v) ⊢ WP e @ E {{ Φ }}. +Lemma wp_value_fupd s E Φ e v `{!IntoVal e v} : + (|={E}=> Φ v) ⊢ WP e @ s; E {{ Φ }}. Proof. intros. rewrite -wp_fupd -wp_value //. Qed. -Lemma wp_frame_l E e Φ R : R ∗ WP e @ E {{ Φ }} ⊢ WP e @ E {{ v, R ∗ Φ v }}. -Proof. iIntros "[??]". iApply (wp_strong_mono E E _ Φ); try iFrame; eauto. Qed. -Lemma wp_frame_r E e Φ R : WP e @ E {{ Φ }} ∗ R ⊢ WP e @ E {{ v, Φ v ∗ R }}. -Proof. iIntros "[??]". iApply (wp_strong_mono E E _ Φ); try iFrame; eauto. Qed. +Lemma wp_frame_l s E e Φ R : R ∗ WP e @ s; E {{ Φ }} ⊢ WP e @ s; E {{ v, R ∗ Φ v }}. +Proof. iIntros "[??]". iApply (wp_strong_mono s E E _ Φ); try iFrame; eauto. Qed. +Lemma wp_frame_r s E e Φ R : WP e @ s; E {{ Φ }} ∗ R ⊢ WP e @ s; E {{ v, Φ v ∗ R }}. +Proof. iIntros "[??]". iApply (wp_strong_mono s E E _ Φ); try iFrame; eauto. Qed. -Lemma wp_frame_step_l E1 E2 e Φ R : +Lemma wp_frame_step_l s E1 E2 e Φ R : to_val e = None → E2 ⊆ E1 → - (|={E1,E2}â–·=> R) ∗ WP e @ E2 {{ Φ }} ⊢ WP e @ E1 {{ v, R ∗ Φ v }}. + (|={E1,E2}â–·=> R) ∗ WP e @ s; E2 {{ Φ }} ⊢ WP e @ s; E1 {{ v, R ∗ Φ v }}. Proof. iIntros (??) "[Hu Hwp]". iApply (wp_step_fupd with "Hu"); try done. iApply (wp_mono with "Hwp"). by iIntros (?) "$$". Qed. -Lemma wp_frame_step_r E1 E2 e Φ R : +Lemma wp_frame_step_r s E1 E2 e Φ R : to_val e = None → E2 ⊆ E1 → - WP e @ E2 {{ Φ }} ∗ (|={E1,E2}â–·=> R) ⊢ WP e @ E1 {{ v, Φ v ∗ R }}. + WP e @ s; E2 {{ Φ }} ∗ (|={E1,E2}â–·=> R) ⊢ WP e @ s; E1 {{ v, Φ v ∗ R }}. Proof. - rewrite [(WP _ @ _ {{ _ }} ∗ _)%I]comm; setoid_rewrite (comm _ _ R). + rewrite [(WP _ @ _; _ {{ _ }} ∗ _)%I]comm; setoid_rewrite (comm _ _ R). apply wp_frame_step_l. Qed. -Lemma wp_frame_step_l' E e Φ R : - to_val e = None → â–· R ∗ WP e @ E {{ Φ }} ⊢ WP e @ E {{ v, R ∗ Φ v }}. -Proof. iIntros (?) "[??]". iApply (wp_frame_step_l E E); try iFrame; eauto. Qed. -Lemma wp_frame_step_r' E e Φ R : - to_val e = None → WP e @ E {{ Φ }} ∗ â–· R ⊢ WP e @ E {{ v, Φ v ∗ R }}. -Proof. iIntros (?) "[??]". iApply (wp_frame_step_r E E); try iFrame; eauto. Qed. - -Lemma wp_wand E e Φ Ψ : - WP e @ E {{ Φ }} -∗ (∀ v, Φ v -∗ Ψ v) -∗ WP e @ E {{ Ψ }}. +Lemma wp_frame_step_l' s E e Φ R : + to_val e = None → â–· R ∗ WP e @ s; E {{ Φ }} ⊢ WP e @ s; E {{ v, R ∗ Φ v }}. +Proof. iIntros (?) "[??]". iApply (wp_frame_step_l s E E); try iFrame; eauto. Qed. +Lemma wp_frame_step_r' s E e Φ R : + to_val e = None → WP e @ s; E {{ Φ }} ∗ â–· R ⊢ WP e @ s; E {{ v, Φ v ∗ R }}. +Proof. iIntros (?) "[??]". iApply (wp_frame_step_r s E E); try iFrame; eauto. Qed. + +Lemma wp_wand s E e Φ Ψ : + WP e @ s; E {{ Φ }} -∗ (∀ v, Φ v -∗ Ψ v) -∗ WP e @ s; E {{ Ψ }}. Proof. - iIntros "Hwp H". iApply (wp_strong_mono E); auto. + iIntros "Hwp H". iApply (wp_strong_mono s E); auto. iIntros "{$Hwp}" (?) "?". by iApply "H". Qed. -Lemma wp_wand_l E e Φ Ψ : - (∀ v, Φ v -∗ Ψ v) ∗ WP e @ E {{ Φ }} ⊢ WP e @ E {{ Ψ }}. +Lemma wp_wand_l s E e Φ Ψ : + (∀ v, Φ v -∗ Ψ v) ∗ WP e @ s; E {{ Φ }} ⊢ WP e @ s; E {{ Ψ }}. Proof. iIntros "[H Hwp]". iApply (wp_wand with "Hwp H"). Qed. -Lemma wp_wand_r E e Φ Ψ : - WP e @ E {{ Φ }} ∗ (∀ v, Φ v -∗ Ψ v) ⊢ WP e @ E {{ Ψ }}. +Lemma wp_wand_r s E e Φ Ψ : + WP e @ s; E {{ Φ }} ∗ (∀ v, Φ v -∗ Ψ v) ⊢ WP e @ s; E {{ Ψ }}. Proof. iIntros "[Hwp H]". iApply (wp_wand with "Hwp H"). Qed. End wp. @@ -267,25 +377,25 @@ Section proofmode_classes. Implicit Types P Q : iProp Σ. Implicit Types Φ : val Λ → iProp Σ. - Global Instance frame_wp p E e R Φ Ψ : - (∀ v, Frame p R (Φ v) (Ψ v)) → Frame p R (WP e @ E {{ Φ }}) (WP e @ E {{ Ψ }}). + Global Instance frame_wp p s E e R Φ Ψ : + (∀ v, Frame p R (Φ v) (Ψ v)) → Frame p R (WP e @ s; E {{ Φ }}) (WP e @ s; E {{ Ψ }}). Proof. rewrite /Frame=> HR. rewrite wp_frame_l. apply wp_mono, HR. Qed. - Global Instance is_except_0_wp E e Φ : IsExcept0 (WP e @ E {{ Φ }}). + Global Instance is_except_0_wp s E e Φ : IsExcept0 (WP e @ s; E {{ Φ }}). Proof. by rewrite /IsExcept0 -{2}fupd_wp -except_0_fupd -fupd_intro. Qed. - Global Instance elim_modal_bupd_wp E e P Φ : - ElimModal (|==> P) P (WP e @ E {{ Φ }}) (WP e @ E {{ Φ }}). + Global Instance elim_modal_bupd_wp s E e P Φ : + ElimModal (|==> P) P (WP e @ s; E {{ Φ }}) (WP e @ s; E {{ Φ }}). Proof. by rewrite /ElimModal (bupd_fupd E) fupd_frame_r wand_elim_r fupd_wp. Qed. - Global Instance elim_modal_fupd_wp E e P Φ : - ElimModal (|={E}=> P) P (WP e @ E {{ Φ }}) (WP e @ E {{ Φ }}). + Global Instance elim_modal_fupd_wp s E e P Φ : + ElimModal (|={E}=> P) P (WP e @ s; E {{ Φ }}) (WP e @ s; E {{ Φ }}). Proof. by rewrite /ElimModal fupd_frame_r wand_elim_r fupd_wp. Qed. (* lower precedence, if possible, it should persistently pick elim_upd_fupd_wp *) - Global Instance elim_modal_fupd_wp_atomic E1 E2 e P Φ : - Atomic e → + Global Instance elim_modal_fupd_wp_atomic s E1 E2 e P Φ : + Atomic (stuckness_to_atomicity s) e → ElimModal (|={E1,E2}=> P) P - (WP e @ E1 {{ Φ }}) (WP e @ E2 {{ v, |={E2,E1}=> Φ v }})%I | 100. + (WP e @ s; E1 {{ Φ }}) (WP e @ s; E2 {{ v, |={E2,E1}=> Φ v }})%I | 100. Proof. intros. by rewrite /ElimModal fupd_frame_r wand_elim_r wp_atomic. Qed. End proofmode_classes. diff --git a/theories/proofmode/tactics.v b/theories/proofmode/tactics.v index 5de1b0792efeb5cade2dcee2a03eeadc2935e9a4..67a5e6d621bcb457e73dd2fb59c22dcb9031b155 100644 --- a/theories/proofmode/tactics.v +++ b/theories/proofmode/tactics.v @@ -448,7 +448,7 @@ Local Tactic Notation "iSpecializePat" open_constr(H) constr(pat) := lazymatch pats with | [] => idtac | SForall :: ?pats => - idtac "the * specialization pattern is deprecated because it is applied implicitly"; + idtac "[IPM] The * specialization pattern is deprecated because it is applied implicitly."; go H1 pats | SIdent ?H2 :: ?pats => eapply tac_specialize with _ _ H2 _ H1 _ _ _ _; (* (j:=H1) (i:=H2) *) diff --git a/theories/tests/heap_lang.v b/theories/tests/heap_lang.v index 6c6cb5072e6c79f64f29d69146ded474c0e2c76f..48414dd253f6f0c7188c6a22d01d5c1948fc9311 100644 --- a/theories/tests/heap_lang.v +++ b/theories/tests/heap_lang.v @@ -20,7 +20,7 @@ Section LiftingTests. end. Qed. - Definition heap_e : expr := + Definition heap_e : expr := let: "x" := ref #1 in "x" <- !"x" + #1 ;; !"x". Lemma heap_e_spec E : WP heap_e @ E {{ v, ⌜v = #2⌠}}%I. @@ -62,6 +62,15 @@ Section LiftingTests. wp_alloc l''. wp_let. by repeat wp_load. Qed. + Definition heap_e5 : expr := + let: "x" := ref (ref #1) in FAA (!"x") (#10 + #1) + ! !"x". + + Lemma heap_e5_spec E : WP heap_e5 @ E {{ v, ⌜v = #13⌠}}%I. + Proof. + rewrite /heap_e5. wp_alloc l. wp_alloc l'. wp_let. + wp_load. wp_op. wp_faa. do 2 wp_load. wp_op. done. + Qed. + Definition FindPred : val := rec: "pred" "x" "y" := let: "yp" := "y" + #1 in @@ -96,5 +105,5 @@ Section LiftingTests. Proof. iIntros "". wp_apply Pred_spec. wp_let. by wp_apply Pred_spec. Qed. End LiftingTests. -Lemma heap_e_adequate σ : adequate heap_e σ (= #2). +Lemma heap_e_adequate σ : adequate NotStuck heap_e σ (= #2). Proof. eapply (heap_adequacy heapΣ)=> ?. by apply heap_e_spec. Qed. diff --git a/theories/tests/ipm_paper.v b/theories/tests/ipm_paper.v index 6834c5c5e3928fd626f706c6eda0a8daf90d433e..38ad33dc6008a9b944c4cbde62ae79efa1be00d9 100644 --- a/theories/tests/ipm_paper.v +++ b/theories/tests/ipm_paper.v @@ -101,7 +101,7 @@ update modalities (which we did not cover in the paper). Normally we use these mask changing update modalities directly in our proofs, but in this file we use the first prove the rule as a lemma, and then use that. *) Lemma wp_inv_open `{irisG Λ Σ} N E P e Φ : - nclose N ⊆ E → Atomic e → + nclose N ⊆ E → Atomic WeaklyAtomic e → inv N P ∗ (â–· P -∗ WP e @ E ∖ ↑N {{ v, â–· P ∗ Φ v }}) ⊢ WP e @ E {{ Φ }}. Proof. iIntros (??) "[#Hinv Hwp]".