├── .github └── workflows │ └── docker-action.yml ├── .gitignore ├── LICENSE ├── Makefile ├── PROOF_ENGINEERING.md ├── README.md ├── STYLE.md ├── _CoqProject ├── coq-verdi.opam ├── dune-project ├── meta.yml ├── script ├── extract_record_notation.py ├── find-bad-imports.sh ├── find-unused-imports.sh ├── orphaned-imports.awk └── time-coqc.sh └── theories ├── Core ├── DupDropReordering.v ├── DynamicNetLemmas.v ├── GhostSimulations.v ├── HandlerMonad.v ├── InverseTraceRelations.v ├── LabeledNet.v ├── NameOverlay.v ├── Net.v ├── PartialExtendedMapSimulations.v ├── PartialMapExecutionSimulations.v ├── PartialMapSimulations.v ├── SingleSimulations.v ├── StateMachineHandlerMonad.v ├── StatePacketPacketDecomposition.v ├── TotalMapExecutionSimulations.v ├── TotalMapSimulations.v ├── TraceRelations.v ├── Verdi.v └── VerdiHints.v ├── Extraction ├── ExtrOcamlBasicExt.v ├── ExtrOcamlBool.v ├── ExtrOcamlDiskOp.v ├── ExtrOcamlFinInt.v ├── ExtrOcamlList.v └── ExtrOcamlNatIntExt.v ├── Lib ├── FMapVeryWeak.v └── Ssrexport.v ├── Systems ├── Counter.v ├── LiveLockServ.v ├── LockServ.v ├── LockServSeqNum.v ├── Log.v ├── LogCorrect.v ├── PrimaryBackup.v ├── SeqNum.v ├── SeqNumCorrect.v ├── SerializedMsgParams.v ├── SerializedMsgParamsCorrect.v ├── VarD.v └── VarDPrimaryBackup.v └── dune /.github/workflows/docker-action.yml: -------------------------------------------------------------------------------- 1 | # This file was generated from `meta.yml`, please do not edit manually. 2 | # Follow the instructions on https://github.com/coq-community/templates to regenerate. 3 | name: Docker CI 4 | 5 | on: 6 | push: 7 | branches: 8 | - master 9 | pull_request: 10 | branches: 11 | - '**' 12 | 13 | jobs: 14 | build: 15 | # the OS must be GNU/Linux to be able to use the docker-coq-action 16 | runs-on: ubuntu-latest 17 | strategy: 18 | matrix: 19 | image: 20 | - 'coqorg/coq:dev' 21 | - 'coqorg/coq:8.18' 22 | - 'coqorg/coq:8.17' 23 | - 'coqorg/coq:8.16' 24 | - 'coqorg/coq:8.15' 25 | - 'coqorg/coq:8.14' 26 | fail-fast: false 27 | steps: 28 | - uses: actions/checkout@v3 29 | - uses: coq-community/docker-coq-action@v1 30 | with: 31 | opam_file: 'coq-verdi.opam' 32 | custom_image: ${{ matrix.image }} 33 | before_install: | 34 | startGroup "Setup and print opam config" 35 | opam repo -a --set-default add coq-extra-dev https://coq.inria.fr/opam/extra-dev 36 | opam config list; opam repo list; opam list 37 | endGroup 38 | 39 | 40 | # See also: 41 | # https://github.com/coq-community/docker-coq-action#readme 42 | # https://github.com/erikmd/docker-coq-github-action-demo 43 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.vo 2 | *.glob 3 | *.v.d 4 | *.buildtime 5 | Makefile.coq 6 | Makefile.coq.bak 7 | Makefile.coq.conf 8 | .Makefile.coq.d 9 | *~ 10 | .coq-native/ 11 | *.aux 12 | *.vio 13 | *.vos 14 | *.vok 15 | *.pyc 16 | .coqdeps.d 17 | .lia.cache 18 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014-2019, Verdi Team 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are 6 | met: 7 | 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | 2. Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 16 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 17 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 18 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 19 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 20 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 21 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 22 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 23 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 24 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 25 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: Makefile.coq 2 | @+$(MAKE) -f Makefile.coq all 3 | 4 | clean: Makefile.coq 5 | @+$(MAKE) -f Makefile.coq cleanall 6 | @rm -f Makefile.coq Makefile.coq.conf 7 | 8 | Makefile.coq: _CoqProject 9 | $(COQBIN)coq_makefile -f _CoqProject -o Makefile.coq 10 | 11 | force _CoqProject Makefile: ; 12 | 13 | %: Makefile.coq force 14 | @+$(MAKE) -f Makefile.coq $@ 15 | 16 | .PHONY: all clean force 17 | -------------------------------------------------------------------------------- /PROOF_ENGINEERING.md: -------------------------------------------------------------------------------- 1 | * make all proofs robust against changes in hypothesis names and 2 | ordering. the effort to do so will be more than made up for as you 3 | change your theorem statements. 4 | * don't say `P -> A /\ B` but instead say `(P -> A) /\ (P -> B)`, even 5 | if `P` is long (in which case maybe you should give it a name/notation). this 6 | makes automatic backwards reasoning easier. 7 | * don't say `P <-> Q` but instead say `(P -> Q) /\ (Q -> P)` even if `P` 8 | and `Q` are long (give them names/notations). this is also for 9 | backwards reasoning. 10 | * when deciding hypothesis order `P -> Q -> R`, place most restrictive 11 | hypothesis first. this helps because it reduces the chance that 12 | eauto will infer the wrong thing satisfying `P` but not `Q`. 13 | * obvious truism: constantly throw exploratory proofs away. it's 14 | not enough to play the video game until QED, produce a maintainable 15 | proof that liberally uses lemmas and tactics. 16 | * whenever possible, define complete "eliminator" lemmas for the facts 17 | you need to reason about. for example, `foo x = true -> P x /\ Q x` 18 | where `P` and `Q` is "all the information" contained in `foo x = 19 | true`. Do this instead of (or in addition to) proving `foo x = true 20 | -> P x` and `foo x = true -> Q x` because the complete eliminator 21 | avoids the need to manage the context in the common case: since the 22 | eliminator is complete, it is always safe to apply it. 23 | * eliminator lemmas don't work well with backwards reasoning. so it is 24 | common to reason forward with them. thus, for each commonly used 25 | eliminator lemma `foo_elim : foo x = true -> P x /\ Q x` , define a 26 | corresponding `do_foo_elim` tactic of the form 27 | ```coq 28 | match goal with 29 | | [ H : foo _ = true |- _ ] => apply foo_elim in H; break_and 30 | end. 31 | ``` 32 | * if necessary/convenient, use a general `elim` tactic that calls all 33 | your elimination tactics. 34 | * TEST THINGS. Verifying software is hard and verifying incorrect 35 | software is impossible, so any time spent finding bugs before starting to 36 | prove stuff will pay dividends down the road. 37 | * each lemma should unfold only one thing. think of this like the 38 | standard software engineering practice of hiding implementation 39 | details. this leads to somewhat longer proof developments, but they 40 | are much more robust to definition change. 41 | * avoid simpl-ing non-trivial definitions. a common anti-pattern: 42 | `simpl in *; repeat break_match; ...` this can be very convenient 43 | for exploratory proofs, but is generally unmaintainable and has 44 | horrible performance. instead, prove all the definitional equalities 45 | you need propositionally as lemmas. another option is to prove a 46 | high-level "definition" lemma, which is usually a big or of ands 47 | that does all the case analysis for you at once. this is much more 48 | efficient and maintainable. 49 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 5 | # Verdi 6 | 7 | [![Docker CI][docker-action-shield]][docker-action-link] 8 | 9 | [docker-action-shield]: https://github.com/uwplse/verdi/actions/workflows/docker-action.yml/badge.svg?branch=master 10 | [docker-action-link]: https://github.com/uwplse/verdi/actions/workflows/docker-action.yml 11 | 12 | 13 | 14 | 15 | Verdi is a Coq framework to implement and formally verify distributed systems. 16 | Verdi supports several different fault models ranging from idealistic to realistic. 17 | Verdi's verified system transformers (VSTs) encapsulate common fault tolerance 18 | techniques. Developers can verify an application in an idealized fault model, and 19 | then apply a VST to obtain an application that is guaranteed to have analogous 20 | properties in a more adversarial environment. 21 | 22 | ## Meta 23 | 24 | - Author(s): 25 | - Justin Adsuara 26 | - Steve Anton 27 | - Ryan Doenges 28 | - Karl Palmskog 29 | - Pavel Panchekha 30 | - Zachary Tatlock 31 | - James R. Wilcox 32 | - Doug Woos 33 | - License: [BSD 2-Clause "Simplified" license](LICENSE) 34 | - Compatible Coq versions: 8.14 or later 35 | - Additional dependencies: 36 | - [InfSeqExt](https://github.com/DistributedComponents/InfSeqExt) 37 | - [StructTact](https://github.com/uwplse/StructTact) 38 | - [Cheerios](https://github.com/uwplse/cheerios) 39 | - Coq namespace: `Verdi` 40 | - Related publication(s): 41 | - [Verdi: A Framework for Implementing and Verifying Distributed Systems](https://homes.cs.washington.edu/~mernst/pubs/verify-distsystem-pldi2015.pdf) doi:[10.1145/2737924.2737958](https://doi.org/10.1145/2737924.2737958) 42 | - [Planning for Change in a Formal Verification of the Raft Consensus Protocol](https://homes.cs.washington.edu/~mernst/pubs/raft-proof-cpp2016.pdf) doi:[10.1145/2854065.2854081](https://doi.org/10.1145/2854065.2854081) 43 | 44 | ## Building and installation instructions 45 | 46 | We recommend installing Verdi via [opam](http://opam.ocaml.org/doc/Install.html), 47 | which will automatically build and install its dependencies: 48 | ```shell 49 | opam repo add coq-extra-dev https://coq.inria.fr/opam/extra-dev 50 | opam install coq-verdi 51 | ``` 52 | 53 | To build Verdi manually, first install all requirements. Then, 54 | run `make` in the Verdi root directory. This will compile 55 | the framework's core specifications and proofs, as well as some 56 | simple example systems and their correctness proofs. 57 | 58 | To run Verdi systems on real hardware, event handler code must be extracted 59 | to OCaml and linked with one of the shims in the Verdi 60 | [runtime library](https://github.com/DistributedComponents/verdi-runtime) 61 | that handles low-level network communication. 62 | 63 | ## Documentation 64 | 65 | To set up your own Verdi-based distributed systems verification project, we 66 | recommend basing it on 67 | [Verdi LockServ](https://github.com/DistributedComponents/verdi-lockserv). 68 | 69 | Verdi LockServ contains a minimalistic implementation of a message-passing 70 | lock server and a proof that it maintains mutual exclusion between client 71 | nodes. At build time, extracted OCaml code is linked to a runtime library 72 | shim to produce an executable program that can be run in a cluster. There 73 | is also a simple script to interface with cluster nodes. 74 | 75 | In addition to the example verified systems listed below, see the 76 | scientific papers and blog posts listed at the 77 | [Verdi website](http://verdi.uwplse.org). See also 78 | [Verdi Raft](https://github.com/uwplse/verdi-raft), a verified 79 | implementation of the Raft distributed consensus protocol. 80 | 81 | ### Files 82 | 83 | - Core Verdi files: 84 | - `Verdi.v`: exporting of core Verdi theories, imported by systems 85 | - `Net.v`: core (unlabeled) network semantics 86 | - `LabeledNet.v`: labeled network semantics, for use in liveness reasoning 87 | - `HandlerMonad.v`: a monad for writing network/input handlers 88 | - `StatePacketPacket.v`: a technique for writing easily decomposable 89 | invariants 90 | - Example systems: 91 | - `Counter.v`: counting server with backup 92 | - `LockServ.v`: lock server with proof of safety 93 | - `LiveLockServ.v`: lock server with proof of liveness 94 | - `VarD.v`: `vard`, a key-value store 95 | - Verified system transformers: 96 | - `SeqNum.v` and `SeqNumCorrect.v`, a system transformer implementing sequence numbering 97 | - `LockServSeqNum.v`, the sequence numbering transformer applied to the lock server 98 | - `PrimaryBackup.v`, a system transformer implementing asynchronous primary-backup replication 99 | - `VarDPrimaryBackup.v`, the primary-backup transformer applied to the key-value store 100 | -------------------------------------------------------------------------------- /STYLE.md: -------------------------------------------------------------------------------- 1 | Filenames 2 | ======== 3 | 4 | * CamlCase for Coq files, example: `StateMachineHandlerMonad.v` 5 | * CamlCase for OCaml files, example: `VarDArrangement.ml` 6 | * lowercase with dashes for scripts, example: `proof-linter.sh` 7 | * UPPERCASE with underscores for documentation, example: `PROOF_ENGINEERING.md` 8 | 9 | Coq Files 10 | ========= 11 | 12 | Sections 13 | -------- 14 | 15 | * CamlCase name, example: `Section StepRelations.` 16 | * indentation of two spaces for all code inside a section 17 | 18 | Type Classes 19 | ------------ 20 | 21 | * CamlCase name 22 | * brackets on separate line indented by two spaces 23 | * field declaration with C-style naming on separate line indented by four spaces 24 | * one space between end of field declaration and semicolon 25 | 26 | Example: 27 | ```coq 28 | Class GhostFailureParams `(P : FailureParams) := 29 | { 30 | ghost_data : Type; 31 | ghost_init : ghost_data ; 32 | ghost_net_handlers : 33 | name -> name -> msg -> (ghost_data * data) -> ghost_data ; 34 | ghost_input_handlers : 35 | name -> input -> (ghost_data * data) -> ghost_data 36 | }. 37 | ``` 38 | 39 | Type Class Instances 40 | -------------------- 41 | 42 | * C-style names 43 | * brackets on separate line indented by two spaces 44 | * field declaration with C-style naming on separate line indented by four spaces 45 | * one space between end of field declaration and semicolon 46 | 47 | Example: 48 | ```coq 49 | Instance base_params : BaseParams := 50 | { 51 | data := raft_data ; 52 | input := raft_input ; 53 | output := raft_output 54 | }. 55 | ``` 56 | 57 | Theorems and Lemmas 58 | ------------------- 59 | 60 | * name uses underscore as separator 61 | * type declaration starts on a separate row 62 | * no unnecessary type declarations for quantified variables 63 | * line break after implication arrow 64 | * proof script indented by two spaces 65 | 66 | Example: 67 | ```coq 68 | Theorem inverse_trace_relations_work : 69 | forall s tr, 70 | refl_trans_1n_trace step init s tr -> 71 | R s -> 72 | T tr. 73 | Proof. 74 | intros. find_apply_lem_hyp refl_trans_1n_n1_trace. 75 | remember init as s'. 76 | induction H. 77 | - subst. exfalso. eauto using R_false_init. 78 | - subst. concludes. 79 | destruct (R_dec x'); 80 | intuition eauto using T_monotonic, refl_trans_n1_1n_trace, R_implies_T. 81 | Qed. 82 | ``` 83 | 84 | Step Relation Definitions 85 | ------------------------- 86 | 87 | * C-style name of (`Inductive`) type 88 | * each case starts with a bar 89 | * name of a case is the type name in CamelCase, followed by an underscore and a C-style identifier 90 | * body of a case is indented by four spaces 91 | 92 | Example: 93 | ```coq 94 | Inductive step_async : step_relation network (name * (input + list output)) := 95 | | StepAsync_deliver : forall net net' p xs ys out d l, 96 | nwPackets net = xs ++ p :: ys -> 97 | net_handlers (pDst p) (pSrc p) (pBody p) (nwState net (pDst p)) = (out, d, l) -> 98 | net' = mkNetwork (send_packets (pDst p) l ++ xs ++ ys) 99 | (update name_eq_dec (nwState net) (pDst p) d) -> 100 | step_async net net' [(pDst p, inr out)] 101 | | StepAsync_input : forall h net net' out inp d l, 102 | input_handlers h inp (nwState net h) = (out, d, l) -> 103 | net' = mkNetwork (send_packets h l ++ nwPackets net) 104 | (update name_eq_dec (nwState net) h d) -> 105 | step_async net net' [(h, inl inp); (h, inr out)]. 106 | ``` 107 | -------------------------------------------------------------------------------- /_CoqProject: -------------------------------------------------------------------------------- 1 | -Q theories Verdi 2 | 3 | theories/Core/NameOverlay.v 4 | theories/Core/DynamicNetLemmas.v 5 | theories/Core/Net.v 6 | theories/Core/HandlerMonad.v 7 | theories/Core/Verdi.v 8 | theories/Core/StateMachineHandlerMonad.v 9 | theories/Core/InverseTraceRelations.v 10 | theories/Core/SingleSimulations.v 11 | theories/Core/PartialMapSimulations.v 12 | theories/Core/TotalMapExecutionSimulations.v 13 | theories/Core/VerdiHints.v 14 | theories/Core/DupDropReordering.v 15 | theories/Core/PartialMapExecutionSimulations.v 16 | theories/Core/GhostSimulations.v 17 | theories/Core/StatePacketPacketDecomposition.v 18 | theories/Core/TraceRelations.v 19 | theories/Core/LabeledNet.v 20 | theories/Core/TotalMapSimulations.v 21 | theories/Core/PartialExtendedMapSimulations.v 22 | 23 | theories/Lib/Ssrexport.v 24 | theories/Lib/FMapVeryWeak.v 25 | 26 | theories/Systems/Counter.v 27 | theories/Systems/SerializedMsgParams.v 28 | theories/Systems/PrimaryBackup.v 29 | theories/Systems/SerializedMsgParamsCorrect.v 30 | theories/Systems/LockServSeqNum.v 31 | theories/Systems/VarDPrimaryBackup.v 32 | theories/Systems/VarD.v 33 | theories/Systems/SeqNum.v 34 | theories/Systems/LiveLockServ.v 35 | theories/Systems/SeqNumCorrect.v 36 | theories/Systems/LockServ.v 37 | theories/Systems/Log.v 38 | theories/Systems/LogCorrect.v 39 | 40 | theories/Extraction/ExtrOcamlFinInt.v 41 | theories/Extraction/ExtrOcamlNatIntExt.v 42 | theories/Extraction/ExtrOcamlDiskOp.v 43 | theories/Extraction/ExtrOcamlBasicExt.v 44 | theories/Extraction/ExtrOcamlBool.v 45 | theories/Extraction/ExtrOcamlList.v 46 | -------------------------------------------------------------------------------- /coq-verdi.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "palmskog@gmail.com" 3 | version: "dev" 4 | 5 | homepage: "https://github.com/uwplse/verdi" 6 | dev-repo: "git+https://github.com/uwplse/verdi.git" 7 | bug-reports: "https://github.com/uwplse/verdi/issues" 8 | license: "BSD-2-Clause" 9 | 10 | synopsis: "Framework for verification of implementations of distributed systems in Coq" 11 | description: """ 12 | Verdi is a Coq framework to implement and formally verify distributed systems. 13 | Verdi supports several different fault models ranging from idealistic to realistic. 14 | Verdi's verified system transformers (VSTs) encapsulate common fault tolerance 15 | techniques. Developers can verify an application in an idealized fault model, and 16 | then apply a VST to obtain an application that is guaranteed to have analogous 17 | properties in a more adversarial environment.""" 18 | 19 | build: [make "-j%{jobs}%"] 20 | install: [make "install"] 21 | depends: [ 22 | "coq" {>= "8.14"} 23 | "coq-inf-seq-ext" {= "dev"} 24 | "coq-struct-tact" {= "dev"} 25 | "coq-cheerios" {= "dev"} 26 | ] 27 | 28 | tags: [ 29 | "category:Computer Science/Concurrent Systems and Protocols/Theory of concurrent systems" 30 | "keyword:program verification" 31 | "keyword:distributed algorithms" 32 | "logpath:Verdi" 33 | ] 34 | authors: [ 35 | "Justin Adsuara" 36 | "Steve Anton" 37 | "Ryan Doenges" 38 | "Karl Palmskog" 39 | "Pavel Panchekha" 40 | "Zachary Tatlock" 41 | "James R. Wilcox" 42 | "Doug Woos" 43 | ] 44 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.5) 2 | (using coq 0.6) 3 | (name verdi) 4 | -------------------------------------------------------------------------------- /meta.yml: -------------------------------------------------------------------------------- 1 | --- 2 | fullname: Verdi 3 | shortname: verdi 4 | opam_name: coq-verdi 5 | organization: uwplse 6 | community: false 7 | action: true 8 | dune: false 9 | coqdoc: false 10 | 11 | synopsis: Framework for verification of implementations of distributed systems in Coq 12 | 13 | description: |- 14 | Verdi is a Coq framework to implement and formally verify distributed systems. 15 | Verdi supports several different fault models ranging from idealistic to realistic. 16 | Verdi's verified system transformers (VSTs) encapsulate common fault tolerance 17 | techniques. Developers can verify an application in an idealized fault model, and 18 | then apply a VST to obtain an application that is guaranteed to have analogous 19 | properties in a more adversarial environment. 20 | 21 | publications: 22 | - pub_url: https://homes.cs.washington.edu/~mernst/pubs/verify-distsystem-pldi2015.pdf 23 | pub_title: 'Verdi: A Framework for Implementing and Verifying Distributed Systems' 24 | pub_doi: 10.1145/2737924.2737958 25 | - pub_url: https://homes.cs.washington.edu/~mernst/pubs/raft-proof-cpp2016.pdf 26 | pub_title: 'Planning for Change in a Formal Verification of the Raft Consensus Protocol' 27 | pub_doi: 10.1145/2854065.2854081 28 | 29 | authors: 30 | - name: Justin Adsuara 31 | - name: Steve Anton 32 | - name: Ryan Doenges 33 | - name: Karl Palmskog 34 | - name: Pavel Panchekha 35 | - name: Zachary Tatlock 36 | - name: James R. Wilcox 37 | - name: Doug Woos 38 | 39 | maintainers: 40 | - name: Karl Palmskog 41 | nickname: palmskog 42 | 43 | opam-file-maintainer: palmskog@gmail.com 44 | 45 | opam-file-version: dev 46 | 47 | license: 48 | fullname: BSD 2-Clause "Simplified" license 49 | identifier: BSD-2-Clause 50 | 51 | supported_coq_versions: 52 | text: 8.14 or later 53 | opam: '{>= "8.14"}' 54 | 55 | tested_coq_opam_versions: 56 | - version: dev 57 | - version: '8.18' 58 | - version: '8.17' 59 | - version: '8.16' 60 | - version: '8.15' 61 | - version: '8.14' 62 | 63 | dependencies: 64 | - opam: 65 | name: coq-inf-seq-ext 66 | version: '{= "dev"}' 67 | description: |- 68 | [InfSeqExt](https://github.com/DistributedComponents/InfSeqExt) 69 | - opam: 70 | name: coq-struct-tact 71 | version: '{= "dev"}' 72 | description: |- 73 | [StructTact](https://github.com/uwplse/StructTact) 74 | - opam: 75 | name: coq-cheerios 76 | version: '{= "dev"}' 77 | description: |- 78 | [Cheerios](https://github.com/uwplse/cheerios) 79 | 80 | ci_extra_dev: true 81 | 82 | namespace: Verdi 83 | 84 | keywords: 85 | - name: program verification 86 | - name: distributed algorithms 87 | 88 | categories: 89 | - name: Computer Science/Concurrent Systems and Protocols/Theory of concurrent systems 90 | 91 | build: |- 92 | ## Building and installation instructions 93 | 94 | We recommend installing Verdi via [opam](http://opam.ocaml.org/doc/Install.html), 95 | which will automatically build and install its dependencies: 96 | ```shell 97 | opam repo add coq-extra-dev https://coq.inria.fr/opam/extra-dev 98 | opam install coq-verdi 99 | ``` 100 | 101 | To build Verdi manually, first install all requirements. Then, 102 | run `make` in the Verdi root directory. This will compile 103 | the framework's core specifications and proofs, as well as some 104 | simple example systems and their correctness proofs. 105 | 106 | To run Verdi systems on real hardware, event handler code must be extracted 107 | to OCaml and linked with one of the shims in the Verdi 108 | [runtime library](https://github.com/DistributedComponents/verdi-runtime) 109 | that handles low-level network communication. 110 | 111 | documentation: |- 112 | ## Documentation 113 | 114 | To set up your own Verdi-based distributed systems verification project, we 115 | recommend basing it on 116 | [Verdi LockServ](https://github.com/DistributedComponents/verdi-lockserv). 117 | 118 | Verdi LockServ contains a minimalistic implementation of a message-passing 119 | lock server and a proof that it maintains mutual exclusion between client 120 | nodes. At build time, extracted OCaml code is linked to a runtime library 121 | shim to produce an executable program that can be run in a cluster. There 122 | is also a simple script to interface with cluster nodes. 123 | 124 | In addition to the example verified systems listed below, see the 125 | scientific papers and blog posts listed at the 126 | [Verdi website](http://verdi.uwplse.org). See also 127 | [Verdi Raft](https://github.com/uwplse/verdi-raft), a verified 128 | implementation of the Raft distributed consensus protocol. 129 | 130 | ### Files 131 | 132 | - Core Verdi files: 133 | - `Verdi.v`: exporting of core Verdi theories, imported by systems 134 | - `Net.v`: core (unlabeled) network semantics 135 | - `LabeledNet.v`: labeled network semantics, for use in liveness reasoning 136 | - `HandlerMonad.v`: a monad for writing network/input handlers 137 | - `StatePacketPacket.v`: a technique for writing easily decomposable 138 | invariants 139 | - Example systems: 140 | - `Counter.v`: counting server with backup 141 | - `LockServ.v`: lock server with proof of safety 142 | - `LiveLockServ.v`: lock server with proof of liveness 143 | - `VarD.v`: `vard`, a key-value store 144 | - Verified system transformers: 145 | - `SeqNum.v` and `SeqNumCorrect.v`, a system transformer implementing sequence numbering 146 | - `LockServSeqNum.v`, the sequence numbering transformer applied to the lock server 147 | - `PrimaryBackup.v`, a system transformer implementing asynchronous primary-backup replication 148 | - `VarDPrimaryBackup.v`, the primary-backup transformer applied to the key-value store 149 | --- 150 | -------------------------------------------------------------------------------- /script/extract_record_notation.py: -------------------------------------------------------------------------------- 1 | # This is the hackiest thing, but it will come in handy. 2 | 3 | import sys 4 | import re 5 | 6 | file_name = sys.argv[1] 7 | record_name = sys.argv[2] 8 | 9 | file = open(file_name).read() 10 | 11 | comment_regex = r'\(\*.*\*\)' 12 | record_regex = r'(Record %s.*\{(.*)\}\.)' % record_name 13 | record_sep = ';' 14 | field_name_regex = r'\s*(\w+)\s*:\s*' 15 | variable_regex = r'Variable ([^.]*)\.' 16 | 17 | n_variables = len(re.findall(variable_regex, file)) 18 | 19 | uncommented_file = re.sub(comment_regex, '', file) 20 | fields = re.search(record_regex, uncommented_file, re.DOTALL).group(2).split(record_sep) 21 | field_names = [re.match(field_name_regex, field).group(1) for field in fields] 22 | 23 | setters = "" 24 | notations = "" 25 | arguments = "" 26 | variables = ' _' * n_variables 27 | 28 | constructor_name = "mk" + record_name[0].upper() + record_name[1:] 29 | 30 | for field_name in field_names: 31 | setters += "\n\nDefinition set_%s_%s a v := %s" % (record_name,field_name,constructor_name) 32 | for fn in field_names: 33 | if fn == field_name: 34 | setters += " v" 35 | else: 36 | setters += " (%s a)" % fn 37 | setters += "." 38 | 39 | notations += "\n\nNotation \"{[ a 'with' '%s' := v ]}\" := (set_%s_%s %s a v)." % (field_name, record_name,field_name,variables) 40 | arguments += "\n\nArguments set_%s_%s %s/." % (record_name, field_name, " _" * (n_variables + 2)) 41 | 42 | setters += "\n" 43 | 44 | lines = file.split("\n") 45 | 46 | print "\n".join(lines[:-2]) 47 | print setters 48 | print "\n".join(lines[-2:]) 49 | print notations 50 | print arguments 51 | -------------------------------------------------------------------------------- /script/find-bad-imports.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | function find-line { 4 | DIR=$1; shift 5 | EXCLUDE_PATH_REGEX=$1; shift 6 | LINE=$1; shift 7 | 8 | find -E "$DIR" -name '*.v' \( -not -regex "$EXCLUDE_PATH_REGEX" \) -exec grep -Hni "$LINE" {} \+ 9 | } 10 | 11 | function find-redundant-imports { 12 | FILE_OF_IMPORTS=$1; shift 13 | EXCLUDE_PATH_REGEX=$1; shift 14 | 15 | sed -nE '/^[[:space:]]*(Require)?[[:space:]]+(Export)/p' "$FILE_OF_IMPORTS" | while read line 16 | do 17 | find-line "." "$EXCLUDE_PATH_REGEX" "${line//Export/Import}" 18 | done 19 | } 20 | 21 | echo "Looking for redundant imports." 22 | find-redundant-imports core/Verdi.v ".*/(core|lib)/.*" 23 | find-redundant-imports raft/Raft.v "(.*/(core|lib|systems)/.*)|(.*/Raft.v)" 24 | 25 | 26 | # Delete imports: 27 | # find . -proofs/ -name '*.v' \( -not -path '*/core/*' \) \ 28 | # -print -exec sed -ibak '/Require Import Net/d' {} \; 29 | 30 | echo "Looking for orphaned imports." 31 | find . -name '*.v' \( -not -path '*/lib/*' \) -exec awk -f script/orphaned-imports.awk {} \; 32 | -------------------------------------------------------------------------------- /script/find-unused-imports.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | function find_unused_imports_of_file { 4 | FILE=$1; shift 5 | 6 | echo "Considering file $FILE" 7 | 8 | cp "$FILE" "${FILE}.bak" 9 | N=0 10 | while read line 11 | do 12 | N=$((N+1)) 13 | echo "read line $N:" 14 | echo "$line" 15 | 16 | # We assume that all imports happen at the top of the file. 17 | # We allow blank lines and lines containing "Arguments" to be 18 | # contained in the imports section. 19 | if [[ "$line" =~ .*(Require|Import|Export|Arguments).*|^[[:space:]]*$ ]] 20 | then 21 | # Only check import statements for necessity, not blank 22 | # lines or Arguments commands. 23 | if [[ "$line" =~ .*(Require|Import|Export).* ]] 24 | then 25 | echo; echo; echo 26 | echo "Testing whether $line is necessary" 27 | 28 | sed -i "${N}d" "$FILE" 29 | 30 | TARGET="$(dirname $FILE)/$(basename $FILE .v).vo" 31 | rm -f "$TARGET" 32 | make -f Makefile.coq "$TARGET" 33 | exit_code=$? 34 | if [[ $exit_code -eq 0 ]] 35 | then 36 | echo "Build still passed with line $N removed from $FILE: " 37 | echo "$line" 38 | fi 39 | cp "${FILE}.bak" "$FILE" 40 | fi 41 | else 42 | break 43 | fi 44 | done < "$FILE.bak" 45 | rm -f "$FILE.bak" 46 | } 47 | 48 | git status | grep modified && { echo ERROR: working directory not clean; exit 1; } 49 | 50 | export -f find_unused_imports_of_file 51 | find . -name '*.v' -exec /bin/bash -c 'find_unused_imports_of_file "$0"' {} \; 52 | -------------------------------------------------------------------------------- /script/orphaned-imports.awk: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | importing = 1 3 | 4 | import_regex = "Require|Import|Export" 5 | } 6 | 7 | 8 | # many Verdi files contain an Arguments command in the middle of the imports 9 | # so we allow that here but do not count later occurences in the file 10 | # as violations of the "imports first" rule 11 | ! ($0 ~ import_regex || /Arguments/ || /^[[:space:]]*$/) { 12 | importing = 0 \ 13 | } 14 | 15 | $0 ~ import_regex { 16 | if (importing == 0) { 17 | printf("Orphaned import in %s!\n", FILENAME) 18 | printf("%s\n", $0) 19 | } 20 | } 21 | -------------------------------------------------------------------------------- /script/time-coqc.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | log=$1 4 | shift 5 | 6 | t0=$(date +"%s") 7 | coqc $@ 8 | t1=$(date +"%s") 9 | 10 | t=$(expr $t1 - $t0) 11 | for last; do true; done 12 | printf "%3d : %s\n" "$t" "$last" >> "$log" 13 | -------------------------------------------------------------------------------- /theories/Core/DupDropReordering.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import List Relations Permutation. 2 | From StructTact Require Import StructTactics. 3 | From Verdi Require Import Net. 4 | 5 | Import ListNotations. 6 | 7 | Section dup_drop_reorder. 8 | Variable A : Type. 9 | Hypothesis A_eq_dec : forall x y : A, {x = y} + {x <> y}. 10 | 11 | Inductive dup_drop_step : list A -> list A -> Prop := 12 | | DDS_dup : forall l p, 13 | In p l -> 14 | dup_drop_step l (p :: l) 15 | | DDS_drop : forall xs p ys, 16 | dup_drop_step (xs ++ p :: ys) (xs ++ ys). 17 | 18 | Definition dup_drop_step_star := clos_refl_trans_n1 _ dup_drop_step. 19 | 20 | Lemma dup_drop_step_star_trans : 21 | forall l l' l'', 22 | dup_drop_step_star l l' -> 23 | dup_drop_step_star l' l'' -> 24 | dup_drop_step_star l l''. 25 | Proof using. 26 | intros. 27 | apply clos_rt_rtn1_iff. 28 | eapply rt_trans; apply clos_rt_rtn1_iff; eauto. 29 | Qed. 30 | 31 | Lemma dup_drop_step_star_step_n1 : 32 | forall l l' l'', 33 | dup_drop_step_star l l' -> 34 | dup_drop_step l' l'' -> 35 | dup_drop_step_star l l''. 36 | Proof using. 37 | intros. 38 | econstructor; eauto. 39 | Qed. 40 | 41 | Lemma dup_drop_step_star_step_1n : 42 | forall l l' l'', 43 | dup_drop_step l l' -> 44 | dup_drop_step_star l' l'' -> 45 | dup_drop_step_star l l''. 46 | Proof using. 47 | intros. 48 | apply clos_rt_rtn1_iff. 49 | apply clos_rt_rt1n_iff. 50 | econstructor; [eauto|]. 51 | apply clos_rt_rt1n_iff. 52 | apply clos_rt_rtn1_iff. 53 | auto. 54 | Qed. 55 | 56 | Lemma dup_drop_step_star_step_1 : 57 | forall l l', 58 | dup_drop_step l l' -> 59 | dup_drop_step_star l l'. 60 | Proof using. 61 | intros. 62 | eapply dup_drop_step_star_step_1n; eauto. 63 | constructor. 64 | Qed. 65 | 66 | Lemma dup_drop_swap : 67 | forall l x y, 68 | dup_drop_step_star (x :: y :: l) (y :: x :: l). 69 | Proof using. 70 | intros. 71 | eapply dup_drop_step_star_step_1n; [eapply DDS_dup with (p := y); simpl; auto|]. 72 | eapply dup_drop_step_star_step_1n. 73 | eapply DDS_drop with (xs := [y; x]) (p := y) (ys := l). 74 | constructor. 75 | Qed. 76 | 77 | Lemma dup_drop_cons : 78 | forall l l' x, 79 | dup_drop_step_star l l' -> 80 | dup_drop_step_star (x :: l) (x :: l'). 81 | Proof using. 82 | induction 1. 83 | - constructor. 84 | - invc H. 85 | + eapply dup_drop_step_star_trans; [eauto|]. 86 | eapply dup_drop_step_star_step_1n; [eapply DDS_dup with (p := p); simpl; auto|]. 87 | auto using dup_drop_swap. 88 | + eapply dup_drop_step_star_trans; [eauto|]. 89 | eapply dup_drop_step_star_step_1n. 90 | eapply DDS_drop with (xs := x :: xs) (p := p) (ys := ys). 91 | constructor. 92 | Qed. 93 | 94 | Lemma dup_drop_Permutation : 95 | forall l l', 96 | Permutation l l' -> 97 | dup_drop_step_star l l'. 98 | Proof using. 99 | induction 1. 100 | - constructor. 101 | - auto using dup_drop_cons. 102 | - auto using dup_drop_swap. 103 | - eauto using dup_drop_step_star_trans. 104 | Qed. 105 | 106 | Lemma remove_not_in_nop : 107 | forall a l, 108 | ~ In a l -> 109 | remove A_eq_dec a l = l. 110 | Proof using. 111 | induction l; simpl; intuition. 112 | break_if; congruence. 113 | Qed. 114 | 115 | Lemma dup_drop_in : 116 | forall l l' a, 117 | dup_drop_step_star l l' -> 118 | In a l' -> 119 | In a l. 120 | Proof using. 121 | induction 1; intros. 122 | - auto. 123 | - invc H. 124 | + simpl in *. intuition. 125 | subst. auto. 126 | + apply IHclos_refl_trans_n1. 127 | find_apply_lem_hyp in_app_or. 128 | intuition auto with datatypes. 129 | Qed. 130 | 131 | Lemma dup_drop_dup_early : 132 | forall l l' a, 133 | dup_drop_step_star l l' -> 134 | In a l -> 135 | dup_drop_step_star l (a :: l'). 136 | Proof using. 137 | induction 1; intros. 138 | - apply dup_drop_step_star_step_1. constructor. auto. 139 | - concludes. 140 | eapply dup_drop_step_star_trans; eauto. 141 | apply dup_drop_cons. 142 | apply dup_drop_step_star_step_1. 143 | auto. 144 | Qed. 145 | 146 | Lemma dup_drop_step_star_remove_In : 147 | forall l' l a, 148 | In a l' -> 149 | dup_drop_step_star l (remove A_eq_dec a l') -> 150 | dup_drop_step_star (a :: l) l'. 151 | Proof using. 152 | induction l'; simpl; intuition. 153 | - subst. break_if; try congruence. 154 | destruct (in_dec A_eq_dec a0 l'). 155 | + find_apply_hyp_hyp. 156 | eapply dup_drop_step_star_trans; eauto. 157 | eapply dup_drop_step_star_step_1. 158 | apply DDS_dup; auto. 159 | + rewrite remove_not_in_nop in * by auto. 160 | apply dup_drop_cons. auto. 161 | - break_if. 162 | + subst. 163 | find_apply_hyp_hyp. 164 | eapply dup_drop_step_star_trans; eauto. 165 | eapply dup_drop_step_star_step_1. 166 | apply DDS_dup; auto. 167 | + pose proof dup_drop_in l _ a ltac:(eauto). 168 | try concludes. (* Only needed in Coq 8.5 *) 169 | eapply dup_drop_step_star_step_n1 in H0; [| eapply DDS_drop with (xs := [])]. 170 | simpl in *. 171 | apply IHl' in H0; auto. 172 | apply dup_drop_dup_early; auto. 173 | simpl. intuition. 174 | Qed. 175 | 176 | Lemma remove_In_elim : 177 | forall x a l, 178 | In x (remove A_eq_dec a l) -> 179 | x <> a /\ In x l. 180 | Proof using. 181 | induction l; simpl; intuition; break_if; subst; simpl in *; intuition. 182 | Qed. 183 | 184 | Lemma dup_drop_reorder : 185 | forall l l' : list A, 186 | (forall x, In x l' -> In x l) -> 187 | dup_drop_step_star l l'. 188 | Proof using A_eq_dec. 189 | induction l; intros. 190 | - destruct l'. 191 | + constructor. 192 | + simpl in *. exfalso. eauto. 193 | - destruct (in_dec A_eq_dec a l'). 194 | + eapply dup_drop_step_star_remove_In. auto. 195 | apply IHl. 196 | intros. 197 | find_apply_lem_hyp remove_In_elim. 198 | intuition. 199 | find_apply_hyp_hyp. 200 | simpl in *. intuition. 201 | exfalso. eauto. 202 | + eapply dup_drop_step_star_step_1n. 203 | eapply DDS_drop with (xs := []). 204 | apply IHl. 205 | simpl in *. intros. 206 | find_copy_apply_hyp_hyp. 207 | intuition. 208 | subst. exfalso. eauto. 209 | Qed. 210 | End dup_drop_reorder. 211 | 212 | Section step_failure_dup_drop_step. 213 | Context `{params : FailureParams}. 214 | 215 | Theorem step_failure_dup_drop_step : 216 | forall ps ps' Sigma f, 217 | dup_drop_step_star _ ps ps' -> 218 | step_failure_star (f, mkNetwork ps Sigma) (f, mkNetwork ps' Sigma) []. 219 | Proof using. 220 | induction 1. 221 | - constructor. 222 | - match goal with 223 | | [ H : dup_drop_step _ _ _ |- _ ] => invc H 224 | end. 225 | + find_apply_lem_hyp in_split. break_exists. break_and. subst. 226 | apply refl_trans_n1_1n_trace. 227 | eapply RTn1TStep with (cs := []). 228 | * apply refl_trans_1n_n1_trace. 229 | apply IHclos_refl_trans_n1. 230 | * eapply StepFailure_dup; [simpl; eauto|]. auto. 231 | + apply refl_trans_n1_1n_trace. 232 | eapply RTn1TStep with (cs := []). 233 | * apply refl_trans_1n_n1_trace. 234 | apply IHclos_refl_trans_n1. 235 | * eapply StepFailure_drop; [simpl; eauto|]. auto. 236 | Qed. 237 | End step_failure_dup_drop_step. 238 | -------------------------------------------------------------------------------- /theories/Core/DynamicNetLemmas.v: -------------------------------------------------------------------------------- 1 | From Verdi Require Import Verdi. 2 | From StructTact Require Import Update. 3 | From Coq Require Import FunctionalExtensionality. 4 | From Coq Require Import Sumbool Relation_Definitions RelationClasses. 5 | From Verdi Require Import Ssrexport. 6 | 7 | Set Implicit Arguments. 8 | 9 | Section DynamicNetLemmas. 10 | 11 | Context {base_params : BaseParams}. 12 | Context {multi_params : MultiParams base_params}. 13 | Context {overlay_params : NameOverlayParams multi_params}. 14 | Context {new_msg_params : NewMsgParams multi_params}. 15 | Context {fail_msg_params : FailMsgParams multi_params}. 16 | 17 | Lemma ordered_dynamic_uninitialized_state : 18 | forall net failed tr, 19 | step_ordered_dynamic_failure_star step_ordered_dynamic_failure_init (failed, net) tr -> 20 | forall n, ~ In n (odnwNodes net) -> 21 | odnwState net n = None. 22 | Proof using. 23 | move => net failed tr H. 24 | remember step_ordered_dynamic_failure_init as y in *. 25 | have ->: net = snd (failed, net) by []. 26 | move: Heqy. 27 | induction H using refl_trans_1n_trace_n1_ind => H_init /=; first by rewrite H_init. 28 | concludes => {H_init}. 29 | match goal with 30 | | [ H : step_ordered_dynamic_failure _ _ _ |- _ ] => invc H 31 | end; rewrite /=. 32 | - move => n H_in. 33 | rewrite /= in IHrefl_trans_1n_trace1. 34 | rewrite /update /=. 35 | have H_neq: h <> n by move => H_eq; case: H_in; left. 36 | have H_not_in: ~ In n (odnwNodes net0) by move => H_not_in; case: H_in; right. 37 | case name_eq_dec => H_dec; first by rewrite H_dec in H_neq. 38 | exact: IHrefl_trans_1n_trace1. 39 | - move => n H_in. 40 | rewrite /= in IHrefl_trans_1n_trace1. 41 | rewrite /update /=. 42 | have H_neq: n <> to by move => H_eq; rewrite H_eq in H_in. 43 | case name_eq_dec => H_dec //. 44 | exact: IHrefl_trans_1n_trace1. 45 | - move => n H_in. 46 | rewrite /= in IHrefl_trans_1n_trace1. 47 | rewrite /update. 48 | have H_neq: n <> h by move => H_eq; rewrite H_eq in H_in. 49 | case name_eq_dec => H_dec //. 50 | exact: IHrefl_trans_1n_trace1. 51 | - move => n H_in. 52 | rewrite /= in IHrefl_trans_1n_trace1. 53 | exact: IHrefl_trans_1n_trace1. 54 | Qed. 55 | 56 | Lemma ordered_dynamic_initialized_state : 57 | forall net failed tr, 58 | step_ordered_dynamic_failure_star step_ordered_dynamic_failure_init (failed, net) tr -> 59 | forall n, In n (odnwNodes net) -> 60 | exists d, odnwState net n = Some d. 61 | Proof using. 62 | move => net failed tr H. 63 | remember step_ordered_dynamic_failure_init as y in *. 64 | have ->: net = snd (failed, net) by []. 65 | move: Heqy. 66 | induction H using refl_trans_1n_trace_n1_ind => H_init /=; first by rewrite H_init. 67 | repeat find_rewrite. 68 | concludes => {H_init}. 69 | match goal with 70 | | [ H : step_ordered_dynamic_failure _ _ _ |- _ ] => invc H 71 | end; rewrite /=. 72 | - move => n H_in. 73 | case: H_in => H_in. 74 | rewrite -H_in /update. 75 | break_if => //. 76 | by exists (init_handlers h). 77 | have H_neq: n <> h by move => H_eq; rewrite H_eq in H_in. 78 | have [d H_eq] := IHrefl_trans_1n_trace1 _ H_in. 79 | exists d. 80 | rewrite /update /=. 81 | by break_if. 82 | - move => n H_in. 83 | rewrite /update. 84 | break_if; first by exists d'. 85 | have [d0 H_eq] := IHrefl_trans_1n_trace1 _ H_in. 86 | by exists d0. 87 | - move => n H_in. 88 | rewrite /update. 89 | break_if; first by exists d'. 90 | have [d0 H_eq] := IHrefl_trans_1n_trace1 _ H_in. 91 | by exists d0. 92 | - move => n H_in. 93 | exact: IHrefl_trans_1n_trace1. 94 | Qed. 95 | 96 | Lemma ordered_dynamic_failed_then_initialized : 97 | forall net failed tr, 98 | step_ordered_dynamic_failure_star step_ordered_dynamic_failure_init (failed, net) tr -> 99 | forall n, In n failed -> 100 | In n (odnwNodes net). 101 | Proof using. 102 | move => net failed tr H. 103 | remember step_ordered_dynamic_failure_init as y in *. 104 | have ->: failed = fst (failed, net) by []. 105 | have H_eq_o: net = snd (failed, net) by []. 106 | rewrite {2}H_eq_o {H_eq_o}. 107 | move: Heqy. 108 | induction H using refl_trans_1n_trace_n1_ind => H_init /=; first by rewrite H_init. 109 | repeat find_rewrite. 110 | concludes => {H_init}. 111 | match goal with 112 | | [ H : step_ordered_dynamic_failure _ _ _ |- _ ] => invc H 113 | end; rewrite /=. 114 | - move => n H_in. 115 | right. 116 | exact: IHrefl_trans_1n_trace1. 117 | - move => n H_in. 118 | exact: IHrefl_trans_1n_trace1. 119 | - move => n H_in. 120 | exact: IHrefl_trans_1n_trace1. 121 | - move => n H_in. 122 | case: H_in => H_in; first by rewrite -H_in. 123 | exact: IHrefl_trans_1n_trace1. 124 | Qed. 125 | 126 | Lemma ordered_dynamic_state_not_initialized_not_failed : 127 | forall net failed tr, 128 | step_ordered_dynamic_failure_star step_ordered_dynamic_failure_init (failed, net) tr -> 129 | forall n, ~ In n (odnwNodes net) -> 130 | ~ In n failed. 131 | Proof using. 132 | move => net failed tr H. 133 | remember step_ordered_dynamic_failure_init as y in *. 134 | have ->: failed = fst (failed, net) by []. 135 | have H_eq_o: net = snd (failed, net) by []. 136 | rewrite {1}H_eq_o {H_eq_o}. 137 | move: Heqy. 138 | induction H using refl_trans_1n_trace_n1_ind => H_init /=; first by rewrite H_init. 139 | repeat find_rewrite. 140 | concludes => {H_init}. 141 | match goal with 142 | | [ H : step_ordered_dynamic_failure _ _ _ |- _ ] => invc H 143 | end; rewrite /=. 144 | - move => n H_in. 145 | have H_not_in: ~ In n (odnwNodes net0) by move => H_in'; case: H_in; right. 146 | exact: IHrefl_trans_1n_trace1. 147 | - move => n H_in. 148 | exact: IHrefl_trans_1n_trace1. 149 | - move => n H_in. 150 | exact: IHrefl_trans_1n_trace1. 151 | - move => n H_in. 152 | move => H_or. 153 | case: H_or => H_or; first by repeat find_rewrite. 154 | contradict H_or. 155 | exact: IHrefl_trans_1n_trace1. 156 | Qed. 157 | 158 | Lemma ordered_dynamic_no_outgoing_uninitialized : 159 | forall onet failed tr, 160 | step_ordered_dynamic_failure_star step_ordered_dynamic_failure_init (failed, onet) tr -> 161 | forall n, ~ In n (odnwNodes onet) -> 162 | forall n', onet.(odnwPackets) n n' = []. 163 | Proof using. 164 | move => net failed tr H. 165 | remember step_ordered_dynamic_failure_init as y in *. 166 | have ->: net = snd (failed, net) by []. 167 | move: Heqy. 168 | induction H using refl_trans_1n_trace_n1_ind => H_init /=; first by rewrite H_init. 169 | concludes => {H_init}. 170 | match goal with 171 | | [ H : step_ordered_dynamic_failure _ _ _ |- _ ] => invc H 172 | end; rewrite /=. 173 | - move => n H_a n'. 174 | have H_neq: h <> n by eauto. 175 | have H_not_in: ~ In n (odnwNodes net0) by eauto. 176 | rewrite collate_ls_not_in; first by rewrite collate_neq //; eauto. 177 | apply: not_in_not_in_filter_rel. 178 | move => H_in. 179 | case: H_not_in. 180 | move: H_in. 181 | exact: in_remove_all_was_in. 182 | - move => n H_a n'. 183 | have H_neq: to <> n by move => H_eq; rewrite -H_eq in H_a. 184 | rewrite collate_neq //. 185 | rewrite /update2. 186 | case sumbool_and => H_and; last by eauto. 187 | break_and; repeat find_rewrite. 188 | simpl in *. 189 | have IH := IHrefl_trans_1n_trace1 _ H_a. 190 | by find_higher_order_rewrite. 191 | - move => n H_a n'. 192 | have H_neq: h <> n by move => H_eq; rewrite -H_eq in H_a. 193 | rewrite collate_neq //. 194 | by eauto. 195 | - move => n H_a n'. 196 | have H_neq: h <> n by move => H_eq; rewrite -H_eq in H_a. 197 | rewrite collate_neq //. 198 | by eauto. 199 | Qed. 200 | 201 | Lemma ordered_dynamic_nodes_no_dup : 202 | forall onet failed tr, 203 | step_ordered_dynamic_failure_star step_ordered_dynamic_failure_init (failed, onet) tr -> 204 | NoDup (odnwNodes onet). 205 | Proof using. 206 | move => net failed tr H. 207 | remember step_ordered_dynamic_failure_init as y in *. 208 | have ->: net = snd (failed, net) by []. 209 | move: Heqy. 210 | induction H using refl_trans_1n_trace_n1_ind => H_init. 211 | rewrite H_init /=. 212 | exact: NoDup_nil. 213 | concludes => {H_init}. 214 | match goal with 215 | | [ H : step_ordered_dynamic_failure _ _ _ |- _ ] => invc H 216 | end; rewrite //=. 217 | exact: NoDup_cons. 218 | Qed. 219 | 220 | End DynamicNetLemmas. 221 | -------------------------------------------------------------------------------- /theories/Core/GhostSimulations.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import List. 2 | From StructTact Require Import StructTactics Util. 3 | From Verdi Require Import Net TotalMapSimulations. 4 | From Coq Require Import FunctionalExtensionality. 5 | From Verdi Require Import Ssrexport. 6 | 7 | Set Implicit Arguments. 8 | 9 | Class GhostMultiParams `(P : MultiParams) := 10 | { 11 | ghost_data : Type; 12 | ghost_init : ghost_data ; 13 | ghost_net_handlers : 14 | name -> name -> msg -> (ghost_data * data) -> ghost_data; 15 | ghost_input_handlers : 16 | name -> input -> (ghost_data * data) -> ghost_data 17 | }. 18 | 19 | Section GhostVars. 20 | 21 | Context {base_params : BaseParams}. 22 | Context {multi_params : MultiParams base_params}. 23 | Context {failure_params : FailureParams multi_params}. 24 | Context {ghost_params : GhostMultiParams multi_params}. 25 | 26 | Definition refined_net_handlers me src m st := 27 | let '(out, st', ps) := 28 | net_handlers me src m (snd st) in 29 | (out, (ghost_net_handlers me src m st, st'), ps). 30 | 31 | Definition refined_input_handlers me inp st := 32 | let '(out, st', ps) := input_handlers me inp (snd st) in 33 | (out, (ghost_input_handlers me inp st, st'), ps). 34 | 35 | Definition refined_init_handlers (n : name) : ghost_data * data := 36 | (ghost_init, init_handlers n). 37 | 38 | Definition refined_reboot (st : ghost_data * data) := 39 | (fst st , reboot (snd st)). 40 | 41 | Instance refined_base_params : BaseParams := 42 | { 43 | data := (ghost_data * data)%type ; 44 | input := input ; 45 | output := output 46 | }. 47 | 48 | Instance refined_multi_params : MultiParams _ := 49 | { 50 | name := name ; 51 | msg := msg ; 52 | msg_eq_dec := msg_eq_dec ; 53 | name_eq_dec := name_eq_dec ; 54 | nodes := nodes ; 55 | all_names_nodes := all_names_nodes ; 56 | no_dup_nodes := no_dup_nodes ; 57 | init_handlers := refined_init_handlers; 58 | net_handlers := refined_net_handlers ; 59 | input_handlers := refined_input_handlers 60 | }. 61 | 62 | Instance refined_failure_params : FailureParams _ := 63 | { 64 | reboot := refined_reboot 65 | }. 66 | 67 | Definition deghost_packet p := 68 | @mkPacket _ multi_params 69 | (@pSrc _ refined_multi_params p) 70 | (pDst p) 71 | (pBody p). 72 | 73 | Definition deghost (net : @network _ refined_multi_params) : (@network _ multi_params). 74 | refine (@mkNetwork _ multi_params 75 | 76 | (map deghost_packet 77 | (nwPackets net)) 78 | _ 79 | ). 80 | intros. 81 | destruct net as [? nwState]. 82 | concludes. 83 | destruct nwState. auto. 84 | Defined. 85 | 86 | Arguments deghost_packet /_. 87 | 88 | Definition deghost_prop I (failed_net : list name * network) : Prop := 89 | I ((fst failed_net), deghost (snd failed_net)). 90 | 91 | Instance refined_base_params_tot_map : 92 | BaseParamsTotalMap refined_base_params base_params := 93 | { 94 | tot_map_data := snd ; 95 | tot_map_input := id ; 96 | tot_map_output := id 97 | }. 98 | 99 | Instance refined_multi_params_name_tot_map : 100 | MultiParamsNameTotalMap refined_multi_params multi_params := 101 | { 102 | tot_map_name := id ; 103 | tot_map_name_inv := id 104 | }. 105 | 106 | Instance refined_multi_params_name_tot_map_bijective : 107 | MultiParamsNameTotalMapBijective refined_multi_params_name_tot_map := 108 | { 109 | tot_map_name_inv_inverse := fun _ => eq_refl ; 110 | tot_map_name_inverse_inv := fun _ => eq_refl 111 | }. 112 | 113 | Instance refined_multi_params_tot_msg_map : 114 | MultiParamsMsgTotalMap refined_multi_params multi_params := 115 | { 116 | tot_map_msg := id 117 | }. 118 | 119 | Program Instance refined_multi_params_map_congruency : 120 | MultiParamsTotalMapCongruency refined_base_params_tot_map 121 | refined_multi_params_name_tot_map refined_multi_params_tot_msg_map := 122 | { 123 | tot_init_handlers_eq := fun _ => eq_refl ; 124 | tot_net_handlers_eq := _ ; 125 | tot_input_handlers_eq := _ 126 | }. 127 | Next Obligation. 128 | rewrite /tot_mapped_net_handlers /= /refined_net_handlers /= /tot_map_name_msgs /= /id /=. 129 | repeat break_let. 130 | find_inversion. 131 | by rewrite /= -/id map_id map_fst_snd_id. 132 | Qed. 133 | Next Obligation. 134 | rewrite /tot_mapped_input_handlers /=. 135 | repeat break_let. 136 | unfold refined_input_handlers in *. 137 | repeat break_let. 138 | find_inversion. 139 | by rewrite /id /= map_id /tot_map_name_msgs /= /id /= map_fst_snd_id. 140 | Qed. 141 | 142 | Instance refined_failure_params_map_congruency : 143 | FailureParamsTotalMapCongruency refined_failure_params 144 | failure_params refined_base_params_tot_map := 145 | { 146 | tot_reboot_eq := fun _ => eq_refl 147 | }. 148 | 149 | Lemma map_id_tr : 150 | forall out, 151 | map (fun e : name * (input + list output) => 152 | let (n, s) := e in 153 | match s with 154 | | inl io => (n, inl io) 155 | | inr lo => (n, inr (map id lo)) 156 | end) out = out. 157 | Proof using. 158 | elim => //. 159 | move => tr l IH. 160 | rewrite /= IH. 161 | break_let. 162 | break_match => //=. 163 | by rewrite map_id. 164 | Qed. 165 | 166 | Theorem ghost_simulation_1 : 167 | forall net net' failed failed' out, 168 | @step_failure _ _ refined_failure_params (failed, net) (failed', net') out -> 169 | @step_failure _ _ failure_params (failed, deghost net) (failed', deghost net') out. 170 | Proof using. 171 | move => net net' failed failed' out H_step. 172 | apply step_failure_tot_mapped_simulation_1 in H_step. 173 | rewrite /tot_map_name /tot_map_net /= 2!map_id /id /= in H_step. 174 | rewrite /tot_map_trace_occ /= /id /= in H_step. 175 | rewrite /tot_map_packet /= /id /= in H_step. 176 | rewrite /deghost /=. 177 | rewrite -/id map_id_tr in H_step. 178 | move: H_step. 179 | set fp := fun p : packet => _. 180 | set fp' := fun p : packet => _. 181 | have H_eq: fp = fp' by rewrite /fp /fp'; apply functional_extensionality; case => /= src dst m. 182 | rewrite H_eq {H_eq fp}. 183 | set fs1 := fun n => _. 184 | set fs2 := fun n => _. 185 | set fs1' := fun n => _. 186 | set fs2' := fun n => _. 187 | have H_eq: fs1 = fs1' by rewrite /fs1 /fs1' {fs1 fs1'}; apply functional_extensionality => n; case: net. 188 | rewrite H_eq {H_eq fs1}. 189 | have H_eq: fs2 = fs2' by rewrite /fs2 /fs2' {fs2 fs2'}; apply functional_extensionality => n; case: net'. 190 | by rewrite H_eq {H_eq fs2}. 191 | Qed. 192 | 193 | Theorem ghost_simulation_2 : 194 | forall net net' failed failed' out gnet, 195 | @step_failure _ _ failure_params (failed, net) (failed', net') out -> 196 | deghost gnet = net -> 197 | exists gnet', 198 | step_failure (failed, gnet) (failed', gnet') out /\ 199 | deghost gnet' = net'. 200 | Proof using. 201 | move => net net' failed failed' out gnet H_step H_eq. 202 | eapply step_failure_tot_mapped_simulation_2 in H_step => //. 203 | - move: H_step => [gnet' [H_step H_eq_net]]. 204 | exists gnet'. 205 | split; eauto. 206 | rewrite -H_eq_net {H_eq_net H_step}. 207 | rewrite /deghost /tot_map_net /= /id /= /tot_map_packet /= /id /=. 208 | set nwPf1 := fun p : packet => _. 209 | set nwPf2 := fun p : packet => _. 210 | have H_eq_p: nwPf1 = nwPf2 by rewrite /nwPf1 /nwPf2 {nwPf1 nwPf2}; apply functional_extensionality; case. 211 | set nwS1 := fun _ => _. 212 | set nwS2 := fun _ => _. 213 | have H_eq_s: nwS1 = nwS2 by rewrite /nwS1 /nwS2 {nwS1 nwS2}; apply functional_extensionality => n; case: gnet'. 214 | by rewrite H_eq_p H_eq_s. 215 | - rewrite -H_eq {H_step H_eq}. 216 | rewrite /deghost /tot_map_net /= /id /= /tot_map_packet /= /id /=. 217 | set nwPf1 := fun p : packet => _. 218 | set nwPf2 := fun p : packet => _. 219 | have H_eq_p: nwPf1 = nwPf2 by rewrite /nwPf1 /nwPf2 {nwPf1 nwPf2}; apply functional_extensionality; case. 220 | set nwS1 := fun _ => _. 221 | set nwS2 := fun _ => _. 222 | have H_eq_s: nwS1 = nwS2 by rewrite /nwS1 /nwS2 {nwS1 nwS2}; apply functional_extensionality => n; case: gnet. 223 | by rewrite H_eq_p H_eq_s. 224 | - by rewrite /tot_map_name /= map_id. 225 | - by rewrite /tot_map_name /= map_id. 226 | - move {H_step}. 227 | elim: out => //. 228 | case => n t out IH. 229 | case: t => /=; first by move => inp; rewrite /id /= IH. 230 | move => out'. 231 | by rewrite {1}/id map_id /= IH. 232 | Qed. 233 | 234 | Definition ghost_packet p := 235 | @mkPacket _ refined_multi_params 236 | (@pSrc _ multi_params p) 237 | (pDst p) 238 | (pBody p). 239 | 240 | Definition reghost (net : @network _ multi_params) : @network _ refined_multi_params. 241 | refine (@mkNetwork _ refined_multi_params 242 | (map ghost_packet 243 | (nwPackets net)) 244 | _ 245 | ). 246 | intros. 247 | destruct net as [? nwState]. 248 | concludes. 249 | exact (ghost_init, nwState). 250 | Defined. 251 | 252 | Arguments ghost_packet /_. 253 | 254 | Lemma reghost_deghost_partial_inverses : 255 | forall net, 256 | deghost (reghost net) = net. 257 | Proof using. 258 | destruct net. unfold deghost, reghost. simpl in *. f_equal. 259 | rewrite map_map. map_id. 260 | Qed. 261 | 262 | Theorem ghost_invariant_lift : 263 | forall P : _ -> Prop, 264 | (forall net net' failed failed' out, 265 | @step_failure _ _ failure_params (failed, net) (failed', net') out -> 266 | P net -> 267 | P net') -> 268 | (forall net net' failed failed' out, 269 | step_failure (failed, net) (failed', net') out -> 270 | P (deghost net) -> 271 | P (deghost net')). 272 | Proof using. 273 | intros. eauto using ghost_simulation_1. 274 | Qed. 275 | 276 | Theorem ghost_invariant_lower : 277 | forall P : _ -> Prop, 278 | (forall net net' failed failed' out, 279 | step_failure (failed, net) (failed', net') out -> 280 | P (deghost net) -> 281 | P (deghost net')) -> 282 | (forall net net' failed failed' out, 283 | @step_failure _ _ failure_params (failed, net) (failed', net') out -> 284 | P net -> 285 | P net'). 286 | Proof using. 287 | intros. 288 | apply ghost_simulation_2 with (gnet := reghost net) in H0. 289 | - break_exists. intuition. subst. 290 | eapply H; eauto. 291 | rewrite reghost_deghost_partial_inverses. 292 | auto. 293 | - eauto using reghost_deghost_partial_inverses. 294 | Qed. 295 | 296 | End GhostVars. 297 | 298 | Class MsgGhostMultiParams `(P : MultiParams) := 299 | { 300 | ghost_msg : Type; 301 | ghost_msg_eq_dec : forall x y : ghost_msg, {x = y} + {x <> y} ; 302 | ghost_msg_default : ghost_msg ; 303 | write_ghost_msg : 304 | name -> data -> ghost_msg 305 | }. 306 | 307 | Section MsgGhostVars. 308 | 309 | Context {base_params : BaseParams}. 310 | Context {multi_params : MultiParams base_params}. 311 | Context {failure_params : FailureParams multi_params}. 312 | Context {msg_ghost_params : MsgGhostMultiParams multi_params}. 313 | 314 | Definition add_ghost_msg (me : name) (st : data) (ps : list (name * msg)) : 315 | list (name * (ghost_msg * msg)) := 316 | map (fun m => (fst m, (write_ghost_msg me st, snd m))) ps. 317 | 318 | Definition mgv_refined_net_handlers me src (m : ghost_msg * msg) st := 319 | let '(out, st', ps) := net_handlers me src (snd m) st in 320 | (out, st', add_ghost_msg me st' ps). 321 | 322 | Definition mgv_refined_input_handlers me inp st := 323 | let '(out, st', ps) := input_handlers me inp st in 324 | (out, st', add_ghost_msg me st' ps). 325 | 326 | Definition mgv_msg_eq_dec : 327 | forall x y : ghost_msg * msg, {x = y} + {x <> y}. 328 | Proof using. 329 | intros. 330 | decide equality; auto using msg_eq_dec, ghost_msg_eq_dec. 331 | Qed. 332 | 333 | Instance mgv_refined_base_params : BaseParams := 334 | { 335 | data := data ; 336 | input := input ; 337 | output := output 338 | }. 339 | 340 | Instance mgv_refined_multi_params : MultiParams _ := 341 | { 342 | name := name ; 343 | msg := (ghost_msg * msg) ; 344 | msg_eq_dec := mgv_msg_eq_dec ; 345 | name_eq_dec := name_eq_dec ; 346 | nodes := nodes ; 347 | all_names_nodes := all_names_nodes ; 348 | no_dup_nodes := no_dup_nodes ; 349 | init_handlers := init_handlers; 350 | net_handlers := mgv_refined_net_handlers ; 351 | input_handlers := mgv_refined_input_handlers 352 | }. 353 | 354 | Instance mgv_refined_failure_params : FailureParams _ := 355 | { 356 | reboot := (@reboot base_params multi_params failure_params) 357 | }. 358 | 359 | Definition mgv_deghost_packet p := 360 | @mkPacket _ multi_params 361 | (@pSrc _ mgv_refined_multi_params p) 362 | (pDst p) 363 | (snd (pBody p)). 364 | 365 | Definition mgv_deghost (net : @network _ mgv_refined_multi_params) : (@network _ multi_params). 366 | refine (@mkNetwork _ multi_params 367 | (map mgv_deghost_packet 368 | (nwPackets net)) 369 | _ 370 | ). 371 | intros. 372 | destruct net. 373 | concludes. 374 | auto. 375 | Defined. 376 | 377 | Arguments mgv_deghost_packet /_. 378 | 379 | Instance mgv_refined_base_params_tot_map : 380 | BaseParamsTotalMap mgv_refined_base_params base_params := 381 | { 382 | tot_map_data := id ; 383 | tot_map_input := id ; 384 | tot_map_output := id 385 | }. 386 | 387 | Instance mgv_refined_multi_params_name_tot_map : 388 | MultiParamsNameTotalMap mgv_refined_multi_params multi_params := 389 | { 390 | tot_map_name := id ; 391 | tot_map_name_inv := id ; 392 | }. 393 | 394 | Instance mgv_refined_multi_params_name_tot_map_bijective : 395 | MultiParamsNameTotalMapBijective mgv_refined_multi_params_name_tot_map := 396 | { 397 | tot_map_name_inv_inverse := fun _ => eq_refl ; 398 | tot_map_name_inverse_inv := fun _ => eq_refl 399 | }. 400 | 401 | Instance mgv_refined_multi_params_tot_map : 402 | MultiParamsMsgTotalMap mgv_refined_multi_params multi_params := 403 | { 404 | tot_map_msg := snd ; 405 | }. 406 | 407 | Program Instance mgv_refined_multi_params_map_congruency : 408 | MultiParamsTotalMapCongruency mgv_refined_base_params_tot_map 409 | mgv_refined_multi_params_name_tot_map mgv_refined_multi_params_tot_map := 410 | { 411 | tot_init_handlers_eq := fun _ => eq_refl ; 412 | tot_net_handlers_eq := _ ; 413 | tot_input_handlers_eq := _ 414 | }. 415 | Next Obligation. 416 | rewrite /tot_mapped_net_handlers /= /mgv_refined_net_handlers /= /tot_map_name_msgs /= /id /=. 417 | repeat break_let. 418 | find_inversion. 419 | rewrite -/id map_id /= /add_ghost_msg /=. 420 | elim l0 => //=. 421 | case => n m' l IH. 422 | find_inversion. 423 | by find_rewrite; find_rewrite. 424 | Qed. 425 | Next Obligation. 426 | rewrite /tot_mapped_input_handlers /=. 427 | repeat break_let. 428 | rewrite map_id /id /=. 429 | unfold mgv_refined_input_handlers in *. 430 | repeat break_let. 431 | find_inversion. 432 | elim l1 => //=. 433 | case => n m l. 434 | move => IH. 435 | find_inversion. 436 | by find_rewrite; find_rewrite. 437 | Qed. 438 | 439 | Instance mgv_refined_failure_params_map_congruency : 440 | FailureParamsTotalMapCongruency mgv_refined_failure_params 441 | failure_params mgv_refined_base_params_tot_map := 442 | { 443 | tot_reboot_eq := fun _ => eq_refl 444 | }. 445 | 446 | Lemma mgv_map_id_tr : 447 | forall out, 448 | map (fun e : name * (input + list output) => 449 | let (n, s) := e in 450 | match s with 451 | | inl io => (n, inl io) 452 | | inr lo => (n, inr (map id lo)) 453 | end) out = out. 454 | Proof using. 455 | elim => //. 456 | move => tr l IH. 457 | rewrite /= IH. 458 | break_let. 459 | break_match => //. 460 | by rewrite map_id. 461 | Qed. 462 | 463 | Theorem mgv_ghost_simulation_1 : 464 | forall net net' failed failed' out, 465 | @step_failure _ _ mgv_refined_failure_params (failed, net) (failed', net') out -> 466 | @step_failure _ _ failure_params (failed, mgv_deghost net) (failed', mgv_deghost net') out. 467 | Proof using. 468 | move => net net' failed failed' out H_step. 469 | apply step_failure_tot_mapped_simulation_1 in H_step. 470 | rewrite /tot_map_name /tot_map_net /= 2!map_id /id /= in H_step. 471 | rewrite /tot_map_trace_occ /= /id /= in H_step. 472 | rewrite /tot_map_packet /= /id /= in H_step. 473 | rewrite /mgv_deghost /=. 474 | rewrite -/id mgv_map_id_tr in H_step. 475 | move: H_step. 476 | set fp := fun p : packet => _. 477 | set fp' := fun p : packet => _. 478 | have H_eq: fp = fp' by rewrite /fp /fp'; apply functional_extensionality; case => /= src dst m. 479 | rewrite H_eq {H_eq fp}. 480 | set fs1 := fun n => _. 481 | set fs2 := fun n => _. 482 | set fs1' := fun n => _. 483 | set fs2' := fun n => _. 484 | have H_eq: fs1 = fs1' by rewrite /fs1 /fs1' {fs1 fs1'}; apply functional_extensionality => n; case: net. 485 | rewrite H_eq {H_eq fs1}. 486 | have H_eq: fs2 = fs2' by rewrite /fs2 /fs2' {fs2 fs2'}; apply functional_extensionality => n; case: net'. 487 | by rewrite H_eq. 488 | Qed. 489 | 490 | Definition mgv_ghost_packet p := 491 | @mkPacket _ mgv_refined_multi_params 492 | (@pSrc _ multi_params p) 493 | (pDst p) 494 | (ghost_msg_default, pBody p). 495 | 496 | Definition mgv_reghost (net : @network _ multi_params) : @network _ mgv_refined_multi_params. 497 | refine (@mkNetwork _ mgv_refined_multi_params 498 | (map mgv_ghost_packet 499 | (nwPackets net)) 500 | _ 501 | ). 502 | intros. 503 | destruct net. 504 | concludes. 505 | auto. 506 | Defined. 507 | 508 | Arguments mgv_ghost_packet /_. 509 | 510 | Lemma mgv_reghost_deghost_partial_inverses : 511 | forall net, 512 | mgv_deghost (mgv_reghost net) = net. 513 | Proof using. 514 | destruct net. unfold mgv_deghost, mgv_reghost. simpl in *. f_equal. 515 | rewrite map_map. map_id. 516 | Qed. 517 | 518 | Theorem mgv_ghost_simulation_2 : 519 | forall net net' failed failed' out gnet, 520 | @step_failure _ _ failure_params (failed, net) (failed', net') out -> 521 | mgv_deghost gnet = net -> 522 | exists gnet', 523 | step_failure (failed, gnet) (failed', gnet') out /\ 524 | mgv_deghost gnet' = net'. 525 | Proof using. 526 | move => net net' failed failed' out gnet H_step H_eq. 527 | eapply step_failure_tot_mapped_simulation_2 in H_step => //. 528 | - move: H_step => [gnet' [H_step H_eq_net]]. 529 | exists gnet'. 530 | split; eauto. 531 | rewrite -H_eq_net {H_step H_eq_net}. 532 | rewrite /mgv_deghost /tot_map_net /= /id /= /tot_map_packet /= /id /=. 533 | set nwPf1 := fun p : packet => _. 534 | set nwPf2 := fun p : packet => _. 535 | have H_eq_p: nwPf1 = nwPf2 by rewrite /nwPf1 /nwPf2 {nwPf1 nwPf2}; apply functional_extensionality; case. 536 | set nwS1 := fun _ => _. 537 | set nwS2 := fun _ => _. 538 | have H_eq_s: nwS1 = nwS2 by rewrite /nwS1 /nwS2 {nwS1 nwS2}; apply functional_extensionality => n; case: gnet'. 539 | by rewrite H_eq_p H_eq_s. 540 | - rewrite -H_eq {H_step H_eq}. 541 | rewrite /mgv_deghost /tot_map_net /= /id /= /tot_map_packet /= /id /=. 542 | set nwPf1 := fun p : packet => _. 543 | set nwPf2 := fun p : packet => _. 544 | have H_eq_p: nwPf1 = nwPf2 by rewrite /nwPf1 /nwPf2 {nwPf1 nwPf2}; apply functional_extensionality; case. 545 | set nwS1 := fun _ => _. 546 | set nwS2 := fun _ => _. 547 | have H_eq_s: nwS1 = nwS2 by rewrite /nwS1 /nwS2 {nwS1 nwS2}; apply functional_extensionality => n; case: gnet. 548 | by rewrite H_eq_p H_eq_s. 549 | - by rewrite /tot_map_name /= map_id. 550 | - by rewrite /tot_map_name /= map_id. 551 | - move {H_step}. 552 | elim: out => //. 553 | case => n t out IH. 554 | case: t => /=; first by move => inp; rewrite /id /= IH. 555 | move => out'. 556 | by rewrite {1}/id map_id /= IH. 557 | Qed. 558 | 559 | Theorem mgv_ghost_invariant_lift : 560 | forall P : _ -> Prop, 561 | (forall net net' failed failed' out, 562 | @step_failure _ _ failure_params (failed, net) (failed', net') out -> 563 | P net -> 564 | P net') -> 565 | (forall net net' failed failed' out, 566 | step_failure (failed, net) (failed', net') out -> 567 | P (mgv_deghost net) -> 568 | P (mgv_deghost net')). 569 | Proof using. 570 | intros. eauto using mgv_ghost_simulation_1. 571 | Qed. 572 | 573 | Theorem mgv_ghost_invariant_lower : 574 | forall P : _ -> Prop, 575 | (forall net net' failed failed' out, 576 | step_failure (failed, net) (failed', net') out -> 577 | P (mgv_deghost net) -> 578 | P (mgv_deghost net')) -> 579 | (forall net net' failed failed' out, 580 | @step_failure _ _ failure_params (failed, net) (failed', net') out -> 581 | P net -> 582 | P net'). 583 | Proof using. 584 | intros. 585 | apply mgv_ghost_simulation_2 with (gnet := mgv_reghost net) in H0. 586 | - break_exists. intuition. subst. 587 | eapply H; eauto. 588 | rewrite mgv_reghost_deghost_partial_inverses. 589 | auto. 590 | - eauto using mgv_reghost_deghost_partial_inverses. 591 | Qed. 592 | 593 | End MsgGhostVars. 594 | Arguments deghost_packet /_ _ _ _. 595 | Arguments ghost_packet /_ _ _ _. 596 | 597 | Arguments mgv_deghost_packet /_ _ _ _. 598 | Arguments mgv_ghost_packet /_ _ _ _. 599 | -------------------------------------------------------------------------------- /theories/Core/HandlerMonad.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import List. 2 | 3 | Import ListNotations. 4 | 5 | Definition GenHandler (W S O A : Type) : Type := S -> A * list O * S * list W % type. 6 | 7 | Definition ret {W S O A : Type} (a : A) : GenHandler W S O A := fun s => (a, [], s, []). 8 | 9 | Definition bind {W S O A B : Type} (m : GenHandler W S O A) (f : A -> GenHandler W S O B) : GenHandler W S O B := 10 | fun s => 11 | let '(a, os1, s', ws1) := m s in 12 | let '(b, os2, s'', ws2) := f a s' in 13 | (b, os1 ++ os2, s'', ws1 ++ ws2). 14 | 15 | Definition send {W S O} (w : W) : GenHandler W S O unit := fun s => (tt, [], s, [w]). 16 | 17 | Definition write_output {W S O} (o : O) : GenHandler W S O unit := fun s => (tt, [o], s, []). 18 | 19 | Definition modify {W S O} (f : S -> S) : GenHandler W S O unit := fun s => (tt, [], f s, []). 20 | 21 | Definition put {W S O} (s : S) : GenHandler W S O unit := fun _ => (tt, [], s, []). 22 | 23 | Definition get {W S O} : GenHandler W S O S := fun s => (s, [], s, []). 24 | 25 | Definition runGenHandler {W S O A} (s : S) (h : GenHandler W S O A) : 26 | A * list O * S * list W % type := 27 | h s. 28 | 29 | Definition runGenHandler_ignore {W S O A} (s : S) (h : GenHandler W S O A) : 30 | list O * S * list W % type := 31 | let '(_, os, s', ms) := h s in (os, s', ms). 32 | 33 | (* for single node semantics *) 34 | Definition runGenHandler1_ignore {W S O A} (h : GenHandler W S O A) (s : S) : list O * S := 35 | let '(_, os, d, _) := runGenHandler s h in 36 | (os, d). 37 | 38 | Definition nop {W S O : Type} := @ret W S O _ tt. 39 | 40 | Notation "a >> b" := (bind a (fun _ => b)) (at level 50). 41 | 42 | Notation "x <- c1 ;; c2" := (@bind _ _ _ _ _ c1 (fun x => c2)) 43 | (at level 100, c1 at next level, right associativity). 44 | 45 | Notation "e1 ;; e2" := (_ <- e1 ;; e2) 46 | (at level 100, right associativity). 47 | 48 | Definition when {W S O A} (b : bool) (m : GenHandler W S O A) : GenHandler W S O unit := 49 | if b then m ;; ret tt else nop. 50 | 51 | Ltac monad_unfold := 52 | repeat unfold 53 | runGenHandler_ignore, 54 | runGenHandler, 55 | runGenHandler1_ignore, 56 | bind, 57 | send, 58 | write_output, 59 | get, 60 | when, 61 | put, 62 | nop, 63 | modify, 64 | ret in *. 65 | 66 | -------------------------------------------------------------------------------- /theories/Core/InverseTraceRelations.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import List. 2 | From Verdi Require Import Net. 3 | From StructTact Require Import StructTactics. 4 | 5 | Class InverseTraceRelation `{State : Type} `{Event : Type} (step : step_relation State Event) := 6 | { 7 | init : State; 8 | T : (list Event) -> Prop; 9 | R : State -> Prop; 10 | R_dec : forall s, {R s} + {~ R s}; 11 | T_monotonic : forall tr o, T tr -> T (tr ++ o); 12 | R_false_init : ~ R init; 13 | R_implies_T : forall s s' o tr, 14 | refl_trans_1n_trace step init s tr -> 15 | ~ R s -> 16 | step s s' o -> 17 | R s' -> 18 | T (tr ++ o) 19 | }. 20 | 21 | Section InverseTraceRelations. 22 | Context `{ITR : InverseTraceRelation}. 23 | 24 | Theorem inverse_trace_relations_work : 25 | forall s tr, 26 | refl_trans_1n_trace step init s tr -> 27 | R s -> 28 | T tr. 29 | Proof using. 30 | intros. find_apply_lem_hyp refl_trans_1n_n1_trace. 31 | remember init as s'. 32 | induction H. 33 | - subst. exfalso. pose R_false_init; auto. 34 | - subst. concludes. 35 | destruct (R_dec x'); 36 | intuition eauto using T_monotonic, refl_trans_n1_1n_trace, R_implies_T. 37 | Qed. 38 | End InverseTraceRelations. 39 | -------------------------------------------------------------------------------- /theories/Core/LabeledNet.v: -------------------------------------------------------------------------------- 1 | From Verdi Require Import Verdi. 2 | From InfSeqExt Require Import infseq exteq. 3 | From Verdi Require Import Ssrexport. 4 | 5 | Set Implicit Arguments. 6 | 7 | Class LabeledMultiParams (P : BaseParams) := 8 | { 9 | lb_name : Type ; 10 | lb_msg : Type ; 11 | lb_msg_eq_dec : forall x y : lb_msg, {x = y} + {x <> y} ; 12 | lb_name_eq_dec : forall x y : lb_name, {x = y} + {x <> y} ; 13 | lb_nodes : list lb_name ; 14 | lb_all_names_nodes : forall n, In n lb_nodes ; 15 | lb_no_dup_nodes : NoDup lb_nodes ; 16 | label : Type ; 17 | label_silent : label ; 18 | lb_init_handlers : lb_name -> data ; 19 | lb_net_handlers : lb_name -> lb_name -> lb_msg -> data -> label * (list output) * data * list (lb_name * lb_msg) ; 20 | lb_input_handlers : lb_name -> input -> data -> label * (list output) * data * list (lb_name * lb_msg) 21 | }. 22 | 23 | Section UnlabeledParams. 24 | 25 | Context {base_params : BaseParams}. 26 | Context {labeled_multi_params : LabeledMultiParams base_params}. 27 | 28 | Definition unlabeled_net_handlers me src m st := 29 | let '(lb, out, st', ps) := lb_net_handlers me src m st in (out, st', ps). 30 | 31 | Definition unlabeled_input_handlers me inp st := 32 | let '(lb, out, st', ps) := lb_input_handlers me inp st in (out, st', ps). 33 | 34 | Global Instance unlabeled_multi_params : MultiParams base_params := 35 | { 36 | name := lb_name ; 37 | msg := lb_msg ; 38 | msg_eq_dec := lb_msg_eq_dec ; 39 | name_eq_dec := lb_name_eq_dec ; 40 | nodes := lb_nodes ; 41 | all_names_nodes := lb_all_names_nodes ; 42 | no_dup_nodes := lb_no_dup_nodes ; 43 | init_handlers := lb_init_handlers; 44 | net_handlers := unlabeled_net_handlers ; 45 | input_handlers := unlabeled_input_handlers 46 | }. 47 | 48 | End UnlabeledParams. 49 | 50 | Section LabeledStepExecution. 51 | Variable A : Type. 52 | Variable L : Type. 53 | Variable trace : Type. 54 | 55 | Definition lb_step_relation := A -> L -> A -> list trace -> Prop. 56 | 57 | Definition lb_step_ex (step : lb_step_relation) (l : L) (a : A) : Prop := 58 | exists a' tr, step a l a' tr. 59 | 60 | Record event := { evt_a : A ; evt_l : L ; evt_trace : list trace }. 61 | 62 | Definition enabled (step : lb_step_relation) (l : L) (e : event) : Prop := 63 | lb_step_ex step l (evt_a e). 64 | 65 | Definition occurred (l : L) (e : event) : Prop := l = evt_l e. 66 | 67 | Definition inf_enabled (step : lb_step_relation) (l : L) (s : infseq event) : Prop := 68 | inf_often (now (enabled step l)) s. 69 | 70 | Definition cont_enabled (step : lb_step_relation) (l : L) (s : infseq event) : Prop := 71 | continuously (now (enabled step l)) s. 72 | 73 | Definition inf_occurred (l : L) (s : infseq event) : Prop := 74 | inf_often (now (occurred l)) s. 75 | 76 | Definition strong_fairness (step : lb_step_relation) (silent : L) (s : infseq event) : Prop := 77 | forall l : L, l <> silent -> inf_enabled step l s -> inf_occurred l s. 78 | 79 | Definition weak_fairness (step : lb_step_relation) (silent : L) (s : infseq event) : Prop := 80 | forall l : L, l <> silent -> cont_enabled step l s -> inf_occurred l s. 81 | 82 | Lemma strong_fairness_invar : 83 | forall step e silent s, strong_fairness step silent (Cons e s) -> strong_fairness step silent s. 84 | Proof using. 85 | unfold strong_fairness. unfold inf_enabled, inf_occurred, inf_often. 86 | intros step e silent s fair l neq alev. 87 | assert (alevt_es: always (eventually (now (enabled step l))) (Cons e s)). 88 | constructor. 89 | constructor 2. destruct alev; assumption. 90 | simpl. assumption. 91 | clear alev. generalize (fair l neq alevt_es); clear fair alevt_es. 92 | intro fair; case (always_Cons fair); trivial. 93 | Qed. 94 | 95 | Lemma strong_fairness_extensional : 96 | forall step silent, extensional (strong_fairness step silent). 97 | Proof using. 98 | move => step silent. 99 | rewrite /extensional /strong_fairness /inf_enabled /inf_occurred /=. 100 | move => s1 s2 H_eq H_s1 l' H_neq' H_en. 101 | have H_s1l := H_s1 l'. 102 | move: H_s1l. 103 | set s1i := inf_often (now (occurred _)) s1. 104 | move => H_s1l. 105 | suff H_suff: s1i. 106 | move: H_suff. 107 | apply extensional_inf_often => //. 108 | exact: extensional_now. 109 | apply: H_s1l => {s1i}; first by []. 110 | move: H_en. 111 | apply: extensional_inf_often; last exact: exteq_sym. 112 | exact: extensional_now. 113 | Qed. 114 | 115 | Lemma weak_fairness_invar : 116 | forall step e silent s, weak_fairness step silent (Cons e s) -> weak_fairness step silent s. 117 | Proof using. 118 | unfold weak_fairness. unfold cont_enabled, inf_occurred, continuously, inf_often. 119 | intros step e silent s fair a neq eval. 120 | assert (eval_es: eventually (always (now (enabled step a))) (Cons e s)). 121 | apply E_next. assumption. 122 | apply fair in eval_es. 123 | apply always_invar in eval_es. 124 | assumption. 125 | assumption. 126 | Qed. 127 | 128 | Lemma weak_fairness_extensional : 129 | forall step silent, extensional (weak_fairness step silent). 130 | Proof using. 131 | move => step silent. 132 | rewrite /extensional /weak_fairness /cont_enabled /inf_occurred /=. 133 | move => s1 s2 H_eq H_s1 l' H_neq' H_en. 134 | have H_s1l := H_s1 l'. 135 | move: H_s1l. 136 | set s1i := inf_often (now (occurred _)) s1. 137 | move => H_s1l. 138 | suff H_suff: s1i. 139 | move: H_suff. 140 | apply extensional_inf_often => //. 141 | exact: extensional_now. 142 | apply: H_s1l => {s1i}; first by []. 143 | move: H_en. 144 | apply: extensional_continuously; last exact: exteq_sym. 145 | exact: extensional_now. 146 | Qed. 147 | 148 | Lemma strong_fairness_weak : 149 | forall step silent s, strong_fairness step silent s -> weak_fairness step silent s. 150 | Proof using. 151 | move => step silent. 152 | case => e s. 153 | rewrite /strong_fairness /weak_fairness /inf_enabled /cont_enabled. 154 | move => H_str l neq H_cont. 155 | apply: H_str; first by []. 156 | exact: continuously_inf_often. 157 | Qed. 158 | 159 | CoInductive lb_step_execution (step : lb_step_relation) : infseq event -> Prop := 160 | Cons_lb_step_exec : forall (e e' : event) (tr : list trace) (s : infseq event), 161 | step (evt_a e) (evt_l e) (evt_a e') tr -> 162 | evt_trace e' = evt_trace e ++ tr -> 163 | lb_step_execution step (Cons e' s) -> 164 | lb_step_execution step (Cons e (Cons e' s)). 165 | 166 | Lemma lb_step_execution_invar : 167 | forall step x s, lb_step_execution step (Cons x s) -> lb_step_execution step s. 168 | Proof using. 169 | intros step x s e. change (lb_step_execution step (tl (Cons x s))). 170 | destruct e; simpl. assumption. 171 | Qed. 172 | 173 | Lemma lb_step_execution_extensional : 174 | forall step, extensional (lb_step_execution step). 175 | Proof using. 176 | move => step. 177 | rewrite /extensional /=. 178 | cofix c. 179 | case => e1; case => e1' s1. 180 | case => e2; case => e2' s2 H_eq. 181 | find_apply_lem_hyp exteq_inversion. 182 | break_and. 183 | find_copy_apply_lem_hyp exteq_inversion. 184 | break_and. 185 | repeat find_rewrite. 186 | move => H_exec. 187 | inversion H_exec; subst. 188 | apply (Cons_lb_step_exec _ tr) => //. 189 | by apply: c; eauto. 190 | Qed. 191 | 192 | Definition event_step_star (step : step_relation A trace) (init : A) (e : event) := 193 | refl_trans_1n_trace step init (evt_a e) (evt_trace e). 194 | 195 | Definition step_star_lb_step_reachable (lb_step : lb_step_relation) (step : step_relation A trace) (init : A) := 196 | forall a l a' tr tr', 197 | refl_trans_1n_trace step init a tr' -> 198 | lb_step a l a' tr -> 199 | refl_trans_1n_trace step init a' (tr' ++ tr). 200 | 201 | Lemma step_star_lb_step_execution : 202 | forall lb_step step init, 203 | step_star_lb_step_reachable lb_step step init -> 204 | forall s, event_step_star step init (hd s) -> 205 | lb_step_execution lb_step s -> 206 | always (now (event_step_star step init)) s. 207 | Proof using. 208 | move => lb_step step init H_r. 209 | case => e s H_star. 210 | move: e s H_star. 211 | cofix cf. 212 | move => e. 213 | case => e' s H_star H_exec'. 214 | constructor; first by []. 215 | apply cf. 216 | inversion H_exec'; subst_max. 217 | simpl in *. 218 | rewrite /event_step_star /=. 219 | rewrite /event_step_star /= in H_star. 220 | rewrite /step_star_lb_step_reachable in H_r. 221 | have H_d := H_r _ _ _ _ _ H_star H2. 222 | rewrite H3. 223 | exact: H_r _ _ _ _ _ H_star H2. 224 | move: H_exec'. 225 | apply: lb_step_execution_invar. 226 | Qed. 227 | End LabeledStepExecution. 228 | 229 | Section LabeledStepAsync. 230 | Context `{labeled_multi_params : LabeledMultiParams}. 231 | 232 | Inductive lb_step_async : lb_step_relation network label (name * (input + list output)) := 233 | | LabeledStepAsync_deliver : forall net net' p xs ys out d l lb, 234 | nwPackets net = xs ++ p :: ys -> 235 | lb_net_handlers (pDst p) (pSrc p) (pBody p) (nwState net (pDst p)) = (lb, out, d, l) -> 236 | net' = mkNetwork (send_packets (pDst p) l ++ xs ++ ys) 237 | (update name_eq_dec (nwState net) (pDst p) d) -> 238 | lb_step_async net lb net' [(pDst p, inr out)] 239 | | LabeledStepAsync_input : forall h net net' out inp d l lb, 240 | lb_input_handlers h inp (nwState net h) = (lb, out, d, l) -> 241 | net' = mkNetwork (send_packets h l ++ nwPackets net) 242 | (update name_eq_dec (nwState net) h d) -> 243 | lb_step_async net lb net' [(h, inl inp); (h, inr out)] 244 | | LabeledStepAsync_stutter : forall net, lb_step_async net label_silent net []. 245 | 246 | Lemma step_async_star_lb_step_reachable : 247 | step_star_lb_step_reachable lb_step_async step_async step_async_init. 248 | Proof using. 249 | rewrite /step_star_lb_step_reachable. 250 | move => net l. 251 | move => net' tr tr' H_star H_st. 252 | invcs H_st. 253 | - set net' := {| nwPackets := _ ; nwState := _ |}. 254 | apply (@refl_trans_1n_trace_trans _ _ _ _ net) => //. 255 | have ->: [(pDst p, inr out)] = [(pDst p, inr out)] ++ [] by []. 256 | apply: (@RT1nTStep _ _ _ _ net'); last exact: RT1nTBase. 257 | apply: (@StepAsync_deliver _ _ _ _ _ xs ys _ d l0) => //. 258 | rewrite /net_handlers /= /unlabeled_net_handlers /=. 259 | repeat break_let. 260 | by tuple_inversion. 261 | - set net' := {| nwPackets := _ ; nwState := _ |}. 262 | apply (@refl_trans_1n_trace_trans _ _ _ _ net) => //. 263 | have ->: [(h, inl inp); (h, inr out)] = [(h, inl inp); (h, inr out)] ++ [] by []. 264 | apply: (@RT1nTStep _ _ _ _ net'); last exact: RT1nTBase. 265 | apply: StepAsync_input => //. 266 | rewrite /input_handlers /= /unlabeled_input_handlers /=. 267 | repeat break_let. 268 | by tuple_inversion. 269 | - by have ->: tr' ++ [] = tr' by auto with datatypes. 270 | Qed. 271 | 272 | Lemma step_async_star_lb_step_execution : 273 | forall s, event_step_star step_async step_async_init (hd s) -> 274 | lb_step_execution lb_step_async s -> 275 | always (now (event_step_star step_async step_async_init)) s. 276 | Proof using. 277 | apply: step_star_lb_step_execution. 278 | exact: step_async_star_lb_step_reachable. 279 | Qed. 280 | End LabeledStepAsync. 281 | 282 | Section LabeledStepFailure. 283 | Context `{labeled_multi_params : LabeledMultiParams}. 284 | 285 | Inductive lb_step_failure : lb_step_relation (list name * network) label (name * (input + list output)) := 286 | | LabeledStepFailure_deliver : forall net net' failed p xs ys out d l lb, 287 | nwPackets net = xs ++ p :: ys -> 288 | ~ In (pDst p) failed -> 289 | lb_net_handlers (pDst p) (pSrc p) (pBody p) (nwState net (pDst p)) = (lb, out, d, l) -> 290 | net' = mkNetwork (send_packets (pDst p) l ++ xs ++ ys) 291 | (update name_eq_dec (nwState net) (pDst p) d) -> 292 | lb_step_failure (failed, net) lb (failed, net') [(pDst p, inr out)] 293 | | LabeledStepFailure_input : forall h net net' failed out inp d l lb, 294 | ~ In h failed -> 295 | lb_input_handlers h inp (nwState net h) = (lb, out, d, l) -> 296 | net' = mkNetwork (send_packets h l ++ nwPackets net) 297 | (update name_eq_dec (nwState net) h d) -> 298 | lb_step_failure (failed, net) lb (failed, net') [(h, inl inp); (h, inr out)] 299 | | LabeledStepFailure_stutter : forall net failed, lb_step_failure (failed, net) label_silent (failed, net) []. 300 | 301 | Context {failure_params : FailureParams unlabeled_multi_params}. 302 | 303 | Lemma step_failure_star_lb_step_reachable : 304 | step_star_lb_step_reachable lb_step_failure step_failure step_failure_init. 305 | Proof using. 306 | rewrite /step_star_lb_step_reachable. 307 | case => failed net l. 308 | case => failed' net' tr tr' H_star H_st. 309 | invcs H_st. 310 | - set net' := {| nwPackets := _ ; nwState := _ |}. 311 | apply (@refl_trans_1n_trace_trans _ _ _ _ (failed', net)) => //. 312 | have ->: [(pDst p, inr out)] = [(pDst p, inr out)] ++ [] by []. 313 | apply: (@RT1nTStep _ _ _ _ (failed', net')); last exact: RT1nTBase. 314 | apply: (@StepFailure_deliver _ _ _ _ _ _ _ xs ys _ d l0) => //. 315 | rewrite /net_handlers /= /unlabeled_net_handlers /=. 316 | repeat break_let. 317 | by tuple_inversion. 318 | - set net' := {| nwPackets := _ ; nwState := _ |}. 319 | apply (@refl_trans_1n_trace_trans _ _ _ _ (failed', net)) => //. 320 | have ->: [(h, inl inp); (h, inr out)] = [(h, inl inp); (h, inr out)] ++ [] by []. 321 | apply: (@RT1nTStep _ _ _ _ (failed', net')); last exact: RT1nTBase. 322 | apply: StepFailure_input => //. 323 | rewrite /input_handlers /= /unlabeled_input_handlers /=. 324 | repeat break_let. 325 | by tuple_inversion. 326 | - by have ->: tr' ++ [] = tr' by auto with datatypes. 327 | Qed. 328 | 329 | Lemma step_failure_star_lb_step_execution : 330 | forall s, event_step_star step_failure step_failure_init (hd s) -> 331 | lb_step_execution lb_step_failure s -> 332 | always (now (event_step_star step_failure step_failure_init)) s. 333 | Proof using. 334 | apply: step_star_lb_step_execution. 335 | exact: step_failure_star_lb_step_reachable. 336 | Qed. 337 | End LabeledStepFailure. 338 | 339 | Section LabeledStepOrderFailure. 340 | Context `{labeled_multi_params : LabeledMultiParams}. 341 | 342 | Inductive lb_step_ordered_failure : lb_step_relation (list name * ordered_network) label (name * (input + output)) := 343 | | LabeledStepOrderedFailure_deliver : forall net net' failed tr m ms out d l from to lb, 344 | onwPackets net from to = m :: ms -> 345 | ~ In to failed -> 346 | lb_net_handlers to from m (onwState net to) = (lb, out, d, l) -> 347 | net' = mkONetwork (collate name_eq_dec to (update2 name_eq_dec (onwPackets net) from to ms) l) 348 | (update name_eq_dec (onwState net) to d) -> 349 | tr = map2fst to (map inr out) -> 350 | lb_step_ordered_failure (failed, net) lb (failed, net') tr 351 | | LabeledStepOrderedFailure_input : forall h net net' failed tr out inp d l lb, 352 | ~ In h failed -> 353 | lb_input_handlers h inp (onwState net h) = (lb, out, d, l) -> 354 | net' = mkONetwork (collate name_eq_dec h (onwPackets net) l) 355 | (update name_eq_dec (onwState net) h d) -> 356 | tr = (h, inl inp) :: map2fst h (map inr out) -> 357 | lb_step_ordered_failure (failed, net) lb (failed, net') tr 358 | | LabeledStepOrderedFailure_stutter : forall net failed, lb_step_ordered_failure (failed, net) label_silent (failed, net) []. 359 | 360 | Context {overlay_params : NameOverlayParams unlabeled_multi_params}. 361 | Context {fail_msg_params : FailMsgParams unlabeled_multi_params}. 362 | 363 | Lemma step_ordered_failure_star_lb_step_reachable : 364 | step_star_lb_step_reachable lb_step_ordered_failure step_ordered_failure step_ordered_failure_init. 365 | Proof using. 366 | rewrite /step_star_lb_step_reachable. 367 | case => failed net l. 368 | case => failed' net' tr tr' H_star H_st. 369 | invcs H_st. 370 | - set net' := {| onwPackets := _ ; onwState := _ |}. 371 | apply (@refl_trans_1n_trace_trans _ _ _ _ (failed', net)) => //. 372 | rewrite -(app_nil_r (map2fst _ _)). 373 | apply: (@RT1nTStep _ _ _ _ (failed', net')); last exact: RT1nTBase. 374 | apply: (StepOrderedFailure_deliver _ _ _ H3) => //. 375 | rewrite /net_handlers /= /unlabeled_net_handlers /=. 376 | repeat break_let. 377 | by tuple_inversion. 378 | - set net' := {| onwPackets := _ ; onwState := _ |}. 379 | apply (@refl_trans_1n_trace_trans _ _ _ _ (failed', net)) => //. 380 | rewrite -(app_nil_r (_ :: _)). 381 | apply: (@RT1nTStep _ _ _ _ (failed', net')); last exact: RT1nTBase. 382 | apply: StepOrderedFailure_input => //; first by []. 383 | rewrite /input_handlers /= /unlabeled_input_handlers /=. 384 | repeat break_let. 385 | by tuple_inversion. 386 | - by have ->: tr' ++ [] = tr' by auto with datatypes. 387 | Qed. 388 | 389 | Lemma step_ordered_failure_star_lb_step_execution : 390 | forall s, event_step_star step_ordered_failure step_ordered_failure_init (hd s) -> 391 | lb_step_execution lb_step_ordered_failure s -> 392 | always (now (event_step_star step_ordered_failure step_ordered_failure_init)) s. 393 | Proof using. 394 | apply: step_star_lb_step_execution. 395 | exact: step_ordered_failure_star_lb_step_reachable. 396 | Qed. 397 | End LabeledStepOrderFailure. 398 | 399 | Section LabeledStepOrderDynamic. 400 | Context `{labeled_multi_params : LabeledMultiParams}. 401 | 402 | Inductive lb_step_ordered_dynamic : lb_step_relation ordered_dynamic_network label (name * (input + output)) := 403 | | LabeledStepOrderedDynamic_deliver : forall net net' tr m ms out d d' l from to lb, 404 | In to (odnwNodes net) -> 405 | odnwState net to = Some d -> 406 | odnwPackets net from to = m :: ms -> 407 | lb_net_handlers to from m d = (lb, out, d', l) -> 408 | net' = {| odnwNodes := odnwNodes net; 409 | odnwPackets := collate name_eq_dec to (update2 name_eq_dec (odnwPackets net) from to ms) l; 410 | odnwState := update name_eq_dec (odnwState net) to (Some d') |} -> 411 | tr = map2fst to (map inr out) -> 412 | lb_step_ordered_dynamic net lb net' tr 413 | | LabeledStepOrderedDynamic_input : forall h net net' tr out inp d d' l lb, 414 | In h (odnwNodes net) -> 415 | odnwState net h = Some d -> 416 | lb_input_handlers h inp d = (lb, out, d', l) -> 417 | net' = {| odnwNodes := odnwNodes net; 418 | odnwPackets := collate name_eq_dec h (odnwPackets net) l; 419 | odnwState := update name_eq_dec (odnwState net) h (Some d') |} -> 420 | tr = (h, inl inp) :: map2fst h (map inr out) -> 421 | lb_step_ordered_dynamic net lb net' tr 422 | | LabeledStepOrderedDynamic_stutter : forall net, 423 | lb_step_ordered_dynamic net label_silent net []. 424 | 425 | Context {overlay_params : NameOverlayParams unlabeled_multi_params}. 426 | Context {new_msg_params : NewMsgParams unlabeled_multi_params}. 427 | 428 | Lemma step_ordered_dynamic_star_lb_step_reachable : 429 | step_star_lb_step_reachable lb_step_ordered_dynamic step_ordered_dynamic step_ordered_dynamic_init. 430 | Proof using. 431 | rewrite /step_star_lb_step_reachable. 432 | move => net l. 433 | move => net' tr tr' H_star H_st. 434 | invcs H_st. 435 | - set net' := {| odnwNodes := _ ; odnwPackets := _ ; odnwState := _ |}. 436 | apply (@refl_trans_1n_trace_trans _ _ _ _ net) => //. 437 | rewrite -(app_nil_r (map2fst _ _)). 438 | apply: (@RT1nTStep _ _ _ _ net'); last exact: RT1nTBase. 439 | apply: (StepOrderedDynamic_deliver _ _ _ H0 H1) => //. 440 | rewrite /net_handlers /= /unlabeled_net_handlers /=. 441 | repeat break_let. 442 | by tuple_inversion. 443 | - set net' := {| odnwNodes := _ ; odnwPackets := _ ; odnwState := _ |}. 444 | apply (@refl_trans_1n_trace_trans _ _ _ _ net) => //. 445 | rewrite -(app_nil_r (_ :: _)). 446 | apply: (@RT1nTStep _ _ _ _ net'); last exact: RT1nTBase. 447 | apply: (StepOrderedDynamic_input _ _ H0) => //. 448 | rewrite /input_handlers /= /unlabeled_input_handlers /=. 449 | repeat break_let. 450 | by tuple_inversion. 451 | - by have ->: tr' ++ [] = tr' by auto with datatypes. 452 | Qed. 453 | 454 | Lemma step_ordered_dynamic_star_lb_step_execution : 455 | forall s, event_step_star step_ordered_dynamic step_ordered_dynamic_init (hd s) -> 456 | lb_step_execution lb_step_ordered_dynamic s -> 457 | always (now (event_step_star step_ordered_dynamic step_ordered_dynamic_init)) s. 458 | Proof using. 459 | apply: step_star_lb_step_execution. 460 | exact: step_ordered_dynamic_star_lb_step_reachable. 461 | Qed. 462 | End LabeledStepOrderDynamic. 463 | 464 | Section LabeledStepOrderDynamicFailure. 465 | Context `{labeled_multi_params : LabeledMultiParams}. 466 | 467 | Inductive lb_step_ordered_dynamic_failure : lb_step_relation (list name * ordered_dynamic_network) label (name * (input + output)) := 468 | | LabeledStepOrderedDynamicFailure_deliver : forall net net' failed tr m ms out d d' l from to lb, 469 | ~ In to failed -> 470 | In to (odnwNodes net) -> 471 | odnwState net to = Some d -> 472 | odnwPackets net from to = m :: ms -> 473 | lb_net_handlers to from m d = (lb, out, d', l) -> 474 | net' = {| odnwNodes := odnwNodes net; 475 | odnwPackets := collate name_eq_dec to (update2 name_eq_dec (odnwPackets net) from to ms) l; 476 | odnwState := update name_eq_dec (odnwState net) to (Some d') |} -> 477 | tr = map2fst to (map inr out) -> 478 | lb_step_ordered_dynamic_failure (failed, net) lb (failed, net') tr 479 | | LabeledStepOrderedDynamicFailure_input : forall h net net' failed tr out inp d d' l lb, 480 | ~ In h failed -> 481 | In h (odnwNodes net) -> 482 | odnwState net h = Some d -> 483 | lb_input_handlers h inp d = (lb, out, d', l) -> 484 | net' = {| odnwNodes := odnwNodes net; 485 | odnwPackets := collate name_eq_dec h (odnwPackets net) l; 486 | odnwState := update name_eq_dec (odnwState net) h (Some d') |} -> 487 | tr = (h, inl inp) :: map2fst h (map inr out) -> 488 | lb_step_ordered_dynamic_failure (failed, net) lb (failed, net') tr 489 | | LabeledStepOrderedDynamicFailure_stutter : forall net failed, 490 | lb_step_ordered_dynamic_failure (failed, net) label_silent (failed, net) []. 491 | 492 | Context {overlay_params : NameOverlayParams unlabeled_multi_params}. 493 | Context {fail_msg_params : FailMsgParams unlabeled_multi_params}. 494 | Context {new_msg_params : NewMsgParams unlabeled_multi_params}. 495 | 496 | Lemma step_ordered_dynamic_failure_star_lb_step_reachable : 497 | step_star_lb_step_reachable lb_step_ordered_dynamic_failure step_ordered_dynamic_failure step_ordered_dynamic_failure_init. 498 | Proof using. 499 | rewrite /step_star_lb_step_reachable. 500 | case => failed net l. 501 | case => failed' net' tr tr' H_star H_st. 502 | invcs H_st. 503 | - set net' := {| odnwNodes := _ ; odnwPackets := _ ; odnwState := _ |}. 504 | apply (@refl_trans_1n_trace_trans _ _ _ _ (failed', net)) => //. 505 | rewrite -(app_nil_r (map2fst _ _)). 506 | apply: (@RT1nTStep _ _ _ _ (failed', net')); last exact: RT1nTBase. 507 | apply: (StepOrderedDynamicFailure_deliver _ _ _ _ _ H5 H6) => //. 508 | rewrite /net_handlers /= /unlabeled_net_handlers /=. 509 | repeat break_let. 510 | by tuple_inversion. 511 | - set net' := {| odnwNodes := _ ; odnwPackets := _ ; odnwState := _ |}. 512 | apply (@refl_trans_1n_trace_trans _ _ _ _ (failed', net)) => //. 513 | rewrite -(app_nil_r (_ :: _)). 514 | apply: (@RT1nTStep _ _ _ _ (failed', net')); last exact: RT1nTBase. 515 | apply: (StepOrderedDynamicFailure_input _ _ _ _ H5) => //. 516 | rewrite /input_handlers /= /unlabeled_input_handlers /=. 517 | repeat break_let. 518 | by tuple_inversion. 519 | - by have ->: tr' ++ [] = tr' by auto with datatypes. 520 | Qed. 521 | 522 | Lemma step_ordered_dynamic_failure_star_lb_step_execution : 523 | forall s, event_step_star step_ordered_dynamic_failure step_ordered_dynamic_failure_init (hd s) -> 524 | lb_step_execution lb_step_ordered_dynamic_failure s -> 525 | always (now (event_step_star step_ordered_dynamic_failure step_ordered_dynamic_failure_init)) s. 526 | Proof using. 527 | apply: step_star_lb_step_execution. 528 | exact: step_ordered_dynamic_failure_star_lb_step_reachable. 529 | Qed. 530 | End LabeledStepOrderDynamicFailure. 531 | 532 | #[global] 533 | Hint Extern 4 (@LabeledMultiParams _) => apply unlabeled_multi_params : typeclass_instances. 534 | -------------------------------------------------------------------------------- /theories/Core/NameOverlay.v: -------------------------------------------------------------------------------- 1 | From Verdi Require Import Verdi. 2 | From StructTact Require Import Fin. 3 | From Coq Require Import OrderedType. 4 | 5 | Module Type NameType. 6 | Parameter name : Type. 7 | Parameter name_eq_dec : forall x y : name, {x = y} + {x <> y}. 8 | Parameter nodes : list name. 9 | Parameter all_names_nodes : forall x, In x nodes. 10 | Parameter no_dup_nodes : NoDup nodes. 11 | End NameType. 12 | 13 | Module Type FinNameType (Import N : NatValue) <: NameType. 14 | Definition name := fin n. 15 | Definition name_eq_dec := fin_eq_dec n. 16 | Parameter nodes : list (fin n). 17 | Parameter all_names_nodes : forall x, In x nodes. 18 | Parameter no_dup_nodes : NoDup nodes. 19 | End FinNameType. 20 | 21 | Module FinName (Import N : NatValue) <: FinNameType N. 22 | Definition name := fin n. 23 | Definition name_eq_dec := fin_eq_dec n. 24 | Definition nodes := all_fin n. 25 | Definition all_names_nodes := all_fin_all n. 26 | Definition no_dup_nodes := all_fin_NoDup n. 27 | End FinName. 28 | 29 | Module Type NameOrderedTypeCompat (Import NT : NameType) <: OrderedType. 30 | Definition t := name. 31 | Definition eq := @eq name. 32 | Parameter lt : name -> name -> Prop. 33 | Definition eq_refl := @eq_refl name. 34 | Definition eq_sym := @eq_sym name. 35 | Definition eq_trans := @eq_trans name. 36 | Parameter lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. 37 | Parameter lt_not_eq : forall x y : t, lt x y -> ~ eq x y. 38 | Parameter compare : forall x y : t, Compare lt eq x y. 39 | Definition eq_dec := name_eq_dec. 40 | End NameOrderedTypeCompat. 41 | 42 | Module FinNameOrderedTypeCompat (N : NatValue) (FN : FinNameType N) <: NameOrderedTypeCompat FN := fin_OT_compat N. 43 | 44 | From Coq Require Import MSetInterface. 45 | 46 | Module Type NameOrderedType (Import NT : NameType) <: OrderedType. 47 | Definition t := name. 48 | Definition eq := @eq name. 49 | Definition eq_equiv := @eq_equivalence name. 50 | Parameter lt : name -> name -> Prop. 51 | Parameter lt_strorder : StrictOrder lt. 52 | Parameter lt_compat : Proper (eq==>eq==>iff) lt. 53 | Parameter compare : forall x y : name, comparison. 54 | Parameter compare_spec : forall x y, CompSpec eq lt x y (compare x y). 55 | Definition eq_dec := name_eq_dec. 56 | End NameOrderedType. 57 | 58 | Module FinNameOrderedType (N : NatValue) (FN : FinNameType N) <: NameOrderedType FN := fin_OT N. 59 | 60 | Module Type AdjacentNameType (Import NT : NameType). 61 | Parameter adjacent_to : relation name. 62 | Parameter adjacent_to_dec : forall x y : name, {adjacent_to x y} + {~ adjacent_to x y}. 63 | Parameter adjacent_to_symmetric : Symmetric adjacent_to. 64 | Parameter adjacent_to_irreflexive : Irreflexive adjacent_to. 65 | End AdjacentNameType. 66 | 67 | Module Type RootNameType (Import NT : NameType). 68 | Parameter root : name -> Prop. 69 | Parameter root_dec : forall n, {root n} + {~ root n}. 70 | Parameter root_unique : forall n n', root n -> root n' -> n = n'. 71 | End RootNameType. 72 | 73 | Module FinCompleteAdjacentNameType (Import N : NatValue) (FN : FinNameType N) <: AdjacentNameType FN. 74 | Inductive fin_complete : fin n -> fin n -> Prop := 75 | | fin_complete_neq : forall x y, x <> y -> fin_complete x y. 76 | 77 | Definition adjacent_to : relation (fin n) := fin_complete. 78 | 79 | Definition adjacent_to_dec : forall x y, {adjacent_to x y} + { ~ adjacent_to x y}. 80 | intros x y. 81 | case (fin_eq_dec n x y); intro H_eq. 82 | - rewrite H_eq. 83 | right. 84 | intros H_r. 85 | inversion H_r. 86 | auto. 87 | - left. 88 | apply fin_complete_neq. 89 | auto. 90 | Defined. 91 | 92 | Lemma adjacent_to_symmetric : Symmetric adjacent_to. 93 | Proof. 94 | unfold Symmetric. 95 | intros x y H_r. 96 | inversion H_r; subst. 97 | apply fin_complete_neq. 98 | intro H_eq. 99 | rewrite H_eq in H. 100 | auto. 101 | Qed. 102 | 103 | Lemma adjacent_to_irreflexive : Irreflexive adjacent_to. 104 | Proof. 105 | unfold Irreflexive; unfold Reflexive; unfold complement. 106 | intros x H_x. 107 | inversion H_x. 108 | auto. 109 | Qed. 110 | End FinCompleteAdjacentNameType. 111 | 112 | Module FinRootNameType (Import N : NatValue) (FN : FinNameType N) <: RootNameType FN. 113 | Definition root (x : fin n) := fin_to_nat x = 0. 114 | 115 | Definition root_dec (x : fin n) := Nat.eq_dec (fin_to_nat x) 0. 116 | 117 | Lemma root_unique : forall x y, root x -> root y -> x = y. 118 | Proof. 119 | intros x y. 120 | unfold root. 121 | intros H_x H_y. 122 | case (fin_compare n x y); intro cmp; case cmp; intro H_cmp. 123 | - inversion H_cmp; auto. 124 | - inversion H_cmp. 125 | unfold fin_lt in H. 126 | rewrite H_x in H. 127 | rewrite H_y in H. 128 | contradict H. 129 | auto with arith. 130 | - inversion H_cmp. 131 | unfold fin_lt in H. 132 | rewrite H_x in H. 133 | rewrite H_y in H. 134 | contradict H. 135 | auto with arith. 136 | Qed. 137 | End FinRootNameType. 138 | -------------------------------------------------------------------------------- /theories/Core/SingleSimulations.v: -------------------------------------------------------------------------------- 1 | From Verdi Require Import Verdi DynamicNetLemmas. 2 | From Verdi Require Import Ssrexport. 3 | 4 | Set Implicit Arguments. 5 | 6 | Class MultiSingleParamsTotalMap 7 | (B0 : BaseParams) (P0 : MultiParams B0) (B1 : BaseParams) := 8 | { 9 | tot_s_map_data : @data B0 -> @data B1 ; 10 | tot_s_map_input : name -> @input B0 -> @input B1 ; 11 | tot_s_map_output : @output B0 -> @output B1 ; 12 | tot_s_map_msg : name -> name -> msg -> @input B1 13 | }. 14 | 15 | Class MultiSingleParamsTotalMapCongruency 16 | (B0 : BaseParams) (B1 : BaseParams) 17 | (P0 : MultiParams B0) (P1 : SingleParams B1) 18 | (M : MultiSingleParamsTotalMap P0 B1) (me : name) : Prop := 19 | { 20 | tot_s_init_handlers_eq : tot_s_map_data (init_handlers me) = init_handler ; 21 | tot_s_input_handlers_eq : forall inp st out st' ps out' st'', 22 | input_handlers me inp st = (out, st', ps) -> 23 | input_handler (tot_s_map_input me inp) (tot_s_map_data st) = (out', st'') -> 24 | map tot_s_map_output out = out' /\ tot_s_map_data st' = st'' 25 | }. 26 | 27 | Section SingleSimulations. 28 | 29 | Context {base_fst : BaseParams}. 30 | Context {base_snd : BaseParams}. 31 | Context {multi : MultiParams base_fst}. 32 | Context {overlay : NameOverlayParams multi}. 33 | Context {fail_msg : FailMsgParams multi}. 34 | Context {single : SingleParams base_snd}. 35 | Context {tot_map : MultiSingleParamsTotalMap multi base_snd}. 36 | Context {me : name} {map_congr : MultiSingleParamsTotalMapCongruency single tot_map me}. 37 | 38 | Definition step_ordered_failure_tot_s_net_handlers_eq := 39 | forall net failed tr src m ms out st' ps out' st'', 40 | step_ordered_failure_star step_ordered_failure_init (failed, net) tr -> 41 | onwPackets net src me = m :: ms -> 42 | ~ In me failed -> 43 | net_handlers me src m (onwState net me) = (out, st', ps) -> 44 | input_handler (tot_s_map_msg me src m) (tot_s_map_data (onwState net me)) = (out', st'') -> 45 | map tot_s_map_output out = out' /\ tot_s_map_data st' = st''. 46 | 47 | Theorem step_ordered_failure_tot_one_mapped_simulation_1 : 48 | step_ordered_failure_tot_s_net_handlers_eq -> 49 | forall net net' failed failed' tr tr', 50 | step_ordered_failure_star step_ordered_failure_init (failed, net) tr -> 51 | step_ordered_failure (failed, net) (failed', net') tr' -> 52 | net.(onwState) me = net'.(onwState) me \/ 53 | exists tr'', @step_s _ single (tot_s_map_data (net.(onwState) me)) (tot_s_map_data (net'.(onwState) me)) tr''. 54 | Proof using map_congr. 55 | move => H_net_eq net net' failed failed' tr tr' H_star H_step. 56 | invcs H_step. 57 | - rewrite /update. 58 | break_if; last by left. 59 | right. 60 | subst_max. 61 | destruct (input_handler (tot_s_map_msg me from m) (tot_s_map_data (onwState net me))) eqn:?. 62 | have H_eq := H_net_eq _ _ _ _ _ _ _ _ _ _ _ H_star H3 H4 H5 Heqp. 63 | break_and. 64 | exists (inl (tot_s_map_msg me from m) :: (map inr l0)). 65 | apply: SST_deliver => //=. 66 | by rewrite Heqp H0. 67 | - rewrite /update. 68 | break_if; last by left. 69 | right. 70 | subst_max. 71 | destruct (input_handler (tot_s_map_input me inp) (tot_s_map_data (onwState net me))) eqn:?. 72 | have H_eq_inp := @tot_s_input_handlers_eq _ _ _ _ _ _ map_congr _ _ _ _ _ _ _ H4 Heqp. 73 | break_and. 74 | exists (inl (tot_s_map_input me inp) :: map inr l0). 75 | apply: SST_deliver => //=. 76 | by rewrite Heqp H0. 77 | - by left. 78 | Qed. 79 | 80 | Lemma step_ordered_failure_tot_one_mapped_simulation_star_1 : 81 | step_ordered_failure_tot_s_net_handlers_eq -> 82 | forall net failed tr, 83 | step_ordered_failure_star step_ordered_failure_init (failed, net) tr -> 84 | exists tr', @step_s_star _ single init_handler (tot_s_map_data (net.(onwState) me)) tr'. 85 | Proof using map_congr. 86 | move => H_net_eq net failed tr H_st. 87 | have ->: net = snd (failed, net) by []. 88 | remember step_ordered_failure_init as y in H_st. 89 | move: Heqy. 90 | induction H_st using refl_trans_1n_trace_n1_ind => /= H_init. 91 | rewrite H_init /=. 92 | exists []. 93 | rewrite tot_s_init_handlers_eq. 94 | exact: RT1nTBase. 95 | concludes. 96 | rewrite H_init {H_init x} in H_st1 H_st2. 97 | case: x' H IHH_st1 H_st1 => failed' net'. 98 | case: x'' H_st2 => failed'' net''. 99 | rewrite /=. 100 | move => H_step2 H IHH_step1 H_step1. 101 | have [tr' H_star] := IHH_step1. 102 | have H_st := step_ordered_failure_tot_one_mapped_simulation_1 H_net_eq H_step1 H. 103 | case: H_st => H_st; first by rewrite -H_st; exists tr'. 104 | have [tr'' H_st'] := H_st. 105 | exists (tr' ++ tr''). 106 | apply: (refl_trans_1n_trace_trans H_star). 107 | have ->: tr'' = tr'' ++ [] by rewrite app_nil_r. 108 | apply RT1nTStep with (x' := (tot_s_map_data (onwState net'' me))) => //. 109 | exact: RT1nTBase. 110 | Qed. 111 | 112 | Context {new_msg : NewMsgParams multi}. 113 | 114 | Definition step_ordered_dynamic_failure_tot_s_net_handlers_eq := 115 | forall net failed tr src m ms d out st' ps out' st'', 116 | step_ordered_dynamic_failure_star step_ordered_dynamic_failure_init (failed, net) tr -> 117 | odnwPackets net src me = m :: ms -> 118 | ~ In me failed -> 119 | odnwState net me = Some d -> 120 | net_handlers me src m d = (out, st', ps) -> 121 | input_handler (tot_s_map_msg me src m) (tot_s_map_data d) = (out', st'') -> 122 | map tot_s_map_output out = out' /\ tot_s_map_data st' = st''. 123 | 124 | Theorem step_ordered_dynamic_failure_tot_one_mapped_simulation_1 : 125 | step_ordered_dynamic_failure_tot_s_net_handlers_eq -> 126 | forall net net' failed failed' tr tr', 127 | step_ordered_dynamic_failure_star step_ordered_dynamic_failure_init (failed, net) tr -> 128 | step_ordered_dynamic_failure (failed, net) (failed', net') tr' -> 129 | forall d, net.(odnwState) me = Some d -> 130 | forall d', net'.(odnwState) me = Some d' -> 131 | d = d' \/ exists tr'', @step_s _ single (tot_s_map_data d) (tot_s_map_data d') tr''. 132 | Proof using map_congr. 133 | move => H_net_eq net net' failed failed' tr tr' H_star H_step d H_eq d' H_eq'. 134 | invcs H_step. 135 | - left. 136 | have H_neq: h <> me. 137 | move => H_n. 138 | rewrite -H_n in H_eq. 139 | have H_eq_n := ordered_dynamic_uninitialized_state H_star _ H4. 140 | by congruence. 141 | move: H_eq'. 142 | rewrite /update. 143 | break_if; first by find_rewrite. 144 | by congruence. 145 | - move: H_eq'. 146 | rewrite /update. 147 | break_if => H_eq'; last by left; congruence. 148 | right. 149 | find_injection. 150 | rewrite H_eq in H5. 151 | find_injection. 152 | destruct (input_handler (tot_s_map_msg me from m) (tot_s_map_data d0)) eqn:?. 153 | have H_eq_st := H_net_eq _ _ _ _ _ _ _ _ _ _ _ _ H_star H6 H3 H_eq H7 Heqp. 154 | break_and. 155 | exists (inl (tot_s_map_msg me from m) :: (map inr l0)). 156 | apply: SST_deliver => //=. 157 | by rewrite Heqp H0. 158 | - move: H_eq'. 159 | rewrite /update. 160 | break_if => H_eq'; last by left; rewrite H_eq in H_eq'; find_injection. 161 | right. 162 | find_injection. 163 | rewrite H_eq in H5. 164 | find_injection. 165 | destruct (input_handler (tot_s_map_input me inp) (tot_s_map_data d0)) eqn:?. 166 | have H_eq_inp := @tot_s_input_handlers_eq _ _ _ _ _ _ map_congr _ _ _ _ _ _ _ H6 Heqp. 167 | break_and. 168 | exists (inl (tot_s_map_input me inp) :: map inr l0). 169 | apply: SST_deliver => //=. 170 | by rewrite Heqp H0. 171 | - left. 172 | find_rewrite. 173 | by find_injection. 174 | Qed. 175 | 176 | Lemma step_ordered_dynamic_failure_tot_one_mapped_simulation_1_init : 177 | forall net net' failed failed' tr, 178 | step_ordered_dynamic_failure (failed, net) (failed', net') tr -> 179 | net.(odnwState) me = None -> 180 | forall d, net'.(odnwState) me = Some d -> 181 | tot_s_map_data d = init_handler. 182 | Proof using map_congr. 183 | move => net net' failed failed' tr H_st H_eq d H_eq'. 184 | invcs H_st => //=. 185 | - move: H_eq'. 186 | rewrite /update. 187 | break_if => H_eq'; last by congruence. 188 | find_injection. 189 | by rewrite tot_s_init_handlers_eq. 190 | - move: H_eq'. 191 | rewrite /update. 192 | by break_if => H_eq'; congruence. 193 | - move: H_eq'. 194 | rewrite /update. 195 | by break_if => H_eq'; congruence. 196 | - by congruence. 197 | Qed. 198 | 199 | Lemma step_ordered_dynamic_failure_tot_one_mapped_simulation_star_1 : 200 | step_ordered_dynamic_failure_tot_s_net_handlers_eq -> 201 | forall net failed tr, 202 | step_ordered_dynamic_failure_star step_ordered_dynamic_failure_init (failed, net) tr -> 203 | forall d, net.(odnwState) me = Some d -> 204 | exists tr', @step_s_star _ single init_handler (tot_s_map_data d) tr'. 205 | Proof using map_congr. 206 | move => H_net_eq net failed tr H_st. 207 | have ->: net = snd (failed, net) by []. 208 | remember step_ordered_dynamic_failure_init as y in H_st. 209 | move: Heqy. 210 | induction H_st using refl_trans_1n_trace_n1_ind => /= H_init; first by rewrite H_init. 211 | concludes. 212 | rewrite H_init {H_init x} in H_st1 H_st2. 213 | case: x' H IHH_st1 H_st1 => failed' net'. 214 | case: x'' H_st2 => failed'' net''. 215 | rewrite /=. 216 | move => H_step2 H IHH_step1 H_step1 d H_eq. 217 | case H_eq': (odnwState net' me) => [d'|]; last first. 218 | exists []. 219 | have H_eq_i := step_ordered_dynamic_failure_tot_one_mapped_simulation_1_init H H_eq' H_eq. 220 | rewrite H_eq_i. 221 | exact: RT1nTBase. 222 | have [tr' H_star] := IHH_step1 _ H_eq'. 223 | have H_st := step_ordered_dynamic_failure_tot_one_mapped_simulation_1 H_net_eq H_step1 H H_eq' H_eq. 224 | case: H_st => H_st; first by rewrite -H_st; exists tr'. 225 | have [tr'' H_st'] := H_st. 226 | exists (tr' ++ tr''). 227 | apply: (refl_trans_1n_trace_trans H_star). 228 | have ->: tr'' = tr'' ++ [] by rewrite app_nil_r. 229 | apply RT1nTStep with (x' := (tot_s_map_data d)) => //. 230 | exact: RT1nTBase. 231 | Qed. 232 | 233 | End SingleSimulations. 234 | -------------------------------------------------------------------------------- /theories/Core/StateMachineHandlerMonad.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import List. 2 | 3 | (* 4 | This file is very similar to HandlerMonad.v, but supports step_1 5 | handlers. It's just a state monad: no sending messages allowed. The 6 | output of the handler is a singleton instead of a list and is given as 7 | the return value. 8 | *) 9 | 10 | Definition GenHandler1 (S A : Type) : Type := S -> A * S % type. 11 | 12 | Definition ret {S A : Type} (a : A) : GenHandler1 S A := fun s => (a, s). 13 | 14 | Definition bind {S A B : Type} (m : GenHandler1 S A) (f : A -> GenHandler1 S B) : GenHandler1 S B := 15 | fun s => 16 | let '(a, s') := m s in 17 | let '(b, s'') := f a s' in 18 | (b, s''). 19 | 20 | (* alias for ret *) 21 | Definition write_output {S O} (o : O) : GenHandler1 S O := ret o. 22 | 23 | Definition modify {S} (f : S -> S) : GenHandler1 S unit := fun s => (tt, f s). 24 | 25 | Definition put {S} (s : S) : GenHandler1 S unit := fun _ => (tt, s). 26 | 27 | Definition get {S} : GenHandler1 S S := fun s => (s, s). 28 | 29 | Definition runGenHandler1 {S A} (s : S) (h : GenHandler1 S A) : 30 | A * S % type := 31 | h s. 32 | 33 | Definition nop {S : Type} := @ret S _ tt. 34 | 35 | Notation "a >> b" := (bind a (fun _ => b)) (at level 50). 36 | 37 | Notation "x <- c1 ;; c2" := (@bind _ _ _ c1 (fun x => c2)) 38 | (at level 100, c1 at next level, right associativity). 39 | 40 | Notation "e1 ;; e2" := (_ <- e1 ;; e2) 41 | (at level 100, right associativity). 42 | 43 | Definition when {S A} (b : bool) (m : GenHandler1 S A) : GenHandler1 S unit := 44 | if b then m ;; ret tt else nop. 45 | 46 | Ltac monad_unfold := 47 | repeat unfold 48 | runGenHandler1, 49 | bind, 50 | write_output, 51 | get, 52 | when, 53 | put, 54 | nop, 55 | modify, 56 | ret in *. 57 | -------------------------------------------------------------------------------- /theories/Core/StatePacketPacketDecomposition.v: -------------------------------------------------------------------------------- 1 | From Verdi Require Import Verdi. 2 | 3 | Local Arguments update {_} {_} _ _ _ _ _ : simpl never. 4 | 5 | Fixpoint distinct_pairs_and {A} (R : A -> A -> Prop) (l : list A) : Prop := 6 | match l with 7 | | [] => True 8 | | x :: xs => (forall y, In y xs -> R x y) /\ distinct_pairs_and R xs 9 | end. 10 | 11 | Class Decomposition (B : BaseParams) (M : MultiParams B) := 12 | { 13 | state_invariant : (name -> data) -> Prop; 14 | network_invariant : (name -> data) -> packet -> Prop; 15 | network_network_invariant : packet -> packet -> Prop; 16 | 17 | network_network_invariant_sym : 18 | forall p1 p2, 19 | network_network_invariant p1 p2 -> 20 | network_network_invariant p2 p1 ; 21 | 22 | state_invariant_init : state_invariant init_handlers; 23 | 24 | state_invariant_maintained_input : 25 | forall h inp sigma st' out ps, 26 | input_handlers h inp (sigma h) = (out, st', ps) -> 27 | state_invariant sigma -> 28 | state_invariant (update name_eq_dec sigma h st'); 29 | state_invariant_maintained_deliver : 30 | forall p sigma st' out ps, 31 | net_handlers (pDst p) (pSrc p) (pBody p) (sigma (pDst p)) = (out, st', ps) -> 32 | state_invariant sigma -> 33 | network_invariant sigma p -> 34 | state_invariant (update name_eq_dec sigma (pDst p) st'); 35 | 36 | network_invariant_maintained_input_old : 37 | forall h inp sigma st' out ps p, 38 | input_handlers h inp (sigma h) = (out, st', ps) -> 39 | state_invariant sigma -> 40 | network_invariant sigma p -> 41 | network_invariant (update name_eq_dec sigma h st') p; 42 | network_invariant_maintained_input_new : 43 | forall h inp sigma st' out ps p, 44 | input_handlers h inp (sigma h) = (out, st', ps) -> 45 | state_invariant sigma -> 46 | In (pDst p, pBody p) ps -> 47 | pSrc p = h -> 48 | network_invariant (update name_eq_dec sigma h st') p; 49 | 50 | network_invariant_maintained_deliver_old : 51 | forall sigma st' out ps p q, 52 | net_handlers (pDst p) (pSrc p) (pBody p) (sigma (pDst p)) = (out, st', ps) -> 53 | state_invariant sigma -> 54 | network_invariant sigma p -> 55 | network_invariant sigma q -> 56 | network_network_invariant p q -> 57 | network_invariant (update name_eq_dec sigma (pDst p) st') q; 58 | network_invariant_maintained_deliver_new : 59 | forall sigma st' out ps p p', 60 | net_handlers (pDst p) (pSrc p) (pBody p) (sigma (pDst p)) = (out, st', ps) -> 61 | state_invariant sigma -> 62 | network_invariant sigma p -> 63 | In (pDst p', pBody p') ps -> 64 | pSrc p' = pDst p -> 65 | network_invariant (update name_eq_dec sigma (pDst p) st') p'; 66 | 67 | network_network_invariant_maintained_input_old : 68 | forall h inp sigma st' out ps p p', 69 | input_handlers h inp (sigma h) = (out, st', ps) -> 70 | state_invariant sigma -> 71 | network_invariant sigma p -> 72 | In (pDst p', pBody p') ps -> 73 | pSrc p' = h -> 74 | network_network_invariant p p'; 75 | 76 | network_network_invariant_maintained_input_new : 77 | forall h inp sigma st' out ps, 78 | input_handlers h inp (sigma h) = (out, st', ps) -> 79 | state_invariant sigma -> 80 | distinct_pairs_and network_network_invariant (map (fun m => mkPacket h (fst m) (snd m)) ps); 81 | 82 | network_network_invariant_maintained_deliver_old : 83 | forall sigma st' out ps p p' q, 84 | net_handlers (pDst p) (pSrc p) (pBody p) (sigma (pDst p)) = (out, st', ps) -> 85 | state_invariant sigma -> 86 | network_invariant sigma p -> 87 | network_invariant sigma q -> 88 | network_network_invariant p q -> 89 | In (pDst p', pBody p') ps -> 90 | pSrc p' = pDst p -> 91 | network_network_invariant p' q; 92 | 93 | network_network_invariant_maintained_deliver_new : 94 | forall sigma st' out ps p, 95 | net_handlers (pDst p) (pSrc p) (pBody p) (sigma (pDst p)) = (out, st', ps) -> 96 | state_invariant sigma -> 97 | network_invariant sigma p -> 98 | distinct_pairs_and network_network_invariant (map (fun m => mkPacket (pDst p) (fst m) (snd m)) ps) 99 | }. 100 | 101 | Section Decomposition. 102 | Context `{d : Decomposition}. 103 | 104 | Definition packet_eq_dec : 105 | forall p1 p2 : packet, 106 | {p1 = p2} + {p1 <> p2}. 107 | Proof. 108 | intros. decide equality; eauto using name_eq_dec,msg_eq_dec. 109 | Defined. 110 | 111 | 112 | Definition composed_invariant net := 113 | (state_invariant (nwState net)) /\ 114 | (forall p, In p (nwPackets net) -> network_invariant (nwState net) p) /\ 115 | (distinct_pairs_and network_network_invariant (nwPackets net)). 116 | 117 | Lemma post_net_analyze_sent_packet : 118 | forall h p ms xs ys, 119 | In p (map (fun m => mkPacket h (fst m) (snd m)) ms ++ xs ++ ys) -> 120 | (In (pDst p, pBody p) ms /\ h = pSrc p) \/ In p (xs ++ ys). 121 | Proof using. 122 | intros. 123 | in_crush. destruct x; simpl in *; eauto. 124 | Qed. 125 | 126 | Lemma post_input_analyze_sent_packet : 127 | forall h p ms l, 128 | In p (map (fun m => mkPacket h (fst m) (snd m)) ms ++ l) -> 129 | (In (pDst p, pBody p) ms /\ h = pSrc p) \/ In p l. 130 | Proof using. 131 | intros. 132 | in_crush; destruct x; simpl in *; eauto. 133 | Qed. 134 | 135 | (* NB: generalizing this over R makes it useless to [eauto using] 136 | because the conclusion is too general. *) 137 | Lemma nw_nw_distinct_pairs_and_elim : 138 | forall xs a b ys l, 139 | l = xs ++ a :: ys -> 140 | In b (xs ++ ys) -> 141 | distinct_pairs_and network_network_invariant l -> 142 | network_network_invariant a b. 143 | Proof using. 144 | induction xs; intros; subst; simpl in *; intuition eauto; subst; eauto. 145 | apply network_network_invariant_sym. eauto. 146 | Qed. 147 | 148 | Lemma distinct_pairs_and_app_cons : 149 | forall A R xs p ys l, 150 | l = (xs ++ p :: ys) -> 151 | distinct_pairs_and (A:=A) R l -> 152 | distinct_pairs_and R (xs ++ ys). 153 | Proof using. 154 | induction xs; intros; subst; simpl in *; intuition eauto. 155 | Qed. 156 | 157 | Lemma distinct_pairs_and_app : 158 | forall A R l1 l2, 159 | distinct_pairs_and (A := A) R l1 -> 160 | distinct_pairs_and R l2 -> 161 | (forall x y, 162 | In x l1 -> 163 | In y l2 -> 164 | R x y) -> 165 | distinct_pairs_and R (l1 ++ l2). 166 | Proof using. 167 | induction l1; intros; simpl in *; intuition. 168 | find_apply_lem_hyp in_app_or. 169 | intuition eauto. 170 | Qed. 171 | 172 | Theorem decomposition_invariant : 173 | inductive_invariant step_async step_async_init composed_invariant. 174 | Proof using. 175 | unfold inductive_invariant. intuition. 176 | - unfold composed_invariant. simpl. 177 | intuition auto using state_invariant_init. 178 | - unfold inductive, composed_invariant. intros. 179 | match goal with H : step_async _ _ _ |- _ => invcs H end; intuition; simpl in *. 180 | + eauto using state_invariant_maintained_deliver. 181 | + find_apply_lem_hyp post_net_analyze_sent_packet. 182 | intuition 183 | eauto 10 using 184 | network_invariant_maintained_deliver_new, 185 | network_invariant_maintained_deliver_old, 186 | nw_nw_distinct_pairs_and_elim, 187 | network_network_invariant_sym. 188 | + apply distinct_pairs_and_app; 189 | eauto using network_network_invariant_maintained_deliver_new, distinct_pairs_and_app_cons. 190 | 191 | intros. do_in_map. subst. 192 | eapply network_network_invariant_maintained_deliver_old; 193 | eauto using nw_nw_distinct_pairs_and_elim. 194 | simpl; now rewrite <- surjective_pairing. 195 | + eauto using state_invariant_maintained_input. 196 | + find_apply_lem_hyp post_input_analyze_sent_packet. 197 | intuition 198 | eauto using network_invariant_maintained_input_new, 199 | network_invariant_maintained_input_old. 200 | + apply distinct_pairs_and_app; 201 | eauto using network_network_invariant_maintained_input_new. 202 | intros. 203 | do_in_map. subst. 204 | apply network_network_invariant_sym. 205 | eapply network_network_invariant_maintained_input_old; eauto. 206 | simpl. now rewrite <- surjective_pairing. 207 | Qed. 208 | End Decomposition. 209 | -------------------------------------------------------------------------------- /theories/Core/TotalMapExecutionSimulations.v: -------------------------------------------------------------------------------- 1 | From Verdi Require Import Verdi LabeledNet TotalMapSimulations. 2 | From InfSeqExt Require Import infseq map exteq. 3 | From Coq Require Import FunctionalExtensionality. 4 | From Verdi Require Import Ssrexport. 5 | 6 | Local Arguments update {_} {_} _ _ _ _ _ : simpl never. 7 | 8 | Set Implicit Arguments. 9 | 10 | Class LabeledMultiParamsLabelTotalMap 11 | (B0 : BaseParams) (B1 : BaseParams) 12 | (P0 : LabeledMultiParams B0) (P1 : LabeledMultiParams B1) := 13 | { 14 | tot_map_label : @label B0 P0 -> @label B1 P1 15 | }. 16 | 17 | Section LabeledTotalMapDefs. 18 | 19 | Context {base_fst : BaseParams}. 20 | Context {base_snd : BaseParams}. 21 | Context {labeled_multi_fst : LabeledMultiParams base_fst}. 22 | Context {labeled_multi_snd : LabeledMultiParams base_snd}. 23 | Context {label_map : LabeledMultiParamsLabelTotalMap labeled_multi_fst labeled_multi_snd}. 24 | 25 | Definition tot_mapped_lb_net_handlers_label me src m st := 26 | let '(lb, out, st', ps) := lb_net_handlers me src m st in tot_map_label lb. 27 | 28 | Definition tot_mapped_lb_input_handlers_label me inp st := 29 | let '(lb, out, st', ps) := lb_input_handlers me inp st in tot_map_label lb. 30 | 31 | End LabeledTotalMapDefs. 32 | 33 | Class LabeledMultiParamsTotalMapCongruency 34 | (B0 : BaseParams) (B1 : BaseParams) 35 | (P0 : LabeledMultiParams B0) (P1 : LabeledMultiParams B1) 36 | (B : BaseParamsTotalMap B0 B1) 37 | (N : MultiParamsNameTotalMap (@unlabeled_multi_params _ P0) (@unlabeled_multi_params _ P1)) 38 | (P : MultiParamsMsgTotalMap (@unlabeled_multi_params _ P0) (@unlabeled_multi_params _ P1)) 39 | (L : LabeledMultiParamsLabelTotalMap P0 P1) : Prop := 40 | { 41 | tot_lb_net_handlers_eq : forall me src m st out st' ps lb, 42 | lb_net_handlers (tot_map_name me) (tot_map_name src) (tot_map_msg m) (tot_map_data st) = (lb, out, st', ps) -> 43 | tot_mapped_lb_net_handlers_label me src m st = lb ; 44 | tot_lb_input_handlers_eq : forall me inp st out st' ps lb, 45 | lb_input_handlers (tot_map_name me) (tot_map_input inp) (tot_map_data st) = (lb, out, st', ps) -> 46 | tot_mapped_lb_input_handlers_label me inp st = lb ; 47 | tot_lb_label_silent_fst_snd : tot_map_label label_silent = label_silent 48 | }. 49 | 50 | Section TotalMapExecutionSimulations. 51 | 52 | Context {base_fst : BaseParams}. 53 | Context {base_snd : BaseParams}. 54 | Context {labeled_multi_fst : LabeledMultiParams base_fst}. 55 | Context {labeled_multi_snd : LabeledMultiParams base_snd}. 56 | Context {base_map : BaseParamsTotalMap base_fst base_snd}. 57 | Context {name_map : MultiParamsNameTotalMap (@unlabeled_multi_params _ labeled_multi_fst) (@unlabeled_multi_params _ labeled_multi_snd)}. 58 | Context {msg_map : MultiParamsMsgTotalMap (@unlabeled_multi_params _ labeled_multi_fst) (@unlabeled_multi_params _ labeled_multi_snd)}. 59 | Context {label_map : LabeledMultiParamsLabelTotalMap labeled_multi_fst labeled_multi_snd}. 60 | Context {name_map_bijective : MultiParamsNameTotalMapBijective name_map}. 61 | Context {multi_map_congr : MultiParamsTotalMapCongruency base_map name_map msg_map}. 62 | Context {multi_map_lb_congr : LabeledMultiParamsTotalMapCongruency base_map name_map msg_map label_map}. 63 | 64 | Hypothesis tot_map_label_injective : 65 | forall l l', tot_map_label l = tot_map_label l' -> l = l'. 66 | 67 | (* lb_step_failure *) 68 | 69 | Theorem lb_step_failure_tot_mapped_simulation_1 : 70 | forall net net' failed failed' lb tr, 71 | @lb_step_failure _ labeled_multi_fst (failed, net) lb (failed', net') tr -> 72 | @lb_step_failure _ labeled_multi_snd (List.map tot_map_name failed, tot_map_net net) (tot_map_label lb) (List.map tot_map_name failed', tot_map_net net') (List.map tot_map_trace_occ tr). 73 | Proof using name_map_bijective multi_map_lb_congr multi_map_congr. 74 | move => net net' failed failed' lb tr H_step. 75 | invcs H_step => //=. 76 | - have ->: tot_map_name (pDst p) = pDst (tot_map_packet p) by destruct p. 77 | apply: (@LabeledStepFailure_deliver _ _ _ _ _ _ (List.map tot_map_packet xs) (List.map tot_map_packet ys) (List.map tot_map_output out) (tot_map_data d) (@tot_map_name_msgs _ _ _ _ _ msg_map l)). 78 | * rewrite /tot_map_net /=. 79 | find_rewrite. 80 | by rewrite map_app. 81 | * destruct p. 82 | simpl in *. 83 | exact: not_in_failed_not_in. 84 | * destruct p. 85 | simpl in *. 86 | rewrite tot_map_name_inv_inverse. 87 | have H_q := @tot_net_handlers_eq _ _ _ _ _ _ _ multi_map_congr pDst pSrc pBody (nwState net pDst). 88 | rewrite /tot_mapped_net_handlers /net_handlers /= /unlabeled_net_handlers in H_q. 89 | repeat break_let. 90 | repeat tuple_inversion. 91 | have H_q' := @tot_lb_net_handlers_eq _ _ _ _ _ _ _ _ multi_map_lb_congr _ _ _ _ _ _ _ _ Heqp1. 92 | rewrite /tot_mapped_lb_net_handlers_label in H_q'. 93 | repeat break_let. 94 | by repeat tuple_inversion. 95 | * rewrite /tot_map_net /= 2!map_app -(@tot_map_update_packet_eq _ _ _ _ _ _ _ name_map_bijective). 96 | destruct p. 97 | by rewrite tot_map_packet_map_eq. 98 | - apply: (@LabeledStepFailure_input _ _ _ _ _ _ _ _ (tot_map_data d) (tot_map_name_msgs l)). 99 | * exact: not_in_failed_not_in. 100 | * rewrite /tot_map_net /= tot_map_name_inv_inverse. 101 | have H_q := @tot_input_handlers_eq _ _ _ _ _ _ _ multi_map_congr h inp (nwState net h). 102 | rewrite /tot_mapped_input_handlers /= /unlabeled_input_handlers in H_q. 103 | repeat break_let. 104 | repeat tuple_inversion. 105 | have H_q' := @tot_lb_input_handlers_eq _ _ _ _ _ _ _ _ multi_map_lb_congr _ _ _ _ _ _ _ Heqp1. 106 | rewrite /tot_mapped_lb_input_handlers_label in H_q'. 107 | repeat break_let. 108 | by repeat tuple_inversion. 109 | * by rewrite /tot_map_net /= map_app tot_map_packet_map_eq -(@tot_map_update_eq _ _ _ _ _ _ name_map_bijective). 110 | - rewrite tot_lb_label_silent_fst_snd. 111 | exact: LabeledStepFailure_stutter. 112 | Qed. 113 | 114 | Definition tot_map_net_event e := 115 | {| evt_a := (List.map tot_map_name (fst e.(evt_a)), tot_map_net (snd e.(evt_a))) ; 116 | evt_l := tot_map_label e.(evt_l) ; 117 | evt_trace := List.map tot_map_trace_occ e.(evt_trace) |}. 118 | 119 | Lemma tot_map_net_event_map_unfold : forall s, 120 | Cons (tot_map_net_event (hd s)) (map tot_map_net_event (tl s)) = map tot_map_net_event s. 121 | Proof using. 122 | by move => s; rewrite -map_Cons /= -{3}(recons s). 123 | Qed. 124 | 125 | Lemma lb_step_trace_execution_lb_step_failure_tot_map_net_infseq : forall s, 126 | lb_step_execution lb_step_failure s -> 127 | lb_step_execution lb_step_failure (map tot_map_net_event s). 128 | Proof using name_map_bijective multi_map_lb_congr multi_map_congr. 129 | cofix c. 130 | move => s H_exec. 131 | rewrite -tot_map_net_event_map_unfold {1}/tot_map_net_event /=. 132 | inversion H_exec; subst => /=. 133 | rewrite -tot_map_net_event_map_unfold /= /tot_map_net_event /=. 134 | apply: (@Cons_lb_step_exec _ _ _ _ _ _ (List.map tot_map_trace_occ tr)) => /=. 135 | - apply: lb_step_failure_tot_mapped_simulation_1. 136 | have <-: evt_a e = (fst (evt_a e), snd (evt_a e)) by destruct e, evt_a. 137 | by have <-: evt_a e' = (fst (evt_a e'), snd (evt_a e')) by destruct e', evt_a. 138 | - simpl in *. 139 | find_rewrite. 140 | by rewrite map_app. 141 | - pose s' := Cons e' s0. 142 | rewrite (tot_map_net_event_map_unfold s'). 143 | exact: c. 144 | Qed. 145 | 146 | Lemma tot_map_net_label_event_inf_often_occurred : 147 | forall l s, 148 | inf_often (now (occurred l)) s -> 149 | inf_often (now (occurred (tot_map_label l))) (map tot_map_net_event s). 150 | Proof using. 151 | move => l. 152 | apply: always_map. 153 | apply: eventually_map. 154 | case => e s. 155 | rewrite /= /occurred /=. 156 | move => H_eq. 157 | by rewrite H_eq. 158 | Qed. 159 | 160 | Lemma tot_map_net_label_event_inf_often_occurred_conv : 161 | forall l s, 162 | inf_often (now (occurred (tot_map_label l))) (map tot_map_net_event s) -> 163 | inf_often (now (occurred l)) s. 164 | Proof using tot_map_label_injective. 165 | move => l. 166 | apply: always_map_conv. 167 | apply: eventually_map_conv => //. 168 | - rewrite /extensional /=. 169 | case => e s1. 170 | case => e' s2. 171 | move => H_eq. 172 | by inversion H_eq; subst_max. 173 | - rewrite /extensional /=. 174 | case => e s1. 175 | case => e' s2. 176 | move => H_eq. 177 | by inversion H_eq; subst_max. 178 | - case => e s. 179 | rewrite /= /occurred /=. 180 | move => H_eq. 181 | exact: tot_map_label_injective. 182 | Qed. 183 | 184 | Context {fail_fst : FailureParams (@unlabeled_multi_params _ labeled_multi_fst)}. 185 | Context {fail_snd : FailureParams (@unlabeled_multi_params _ labeled_multi_snd)}. 186 | Context {fail_map_congr : FailureParamsTotalMapCongruency fail_fst fail_snd base_map}. 187 | 188 | Lemma tot_map_net_hd_step_failure_star_always : 189 | forall s, event_step_star step_failure step_failure_init (hd s) -> 190 | lb_step_execution lb_step_failure s -> 191 | always (now (event_step_star step_failure step_failure_init)) (map tot_map_net_event s). 192 | Proof using name_map_bijective multi_map_lb_congr multi_map_congr fail_map_congr. 193 | case => e s H_star H_exec. 194 | apply: step_failure_star_lb_step_execution. 195 | rewrite /=. 196 | rewrite /tot_map_net_event /= /event_step_star /=. 197 | apply: step_failure_tot_mapped_simulation_star_1. 198 | by have <-: evt_a e = (fst (evt_a e), snd (evt_a e)) by destruct e, evt_a. 199 | exact: lb_step_trace_execution_lb_step_failure_tot_map_net_infseq. 200 | Qed. 201 | 202 | (* lb_step_ordered_failure *) 203 | 204 | Theorem lb_step_ordered_failure_tot_mapped_simulation_1 : 205 | forall net net' failed failed' lb tr, 206 | @lb_step_ordered_failure _ labeled_multi_fst (failed, net) lb (failed', net') tr -> 207 | @lb_step_ordered_failure _ labeled_multi_snd (List.map tot_map_name failed, tot_map_onet net) (tot_map_label lb) (List.map tot_map_name failed', tot_map_onet net') (List.map tot_map_trace tr). 208 | Proof using name_map_bijective multi_map_lb_congr multi_map_congr. 209 | move => net net' failed failed' lb tr H_step. 210 | invcs H_step => //=. 211 | - apply (@LabeledStepOrderedFailure_deliver _ _ _ _ _ _ (@tot_map_msg _ _ _ _ msg_map m) (List.map (@tot_map_msg _ _ _ _ msg_map) ms) (List.map tot_map_output out) (tot_map_data d) (@tot_map_name_msgs _ _ _ _ _ msg_map l) (@tot_map_name _ _ _ _ name_map from) (@tot_map_name _ _ _ _ name_map to)) => //=. 212 | * rewrite /tot_map_onet /=. 213 | rewrite 2!tot_map_name_inv_inverse. 214 | by find_rewrite. 215 | * exact: not_in_failed_not_in. 216 | * rewrite /tot_map_onet /= tot_map_name_inv_inverse. 217 | have H_q := @tot_net_handlers_eq _ _ _ _ _ _ _ multi_map_congr to from m (onwState net to). 218 | rewrite /tot_mapped_net_handlers /net_handlers /= /unlabeled_net_handlers in H_q. 219 | repeat break_let. 220 | repeat tuple_inversion. 221 | have H_q' := @tot_lb_net_handlers_eq _ _ _ _ _ _ _ _ multi_map_lb_congr _ _ _ _ _ _ _ _ Heqp1. 222 | rewrite /tot_mapped_lb_net_handlers_label in H_q'. 223 | repeat break_let. 224 | by repeat tuple_inversion. 225 | * rewrite /tot_map_onet /=. 226 | rewrite (@collate_tot_map_update2_eq _ _ _ _ _ _ name_map_bijective). 227 | set f1 := fun _ => tot_map_data _. 228 | set f2 := update _ _ _ _. 229 | have H_eq_f: f1 = f2. 230 | rewrite /f1 /f2. 231 | apply functional_extensionality => n. 232 | rewrite /update. 233 | break_if; break_if => //; first by rewrite -e tot_map_name_inverse_inv in n0. 234 | by rewrite e tot_map_name_inv_inverse in n0. 235 | by rewrite H_eq_f. 236 | * by rewrite (@map_tot_map_trace_eq _ _ _ _ _ name_map). 237 | - rewrite /tot_map_onet /=. 238 | apply (@LabeledStepOrderedFailure_input _ _ (@tot_map_name _ _ _ _ name_map h) _ _ _ _ (List.map tot_map_output out) (tot_map_input inp) (tot_map_data d) (@tot_map_name_msgs _ _ _ _ _ msg_map l)). 239 | * exact: not_in_failed_not_in. 240 | * rewrite /tot_map_onet /= tot_map_name_inv_inverse. 241 | have H_q := @tot_input_handlers_eq _ _ _ _ _ _ _ multi_map_congr h inp (onwState net h). 242 | rewrite /tot_mapped_input_handlers /= /unlabeled_input_handlers in H_q. 243 | repeat break_let. 244 | repeat tuple_inversion. 245 | have H_q' := @tot_lb_input_handlers_eq _ _ _ _ _ _ _ _ multi_map_lb_congr _ _ _ _ _ _ _ Heqp1. 246 | rewrite /tot_mapped_lb_input_handlers_label in H_q'. 247 | repeat break_let. 248 | by repeat tuple_inversion. 249 | * rewrite /tot_map_onet /=. 250 | rewrite (@collate_tot_map_eq _ _ _ _ _ _ name_map_bijective). 251 | set f1 := fun _ => tot_map_data _. 252 | set f2 := update _ _ _ _. 253 | have H_eq_f: f1 = f2. 254 | rewrite /f1 /f2. 255 | apply functional_extensionality => n. 256 | rewrite /update. 257 | break_if; break_if => //; first by rewrite -e tot_map_name_inverse_inv in n0. 258 | by rewrite e tot_map_name_inv_inverse in n0. 259 | by rewrite H_eq_f. 260 | * by rewrite (@map_tot_map_trace_eq _ _ _ _ _ name_map). 261 | - rewrite tot_lb_label_silent_fst_snd. 262 | exact: LabeledStepOrderedFailure_stutter. 263 | Qed. 264 | 265 | Definition tot_map_onet_event e := 266 | {| evt_a := (List.map tot_map_name (fst e.(evt_a)), tot_map_onet (snd e.(evt_a))) ; 267 | evt_l := tot_map_label e.(evt_l) ; 268 | evt_trace := List.map tot_map_trace e.(evt_trace) |}. 269 | 270 | Lemma tot_map_onet_event_map_unfold : forall s, 271 | Cons (tot_map_onet_event (hd s)) (map tot_map_onet_event (tl s)) = map tot_map_onet_event s. 272 | Proof using. 273 | by move => s; rewrite -map_Cons /= -{3}(recons s). 274 | Qed. 275 | 276 | Lemma lb_step_execution_lb_step_ordered_failure_tot_map_onet_infseq : forall s, 277 | lb_step_execution lb_step_ordered_failure s -> 278 | lb_step_execution lb_step_ordered_failure (map tot_map_onet_event s). 279 | Proof using name_map_bijective multi_map_lb_congr multi_map_congr. 280 | cofix c. 281 | move => s H_exec. 282 | rewrite -tot_map_onet_event_map_unfold {1}/tot_map_onet_event /=. 283 | inversion H_exec; subst => /=. 284 | rewrite -tot_map_onet_event_map_unfold /= /tot_map_onet_event /=. 285 | apply: (@Cons_lb_step_exec _ _ _ _ _ _ (List.map tot_map_trace tr)) => /=. 286 | - apply: lb_step_ordered_failure_tot_mapped_simulation_1. 287 | have <-: evt_a e = (fst (evt_a e), snd (evt_a e)) by destruct e, evt_a. 288 | by have <-: evt_a e' = (fst (evt_a e'), snd (evt_a e')) by destruct e', evt_a. 289 | - simpl in *. 290 | find_rewrite. 291 | by rewrite map_app. 292 | - pose s' := Cons e' s0. 293 | rewrite (tot_map_onet_event_map_unfold s'). 294 | exact: c. 295 | Qed. 296 | 297 | Lemma tot_map_onet_label_event_inf_often_occurred : 298 | forall l s, 299 | inf_often (now (occurred l)) s -> 300 | inf_often (now (occurred (tot_map_label l))) (map tot_map_onet_event s). 301 | Proof using. 302 | move => l. 303 | apply: always_map. 304 | apply: eventually_map. 305 | case => e s. 306 | rewrite /= /occurred /=. 307 | move => H_eq. 308 | by rewrite H_eq. 309 | Qed. 310 | 311 | Lemma tot_map_onet_label_event_inf_often_occurred_conv : 312 | forall l s, 313 | inf_often (now (occurred (tot_map_label l))) (map tot_map_onet_event s) -> 314 | inf_often (now (occurred l)) s. 315 | Proof using tot_map_label_injective. 316 | move => l. 317 | apply: always_map_conv. 318 | apply: eventually_map_conv => //. 319 | - rewrite /extensional /=. 320 | case => e s1. 321 | case => e' s2. 322 | move => H_eq. 323 | by inversion H_eq; subst_max. 324 | - rewrite /extensional /=. 325 | case => e s1. 326 | case => e' s2. 327 | move => H_eq. 328 | by inversion H_eq; subst_max. 329 | - case => e s. 330 | rewrite /= /occurred /=. 331 | move => H_eq. 332 | exact: tot_map_label_injective. 333 | Qed. 334 | 335 | Context {overlay_fst : NameOverlayParams (@unlabeled_multi_params _ labeled_multi_fst)}. 336 | Context {overlay_snd : NameOverlayParams (@unlabeled_multi_params _ labeled_multi_snd)}. 337 | Context {overlay_map_congr : NameOverlayParamsTotalMapCongruency overlay_fst overlay_snd name_map}. 338 | 339 | Context {fail_msg_fst : FailMsgParams (@unlabeled_multi_params _ labeled_multi_fst)}. 340 | Context {fail_msg_snd : FailMsgParams (@unlabeled_multi_params _ labeled_multi_snd)}. 341 | Context {fail_msg_map_congr : FailMsgParamsTotalMapCongruency fail_msg_fst fail_msg_snd msg_map}. 342 | 343 | Lemma tot_map_onet_hd_step_ordered_failure_star_always : 344 | forall s, event_step_star step_ordered_failure step_ordered_failure_init (hd s) -> 345 | lb_step_execution lb_step_ordered_failure s -> 346 | always (now (event_step_star step_ordered_failure step_ordered_failure_init)) (map tot_map_onet_event s). 347 | Proof using overlay_map_congr name_map_bijective multi_map_lb_congr multi_map_congr fail_msg_map_congr. 348 | case => e s H_star H_exec. 349 | apply: step_ordered_failure_star_lb_step_execution; last exact: lb_step_execution_lb_step_ordered_failure_tot_map_onet_infseq. 350 | rewrite /= /tot_map_onet_event /= /event_step_star /=. 351 | apply: step_ordered_failure_tot_mapped_simulation_star_1. 352 | by have <-: evt_a e = (fst (evt_a e), snd (evt_a e)) by destruct e, evt_a. 353 | Qed. 354 | 355 | (* lb_step_ordered_dynamic_failure *) 356 | 357 | Theorem lb_step_ordered_dynamic_failure_tot_mapped_simulation_1 : 358 | forall net net' failed failed' lb tr, 359 | @lb_step_ordered_dynamic_failure _ labeled_multi_fst (failed, net) lb (failed', net') tr -> 360 | @lb_step_ordered_dynamic_failure _ labeled_multi_snd (List.map tot_map_name failed, tot_map_odnet net) (tot_map_label lb) (List.map tot_map_name failed', tot_map_odnet net') (List.map tot_map_trace tr). 361 | Proof using name_map_bijective multi_map_lb_congr multi_map_congr. 362 | move => net net' failed failed' lb tr H_step. 363 | invcs H_step => //=. 364 | - rewrite /tot_map_odnet /=. 365 | apply (@LabeledStepOrderedDynamicFailure_deliver _ _ _ _ _ _ (@tot_map_msg _ _ _ _ msg_map m) (List.map (@tot_map_msg _ _ _ _ msg_map) ms) (List.map tot_map_output out) (tot_map_data d) (tot_map_data d') (@tot_map_name_msgs _ _ _ _ _ msg_map l) (@tot_map_name _ _ _ _ name_map from) (@tot_map_name _ _ _ _ name_map to)) => //=. 366 | * exact: not_in_failed_not_in. 367 | * exact: in_failed_in. 368 | * rewrite tot_map_name_inv_inverse. 369 | by find_rewrite. 370 | * rewrite 2!tot_map_name_inv_inverse. 371 | by find_rewrite. 372 | * have H_q := @tot_net_handlers_eq _ _ _ _ _ _ _ multi_map_congr to from m d. 373 | rewrite /tot_mapped_net_handlers /net_handlers /= /unlabeled_net_handlers in H_q. 374 | repeat break_let. 375 | repeat tuple_inversion. 376 | have H_q' := @tot_lb_net_handlers_eq _ _ _ _ _ _ _ _ multi_map_lb_congr _ _ _ _ _ _ _ _ Heqp1. 377 | rewrite /tot_mapped_lb_net_handlers_label in H_q'. 378 | repeat break_let. 379 | by repeat tuple_inversion. 380 | * rewrite (@collate_tot_map_update2_eq _ _ _ _ _ _ name_map_bijective). 381 | set f1 := fun _ => match _ with _ => _ end. 382 | set f2 := update _ _ _ _. 383 | have H_eq_f: f1 = f2. 384 | rewrite /f1 /f2 /update. 385 | apply functional_extensionality => dst. 386 | repeat break_if => //=; first by rewrite -e tot_map_name_inverse_inv in n. 387 | by rewrite e tot_map_name_inv_inverse in n. 388 | by rewrite H_eq_f. 389 | * by rewrite (@map_tot_map_trace_eq _ _ _ _ _ name_map). 390 | - rewrite /tot_map_odnet /=. 391 | apply (@LabeledStepOrderedDynamicFailure_input _ _ (@tot_map_name _ _ _ _ name_map h) _ _ _ _ (List.map tot_map_output out) (tot_map_input inp) (tot_map_data d) (tot_map_data d') (@tot_map_name_msgs _ _ _ _ _ msg_map l)) => //=. 392 | * exact: not_in_failed_not_in. 393 | * exact: in_failed_in. 394 | * rewrite tot_map_name_inv_inverse. 395 | by find_rewrite. 396 | * have H_q := @tot_input_handlers_eq _ _ _ _ _ _ _ multi_map_congr h inp d. 397 | rewrite /tot_mapped_input_handlers /= /unlabeled_input_handlers in H_q. 398 | repeat break_let. 399 | repeat tuple_inversion. 400 | have H_q' := @tot_lb_input_handlers_eq _ _ _ _ _ _ _ _ multi_map_lb_congr _ _ _ _ _ _ _ Heqp1. 401 | rewrite /tot_mapped_lb_input_handlers_label in H_q'. 402 | repeat break_let. 403 | by repeat tuple_inversion. 404 | * rewrite (@collate_tot_map_eq _ _ _ _ _ _ name_map_bijective). 405 | set f1 := fun _ => match _ with _ => _ end. 406 | set f2 := update _ _ _ _. 407 | have H_eq_f: f1 = f2. 408 | rewrite /f1 /f2 /update. 409 | apply functional_extensionality => n. 410 | repeat break_match; try by congruence. 411 | * by rewrite e tot_map_name_inv_inverse in n0. 412 | * by rewrite -e tot_map_name_inverse_inv in n0. 413 | * by rewrite e tot_map_name_inv_inverse in n0. 414 | by rewrite H_eq_f. 415 | * by rewrite (@map_tot_map_trace_eq _ _ _ _ _ name_map). 416 | - rewrite tot_lb_label_silent_fst_snd. 417 | exact: LabeledStepOrderedDynamicFailure_stutter. 418 | Qed. 419 | 420 | Definition tot_map_odnet_event e := 421 | {| evt_a := (List.map tot_map_name (fst e.(evt_a)), tot_map_odnet (snd e.(evt_a))) ; 422 | evt_l := tot_map_label e.(evt_l) ; 423 | evt_trace := List.map tot_map_trace e.(evt_trace) |}. 424 | 425 | Lemma tot_map_odnet_event_map_unfold : forall s, 426 | Cons (tot_map_odnet_event (hd s)) (map tot_map_odnet_event (tl s)) = map tot_map_odnet_event s. 427 | Proof using. 428 | by move => s; rewrite -map_Cons /= -{3}(recons s). 429 | Qed. 430 | 431 | Lemma lb_step_execution_lb_step_ordered_dynamic_failure_tot_map_odnet_infseq : forall s, 432 | lb_step_execution lb_step_ordered_dynamic_failure s -> 433 | lb_step_execution lb_step_ordered_dynamic_failure (map tot_map_odnet_event s). 434 | Proof using name_map_bijective multi_map_lb_congr multi_map_congr. 435 | cofix c. 436 | move => s H_exec. 437 | rewrite -tot_map_odnet_event_map_unfold {1}/tot_map_odnet_event /=. 438 | inversion H_exec; subst => /=. 439 | rewrite -tot_map_odnet_event_map_unfold /= /tot_map_odnet_event /=. 440 | apply: (@Cons_lb_step_exec _ _ _ _ _ _ (List.map tot_map_trace tr)) => /=. 441 | - apply: lb_step_ordered_dynamic_failure_tot_mapped_simulation_1. 442 | have <-: evt_a e = (fst (evt_a e), snd (evt_a e)) by destruct e, evt_a. 443 | by have <-: evt_a e' = (fst (evt_a e'), snd (evt_a e')) by destruct e', evt_a. 444 | - simpl in *. 445 | find_rewrite. 446 | by rewrite map_app. 447 | - pose s' := Cons e' s0. 448 | rewrite (tot_map_odnet_event_map_unfold s'). 449 | exact: c. 450 | Qed. 451 | 452 | Lemma tot_map_odnet_label_event_inf_often_occurred : 453 | forall l s, 454 | inf_often (now (occurred l)) s -> 455 | inf_often (now (occurred (tot_map_label l))) (map tot_map_odnet_event s). 456 | Proof using. 457 | move => l. 458 | apply: always_map. 459 | apply: eventually_map. 460 | case => e s. 461 | rewrite /= /occurred /=. 462 | move => H_eq. 463 | by rewrite H_eq. 464 | Qed. 465 | 466 | Lemma tot_map_odnet_label_event_inf_often_occurred_conv : 467 | forall l s, 468 | inf_often (now (occurred (tot_map_label l))) (map tot_map_odnet_event s) -> 469 | inf_often (now (occurred l)) s. 470 | Proof using tot_map_label_injective. 471 | move => l. 472 | apply: always_map_conv. 473 | apply: eventually_map_conv => //. 474 | - rewrite /extensional /=. 475 | case => e s1. 476 | case => e' s2. 477 | move => H_eq. 478 | by inversion H_eq; subst_max. 479 | - rewrite /extensional /=. 480 | case => e s1. 481 | case => e' s2. 482 | move => H_eq. 483 | by inversion H_eq; subst_max. 484 | - case => e s. 485 | rewrite /= /occurred /=. 486 | move => H_eq. 487 | exact: tot_map_label_injective. 488 | Qed. 489 | 490 | Context {new_msg_fst : NewMsgParams (@unlabeled_multi_params _ labeled_multi_fst)}. 491 | Context {new_msg_snd : NewMsgParams (@unlabeled_multi_params _ labeled_multi_snd)}. 492 | Context {new_msg_map_congr : NewMsgParamsTotalMapCongruency new_msg_fst new_msg_snd msg_map}. 493 | 494 | Lemma tot_map_odnet_hd_step_ordered_dynamic_failure_star_always : 495 | forall s, event_step_star step_ordered_dynamic_failure step_ordered_dynamic_failure_init (hd s) -> 496 | lb_step_execution lb_step_ordered_dynamic_failure s -> 497 | always (now (event_step_star step_ordered_dynamic_failure step_ordered_dynamic_failure_init)) (map tot_map_odnet_event s). 498 | Proof using overlay_map_congr new_msg_map_congr name_map_bijective multi_map_lb_congr multi_map_congr fail_msg_map_congr. 499 | case => e s H_star H_exec. 500 | apply: step_ordered_dynamic_failure_star_lb_step_execution; last exact: lb_step_execution_lb_step_ordered_dynamic_failure_tot_map_odnet_infseq. 501 | rewrite /= /tot_map_odnet_event /= /event_step_star /=. 502 | apply: step_ordered_dynamic_failure_tot_mapped_simulation_star_1. 503 | by have <-: evt_a e = (fst (evt_a e), snd (evt_a e)) by destruct e, evt_a. 504 | Qed. 505 | 506 | End TotalMapExecutionSimulations. 507 | -------------------------------------------------------------------------------- /theories/Core/TraceRelations.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import List. 2 | From Verdi Require Import Net. 3 | From StructTact Require Import StructTactics. 4 | 5 | Import ListNotations. 6 | 7 | Class TraceRelation `{State : Type} `{Event : Type} (step : step_relation State Event) := 8 | { 9 | init : State; 10 | T : (list Event) -> Prop; 11 | T_dec : forall l, {T l} + {~ T l}; 12 | R : State -> Prop; 13 | R_monotonic : forall s s' tr o, refl_trans_1n_trace step init s tr -> 14 | step s s' o -> 15 | R s -> 16 | R s'; 17 | T_false_init : ~ T []; 18 | T_implies_R : forall tr s s' o, 19 | refl_trans_1n_trace step init s tr -> 20 | ~ T tr -> 21 | step s s' o -> 22 | T (tr ++ o) -> 23 | R s' 24 | }. 25 | 26 | Section TraceRelations. 27 | Context `{TR : TraceRelation}. 28 | 29 | Theorem trace_relations_work : 30 | forall s tr, 31 | refl_trans_1n_trace step init s tr -> 32 | T tr -> R s. 33 | Proof using. 34 | intros. 35 | find_copy_apply_lem_hyp refl_trans_1n_n1_trace. 36 | remember init as s'. 37 | induction H1. 38 | - intros; exfalso; pose T_false_init; auto. 39 | - subst. destruct (T_dec cs); intuition eauto using R_monotonic, refl_trans_n1_1n_trace, T_implies_R. 40 | Qed. 41 | End TraceRelations. 42 | -------------------------------------------------------------------------------- /theories/Core/Verdi.v: -------------------------------------------------------------------------------- 1 | From Coq Require Export List. 2 | Export ListNotations. 3 | From Coq Require Export Arith Lia. 4 | From Coq Require Export Numbers.Natural.Abstract.NDiv. 5 | From Coq Require Export Sorting.Permutation. 6 | From StructTact Require Export Util StructTactics. 7 | From Verdi Require Export VerdiHints Net. 8 | From Coq Require PeanoNat. 9 | -------------------------------------------------------------------------------- /theories/Core/VerdiHints.v: -------------------------------------------------------------------------------- 1 | From StructTact Require Import Util. 2 | 3 | #[global] Hint Resolve app_cons_in : core. 4 | #[global] Hint Resolve app_cons_in_rest : core. 5 | -------------------------------------------------------------------------------- /theories/Extraction/ExtrOcamlBasicExt.v: -------------------------------------------------------------------------------- 1 | From Coq Require Extraction. 2 | 3 | Extract Inlined Constant fst => "fst". 4 | Extract Inlined Constant snd => "snd". 5 | -------------------------------------------------------------------------------- /theories/Extraction/ExtrOcamlBool.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import Bool. 2 | From Coq Require Extraction. 3 | 4 | Extract Inlined Constant negb => "not". 5 | 6 | Extract Inlined Constant Nat.leb => "(<=)". 7 | Extract Inlined Constant bool_dec => "(=)". 8 | -------------------------------------------------------------------------------- /theories/Extraction/ExtrOcamlDiskOp.v: -------------------------------------------------------------------------------- 1 | From Verdi Require Import Net. 2 | From Coq Require Extraction. 3 | 4 | Extract Inductive disk_op => "DiskOpShim.disk_op" ["DiskOpShim.Append" "DiskOpShim.Write" "DiskOpShim.Delete"]. 5 | -------------------------------------------------------------------------------- /theories/Extraction/ExtrOcamlFinInt.v: -------------------------------------------------------------------------------- 1 | From StructTact Require Import Fin. 2 | From Coq Require Extraction. 3 | 4 | Extract Inlined Constant fin => int. 5 | 6 | Extract Inlined Constant fin_eq_dec => "(fun _ -> (=))". 7 | 8 | Extract Inlined Constant all_fin => "(fun n -> (Obj.magic (seq 0 n)))". 9 | 10 | Extract Inlined Constant fin_to_nat => "(fun _ n -> n)". 11 | 12 | Extract Inlined Constant fin_compare_compat => "(fun _ n m -> if n = m then EQ else if n < m then LT else GT)". 13 | Extract Inlined Constant fin_compare => "(fun _ n m -> if n = m then Eq else if n < m then Lt else Gt)". 14 | -------------------------------------------------------------------------------- /theories/Extraction/ExtrOcamlList.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import List. 2 | From Coq Require Extraction. 3 | 4 | Extract Inlined Constant length => "List.length". 5 | Extract Inlined Constant app => "List.append". 6 | 7 | Extract Inlined Constant map => "List.map". 8 | Extract Inlined Constant rev => "List.rev". 9 | Extract Inlined Constant filter => "List.filter". 10 | Extract Inlined Constant fold_left => "(fun a b c -> List.fold_left a c b)". 11 | Extract Inlined Constant fold_right => "(fun a b c -> List.fold_right a c b)". 12 | 13 | Extract Inlined Constant in_dec => "(fun h -> List.mem)". 14 | -------------------------------------------------------------------------------- /theories/Extraction/ExtrOcamlNatIntExt.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import PeanoNat Ascii. 2 | From Coq Require Extraction. 3 | 4 | Extract Inlined Constant Nat.max => "Pervasives.max". 5 | Extract Inlined Constant Nat.min => "Pervasives.min". 6 | 7 | Extract Inlined Constant Nat.ltb => "(<)". 8 | 9 | Extract Inlined Constant nat_of_ascii => "Char.code". 10 | 11 | Extract Inlined Constant Nat.compare => "(fun n m -> if n = m then Eq else if n < m then Lt else Gt)". 12 | -------------------------------------------------------------------------------- /theories/Lib/FMapVeryWeak.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import ZArith. 2 | From Coq Require Import FMapInterface FMapPositive. 3 | From Coq Require Import FMapList FMapFacts. 4 | From Coq Require Import String Ascii List. 5 | From StructTact Require Import StructTactics StringOrders. 6 | 7 | Import ListNotations. 8 | 9 | Set Implicit Arguments. 10 | 11 | Module Type VWS. 12 | Declare Module E : DecidableType. 13 | 14 | Definition key := E.t. 15 | 16 | #[global] Hint Transparent key : core. 17 | 18 | Parameter t : Type -> Type. 19 | 20 | Section Types. 21 | Variable elt:Type. 22 | 23 | Parameter empty : t elt. 24 | Parameter add : key -> elt -> t elt -> t elt. 25 | Parameter find : key -> t elt -> option elt. 26 | Parameter remove : key -> t elt -> t elt. 27 | 28 | Parameter empty_o : forall x, find x empty = None. 29 | Parameter add_eq_o : forall m x y e, E.eq x y -> find y (add x e m) = Some e. 30 | Parameter add_neq_o : forall m x y e, ~ E.eq x y -> find y (add x e m) = find y m. 31 | Parameter remove_eq_o : forall m x y, E.eq x y -> find y (remove x m) = None. 32 | Parameter remove_neq_o : forall m x y, ~ E.eq x y -> find y (remove x m) = find y m. 33 | End Types. 34 | End VWS. 35 | 36 | Module WS_to_VWS (Map : WS) <: VWS. 37 | Module E := Map.E. 38 | Module F := Facts Map. 39 | Definition key := E.t. 40 | Definition t := Map.t. 41 | Definition empty := Map.empty. 42 | Definition add := Map.add. 43 | Definition find := Map.find. 44 | Definition remove := Map.remove. 45 | Definition empty_o := F.empty_o. 46 | Definition add_eq_o := F.add_eq_o. 47 | Definition add_neq_o := F.add_neq_o. 48 | Definition remove_eq_o := F.remove_eq_o. 49 | Definition remove_neq_o := F.remove_neq_o. 50 | End WS_to_VWS. 51 | 52 | Module StringMapList := FMapList.Make string_lex_as_OT_compat. 53 | Module LinearTimeStringMap <: VWS := WS_to_VWS StringMapList. 54 | 55 | Module Type IndexedType. 56 | Parameter t: Type. 57 | Parameter index: t -> positive. 58 | Parameter index_inj: forall (x y: t), index x = index y -> x = y. 59 | Parameter eq: forall (x y: t), {x = y} + {x <> y}. 60 | End IndexedType. 61 | 62 | Module IT_to_DT (I : IndexedType) <: DecidableType. 63 | Definition t := I.t. 64 | Definition eq := @eq t. 65 | Definition eq_refl := @eq_refl t. 66 | Definition eq_sym := @eq_sym t. 67 | Definition eq_trans := @eq_trans t. 68 | Definition eq_dec := I.eq. 69 | End IT_to_DT. 70 | 71 | Module IndexedPositiveMap (X : IndexedType) <: VWS. 72 | Module E := IT_to_DT X. 73 | Module M := PositiveMap. 74 | Module F := Facts M. 75 | 76 | Definition key := X.t. 77 | 78 | Definition t := M.t. 79 | 80 | Definition empty := M.empty. 81 | 82 | Definition add (A : Type) (i : key) (v : A) (m : t A) : t A := 83 | M.add (X.index i) v m. 84 | 85 | Definition find (A : Type) (i : key) (m : t A) : option A := 86 | M.find (X.index i) m. 87 | 88 | Definition remove (A : Type) (i : key) (m : t A) : t A := 89 | M.remove (X.index i) m. 90 | 91 | Lemma empty_o : forall A x, find x (empty A) = None. 92 | Proof. 93 | intros. 94 | unfold find. 95 | apply F.empty_o. 96 | Qed. 97 | 98 | Lemma add_eq_o : forall A m x y e, E.eq x y -> @find A y (add x e m) = Some e. 99 | Proof. 100 | intros. 101 | unfold find. 102 | apply F.add_eq_o. 103 | rewrite H. 104 | reflexivity. 105 | Qed. 106 | 107 | Lemma add_neq_o : forall A m x y e, ~ E.eq x y -> find y (add x e m) = @find A y m. 108 | Proof. 109 | intros. 110 | unfold find. 111 | apply F.add_neq_o. 112 | intro H_eq. 113 | contradict H. 114 | apply X.index_inj in H_eq. 115 | assumption. 116 | Qed. 117 | 118 | Lemma remove_eq_o : forall A m x y, E.eq x y -> @find A y (remove x m) = None. 119 | Proof. 120 | intros. 121 | unfold find. 122 | apply F.remove_eq_o. 123 | rewrite H. 124 | reflexivity. 125 | Qed. 126 | 127 | Lemma remove_neq_o : forall A m x y, ~ E.eq x y -> find y (remove x m) = @find A y m. 128 | Proof. 129 | intros. 130 | unfold find. 131 | apply F.remove_neq_o. 132 | intro H_eq. 133 | contradict H. 134 | apply X.index_inj in H_eq. 135 | assumption. 136 | Qed. 137 | End IndexedPositiveMap. 138 | 139 | Module IndexedString <: IndexedType. 140 | Definition t := string. 141 | Definition eq := string_dec. 142 | 143 | Fixpoint positive_of_digits (l : list bool) (p : positive) : positive := 144 | match l with 145 | | [] => p 146 | | b :: l' => if b then xI (positive_of_digits l' p) else xO (positive_of_digits l' p) 147 | end. 148 | 149 | Definition list_bool_of_ascii (a : ascii) : list bool := 150 | let (a0,a1,a2,a3,a4,a5,a6,a7) := a in 151 | [a0; a1; a2; a3; a4; a5; a6; a7]. 152 | 153 | Fixpoint index (s : string) : positive := 154 | match s with 155 | | EmptyString => 1 156 | | String a s' => positive_of_digits (list_bool_of_ascii a) (index s') 157 | end. 158 | 159 | Lemma positive_of_digits_inj : 160 | forall l l' p p', 161 | List.length l = List.length l' -> 162 | positive_of_digits l p = positive_of_digits l' p' -> 163 | l = l' /\ p = p'. 164 | Proof. 165 | induction l; destruct l'; intros; try discriminate; auto. 166 | simpl in *. do 2 break_match; try discriminate; 167 | solve [ find_inversion; find_apply_hyp_hyp; break_and; subst; auto ]. 168 | Qed. 169 | 170 | Theorem index_inj : 171 | forall (x y : t), 172 | index x = index y -> 173 | x = y. 174 | Proof. 175 | induction x; destruct y; intros. 176 | - reflexivity. 177 | - simpl in *. unfold list_bool_of_ascii in *. 178 | break_let; simpl in * ; repeat break_match; congruence. 179 | - simpl in *. unfold list_bool_of_ascii in *. 180 | break_let; simpl in *; repeat break_match; congruence. 181 | - simpl in *. unfold list_bool_of_ascii in *. repeat break_let. 182 | find_apply_lem_hyp positive_of_digits_inj. 183 | + subst. break_and. find_inversion. find_apply_hyp_hyp. subst. reflexivity. 184 | + reflexivity. 185 | Qed. 186 | End IndexedString. 187 | 188 | Module LogTimeStringMap <: VWS := IndexedPositiveMap IndexedString. 189 | -------------------------------------------------------------------------------- /theories/Lib/Ssrexport.v: -------------------------------------------------------------------------------- 1 | From Coq Require Export ssreflect. 2 | #[export] Set SsrOldRewriteGoalsOrder. 3 | #[export] Set Asymmetric Patterns. 4 | #[export] Set Bullet Behavior "None". 5 | -------------------------------------------------------------------------------- /theories/Systems/Counter.v: -------------------------------------------------------------------------------- 1 | From Verdi Require Import Verdi HandlerMonad. 2 | 3 | Local Arguments update {_} {_} _ _ _ _ _ : simpl never. 4 | 5 | Set Implicit Arguments. 6 | 7 | Inductive Name := primary | backup. 8 | Definition Name_eq_dec : forall x y : Name, {x = y} + {x <> y}. 9 | decide equality. 10 | Defined. 11 | 12 | Inductive Msg := inc | ack. 13 | Definition Msg_eq_dec : forall x y : Msg, {x = y} + {x <> y}. 14 | decide equality. 15 | Defined. 16 | 17 | Inductive Input := request_inc. 18 | Definition Input_eq_dec : forall x y : Input, {x = y} + {x <> y}. 19 | destruct x,y. auto. 20 | Defined. 21 | 22 | Inductive Output := inc_executed. 23 | Definition Output_eq_dec : forall x y : Output, {x = y} + {x <> y}. 24 | destruct x,y. auto. 25 | Defined. 26 | 27 | Definition Data := nat. 28 | 29 | Definition init_Data := 0. 30 | 31 | Definition Handler (S : Type) := GenHandler (Name * Msg) S Output unit. 32 | 33 | Definition PrimaryNetHandler (m : Msg) : Handler Data := 34 | match m with 35 | | ack => write_output inc_executed 36 | | _ => nop 37 | end. 38 | 39 | Definition PrimaryInputHandler (i : Input) : Handler Data := 40 | match i with 41 | | request_inc => modify S ;; send (backup, inc) 42 | end. 43 | 44 | Definition BackupNetHandler (m : Msg) : Handler Data := 45 | match m with 46 | | inc => modify S ;; send (primary, ack) 47 | | _ => nop 48 | end. 49 | 50 | Definition BackupInputHandler (i : Input) : Handler Data := nop. 51 | 52 | Definition NetHandler (me : Name) (m : Msg) : Handler Data := 53 | match me with 54 | | primary => PrimaryNetHandler m 55 | | backup => BackupNetHandler m 56 | end. 57 | 58 | Definition InputHandler (me : Name) (i : Input) : Handler Data := 59 | match me with 60 | | primary => PrimaryInputHandler i 61 | | backup => BackupInputHandler i 62 | end. 63 | 64 | #[global] 65 | Instance Counter_BaseParams : BaseParams := 66 | { 67 | data := Data; 68 | input := Input; 69 | output := Output 70 | }. 71 | 72 | Definition Nodes : list Name := [primary; backup]. 73 | 74 | Lemma all_Names_Nodes : forall n, In n Nodes. 75 | Proof. 76 | destruct n; simpl; auto. 77 | Qed. 78 | 79 | Lemma NoDup_Nodes : NoDup Nodes. 80 | Proof. 81 | repeat constructor; simpl; intuition discriminate. 82 | Qed. 83 | 84 | #[global] 85 | Instance Counter_MultiParams : MultiParams Counter_BaseParams := 86 | { 87 | name := Name; 88 | name_eq_dec := Name_eq_dec; 89 | msg := Msg; 90 | msg_eq_dec := Msg_eq_dec; 91 | nodes := Nodes; 92 | all_names_nodes := all_Names_Nodes; 93 | no_dup_nodes := NoDup_Nodes; 94 | init_handlers := fun _ => init_Data; 95 | net_handlers := fun dst src msg s => 96 | runGenHandler_ignore s (NetHandler dst msg); 97 | input_handlers := fun nm i s => 98 | runGenHandler_ignore s (InputHandler nm i) 99 | }. 100 | 101 | 102 | Lemma net_handlers_NetHandler : 103 | forall h src m d os d' ms, 104 | net_handlers h src m d = (os, d', ms) -> 105 | NetHandler h m d = (tt, os, d', ms). 106 | Proof. 107 | intros. 108 | simpl in *. 109 | monad_unfold. 110 | repeat break_let. 111 | find_inversion. 112 | destruct u. auto. 113 | Qed. 114 | 115 | Lemma input_handlers_InputHandlers : 116 | forall h i d os d' ms, 117 | input_handlers h i d = (os, d', ms) -> 118 | InputHandler h i d = (tt, os, d', ms). 119 | Proof. 120 | intros. 121 | simpl in *. 122 | monad_unfold. 123 | repeat break_let. 124 | find_inversion. 125 | destruct u. auto. 126 | Qed. 127 | 128 | Lemma PrimaryNetHandler_no_msgs : 129 | forall m d ms d' o u, 130 | PrimaryNetHandler m d = (u, o, d', ms) -> 131 | ms = []. 132 | Proof. 133 | unfold PrimaryNetHandler. 134 | intros. monad_unfold. 135 | break_match; find_inversion; auto. 136 | Qed. 137 | 138 | Definition inc_in_flight_to_backup (l : list packet) : nat := 139 | length (filterMap 140 | (fun p => if msg_eq_dec (pBody p) inc 141 | then if name_eq_dec (pDst p) backup 142 | then Some tt else None 143 | else None) 144 | l). 145 | 146 | Lemma inc_in_flight_to_backup_app : 147 | forall xs ys, 148 | inc_in_flight_to_backup (xs ++ ys) = inc_in_flight_to_backup xs + inc_in_flight_to_backup ys. 149 | Proof. 150 | intros. 151 | unfold inc_in_flight_to_backup. 152 | rewrite filterMap_app. 153 | rewrite app_length. 154 | auto. 155 | Qed. 156 | 157 | Lemma inc_in_flight_to_backup_cons_primary_dst : 158 | forall p, 159 | pDst p = primary -> 160 | inc_in_flight_to_backup [p] = 0. 161 | Proof. 162 | intros. 163 | unfold inc_in_flight_to_backup. 164 | simpl. 165 | repeat break_match; try congruence; auto. 166 | Qed. 167 | 168 | Lemma inc_in_flight_to_backup_nil : 169 | inc_in_flight_to_backup [] = 0. 170 | Proof. 171 | reflexivity. 172 | Qed. 173 | 174 | Lemma InputHandler_inc_in_flight_to_backup_preserved : 175 | forall h i d u o d' l, 176 | InputHandler h i d = (u, o, d', l) -> 177 | d' = d + inc_in_flight_to_backup (send_packets h l). 178 | Proof. 179 | unfold InputHandler, PrimaryInputHandler, BackupInputHandler. 180 | simpl. 181 | intros. 182 | monad_unfold. 183 | repeat break_match; find_inversion; compute; auto. 184 | rewrite Nat.add_comm. auto. 185 | Qed. 186 | 187 | Lemma NetHandler_inc_in_flight_to_backup_preserved : 188 | forall p d u o d' l, 189 | NetHandler (pDst p) (pBody p) d = (u, o, d', l) -> 190 | d' + inc_in_flight_to_backup (send_packets (pDst p) l) = d + inc_in_flight_to_backup [p]. 191 | Proof. 192 | unfold NetHandler, PrimaryNetHandler, BackupNetHandler. 193 | intros. 194 | monad_unfold. 195 | destruct p. simpl in *. 196 | repeat break_match; find_inversion; simpl; try rewrite inc_in_flight_to_backup_nil; 197 | unfold Data in *; compute; 198 | auto with *. 199 | Qed. 200 | 201 | Lemma InputHandler_backup_no_msgs : 202 | forall i d u o d' l, 203 | InputHandler backup i d = (u, o, d', l) -> 204 | l = []. 205 | Proof. 206 | simpl. unfold BackupInputHandler. 207 | intros. 208 | monad_unfold. 209 | find_inversion. 210 | auto. 211 | Qed. 212 | 213 | Lemma cons_is_app : 214 | forall A (x : A) xs, 215 | x :: xs = [x] ++ xs. 216 | Proof. 217 | auto. 218 | Qed. 219 | 220 | Lemma backup_plus_network_eq_primary : 221 | forall net tr, 222 | step_async_star (params := Counter_MultiParams) step_async_init net tr -> 223 | nwState net backup + inc_in_flight_to_backup (nwPackets net) = nwState net primary. 224 | Proof. 225 | intros. 226 | remember step_async_init as y in *. 227 | revert Heqy. 228 | induction H using refl_trans_1n_trace_n1_ind; intros; subst. 229 | - reflexivity. 230 | - concludes. 231 | match goal with 232 | | [ H : step_async _ _ _ |- _ ] => invc H 233 | end; simpl. 234 | + find_apply_lem_hyp net_handlers_NetHandler. 235 | find_copy_apply_lem_hyp NetHandler_inc_in_flight_to_backup_preserved. 236 | repeat find_rewrite. 237 | rewrite cons_is_app in IHrefl_trans_1n_trace1. 238 | repeat rewrite inc_in_flight_to_backup_app in *. 239 | destruct (pDst p) eqn:?; 240 | try rewrite update_same; 241 | try rewrite update_diff by congruence; 242 | unfold send_packets in *; simpl in *. 243 | * erewrite PrimaryNetHandler_no_msgs with (ms := l) in * by eauto. 244 | rewrite inc_in_flight_to_backup_cons_primary_dst in * by auto. 245 | simpl in *. rewrite inc_in_flight_to_backup_nil in *. auto with *. 246 | * lia. 247 | + find_apply_lem_hyp input_handlers_InputHandlers. 248 | find_copy_apply_lem_hyp InputHandler_inc_in_flight_to_backup_preserved. 249 | unfold send_packets in *. simpl in *. 250 | rewrite inc_in_flight_to_backup_app. subst. 251 | destruct h eqn:?; 252 | try rewrite update_same; 253 | try rewrite update_diff by congruence. 254 | * lia. 255 | * erewrite InputHandler_backup_no_msgs with (l := l) by eauto. 256 | simpl. rewrite inc_in_flight_to_backup_nil. lia. 257 | Qed. 258 | 259 | Theorem primary_ge_backup : 260 | forall net tr, 261 | step_async_star (params := Counter_MultiParams) step_async_init net tr -> 262 | nwState net backup <= nwState net primary. 263 | Proof. 264 | intros. 265 | apply backup_plus_network_eq_primary in H. 266 | auto with *. 267 | Qed. 268 | 269 | Definition trace_inputs (tr : list (name * (input + list output))) : nat := 270 | length (filterMap (fun e => match e with 271 | | (primary, inl i) => Some i 272 | | _ => None 273 | end) tr). 274 | Lemma trace_inputs_app : 275 | forall tr1 tr2, 276 | trace_inputs (tr1 ++ tr2) = trace_inputs tr1 + trace_inputs tr2. 277 | Proof. 278 | unfold trace_inputs. 279 | intros. 280 | rewrite filterMap_app. 281 | rewrite app_length. auto. 282 | Qed. 283 | 284 | Definition trace_outputs (tr : list (name * (input + list output))) : nat := 285 | length (filterMap (fun e => match e with 286 | | (primary, inr [o]) => Some o 287 | | _ => None 288 | end) tr). 289 | 290 | Lemma trace_outputs_app : 291 | forall tr1 tr2, 292 | trace_outputs (tr1 ++ tr2) = trace_outputs tr1 + trace_outputs tr2. 293 | Proof. 294 | unfold trace_outputs. 295 | intros. 296 | rewrite filterMap_app. 297 | rewrite app_length. auto. 298 | Qed. 299 | 300 | Definition ack_in_flight_to_primary (l : list packet) : nat := 301 | length (filterMap 302 | (fun p => if msg_eq_dec (pBody p) ack 303 | then if name_eq_dec (pDst p) primary 304 | then Some tt else None 305 | else None) 306 | l). 307 | 308 | Lemma ack_in_flight_to_primary_app : 309 | forall xs ys, 310 | ack_in_flight_to_primary (xs ++ ys) = ack_in_flight_to_primary xs + ack_in_flight_to_primary ys. 311 | Proof. 312 | unfold ack_in_flight_to_primary. 313 | intros. 314 | rewrite filterMap_app. 315 | rewrite app_length. auto. 316 | Qed. 317 | 318 | Lemma ack_in_flight_to_primary_backup : 319 | forall p, 320 | pDst p = backup -> 321 | ack_in_flight_to_primary [p] = 0. 322 | Proof. 323 | intros. 324 | unfold ack_in_flight_to_primary. 325 | simpl. 326 | repeat break_match; try congruence; auto. 327 | Qed. 328 | 329 | 330 | Lemma InputHandler_trace_preserved : 331 | forall h i d u o d' l, 332 | InputHandler h i d = (u, o, d', l) -> 333 | trace_inputs [(h, inl i)] = 334 | trace_outputs [(h, inr o)] + 335 | inc_in_flight_to_backup (send_packets h l) + 336 | ack_in_flight_to_primary (send_packets h l). 337 | Proof. 338 | unfold InputHandler, PrimaryInputHandler, BackupInputHandler. 339 | simpl. 340 | intros. 341 | monad_unfold. 342 | repeat break_match; find_inversion; compute; auto. 343 | Qed. 344 | 345 | Lemma NetHandler_trace_preserved : 346 | forall p d u o d' l, 347 | NetHandler (pDst p) (pBody p) d = (u, o, d', l) -> 348 | inc_in_flight_to_backup [p] + 349 | ack_in_flight_to_primary [p] = 350 | trace_outputs [((pDst p), inr o)] + 351 | inc_in_flight_to_backup (send_packets (pDst p) l) + 352 | ack_in_flight_to_primary (send_packets (pDst p) l). 353 | Proof. 354 | unfold NetHandler, PrimaryNetHandler, BackupNetHandler. 355 | intros. 356 | monad_unfold. 357 | destruct p. simpl in *. 358 | repeat break_match; find_inversion; simpl; try rewrite inc_in_flight_to_backup_nil; 359 | unfold Data in *; compute; 360 | auto with *. 361 | Qed. 362 | 363 | Lemma trace_inputs_output : 364 | forall h os, 365 | trace_inputs [(h, inr os)] = 0. 366 | Proof. 367 | intros. 368 | unfold trace_inputs. 369 | simpl. repeat break_match; simpl; congruence. 370 | Qed. 371 | 372 | Lemma trace_outputs_input : 373 | forall h i, 374 | trace_outputs [(h, inl i)] = 0. 375 | Proof. 376 | intros. 377 | unfold trace_outputs. 378 | simpl. repeat break_match; simpl; congruence. 379 | Qed. 380 | 381 | Lemma trace_outputs_backup : 382 | forall e, 383 | trace_outputs [(backup, e)] = 0. 384 | Proof. 385 | auto. 386 | Qed. 387 | 388 | Lemma inputs_eq_outputs_plus_inc_plus_ack : 389 | forall net tr, 390 | step_async_star (params := Counter_MultiParams) step_async_init net tr -> 391 | trace_inputs tr = trace_outputs tr + 392 | inc_in_flight_to_backup (nwPackets net) + 393 | ack_in_flight_to_primary (nwPackets net). 394 | Proof. 395 | intros. 396 | remember step_async_init as y in *. 397 | revert Heqy. 398 | induction H using refl_trans_1n_trace_n1_ind; intros; subst. 399 | - reflexivity. 400 | - concludes. 401 | match goal with 402 | | [ H : step_async _ _ _ |- _ ] => invc H 403 | end; simpl. 404 | + find_apply_lem_hyp net_handlers_NetHandler. 405 | repeat find_rewrite. 406 | rewrite trace_inputs_app. 407 | rewrite trace_outputs_app. 408 | rewrite cons_is_app with (x := p) in *. 409 | repeat rewrite inc_in_flight_to_backup_app in *. 410 | repeat rewrite ack_in_flight_to_primary_app in *. 411 | find_apply_lem_hyp NetHandler_trace_preserved. 412 | destruct (pDst p) eqn:?. 413 | * erewrite inc_in_flight_to_backup_cons_primary_dst in * by eauto. 414 | rewrite trace_inputs_output in *. simpl in *. lia. 415 | * rewrite ack_in_flight_to_primary_backup in * by auto. 416 | rewrite trace_outputs_backup in *. unfold send_packets in *. 417 | simpl in *. rewrite <- plus_n_O in *. lia. 418 | + find_apply_lem_hyp input_handlers_InputHandlers. 419 | find_apply_lem_hyp InputHandler_trace_preserved. 420 | rewrite cons_is_app. 421 | repeat rewrite trace_inputs_app. 422 | repeat rewrite trace_outputs_app. 423 | repeat rewrite inc_in_flight_to_backup_app in *. 424 | repeat rewrite ack_in_flight_to_primary_app in *. 425 | rewrite trace_outputs_input. 426 | rewrite trace_inputs_output. 427 | unfold send_packets in *. simpl in *. lia. 428 | Qed. 429 | 430 | Theorem inputs_ge_outputs : 431 | forall net tr, 432 | step_async_star (params := Counter_MultiParams) step_async_init net tr -> 433 | trace_outputs tr <= trace_inputs tr. 434 | Proof. 435 | intros. 436 | apply inputs_eq_outputs_plus_inc_plus_ack in H. 437 | lia. 438 | Qed. 439 | -------------------------------------------------------------------------------- /theories/Systems/LockServSeqNum.v: -------------------------------------------------------------------------------- 1 | From Verdi Require Import Verdi LockServ. 2 | From Verdi Require SeqNum. 3 | From Verdi Require Import SeqNumCorrect. 4 | 5 | Section LockServSeqNum. 6 | 7 | Variable num_Clients : nat. 8 | 9 | Definition transformed_base_params := 10 | @SeqNum.base_params (LockServ_BaseParams num_Clients) (LockServ_MultiParams num_Clients). 11 | Definition transformed_multi_params := 12 | @SeqNum.multi_params (LockServ_BaseParams num_Clients) (LockServ_MultiParams num_Clients). 13 | 14 | Definition transformed_network := 15 | @network transformed_base_params transformed_multi_params. 16 | 17 | Theorem transformed_correctness : 18 | forall (net : transformed_network) tr, 19 | step_dup_star (params := transformed_multi_params) step_async_init net tr -> 20 | @mutual_exclusion num_Clients (nwState (revertNetwork net)). 21 | Proof using. 22 | intros. 23 | pose proof @true_in_reachable_transform _ (LockServ_MultiParams num_Clients) 24 | (fun net : network => mutual_exclusion (nwState net)) 25 | (@true_in_reachable_mutual_exclusion num_Clients). 26 | unfold true_in_reachable in *. 27 | apply H0. 28 | unfold reachable. 29 | eauto. 30 | Qed. 31 | 32 | End LockServSeqNum. 33 | -------------------------------------------------------------------------------- /theories/Systems/Log.v: -------------------------------------------------------------------------------- 1 | From Verdi Require Import Verdi. 2 | From Cheerios Require Import Cheerios. 3 | 4 | Import DeserializerNotations. 5 | 6 | Set Implicit Arguments. 7 | 8 | Section Log. 9 | Context {orig_base_params : BaseParams}. 10 | Context {orig_multi_params : MultiParams orig_base_params}. 11 | Context {orig_failure_params : FailureParams orig_multi_params}. 12 | 13 | Context {data_serializer : Serializer data}. 14 | Context {name_serializer : Serializer name}. 15 | Context {msg_serializer : Serializer msg}. 16 | Context {input_serializer : Serializer input}. 17 | 18 | Variable snapshot_interval : nat. 19 | 20 | Definition entry : Type := input + (name * msg). 21 | 22 | Inductive log_files := 23 | | Count 24 | | Snapshot 25 | | Log. 26 | 27 | Definition log_files_eq_dec : forall x y : log_files, {x = y} + {x <> y}. 28 | decide equality. 29 | Defined. 30 | 31 | Record log_state := mk_log_state { log_num_entries : nat ; log_data : data }. 32 | 33 | Definition log_handler_result (num_entries : nat) (e : entry) (out : list output) (d : data) (ps : list (name * msg)) := 34 | if S num_entries =? snapshot_interval 35 | then ([Delete Log; Write Snapshot (serialize d); Write Count (serialize 0)], 36 | out, mk_log_state 0 d, ps) 37 | else ([Append Log (serialize e); Write Count (serialize (S num_entries))], 38 | out, mk_log_state (S num_entries) d, ps). 39 | 40 | Definition log_net_handlers dst src m st : 41 | list (disk_op log_files) * list output * log_state * list (name * msg) := 42 | let '(out, d, ps) := net_handlers dst src m (log_data st) in 43 | log_handler_result (log_num_entries st) (inr (src , m)) out d ps. 44 | 45 | Definition log_input_handlers h inp st : 46 | list (disk_op log_files) * list output * log_state * list (name * msg) := 47 | let '(out, d, ps) := input_handlers h inp (log_data st) in 48 | log_handler_result (log_num_entries st) (inl inp) out d ps. 49 | 50 | Instance log_base_params : BaseParams := 51 | { 52 | data := log_state ; 53 | input := input ; 54 | output := output 55 | }. 56 | 57 | Instance log_multi_params : DiskOpMultiParams log_base_params := 58 | { 59 | do_name := name; 60 | file_name := log_files; 61 | do_name_eq_dec := name_eq_dec; 62 | do_msg := msg; 63 | do_msg_eq_dec := msg_eq_dec; 64 | file_name_eq_dec := log_files_eq_dec; 65 | do_nodes := nodes; 66 | do_all_names_nodes := all_names_nodes; 67 | do_no_dup_nodes := no_dup_nodes; 68 | do_net_handlers := log_net_handlers; 69 | do_input_handlers := log_input_handlers 70 | }. 71 | 72 | Definition channel_to_log (channel : file_name -> option IOStreamWriter.in_channel) : 73 | option (list entry * @data orig_base_params) := 74 | match channel Count, channel Log, channel Snapshot with 75 | | Some s1, Some s2, Some s3 => 76 | match from_channel deserialize s1 with 77 | | Some n => 78 | match from_channel (list_deserialize_rec _ _ n) s2 with 79 | | Some es => 80 | match from_channel deserialize s3 with 81 | | Some snap => Some (es, snap) 82 | | None => None 83 | end 84 | | None => None 85 | end 86 | | None => None 87 | end 88 | | _, _, _ => None 89 | end. 90 | 91 | Definition apply_entry h d e := 92 | match e with 93 | | inl inp => let '(_, d', _) := input_handlers h inp d in d' 94 | | inr (src, m) => let '(_, d', _) := net_handlers h src m d in d' 95 | end. 96 | 97 | Definition apply_log h (d : @data orig_base_params) (entries : list entry) : @data orig_base_params := 98 | fold_left (apply_entry h) entries d. 99 | 100 | Definition do_log_reboot (h : do_name) (w : log_files -> option IOStreamWriter.in_channel) : 101 | data * list (disk_op log_files) := 102 | let d := match channel_to_log w with 103 | | Some (es, d) => reboot (apply_log h d es) 104 | | None => init_handlers h 105 | end 106 | in 107 | (mk_log_state 0 d, [Delete Log; Write Snapshot (serialize d); Write Count (serialize 0)]). 108 | 109 | Instance log_failure_params : DiskOpFailureParams log_multi_params := 110 | { do_reboot := do_log_reboot }. 111 | End Log. 112 | 113 | #[global] 114 | Hint Extern 5 (@BaseParams) => apply log_base_params : typeclass_instances. 115 | #[global] 116 | Hint Extern 5 (@DiskOpMultiParams _) => apply log_multi_params : typeclass_instances. 117 | #[global] 118 | Hint Extern 5 (@DiskOpFailureParams _ _) => apply log_failure_params : typeclass_instances. 119 | -------------------------------------------------------------------------------- /theories/Systems/LogCorrect.v: -------------------------------------------------------------------------------- 1 | From Verdi Require Import Verdi. 2 | From Cheerios Require Import Cheerios. 3 | From Verdi Require Import Log. 4 | From Coq Require Import FunctionalExtensionality. 5 | 6 | Section LogCorrect. 7 | Context {orig_base_params : BaseParams}. 8 | Context {orig_multi_params : MultiParams orig_base_params}. 9 | Context {orig_failure_params : FailureParams orig_multi_params}. 10 | 11 | Context {data_serializer : Serializer data}. 12 | Context {name_serializer : Serializer name}. 13 | Context {msg_serializer : Serializer msg}. 14 | Context {input_serializer : Serializer input}. 15 | 16 | Variable snapshot_interval : nat. 17 | 18 | Instance log_base_params : BaseParams := @log_base_params orig_base_params. 19 | Instance log_multi_params : DiskOpMultiParams log_base_params := log_multi_params snapshot_interval. 20 | Instance log_failure_params : DiskOpFailureParams log_multi_params := log_failure_params snapshot_interval. 21 | 22 | Lemma apply_log_app : forall h d entries e, 23 | apply_log h d (entries ++ [e]) = 24 | apply_entry h (apply_log h d entries) e. 25 | Proof using. 26 | intros. 27 | unfold apply_log. 28 | rewrite fold_left_app. 29 | reflexivity. 30 | Qed. 31 | 32 | Definition disk_correct dsk h st := 33 | exists s (entries : list entry) (snap : data), 34 | dsk Count = Some (serialize (length entries)) /\ 35 | dsk Log = Some s /\ 36 | IOStreamWriter.unwrap s = IOStreamWriter.unwrap (list_serialize_rec entry _ entries) /\ 37 | dsk Snapshot = Some (serialize snap) /\ 38 | log_num_entries st = length entries /\ 39 | (apply_log h snap entries = log_data st). 40 | 41 | Lemma log_net_handlers_spec : 42 | forall dst src m st ops out st' l dsk dsk', 43 | disk_correct dsk dst st -> 44 | log_net_handlers snapshot_interval dst src m st = (ops, out, st', l) -> 45 | apply_ops dsk ops = dsk' -> 46 | disk_correct dsk' dst st'. 47 | Proof using. 48 | intros. 49 | unfold disk_correct in *. 50 | unfold log_net_handlers, log_handler_result in *; 51 | break_if; do 2 break_let. 52 | - find_inversion. 53 | simpl. 54 | exists IOStreamWriter.empty, [], d. 55 | intuition. 56 | - find_inversion. 57 | simpl. 58 | break_exists. 59 | intuition. 60 | match goal with 61 | | _ : dsk Log = Some ?s, _ : apply_log _ ?d ?entries = _ |- _ => 62 | exists (s +$+ (serialize (inr (src, m) : entry))), (entries ++ [inr (src, m)]), d 63 | end. 64 | intuition. 65 | + match goal with 66 | | H : context [log_num_entries] |- _ => rewrite H 67 | end. 68 | rewrite app_length. 69 | simpl. 70 | rewrite Nat.add_1_r. 71 | reflexivity. 72 | + break_match. 73 | * find_inversion. 74 | reflexivity. 75 | * congruence. 76 | + cheerios_crush. 77 | rewrite serialize_snoc. 78 | match goal with 79 | | H : IOStreamWriter.unwrap _ = IOStreamWriter.unwrap _ |- _ => rewrite H 80 | end. 81 | reflexivity. 82 | + match goal with 83 | | H : context [log_num_entries] |- _ => rewrite H 84 | end. 85 | rewrite app_length. 86 | simpl. 87 | rewrite Nat.add_1_r. 88 | reflexivity. 89 | + rewrite apply_log_app. 90 | match goal with 91 | | H : context [apply_log] |- _ => rewrite H 92 | end. 93 | simpl. 94 | match goal with 95 | | H : context [net_handlers] |- _ => rewrite H 96 | end. 97 | reflexivity. 98 | Qed. 99 | 100 | Lemma log_input_handlers_spec : 101 | forall h m st ops out st' l dsk dsk', 102 | disk_correct dsk h st -> 103 | log_input_handlers snapshot_interval h m st = (ops, out, st', l) -> 104 | apply_ops dsk ops = dsk' -> 105 | disk_correct dsk' h st'. 106 | Proof using. 107 | intros. 108 | unfold disk_correct in *. 109 | unfold log_input_handlers, log_handler_result in *; 110 | break_if; do 2 break_let. 111 | - find_inversion. 112 | simpl. 113 | exists IOStreamWriter.empty, [], d. 114 | intuition. 115 | - find_inversion. 116 | simpl. 117 | break_exists. 118 | intuition. 119 | match goal with 120 | | _ : dsk Log = Some ?s, _ : apply_log _ ?d ?entries = _ |- _ => 121 | exists (s +$+ (serialize (inl m : entry))), (entries ++ [inl m]), d 122 | end. 123 | intuition. 124 | + match goal with 125 | | H : context [log_num_entries] |- _ => rewrite H 126 | end. 127 | rewrite app_length. 128 | simpl. 129 | rewrite Nat.add_1_r. 130 | reflexivity. 131 | + break_match. 132 | * find_inversion. 133 | reflexivity. 134 | * congruence. 135 | + cheerios_crush. 136 | rewrite serialize_snoc. 137 | match goal with 138 | | H : IOStreamWriter.unwrap _ = IOStreamWriter.unwrap _ |- _ => rewrite H 139 | end. 140 | reflexivity. 141 | + match goal with 142 | | H : context [log_num_entries] |- _ => rewrite H 143 | end. 144 | rewrite app_length. 145 | simpl. 146 | rewrite Nat.add_1_r. 147 | reflexivity. 148 | + rewrite apply_log_app. 149 | match goal with 150 | | H : context [apply_log] |- _ => rewrite H 151 | end. 152 | simpl. 153 | match goal with 154 | | H : context [input_handlers] |- _ => rewrite H 155 | end. 156 | reflexivity. 157 | Qed. 158 | 159 | Lemma disk_correct_reboot : forall net h d ops, 160 | disk_correct (nwdoDisk net h) h (nwdoState net h) -> 161 | do_log_reboot snapshot_interval h (disk_to_channel (nwdoDisk net h)) = (d, ops) -> 162 | disk_correct (apply_ops (nwdoDisk net h) ops) h d. 163 | Proof using. 164 | intros net h d dsk H_correct H_reboot. 165 | unfold do_log_reboot, disk_to_channel, channel_to_log, from_channel in *. 166 | unfold disk_correct in *. break_exists. intuition. 167 | repeat find_rewrite. 168 | repeat rewrite IOStreamWriter.channel_wrap_unwrap in *. 169 | repeat rewrite serialize_deserialize_id_nil in H_reboot. 170 | rewrite <- (app_nil_r (IOStreamWriter.unwrap _)) in H_reboot. 171 | repeat find_rewrite. 172 | rewrite list_serialize_deserialize_id_rec in H_reboot. 173 | find_inversion. 174 | exists (IOStreamWriter.empty). 175 | exists []. 176 | exists (reboot (apply_log h x1 x0)). 177 | intuition. 178 | Qed. 179 | 180 | Lemma disk_correct_invariant : forall net failed tr, 181 | @step_failure_disk_ops_star _ _ log_failure_params step_failure_disk_ops_init (failed, net) tr -> 182 | forall h, disk_correct (nwdoDisk net h) h (nwdoState net h). 183 | Proof using. 184 | intros net failed tr H_st h. 185 | remember step_failure_disk_ops_init as x. 186 | change net with (snd (failed, net)). 187 | induction H_st using refl_trans_1n_trace_n1_ind. 188 | - subst. 189 | intros. 190 | simpl in *. 191 | unfold disk_correct. 192 | simpl. 193 | exists IOStreamWriter.empty, [], (init_handlers h). 194 | intuition. 195 | - concludes. 196 | match goal with H : step_failure_disk_ops _ _ _ |- _ => invcs H end. 197 | + break_if. 198 | * rewrite e in *. 199 | intuition. 200 | match goal with 201 | | [G : disk_correct _ _ _, H : log_net_handlers _ _ _ _ _ = _ |- _] => 202 | apply (log_net_handlers_spec _ _ _ _ _ _ _ _ _ _ G H) 203 | end. 204 | reflexivity. 205 | * assumption. 206 | + break_if. 207 | * rewrite e in *. 208 | match goal with 209 | | [G : disk_correct _ _ _, H : log_input_handlers _ _ _ _ = _ |- _] => 210 | apply (log_input_handlers_spec _ _ _ _ _ _ _ _ _ G H) 211 | end. 212 | reflexivity. 213 | * assumption. 214 | + assumption. 215 | + assumption. 216 | + assumption. 217 | + break_if. 218 | * repeat find_rewrite. 219 | find_apply_lem_hyp disk_correct_reboot; 220 | assumption. 221 | * assumption. 222 | Qed. 223 | 224 | Lemma reboot_invariant : forall net failed tr, 225 | @step_failure_disk_ops_star _ _ log_failure_params step_failure_disk_ops_init (failed, net) tr -> 226 | forall h d dsk, do_reboot h (disk_to_channel (nwdoDisk net h)) = (d, dsk) -> 227 | log_data d = reboot (log_data (nwdoState net h)). 228 | Proof using. 229 | intros net failed tr H_st h d dsk H_reboot. 230 | apply disk_correct_invariant with (h := h) in H_st. 231 | unfold disk_correct in *. 232 | break_exists. intuition. 233 | simpl in *. 234 | unfold do_log_reboot, channel_to_log, disk_to_channel in *. find_inversion. 235 | simpl. 236 | repeat match goal with 237 | | H : nwdoDisk net h _ = Some _ |- _ => rewrite H 238 | end. 239 | unfold from_channel. 240 | repeat rewrite IOStreamWriter.channel_wrap_unwrap in *. 241 | rewrite serialize_deserialize_id_nil. 242 | rewrite <- (app_nil_r (IOStreamWriter.unwrap _)). 243 | match goal with 244 | | H : IOStreamWriter.unwrap _ = IOStreamWriter.unwrap _ |- _ => rewrite H 245 | end. 246 | rewrite nat_serialize_deserialize_id. 247 | rewrite <- (app_nil_r (IOStreamWriter.unwrap _)). 248 | rewrite list_serialize_deserialize_id_rec. 249 | find_rewrite. 250 | reflexivity. 251 | Qed. 252 | 253 | Definition orig_packet := @packet _ orig_multi_params. 254 | Definition orig_network := @network _ orig_multi_params. 255 | 256 | Definition log_packet := @do_packet _ log_multi_params. 257 | Definition log_network := @do_network _ log_multi_params. 258 | 259 | Definition revertPacket (p : log_packet) : orig_packet := 260 | @mkPacket _ orig_multi_params (do_pSrc p) (do_pDst p) (do_pBody p). 261 | 262 | Definition revertLogNetwork (net: log_network) : orig_network := 263 | mkNetwork (map revertPacket (nwdoPackets net)) (fun h => (log_data (nwdoState net h))). 264 | 265 | Theorem log_step_failure_step : 266 | forall net net' failed failed' tr tr', 267 | @step_failure_disk_ops_star _ _ log_failure_params step_failure_disk_ops_init (failed, net) tr -> 268 | @step_failure_disk_ops _ _ log_failure_params (failed, net) (failed', net') tr' -> 269 | step_failure (failed, revertLogNetwork net) (failed', revertLogNetwork net') tr'. 270 | Proof using. 271 | intros. 272 | assert (revert_packets : forall net, nwPackets (revertLogNetwork net) = 273 | map revertPacket (nwdoPackets net)) by reflexivity. 274 | assert (revert_send : forall l h, 275 | map revertPacket (do_send_packets h l) = send_packets h l). 276 | { 277 | induction l. 278 | * reflexivity. 279 | * intros. 280 | simpl. 281 | now rewrite IHl. 282 | } 283 | assert (apply_if : forall h d, 284 | (fun h0 : name => log_data (if name_eq_dec h0 h then d else nwdoState net h0)) = 285 | (fun h0 : name => if name_eq_dec h0 h 286 | then log_data d 287 | else log_data (nwdoState net h0))). 288 | { 289 | intros. 290 | extensionality h0. 291 | break_if; reflexivity. 292 | } 293 | invcs H0. 294 | - unfold revertLogNetwork. 295 | simpl. 296 | find_rewrite. 297 | repeat rewrite map_app. simpl. 298 | rewrite revert_send. 299 | assert (revert_packet : do_pDst p = pDst (revertPacket p)) by reflexivity. 300 | rewrite revert_packet in *. 301 | apply @StepFailure_deliver with (xs := map revertPacket xs) 302 | (ys := map revertPacket ys) 303 | (d := log_data d) 304 | (l := l). 305 | + reflexivity. 306 | + assumption. 307 | + simpl. 308 | unfold log_net_handlers, log_handler_result in *. 309 | break_let. break_let. 310 | break_if; 311 | find_inversion; 312 | rewrite revert_packet in *; 313 | assumption. 314 | + simpl. 315 | rewrite apply_if. 316 | reflexivity. 317 | - unfold revertLogNetwork. 318 | simpl. 319 | repeat rewrite map_app. 320 | rewrite revert_send. 321 | apply @StepFailure_input with (d := log_data d) (l := l). 322 | + assumption. 323 | + unfold log_input_handlers, log_handler_result in *. 324 | do 2 break_let. 325 | break_if; 326 | find_inversion; 327 | assumption. 328 | + rewrite apply_if. 329 | reflexivity. 330 | - unfold revertLogNetwork. 331 | simpl. find_rewrite. 332 | rewrite map_app. simpl. 333 | apply @StepFailure_drop with (xs := map revertPacket xs) 334 | (p := revertPacket p) 335 | (ys := map revertPacket ys). 336 | + reflexivity. 337 | + rewrite map_app. reflexivity. 338 | - unfold revertLogNetwork. 339 | simpl. find_rewrite. 340 | rewrite map_app. simpl. 341 | apply (@StepFailure_dup _ _ _ _ _ _ 342 | (revertPacket p) 343 | (map revertPacket xs) 344 | (map revertPacket ys)). 345 | + reflexivity. 346 | + reflexivity. 347 | - constructor. 348 | - apply @StepFailure_reboot with (h := h). 349 | + assumption. 350 | + reflexivity. 351 | + unfold revertLogNetwork. simpl. 352 | apply reboot_invariant with (h := h) (d := d) (dsk := ops) in H. 353 | * rewrite <- H. 354 | rewrite apply_if. 355 | reflexivity. 356 | * assumption. 357 | Qed. 358 | 359 | Lemma log_step_failure_star_simulation : 360 | forall net failed tr, 361 | step_failure_disk_ops_star step_failure_disk_ops_init (failed, net) tr -> 362 | step_failure_star step_failure_init (failed, revertLogNetwork net) tr. 363 | Proof using. 364 | intros net failed tr H_star. 365 | remember step_failure_disk_ops_init as y in *. 366 | change failed with (fst (failed, net)). 367 | change net with (snd (failed, net)) at 2. 368 | revert Heqy. 369 | induction H_star using refl_trans_1n_trace_n1_ind; intro H_init. 370 | - find_rewrite. 371 | simpl; unfold revertLogNetwork; simpl. 372 | unfold step_failure_init, step_async_init. 373 | constructor. 374 | - concludes. 375 | destruct x' as (failed', net'). 376 | destruct x'' as (failed'', net''). 377 | subst. 378 | apply RT1n_step with (y := (failed', revertLogNetwork net')). 379 | + apply IHH_star1. 380 | + eapply log_step_failure_step; eauto. 381 | Qed. 382 | End LogCorrect. 383 | -------------------------------------------------------------------------------- /theories/Systems/SeqNum.v: -------------------------------------------------------------------------------- 1 | From Verdi Require Import Verdi. 2 | 3 | Set Implicit Arguments. 4 | 5 | Section SeqNum. 6 | Context {orig_base_params : BaseParams}. 7 | Context {orig_multi_params : MultiParams orig_base_params}. 8 | 9 | Record seq_num_data := mkseq_num_data { tdNum : nat; 10 | tdSeen : list (name * list nat); 11 | tdData : data }. 12 | 13 | Record seq_num_msg := mkseq_num_msg { tmNum : nat; tmMsg : msg }. 14 | 15 | Definition seq_num_msg_eq_dec (x y : seq_num_msg) : {x = y} + {x <> y}. 16 | decide equality. 17 | apply msg_eq_dec. 18 | decide equality. 19 | Defined. 20 | 21 | Fixpoint processPackets (seq_num : nat) (packets : list (name * msg)) : nat * list (name * seq_num_msg) := 22 | match packets with 23 | | [] => (seq_num, []) 24 | | p :: ps => let (n', pkts) := processPackets seq_num ps in 25 | (S n', (fst p, mkseq_num_msg n' (snd p)) :: pkts) 26 | end. 27 | 28 | Definition seq_num_init_handlers (n : name) := 29 | mkseq_num_data 0 [] (init_handlers n). 30 | 31 | Definition seq_num_net_handlers (dst : name) (src : name) (m : seq_num_msg) (state : seq_num_data) : 32 | list output * seq_num_data * list (name * seq_num_msg) := 33 | let seen_src := assoc_default name_eq_dec (tdSeen state) src [] in 34 | if member (tmNum m) seen_src then 35 | ([], state, []) 36 | else 37 | let '(out, data', pkts) := net_handlers dst src (tmMsg m) (tdData state) in 38 | let (n', tpkts) := processPackets (tdNum state) pkts in 39 | (out, mkseq_num_data n' (assoc_set name_eq_dec (tdSeen state) src (tmNum m :: seen_src)) data', tpkts). 40 | 41 | Definition seq_num_input_handlers 42 | (h : name) 43 | (inp : input) 44 | (state : seq_num_data) : 45 | (list output) * seq_num_data * list (name * seq_num_msg) := 46 | let '(out, data', pkts) := input_handlers h inp (tdData state) in 47 | let (n', tpkts) := processPackets (tdNum state) pkts in 48 | (out, mkseq_num_data n' (tdSeen state) data', tpkts). 49 | 50 | Instance base_params : BaseParams := 51 | { 52 | data := seq_num_data ; 53 | input := input ; 54 | output := output 55 | }. 56 | 57 | Instance multi_params : MultiParams _ := 58 | { 59 | name := name ; 60 | msg := seq_num_msg ; 61 | msg_eq_dec := seq_num_msg_eq_dec ; 62 | name_eq_dec := name_eq_dec ; 63 | nodes := nodes ; 64 | all_names_nodes := all_names_nodes; 65 | no_dup_nodes := no_dup_nodes; 66 | init_handlers := seq_num_init_handlers; 67 | net_handlers := seq_num_net_handlers; 68 | input_handlers := seq_num_input_handlers 69 | }. 70 | End SeqNum. 71 | 72 | #[global] 73 | Hint Extern 5 (@BaseParams) => apply base_params : typeclass_instances. 74 | #[global] 75 | Hint Extern 5 (@MultiParams _) => apply multi_params : typeclass_instances. 76 | -------------------------------------------------------------------------------- /theories/Systems/SerializedMsgParams.v: -------------------------------------------------------------------------------- 1 | From Verdi Require Import Verdi. 2 | From Cheerios Require Import Cheerios. 3 | 4 | Set Implicit Arguments. 5 | 6 | Section Serialized. 7 | Context {orig_base_params : BaseParams}. 8 | Context {orig_multi_params : MultiParams orig_base_params}. 9 | Context {orig_failure_params : FailureParams orig_multi_params}. 10 | Context {orig_name_overlay_params : NameOverlayParams orig_multi_params}. 11 | Context {orig_fail_msg_params : FailMsgParams orig_multi_params}. 12 | Context {orig_new_msg_params : NewMsgParams orig_multi_params}. 13 | Context {orig_msg_serializer : Serializer msg}. 14 | 15 | Definition serialize_name_msg_tuple (nm : name * msg) := 16 | let (n, msg) := nm in 17 | (n, serialize_top (serialize msg)). 18 | 19 | Definition serialize_handler_result (res : (list output) * data * list (name * msg)) := 20 | let '(outputs, data, messages) := res in 21 | (outputs, data, map serialize_name_msg_tuple messages). 22 | 23 | Definition serialized_net_handlers (dst : name) (src : name) (wm : IOStreamWriter.wire) (d : data) := 24 | match deserialize_top deserialize wm with 25 | | None => ([], d, []) 26 | | Some m => serialize_handler_result (net_handlers dst src m d) 27 | end. 28 | 29 | Definition serialized_input_handlers (h : name) (inp : input) (d : data) := 30 | serialize_handler_result (input_handlers h inp d). 31 | 32 | Instance serialized_base_params : BaseParams := orig_base_params. 33 | 34 | Instance serialized_multi_params : MultiParams _ := 35 | { 36 | name := name; 37 | name_eq_dec := name_eq_dec; 38 | msg := IOStreamWriter.wire; 39 | msg_eq_dec := IOStreamWriter.wire_eq_dec; 40 | nodes := nodes; 41 | all_names_nodes := all_names_nodes; 42 | no_dup_nodes := no_dup_nodes; 43 | init_handlers := init_handlers; 44 | net_handlers := serialized_net_handlers; 45 | input_handlers := serialized_input_handlers; 46 | }. 47 | 48 | Instance serialized_failure_params : FailureParams serialized_multi_params := 49 | { 50 | reboot := @reboot _ _ orig_failure_params 51 | }. 52 | 53 | Instance serialized_name_overlay_params : NameOverlayParams serialized_multi_params := 54 | { 55 | adjacent_to := @adjacent_to _ _ orig_name_overlay_params; 56 | adjacent_to_dec := @adjacent_to_dec _ _ orig_name_overlay_params; 57 | adjacent_to_symmetric := @adjacent_to_symmetric _ _ orig_name_overlay_params; 58 | adjacent_to_irreflexive := @adjacent_to_irreflexive _ _ orig_name_overlay_params 59 | }. 60 | 61 | Instance serialized_fail_msg_params : FailMsgParams serialized_multi_params := 62 | { 63 | msg_fail := serialize_top (serialize msg_fail) 64 | }. 65 | 66 | Instance serialized_new_msg_params : NewMsgParams serialized_multi_params := 67 | { 68 | msg_new := serialize_top (serialize msg_new) 69 | }. 70 | End Serialized. 71 | 72 | #[global] 73 | Hint Extern 5 (@BaseParams) => apply serialized_base_params : typeclass_instances. 74 | #[global] 75 | Hint Extern 5 (@MultiParams _) => apply serialized_multi_params : typeclass_instances. 76 | #[global] 77 | Hint Extern 5 (@FailureParams _ _) => apply serialized_failure_params : typeclass_instances. 78 | #[global] 79 | Hint Extern 5 (@NameOverlayParams _ _) => apply serialized_name_overlay_params : typeclass_instances. 80 | #[global] 81 | Hint Extern 5 (@FailMsgParams _ _) => apply serialized_fail_msg_params : typeclass_instances. 82 | #[global] 83 | Hint Extern 5 (@NewMsgParams _ _) => apply serialized_new_msg_params : typeclass_instances. 84 | -------------------------------------------------------------------------------- /theories/Systems/VarD.v: -------------------------------------------------------------------------------- 1 | From Verdi Require Import Verdi. 2 | From Coq Require Import FMapList String. 3 | From Verdi Require Import FMapVeryWeak StateMachineHandlerMonad. 4 | 5 | Definition key := string. 6 | Definition value := string. 7 | 8 | Inductive input : Set := 9 | | Put : key -> value -> input 10 | | Get : key -> input 11 | | Del : key -> input 12 | | CAS : key -> option value -> value -> input 13 | | CAD : key -> value -> input. 14 | 15 | Inductive output : Set := 16 | | Response : key -> option value -> option value -> output. (* uniform response *) 17 | 18 | Module VarDFunctor (Map : VWS 19 | with Definition E.t := string 20 | with Definition E.eq := @eq string). 21 | 22 | Definition key_eq_dec := string_dec. 23 | Definition value_eq_dec := string_dec. 24 | 25 | Definition val_eq_dec : forall v v' : option value, {v = v'} + {v <> v'}. 26 | decide equality. 27 | auto using value_eq_dec. 28 | Defined. 29 | 30 | Theorem input_eq_dec : forall x y: input, {x = y} + {x <> y}. 31 | Proof. 32 | decide equality; 33 | auto using key_eq_dec, value_eq_dec, val_eq_dec. 34 | Defined. 35 | 36 | Theorem output_eq_dec : forall x y: output, {x = y} + {x <> y}. 37 | Proof. 38 | decide equality; 39 | auto using key_eq_dec, value_eq_dec, val_eq_dec. 40 | Defined. 41 | 42 | Definition data := 43 | Map.t string. 44 | 45 | Definition beq_key (k1 k2 : key) := 46 | if string_dec k1 k2 then true else false. 47 | 48 | Definition getk k : GenHandler1 data (option value) := 49 | db <- get ;; 50 | ret (Map.find k db). 51 | 52 | Definition setk k v : GenHandler1 data unit := modify (fun db => Map.add k v db). 53 | 54 | Definition delk k : GenHandler1 data unit := modify (fun db => Map.remove k db). 55 | 56 | Definition resp k v old : GenHandler1 data output := 57 | write_output (Response k v old). 58 | 59 | Definition VarDHandler' (inp : input) : GenHandler1 data output := 60 | match inp with 61 | | Get k => v <- getk k ;; resp k v v 62 | | Put k v => old <- getk k ;; setk k v ;; resp k (Some v) old 63 | | Del k => old <- getk k ;; delk k ;; resp k None old 64 | | CAS k v v' => 65 | old <- getk k ;; 66 | if (val_eq_dec old v) then 67 | (setk k v' ;; resp k (Some v') old) 68 | else 69 | resp k old old 70 | | CAD k v => 71 | old <- getk k ;; 72 | if (val_eq_dec old (Some v)) then 73 | (delk k ;; resp k None old) 74 | else 75 | resp k old old 76 | end. 77 | 78 | Definition runHandler (h : input -> GenHandler1 data output) 79 | (inp : input) (d : data) : output * data := 80 | runGenHandler1 d (h inp). 81 | 82 | Definition VarDHandler := runHandler VarDHandler'. 83 | 84 | Definition init_map := Map.empty string. 85 | 86 | #[global] 87 | Instance vard_base_params : BaseParams := 88 | { 89 | data := data ; 90 | input := input ; 91 | output := output 92 | }. 93 | 94 | #[global] 95 | Instance vard_one_node_params : OneNodeParams _ := 96 | { 97 | init := init_map ; 98 | handler := VarDHandler 99 | }. 100 | 101 | Definition input_key (i : input) : key := 102 | match i with 103 | | Get k => k 104 | | Put k _ => k 105 | | Del k => k 106 | | CAS k _ _ => k 107 | | CAD k _ => k 108 | end. 109 | 110 | Definition operate (op : input) (curr : option value) := 111 | match op with 112 | | Get _ => (curr, curr) 113 | | Put _ v => (Some v, curr) 114 | | Del _ => (None, curr) 115 | | CAS _ v v' => if val_eq_dec curr v then (Some v', curr) else (curr, curr) 116 | | CAD _ v => if val_eq_dec curr (Some v) then (None, curr) else (curr, curr) 117 | end. 118 | 119 | Fixpoint interpret (k : key) (ops : list input) (init : option value) := 120 | match ops with 121 | | [] => (init, init) 122 | | op :: ops => 123 | (operate op (fst (interpret k ops init))) 124 | end. 125 | 126 | Definition inputs_with_key (trace : list (input * output)) (k : key) : list input := 127 | filterMap (fun ev => if key_eq_dec k (input_key (fst ev)) then 128 | Some (fst ev) 129 | else 130 | None) 131 | trace. 132 | 133 | 134 | Inductive trace_correct : list (input * output) -> Prop := 135 | | TCnil : trace_correct [] 136 | | TCApp : forall t i v o, trace_correct t -> 137 | interpret (input_key i) 138 | (i :: (rev (inputs_with_key t (input_key i)))) 139 | None = (v, o) -> 140 | trace_correct (t ++ [(i, Response (input_key i) v o)]). 141 | 142 | Inductive trace_correct' : data -> list (input * output) -> Prop := 143 | | TC'nil : forall st, trace_correct' st [] 144 | | TC'App : forall st t i v o, trace_correct' st t -> 145 | interpret (input_key i) 146 | (i :: (rev (inputs_with_key t (input_key i)))) 147 | (Map.find (input_key i) st) = (v, o) -> 148 | trace_correct' st (t ++ [(i, Response (input_key i) v o)]). 149 | 150 | Lemma trace_correct'_trace_correct : 151 | forall trace, 152 | trace_correct' init trace -> 153 | trace_correct trace. 154 | Proof. 155 | intros. 156 | remember init as x. induction H. 157 | - constructor. 158 | - subst. constructor; auto. 159 | find_rewrite_lem Map.empty_o. auto. 160 | Qed. 161 | 162 | Definition trace_state_correct (trace : list (input * output)) (st : data) (st' : data) := 163 | forall k, 164 | fst (interpret k (rev (inputs_with_key trace k)) (Map.find k st)) = Map.find k st'. 165 | 166 | Ltac vard_unfold := 167 | unfold runHandler, 168 | getk, 169 | setk, 170 | delk, 171 | resp in *; monad_unfold. 172 | 173 | Lemma trace_well_formed : 174 | forall st st' trace, 175 | step_1_star st st' trace -> 176 | (trace = [] \/ exists t i o, trace = t ++ [(i, o)]). 177 | Proof. 178 | intros. 179 | find_apply_lem_hyp refl_trans_1n_n1_trace. 180 | invcs H; intuition. 181 | right. exists cs. invcs H1. unfold VarDHandler, VarDHandler' in *. 182 | vard_unfold. 183 | repeat break_match; simpl in *; repeat find_inversion; repeat eexists; eauto. 184 | Qed. 185 | 186 | Lemma inputs_with_key_plus_key : 187 | forall l k i o, 188 | input_key i = k -> 189 | inputs_with_key (l ++ [(i, o)]) k = 190 | (inputs_with_key l k) ++ [i]. 191 | Proof. 192 | induction l; intros; simpl in *. 193 | - unfold inputs_with_key. simpl in *. 194 | repeat break_match; congruence. 195 | - unfold inputs_with_key in *. 196 | simpl in *. 197 | repeat break_match; simpl in *; f_equal; eauto. 198 | Qed. 199 | 200 | Lemma inputs_with_key_plus_not_key : 201 | forall l k i o, 202 | input_key i <> k -> 203 | inputs_with_key (l ++ [(i, o)]) k = 204 | (inputs_with_key l k). 205 | Proof. 206 | induction l; intros; simpl in *. 207 | - unfold inputs_with_key. simpl in *. 208 | repeat break_match; congruence. 209 | - unfold inputs_with_key in *. 210 | simpl in *. 211 | repeat break_match; simpl in *; eauto; try discriminate. 212 | repeat find_inversion. 213 | f_equal. eauto. 214 | Qed. 215 | 216 | Theorem step_1_star_trace_state_correct : 217 | forall st st' trace, 218 | step_1_star st st' trace -> 219 | trace_state_correct trace st st'. 220 | Proof. 221 | intros. 222 | find_apply_lem_hyp refl_trans_1n_n1_trace. 223 | induction H; auto. 224 | - unfold trace_state_correct. auto. 225 | - unfold trace_state_correct in *. intros. 226 | invcs H0. unfold VarDHandler, VarDHandler' in *. 227 | vard_unfold. repeat break_match; simpl in *; repeat find_inversion. 228 | + destruct (key_eq_dec k0 k). 229 | * rewrite inputs_with_key_plus_key; simpl in *; auto. 230 | rewrite rev_unit. simpl in *. 231 | subst. 232 | symmetry; apply Map.add_eq_o. 233 | reflexivity. 234 | * rewrite inputs_with_key_plus_not_key; simpl in *; eauto. 235 | rewrite Map.add_neq_o; auto. 236 | + destruct (key_eq_dec k0 k). 237 | * rewrite inputs_with_key_plus_key; simpl in *; auto. 238 | rewrite rev_unit. simpl in *. 239 | subst. eauto. 240 | * rewrite inputs_with_key_plus_not_key; simpl in *; eauto. 241 | + destruct (key_eq_dec k0 k). 242 | * rewrite inputs_with_key_plus_key; simpl in *; auto. 243 | rewrite rev_unit. simpl in *. 244 | subst. eauto. 245 | rewrite Map.remove_eq_o; auto. 246 | * rewrite inputs_with_key_plus_not_key; simpl in *; eauto. 247 | rewrite Map.remove_neq_o; auto. 248 | + destruct (key_eq_dec k0 k). 249 | * subst. rewrite inputs_with_key_plus_key; simpl in *; auto. 250 | rewrite rev_unit. simpl in *. 251 | break_if; [rewrite Map.add_eq_o; auto | idtac]. 252 | exfalso. intuition. 253 | * rewrite inputs_with_key_plus_not_key; simpl in *; eauto. 254 | rewrite Map.add_neq_o; auto. 255 | + destruct (key_eq_dec k0 k). 256 | * rewrite inputs_with_key_plus_key; simpl in *; auto. 257 | rewrite rev_unit. simpl in *. 258 | subst. break_if. 259 | -- subst. 260 | exfalso. intuition. 261 | -- simpl in *. 262 | apply IHrefl_trans_n1_trace. 263 | * rewrite inputs_with_key_plus_not_key; simpl in *; eauto. 264 | + destruct (key_eq_dec k0 k). 265 | * { subst. rewrite inputs_with_key_plus_key; simpl in *; auto. 266 | rewrite rev_unit. simpl in *. 267 | break_if; simpl in *. 268 | - symmetry. rewrite Map.remove_eq_o; auto. 269 | - exfalso. intuition. 270 | match goal with 271 | | H : _ -> False |- _ => apply H 272 | end. 273 | find_higher_order_rewrite. auto. 274 | } 275 | * rewrite inputs_with_key_plus_not_key; simpl in *; eauto. 276 | rewrite Map.remove_neq_o; auto. 277 | + destruct (key_eq_dec k0 k). 278 | * subst. rewrite inputs_with_key_plus_key; simpl in *; auto. 279 | rewrite rev_unit. simpl in *. 280 | break_if; simpl in *; intuition. 281 | exfalso. intuition. 282 | match goal with 283 | | H : _ -> False |- _ => apply H 284 | end. 285 | find_higher_order_rewrite. auto. 286 | * rewrite inputs_with_key_plus_not_key; simpl in *; eauto. 287 | Qed. 288 | 289 | Lemma trace_state_correct_trace_correct : 290 | forall st st' st'' trace t, 291 | trace_state_correct trace st st' -> 292 | trace_correct' st trace -> 293 | step_1 st' st'' t -> 294 | trace_correct' st (trace ++ t). 295 | Proof. 296 | intros. 297 | invcs H1; simpl in *. 298 | unfold VarDHandler, VarDHandler' in *. 299 | vard_unfold. 300 | repeat break_match; simpl in *; repeat find_inversion; constructor; auto; 301 | simpl in *; f_equal; eauto; 302 | break_if; simpl in *; f_equal; eauto; unfold trace_state_correct in *; 303 | exfalso; subst; repeat find_higher_order_rewrite; 304 | intuition. 305 | Qed. 306 | 307 | Theorem step_1_star_trace_correct' : 308 | forall st st' trace, 309 | step_1_star st st' trace -> 310 | trace_correct' st trace. 311 | Proof. 312 | intros. 313 | find_apply_lem_hyp refl_trans_1n_n1_trace. 314 | induction H. 315 | - constructor. 316 | - find_apply_lem_hyp refl_trans_n1_1n_trace. 317 | find_apply_lem_hyp step_1_star_trace_state_correct; auto. 318 | eapply trace_state_correct_trace_correct; eauto. 319 | Qed. 320 | 321 | Theorem step_1_star_trace_correct : 322 | forall st trace, 323 | step_1_star init st trace -> 324 | trace_correct trace. 325 | Proof. 326 | intros. 327 | find_apply_lem_hyp step_1_star_trace_correct'. 328 | eauto using trace_correct'_trace_correct. 329 | Qed. 330 | 331 | Open Scope string_scope. 332 | Example trace_correct_eg0 : 333 | trace_correct [(Put "james" "awesome", Response "james" (Some "awesome") None)]. 334 | Proof. 335 | rewrite <- app_nil_l. 336 | constructor. 337 | - constructor. 338 | - simpl. auto. 339 | Qed. 340 | End VarDFunctor. 341 | 342 | Module LogTimeVarD := VarDFunctor(LogTimeStringMap). 343 | Module LinearTimeVarD := VarDFunctor(LinearTimeStringMap). 344 | 345 | Module VarD := LogTimeVarD. 346 | 347 | Export VarD. 348 | -------------------------------------------------------------------------------- /theories/Systems/VarDPrimaryBackup.v: -------------------------------------------------------------------------------- 1 | From Verdi Require Import Verdi. 2 | From Coq Require Import String. 3 | From Verdi Require Import VarD PrimaryBackup. 4 | 5 | Open Scope string_scope. 6 | 7 | #[global] 8 | Instance vard_pbj_params : PrimaryBackupParams vard_base_params := 9 | { 10 | input_eq_dec := VarD.input_eq_dec 11 | }. 12 | 13 | Theorem lifting_applied : 14 | forall (net : @network _ PB_multi_params) tr, 15 | step_async_star step_async_init net tr -> 16 | trace_correct (revert_trace (base_params := vard_base_params) tr). 17 | Proof. 18 | apply transformer. 19 | eauto using step_1_star_trace_correct. 20 | Qed. 21 | 22 | Example revert_trace_primary_empty : 23 | revert_trace [(Primary, inl (Request (Put "james" "awesome")))] = []. 24 | Proof. 25 | reflexivity. 26 | Qed. 27 | 28 | Example revert_trace_eg : 29 | forall net tr o, 30 | step_async_star (params := PB_multi_params) step_async_init net tr -> 31 | inputs_m tr = [Put "james" "awesome"] -> 32 | outputs_m tr = [o] -> 33 | o = Response "james" (Some "awesome") None. 34 | Proof. 35 | intros. 36 | find_copy_apply_lem_hyp simulation. 37 | find_copy_apply_lem_hyp pbj_NOABT. 38 | find_apply_lem_hyp outputs_m_revert_trace. 39 | find_copy_apply_lem_hyp inputs_1_m_revert. 40 | find_copy_apply_lem_hyp lifting_applied. 41 | 42 | repeat find_rewrite. 43 | destruct (revert_trace tr); try discriminate. 44 | simpl in *. find_inversion. destruct l; try discriminate. 45 | simpl in *. 46 | find_inversion. 47 | repeat find_reverse_rewrite. 48 | 49 | find_copy_eapply_lem_hyp correspond_reachable; eauto. 50 | - invc H5. destruct t. 51 | + simpl in *. repeat find_inversion. simpl in *. subst. simpl in *. find_inversion. auto. 52 | + destruct t; discriminate. 53 | - simpl. congruence. 54 | Qed. 55 | 56 | Example get_set_eg1 : 57 | forall tr (net : @network _ PB_multi_params) a b, 58 | step_async_star step_async_init net tr -> 59 | inputs_m tr = [Put "james" "awesome"; Get "james"] -> 60 | outputs_m tr = [a; b] -> 61 | outputs_m tr = [Response "james" (Some "awesome") None; 62 | Response "james" (Some "awesome") (Some "awesome")]. 63 | Proof. 64 | intros. 65 | find_copy_apply_lem_hyp simulation. 66 | find_copy_apply_lem_hyp pbj_NOABT. 67 | find_apply_lem_hyp outputs_m_revert_trace. 68 | find_copy_apply_lem_hyp inputs_1_m_revert. 69 | find_copy_apply_lem_hyp lifting_applied. 70 | 71 | repeat find_rewrite. 72 | destruct (revert_trace tr); try discriminate. 73 | simpl in *. find_inversion. destruct l; try discriminate. 74 | simpl in *. 75 | find_inversion. 76 | destruct l; try discriminate. 77 | simpl in *. 78 | find_inversion. 79 | repeat find_reverse_rewrite. 80 | 81 | find_copy_eapply_lem_hyp correspond_reachable; eauto. 82 | - invc H5. 83 | destruct t; simpl in *; repeat find_inversion. 84 | destruct t; simpl in *; repeat find_inversion. 85 | + simpl in *. invc H8. destruct t; simpl in *. 86 | * repeat find_inversion. simpl in *. repeat find_rewrite. 87 | subst. simpl in *. find_inversion. auto. 88 | * repeat find_inversion. destruct t; discriminate. 89 | + destruct t; discriminate. 90 | - simpl. congruence. 91 | Qed. 92 | -------------------------------------------------------------------------------- /theories/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name Verdi) 3 | (package coq-verdi) 4 | (synopsis "Framework for verification of implementations of distributed systems in Coq")) 5 | 6 | (include_subdirs qualified) 7 | --------------------------------------------------------------------------------