├── .github └── workflows │ ├── docker-action.yml │ └── nix-action.yml ├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── Makefile ├── README.md ├── _CoqProject ├── coq-chapar-stores.opam ├── coq-chapar.opam ├── dune-project ├── meta.yml ├── scripts ├── Settings.txt ├── Settings1.txt ├── Settings2.txt ├── batchrun ├── batchrundetach ├── clearnodes ├── common ├── fetchresults ├── printlauncherout ├── printnodesout └── run ├── src ├── bench │ ├── benchgen.ml │ ├── dune │ └── experiment.ml ├── store1 │ ├── ExtractAlgorithm1.v │ ├── algorithm1.ml │ ├── dune │ └── launchStore1.ml ├── store2 │ ├── ExtractAlgorithm2.v │ ├── algorithm2.ml │ ├── dune │ └── launchStore2.ml ├── store3 │ ├── ExtractAlgorithm3.v │ ├── algorithm3.ml │ ├── dune │ └── launchStore3.ml └── utils │ ├── algorithm.ml │ ├── benchprog.ml │ ├── common.ml │ ├── commonbench.ml │ ├── configuration.ml │ ├── dune │ ├── readConfig.ml │ ├── runtime.ml │ └── util.ml └── theories ├── Algorithms ├── ExtractAlgorithm.v ├── KVSAlg1.v ├── KVSAlg2.v └── KVSAlg3.v ├── Examples ├── Clients.v └── ListClient.v ├── Framework ├── KVStore.v └── ReflectiveAbstractSemantics.v ├── Lib ├── Predefs.v └── extralib.v └── dune /.github/workflows/docker-action.yml: -------------------------------------------------------------------------------- 1 | name: Docker CI 2 | 3 | on: 4 | push: 5 | branches: 6 | - master 7 | pull_request: 8 | branches: 9 | - '**' 10 | 11 | jobs: 12 | build: 13 | # the OS must be GNU/Linux to be able to use the docker-coq-action 14 | runs-on: ubuntu-latest 15 | strategy: 16 | matrix: 17 | image: 18 | - 'coqorg/coq:dev' 19 | - 'coqorg/coq:8.19' 20 | - 'coqorg/coq:8.18' 21 | - 'coqorg/coq:8.17' 22 | - 'coqorg/coq:8.16' 23 | - 'coqorg/coq:8.15' 24 | - 'coqorg/coq:8.14' 25 | fail-fast: false 26 | steps: 27 | - uses: actions/checkout@v3 28 | - uses: coq-community/docker-coq-action@v1 29 | with: 30 | custom_image: ${{ matrix.image }} 31 | custom_script: | 32 | {{before_install}} 33 | startGroup "Build chapar dependencies" 34 | opam pin add -n -y -k path coq-chapar . 35 | opam update -y 36 | opam install -y -j 2 coq-chapar --deps-only 37 | endGroup 38 | startGroup "Build chapar" 39 | opam install -y -v -j 2 coq-chapar 40 | opam list 41 | endGroup 42 | startGroup "Build chapar-stores dependencies" 43 | opam pin add -n -y -k path coq-chapar-stores . 44 | opam update -y 45 | opam install -y -j 2 coq-chapar-stores --deps-only 46 | endGroup 47 | startGroup "Build chapar-stores" 48 | opam install -y -v -j 2 coq-chapar-stores 49 | opam list 50 | endGroup 51 | startGroup "Uninstallation test" 52 | opam remove -y coq-chapar-stores 53 | opam remove -y coq-chapar 54 | endGroup 55 | 56 | # See also: 57 | # https://github.com/coq-community/docker-coq-action#readme 58 | # https://github.com/erikmd/docker-coq-github-action-demo 59 | -------------------------------------------------------------------------------- /.github/workflows/nix-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: Nix CI 4 | 5 | on: 6 | push: 7 | branches: 8 | - master 9 | pull_request: 10 | paths: 11 | - .github/workflows/** 12 | pull_request_target: 13 | 14 | jobs: 15 | build: 16 | runs-on: ubuntu-latest 17 | strategy: 18 | matrix: 19 | overrides: 20 | - 'coq = "master"' 21 | fail-fast: false 22 | steps: 23 | - name: Determine which commit to test 24 | run: | 25 | if [[ ${{ github.event_name }} =~ "pull_request" ]]; then 26 | merge_commit=$(git ls-remote ${{ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge | cut -f1) 27 | if [ -z "$merge_commit" ]; then 28 | echo "tested_commit=${{ github.event.pull_request.head.sha }}" >> $GITHUB_ENV 29 | else 30 | echo "tested_commit=$merge_commit" >> $GITHUB_ENV 31 | fi 32 | else 33 | echo "tested_commit=${{ github.sha }}" >> $GITHUB_ENV 34 | fi 35 | - uses: cachix/install-nix-action@v20 36 | with: 37 | nix_path: nixpkgs=channel:nixpkgs-unstable 38 | - uses: cachix/cachix-action@v12 39 | with: 40 | name: coq-community 41 | authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}' 42 | extraPullNames: coq, math-comp 43 | - uses: actions/checkout@v3 44 | with: 45 | ref: ${{ env.tested_commit }} 46 | - run: > 47 | nix-build https://github.com/coq-community/coq-nix-toolbox/archive/master.tar.gz --argstr job chapar --arg override '{ ${{ matrix.overrides }}; chapar = builtins.filterSource (path: _: baseNameOf path != ".git") ./.; }' 48 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.vo 2 | *.glob 3 | *.v.d 4 | *.aux 5 | *.vio 6 | *.vos 7 | *.vok 8 | *~ 9 | *.install 10 | .Makefile.coq.d 11 | Makefile.coq 12 | Makefile.coq.bak 13 | Makefile.coq.conf 14 | .coqdeps.d 15 | ml/KVSAlg1.ml 16 | ml/KVSAlg1.mli 17 | ml/KVSAlg2.ml 18 | ml/KVSAlg2.mli 19 | ml/KVSAlg3.ml 20 | ml/KVSAlg3.mli 21 | benchgen.native 22 | launchStore1.native 23 | launchStore2.native 24 | launchStore3.native 25 | experiment.native 26 | _build 27 | .lia.cache 28 | .merlin 29 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | All notable changes to this project will be documented in this file. 3 | 4 | The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/). 5 | 6 | ## [Unreleased] 7 | 8 | ### Fixed 9 | - Build with Coq 8.19 and beyond 10 | 11 | ## [8.16.0] - 2023-10-01 12 | 13 | ### Changed 14 | - Adjust build for Coq 8.18 and beyond 15 | - Use Dune wrapping for OCaml modules 16 | - Remove boilerplate for OCamlbuild 17 | - Move bash scripts to scripts directory 18 | - Use standard theories/src directory names 19 | 20 | ### Fixed 21 | - Stores build with Dune 3.6 or later 22 | - Nix CI configuration 23 | - List lemma deprecations in 8.18 24 | 25 | ## [8.15.0] - 2023-02-05 26 | ### Changed 27 | - Removed unecessary imports 28 | - Adjust build for Coq 8.16 and beyond 29 | 30 | ### Fixed 31 | - Deprecations related to Stdlib Nat module 32 | 33 | ## [8.14.0] - 2022-01-12 34 | ### Changed 35 | - Add hint locality everywhere and consequently require Coq 8.14 or later 36 | 37 | ### Fixed 38 | - Use consistent conventions for `Require Import` 39 | 40 | ## [8.13.0] - 2021-08-02 41 | ### Changed 42 | - Make most hints local 43 | - Adjust build for Coq 8.13 and beyond 44 | 45 | ## [8.12.0] - 2020-10-01 46 | ### Changed 47 | - OCaml OPAM package definition uses Dune 48 | - Reorganize extraction to support Dune 49 | - Coq OPAM package definition uses Dune 50 | - Declare all scopes and consequently require Coq 8.10 or later 51 | 52 | ### Added 53 | - Support for OCaml builds with Dune 54 | - Support for Coq builds with Dune 55 | 56 | ### Fixed 57 | - Remove dependency on a local functional extensionality axiom 58 | 59 | ### Removed 60 | - All uses of UTF-8 61 | 62 | ## [8.11.0] - 2020-01-31 63 | ### Fixed 64 | - Compatibility with Coq 8.11 65 | - Ignore more untracked files such as `.vos` 66 | - Remove mention of extracted OPAM package in README.md 67 | 68 | ### Changed 69 | - Add `Proof using` annotations for faster `.vos`/`.vio` compilation 70 | - Ignore undeclared scope warnings 71 | 72 | ## [8.10.0] - 2019-10-14 73 | ### Removed 74 | - Unused library lemmas and functions originally from a formalization of separation logic that were vendored 75 | 76 | ### Fixed 77 | - Hint and declaration deprecation warnings 78 | - Switch from deprecated `omega` tactic to `lia` 79 | 80 | ### Changed 81 | - Use LF newlines everywhere, in place of CRLF 82 | 83 | ## [8.9.0] - 2019-05-15 84 | ### Fixed 85 | - Support for Coq 8.9 and later (port from Coq 8.4) 86 | - OCaml compilation of extracted code (OCaml 4.05.0 or later and Batteries 2.8.0 or later) 87 | 88 | ### Changed 89 | - Modernize build scripts to use `coq_makefile` features 90 | - Reorganize code into subdirectories 91 | 92 | [Unreleased]: https://github.com/coq-community/chapar/compare/v8.16.0...master 93 | [8.16.0]: https://github.com/coq-community/chapar/releases/tag/v8.16.0 94 | [8.15.0]: https://github.com/coq-community/chapar/releases/tag/v8.15.0 95 | [8.14.0]: https://github.com/coq-community/chapar/releases/tag/v8.14.0 96 | [8.13.0]: https://github.com/coq-community/chapar/releases/tag/v8.13.0 97 | [8.12.0]: https://github.com/coq-community/chapar/releases/tag/v8.12.0 98 | [8.11.0]: https://github.com/coq-community/chapar/releases/tag/v8.11.0 99 | [8.10.0]: https://github.com/coq-community/chapar/releases/tag/v8.10.0 100 | [8.9.0]: https://github.com/coq-community/chapar/releases/tag/v8.9.0 101 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2015 Programming Languages and Verification Group at MIT CSAIL 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | 23 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 5 | # Chapar 6 | 7 | [![Docker CI][docker-action-shield]][docker-action-link] 8 | [![Nix CI][nix-action-shield]][nix-action-link] 9 | [![Contributing][contributing-shield]][contributing-link] 10 | [![Code of Conduct][conduct-shield]][conduct-link] 11 | [![Zulip][zulip-shield]][zulip-link] 12 | [![DOI][doi-shield]][doi-link] 13 | 14 | [docker-action-shield]: https://github.com/coq-community/chapar/actions/workflows/docker-action.yml/badge.svg?branch=master 15 | [docker-action-link]: https://github.com/coq-community/chapar/actions/workflows/docker-action.yml 16 | 17 | [nix-action-shield]: https://github.com/coq-community/chapar/actions/workflows/nix-action.yml/badge.svg?branch=master 18 | [nix-action-link]: https://github.com/coq-community/chapar/actions/workflows/nix-action.yml 19 | 20 | [contributing-shield]: https://img.shields.io/badge/contributions-welcome-%23f7931e.svg 21 | [contributing-link]: https://github.com/coq-community/manifesto/blob/master/CONTRIBUTING.md 22 | 23 | [conduct-shield]: https://img.shields.io/badge/%E2%9D%A4-code%20of%20conduct-%23f15a24.svg 24 | [conduct-link]: https://github.com/coq-community/manifesto/blob/master/CODE_OF_CONDUCT.md 25 | 26 | [zulip-shield]: https://img.shields.io/badge/chat-on%20zulip-%23c1272d.svg 27 | [zulip-link]: https://coq.zulipchat.com/#narrow/stream/237663-coq-community-devs.20.26.20users 28 | 29 | 30 | [doi-shield]: https://zenodo.org/badge/DOI/10.1145/2837614.2837622.svg 31 | [doi-link]: https://doi.org/10.1145/2837614.2837622 32 | 33 | A framework for modular verification of causal consistency for replicated key-value 34 | store implementations and their client programs in Coq. Includes proofs of the causal consistency 35 | of two key-value store implementations and a simple automatic model checker for the correctness 36 | of client programs. 37 | 38 | ## Meta 39 | 40 | - Author(s): 41 | - Mohsen Lesani (initial) 42 | - Christian J. Bell (initial) 43 | - Adam Chlipala (initial) 44 | - Coq-community maintainer(s): 45 | - Karl Palmskog ([**@palmskog**](https://github.com/palmskog)) 46 | - License: [MIT License](LICENSE) 47 | - Compatible Coq versions: 8.14 or later 48 | - Additional dependencies: none 49 | - Coq namespace: `Chapar` 50 | - Related publication(s): 51 | - [Chapar: Certified Causally Consistent Distributed Key-value Stores](http://adam.chlipala.net/papers/ChaparPOPL16/) doi:[10.1145/2837614.2837622](https://doi.org/10.1145/2837614.2837622) 52 | 53 | ## Building and installation instructions 54 | 55 | The easiest way to install the latest released version of Chapar 56 | is via [OPAM](https://opam.ocaml.org/doc/Install.html): 57 | 58 | ```shell 59 | opam repo add coq-released https://coq.inria.fr/opam/released 60 | opam install coq-chapar 61 | ``` 62 | 63 | To instead build and install manually, do: 64 | 65 | ``` shell 66 | git clone https://github.com/coq-community/chapar.git 67 | cd chapar 68 | make # or make -j 69 | make install 70 | ``` 71 | 72 | 73 | ## Chapar Executable Key-value Stores 74 | 75 | Three key-value stores, verified to be causally consistent in the Coq proof assistant and extracted to executable code. See [here](coq-chapar-stores.opam) for the requirements to build the stores. 76 | 77 | ## Documentation 78 | 79 | ### Coq Framework 80 | 81 | The Coq definitions and proofs are located in the `theories` directory. The code location of the definitions and lemmas presented in the paper are listed below. 82 | 83 | #### Semantics and the Proof Technique 84 | 85 | - Section 2, Figure 3 (Program): `KVStore.v`, `Section ValSec` 86 | - Section 2, Figure 4 (Key-value Store Algorithm Interface): `KVStore.v`, `Module Type AlgDef` 87 | - Section 2, Figure 5 (Concrete Operational Semantics): `KVStore.v`, `Module ConcExec` 88 | - Section 3, Figure 6 (Abstract Operational Semantics): `KVStore.v`, `Module AbsExec` 89 | - Section 4, Figure 8 (Concrete Instrumented Operational Semantics): `KVStore.v`, `Module InstConcExec` 90 | - Section 4, Figure 10 (Correctness Condition WellRec): `KVStore.v`, `Module Type CauseObl` 91 | - Section 4, Figure 11 (Causal relation): `KVStore.v`, `Definition cause_step` and `Inductive cause` 92 | - Section 4, Figure 12 (Sequential Operational Semantics): `KVStore.v`, `Module SeqExec` 93 | - Section 4, Definition 2 (Causal Consistency) and Theorem 2 (Sufficiency of Well-reception): `KVStore.v`, `Theorem CausallyConsistent`. Note that `(CauseObl: CauseObl AlgDef)` is a parameter of the module `ExecToAbstExec`. 94 | - Section 4, Lemma 1: `KVStore.v`, `Lemma FaultFreedom`. Note that `(CauseObl: CauseObl AlgDef)` is a parameter of the module `ExecToAbstExec`. 95 | 96 | #### Algorithms 97 | 98 | - Section 5, Figure 13 (Algorithm 1): `KVSAlg1.v`, `Module Type KVSAlg1` 99 | - Section 5, Theorem 3: `KVSAlg1.v`, `Module KVSAlg1CauseObl (SyntaxArg: SyntaxPar) <: CauseObl KVSAlg1 SyntaxArg` 100 | - Section 5, Corollary 1: `KVSAlg1.v`, `Lemma CausallyConsistent` 101 | - Section 5, Lemma 2 (Clock Monotonicity): `KVSAlg1.v`, `Lemma cause_clock` 102 | - Section 5, Lemma 3 (CauseCond): `KVSAlg1.v`, `Lemma cause_rec` 103 | - Section 5, Figure 14 (Algorithm 2): `KVSAlg2.v`, `Module Type KVSAlg2` 104 | - Section 5, Theorem 3: `KVSAlg1.v`, `Module KVSAlg2CauseObl (SyntaxArg: SyntaxPar) <: CauseObl KVSAlg2 SyntaxArg` 105 | - Secton 5, Corollary 2: `KVSAlg2.v`, `Lemma CausallyConsistent` 106 | - Secton 5, Lemma 4 (Update Dependency Transitivity): `KVSAlg2.v`, `Lemma cause_dep` 107 | - Secton 5, Lemma 5: `KVSAlg2.v`, `Lemma cause_received_received` 108 | - Secton 5, Lemma 6 (CauseCond): `KVSAlg2.v`, `Lemma cause_rec` 109 | - Section 10, Figure 16 (Algorithm 3): `KVSAlg3.v`, `Module Type KVSAlg3` 110 | - Section 10, Theorem 5: `KVSAlg3.v`, `Module KVSAlg3CauseObl (SyntaxArg: SyntaxPar) <: CauseObl KVSAlg3 SyntaxArg` 111 | - Secton 5, Corollary 3: `KVSAlg3.v`, `Lemma CausallyConsistent` 112 | - Section 5, Lemma 7 (Clock Monotonicity): `KVSAlg3.v`, `Lemma cause_clock` 113 | - Section 5, Lemma 8 (Dep less than equal Rec): `KVSAlg3.v`, `Lemma dep_leq_rec` 114 | - Section 5, Lemma 9 (CauseCond): `KVSAlg3.v`, `Lemma cause_rec` 115 | 116 | #### Clients 117 | - Section 1, Program 1: `Clients.v`, `Definition prog_photo_upload` 118 | - Section 1, Program 2: `Clients.v`, `Definition prog_lost_ring` 119 | - Section 10, Program 3: `ListClient.v` 120 | - Section 2, Theorem 1: `Clients.v`, `Lemma CauseConsistent_Prog1` 121 | - Section 3, Definition 1 (Cause-content Program): `Definition CausallyContent` 122 | - Section 6: `ReflectiveAbstractSemantics.v` 123 | 124 | ### Experiment Setup 125 | 126 | #### Directory structure 127 | 128 | - `scripts` (directory): The execution scripts described in the section Running Experiments below 129 | 130 | - `theories` (directory); the Coq verification framework: 131 | * `Framework/KVStore.v`: The basic definitions, the semantics and accompanying lemma 132 | * `Framework/ReflectiveAbstractSemantics.v`: The client verification definitions and lemmas 133 | * `Algorithms/KVSAlg1.v`: The definition and proof of algorithm 1 in the paper 134 | * `Algorithms/KVSAlg2.v`: The definition and proof of algorithm 2 in the paper 135 | * `Algorithms/KVSAlg3.v`: The definition and proof of algorithm 3 in the appendix 136 | * `Algorithms/ExtractAlgorithm.v`: Extraction directives for extracting the algorithms to OCaml 137 | * `Examples/Clients.v`: Verified client program 138 | * `Examples/ListClient.v`: Verified client program 139 | * `Lib` (directory): General purpose Coq libraries 140 | 141 | - `src` (directory); the OCaml runtime to execute the algorithms: 142 | * `algorithm.ml`: Key-value store algorithm shared interface 143 | * `algorithm1.ml`, `algorithm2.ml`, `algorithm3.ml`: Wrappers for the extracted algorithms 144 | * `benchgen.ml`: Benchmark generation and storing program 145 | * `benchprog.ml`: Benchmark retrieval program 146 | * `commonbench.ml`: Common definitions for benchmarks 147 | * `common.ml`: Common definitions 148 | * `configuration.ml`: Execution configuration definitions 149 | * `readConfig.ml`: Configuration retrieval program 150 | * `runtime.ml`: Execution runtime 151 | * `launchStore1.ml`, `launchStore2.ml`, `launchStore3.ml`: Launchers for the extracted algorithms 152 | * `util.ml`: General purpose OCaml functions 153 | * `experiment.ml`: Small OCaml programming tests 154 | 155 | ### Running Experiments 156 | 157 | #### Overview 158 | 159 | We run with 4 nodes called the worker nodes and a node called the master node that keeps 160 | track of the start and end of the runs. The scripts support running with both the current terminal 161 | blocked or detached. In the former, the terminal should be active for the entire execution time. To 162 | avoid this, we use another node called the launcher node. Repeating and collecting the results 163 | of the runs is delegated to the launcher node. The terminal can be closed and the execution 164 | results can be retrieved later from the launcher node. The four workers, the master and the 165 | launcher can be different nodes. However, to simplify running, the scripts support assigning 166 | one host to all of these roles. This is the default setting. 167 | 168 | The settings of the nodes can be edited in the file `Settings.txt`. The following should be 169 | noted if other machines are used as the running nodes. 170 | The host should have password-less ssh access to the launcher node. The launcher node 171 | should have password-less ssh access to the other nodes. This can be done by copying 172 | the public key of the accessing machine to the accessed machine by a command like: 173 | ``` 174 | cat ~/.ssh/id_dsa.pub | ssh -l remoteuser remote.example.com 'cat >> ~/.ssh/authorized_keys' 175 | ``` 176 | The port numbers 9100, 9101, 9102, and 9103 should be open on the worker nodes 177 | 1, 2, 3 and 4 respectively. The port number 9099 should be open on the master node. 178 | 179 | #### A simple run 180 | 181 | To start the run: 182 | ``` 183 | ./batchrundetach 184 | ``` 185 | To check the status of the run: 186 | ``` 187 | ./printlauncherout 188 | ``` 189 | To get the results once the run is finished: 190 | ``` 191 | ./fetchresults 192 | ``` 193 | The result are stored in the file `RemoteAllResults.txt`. See `fetchresults` below for the format 194 | of the results. 195 | 196 | #### Settings and scripts 197 | 198 | All of the following files are in the root directory: 199 | 200 | - `Settings.txt` 201 | 202 | * `KeyRange`: The range of keys in the generated benchmarks is from 0 to this number. For our experiments, it is set to 50. 203 | * `RepeatCount`: The number of times that each experiment is repeated. For our experiments, it is set to 5. 204 | * `LauncherNode`: The user name and the ip of the launcher node 205 | * `MasterNode`: The user name and the ip of the master node 206 | * `WorkerNodes`: The user name and the ip of the worker nodes 207 | 208 | - `batchrun`: 209 | This is the place where the experiments are listed. Each call to the script `run` is an experiment. The arguments are: 210 | 211 | * argument 1: The number of nodes. This is 4 for our purpose. 212 | * argument 2: The number of operations per server. This is 60000 in our experiments. 213 | * argument 3: The percent of puts. This ranges from 10 to 90 in our experiments. 214 | 215 | This script can be called without using the launcher node. The current terminal is blocked. 216 | See batchrundetach below for detached execution of the experiments. 217 | 218 | - `batchrundetach`: To execute using the launcher node. The current terminal is detached. 219 | 220 | - `printlauncherout`: To see the output of the launcher even while the experiments are being run 221 | 222 | - `printnodesout`: To see the output of the worker nodes 223 | 224 | - `fetchresults`: To get the results. The fetched files are: 225 | 226 | * `RemoteAllResults.txt`: The timing of the replicas 227 | * `RemoteAllOutputs.txt`: The outputs of the replicas 228 | * `RemoteLauncherOutput.txt`: The output of the launcher node 229 | 230 | The following example output is for the algorithm 2 with 4 worker nodes and 40000 operations per 231 | node with 10 percent puts. It shows two runs. Under each run, the time spend by each of the 232 | nodes is shown. We compute the maximum of these four numbers to compute the 233 | total process time. 234 | ``` 235 | Algorithm: 2 236 | Server count: 4 237 | Operation count: 40000 238 | Put percent: 10 239 | Run: 1 240 | 1.000000 241 | 3.000000 242 | 1.000000 243 | 1.000000 244 | Run: 2 245 | 1.000000 246 | 1.000000 247 | 4.000000 248 | 1.000000 249 | ``` 250 | 251 | - `clearnodes`: To remove the output and result files and the running processes in all the nodes; this is used to start over 252 | 253 | #### The experiments in the paper 254 | 255 | The goal of our experimental result section was to show that our verification effort can 256 | lead to executable code and also to compare the performance of the two algorithms. 257 | As described in the paper, the experiments were done with four worker nodes cluster. 258 | Each worker node had an Intel(R) Xeon(R) 2.27GHz CPU with 2GB of RAM and ran 259 | Linux Ubuntu 14.04.2 with the kernel version 3.13.0-48-generic#80-Ubuntu. The nodes 260 | were connected to a gigabit switch. 261 | The keys were uniformly selected from 0 to 50 for the benchmarks. 262 | Each experiment was repeated 5 times. (The reported numbers are the arithmetic mean of the five runs.) 263 | Each node processed 60,000 requests. 264 | The put ratio ranged from 10% to 90%. 265 | 266 | Here are the contents of the two configuration files, `Settings.txt` and `batchrun`: 267 | Note: user and ip should be filled with specific values. 268 | - `Settings.txt`: 269 | ``` 270 | KeyRange= 271 | 50 272 | RepeatCount= 273 | 5 274 | LauncherNode= 275 | @ 276 | MasterNode= 277 | @ 278 | WorkerNodes= 279 | @ 280 | @ 281 | @ 282 | @ 283 | ``` 284 | 285 | - `batchrun`: 286 | ``` 287 | ./run 4 60000 10 288 | ./run 4 60000 20 289 | ./run 4 60000 30 290 | ./run 4 60000 40 291 | ./run 4 60000 50 292 | ./run 4 60000 60 293 | ./run 4 60000 70 294 | ./run 4 60000 80 295 | ./run 4 60000 90 296 | ``` 297 | 298 | #### Interpretation of results from the paper 299 | 300 | As expected, the throughput of both of the stores increases as the ratio of the get operation 301 | increases. The second algorithm shows a higher throughput than the first algorithm. The 302 | reason is twofold. Firstly, in the first algorithm, the clock function of a node keeps an 303 | over-approximation of the dependencies of the node. This over-approximation incurs 304 | extra dependencies on updates. On the other hand, the second algorithm does not require 305 | any extra dependencies. Therefore, in the first algorithm compared to the second, 306 | the updates can have longer waiting times, and the update queues tend to be longer. 307 | Therefore, the traversal of the update queue is more time consuming in the first algorithm 308 | than the second. Secondly, the update payload that is sent and received by the first 309 | algorithm contains the function clock. OCaml cannot marshal functions. However, as 310 | the clock function has the finite domain of the participating nodes, it can be serialized to 311 | and deserialized from a list. Nonetheless, serialization and de-serialization on every 312 | sent and received message adds performance cost. On the other hand, the payload 313 | of the second algorithm consists of only data types that can be directly marshalled. 314 | Therefore, the second algorithm has no extra marshalling cost. 315 | 316 | -------------------------------------------------------------------------------- /_CoqProject: -------------------------------------------------------------------------------- 1 | -Q theories Chapar 2 | 3 | theories/Lib/extralib.v 4 | theories/Lib/Predefs.v 5 | theories/Framework/KVStore.v 6 | theories/Framework/ReflectiveAbstractSemantics.v 7 | theories/Algorithms/KVSAlg1.v 8 | theories/Algorithms/KVSAlg2.v 9 | theories/Algorithms/KVSAlg3.v 10 | theories/Algorithms/ExtractAlgorithm.v 11 | theories/Examples/Clients.v 12 | theories/Examples/ListClient.v 13 | -------------------------------------------------------------------------------- /coq-chapar-stores.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "palmskog@gmail.com" 3 | version: "dev" 4 | 5 | homepage: "https://github.com/coq-community/chapar" 6 | dev-repo: "git+https://github.com/coq-community/chapar.git" 7 | bug-reports: "https://github.com/coq-community/chapar/issues" 8 | license: "MIT" 9 | 10 | synopsis: "Three executable causally consistent distributed key-value stores" 11 | description: """ 12 | Three key-value stores, verified to be causally consistent in 13 | the Coq proof assistant and extracted to executable code. 14 | """ 15 | 16 | build: ["dune" "build" "-p" name "-j" jobs] 17 | depends: [ 18 | "ocaml" {>= "4.05.0"} 19 | "dune" {>= "3.5"} 20 | "coq" {>= "8.14"} 21 | "batteries" {>= "2.8.0"} 22 | "coq-chapar" {= version} 23 | ] 24 | 25 | authors: [ 26 | "Mohsen Lesani" 27 | "Christian J. Bell" 28 | "Adam Chlipala" 29 | ] 30 | -------------------------------------------------------------------------------- /coq-chapar.opam: -------------------------------------------------------------------------------- 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 | 4 | opam-version: "2.0" 5 | maintainer: "palmskog@gmail.com" 6 | version: "dev" 7 | 8 | homepage: "https://github.com/coq-community/chapar" 9 | dev-repo: "git+https://github.com/coq-community/chapar.git" 10 | bug-reports: "https://github.com/coq-community/chapar/issues" 11 | license: "MIT" 12 | 13 | synopsis: "A framework for verification of causal consistency for distributed key-value stores and their clients in Coq" 14 | description: """ 15 | A framework for modular verification of causal consistency for replicated key-value 16 | store implementations and their client programs in Coq. Includes proofs of the causal consistency 17 | of two key-value store implementations and a simple automatic model checker for the correctness 18 | of client programs.""" 19 | 20 | build: ["dune" "build" "-p" name "-j" jobs] 21 | depends: [ 22 | "dune" {>= "3.5"} 23 | "coq" {>= "8.14"} 24 | ] 25 | 26 | tags: [ 27 | "category:Computer Science/Concurrent Systems and Protocols/Theory of concurrent systems" 28 | "keyword:causal consistency" 29 | "keyword:key-value stores" 30 | "keyword:distributed algorithms" 31 | "keyword:program verification" 32 | "logpath:Chapar" 33 | ] 34 | authors: [ 35 | "Mohsen Lesani" 36 | "Christian J. Bell" 37 | "Adam Chlipala" 38 | ] 39 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.5) 2 | (using coq 0.6) 3 | (name chapar) 4 | -------------------------------------------------------------------------------- /meta.yml: -------------------------------------------------------------------------------- 1 | --- 2 | fullname: Chapar 3 | shortname: chapar 4 | organization: coq-community 5 | community: true 6 | action: true 7 | nix: true 8 | doi: 10.1145/2837614.2837622 9 | 10 | synopsis: >- 11 | A framework for verification of causal consistency for distributed key-value stores 12 | and their clients in Coq 13 | 14 | description: |- 15 | A framework for modular verification of causal consistency for replicated key-value 16 | store implementations and their client programs in Coq. Includes proofs of the causal consistency 17 | of two key-value store implementations and a simple automatic model checker for the correctness 18 | of client programs. 19 | 20 | publications: 21 | - pub_doi: 10.1145/2837614.2837622 22 | pub_url: http://adam.chlipala.net/papers/ChaparPOPL16/ 23 | pub_title: 'Chapar: Certified Causally Consistent Distributed Key-value Stores' 24 | 25 | authors: 26 | - name: Mohsen Lesani 27 | initial: true 28 | - name: Christian J. Bell 29 | initial: true 30 | - name: Adam Chlipala 31 | initial: true 32 | 33 | maintainers: 34 | - name: Karl Palmskog 35 | nickname: palmskog 36 | 37 | opam-file-maintainer: palmskog@gmail.com 38 | 39 | opam-file-version: dev 40 | 41 | license: 42 | fullname: MIT License 43 | identifier: MIT 44 | 45 | supported_coq_versions: 46 | text: 8.14 or later 47 | opam: '{>= "8.14"}' 48 | 49 | tested_coq_opam_versions: 50 | - version: dev 51 | - version: '8.19' 52 | - version: '8.18' 53 | - version: '8.17' 54 | - version: '8.16' 55 | - version: '8.15' 56 | - version: '8.14' 57 | 58 | tested_coq_nix_versions: 59 | - coq_version: 'master' 60 | 61 | namespace: Chapar 62 | 63 | keywords: 64 | - name: causal consistency 65 | - name: key-value stores 66 | - name: distributed algorithms 67 | - name: program verification 68 | 69 | categories: 70 | - name: Computer Science/Concurrent Systems and Protocols/Theory of concurrent systems 71 | 72 | documentation: | 73 | ## Chapar Executable Key-value Stores 74 | 75 | Three key-value stores, verified to be causally consistent in the Coq proof assistant and extracted to executable code. See [here](coq-chapar-stores.opam) for the requirements to build the stores. 76 | 77 | ## Documentation 78 | 79 | ### Coq Framework 80 | 81 | The Coq definitions and proofs are located in the `theories` directory. The code location of the definitions and lemmas presented in the paper are listed below. 82 | 83 | #### Semantics and the Proof Technique 84 | 85 | - Section 2, Figure 3 (Program): `KVStore.v`, `Section ValSec` 86 | - Section 2, Figure 4 (Key-value Store Algorithm Interface): `KVStore.v`, `Module Type AlgDef` 87 | - Section 2, Figure 5 (Concrete Operational Semantics): `KVStore.v`, `Module ConcExec` 88 | - Section 3, Figure 6 (Abstract Operational Semantics): `KVStore.v`, `Module AbsExec` 89 | - Section 4, Figure 8 (Concrete Instrumented Operational Semantics): `KVStore.v`, `Module InstConcExec` 90 | - Section 4, Figure 10 (Correctness Condition WellRec): `KVStore.v`, `Module Type CauseObl` 91 | - Section 4, Figure 11 (Causal relation): `KVStore.v`, `Definition cause_step` and `Inductive cause` 92 | - Section 4, Figure 12 (Sequential Operational Semantics): `KVStore.v`, `Module SeqExec` 93 | - Section 4, Definition 2 (Causal Consistency) and Theorem 2 (Sufficiency of Well-reception): `KVStore.v`, `Theorem CausallyConsistent`. Note that `(CauseObl: CauseObl AlgDef)` is a parameter of the module `ExecToAbstExec`. 94 | - Section 4, Lemma 1: `KVStore.v`, `Lemma FaultFreedom`. Note that `(CauseObl: CauseObl AlgDef)` is a parameter of the module `ExecToAbstExec`. 95 | 96 | #### Algorithms 97 | 98 | - Section 5, Figure 13 (Algorithm 1): `KVSAlg1.v`, `Module Type KVSAlg1` 99 | - Section 5, Theorem 3: `KVSAlg1.v`, `Module KVSAlg1CauseObl (SyntaxArg: SyntaxPar) <: CauseObl KVSAlg1 SyntaxArg` 100 | - Section 5, Corollary 1: `KVSAlg1.v`, `Lemma CausallyConsistent` 101 | - Section 5, Lemma 2 (Clock Monotonicity): `KVSAlg1.v`, `Lemma cause_clock` 102 | - Section 5, Lemma 3 (CauseCond): `KVSAlg1.v`, `Lemma cause_rec` 103 | - Section 5, Figure 14 (Algorithm 2): `KVSAlg2.v`, `Module Type KVSAlg2` 104 | - Section 5, Theorem 3: `KVSAlg1.v`, `Module KVSAlg2CauseObl (SyntaxArg: SyntaxPar) <: CauseObl KVSAlg2 SyntaxArg` 105 | - Secton 5, Corollary 2: `KVSAlg2.v`, `Lemma CausallyConsistent` 106 | - Secton 5, Lemma 4 (Update Dependency Transitivity): `KVSAlg2.v`, `Lemma cause_dep` 107 | - Secton 5, Lemma 5: `KVSAlg2.v`, `Lemma cause_received_received` 108 | - Secton 5, Lemma 6 (CauseCond): `KVSAlg2.v`, `Lemma cause_rec` 109 | - Section 10, Figure 16 (Algorithm 3): `KVSAlg3.v`, `Module Type KVSAlg3` 110 | - Section 10, Theorem 5: `KVSAlg3.v`, `Module KVSAlg3CauseObl (SyntaxArg: SyntaxPar) <: CauseObl KVSAlg3 SyntaxArg` 111 | - Secton 5, Corollary 3: `KVSAlg3.v`, `Lemma CausallyConsistent` 112 | - Section 5, Lemma 7 (Clock Monotonicity): `KVSAlg3.v`, `Lemma cause_clock` 113 | - Section 5, Lemma 8 (Dep less than equal Rec): `KVSAlg3.v`, `Lemma dep_leq_rec` 114 | - Section 5, Lemma 9 (CauseCond): `KVSAlg3.v`, `Lemma cause_rec` 115 | 116 | #### Clients 117 | - Section 1, Program 1: `Clients.v`, `Definition prog_photo_upload` 118 | - Section 1, Program 2: `Clients.v`, `Definition prog_lost_ring` 119 | - Section 10, Program 3: `ListClient.v` 120 | - Section 2, Theorem 1: `Clients.v`, `Lemma CauseConsistent_Prog1` 121 | - Section 3, Definition 1 (Cause-content Program): `Definition CausallyContent` 122 | - Section 6: `ReflectiveAbstractSemantics.v` 123 | 124 | ### Experiment Setup 125 | 126 | #### Directory structure 127 | 128 | - `scripts` (directory): The execution scripts described in the section Running Experiments below 129 | 130 | - `theories` (directory); the Coq verification framework: 131 | * `Framework/KVStore.v`: The basic definitions, the semantics and accompanying lemma 132 | * `Framework/ReflectiveAbstractSemantics.v`: The client verification definitions and lemmas 133 | * `Algorithms/KVSAlg1.v`: The definition and proof of algorithm 1 in the paper 134 | * `Algorithms/KVSAlg2.v`: The definition and proof of algorithm 2 in the paper 135 | * `Algorithms/KVSAlg3.v`: The definition and proof of algorithm 3 in the appendix 136 | * `Algorithms/ExtractAlgorithm.v`: Extraction directives for extracting the algorithms to OCaml 137 | * `Examples/Clients.v`: Verified client program 138 | * `Examples/ListClient.v`: Verified client program 139 | * `Lib` (directory): General purpose Coq libraries 140 | 141 | - `src` (directory); the OCaml runtime to execute the algorithms: 142 | * `algorithm.ml`: Key-value store algorithm shared interface 143 | * `algorithm1.ml`, `algorithm2.ml`, `algorithm3.ml`: Wrappers for the extracted algorithms 144 | * `benchgen.ml`: Benchmark generation and storing program 145 | * `benchprog.ml`: Benchmark retrieval program 146 | * `commonbench.ml`: Common definitions for benchmarks 147 | * `common.ml`: Common definitions 148 | * `configuration.ml`: Execution configuration definitions 149 | * `readConfig.ml`: Configuration retrieval program 150 | * `runtime.ml`: Execution runtime 151 | * `launchStore1.ml`, `launchStore2.ml`, `launchStore3.ml`: Launchers for the extracted algorithms 152 | * `util.ml`: General purpose OCaml functions 153 | * `experiment.ml`: Small OCaml programming tests 154 | 155 | ### Running Experiments 156 | 157 | #### Overview 158 | 159 | We run with 4 nodes called the worker nodes and a node called the master node that keeps 160 | track of the start and end of the runs. The scripts support running with both the current terminal 161 | blocked or detached. In the former, the terminal should be active for the entire execution time. To 162 | avoid this, we use another node called the launcher node. Repeating and collecting the results 163 | of the runs is delegated to the launcher node. The terminal can be closed and the execution 164 | results can be retrieved later from the launcher node. The four workers, the master and the 165 | launcher can be different nodes. However, to simplify running, the scripts support assigning 166 | one host to all of these roles. This is the default setting. 167 | 168 | The settings of the nodes can be edited in the file `Settings.txt`. The following should be 169 | noted if other machines are used as the running nodes. 170 | The host should have password-less ssh access to the launcher node. The launcher node 171 | should have password-less ssh access to the other nodes. This can be done by copying 172 | the public key of the accessing machine to the accessed machine by a command like: 173 | ``` 174 | cat ~/.ssh/id_dsa.pub | ssh -l remoteuser remote.example.com 'cat >> ~/.ssh/authorized_keys' 175 | ``` 176 | The port numbers 9100, 9101, 9102, and 9103 should be open on the worker nodes 177 | 1, 2, 3 and 4 respectively. The port number 9099 should be open on the master node. 178 | 179 | #### A simple run 180 | 181 | To start the run: 182 | ``` 183 | ./batchrundetach 184 | ``` 185 | To check the status of the run: 186 | ``` 187 | ./printlauncherout 188 | ``` 189 | To get the results once the run is finished: 190 | ``` 191 | ./fetchresults 192 | ``` 193 | The result are stored in the file `RemoteAllResults.txt`. See `fetchresults` below for the format 194 | of the results. 195 | 196 | #### Settings and scripts 197 | 198 | All of the following files are in the root directory: 199 | 200 | - `Settings.txt` 201 | 202 | * `KeyRange`: The range of keys in the generated benchmarks is from 0 to this number. For our experiments, it is set to 50. 203 | * `RepeatCount`: The number of times that each experiment is repeated. For our experiments, it is set to 5. 204 | * `LauncherNode`: The user name and the ip of the launcher node 205 | * `MasterNode`: The user name and the ip of the master node 206 | * `WorkerNodes`: The user name and the ip of the worker nodes 207 | 208 | - `batchrun`: 209 | This is the place where the experiments are listed. Each call to the script `run` is an experiment. The arguments are: 210 | 211 | * argument 1: The number of nodes. This is 4 for our purpose. 212 | * argument 2: The number of operations per server. This is 60000 in our experiments. 213 | * argument 3: The percent of puts. This ranges from 10 to 90 in our experiments. 214 | 215 | This script can be called without using the launcher node. The current terminal is blocked. 216 | See batchrundetach below for detached execution of the experiments. 217 | 218 | - `batchrundetach`: To execute using the launcher node. The current terminal is detached. 219 | 220 | - `printlauncherout`: To see the output of the launcher even while the experiments are being run 221 | 222 | - `printnodesout`: To see the output of the worker nodes 223 | 224 | - `fetchresults`: To get the results. The fetched files are: 225 | 226 | * `RemoteAllResults.txt`: The timing of the replicas 227 | * `RemoteAllOutputs.txt`: The outputs of the replicas 228 | * `RemoteLauncherOutput.txt`: The output of the launcher node 229 | 230 | The following example output is for the algorithm 2 with 4 worker nodes and 40000 operations per 231 | node with 10 percent puts. It shows two runs. Under each run, the time spend by each of the 232 | nodes is shown. We compute the maximum of these four numbers to compute the 233 | total process time. 234 | ``` 235 | Algorithm: 2 236 | Server count: 4 237 | Operation count: 40000 238 | Put percent: 10 239 | Run: 1 240 | 1.000000 241 | 3.000000 242 | 1.000000 243 | 1.000000 244 | Run: 2 245 | 1.000000 246 | 1.000000 247 | 4.000000 248 | 1.000000 249 | ``` 250 | 251 | - `clearnodes`: To remove the output and result files and the running processes in all the nodes; this is used to start over 252 | 253 | #### The experiments in the paper 254 | 255 | The goal of our experimental result section was to show that our verification effort can 256 | lead to executable code and also to compare the performance of the two algorithms. 257 | As described in the paper, the experiments were done with four worker nodes cluster. 258 | Each worker node had an Intel(R) Xeon(R) 2.27GHz CPU with 2GB of RAM and ran 259 | Linux Ubuntu 14.04.2 with the kernel version 3.13.0-48-generic#80-Ubuntu. The nodes 260 | were connected to a gigabit switch. 261 | The keys were uniformly selected from 0 to 50 for the benchmarks. 262 | Each experiment was repeated 5 times. (The reported numbers are the arithmetic mean of the five runs.) 263 | Each node processed 60,000 requests. 264 | The put ratio ranged from 10% to 90%. 265 | 266 | Here are the contents of the two configuration files, `Settings.txt` and `batchrun`: 267 | Note: user and ip should be filled with specific values. 268 | - `Settings.txt`: 269 | ``` 270 | KeyRange= 271 | 50 272 | RepeatCount= 273 | 5 274 | LauncherNode= 275 | @ 276 | MasterNode= 277 | @ 278 | WorkerNodes= 279 | @ 280 | @ 281 | @ 282 | @ 283 | ``` 284 | 285 | - `batchrun`: 286 | ``` 287 | ./run 4 60000 10 288 | ./run 4 60000 20 289 | ./run 4 60000 30 290 | ./run 4 60000 40 291 | ./run 4 60000 50 292 | ./run 4 60000 60 293 | ./run 4 60000 70 294 | ./run 4 60000 80 295 | ./run 4 60000 90 296 | ``` 297 | 298 | #### Interpretation of results from the paper 299 | 300 | As expected, the throughput of both of the stores increases as the ratio of the get operation 301 | increases. The second algorithm shows a higher throughput than the first algorithm. The 302 | reason is twofold. Firstly, in the first algorithm, the clock function of a node keeps an 303 | over-approximation of the dependencies of the node. This over-approximation incurs 304 | extra dependencies on updates. On the other hand, the second algorithm does not require 305 | any extra dependencies. Therefore, in the first algorithm compared to the second, 306 | the updates can have longer waiting times, and the update queues tend to be longer. 307 | Therefore, the traversal of the update queue is more time consuming in the first algorithm 308 | than the second. Secondly, the update payload that is sent and received by the first 309 | algorithm contains the function clock. OCaml cannot marshal functions. However, as 310 | the clock function has the finite domain of the participating nodes, it can be serialized to 311 | and deserialized from a list. Nonetheless, serialization and de-serialization on every 312 | sent and received message adds performance cost. On the other hand, the payload 313 | of the second algorithm consists of only data types that can be directly marshalled. 314 | Therefore, the second algorithm has no extra marshalling cost. 315 | --- 316 | -------------------------------------------------------------------------------- /scripts/Settings.txt: -------------------------------------------------------------------------------- 1 | KeyRange= 2 | 50 3 | RepeatCount= 4 | 2 5 | LauncherNode= 6 | coq@127.0.0.1 7 | MasterNode= 8 | coq@127.0.0.1 9 | WorkerNodes= 10 | coq@127.0.0.1 11 | coq@127.0.0.1 12 | coq@127.0.0.1 13 | coq@127.0.0.1 14 | -------------------------------------------------------------------------------- /scripts/Settings1.txt: -------------------------------------------------------------------------------- 1 | KeyRange= 2 | 50 3 | RepeatCount= 4 | 5 5 | LauncherNode= 6 | ubuntu@128.52.186.213 7 | MasterNode= 8 | ubuntu@128.52.186.218 9 | WorkerNodes= 10 | ubuntu@128.52.186.214 11 | ubuntu@128.52.186.215 12 | ubuntu@128.52.186.217 13 | ubuntu@128.52.186.216 14 | -------------------------------------------------------------------------------- /scripts/Settings2.txt: -------------------------------------------------------------------------------- 1 | KeyRange= 2 | 50 3 | RepeatCount= 4 | 2 5 | LauncherNode= 6 | lesani@127.0.0.1 7 | MasterNode= 8 | lesani@127.0.0.1 9 | WorkerNodes= 10 | lesani@127.0.0.1 11 | lesani@127.0.0.1 12 | lesani@127.0.0.1 13 | lesani@127.0.0.1 14 | 15 | -------------------------------------------------------------------------------- /scripts/batchrun: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | 4 | # Argument 1: 5 | # The number of nodes 6 | # Argument 2: 7 | # The number of operations per server 8 | # Argument 3 9 | # The percent of puts 10 | 11 | # -------------------------------------------------- 12 | 13 | . ./run 4 40000 10 14 | . ./run 4 40000 20 15 | 16 | 17 | # -------------------------------------------------- 18 | 19 | 20 | # . ./run 4 60000 10 21 | # . ./run 4 60000 20 22 | # . ./run 4 60000 30 23 | # . ./run 4 60000 40 24 | # . ./run 4 60000 50 25 | # . ./run 4 60000 60 26 | # . ./run 4 60000 70 27 | # . ./run 4 60000 80 28 | # . ./run 4 60000 90 29 | 30 | 31 | # -------------------------------------------------- 32 | 33 | 34 | 35 | -------------------------------------------------------------------------------- /scripts/batchrundetach: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | . ./common 4 | 5 | 6 | ssh $launcherNode "mkdir -p ~/Runner/Launcher/_build/ml" 7 | scp common $launcherNode:~/Runner/Launcher/ 8 | scp run $launcherNode:~/Runner/Launcher/ 9 | scp batchrun $launcherNode:~/Runner/Launcher 10 | scp Settings.txt $launcherNode:~/Runner/Launcher/ 11 | # ssh $launcherNode "pkill batchrun" 12 | 13 | for (( algNo=${alg1}; algNo <= ${alg2}; algNo++ )) 14 | do 15 | scp _build/ml/launchStore${algNo}.native $launcherNode:~/Runner/Launcher/_build/ml/ 16 | scp launchStore${algNo}.native $launcherNode:~/Runner/Launcher 17 | done 18 | scp _build/ml/benchgen.native $launcherNode:~/Runner/Launcher/_build/ml/ 19 | scp benchgen.native $launcherNode:~/Runner/Launcher/ 20 | 21 | ssh -A $launcherNode "cd Runner/Launcher; echo "" >> AllOutputs.txt; echo "" >> AllResults.txt; nohup ./batchrun > LauncherOutput.txt 2>&1 &" 22 | 23 | -------------------------------------------------------------------------------- /scripts/clearnodes: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | . ./common 4 | 5 | serverCount=4 6 | 7 | # pkill batchrun 8 | ssh $launcherNode "pkill batchrun" 9 | # ssh $launcherNode "rm -f AllOutputs.txt" 10 | # ssh $launcherNode "rm -f AllResults.txt" 11 | # ssh $launcherNode "rm -f LauncherOutput.txt" 12 | # ssh $launcherNode "rm -f Settings.txt" 13 | # ssh $launcherNode "rm -f -r _build" 14 | # ssh $launcherNode "rm -f -r bench" 15 | ssh $launcherNode "rm -f -r Runner" 16 | for (( i=0; i < $serverCount; i++ )) 17 | do 18 | ssh ${workerNodes[$i]} "pkill launchStore" 19 | # ssh ${workerNodes[$i]} "rm -f Settings.txt" 20 | ssh ${workerNodes[$i]} "rm -f -r Runner$i" 21 | done 22 | ssh $masterNode "pkill launchStore" 23 | # ssh $masterNode "rm -f Settings.txt" 24 | ssh $masterNode "rm -f -r Runner" -------------------------------------------------------------------------------- /scripts/common: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | 4 | exec 3<> Settings.txt 5 | 6 | read dumm <&3 7 | read keyRange <&3 8 | 9 | read dumm <&3 10 | read repeatCount <&3 11 | 12 | read dumm <&3 13 | read launcherNode <&3 14 | 15 | read dumm <&3 16 | read masterNode <&3 17 | 18 | read dumm <&3 19 | readarray -n 4 -t -u 3 workerNodes 20 | 21 | 22 | exec 3>&- 23 | 24 | alg1=1 25 | alg2=2 26 | 27 | 28 | # declare -a workerNodes=("ubuntu@128.52.186.214" "ubuntu@128.52.186.215" "ubuntu@128.52.186.217" "ubuntu@128.52.186.216") 29 | # masterNode="ubuntu@128.52.186.218" 30 | # launcherNode="ubuntu@128.52.186.213" 31 | 32 | 33 | # echo $launcherNode 34 | # echo $masterNode 35 | # for (( i=0; i < 4; i++ )) 36 | # do 37 | # echo ${workerNodes[$i]} 38 | # done 39 | # echo $keyRange 40 | # echo $repeatCount 41 | 42 | -------------------------------------------------------------------------------- /scripts/fetchresults: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | . ./common 4 | 5 | 6 | echo "Fetching ..." 7 | scp $launcherNode:~/Runner/Launcher/AllOutputs.txt RemoteAllOutputs.txt 8 | scp $launcherNode:~/Runner/Launcher/AllResults.txt RemoteAllResults.txt 9 | scp $launcherNode:~/Runner/Launcher/LauncherOutput.txt RemoteLauncherOutput.txt 10 | cat RemoteAllResults.txt 11 | 12 | 13 | -------------------------------------------------------------------------------- /scripts/printlauncherout: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | . ./common 4 | 5 | rm -f RemoteLauncherOutput.txt 6 | scp $launcherNode:~/Runner/Launcher/LauncherOutput.txt RemoteLauncherOutput.txt 7 | cat RemoteLauncherOutput.txt 8 | 9 | 10 | -------------------------------------------------------------------------------- /scripts/printnodesout: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | . ./common 4 | 5 | serverCount=4 6 | 7 | # alg1=1 8 | alg1=2 9 | alg2=2 10 | keyRange=50 11 | # repeatCount=5 12 | repeatCount=1 13 | 14 | 15 | echo "Fetching outputs ..." 16 | for (( i=0; i < $serverCount; i++ )) 17 | do 18 | scp ${workerNodes[$i]}:~/Runner/Worker$i/Output.txt PrintOutput${i}.txt 19 | done 20 | scp $masterNode:~/Runner/Master/Output.txt PrintOutputMaster.txt 21 | 22 | for (( i=0; i < $serverCount; i++ )) 23 | do 24 | echo "--------------------------------" 25 | echo "Server: ${i}, IP: ${workerNodes[$i]}" 26 | cat PrintOutput${i}.txt 27 | done 28 | echo "--------------------------------" 29 | echo "Master Server, IP: $masterNode" 30 | cat PrintOutputMaster.txt 31 | 32 | rm PrintOutput* 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | -------------------------------------------------------------------------------- /scripts/run: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | . ./common 4 | 5 | serverCount=$1 6 | opsCount=$2 7 | putPercent=$3 8 | 9 | echo "======================================================" 10 | echo "Server count: $serverCount" 11 | echo "Operation count: $opsCount" 12 | echo "Put percent: $putPercent" 13 | 14 | # echo 15 | # echo "Making ..." 16 | # make 17 | 18 | 19 | # echo $launcherNode 20 | # echo $masterNode 21 | # for (( i=0; i < 4; i++ )) 22 | # do 23 | # echo ${workerNodes[$i]} 24 | # done 25 | # echo $keyRange 26 | # echo $repeatCount 27 | 28 | echo 29 | echo "Generating benchmarks ..." 30 | mkdir -p bench 31 | for (( i=0; i < $serverCount; i++ )) 32 | do 33 | ./benchgen.native bench/Bench${i}.dat $opsCount $keyRange $putPercent 34 | ssh ${workerNodes[$i]} "mkdir -p ~/Runner/Worker$i" 35 | scp bench/Bench${i}.dat ${workerNodes[$i]}:~/Runner/Worker$i 36 | done 37 | 38 | 39 | echo 40 | echo "Sending code ..." 41 | for (( i=0; i < $serverCount; i++ )) 42 | do 43 | ssh ${workerNodes[$i]} "pkill launchStore" 44 | scp Settings.txt ${workerNodes[$i]}:~/Runner/Worker$i 45 | for (( algNo=${alg1}; algNo <= ${alg2}; algNo++ )) 46 | do 47 | scp _build/ml/launchStore${algNo}.native ${workerNodes[$i]}:~/Runner/Worker$i 48 | done 49 | done 50 | ssh $masterNode "mkdir -p ~/Runner/Master" 51 | ssh $masterNode "pkill launchStore" 52 | scp Settings.txt $masterNode:~/Runner/Master 53 | for (( algNo=${alg1}; algNo <= ${alg2}; algNo++ )) 54 | do 55 | scp _build/ml/launchStore${algNo}.native $masterNode:~/Runner/Master 56 | done 57 | 58 | 59 | echo 60 | echo "Running ..." 61 | for (( algNo=${alg1}; algNo <= ${alg2}; algNo++ )) 62 | do 63 | 64 | echo 65 | echo "Algorithm: $algNo" 66 | echo "---------------------------------------------" >> AllOutputs.txt 67 | echo "Algorithm: $algNo" >> AllOutputs.txt 68 | echo "Server count: $serverCount" >> AllOutputs.txt 69 | echo "Operation count: $opsCount" >> AllOutputs.txt 70 | echo "Put percent: $putPercent" >> AllOutputs.txt 71 | 72 | echo "---------------------------------------------" >> AllResults.txt 73 | echo "Algorithm: $algNo" >> AllResults.txt 74 | echo "Server count: $serverCount" >> AllResults.txt 75 | echo "Operation count: $opsCount" >> AllResults.txt 76 | echo "Put percent: $putPercent" >> AllResults.txt 77 | 78 | for (( j=1; j <= $repeatCount; j++ )) 79 | do 80 | echo 81 | echo "Run: $j" 82 | echo "Launching ..." 83 | date 84 | for (( i=0; i < $serverCount; i++ )) 85 | do 86 | ssh ${workerNodes[$i]} "cd ~/Runner/Worker$i; rm -f Results.txt; nohup ./launchStore${algNo}.native ${serverCount} ${i} Bench${i}.dat > Output.txt 2>&1 &" 87 | done 88 | sleep 1 89 | ssh $masterNode "cd ~/Runner/Master; rm -f Results.txt; ./launchStore${algNo}.native ${serverCount} -1 > Output.txt" 90 | 91 | echo "Receiving and saving results ..." 92 | for (( i=0; i < $serverCount; i++ )) 93 | do 94 | scp ${workerNodes[$i]}:~/Runner/Worker$i/Output.txt Output${i}.txt 95 | done 96 | scp $masterNode:~/Runner/Master/Output.txt OutputM.txt 97 | cat Output* >> AllOutputs.txt 98 | rm Output* 99 | 100 | rm -f TempResult.txt 101 | for (( i=0; i < $serverCount; i++ )) 102 | do 103 | scp ${workerNodes[$i]}:~/Runner/Worker$i/Result.txt Result${i}.txt 104 | done 105 | cat Result* >> TempResult.txt 106 | echo "Results ..." 107 | cat TempResult.txt 108 | echo "Run: $j" >> AllResults.txt 109 | cat TempResult.txt >> AllResults.txt 110 | rm Result* 111 | rm TempResult.txt 112 | 113 | echo "Sleeping for 10 seconds before the next run ..." 114 | sleep 10 115 | # sleep 30 116 | 117 | done 118 | done 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | -------------------------------------------------------------------------------- /src/bench/benchgen.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | 3 | open Utils.Commonbench 4 | 5 | 6 | let () = 7 | Random.self_init (); 8 | (* printf "%s\n%!" Sys.argv.(1); 9 | printf "%s\n%!" Sys.argv.(2); 10 | printf "%s\n%!" Sys.argv.(3); 11 | printf "%s\n%!" Sys.argv.(4);*) 12 | let filename = Sys.argv.(1) in 13 | let op_count = int_of_string Sys.argv.(2) in 14 | let key_range = int_of_string Sys.argv.(3) in 15 | let put_percent = int_of_string Sys.argv.(4) in 16 | 17 | let oc = open_out filename in 18 | 19 | fprintf oc "%d\n" op_count; 20 | for i = 0 to op_count - 1 do 21 | let op_p = Random.int 100 in 22 | let op = if op_p < put_percent then put_num else get_num in 23 | let k = Random.int key_range in 24 | let v = Random.int key_range in 25 | fprintf oc "%d\n" op; 26 | fprintf oc "%d\n" k; 27 | fprintf oc "%d\n" v 28 | done; 29 | close_out oc 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | -------------------------------------------------------------------------------- /src/bench/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name benchgen) 3 | (flags :standard -w -35) 4 | (public_name chaparBenchgen) 5 | (libraries utils) 6 | (modules benchgen) 7 | (package coq-chapar-stores)) 8 | 9 | (executable 10 | (name experiment) 11 | (flags :standard -w -33-35) 12 | ;(public_name chaparExperiment) 13 | (libraries utils) 14 | ;(package coq-chapar-stores) 15 | (modules experiment)) 16 | -------------------------------------------------------------------------------- /src/bench/experiment.ml: -------------------------------------------------------------------------------- 1 | (* open Printf *) 2 | open Utils.Configuration 3 | open Utils.ReadConfig 4 | open String 5 | 6 | let _ = 7 | (* let conf = readConfiguration "Settings.txt" in *) 8 | (* List.iter 9 | (fun (n, {ip; port}) -> 10 | print_int n; 11 | print_newline (); 12 | print_string ip; 13 | print_newline (); 14 | print_int port; 15 | print_newline ()) 16 | conf*) 17 | 18 | let mysub ms = ( 19 | let i = (index ms '@') in 20 | String.sub ms (i + 1) (String.length ms - i - 1)) in 21 | print_string (mysub "AName@12.232.232.3") 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | (* 30 | open Printf 31 | open BatDllist 32 | 33 | 34 | let _ = 35 | let h = create 0 in 36 | add h 3; 37 | (* add h 1; 38 | add h 2; 39 | add h 3; 40 | add h 4; 41 | add h 5; 42 | add h 6; 43 | add h 7;*) 44 | let c = ref (next h) in 45 | let p = ref h in 46 | while not (!c == h) do 47 | let n = get !c in 48 | p := !c; 49 | c := next !c; 50 | if (n = 3 || n = 4) then ( 51 | remove !p; 52 | printf "%d\n%!" n 53 | ) 54 | done; 55 | printf "\n%!"; 56 | let c = ref (next h) in 57 | let p = ref h in 58 | while not (!c == h) do 59 | let n = get !c in 60 | printf "%d\n%!" n; 61 | p := !c; 62 | c := next !c; 63 | done; 64 | 0*) 65 | 66 | (* 67 | iter 68 | (fun n -> 69 | printf "%d\n%!" 70 | if n = 2 || n = 3 then 71 | remove 72 | ) 73 | h 74 | *) 75 | 76 | 77 | 78 | (* 79 | open Printf 80 | open PriorityQueue 81 | type clock = int 82 | 83 | let clock_oder: clock order = 84 | fun a b -> a <= b 85 | 86 | 87 | let _ = 88 | let pq = make clock_oder in 89 | add pq 3; 90 | add pq 1; 91 | add pq 4; 92 | add pq 5; 93 | add pq 0; 94 | add pq 2; 95 | while not (is_empty pq) do 96 | let e = first pq in 97 | remove_first pq; 98 | printf "%d\n%!" e 99 | done; 100 | 0 101 | *) 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | (* 114 | open Util 115 | open Printf 116 | 117 | 118 | 119 | let _ = 120 | let l = [0;1;2;3;4;5] in 121 | List.iter (printf "%d ") l; 122 | printf "\n"; 123 | List.iter (printf "%d ") (take 3 l); 124 | printf "\n" 125 | 126 | *) 127 | -------------------------------------------------------------------------------- /src/store1/ExtractAlgorithm1.v: -------------------------------------------------------------------------------- 1 | From Chapar Require Import KVSAlg1 ExtractAlgorithm. 2 | 3 | Extract Constant KVStore.SysPredefs.MaxNId => "4". 4 | 5 | Extraction "KVSAlg1.ml" KVSAlg1.KVSAlg1. 6 | -------------------------------------------------------------------------------- /src/store1/algorithm1.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open List 3 | 4 | open Utils.Common 5 | open Utils.Algorithm 6 | 7 | open KVSAlg1 8 | open SysPredefs 9 | 10 | 11 | 12 | module Algorithm1 : Algorithm = struct 13 | open KVSAlg1 14 | 15 | type state = valu KVSAlg1.coq_State 16 | 17 | type update = valu KVSAlg1.coq_Update 18 | 19 | let init_method = KVSAlg1.init_method 20 | 21 | let get_method = KVSAlg1.get_method 22 | 23 | let put_method = KVSAlg1.put_method 24 | 25 | let guard_method = KVSAlg1.guard_method 26 | 27 | let update_method = KVSAlg1.update_method 28 | 29 | type clock = KVSAlg1.coq_Clock 30 | type update_data = { sender_node_data : node_id; 31 | sender_clock_data : (node_id * clock) list } 32 | 33 | let nid_fun_to_list f = 34 | List.map (fun nid -> (nid, f nid)) 35 | nids 36 | 37 | let rec nid_fun_from_list_rec f l = 38 | match l with 39 | | [] -> f 40 | | (nid, c) :: l' -> 41 | nid_fun_from_list_rec (override f nid c) l' 42 | 43 | let nid_fun_from_list l = 44 | nid_fun_from_list_rec (fun n -> 0) l 45 | 46 | 47 | let to_data u = { sender_node_data = u.KVSAlg1.sender_node; 48 | sender_clock_data = nid_fun_to_list u.KVSAlg1.sender_clock } 49 | 50 | let from_data u = { KVSAlg1.sender_node = u.sender_node_data; 51 | KVSAlg1.sender_clock = nid_fun_from_list u.sender_clock_data } 52 | 53 | 54 | open BatDllist 55 | type message = node_id * key * valu * update 56 | type mqueue = message node_t 57 | 58 | let init_queue = create (0, 0, 0, dummy_update) 59 | 60 | let check_messages nid st qu = 61 | let cst = ref st in 62 | let h = qu in 63 | let c = ref (next h) in 64 | let p = ref h in 65 | while not (!c == h) do 66 | let m = get !c in 67 | let (n, k, v, u) = m in 68 | p := !c; 69 | c := next !c; 70 | let g = guard_method nid !cst k v u in 71 | if g then ( 72 | cst := update_method nid !cst k v u; 73 | remove !p 74 | (* ; printf "Node %d: Applying update from node %d for key %d\n%!" nid n k *) 75 | ) 76 | done; 77 | !cst 78 | 79 | let enqueue_message nid qu m = 80 | add qu m 81 | (* let (n, k, v, u) = m in 82 | printf "Node %d: Received message from node %d key %d\n%!" nid n k; 83 | add qu m*) 84 | 85 | (* 86 | open PriorityQueue 87 | 88 | 89 | type message = node_id * key * valu * update 90 | let moder: message order = 91 | fun m1 m2 -> 92 | let (_, _, _, u1) = m1 in 93 | let c1 = u1.sender_clock in 94 | let (_, _, _, u2) = m2 in 95 | let c2 = u2.sender_clock in 96 | for_all (fun n -> c1 n <= c2 n) nids 97 | 98 | type mqueue = message PriorityQueue.t 99 | 100 | let init_queue = make moder 101 | 102 | let print_clock nid u = 103 | let c = u.sender_clock in 104 | List.iter (fun n -> 105 | printf "Node %d: Clock for Node %d: %d\n%!" nid n (c n) 106 | ) nids 107 | 108 | 109 | let check_messages nid st qu = 110 | let cst = ref st in 111 | let fin = ref false in 112 | while (not (!fin)) && (not (is_empty qu)) do 113 | let m = first qu in 114 | let (n, k, v, u) = m in 115 | printf "Node %d: Looking at first with key %d and value %d\n%!" nid k v; 116 | print_clock nid u; 117 | let g = guard_method nid !cst k v u in 118 | if g then ( 119 | remove_first qu; 120 | cst := update_method nid !cst k v u 121 | ; printf "Node %d: Applying update from node %d for key %d\n%!" nid n k 122 | ) else 123 | fin := true 124 | done; 125 | !cst 126 | 127 | let enqueue_message nid qu m = 128 | (* add qu m *) 129 | let (n, k, v, u) = m in 130 | printf "Node %d: Received message from node %d for key %d\n%!" nid n k; 131 | add qu m 132 | *) 133 | 134 | end 135 | 136 | -------------------------------------------------------------------------------- /src/store1/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name launchStore1) 3 | (flags :standard -w -3-27-33-39) 4 | (public_name chaparStore1) 5 | (libraries utils batteries) 6 | (modules launchStore1 KVSAlg1 algorithm1) 7 | (package coq-chapar-stores)) 8 | 9 | (coq.extraction 10 | (prelude ExtractAlgorithm1) 11 | (extracted_modules KVSAlg1) 12 | ;(theories Chapar) 13 | ) 14 | -------------------------------------------------------------------------------- /src/store1/launchStore1.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open Utils.Util 3 | open Utils.Common 4 | open Utils.Runtime 5 | open Algorithm1 6 | open Utils.ReadConfig 7 | open Utils.Benchprog 8 | 9 | module Alg1RunSys = RuntimeSystem (Algorithm1) 10 | open Alg1RunSys 11 | 12 | 13 | 14 | let _ = 15 | let count = int_of_string Sys.argv.(1) in 16 | let node = int_of_string Sys.argv.(2) in 17 | let info = take (count + 1) (readConfiguration "Settings.txt") in 18 | if node <> -1 then ( 19 | let bench_file = Sys.argv.(3) in 20 | let p = prog_of_bench bench_file in 21 | main info node p 22 | ) else 23 | main info node Skip 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | -------------------------------------------------------------------------------- /src/store2/ExtractAlgorithm2.v: -------------------------------------------------------------------------------- 1 | From Chapar Require Import KVSAlg2 ExtractAlgorithm. 2 | 3 | Extract Constant KVStore.SysPredefs.MaxNId => "4". 4 | 5 | Extraction "KVSAlg2.ml" KVSAlg2.KVSAlg2. 6 | -------------------------------------------------------------------------------- /src/store2/algorithm2.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open Unix 3 | 4 | open Utils.Common 5 | open Utils.Algorithm 6 | open KVSAlg2 7 | 8 | 9 | module Algorithm2 : Algorithm = struct 10 | open KVSAlg2 11 | 12 | type state = valu KVSAlg2.coq_State 13 | 14 | type update = valu KVSAlg2.coq_Update 15 | 16 | let init_method = KVSAlg2.init_method 17 | 18 | let get_method = KVSAlg2.get_method 19 | 20 | let put_method = KVSAlg2.put_method 21 | 22 | let guard_method = KVSAlg2.guard_method 23 | 24 | let update_method = KVSAlg2.update_method 25 | 26 | type update_data = update 27 | 28 | let to_data u = u 29 | let from_data u = u 30 | 31 | open BatDllist 32 | type message = node_id * key * valu * update 33 | type mqueue = message node_t 34 | 35 | let init_queue = create (0, 0, 0, dummy_update) 36 | 37 | let check_messages nid st qu = 38 | let cst = ref st in 39 | let h = qu in 40 | let c = ref (next h) in 41 | let p = ref h in 42 | (* printf "Node %d: Entering the loop %f\n%!" nid (time ()); *) 43 | while not (!c == h) do 44 | let m = get !c in 45 | let (n, k, v, u) = m in 46 | p := !c; 47 | c := next !c; 48 | let g = guard_method nid !cst k v u in 49 | if g then ( 50 | cst := update_method nid !cst k v u; 51 | remove !p 52 | (* ; printf "Node %d: Applying update from node %d for key %d\n%!" nid n k *) 53 | ) 54 | done; 55 | (* printf "Node %d: Exiting the loop %f\n%!" nid (time ()); *) 56 | !cst 57 | 58 | let enqueue_message nid qu m = 59 | add qu m 60 | (* let (n, k, v, u) = m in 61 | printf "Node %d: Received message from node %d key %d\n%!" nid n k; 62 | add qu m*) 63 | 64 | end 65 | 66 | 67 | 68 | (* 69 | type mqueue = message list 70 | 71 | let init_queue = [] 72 | 73 | let rec check_messages_rec nid st qu qu' = 74 | match qu with 75 | | [] -> (st, qu') 76 | | m :: qur -> 77 | let (_, k, v, u) = m in 78 | let g = guard_method nid st k v u in 79 | if g then ( 80 | let st' = update_method nid st k v u in 81 | check_messages_rec nid st' qur qu' 82 | ) else 83 | check_messages_rec nid st qur (m :: qu') 84 | 85 | let check_messages nid st qu = 86 | check_messages_rec nid st qu [] 87 | 88 | let enqueue_message qu m = 89 | m :: qu 90 | *) 91 | 92 | -------------------------------------------------------------------------------- /src/store2/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name launchStore2) 3 | (flags :standard -w -3-27-33-39) 4 | (public_name chaparStore2) 5 | (libraries utils batteries) 6 | (modules launchStore2 KVSAlg2 algorithm2) 7 | (package coq-chapar-stores)) 8 | 9 | (coq.extraction 10 | (prelude ExtractAlgorithm2) 11 | (extracted_modules KVSAlg2) 12 | ;(theories Chapar) 13 | ) 14 | -------------------------------------------------------------------------------- /src/store2/launchStore2.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open Utils.Util 3 | open Utils.Common 4 | open Utils.Runtime 5 | open Algorithm2 6 | open Utils.ReadConfig 7 | open Utils.Benchprog 8 | 9 | module Alg1RunSys = RuntimeSystem (Algorithm2) 10 | open Alg1RunSys 11 | 12 | 13 | 14 | let _ = 15 | let count = int_of_string Sys.argv.(1) in 16 | let node = int_of_string Sys.argv.(2) in 17 | let info = take (count + 1) (readConfiguration "Settings.txt") in 18 | if node <> -1 then ( 19 | let bench_file = Sys.argv.(3) in 20 | let p = prog_of_bench bench_file in 21 | main info node p 22 | 23 | ) else 24 | main info node Skip 25 | 26 | -------------------------------------------------------------------------------- /src/store3/ExtractAlgorithm3.v: -------------------------------------------------------------------------------- 1 | From Chapar Require Import KVSAlg3 ExtractAlgorithm. 2 | 3 | Extract Constant KVStore.SysPredefs.MaxNId => "4". 4 | 5 | Extraction "KVSAlg3.ml" KVSAlg3.KVSAlg3. 6 | -------------------------------------------------------------------------------- /src/store3/algorithm3.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open List 3 | 4 | open Utils.Common 5 | open Utils.Algorithm 6 | 7 | open KVSAlg3 8 | open SysPredefs 9 | 10 | 11 | 12 | module Algorithm3 : Algorithm = struct 13 | open KVSAlg3 14 | 15 | type state = valu KVSAlg3.coq_State 16 | 17 | type update = valu KVSAlg3.coq_Update 18 | 19 | let init_method = KVSAlg3.init_method 20 | 21 | let get_method = KVSAlg3.get_method 22 | 23 | let put_method = KVSAlg3.put_method 24 | 25 | let guard_method = KVSAlg3.guard_method 26 | 27 | let update_method = KVSAlg3.update_method 28 | 29 | type clock = KVSAlg3.coq_Clock 30 | type update_data = { sender_node_data : node_id; 31 | sender_dep_data : (node_id * clock) list } 32 | 33 | let nid_fun_to_list f = 34 | List.map (fun nid -> (nid, f nid)) 35 | nids 36 | 37 | let rec nid_fun_from_list_rec f l = 38 | match l with 39 | | [] -> f 40 | | (nid, c) :: l' -> 41 | nid_fun_from_list_rec (override f nid c) l' 42 | 43 | let nid_fun_from_list l = 44 | nid_fun_from_list_rec (fun n -> 0) l 45 | 46 | 47 | let to_data u = { sender_node_data = u.KVSAlg3.sender_node; 48 | sender_dep_data = nid_fun_to_list u.KVSAlg3.sender_dep } 49 | 50 | let from_data u = { KVSAlg3.sender_node = u.sender_node_data; 51 | KVSAlg3.sender_dep = nid_fun_from_list u.sender_dep_data } 52 | 53 | open BatDllist 54 | type message = node_id * key * valu * update 55 | type mqueue = message node_t 56 | 57 | let init_queue = create (0, 0, 0, dummy_update) 58 | 59 | let check_messages nid st qu = 60 | let cst = ref st in 61 | let h = qu in 62 | let c = ref (next h) in 63 | let p = ref h in 64 | while not (!c == h) do 65 | let m = get !c in 66 | let (n, k, v, u) = m in 67 | p := !c; 68 | c := next !c; 69 | let g = guard_method nid !cst k v u in 70 | if g then ( 71 | cst := update_method nid !cst k v u; 72 | remove !p 73 | (* ; printf "Node %d: Applying update from node %d for key %d\n%!" nid n k *) 74 | ) 75 | done; 76 | !cst 77 | 78 | let enqueue_message nid qu m = 79 | add qu m 80 | (* 81 | let (n, k, v, u) = m in 82 | printf "Node %d: Received message from node %d key %d\n%!" nid n k; 83 | add qu m 84 | *) 85 | 86 | (* 87 | open PriorityQueue 88 | type message = node_id * key * valu * update 89 | let moder: message order = 90 | fun m1 m2 -> 91 | let (_, _, _, u1) = m1 in 92 | let c1 = u1.sender_dep in 93 | let (_, _, _, u2) = m2 in 94 | let c2 = u2.sender_dep in 95 | for_all (fun n -> c1 n <= c2 n) nids 96 | 97 | type mqueue = message PriorityQueue.t 98 | 99 | let init_queue = make moder 100 | 101 | let check_messages nid st qu = 102 | let cst = ref st in 103 | let fin = ref false in 104 | while (not (!fin)) && (not (is_empty qu)) do 105 | let m = first qu in 106 | let (_, k, v, u) = m in 107 | let g = guard_method nid !cst k v u in 108 | if g then ( 109 | remove_first qu; 110 | cst := update_method nid !cst k v u 111 | ) else 112 | fin := true 113 | done; 114 | !cst 115 | 116 | let enqueue_message nid qu m = 117 | add qu m 118 | *) 119 | 120 | end 121 | 122 | 123 | 124 | 125 | -------------------------------------------------------------------------------- /src/store3/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name launchStore3) 3 | (flags :standard -w -3-27-33-39) 4 | (public_name chaparStore3) 5 | (libraries utils batteries) 6 | (modules launchStore3 KVSAlg3 algorithm3) 7 | (package coq-chapar-stores)) 8 | 9 | (coq.extraction 10 | (prelude ExtractAlgorithm3) 11 | (extracted_modules KVSAlg3) 12 | ;(theories Chapar) 13 | ) 14 | -------------------------------------------------------------------------------- /src/store3/launchStore3.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open Utils.Util 3 | open Utils.Common 4 | open Utils.Runtime 5 | open Algorithm3 6 | open Utils.ReadConfig 7 | open Utils.Benchprog 8 | 9 | module Alg1RunSys = RuntimeSystem (Algorithm3) 10 | open Alg1RunSys 11 | 12 | 13 | 14 | let _ = 15 | let count = int_of_string Sys.argv.(1) in 16 | let node = int_of_string Sys.argv.(2) in 17 | let info = take (count + 1) (readConfiguration "Settings.txt") in 18 | if node <> -1 then ( 19 | let bench_file = Sys.argv.(3) in 20 | let p = prog_of_bench bench_file in 21 | main info node p 22 | 23 | ) else 24 | main info node Skip 25 | 26 | 27 | 28 | 29 | 30 | -------------------------------------------------------------------------------- /src/utils/algorithm.ml: -------------------------------------------------------------------------------- 1 | open Common 2 | 3 | 4 | 5 | 6 | 7 | module type Algorithm = sig 8 | 9 | type state 10 | type update 11 | 12 | val init_method : valu -> state 13 | 14 | val get_method : 15 | node_id -> state -> key -> valu * state 16 | 17 | val put_method : 18 | node_id -> state -> key -> valu -> state * update 19 | 20 | val guard_method : 21 | node_id -> state -> key -> valu -> update -> bool 22 | 23 | val update_method : 24 | node_id -> state -> key -> valu -> update -> state 25 | 26 | type update_data 27 | 28 | val to_data : update -> update_data 29 | val from_data: update_data -> update 30 | 31 | type mqueue 32 | 33 | type message = node_id * key * valu * update 34 | 35 | val init_queue: mqueue 36 | 37 | (* val check_messages: node_id -> state -> mqueue -> (state * mqueue) *) 38 | val check_messages: node_id -> state -> mqueue -> state 39 | 40 | (* val enqueue_message: node_id -> mqueue -> message -> mqueue *) 41 | val enqueue_message: node_id -> mqueue -> message -> unit 42 | 43 | end 44 | 45 | 46 | 47 | 48 | (* 49 | open Common 50 | 51 | module type Algorithm = sig 52 | 53 | type state 54 | type payload 55 | 56 | val init: state 57 | val put: node_id -> state -> key -> valu -> (state * payload) 58 | val get: node_id -> state -> key -> (valu * state) 59 | val guard: node_id -> state -> key -> valu -> payload -> bool 60 | val update: node_id -> state -> key -> valu -> payload -> state 61 | 62 | end 63 | *) 64 | -------------------------------------------------------------------------------- /src/utils/benchprog.ml: -------------------------------------------------------------------------------- 1 | open Common 2 | open Commonbench 3 | 4 | 5 | 6 | let prog_of_bench filename = 7 | 8 | let ic = open_in filename in 9 | try 10 | let op_count = int_of_string (input_line ic) in 11 | let rec prog_of_rec i prog = 12 | if i = op_count then 13 | prog 14 | else 15 | let op = int_of_string (input_line ic) in 16 | let k = int_of_string (input_line ic) in 17 | let v = int_of_string (input_line ic) in 18 | if op = put_num then 19 | prog_of_rec (i+1) (Put (k, v, prog)) 20 | else 21 | prog_of_rec (i+1) (Get (k, fun v -> prog)) in 22 | 23 | let p = prog_of_rec 0 Skip in 24 | close_in ic; 25 | p 26 | 27 | with e -> 28 | close_in_noerr ic; 29 | raise e 30 | 31 | -------------------------------------------------------------------------------- /src/utils/common.ml: -------------------------------------------------------------------------------- 1 | (* open KVSAlg1 *) 2 | (* open SysPredefs *) 3 | 4 | 5 | type key = int (* coq_Key *) 6 | type valu = int 7 | type node_id = int (* coq_NId *) 8 | 9 | 10 | type program = 11 | | Put of key * valu * program 12 | | Get of key * (valu -> program) 13 | | Skip 14 | | Fault 15 | 16 | 17 | 18 | (* 19 | let p1 = 20 | Put (1, 2, Skip) 21 | 22 | let _ = 23 | print_endline "Executed" 24 | 25 | *) -------------------------------------------------------------------------------- /src/utils/commonbench.ml: -------------------------------------------------------------------------------- 1 | 2 | 3 | let put_num = 1 4 | let get_num = 2 5 | -------------------------------------------------------------------------------- /src/utils/configuration.ml: -------------------------------------------------------------------------------- 1 | open Common 2 | 3 | type node_info = { 4 | ip: string; 5 | port: int 6 | (* prog: program *) 7 | } 8 | 9 | module type Configuration = sig 10 | 11 | val net_info: (node_id * node_info) list 12 | 13 | end 14 | 15 | -------------------------------------------------------------------------------- /src/utils/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name utils) 3 | (flags :standard -w -27-33-35) 4 | (modules util runtime configuration common algorithm readConfig benchprog commonbench) 5 | ;(wrapped false) 6 | (libraries unix)) 7 | -------------------------------------------------------------------------------- /src/utils/readConfig.ml: -------------------------------------------------------------------------------- 1 | (* open List *) 2 | open Configuration 3 | (* open String *) 4 | 5 | let readConfiguration filename = 6 | let net_info = ref [] in 7 | (* let mysub st = String.sub st 7 (String.length st - 7) in *) 8 | let mysub ms = ( 9 | let i = (String.index ms '@') in 10 | String.sub ms (i + 1) (String.length ms - i - 1)) in 11 | let chan = open_in filename in 12 | (* try *) 13 | ignore(input_line chan); 14 | ignore(input_line chan); 15 | ignore(input_line chan); 16 | ignore(input_line chan); 17 | ignore(input_line chan); 18 | ignore(input_line chan); 19 | ignore(input_line chan); 20 | net_info := (-1, {ip = mysub (input_line chan); port = 9099}) :: !net_info; 21 | ignore(input_line chan); 22 | net_info := (0, {ip = mysub (input_line chan); port = 9100}) :: !net_info; 23 | net_info := (1, {ip = mysub (input_line chan); port = 9101}) :: !net_info; 24 | net_info := (2, {ip = mysub (input_line chan); port = 9102}) :: !net_info; 25 | net_info := (3, {ip = mysub (input_line chan); port = 9103}) :: !net_info; 26 | (* with End_of_file -> *) 27 | close_in chan; 28 | List.rev !net_info 29 | -------------------------------------------------------------------------------- /src/utils/runtime.ml: -------------------------------------------------------------------------------- 1 | open Common 2 | open Printf 3 | open Unix 4 | open Configuration 5 | 6 | (* The module Marshal is used for serialization and deserialization. *) 7 | 8 | open Util 9 | open Common 10 | open Algorithm 11 | 12 | module RuntimeSystem (Alg: Algorithm) = struct 13 | 14 | open Alg 15 | 16 | 17 | (* 18 | let get = 19 | node_id -> state -> key -> valu * state 20 | 21 | let put = 22 | node_id -> state -> key -> valu -> state * payload 23 | 24 | let guard = 25 | node_id -> state -> key -> valu -> payload -> bool 26 | 27 | let update = 28 | node_id -> state -> key -> valu -> payload -> state 29 | *) 30 | 31 | 32 | type message_data = node_id * key * valu * update_data 33 | 34 | type env = { 35 | nid: node_id 36 | ; in_sock: file_descr 37 | ; in_sock_cmsg: file_descr 38 | ; in_chan: in_channel 39 | ; in_chan_cmsg: in_channel 40 | 41 | (* nodes: Other nodes in the system. *) 42 | (* ; nodes : (node_id * (file_descr * sockaddr)) list *) 43 | ; nodes: (node_id * (file_descr * out_channel)) list 44 | ; nodes_cmsg: (node_id * (file_descr * out_channel)) list 45 | 46 | (* st: The current state of the node. *) 47 | ; mutable st: state 48 | 49 | ; mutable prog: program 50 | 51 | ; mutable qu: mqueue 52 | 53 | ; mutable put_time: float 54 | ; mutable get_time: float 55 | ; mutable update_time: float 56 | 57 | } 58 | 59 | let make_sockaddr ip p = 60 | ADDR_INET (inet_addr_of_string ip, p) 61 | 62 | let make_udp_socket = 63 | let s = socket PF_INET SOCK_DGRAM 0 in 64 | setsockopt s SO_REUSEADDR true; 65 | s 66 | 67 | let make_out_udp_socket ip p = 68 | let s = socket PF_INET SOCK_DGRAM 0 in 69 | setsockopt s SO_REUSEADDR true; 70 | connect s (make_sockaddr ip p); 71 | s 72 | 73 | let make_in_udp_socket p = 74 | let s = socket PF_INET SOCK_DGRAM 0 in 75 | setsockopt s SO_REUSEADDR true; 76 | bind s (ADDR_INET (inet_addr_any, p)); 77 | s 78 | (* 79 | PF_INET: Internet domain (IPv4) 80 | SOCK_DGRAM: Datagram socket 81 | SOCK_STREAM: Stream socket 82 | *) 83 | (* 84 | setsockopt: Set or clear a boolean-valued option in the given socket. 85 | SO_REUSEADDR: Allow reuse of local addresses for bind 86 | *) 87 | (* 88 | bind: Bind a socket to an address. 89 | val inet_addr_any: A special IPv4 address, for use only with bind, representing all the Internet addresses that the host machine possesses. 90 | *) 91 | 92 | (* 93 | let chan_of env nid : out_channel = 94 | let (_, sa) = List.assoc nid env.nodes in 95 | let s = make_udp_socket in 96 | ignore(getsockopt_error s); 97 | connect s sa; 98 | out_channel_of_descr s 99 | *) 100 | 101 | let chan_of env nid : out_channel = 102 | let (_, c) = List.assoc nid env.nodes in 103 | c 104 | 105 | let chan_of_cmsg env nid : out_channel = 106 | let (_, c) = List.assoc nid env.nodes_cmsg in 107 | c 108 | 109 | let nid_of env chan : node_id = 110 | (* let flip = function (n, (s, sa, c)) -> (c, n) in *) 111 | let flip = function (n, (_, c)) -> (c, n) in 112 | List.assoc chan (List.map flip env.nodes) 113 | 114 | 115 | (* The function setup prepares and returns the environment for the input node id. *) 116 | let setup net_info nid prog = 117 | let n_info = List.assoc nid net_info in 118 | let p = n_info.port in 119 | (* let prog = n_info.prog in *) 120 | let sock = make_in_udp_socket p in 121 | let sock_cmsg = make_in_udp_socket (p + List.length net_info) in 122 | { 123 | nid = nid 124 | ; in_sock = sock 125 | ; in_sock_cmsg = sock_cmsg 126 | ; in_chan = in_channel_of_descr sock 127 | ; in_chan_cmsg = in_channel_of_descr sock_cmsg 128 | ; nodes = optmap (fun (nid', {ip; port}) -> 129 | if nid' = nid || nid' = -1 then 130 | None 131 | else 132 | let sock = make_out_udp_socket ip port in 133 | let chan = out_channel_of_descr sock in 134 | Some (nid', (sock, chan))) 135 | net_info 136 | ; nodes_cmsg = optmap (fun (nid', {ip; port}) -> 137 | if (nid <> -1 && nid' <> -1) || (nid = -1 && nid' = -1) then 138 | None 139 | else 140 | let sock = make_out_udp_socket ip (port + List.length net_info) in 141 | let chan = out_channel_of_descr sock in 142 | Some (nid', (sock, chan))) 143 | net_info 144 | ; st = init_method 0 145 | ; prog = prog 146 | ; qu = init_queue 147 | ; put_time = 0.0 148 | ; get_time = 0.0 149 | ; update_time = 0.0 150 | 151 | } 152 | 153 | 154 | 155 | let receive env : message_data = 156 | (* Marshal.from_channel env.in_chan *) 157 | let m = Marshal.from_channel env.in_chan in 158 | (* let (nid, _, _ , _) = m in *) 159 | (* printf "Node %d: Received message from node %d\n%!" env.nid nid; *) 160 | m 161 | 162 | let send_chan env chan m nid = 163 | (* printf "Node %d: Sending message to node %d\n%!" env.nid nid; (* (nid_of env chan); *) *) 164 | Marshal.to_channel chan m []; 165 | flush chan 166 | 167 | let send env nid m = 168 | send_chan env (chan_of env nid) m nid 169 | 170 | (* 171 | let broadcast env m = 172 | List.iter 173 | (fun (nid', (_, sa)) -> 174 | let s = make_udp_socket in 175 | ignore(getsockopt_error s); 176 | connect s sa; 177 | ignore(send_chan env (out_channel_of_descr s) m nid')) 178 | env.nodes 179 | *) 180 | 181 | let broadcast env m = 182 | List.iter 183 | (fun (nid', (sock, chan)) -> 184 | ignore(getsockopt_error sock); 185 | ignore(send_chan env chan m nid')) 186 | env.nodes 187 | 188 | 189 | (* type cmsg = node_id * int *) 190 | type cmsg = int 191 | let start_cmsg = 7 192 | let finish_cmsg = 8 193 | 194 | 195 | (* cmsg *) 196 | let receive_cmsg env : cmsg = 197 | Marshal.from_channel env.in_chan_cmsg 198 | (* let c = Marshal.from_channel env.in_chan_cmsg in 199 | let (nid, m) = c in 200 | printf "Node %d: Received cmsg %d from node %d\n%!" env.nid m nid; 201 | c*) 202 | 203 | let send_chan_cmsg env chan c nid = 204 | (* let (_, m) = c in 205 | printf "Node %d: Sending cmsg %d to node %d\n%!" env.nid m nid; (* (nid_of env chan); *)*) 206 | Marshal.to_channel chan c []; 207 | flush chan 208 | 209 | let send_cmsg env nid c = 210 | send_chan_cmsg env (chan_of_cmsg env nid) c nid 211 | 212 | (* 213 | let broadcast_cmsg env c = 214 | List.iter 215 | (fun (nid', (_, sa)) -> 216 | let s = make_udp_socket in 217 | ignore(getsockopt_error s); 218 | connect s sa; 219 | ignore(send_chan env (out_channel_of_descr s) c nid')) 220 | env.nodes 221 | *) 222 | 223 | let broadcast_cmsg env c = 224 | List.iter 225 | (fun (nid', (sock, chan)) -> 226 | ignore(getsockopt_error sock); 227 | ignore(send_chan_cmsg env chan c nid')) 228 | env.nodes_cmsg 229 | 230 | 231 | (* 232 | let check_message env nid m = 233 | let (_, k, v, u) = m in 234 | let st = env.st in 235 | let t1 = time () in 236 | let g = guard_method nid st k v u in 237 | let t2 = time () in 238 | env.guard_time <- (env.guard_time +. (t2 -. t1)); 239 | if g then ( 240 | env.st <- update_method nid st k v u 241 | (* ; printf "Node %d: Applying update for key %d\n%!" nid k *) 242 | ) 243 | 244 | let check_messages env nid = 245 | let t1 = time () in 246 | List.iter (check_message env nid) env.messages; 247 | let t2 = time () in 248 | env.update_time <- (env.update_time +. (t2 -. t1)) 249 | *) 250 | 251 | let prog_step env nid : bool = 252 | let st = env.st in 253 | match env.prog with 254 | | Put (k, v, p) -> 255 | (* let t1' = time () in *) 256 | let (st', u) = put_method nid st k v in 257 | env.st <- st'; 258 | env.prog <- p; 259 | if (List.length env.nodes > 0) then ( 260 | let u' = to_data u in 261 | broadcast env (nid, k, v, u') 262 | ); 263 | (* let t2' = time () in *) 264 | (* env.put_time <- (env.put_time +. (t2' -. t1')); *) 265 | (* printf "Node %d: executing Put(%d, %d)\n%!" nid k v; *) 266 | false 267 | 268 | | Get (k, pf) -> 269 | (* let t1 = time () in *) 270 | let (v, st') = get_method nid st k in 271 | env.st <- st'; 272 | env.prog <- pf v; 273 | (* let t2 = time () in *) 274 | (* env.get_time <- (env.get_time +. (t2 -. t1)); *) 275 | (* printf "Node %d: executing Get (%d): %d\n%!" nid k v; *) 276 | false 277 | 278 | | Skip -> 279 | (* printf "Node %d: executing Skip\n%!" nid; *) 280 | true 281 | 282 | | Fault -> 283 | (* printf "Node %d: Assertion Failure!\n%!" nid; *) 284 | true 285 | 286 | let rec prog_step_rec env nid n = 287 | if n = 0 then 288 | false 289 | else 290 | let b = prog_step env nid in 291 | if b then 292 | true 293 | else 294 | prog_step_rec env nid (n - 1) 295 | 296 | let exec_step env nid : bool = 297 | (* let t1 = time () in *) 298 | let st' = check_messages nid env.st env.qu in 299 | (* let t2 = time () in *) 300 | (* env.update_time <- (env.update_time +. (t2 -. t1)); *) 301 | env.st <- st'; 302 | prog_step_rec env nid 350 303 | (* prog_step_rec env nid 200 *) 304 | (* prog_step_rec env nid 400 *) 305 | (* prog_step env nid *) 306 | 307 | 308 | (* let handshake env nid = 309 | printf "Node %d: Sending control messages\n%!" nid; 310 | broadcast_cmsg env (nid, are_you_on_cmsg); 311 | (* broadcast_cmsg env (nid, are_you_on_cmsg); *) 312 | printf "Node %d: Receiving control messages\n%!" nid; 313 | for i = 0 to (2*(List.length env.nodes_cmsg) - 1) do 314 | let (n, c) = receive_cmsg env in 315 | if c = are_you_on_cmsg then 316 | send_cmsg env n (nid, i_am_on_cmsg) 317 | done*) 318 | 319 | 320 | let flag_start env = 321 | ignore(broadcast_cmsg env start_cmsg) 322 | 323 | let wait_for_start_flag env = 324 | ignore (receive_cmsg env) 325 | 326 | let flag_finish env = 327 | ignore(broadcast_cmsg env finish_cmsg) 328 | 329 | let wait_for_finish_flag env = 330 | for i = 0 to (List.length env.nodes_cmsg - 1) do 331 | ignore (receive_cmsg env) 332 | done 333 | 334 | 335 | let deliver_step env nid = 336 | let m = receive env in 337 | let (n, k, v, u) = m in 338 | (* printf "Node %d: Delivered message from node %d\n%!" nid n; *) 339 | let u' = from_data u in 340 | enqueue_message nid env.qu (n, k, v, u') 341 | (* env.messages <- (n, k, v, u') :: env.messages *) 342 | 343 | 344 | (* It loops until a socket is ready to read from. *) 345 | let rec select_ready rs ws es t = 346 | try select rs ws es t 347 | with Unix_error (err, fn, arg) -> 348 | select_ready rs ws es t 349 | (* 350 | select: Wait until some input/output operations become possible on some channels. The three list arguments are, respectively, a set of descriptors to check 351 | for reading (first argument), 352 | for writing (second argument), or 353 | for exceptional conditions (third argument). 354 | The fourth argument is the maximal timeout, in seconds; a negative fourth argument means no timeout (unbounded wait). 355 | The result is composed of three sets of descriptors: those ready for reading (first component), ready for writing (second component), and over which an exceptional condition is pending (third component). 356 | *) 357 | 358 | (* let rec step_loop env nid c = *) 359 | let rec step_loop env nid = 360 | (* let (fds, _, _) = select_ready [env.in_sock] [] [] 0.01 in *) 361 | let (fds, _, _) = select_ready [env.in_sock] [] [] 0.0 in 362 | let fin = 363 | try 364 | match fds with 365 | | _ :: _ -> 366 | deliver_step env nid; 367 | false 368 | | _ -> 369 | let b = exec_step env nid in 370 | (* c := !c + 400; *) 371 | (* printf "Node %d: Done ops %d\n%!" nid !c; *) 372 | b 373 | with _ -> 374 | printf "Node %d: Error\n%!" nid; 375 | false 376 | in 377 | if not fin then 378 | step_loop env nid 379 | (* step_loop env nid c *) 380 | 381 | 382 | 383 | let main (net_info: (node_id * node_info) list) nid prog = 384 | printf "Node %d: Setting up the node state\n%!" nid; 385 | let env = setup net_info nid prog in 386 | (* printf "Node %d: Handshaking with others\n%!" nid; *) 387 | (* handshake env nid; *) 388 | (* printf "Node %d: Press Enter once all servers are setup\n%!" nid; *) 389 | (* let _ = input_line Pervasives.stdin in *) 390 | if nid <> -1 then ( 391 | printf "Node %d: Waiting for start flag\n%!" nid; 392 | wait_for_start_flag env; 393 | printf "Node %d: Entering the step loop\n%!" nid; 394 | let t1 = time () in 395 | step_loop env nid; 396 | (* step_loop env nid (ref 0); *) 397 | let t2 = time () in 398 | printf "Node %d: Finished in %f seconds.\n%!" nid (t2 -. t1); 399 | let oc = open_out "Result.txt" in 400 | fprintf oc "%f\n%!" (t2 -. t1); 401 | (* fprintf oc "%f\n%!" env.put_time; *) 402 | (* fprintf oc "%f\n%!" env.get_time; *) 403 | (* fprintf oc "%f\n%!" env.update_time; *) 404 | close_out oc; 405 | printf "Node %d: Sending finish flag and waiting for termination flag\n%!" nid; 406 | flag_finish env; 407 | wait_for_start_flag env; 408 | printf "Node %d: Received termination flag\n%!" nid 409 | 410 | ) else ( 411 | printf "Node %d: sending flag\n%!" nid; 412 | flag_start env; 413 | printf "Node %d: Waiting for finish flag\n%!" nid; 414 | wait_for_finish_flag env; 415 | printf "Node %d: Sending termination flag\n%!" nid; 416 | flag_start env 417 | ) 418 | 419 | 420 | end 421 | 422 | 423 | 424 | 425 | 426 | 427 | 428 | 429 | 430 | 431 | 432 | 433 | 434 | 435 | -------------------------------------------------------------------------------- /src/utils/util.ml: -------------------------------------------------------------------------------- 1 | open List 2 | 3 | 4 | 5 | let rec optmap f = function 6 | | [] -> [] 7 | | hd :: tl -> 8 | match f hd with 9 | | None -> optmap f tl 10 | | Some x -> x :: optmap f tl 11 | 12 | 13 | let take n l = 14 | let rec sub_list n accu l = 15 | match l with 16 | | [] -> accu 17 | | hd :: tl -> 18 | if n = 0 then accu 19 | else sub_list (n - 1) (hd :: accu) tl 20 | in 21 | rev (sub_list n [] l) 22 | 23 | 24 | -------------------------------------------------------------------------------- /theories/Algorithms/ExtractAlgorithm.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import Arith. 2 | (* Require Import PeanoNat. *) 3 | From Coq Require Import List Ascii String. 4 | From Coq Require Export ExtrOcamlBasic ExtrOcamlNatInt ExtrOcamlString. 5 | 6 | Extract Inlined Constant length => "List.length". 7 | Extract Inlined Constant negb => "not". 8 | Extract Inlined Constant app => "List.append". 9 | Extract Inlined Constant map => "List.map". 10 | Extract Inlined Constant filter => "List.filter". 11 | Extract Inlined Constant fold_left => "(fun a b c -> List.fold_left a c b)". 12 | Extract Inlined Constant in_dec => "(fun h -> List.mem)". 13 | Extract Inlined Constant leb => "(<=)". 14 | Extract Inlined Constant ltb => "(<)". 15 | Extract Inlined Constant pred => "(fun n -> if n <= 0 then 0 else n - 1)". 16 | -------------------------------------------------------------------------------- /theories/Examples/Clients.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import String. 2 | From Chapar Require Import Predefs KVStore ReflectiveAbstractSemantics. 3 | From Chapar Require KVSAlg1 KVSAlg2 KVSAlg3. 4 | 5 | Open Scope string_scope. 6 | 7 | Definition max_nid:= 3. 8 | (* PERFORMANCE: 9 | The following gives a very rough example of how performance will scale as we add threads to check 10 | (even the prog1 and prog2 use at most 3 threads, the nondeterministic update will apply to all N threads) 11 | Threads Prog1 (sec) Prog2 (sec) 12 | 3 0.015625 0.03125 13 | 4 0.96875 0.96875 14 | 5 82 15 | *) 16 | 17 | Axiom max_nid_eq: max_nid = SysPredefs.MaxNId. 18 | 19 | Module SyntaxArg <: SyntaxPar. 20 | Definition Val := string. 21 | Definition init_val := "". 22 | End SyntaxArg. 23 | 24 | 25 | Module Clients (AlgDef: AlgDef) (Parametric: Parametric AlgDef) (CauseObl: CauseObl AlgDef). 26 | Module Import Alg := ExecToAbstExec AlgDef Parametric CauseObl SyntaxArg. 27 | 28 | Module Import AECarrier <: AbsExecCarrier SyntaxArg. 29 | Module AbsExec:= Alg.AExec. 30 | Definition CausallyContent := CausallyContent. 31 | End AECarrier. 32 | 33 | Module Import RAS:= ReflAbsSem SyntaxArg AECarrier. 34 | Declare Scope Prog. 35 | Delimit Scope Prog with Prog. 36 | Bind Scope Prog with Prog. 37 | Bind Scope Prog with PProg. 38 | 39 | Notation "'put' '(' k ',' v ')' ;; c" := (put k v c%Prog) (right associativity, at level 100) : Prog. 40 | Notation "x <- 'get' '(' k ')' ;; c" := (get k (fun x => c%Prog)) (right associativity, at level 100) : Prog. 41 | Notation "'assert' '(' t ')' ;; c" := (if t%bool then c%Prog else fault) (right associativity, at level 100, t at level 0) : Prog. 42 | 43 | Definition Photo := 1. 44 | Definition Post := 2. 45 | 46 | Definition prog_photo_upload: PProg := 47 | fun n => 48 | match n with 49 | | 0 => 50 | put (Photo, "NewPhoto");; 51 | put (Post, "Uploaded");; 52 | skip 53 | 54 | | 1 => 55 | post <- get (Post);; 56 | if (string_dec post "Uploaded") then 57 | photo <- get (Photo);; 58 | if string_dec photo "" then 59 | fault 60 | else 61 | skip 62 | else 63 | skip 64 | 65 | | _ => skip 66 | end%Prog. 67 | 68 | Lemma CausallyContent_Prog_PhotoUpload: CausallyContent prog_photo_upload. 69 | Proof. 70 | fast_casually_content max_nid max_nid_eq 50. 71 | Qed. 72 | 73 | Lemma CauseConsistent_Prog_PhotoUpload: forall h n, 74 | Alg.CExec.history (Alg.CExec.init prog_photo_upload) h -> 75 | forall l, List.In l h -> l <> Alg.CExec.fault_label n. 76 | Proof. 77 | intros h n Hrun; intros. 78 | eapply FaultFreedom; eauto. 79 | eapply CausallyContent_Prog_PhotoUpload; eauto. 80 | Qed. 81 | 82 | Definition prog_lost_ring: PProg := 83 | fun n => 84 | match n with 85 | | 0 => 86 | put (1, "I Lost my ring!");; 87 | put (1, "Nevermind -- I just found it. :)");; 88 | skip 89 | 90 | | 1 => 91 | post <- get (1);; 92 | if (string_dec post "Nevermind -- I just found it. :)") then 93 | put (2, "Glad to hear!");; 94 | skip 95 | else 96 | skip 97 | 98 | | 2 => 99 | postB <- get (2);; 100 | if (string_dec postB "Glad to hear!") then 101 | postA <- get (1);; 102 | if (string_dec postA "Nevermind -- I just found it. :)") then 103 | skip 104 | else 105 | fault 106 | else 107 | skip 108 | 109 | | _ => skip 110 | end%Prog. 111 | 112 | Lemma CausallyContent_Prog_LostRing: CausallyContent prog_lost_ring. 113 | Proof. 114 | fast_casually_content max_nid max_nid_eq 50. 115 | Qed. 116 | 117 | Lemma CauseConsistent_Prog_LostRing: forall h n, 118 | Alg.CExec.history (Alg.CExec.init prog_lost_ring) h -> 119 | forall l, List.In l h -> l <> Alg.CExec.fault_label n. 120 | Proof. 121 | intros h n Hrun; intros. 122 | eapply FaultFreedom; eauto; intros. 123 | eapply CausallyContent_Prog_LostRing; eauto. 124 | Qed. 125 | 126 | Definition string_beq (s1 s2: string):= if string_dec s1 s2 then true else false. 127 | 128 | Definition prog_photo_album: PProg := 129 | fun n => 130 | match n with 131 | | 0 => 132 | put (1, "uploads photos");; 133 | put (2, "creates album");; 134 | put (3, "adds photos to album");; 135 | skip 136 | 137 | | 1 => 138 | z <- get (3);; 139 | y <- get (2);; 140 | x <- get (1);; 141 | assert (if string_beq z "adds photos to album" then string_beq y "creates album" else true);; 142 | assert (if string_beq y "creates album" then string_beq x "uploads photos" else true);; 143 | skip 144 | 145 | | _ => skip 146 | end%Prog. 147 | 148 | Lemma CausallyContent_Prog_PhotoAlbum: CausallyContent prog_photo_album. 149 | Proof. 150 | fast_casually_content max_nid max_nid_eq 50. 151 | Qed. 152 | 153 | Lemma CauseConsistent_Prog_PhotoAlbum: forall h n, 154 | Alg.CExec.history (Alg.CExec.init prog_photo_album) h -> 155 | forall l, List.In l h -> l <> Alg.CExec.fault_label n. 156 | Proof. 157 | intros h n Hrun; intros. 158 | eapply FaultFreedom; eauto; intros. 159 | eapply CausallyContent_Prog_PhotoAlbum; eauto. 160 | Qed. 161 | 162 | End Clients. 163 | 164 | 165 | 166 | (* Corollary: causally-consistent for Alg1 *) 167 | Module Alg1. 168 | Import KVSAlg1. 169 | Module C:= Clients KVSAlg1.KVSAlg1 KVSAlg1Parametric KVSAlg1CauseObl. 170 | 171 | Lemma CauseConsistent_Prog1: forall h n, 172 | C.Alg.CExec.history (C.Alg.CExec.init C.prog_photo_upload) h -> 173 | forall l, List.In l h -> l <> C.Alg.CExec.fault_label n. 174 | Proof. 175 | exact C.CauseConsistent_Prog_PhotoUpload. 176 | Qed. 177 | 178 | Lemma CauseConsistent_Prog_LostRing: forall h n, 179 | C.Alg.CExec.history (C.Alg.CExec.init C.prog_lost_ring) h -> 180 | forall l, List.In l h -> l <> C.Alg.CExec.fault_label n. 181 | Proof. 182 | exact C.CauseConsistent_Prog_LostRing. 183 | Qed. 184 | 185 | Lemma CauseConsistent_Prog_PhotoAlbum: forall h n, 186 | C.Alg.CExec.history (C.Alg.CExec.init C.prog_photo_album) h -> 187 | forall l, List.In l h -> l <> C.Alg.CExec.fault_label n. 188 | Proof. 189 | exact C.CauseConsistent_Prog_PhotoAlbum. 190 | Qed. 191 | 192 | End Alg1. 193 | 194 | 195 | (* Corollary: causally-consistent for Alg2 *) 196 | Module Alg2. 197 | Import KVSAlg2. 198 | Module C:= Clients KVSAlg2.KVSAlg2 KVSAlg2Parametric KVSAlg2CauseObl. 199 | 200 | Lemma CauseConsistent_Prog_PhotoUpload: forall h n, 201 | C.Alg.CExec.history (C.Alg.CExec.init C.prog_photo_upload) h -> 202 | forall l, List.In l h -> l <> C.Alg.CExec.fault_label n. 203 | Proof. 204 | exact C.CauseConsistent_Prog_PhotoUpload. 205 | Qed. 206 | 207 | Lemma CauseConsistent_Prog2: forall h n, 208 | C.Alg.CExec.history (C.Alg.CExec.init C.prog_lost_ring) h -> 209 | forall l, List.In l h -> l <> C.Alg.CExec.fault_label n. 210 | Proof. 211 | exact C.CauseConsistent_Prog_LostRing. 212 | Qed. 213 | 214 | Lemma CauseConsistent_Prog_PhotoAlbum: forall h n, 215 | C.Alg.CExec.history (C.Alg.CExec.init C.prog_photo_album) h -> 216 | forall l, List.In l h -> l <> C.Alg.CExec.fault_label n. 217 | Proof. 218 | exact C.CauseConsistent_Prog_PhotoAlbum. 219 | Qed. 220 | 221 | End Alg2. 222 | 223 | 224 | (* Corollary: causally-consistent for Alg3 *) 225 | Module Alg3. 226 | Import KVSAlg3. 227 | Module C:= Clients KVSAlg3.KVSAlg3 KVSAlg1Parametric KVSAlg3CauseObl. 228 | 229 | Lemma CauseConsistent_Prog_PhotoUpload: forall h n, 230 | C.Alg.CExec.history (C.Alg.CExec.init C.prog_photo_upload) h -> 231 | forall l, List.In l h -> l <> C.Alg.CExec.fault_label n. 232 | Proof. 233 | exact C.CauseConsistent_Prog_PhotoUpload. 234 | Qed. 235 | 236 | Lemma CauseConsistent_Prog2: forall h n, 237 | C.Alg.CExec.history (C.Alg.CExec.init C.prog_lost_ring) h -> 238 | forall l, List.In l h -> l <> C.Alg.CExec.fault_label n. 239 | Proof. 240 | exact C.CauseConsistent_Prog_LostRing. 241 | Qed. 242 | 243 | Lemma CauseConsistent_Prog_PhotoAlbum: forall h n, 244 | C.Alg.CExec.history (C.Alg.CExec.init C.prog_photo_album) h -> 245 | forall l, List.In l h -> l <> C.Alg.CExec.fault_label n. 246 | Proof. 247 | exact C.CauseConsistent_Prog_PhotoAlbum. 248 | Qed. 249 | 250 | End Alg3. 251 | -------------------------------------------------------------------------------- /theories/Examples/ListClient.v: -------------------------------------------------------------------------------- 1 | From Coq Require String. 2 | From Chapar Require Import Predefs KVStore ReflectiveAbstractSemantics. 3 | From Chapar Require KVSAlg1 KVSAlg2 KVSAlg3. 4 | 5 | Import PeanoNat. 6 | 7 | Open Scope string_scope. 8 | 9 | Definition max_nid:= 2. 10 | 11 | Axiom max_nid_eq: max_nid = SysPredefs.MaxNId. 12 | 13 | Module SyntaxArg <: SyntaxPar. 14 | Definition Val := nat. 15 | Definition init_val : nat := 10. 16 | End SyntaxArg. 17 | 18 | Module ListClient (AlgDef: AlgDef) (Parametric: Parametric AlgDef) (CauseObl: CauseObl AlgDef). 19 | Module Import Alg := ExecToAbstExec AlgDef Parametric CauseObl SyntaxArg. 20 | 21 | Module Import AECarrier <: AbsExecCarrier SyntaxArg. 22 | Module AbsExec:= Alg.AExec. 23 | End AECarrier. 24 | 25 | Module Import RAS:= ReflAbsSem SyntaxArg AECarrier. 26 | Declare Scope Prog. 27 | Delimit Scope Prog with Prog. 28 | Bind Scope Prog with Prog. 29 | Bind Scope Prog with PProg. 30 | 31 | Notation "'put' '(' k ',' v ')' ;; c" := (put k v c%Prog) (right associativity, at level 100) : Prog. 32 | Notation "x <- 'get' '(' k ')' ;; c" := (get k (fun x => c%Prog)) (right associativity, at level 100) : Prog. 33 | Notation "'assert' '(' t ')' ;; c" := (if t%bool then c%Prog else fault) (right associativity, at level 100, t at level 0) : Prog. 34 | 35 | (* Linked list layout 36 | 37 | Address: 3 4 5 6 1 2 38 | --------- --------- --------- 39 | Value: | 1 | 5 +---->| 2 | 1 +---->| 3 | 0 X 40 | --------- --------- --------- 41 | ^ ^ ^ 42 | 7 | | | 43 | -------- | | | 44 | | head +---+-------------+-------------+-----= 0 45 | -------- 46 | *) 47 | 48 | (* could also be section-ed Lets *) 49 | Local Definition null := 0. 50 | Local Definition head := 7. 51 | Local Definition init := 10. 52 | 53 | Definition prog1: PProg := 54 | fun n => 55 | match n with 56 | | 0 => 57 | (* first node *) 58 | put (2,null);; 59 | put (1,3);; 60 | put (head,1);; (* update head *) 61 | (* second node *) 62 | put (6,1);; 63 | put (5,2);; 64 | put (head,5);; (* update head *) 65 | (* third node *) 66 | put (4,5);; 67 | put (3,1);; 68 | put (head,3);; (* update head *) 69 | skip 70 | 71 | | 1 => 72 | node1 <- get(head);; 73 | if (node1 =? init) || (node1 =? null) then 74 | skip 75 | else 76 | item1 <- get(node1);; 77 | node2 <- get(S node1);; 78 | if node2 =? null then 79 | skip 80 | else 81 | item2 <- get(node2);; 82 | node3 <- get(S node2);; 83 | assert (item1 skip 93 | end%Prog%bool. 94 | 95 | Lemma CausallyContent_Prog1: CausallyContent prog1. 96 | Proof. (* Note: "fast" is a relative term. This will take a few minutes... *) 97 | fast_casually_content max_nid max_nid_eq 50. 98 | Qed. 99 | 100 | Lemma CauseConsistent_Prog1: forall h n, 101 | Alg.CExec.history (Alg.CExec.init prog1) h -> 102 | forall l, List.In l h -> l <> Alg.CExec.fault_label n. 103 | Proof. 104 | intros h n Hrun; intros. 105 | eapply FaultFreedom; eauto. 106 | eapply CausallyContent_Prog1; eauto. 107 | Qed. 108 | 109 | End ListClient. 110 | 111 | (* Corollary: causally-consistent for Alg1 *) 112 | Module Alg1. 113 | Import KVSAlg1. 114 | Module C:= ListClient KVSAlg1.KVSAlg1 KVSAlg1Parametric KVSAlg1CauseObl. 115 | 116 | Lemma CauseConsistent_Prog1: forall h n, 117 | C.Alg.CExec.history (C.Alg.CExec.init C.prog1) h -> 118 | forall l, List.In l h -> l <> C.Alg.CExec.fault_label n. 119 | Proof. 120 | exact C.CauseConsistent_Prog1. 121 | Qed. 122 | 123 | End Alg1. 124 | 125 | (* Corollary: causally-consistent for Alg2 *) 126 | Module Alg2. 127 | Import KVSAlg2. 128 | Module C:= ListClient KVSAlg2.KVSAlg2 KVSAlg2Parametric KVSAlg2CauseObl. 129 | 130 | Lemma CauseConsistent_Prog1: forall h n, 131 | C.Alg.CExec.history (C.Alg.CExec.init C.prog1) h -> 132 | forall l, List.In l h -> l <> C.Alg.CExec.fault_label n. 133 | Proof. 134 | exact C.CauseConsistent_Prog1. 135 | Qed. 136 | 137 | End Alg2. 138 | 139 | (* Corollary: causally-consistent for Alg3 *) 140 | Module Alg3. 141 | Import KVSAlg3. 142 | Module C:= ListClient KVSAlg3.KVSAlg3 KVSAlg1Parametric KVSAlg3CauseObl. 143 | 144 | Lemma CauseConsistent_Prog1: forall h n, 145 | C.Alg.CExec.history (C.Alg.CExec.init C.prog1) h -> 146 | forall l, List.In l h -> l <> C.Alg.CExec.fault_label n. 147 | Proof. 148 | exact C.CauseConsistent_Prog1. 149 | Qed. 150 | 151 | End Alg3. 152 | -------------------------------------------------------------------------------- /theories/Framework/ReflectiveAbstractSemantics.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import FunctionalExtensionality List Arith Lia. 2 | From Chapar Require Import Predefs KVStore. 3 | 4 | Import ListNotations. 5 | 6 | Module Type AbsExecCarrier (SyntaxArg : SyntaxPar). 7 | Module AbsExec := AbsExec SyntaxArg. 8 | End AbsExecCarrier. 9 | 10 | Module ReflAbsSem (SyntaxArg : SyntaxPar) (Import AE : AbsExecCarrier SyntaxArg). 11 | Export AbsExec. 12 | Export AbsExec.Syntax. 13 | 14 | Local Hint Constructors step_star : core. 15 | 16 | Lemma rev_step_star_ind : 17 | forall (P : StepStarArgs.State -> list StepStarArgs.Label -> StepStarArgs.State -> Prop), 18 | (forall s, P s nil s) -> 19 | (forall s1 l s2 ls s3, 20 | StepStarArgs.step s1 l s2 -> 21 | step_star s2 ls s3 -> 22 | P s2 ls s3 -> 23 | P s1 (l::ls)%list s3) -> 24 | forall s l s0, 25 | step_star s l s0 -> 26 | P s l s0. 27 | Proof. 28 | intros P Hnil Hstep. 29 | intros s l1 s1 Hss1. 30 | assert (Hss2: step_star s1 nil s1) by auto. 31 | remember s1 as s0 in Hss2 at 2. 32 | rewrite <-Heqs0. 33 | remember nil as l2 in Hss2. 34 | replace l1 with (l1++l2)%list by (subst; rewrite List.app_nil_r; auto). 35 | assert (HPl2: P s1 l2 s0) by (subst; auto). 36 | clear Heqs0 Heql2. 37 | revert s0 l2 HPl2 Hss2. 38 | induction Hss1; intros; auto. 39 | rewrite <-List.app_assoc. 40 | apply IHHss1. 41 | eapply Hstep; eauto. 42 | simpl. 43 | apply step_star_end. 44 | eauto. 45 | Qed. 46 | 47 | Lemma rev_step_star_inv : 48 | forall s ls s0 (P : StepStarArgs.State -> list StepStarArgs.Label -> StepStarArgs.State -> Prop), 49 | P s nil s -> 50 | (forall l s1 ls', 51 | StepStarArgs.step s l s1 -> 52 | step_star s1 ls' s0 -> 53 | P s (l::ls')%list s0) -> 54 | step_star s ls s0 -> 55 | P s ls s0. 56 | Proof. 57 | intros s ls s0 P Hnil Hstep Hss. 58 | revert P Hnil Hstep. 59 | induction Hss using rev_step_star_ind; intros; auto. 60 | eauto. 61 | Qed. 62 | 63 | Lemma override_eq: forall {V} n s (v1 v2: V), 64 | SysPredefs.override (SysPredefs.override s n v1) n v2 = SysPredefs.override s n v2. 65 | Proof. 66 | unfold SysPredefs.override; intros. 67 | apply functional_extensionality; intros. 68 | case_eq (x =_? n); intros; auto. 69 | Qed. 70 | 71 | Lemma override_neq: forall {V} n1 n2 s (v1 v2: V), 72 | n1 <> n2 -> 73 | SysPredefs.override (SysPredefs.override s n1 v1) n2 v2 = SysPredefs.override (SysPredefs.override s n2 v2) n1 v1. 74 | Proof. 75 | unfold SysPredefs.override; intros. 76 | apply functional_extensionality; intros. 77 | case_eq (x =_? n2); intros; subst; auto. 78 | case_eq (n2 =_? n1); intros; subst; auto. 79 | congruence. 80 | Qed. 81 | 82 | Ltac simpl_override:= 83 | repeat match goal with 84 | | H: context[SysPredefs.override _ ?n _ ?n] |- _ => 85 | rewrite SysPredefs.override_new_val with (k:=n) in H 86 | | H: context[SysPredefs.override _ ?n1 _ ?n2] |- _ => 87 | rewrite SysPredefs.override_old_val with (k:=n1) (k':=n2) in H; [ | congruence] 88 | | H: context[SysPredefs.override (SysPredefs.override _ ?n _) ?n _] |- _ => 89 | rewrite @override_eq in H 90 | | H: context[SysPredefs.override (SysPredefs.override _ ?n1 _) ?n2 _] |- _ => 91 | (* sort the overrides so we can eliminate redundencies easily *) 92 | let Hlt:= fresh "H" in 93 | assert (Hlt: n1 > n2) by lia; 94 | rewrite (@override_neq _ n1 n2) in H; [ | lia ]; 95 | clear Hlt 96 | | |- context[SysPredefs.override _ ?n _ ?n] => 97 | rewrite SysPredefs.override_new_val with (k:=n) 98 | | |- context[SysPredefs.override _ _ _ _] => 99 | rewrite SysPredefs.override_old_val; [ | congruence] 100 | | |- context[SysPredefs.override (SysPredefs.override _ ?n _) ?n _] => 101 | rewrite @override_eq 102 | | |- context[SysPredefs.override (SysPredefs.override _ ?n1 _) ?n2 _] => 103 | (* sort the overrides so we can eliminate redundencies easily *) 104 | let Hlt:= fresh "H" in 105 | assert (Hlt: n1 > n2) by lia; 106 | rewrite (@override_neq _ n1 n2); [ | lia ]; 107 | clear Hlt 108 | end. 109 | 110 | Arguments Nat.ltb n m : simpl nomatch. 111 | Arguments Nat.leb n m : simpl nomatch. 112 | 113 | Lemma ltb_ge: forall n m, 114 | Nat.ltb n m = false <-> n >= m. 115 | Proof. 116 | unfold Nat.ltb; intros. 117 | revert n. 118 | induction m; destruct n; simpl; 119 | intuition auto; 120 | try discriminate || lia. 121 | apply IHm in H; lia. 122 | apply IHm; lia. 123 | Qed. 124 | 125 | Local Hint Rewrite Nat.eqb_neq Nat.eqb_eq Nat.ltb_lt ltb_ge : nat. 126 | 127 | Inductive ScheduleTask : Set := 128 | | SchedProc: forall (n: SysPredefs.NId), ScheduleTask 129 | | SchedUpdate: forall (n1 n2 : SysPredefs.NId), ScheduleTask. 130 | 131 | Lemma NId_eq_dec: forall (x y: SysPredefs.NId), {x=y}+{x<>y}. 132 | Proof. decide equality. Qed. 133 | 134 | 135 | Tactic Notation "do_" constr(n) tactic(tac):= 136 | let rec do__ n := 137 | match n with 138 | | S ?n' => tac; do__ n' 139 | | O => idtac 140 | end 141 | in do__ n. 142 | 143 | Ltac mcase_eq_term t H:= 144 | match t with 145 | | context[match ?t with _=>_ end] => 146 | mcase_eq_term t H 147 | | _ => 148 | case_eq t; 149 | repeat match goal with 150 | | |- t = _ -> _ => fail 1 151 | | |- _->_ => intro 152 | end; 153 | intro H; 154 | rewrite ?H in * 155 | end. 156 | Tactic Notation "mcase_eq" "as" ident(H') "in" hyp(H):= 157 | match type of H with 158 | | ?t => mcase_eq_term t H' 159 | end. 160 | Tactic Notation "mcase_eq" "in" hyp(H):= 161 | let H':= fresh "H" in 162 | mcase_eq as H' in H. 163 | Tactic Notation "mcase_eq":= 164 | let H':= fresh "H" in 165 | match goal with 166 | | |- ?t => mcase_eq_term t H' 167 | end. 168 | 169 | Section A. 170 | (* TEMPORARY *) 171 | (* these are defined here because SysPredefs.MaxNId is currently admitted. 172 | we need the user to be able to instantiate it with a constant for these 173 | eflective semantics to work correctly 174 | *) 175 | Variable max_nid : nat. 176 | Hypothesis max_nid_eq: max_nid = SysPredefs.MaxNId. 177 | 178 | Definition nids:= (let (l, _, _) := SysPredefs.bnats max_nid in l). 179 | 180 | Lemma nids_eq: nids = SysPredefs.nids. 181 | Proof using max_nid_eq. unfold nids, SysPredefs.nids; intros; rewrite max_nid_eq; reflexivity. Qed. 182 | 183 | 184 | Definition step_fun task s: option (Label * State) := 185 | match task with 186 | | SchedProc n => 187 | if List.existsb (Nat.eqb n) nids then 188 | match s n with 189 | | Build_NodeState (KVStore.put _ k v p) u d r m => 190 | let u' := u ++ [(t_put k v d)] in 191 | let d' := (put_id n (List.length u')) :: d in 192 | let r' := SysPredefs.override r n ((r n) + 1) in 193 | let m' := SysPredefs.override m k (entry v n (List.length u') nil) in 194 | Some (put_label n (List.length u') k v, SysPredefs.override s n (node_state p u' d' r' m')) 195 | | Build_NodeState (KVStore.get _ k p) u d r m => 196 | let v := entry_val (m k) in 197 | let n'' := entry_nid (m k) in 198 | let c'' := entry_clock (m k) in 199 | let d'' := entry_dep (m k) in 200 | let d' := if Nat.eqb n'' max_nid then d 201 | else d ++ [put_id n'' c''] ++ d'' in 202 | Some (get_label n'' c'' n k v, SysPredefs.override s n (node_state (p v) u d' r m)) 203 | | Build_NodeState (KVStore.fault _) u d r m => 204 | Some (fault_label n, SysPredefs.override s n (node_state skip u d r m)) 205 | | _ => None 206 | end 207 | else None 208 | | SchedUpdate n1 n2 => 209 | match s n1, s n2 with 210 | | Build_NodeState p_1 u_1 d_1 r_1 m_1, Build_NodeState p_2 u_2 d_2 r_2 m_2 => 211 | let d := t_put_dep (List.nth (r_1 n2) u_2 dummy_t_put) in 212 | if negb (Nat.eqb n1 n2) 213 | && List.existsb (Nat.eqb n1) nids 214 | && Nat.ltb (r_1 n2) (List.length u_2) 215 | && List.forallb (fun pid => Nat.leb (put_id_clock pid) (r_1 (put_id_nid pid))) d then 216 | let k := t_put_key (List.nth (r_1 n2) u_2 dummy_t_put) in 217 | let v := t_put_val (List.nth (r_1 n2) u_2 dummy_t_put) in 218 | let r_1' := SysPredefs.override r_1 n2 ((r_1 n2) + 1) in 219 | let m_1' := SysPredefs.override m_1 k (entry v n2 (r_1' n2) d) in 220 | Some (update_label n2 (r_1' n2) n1 k v, 221 | SysPredefs.override (SysPredefs.override s 222 | n1 (node_state p_1 u_1 d_1 r_1' m_1')) 223 | n2 (node_state p_2 u_2 d_2 r_2 m_2)) 224 | else 225 | None 226 | end 227 | end%list%bool. 228 | 229 | Fixpoint step_star_fun tracePrefix (sched : list ScheduleTask) s : option ((list Label) * State) := 230 | match sched with 231 | | task :: sched' => 232 | match step_fun task s with 233 | | Some (l, s') => 234 | step_star_fun (tracePrefix++[l]) sched' s' 235 | | None => None 236 | end 237 | | nil => Some (tracePrefix, s) 238 | end%list. 239 | 240 | Definition fast_step_fun task s: option State := 241 | match task with 242 | | SchedProc n => 243 | match s n with 244 | | Build_NodeState (KVStore.put _ k v p) u d r m => 245 | let u' := u ++ [(t_put k v d)] in 246 | let d' := (put_id n (List.length u')) :: d in 247 | let r' := SysPredefs.override r n ((r n) + 1) in 248 | let m' := SysPredefs.override m k (entry v n (List.length u') nil) in 249 | Some (SysPredefs.override s n (node_state p u' d' r' m')) 250 | | Build_NodeState (KVStore.get _ k p) u d r m => 251 | let n'' := entry_nid (m k) in 252 | let d' := if Nat.eqb n'' max_nid then d 253 | else d ++ [put_id n'' (entry_clock (m k))] ++ entry_dep (m k) in 254 | Some (SysPredefs.override s n (node_state (p (entry_val (m k))) u d' r m)) 255 | | Build_NodeState (KVStore.fault _) u d r m => 256 | Some (SysPredefs.override s n (node_state skip u d r m)) 257 | | _ => None 258 | end 259 | | SchedUpdate n1 n2 => 260 | match s n1, s n2 with 261 | | Build_NodeState p_1 u_1 d_1 r_1 m_1, Build_NodeState p_2 u_2 d_2 r_2 m_2 => 262 | let d := t_put_dep (List.nth (r_1 n2) u_2 dummy_t_put) in 263 | if negb (Nat.eqb n1 n2) 264 | && Nat.ltb (r_1 n2) (List.length u_2) 265 | && List.forallb (fun pid => Nat.leb (put_id_clock pid) (r_1 (put_id_nid pid))) d then 266 | let x:= List.nth (r_1 n2) u_2 dummy_t_put in 267 | let k := t_put_key x in 268 | let v := t_put_val x in 269 | let r_1' := SysPredefs.override r_1 n2 ((r_1 n2) + 1) in 270 | let m_1' := SysPredefs.override m_1 k (entry v n2 (r_1' n2) d) in 271 | Some ( 272 | SysPredefs.override (SysPredefs.override s 273 | n1 (node_state p_1 u_1 d_1 r_1' m_1')) 274 | n2 (node_state p_2 u_2 d_2 r_2 m_2)) 275 | else 276 | None 277 | end 278 | end%list%bool. 279 | 280 | Fixpoint fast_step_star_fun (sched : list ScheduleTask) s : option State := 281 | match sched with 282 | | task :: sched' => 283 | match fast_step_fun task s with 284 | | Some s' => 285 | fast_step_star_fun sched' s' 286 | | None => None 287 | end 288 | | nil => Some s 289 | end%list. 290 | 291 | Lemma nid_in_dec_existsb: forall n l, 292 | List.existsb (Nat.eqb n) l = 293 | if List.in_dec NId_eq_dec n l then true else false. 294 | Proof using. 295 | intros. 296 | case_eq (List.existsb (Nat.eqb n) l); intros. 297 | apply List.existsb_exists in H; destruct H as [y[??]]. 298 | apply Nat.eqb_eq in H0; subst y. 299 | case_eq (List.in_dec NId_eq_dec n l); intros; auto. 300 | contradiction. 301 | case_eq (List.in_dec NId_eq_dec n l); intros; auto. 302 | rewrite <-H. 303 | apply List.existsb_exists. 304 | exists n; split; auto. 305 | apply Nat.eqb_refl. 306 | Qed. 307 | 308 | 309 | 310 | Lemma fast_step_correct: forall task s l s', 311 | step_fun task s = Some (l, s') -> 312 | fast_step_fun task s = Some s'. 313 | Proof using max_nid_eq. 314 | unfold step_fun, fast_step_fun; intros. 315 | rewrite nids_eq in *. 316 | repeat match goal with 317 | | H: Some _ = Some _ |- _ => inversion H; clear H; subst 318 | | _ => rewrite nid_in_dec_existsb in * 319 | | H: (_ && _ = true)%bool |- _ => rewrite Bool.andb_true_iff in H; destruct H 320 | | H: (_ && _ = false)%bool |- _ => rewrite Bool.andb_false_iff in H; destruct H 321 | | H: None = Some _ |- _ => discriminate 322 | | _ => reflexivity 323 | | _ => mcase_eq in H 324 | | _ => mcase_eq 325 | | _ => congruence 326 | end. 327 | Qed. 328 | 329 | Lemma fast_step_star_correct: forall ls sched s ls' s', 330 | step_star_fun ls sched s = Some (ls', s') -> 331 | fast_step_star_fun sched s = Some s'. 332 | Proof using max_nid_eq. 333 | intros. 334 | revert ls s ls' s' H. 335 | induction sched; simpl; intros. 336 | * congruence. 337 | * mcase_eq as Hs in H; try congruence. 338 | destruct p. 339 | apply fast_step_correct in Hs; rewrite Hs. 340 | eauto. 341 | Qed. 342 | 343 | Lemma step_star_fun_app: forall sched1 sched2 ls1 s, 344 | step_star_fun ls1 (sched1 ++ sched2)%list s = 345 | match step_star_fun ls1 sched1 s with 346 | | Some (ls2, s') => step_star_fun ls2 sched2 s' 347 | | None => None 348 | end. 349 | Proof using. 350 | clear max_nid_eq. 351 | induction sched1; simpl; intros; auto. 352 | repeat mcase_eq; subst; auto. 353 | rewrite IHsched1, H1; reflexivity. 354 | rewrite IHsched1, H1; reflexivity. 355 | Qed. 356 | 357 | Lemma prefix_step_star_fun: forall sched ls1 ls2 ls3 s s', 358 | step_star_fun ls1 sched s = Some (ls2, s') -> 359 | step_star_fun (ls3++ls1)%list sched s = Some (ls3++ls2, s')%list. 360 | Proof using. 361 | induction sched; simpl; intros. 362 | congruence. 363 | destruct (step_fun a s ) as [ [??] | ]; try discriminate. 364 | rewrite <-List.app_assoc. 365 | eauto. 366 | Qed. 367 | 368 | 369 | Lemma prefix_inv_step_star_fun: forall sched ls1 ls2 s s', 370 | step_star_fun ls1 sched s = Some (ls2, s') -> 371 | (exists ls3, 372 | ls2 = ls1 ++ ls3 /\ step_star_fun nil sched s = Some (ls3, s'))%list. 373 | Proof using. 374 | induction sched; simpl; intros. 375 | - inversion H; clear H; subst. 376 | exists nil; rewrite List.app_nil_r; split; reflexivity. 377 | - destruct (step_fun a s) as [[?]|]; try discriminate. 378 | edestruct IHsched as [ls3[??]]; eauto; subst ls2. 379 | exists (l::ls3)%list; split. 380 | * rewrite <-List.app_assoc. 381 | reflexivity. 382 | * eapply prefix_step_star_fun with (ls3:=[l]) (ls1:=nil). 383 | assumption. 384 | Qed. 385 | 386 | Lemma step_ext: forall s1 s3 l s2 s4, 387 | step s1 l s2 -> 388 | (forall n, s1 n = s3 n) -> 389 | (forall n, s2 n = s4 n) -> 390 | step s3 l s4. 391 | Proof using. 392 | intros s1 s3 l s2 s4 Hstep Heq1 Heq2. 393 | apply functional_extensionality in Heq1. 394 | apply functional_extensionality in Heq2. 395 | subst; auto. 396 | Qed. 397 | 398 | Definition valid_schedule nids (sched: list ScheduleTask) := 399 | List.Forall 400 | (fun task => match task with 401 | | SchedProc n1 => List.In n1 nids 402 | | SchedUpdate n1 n2 => List.In n1 nids /\ List.In n2 nids 403 | end) 404 | sched. 405 | 406 | Lemma valid_schedule_cons: forall nids task sched, 407 | valid_schedule nids (task::sched) <-> 408 | match task with 409 | | SchedProc n1 => List.In n1 nids 410 | | SchedUpdate n1 n2 => List.In n1 nids /\ List.In n2 nids 411 | end 412 | /\ valid_schedule nids sched. 413 | Proof using. 414 | unfold valid_schedule; intros. 415 | split; intros. 416 | inversion H; split; auto. 417 | apply List.Forall_cons; tauto. 418 | Qed. 419 | 420 | Lemma valid_schedule_app: forall nids sched1 sched2, 421 | valid_schedule nids (sched1++sched2) <-> 422 | valid_schedule nids sched1 /\ valid_schedule nids sched2. 423 | Proof using. 424 | unfold valid_schedule; intros. 425 | rewrite !List.Forall_forall in *. 426 | setoid_rewrite List.in_app_iff. 427 | split. 428 | * intros H. 429 | split; intros task Hin; specialize (H task); tauto. 430 | * intros [H1 H2] x. 431 | specialize (H1 x); specialize (H2 x). 432 | intros [?|?]; tauto. 433 | Qed. 434 | 435 | Ltac nid_cases n:= 436 | try match goal with 437 | | H: List.In n SysPredefs.nids |- _ => 438 | unfold SysPredefs.nids in H; 439 | rewrite max_nid in H; 440 | simpl in H; 441 | repeat match type of H with 442 | | _ \/ _ => destruct H as [H|H] 443 | | ?x = ?x => clear H 444 | | _ = ?n => is_var n; subst n 445 | | ?n = _ => is_var n; subst n 446 | | _ = _ => congruence 447 | | False => contradiction 448 | end 449 | end. 450 | 451 | Lemma valid_nid_step_fun_Proc: forall n1 s l s', 452 | step_fun (SchedProc n1) s = Some (l, s') -> 453 | List.In n1 nids. 454 | Proof using. 455 | simpl; intros. 456 | rewrite nid_in_dec_existsb in *. 457 | mcase_eq in H; auto. 458 | discriminate. 459 | Qed. 460 | 461 | Lemma valid_nid_step_fun_Update: forall n1 n2 s l s', 462 | step_fun (SchedUpdate n1 n2) s = Some (l, s') -> 463 | List.In n1 nids. 464 | Proof using. 465 | simpl; intros. 466 | rewrite nid_in_dec_existsb in *. 467 | repeat mcase_eq in H; auto; 468 | rewrite ?Bool.andb_false_r, ?Bool.andb_false_l in *; 469 | discriminate. 470 | Qed. 471 | 472 | Lemma valid_schedule_step_star_fun: forall ls1 sched prog0 hs', 473 | step_star_fun ls1 sched (init prog0) = Some hs' -> 474 | valid_schedule nids sched. 475 | Proof using. 476 | intros. 477 | clear max_nid_eq. 478 | assert (forall n1 n2, List.In n1 nids -> ~List.In n2 nids -> ptrace ((init prog0) n2) = nil /\ rec ((init prog0) n1) n2 = 0) 479 | by (split; reflexivity). 480 | remember (init prog0) as s. 481 | rename H into Hss. 482 | rename H0 into Hbad_nid_clock_zero. 483 | clear Heqs. 484 | revert ls1 s Hss Hbad_nid_clock_zero. 485 | induction sched as [ | [ n1 | n1 n2 ] sched ]; simpl; intros. 486 | * constructor. 487 | * rewrite nid_in_dec_existsb in Hss. 488 | generalize (Hbad_nid_clock_zero n1); intro Hbncz1. 489 | apply valid_schedule_cons; simpl; split; auto; 490 | repeat mcase_eq in Hss; auto; 491 | try discriminate; 492 | eapply IHsched; eauto; 493 | clear Hss H0 IHsched; 494 | intros ? n2; intros; 495 | generalize (Hbad_nid_clock_zero n2); intro Hbncz2; 496 | intuition (subst; auto); 497 | repeat match goal with 498 | | |- context[SysPredefs.override _ ?n1 _ ?n2] => 499 | (is_var n1 || is_var n2); 500 | destruct (NId_eq_dec n1 n2); 501 | [ subst; 502 | rewrite !SysPredefs.override_new_val 503 | | rewrite SysPredefs.override_old_val with (k:=n1) (k':=n2); 504 | auto 505 | ] 506 | | _ => progress simpl 507 | | _ => contradiction 508 | end; 509 | try solve 510 | [ eapply Hbad_nid_clock_zero; intuition auto 511 | | apply Hbncz1; auto 512 | ]. 513 | * assert (List.In n2 nids). 514 | { repeat mcase_eq in Hss; try discriminate. 515 | clear Hss IHsched. 516 | destruct (List.in_dec NId_eq_dec n2 nids) as [Hin|Hnin]; auto. 517 | exfalso. 518 | rewrite ?Bool.andb_true_iff, ?Bool.orb_true_iff in H1. 519 | autorewrite with nat in H1. 520 | specialize (Hbad_nid_clock_zero n1 n2). 521 | rewrite H in Hbad_nid_clock_zero. 522 | rewrite H0 in Hbad_nid_clock_zero. 523 | simpl in Hbad_nid_clock_zero. 524 | destruct H1 as [[[??]?]?]. 525 | rewrite nid_in_dec_existsb in *. 526 | mcase_eq in H2; try discriminate. 527 | lapply Hbad_nid_clock_zero; clear Hbad_nid_clock_zero; 528 | [ intro Hbad_nid_clock_zero 529 | | intuition (subst; auto) ]. 530 | lapply Hbad_nid_clock_zero; clear Hbad_nid_clock_zero; auto. 531 | intros [Heq1 Heq2]; rewrite ?Heq1, ?Heq2 in *. 532 | inversion H3. 533 | } 534 | generalize (Hbad_nid_clock_zero n2); intro Hbncz2. 535 | generalize (Hbad_nid_clock_zero n1); intro Hbncz1. 536 | rewrite nid_in_dec_existsb in *; 537 | nid_cases n1; 538 | nid_cases n2; simpl in *; 539 | repeat mcase_eq in Hss; try discriminate; 540 | rewrite ?Bool.andb_true_iff, ?Bool.orb_true_iff in *; 541 | intuition auto; 542 | try discriminate; 543 | apply valid_schedule_cons; simpl; split_all; auto; 544 | eapply IHsched; eauto; intros; auto; 545 | intuition (subst; auto); try discriminate; 546 | repeat match goal with 547 | | |- context[SysPredefs.override _ ?n1 _ ?n2] => 548 | (is_var n1 || is_var n2); 549 | destruct (NId_eq_dec n1 n2); 550 | [ subst; 551 | rewrite !SysPredefs.override_new_val 552 | | rewrite SysPredefs.override_old_val with (k:=n1) (k':=n2); 553 | auto 554 | ] 555 | | _ => progress simpl 556 | | _ => contradiction 557 | end; 558 | try solve 559 | [ eapply Hbad_nid_clock_zero; intuition auto 560 | | eapply Hbncz2; intuition auto 561 | | simpl; simpl_override; eapply Hbncz1; intuition auto 562 | ]. 563 | Qed. 564 | 565 | 566 | Lemma step_fun_complete: forall s l s', 567 | step s l s' -> exists task, step_fun task s = Some (l,s'). 568 | Proof using max_nid_eq. 569 | intros s l s' Hstep. 570 | inversion Hstep; clear Hstep. 571 | * exists (SchedProc n). 572 | unfold step_fun. 573 | rewrite nids_eq in *. 574 | rewrite nid_in_dec_existsb in *. 575 | simpl. 576 | destruct (List.in_dec NId_eq_dec n SysPredefs.nids); try contradiction. 577 | simpl_override. 578 | simpl. 579 | subst u' d' r' m'. 580 | f_equal. 581 | f_equal. 582 | apply functional_extensionality; intros. 583 | case_eq (n =? x); autorewrite with nat; intros; subst; 584 | simpl_override; auto. 585 | * exists (SchedProc n). 586 | unfold step_fun, SysPredefs.init_nid in *. 587 | rewrite ?nids_eq in *. 588 | rewrite ?nid_in_dec_existsb in *. 589 | rewrite <-?max_nid in *. 590 | simpl. 591 | mcase_eq; try contradiction. 592 | simpl_override. 593 | simpl. 594 | subst n'' c'' d'' d' v s l s'. 595 | f_equal. 596 | f_equal. 597 | simpl_override. 598 | rewrite max_nid_eq. 599 | destruct Peano_dec.eq_nat_dec as [Heq | Hneq]; auto; 600 | [ rewrite Heq, Nat.eqb_refl; auto 601 | | apply Nat.eqb_neq in Hneq; rewrite Hneq 602 | ]; 603 | apply functional_extensionality; intros; 604 | case_eq (n =? x); autorewrite with nat; intros; subst; 605 | simpl_override; auto. 606 | * exists (SchedUpdate n_1 n_2). 607 | unfold step_fun, SysPredefs.init_nid in *. 608 | rewrite ?nids_eq in *. 609 | rewrite ?nid_in_dec_existsb in *. 610 | rewrite <-?max_nid in *. 611 | simpl. 612 | destruct (List.in_dec NId_eq_dec n_1 SysPredefs.nids); try contradiction. 613 | subst k v d r_1' m_1'. 614 | simpl_override. 615 | simpl. 616 | apply Nat.eqb_neq in H0; rewrite H0. 617 | case_eq (Nat.ltb (r_1 n_2) (Datatypes.length u_2)); 618 | autorewrite with nat; intro; try lia. 619 | match goal with 620 | | H: List.Forall ?f ?l |- context[List.forallb _ _] => 621 | rewrite List.Forall_forall in H; 622 | setoid_rewrite <-Nat.leb_le in H; 623 | apply <-List.forallb_forall in H; 624 | rewrite H 625 | end. 626 | simpl. 627 | simpl_override. 628 | f_equal. 629 | f_equal. 630 | apply Nat.eqb_neq in H0. 631 | rewrite override_neq with (n1:=n_1) (n2:=n_2); auto. 632 | rewrite override_eq. 633 | rewrite override_neq with (n1:=n_1) (n2:=n_2); auto. 634 | rewrite override_eq. 635 | rewrite override_neq with (n1:=n_1) (n2:=n_2); auto. 636 | * exists (SchedProc n). 637 | unfold step_fun. 638 | rewrite nids_eq in *. 639 | rewrite nid_in_dec_existsb in *. 640 | simpl. 641 | destruct (List.in_dec NId_eq_dec n SysPredefs.nids); try contradiction. 642 | simpl_override. 643 | simpl. 644 | f_equal. 645 | f_equal. 646 | apply functional_extensionality; intros. 647 | case_eq (n =? x); autorewrite with nat; intros; subst; 648 | simpl_override; auto. 649 | Qed. 650 | 651 | Lemma state_eq_override: forall s n p u d r m, 652 | s n = node_state p u d r m -> 653 | s = SysPredefs.override s n (node_state p u d r m). 654 | Proof using. 655 | intros. 656 | apply functional_extensionality; intros. 657 | case_eq (n =? x); 658 | autorewrite with nat; intros; subst; 659 | simpl_override; 660 | auto. 661 | Qed. 662 | 663 | Lemma nid_eq_equiv: forall {A} (t1 t2: A) n1 n2, 664 | (if n1 =_? n2 then t1 else t2) = (if n1 =? n2 then t1 else t2). 665 | Proof using. 666 | intros. 667 | destruct Peano_dec.eq_nat_dec as [Heq | Hneq]; subst; auto. 668 | rewrite Nat.eqb_refl; auto. 669 | apply Nat.eqb_neq in Hneq; rewrite Hneq; auto. 670 | Qed. 671 | 672 | Lemma step_fun_sound: forall task s l s', 673 | step_fun task s = Some (l,s') -> 674 | step s l s'. 675 | Proof using max_nid_eq. 676 | intros task s l s' Hstep. 677 | unfold step_fun, SysPredefs.init_nid in *. 678 | rewrite ?nids_eq in *. 679 | rewrite ?nid_in_dec_existsb in *. 680 | rewrite <-?max_nid in *. 681 | simpl. 682 | destruct task; simpl in Hstep. 683 | * case_eq (s n); intros ? ? ? ? ? Heq; rewrite Heq in *. 684 | rewrite nid_in_dec_existsb in *. 685 | destruct (List.in_dec NId_eq_dec n SysPredefs.nids); try discriminate. 686 | destruct prog0; 687 | inversion Hstep; clear Hstep; subst. 688 | - apply state_eq_override in Heq. 689 | rewrite Heq at 1. 690 | constructor; auto. 691 | - apply state_eq_override in Heq. 692 | rewrite Heq at 1. 693 | rewrite <-nid_eq_equiv in *. 694 | constructor; auto. 695 | - apply state_eq_override in Heq. 696 | rewrite Heq at 1. 697 | constructor; auto. 698 | * case_eq (s n1); intros ? ? ? ? ? Heq1; rewrite Heq1 in *. 699 | case_eq (s n2); intros ? ? ? ? ? Heq2; rewrite Heq2 in *. 700 | rewrite nid_in_dec_existsb in *. 701 | destruct (NId_eq_dec n1 n2); subst. 702 | rewrite Nat.eqb_refl in *. 703 | inversion Hstep; clear Hstep; subst. 704 | inversion Hstep; clear Hstep; subst. 705 | apply Nat.eqb_neq in n; rewrite n in *. 706 | apply Nat.eqb_neq in n. 707 | destruct (List.in_dec NId_eq_dec n1 SysPredefs.nids); try discriminate. 708 | case_eq (Nat.ltb (rec0 n2) (Datatypes.length ptrace1)); 709 | intro Hltb_eq; rewrite ?Hltb_eq in *; 710 | case_eq (List.forallb 711 | (fun pid : PutId => 712 | Nat.leb (put_id_clock pid) (rec0 (put_id_nid pid))) 713 | (t_put_dep (List.nth (rec0 n2) ptrace1 dummy_t_put))); 714 | intro Hforall_eq; rewrite ?Hforall_eq in *; 715 | simpl in *; 716 | try (inversion H0; clear H0; subst). 717 | autorewrite with nat in *. 718 | apply state_eq_override in Heq1. 719 | apply state_eq_override in Heq2. 720 | rewrite Heq2 at 1. 721 | rewrite Heq1 at 1. 722 | constructor; auto. 723 | apply List.Forall_forall. 724 | setoid_rewrite <-Nat.leb_le. 725 | apply ->List.forallb_forall. 726 | auto. 727 | Qed. 728 | 729 | Lemma step_star_not_in_nids: forall s ls s' n, 730 | step_star s ls s' -> 731 | ~List.In n nids -> 732 | prog (s n) = prog (s' n). 733 | Proof using max_nid_eq. 734 | intros. 735 | rewrite nids_eq in *. 736 | induction H using rev_step_star_ind; auto. 737 | rewrite <-IHstep_star; clear IHstep_star. 738 | inversion H; clear H; subst. 739 | * destruct (NId_eq_dec n0 n) as [Heq | Hneq]. 740 | rewrite !Heq in *. 741 | contradiction. 742 | simpl_override. 743 | reflexivity. 744 | * destruct (NId_eq_dec n0 n) as [Heq | Hneq]. 745 | rewrite !Heq in *. 746 | contradiction. 747 | simpl_override. 748 | reflexivity. 749 | * destruct (NId_eq_dec n n_1); 750 | destruct (NId_eq_dec n n_2); 751 | try subst; 752 | try contradiction; 753 | simpl_override; 754 | reflexivity. 755 | * destruct (NId_eq_dec n0 n) as [Heq | Hneq]. 756 | rewrite !Heq in *. 757 | contradiction. 758 | simpl_override. 759 | reflexivity. 760 | Qed. 761 | 762 | 763 | Lemma step_star_fun_complete: forall s ls s', 764 | step_star s ls s' -> exists sched, step_star_fun nil sched s = Some (ls,s'). 765 | Proof using max_nid_eq. 766 | intros s ls s' Hss. 767 | induction Hss using rev_step_star_ind. 768 | exists nil; reflexivity. 769 | destruct IHHss as [sched ?]. 770 | edestruct step_fun_complete as [task ?]; eauto. 771 | exists (task::sched)%list. 772 | simpl. 773 | rewrite H1. 774 | rewrite <-List.app_nil_r with (l:=[l]). 775 | change (l::ls)%list with ([l]++ls)%list. 776 | apply prefix_step_star_fun; auto. 777 | Qed. 778 | 779 | Lemma step_star_fun_sound: forall sched s ls1 ls2 s', 780 | step_star_fun ls1 sched s = Some (ls1++ls2,s')%list -> 781 | step_star s ls2 s'. 782 | Proof using max_nid_eq. 783 | intros sched s ls1 ls2 s' Hss. 784 | revert s ls1 ls2 s' Hss. 785 | induction sched; simpl; intros. 786 | inversion Hss; clear Hss; subst s'; try subst. 787 | * rewrite <- app_nil_r in H0 at 1. 788 | apply List.app_inv_head in H0; subst ls2. 789 | constructor. 790 | * case_eq (step_fun a s). 791 | intros [??] Hs; rewrite Hs in *. 792 | edestruct prefix_inv_step_star_fun as [ls3[Heq _]]; eauto. 793 | rewrite <-List.app_assoc in Heq. 794 | apply List.app_inv_head in Heq; subst ls2. 795 | rewrite List.app_assoc in Hss. 796 | apply IHsched in Hss. 797 | apply step_fun_sound in Hs. 798 | eapply step_star_end; eauto. 799 | intro Hs; rewrite Hs in *; discriminate. 800 | Qed. 801 | 802 | 803 | Fixpoint fast_check_all_schedules (nids: list SysPredefs.NId) (N: nat) s (check: State -> bool) {struct N} : bool := 804 | match N with 805 | | O => true 806 | | S N' => 807 | (* forall n1 \in proceses *) 808 | List.forallb 809 | (fun n1 => 810 | (* schedule process n1 *) 811 | match fast_step_fun (SchedProc n1) s with 812 | | Some s' => 813 | check s' && 814 | fast_check_all_schedules nids N' s' check 815 | | None => true 816 | end 817 | && 818 | (* schedule an update from n1 to any n2 \in processes *) 819 | List.forallb 820 | (fun n2 => 821 | match fast_step_fun (SchedUpdate n1 n2) s with 822 | | Some s' => 823 | check s' && 824 | fast_check_all_schedules nids N' s' check 825 | | None => true 826 | end) 827 | nids) 828 | nids 829 | end%bool%list. 830 | 831 | 832 | Fixpoint check_all_schedules' (nids: list SysPredefs.NId) (N: nat) s (check: Label -> State -> bool) {struct N} : bool := 833 | match N with 834 | | O => true 835 | | S N' => 836 | (* forall n1 \in proceses *) 837 | List.forallb 838 | (fun n1 => 839 | (* schedule process n1 *) 840 | match step_fun (SchedProc n1) s with 841 | | Some (l', s') => 842 | check l' s' && 843 | check_all_schedules' nids N' s' check 844 | | None => true 845 | end 846 | && 847 | (* schedule an update from n1 to any n2 \in processes *) 848 | List.forallb 849 | (fun n2 => 850 | match step_fun (SchedUpdate n1 n2) s with 851 | | Some (l', s') => 852 | check l' s' && 853 | check_all_schedules' nids N' s' check 854 | | None => true 855 | end) 856 | nids) 857 | nids 858 | end%bool%list. 859 | 860 | Lemma fast_check_all_schedules_correct': forall nids N s check check', 861 | fast_check_all_schedules nids N s check = true -> 862 | (forall l s, check s = true -> check' l s = true) -> 863 | check_all_schedules' nids N s check' = true. 864 | Proof using max_nid_eq. 865 | induction N; intros. 866 | * reflexivity. 867 | * unfold check_all_schedules'; fold check_all_schedules'. 868 | unfold fast_check_all_schedules in H; fold fast_check_all_schedules in H. 869 | rewrite List.forallb_forall in *. 870 | setoid_rewrite Bool.andb_true_iff. 871 | setoid_rewrite List.forallb_forall. 872 | setoid_rewrite Bool.andb_true_iff in H. 873 | setoid_rewrite List.forallb_forall in H. 874 | intros n1 Hin1. 875 | specialize (H n1 Hin1). 876 | mcase_eq. destruct p. 877 | apply fast_step_correct in H1. 878 | rewrite H1 in H. 879 | rewrite Bool.andb_true_iff in *. 880 | destruct H as [[??]?]. 881 | split_all; auto. 882 | eapply IHN; eauto. 883 | intros n2 Hin2. 884 | mcase_eq; auto. destruct p. 885 | apply fast_step_correct in H4. 886 | specialize (H3 n2 Hin2). 887 | rewrite H4 in H3. 888 | rewrite Bool.andb_true_iff in *. 889 | destruct H3. 890 | split; eauto. 891 | split; auto. 892 | intros n2 Hin2. 893 | mcase_eq; auto. destruct p. 894 | apply fast_step_correct in H2. 895 | destruct H as [_ H]. 896 | specialize (H n2 Hin2). 897 | rewrite H2 in H. 898 | rewrite Bool.andb_true_iff in *. 899 | destruct H. 900 | split; eauto. 901 | Qed. 902 | 903 | Fixpoint check_all_schedules (nids: list SysPredefs.NId) (N: nat) ls (prefix:list ScheduleTask) s (check: list Label -> State ->bool) {struct N} : bool := 904 | (match step_star_fun ls prefix s with 905 | | Some (ls', s') => 906 | (* chec the current schedule (whatever the length) *) 907 | check ls' s' && 908 | (* add a new step to the schedule *) 909 | match N with 910 | | O => true 911 | | S N' => 912 | (* forall n1 \in proceses *) 913 | List.forallb 914 | (fun n1 => 915 | (* schedule process n1 *) 916 | check_all_schedules nids N' ls' (SchedProc n1::nil) s' check && 917 | (* schedule an update from n1 to any n2 \in processes *) 918 | List.forallb 919 | (fun n2 => check_all_schedules nids N' ls' (SchedUpdate n1 n2::nil) s' check) 920 | nids 921 | ) 922 | nids 923 | end 924 | | None => true 925 | end)%bool%list. 926 | 927 | Lemma check_all_schedules'_correct_fun_equiv: forall max_steps check s, 928 | (check_all_schedules' nids max_steps s check = true 929 | <-> 930 | (forall sched task ls l s' s'', 931 | valid_schedule nids (sched++[task]) -> 932 | List.length sched < max_steps -> 933 | step_star_fun nil sched s = Some (ls,s') -> 934 | step_fun task s' = Some (l,s'') -> 935 | check l s'' = true)). 936 | Proof using max_nid_eq. 937 | split; intros. 938 | * rewrite nids_eq in *. 939 | rename H into Hperm. 940 | rename H0 into Hvalid_sched. 941 | rename H1 into Hsched_len. 942 | rename H2 into Hss. 943 | rename H3 into Hs. 944 | revert sched task ls l Hsched_len s s' s'' Hvalid_sched Hperm Hss Hs. 945 | clear max_nid_eq. 946 | induction max_steps; intros; subst. 947 | destruct sched; inversion Hsched_len. 948 | apply valid_schedule_app in Hvalid_sched. 949 | unfold check_all_schedules' in Hperm. 950 | fold check_all_schedules' in Hperm. 951 | rewrite List.forallb_forall in Hperm. 952 | setoid_rewrite Bool.andb_true_iff in Hperm. 953 | setoid_rewrite List.forallb_forall in Hperm. 954 | destruct Hvalid_sched as [Hvalid_sched Hin]. 955 | apply valid_schedule_cons in Hin; destruct Hin as [Hin _]. 956 | destruct sched as [ | task' sched ]. 957 | - simpl in Hss; inversion Hss; clear Hss; subst. 958 | destruct task as [ n1 | n1 n2 ]; 959 | [ (* SchedProc n1 *) 960 | specialize (Hperm n1 Hin); 961 | destruct Hperm as [Hcheck _]; 962 | rewrite Hs in Hcheck; 963 | apply Bool.andb_true_iff in Hcheck; tauto 964 | | (* SchedUpdate n1 n2 *) 965 | destruct Hin as [Hin1 Hin2]; 966 | specialize (Hperm n1 Hin1); 967 | destruct Hperm as [_ HcheckUpd]; 968 | specialize (HcheckUpd n2 Hin2); 969 | rewrite Hs in HcheckUpd; 970 | apply Bool.andb_true_iff in HcheckUpd; tauto 971 | ]. 972 | - simpl in Hsched_len. 973 | apply Nat.succ_lt_mono in Hsched_len. 974 | simpl in Hss. 975 | apply valid_schedule_cons in Hvalid_sched. 976 | destruct Hvalid_sched as [Hin' Hvalid_sched]. 977 | repeat mcase_eq in Hss; try congruence; subst. 978 | apply prefix_inv_step_star_fun in Hss. 979 | destruct Hss as [ls3[Heq Hss]]; subst ls. 980 | destruct task' as [ n1 | n1 n2 ]. 981 | + (* SchedProc n1 *) 982 | specialize (Hperm n1 Hin'). 983 | destruct Hperm as [Hcheck _]. 984 | rewrite H in Hcheck. 985 | apply Bool.andb_true_iff in Hcheck. 986 | destruct Hcheck as [Hcheck Hcheck_all]. 987 | eapply IHmax_steps with (s:=s0) (s':=s'); eauto. 988 | apply valid_schedule_app; split; auto. 989 | apply valid_schedule_cons; split; auto; constructor. 990 | + (* SchedUpdate n1 n2 *) 991 | destruct Hin' as [Hin1' Hin2']. 992 | specialize (Hperm n1 Hin1'). 993 | destruct Hperm as [_ HcheckUpd]. 994 | specialize (HcheckUpd n2 Hin2'). 995 | rewrite H in HcheckUpd. 996 | apply Bool.andb_true_iff in HcheckUpd. 997 | destruct HcheckUpd as [Hcheck Hcheck_all]. 998 | eapply IHmax_steps with (s:=s0) (s':=s'); eauto. 999 | apply valid_schedule_app; split; auto. 1000 | apply valid_schedule_cons; split; auto; constructor. 1001 | 1002 | * rename H into Hss. 1003 | revert s Hss. 1004 | clear max_nid_eq. 1005 | induction max_steps; intros; subst. 1006 | - reflexivity. 1007 | - unfold check_all_schedules'; fold check_all_schedules'. 1008 | rewrite List.forallb_forall. 1009 | setoid_rewrite Bool.andb_true_iff. 1010 | setoid_rewrite List.forallb_forall. 1011 | intros n1 Hin1. 1012 | split. 1013 | + mcase_eq; auto. 1014 | destruct p as [l s']. 1015 | rewrite Bool.andb_true_iff. 1016 | split. 1017 | eapply Hss with (sched:=nil) (ls:=nil); simpl; eauto. 1018 | apply valid_nid_step_fun_Proc in H. 1019 | apply valid_schedule_cons; split; auto; constructor. 1020 | lia. 1021 | eapply IHmax_steps; eauto. 1022 | intros sched task ls l' s'' s''' Hvalid_sched Hsched_len Hss' Hs''. 1023 | eapply Hss with (sched:=([SchedProc n1]++sched)%list) (ls:=([l]++ls)%list); eauto. 1024 | rewrite <-List.app_assoc. 1025 | apply valid_schedule_app; split; auto. 1026 | apply valid_schedule_cons; split; auto; constructor. 1027 | simpl; lia. 1028 | rewrite step_star_fun_app. 1029 | unfold step_star_fun; fold step_star_fun. 1030 | rewrite H. 1031 | simpl. 1032 | apply prefix_step_star_fun with (ls3:=[l]); auto. 1033 | + intros n2 Hin2. 1034 | mcase_eq; auto. 1035 | destruct p as [l s']. 1036 | rewrite Bool.andb_true_iff. 1037 | split. 1038 | eapply Hss with (sched:=nil) (ls:=nil); simpl; eauto. 1039 | apply valid_nid_step_fun_Update in H. 1040 | apply valid_schedule_cons; split; auto; constructor. 1041 | lia. 1042 | eapply IHmax_steps; eauto. 1043 | intros sched task ls l' s'' s''' Hvalid_sched Hsched_len Hss' Hs''. 1044 | eapply Hss with (sched:=([SchedUpdate n1 n2]++sched)%list) (ls:=([l]++ls)%list); eauto. 1045 | rewrite <-List.app_assoc. 1046 | apply valid_schedule_app; split; auto. 1047 | apply valid_schedule_cons; split; auto; constructor. 1048 | simpl; lia. 1049 | rewrite step_star_fun_app. 1050 | unfold step_star_fun; fold step_star_fun. 1051 | rewrite H. 1052 | simpl. 1053 | apply prefix_step_star_fun with (ls3:=[l]); auto. 1054 | Qed. 1055 | 1056 | Lemma check_all_schedules'_correct: forall max_steps check s, 1057 | check_all_schedules' nids max_steps s check = true -> 1058 | forall task sched ls l' s' s'', 1059 | valid_schedule nids (sched++[task]) -> 1060 | List.length sched < max_steps -> 1061 | step_star_fun nil sched s = Some (ls, s') -> 1062 | step_fun task s' = Some (l', s'') -> 1063 | check l' s'' = true. 1064 | Proof using max_nid_eq. 1065 | intros. 1066 | eapply check_all_schedules'_correct_fun_equiv; eauto. 1067 | Qed. 1068 | 1069 | Definition check_no_fault' (l: StepStarArgs.Label) (s: State) := 1070 | match l with 1071 | | fault_label _ => false 1072 | | _ => true 1073 | end. 1074 | 1075 | Lemma step_star_fun_cons_inv: forall sched s l ls s'', 1076 | step_star_fun nil sched s = Some (l :: ls, s'')%list -> 1077 | exists task s' sched', 1078 | sched = (task::sched')%list /\ 1079 | step_fun task s = Some (l, s') /\ 1080 | step_star_fun nil sched' s' = Some (ls, s''). 1081 | Proof using. 1082 | intros. 1083 | clear max_nid_eq. 1084 | revert s l ls s'' H. 1085 | destruct sched as [ | task sched]; simpl; intros. 1086 | * inversion H; clear H; subst. 1087 | * mcase_eq as Hs in H; try discriminate. 1088 | destruct p. 1089 | apply prefix_inv_step_star_fun in H as [ls3[Heq Hss]]. 1090 | simpl in Heq. 1091 | inversion Heq; clear Heq; subst l0 ls3. 1092 | exists task; exists s0; exists sched; simpl; split_all; auto. 1093 | Qed. 1094 | 1095 | Lemma step_star_fun_app_inv: forall sched s ls1 ls2 s'', 1096 | step_star_fun nil sched s = Some (ls1 ++ ls2, s'')%list -> 1097 | exists sched1 s' sched2, 1098 | sched = (sched1 ++ sched2)%list /\ 1099 | step_star_fun nil sched1 s = Some (ls1, s') /\ 1100 | step_star_fun nil sched2 s' = Some (ls2, s''). 1101 | Proof using. 1102 | intros. 1103 | clear max_nid_eq. 1104 | revert s sched ls2 s'' H. 1105 | induction ls1; simpl; intros. 1106 | * exists nil; exists s; exists sched; simpl; split; auto. 1107 | * apply step_star_fun_cons_inv in H. 1108 | destruct H as [task[s'[sched'[Heq[Hs Hss]]]]]; subst sched. 1109 | apply IHls1 in Hss. 1110 | destruct Hss as [sched1[s'0[sched2[Heq[Hss1 Hss2]]]]]; subst sched'. 1111 | exists (task::sched1)%list; exists s'0; exists sched2; simpl; split_all; auto. 1112 | rewrite Hs. 1113 | apply prefix_step_star_fun with (ls3:=[a]); auto. 1114 | Qed. 1115 | 1116 | Lemma prove_no_fault': forall program h s n run_steps, 1117 | StepStar.step_star (init program) h s -> 1118 | (forall sched_length, 1119 | check_all_schedules' nids (run_steps + sched_length) 1120 | (init program) check_no_fault' = true) -> 1121 | (forall l, List.In l h -> l <> fault_label n). 1122 | Proof using max_nid_eq. 1123 | intros program h s n run_steps Hss Hcheck_scheds. 1124 | generalize (step_star_not_in_nids _ _ _ n Hss); 1125 | intro Hnot_nids_eq. 1126 | apply step_star_fun_complete in Hss. 1127 | destruct Hss as [sched Hss]. 1128 | intros l Hin. 1129 | apply List.in_split in Hin. 1130 | destruct Hin as [h1[h2 Heq]]; subst h. 1131 | apply step_star_fun_app_inv in Hss. 1132 | destruct Hss as [sched1[s'[sched2'[Heq[Hss1 Hss2]]]]]; subst sched. 1133 | apply step_star_fun_cons_inv in Hss2. 1134 | destruct Hss2 as [task[s''[sched2[Heq[Hs Hss2]]]]]; subst sched2'. 1135 | eapply check_all_schedules'_correct 1136 | with (check:=check_no_fault') (max_steps:= run_steps + (S (List.length sched1))) 1137 | in Hss1; eauto. 1138 | * unfold check_no_fault' in Hss1. 1139 | destruct l; try discriminate. 1140 | * eapply valid_schedule_step_star_fun 1141 | with (ls1:=nil) (sched:=(sched1++[task])%list) (prog0:=program); eauto. 1142 | rewrite step_star_fun_app, Hss1. 1143 | simpl; rewrite Hs; reflexivity. 1144 | * lia. 1145 | Qed. 1146 | 1147 | Definition check_no_fault'' nids (s: State) := 1148 | List.forallb 1149 | (fun n => 1150 | match prog (s n) with 1151 | | KVStore.fault _ => false 1152 | | _ => true 1153 | end) 1154 | nids%bool. 1155 | 1156 | Lemma step_label_check_no_fault'': forall task s l s' n, 1157 | step_fun task s = Some (l, s') -> 1158 | check_no_fault'' nids s = true -> 1159 | l <> fault_label n. 1160 | Proof using. 1161 | unfold step_fun, check_no_fault''; intros. 1162 | clear max_nid_eq. 1163 | repeat ( 1164 | mcase_eq in H; 1165 | repeat match goal with 1166 | | H: Some _ = Some _ |- _ => inversion H; clear H; subst 1167 | | _ => rewrite nid_in_dec_existsb in * 1168 | | _ => discriminate 1169 | end). 1170 | rewrite List.forallb_forall in H0. 1171 | specialize (H0 n0 i). 1172 | rewrite H3 in H0. 1173 | simpl in H0. 1174 | discriminate. 1175 | Qed. 1176 | 1177 | 1178 | Lemma fast_prove_no_fault: forall program h s n run_steps, 1179 | StepStar.step_star (init program) h s -> 1180 | (forall n, program n <> fault) -> 1181 | (forall sched_length, 1182 | fast_check_all_schedules nids (run_steps + sched_length) 1183 | (init program) (check_no_fault'' nids) = true) -> 1184 | (forall l, List.In l h -> l <> fault_label n). 1185 | Proof using max_nid_eq. 1186 | intros program h s n run_steps Hss Hinit_no_fault Hcheck_scheds. 1187 | intros l Hin. 1188 | generalize (step_star_not_in_nids _ _ _ n Hss); 1189 | intro Hnot_nids_eq. 1190 | apply step_star_fun_complete in Hss. 1191 | destruct Hss as [sched Hss]. 1192 | apply List.in_split in Hin. 1193 | destruct Hin as [h1[h2 Heq]]; subst h. 1194 | apply step_star_fun_app_inv in Hss. 1195 | destruct Hss as [sched1[s'[sched2'[Heq[Hss1 Hss2]]]]]; subst sched. 1196 | apply step_star_fun_cons_inv in Hss2. 1197 | destruct Hss2 as [task[s''[sched2[Heq[Hs _]]]]]; subst sched2'. 1198 | eapply step_label_check_no_fault''; eauto. 1199 | clear task Hs. 1200 | destruct (list_end _ sched1) as [Heq | [sched[task Heq]]]; subst sched1. 1201 | * simpl in Hss1. 1202 | inversion Hss1; clear Hss1. 1203 | unfold check_no_fault''. 1204 | apply List.forallb_forall. 1205 | intros n1 Hin1. 1206 | simpl. 1207 | mcase_eq; auto. 1208 | exfalso. 1209 | eapply Hinit_no_fault; eauto. 1210 | * rewrite step_star_fun_app in Hss1. 1211 | mcase_eq as Hss in Hss1; try discriminate. 1212 | destruct p. 1213 | simpl in Hss1. 1214 | mcase_eq as Hs in Hss1; try discriminate. 1215 | destruct p. 1216 | inversion Hss1; clear Hss1; subst h1 s1. 1217 | eapply check_all_schedules'_correct 1218 | with (check:=fun l s => check_no_fault'' nids s) (max_steps:= run_steps + (S (List.length sched))) 1219 | (sched:=sched) (task:=task) (s':=s0); 1220 | eauto. 1221 | - eapply fast_check_all_schedules_correct'; eauto. 1222 | - eapply valid_schedule_step_star_fun 1223 | with (ls1:=nil) (sched:=(sched++[task])%list) (prog0:=program); eauto. 1224 | rewrite step_star_fun_app, Hss. 1225 | simpl; rewrite Hs; reflexivity. 1226 | - lia. 1227 | Qed. 1228 | 1229 | Lemma check_all_schedules_correct_fun_equiv: forall max_steps ls1 sched1 check s, 1230 | (check_all_schedules nids max_steps ls1 sched1 s check = true 1231 | <-> 1232 | (forall sched2 ls s', 1233 | valid_schedule nids sched2 -> 1234 | List.length sched2 <= max_steps -> 1235 | step_star_fun ls1 (sched1 ++ sched2)%list s = Some (ls,s') -> 1236 | check ls s' = true)). 1237 | Proof using max_nid_eq. 1238 | split; intros. 1239 | rewrite nids_eq in *. 1240 | * rename H0 into Hvalid_sched. 1241 | rename H into Hperm. 1242 | rename H1 into Hsched_len. 1243 | rename H2 into Hss. 1244 | revert ls1 sched2 Hsched_len sched1 s s' Hvalid_sched Hperm Hss. 1245 | induction max_steps; simpl; intros. 1246 | - destruct sched2; inversion Hsched_len. 1247 | rewrite List.app_nil_r in *. 1248 | rewrite Hss in Hperm. 1249 | rewrite !Bool.andb_true_iff in *. 1250 | apply Hperm. 1251 | - repeat mcase_eq in Hperm. 1252 | rewrite !Bool.andb_true_iff in *. 1253 | destruct Hperm as [Heq Hperm]. 1254 | rewrite List.forallb_forall in Hperm. 1255 | setoid_rewrite Bool.andb_true_iff in Hperm. 1256 | setoid_rewrite List.forallb_forall in Hperm. 1257 | destruct sched2 as [ | [ n1 | n1 n2 ] sched2 ]. 1258 | + rewrite List.app_nil_r in *; intuition auto. 1259 | rewrite H in Hss; inversion Hss; clear Hss; auto. 1260 | rewrite <- H2. 1261 | rewrite <- H3. 1262 | assumption. 1263 | + simpl in Hsched_len; apply le_S_n in Hsched_len. 1264 | apply valid_schedule_cons in Hvalid_sched. 1265 | rewrite step_star_fun_app, H in Hss. 1266 | destruct Hvalid_sched as [Hin Hvalid_sched]. 1267 | simpl in Hin. 1268 | rewrite <-nids_eq in *. 1269 | eapply IHmax_steps with (s:=s0) (sched1:=[SchedProc n1]%list) (sched2:=sched2); auto. 1270 | eapply Hperm; eauto. 1271 | intuition (subst; eauto). 1272 | + simpl in Hsched_len; apply le_S_n in Hsched_len. 1273 | apply valid_schedule_cons in Hvalid_sched. 1274 | rewrite step_star_fun_app, H in Hss. 1275 | destruct Hvalid_sched as [Hin Hvalid_sched]. 1276 | simpl in Hin. 1277 | eapply IHmax_steps with (sched1:=[SchedUpdate n1 n2]%list); eauto. 1278 | eapply Hperm; apply Hin. 1279 | + rewrite step_star_fun_app, H in Hss; discriminate. 1280 | * rename H into Hss. 1281 | revert ls1 sched1 s Hss. 1282 | clear max_nid_eq. 1283 | induction max_steps; simpl; intros; subst. 1284 | - repeat mcase_eq; subst; auto. 1285 | rewrite Bool.andb_true_r; auto. 1286 | apply (Hss nil); simpl; auto. 1287 | constructor. 1288 | rewrite List.app_nil_r; auto. 1289 | - repeat mcase_eq; subst; auto. 1290 | rewrite !Bool.andb_true_iff in *. 1291 | rewrite List.forallb_forall. 1292 | setoid_rewrite Bool.andb_true_iff. 1293 | setoid_rewrite List.forallb_forall. 1294 | split; intros; split_all; intros; 1295 | try match goal with 1296 | | Hss: context[_ -> check _ _ = true], 1297 | IH: context[check_all_schedules _ _ _ _ _ _ = true] 1298 | |- check_all_schedules _ _ _ _ _ _ = true => 1299 | eapply IHmax_steps; 1300 | repeat match goal with |- _->?a => fail 1 | |- forall _:_, _ => intro end; 1301 | intros; 1302 | eapply (Hss (_::_)%list); simpl; 1303 | [ | | rewrite step_star_fun_app, H; eauto]; 1304 | [ eapply valid_schedule_cons; split; auto; simpl; auto 1305 | | lia 1306 | ] 1307 | | |- true = true => reflexivity 1308 | end. 1309 | apply (Hss nil); simpl. 1310 | constructor. 1311 | lia. 1312 | rewrite List.app_nil_r; auto. 1313 | Qed. 1314 | 1315 | Lemma check_all_schedules_correct: forall max_steps ls1 sched1 sched2 check s ls' s', 1316 | valid_schedule nids sched2 -> 1317 | List.length sched2 <= max_steps -> 1318 | step_star_fun ls1 (sched1 ++ sched2)%list s = Some (ls', s') -> 1319 | check_all_schedules nids max_steps ls1 sched1 s check = true -> 1320 | check ls' s' = true. 1321 | Proof using max_nid_eq. 1322 | intros. 1323 | eapply check_all_schedules_correct_fun_equiv; eauto. 1324 | Qed. 1325 | 1326 | Definition check_no_fault nids (ls: list StepStarArgs.Label) (s: State) := 1327 | (List.forallb 1328 | (fun l => 1329 | match l with 1330 | | fault_label _ => false 1331 | | _ => true 1332 | end) 1333 | ls && 1334 | List.forallb 1335 | (fun n => 1336 | match prog (s n) with 1337 | | KVStore.fault _ => false 1338 | | _ => true 1339 | end) 1340 | nids)%bool. 1341 | 1342 | Lemma prove_no_fault: forall program h s n run_steps, 1343 | StepStar.step_star (init program) h s -> 1344 | (forall n, 1345 | ~List.In n nids -> 1346 | program n <> fault) -> 1347 | (forall sched_length, 1348 | check_all_schedules nids (run_steps + sched_length) nil 1349 | nil (init program) (check_no_fault nids) = true) -> 1350 | AbsExec.prog (s n) <> fault /\ (forall l, List.In l h -> l <> fault_label n). 1351 | Proof using max_nid_eq. 1352 | intros program h s n run_steps Hss Hnot_nit_no_fault Hcheck_scheds. 1353 | generalize (step_star_not_in_nids _ _ _ n Hss); 1354 | intro Hnot_nids_eq. 1355 | apply step_star_fun_complete in Hss. 1356 | destruct Hss as [sched Hss]. 1357 | eapply check_all_schedules_correct 1358 | with (sched1:=nil) (check:=check_no_fault nids) (max_steps:= run_steps + List.length sched) 1359 | in Hss. 1360 | * unfold check_no_fault in Hss. 1361 | apply Bool.andb_true_iff in Hss. 1362 | destruct Hss as [Hno_fault_label Hnot_fault]. 1363 | simpl in *. 1364 | rewrite List.forallb_forall in *. 1365 | specialize (Hnot_nit_no_fault n). 1366 | specialize (Hnot_fault n). 1367 | nid_cases n; 1368 | (split; 1369 | [ intro HH; 1370 | try solve 1371 | [ rewrite HH in Hnot_fault; 1372 | simpl in Hnot_fault; 1373 | rewrite ?Bool.andb_false_r in Hnot_fault; 1374 | discriminate 1375 | ] 1376 | | intros l Hin2; 1377 | specialize (Hno_fault_label l Hin2); 1378 | destruct l; try discriminate 1379 | ]). 1380 | clear max_nid_eq. 1381 | destruct (List.in_dec NId_eq_dec n nids) as [Hin | Hnin]. 1382 | - specialize (Hnot_fault Hin). 1383 | rewrite HH in Hnot_fault. 1384 | simpl in Hnot_fault. 1385 | rewrite ?Bool.andb_false_r in Hnot_fault. 1386 | discriminate. 1387 | - rewrite <-Hnot_nids_eq in HH; simpl in *; auto. 1388 | intuition (subst; auto). 1389 | * eapply valid_schedule_step_star_fun; eauto. 1390 | * lia. 1391 | * eapply Hcheck_scheds. 1392 | Qed. 1393 | 1394 | 1395 | End A. 1396 | 1397 | Ltac fast_casually_content max_nid max_nid_eq steps:= 1398 | match goal with 1399 | |- ?CausallyContent ?prog => 1400 | hnf; intros; 1401 | eapply (@fast_prove_no_fault max_nid max_nid_eq) with (run_steps:= steps) (program:=prog); 1402 | [ solve[eauto] 1403 | | let n':= fresh "n" in let Hnin:= fresh "Hin" in 1404 | intros n' Hin; 1405 | try abstract ( 1406 | let x:= eval compute in max_nid in 1407 | (do_ x try (destruct n' as [ | n'])); 1408 | simpl; discriminate 1409 | ) 1410 | | vm_compute; reflexivity 1411 | | auto 1412 | ] 1413 | end. 1414 | 1415 | Ltac casually_content max_nid max_nid_eq steps:= 1416 | match goal with 1417 | |- ?CausallyContent ?prog => 1418 | hnf; intros; 1419 | eapply (@prove_no_fault max_nid max_nid_eq) with (run_steps:= steps) (program:=prog); 1420 | [ solve[eauto] 1421 | | let n':= fresh "n" in let Hnin:= fresh "Hin" in 1422 | intros n' Hin; 1423 | try abstract ( 1424 | let x:= eval compute in max_nid in 1425 | (do_ x try (destruct n' as [ | n'])); 1426 | simpl; discriminate 1427 | ) 1428 | | vm_compute; reflexivity 1429 | | auto 1430 | ] 1431 | end. 1432 | 1433 | Ltac casually_content' max_nid max_nid_eq steps:= 1434 | match goal with 1435 | |- ?CausallyContent ?prog => 1436 | hnf; intros; 1437 | eapply (@prove_no_fault' max_nid max_nid_eq) with (run_steps:= steps) (program:=prog); 1438 | [ solve[eauto] 1439 | | vm_compute; reflexivity 1440 | | auto 1441 | ] 1442 | end. 1443 | 1444 | 1445 | End ReflAbsSem. 1446 | -------------------------------------------------------------------------------- /theories/Lib/Predefs.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import Bool Arith Arith.Peano_dec Arith.Compare_dec List. 2 | 3 | Import ListNotations. 4 | 5 | Notation "a =_? b" := (eq_nat_dec a b) (at level 20). 6 | Notation "a <>_? b" := (negb (a =_? b)) (at level 20). 7 | Notation "a <_? b" := (lt_dec a b) (at level 20). 8 | Notation "a <=_? b" := (le_dec a b) (at level 20). 9 | Notation "a >_? b" := (gt_dec a b) (at level 20). 10 | Notation "a >=_? b" := (ge_dec a b) (at level 20). 11 | 12 | Notation "a <>? b" := (negb (Nat.eqb a b)) (at level 70). 13 | Notation "a =? b" := (Nat.eqb a b) (at level 70). 14 | Notation "a <=? b" := (leb a b) (at level 70). 15 | 16 | (* 17 | Programming bools 18 | && || =? <>? <=? 19 | ---- 20 | andb_prop 21 | orb_prop 22 | beq_nat_true_iff beq_nat_false_iff 23 | leb_iff 24 | negb_true_iff negb_false_iff 25 | *) 26 | 27 | Lemma eq_nat_dec_eq: 28 | forall (A: Type) n (s1 s2: A), 29 | (if eq_nat_dec n n then s1 else s2) = 30 | s1. 31 | Proof. 32 | intros. 33 | destruct (eq_nat_dec n n). 34 | reflexivity. 35 | 36 | exfalso. apply n0. reflexivity. 37 | Qed. 38 | 39 | Lemma eq_nat_dec_neq: 40 | forall (A: Type) n n' (s1 s2: A), 41 | (not (n = n')) 42 | -> (if eq_nat_dec n n' then s1 else s2) = 43 | s2. 44 | Proof. 45 | intros. 46 | 47 | destruct (eq_nat_dec n n'). 48 | exfalso. apply H in e. assumption. 49 | 50 | reflexivity. 51 | Qed. 52 | 53 | Lemma fold_left_and_false: 54 | forall (A: Type) ls (f: A -> bool), 55 | fold_left (fun b l => b && f l) ls false = false. 56 | Proof. 57 | intros. 58 | induction ls. 59 | simpl. 60 | reflexivity. 61 | simpl. 62 | assumption. 63 | Qed. 64 | 65 | Lemma fold_left_and: 66 | forall (A: Type) ls (l: A) f, 67 | (fold_left (fun b l => b && f l) ls true = true 68 | /\ In l ls) 69 | -> f l = true. 70 | Proof. 71 | intros. 72 | destruct H. 73 | generalize dependent l. 74 | generalize dependent f. 75 | induction ls. 76 | 77 | intros. unfold In in H0. contradiction. 78 | 79 | intros. 80 | apply in_inv in H0. 81 | destruct H0. 82 | 83 | subst a. 84 | simpl in H. 85 | destruct (f l). 86 | reflexivity. 87 | simpl in H. 88 | rewrite fold_left_and_false in H. 89 | assumption. 90 | 91 | apply IHls. 92 | simpl in H. 93 | destruct (f a). 94 | assumption. 95 | rewrite fold_left_and_false in H. 96 | inversion H. 97 | assumption. 98 | Qed. 99 | 100 | Theorem call: 101 | forall {A B : Type} {f g: A -> B} (x: A), 102 | f = g -> f x = g x. 103 | Proof. 104 | intros. 105 | rewrite H. 106 | reflexivity. 107 | Qed. 108 | 109 | Theorem f_equal : forall (A B : Type) (f: A -> B) (x y: A), 110 | x = y -> f x = f y. 111 | Proof. 112 | intros A B f x y eq. rewrite eq. reflexivity. 113 | Qed. 114 | 115 | Theorem f2_equal : forall (A B C: Type) (f: A -> B -> C) (x1 x2: A)(y1 y2: B), 116 | (x1 = x2 /\ y1 = y2) -> f x1 y1 = f x2 y2. 117 | Proof. 118 | intros A B C f x1 x2 y1 y2 eq. destruct eq as [eq1 eq2]. rewrite eq1. rewrite eq2. reflexivity. 119 | Qed. 120 | 121 | Theorem f3_equal : forall (A B C D: Type) (f: A -> B -> C -> D) 122 | (x1 x2: A)(y1 y2: B)(z1 z2: C), 123 | (x1 = x2 /\ y1 = y2 /\ z1 = z2) -> f x1 y1 z1 = f x2 y2 z2. 124 | Proof. 125 | intros A B C D f x1 x2 y1 y2 z1 z2 eq. 126 | destruct eq as [eq1 [eq2 eq3]]. 127 | rewrite eq1. 128 | rewrite eq2. 129 | rewrite eq3. 130 | reflexivity. 131 | Qed. 132 | 133 | Definition nat_dec (n: nat): {n' | n = S n'} + {n = 0}. 134 | destruct n; eauto. 135 | Defined. 136 | 137 | Definition option_dec {A}(n: option A): {n' | n = Some n'} + {n = None}. 138 | destruct n; eauto. 139 | Defined. 140 | 141 | (* ------------------------------------------------------- *) 142 | (* General tactics. *) 143 | 144 | Tactic Notation "open_conjs" := 145 | repeat(match goal with 146 | | [ H : _ /\ _ |- _ ] => destruct H 147 | end). 148 | 149 | Tactic Notation "split_all" := 150 | repeat(match goal with 151 | | [ |- _ /\ _ ] => split 152 | end). 153 | 154 | 155 | Ltac specex H := 156 | repeat match type of H with 157 | | forall x : ?T, _ => 158 | match type of T with 159 | | Prop => 160 | fail 1 161 | | _ => 162 | let x := fresh "x" in 163 | evar (x : T); 164 | let x' := eval unfold x in x in 165 | clear x; specialize (H x') 166 | end 167 | end. 168 | 169 | Ltac depremise H := 170 | match type of H with 171 | | forall x : ?T, _ => 172 | let x := fresh "x" in 173 | assert (x: T); 174 | [ clear H | specialize (H x); clear x ] 175 | end. 176 | 177 | Ltac specex_deprem H := 178 | specex H; depremise H. 179 | 180 | Ltac subv x := 181 | match goal with 182 | | H: x = _ |- _ => rewrite H; simpl 183 | | H: _ = x |- _ => rewrite <- H; simpl 184 | | _ => try unfold x; simpl 185 | end. 186 | 187 | Ltac subv_in x H' := 188 | match goal with 189 | | H: x = _ |- _ => rewrite H in H'; simpl in H' 190 | | H: _ = x |- _ => rewrite <- H in H'; simpl in H' 191 | | _ => try unfold x in H'; simpl in H' 192 | end. 193 | 194 | Tactic Notation "rewrite_clear" ident(H) ident(H') := 195 | rewrite H in H'; clear H. 196 | 197 | Tactic Notation "r_rewrite_clear" ident(H) ident(H') := 198 | rewrite <- H in H'; clear H. 199 | 200 | Tactic Notation "bool_to_prop" := 201 | try match goal with 202 | | [ |- negb _ = true ] => try apply negb_true_iff 203 | | [ |- negb _ = false ] => try apply negb_false_iff 204 | end; 205 | (apply andb_prop || 206 | apply orb_prop || 207 | apply Nat.eqb_eq || 208 | apply Nat.eqb_neq || 209 | apply leb_iff). 210 | 211 | Tactic Notation "bool_to_prop_in" ident(H) := 212 | try match goal with 213 | | [ H: negb _ = true |- _ ] => try apply negb_true_iff in H 214 | | [ H: negb _ = false |- _ ] => try apply negb_false_iff in H 215 | end; 216 | (apply andb_prop in H || 217 | apply orb_prop in H || 218 | apply Nat.eqb_eq in H || 219 | apply Nat.eqb_neq in H || 220 | apply leb_iff in H). 221 | 222 | (* ------------------------------------------------------- *) 223 | (* list set lemmas *) 224 | 225 | Lemma nil_cons_end: 226 | forall (T: Type)(l: list T)(e: T), 227 | not((l++[e]) = nil). 228 | Proof. 229 | intros. 230 | intro. 231 | destruct l. 232 | 233 | rewrite app_nil_l in H. 234 | assert (A := @nil_cons T e nil). 235 | symmetry in H. 236 | apply A in H. 237 | assumption. 238 | 239 | rewrite <- app_comm_cons in H. 240 | assert (A := @nil_cons T t (l ++ [e])). 241 | symmetry in H. 242 | apply A in H. 243 | assumption. 244 | Qed. 245 | 246 | Lemma list_end : forall (T: Type)(l: list T), 247 | l = nil \/ exists l' e, l = l' ++ [e]. 248 | Proof. 249 | intros. 250 | destruct l. 251 | 252 | left. reflexivity. 253 | 254 | right. 255 | assert (A1 := @nil_cons T t l). 256 | apply not_eq_sym in A1. 257 | 258 | assert (A2 := @exists_last T (t :: l) A1). 259 | destruct A2. destruct s. 260 | exists x. exists x0. 261 | assumption. 262 | Qed. 263 | 264 | Lemma cons_to_app: 265 | forall {T: Type}(ls: list T)(e: T), 266 | e :: ls = [e] ++ ls. 267 | Proof. 268 | intros. 269 | assert (A := app_nil_l ls). 270 | rewrite <- A at 1. 271 | rewrite app_comm_cons. 272 | reflexivity. 273 | Qed. 274 | 275 | Lemma filter_filter: 276 | forall A (f g: A->bool) l, 277 | filter f (filter g l) = filter (fun x => (andb (f x) (g x))) l. 278 | Proof. 279 | intros. 280 | induction l. 281 | reflexivity. 282 | 283 | unfold filter at 2 3. 284 | (* unfold compose. *) 285 | destruct (g a); simpl; destruct (f a); 286 | 287 | simpl; 288 | try apply f_equal; 289 | unfold filter in IHl at 2 3; 290 | rewrite IHl; 291 | reflexivity. 292 | Qed. 293 | 294 | Lemma nodup_filter: 295 | forall A (l: list A) f, 296 | NoDup l -> NoDup (filter f l). 297 | Proof. 298 | intros. 299 | induction l. 300 | 301 | simpl. constructor. 302 | 303 | simpl. 304 | inversion H. 305 | subst. 306 | destruct (f a). 307 | depremise IHl. assumption. 308 | constructor. 309 | intro. apply filter_In in H0. destruct H0. contradiction. 310 | assumption. 311 | 312 | apply IHl. assumption. 313 | Qed. 314 | -------------------------------------------------------------------------------- /theories/Lib/extralib.v: -------------------------------------------------------------------------------- 1 | From Coq Require Import List Permutation. 2 | 3 | Set Implicit Arguments. 4 | 5 | (* ****************************************************************************** *) 6 | (* Adapted from "A Formalization of Relaxed Separation Logic" by Viktor Vafeiadis *) 7 | (* ****************************************************************************** *) 8 | 9 | Definition disjoint A (l1 l2 : list A) := 10 | forall a (IN1: In a l1) (IN2: In a l2), False. 11 | 12 | Lemma In_mapI : forall A B (f: A -> B) x l (IN: In x l), In (f x) (map f l). 13 | Proof. 14 | induction l; simpl; intros; auto. 15 | case IN; intros. 16 | - rewrite H. 17 | left; auto. 18 | - right. 19 | apply IHl; auto. 20 | Qed. 21 | 22 | Lemma In_mapD : 23 | forall A B (f: A->B) y l, In y (map f l) -> exists x, f x = y /\ In x l. 24 | Proof. 25 | induction l; simpl in *; intuition; eauto. 26 | destruct H; destruct H. 27 | eauto. 28 | Qed. 29 | 30 | Lemma In_map : 31 | forall A B (f: A->B) y l, In y (map f l) <-> exists x, f x = y /\ In x l. 32 | Proof. 33 | split; intros. 34 | - apply In_mapD; auto. 35 | - destruct H; destruct H. 36 | rewrite <- H. 37 | eapply In_mapI in H0; eauto. 38 | Qed. 39 | 40 | Lemma nodup_map: 41 | forall (A B: Type) (f: A -> B) (l: list A), 42 | NoDup l -> 43 | (forall x y, In x l -> In y l -> x <> y -> f x <> f y) -> 44 | NoDup (map f l). 45 | Proof. 46 | induction l; simpl; intros; [constructor|]. 47 | inversion H; subst. 48 | constructor; eauto. 49 | intro; rewrite In_map in *. 50 | destruct H1; destruct H1. 51 | edestruct H0; try eapply H1; eauto. 52 | intro. 53 | contradict H3. 54 | rewrite <- H5. 55 | auto. 56 | Qed. 57 | 58 | Lemma nodup_cons A (x: A) l: 59 | NoDup (x :: l) <-> ~ In x l /\ NoDup l. 60 | Proof. 61 | split; intros; inversion H; auto. 62 | apply NoDup_cons; auto. 63 | Qed. 64 | 65 | Lemma In_appI1 : forall A (x:A) l (IN: In x l) l', In x (l++l'). 66 | Proof. 67 | induction l; intros; inversion IN. 68 | - left; auto. 69 | - right. 70 | apply IHl; auto. 71 | Qed. 72 | 73 | Lemma In_appI2 : forall A (x:A) l' (IN: In x l') l, In x (l++l'). 74 | Proof. 75 | induction l; intros; auto. 76 | right; auto. 77 | Qed. 78 | 79 | Lemma In_app : forall A (x:A) l l', In x (l++l') <-> In x l \/ In x l'. 80 | Proof. intuition auto with datatypes; auto using In_appI1, In_appI2. Qed. 81 | 82 | Lemma nodup_app: 83 | forall (A: Type) (l1 l2: list A), 84 | NoDup (l1 ++ l2) <-> 85 | NoDup l1 /\ NoDup l2 /\ disjoint l1 l2. 86 | Proof. 87 | induction l1; intros. 88 | - split. 89 | * simpl; split; auto using NoDup_nil. 90 | split; auto. 91 | unfold disjoint; intuition. 92 | * simpl; intros. 93 | destruct H. 94 | destruct H0. 95 | assumption. 96 | - simpl. 97 | rewrite nodup_cons. 98 | rewrite IHl1. 99 | rewrite In_app. 100 | unfold disjoint. 101 | split; intuition (subst; eauto). 102 | * apply NoDup_cons; auto. 103 | * inversion IN1; subst; auto. 104 | eauto. 105 | * inversion H0; subst; auto. 106 | * inversion H0; subst. 107 | specialize (H2 a). 108 | apply H2; auto. 109 | left; auto. 110 | * inversion H0; auto. 111 | * specialize (H2 a0). 112 | apply H2; auto. 113 | right; auto. 114 | Qed. 115 | 116 | Lemma In_filter : 117 | forall (A : Type) (x:A) f l, In x (filter f l) <-> In x l /\ f x = true. 118 | Proof. 119 | induction l; intros; simpl. 120 | - split; auto; intros. 121 | destruct H; auto. 122 | - destruct (f a) eqn:?. 123 | * simpl; split; intros; intuition (subst; eauto). 124 | * split; intros; intuition eauto; congruence. 125 | Qed. 126 | 127 | Lemma NoDup_filter A (l: list A) (ND: NoDup l) f : NoDup (filter f l). 128 | Proof. 129 | induction l; intros; try constructor. 130 | simpl. 131 | destruct (f a) eqn:?; simpl; inversion ND; subst; auto. 132 | apply NoDup_cons; auto. 133 | rewrite In_filter. 134 | tauto. 135 | Qed. 136 | -------------------------------------------------------------------------------- /theories/dune: -------------------------------------------------------------------------------- 1 | (coq.theory 2 | (name Chapar) 3 | (package coq-chapar) 4 | (synopsis "A framework for verification of causal consistency for distributed key-value stores and their clients in Coq")) 5 | 6 | (include_subdirs qualified) 7 | --------------------------------------------------------------------------------