├── .gitignore ├── .gitmodules ├── README.md ├── pset01_ProgramAnalysis ├── Makefile ├── Pset1Implementation.v ├── Pset1Signature.v ├── Tips.v └── _CoqProject ├── pset02_BinomialCoefficients ├── Makefile ├── Pset2.v ├── Pset2Sig.v ├── Tips.v └── _CoqProject ├── pset03_ContainersAndHOFs ├── Makefile ├── Pset3.v ├── Pset3Sig.v └── _CoqProject ├── pset04_BSTs ├── Makefile ├── Pset4.v ├── Pset4Sig.v ├── _CoqProject ├── image-credit.txt ├── rotation1.svg └── rotation2.svg ├── pset05_BigStepVsInterpreter ├── Makefile ├── Pset5.v ├── Pset5Sig.v └── _CoqProject ├── pset06_ProgramTransformations ├── Hints.v ├── Makefile ├── Pset6.v ├── Pset6Sig.v ├── _CoqProject ├── collatz1.c └── collatz2.c ├── pset07_Subtyping ├── Makefile ├── Pset7.v ├── Pset7Sig.v ├── _CoqProject └── hints.md ├── pset08_InformationFlow ├── Hints.v ├── Makefile ├── Pset8.v ├── Pset8Sig.v └── _CoqProject ├── pset09_HoareLogic ├── Hints.v ├── Makefile ├── Pset9.v ├── Pset9Sig.v └── _CoqProject ├── pset10_SeparationLogic ├── Makefile ├── Pset10.v ├── Pset10Sig.v └── _CoqProject ├── pset11_Deadlocks ├── Makefile ├── Pset11.v ├── Pset11Sig.v ├── _CoqProject └── hints.md └── pset12_RelyGuarantee ├── Makefile ├── Pset12.v ├── Pset12Example.v ├── Pset12Hints.md ├── Pset12Sig.v └── _CoqProject /.gitignore: -------------------------------------------------------------------------------- 1 | .*.aux 2 | .*.d 3 | *.a 4 | *.cma 5 | *.cmi 6 | *.cmo 7 | *.cmx 8 | *.cmxa 9 | *.cmxs 10 | *.glob 11 | *.ml.d 12 | *.ml4.d 13 | *.mli.d 14 | *.mllib.d 15 | *.mlpack.d 16 | *.native 17 | *.o 18 | *.v.d 19 | *.vio 20 | *.vo 21 | *.vok 22 | *.vos 23 | .coq-native/ 24 | .csdp.cache 25 | .lia.cache 26 | .nia.cache 27 | .nlia.cache 28 | .nra.cache 29 | csdp.cache 30 | lia.cache 31 | nia.cache 32 | nlia.cache 33 | nra.cache 34 | 35 | # generated timing files 36 | *.timing.diff 37 | *.v.after-timing 38 | *.v.before-timing 39 | *.v.timing 40 | time-of-build-after.log 41 | time-of-build-before.log 42 | time-of-build-both.log 43 | time-of-build-pretty.log -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "frap"] 2 | path = frap 3 | url = https://github.com/achlipala/frap.git 4 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 6.822: Formal Reasoning About Programs 2 | ====================================== 3 | 4 | Course website: https://frap.csail.mit.edu/ 5 | 6 | Use `git clone --recursive` to clone this repository. If you have already 7 | cloned it without submodules, use `git submodule init` followed by `git 8 | submodule update` to get the 6.822 Coq library in `frap/`. 9 | 10 | Each pset will appear in this repository. Pset 1 is already available in 11 | `pset01_ProgramAnalysis/`. Instructions for completing it are in 12 | `pset01_ProgramAnalysis/Pset1Signature.v`. 13 | 14 | Happy proving! 15 | -------------------------------------------------------------------------------- /pset01_ProgramAnalysis/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: coq clean 2 | 3 | COQC=coqc -q -R ../frap Frap 4 | 5 | coq: 6 | $(COQC) Pset1Signature.v 7 | $(COQC) Pset1Implementation.v 8 | 9 | clean: 10 | rm -f *.vo *.glob 11 | -------------------------------------------------------------------------------- /pset01_ProgramAnalysis/Pset1Implementation.v: -------------------------------------------------------------------------------- 1 | (** * 6.822 Formal Reasoning About Programs, Spring 2021 - Pset 1 *) 2 | 3 | (* Welcome to 6.822! Read through `Pset1Signature.v` before starting here. *) 4 | 5 | Require Import Frap Pset1Signature. 6 | 7 | Module Impl. 8 | (* The first part of this assignment involves the [bool] datatype, 9 | * which has the following definition. 10 | * << 11 | Inductive bool := 12 | | true 13 | | false. 14 | >> 15 | * We will define logical negation and conjunction of Boolean values, 16 | * and prove some properties of these definitions. 17 | *) 18 | 19 | (* Define [Neg] so that it implements Boolean negation, which flips 20 | * the truth value of a Boolean value. 21 | *) 22 | Definition Neg (b : bool) : bool. 23 | Admitted. 24 | 25 | (* For instance, the negation of [true] should be [false]. 26 | * This proof should follow from reducing both sides of the equation 27 | * and observing that they are identical. 28 | *) 29 | Theorem Neg_true : Neg true = false. 30 | Proof. 31 | Admitted. 32 | 33 | (* Negation should be involutive, meaning that if we negate 34 | * any Boolean value twice, we should get the original value back. 35 | 36 | * To prove a fact like this that holds for all Booleans, it suffices 37 | * to prove the fact for both [true] and [false] by using the 38 | * [cases] tactic. 39 | *) 40 | Theorem Neg_involutive : forall b : bool, Neg (Neg b) = b. 41 | Proof. 42 | Admitted. 43 | 44 | (* Define [And] so that it implements Boolean conjunction. That is, 45 | * the result value should be [true] exactly when both inputs 46 | * are [true]. 47 | *) 48 | Definition And (x y : bool) : bool. 49 | Admitted. 50 | 51 | (* Here are a couple of examples of how [And] should act on 52 | * concrete inputs. 53 | *) 54 | Theorem And_true_true : And true true = true. 55 | Proof. 56 | Admitted. 57 | 58 | Theorem And_false_true : And false true = false. 59 | Proof. 60 | Admitted. 61 | 62 | (* Prove that [And] is commutative, meaning that switching the order 63 | * of its arguments doesn't affect the result. 64 | *) 65 | Theorem And_comm : forall x y : bool, And x y = And y x. 66 | Proof. 67 | Admitted. 68 | 69 | (* Prove that the conjunction of a Boolean value with [true] 70 | * doesn't change that value. 71 | *) 72 | Theorem And_true_r : forall x : bool, And x true = x. 73 | Proof. 74 | Admitted. 75 | 76 | (* In the second part of this assignment, we will work with a simple language 77 | * of imperative arithmetic programs that sequentially apply operations 78 | * to a natural-number-valued state. 79 | 80 | * The [Prog] datatype defines abstract syntax trees for this language. 81 | *) 82 | 83 | Print Prog. 84 | 85 | (* Define [run] such that [run p n] gives the final state 86 | * that running the program [p] should result in, when the 87 | * initial state is [n]. 88 | *) 89 | Fixpoint run (p : Prog) (initState : nat) : nat. 90 | Admitted. 91 | 92 | Theorem run_Example1 : run Done 0 = 0. 93 | Proof. 94 | Admitted. 95 | 96 | Theorem run_Example2 : run (MulThen 5 (AddThen 2 Done)) 1 = 7. 97 | Proof. 98 | Admitted. 99 | 100 | Theorem run_Example3 : run (SetToThen 3 (MulThen 2 Done)) 10 = 6. 101 | Proof. 102 | Admitted. 103 | 104 | (* Define [numInstructions] to compute the number of instructions 105 | * in a program, not counting [Done] as an instruction. 106 | *) 107 | Fixpoint numInstructions (p : Prog) : nat. 108 | Admitted. 109 | 110 | Theorem numInstructions_Example : 111 | numInstructions (MulThen 5 (AddThen 2 Done)) = 2. 112 | Proof. 113 | Admitted. 114 | 115 | (* Define [concatProg] such that [concatProg p1 p2] is the program 116 | * that first runs [p1] and then runs [p2]. 117 | *) 118 | Fixpoint concatProg (p1 p2 : Prog) : Prog. 119 | Admitted. 120 | 121 | Theorem concatProg_Example : 122 | concatProg (AddThen 1 Done) (MulThen 2 Done) 123 | = AddThen 1 (MulThen 2 Done). 124 | Proof. 125 | Admitted. 126 | 127 | (* Prove that the number of instructions in the concatenation of 128 | * two programs is the sum of the number of instructions in each 129 | * program. 130 | *) 131 | Theorem concatProg_numInstructions 132 | : forall (p1 p2 : Prog), numInstructions (concatProg p1 p2) 133 | = numInstructions p1 + numInstructions p2. 134 | Proof. 135 | Admitted. 136 | 137 | (* Prove that running the concatenation of [p1] with [p2] is 138 | equivalent to running [p1] and then running [p2] on the 139 | result. *) 140 | Theorem concatProg_run 141 | : forall (p1 p2 : Prog) (initState : nat), 142 | run (concatProg p1 p2) initState = 143 | run p2 (run p1 initState). 144 | Proof. 145 | Admitted. 146 | 147 | (* Read this definition and understand how division by zero is handled. *) 148 | Fixpoint runPortable (p : Prog) (state : nat) : bool * nat := 149 | match p with 150 | | Done => (true, state) 151 | | AddThen n p => runPortable p (n+state) 152 | | MulThen n p => runPortable p (n*state) 153 | | DivThen n p => 154 | if n ==n 0 then (false, state) else 155 | runPortable p (state/n) 156 | | VidThen n p => 157 | if state ==n 0 then (false, 0) else 158 | runPortable p (n/state) 159 | | SetToThen n p => 160 | runPortable p n 161 | end. 162 | Arguments Nat.div : simpl never. (* you don't need to understand this line *) 163 | 164 | (* Here are a few examples: *) 165 | 166 | Definition goodProgram1 := AddThen 1 (VidThen 10 Done). 167 | Example runPortable_good : forall n, 168 | runPortable goodProgram1 n = (true, 10/(1+n)). 169 | Proof. simplify. equality. Qed. 170 | 171 | Definition badProgram1 := AddThen 0 (VidThen 10 Done). 172 | Example runPortable_bad : let n := 0 in 173 | runPortable badProgram1 n = (false, 0). 174 | Proof. simplify. equality. Qed. 175 | 176 | Definition badProgram2 := AddThen 1 (DivThen 0 Done). 177 | Example runPortable_bad2 : forall n, 178 | runPortable badProgram2 n = (false, 1+n). 179 | Proof. simplify. equality. Qed. 180 | 181 | (* Prove that running the concatenation [p] using [runPortable] 182 | coincides with using [run], as long as [runPortable] returns 183 | [true] to confirm that no divison by zero occurred. *) 184 | Lemma runPortable_run : forall p s0 s1, 185 | runPortable p s0 = (true, s1) -> run p s0 = s1. 186 | Proof. 187 | Admitted. 188 | 189 | (* The final goal of this pset is to implement [validate : Prog -> bool] 190 | such that if this function returns [true], the program would not trigger 191 | division by zero regardless of what state it starts out in. [validate] is 192 | allowed to return [false] for some perfectly good programs that never cause 193 | division by zero, but it must recognize as good the examples given below. In 194 | jargon, [validate] is required to be sound but not complete, but "complete 195 | enough" for the use cases defined by the examples given here: *) 196 | 197 | Definition goodProgram2 := AddThen 0 (MulThen 10 (AddThen 0 (DivThen 1 Done))). 198 | Definition goodProgram3 := AddThen 1 (MulThen 10 (AddThen 0 (VidThen 1 Done))). 199 | Definition goodProgram4 := Done. 200 | Definition goodProgram5 := SetToThen 0 (DivThen 1 Done). 201 | Definition goodProgram6 := SetToThen 1 (VidThen 1 Done). 202 | Definition goodProgram7 := AddThen 1 (DivThen 1 (DivThen 1 (VidThen 1 Done))). 203 | 204 | (* If you already see a way to build [validate] that meets the 205 | * requirements above, _and have a plan for how to prove it correct_, 206 | * feel free to just code away. Our solution uses one intermediate definition 207 | * and one intermediate lemma in the soundness proof -- both of which are more 208 | * sophisticated than the top-level versions given here. *) 209 | 210 | (* If a clear plan hasn't emerged in 10 minutes (or if you get stuck later), 211 | * take a look at the hints for this pset on the course web site. 212 | * It is not expected that this pset is doable for everyone without the hints, 213 | * and some planning is required to complete the proof successfully. 214 | * In particular, repeatedly trying out different combinations of tactics 215 | * and ideas from hints until something sticks can go on for arbitrarily long 216 | * with little insight and no success; just guessing a solution is unlikely. 217 | * Thus, we encourage you to take your time to think, look at the hints when 218 | * necessary, and only jump into coding when you have some idea why it should 219 | * succeed. Some may call Coq a video game, but it is not a grinding contest. *) 220 | 221 | 222 | Definition validate (p : Prog) : bool. 223 | Admitted. 224 | 225 | (* Start by making sure that your solution passes the following tests, and add 226 | * at least one of your own tests: *) 227 | 228 | Example validate1 : validate goodProgram1 = true. Admitted. 229 | Example validate2 : validate goodProgram2 = true. Admitted. 230 | Example validate3 : validate goodProgram3 = true. Admitted. 231 | Example validate4 : validate goodProgram4 = true. Admitted. 232 | Example validate5 : validate goodProgram5 = true. Admitted. 233 | Example validate6 : validate goodProgram6 = true. Admitted. 234 | Example validate7 : validate goodProgram7 = true. Admitted. 235 | Example validateb1 : validate badProgram1 = false. Admitted. 236 | Example validateb2 : validate badProgram2 = false. Admitted. 237 | 238 | (* Then, add your own example of a bad program here, and check that `validate` 239 | * returns `false` on it: *) 240 | 241 | Definition badProgram3 : Prog. Admitted. 242 | Example validateb3 : validate badProgram3 = false. Admitted. 243 | 244 | 245 | 246 | (* Finally, before diving into the Coq proof, try to convince yourself that 247 | * your code is correct by applying induction by hand. Can you describe the 248 | * high-level structure of the proof? Which cases will you have to reason 249 | * about? What do the induction hypotheses look like? Which key lemmas do 250 | * you need? Write a short (~10-20 lines) informal proof sketch before 251 | * proceeding. *) 252 | 253 | (** Proof sketch: **) 254 | (* [[Fill in your proof sketch here.]] *) 255 | 256 | (* Now you're ready to write the proof in Coq: *) 257 | 258 | Lemma validate_sound : forall p, validate p = true -> 259 | forall s, runPortable p s = (true, run p s). 260 | Admitted. 261 | 262 | (* Here is the complete list of commands used in one possible solution: 263 | - Search, for example Search (_ + 0). 264 | - induct, for example induct x 265 | - simplify 266 | - propositional 267 | - equality 268 | - linear_arithmetic 269 | - cases, for example cases (X ==n Y) 270 | - apply, for example apply H 271 | - apply in, for example apply H1 in H2 or apply somelemma in H1 272 | - apply with, for example apply H1 with (x:=2) 273 | - apply in with, for example apply H1 with (x:=2) in H2 274 | - rewrite, for example rewrite H 275 | - rewrite in, for example rewrite H1 in H2 or rewrite somelemma in H1 276 | - ;, for example simplify; propositional *) 277 | End Impl. 278 | 279 | (* The following line checks that your `Impl` module implements the right 280 | signature. Make sure that it works, or the auto-grader will break! 281 | If there are mismatches, coq will report them (`Signature components for 282 | label … do not match`): *) 283 | Module ImplCorrect : Pset1Signature.S := Impl. 284 | -------------------------------------------------------------------------------- /pset01_ProgramAnalysis/Pset1Signature.v: -------------------------------------------------------------------------------- 1 | (** * 6.822 Formal Reasoning About Programs, Spring 2021 - Pset 1 *) 2 | 3 | (* Welcome to the wonderful world of Coq programming! *) 4 | 5 | (* This pset dives straight in to building a program-analysis pass and 6 | * proving it sound in Coq. But before that, you will need to get set up 7 | * with Coq. *) 8 | 9 | (* 10 | * Start by installing the Coq system, either from your operating system's 11 | * repositories (`apt install coq`, `brew install coq`, etc.) or from the Coq 12 | * website at . For this class, you can use any 13 | * version from 8.11 to 8.13 (the latest). 14 | * 15 | * Beware: versions of Ubuntu prior to 20.04 (and Debian stable) ship outdated 16 | * Coq releases. 17 | * 18 | * Run `coqc -v` to check that the right version was installed. 19 | * 20 | * It will also be *essential* to install a UI for editing Coq proofs! The most 21 | * popular Coq IDE in the research world, which the course staff use and 22 | * recommend, is the venerable Proof General , 23 | * a package for the Emacs IDE, which can optionally be extended with 24 | * company-coq . 25 | * 26 | * If you're not ready to take the Emacs plunge (but it's worth it! We 27 | * promise!), then install one of the alternatives listed on the Coq website at 28 | * . The one called “CoqIDE” has a 29 | * the least steep learning curve, but Proof General will make you significantly 30 | * more productive after spending some practice time. 31 | * 32 | * We will have special office hours the first week of class, 33 | * to help everyone get these packages set up. 34 | * 35 | * Now, on to the actual assignment, once you have Coq and a UI installed! This 36 | * course uses a special Coq library, so we'll start by compiling that: 37 | * 38 | * Run `make -C frap lib` in the root directory of your 6.822 git clone. 39 | *) 40 | 41 | Require Import Frap. 42 | (* If this import command doesn't work, something may be wrong with the copy 43 | * of the FRAP book source that has been included as a Git submodule. 44 | * Running `git submodule init' or `git submodule update' in the repository 45 | * base directory (followed by rerunning `make -C frap lib` here) might help. 46 | *) 47 | 48 | (* The first part of this assignment involves the [bool] datatype, 49 | * which has the following definition. 50 | * << 51 | Inductive bool := 52 | | true 53 | | false. 54 | >> 55 | * We will define logical negation and conjunction of Boolean values, 56 | * and we will prove some properties of these definitions. 57 | 58 | * In the second part of this assignment, we will work with a simple language 59 | * of imperative arithmetic programs that sequentially apply operations 60 | * to a natural-number-valued state. 61 | 62 | * The file that you are currently reading contains only the *signature* of the 63 | * programs that we will implement: the module type `S` below defines the 64 | * interface of the code. 65 | 66 | * Your job is to write a module implementing this interface by fleshing out the 67 | * skeleton given in the file `Pset1Implementation.v`. For the last problem, we 68 | * also ask you to give an informal explanation of the proof in addition to the 69 | * Coq proof script. 70 | * 71 | * Your `Pset1Implementation.v` file is what you upload to the course web site 72 | * to get credit for doing the assignment. A line at the end of 73 | * `Pset1Implementation.v` (`Module Impl := …`) checks that your code conforms 74 | * to the expected signature. Make sure that the file that you submit can be 75 | * compiled and checked: use `Admitted` if you're not sure how to complete a 76 | * proof. 77 | * 78 | * Percentages in square brackets below show the approximate rubric that we will 79 | * apply. 80 | *) 81 | 82 | (* 83 | * First, here's the [Prog] datatype that defines abstract syntax trees for this 84 | * pset's language. 85 | *) 86 | 87 | Inductive Prog := 88 | | Done (* Don't modify the state. *) 89 | | AddThen (n : nat) (p : Prog) (* Add [n] to the state, then run [p]. *) 90 | | MulThen (n : nat) (p : Prog) (* Multiply the state by [n], then run [p]. *) 91 | | DivThen (n : nat) (p : Prog) (* Divide the state by [n], then run [p]. *) 92 | | VidThen (n : nat) (p : Prog) (* Divide [n] by the state, then run [p]. *) 93 | | SetToThen (n : nat) (p : Prog) (* Set the state to [n], then run [p]. *) 94 | . 95 | 96 | (* Then, here's the actual signature to implement. *) 97 | 98 | Module Type S. 99 | 100 | (* Define [Neg] so that it implements Boolean negation, which flips 101 | * the truth value of a Boolean value. 102 | *) 103 | (*[2%]*) Parameter Neg : bool -> bool. 104 | 105 | (* For instance, the negation of [true] should be [false]. 106 | * This proof should follow from reducing both sides of the equation 107 | * and observing that they are identical. 108 | *) 109 | (*[1%]*) Axiom Neg_true : Neg true = false. 110 | 111 | (* Negation should be involutive, meaning that if we negate 112 | * any Boolean value twice, we should get the original value back. 113 | 114 | * To prove a fact like this that holds for all Booleans, it suffices 115 | * to prove the fact for both [true] and [false] by using the 116 | * [cases] tactic. 117 | *) 118 | (*[4%]*) Axiom Neg_involutive : forall b : bool, Neg (Neg b) = b. 119 | 120 | (* Define [And] so that it implements Boolean conjunction. That is, 121 | * the result value should be [true] exactly when both inputs 122 | * are [true]. 123 | *) 124 | (*[3%]*) Parameter And : bool -> bool -> bool. 125 | 126 | (* Here are a couple of examples of how [And] should act on 127 | * concrete inputs. 128 | *) 129 | (*[1%]*) Axiom And_true_true : And true true = true. 130 | (*[1%]*) Axiom And_false_true : And false true = false. 131 | 132 | (* Prove that [And] is commutative, meaning that switching the order 133 | * of its arguments doesn't affect the result. 134 | *) 135 | (*[4%]*) Axiom And_comm : forall x y : bool, And x y = And y x. 136 | 137 | (* Prove that the conjunction of a Boolean value with [true] 138 | * doesn't change that value. 139 | *) 140 | (*[4%]*) Axiom And_true_r : forall x : bool, And x true = x. 141 | 142 | 143 | (* Define [run] such that [run p n] gives the final state 144 | * that running the program [p] should result in, when the 145 | * initial state is [n]. 146 | * Use the +, *, and / operators for natural numbers provided 147 | * by the Coq standard library, and for this part of the 148 | * exercise, don't worry about division by 0; doing the same 149 | * thing as division from the standard library does is fine. 150 | *) 151 | (*[3%]*) Parameter run : Prog -> nat -> nat. 152 | 153 | (*[1%]*) Axiom run_Example1 : run Done 0 = 0. 154 | (*[1%]*) Axiom run_Example2 : run (MulThen 5 (AddThen 2 Done)) 1 = 7. 155 | (*[1%]*) Axiom run_Example3 : run (SetToThen 3 (MulThen 2 Done)) 10 = 6. 156 | 157 | (* Define [numInstructions] to compute the number of instructions 158 | * in a program, not counting [Done] as an instruction. 159 | *) 160 | (*[3%]*) Parameter numInstructions : Prog -> nat. 161 | 162 | (*[1%]*) Axiom numInstructions_Example : 163 | numInstructions (MulThen 5 (AddThen 2 Done)) = 2. 164 | 165 | (* Define [concatProg] such that [concatProg p1 p2] is the program 166 | * that first runs [p1] and then runs [p2]. 167 | *) 168 | (*[3%]*) Parameter concatProg : Prog -> Prog -> Prog. 169 | 170 | (*[1%]*) Axiom concatProg_Example : 171 | concatProg (AddThen 1 Done) (MulThen 2 Done) 172 | = AddThen 1 (MulThen 2 Done). 173 | 174 | (* Prove that the number of instructions in the concatenation of 175 | * two programs is the sum of the number of instructions in each 176 | * program. 177 | *) 178 | (*[8%]*) Axiom concatProg_numInstructions : forall p1 p2, 179 | numInstructions (concatProg p1 p2) 180 | = numInstructions p1 + numInstructions p2. 181 | 182 | (* Prove that running the concatenation of [p1] with [p2] is 183 | equivalent to running [p1] and then running [p2] on the 184 | result. *) 185 | (*[8%]*) Axiom concatProg_run : forall p1 p2 initState, 186 | run (concatProg p1 p2) initState = 187 | run p2 (run p1 initState). 188 | 189 | (* As there is no intuitive or broadly useful definition for x/0, 190 | common processors handle it differently. We would like to model the 191 | portable behavior of a program, that is, its behavior to the extent 192 | it is known without relying on arbitrary choices about division by 193 | zero. The following interpreter returns (b, s), where the Boolean [b] 194 | indicates whether the execution completed without division by 195 | zero, and if it did, then [s] is the final state. First, you will be 196 | asked to prove that [s] matches [run] in those cases. *) 197 | Fixpoint runPortable (p : Prog) (state : nat) : bool * nat := 198 | match p with 199 | | Done => (true, state) 200 | | AddThen n p => runPortable p (n+state) 201 | | MulThen n p => runPortable p (n*state) 202 | | DivThen n p => 203 | if n ==n 0 then (false, state) else 204 | runPortable p (state/n) 205 | | VidThen n p => 206 | if state ==n 0 then (false, 0) else 207 | runPortable p (n/state) 208 | | SetToThen n p => 209 | runPortable p n 210 | end. 211 | 212 | (*[8%]*) Axiom runPortable_run : forall p s0 s1, 213 | runPortable p s0 = (true, s1) -> run p s0 = s1. 214 | 215 | (* Static analysis to validate that a program never divides by 0 *) 216 | 217 | (* The final goal of this pset is to implement [validate : Prog -> bool] *) 218 | (*[5%]*) Parameter validate : Prog -> bool. 219 | (* such that if this function returns [true], the program would not trigger 220 | division by zero regardless of what state it starts out in. [validate] is 221 | allowed to return [false] for some perfectly good programs that never cause 222 | a division by zero, but it must recognize as good the examples given below. 223 | In jargon, [validate] is required to be sound but not complete, but 224 | "complete enough" for the use cases defined by the examples given here. 225 | We also ask you to define one additional negative test and prove that 226 | [validate] correctly flags it. *) 227 | 228 | Definition goodProgram1 := AddThen 1 (VidThen 10 Done). 229 | Definition goodProgram2 := AddThen 0 (MulThen 10 (AddThen 0 (DivThen 1 Done))). 230 | Definition goodProgram3 := AddThen 1 (MulThen 10 (AddThen 0 (VidThen 1 Done))). 231 | Definition goodProgram4 := Done. 232 | Definition goodProgram5 := SetToThen 0 (DivThen 1 Done). 233 | Definition goodProgram6 := SetToThen 1 (VidThen 1 Done). 234 | Definition goodProgram7 := AddThen 1 (DivThen 1 (DivThen 1 (VidThen 1 Done))). 235 | (*[0.5%]*) Axiom validate1 : validate goodProgram1 = true. 236 | (*[0.5%]*) Axiom validate2 : validate goodProgram2 = true. 237 | (*[0.5%]*) Axiom validate3 : validate goodProgram3 = true. 238 | (*[0.5%]*) Axiom validate4 : validate goodProgram4 = true. 239 | (*[0.5%]*) Axiom validate5 : validate goodProgram5 = true. 240 | (*[0.5%]*) Axiom validate6 : validate goodProgram6 = true. 241 | (*[0.5%]*) Axiom validate7 : validate goodProgram7 = true. 242 | 243 | Definition badProgram1 := AddThen 0 (VidThen 10 Done). 244 | Definition badProgram2 := AddThen 1 (DivThen 0 Done). 245 | (*[0.5%]*) Axiom validateb1 : validate badProgram1 = false. 246 | (*[0.5%]*) Axiom validateb2 : validate badProgram2 = false. 247 | 248 | (*[1.5%]*) Parameter badProgram3 : Prog. 249 | (*[1%]*) Axiom validateb3 : validate badProgram3 = false. 250 | 251 | (*[10%]*) (* Informal proof sketch for `validate_sound`. *) 252 | (* Before diving into the Coq proof, try to convince yourself that your code 253 | * is correct by applying induction by hand. Can you describe the high-level 254 | * structure of the proof? Which cases will you have to reason about? What 255 | * do the induction hypotheses look like? Which key lemmas do you need? 256 | * Write a short (~10-20 lines) informal proof sketch before proceeding. *) 257 | 258 | (*[20%]*) Axiom validate_sound : forall p, validate p = true -> 259 | forall s, runPortable p s = (true, run p s). 260 | End S. 261 | 262 | (* Authors: 263 | * Peng Wang 264 | * Adam Chlipala 265 | * Joonwon Choi 266 | * Benjamin Sherman 267 | * Andres Erbsen 268 | * Clément Pit-Claudel 269 | *) 270 | -------------------------------------------------------------------------------- /pset01_ProgramAnalysis/Tips.v: -------------------------------------------------------------------------------- 1 | (*| 2 | A few things to keep in mind as you work through pset 1 3 | ======================================================= 4 | |*) 5 | 6 | Require Import Frap. 7 | 8 | (*| 9 | Coq resources 10 | ------------- 11 | 12 | - Start by looking for examples in the course textbook, including the tactic appendix at the end of the book. 13 | 14 | - For help on standard Coq tactics, consult Coq's reference manual (https://coq.inria.fr/distrib/current/refman/), starting from the indices at https://coq.inria.fr/distrib/current/refman/appendix/indexes/index.html. The manual can be overwhelming, so it's best used for looking up fine details. 15 | 16 | Useful commands 17 | --------------- 18 | 19 | Coq comes with many predefined types, functions, and theorems (“objects”). The most important commands to help you discover them are `Check`, `About`, `Print`, `Search`, and `Compute`. Try the following examples: 20 | 21 | `Check` gives the type of any term, even with holes: 22 | |*) 23 | 24 | Check (1 + _). 25 | Check (fun b => match b with true => 0 | false => 1 end). 26 | 27 | (*| 28 | `About` gives general information about an object: 29 | |*) 30 | 31 | About bool. 32 | About nat. 33 | 34 | (*| 35 | `Print` displays the definition of an object: 36 | |*) 37 | 38 | Print bool. 39 | Print Nat.add. 40 | 41 | (*| 42 | `Search` finds objects. Its syntax is very flexible: 43 | |*) 44 | 45 | (* Find functions of type [nat -> nat -> bool]. *) 46 | Search (nat -> nat -> bool). 47 | (* Find theorems about "+". *) 48 | Search "+". 49 | (* Find theorems whose statement mentions S and eq. *) 50 | Search eq S. 51 | (* Search for a lemma proving the symmetry of eq. *) 52 | Search (?x = ?y -> ?y = ?x). 53 | 54 | (*| 55 | If you are puzzled by a notation, the `Locate` command can help: 56 | |*) 57 | 58 | Locate "*". 59 | 60 | (*| 61 | To evaluate an expression, use `Compute`: 62 | |*) 63 | 64 | Compute (2 * 3, 4 + 4, 0 - 2 + 2, pred (S (S (S 0)))). 65 | 66 | (*| 67 | Syntax recap 68 | ------------ 69 | 70 | To define a function inline, use `fun`: 71 | |*) 72 | 73 | Check (fun x => x + 1). 74 | Check (fun x: bool => xorb x x). 75 | 76 | (*| 77 | To perform a case analysis on a value, use `match`: 78 | |*) 79 | 80 | Check (fun b (x y: nat) => 81 | match b with 82 | | true => x 83 | | false => y 84 | end). 85 | 86 | Check (fun (n: nat) => 87 | match n with 88 | | 0 => 1 89 | | S n => n 90 | end). 91 | 92 | (*| 93 | In Coq, `if` is just short for `match`: 94 | |*) 95 | 96 | Check (fun (b: bool) (x y: nat) => 97 | if b then x else y). 98 | 99 | (*| 100 | To define a global object, use `Definition` or `Lemma` (`Theorem` is an alias of `Lemma`): 101 | |*) 102 | 103 | Definition choose (b: bool) (x y: nat) := 104 | if b then x else y. 105 | 106 | Compute (choose true 6 822). 107 | 108 | Lemma plus_commutes : 109 | forall x, x = x + 0 + 0. 110 | Proof. 111 | intros. 112 | Search (_ + 0). 113 | rewrite <- plus_n_O. 114 | rewrite <- plus_n_O. 115 | equality. 116 | Qed. 117 | 118 | (*| 119 | Recursive functions use the keyword `Fixpoint`: 120 | |*) 121 | 122 | Fixpoint do_n_times (ntimes: nat) (step: nat -> nat) (start_from: nat) := 123 | match ntimes with 124 | | 0 => start_from 125 | | S ntimes' => step (do_n_times ntimes' step start_from) 126 | end. 127 | 128 | Compute (6, do_n_times 12 (fun x => x + 65) 42). 129 | 130 | (*| 131 | You can use bullets or braces to structure your proofs: 132 | |*) 133 | 134 | Lemma both_zero: 135 | forall x y z: nat, x + y + z = 0 -> x = 0 /\ y = 0 /\ z = 0. 136 | Proof. 137 | intros x. 138 | cases x. 139 | - intros. 140 | cases y. 141 | + propositional. 142 | + simplify. 143 | invert H. 144 | - intros y z Heq. 145 | simplify. 146 | invert Heq. 147 | Qed. 148 | 149 | (*| 150 | A few gotchas 151 | ------------- 152 | 153 | Natural numbers saturate at 0: 154 | |*) 155 | 156 | Compute (3 - 5 + 3). 157 | 158 | (*| 159 | The order in which you perform induction on variables matters: if `x` comes before `y` and you induct on `y`, your induction hypothesis will not be general enough. 160 | |*) 161 | 162 | Lemma add_comm: 163 | forall x y: nat, x + y = y + x. 164 | Proof. 165 | induct y. 166 | - induct x; simplify; equality. 167 | - simplify. 168 | (* `IHy` is valid only for one specific `y` *) 169 | Abort. 170 | 171 | Lemma add_comm: 172 | forall x y: nat, x + y = y + x. 173 | Proof. 174 | induct x. 175 | - induct y; simplify; equality. 176 | - simplify. 177 | (* `IHx` starts with `forall y`. *) 178 | Abort. 179 | 180 | (*| 181 | Here's an example where this subtlety matters: 182 | |*) 183 | 184 | Fixpoint factorial (n: nat) := 185 | match n with 186 | | O => 1 187 | | S n' => n * factorial n' 188 | end. 189 | 190 | Fixpoint factorial_acc (n: nat) (acc: nat) := 191 | match n with 192 | | O => acc 193 | | S n' => factorial_acc n' (n * acc) 194 | end. 195 | 196 | (*| 197 | First attempt, but our lemma is too weak. 198 | |*) 199 | 200 | Lemma factorial_acc_correct: 201 | forall n, factorial n = factorial_acc n 1. 202 | Proof. 203 | induct n. 204 | - equality. 205 | - simplify. 206 | Search (_ * 1). 207 | rewrite Nat.mul_1_r. 208 | 209 | (*| 210 | Stuck! We have no way to simplify `factorial_acc n (S n)`. 211 | |*) 212 | 213 | Abort. 214 | 215 | (*| 216 | Second attempt: a generalized lemma, but we put the `acc` first, so induction will not generalize it. 217 | |*) 218 | 219 | Lemma factorial_acc_correct: 220 | forall acc n, factorial n * acc = factorial_acc n acc. 221 | Proof. 222 | induct n. 223 | - simplify. 224 | Search (_ + 0). 225 | rewrite Nat.add_0_r. 226 | equality. 227 | - simplify. 228 | Fail rewrite <- IHn. 229 | 230 | (*| 231 | Stuck! IHn is too weak. 232 | |*) 233 | 234 | Abort. 235 | 236 | (*| 237 | Third time's the charm! Note how we ordered `n` and `acc`. 238 | |*) 239 | 240 | Lemma factorial_acc_correct: 241 | forall n acc, factorial n * acc = factorial_acc n acc. 242 | Proof. 243 | induct n. 244 | - simplify. 245 | linear_arithmetic. 246 | - simplify. 247 | 248 | (*| 249 | IHn is strong enough now! 250 | |*) 251 | 252 | rewrite <- IHn. 253 | linear_arithmetic. 254 | Qed. 255 | -------------------------------------------------------------------------------- /pset01_ProgramAnalysis/_CoqProject: -------------------------------------------------------------------------------- 1 | -R ../frap Frap 2 | Pset1Signature.v 3 | Pset1Implementation.v 4 | -------------------------------------------------------------------------------- /pset02_BinomialCoefficients/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: coq clean 2 | 3 | COQC=coqc -q -R ../frap Frap 4 | 5 | coq: 6 | $(COQC) Pset2Sig.v 7 | $(COQC) Pset2.v 8 | 9 | clean: 10 | rm -f *.vo *.glob *.aux .*.aux .lia.cache .nia.cache *.vok *.vos 11 | -------------------------------------------------------------------------------- /pset02_BinomialCoefficients/Pset2Sig.v: -------------------------------------------------------------------------------- 1 | (** * 6.822 Formal Reasoning About Programs, Spring 2021 - Pset 2 *) 2 | 3 | Require Import Coq.NArith.NArith. Open Scope N_scope. 4 | Require Import Coq.Lists.List. Import ListNotations. 5 | Require Import Coq.micromega.Lia. 6 | Require Import Frap.Frap. 7 | 8 | Module Type S. 9 | Definition fact: N -> N := 10 | recurse by cases 11 | | 0 => 1 12 | | n + 1 => (n + 1) * recurse 13 | end. 14 | 15 | (*[5%]*) Parameter exp: N -> N -> N. 16 | Axiom test_exp_2_3: exp 2 3 = 8. 17 | Axiom test_exp_3_2: exp 3 2 = 9. 18 | Axiom test_exp_4_1: exp 4 1 = 4. 19 | Axiom test_exp_5_0: exp 5 0 = 1. 20 | Axiom test_exp_1_3: exp 1 3 = 1. 21 | 22 | Definition seq (f: N -> N): N -> N -> list N := 23 | recurse by cases 24 | | 0 => fun start => [] 25 | | n + 1 => fun start => f start :: recurse (start + 1) 26 | end. 27 | 28 | Definition ith: N -> list N -> N := 29 | recurse by cases 30 | | 0 => fun (l: list N) => match l with 31 | | h :: t => h 32 | | nil => 0 33 | end 34 | | i + 1 => fun (l: list N) => match l with 35 | | h :: t => recurse t 36 | | nil => 0 37 | end 38 | end. 39 | 40 | Fixpoint len(l: list N): N := 41 | match l with 42 | | [] => 0 43 | | h :: t => 1 + len t 44 | end. 45 | 46 | (*[12%]*) 47 | Axiom seq_spec: forall f count i start, i < count -> ith i (seq f count start) = f (start + i). 48 | 49 | (*[12%]*) 50 | Axiom ith_out_of_bounds_0: forall i l, len l <= i -> ith i l = 0. 51 | 52 | Definition C(n k: N): N := fact n / (fact (n - k) * fact k). 53 | 54 | Definition bcoeff(n: N): N -> N := 55 | recurse by cases 56 | | 0 => 1 57 | | k + 1 => recurse * (n - k) / (k + 1) 58 | end. 59 | 60 | (*[7%]*) 61 | Axiom fact_nonzero: forall n, fact n <> 0. 62 | 63 | (*[7%]*) 64 | Axiom Cn0: forall n, C n 0 = 1. 65 | 66 | (*[7%]*) 67 | Axiom Cnn: forall n, C n n = 1. 68 | 69 | (*[25%]*) 70 | Axiom bcoeff_correct: forall n k, k <= n -> bcoeff n k = C n k. 71 | 72 | Definition Pascal's_rule: Prop := forall n k, 73 | 1 <= k <= n -> 74 | C (n+1) k = C n (k - 1) + C n k. 75 | 76 | Definition nextLine(l: list N): list N := 77 | 1 :: seq (fun k => ith (k - 1) l + ith k l) (len l) 1. 78 | 79 | Definition all_coeffs_fast: N -> list N := 80 | recurse by cases 81 | | 0 => [1] 82 | | n + 1 => nextLine recurse 83 | end. 84 | 85 | (*[25%]*) 86 | Axiom all_coeffs_fast_correct: 87 | Pascal's_rule -> 88 | forall n k, 89 | k <= n -> 90 | ith k (all_coeffs_fast n) = C n k. 91 | End S. 92 | -------------------------------------------------------------------------------- /pset02_BinomialCoefficients/Tips.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.NArith.NArith. 2 | Open Scope N_scope. 3 | Require Import Frap.Frap. 4 | Require Import Pset2. 5 | Import Pset2.Impl. 6 | 7 | Notation "x !" := (fact x) (at level 12, format "x !"). (* local in Pset2 *) 8 | 9 | (* This file demonstrates a number of useful Coq tactics. Step though the 10 | examples, and check Coq's reference manual or ask us in office hours if 11 | you're confused about any of these tactics. 12 | 13 | There are no exercises to complete in this file, just neat examples; feel 14 | free to work on it at your pace over multiple psets and to refer to it at 15 | later points; no need to go through it all at once. *) 16 | 17 | (* The tactic we introduce in each example is underlined like this. *) 18 | (********************) 19 | 20 | Parameter whatever: Prop. 21 | 22 | (* ‘apply’ matches the conclusion of a theorem to the current goal, then 23 | replaces it with one subgoal per premise of that theorem: *) 24 | 25 | Goal forall (P Q R: Prop) (H1: P) (H2: Q) (IH: P -> Q -> R), R. 26 | Proof. 27 | simplify. 28 | apply IH. 29 | (********) 30 | Abort. 31 | 32 | (* Apply works with implications (`A -> B`) but also with equivalences, where 33 | it tries to pick the right direction based on the goal: *) 34 | Goal forall (n m k: N), n = m. 35 | Proof. 36 | simplify. 37 | Check N.mul_cancel_r. 38 | 39 | (* Careful: apply only works if it's clear how the theorem applies to your goal: *) 40 | Fail apply N.mul_cancel_r. 41 | (* Here, Coq wants to know the value of ‘p’ before it can apply the lemma; so, 42 | we use the ‘with’ for of ‘apply’ to supply it: *) 43 | apply N.mul_cancel_r with (p := n - k + 1). 44 | (****) (****) 45 | Abort. 46 | 47 | (* Apply also works in hypotheses, where it tuns premises into conclusions: *) 48 | Goal forall (n m k: N), n = m -> whatever. 49 | Proof. 50 | simplify. 51 | apply N.mul_cancel_r with (p := n - k + 1) in H. 52 | (*****) (****) (**) 53 | Abort. 54 | 55 | Goal forall (n m k: N), n - k + 1 <> 0 -> n = m -> whatever. 56 | Proof. 57 | simplify. 58 | 59 | (* Specifying parameters by hand is not always convenient, so we can ask Coq 60 | to create placeholders instead, to be filled later: *) 61 | eapply N.mul_cancel_r in H0. 62 | (******) (**) 63 | 2: { (* This ‘2:’ notation means: operate on the second goal *) 64 | apply H. 65 | } (* … and the curly braces delimit a subproof. *) 66 | Abort. 67 | 68 | Goal forall (P Q R S: Prop), (P -> S) -> (R -> S) -> P \/ Q \/ R -> S. 69 | Proof. 70 | simplify. 71 | cases H1. (* You are familiar with ‘cases’ from pset 1. *) 72 | (*****) 73 | - apply H. apply H1. 74 | - admit. (* ‘admit’ is just like ‘Admitted’ but for a single goal *) 75 | (*****) 76 | - apply H0. apply H1. 77 | Fail Qed. (* But if you use ‘admit’, no ‘Qed’ for you! *) 78 | Admitted. 79 | 80 | (* Here is a convenient pattern that you will be familiar with from math 81 | classes. It's called a “cut”. We state an intermediate fact and prove it 82 | as part of a larger proof. *) 83 | 84 | Goal forall (f : N -> N) (count : N) 85 | (IHcount : forall i start : N, i < count -> 86 | ith i (seq f count start) = f (start + i)) 87 | (i start : N) 88 | (H : i < count + 1), 89 | ith i (f start :: seq f count (start + 1)) = f (start + i). 90 | Proof. 91 | simplify. 92 | 93 | (* ‘assert’ introduces the fact that we want to prove, then uses *) 94 | assert (i = 0 \/ 0 < i) as A. { (* the ‘as’ clause to name the resulting fact *) 95 | (******) (**) 96 | linear_arithmetic. (* The proof of the lemma comes first. *) 97 | } 98 | cases A. (* Then we get to use the lemma itself. *) 99 | - subst. (* ‘subst’ rewrites all equalities. *) 100 | (*****) (* or "subst i" for just one var *) 101 | simplify. admit. 102 | - (* Another assertion! This time we fit the whole proof in a ‘by’ clause. *) 103 | assert (i = i - 1 + 1) as E by linear_arithmetic. 104 | (******) (**) 105 | rewrite E. 106 | unfold_recurse ith (i - 1). 107 | Abort. 108 | 109 | Goal forall (n x0 k: N), 110 | 0 < k -> 111 | k + 1 < n -> 112 | n! = x0 * ((n - (k - 1))! * (k - 1)!) -> 113 | whatever. 114 | Proof. 115 | intros n m. 116 | (******) 117 | (* ‘simplify’ takes care of moving variables into the “context” above the 118 | line, but ‘intros’ gives finer grained control and lets you name 119 | hypotheses. Users of Proof General with company-coq can type ‘intros!’ to 120 | get names automatically inserted. *) 121 | intros. (* A plain ‘intros’ takes care of all remaining variables. *) 122 | (******) 123 | 124 | (* Sometimes we want to say “a = b, so replace all ‘a’s with ‘b’s.”. Replace 125 | is the perfect tactic for these cases; it's like ‘assert’ followed by 126 | ‘rewrite’. *) 127 | replace (n - (k - 1)) with (n - k + 1) in H1 by linear_arithmetic. 128 | (*******) (****) (**) (**) 129 | (* "in" and "by" are optional *) 130 | unfold_recurse fact (n - k). 131 | Abort. 132 | 133 | Goal forall (P Q R: Prop) (H0: Q) (x: N) (H: forall (a b: N), P -> Q -> a < b -> R), whatever. 134 | Proof. 135 | simplify. 136 | (* Often you have a general hypothesis, and you want to make it more specific 137 | to your case. Then, ‘specialize’ is the tactic you want: *) 138 | specialize H with (b := x). 139 | (**********) (****) 140 | assert (3 < x) by admit. 141 | specialize H with (2 := H0) (3 := H1). 142 | Abort. 143 | 144 | Goal forall (f : N -> N) (start : N), 145 | f start = f (start + 0). 146 | Proof. 147 | simplify. 148 | 149 | (* We have seen ‘apply’ earlier, which applies a theorem ending with an 150 | implication to a complete goal. ‘rewrite’ takes theorems ending in an 151 | equality and replaces matching subterms of the goal according to that 152 | equality: *) 153 | rewrite N.add_0_r. 154 | (*******) 155 | (* Options like "with (a := 2)", "in H", "by tactic" also work! *) 156 | equality. 157 | Abort. 158 | 159 | Goal forall (f : N -> N) (start : N), 160 | f start = f (start + 0). 161 | Proof. 162 | simplify. 163 | (* Alternatively, sometimes, it helps to apply the principle that, if two 164 | function arguments match, then the function calls themselves match: *) 165 | f_equal. 166 | (*******) 167 | linear_arithmetic. 168 | Abort. 169 | 170 | Goal forall (f : N -> N) (start : N), 171 | f start = f (start + 0). 172 | Proof. 173 | simplify. 174 | (* How many other ways can we find to deal with this theorem? *) 175 | assert (start + 0 = start) as E by linear_arithmetic. 176 | rewrite E. 177 | Abort. 178 | 179 | Goal forall (A B: Type) (f: A -> B) (a1 a2 a3: A), 180 | Some a1 = Some a2 -> 181 | Some a2 = Some a3 -> 182 | f a3 = f a1. 183 | Proof. 184 | (* ‘simplify’ is a favorite of this class, which does all sorts of small goal 185 | reorganization to make things more readable. *) 186 | simplify. 187 | 188 | (* ‘invert’ is another favorite: it “replaces hypothesis H with other facts that can be deduced from the structure of H's statement”. 189 | 190 | Specifically, it looks at the structure of the arguments passed to the 191 | constructor of inductive types appearing in H and deduces equalities from 192 | that and then substitutes the equalities. It's also particularly useful 193 | for inductive ‘Prop’s, which we will see later in this class. *) 194 | invert H. (* Watch what happens carefully in this example *) 195 | (******) 196 | invert H0. 197 | equality. 198 | Abort. 199 | 200 | Goal forall (A B: Type) (f: A -> B) (a1 a2 a3: A), 201 | Some a1 = Some a2 -> 202 | Some a2 = Some a3 -> 203 | f a3 = f a1. 204 | Proof. 205 | simplify. 206 | equality. (* Of course, ‘equality’ can do all the work for us here. *) 207 | (********) 208 | Abort. 209 | 210 | Goal forall (a1 a2 b1 b2: N) (l1 l2: list N), 211 | a1 :: b1 :: l1 = a2 :: b2 :: l2 -> 212 | a1 = a2 /\ b1 = b2 /\ l1 = l2. 213 | Proof. 214 | simplify. 215 | (* ‘invert’ works at arbitrary depth, btw: *) 216 | invert H. 217 | (******) 218 | Abort. 219 | 220 | (* If you ever end up with contradictory hypotheses, you'll want to apply the 221 | pompously named “ex falso quodlibet” principle (also known under the 222 | scary-sounding name of “principle of explosion”), through the aptly named 223 | ‘exfalso’ tactic: *) 224 | Goal forall (P: Prop) (a b: N), 225 | (a < b -> ~P) -> 226 | P -> 227 | whatever. 228 | Proof. 229 | simplify. 230 | assert (a < b \/ b <= a) as C by linear_arithmetic. cases C. 231 | - exfalso. 232 | (*******) 233 | unfold not in H. 234 | apply H. 235 | all: assumption. 236 | Abort. 237 | 238 | (* Contradictions can take many forms; a common one is Coq is an impossible equality between two constructors; here the empty list ‘[]’ and a non-empty list ‘a :: l’. *) 239 | Goal forall (a : N) (l : list N), 240 | a :: l = [] -> 241 | whatever. 242 | Proof. 243 | simplify. 244 | discriminate. 245 | (************) 246 | Abort. 247 | 248 | Goal forall (P Q R S T: Prop), (P \/ Q -> T) -> (R \/ S -> T) -> P \/ S -> T. 249 | Proof. 250 | simplify. 251 | cases H1. 252 | - apply H. left. assumption. 253 | - apply H0. right. assumption. 254 | Abort. 255 | 256 | (* Here are some more interesting tactics to look into along your Coq journey. 257 | Happy proving! 258 | 259 | - constructor, econstructor 260 | - eassumption 261 | - eexists 262 | - first_order 263 | - induct 264 | - left, right 265 | - trivial 266 | - transitivity 267 | - symmetry 268 | *) 269 | 270 | (* References: 271 | 272 | - FRAP book Appendix A.2. Tactic Reference (http://adam.chlipala.net/frap/frap_book.pdf) 273 | - Coq Reference Manual, Chapter on Tactics (https://coq.inria.fr/refman/proof-engine/tactics.html) 274 | *) 275 | -------------------------------------------------------------------------------- /pset02_BinomialCoefficients/_CoqProject: -------------------------------------------------------------------------------- 1 | -Q ../frap Frap 2 | -------------------------------------------------------------------------------- /pset03_ContainersAndHOFs/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: coq clean 2 | 3 | COQC=coqc -q -R ../frap Frap 4 | 5 | coq: 6 | $(COQC) Pset3Sig.v 7 | $(COQC) Pset3.v 8 | 9 | clean: 10 | rm -f *.vo *.glob .*.aux *.aux .lia.cache .nia.cache *.vok *.vos 11 | -------------------------------------------------------------------------------- /pset03_ContainersAndHOFs/Pset3Sig.v: -------------------------------------------------------------------------------- 1 | (** * 6.822 Formal Reasoning About Programs, Spring 2021 - Pset 3 *) 2 | 3 | Require Import Frap.Frap. 4 | 5 | (* three-way comparisions, and [cases] support for them *) 6 | Notation Lt := (inleft (left _)) (only parsing). 7 | Notation Eq := (inleft (right _)) (only parsing). 8 | Notation Gt := (inright _) (only parsing). 9 | Notation compare := Compare_dec.lt_eq_lt_dec. 10 | 11 | Module Type S. 12 | Inductive tree {A} := 13 | | Leaf 14 | | Node (l : tree) (d : A) (r : tree). 15 | Arguments tree : clear implicits. 16 | 17 | Fixpoint flatten {A} (t : tree A) : list A := 18 | match t with 19 | | Leaf => [] 20 | | Node l d r => flatten l ++ d :: flatten r 21 | end. 22 | 23 | Definition either {A} (xo yo : option A) : option A := 24 | match xo with 25 | | None => yo 26 | | Some x => Some x 27 | end. 28 | 29 | 30 | (* 1a) HOFs: id and compose *) 31 | 32 | Definition id {A : Type} (x : A) : A := x. 33 | Definition compose {A B C : Type} (g : B -> C) (f : A -> B) (x : A) : C := g (f x). 34 | 35 | (*[0.5%]*) 36 | Parameter compose_id_l : forall (A B : Type) (f : A -> B), compose id f = f. 37 | 38 | (*[0.5%]*) 39 | Parameter compose_id_r : forall (A B : Type) (f : A -> B), compose f id = f. 40 | 41 | (*[1%]*) 42 | Parameter compose_assoc : 43 | forall (A B C D : Type) (f : A -> B) (g : B -> C) (h : C -> D), 44 | compose h (compose g f) = compose (compose h g) f. 45 | 46 | Fixpoint selfCompose{A: Type}(f: A -> A)(n: nat): A -> A := 47 | match n with 48 | | O => id 49 | | S n' => compose f (selfCompose f n') 50 | end. 51 | 52 | Parameter exp : nat -> nat -> nat. 53 | (*[0.25%]*) 54 | Parameter test_exp_3_2 : exp 3 2 = 9. 55 | (*[0.25%]*) 56 | Parameter test_exp_4_1 : exp 4 1 = 4. 57 | (*[0.25%]*) 58 | Parameter test_exp_5_0 : exp 5 0 = 1. 59 | (*[0.25%]*) 60 | Parameter test_exp_1_3 : exp 1 3 = 1. 61 | 62 | (* 1b) HOFs: Left inverses *) 63 | 64 | Definition left_inverse{A B: Type}(f: A -> B)(g: B -> A): Prop := compose g f = id. 65 | 66 | (*[1%]*) 67 | Parameter plus2minus2 : left_inverse (fun x : nat => x + 2) (fun x : nat => x - 2). 68 | 69 | (*[2.5%]*) 70 | Parameter minus2plus2 : ~ left_inverse (fun x : nat => x - 2) (fun x : nat => x + 2). 71 | 72 | (*[4%]*) 73 | Parameter left_invertible_injective: 74 | forall {A} (f g: A -> A), 75 | left_inverse f g -> 76 | (forall x y, f x = f y -> x = y). 77 | 78 | (*[0.25%]*) 79 | Parameter left_inverse_id : forall {A : Type}, left_inverse (@id A) (@id A). 80 | 81 | (*[8%]*) 82 | Parameter invert_selfCompose : 83 | forall {A : Type} (f g : A -> A) (n : nat), left_inverse f g -> left_inverse (selfCompose f n) (selfCompose g n). 84 | 85 | (* 2a) Simple containers *) 86 | 87 | (*[0.25%]*) 88 | Parameter either_None_right : forall {A : Type} (xo : option A), either xo None = xo. 89 | 90 | (*[0.5%]*) 91 | Parameter either_assoc : 92 | forall {A : Type} (xo yo zo : option A), either (either xo yo) zo = either xo (either yo zo). 93 | 94 | Parameter head : forall {A : Type}, list A -> option A. 95 | 96 | (*[1%]*) 97 | Parameter head_example : head (1 :: 2 :: 3 :: nil) = Some 1. 98 | 99 | (*[1%]*) 100 | Parameter either_app_head : 101 | forall {A : Type} (xs ys : list A), head (xs ++ ys) = either (head xs) (head ys). 102 | 103 | Parameter leftmost_Node : forall {A : Type}, tree A -> option A. 104 | 105 | (*[1%]*) 106 | Parameter leftmost_Node_example : leftmost_Node (Node (Node Leaf 2 (Node Leaf 3 Leaf)) 1 Leaf) = Some 2. 107 | 108 | (*[4%]*) 109 | Parameter leftmost_Node_head : forall {A : Type} (t : tree A), leftmost_Node t = head (flatten t). 110 | 111 | 112 | (* 2b) bitwise tries *) 113 | 114 | Definition bitwise_trie A := tree (option A). 115 | 116 | Parameter lookup : forall {A : Type}, list bool -> bitwise_trie A -> option A. 117 | 118 | (*[1%]*) 119 | Parameter lookup_example1 : lookup nil (Node Leaf (None : option nat) Leaf) = None. 120 | 121 | (*[1%]*) 122 | Parameter lookup_example2 : 123 | lookup (false :: true :: nil) 124 | (Node (Node Leaf (Some 2) Leaf) None (Node (Node Leaf (Some 1) Leaf) (Some 3) Leaf)) = 125 | Some 1. 126 | 127 | (*[1%]*) 128 | Parameter lookup_empty : forall {A : Type} (k : list bool), lookup k (Leaf : bitwise_trie A) = None. 129 | 130 | Parameter insert : forall {A : Type}, list bool -> option A -> bitwise_trie A -> bitwise_trie A. 131 | 132 | (*[1%]*) 133 | Parameter insert_example1 : lookup nil (insert nil None (Node Leaf (Some 0) Leaf)) = None. 134 | 135 | (*[1%]*) 136 | Parameter insert_example2 : 137 | lookup nil (insert (true :: nil) (Some 2) (Node Leaf (Some 0) Leaf)) = Some 0. 138 | 139 | (*[8%]*) 140 | Parameter lookup_insert : 141 | forall {A : Type} (k : list bool) (v : option A) (t : bitwise_trie A), lookup k (insert k v t) = v. 142 | 143 | (*[2%]*) 144 | Parameter map_id : forall {A : Type} (xs : list A), List.map id xs = xs. 145 | 146 | (*[3%]*) 147 | Parameter map_compose : 148 | forall (A B C : Type) (g : B -> C) (f : A -> B) (xs : list A), 149 | List.map (compose g f) xs = List.map g (List.map f xs). 150 | 151 | (*[4%]*) 152 | Parameter invert_map : 153 | forall (A B : Type) (f : A -> B) (g : B -> A), left_inverse f g -> left_inverse (List.map f) (List.map g). 154 | 155 | (* 2c) HOFs: tree_map *) 156 | 157 | Parameter tree_map : forall {A B : Type}, (A -> B) -> tree A -> tree B. 158 | 159 | (*[1%]*) 160 | Parameter tree_map_example : 161 | tree_map (fun x : nat => x + 1) (Node (Node Leaf 1 Leaf) 2 (Node Leaf 3 (Node Leaf 4 Leaf))) = 162 | Node (Node Leaf 2 Leaf) 3 (Node Leaf 4 (Node Leaf 5 Leaf)). 163 | 164 | (*[8%]*) 165 | Parameter tree_map_flatten : 166 | forall (A B : Type) (f : A -> B) (t : tree A), flatten (tree_map f t) = List.map f (flatten t). 167 | 168 | Fixpoint tree_forall {A} (P: A -> Prop) (tr: tree A) := 169 | match tr with 170 | | Leaf => True 171 | | Node l d r => tree_forall P l /\ P d /\ tree_forall P r 172 | end. 173 | 174 | Parameter tree_exists : forall {A: Type}, (A -> Prop) -> tree A -> Prop. 175 | 176 | (*[0.5%]*) 177 | Parameter tree_exists_Leaf : 178 | forall (A : Type) (P : A -> Prop), ~ tree_exists P Leaf. 179 | (*[3%]*) 180 | Parameter tree_forall_exists : 181 | forall (A : Type) (P : A -> Prop) (tr : tree A), 182 | tr <> Leaf -> tree_forall P tr -> tree_exists P tr. 183 | 184 | (*[2%]*) 185 | (* Explain what tree_forall_sound means *) 186 | 187 | (*[3%]*) 188 | Parameter tree_forall_sound : 189 | forall (A : Type) (P : A -> Prop) (tr : tree A), 190 | tree_forall P tr -> forall d : A, tree_exists (fun d' : A => d' = d) tr -> P d. 191 | 192 | (* 2d) Binary search trees *) 193 | 194 | Fixpoint listset (l: list nat) (s: nat -> Prop) := 195 | match l with 196 | | [] => 197 | (* An empty list represents an empty set *) 198 | forall x, ~ s x 199 | | hd :: tl => 200 | (* Note how we remove an element from the propositional set: *) 201 | s hd /\ listset tl (fun x => x <> hd /\ s x) 202 | end. 203 | 204 | Fixpoint list_member (a: nat) (l: list nat) := 205 | match l with 206 | | [] => false 207 | | hd :: tl => 208 | if a ==n hd then true else list_member a tl 209 | end. 210 | 211 | (*[4%]*) 212 | Parameter list_member_lset: forall l s a, 213 | listset l s -> 214 | list_member a l = true <-> s a. 215 | 216 | (*[3%]*) 217 | Parameter list_member_lset': forall l s a, 218 | listset l s -> 219 | list_member a l = false <-> ~ (s a). 220 | 221 | Definition list_insert (a: nat) (l: list nat) := 222 | if list_member a l then l else a :: l. 223 | 224 | (*[8%]*) 225 | Parameter list_insert_listset : forall l s a, 226 | listset l s -> 227 | listset (list_insert a l) 228 | (fun x => s x \/ x = a). 229 | 230 | Fixpoint bst (tr : tree nat) (s : nat -> Prop) := 231 | match tr with 232 | | Leaf => forall x, not (s x) (* s is empty set *) 233 | | Node l d r => 234 | s d /\ 235 | bst l (fun x => s x /\ x < d) /\ 236 | bst r (fun x => s x /\ d < x) 237 | end. 238 | 239 | (*[3%]*) 240 | Parameter bst_implies : 241 | forall (tr : tree nat) (s : nat -> Prop), bst tr s -> tree_forall s tr. 242 | 243 | (*[1%]*) 244 | Parameter bst_node_ordered : 245 | forall (l : tree nat) (d : nat) (r : tree nat) (s : nat -> Prop), 246 | bst (Node l d r) s -> 247 | tree_forall (fun x : nat => x < d) l /\ tree_forall (fun x : nat => x > d) r. 248 | 249 | (*[5%]*) 250 | Parameter bst_iff : 251 | forall (tr : tree nat) (P Q : nat -> Prop), 252 | bst tr P -> (forall x : nat, P x <-> Q x) -> bst tr Q. 253 | 254 | Fixpoint bst_member (a: nat) (tr: tree nat) : bool := 255 | match tr with 256 | | Leaf => false 257 | | Node lt v rt => 258 | match compare a v with 259 | | Lt => bst_member a lt 260 | | Eq => true 261 | | Gt => bst_member a rt 262 | end 263 | end. 264 | 265 | (*[10%]*) 266 | Parameter member_bst : 267 | forall (tr : tree nat) (s : nat -> Prop) (a : nat), 268 | bst tr s -> bst_member a tr = true <-> s a. 269 | End S. 270 | 271 | (* Here's a technical note on why this pset overrides a Frap tactic. 272 | There's no need to understand this at all. 273 | 274 | The "simplify" tactic provided by the Frap library is not quite suitable for this 275 | pset, because it does "autorewrite with core in *" (which we commented out below), 276 | and there's a Hint in Coq.Program.Combinators 277 | 278 | Hint Rewrite <- @compose_assoc : core. 279 | 280 | which causes "autorewrite with core in *." to have the 281 | same effect as 282 | 283 | rewrite <-? Combinators.compose_assoc. 284 | 285 | and apparently, rewrite does not just syntactic matching, 286 | but matching modulo unification, so it will replace 287 | our "compose" by "Basics.compose", and rewrite using 288 | associativity of "compose" as many times as it can. 289 | It's confusing to have "Basics.compose" appear in our goals, 290 | and rewriting with associativity is something we want to teach in this 291 | pset, so we redefine "simplify" to not use "autorewrite": *) 292 | Ltac simplify ::= 293 | repeat (unifyTails; pose proof I); repeat match goal with 294 | | H:True |- _ => clear H 295 | end; 296 | repeat progress (simpl in *; intros(*; try autorewrite with core in * *); simpl_maps); 297 | repeat normalize_set || doSubtract. 298 | 299 | Ltac cases E := 300 | (is_var E; destruct E) || 301 | match type of E with 302 | | sumor (sumbool _ _) _ => destruct E as [[]|] 303 | | {_} + {_} => destruct E 304 | | _ => let Heq := fresh "Heq" in 305 | destruct E eqn:Heq 306 | end; 307 | repeat 308 | match goal with 309 | | H:_ = left _ |- _ => clear H 310 | | H:_ = right _ |- _ => clear H 311 | | H:_ = inleft _ |- _ => clear H 312 | | H:_ = inright _ |- _ => clear H 313 | end. 314 | -------------------------------------------------------------------------------- /pset03_ContainersAndHOFs/_CoqProject: -------------------------------------------------------------------------------- 1 | -Q ../frap Frap 2 | -------------------------------------------------------------------------------- /pset04_BSTs/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: coq clean 2 | 3 | COQC=coqc -q -R ../frap Frap 4 | 5 | coq: 6 | $(COQC) Pset4Sig.v 7 | $(COQC) Pset4.v 8 | 9 | clean: 10 | rm -f *.vo* .*.aux *.cache *.glob 11 | -------------------------------------------------------------------------------- /pset04_BSTs/Pset4.v: -------------------------------------------------------------------------------- 1 | (** * Correctness of Binary Search Trees (BSTs) *) 2 | 3 | (* This week we'll continue proving the correctness of a binary search tree implementation. 4 | * BSTs are a famous data structure for finite sets, allowing fast (log-time) 5 | * lookup, insertion, and deletion of items. (We omit the rebalancing heuristics 6 | * needed to achieve worst-case log-time operations, but you will prove the 7 | * correctness of rotation operations these heuristics use to modify the tree.) 8 | * In this problem set, we show that insertion and deletion functions are 9 | * correctly defined by relating them to operations on functional sets. *) 10 | 11 | Require Import Frap Datatypes Pset4Sig. 12 | Require Import Compare_dec. 13 | 14 | (* We will study binary trees of natural numbers only for convenience. 15 | Almost everything here would also work with an arbitrary type 16 | [t], but with [nat] you can use [linear_arithmetic] to prove 17 | goals about ordering of multiple elements (e.g., transitivity). *) 18 | Local Notation t := nat. 19 | 20 | Module Impl. 21 | (* Trees are an inductive structure, where [Leaf] doesn't have any items, 22 | * whereas [Node] has an item and two subtrees. Note that a [tree] can 23 | * contain nodes in arbitrary order, so not all [tree]s are valid binary 24 | * search trees. *) 25 | 26 | (* (* Imported from Sig file: *) 27 | Inductive tree := 28 | | Leaf (* an empty tree *) 29 | | Node (d : t) (l r : tree). 30 | *) 31 | (* Then a singleton is just a node without subtrees. *) 32 | Definition Singleton (v: t) := Node v Leaf Leaf. 33 | 34 | (* [bst] relates a well-formed binary search tree to the set of elements it 35 | contains. Note that invalid trees with misordered elements are not valid 36 | representations of any set. All operations on a binary tree are specified 37 | in terms of how they affect the set that the tree represents. That 38 | set is encoded as function that takes a [t] and returns the proposition "[t] 39 | is in this set". *) 40 | Fixpoint bst (tr : tree) (s : t -> Prop) := 41 | match tr with 42 | | Leaf => forall x, not (s x) (* s is empty set *) 43 | | Node d l r => 44 | s d /\ 45 | bst l (fun x => s x /\ x < d) /\ 46 | bst r (fun x => s x /\ d < x) 47 | end. 48 | 49 | (* [member] computes whether [a] is in [tr], but to do so it *relies* on the 50 | [bst] property -- if [tr] is not a valid binary search tree, [member] 51 | will (and should, for performance) give arbitrarily incorrect answers. *) 52 | Fixpoint member (a: t) (tr: tree) : bool := 53 | match tr with 54 | | Leaf => false 55 | | Node v lt rt => 56 | match compare a v with 57 | | Lt => member a lt 58 | | Eq => true 59 | | Gt => member a rt 60 | end 61 | end. 62 | 63 | (* Here is a typical insertion routine for BSTs. 64 | * From a given value, we recursively compare the value with items in 65 | * the tree from the root, until we find a leaf whose place the new value can take. *) 66 | Fixpoint insert (a: t) (tr: tree) : tree := 67 | match tr with 68 | | Leaf => Singleton a 69 | | Node v lt rt => 70 | match compare a v with 71 | | Lt => Node v (insert a lt) rt 72 | | Eq => tr 73 | | Gt => Node v lt (insert a rt) 74 | end 75 | end. 76 | 77 | (* Helper functions for [delete] below. The *main task* in this pset 78 | is to understand, specify, and prove these helpers. *) 79 | Fixpoint rightmost (tr: tree) : option t := 80 | match tr with 81 | | Leaf => None 82 | | Node v _ rt => 83 | match rightmost rt with 84 | | None => Some v 85 | | r => r 86 | end 87 | end. 88 | Definition is_leaf (tr : tree) : bool := 89 | match tr with Leaf => true | _ => false end. 90 | Fixpoint delete_rightmost (tr: tree) : tree := 91 | match tr with 92 | | Leaf => Leaf 93 | | Node v lt rt => 94 | if is_leaf rt 95 | then lt 96 | else Node v lt (delete_rightmost rt) 97 | end. 98 | Definition merge_ordered lt rt := 99 | match rightmost lt with 100 | | Some rv => Node rv (delete_rightmost lt) rt 101 | | None => rt 102 | end. 103 | 104 | (* [delete] searches for an element by its value and removes it if it is found. 105 | Removing an element from a leaf is degenerate (nothing to do), and 106 | removing the value from a node with no other children (both Leaf) can be done 107 | by replacing the node itself with a Leaf. Deleting a non-leaf node is 108 | substantially trickier because the type of [tree] does not allow for a Node 109 | with two subtrees but no value -- merging two trees is nontrivial. The 110 | implementation here removes the value anyway and then moves the rightmost 111 | node of the left subtree up to replace the removed value. This is equivalent 112 | to using rotations to move the value to be removed into leaf position and 113 | removing it there. *) 114 | Fixpoint delete (a: t) (tr: tree) : tree := 115 | match tr with 116 | | Leaf => Leaf 117 | | Node v lt rt => 118 | match compare a v with 119 | | Lt => Node v (delete a lt) rt 120 | | Eq => merge_ordered lt rt 121 | | Gt => Node v lt (delete a rt) 122 | end 123 | end. 124 | 125 | (* Here is a lemma that you will almost definitely want to use. *) 126 | Example bst_iff : forall tr P Q, bst tr P -> (forall x, P x <-> Q x) -> bst tr Q. 127 | Proof. 128 | induct tr; simplify. 129 | { rewrite <- H0. apply H with (x:=x). } 130 | rewrite H0 in H. 131 | propositional. 132 | { apply IHtr1 with (P:=(fun x : t => (fun d => P x /\ x < d) d)); 133 | propositional; cycle 1. 134 | { rewrite H0; trivial. } 135 | { rewrite <-H0; trivial. } } 136 | { apply IHtr2 with (P:=(fun x : t => (fun d => P x /\ d < x) d)); 137 | propositional; cycle 2. 138 | { rewrite <-H0; trivial. } 139 | { rewrite H0; trivial. } } 140 | Qed. 141 | 142 | (* You may want to call these tactics to use the previous lemma. *) 143 | (* They are just a means to save some typing of [apply ... with]. *) 144 | Ltac use_bst_iff known_bst := 145 | lazymatch type of known_bst with 146 | | bst ?tree2 ?set2 => 147 | lazymatch goal with 148 | | |- bst ?tree1 ?set1 => 149 | apply bst_iff with (P:=set2) (Q := set1); 150 | lazymatch goal with 151 | |- bst tree2 set2 => apply known_bst 152 | | _ => idtac 153 | end 154 | end 155 | end. 156 | 157 | Ltac use_bst_iff_assumption := 158 | match goal with 159 | | H : bst ?t _ |- bst ?t _ => 160 | use_bst_iff H 161 | end. 162 | 163 | (* If you are comfortable with it, [eapply bst_iff] followed by careful 164 | * application of other [bst] facts (e.g., inductive hypotheses) can 165 | * save typing in some places where this tactic does not apply, though 166 | * keep in mind that forcing an incorrect choice for a ?unification 167 | * variable can make the goal false. *) 168 | 169 | (* It may also be useful to know that you can switch to proving [False] by 170 | * calling [exfalso]. This, for example, enables you to apply lemmas that end in 171 | * [-> False]. Of course, only do this if the hypotheses are contradictory. *) 172 | 173 | (* Other tactics used in our solution: apply, apply with, apply with in 174 | * (including multiple "with" clauses like in [use_bst_iff]), cases, propositional, 175 | linear_arithmetic, simplify, trivial, try, induct, equality, rewrite, assert. *) 176 | 177 | (* Warm-up exercise: rebalancing rotations *) 178 | 179 | (* Transcribe and prove one of the two rotations shown in [rotation1.svg] and [rotation2.svg]. 180 | The AA-tree rebalancing algorithm applies these only if the annotations of relevant 181 | subtrees are in violation of a performance-critical invariant, but the rotations 182 | themselves are correct regardless. (These are straight from 183 | https://en.wikipedia.org/wiki/AA_tree#Balancing_rotations.) *) 184 | (* Each one can be written as a simple non-recursive definition 185 | containing two "match" expressions that returns the original 186 | tree in cases where the expected structure is not present. *) 187 | 188 | Definition rotate (T : tree) : tree. 189 | Admitted. 190 | 191 | Lemma bst_rotate T s (H : bst T s) : bst (rotate T) s. 192 | Admitted. 193 | 194 | (* There is a hint on the class website that completely gives away the proofs 195 | * of these rotations. We recommend you study that code after completing this 196 | * exercise to see how we did it, maybe picking up a trick or two to use below. *) 197 | 198 | Lemma bst_insert : forall tr s a, bst tr s -> 199 | bst (insert a tr) (fun x => s x \/ x = a). 200 | Proof. 201 | Admitted. 202 | 203 | (* To prove [bst_delete], you will need to write specifications for its helper 204 | functions, find suitable statements for proving correctness by induction, and use 205 | proofs of some helper functions in proofs of other helper functions. The hints 206 | on the course website provide examples and guidance but no longer ready-to-prove 207 | lemma statements. For time-planning purposes: you are not halfway done yet. 208 | (The Sig file also has a rough point allocation between problems.) 209 | 210 | It is up to you whether to use one lemma per function, multiple lemmas per 211 | function, or (when applicable) one lemma per multiple functions. However, 212 | the lemmas you prove about one function need to specify everything a caller 213 | would need to know about this function. *) 214 | 215 | Lemma bst_delete : forall tr s a, bst tr s -> 216 | bst (delete a tr) (fun x => s x /\ x <> a). 217 | Admitted. 218 | 219 | (* Great job! Now you have proven all tree-structure-manipulating operations 220 | necessary to implement a balanced binary search tree. Rebalancing heuristics 221 | that achieve worst-case-logarithmic running time maintain annotations on 222 | nodes of the tree (and decide to rebalance based on these). The implementation 223 | here omits them, but as the rotation operations are correct regardless of 224 | the annotations, any way of calling them from heuristic code would result in a 225 | functionally correct binary tree. *) 226 | End Impl. 227 | 228 | Module ImplCorrect : Pset4Sig.S := Impl. 229 | 230 | (* Authors: 231 | * Joonwon Choi 232 | * Adam Chlipala 233 | * Benjamin Sherman 234 | * Andres Erbsen 235 | *) 236 | -------------------------------------------------------------------------------- /pset04_BSTs/Pset4Sig.v: -------------------------------------------------------------------------------- 1 | Require Import Lia Frap Datatypes. 2 | Require Import Compare_dec. 3 | 4 | Notation t := nat. 5 | 6 | Inductive tree := 7 | | Leaf (* an empty tree *) 8 | | Node (d : t) (l r : tree). 9 | 10 | Notation compare := Compare_dec.lt_eq_lt_dec. 11 | Notation Lt := (inleft (left _)) (only parsing). 12 | Notation Eq := (inleft (right _)) (only parsing). 13 | Notation Gt := (inright _) (only parsing). 14 | 15 | Module Type S. 16 | Definition Singleton (v: t) := Node v Leaf Leaf. 17 | Parameter bst : forall (tr : tree) (s : t -> Prop), Prop. 18 | 19 | Parameter rotate : tree -> tree. 20 | 21 | (*[10%]*) Axiom bst_rotate : forall T s (H : bst T s), bst (rotate T) s. 22 | 23 | Fixpoint insert (a: t) (tr: tree) : tree := 24 | match tr with 25 | | Leaf => Singleton a 26 | | Node v lt rt => 27 | match compare a v with 28 | | Lt => Node v (insert a lt) rt 29 | | Eq => tr 30 | | Gt => Node v lt (insert a rt) 31 | end 32 | end. 33 | 34 | Fixpoint rightmost (tr: tree) : option t := 35 | match tr with 36 | | Leaf => None 37 | | Node v _ rt => 38 | match rightmost rt with 39 | | None => Some v 40 | | r => r 41 | end 42 | end. 43 | 44 | Definition is_leaf (tr : tree) : bool := 45 | match tr with Leaf => true | _ => false end. 46 | 47 | Fixpoint delete_rightmost (tr: tree) : tree := 48 | match tr with 49 | | Leaf => Leaf 50 | | Node v lt rt => 51 | if is_leaf rt 52 | then lt 53 | else Node v lt (delete_rightmost rt) 54 | end. 55 | 56 | Definition merge_ordered lt rt := 57 | match rightmost lt with 58 | | Some rv => Node rv (delete_rightmost lt) rt 59 | | None => rt 60 | end. 61 | 62 | Fixpoint delete (a: t) (tr: tree) : tree := 63 | match tr with 64 | | Leaf => Leaf 65 | | Node v lt rt => 66 | match compare a v with 67 | | Lt => Node v (delete a lt) rt 68 | | Eq => merge_ordered lt rt 69 | | Gt => Node v lt (delete a rt) 70 | end 71 | end. 72 | 73 | (*[40%]*) Axiom bst_insert : 74 | forall tr s a, 75 | bst tr s -> 76 | bst (insert a tr) (fun x => s x \/ x = a). 77 | 78 | (*[50%]*) Axiom bst_delete : 79 | forall tr s a, bst tr s -> 80 | bst (delete a tr) (fun x => s x /\ x <> a). 81 | End S. 82 | 83 | (* three-way comparisions and [cases] support for them *) 84 | Ltac cases E := 85 | (is_var E; destruct E) || 86 | match type of E with 87 | | sumor (sumbool _ _) _ => destruct E as [[]|] 88 | | {_} + {_} => destruct E 89 | | _ => let Heq := fresh "Heq" in 90 | destruct E eqn:Heq 91 | end; 92 | repeat 93 | match goal with 94 | | H:_ = left _ |- _ => clear H 95 | | H:_ = right _ |- _ => clear H 96 | | H:_ = inleft _ |- _ => clear H 97 | | H:_ = inright _ |- _ => clear H 98 | end. 99 | -------------------------------------------------------------------------------- /pset04_BSTs/_CoqProject: -------------------------------------------------------------------------------- 1 | -R ../frap Frap 2 | Pset4Sig.v 3 | Pset4.v 4 | -------------------------------------------------------------------------------- /pset04_BSTs/image-credit.txt: -------------------------------------------------------------------------------- 1 | https://en.wikipedia.org/wiki/File:AA_Tree_Skew2.svg 2 | https://en.wikipedia.org/wiki/File:AA_Tree_Split2.svg 3 | -------------------------------------------------------------------------------- /pset04_BSTs/rotation1.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | T 33 | 34 | 35 | 36 | X 37 | 38 | 39 | 40 | R 41 | 42 | 43 | 44 | A 45 | 46 | 47 | 48 | B 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | -------------------------------------------------------------------------------- /pset04_BSTs/rotation2.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | T 33 | 34 | 35 | 36 | L 37 | 38 | 39 | 40 | R 41 | 42 | 43 | 44 | A 45 | 46 | 47 | 48 | B 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | -------------------------------------------------------------------------------- /pset05_BigStepVsInterpreter/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: coq clean 2 | 3 | COQC=coqc -q -R ../frap Frap 4 | 5 | coq: 6 | $(COQC) Pset5Sig.v 7 | $(COQC) Pset5.v 8 | 9 | clean: 10 | rm -f *.vo *.glob *.aux .*.aux .*.cache *.vok *.vos 11 | -------------------------------------------------------------------------------- /pset05_BigStepVsInterpreter/Pset5Sig.v: -------------------------------------------------------------------------------- 1 | (** * 6.822 Formal Reasoning About Programs, Spring 2021 - Pset 5 *) 2 | 3 | Require Import Frap.Frap. 4 | 5 | 6 | Module Type S. 7 | Inductive arith : Set := 8 | | Const (n: nat) 9 | | Var (x: var) 10 | | Plus (e1 e2: arith). 11 | 12 | Inductive cmd := 13 | | Skip 14 | | Assign (x: var) (e: arith) 15 | | Sequence (c1 c2: cmd) 16 | | If (e: arith) (thn els: cmd) 17 | | While (e: arith) (body: cmd). 18 | 19 | Definition valuation := fmap var nat. 20 | 21 | Fixpoint interp (e: arith) (v: valuation) (a: nat): Prop := 22 | match e with 23 | | Const n => a = n 24 | | Var x => 25 | match v $? x with 26 | | None => True (* any a is possible! *) 27 | | Some n => a = n 28 | end 29 | | Plus e1 e2 => exists a1 a2, interp e1 v a1 /\ interp e2 v a2 /\ a = a1 + a2 30 | end. 31 | 32 | (*[4%]*) 33 | Parameter values_alias_for_grading: arith -> valuation -> nat -> Prop. 34 | 35 | (*[1%]*) 36 | Parameter values_example: forall a, 37 | 2 <= a -> 38 | values_alias_for_grading (Plus (Var "y") (Var "z")) ($0 $+ ("y", 2)) a. 39 | 40 | (*[4%]*) 41 | Parameter interp_to_values: forall e v a, 42 | interp e v a -> values_alias_for_grading e v a. 43 | 44 | (*[4%]*) 45 | Parameter values_to_interp: forall e v a, 46 | values_alias_for_grading e v a -> interp e v a. 47 | 48 | (*[2%]*) 49 | Parameter values_to_interp_induction_on_e: forall e v a, 50 | values_alias_for_grading e v a -> interp e v a. 51 | 52 | (*[7%]*) 53 | Parameter eval_alias_for_grading: valuation -> cmd -> valuation -> Prop. 54 | 55 | Example the_answer_is_42 := 56 | Sequence (Assign "x" (Var "oops")) 57 | (Sequence (If (Var "x") 58 | (Assign "tmp" (Plus (Var "x") (Var "x"))) 59 | (Assign "tmp" (Const 1))) 60 | (If (Var "tmp") 61 | (Assign "answer" (Const 42)) 62 | (Assign "answer" (Const 24)))). 63 | 64 | (*[1%]*) 65 | Parameter read_last_value: forall x v c n, 66 | values_alias_for_grading (Var x) (v $+ (x, c)) n -> n = c. 67 | 68 | (*[7%]*) 69 | Parameter the_answer_is_indeed_42: 70 | forall v, eval_alias_for_grading $0 the_answer_is_42 v -> v $? "answer" = Some 42. 71 | 72 | Example loop_of_unknown_length := 73 | (While (Var "x") (Assign "counter" (Plus (Var "counter") (Const 1)))). 74 | 75 | (*[7%]*) 76 | Parameter eval_loop_of_unknown_length: forall n initialCounter, 77 | eval_alias_for_grading ($0 $+ ("counter", initialCounter)) 78 | loop_of_unknown_length 79 | ($0 $+ ("counter", initialCounter + n)). 80 | 81 | (*[4%]*) 82 | Parameter run: nat -> valuation -> cmd -> valuation -> Prop. 83 | 84 | (*[14%]*) 85 | Parameter run_to_eval: forall fuel v1 c v2, 86 | run fuel v1 c v2 -> 87 | eval_alias_for_grading v1 c v2. 88 | 89 | Definition wrun (v1: valuation) (c: cmd) (v2: valuation): Prop := 90 | exists fuel, run fuel v1 c v2. 91 | 92 | (*[17%]*) 93 | Parameter run_monotone: forall fuel1 fuel2 v1 c v2, 94 | fuel1 <= fuel2 -> 95 | run fuel1 v1 c v2 -> 96 | run fuel2 v1 c v2. 97 | 98 | (*[1%]*) 99 | Parameter WRunSkip: forall v, 100 | wrun v Skip v. 101 | 102 | (*[2%]*) 103 | Parameter WRunAssign: forall v x e a, 104 | interp e v a -> 105 | wrun v (Assign x e) (v $+ (x, a)). 106 | 107 | (*[2%]*) 108 | Parameter WRunSeq: forall v c1 v1 c2 v2, 109 | wrun v c1 v1 -> 110 | wrun v1 c2 v2 -> 111 | wrun v (Sequence c1 c2) v2. 112 | 113 | (* [1%] *) 114 | Parameter WRunIfTrue_statement: Prop. 115 | (* [2%] *) 116 | Parameter WRunIfTrue: WRunIfTrue_statement. 117 | 118 | (* [1%] *) 119 | Parameter WRunIfFalse_statement: Prop. 120 | (* [2%] *) 121 | Parameter WRunIfFalse: WRunIfFalse_statement. 122 | 123 | (* [1%] *) 124 | Parameter WRunWhileTrue_statement: Prop. 125 | (* [3%] *) 126 | Parameter WRunWhileTrue: WRunWhileTrue_statement. 127 | 128 | (* [1%] *) 129 | Parameter WRunWhileFalse_statement: Prop. 130 | (* [2%] *) 131 | Parameter WRunWhileFalse: WRunWhileFalse_statement. 132 | 133 | (*[10%]*) 134 | Parameter eval_to_wrun: forall v1 c v2, 135 | eval_alias_for_grading v1 c v2 -> 136 | wrun v1 c v2. 137 | End S. 138 | -------------------------------------------------------------------------------- /pset05_BigStepVsInterpreter/_CoqProject: -------------------------------------------------------------------------------- 1 | -Q ../frap Frap 2 | -------------------------------------------------------------------------------- /pset06_ProgramTransformations/Hints.v: -------------------------------------------------------------------------------- 1 | (*| 2 | ============== 3 | Pset 6 Hints 4 | ============== 5 | |*) 6 | 7 | Require Import Pset6Sig. 8 | Module Hints (I: S). Import I. 9 | 10 | (*| 11 | General hints 12 | ============= 13 | 14 | Throughout the pset, think carefully on what you want to be doing induction on: commands, or proofs of `eval`? In many cases both are possible, but not always: theorems that require reasoning about equivalences between loops will typically not be provable by induction on a command. You might find it useful to review the debriefing for Pset 4 (the link is in the course calendar). 15 | 16 | --- 17 | 18 | Do not assume that all lemmas are directly provable as stated: you will often need intermediate lemmas. For example, for `eval_deterministic`, you will likely want to prove an variant with premises reordered to get a stronger induction hypothesis. For `opt_constprop_sound`, you'll want to make a generalized version with an arbitrary `consts` set instead of `$0`. 19 | 20 | --- 21 | 22 | Automation can help with many of the proofs in this psets. The tactics `eval_intro` and `eval_elim` may be convenient building blocks to use in your own tactics. 23 | 24 | To detect an arbitrary match from Ltac, use `match ?x with _ => _ end`: 25 | |*) 26 | 27 | Ltac cases_any := 28 | match goal with 29 | | [ |- context[match ?x with _ => _ end] ] => cases x 30 | end. 31 | 32 | Goal (forall x y z: bool, x || y || z || true = true). 33 | Proof. 34 | unfold orb. 35 | simplify; repeat cases_any; eauto. 36 | Qed. 37 | 38 | (*| 39 | --- 40 | 41 | Coq's standard library contains many lemmas — you do not need to prove 42 | everything from first principles! Among other lemmas, our solution uses the 43 | following, which gets automatically picked up by `simplify`. 44 | |*) 45 | 46 | Hint Rewrite Nat.mul_0_r Nat.div_1_r Nat.add_0_r. 47 | Hint Rewrite <- Nat.ones_equiv. 48 | Hint Rewrite Nat.mul_1_r Nat.shiftl_mul_pow2 Nat.shiftr_div_pow2 Nat.land_ones. 49 | 50 | (*| 51 | As always, use `Search` to find relevant lemmas. 52 | 53 | --- 54 | 55 | Beware of issues with operator precedence: 56 | - `(n - 1) mod 2` is not the same as `n - 1 mod 2`. 57 | - `a $<= b /\ P` is not the same as `(a $<= b) /\ P` 58 | 59 | Problem-specific hints 60 | ====================== 61 | 62 | Constant propagation 63 | -------------------- 64 | 65 | You will have an easier time if you define a function to test for constants, like so: 66 | |*) 67 | 68 | Definition as_const (e: expr) : option nat := 69 | match e with 70 | | Const n => Some n 71 | | _ => None 72 | end. 73 | 74 | (*| 75 | Otherwise, goals will get very large. 76 | 77 | ---- 78 | 79 | In the proof of `opt_constprop_sound`, or more likely the strengthened version of it, you will probably find the following lemma useful: 80 | |*) 81 | 82 | Lemma includes_remove_add (consts v: valuation) x n: 83 | consts $<= v -> 84 | consts $- x $<= v $+ (x, n). 85 | Proof. 86 | simplify; apply includes_intro; simplify. 87 | cases (x ==v k); subst; simplify; try equality. 88 | eauto using includes_lookup. 89 | Qed. 90 | 91 | (*| 92 | Loop unrolling 93 | -------------- 94 | 95 | In the implementation of `read_only`, you can use `if x ==v x0 then true else false` to get a Boolean indicating whether two variables are equal. 96 | 97 | --- 98 | 99 | Programs in this section can get pretty big — consider adding intermediate definitions and proving lemmas about them. For example, I used this: 100 | |*) 101 | 102 | Definition loop1 x body := 103 | body;; x <- x - 1. 104 | 105 | Lemma opt_unroll_decr : forall {phi v v' x body n}, 106 | eval phi v (loop1 x body) v' -> 107 | read_only body x = true -> 108 | v $? x = Some n -> 109 | v' $? x = Some (n - 1). 110 | Abort. 111 | 112 | (*| 113 | The key difficulty in this problem is connecting the unrolled loop body to the original loop body. Because of the way `EvalWhileTrue` and `EvalWhileFalse` are defined, regular induction gives you two cases: one where the loop exists immediately and one where it runs `n + 1` times. 114 | 115 | Instead, you want to think about three cases: the loops exits immediately, the loop runs a single time, and the loop runs `n + 2` times. The key is to make a lemma that mentions both of these cases at once. Let's look at a concrete example: 116 | |*) 117 | 118 | Fixpoint even (n: nat) := 119 | match n with 120 | | 0 => True 121 | | 1 => False 122 | | S (S n) => even n 123 | end. 124 | 125 | Lemma even_sum : forall x y, even x -> even y -> even (x + y). 126 | Proof. 127 | induct x; simplify. 128 | - assumption. 129 | - cases x. 130 | + equality. 131 | + simpl. 132 | 133 | (*| 134 | This proof is stuck: intuitively, IH steps one step forward, and we want to take two steps at once. 135 | |*) 136 | 137 | Abort. 138 | 139 | (*| 140 | The trick is to generalize the lemma to assert two "levels": 141 | |*) 142 | 143 | Lemma even_sum : forall x y, 144 | (even x -> even y -> even (x + y)) /\ 145 | (even (S x) -> even y -> even (S x + y)). 146 | Proof. 147 | induct x. 148 | - simplify; cases y; first_order. 149 | - simplify; firstorder. 150 | Qed. 151 | 152 | (*| 153 | What does that mean for this pset? Chances are you'll probably come up with a lemma that looks like this at some point: 154 | |*) 155 | 156 | Lemma opt_unroll_template_sound : forall phi v v' x body n, 157 | n mod 2 = 0 -> 158 | v $? x = Some n -> 159 | read_only body x = true -> 160 | eval phi v (while x loop (loop1 x body) done) v' -> 161 | eval phi v (while x loop (loop1 x body);; (loop1 x body) done) v'. 162 | Abort. 163 | 164 | (*| 165 | … but it won't work by induction. No, what you need is this, which *will* work by induction: 166 | |*) 167 | 168 | Lemma opt_unroll_template_mx_sound : forall phi v v' x body n, 169 | v $? x = Some n -> 170 | read_only body x = true -> 171 | eval phi v (while x loop (loop1 x body) done) v' -> 172 | eval phi v (if n mod 2 ==n 0 then 173 | while x loop (loop1 x body);; (loop1 x body) done 174 | else 175 | (loop1 x body);; 176 | while x loop (loop1 x body);; (loop1 x body) done) v'. 177 | Abort. 178 | 179 | (*| 180 | One last trick: this form with an `if` is essentially a partially-evaluated version of the full loop-unrolling template, with the “fixup” phase at the beginning. In other words, you can prove the following theorem: 181 | |*) 182 | 183 | Lemma opt_unroll_eqn {phi v v' body x}: 184 | let n := match v $? x with Some n => n | None => 0 end in 185 | eval phi v (if n mod 2 ==n 0 then 186 | while x loop (loop1 x body);; (loop1 x body) done 187 | else 188 | (loop1 x body);; 189 | while x loop (loop1 x body);; (loop1 x body) done) v' -> 190 | eval phi v (when (x mod 2) then loop1 x body else Skip done;; 191 | while x loop (loop1 x body);; (loop1 x body) done) v'. 192 | Abort. 193 | -------------------------------------------------------------------------------- /pset06_ProgramTransformations/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: coq clean 2 | 3 | COQC=coqc -q -R ../frap Frap 4 | 5 | coq: 6 | $(COQC) Pset6Sig.v 7 | $(COQC) Pset6.v 8 | 9 | clean: 10 | rm -f *.vo *.glob *.aux .*.aux .*.cache *.vok *.vos 11 | -------------------------------------------------------------------------------- /pset06_ProgramTransformations/Pset6Sig.v: -------------------------------------------------------------------------------- 1 | Require Export Frap.Frap. 2 | From Coq Require Export NArith. 3 | From Coq Require Export Program.Equality. 4 | 5 | Arguments N.add : simpl nomatch. 6 | Arguments N.sub : simpl nomatch. 7 | Arguments N.mul : simpl nomatch. 8 | Arguments N.div : simpl nomatch. 9 | Arguments N.shiftl : simpl nomatch. 10 | Arguments N.shiftr : simpl nomatch. 11 | 12 | (*| 13 | Totals below don't sum up to 100%! This is because this pset is a 14 | chose-your-own-adventure assignment, so you can pick what to do. Here is the 15 | complete rubric, which choice points indicated by `==`:: 16 | 17 | 1 Axiom opt_binop_fold_test1 18 | 8 Axiom opt_binop_fold_sound 19 | = Arith (23 points) 20 | == Precompute 21 | 17 Axiom opt_binop_precompute_sound 22 | 3 Axiom opt_arith_precompute_test1 23 | 3 Axiom opt_arith_precompute_test2 24 | == Log 25 | 17 Axiom opt_binop_log2_sound 26 | 3 Axiom opt_arith_log2_test1 27 | 3 Axiom opt_arith_log2_test2 28 | == Bitwise 29 | 17 Axiom opt_binop_bitwise_sound 30 | 3 Axiom opt_arith_bitwise_test1 31 | 3 Axiom opt_arith_bitwise_test2 32 | 4 Axiom opt_arith_fold_test1 33 | 10 Axiom opt_arith_sound 34 | 3 Axiom opt_unskip_test1 35 | 3 Axiom opt_unskip_test2 36 | 16 Axiom opt_unskip_sound 37 | = Eval (32 points) 38 | == ConstProp 39 | 8 Axiom opt_arith_constprop_sound 40 | 3 Axiom opt_constprop_test1 41 | 3 Axiom opt_constprop_test2 42 | 18 Axiom opt_constprop_sound 43 | == Unroll 44 | 6 Parameter eval_read_only 45 | 3 Axiom opt_unroll_test1 46 | 3 Axiom opt_unroll_test2 47 | 20 Axiom opt_unroll_sound 48 | -- Total 100 49 | |*) 50 | 51 | Module Type S. 52 | Inductive BinopName : Set := 53 | LogAnd : BinopName 54 | | Eq : BinopName 55 | | ShiftLeft : BinopName 56 | | ShiftRight : BinopName 57 | | Times : BinopName 58 | | Divide : BinopName 59 | | Plus : BinopName 60 | | Minus : BinopName 61 | | Modulo : BinopName. 62 | 63 | Inductive expr : Set := 64 | Const : nat -> expr 65 | | Var : var -> expr 66 | | Binop : BinopName -> expr -> expr -> expr. 67 | 68 | Inductive cmd : Set := 69 | Skip : cmd 70 | | Assign : var -> expr -> cmd 71 | | AssignCall : var -> var -> expr -> expr -> cmd 72 | | Sequence : cmd -> cmd -> cmd 73 | | If : expr -> cmd -> cmd -> cmd 74 | | While : expr -> cmd -> cmd. 75 | 76 | Declare Scope expr. 77 | Delimit Scope expr with expr. 78 | 79 | Coercion Const : nat >-> expr. 80 | Coercion Var : var >-> expr. 81 | 82 | Infix "&" := (Binop LogAnd) (at level 80) : expr. 83 | Infix "==" := (Binop Eq) (at level 70) : expr. 84 | Infix ">>" := (Binop ShiftRight) (at level 60) : expr. 85 | Infix "<<" := (Binop ShiftLeft) (at level 60) : expr. 86 | Infix "+" := (Binop Plus) (at level 50, left associativity) : expr. 87 | Infix "-" := (Binop Minus) (at level 50, left associativity) : expr. 88 | Infix "*" := (Binop Times) (at level 40, left associativity) : expr. 89 | Infix "/" := (Binop Divide) (at level 40, left associativity) : expr. 90 | Infix "mod" := (Binop Modulo) (at level 40) : expr. 91 | 92 | Notation "x <- e" := 93 | (Assign x e%expr) 94 | (at level 75). 95 | Notation "x <- 'call1' f e1" := 96 | (AssignCall x f e1%expr (Const 0)) 97 | (at level 75, f at level 0, e1 at level 0). 98 | Notation "x <- 'call2' f e1 e2" := 99 | (AssignCall x f e1%expr e2%expr) 100 | (at level 75, f at level 0, e1 at level 0, e2 at level 0). 101 | Infix ";;" := 102 | Sequence (at level 76). 103 | Notation "'when' e 'then' then_ 'else' else_ 'done'" := 104 | (If e%expr then_ else_) 105 | (at level 75, e at level 0). 106 | Notation "'while' e 'loop' body 'done'" := 107 | (While e%expr body) 108 | (at level 75). 109 | 110 | Example Times3Plus1Body := 111 | ("n" <- "n" * 3 + 1). 112 | 113 | Example FactBody := 114 | ("f" <- 1;; 115 | while "n" loop 116 | "f" <- "f" * "n";; 117 | "n" <- "n" - 1 118 | done). 119 | 120 | Example FactRecBody := 121 | (when "n" == 1 then 122 | "f" <- 1 123 | else 124 | "f" <- call1 "fact_r" ("n" - 1);; 125 | "f" <- "f" * "n" 126 | done). 127 | 128 | Example FactTailRecBody := 129 | (when "n" == 1 then 130 | "f" <- "acc" 131 | else 132 | "f" <- call2 "fact_tr" ("n" - 1) ("acc" * "n") 133 | done). 134 | 135 | Example CollatzBody := 136 | (when ("start" == 1) then 137 | Skip 138 | else when ("start" mod 2 == 0) then 139 | "start" <- "start" / 2 140 | else 141 | (* `call1 f arg` is short for `call2 f arg 0` *) 142 | "start" <- call1 "times3plus1" ("start" + 0) 143 | done;; 144 | "flight" <- call2 "collatz" "start" ("flight" + 1) 145 | done). 146 | 147 | Notation TimesThreePlus1_signature := (("n", ""), "n", Times3Plus1Body). 148 | Notation Fact_signature := (("n", ""), "f", FactBody). 149 | Notation FactRec_signature := (("n", ""), "f", FactRecBody). 150 | Notation FactTailRec_signature := (("n", "acc"), "f", FactTailRecBody). 151 | Notation Collatz_signature := (("start", "flight"), "flight", CollatzBody). 152 | 153 | Notation Collatz_env := 154 | ($0 155 | $+ ("collatz", Collatz_signature) 156 | $+ ("times3plus1", TimesThreePlus1_signature)). 157 | 158 | Notation Fact_env := 159 | ($0 160 | $+ ("fact", Fact_signature) 161 | $+ ("fact_r", FactRec_signature) 162 | $+ ("fact_tr", FactTailRec_signature)). 163 | 164 | Parameter interp_binop : BinopName -> nat -> nat -> nat. 165 | 166 | Definition valuation := fmap var nat. 167 | Parameter interp_arith : expr -> valuation -> nat. 168 | 169 | Definition environment := fmap string ((var * var) * var * cmd). 170 | 171 | Inductive eval (phi: environment): valuation -> cmd -> valuation -> Prop := 172 | | EvalSkip: forall v, 173 | eval phi v Skip v 174 | | EvalAssign: forall v x e a, 175 | interp_arith e v = a -> 176 | eval phi v (Assign x e) (v $+ (x, a)) 177 | | EvalAssignCall: forall x f e1 e2 x1 x2 y body a1 a2 a v v', 178 | phi $? f = Some ((x1, x2), y, body) -> 179 | interp_arith e1 v = a1 -> 180 | interp_arith e2 v = a2 -> 181 | eval phi ($0 $+ (x1, a1) $+ (x2, a2)) body v' -> 182 | v' $? y = Some a -> 183 | eval phi v (AssignCall x f e1 e2) (v $+ (x, a)) 184 | | EvalSequence: forall v c1 v1 c2 v2, 185 | eval phi v c1 v1 -> 186 | eval phi v1 c2 v2 -> 187 | eval phi v (Sequence c1 c2) v2 188 | | EvalIfTrue: forall v e thn els v' c, 189 | interp_arith e v = c -> 190 | c <> 0 -> 191 | eval phi v thn v' -> 192 | eval phi v (If e thn els) v' 193 | | EvalIfFalse: forall v e thn els v', 194 | interp_arith e v = 0 -> 195 | eval phi v els v' -> 196 | eval phi v (If e thn els) v' 197 | | EvalWhileTrue: forall v e body v' v'' c, 198 | interp_arith e v = c -> 199 | c <> 0 -> 200 | eval phi v body v' -> 201 | eval phi v' (While e body) v'' -> 202 | eval phi v (While e body) v'' 203 | | EvalWhileFalse: forall v e body, 204 | interp_arith e v = 0 -> 205 | eval phi v (While e body) v. 206 | 207 | Definition eval_returns phi v cmd outVar result := 208 | exists v', eval phi v cmd v' /\ v' $? outVar = Some result. 209 | 210 | Axiom TwoPlusTwoIsFour : 211 | eval_returns $0 $0 ("out" <- 2 + 2) "out" 4. 212 | Axiom EvalVars : 213 | eval_returns $0 $0 ("x" <- 1 + 1;; "x" <- "x" + "x" + "y") "x" 4. 214 | Axiom EvalSimpleArith : 215 | eval_returns $0 $0 ("out" <- (((14 >> 1) + 8 / 4 / 2) * (7 - 2) << 1) + 2 == 82) "out" 1. 216 | Axiom EvalTimes3Plus1 : forall n : nat, 217 | eval_returns $0 ($0 $+ ("n", n)) Times3Plus1Body "n" (3 * n + 1). 218 | Axiom EvalFact6 : exists v : valuation, 219 | eval $0 ($0 $+ ("n", 3)) FactBody v /\ v $? "f" = Some 6. 220 | Axiom EvalFactRec6 : exists v : valuation, 221 | eval Fact_env ($0 $+ ("n", 3)) FactRecBody v /\ v $? "f" = Some 6. 222 | Axiom EvalFactTailRec6 : exists v : valuation, 223 | eval Fact_env ($0 $+ ("n", 3) $+ ("acc", 1)) FactTailRecBody v /\ 224 | v $? "f" = Some 6. 225 | Axiom collatz_result : exists v : valuation, 226 | eval Collatz_env ($0 $+ ("flight", 0) $+ ("start", 10)) CollatzBody v /\ 227 | v $? "flight" = Some 6. 228 | 229 | Parameter opt_binop_fold : BinopName -> expr -> expr -> expr. 230 | (*[1%]*) Axiom opt_binop_fold_test1 : opt_binop_fold Plus "x" 0 = "x". 231 | 232 | (*[8%]*) Axiom opt_binop_fold_sound : 233 | forall (b : BinopName) (e1 e2 : expr) (v : valuation), 234 | interp_arith (opt_binop_fold b e1 e2) v = 235 | interp_binop b (interp_arith e1 v) (interp_arith e2 v). 236 | 237 | Parameter opt_binop_precompute : BinopName -> expr -> expr -> expr. 238 | (*[Arith/Precompute:17%]*) Axiom opt_binop_precompute_sound : 239 | forall (b : BinopName) (e1 e2 : expr) (v : valuation), 240 | interp_arith (opt_binop_precompute b e1 e2) v = 241 | interp_binop b (interp_arith e1 v) (interp_arith e2 v). 242 | 243 | Parameter opt_binop_log2 : BinopName -> expr -> expr -> expr. 244 | (*[Arith/Log:17%]*) Axiom opt_binop_log2_sound : 245 | forall (b : BinopName) (e1 e2 : expr) (v : valuation), 246 | interp_arith (opt_binop_log2 b e1 e2) v = 247 | interp_binop b (interp_arith e1 v) (interp_arith e2 v). 248 | 249 | Parameter opt_binop_bitwise : BinopName -> expr -> expr -> expr. 250 | (*[Arith/Bitwise:17%]*) Axiom opt_binop_bitwise_sound : 251 | forall (b : BinopName) (e1 e2 : expr) (v : valuation), 252 | interp_arith (opt_binop_bitwise b e1 e2) v = 253 | interp_binop b (interp_arith e1 v) (interp_arith e2 v). 254 | 255 | Parameter opt_arith : expr -> expr. 256 | 257 | (*[4%]*) Axiom opt_arith_fold_test1 : 258 | opt_arith (1 + "z" * ("y" * ("x" * (0 + 0 / 1))))%expr = 259 | (1)%expr. 260 | (*[Arith/Precompute:3%]*) Axiom opt_arith_precompute_test1: 261 | opt_arith (("x" + (3 - 3)) / (0 + 1) + ("y" + "y" * 0))%expr = 262 | ("x" + "y")%expr. 263 | (*[Arith/Precompute:3%]*) Axiom opt_arith_precompute_test2 : 264 | opt_arith ((("y" / ("x" * 0 + 7 / 1)) mod (12 - 5)) / (2 * 3))%expr = 265 | (("y" / 7) mod 7 / 6)%expr. 266 | (*[Arith/Log:3%]*) Axiom opt_arith_log2_test1 : 267 | opt_arith (("y" * 8) mod 8 / 4)%expr = 268 | (("y" << 3 & 7) >> 2)%expr. 269 | (*[Arith/Log:3%]*) Axiom opt_arith_log2_test2 : 270 | opt_arith (("y" * 1 + (4 + 0)) mod 9 / 3)%expr = 271 | (("y" + 4) mod 9 / 3)%expr. 272 | (*[Arith/Bitwise:3%]*) Axiom opt_arith_bitwise_test1 : 273 | opt_arith ("y" * 13)%expr = 274 | ("y" + (("y" << 2) + ("y" << 3)))%expr. 275 | (*[Arith/Bitwise:3%]*) Axiom opt_arith_bitwise_test2 : 276 | opt_arith ("y" * (3 + 0))%expr = 277 | ("y" + ("y" << 1))%expr. 278 | 279 | (*[10%]*) Axiom opt_arith_sound : 280 | forall (e : expr) (v : valuation), 281 | interp_arith (opt_arith e) v = interp_arith e v. 282 | 283 | Parameter opt_unskip : cmd -> cmd. 284 | 285 | (*[3%]*) Axiom opt_unskip_test1 : 286 | opt_unskip (Skip;; (Skip;; Skip);; (Skip;; Skip;; Skip)) = 287 | Skip. 288 | (*[3%]*) Axiom opt_unskip_test2 : 289 | opt_unskip (when 0 then (Skip;; Skip) else Skip done;; 290 | while 0 loop Skip;; Skip done;; Skip) = 291 | (when 0 then Skip else Skip done;; while 0 loop Skip done). 292 | 293 | (*[16%]*) Axiom opt_unskip_sound : 294 | forall (phi : environment) (c : cmd) (v v' : valuation), 295 | eval phi v c v' -> eval phi v (opt_unskip c) v'. 296 | 297 | Parameter opt_arith_constprop : expr -> valuation -> expr. 298 | 299 | (*[Eval/ConstProp:8%]*) Axiom opt_arith_constprop_sound : 300 | forall (e : expr) (v consts : fmap var nat), 301 | consts $<= v -> 302 | interp_arith (opt_arith_constprop e consts) v = interp_arith e v. 303 | 304 | Parameter opt_constprop : cmd -> cmd. 305 | 306 | (*[Eval/ConstProp:3%]*) Axiom opt_constprop_test1 : 307 | opt_constprop FactBody = FactBody. 308 | (*[Eval/ConstProp:3%]*) Axiom opt_constprop_test2 : 309 | opt_constprop ("x" <- 7;; "y" <- "x";; 310 | when "x" mod "w" then 311 | "z" <- "x";; "t" <- "z";; while "t" loop "t" <- "t" - 1 done 312 | else 313 | "z" <- "u" + "x";; "t" <- "z" 314 | done;; 315 | "r" <- "z") = 316 | ("x" <- 7;; "y" <- 7;; 317 | when 7 mod "w" then 318 | "z" <- 7;; "t" <- 7;; while "t" loop "t" <- "t" - 1 done 319 | else 320 | "z" <- "u" + 7;; "t" <- "z" 321 | done;; 322 | "r" <- "z"). 323 | 324 | (*[Eval/ConstProp:18%]*) Axiom opt_constprop_sound : 325 | forall (phi : environment) (c : cmd) (v v' : valuation), 326 | eval phi v c v' -> eval phi v (opt_constprop c) v'. 327 | 328 | Parameter read_only : forall (c: cmd) (x0: var), bool. 329 | 330 | (*[Eval/Unroll:6%]*) 331 | Parameter eval_read_only: forall {phi v v' x c}, 332 | eval phi v c v' -> 333 | read_only c x = true -> 334 | v' $? x = v $? x. 335 | 336 | Parameter opt_unroll : cmd -> cmd. 337 | 338 | (*[Eval/Unroll:3%]*) Axiom opt_unroll_test1 : 339 | opt_unroll CollatzBody = CollatzBody. 340 | (*[Eval/Unroll:3%]*) Axiom opt_unroll_test2 : 341 | opt_unroll FactBody <> FactBody. 342 | 343 | (*[Eval/Unroll:20%]*) Axiom opt_unroll_sound : 344 | forall (phi : environment) (c : cmd) (v v' : valuation), 345 | eval phi v c v' -> eval phi v (opt_unroll c) v'. 346 | End S. 347 | 348 | Global Arguments Nat.modulo !_ !_ /. 349 | Global Arguments Nat.div !_ !_. 350 | Global Arguments Nat.log2 !_ /. 351 | -------------------------------------------------------------------------------- /pset06_ProgramTransformations/_CoqProject: -------------------------------------------------------------------------------- 1 | -Q ../frap Frap 2 | -------------------------------------------------------------------------------- /pset06_ProgramTransformations/collatz1.c: -------------------------------------------------------------------------------- 1 | static unsigned int affine(unsigned int n, 2 | unsigned int slope, 3 | unsigned int offset) { 4 | return n * slope + offset; 5 | } 6 | 7 | unsigned int collatz1(unsigned int start) { 8 | if (start == 1) 9 | return 0; 10 | else if (start % 2 == 0) 11 | return collatz1(start / 2) + 1; 12 | else 13 | return collatz1(affine(start, 3, 1)) + 1; 14 | } 15 | -------------------------------------------------------------------------------- /pset06_ProgramTransformations/collatz2.c: -------------------------------------------------------------------------------- 1 | unsigned int collatz2(unsigned int start) { 2 | unsigned int flight = 0; 3 | while (start != 1) { 4 | flight++; 5 | if ((start & 1) == 0) { 6 | start = start >> 1; 7 | } else { 8 | start = start * 2 + start + 1; 9 | } 10 | } 11 | return flight; 12 | } 13 | -------------------------------------------------------------------------------- /pset07_Subtyping/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: coq clean 2 | 3 | COQC=coqc -q -R ../frap Frap 4 | 5 | coq: 6 | $(COQC) Pset7Sig.v 7 | $(COQC) Pset7.v 8 | 9 | clean: 10 | rm -f *.vo *.glob *.aux .*.aux .lia.cache .nia.cache *.vok *.vos 11 | -------------------------------------------------------------------------------- /pset07_Subtyping/Pset7.v: -------------------------------------------------------------------------------- 1 | (** * 6.822 Formal Reasoning About Programs, Spring 2021 - Pset 7 *) 2 | 3 | Require Import Frap.Frap. 4 | Require Import Pset7Sig. 5 | 6 | (* The following line forces you to use bullets or braces. Remove it if you get 7 | errors like "Expected a single focused goal but 2 goals are focused." and you 8 | don't want to structure your proofs. *) 9 | Set Default Goal Selector "!". 10 | Set Implicit Arguments. 11 | 12 | Module Impl. 13 | (** * Subtyping *) 14 | 15 | (* We can't resist fitting in another crucial aspect of type systems: 16 | * *subtyping*, which formalizes when any value of one type should also be 17 | * permitted as a value of some other type. Languages like Java include 18 | * *nominal* subtyping, based on declared type hierarchies. Instead, here we 19 | * will prove soundness of *structural* subtyping, whose rules we'll get to 20 | * shortly. The simply typed lambda calculus will be our starting point. *) 21 | 22 | (* Expression syntax *) 23 | Inductive exp := 24 | (* Our old friends from simply typed lambda calculus *) 25 | | Var (x : var) 26 | | Abs (x : var) (e1 : exp) 27 | | App (e1 e2 : exp) 28 | 29 | (* New features, surrounding *tuple* types, which build composite types out of 30 | * constituents *) 31 | | TupleNil 32 | (* Empty tuple (no fields *) 33 | | TupleCons (e1 e2 : exp) 34 | (* Nonempty tuple, where [e1] is the first field of the tuple, and [e2] is a 35 | * nested tuple with all the remaining fields *) 36 | 37 | | Proj (e : exp) (n : nat) 38 | (* Grab the [n]th field of tuple [e]. *) 39 | . 40 | 41 | (* Values (final results of evaluation) *) 42 | Inductive value : exp -> Prop := 43 | | VAbs : forall x e1, value (Abs x e1) 44 | | VTupleNil : value TupleNil 45 | | VTupleCons : forall e1 e2, value e1 -> value e2 -> value (TupleCons e1 e2) 46 | . 47 | 48 | (* The next few definitions are quite routine and should be safe to skim through 49 | * quickly; but start paying more attention when we get to defining the 50 | * subtyping relation! *) 51 | 52 | (* Substitution (not capture-avoiding, for the usual reason) *) 53 | Fixpoint subst (e1 : exp) (x : var) (e2 : exp) : exp := 54 | match e2 with 55 | | Var y => if y ==v x then e1 else Var y 56 | | Abs y e2' => Abs y (if y ==v x then e2' else subst e1 x e2') 57 | | App e2' e2'' => App (subst e1 x e2') (subst e1 x e2'') 58 | | TupleNil => TupleNil 59 | | TupleCons e2' e2'' => TupleCons (subst e1 x e2') (subst e1 x e2'') 60 | | Proj e2' n => Proj (subst e1 x e2') n 61 | end. 62 | 63 | (* Evaluation contexts *) 64 | Inductive context := 65 | | Hole 66 | | App1 (C : context) (e2 : exp) 67 | | App2 (v1 : exp) (C : context) 68 | | TupleCons1 (C : context) (e2 : exp) 69 | | TupleCons2 (v1 : exp) (C : context) 70 | | Proj1 (C : context) (n : nat) 71 | . 72 | 73 | (* Plugging an expression into a context *) 74 | Inductive plug : context -> exp -> exp -> Prop := 75 | | PlugHole : forall e, plug Hole e e 76 | | PlugApp1 : forall e e' C e2, 77 | plug C e e' 78 | -> plug (App1 C e2) e (App e' e2) 79 | | PlugApp2 : forall e e' v1 C, 80 | value v1 81 | -> plug C e e' 82 | -> plug (App2 v1 C) e (App v1 e') 83 | | PlugTupleCons1 : forall C e e' e2, 84 | plug C e e' 85 | -> plug (TupleCons1 C e2) e (TupleCons e' e2) 86 | | PlugTupleCons2 : forall v1 C e e', 87 | value v1 88 | -> plug C e e' 89 | -> plug (TupleCons2 v1 C) e (TupleCons v1 e') 90 | | PlugProj : forall C e e' n, 91 | plug C e e' 92 | -> plug (Proj1 C n) e (Proj e' n) 93 | . 94 | 95 | (* Small-step, call-by-value evaluation *) 96 | Inductive step0 : exp -> exp -> Prop := 97 | | Beta : forall x e v, 98 | value v 99 | -> step0 (App (Abs x e) v) (subst v x e) 100 | 101 | (* To project field 0 out of a tuple, just grab the first component. *) 102 | | Proj0 : forall v1 v2, 103 | value v1 104 | -> value v2 105 | -> step0 (Proj (TupleCons v1 v2) 0) v1 106 | 107 | (* To project field [1+n], drop the first component and continue with [n]. *) 108 | | ProjS : forall v1 v2 n, 109 | value v1 110 | -> value v2 111 | -> step0 (Proj (TupleCons v1 v2) (1 + n)) (Proj v2 n) 112 | . 113 | 114 | Inductive step : exp -> exp -> Prop := 115 | | StepRule : forall C e1 e2 e1' e2', 116 | plug C e1 e1' 117 | -> plug C e2 e2' 118 | -> step0 e1 e2 119 | -> step e1' e2'. 120 | 121 | Definition trsys_of (e : exp) := 122 | {| Initial := {e}; Step := step |}. 123 | 124 | (* Syntax of types *) 125 | Inductive type := 126 | | Fun (dom ran : type) 127 | | TupleTypeNil 128 | | TupleTypeCons (t1 t2 : type) 129 | . 130 | 131 | Inductive subtype : type -> type -> Prop := 132 | 133 | (* Two function types are related if their components are related pairwise. 134 | * Counterintuitively, we *reverse* the comparison order for function domains! 135 | * It may be worth working through some examples to see why the relation would 136 | * otherwise be unsound. *) 137 | | StFun : forall t1' t2' t1 t2, 138 | subtype t1 t1' -> 139 | subtype t2' t2 -> 140 | subtype (Fun t1' t2') (Fun t1 t2) 141 | 142 | (* An empty tuple type is its own subtype. *) 143 | | StTupleNilNil : 144 | subtype TupleTypeNil TupleTypeNil 145 | 146 | (* However, a nonempty tuple type is also a subtype of the empty tuple type. 147 | * This rule gives rise to *width* subtyping, where we can drop some fields of 148 | * a tuple type to produce a subtype. *) 149 | | StTupleNilCons : forall t1 t2, 150 | subtype (TupleTypeCons t1 t2) TupleTypeNil 151 | 152 | (* We also have *depth* subtyping: we can replace tuple components with 153 | * subtypes. *) 154 | | StTupleCons : forall t1' t2' t1 t2, 155 | subtype t1' t1 -> 156 | subtype t2' t2 -> 157 | subtype (TupleTypeCons t1' t2') (TupleTypeCons t1 t2) 158 | . 159 | 160 | (* Here's a more compact notation for subtyping. *) 161 | Infix "$<:" := subtype (at level 70). 162 | 163 | Hint Constructors subtype : core. 164 | 165 | (* Projecting out the nth field of a tuple type *) 166 | Inductive proj_t : type -> nat -> type -> Prop := 167 | | ProjT0 : forall t1 t2, 168 | proj_t (TupleTypeCons t1 t2) 0 t1 169 | | ProjTS : forall t1 t2 n t, 170 | proj_t t2 n t -> 171 | proj_t (TupleTypeCons t1 t2) (1 + n) t 172 | . 173 | 174 | (* Expression typing relation *) 175 | Inductive hasty : fmap var type -> exp -> type -> Prop := 176 | | HtVar : forall G x t, 177 | G $? x = Some t -> 178 | hasty G (Var x) t 179 | | HtAbs : forall G x e1 t1 t2, 180 | hasty (G $+ (x, t1)) e1 t2 -> 181 | hasty G (Abs x e1) (Fun t1 t2) 182 | | HtApp : forall G e1 e2 t1 t2, 183 | hasty G e1 (Fun t1 t2) -> 184 | hasty G e2 t1 -> 185 | hasty G (App e1 e2) t2 186 | | HtTupleNil : forall G, 187 | hasty G TupleNil TupleTypeNil 188 | | HtTupleCons: forall G e1 e2 t1 t2, 189 | hasty G e1 t1 -> 190 | hasty G e2 t2 -> 191 | hasty G (TupleCons e1 e2) (TupleTypeCons t1 t2) 192 | | HtProj : forall G e n t t', 193 | hasty G e t' -> 194 | proj_t t' n t -> 195 | hasty G (Proj e n) t 196 | 197 | (* This is the crucial rule: when an expression has a type, it also has any 198 | * supertype of that type. We call this rule *subsumption*. *) 199 | | HtSub : forall G e t t', 200 | hasty G e t' -> 201 | t' $<: t -> 202 | hasty G e t 203 | . 204 | 205 | (* Prove these two basic algebraic properties of subtyping. *) 206 | 207 | Lemma subtype_refl : forall t1, t1 $<: t1. 208 | Proof. 209 | Admitted. 210 | 211 | Lemma subtype_trans : forall t1 t2 t3, t1 $<: t2 -> t2 $<: t3 -> t1 $<: t3. 212 | Proof. 213 | Admitted. 214 | 215 | (* BEGIN handy tactic that we suggest for these proofs *) 216 | Ltac tac0 := 217 | match goal with 218 | | [ H : ex _ |- _ ] => invert H 219 | | [ H : _ /\ _ |- _ ] => invert H 220 | | [ |- context[_ $+ (?x, _) $? ?y] ] => cases (x ==v y); simplify 221 | | [ |- context[?x ==v ?y] ] => cases (x ==v y); simplify 222 | | [ H : step _ _ |- _ ] => invert H 223 | | [ H : step0 _ _ |- _ ] => invert1 H 224 | | [ H : hasty _ _ _ |- _ ] => invert1 H 225 | | [ H : proj_t _ _ _ |- _ ] => invert1 H 226 | | [ H : plug _ _ _ |- _ ] => invert1 H 227 | | [ H : subtype _ _ |- _ ] => invert1 H 228 | | [ H : Some _ = Some _ |- _ ] => invert H 229 | end; 230 | subst. 231 | 232 | Ltac tac := simplify; subst; propositional; repeat (tac0; simplify); try equality. 233 | (* END handy tactic *) 234 | 235 | 236 | (* The real prize: prove soundness of this type system. 237 | * We suggest starting from a copy of the type-safety proof from the book's 238 | * EvaluationContexts.v. 239 | * The soundness argument for simply typed lambda calculus is genuinely difficult 240 | * (a celebrated result!). We're not expecing you to reinvent it. Rather, the 241 | * task of this pset is to *extend* it to cover subtyping. This will involve 242 | * changing some proofs and making appropriate additional helper lemmas (there 243 | * are more hints on the website). 244 | * Trying to write this proof from scratch is *not* recommended for this pset. 245 | * This is in contrast to the *previous* psets, which we tried to design so that 246 | * they could be solved from scratch with a good understanding of the lecture 247 | * material. *) 248 | Theorem safety : 249 | forall e t, 250 | hasty $0 e t -> invariantFor (trsys_of e) 251 | (fun e' => value e' 252 | \/ exists e'', step e' e''). 253 | Proof. 254 | Admitted. 255 | 256 | End Impl. 257 | 258 | (* The following line checks that your `Impl` module implements the right 259 | signature. Make sure that it works, or the auto-grader will break! 260 | If there are mismatches, Coq will report them (`Signature components for 261 | label … do not match`): *) 262 | Module ImplCorrect : Pset7Sig.S := Impl. 263 | 264 | (* Authors: 265 | * Peng Wang 266 | * Adam Chlipala 267 | * Samuel Gruetter 268 | *) 269 | -------------------------------------------------------------------------------- /pset07_Subtyping/Pset7Sig.v: -------------------------------------------------------------------------------- 1 | (** * 6.822 Formal Reasoning About Programs, Spring 2021 - Pset 7 *) 2 | 3 | Require Import Frap.Frap. 4 | 5 | Module Type S. 6 | 7 | (* --- DEFINITIONS --- *) 8 | 9 | Inductive exp := 10 | | Var (x : var) 11 | | Abs (x : var) (e1 : exp) 12 | | App (e1 e2 : exp) 13 | | TupleNil 14 | | TupleCons (e1 e2 : exp) 15 | | Proj (e : exp) (n : nat) 16 | . 17 | 18 | Inductive value : exp -> Prop := 19 | | VAbs : forall x e1, value (Abs x e1) 20 | | VTupleNil : value TupleNil 21 | | VTupleCons : forall e1 e2, value e1 -> value e2 -> value (TupleCons e1 e2) 22 | . 23 | 24 | Fixpoint subst (e1 : exp) (x : var) (e2 : exp) : exp := 25 | match e2 with 26 | | Var y => if y ==v x then e1 else Var y 27 | | Abs y e2' => Abs y (if y ==v x then e2' else subst e1 x e2') 28 | | App e2' e2'' => App (subst e1 x e2') (subst e1 x e2'') 29 | | TupleNil => TupleNil 30 | | TupleCons e2' e2'' => TupleCons (subst e1 x e2') (subst e1 x e2'') 31 | | Proj e2' n => Proj (subst e1 x e2') n 32 | end. 33 | 34 | Inductive context := 35 | | Hole 36 | | App1 (C : context) (e2 : exp) 37 | | App2 (v1 : exp) (C : context) 38 | | TupleCons1 (C : context) (e2 : exp) 39 | | TupleCons2 (v1 : exp) (C : context) 40 | | Proj1 (C : context) (n : nat) 41 | . 42 | 43 | Inductive plug : context -> exp -> exp -> Prop := 44 | | PlugHole : forall e, plug Hole e e 45 | | PlugApp1 : forall e e' C e2, 46 | plug C e e' 47 | -> plug (App1 C e2) e (App e' e2) 48 | | PlugApp2 : forall e e' v1 C, 49 | value v1 50 | -> plug C e e' 51 | -> plug (App2 v1 C) e (App v1 e') 52 | | PlugTupleCons1 : forall C e e' e2, 53 | plug C e e' 54 | -> plug (TupleCons1 C e2) e (TupleCons e' e2) 55 | | PlugTupleCons2 : forall v1 C e e', 56 | value v1 57 | -> plug C e e' 58 | -> plug (TupleCons2 v1 C) e (TupleCons v1 e') 59 | | PlugProj : forall C e e' n, 60 | plug C e e' 61 | -> plug (Proj1 C n) e (Proj e' n) 62 | . 63 | 64 | Inductive step0 : exp -> exp -> Prop := 65 | | Beta : forall x e v, 66 | value v 67 | -> step0 (App (Abs x e) v) (subst v x e) 68 | | Proj0 : forall v1 v2, 69 | value v1 70 | -> value v2 71 | -> step0 (Proj (TupleCons v1 v2) 0) v1 72 | | ProjS : forall v1 v2 n, 73 | value v1 74 | -> value v2 75 | -> step0 (Proj (TupleCons v1 v2) (1 + n)) (Proj v2 n) 76 | . 77 | 78 | Inductive step : exp -> exp -> Prop := 79 | | StepRule : forall C e1 e2 e1' e2', 80 | plug C e1 e1' 81 | -> plug C e2 e2' 82 | -> step0 e1 e2 83 | -> step e1' e2'. 84 | 85 | Definition trsys_of (e : exp) := 86 | {| Initial := {e}; Step := step |}. 87 | 88 | Inductive type := 89 | | Fun (dom ran : type) 90 | | TupleTypeNil 91 | | TupleTypeCons (t1 t2 : type) 92 | . 93 | 94 | Inductive subtype : type -> type -> Prop := 95 | | StFun : forall t1' t2' t1 t2, 96 | subtype t1 t1' -> 97 | subtype t2' t2 -> 98 | subtype (Fun t1' t2') (Fun t1 t2) 99 | | StTupleNilNil : 100 | subtype TupleTypeNil TupleTypeNil 101 | | StTupleNilCons : forall t1 t2, 102 | subtype (TupleTypeCons t1 t2) TupleTypeNil 103 | | StTupleCons : forall t1' t2' t1 t2, 104 | subtype t1' t1 -> 105 | subtype t2' t2 -> 106 | subtype (TupleTypeCons t1' t2') (TupleTypeCons t1 t2) 107 | . 108 | 109 | Infix "$<:" := subtype (at level 70). 110 | 111 | Inductive proj_t : type -> nat -> type -> Prop := 112 | | ProjT0 : forall t1 t2, 113 | proj_t (TupleTypeCons t1 t2) 0 t1 114 | | ProjTS : forall t1 t2 n t, 115 | proj_t t2 n t -> 116 | proj_t (TupleTypeCons t1 t2) (1 + n) t 117 | . 118 | 119 | Inductive hasty : fmap var type -> exp -> type -> Prop := 120 | | HtVar : forall G x t, 121 | G $? x = Some t -> 122 | hasty G (Var x) t 123 | | HtAbs : forall G x e1 t1 t2, 124 | hasty (G $+ (x, t1)) e1 t2 -> 125 | hasty G (Abs x e1) (Fun t1 t2) 126 | | HtApp : forall G e1 e2 t1 t2, 127 | hasty G e1 (Fun t1 t2) -> 128 | hasty G e2 t1 -> 129 | hasty G (App e1 e2) t2 130 | | HtTupleNil : forall G, 131 | hasty G TupleNil TupleTypeNil 132 | | HtTupleCons: forall G e1 e2 t1 t2, 133 | hasty G e1 t1 -> 134 | hasty G e2 t2 -> 135 | hasty G (TupleCons e1 e2) (TupleTypeCons t1 t2) 136 | | HtProj : forall G e n t t', 137 | hasty G e t' -> 138 | proj_t t' n t -> 139 | hasty G (Proj e n) t 140 | | HtSub : forall G e t t', 141 | hasty G e t' -> 142 | t' $<: t -> 143 | hasty G e t 144 | . 145 | 146 | (* --- THEOREMS TO PROVE (in Pset7.v) --- *) 147 | 148 | (*[5%]*) 149 | Axiom subtype_refl : forall t, t $<: t. 150 | 151 | (*[25%]*) 152 | Axiom subtype_trans : forall t1 t2 t3, t1 $<: t2 -> t2 $<: t3 -> t1 $<: t3. 153 | 154 | (*[70%]*) 155 | Axiom safety : 156 | forall e t, 157 | hasty $0 e t -> invariantFor (trsys_of e) 158 | (fun e' => value e' 159 | \/ exists e'', step e' e''). 160 | 161 | End S. 162 | -------------------------------------------------------------------------------- /pset07_Subtyping/_CoqProject: -------------------------------------------------------------------------------- 1 | -Q ../frap Frap 2 | -------------------------------------------------------------------------------- /pset07_Subtyping/hints.md: -------------------------------------------------------------------------------- 1 | ### Use LambdaCalculusAndTypeSoundness.v 2 | 3 | Make sure you read and understand `LambdaCalculusAndTypeSoundness.v` from FRAP, a lot of the proof structure from that file can be reused in this Pset! 4 | 5 | 6 | ### Transitivity of subtyping 7 | 8 | Before attempting to prove `subtype_trans`, make sure you understand why in `StFun`, the subtyping order of the argument types is reversed (this is called contravariance). Maybe it helps to think of it this way: If we have `u1 $<: u2`, all code expecting a `u2` should also work if we give it something more specific, such as a `u1`. Now if we have `Apple $<: Fruit $<: Food`, and `u2` is the type of fruit consumers, i.e. `u2 = Fun Fruit Result`, what can you safely replace a fruit consumer with? If you replace it with an apple consumer, but keep treating it like a fruit consumer, you might end up feeding pears to an apple consumer, and it might be allergic to pears, and you have a problem. On the other hand, replacing a fruit consumer with a food consumer and keep treating it like an fruit consumer is safe: All the apples you'll feed to the food consumer will be accepted by it (and the food consumer might be a bit surprised that its diet is less varied than expected, but that's not a soundness issue ;-)). 9 | 10 | If you try to prove `subtype_trans` as-is by inducting on the proof tree of `t1 $<: t2`, you will get stuck in the case where `t1 $<: t2` was created using `StFun`. 11 | To discuss this case, we will use `As` for argument types and `Bs` for return types, and use numbers such that they match the subtyping order, e.g. `A0 $<: A1 $<: A2 $<: A3` etc. Coq's autogenerated names will look different, and we encourage you to use commands like `rename t1 into myNewName` to give more intuitive names to the variables. 12 | In the `StFun` case, `induct` knows that the `t1 $<: t2` you're inducting on was created using the `StFun` constructor, and therefore the original `t1 $<: t2` can be written as `Fun A2 B1 $<: Fun A1 B2`, and the preconditions of `StFun` hold, that is, `A1 $<: A2` and `B1 $<: B2`. 13 | Moreover, you got a `t2 $<: t3`, and since you know that `t2` is a function type, inverting it will reveal that `t3` is a function type as well, so it can be written as `Fun A1 B2 $<: Fun A0 B3`, and `invert` also gave you `A0 $<: A1` and `B2 $<: B3` because these are the preconditions of `StFun`. 14 | Using this, and some IHs, you have to prove `t1 $<: t3`, i.e. `Fun A2 B1 $<: Fun A0 B3`. If you try applying `StFun`, you'll need to prove `A0 $<: A2` and `B1 $<: B3`. If you forgot to generalize `t3`, this will not work at all, but even if you change the statement to 15 | 16 | ``` 17 | Lemma subtype_trans_aux : forall t1 t2, t1 $<: t2 -> forall t3, t2 $<: t3 -> t1 $<: t3). 18 | ``` 19 | 20 | you can now prove `B1 $<: B3`, but proving `A0 $<: A2` will still not work. 21 | Let's look at the IH which allows us to prove `B1 $<: B3`: `induct` provided it because `B1 $<: B2` is a subproof of the derivation you're inducting on, and it tells you that you can "append" any subtyping derivation of the form `B2 $<: B3` to the right of it to obtain a `B1 $<: B3`. 22 | Now the other IH (the one which `induct` provides because `A1 <: A2` is a subproof of the derivation you're inducting on) also tells you that you can "append" another subtyping derivation to the right, but what you'd really need here would be to "append" an `A0 $<: A1` derivation *to the left* of the `A1 <: A2`. 23 | 24 | So it might help to spell out the *induction motive* `P` explicitly, that is, to write 25 | 26 | ``` 27 | Definition P(t1 t2: type): Prop := ... 28 | ``` 29 | 30 | and then to prove 31 | 32 | ``` 33 | Lemma subtype_trans_aux : forall t1 t2, t1 $<: t2 -> P t1 t2. 34 | ``` 35 | 36 | In our previous attempt, we did something which is equivalent to defining 37 | 38 | ``` 39 | Definition P t1 t2 := forall t3, t2 $<: t3 -> t1 $<: t3. 40 | ``` 41 | 42 | and observe how this only allows you to append a subtyping derivation on the right. 43 | Therefore, by using a conjunction `/\` in `P`, you should say that you can also append a subtyping derivation on the left, so that you get a stronger IH in the `StFun` case, and then `induct` on the `t1 $<: t2` derivation will work. 44 | 45 | 46 | ### Helper lemmas for progress: Canonical forms 47 | 48 | While proving the progress lemma, you will have a case where you know that the type of some expression is a function type and that this expression is a value. Without subtyping, you could just invert these two hypotheses (in the right order) to conclude that the expression is an Abs expression. But now that we have subtyping, the typing derivation could contain any number of `HtSub` usages, so you will need induction to peel them off, and to do that, you should prove a separate lemma. 49 | Also prove a similar lemma saying that if an expression has type `TupleTypeCons` and is a value, the expression is indeed a `TupleCons`. 50 | Existential quantifiers can be helpful to state those lemmas. 51 | 52 | 53 | ### Helper lemmas for preservation: Typing inversion 54 | 55 | In the proof of preservation for `step0`, you will have `hasty` hypotheses for for expressions with a known constructor, e.g. for an `(Abs x e)` or for a `(TupleCons e1 e2)` etc. 56 | Without subtyping, inverting such a `hasty` would give you just one subgoal, where the `hasty` is replaced by the preconditions which were used to construct it. 57 | Now, with subtyping, you get one additional subgoal for the `HtSub` case, where the original `hasty` is replaced by a similar looking `hasty` and a subtyping derivation. You could invert that new `hasty` again, and again and again, and your proving endeavor would never end. 58 | This hint shows how to solve this problem for `TupleCons`, but you will have to apply this trick for all constructors of `exp`. 59 | Without subtyping, we would know that if `TupleCons e1 e2` has a type t, then there are some types t1 and t2 such that e1 has type t1, e2 has type t2, and `t = TupleTypeCons t1 t2`. This fact would follow directly from the fact that there is only a single rule for typing a TupleCons expression. 60 | However, once we add subtyping, the HtSub rule allows us to type an expression of any form, and so the above property doesn't hold. A typing derivation for the fact that `TupleCons e1 e2` has type t can be arbitrarily long even when e1 and e2 are small, but we still know that it must start from an application of the HtTupleCons rule, followed by potentially many applications of the HtSub rule. Since we have proven that the subtype relation is reflexive and transitive, we know the many applications of the HtSub rule can be replaced with exactly one, meaning we know that there is a derivation for TupleCons e1 e2 that is an HtSub rule applied to the HtTupleCons rule. This tells us the following fact: 61 | 62 | ``` 63 | Lemma hasty_TupleCons G e e' t: 64 | hasty G (TupleCons e e') t -> 65 | exists t1 t2, hasty G e t1 /\ hasty G e' t2 /\ TupleTypeCons t1 t2 $<: t. 66 | ``` 67 | 68 | Knowing this fact is useful for the type-safety proof, because now whenever we know that `TupleCons e e'` has some type, we can directly get information about the types of its subexpressions. If we only tried to invert the original typing derivation, the last rule in the derivation may have been HtSub, in which case we would make no "progress" down towards finding the application of the rule HtTupleCons. 69 | 70 | You should be able to formulate and prove similar lemmas for Abs, App, and Proj. 71 | -------------------------------------------------------------------------------- /pset08_InformationFlow/Hints.v: -------------------------------------------------------------------------------- 1 | (*| 2 | ============================================ 3 | Hints for Pset 8: Information-flow control 4 | ============================================ 5 | |*) 6 | 7 | Require Import Frap.Frap. 8 | 9 | (*| 10 | The `set` type 11 | ============== 12 | 13 | - `set A` is a set of values of type `A`. 14 | 15 | - Common operators include `x \in s` (membership), `s1 \subseteq s2` 16 | (inclusion), `s1 \cup s2` (union). Because of the way sets are implemented, 17 | `x \in s` is the same as `s x`. 18 | 19 | - Sets can be used in conjunction with maps: `restrict s m` computes a new map 20 | from `m` with all variables in set `s` removed. 21 | 22 | - If you find yourself proving properties of sets, especially regarding 23 | `restrict`, try the `sets` tactic — it often helps. 24 | 25 | - If you want to reason on whether a particular element `k` is in set `s`, you 26 | can use the `excluded_middle` tactic, as `excluded_middle (k \in s)`. 27 | 28 | Here is an example demonstrating some of these points (remember that, to prove 29 | equality on maps, you can use the `maps_equal` tactic): 30 | |*) 31 | 32 | Goal forall {K V} (k: K) (v: V) (s: set K) (m: fmap K V), 33 | k \in s -> 34 | restrict s (m $+ (k, v)) = (restrict s m) $+ (k, v). 35 | Proof. 36 | simplify. 37 | maps_equal. 38 | - rewrite lookup_restrict_true. 39 | + simplify; equality. 40 | + eassumption. 41 | - excluded_middle (k0 \in s). 42 | + rewrite !lookup_restrict_true by assumption. 43 | simplify; equality. 44 | + rewrite !lookup_restrict_false by assumption. 45 | equality. 46 | Qed. 47 | 48 | (*| 49 | Tips 50 | ==== 51 | 52 | - You will need to generalize the theorem statement to prove it by induction. 53 | 54 | - The noninterference property says that running a program in states with private variables holding potentially different values does not change the public outputs of the program. 55 | 56 | The key difficulty is to deal with *divergence* — the cases where the two program executions take different paths. 57 | 58 | 1. When does this happen? How does that translate in terms of the variables in `pc`? 59 | 2. Can a divergent execution affect the value of public variables? 60 | 61 | - Some of your theorems will take a `Confidential … c` premise. In the case of a while loop, `invert`-ing `Confidential pub pc (While e body)` will give you, `Confidential pub (pc \cup vars e)`, but you will lose the original `Confidential pub pc (While e body)` fact. In our proof, we had to reprove it (you could also make a copy of it) a few times, to apply a theorem to the `eval _ (While _ _) _` premise of the `EvalWhileTrue` constructor. (This hint will make more sense when you get there.) 62 | 63 | Good luck! 64 | |*) 65 | -------------------------------------------------------------------------------- /pset08_InformationFlow/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: coq clean 2 | 3 | COQC=coqc -q -R ../frap Frap 4 | 5 | coq: 6 | $(COQC) Pset8Sig.v 7 | $(COQC) Pset8.v 8 | 9 | clean: 10 | rm -f *.vo *.glob *.aux .*.aux .lia.cache .nia.cache *.vok *.vos 11 | -------------------------------------------------------------------------------- /pset08_InformationFlow/Pset8.v: -------------------------------------------------------------------------------- 1 | (*| 2 | ============================================================= 3 | 6.822 Formal Reasoning About Programs, Spring 2021 - Pset 8 4 | ============================================================= 5 | |*) 6 | 7 | Require Import Pset8Sig. 8 | 9 | (*| 10 | Introduction 11 | ============ 12 | 13 | Computer programs commonly manipulate data from different sources, at different levels of privacy or trust. An e-commerce website, for example, might keep track of the contents of each individual cart, and it would be a severe issue if one user got access to the content of another user's cart. 14 | 15 | Such “information-flow” issues are of a different nature from the functionality bugs that we usually think of, but they are also pervasive and tricky to detect and fix: for example, for a few weeks in 2011, Facebook's abuse-reporting tool made it possible to access a user's private photos by reporting one of their *public* photos for abuse: the tool would then conveniently offer to report other photos, *including private ones* that the reporter was not allowed to access. (https://www.zdnet.com/article/facebook-flaw-allows-access-to-private-photos/) 16 | 17 | In this pset, we will see how type systems can help with information-flow issues. We will operate in a simplified setting in which all information is either “public” or “private”, and we will concern ourselves only with *confidentiality*, the property that private inputs should not influence public program outputs. 18 | 19 | Informally, we'll prove the correctness of a type system such that type-safe programs do not leak private data: that is, we'll prove that changing the private inputs of a well-typed program does not change its public outputs. We'll say that well-typed programs are “confidential”. 20 | 21 | Note that this formulation doesn't rule out side channels: changing the private inputs of a program might change its runtime or even whether it terminates. 22 | 23 | Language definition 24 | =================== 25 | 26 | This is as usual: 27 | |*) 28 | 29 | Module Impl. 30 | Inductive bop := Plus | Minus | Times. 31 | 32 | Inductive arith : Set := 33 | | Const (n : nat) 34 | | Var (x : var) 35 | | Bop (b : bop) (e1 e2 : arith). 36 | 37 | Coercion Const : nat >-> arith. 38 | Coercion Var : var >-> arith. 39 | Declare Scope arith_scope. 40 | Notation "a + b" := (Bop Plus a b) : arith_scope. 41 | Notation "a - b" := (Bop Minus a b) : arith_scope. 42 | Notation "a * b" := (Bop Times a b) : arith_scope. 43 | Delimit Scope arith_scope with arith. 44 | 45 | Inductive cmd := 46 | | Skip 47 | | Assign (x : var) (e : arith) 48 | | Sequence (c1 c2 : cmd) 49 | | If (e : arith) (thn els : cmd) 50 | | While (e : arith) (body : cmd). 51 | 52 | (* Here are some notations for the language, which again we won't really 53 | * explain. *) 54 | Notation "x <- e" := (Assign x e%arith) (at level 75). 55 | Infix ";;" := Sequence (at level 76). (* This one changed slightly, to avoid parsing clashes. *) 56 | Notation "'when' e 'then' thn 'else' els 'done'" := (If e%arith thn els) (at level 75, e at level 0). 57 | Notation "'while' e 'loop' body 'done'" := (While e%arith body) (at level 75). 58 | 59 | (*| 60 | Program semantics 61 | ================= 62 | 63 | And the semantics of the language are as expected; the language is made deterministic by defaulting to 0 when a variable is undefined. 64 | |*) 65 | 66 | Definition valuation := fmap var nat. 67 | 68 | Fixpoint interp (e : arith) (v : valuation) : nat := 69 | match e with 70 | | Const n => n 71 | | Var x => 72 | match v $? x with 73 | | None => 0 74 | | Some n => n 75 | end 76 | | Bop bp e1 e2 => 77 | match bp with 78 | | Plus => Nat.add 79 | | Minus => Nat.sub 80 | | Times => Nat.mul 81 | end (interp e1 v) (interp e2 v) 82 | end. 83 | 84 | Inductive eval : valuation -> cmd -> valuation -> Prop := 85 | | EvalSkip : forall v, 86 | eval v Skip v 87 | | EvalAssign : forall v x e, 88 | eval v (Assign x e) (v $+ (x, interp e v)) 89 | | EvalSeq : forall v c1 v1 c2 v2, 90 | eval v c1 v1 91 | -> eval v1 c2 v2 92 | -> eval v (Sequence c1 c2) v2 93 | | EvalIfTrue : forall v e thn els v', 94 | interp e v <> 0 95 | -> eval v thn v' 96 | -> eval v (If e thn els) v' 97 | | EvalIfFalse : forall v e thn els v', 98 | interp e v = 0 99 | -> eval v els v' 100 | -> eval v (If e thn els) v' 101 | | EvalWhileTrue : forall v e body v' v'', 102 | interp e v <> 0 103 | -> eval v body v' 104 | -> eval v' (While e body) v'' 105 | -> eval v (While e body) v'' 106 | | EvalWhileFalse : forall v e body, 107 | interp e v = 0 108 | -> eval v (While e body) v. 109 | 110 | (*| 111 | Typing judgment 112 | =============== 113 | 114 | The `Confidential` judgment below indicates that a program respects confidentiality. It takes a set of public variables and a command and returns a `Prop` indicating whether the program is safe. Take the time to understand exactly how `Confidential` works (or, even better, take a few moments to think how you would define a `Confidential` predicate. 115 | 116 | In full generality, information-flow systems associate a label to each variable. We'll simplify things and classify variables as “public” or “private”, and instead of having a map giving the label of each value, we'll keep track of the set of all public variables. 117 | 118 | First, we need a way to collect the variables of an expression (we haven't seen the `set` type too often; see ``Hints.v`` for a quick recap). 119 | |*) 120 | 121 | Fixpoint vars (e: arith) : set var := 122 | match e with 123 | | Const n => {} (** A constant has no variables **) 124 | | Var x => {x} (** A variable has… one variable! **) 125 | | Bop _ e1 e2 => vars e1 \cup vars e2 (** An operator's variables are the variables of its subterms **) 126 | end. 127 | 128 | (*| 129 | The parameter `pub` below represents the set of all public variables. This is pre-declared and fixed. But there is also a distinct `set var` argument. This is because we need to consider *implicit* as well as *explicit* flows. 130 | 131 | - An explicit flow happens when assigning to a variable. If `e` mentions variable `x`, then `y := e` may cause data to flow from `x` into `y`. If `x` is private and `y` is public, we want to rule that out. 132 | 133 | - An implicit flow happens when assigning to a variable *under a conditional*. If `e` mentions variable `x`, then `when e then y := 1` may cause data to flow from `x` to `y` (can you see why?). There, too, if `x` is private and `y` is public, we want to disallow this flow. 134 | 135 | This is why we have the second `set var` (`pc`) argument below: in addition to the set of public variables, we keep track of the set of variables from which data may flow implicitly. We call that set “pc”, for “program counter”. 136 | |*) 137 | 138 | Inductive Confidential (pub: set var) : set var (* pc *) -> cmd (* program *) -> Prop := 139 | | ConfidentialSkip : forall pc, 140 | Confidential pub pc Skip 141 | (** A `Skip` is safe. **) 142 | | ConfidentialAssignPrivate : forall pc x e, 143 | ~ x \in pub -> 144 | Confidential pub pc (Assign x e) 145 | (** Assigning to a private variable is safe. **) 146 | | ConfidentialAssignPublic : forall pc x e, 147 | vars e \subseteq pub -> 148 | pc \subseteq pub -> 149 | Confidential pub pc (Assign x e) 150 | (** Assigning to a public variable variable is safe as long as the expression does not mention private variables and we are not under a conditional that depends on private variables. **) 151 | | ConfidentialSeq : forall pc c1 c2, 152 | Confidential pub pc c1 -> 153 | Confidential pub pc c2 -> 154 | Confidential pub pc (Sequence c1 c2) 155 | (** A sequence is safe if both halves of it are safe. **) 156 | | ConfidentialIf : forall pc e thn els, 157 | Confidential pub (pc \cup vars e) thn -> 158 | Confidential pub (pc \cup vars e) els -> 159 | Confidential pub pc (If e thn els) 160 | (** A conditional is safe if both branches are safe, noting that the branches run with additional variables in the `pc`. **) 161 | | ConfidentialWhile : forall pc e body, 162 | Confidential pub (pc \cup vars e) body -> 163 | Confidential pub pc (While e body). 164 | (** A while loop is safe if its body is safe, noting that the body runs with additional variables in the `pc`. **) 165 | 166 | (*| 167 | Here are a few examples: 168 | |*) 169 | 170 | Definition pub_example := {"x", "y", "z"}. (* Variables x, y, z are public. *) 171 | 172 | Example confidential_prog := 173 | ("x" <- "y" + 1;; 174 | "a" <- "a" * "b";; 175 | when "y" then "a" <- 0 else "b" <- 0 done). 176 | 177 | Goal Confidential pub_example {} confidential_prog. 178 | Proof. 179 | unfold confidential_prog, pub_example. 180 | apply ConfidentialSeq; simplify. 181 | - apply ConfidentialSeq; simplify. 182 | + apply ConfidentialAssignPublic; simplify. 183 | * sets. 184 | * sets. 185 | + apply ConfidentialAssignPrivate; simplify. 186 | sets. 187 | - apply ConfidentialIf; simplify. 188 | + apply ConfidentialAssignPrivate; simplify. 189 | sets. 190 | + apply ConfidentialAssignPrivate; simplify. 191 | sets. 192 | Qed. 193 | 194 | Example leaky_prog := 195 | (when "a" then "x" <- 1 else "x" <- 2 done). 196 | 197 | Goal ~ Confidential pub_example {} leaky_prog. 198 | Proof. 199 | unfold leaky_prog, pub_example, not; simplify. 200 | invert H; simplify. 201 | invert H3; simplify. 202 | - sets. 203 | - pose proof @subseteq_In _ "a" _ _ H4. 204 | sets. 205 | Qed. 206 | 207 | (*| 208 | Proof of noninterference 209 | ========================= 210 | 211 | We first need a relation to characterize “equivalent” valuations — that is, valuations that agree on all public variables. `restrict s m` means restrict the valuation `m` to just the keys in `s`: 212 | |*) 213 | 214 | Definition same_public_state pub (v1 v2: valuation) := 215 | restrict pub v1 = restrict pub v2. 216 | 217 | (*| 218 | Then we're ready to prove noninterference! Have a look at ``Hints.v`` for tips. 219 | |*) 220 | 221 | 222 | Theorem non_interference : 223 | forall pub c v1 v1' v2 v2', 224 | eval v1 c v1' -> 225 | eval v2 c v2' -> 226 | Confidential pub {} c -> 227 | same_public_state pub v1 v2 -> 228 | same_public_state pub v1' v2'. 229 | Proof. 230 | Admitted. 231 | 232 | (*| 233 | Congratulations, you have proved that our type system is *sound*: it catches all leaky programs! But it is not *complete*: there are some good programs that it rejects, too. In other words, it *overapproximates* the set of unsafe programs. 234 | 235 | Can you give an example of a safe program (a program that does not leak data) that our system would reject? 236 | |*) 237 | 238 | Definition tricky_example : cmd. Admitted. 239 | 240 | Lemma tricky_rejected : ~ Confidential pub_example {} tricky_example. 241 | Proof. 242 | Admitted. 243 | 244 | Lemma tricky_confidential : 245 | forall v1 v1' v2 v2', 246 | eval v1 tricky_example v1' -> 247 | eval v2 tricky_example v2' -> 248 | same_public_state pub_example v1 v2 -> 249 | same_public_state pub_example v1' v2'. 250 | Proof. 251 | Admitted. 252 | End Impl. 253 | 254 | Module ImplCorrect : Pset8Sig.S := Impl. 255 | 256 | (* Authors: 257 | Clément Pit-Claudel *) 258 | -------------------------------------------------------------------------------- /pset08_InformationFlow/Pset8Sig.v: -------------------------------------------------------------------------------- 1 | (*| 2 | ============================================================= 3 | 6.822 Formal Reasoning About Programs, Spring 2021 - Pset 8 4 | ============================================================= 5 | |*) 6 | 7 | Require Export Frap.Frap. 8 | 9 | Module Type S. 10 | Inductive bop := Plus | Minus | Times. 11 | 12 | Inductive arith : Set := 13 | | Const (n : nat) 14 | | Var (x : var) 15 | | Bop (b : bop) (e1 e2 : arith). 16 | 17 | Inductive cmd := 18 | | Skip 19 | | Assign (x : var) (e : arith) 20 | | Sequence (c1 c2 : cmd) 21 | | If (e : arith) (thn els : cmd) 22 | | While (e : arith) (body : cmd). 23 | 24 | Definition valuation := fmap var nat. 25 | 26 | Fixpoint interp (e : arith) (v : valuation) : nat := 27 | match e with 28 | | Const n => n 29 | | Var x => 30 | match v $? x with 31 | | None => 0 32 | | Some n => n 33 | end 34 | | Bop bp e1 e2 => 35 | match bp with 36 | | Plus => Nat.add 37 | | Minus => Nat.sub 38 | | Times => Nat.mul 39 | end (interp e1 v) (interp e2 v) 40 | end. 41 | 42 | Inductive eval : valuation -> cmd -> valuation -> Prop := 43 | | EvalSkip : forall v, 44 | eval v Skip v 45 | | EvalAssign : forall v x e, 46 | eval v (Assign x e) (v $+ (x, interp e v)) 47 | | EvalSeq : forall v c1 v1 c2 v2, 48 | eval v c1 v1 49 | -> eval v1 c2 v2 50 | -> eval v (Sequence c1 c2) v2 51 | | EvalIfTrue : forall v e thn els v', 52 | interp e v <> 0 53 | -> eval v thn v' 54 | -> eval v (If e thn els) v' 55 | | EvalIfFalse : forall v e thn els v', 56 | interp e v = 0 57 | -> eval v els v' 58 | -> eval v (If e thn els) v' 59 | | EvalWhileTrue : forall v e body v' v'', 60 | interp e v <> 0 61 | -> eval v body v' 62 | -> eval v' (While e body) v'' 63 | -> eval v (While e body) v'' 64 | | EvalWhileFalse : forall v e body, 65 | interp e v = 0 66 | -> eval v (While e body) v. 67 | 68 | Fixpoint vars (e: arith) : set var := 69 | match e with 70 | | Const n => {} (** A constant has no variables **) 71 | | Var x => {x} (** A variable has… one variable! **) 72 | | Bop _ e1 e2 => vars e1 \cup vars e2 (** An operator's variables are the variables of its subterms **) 73 | end. 74 | 75 | Inductive Confidential (pub: set var) : set var (* pc *) -> cmd (* program *) -> Prop := 76 | | ConfidentialSkip : forall pc, 77 | Confidential pub pc Skip 78 | (** A `Skip` is safe. **) 79 | | ConfidentialAssignPrivate : forall pc x e, 80 | ~ x \in pub -> 81 | Confidential pub pc (Assign x e) 82 | (** Assigning to a private variable is safe. **) 83 | | ConfidentialAssignPublic : forall pc x e, 84 | vars e \subseteq pub -> 85 | pc \subseteq pub -> 86 | Confidential pub pc (Assign x e) 87 | (** Assigning to a public variable variable is safe as long as the expression does not mention private variables and we are not under a conditional that depends on private variables. **) 88 | | ConfidentialSeq : forall pc c1 c2, 89 | Confidential pub pc c1 -> 90 | Confidential pub pc c2 -> 91 | Confidential pub pc (Sequence c1 c2) 92 | (** A sequence is safe if both halves of it are safe. **) 93 | | ConfidentialIf : forall pc e thn els, 94 | Confidential pub (pc \cup vars e) thn -> 95 | Confidential pub (pc \cup vars e) els -> 96 | Confidential pub pc (If e thn els) 97 | (** A conditional is safe if both branches are safe, noting that the branches run with additional variables in the `pc`. **) 98 | | ConfidentialWhile : forall pc e body, 99 | Confidential pub (pc \cup vars e) body -> 100 | Confidential pub pc (While e body). 101 | (** A while loop is safe if its body is safe, noting that the body runs with additional variables in the `pc`. **) 102 | 103 | Definition same_public_state pub (v1 v2: valuation) := 104 | restrict pub v1 = restrict pub v2. 105 | 106 | (*[90%]*) Axiom non_interference : 107 | forall pub c v1 v1' v2 v2', 108 | eval v1 c v1' -> 109 | eval v2 c v2' -> 110 | Confidential pub {} c -> 111 | same_public_state pub v1 v2 -> 112 | same_public_state pub v1' v2'. 113 | 114 | Definition pub_example := {"x", "y", "z"}. (* Variables x, y, z are public. *) 115 | 116 | Parameter tricky_example : cmd. 117 | 118 | (*[5%]*) Axiom tricky_rejected : ~ Confidential pub_example {} tricky_example. 119 | 120 | (*[5%]*) Axiom tricky_confidential : 121 | forall v1 v1' v2 v2', 122 | eval v1 tricky_example v1' -> 123 | eval v2 tricky_example v2' -> 124 | same_public_state pub_example v1 v2 -> 125 | same_public_state pub_example v1' v2'. 126 | End S. 127 | -------------------------------------------------------------------------------- /pset08_InformationFlow/_CoqProject: -------------------------------------------------------------------------------- 1 | -Q ../frap Frap 2 | -------------------------------------------------------------------------------- /pset09_HoareLogic/Hints.v: -------------------------------------------------------------------------------- 1 | (*| 2 | =================================================================== 3 | 6.822 Formal Reasoning About Programs, Spring 2021 - Pset 9 Hints 4 | =================================================================== 5 | 6 | Using Hoare logic 7 | ================= 8 | 9 | The strength of Hoare logic is how well it lends itself to automation, so it's natural to be tempted to just run `ht` on every goal. This is not a bad idea! But as you get started, it's best to spend a bit of time familiarizing yourself with the way `ht1` works, first, to get a feeling of the way the proofs work. 10 | 11 | In particular, note that using `ht1` and `ht` *can* lead to incorrect goals: this is due to the while loop rule: it checks that the invariant that you provide holds at the beginning of the loop and that it is preserved by the loop, and then it gives you that invariant at the end of the loop (plus the negation of the loop condition). 12 | 13 | Ask yourself: what happens if you use `fun/inv _ _ _ => True` as your invariant? What about `fun/inv _ _ _ => False`? 14 | 15 | Writing invariants 16 | ------------------ 17 | 18 | The key difficulty of this pset is figuring out the right invariant for each problem. You want something that is weak enough to be true before the loop start and to remain true across loop iterations (under the assumption that the loop condition holds) and that is strong enough to prove your final postcondition. 19 | 20 | In general, it pays to make the invariant as precise as possible. 21 | 22 | 23 | Tips for this pset 24 | ================== 25 | 26 | Fibonacci 27 | --------- 28 | 29 | Our invariant says two things: the trace is “valid”, and the latest values in the output correspond to the values of the local variables `x` and `y`. 30 | 31 | Factorial 32 | --------- 33 | 34 | This one is similar to the previous one, but with two extra twists: a condition on the value of the variable `"n"` relative to the parameter `n` and a condition on the value of the variable `cnt` (the first one is needed because the loop rule forgets everything that is not explicitly part of the invariant). 35 | 36 | Mailbox 37 | ------- 38 | 39 | Our invariant for this problem is very short; it checks if `done` is 0 and says something slightly different in both cases. 40 | 41 | Search 42 | ------ 43 | 44 | The invariant here combines tricks from the previous invariants: 45 | 46 | - A condition on the value of the `ptr` variable 47 | - A condition on the value of the `length` variable 48 | - A relation between the parameters `ptr` and `data` 49 | - A well-formedness criterion for the partial stream of output. 50 | 51 | The last one is the trickiest. Here is some intuition (spoilers ahead): 52 | 53 | - After running to completion, we want the program to obey `search_done`, which is essentially the same as `exists needle, search_spec needle …`. The `exists` part is needed because we don't know what the needle will be when we start the program. But when we get to the loop we have the needle: it's in `v $! "needle"`. 54 | 55 | - Now we need to phrase a form of `search_spec` for the stream of results up to a point. We had the same issue in factorial (stating that the program had run up to `n`). Ask yourself: which part of the list have we processed after, say, 3 iterations? What will be the value of `v $! "length"` at that point? 56 | 57 | - Can you straightforwardly compute the list of elements that has already been processed? You might find one of the `List.skipn` and `List.firstn` functions useful. Once you do that, can you use the result to state a `search_spec` property? 58 | 59 | - Finally, you'll want to make sure that when `length` reaches 0, your prefix is empty or your suffix covers the whole list, so that you recover a `search_spec` predicate about the complete list, which is exactly the program's postcondition. 60 | 61 | Here are two lemmas about these functions that might prove useful (our proof only uses one of these): 62 | |*) 63 | 64 | Require Import Pset9Sig. 65 | 66 | Lemma firstn_S_app: 67 | forall (data : list nat) (n : nat), 68 | S n <= Datatypes.length data -> 69 | firstn (S n) data = 70 | firstn n data ++ [nth n data 0]. 71 | Proof. 72 | induct data; simplify. 73 | - linear_arithmetic. 74 | - cases n; simplify; eauto using f_equal with arith. 75 | Qed. 76 | 77 | Lemma skipn_sub_app: 78 | forall (data : list nat) (n : nat), 79 | 0 < n <= Datatypes.length data -> 80 | List.skipn (n - 1) data = 81 | List.nth (n - 1) data 0 :: List.skipn n data. 82 | Proof. 83 | induct data; simplify. 84 | - linear_arithmetic. 85 | - assert (n = 1 \/ n - 1 = S (n - 1 - 1)) as Heq by linear_arithmetic. 86 | cases Heq; rewrite Heq. 87 | + reflexivity. 88 | + replace n with (S (n - 1)) at 3 by linear_arithmetic. 89 | simplify; apply IHdata; linear_arithmetic. 90 | Qed. 91 | 92 | (*| 93 | One you've phrased your invariant using `List.firstn` or `List.skipn`, the main difficulty will be reasoning about the relation between `array_at` and the heap. In our solution, we used the following two lemmas (phrased in slightly strange ways, chosen to play well with our automation): 94 | |*) 95 | 96 | Require Import Pset9. 97 | Import Impl. 98 | 99 | Lemma array_at_nth_eq : 100 | forall data ptr (h: heap) n x, 101 | array_at h ptr data -> 102 | S n <= Datatypes.length data -> 103 | h $! (ptr + n) = x -> 104 | nth n data 0 = x. 105 | Admitted. 106 | 107 | Lemma array_at_nth_neq : 108 | forall data ptr (h: heap) n x, 109 | array_at h ptr data -> 110 | S n <= Datatypes.length data -> 111 | h $! (ptr + n) <> x -> 112 | nth n data 0 <> x. 113 | Admitted. 114 | 115 | (*| 116 | Good luck! 117 | |*) 118 | -------------------------------------------------------------------------------- /pset09_HoareLogic/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: coq clean 2 | 3 | COQC=coqc -q -R ../frap Frap 4 | 5 | coq: 6 | $(COQC) Pset9Sig.v 7 | $(COQC) Pset9.v 8 | 9 | clean: 10 | rm -f *.vo *.vok *.vos *.glob 11 | -------------------------------------------------------------------------------- /pset09_HoareLogic/Pset9Sig.v: -------------------------------------------------------------------------------- 1 | (*| 2 | ============================================================= 3 | 6.822 Formal Reasoning About Programs, Spring 2021 - Pset 9 4 | ============================================================= 5 | |*) 6 | 7 | Require Export Frap. 8 | 9 | Module Type S. 10 | Inductive nat_op := 11 | | Plus 12 | | Minus 13 | | Times. 14 | 15 | Inductive exp := 16 | | Const (n : nat) 17 | | Var (x : string) 18 | | Read (e1 : exp) 19 | | NatOp (b: nat_op) (e1 e2 : exp). 20 | 21 | Inductive bool_op := 22 | | Equal 23 | | Less. 24 | 25 | Inductive bexp := 26 | | BoolOp (b: bool_op) (e1 e2 : exp). 27 | 28 | Definition heap := fmap nat nat. 29 | Definition valuation := fmap var nat. 30 | 31 | Inductive io := In (v : nat) | Out (v : nat). 32 | Definition trace := list io. 33 | 34 | Definition assertion := trace -> heap -> valuation -> Prop. 35 | 36 | Inductive cmd := 37 | | Skip 38 | | Assign (x : var) (e : exp) 39 | | Write (e1 e2 : exp) 40 | | Seq (c1 c2 : cmd) 41 | | If_ (be : bexp) (then_ else_ : cmd) 42 | | While_ (inv : assertion) (be : bexp) (body : cmd) 43 | | Input (x : var) 44 | | Output (e : exp). 45 | 46 | (* BEGIN NOTATION MAGIC *) 47 | Coercion Const : nat >-> exp. 48 | Coercion Var : string >-> exp. 49 | Declare Scope cmd_scope. 50 | Notation "*[ e ]" := (Read e) : cmd_scope. 51 | Notation "a + b" := (NatOp Plus a b) : cmd_scope. 52 | Notation "a - b" := (NatOp Minus a b) : cmd_scope. 53 | Notation "a * b" := (NatOp Times a b) : cmd_scope. 54 | Notation "a = b" := (BoolOp Equal a b) : cmd_scope. 55 | Notation "a < b" := (BoolOp Less a b) : cmd_scope. 56 | Definition set (dst src : exp) : cmd := 57 | match dst with 58 | | Read dst' => Write dst' src 59 | | Var dst' => Assign dst' src 60 | | _ => Assign "Bad LHS" 0 61 | end. 62 | Infix "<-" := set (no associativity, at level 70) : cmd_scope. 63 | Infix ";;" := Seq (right associativity, at level 75) : cmd_scope. 64 | Notation "'when' b 'then' then_ 'else' else_ 'done'" := 65 | (If_ b then_ else_) (at level 75, b at level 0) : cmd_scope. 66 | Notation "'when' b 'then' then_ 'done'" := 67 | (If_ b then_ Skip) (at level 75, b at level 0) : cmd_scope. 68 | Notation "{{ I }} 'while' b 'loop' body 'done'" := (While_ I%nat%type b body) (at level 75) : cmd_scope. 69 | Notation "x '<--' 'input'" := (Input x) (at level 75) : cmd_scope. 70 | Notation "'output' e" := (Output e) (at level 75) : cmd_scope. 71 | Delimit Scope cmd_scope with cmd. 72 | (* END NOTATION MAGIC *) 73 | 74 | Notation "m $! k" := (match m $? k with Some n => n | None => O end) (at level 30). 75 | 76 | Fixpoint eval (e : exp) (h : heap) (v : valuation) : nat := 77 | match e with 78 | | Const n => n 79 | | Var x => v $! x 80 | | Read e1 => h $! eval e1 h v 81 | | NatOp b e1 e2 => 82 | let e1 := eval e1 h v in 83 | let e2 := eval e2 h v in 84 | match b with 85 | | Plus => e1 + e2 86 | | Minus => e1 - e2 87 | | Times => e1 * e2 88 | end 89 | end. 90 | 91 | Fixpoint beval (b : bexp) (h : heap) (v : valuation) : bool := 92 | match b with 93 | | BoolOp b e1 e2 => 94 | let e1 := eval e1 h v in 95 | let e2 := eval e2 h v in 96 | match b with 97 | | Equal => if eval e1 h v ==n eval e2 h v then true else false 98 | | Less => if eval e2 h v <=? eval e1 h v then false else true 99 | end 100 | end. 101 | 102 | Inductive exec : trace -> heap -> valuation -> cmd -> 103 | trace -> heap -> valuation -> Prop := 104 | | ExSkip : forall tr h v, 105 | exec tr h v Skip tr h v 106 | | ExAssign : forall tr h v x e, 107 | exec tr h v (Assign x e) tr h (v $+ (x, eval e h v)) 108 | | ExWrite : forall tr h v e1 e2, 109 | exec tr h v (Write e1 e2) tr (h $+ (eval e1 h v, eval e2 h v)) v 110 | | ExSeq : forall tr1 h1 v1 c1 tr2 h2 v2 c2 tr3 h3 v3, 111 | exec tr1 h1 v1 c1 tr2 h2 v2 -> 112 | exec tr2 h2 v2 c2 tr3 h3 v3 -> 113 | exec tr1 h1 v1 (Seq c1 c2) tr3 h3 v3 114 | | ExIfTrue : forall tr1 h1 v1 b c1 c2 tr2 h2 v2, 115 | beval b h1 v1 = true -> 116 | exec tr1 h1 v1 c1 tr2 h2 v2 -> 117 | exec tr1 h1 v1 (If_ b c1 c2) tr2 h2 v2 118 | | ExIfFalse : forall tr1 h1 v1 b c1 c2 tr2 h2 v2, 119 | beval b h1 v1 = false -> 120 | exec tr1 h1 v1 c2 tr2 h2 v2 -> 121 | exec tr1 h1 v1 (If_ b c1 c2) tr2 h2 v2 122 | | ExWhileFalse : forall I tr h v b c, 123 | beval b h v = false -> 124 | exec tr h v (While_ I b c) tr h v 125 | | ExWhileTrue : forall I tr1 h1 v1 b c tr2 h2 v2 tr3 h3 v3, 126 | beval b h1 v1 = true -> 127 | exec tr1 h1 v1 c tr2 h2 v2 -> 128 | exec tr2 h2 v2 (While_ I b c) tr3 h3 v3 -> 129 | exec tr1 h1 v1 (While_ I b c) tr3 h3 v3 130 | | ExInput : forall tr h v x inp, 131 | exec tr h v (Input x) (In inp :: tr) h (v $+ (x, inp)) 132 | | ExOutput : forall tr h v e, 133 | exec tr h v (Output e) (Out (eval e h v) :: tr) h v. 134 | 135 | Reserved Notation "<{ P }> c <{ Q }>" 136 | (at level 90, c at next level, 137 | format "'[hv' <{ P }> '/' c '/' <{ Q }> ']'"). 138 | 139 | Notation "'fun/inv' tr h v => e" := 140 | (fun (tr : trace) (h : heap) (v : valuation) => e%nat%type) 141 | (at level 90, tr ident, h ident, v ident). 142 | 143 | Inductive hoare_triple : assertion -> cmd -> assertion -> Prop := 144 | | HtSkip : forall P, <{ P }> Skip <{ P }> 145 | | HtAssign : forall P x e, 146 | <{ P }> 147 | Assign x e 148 | <{ fun/inv tr h v => exists v', P tr h v' /\ v = v' $+ (x, eval e h v') }> 149 | | HtWrite : forall P (e1 e2 : exp), 150 | <{ P }> 151 | Write e1 e2 152 | <{ fun/inv tr h v => 153 | exists h', P tr h' v /\ h = h' $+ (eval e1 h' v, eval e2 h' v) }> 154 | | HtSeq : forall (P Q R : assertion) c1 c2, 155 | <{ P }> c1 <{ Q }> -> <{ Q }> c2 <{ R }> -> <{ P }> c1;; c2 <{ R }> 156 | | HtIf : forall (P Q1 Q2 : assertion) b c1 c2, 157 | <{ fun/inv tr h v => P tr h v /\ beval b h v = true }> c1 <{ Q1 }> -> 158 | <{ fun/inv tr h v => P tr h v /\ beval b h v = false }> c2 <{ Q2 }> -> 159 | <{ P }> (when b then c1 else c2 done) <{ fun/inv tr h v => Q1 tr h v \/ Q2 tr h v }> 160 | | HtWhile : forall (I P : assertion) b c, 161 | (forall tr h v, P tr h v -> I tr h v) -> 162 | <{ fun/inv tr h v => I tr h v /\ beval b h v = true }> c <{ I }> -> 163 | <{ P }> 164 | {{ I }} while b loop c done 165 | <{ fun/inv tr h v => I tr h v /\ beval b h v = false }> 166 | | HtInput : forall (P : assertion) x, 167 | <{ P }> 168 | x <-- input 169 | <{ fun/inv tr h v => 170 | exists tr' v' inp, P tr' h v' /\ tr = In inp :: tr' /\ v = v' $+ (x, inp) }> 171 | | HtOutput : forall (P : assertion) e, 172 | <{ P }> 173 | output e 174 | <{ fun/inv tr h v => exists tr', P tr' h v /\ tr = Out (eval e h v) :: tr' }> 175 | | HtConsequence : forall (P Q P' Q' : assertion) c, 176 | <{ P }> c <{ Q }> -> 177 | (forall tr h v, P' tr h v -> P tr h v) -> 178 | (forall tr h v, Q tr h v -> Q' tr h v) -> 179 | <{ P' }> c <{ Q' }> 180 | where "<{ P }> c <{ Q }>" := (hoare_triple P c%cmd Q). 181 | 182 | Example max3 := 183 | ("x" <-- input;; 184 | "y" <-- input;; 185 | "z" <-- input;; 186 | when "x" < "y" then 187 | when "y" < "z" then 188 | output "z" 189 | else 190 | output "y" 191 | done 192 | else 193 | when "x" < "z" then 194 | output "z" 195 | else 196 | output "x" 197 | done 198 | done)%cmd. 199 | 200 | Definition max3_spec (tr: trace): Prop := 201 | exists x y z, 202 | tr = [Out (max x (max y z)); In z; In y; In x]. 203 | 204 | (*[10%]*) Axiom max3_ok: 205 | <{ fun/inv tr _ _ => tr = [] }> 206 | max3 207 | <{ fun/inv tr' _ _ => max3_spec tr' }>. 208 | 209 | Example fibonacci n inv := 210 | ("cnt" <- 0;; 211 | "x" <- 0;; 212 | output "x";; 213 | "y" <- 1;; 214 | output "y";; 215 | {{ inv }} 216 | while "cnt" < n loop 217 | "tmp" <- "y";; 218 | "y" <- "x" + "y";; 219 | "x" <- "tmp";; 220 | "cnt" <- "cnt" + 1;; 221 | output "y" 222 | done)%cmd. 223 | 224 | Inductive fibonacci_spec : trace -> Prop := 225 | | FibInit: fibonacci_spec [Out 1; Out 0] 226 | | FibRec: forall x y tr, 227 | fibonacci_spec (Out y :: Out x :: tr) -> 228 | fibonacci_spec (Out (x + y) :: Out y :: Out x :: tr). 229 | 230 | Parameter fibonacci_invariant : forall (n: nat), assertion. 231 | 232 | (*[20%]*) Axiom fibonacci_ok : forall (n: nat), 233 | <{ fun/inv tr _ _ => tr = [] }> 234 | fibonacci n (fibonacci_invariant n) 235 | <{ fun/inv tr' _ _ => fibonacci_spec tr' }>. 236 | 237 | Example fact inv := 238 | ("cnt" <- 0;; 239 | "x" <- 1;; 240 | output "x";; 241 | {{ inv }} 242 | while "cnt" < "n" loop 243 | "cnt" <- 1 + "cnt";; 244 | "x" <- "x" * "cnt";; 245 | output "x" 246 | done)%cmd. 247 | 248 | Inductive fact_spec : nat -> trace -> Prop := 249 | | FactInit: fact_spec 0 [Out 1] 250 | | FactRec: forall x n tr, 251 | fact_spec n (Out x :: tr) -> 252 | fact_spec (S n) (Out (x * S n) :: Out x :: tr). 253 | 254 | Parameter fact_invariant : forall (n: nat), assertion. 255 | 256 | (*[20%]*) Axiom fact_ok : forall (n: nat), 257 | <{ fun/inv tr _ v => tr = [] /\ v $! "n" = n }> 258 | fact (fact_invariant n) 259 | <{ fun/inv tr' _ _ => fact_spec n tr' }>. 260 | 261 | Example mailbox inv := 262 | ("done" <- 0;; 263 | {{ inv }} 264 | while "done" = 0 loop 265 | "address" <-- input;; 266 | when "address" = 0 then 267 | "done" <- 1 268 | else 269 | "val" <-- input;; 270 | output *["address"];; 271 | *["address"] <- "val" 272 | done 273 | done)%cmd. 274 | 275 | Inductive mailbox_spec : forall (h: heap) (tr: trace), Prop := 276 | | MBNil: mailbox_spec $0 [] 277 | | MBPut: forall h address val ret tr, 278 | address <> 0 -> 279 | ret = h $! address -> 280 | mailbox_spec h tr -> 281 | mailbox_spec (h $+ (address, val)) (Out ret :: In val :: In address :: tr). 282 | 283 | Inductive mailbox_done (h: heap) : trace -> Prop := 284 | | MBDone: forall tr, 285 | mailbox_spec h tr -> 286 | mailbox_done h (In 0 :: tr). 287 | 288 | Parameter mailbox_invariant : assertion. 289 | 290 | (*[20%]*) Axiom mailbox_ok: 291 | <{ fun/inv tr h _ => tr = [] /\ h = $0 }> 292 | mailbox mailbox_invariant 293 | <{ fun/inv tr' h' _ => mailbox_done h' tr' }>. 294 | 295 | Example search inv := 296 | ("needle" <-- input;; 297 | {{ inv }} 298 | while 0 < "length" loop 299 | "length" <- "length" - 1;; 300 | when *["ptr" + "length"] = "needle" then 301 | output "length" done 302 | done)%cmd. 303 | 304 | Inductive search_spec (needle: nat) : forall (offset: nat) (haystack: list nat), trace -> Prop := 305 | | SearchNil: forall offset, 306 | search_spec needle offset [] [In needle] 307 | | SearchConsYes: forall n offset haystack tr, 308 | 0 < offset -> 309 | n = needle -> 310 | search_spec needle offset haystack tr -> 311 | search_spec needle (offset - 1) (n :: haystack) (Out (offset - 1) :: tr) 312 | | SearchConsNo: forall n offset haystack tr, 313 | 0 < offset -> 314 | n <> needle -> 315 | search_spec needle offset haystack tr -> 316 | search_spec needle (offset - 1) (n :: haystack) tr. 317 | 318 | Inductive search_done haystack tr : Prop := 319 | | SearchDone: forall needle offset, 320 | offset = 0 -> 321 | search_spec needle offset haystack tr -> 322 | search_done haystack tr. 323 | 324 | Inductive array_at (h: heap) : nat -> list nat -> Prop := 325 | | ArrayEmpty : forall ptr, array_at h ptr [] 326 | | ArrayCons : forall ptr hd tl, 327 | h $! ptr = hd -> 328 | array_at h (S ptr) tl -> 329 | array_at h ptr (hd :: tl). 330 | 331 | Parameter search_invariant : forall (ptr: nat) (data: list nat), assertion. 332 | 333 | (*[30%]*) Axiom search_ok : forall ptr data, 334 | <{ fun/inv tr h v => 335 | tr = [] /\ 336 | v $! "ptr" = ptr /\ 337 | v $! "length" = Datatypes.length data /\ 338 | array_at h ptr data }> 339 | search (search_invariant ptr data) 340 | <{ fun/inv tr' h' _ => 341 | array_at h' ptr data /\ 342 | search_done data tr' }>. 343 | End S. 344 | -------------------------------------------------------------------------------- /pset09_HoareLogic/_CoqProject: -------------------------------------------------------------------------------- 1 | -R ../frap Frap 2 | Pset9Sig.v 3 | Pset9.v 4 | -------------------------------------------------------------------------------- /pset10_SeparationLogic/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: coq clean 2 | 3 | COQC=coqc -q -R ../frap Frap 4 | 5 | coq: 6 | $(COQC) Pset10Sig.v 7 | $(COQC) Pset10.v 8 | 9 | clean: 10 | rm -f *.vo *.vok *.vos *.glob 11 | -------------------------------------------------------------------------------- /pset10_SeparationLogic/_CoqProject: -------------------------------------------------------------------------------- 1 | -R ../frap Frap 2 | 3 | Pset10Sig.v 4 | Pset10.v 5 | -------------------------------------------------------------------------------- /pset11_Deadlocks/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: coq clean 2 | 3 | COQC=coqc -q -R ../frap Frap 4 | 5 | coq: 6 | $(COQC) Pset11Sig.v 7 | $(COQC) Pset11.v 8 | 9 | clean: 10 | rm -f *.vo *.glob *.aux .*.aux .lia.cache .nia.cache *.vok *.vos 11 | -------------------------------------------------------------------------------- /pset11_Deadlocks/Pset11.v: -------------------------------------------------------------------------------- 1 | (** * 6.822 Formal Reasoning About Programs, Spring 2021 - Pset 11 *) 2 | 3 | Require Import Frap Pset11Sig. 4 | 5 | (* Programmers who start programming with threads and locks soon realize that it 6 | * is tricky to avoid *deadlocks*, where thread #1 is waiting to take a lock 7 | * held by thread #2, and thread #2 is waiting to take a lock held by thread #3, 8 | * and... thread #N is waiting to take a lock held by thread #1. That's a wait 9 | * cycle, and none of the threads will ever make progress. 10 | * 11 | * The most common wisdom about avoiding deadlocks is to impose a *total order* 12 | * on the locks. A thread is only allowed to acquire a lock that is *less than* 13 | * all locks it currently holds. In this pset, we formalize a simple static 14 | * analysis checking that the total-order rule is obeyed, and we prove that any 15 | * program accepted by the analysis avoids deadlock. *) 16 | 17 | (* Please start by reading the definitions in Pset11Sig.v! *) 18 | 19 | (* Before diving into the proof hacking, it might be helpful to write a short 20 | sample program (in Coq) where thread 1 acquires lock 1 and then lock 2, 21 | while thread 2 tries to acquire lock 2 and then lock 1, and explain (in 22 | English) how a deadlock can happen: *) 23 | 24 | Example bad: prog. Admitted. 25 | 26 | (* FILL IN explanation here *) 27 | 28 | 29 | (* And now, explain why the total-order rule would reject your example by copy-pasting 30 | the one rule which rejects it from Pset11Sig.v and briefly describing how it would 31 | reject it: *) 32 | 33 | (* FILL IN explanation here *) 34 | 35 | (* The two questions above are not graded, but we hope they help you understand 36 | the material better! *) 37 | 38 | (* Since we use the [a_useful_invariant] theorem, proving [deadlock_freedom] 39 | reduces to proving this lemma — the only one in this Pset! See hints.md if 40 | you get stuck, and of course come to office hours if you have any questions 41 | or need help. *) 42 | 43 | 44 | 45 | Module Impl. 46 | Lemma deadlock_freedom' : 47 | forall (h : heap) (p : prog'), 48 | Forall (fun l_c : locks * cmd => goodCitizen (fst l_c) (snd l_c) { }) p -> 49 | Forall finished (progOf p) \/ (exists h_l_p' : heap * locks * prog, 50 | step (h, locksOf p, progOf p) h_l_p'). 51 | Proof. 52 | Admitted. 53 | 54 | (* Here's how we can use [a_useful_invariant] to go from [deadlock_freedom'] to 55 | [deadlock_freedom]: *) 56 | Theorem deadlock_freedom : 57 | forall h p, 58 | Forall (fun c => goodCitizen {} c {}) p -> 59 | invariantFor (trsys_of h {} p) (fun h_l_p => 60 | let '(_, _, p') := h_l_p in 61 | Forall finished p' 62 | \/ exists h_l_p', step h_l_p h_l_p'). 63 | Proof. 64 | (* To begin with, we strengthen the invariant to the one proved in Pset11Sig. *) 65 | simplify. 66 | eapply invariant_weaken. 67 | eauto using a_useful_invariant. 68 | 69 | (* What's left is to prove that this invariant implies deadlock-freedom. *) 70 | first_order. 71 | destruct s as [[h' ls] p']. 72 | invert H0. 73 | 74 | (* We don't actually need to use the [disjointLocks] property. It was only 75 | * important in strengthening the induction to prove that other invariant. *) 76 | clear H6. 77 | 78 | (* At this point, we apply the lemma that we expect you to prove! *) 79 | apply deadlock_freedom'. assumption. 80 | Qed. 81 | End Impl. 82 | 83 | Module ImplCorrect : Pset11Sig.S := Impl. 84 | 85 | (* Authors: 86 | Adam Chlipala, 87 | Peng Wang, 88 | Samuel Gruetter *) 89 | -------------------------------------------------------------------------------- /pset11_Deadlocks/Pset11Sig.v: -------------------------------------------------------------------------------- 1 | (** * 6.822 Formal Reasoning About Programs, Spring 2021 - Pset 11 *) 2 | 3 | Require Import Frap. 4 | 5 | Set Implicit Arguments. 6 | Set Asymmetric Patterns. 7 | 8 | (** * Shared notations and definitions; main material starts afterward. *) 9 | 10 | Notation "m $! k" := (match m $? k with Some n => n | None => O end) (at level 30). 11 | Notation heap := (fmap nat nat). 12 | Notation locks := (set nat). 13 | 14 | Global Hint Extern 1 (_ <= _) => linear_arithmetic : core. 15 | 16 | 17 | (** * Some helpful lemmas to get out of the way *) 18 | 19 | Theorem Forall_app_fwd : forall A (P : A -> Prop) ls1 ls2, 20 | Forall P (ls1 ++ ls2) 21 | -> Forall P ls1 /\ Forall P ls2. 22 | Proof. 23 | induct ls1; invert 1; simplify; subst; eauto. 24 | apply IHls1 in H3; propositional; auto. 25 | Qed. 26 | 27 | Theorem Forall_app_bwd : forall A (P : A -> Prop) ls1 ls2, 28 | Forall P ls1 29 | -> Forall P ls2 30 | -> Forall P (ls1 ++ ls2). 31 | Proof. 32 | induct 1; invert 1; simplify; eauto. 33 | Qed. 34 | 35 | Global Hint Resolve Forall_app_bwd : core. 36 | 37 | Lemma notin_from_order : forall a l, 38 | (forall a', a' \in l -> a' > a) 39 | -> ~a \in l. 40 | Proof. 41 | sets. 42 | apply H in H0. 43 | linear_arithmetic. 44 | Qed. 45 | 46 | Global Hint Immediate notin_from_order : core. 47 | 48 | Lemma gt_lt : forall n m, n > m -> m < n. 49 | Proof. 50 | linear_arithmetic. 51 | Qed. 52 | 53 | Global Hint Resolve gt_lt : core. 54 | 55 | 56 | (** * A variant of the object language from lecture *) 57 | 58 | (* We'll work with a simpler language that (1) removes [Fail] and (2) only uses 59 | * a flat nesting structure for multithreading. In particular, the [cmd] type 60 | * no longer contains parallel composition. *) 61 | 62 | Inductive cmd := 63 | | Return (r : nat) 64 | | Bind (c1 : cmd) (c2 : nat -> cmd) 65 | | Read (a : nat) 66 | | Write (a v : nat) 67 | | Lock (a : nat) 68 | | Unlock (a : nat). 69 | 70 | Notation "x <- c1 ; c2" := (Bind c1 (fun x => c2)) (right associativity, at level 80). 71 | 72 | (* Instead, we separately define a program as a list of commands, for different 73 | * threads. *) 74 | Notation prog := (list cmd). 75 | 76 | (* The intra-thread step relation looks the same as before. *) 77 | Inductive step0 : heap * locks * cmd -> heap * locks * cmd -> Prop := 78 | | StepBindRecur : forall c1 c1' c2 h h' l l', 79 | step0 (h, l, c1) (h', l', c1') 80 | -> step0 (h, l, Bind c1 c2) (h', l', Bind c1' c2) 81 | | StepBindProceed : forall v c2 h l, 82 | step0 (h, l, Bind (Return v) c2) (h, l, c2 v) 83 | 84 | | StepRead : forall h l a, 85 | step0 (h, l, Read a) (h, l, Return (h $! a)) 86 | | StepWrite : forall h l a v, 87 | step0 (h, l, Write a v) (h $+ (a, v), l, Return 0) 88 | 89 | | StepLock : forall h l a, 90 | ~a \in l 91 | -> step0 (h, l, Lock a) (h, l \cup {a}, Return 0) 92 | | StepUnlock : forall h l a, 93 | a \in l 94 | -> step0 (h, l, Unlock a) (h, l \setminus {a}, Return 0). 95 | 96 | (* The whole-program step relation uses list operations to select a thread and 97 | * step it. *) 98 | Inductive step : heap * locks * prog -> heap * locks * prog -> Prop := 99 | | StepThread : forall h l cs1 c cs2 h' l' c', 100 | step0 (h, l, c) (h', l', c') 101 | -> step (h, l, cs1 ++ c :: cs2) (h', l', cs1 ++ c' :: cs2). 102 | 103 | Definition trsys_of (h : heap) (l : locks) (p : prog) := {| 104 | Initial := {(h, l, p)}; 105 | Step := step 106 | |}. 107 | 108 | (* These properties may come in handy: *) 109 | 110 | Lemma StepThread1 : forall h l c cs2 h' l' c', 111 | step0 (h, l, c) (h', l', c') 112 | -> step (h, l, c :: cs2) (h', l', c' :: cs2). 113 | Proof. 114 | simplify. 115 | apply StepThread with (cs1 := []); auto. 116 | Qed. 117 | 118 | Global Hint Resolve StepThread1 : core. 119 | Global Hint Constructors step0 step : core. 120 | 121 | Lemma step_cat : forall h l p x a, 122 | step (h, l, p) x 123 | -> exists h_l_p', step (h, l, a :: p) h_l_p'. 124 | Proof. 125 | invert 1. 126 | exists (h', l', a :: cs1 ++ c' :: cs2). 127 | change (step (h, l, (a :: cs1) ++ c :: cs2) (h', l', (a :: cs1) ++ c' :: cs2)). 128 | eauto. 129 | Qed. 130 | 131 | Global Hint Resolve step_cat : core. 132 | 133 | 134 | (** * A static analysis for principled use of locks *) 135 | 136 | (* If every thread passes the check built into this relation, then we can 137 | * guarantee lack of deadlock. (Don't worry; you'll prove it!) 138 | * A fact [goodCitizen l1 c l2] tells us that when we run [c] in a starting 139 | * state where it "owns" exactly the locks in [l1], it follows the lock-order 140 | * rules and terminates in a state where it owns the locks in [l2]. *) 141 | Inductive goodCitizen : locks -> cmd -> locks -> Prop := 142 | | GcReturn : forall l r, 143 | goodCitizen l (Return r) l 144 | | GcBind : forall l1 c1 l2 c2 l3, 145 | goodCitizen l1 c1 l2 146 | -> (forall r, goodCitizen l2 (c2 r) l3) 147 | -> goodCitizen l1 (Bind c1 c2) l3 148 | | GcRead : forall l a, 149 | goodCitizen l (Read a) l 150 | | GcWrite : forall l a v, 151 | goodCitizen l (Write a v) l 152 | | GcLock : forall l a, 153 | (forall a', a' \in l -> a' > a) 154 | (* ^-- Note that this premise enforces the total order on locks! 155 | * That is, every lock already held must be greater than the new one. *) 156 | -> goodCitizen l (Lock a) (l \cup {a}) 157 | | GcUnlock : forall l a, 158 | a \in l 159 | (* ^-- We also require that a thread only tries to unlock locks that it 160 | * owns. *) 161 | -> goodCitizen l (Unlock a) (l \setminus {a}). 162 | 163 | 164 | (** * An alternative semantics that tracks lock ownership *) 165 | 166 | (* To prove deadlock-freedom from [goodCitizen], we go by way of an alternative 167 | * semantics that assigns each held lock to an owning thread. Concretely, we 168 | * represent a program with a lockset annotated on each command. *) 169 | Definition prog' := list (locks * cmd). 170 | 171 | (* These next two functions project back out the baseline components of an 172 | * instrumented state. *) 173 | 174 | Fixpoint progOf (p : prog') : prog := 175 | match p with 176 | | nil => nil 177 | | (_, c) :: p' => c :: progOf p' 178 | end. 179 | 180 | Fixpoint locksOf (p : prog') : locks := 181 | match p with 182 | | nil => {} 183 | | (l, _) :: p' => l \cup locksOf p' 184 | end. 185 | (* That [\cup] is set union. We also use [\cap] for intersection and 186 | * [\setminus] for set difference. There are also binary relations [\in] for 187 | * membership and [\subseteq] for subset inclusion. When faced with any goal 188 | * that seems to follow just from the laws of set theory, try calling the [sets] 189 | * tactic from the book library. *) 190 | 191 | (* You'll likely want to use this lemma in your solution. *) 192 | Lemma progOf_app : forall p1 p2, 193 | progOf (p1 ++ p2) = progOf p1 ++ progOf p2. 194 | Proof. 195 | induct p1; simplify; eauto. 196 | cases a; simplify. 197 | equality. 198 | Qed. 199 | 200 | (* This predicate captures the property that no lock has multiple owners. 201 | * NOTE: you won't actually need to understand this function in detail, as we 202 | * will be proving enough starter lemmas to hide all reasoning about it! *) 203 | Fixpoint disjointLocks (p : prog') : Prop := 204 | match p with 205 | | nil => True 206 | | (l, _) :: p' => l \cap locksOf p' = {} 207 | /\ disjointLocks p' 208 | end. 209 | 210 | 211 | (** * Proof that the ownership semantics simulates the baseline semantics *) 212 | 213 | (* In this section, we prove for you a useful invariant of any program that is 214 | * full of good citizens. It's safe to skip ahead to the statement of 215 | * [a_useful_invariant]. *) 216 | 217 | (* But, for the curious: we use this relation to connect a baseline state to an 218 | * ownership-tracking state. *) 219 | Inductive assign_lock_ownership : heap * locks * prog -> heap * prog' -> Prop := 220 | | ALO : forall h p', 221 | Forall (fun l_c => goodCitizen (fst l_c) (snd l_c) {}) p' 222 | -> disjointLocks p' 223 | -> assign_lock_ownership (h, locksOf p', progOf p') (h, p'). 224 | 225 | Fixpoint prog'Of (p : prog) : prog' := 226 | match p with 227 | | nil => nil 228 | | c :: p' => ({}, c) :: prog'Of p' 229 | end. 230 | 231 | Lemma progOf_prog'Of : forall p, 232 | progOf (prog'Of p) = p. 233 | Proof. 234 | induct p; simplify; equality. 235 | Qed. 236 | 237 | Lemma locksOf_prog'Of : forall p, 238 | locksOf (prog'Of p) = {}. 239 | Proof. 240 | induct p; simplify; eauto. 241 | rewrite IHp. 242 | sets. 243 | Qed. 244 | 245 | Lemma goodCitizen_prog'Of : forall p, 246 | Forall (fun c => goodCitizen {} c {}) p 247 | -> Forall (fun l_c => goodCitizen (fst l_c) (snd l_c) {}) (prog'Of p). 248 | Proof. 249 | induct 1; simplify; eauto. 250 | Qed. 251 | 252 | Lemma disjointLocks_init : forall p, disjointLocks (prog'Of p). 253 | Proof. 254 | induct p; simplify; propositional. 255 | sets. 256 | Qed. 257 | 258 | Lemma init : forall h p, 259 | Forall (fun c => goodCitizen {} c {}) p 260 | -> assign_lock_ownership (h, {}, p) (h, prog'Of p). 261 | Proof. 262 | simplify. 263 | rewrite <- (progOf_prog'Of p) at 1. 264 | rewrite <- (locksOf_prog'Of p). 265 | constructor. 266 | eauto using goodCitizen_prog'Of. 267 | apply disjointLocks_init. 268 | Qed. 269 | 270 | Lemma invert_progOf : forall p' cs1 c cs2, 271 | progOf p' = cs1 ++ c :: cs2 272 | -> exists p1' l p2', 273 | p' = p1' ++ (l, c) :: p2' 274 | /\ progOf p1' = cs1 275 | /\ progOf p2' = cs2. 276 | Proof. 277 | induct p'; simplify. 278 | 279 | cases cs1; simplify; equality. 280 | 281 | cases a. 282 | cases cs1; simplify. 283 | 284 | invert H. 285 | exists [], s, p'; auto. 286 | 287 | invert H. 288 | apply IHp' in H2. 289 | first_order; subst. 290 | exists ((s, c1) :: x), x0, x1; auto. 291 | Qed. 292 | 293 | Lemma locksOf_app : forall p1 p2, 294 | locksOf (p1 ++ p2) = locksOf p1 \cup locksOf p2. 295 | Proof. 296 | induct p1; simplify; eauto. 297 | sets. 298 | cases a. 299 | rewrite IHp1. 300 | sets. 301 | Qed. 302 | 303 | Global Hint Constructors goodCitizen : core. 304 | 305 | Lemma take_step' : forall h l c h' l' c', 306 | step0 (h, l, c) (h', l', c') 307 | -> forall l1 l2, goodCitizen l1 c l2 308 | -> (l' = l 309 | /\ goodCitizen l1 c' l2) 310 | \/ (exists a, ~a \in l 311 | /\ ~a \in l1 312 | /\ l' = l \cup {a} 313 | /\ goodCitizen (l1 \cup {a}) c' l2) 314 | \/ (exists a, a \in l 315 | /\ a \in l1 316 | /\ l' = l \setminus {a} 317 | /\ goodCitizen (l1 \setminus {a}) c' l2). 318 | Proof. 319 | induct 1; invert 1; simplify; eauto 8. 320 | 321 | apply IHstep0 in H4; auto. 322 | first_order; subst; eauto 8. 323 | 324 | invert H3. 325 | eauto. 326 | 327 | right; left; exists a; repeat split; eauto. 328 | sets. 329 | Qed. 330 | 331 | Global Hint Constructors assign_lock_ownership : core. 332 | 333 | Lemma disjointLocks_unchanged : forall x x0 c x1, 334 | disjointLocks (x ++ (x0, c) :: x1) 335 | -> forall c', disjointLocks (x ++ (x0, c') :: x1). 336 | Proof. 337 | induct x; simplify; propositional. 338 | cases a; propositional; eauto. 339 | repeat rewrite locksOf_app in *; auto. 340 | Qed. 341 | 342 | Lemma disjointLocks_add : forall a x x0 c x1, 343 | disjointLocks (x ++ (x0, c) :: x1) 344 | -> ~a \in locksOf (x ++ (x0, c) :: x1) 345 | -> forall c', disjointLocks (x ++ (x0 \cup {a}, c') :: x1). 346 | Proof. 347 | induct x; simplify; propositional. 348 | 349 | sets. 350 | 351 | cases a0; propositional; eauto. 352 | repeat rewrite locksOf_app in *; simplify; auto. 353 | sets. 354 | 355 | replace ({a} \cup x0) with (x0 \cup {a}) by sets. 356 | eapply IHx; eauto. 357 | sets. 358 | Qed. 359 | 360 | Lemma disjointLocks_remove : forall a x x0 c x1, 361 | disjointLocks (x ++ (x0, c) :: x1) 362 | -> a \in x0 363 | -> forall c', disjointLocks (x ++ (x0 \setminus {a}, c') :: x1). 364 | Proof. 365 | induct x; simplify; propositional. 366 | 367 | sets. 368 | 369 | cases a0; propositional; eauto. 370 | repeat rewrite locksOf_app in *; simplify; auto. 371 | sets. 372 | Qed. 373 | 374 | Global Hint Immediate disjointLocks_unchanged disjointLocks_add disjointLocks_remove : core. 375 | 376 | Lemma disjointLocks_middle' : forall s x x0 c x1, 377 | s \cap locksOf (x ++ (x0, c) :: x1) = { } 378 | -> x0 \cap s = { }. 379 | Proof. 380 | induct x; simplify. 381 | 382 | sets. 383 | 384 | cases a. 385 | repeat rewrite locksOf_app in *. 386 | simplify. 387 | sets. 388 | Qed. 389 | 390 | Lemma disjointLocks_middle : forall x x0 c x1, 391 | disjointLocks (x ++ (x0, c) :: x1) 392 | -> x0 \cap locksOf x = {} 393 | /\ x0 \cap locksOf x1 = {}. 394 | Proof. 395 | induct x; simplify. 396 | 397 | propositional. 398 | sets. 399 | 400 | cases a. 401 | invert H. 402 | apply IHx in H1. 403 | propositional. 404 | repeat rewrite locksOf_app in *; simplify. 405 | sets. 406 | Qed. 407 | 408 | Lemma take_step : forall s1 s2, 409 | step s1 s2 410 | -> forall s1', assign_lock_ownership s1 s1' 411 | -> exists s2', assign_lock_ownership s2 s2'. 412 | Proof. 413 | invert 1; invert 1. 414 | apply invert_progOf in H4; first_order; subst. 415 | apply Forall_app_fwd in H5; propositional. 416 | invert H1; simplify. 417 | eapply take_step' in H0; eauto; first_order; subst. 418 | 419 | exists (h', x ++ (x0, c') :: x1). 420 | replace (locksOf (x ++ (x0, c) :: x1)) 421 | with (locksOf (x ++ (x0, c') :: x1)) 422 | by (repeat rewrite locksOf_app; simplify; sets). 423 | replace (progOf x ++ c' :: progOf x1) 424 | with (progOf (x ++ (x0, c') :: x1)) 425 | by (repeat rewrite progOf_app; simplify; sets). 426 | eauto. 427 | 428 | exists (h', x ++ (x0 \cup {x2}, c') :: x1). 429 | replace (locksOf (x ++ (x0, c) :: x1) \cup {x2}) 430 | with (locksOf (x ++ (x0 \cup {x2}, c') :: x1)) 431 | by (repeat rewrite locksOf_app; simplify; sets). 432 | replace (progOf x ++ c' :: progOf x1) 433 | with (progOf (x ++ (x0 \cup {x2}, c') :: x1)) 434 | by (repeat rewrite progOf_app; simplify; sets). 435 | eauto. 436 | 437 | exists (h', x ++ (x0 \setminus {x2}, c') :: x1). 438 | replace (locksOf (x ++ (x0, c) :: x1) \setminus {x2}) 439 | with (locksOf (x ++ (x0 \setminus {x2}, c') :: x1)) 440 | by (repeat apply disjointLocks_middle in H6; propositional; 441 | repeat rewrite locksOf_app; simplify; sets). 442 | replace (progOf x ++ c' :: progOf x1) 443 | with (progOf (x ++ (x0 \setminus {x2}, c') :: x1)) 444 | by (repeat rewrite progOf_app; simplify; sets). 445 | eauto. 446 | Qed. 447 | 448 | (* Now the invariant proof: starting with good citizens, we always wind up in a 449 | * baseline state that has a matching ownership-tracking state. *) 450 | Theorem a_useful_invariant : forall h p, 451 | Forall (fun c => goodCitizen {} c {}) p 452 | -> invariantFor (trsys_of h {} p) (fun st => exists st', assign_lock_ownership st st'). 453 | Proof. 454 | simplify. 455 | apply invariant_induction; simplify; first_order; subst. 456 | eauto using init. 457 | eauto using take_step. 458 | Qed. 459 | 460 | 461 | (* OK, now to state the deadlock-freedom property that we ask you to prove! *) 462 | 463 | (* This predicate captures when a command is done executing. *) 464 | Inductive finished : cmd -> Prop := 465 | | Finished : forall r, finished (Return r). 466 | 467 | Global Hint Constructors finished : core. 468 | 469 | (* It has this useful connection to [progOf]: *) 470 | Lemma finished_progOf : forall p, 471 | Forall (fun l_c => finished (snd l_c)) p 472 | -> Forall finished (progOf p). 473 | Proof. 474 | induct 1; simplify; eauto. 475 | cases x; eauto. 476 | Qed. 477 | 478 | Global Hint Immediate finished_progOf : core. 479 | 480 | Module Type S. 481 | (* Finally, your task is to prove deadlock-freedom: if all commands are good 482 | * citizens, then execution is either completely finished running, or 483 | * it is possible to take a step. *) 484 | (*[100%]*) Axiom deadlock_freedom : forall h p, 485 | Forall (fun c => goodCitizen {} c {}) p 486 | -> invariantFor (trsys_of h {} p) (fun h_l_p => 487 | let '(_, _, p') := h_l_p in 488 | Forall finished p' 489 | \/ exists h_l_p', step h_l_p h_l_p'). 490 | End S. 491 | -------------------------------------------------------------------------------- /pset11_Deadlocks/_CoqProject: -------------------------------------------------------------------------------- 1 | -R ../frap Frap 2 | Pset11.v 3 | Pset11Sig.v -------------------------------------------------------------------------------- /pset11_Deadlocks/hints.md: -------------------------------------------------------------------------------- 1 | Hints for Pset 11 2 | ================= 3 | 4 | META-HINT 5 | --------- 6 | 7 | If you are stuck trying to prove any fiddly but obvious-seeming fact, say about sets or lists, please ask the course staff for advice! 8 | 9 | Most lemma statements are at the bottom of the file; the pset will be more interesting if you start with just the textual hints, and then look at the statements only if you need them! 10 | 11 | Structure of the proof 12 | ---------------------- 13 | 14 | The key trick in this proof is two distinguish two cases: does any thread hold a lock, or not? 15 | You can use the `excluded_middle` tactic for this. See [1] below for the exact invocation we used. 16 | 17 | Progress without locking 18 | ------------------------ 19 | 20 | This is the first of two cases: the case in which no thread holds any lock (see [2]). In that case, can threads get blocked? If yes, how? Does the `goodCitizen` assumption rule that case out, and if so what can you say about the progress of each individual thread? [3] 21 | 22 | Progress with locking 23 | --------------------- 24 | 25 | If some lock is taken, we need a bit more work [4]. Unlike the previous case, some threads may in fact be waiting on other threads, and hence cannot make progress. But, could all threads be blocked? If not, how can we identify a thread that's ready to run? 26 | 27 | We phrased this intuition in the following way (to prove this lemma, you may need [5], a specialized version of it applied to a single command. 28 | ) 29 | 30 | ``` 31 | Lemma who_has_the_lock : forall l h a p, 32 | Forall (fun l_c => goodCitizen (fst l_c) (snd l_c) {}) p 33 | -> a \in locksOf p 34 | -> locksOf p \subseteq l 35 | -> (exists h_l_p', step (h, l, progOf p) h_l_p') 36 | \/ (exists a', a' < a /\ a' \in l). 37 | ``` 38 | 39 | What this means is that we can either find a command that's ready to run, or we can find another owned lock that is *less than* `a`, the one we already knew had an owner. If we apply this lemma repeatedly, we will eventually find a command that can run; can you see why? (hint: the key part is a' < a). 40 | 41 | Of course, we can't actually “apply this lemma repeatedly”; we need induction — specifically, strong induction (that's why [4] mentions a `bound`). 42 | 43 | Lemma statements 44 | ---------------- 45 | 46 | [1] Our proof of the lemma `deadlock_freedom'` begins by using calling `excluded_middle (exists a, a \in locksOf p)`. 47 | 48 | [2] The no-locks lemma looks like this: 49 | 50 | ``` 51 | Theorem if_no_locks_held_then_progress : forall h p, 52 | Forall (fun l_c => goodCitizen (fst l_c) (snd l_c) {}) p 53 | -> locksOf p = {} 54 | -> Forall (fun l_c => finished (snd l_c)) p 55 | \/ exists h_l_p', step (h, locksOf p, progOf p) h_l_p'. 56 | ``` 57 | 58 | [3] We use the following sublemma in the no-locks case: 59 | 60 | ``` 61 | Lemma if_no_locks_held_then_progress' : forall h c l, 62 | goodCitizen {} c l 63 | -> finished c \/ exists h' l' c', step0 (h, {}, c) (h', l', c'). 64 | ``` 65 | 66 | [4] The with-locks lemma looks like this: 67 | 68 | ``` 69 | Theorem if_lock_held_then_progress : forall bound a h p, 70 | Forall (fun l_c => goodCitizen (fst l_c) (snd l_c) {}) p 71 | -> a \in locksOf p 72 | -> a < bound 73 | -> Forall (fun l_c => finished (snd l_c)) p 74 | \/ exists h_l_p', step (h, locksOf p, progOf p) h_l_p'. 75 | ``` 76 | 77 | [5] Zooming in on a single command: 78 | 79 | ``` 80 | Lemma who_has_the_lock' : forall h a l l1 c, 81 | goodCitizen l1 c {} 82 | -> a \in l1 83 | -> l1 \subseteq l 84 | -> (exists h' l' c', step0 (h, l, c) (h', l', c')) 85 | \/ (exists a', a' < a /\ a' \in l). 86 | ``` 87 | 88 | To prove this sub-lemma, we relax the restriction on the owned-lock set from *after* running `c`, so now we must also consider the case where `c` is finished. (A good-citizen command that owns a lock before and owns no locks afterward can never be finished, since it must do its civic duty and release the lock.): 89 | 90 | ``` 91 | Lemma who_has_the_lock'' : forall h a l l1 c l2, 92 | goodCitizen l1 c l2 93 | -> a \in l1 94 | -> l1 \subseteq l 95 | -> finished c 96 | \/ (exists h' l' c', step0 (h, l, c) (h', l', c')) 97 | \/ (exists a', a' < a /\ a' \in l). 98 | ``` 99 | -------------------------------------------------------------------------------- /pset12_RelyGuarantee/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: coq clean 2 | 3 | COQC=coqc -q -R ../frap Frap 4 | 5 | coq: 6 | $(COQC) Pset12Sig.v 7 | $(COQC) Pset12Example.v 8 | $(COQC) Pset12.v 9 | 10 | clean: 11 | rm -f *.vo *.vok *.vos *.glob 12 | -------------------------------------------------------------------------------- /pset12_RelyGuarantee/Pset12.v: -------------------------------------------------------------------------------- 1 | Require Import Frap Pset12Sig. 2 | 3 | Module Impl. 4 | (* Part 1: read Pset12Sig.v and answer the questions below. This task is 5 | * ungraded, but we are assigning it in hope it helps you complete the 6 | * following parts. 7 | 8 | (these are duplicative with past psets:) 9 | 10 | - Which syntactic construct can be used to implement sequencing of two commands? 11 | 12 | - Which step rules allow a sequenced program to make progress? 13 | 14 | - Which step rule is used when a loop terminates? 15 | 16 | - Which step rule is used when a loop continues? 17 | 18 | - Why is there no step rule for Fail? 19 | 20 | (these are about the programming language in this pset:) 21 | 22 | - Which syntactic construct is used to spawn new threads? 23 | 24 | - Which step rules allow a multi-threaded program to make progress? 25 | 26 | - How can threads in this language communicate with each other? 27 | 28 | - What do the steps that are factored out into the astep inductive have in common? 29 | 30 | (these are about the program logic:) 31 | 32 | - Which rule of the program logic handles astep commands? 33 | 34 | - What is the meaning of the "rely" argument [R]? 35 | 36 | - What would [R] be for a program that can run in any environment? 37 | 38 | - What would [R] be for a program that can only run alone? 39 | 40 | - Which constructors of [hoare_triple] change [R]? Do they make it more or less permissive? 41 | 42 | - What is the meaning of the "guarantee" argument [G]? 43 | 44 | - Which cases of [hoare_triple] require you to prove [G]? 45 | 46 | - What would [G] be for a program that can run in any environment? 47 | 48 | - What would [G] be for a program that can only run alone? 49 | 50 | (these are about program logic tactics:) 51 | 52 | - What syntactic forms of commands does [step] handle? 53 | 54 | - What syntactic forms of commands does [fork] handle? 55 | 56 | - What are the six arguments to the tactic [fork]? Classify them into two groups of three, and then (differently) classify them into three pairs. 57 | 58 | - What syntactic forms of commands does [atomic] handle? 59 | 60 | - What is the argument to the tactic [atomic]? 61 | *) 62 | 63 | (* Part 2: prove a program *) 64 | 65 | (* Pset12Example.v contains an example verification of a non-trivial program. 66 | * You can use it as a reference when trying to figure out what the rules, 67 | * lemmas, and tactics here do, but you are not required to understand it. 68 | * The program in this file is much simpler. *) 69 | 70 | (* Verify that this program manages to increase the counter value. *) 71 | Lemma ht_increment : forall init, 72 | hoare_triple 73 | (fun h => h $! 0 = init) 74 | (fun _ _ => False) 75 | ( (tmp <- Atomic (Read 0); Atomic (Write 0 (tmp + 1))) 76 | || (tmp <- Atomic (Read 0); Atomic (Write 0 (tmp + 1))) 77 | ) 78 | (fun _ _ => True) 79 | (fun _ h => h $! 0 > init). 80 | Proof. 81 | Admitted. 82 | 83 | (* Part 3: prove soundness of the program logic *) 84 | 85 | (* Now it remains to prove that having a [hoare_triple] actually means 86 | * that execution will proceed safely, and if the program terminates then the 87 | * postcondition will be satisfied. *) 88 | 89 | (* If non-negligible time has passed since you read the sig file, please 90 | * review the definitions of [trsys_of] and [notAboutToFail] now. *) 91 | 92 | (* Then, feel free to just skim the next lemmas, right until the final 93 | * theorem you are asked to prove. *) 94 | 95 | (* Here are a few more lemmas that you may find helpful: *) 96 | 97 | Lemma HtStrengthen : forall {t : Set} P R c G (Q : t -> _) (P' : hprop), 98 | hoare_triple P R c G Q 99 | -> (forall h, P' h -> P h) 100 | -> stableP P' R 101 | -> hoare_triple P' R c G Q. 102 | Proof. eauto. Qed. 103 | 104 | Lemma HtWeakenFancy : forall {t : Set} P R c G Q (G' : hrel) (Q' : t -> hprop), 105 | hoare_triple P R c G Q 106 | -> (forall v h, Q v h -> Q' v h) 107 | -> (forall h h', G h h' -> G' h h') 108 | -> hoare_triple P R c G' Q'. 109 | Proof. eauto using always_stableP. Qed. 110 | 111 | Lemma HtReturn' : forall {t : Set} (P : hprop) (R G : hrel) (Q : _ -> hprop) (v : t), 112 | stableP P R 113 | -> (forall h, P h -> Q v h) 114 | -> hoare_triple P R (Return v) G Q. 115 | Proof. 116 | simplify. 117 | eapply HtConsequence with (P' := P) (R' := R) (G' := G); eauto. 118 | simplify; propositional; subst; eauto. 119 | Qed. 120 | 121 | Lemma stableP_self : forall h R, stableP (fun h' => R^* h h') R. 122 | Proof. simp. eauto using trc_trans. Qed. 123 | 124 | Lemma stableP_star : forall R h h', R^* h h' -> 125 | forall P, stableP P R -> P h -> P h'. 126 | Proof. induct 1; simplify; eauto. eapply IHtrc; eauto. Qed. 127 | 128 | Lemma stableP_weakenR : forall P R, stableP P R -> forall R' : hrel, 129 | (forall h1 h2, R' h1 h2 -> R h1 h2) -> stableP P R'. 130 | Proof. simp; eauto. Qed. 131 | 132 | Local Hint Resolve stableP_self : core. 133 | 134 | Lemma stable_stableQ : forall (t : Set) P (Q : t -> _) R r, 135 | stable P Q R -> stableP (Q r) R. 136 | Proof. unfold stable; propositional; eauto. Qed. 137 | Local Hint Resolve stable_stableQ : core. 138 | 139 | Lemma stable_stableP : forall (t : Set) P (Q : t -> _) R, 140 | stable P Q R -> stableP P R. 141 | Proof. unfold stable; propositional; eauto. Qed. 142 | Local Hint Resolve stable_stableP : core. 143 | 144 | Lemma trc_imply :forall t R (s s' : t), R^* s s' -> 145 | forall (R':_->_->Prop), (forall s s', R s s' -> R' s s') -> 146 | R'^* s s'. 147 | Proof. induct 1; simplify; eauto. Qed. 148 | 149 | Local Hint Extern 1 (_ >= _) => linear_arithmetic : core. 150 | Local Hint Constructors notAboutToFail : core. 151 | 152 | 153 | 154 | Theorem hoare_triple_sound : forall (t : Set) P (c : cmd t) Q, 155 | hoare_triple P (fun _ _ => False) c (fun _ _ => True) Q -> 156 | forall h, P h -> 157 | invariantFor (trsys_of h c) (fun st => notAboutToFail (snd st)). 158 | Proof. 159 | (* Stuck? See hints.md. *) 160 | Admitted. 161 | End Impl. 162 | 163 | Module ImplCorrect : Pset12Sig.S := Impl. 164 | -------------------------------------------------------------------------------- /pset12_RelyGuarantee/Pset12Example.v: -------------------------------------------------------------------------------- 1 | Require Import Frap Pset12Sig. 2 | 3 | 4 | (* The next span of code, up to the word "Example", sets up some automation 5 | * support. Feel free to skip ahead to the example to see the ingredients 6 | * in action in the verification of an example program. 7 | *) 8 | 9 | Lemma HtReturn' : forall {t : Set} (P : hprop) (R G : hrel) (Q : _ -> hprop) (v : t), 10 | stableP P R 11 | -> (forall h, P h -> Q v h) 12 | -> hoare_triple P R (Return v) G Q. 13 | Proof. 14 | simplify. 15 | eapply HtConsequence with (P' := P) (R' := R) (G' := G); eauto. 16 | simplify; propositional; subst; eauto. 17 | Qed. 18 | 19 | Lemma HtFail' : forall {t : Set} (P : hprop) (R G : hrel) (Q : t -> hprop), 20 | (forall h, P h -> False) 21 | -> hoare_triple P R Fail G Q. 22 | Proof. 23 | simplify. 24 | eapply HtConsequence with (R' := R) (G' := G) (Q' := Q); eauto. 25 | simplify; propositional. 26 | simplify; propositional. 27 | unfold stableP; simplify. 28 | first_order. 29 | Qed. 30 | 31 | Lemma HtConsequenceBasic : forall {t : Set} P R c G Q (P' : hprop) (Q' : t -> hprop), 32 | hoare_triple P R c G Q 33 | -> (forall h, P' h -> P h) 34 | -> (forall v h, Q v h -> Q' v h) 35 | -> stableP P' R 36 | -> hoare_triple P' R c G Q'. 37 | Proof. 38 | eauto. 39 | Qed. 40 | 41 | Lemma HtStrengthen : forall {t : Set} P R c G (Q : t -> _) (P' : hprop), 42 | hoare_triple P R c G Q 43 | -> (forall h, P' h -> P h) 44 | -> stableP P' R 45 | -> hoare_triple P' R c G Q. 46 | Proof. 47 | eauto. 48 | Qed. 49 | 50 | Lemma HtWeaken : forall {t : Set} P R c G Q (Q' : t -> hprop), 51 | hoare_triple P R c G Q 52 | -> (forall v h, Q v h -> Q' v h) 53 | -> hoare_triple P R c G Q'. 54 | Proof. 55 | eauto using always_stableP. 56 | Qed. 57 | 58 | (* The first several tactics are similar to those that we have 59 | * already seen for earlier iterations of our Hoare logics. 60 | *) 61 | Ltac step0 := apply HtReturn' || eapply HtFail' || eapply HtBind. 62 | Ltac step := step0; simp. 63 | Ltac ht := simp; repeat step. 64 | Ltac loop_inv0 Inv := (eapply HtStrengthen; [ apply HtLoop with (I := Inv) | .. ]) 65 | || (eapply HtConsequenceBasic; [ apply HtLoop with (I := Inv) | .. ]). 66 | Ltac loop_inv Inv := loop_inv0 Inv; simp. 67 | Ltac strengthen P_ := apply HtStrengthen with (P := P_); simp. 68 | 69 | 70 | (** * Example *) 71 | 72 | (* Here is a demonstrative use of rely-guarantee logic to verify a concurrent 73 | * program. We prove that two threads cooperate to keep the value in one memory 74 | * address even. They follow a manually implemented locking protocol -- 75 | * we code and justify mutual-exclusion functionality explicitly as a part of 76 | * the implementation. *) 77 | 78 | Fixpoint isEven (n : nat) : bool := 79 | match n with 80 | | O => true 81 | | S (S n') => isEven n' 82 | | _ => false 83 | end. 84 | 85 | Definition prog2_th turn_addr data_addr me other := 86 | (* First, we loop forever adding to a counter. *) 87 | for _ := tt loop 88 | (* The next loop waits until it's our turn to run. *) 89 | _ <- (for _ := tt loop 90 | (* We read from a flag [turn_addr] that holds the ID of the thread allowed 91 | * to run next. *) 92 | turn <- Atomic (Read turn_addr); 93 | if turn ==n me then 94 | (* Is it my turn? Good; exit the loop. *) 95 | Return (Done tt) 96 | else 97 | (* Not my turn? Go around again. *) 98 | Return (Again tt) 99 | done); 100 | (* OK, we are allowed to run. Let's read the counter from [data_addr]. *) 101 | tmp <- Atomic (Read data_addr); 102 | if isEven tmp then 103 | (* Just to make this interesting, let's first write an odd value, based on 104 | * incrementing by 1! The other thread had better not be looking now. *) 105 | _ <- Atomic (Write data_addr (1 + tmp)); 106 | (* Now let's read back what we wrote. *) 107 | tmp2 <- Atomic (Read data_addr); 108 | (* Then increment again to reach an even value. *) 109 | _ <- Atomic (Write data_addr (1 + tmp2)); 110 | (* Finally, flip the whose-turn flag to the other thread's ID. *) 111 | _ <- Atomic (Write turn_addr other); 112 | Return (Again tt) 113 | else 114 | (* Impossible case: we read an odd counter. *) 115 | Fail 116 | done. 117 | 118 | Example prog2 turn_addr data_addr := 119 | prog2_th turn_addr data_addr 0 1 || prog2_th turn_addr data_addr 1 0. 120 | 121 | (* Let's prove this program against a natural spec. *) 122 | Lemma ht_prog2 : forall turn_addr data_addr, 123 | turn_addr <> data_addr 124 | -> hoare_triple 125 | (fun h => isEven (h $! data_addr) = true /\ (h $! turn_addr = 0 \/ h $! turn_addr = 1)) 126 | (* Precondition: data starts out even, and it's someone's turn. *) 127 | 128 | (fun _ _ => False) 129 | (* Rely: no other threads are allowed to do anything at all, because 130 | * this program is meant to run by itself, with just these two 131 | * threads. *) 132 | 133 | (prog2 turn_addr data_addr) 134 | 135 | (fun _ _ => True) 136 | (* Guarantee: we are generous to ourselves and allow any steps. ;-) 137 | * (We will still use stricter guarantees internally within the 138 | * proof.) *) 139 | 140 | (fun _ _ => False) 141 | (* Postcondition: the program is nonterminating by design! *). 142 | Proof. 143 | unfold prog2, prog2_th. 144 | simp. 145 | 146 | (* We use the [fork] tactic to make progress when we get to a parallel 147 | * composition. *) 148 | fork (fun h => (h $! turn_addr = 0 /\ isEven (h $! data_addr) = true) 149 | \/ h $! turn_addr = 1) 150 | (* This is the precondition of the first thread. Note how we make no 151 | * claim about the counter value if it is the *other* thread's turn. 152 | * Otherwise, the precondition would not be *stable*. *) 153 | 154 | (fun h h' => (h $! turn_addr = 0 155 | /\ h' $! turn_addr = 0) 156 | \/ (h $! turn_addr = 0 157 | /\ h' $! turn_addr = 1 158 | /\ isEven (h' $! data_addr) = true) 159 | \/ (h $! turn_addr = 1 160 | /\ h' $! turn_addr = 1 161 | /\ h' $! data_addr = h $! data_addr)) 162 | (* This is the first thread's guarantee: any step it takes should satisfy 163 | * this relation. The details are easier to read in math than to explain 164 | * in prose! *) 165 | 166 | (fun (_ : unit) (_ : heap) => False) 167 | (* And here's the first thread's postcondition. *) 168 | 169 | (* We then repeat the mirror images to give the same specifications for 170 | * the second thread. *) 171 | (fun h => (h $! turn_addr = 1 /\ isEven (h $! data_addr) = true) 172 | \/ h $! turn_addr = 0) 173 | (fun h h' => (h $! turn_addr = 1 174 | /\ h' $! turn_addr = 1) 175 | \/ (h $! turn_addr = 1 176 | /\ h' $! turn_addr = 0 177 | /\ isEven (h' $! data_addr) = true) 178 | \/ (h $! turn_addr = 0 179 | /\ h' $! turn_addr = 0 180 | /\ h' $! data_addr = h $! data_addr)) 181 | (fun (_ : unit) (_ : heap) => False). 182 | 183 | (* Now we're verifying thread #1. *) 184 | 185 | (* The outer loop invariant is a repeat of the precondition, also asserting 186 | * that the loop can never terminate (e.g., [Done] mapped to [False]). *) 187 | loop_inv (fun (o : loop_outcome unit) h => match o with 188 | | Done _ => False 189 | | Again _ => (h $! turn_addr = 0 /\ isEven (h $! data_addr) = true) \/ h $! turn_addr = 1 190 | end). 191 | step. 192 | (* Inner loop invariant: if the loop isn't done yet ([Again]), then we repeat 193 | * the precondition; otherwise, we have learned that it's our turn, so we use 194 | * the precondition with the case for "it's not my turn" pruned out. *) 195 | loop_inv (fun (o : loop_outcome unit) h => match o with 196 | | Done _ => h $! turn_addr = 0 /\ isEven (h $! data_addr) = true 197 | | Again _ => (h $! turn_addr = 0 /\ isEven (h $! data_addr) = true) \/ h $! turn_addr = 1 198 | end). 199 | step. 200 | (* Every time we reach an atomic command (read or write), we call [atomic], 201 | * providing the postcondition explicitly. Some care is needed in choosing 202 | * this predicate, since it must be *stable*. That is, other threads must not 203 | * be allowed to falsify it. *) 204 | atomic (fun r h => 205 | ((h $! turn_addr = 0 /\ isEven (h $! data_addr) = true) 206 | \/ h $! turn_addr = 1) 207 | /\ (r = 0 -> h $! turn_addr = 0)). 208 | (* Further details in this particular proof aren't essential for completing 209 | * this pset, but feel free to step through and see what's happening. *) 210 | cases (r ==n 0). 211 | step. 212 | step. 213 | step. 214 | atomic (fun r h => 215 | h $! turn_addr = 0 /\ isEven (h $! data_addr) = true /\ r = h $! data_addr). 216 | simp. 217 | cases (isEven r0). 218 | step. 219 | atomic (fun (_ : unit) h => 220 | exists r, h $! turn_addr = 0 /\ isEven r = true /\ h $! data_addr = 1 + r). 221 | eauto. 222 | rewrite H4; eauto. 223 | simp. 224 | step. 225 | atomic (fun r' h => 226 | exists r, h $! turn_addr = 0 /\ isEven r = true /\ h $! data_addr = 1 + r /\ r' = 1 + r). 227 | eauto. 228 | rewrite H4; eauto. 229 | rewrite H4; eauto. 230 | simp. 231 | step. 232 | atomic (fun (_ : unit) h => 233 | h $! turn_addr = 0 /\ isEven (h $! data_addr) = true). 234 | rewrite H4; eauto. 235 | step. 236 | atomic (fun (_ : unit) h => 237 | (h $! turn_addr = 0 /\ isEven (h $! data_addr) = true) 238 | \/ h $! turn_addr = 1). 239 | step. 240 | step. 241 | 242 | (* Here's the proof for the second thread, where we switch [0]s with [1]s. *) 243 | loop_inv (fun (o : loop_outcome unit) h => match o with 244 | | Done _ => False 245 | | Again _ => (h $! turn_addr = 1 /\ isEven (h $! data_addr) = true) \/ h $! turn_addr = 0 246 | end). 247 | step. 248 | loop_inv (fun (o : loop_outcome unit) h => match o with 249 | | Done _ => h $! turn_addr = 1 /\ isEven (h $! data_addr) = true 250 | | Again _ => (h $! turn_addr = 1 /\ isEven (h $! data_addr) = true) \/ h $! turn_addr = 0 251 | end). 252 | step. 253 | atomic (fun r h => 254 | ((h $! turn_addr = 1 /\ isEven (h $! data_addr) = true) 255 | \/ h $! turn_addr = 0) 256 | /\ (r = 1 -> h $! turn_addr = 1)). 257 | cases (r ==n 1). 258 | step. 259 | step. 260 | step. 261 | atomic (fun r h => 262 | h $! turn_addr = 1 /\ isEven (h $! data_addr) = true /\ r = h $! data_addr). 263 | simp. 264 | cases (isEven r0). 265 | step. 266 | atomic (fun (_ : unit) h => 267 | exists r, h $! turn_addr = 1 /\ isEven r = true /\ h $! data_addr = 1 + r). 268 | eauto. 269 | rewrite H4; eauto. 270 | simp. 271 | step. 272 | atomic (fun r' h => 273 | exists r, h $! turn_addr = 1 /\ isEven r = true /\ h $! data_addr = 1 + r /\ r' = 1 + r). 274 | eauto. 275 | rewrite H4; eauto. 276 | rewrite H4; eauto. 277 | simp. 278 | step. 279 | atomic (fun (_ : unit) h => 280 | h $! turn_addr = 1 /\ isEven (h $! data_addr) = true). 281 | rewrite H4; eauto. 282 | step. 283 | atomic (fun (_ : unit) h => 284 | (h $! turn_addr = 1 /\ isEven (h $! data_addr) = true) 285 | \/ h $! turn_addr = 0). 286 | step. 287 | step. 288 | 289 | simp. 290 | simp. 291 | simp. 292 | simp. 293 | simp. 294 | Qed. 295 | -------------------------------------------------------------------------------- /pset12_RelyGuarantee/Pset12Hints.md: -------------------------------------------------------------------------------- 1 | Hints for Pset 12 2 | ================= 3 | 4 | Summarizing the effects of other threads as "rely" 5 | -------------------------------------------------- 6 | 7 | The challenge of the first problem is of course to come up with the right 'rely' and 'guarantee' and weakened precondition (which needs to be stable). How can you summarize the effects of other threads in a compact 'rely'? 8 | 9 | Here is the one used by our solution: 10 | ``` 11 | fork (fun h => h $! 0 >= init) 12 | (fun h h' => h = h' \/ h' $! 0 > init) 13 | (fun (_ : unit) h => h $! 0 > init) 14 | (fun h => h $! 0 >= init) 15 | (fun h h' => h = h' \/ h' $! 0 > init) 16 | (fun (_ : unit) h => h $! 0 > init). 17 | ``` 18 | 19 | Soundness strategy 20 | ------------------ 21 | 22 | Our proof template for logic soundness starts as usual by appealing to an 'invariant weaking' lemma and an 'invariant induction' lemma. We can also call them the 'progress' lemma and the 'preservation' lemma. Roughly, the first one says that commands that have a Hoare triple in the current state are not about to fail, and the second says that if a command with a Hoare triple in the current state takes a step, the resulting command will still have a Hoare triple in the resulting state. 23 | 24 | A particularly useful lemma from Pset12Sig that is easily missed is `always_stableP`: 25 | 26 | ``` 27 | Lemma always_stableP : forall (t : Set) P R c G (Q : t -> _), 28 | hoare_triple P R c G Q -> stableP P R. 29 | ``` 30 | 31 | Progress 32 | -------- 33 | 34 | We strengthen the invariant to say that some Hoare triple holds of the current program such that the current heap satisfies the precondition of the Hoare triple: `progress` says that this indeed implies that the program is not about to fail: 35 | ``` 36 | Lemma progress : 37 | forall (t : Set) P (c : cmd t) R G Q, 38 | hoare_triple P R c G Q -> 39 | forall h, P h -> 40 | notAboutToFail c. 41 | ``` 42 | 43 | Preservation 44 | ------------ 45 | 46 | Then the 'invariant induction' lemma says that this is in fact an inductive invariant: `preservation` says that if some Hoare triple holds and the current heap satisfies its precondition and we take a step, then another Hoare triple holds with a particular precondition that holds of the new heap: 47 | ``` 48 | Lemma preservation : 49 | forall (t : Set) P (c : cmd t) R G Q, 50 | hoare_triple P R c G Q -> 51 | forall h, 52 | P h -> 53 | forall h' c', 54 | step (h, c) (h', c') -> 55 | hoare_triple (fun h'' => R^* h' h'') R c' G Q. 56 | ``` 57 | 58 | Using guarantee for soundness 59 | ----------------------------- 60 | 61 | In proving the preservation lemma, you will need to think what the 'guarantee' part of a Hoare triple gives you. That is, you will need to prove that the 'guarantee' actually guarantees the range of effects. Formally, here is a lemma you will want to prove: 62 | ``` 63 | Lemma guarantee : 64 | forall (t : Set) P (c : cmd t) R G Q, 65 | hoare_triple P R c G Q -> 66 | forall h, 67 | P h -> 68 | forall h' c', 69 | step (h, c) (h', c') -> 70 | G^* h h'. 71 | ``` 72 | 73 | Equalities involving existT 74 | --------------------------- 75 | 76 | When inverting facts involving `cmd`s, you may find that you have 77 | equalities of the form `existT P p x = existT P p y`. The following 78 | tactic derives the equality `x = y` from facts of this sort and 79 | performs substitution. You may find this useful for your soundness 80 | proof of the rely-guarantee logic. 81 | (This tactic performs a subset of what `simp` does.) 82 | So what makes these strange-looking goals pop into existence, anyway? 83 | They arise from inversion on hypotheses involving fancy types. 84 | In general, inversion derives new equalities. Sometimes a particular 85 | derived equality relates terms whose *types* are computed via some 86 | fancy recipe. The constructor `existT` is used to package a term together 87 | with its (first-class) type. Interestingly, the natural inversion 88 | principle, for equalities on those sorts of packages, is not provable in 89 | Coq! It's actually formally independent of Coq's logic. However, a 90 | standard-library lemma `inj_pair2` proves the inversion principle from a 91 | more basic axiom. For more detail (orthogonal to this course), see the 92 | `Eqdep` module of the Coq standard library. 93 | ``` 94 | Ltac existT_subst := 95 | repeat match goal with 96 | | [ H : existT _ _ _ = existT _ _ _ |- _ ] => eapply inj_pair2 in H 97 | end; subst. 98 | ``` 99 | -------------------------------------------------------------------------------- /pset12_RelyGuarantee/Pset12Sig.v: -------------------------------------------------------------------------------- 1 | (** * 6.822 Formal Reasoning About Programs, Spring 2021 - Pset 12 *) 2 | 3 | Require Import Frap. 4 | Require Export Eqdep. (* for inj_pair2 as referenced in a hint *) 5 | 6 | Local Set Implicit Arguments. 7 | 8 | (** * Rely/Guarantee Reasoning *) 9 | 10 | (* In this problem set we will reason about concurrent programs using a program 11 | * logic called “rely-guarantee”. In this logic, in addition to 12 | * precondition and postcondition, each Hoare triple also contains a "rely," 13 | * which specifies how the environment (i.e. other threads) can interfere and 14 | * change the state at any point; and a "guarantee," which specifies how 15 | * *any piece of* this program can change the state (so the Hoare triple should 16 | * really be called "Hoare quintuple"). The name "rely-guarantee" comes from 17 | * the interpretation "I rely on the environment to interfere in a way 18 | * compatible with the rely condition, and I guarantee that I will make no 19 | * atomic state change not allowed by the guarantee condition." It is important 20 | * that the guarantee condition is imposed on all atomic state changes, because 21 | * any piece of a program can be run in a burst of execution by the scheduler, 22 | * and its effect is interference from other threads' points of view. By 23 | * decomposing a multi-thread program into threads with rely/guarantee acting as 24 | * their interface, we achieve modular, thread-local reasoning. *) 25 | 26 | (** Similar language definition as before, except that we group [Read] and 27 | [Write] into a syntax category called [Atomic] operations. *) 28 | 29 | Inductive loop_outcome acc := 30 | | Done (a : acc) 31 | | Again (a : acc). 32 | 33 | Inductive atomic : Set -> Type := 34 | | Read (addr : nat) : atomic nat 35 | | Write (addr : nat) (value : nat) : atomic unit. 36 | 37 | Inductive cmd : Set -> Type := 38 | | Return {t : Set} (r : t) : cmd t 39 | | Bind {t t' : Set} (c1 : cmd t) (c2 : t -> cmd t') : cmd t' 40 | | Fail {result} : cmd result 41 | | Par (c1 c2 : cmd unit) : cmd unit 42 | | Atomic {t : Set} (a : atomic t) : cmd t 43 | | Loop {acc : Set} (init : acc) (body : acc -> cmd (loop_outcome acc)) : cmd acc. 44 | 45 | Notation "x <- c1 ; c2" := (Bind c1 (fun x => c2)) (right associativity, at level 80). 46 | Notation "'for' x := i 'loop' c1 'done'" := (Loop i (fun x => c1)) (right associativity, at level 80). 47 | Infix "||" := Par. 48 | 49 | Notation heap := (fmap nat nat). 50 | Notation "m $! k" := (match m $? k with Some n => n | None => O end) (at level 30). 51 | 52 | 53 | (* The next two definitions, of step relations, should be unsurprising by now, 54 | * essentially copying rules we've seen already in other contexts. *) 55 | 56 | (* atomic step *) 57 | Inductive astep : forall {t : Set}, heap * atomic t -> heap * t -> Prop := 58 | | StepRead : forall h a, 59 | astep (h, Read a) (h, h $! a) 60 | | StepWrite : forall h a v, 61 | astep (h, Write a v) (h $+ (a, v), tt). 62 | 63 | Global Hint Constructors astep : core. 64 | 65 | Inductive step : forall {t : Set}, heap * cmd t -> heap * cmd t -> Prop := 66 | | StepBindRecur : forall {t t' : Set} (c1 c1' : cmd t) (c2 : t -> cmd t') h h', 67 | step (h, c1) (h', c1') 68 | -> step (h, Bind c1 c2) (h', Bind c1' c2) 69 | | StepBindProceed : forall {t t' : Set} (v : t) (c2 : t -> cmd t') h, 70 | step (h, Bind (Return v) c2) (h, c2 v) 71 | | StepPar1 : forall h c1 c2 h' c1', 72 | step (h, c1) (h', c1') 73 | -> step (h, Par c1 c2) (h', Par c1' c2) 74 | | StepPar2 : forall h c1 c2 h' c2', 75 | step (h, c2) (h', c2') 76 | -> step (h, Par c1 c2) (h', Par c1 c2') 77 | | StepAtomic : forall {t : Set} h a h' (v : t), 78 | astep (h, a) (h', v) 79 | -> step (h, Atomic a) (h', Return v) 80 | | StepLoop : forall (acc : Set) (init : acc) (body : acc -> cmd (loop_outcome acc)) h, 81 | step (h, Loop init body) (h, x <- body init; match x with 82 | | Done y => Return y 83 | | Again y => Loop y body 84 | end). 85 | 86 | (* predicates on heaps *) 87 | Definition hprop := heap -> Prop. 88 | (* binary relations on heaps *) 89 | Definition hrel := heap -> heap -> Prop. 90 | 91 | (* "Stability" is an important notion in rely-guarantee logic. A heap predicate 92 | * is stable under some interference (expressed as a binary relation on heaps, 93 | * telling us which heap changes the interference can cause) if whenever the 94 | * predicate holds before the interference, it will still hold after the 95 | * interference. In other words, predicate [P] is preserved by relation [R]. *) 96 | Definition stableP (P : hprop) (R : hrel) := forall h h', P h -> R h h' -> P h'. 97 | 98 | (* [stableP] defined the basic interference notion, while [stableQ] adapts it to 99 | * work for postconditions, which are additionally parameterized over return 100 | * values. *) 101 | Definition stableQ {t : Set} (Q : t -> hprop) (R : hrel) := forall v, stableP (Q v) R. 102 | 103 | (* Here's a convenient predicate to assert both kinds of stability at once. A 104 | convenient way to think of it is that P and Q are preserved by R's heap 105 | modifications. *) 106 | Definition stable {t : Set} (P : hprop) (Q : t -> hprop) R := 107 | stableP P R /\ stableQ Q R. 108 | 109 | Inductive hoare_triple : forall {t : Set}, hprop -> hrel -> cmd t -> hrel -> (t -> hprop) -> Prop := 110 | | HtBind : forall {t t' : Set} (c1 : cmd t) (c2 : t -> cmd t') P1 R G Q1 Q2 , 111 | (* The bind rule is almost the same as before. The same rely and guarantee 112 | * are propagated into subparts. (Subparts can relax these parameters using 113 | * the Consequence rule.) *) 114 | hoare_triple P1 R c1 G Q1 115 | -> (forall r, hoare_triple (Q1 r) R (c2 r) G Q2) 116 | -> hoare_triple P1 R (Bind c1 c2) G Q2 117 | 118 | | HtPar : forall P1 c1 Q1 P2 c2 Q2 R G1 G2 (P : hprop), 119 | (* The essence of rely-guarantee reasoning is shown here: one thread's 120 | * guarantee becomes another thread's rely. *) 121 | hoare_triple P1 (fun h h' => R h h' \/ G2 h h') c1 G1 Q1 122 | -> hoare_triple P2 (fun h h' => R h h' \/ G1 h h') c2 G2 Q2 123 | 124 | (* By design we require preconditions to remain stable. *) 125 | -> stableP P R 126 | 127 | (* We also allow weakening of the precondition into a different 128 | * more-permissive version for each new thread. *) 129 | -> (forall h, P h -> P1 h) 130 | -> (forall h, P h -> P2 h) 131 | 132 | -> hoare_triple P R (Par c1 c2) (fun h h' => G1 h h' \/ G2 h h') (fun r h => Q1 r h /\ Q2 r h) 133 | (* Note that the combined guarantee is effectively the union of guarantees 134 | * of the individual threads, while the combined postcondition is the 135 | * intersection of postconditions. *) 136 | 137 | | HtFail : forall {result} R, 138 | (* Nothing changes for failure: it must be impossible to reach. *) 139 | hoare_triple (fun _ => False) R (Fail (result := result)) (fun _ _ => False) (fun _ _ => False) 140 | 141 | | HtReturn : forall {t : Set} (P : hprop) (R G : hrel) (v : t), 142 | (* We add one extra premise for [Return], about stability. *) 143 | stableP P R 144 | -> hoare_triple P R (Return v) G (fun r h => P h /\ r = v) 145 | 146 | | HtAtomic : forall {t : Set} (P : hprop) (R G : hrel) (Q : t -> hprop) a, 147 | (* Here is the rule that forces us to pick a nonempty guarantee set: it 148 | * should contain the effect of every atomic operation we run. *) 149 | (forall (v : t) h h', P h -> astep (h, a) (h', v) -> G h h') 150 | 151 | (* Furthermore, taking an atomic step should get us to the postcondition. *) 152 | -> (forall (v : t) h h', P h -> astep (h, a) (h', v) -> Q v h') 153 | 154 | (* Here we require both precondition and postcondition to be stable. 155 | * That is, the environment should not be able to invalidate the truth of 156 | * either one, when it only takes steps permitted by [R]. *) 157 | -> stable P Q R 158 | 159 | -> hoare_triple P R (Atomic a) G Q 160 | 161 | | HtLoop : forall {acc : Set} (init : acc) (body : acc -> cmd (loop_outcome acc)) 162 | (I : loop_outcome acc -> hprop) R G, 163 | (* This rule is about the same as before, with an extra stability 164 | * requirement. *) 165 | (forall acc, hoare_triple (I (Again acc)) R (body acc) G I) 166 | -> (forall acc, stableP (I (Done acc)) R) 167 | -> hoare_triple (I (Again init)) R (Loop init body) G (fun r h => I (Done r) h) 168 | 169 | | HtConsequence : forall {t : Set} P R c G Q (P' : hprop) (R' G' : hrel) (Q' : t -> hprop), 170 | (* You can relax any part, in the right direction. *) 171 | hoare_triple P R c G Q 172 | -> (forall h, P' h -> P h) 173 | -> (forall v h, Q v h -> Q' v h) 174 | -> (forall h h', R' h h' -> R h h') 175 | -> (forall h h', G h h' -> G' h h') 176 | (* But make sure the new precondition is stable! *) 177 | -> stableP P' R' 178 | -> hoare_triple P' R' c G' Q'. 179 | 180 | 181 | Global Hint Constructors step : core. 182 | Global Hint Constructors hoare_triple : core. 183 | 184 | (* Two lemmas for tactics below: *) 185 | Lemma always_stableP : forall (t : Set) P R c G (Q : t -> _), 186 | hoare_triple P R c G Q -> stableP P R. 187 | Proof. induct 1; unfold stableP in *; first_order. Qed. 188 | (* (* do not do this, makes eauto slow *) Hint Resolve always_stableP : core. *) 189 | Lemma HtWeakenFancy : forall {t : Set} P R c G Q (G' : hrel) (Q' : t -> hprop), 190 | hoare_triple P R c G Q -> 191 | (forall v h, Q v h -> Q' v h) -> 192 | (forall h h', G h h' -> G' h h') -> 193 | hoare_triple P R c G' Q'. 194 | Proof. eauto using always_stableP. Qed. 195 | 196 | (* The usual step and simplification tactics: *) 197 | 198 | Ltac simp := repeat (simplify; subst; propositional; 199 | try match goal with 200 | | [ H : ex _ |- _ ] => invert H 201 | | [ H : astep _ _ |- _ ] => invert H 202 | | [ H : existT _ _ _ = existT _ _ _ |- _ ] => eapply inj_pair2 in H; subst 203 | | [ |- stableP _ _ ] => unfold stableP in * 204 | | [ |- stable _ _ _ ] => unfold stable, stableP, stableQ in * 205 | end); try solve [ intuition linear_arithmetic | equality ]. 206 | 207 | Ltac step := eapply HtBind; simp. 208 | 209 | 210 | (* NEW TACTICS: *) 211 | 212 | (* The [fork] tactic builds a Hoare triple for a parallel program 213 | * with particular preconditions, rely/guarantees, and postconditions. *) 214 | Ltac fork P1_ G1_ Q1_ P2_ G2_ Q2_ := eapply HtWeakenFancy; [ eapply HtPar with (P1 := P1_) (G1 := G1_) (Q1 := Q1_) (P2 := P2_) (G2 := G2_) (Q2 := Q2_) | .. ]. 215 | 216 | (* The [atomic] tactic builds a Hoare triple for an atomic step 217 | * with a particular postcondition. *) 218 | Ltac atomic Q_ := eapply HtAtomic with (Q := Q_); simp. 219 | 220 | 221 | (* KEY DEFINITIONS FOR SAFETY: *) 222 | Inductive notAboutToFail : forall {t : Set}, cmd t -> Prop := 223 | | NatfBind : forall t t' (c1 : cmd t) (c2 : t -> cmd t'), 224 | notAboutToFail c1 -> 225 | notAboutToFail (Bind c1 c2) 226 | | NatfPar : forall c1 c2, 227 | notAboutToFail c1 -> 228 | notAboutToFail c2 -> 229 | notAboutToFail (Par c1 c2) 230 | | NatfReturn : forall (t : Set) (v : t), 231 | notAboutToFail (Return v) 232 | | NatfAtomic : forall t (a : atomic t), 233 | notAboutToFail (Atomic a) 234 | | NatfLoop : forall (acc : Set) (init : acc) (body : acc -> cmd (loop_outcome acc)), 235 | notAboutToFail (Loop init body). 236 | 237 | Definition trsys_of h {t : Set} (c : cmd t) := {| 238 | Initial := {(h, c)}; 239 | Step := step (t := t) 240 | |}. 241 | 242 | Module Type S. 243 | (*[20%]*) Axiom ht_increment : forall init, 244 | hoare_triple 245 | (fun h => h $! 0 = init) 246 | (fun _ _ => False) 247 | ( (tmp <- Atomic (Read 0); Atomic (Write 0 (tmp + 1))) 248 | || (tmp <- Atomic (Read 0); Atomic (Write 0 (tmp + 1))) 249 | ) 250 | (fun _ _ => True) 251 | (fun _ h => h $! 0 > init). 252 | 253 | (*[80%]*) Axiom hoare_triple_sound : forall (t : Set) P (c : cmd t) Q, 254 | hoare_triple P (fun _ _ => False) c (fun _ _ => True) Q -> 255 | forall h, P h -> 256 | invariantFor (trsys_of h c) (fun st => notAboutToFail (snd st)). 257 | End S. 258 | 259 | (* Authors: 260 | - Peng Wang, 261 | - Adam Chlipala *) 262 | -------------------------------------------------------------------------------- /pset12_RelyGuarantee/_CoqProject: -------------------------------------------------------------------------------- 1 | -R ../frap Frap 2 | 3 | Pset12Sig.v 4 | Pset12Example.v 5 | Pset12.v 6 | --------------------------------------------------------------------------------