├── Auto.v ├── Basics.v ├── Equiv.v ├── Extraction.v ├── Hoare.v ├── Hoare2.v ├── HoareAsLogic.v ├── Imp.v ├── ImpCEvalFun.v ├── ImpParser.v ├── Induction.v ├── LibTactics.v ├── Lists.v ├── Logic.v ├── MoreCoq.v ├── MoreInd.v ├── MoreLogic.v ├── MoreStlc.v ├── Norm.v ├── PE.v ├── Poly.v ├── Postscript.v ├── Preface.v ├── ProofObjects.v ├── Prop.v ├── README.md ├── RecordSub.v ├── Records.v ├── References.v ├── Rel.v ├── SepLogic.v ├── SfLib.v ├── Smallstep.v ├── Stlc.v ├── StlcProp.v ├── Sub.v ├── Symbols.v ├── Typechecking.v ├── Types.v ├── UseAuto.v └── UseTactics.v /Auto.v: -------------------------------------------------------------------------------- 1 | (** * Auto: More Automation *) 2 | 3 | Require Export Imp. 4 | 5 | (** Up to now, we've continued to use a quite restricted set of 6 | Coq's tactic facilities. In this chapter, we'll learn more about 7 | two very powerful features of Coq's tactic language: 8 | proof search via the [auto] and [eauto] tactics, and 9 | automated forward reasoning via the [Ltac] hypothesis matching 10 | machinery. Using these features together with Ltac's scripting facilities 11 | will enable us to make our proofs startlingly short! Used properly, 12 | they can also make proofs more maintainable and robust in the face 13 | of incremental changes to underlying definitions. 14 | 15 | There's a third major source of automation we haven't 16 | fully studied yet, namely built-in decision procedures for specific 17 | kinds of problems: [omega] is one example, but there are others. 18 | This topic will be defered for a while longer. 19 | 20 | *) 21 | 22 | (** Our motivating example will be this proof, repeated with 23 | just a few small changes from [Imp]. We will try to simplify 24 | this proof in several stages. *) 25 | 26 | Ltac inv H := inversion H; subst; clear H. 27 | 28 | Theorem ceval_deterministic: forall c st st1 st2, 29 | c / st || st1 -> 30 | c / st || st2 -> 31 | st1 = st2. 32 | Proof. 33 | intros c st st1 st2 E1 E2; 34 | generalize dependent st2; 35 | ceval_cases (induction E1) Case; 36 | intros st2 E2; inv E2. 37 | Case "E_Skip". reflexivity. 38 | Case "E_Ass". reflexivity. 39 | Case "E_Seq". 40 | assert (st' = st'0) as EQ1. 41 | SCase "Proof of assertion". apply IHE1_1; assumption. 42 | subst st'0. 43 | apply IHE1_2. assumption. 44 | Case "E_IfTrue". 45 | SCase "b evaluates to true". 46 | apply IHE1. assumption. 47 | SCase "b evaluates to false (contradiction)". 48 | rewrite H in H5. inversion H5. 49 | Case "E_IfFalse". 50 | SCase "b evaluates to true (contradiction)". 51 | rewrite H in H5. inversion H5. 52 | SCase "b evaluates to false". 53 | apply IHE1. assumption. 54 | Case "E_WhileEnd". 55 | SCase "b evaluates to false". 56 | reflexivity. 57 | SCase "b evaluates to true (contradiction)". 58 | rewrite H in H2. inversion H2. 59 | Case "E_WhileLoop". 60 | SCase "b evaluates to false (contradiction)". 61 | rewrite H in H4. inversion H4. 62 | SCase "b evaluates to true". 63 | assert (st' = st'0) as EQ1. 64 | SSCase "Proof of assertion". apply IHE1_1; assumption. 65 | subst st'0. 66 | apply IHE1_2. assumption. Qed. 67 | 68 | (** * The [auto] and [eauto] tactics *) 69 | 70 | (** Thus far, we have (nearly) always written proof scripts that 71 | apply relevant hypothoses or lemmas by name. In particular, when 72 | a chain of hypothesis applications is needed, we have specified 73 | them explicitly. (The only exceptions introduced so far are using 74 | [assumption] to find a matching unqualified hypothesis 75 | or [(e)constructor] to find a matching constructor.) *) 76 | 77 | 78 | Example auto_example_1 : forall (P Q R: Prop), (P -> Q) -> (Q -> R) -> P -> R. 79 | Proof. 80 | intros P Q R H1 H2 H3. 81 | apply H2. apply H1. assumption. 82 | Qed. 83 | 84 | (** The [auto] tactic frees us from this drudgery by _searching_ 85 | for a sequence of applications that will prove the goal *) 86 | 87 | Example auto_example_1' : forall (P Q R: Prop), (P -> Q) -> (Q -> R) -> P -> R. 88 | Proof. 89 | intros P Q R H1 H2 H3. 90 | auto. 91 | Qed. 92 | 93 | (** The [auto] tactic solves goals that are solvable by any combination of 94 | - [intros], 95 | - [apply] (with a local hypothesis, by default). 96 | 97 | The [eauto] tactic works just like [auto], except that it uses 98 | [eapply] instead of [apply]. *) 99 | 100 | (** Using [auto] is always "safe" in the sense that it will never fail 101 | and will never change the proof state: either it completely solves 102 | the current goal, or it does nothing. 103 | *) 104 | 105 | (** A more complicated example: *) 106 | 107 | Example auto_example_2 : forall P Q R S T U : Prop, 108 | (P -> Q) -> 109 | (P -> R) -> 110 | (T -> R) -> 111 | (S -> T -> U) -> 112 | ((P->Q) -> (P->S)) -> 113 | T -> 114 | P -> 115 | U. 116 | Proof. auto. Qed. 117 | 118 | 119 | (** Search can take an arbitrarily long time, so there are limits to 120 | how far [auto] will search by default *) 121 | 122 | Example auto_example_3 : forall (P Q R S T U: Prop), 123 | (P -> Q) -> (Q -> R) -> (R -> S) -> 124 | (S -> T) -> (T -> U) -> P -> U. 125 | Proof. 126 | auto. (* When it cannot solve the goal, does nothing! *) 127 | auto 6. (* Optional argument says how deep to search (default depth is 5) *) 128 | Qed. 129 | 130 | 131 | (** When searching for potential proofs of the current goal, [auto] 132 | and [eauto] consider the hypotheses in the current context 133 | together with a _hint database_ of other lemmas and constructors. 134 | Some of the lemmas and constructors we've already seen -- e.g., 135 | [eq_refl], [conj], [or_introl], and [or_intror] -- are installed in this hint 136 | database by default. *) 137 | 138 | Example auto_example_4 : forall P Q R : Prop, 139 | Q -> 140 | (Q -> R) -> 141 | P \/ (Q /\ R). 142 | Proof. 143 | auto. Qed. 144 | 145 | 146 | (** If we want to see which facts [auto] is using, we can use [info_auto] instead. *) 147 | 148 | Example auto_example_5: 2 = 2. 149 | Proof. 150 | info_auto. (* subsumes reflexivity because eq_refl is in hint database *) 151 | Qed. 152 | 153 | 154 | (** We can extend the hint database just for the purposes of one 155 | application of [auto] or [eauto] by writing [auto using ...]. *) 156 | 157 | Lemma le_antisym : forall n m: nat, (n <= m /\ m <= n) -> n = m. 158 | Proof. intros. omega. Qed. 159 | 160 | Example auto_example_6 : forall n m p : nat, 161 | (n<= p -> (n <= m /\ m <= n)) -> 162 | n <= p -> 163 | n = m. 164 | Proof. 165 | intros. 166 | auto. (* does nothing: auto doesn't destruct hypotheses! *) 167 | auto using le_antisym. 168 | Qed. 169 | 170 | 171 | (** Of course, in any given development there will also be some of our 172 | own specific constructors and lemmas that are used very often in 173 | proofs. We can add these to the global hint database by writing 174 | Hint Resolve T. 175 | at the top level, where [T] is a top-level theorem or a 176 | constructor of an inductively defined proposition (i.e., anything 177 | whose type is an implication). As a shorthand, we can write 178 | Hint Constructors c. 179 | to tell Coq to do a [Hint Resolve] for _all_ of the constructors 180 | from the inductive definition of [c]. 181 | 182 | It is also sometimes necessary to add 183 | Hint Unfold d. 184 | where [d] is a defined symbol, so that [auto] knows to expand 185 | uses of [d] and enable further possibilities for applying 186 | lemmas that it knows about. *) 187 | 188 | Hint Resolve le_antisym. 189 | 190 | Example auto_example_6' : forall n m p : nat, 191 | (n<= p -> (n <= m /\ m <= n)) -> 192 | n <= p -> 193 | n = m. 194 | Proof. 195 | intros. 196 | auto. (* picks up hint from database *) 197 | Qed. 198 | 199 | Definition is_fortytwo x := x = 42. 200 | 201 | Example auto_example_7: forall x, (x <= 42 /\ 42 <= x) -> is_fortytwo x. 202 | Proof. 203 | auto. (* does nothing *) 204 | Abort. 205 | 206 | Hint Unfold is_fortytwo. 207 | 208 | Example auto_example_7' : forall x, (x <= 42 /\ 42 <= x) -> is_fortytwo x. 209 | Proof. 210 | info_auto. 211 | Qed. 212 | 213 | Hint Constructors ceval. 214 | 215 | Definition st12 := update (update empty_state X 1) Y 2. 216 | Definition st21 := update (update empty_state X 2) Y 1. 217 | 218 | Example auto_example_8 : exists s', 219 | (IFB (BLe (AId X) (AId Y)) 220 | THEN (Z ::= AMinus (AId Y) (AId X)) 221 | ELSE (Y ::= APlus (AId X) (AId Z)) 222 | FI) / st21 || s'. 223 | Proof. 224 | eexists. info_auto. 225 | Qed. 226 | 227 | Example auto_example_8' : exists s', 228 | (IFB (BLe (AId X) (AId Y)) 229 | THEN (Z ::= AMinus (AId Y) (AId X)) 230 | ELSE (Y ::= APlus (AId X) (AId Z)) 231 | FI) / st12 || s'. 232 | Proof. 233 | eexists. info_auto. 234 | Qed. 235 | 236 | 237 | (** Now let's take a pass over [ceval_deterministic] using [auto] 238 | to simplify the proof script. We see that all simple sequences of hypothesis 239 | applications and all uses of [reflexivity] can be replaced by [auto], 240 | which we add to the default tactic to be applied to each case. 241 | *) 242 | 243 | Theorem ceval_deterministic': forall c st st1 st2, 244 | c / st || st1 -> 245 | c / st || st2 -> 246 | st1 = st2. 247 | Proof. 248 | intros c st st1 st2 E1 E2; 249 | generalize dependent st2; 250 | ceval_cases (induction E1) Case; 251 | intros st2 E2; inv E2; auto. 252 | Case "E_Seq". 253 | assert (st' = st'0) as EQ1. 254 | SCase "Proof of assertion". auto. 255 | subst st'0. 256 | auto. 257 | Case "E_IfTrue". 258 | SCase "b evaluates to false (contradiction)". 259 | rewrite H in H5. inversion H5. 260 | Case "E_IfFalse". 261 | SCase "b evaluates to true (contradiction)". 262 | rewrite H in H5. inversion H5. 263 | Case "E_WhileEnd". 264 | SCase "b evaluates to true (contradiction)". 265 | rewrite H in H2. inversion H2. 266 | Case "E_WhileLoop". 267 | SCase "b evaluates to false (contradiction)". 268 | rewrite H in H4. inversion H4. 269 | SCase "b evaluates to true". 270 | assert (st' = st'0) as EQ1. 271 | SSCase "Proof of assertion". auto. 272 | subst st'0. 273 | auto. 274 | Qed. 275 | 276 | (** When we are using a particular tactic many times in a proof, 277 | we can use a variant of the [Proof] command to make that tactic 278 | into a default within the proof. 279 | Saying [Proof with t] (where [t] is an arbitrary tactic) 280 | allows us to use [t1...] as a shorthand for [t1;t] within the proof. 281 | As an illustration, here is an alternate version of the previous proof, 282 | using [Proof with auto]. 283 | *) 284 | 285 | Theorem ceval_deterministic'_alt: forall c st st1 st2, 286 | c / st || st1 -> 287 | c / st || st2 -> 288 | st1 = st2. 289 | Proof with auto. 290 | intros c st st1 st2 E1 E2; 291 | generalize dependent st2; 292 | ceval_cases (induction E1) Case; 293 | intros st2 E2; inv E2... 294 | Case "E_Seq". 295 | assert (st' = st'0) as EQ1. 296 | SCase "Proof of assertion"... 297 | subst st'0... 298 | Case "E_IfTrue". 299 | SCase "b evaluates to false (contradiction)". 300 | rewrite H in H5. inversion H5. 301 | Case "E_IfFalse". 302 | SCase "b evaluates to true (contradiction)". 303 | rewrite H in H5. inversion H5. 304 | Case "E_WhileEnd". 305 | SCase "b evaluates to true (contradiction)". 306 | rewrite H in H2. inversion H2. 307 | Case "E_WhileLoop". 308 | SCase "b evaluates to false (contradiction)". 309 | rewrite H in H4. inversion H4. 310 | SCase "b evaluates to true". 311 | assert (st' = st'0) as EQ1. 312 | SSCase "Proof of assertion"... 313 | subst st'0... 314 | Qed. 315 | 316 | (** * Searching Hypotheses *) 317 | 318 | (** The proof has become simpler, but there is still an annoying amount 319 | of repetition. Let's start by tackling the contradiction cases. Each 320 | of them occurs in a situation where we have both 321 | 322 | [H1: beval st b = false] 323 | 324 | and 325 | 326 | [H2: beval st b = true] 327 | 328 | as hypotheses. The contradiction is evident, but demonstrating it 329 | is a little complicated: we have to locate the two hypotheses [H1] and [H2] 330 | and do a [rewrite] following by an [inversion]. We'd like to automate 331 | this process. 332 | 333 | Note: In fact, Coq has a built-in tactic [congruence] that will do the 334 | job. But we'll ignore the existence of this tactic for now, in order 335 | to demonstrate how to build forward search tactics by hand. 336 | 337 | *) 338 | 339 | (** As a first step, we can abstract out the piece of script in question by 340 | writing a small amount of paramerized Ltac. *) 341 | 342 | Ltac rwinv H1 H2 := rewrite H1 in H2; inv H2. 343 | 344 | Theorem ceval_deterministic'': forall c st st1 st2, 345 | c / st || st1 -> 346 | c / st || st2 -> 347 | st1 = st2. 348 | Proof. 349 | intros c st st1 st2 E1 E2; 350 | generalize dependent st2; 351 | ceval_cases (induction E1) Case; 352 | intros st2 E2; inv E2; auto. 353 | Case "E_Seq". 354 | assert (st' = st'0) as EQ1. 355 | SCase "Proof of assertion". auto. 356 | subst st'0. 357 | auto. 358 | Case "E_IfTrue". 359 | SCase "b evaluates to false (contradiction)". 360 | rwinv H H5. 361 | Case "E_IfFalse". 362 | SCase "b evaluates to true (contradiction)". 363 | rwinv H H5. 364 | Case "E_WhileEnd". 365 | SCase "b evaluates to true (contradiction)". 366 | rwinv H H2. 367 | Case "E_WhileLoop". 368 | SCase "b evaluates to false (contradiction)". 369 | rwinv H H4. 370 | SCase "b evaluates to true". 371 | assert (st' = st'0) as EQ1. 372 | SSCase "Proof of assertion". auto. 373 | subst st'0. 374 | auto. Qed. 375 | 376 | 377 | (** But this is not much better. We really want Coq to discover 378 | the relevant hypotheses for us. We can do this by using the 379 | [match goal with ... end] facility of Ltac. *) 380 | 381 | Ltac find_rwinv := 382 | match goal with 383 | H1: ?E = true, H2: ?E = false |- _ => rwinv H1 H2 384 | end. 385 | 386 | (** In words, this [match goal] looks for two (distinct) hypotheses that have 387 | the form of equalities with the same arbitrary expression [E] on the 388 | left and conflicting boolean values on the right; if such hypotheses are 389 | found, it binds [H1] and [H2] to their names, and applies the tactic 390 | after the [=>]. 391 | 392 | Adding this tactic to our default string handles all the contradiction cases. *) 393 | 394 | Theorem ceval_deterministic''': forall c st st1 st2, 395 | c / st || st1 -> 396 | c / st || st2 -> 397 | st1 = st2. 398 | Proof. 399 | intros c st st1 st2 E1 E2; 400 | generalize dependent st2; 401 | ceval_cases (induction E1) Case; 402 | intros st2 E2; inv E2; try find_rwinv; auto. 403 | Case "E_Seq". 404 | assert (st' = st'0) as EQ1. 405 | SCase "Proof of assertion". auto. 406 | subst st'0. 407 | auto. 408 | Case "E_WhileLoop". 409 | SCase "b evaluates to true". 410 | assert (st' = st'0) as EQ1. 411 | SSCase "Proof of assertion". auto. 412 | subst st'0. 413 | auto. Qed. 414 | 415 | (** Finally, let's see about the remaining cases. Each of them involves 416 | applying a conditional hypothesis to extract an equality. Currently 417 | we have phrased these as assertions, so that we have to predict what 418 | the resulting equality will be (although we can then use [auto] 419 | to prove it.) An alternative is to pick the relevant 420 | hypotheses to use, and then rewrite with them, as follows: 421 | *) 422 | 423 | Theorem ceval_deterministic'''': forall c st st1 st2, 424 | c / st || st1 -> 425 | c / st || st2 -> 426 | st1 = st2. 427 | Proof. 428 | intros c st st1 st2 E1 E2; 429 | generalize dependent st2; 430 | ceval_cases (induction E1) Case; 431 | intros st2 E2; inv E2; try find_rwinv; auto. 432 | Case "E_Seq". 433 | rewrite (IHE1_1 st'0 H1) in *. auto. 434 | Case "E_WhileLoop". 435 | SCase "b evaluates to true". 436 | rewrite (IHE1_1 st'0 H3) in *. auto. Qed. 437 | 438 | (** Now we can automate the task of finding the relevant hypotheses to 439 | rewrite with. *) 440 | 441 | Ltac find_eqn := 442 | match goal with 443 | H1: forall x, ?P x -> ?L = ?R, H2: ?P ?X |- _ => 444 | rewrite (H1 X H2) in * 445 | end. 446 | 447 | (** But there are several pairs of hypotheses that have the right 448 | general form, and it seems tricky to pick out the ones we actually need. 449 | A key trick is to realize that we can _try them all_! 450 | Here's how this works: 451 | 452 | - [rewrite] will fail given a trivial equation of the form [X = X]. 453 | - each execution of [match goal] will keep trying to find a valid pair of 454 | hypotheses until the tactic on the RHS of the match succeeds; 455 | if there are no such pairs, it fails. 456 | - we can wrap the whole thing in a [repeat] which will keep 457 | doing useful rewrites until only trivial ones are left. 458 | *) 459 | 460 | 461 | Theorem ceval_deterministic''''': forall c st st1 st2, 462 | c / st || st1 -> 463 | c / st || st2 -> 464 | st1 = st2. 465 | Proof. 466 | intros c st st1 st2 E1 E2; 467 | generalize dependent st2; 468 | ceval_cases (induction E1) Case; 469 | intros st2 E2; inv E2; try find_rwinv; repeat find_eqn; auto. 470 | Qed. 471 | 472 | (** The big pay-off in this approach is that our proof script 473 | should be robust in the face of modest changes to our language. 474 | For example, we can add a [REPEAT] command to the language. 475 | (This was an exercise in [Hoare.v].) *) 476 | 477 | Module Repeat. 478 | 479 | Inductive com : Type := 480 | | CSkip : com 481 | | CAsgn : id -> aexp -> com 482 | | CSeq : com -> com -> com 483 | | CIf : bexp -> com -> com -> com 484 | | CWhile : bexp -> com -> com 485 | | CRepeat : com -> bexp -> com. 486 | 487 | (** [REPEAT] behaves like [WHILE], except that the loop guard is 488 | checked _after_ each execution of the body, with the loop 489 | repeating as long as the guard stays _false_. Because of this, 490 | the body will always execute at least once. *) 491 | 492 | Tactic Notation "com_cases" tactic(first) ident(c) := 493 | first; 494 | [ Case_aux c "SKIP" | Case_aux c "::=" | Case_aux c ";" 495 | | Case_aux c "IFB" | Case_aux c "WHILE" 496 | | Case_aux c "CRepeat" ]. 497 | 498 | Notation "'SKIP'" := 499 | CSkip. 500 | Notation "c1 ; c2" := 501 | (CSeq c1 c2) (at level 80, right associativity). 502 | Notation "X '::=' a" := 503 | (CAsgn X a) (at level 60). 504 | Notation "'WHILE' b 'DO' c 'END'" := 505 | (CWhile b c) (at level 80, right associativity). 506 | Notation "'IFB' e1 'THEN' e2 'ELSE' e3 'FI'" := 507 | (CIf e1 e2 e3) (at level 80, right associativity). 508 | Notation "'REPEAT' e1 'UNTIL' b2 'END'" := 509 | (CRepeat e1 b2) (at level 80, right associativity). 510 | 511 | Inductive ceval : state -> com -> state -> Prop := 512 | | E_Skip : forall st, 513 | ceval st SKIP st 514 | | E_Ass : forall st a1 n X, 515 | aeval st a1 = n -> 516 | ceval st (X ::= a1) (update st X n) 517 | | E_Seq : forall c1 c2 st st' st'', 518 | ceval st c1 st' -> 519 | ceval st' c2 st'' -> 520 | ceval st (c1 ; c2) st'' 521 | | E_IfTrue : forall st st' b1 c1 c2, 522 | beval st b1 = true -> 523 | ceval st c1 st' -> 524 | ceval st (IFB b1 THEN c1 ELSE c2 FI) st' 525 | | E_IfFalse : forall st st' b1 c1 c2, 526 | beval st b1 = false -> 527 | ceval st c2 st' -> 528 | ceval st (IFB b1 THEN c1 ELSE c2 FI) st' 529 | | E_WhileEnd : forall b1 st c1, 530 | beval st b1 = false -> 531 | ceval st (WHILE b1 DO c1 END) st 532 | | E_WhileLoop : forall st st' st'' b1 c1, 533 | beval st b1 = true -> 534 | ceval st c1 st' -> 535 | ceval st' (WHILE b1 DO c1 END) st'' -> 536 | ceval st (WHILE b1 DO c1 END) st'' 537 | | E_RepeatEnd : forall st st' b1 c1, 538 | ceval st c1 st' -> 539 | beval st' b1 = true -> 540 | ceval st (CRepeat c1 b1) st' 541 | | E_RepeatLoop : forall st st' st'' b1 c1, 542 | ceval st c1 st' -> 543 | beval st' b1 = false -> 544 | ceval st' (CRepeat c1 b1) st'' -> 545 | ceval st (CRepeat c1 b1) st'' 546 | . 547 | 548 | Tactic Notation "ceval_cases" tactic(first) ident(c) := 549 | first; 550 | [ Case_aux c "E_Skip" | Case_aux c "E_Ass" 551 | | Case_aux c "E_Seq" 552 | | Case_aux c "E_IfTrue" | Case_aux c "E_IfFalse" 553 | | Case_aux c "E_WhileEnd" | Case_aux c "E_WhileLoop" 554 | | Case_aux c "E_RepeatEnd" | Case_aux c "E_RepeatLoop" 555 | ]. 556 | 557 | Notation "c1 '/' st '||' st'" := (ceval st c1 st') 558 | (at level 40, st at level 39). 559 | 560 | 561 | Theorem ceval_deterministic: forall c st st1 st2, 562 | c / st || st1 -> 563 | c / st || st2 -> 564 | st1 = st2. 565 | Proof. 566 | intros c st st1 st2 E1 E2; 567 | generalize dependent st2; 568 | ceval_cases (induction E1) Case; 569 | intros st2 E2; inv E2; try find_rwinv; repeat find_eqn; auto. 570 | Case "E_RepeatEnd". 571 | SCase "b evaluates to false (contradiction)". 572 | find_rwinv. 573 | (* oops: why didn't [find_rwinv] solve this for us already? 574 | answer: we did things in the wrong order. *) 575 | case "E_RepeatLoop". 576 | SCase "b evaluates to true (contradiction)". 577 | find_rwinv. 578 | Qed. 579 | 580 | Theorem ceval_deterministic': forall c st st1 st2, 581 | c / st || st1 -> 582 | c / st || st2 -> 583 | st1 = st2. 584 | Proof. 585 | intros c st st1 st2 E1 E2; 586 | generalize dependent st2; 587 | ceval_cases (induction E1) Case; 588 | intros st2 E2; inv E2; repeat find_eqn; try find_rwinv; auto. 589 | Qed. 590 | 591 | End Repeat. 592 | 593 | (** These examples just give a flavor of what "hyper-automation" can do... 594 | 595 | The details of using [match goal] are tricky, and debugging is 596 | not pleasant at all. But it is well worth adding at least simple 597 | uses to your proofs to avoid tedium and "future proof" your scripts. 598 | 599 | *) 600 | 601 | (** $Date: 2014-12-31 11:17:56 -0500 (Wed, 31 Dec 2014) $ *) 602 | -------------------------------------------------------------------------------- /Extraction.v: -------------------------------------------------------------------------------- 1 | (** * Extraction: Extracting ML from Coq *) 2 | 3 | (** * Basic Extraction *) 4 | 5 | (** In its simplest form, program extraction from Coq is completely straightforward. *) 6 | 7 | (** First we say what language we want to extract into. Options are OCaml (the 8 | most mature), Haskell (which mostly works), and Scheme (a bit out 9 | of date). *) 10 | 11 | Extraction Language Ocaml. 12 | 13 | (** Now we load up the Coq environment with some definitions, either 14 | directly or by importing them from other modules. *) 15 | 16 | Require Import SfLib. 17 | Require Import ImpCEvalFun. 18 | 19 | (** Finally, we tell Coq the name of a definition to extract and the 20 | name of a file to put the extracted code into. *) 21 | 22 | Extraction "imp1.ml" ceval_step. 23 | 24 | (** When Coq processes this command, it generates a file [imp1.ml] 25 | containing an extracted version of [ceval_step], together with 26 | everything that it recursively depends on. Have a look at this 27 | file now. *) 28 | 29 | (* ############################################################## *) 30 | (** * Controlling Extraction of Specific Types *) 31 | 32 | (** We can tell Coq to extract certain [Inductive] definitions to 33 | specific OCaml types. For each one, we must say 34 | - how the Coq type itself should be represented in OCaml, and 35 | - how each constructor should be translated. *) 36 | 37 | Extract Inductive bool => "bool" [ "true" "false" ]. 38 | 39 | (** Also, for non-enumeration types (where the constructors take 40 | arguments), we give an OCaml expression that can be used as a 41 | "recursor" over elements of the type. (Think Church numerals.) *) 42 | 43 | Extract Inductive nat => "int" 44 | [ "0" "(fun x -> x + 1)" ] 45 | "(fun zero succ n -> 46 | if n=0 then zero () else succ (n-1))". 47 | 48 | (** We can also extract defined constants to specific OCaml terms or 49 | operators. *) 50 | 51 | Extract Constant plus => "( + )". 52 | Extract Constant mult => "( * )". 53 | Extract Constant beq_nat => "( = )". 54 | 55 | (** Important: It is entirely _your responsibility_ to make sure that 56 | the translations you're proving make sense. For example, it might 57 | be tempting to include this one 58 | Extract Constant minus => "( - )". 59 | but doing so could lead to serious confusion! (Why?) 60 | *) 61 | 62 | Extraction "imp2.ml" ceval_step. 63 | 64 | (** Have a look at the file [imp2.ml]. Notice how the fundamental 65 | definitions have changed from [imp1.ml]. *) 66 | 67 | (* ############################################################## *) 68 | (** * A Complete Example *) 69 | 70 | (** To use our extracted evaluator to run Imp programs, all we need to 71 | add is a tiny driver program that calls the evaluator and somehow 72 | prints out the result. 73 | 74 | For simplicity, we'll print results by dumping out the first four 75 | memory locations in the final state. 76 | 77 | Also, to make it easier to type in examples, let's extract a 78 | parser from the [ImpParser] Coq module. To do this, we need a few 79 | more declarations to set up the right correspondence between Coq 80 | strings and lists of OCaml characters. *) 81 | 82 | Require Import Ascii String. 83 | Extract Inductive ascii => char 84 | [ 85 | "(* If this appears, you're using Ascii internals. Please don't *) (fun (b0,b1,b2,b3,b4,b5,b6,b7) -> let f b i = if b then 1 lsl i else 0 in Char.chr (f b0 0 + f b1 1 + f b2 2 + f b3 3 + f b4 4 + f b5 5 + f b6 6 + f b7 7))" 86 | ] 87 | "(* If this appears, you're using Ascii internals. Please don't *) (fun f c -> let n = Char.code c in let h i = (n land (1 lsl i)) <> 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7))". 88 | Extract Constant zero => "'\000'". 89 | Extract Constant one => "'\001'". 90 | Extract Constant shift => 91 | "fun b c -> Char.chr (((Char.code c) lsl 1) land 255 + if b then 1 else 0)". 92 | Extract Inlined Constant ascii_dec => "(=)". 93 | 94 | (** We also need one more variant of booleans. *) 95 | 96 | Extract Inductive sumbool => "bool" ["true" "false"]. 97 | 98 | (** The extraction is the same as always. *) 99 | 100 | Require Import Imp. 101 | Require Import ImpParser. 102 | Extraction "imp.ml" empty_state ceval_step parse. 103 | 104 | (** Now let's run our generated Imp evaluator. First, have a look at 105 | [impdriver.ml]. (This was written by hand, not extracted.) 106 | 107 | Next, compile the driver together with the extracted code and 108 | execute it, as follows. 109 | << 110 | ocamlc -w -20 -w -26 -o impdriver imp.mli imp.ml impdriver.ml 111 | ./impdriver 112 | >> 113 | (The [-w] flags to [ocamlc] are just there to suppress a few 114 | spurious warnings.) *) 115 | 116 | (* ############################################################## *) 117 | (** * Discussion *) 118 | 119 | (** Since we've proved that the [ceval_step] function behaves the same 120 | as the [ceval] relation in an appropriate sense, the extracted 121 | program can be viewed as a _certified_ Imp interpreter. (Of 122 | course, the parser is not certified in any interesting sense, 123 | since we didn't prove anything about it.) *) 124 | 125 | (** $Date: 2014-12-31 11:17:56 -0500 (Wed, 31 Dec 2014) $ *) 126 | -------------------------------------------------------------------------------- /HoareAsLogic.v: -------------------------------------------------------------------------------- 1 | (** * HoareAsLogic: Hoare Logic as a Logic *) 2 | 3 | Require Export Hoare. 4 | 5 | (** The presentation of Hoare logic in chapter [Hoare] could be 6 | described as "model-theoretic": the proof rules for each of the 7 | constructors were presented as _theorems_ about the evaluation 8 | behavior of programs, and proofs of program correctness (validity 9 | of Hoare triples) were constructed by combining these theorems 10 | directly in Coq. 11 | 12 | Another way of presenting Hoare logic is to define a completely 13 | separate proof system -- a set of axioms and inference rules that 14 | talk about commands, Hoare triples, etc. -- and then say that a 15 | proof of a Hoare triple is a valid derivation in _that_ logic. We 16 | can do this by giving an inductive definition of _valid 17 | derivations_ in this new logic. *) 18 | 19 | Inductive hoare_proof : Assertion -> com -> Assertion -> Type := 20 | | H_Skip : forall P, 21 | hoare_proof P (SKIP) P 22 | | H_Asgn : forall Q V a, 23 | hoare_proof (assn_sub V a Q) (V ::= a) Q 24 | | H_Seq : forall P c Q d R, 25 | hoare_proof P c Q -> hoare_proof Q d R -> hoare_proof P (c;;d) R 26 | | H_If : forall P Q b c1 c2, 27 | hoare_proof (fun st => P st /\ bassn b st) c1 Q -> 28 | hoare_proof (fun st => P st /\ ~(bassn b st)) c2 Q -> 29 | hoare_proof P (IFB b THEN c1 ELSE c2 FI) Q 30 | | H_While : forall P b c, 31 | hoare_proof (fun st => P st /\ bassn b st) c P -> 32 | hoare_proof P (WHILE b DO c END) (fun st => P st /\ ~ (bassn b st)) 33 | | H_Consequence : forall (P Q P' Q' : Assertion) c, 34 | hoare_proof P' c Q' -> 35 | (forall st, P st -> P' st) -> 36 | (forall st, Q' st -> Q st) -> 37 | hoare_proof P c Q. 38 | 39 | Tactic Notation "hoare_proof_cases" tactic(first) ident(c) := 40 | first; 41 | [ Case_aux c "H_Skip" | Case_aux c "H_Asgn" | Case_aux c "H_Seq" 42 | | Case_aux c "H_If" | Case_aux c "H_While" | Case_aux c "H_Consequence" ]. 43 | 44 | (** We don't need to include axioms corresponding to [hoare_consequence_pre] 45 | or [hoare_consequence_post], because these can be proven easily 46 | from [H_Consequence]. *) 47 | 48 | Lemma H_Consequence_pre : forall (P Q P': Assertion) c, 49 | hoare_proof P' c Q -> 50 | (forall st, P st -> P' st) -> 51 | hoare_proof P c Q. 52 | Proof. 53 | intros. eapply H_Consequence. apply X. assumption. 54 | intros; assumption. 55 | Qed. 56 | 57 | Lemma H_Consequence_post : forall (P Q Q' : Assertion) c, 58 | hoare_proof P c Q' -> 59 | (forall st, Q' st -> Q st) -> 60 | hoare_proof P c Q. 61 | Proof. 62 | intros. eapply H_Consequence. apply X. intros; assumption. 63 | assumption. 64 | Qed. 65 | 66 | 67 | (** Now, for example, let's construct a proof object representing a 68 | derivation for the hoare triple 69 | {{assn_sub X (X+1) (assn_sub X (X+2) (X=3))}} X::=X+1;; X::=X+2 {{X=3}}. 70 | We can use Coq's tactics to help us construct the proof object. *) 71 | 72 | Example sample_proof 73 | : hoare_proof 74 | (assn_sub X (APlus (AId X) (ANum 1)) 75 | (assn_sub X (APlus (AId X) (ANum 2)) 76 | (fun st => st X = 3) )) 77 | (X ::= APlus (AId X) (ANum 1);; (X ::= APlus (AId X) (ANum 2))) 78 | (fun st => st X = 3). 79 | Proof. 80 | eapply H_Seq; apply H_Asgn. 81 | Qed. 82 | 83 | 84 | (* 85 | Print sample_proof. 86 | ====> 87 | H_Seq 88 | (assn_sub X (APlus (AId X) (ANum 1)) 89 | (assn_sub X (APlus (AId X) (ANum 2)) (fun st : state => st X = VNat 3))) 90 | (X ::= APlus (AId X) (ANum 1)) 91 | (assn_sub X (APlus (AId X) (ANum 2)) (fun st : state => st X = VNat 3)) 92 | (X ::= APlus (AId X) (ANum 2)) (fun st : state => st X = VNat 3) 93 | (H_Asgn 94 | (assn_sub X (APlus (AId X) (ANum 2)) (fun st : state => st X = VNat 3)) 95 | X (APlus (AId X) (ANum 1))) 96 | (H_Asgn (fun st : state => st X = VNat 3) X (APlus (AId X) (ANum 2))) 97 | *) 98 | 99 | (** **** Exercise: 2 stars (hoare_proof_sound) *) 100 | (** Prove that such proof objects represent true claims. *) 101 | 102 | Theorem hoare_proof_sound : forall P c Q, 103 | hoare_proof P c Q -> {{P}} c {{Q}}. 104 | Proof. 105 | intros. induction X. 106 | apply hoare_skip. 107 | apply hoare_asgn. 108 | eapply hoare_seq. eauto. assumption. 109 | apply hoare_if; assumption. 110 | apply hoare_while. assumption. 111 | eapply hoare_consequence_post. 112 | eapply hoare_consequence_pre. 113 | eauto. assumption. assumption. 114 | Qed. 115 | (** [] *) 116 | 117 | (** We can also use Coq's reasoning facilities to prove metatheorems 118 | about Hoare Logic. For example, here are the analogs of two 119 | theorems we saw in chapter [Hoare] -- this time expressed in terms 120 | of the syntax of Hoare Logic derivations (provability) rather than 121 | directly in terms of the semantics of Hoare triples. 122 | 123 | The first one says that, for every [P] and [c], the assertion 124 | [{{P}} c {{True}}] is _provable_ in Hoare Logic. Note that the 125 | proof is more complex than the semantic proof in [Hoare]: we 126 | actually need to perform an induction over the structure of the 127 | command [c]. *) 128 | 129 | Theorem H_Post_True_deriv: 130 | forall c P, hoare_proof P c (fun _ => True). 131 | Proof. 132 | intro c. 133 | com_cases (induction c) Case; intro P. 134 | Case "SKIP". 135 | eapply H_Consequence. 136 | apply H_Skip. 137 | intros. apply H. 138 | (* Proof of True *) 139 | intros. apply I. 140 | Case "::=". 141 | eapply H_Consequence_pre. 142 | apply H_Asgn. 143 | intros. apply I. 144 | Case ";;". 145 | eapply H_Consequence_pre. 146 | eapply H_Seq. 147 | apply (IHc1 (fun _ => True)). 148 | apply IHc2. 149 | intros. apply I. 150 | Case "IFB". 151 | apply H_Consequence_pre with (fun _ => True). 152 | apply H_If. 153 | apply IHc1. 154 | apply IHc2. 155 | intros. apply I. 156 | Case "WHILE". 157 | eapply H_Consequence. 158 | eapply H_While. 159 | eapply IHc. 160 | intros; apply I. 161 | intros; apply I. 162 | Qed. 163 | 164 | (** Similarly, we can show that [{{False}} c {{Q}}] is provable for 165 | any [c] and [Q]. *) 166 | 167 | Lemma False_and_P_imp: forall P Q, 168 | False /\ P -> Q. 169 | Proof. 170 | intros P Q [CONTRA HP]. 171 | destruct CONTRA. 172 | Qed. 173 | 174 | Tactic Notation "pre_false_helper" constr(CONSTR) := 175 | eapply H_Consequence_pre; 176 | [eapply CONSTR | intros ? CONTRA; destruct CONTRA]. 177 | 178 | Theorem H_Pre_False_deriv: 179 | forall c Q, hoare_proof (fun _ => False) c Q. 180 | Proof. 181 | intros c. 182 | com_cases (induction c) Case; intro Q. 183 | Case "SKIP". pre_false_helper H_Skip. 184 | Case "::=". pre_false_helper H_Asgn. 185 | Case ";;". pre_false_helper H_Seq. apply IHc1. apply IHc2. 186 | Case "IFB". 187 | apply H_If; eapply H_Consequence_pre. 188 | apply IHc1. intro. eapply False_and_P_imp. 189 | apply IHc2. intro. eapply False_and_P_imp. 190 | Case "WHILE". 191 | eapply H_Consequence_post. 192 | eapply H_While. 193 | eapply H_Consequence_pre. 194 | apply IHc. 195 | intro. eapply False_and_P_imp. 196 | intro. simpl. eapply False_and_P_imp. 197 | Qed. 198 | 199 | (** As a last step, we can show that the set of [hoare_proof] axioms is 200 | sufficient to prove any true fact about (partial) correctness. 201 | More precisely, any semantic Hoare triple that we can prove can 202 | also be proved from these axioms. Such a set of axioms is said 203 | to be _relatively complete_. *) 204 | 205 | (** This proof is inspired by the one at 206 | http://www.ps.uni-saarland.de/courses/sem-ws11/script/Hoare.html 207 | *) 208 | 209 | (** To prove this fact, we'll need to invent some intermediate 210 | assertions using a technical device known as _weakest preconditions_. 211 | Given a command [c] and a desired postcondition assertion [Q], 212 | the weakest precondition [wp c Q] is an assertion [P] such that 213 | [{{P}} c {{Q}}] holds, and moreover, for any other assertion [P'], 214 | if [{{P'}} c {{Q}}] holds then [P' -> P]. We can more directly 215 | define this as follows: *) 216 | 217 | Definition wp (c:com) (Q:Assertion) : Assertion := 218 | fun s => forall s', c / s || s' -> Q s'. 219 | 220 | (** **** Exercise: 1 star (wp_is_precondition) *) 221 | 222 | Lemma wp_is_precondition: forall c Q, 223 | {{wp c Q}} c {{Q}}. 224 | Proof. 225 | unfold wp. intros c Q st st' H H1. 226 | apply H1. assumption. 227 | Qed. 228 | (** [] *) 229 | 230 | (** **** Exercise: 1 star (wp_is_weakest) *) 231 | 232 | Lemma wp_is_weakest: forall c Q P', 233 | {{P'}} c {{Q}} -> forall st, P' st -> wp c Q st. 234 | Proof. 235 | unfold hoare_triple. unfold wp. 236 | intros. eapply H. eauto. assumption. 237 | Qed. 238 | 239 | (** The following utility lemma will also be useful. *) 240 | 241 | Lemma bassn_eval_false : forall b st, ~ bassn b st -> beval st b = false. 242 | Proof. 243 | intros b st H. unfold bassn in H. destruct (beval st b). 244 | exfalso. apply H. reflexivity. 245 | reflexivity. 246 | Qed. 247 | (** [] *) 248 | 249 | (** **** Exercise: 4 stars (hoare_proof_complete) *) 250 | (** Complete the proof of the theorem. *) 251 | 252 | Theorem hoare_proof_complete: forall P c Q, 253 | {{P}} c {{Q}} -> hoare_proof P c Q. 254 | Proof. 255 | intros P c. generalize dependent P. 256 | com_cases (induction c) Case; intros P Q HT. 257 | Case "SKIP". 258 | eapply H_Consequence. 259 | eapply H_Skip. 260 | intros. eassumption. 261 | intro st. apply HT. apply E_Skip. 262 | Case "::=". 263 | eapply H_Consequence. 264 | eapply H_Asgn. 265 | intro st. apply HT. econstructor. reflexivity. 266 | intros; assumption. 267 | Case ";;". 268 | apply H_Seq with (wp c2 Q). 269 | eapply IHc1. 270 | intros st st' E1 H. unfold wp. intros st'' E2. 271 | eapply HT. econstructor; eassumption. assumption. 272 | eapply IHc2. intros st st' E1 H. apply H; assumption. 273 | Case "IFB". 274 | apply H_If. 275 | apply IHc1. intros st st' H1 H2. destruct H2. 276 | eapply HT; eauto. apply E_IfTrue; auto. 277 | apply IHc2. intros st st' H1 H2. destruct H2. 278 | eapply HT; eauto. apply E_IfFalse; auto. eapply bassn_eval_false. assumption. 279 | Case "WHILE". 280 | eapply H_Consequence with (P' := wp (WHILE b DO c END) Q). 281 | apply H_While. apply IHc. intros st st' H H'. 282 | destruct H'. unfold wp in *. intros. 283 | apply H0. eapply E_WhileLoop. assumption. eassumption. 284 | assumption. 285 | apply wp_is_weakest. assumption. 286 | simpl. intros. destruct H. 287 | apply wp_is_precondition with (WHILE b DO c END) st. 288 | apply E_WhileEnd. apply bassn_eval_false. assumption. assumption. 289 | Qed. 290 | (** [] *) 291 | 292 | (** Finally, we might hope that our axiomatic Hoare logic is _decidable_; 293 | that is, that there is an (terminating) algorithm (a _decision procedure_) 294 | that can determine whether or not a given Hoare triple is valid (derivable). 295 | But such a decision procedure cannot exist! 296 | 297 | Consider the triple [{{True}} c {{False}}]. This triple is valid 298 | if and only if [c] is non-terminating. So any algorithm that could 299 | determine validity of arbitrary triples could solve the Halting Problem. 300 | 301 | Similarly, the triple [{{True} SKIP {{P}}] is valid if and only if 302 | [forall s, P s] is valid, where [P] is an arbitrary assertion of Coq's 303 | logic. But it is known that there can be no decision procedure for 304 | this logic. 305 | 306 | *) 307 | 308 | (** Overall, this axiomatic style of presentation gives a clearer picture of what it 309 | means to "give a proof in Hoare logic." However, it is not 310 | entirely satisfactory from the point of view of writing down such 311 | proofs in practice: it is quite verbose. The section of chapter 312 | [Hoare2] on formalizing decorated programs shows how we can do even 313 | better. *) 314 | 315 | (** $Date: 2014-12-31 11:17:56 -0500 (Wed, 31 Dec 2014) $ *) 316 | -------------------------------------------------------------------------------- /ImpCEvalFun.v: -------------------------------------------------------------------------------- 1 | (** * ImpCEvalFun: Evaluation Function for Imp *) 2 | 3 | (* #################################### *) 4 | (** * Evaluation Function *) 5 | 6 | Require Import Imp. 7 | 8 | (** Here's a first try at an evaluation function for commands, 9 | omitting [WHILE]. *) 10 | 11 | Fixpoint ceval_step1 (st : state) (c : com) : state := 12 | match c with 13 | | SKIP => 14 | st 15 | | l ::= a1 => 16 | update st l (aeval st a1) 17 | | c1 ;; c2 => 18 | let st' := ceval_step1 st c1 in 19 | ceval_step1 st' c2 20 | | IFB b THEN c1 ELSE c2 FI => 21 | if (beval st b) 22 | then ceval_step1 st c1 23 | else ceval_step1 st c2 24 | | WHILE b1 DO c1 END => 25 | st (* bogus *) 26 | end. 27 | 28 | (** In a traditional functional programming language like ML or 29 | Haskell we could write the WHILE case as follows: 30 | << 31 | | WHILE b1 DO c1 END => 32 | if (beval st b1) 33 | then ceval_step1 st (c1;; WHILE b1 DO c1 END) 34 | else st 35 | >> 36 | Coq doesn't accept such a definition ([Error: Cannot guess 37 | decreasing argument of fix]) because the function we want to 38 | define is not guaranteed to terminate. Indeed, the changed 39 | [ceval_step1] function applied to the [loop] program from [Imp.v] would 40 | never terminate. Since Coq is not just a functional programming 41 | language, but also a consistent logic, any potentially 42 | non-terminating function needs to be rejected. Here is an 43 | invalid(!) Coq program showing what would go wrong if Coq allowed 44 | non-terminating recursive functions: 45 | << 46 | Fixpoint loop_false (n : nat) : False := loop_false n. 47 | >> 48 | That is, propositions like [False] would become 49 | provable (e.g. [loop_false 0] would be a proof of [False]), which 50 | would be a disaster for Coq's logical consistency. 51 | 52 | Thus, because it doesn't terminate on all inputs, the full version 53 | of [ceval_step1] cannot be written in Coq -- at least not 54 | without one additional trick... *) 55 | 56 | 57 | (** Second try, using an extra numeric argument as a "step index" to 58 | ensure that evaluation always terminates. *) 59 | 60 | Fixpoint ceval_step2 (st : state) (c : com) (i : nat) : state := 61 | match i with 62 | | O => empty_state 63 | | S i' => 64 | match c with 65 | | SKIP => 66 | st 67 | | l ::= a1 => 68 | update st l (aeval st a1) 69 | | c1 ;; c2 => 70 | let st' := ceval_step2 st c1 i' in 71 | ceval_step2 st' c2 i' 72 | | IFB b THEN c1 ELSE c2 FI => 73 | if (beval st b) 74 | then ceval_step2 st c1 i' 75 | else ceval_step2 st c2 i' 76 | | WHILE b1 DO c1 END => 77 | if (beval st b1) 78 | then let st' := ceval_step2 st c1 i' in 79 | ceval_step2 st' c i' 80 | else st 81 | end 82 | end. 83 | 84 | (** _Note_: It is tempting to think that the index [i] here is 85 | counting the "number of steps of evaluation." But if you look 86 | closely you'll see that this is not the case: for example, in the 87 | rule for sequencing, the same [i] is passed to both recursive 88 | calls. Understanding the exact way that [i] is treated will be 89 | important in the proof of [ceval__ceval_step], which is given as 90 | an exercise below. *) 91 | 92 | (** Third try, returning an [option state] instead of just a [state] 93 | so that we can distinguish between normal and abnormal 94 | termination. *) 95 | 96 | Fixpoint ceval_step3 (st : state) (c : com) (i : nat) 97 | : option state := 98 | match i with 99 | | O => None 100 | | S i' => 101 | match c with 102 | | SKIP => 103 | Some st 104 | | l ::= a1 => 105 | Some (update st l (aeval st a1)) 106 | | c1 ;; c2 => 107 | match (ceval_step3 st c1 i') with 108 | | Some st' => ceval_step3 st' c2 i' 109 | | None => None 110 | end 111 | | IFB b THEN c1 ELSE c2 FI => 112 | if (beval st b) 113 | then ceval_step3 st c1 i' 114 | else ceval_step3 st c2 i' 115 | | WHILE b1 DO c1 END => 116 | if (beval st b1) 117 | then match (ceval_step3 st c1 i') with 118 | | Some st' => ceval_step3 st' c i' 119 | | None => None 120 | end 121 | else Some st 122 | end 123 | end. 124 | 125 | (** We can improve the readability of this definition by introducing a 126 | bit of auxiliary notation to hide the "plumbing" involved in 127 | repeatedly matching against optional states. *) 128 | 129 | Notation "'LETOPT' x <== e1 'IN' e2" 130 | := (match e1 with 131 | | Some x => e2 132 | | None => None 133 | end) 134 | (right associativity, at level 60). 135 | 136 | Fixpoint ceval_step (st : state) (c : com) (i : nat) 137 | : option state := 138 | match i with 139 | | O => None 140 | | S i' => 141 | match c with 142 | | SKIP => 143 | Some st 144 | | l ::= a1 => 145 | Some (update st l (aeval st a1)) 146 | | c1 ;; c2 => 147 | LETOPT st' <== ceval_step st c1 i' IN 148 | ceval_step st' c2 i' 149 | | IFB b THEN c1 ELSE c2 FI => 150 | if (beval st b) 151 | then ceval_step st c1 i' 152 | else ceval_step st c2 i' 153 | | WHILE b1 DO c1 END => 154 | if (beval st b1) 155 | then LETOPT st' <== ceval_step st c1 i' IN 156 | ceval_step st' c i' 157 | else Some st 158 | end 159 | end. 160 | 161 | Definition test_ceval (st:state) (c:com) := 162 | match ceval_step st c 500 with 163 | | None => None 164 | | Some st => Some (st X, st Y, st Z) 165 | end. 166 | 167 | (* Eval compute in 168 | (test_ceval empty_state 169 | (X ::= ANum 2;; 170 | IFB BLe (AId X) (ANum 1) 171 | THEN Y ::= ANum 3 172 | ELSE Z ::= ANum 4 173 | FI)). 174 | ====> 175 | Some (2, 0, 4) *) 176 | 177 | (** **** Exercise: 2 stars (pup_to_n) *) 178 | (** Write an Imp program that sums the numbers from [1] to 179 | [X] (inclusive: [1 + 2 + ... + X]) in the variable [Y]. Make sure 180 | your solution satisfies the test that follows. *) 181 | 182 | Definition pup_to_n : com := 183 | Y ::= (ANum 0);; 184 | WHILE BLe (ANum 1) (AId X) DO 185 | Y ::= APlus (AId Y) (AId X);; 186 | X ::= AMinus (AId X) (ANum 1) 187 | END. 188 | 189 | Example pup_to_n_1 : 190 | test_ceval (update empty_state X 5) pup_to_n 191 | = Some (0, 15, 0). 192 | Proof. reflexivity. Qed. 193 | (** [] *) 194 | 195 | (** **** Exercise: 2 stars, optional (peven) *) 196 | (** Write a [While] program that sets [Z] to [0] if [X] is even and 197 | sets [Z] to [1] otherwise. Use [ceval_test] to test your 198 | program. *) 199 | 200 | Definition peven : com := 201 | WHILE BLe (ANum 2) (AId X) DO 202 | X ::= AMinus (AId X) (ANum 2) 203 | END;; 204 | IFB BEq (ANum 1) (AId X) THEN 205 | Z ::= (ANum 1) ELSE Z ::= (ANum 0) 206 | FI. 207 | 208 | Example peven_11: 209 | test_ceval (update empty_state X 11) peven 210 | = Some (1, 0, 1). 211 | Proof. reflexivity. Qed. 212 | 213 | Example peven_10: 214 | test_ceval (update empty_state X 10) peven 215 | = Some (0, 0, 0). 216 | Proof. reflexivity. Qed. 217 | (** [] *) 218 | 219 | (* ################################################################ *) 220 | (** * Equivalence of Relational and Step-Indexed Evaluation *) 221 | 222 | (** As with arithmetic and boolean expressions, we'd hope that 223 | the two alternative definitions of evaluation actually boil down 224 | to the same thing. This section shows that this is the case. 225 | Make sure you understand the statements of the theorems and can 226 | follow the structure of the proofs. *) 227 | 228 | Theorem ceval_step__ceval: forall c st st', 229 | (exists i, ceval_step st c i = Some st') -> 230 | c / st || st'. 231 | Proof. 232 | intros c st st' H. 233 | inversion H as [i E]. 234 | clear H. 235 | generalize dependent st'. 236 | generalize dependent st. 237 | generalize dependent c. 238 | induction i as [| i' ]. 239 | 240 | Case "i = 0 -- contradictory". 241 | intros c st st' H. inversion H. 242 | 243 | Case "i = S i'". 244 | intros c st st' H. 245 | com_cases (destruct c) SCase; 246 | simpl in H; inversion H; subst; clear H. 247 | SCase "SKIP". apply E_Skip. 248 | SCase "::=". apply E_Ass. reflexivity. 249 | 250 | SCase ";;". 251 | destruct (ceval_step st c1 i') eqn:Heqr1. 252 | SSCase "Evaluation of r1 terminates normally". 253 | apply E_Seq with s. 254 | apply IHi'. rewrite Heqr1. reflexivity. 255 | apply IHi'. simpl in H1. assumption. 256 | SSCase "Otherwise -- contradiction". 257 | inversion H1. 258 | 259 | SCase "IFB". 260 | destruct (beval st b) eqn:Heqr. 261 | SSCase "r = true". 262 | apply E_IfTrue. rewrite Heqr. reflexivity. 263 | apply IHi'. assumption. 264 | SSCase "r = false". 265 | apply E_IfFalse. rewrite Heqr. reflexivity. 266 | apply IHi'. assumption. 267 | 268 | SCase "WHILE". destruct (beval st b) eqn :Heqr. 269 | SSCase "r = true". 270 | destruct (ceval_step st c i') eqn:Heqr1. 271 | SSSCase "r1 = Some s". 272 | apply E_WhileLoop with s. rewrite Heqr. reflexivity. 273 | apply IHi'. rewrite Heqr1. reflexivity. 274 | apply IHi'. simpl in H1. assumption. 275 | SSSCase "r1 = None". 276 | inversion H1. 277 | SSCase "r = false". 278 | inversion H1. 279 | apply E_WhileEnd. 280 | rewrite <- Heqr. subst. reflexivity. Qed. 281 | 282 | (** **** Exercise: 4 stars (ceval_step__ceval_inf) *) 283 | (** Write an informal proof of [ceval_step__ceval], following the 284 | usual template. (The template for case analysis on an inductively 285 | defined value should look the same as for induction, except that 286 | there is no induction hypothesis.) Make your proof communicate 287 | the main ideas to a human reader; do not simply transcribe the 288 | steps of the formal proof. 289 | 290 | ... 291 | [] 292 | *) 293 | 294 | Theorem ceval_step_more: forall i1 i2 st st' c, 295 | i1 <= i2 -> 296 | ceval_step st c i1 = Some st' -> 297 | ceval_step st c i2 = Some st'. 298 | Proof. 299 | induction i1 as [|i1']; intros i2 st st' c Hle Hceval. 300 | Case "i1 = 0". 301 | simpl in Hceval. inversion Hceval. 302 | Case "i1 = S i1'". 303 | destruct i2 as [|i2']. inversion Hle. 304 | assert (Hle': i1' <= i2') by omega. 305 | com_cases (destruct c) SCase. 306 | SCase "SKIP". 307 | simpl in Hceval. inversion Hceval. 308 | reflexivity. 309 | SCase "::=". 310 | simpl in Hceval. inversion Hceval. 311 | reflexivity. 312 | SCase ";;". 313 | simpl in Hceval. simpl. 314 | destruct (ceval_step st c1 i1') eqn:Heqst1'o. 315 | SSCase "st1'o = Some". 316 | apply (IHi1' i2') in Heqst1'o; try assumption. 317 | rewrite Heqst1'o. simpl. simpl in Hceval. 318 | apply (IHi1' i2') in Hceval; try assumption. 319 | SSCase "st1'o = None". 320 | inversion Hceval. 321 | 322 | SCase "IFB". 323 | simpl in Hceval. simpl. 324 | destruct (beval st b); apply (IHi1' i2') in Hceval; assumption. 325 | 326 | SCase "WHILE". 327 | simpl in Hceval. simpl. 328 | destruct (beval st b); try assumption. 329 | destruct (ceval_step st c i1') eqn: Heqst1'o. 330 | SSCase "st1'o = Some". 331 | apply (IHi1' i2') in Heqst1'o; try assumption. 332 | rewrite -> Heqst1'o. simpl. simpl in Hceval. 333 | apply (IHi1' i2') in Hceval; try assumption. 334 | SSCase "i1'o = None". 335 | simpl in Hceval. inversion Hceval. Qed. 336 | 337 | (** **** Exercise: 3 stars (ceval__ceval_step) *) 338 | (** Finish the following proof. You'll need [ceval_step_more] in a 339 | few places, as well as some basic facts about [<=] and [plus]. *) 340 | 341 | Theorem ceval__ceval_step: forall c st st', 342 | c / st || st' -> 343 | exists i, ceval_step st c i = Some st'. 344 | Proof. 345 | intros c st st' Hce. 346 | ceval_cases (induction Hce) Case. 347 | exists 1. reflexivity. exists 1. simpl. rewrite H. reflexivity. 348 | destruct IHHce1. destruct IHHce2. 349 | exists (1 + x + x0). simpl. destruct (ceval_step st c1 (x + x0)) eqn:eqstep. 350 | apply ceval_step_more with (i2 := x + x0) in H. 351 | rewrite H in eqstep. inversion eqstep. subst. 352 | apply ceval_step_more with (i1 := x0). omega. assumption. omega. 353 | apply ceval_step_more with (i2 := x + x0) in H. 354 | rewrite eqstep in H. inversion H. omega. 355 | destruct IHHce. exists (1 + x). simpl. rewrite H. assumption. 356 | destruct IHHce. exists (1 + x). simpl. rewrite H. assumption. 357 | exists 1. simpl. rewrite H. reflexivity. 358 | destruct IHHce1. destruct IHHce2. 359 | exists (1 + x + x0). simpl. rewrite H. 360 | destruct (ceval_step st c (x + x0)) eqn:eqstep. 361 | apply ceval_step_more with (i2 := x + x0) in H0. 362 | rewrite eqstep in H0. inversion H0. 363 | apply ceval_step_more with (i1 := x0). omega. assumption. omega. 364 | apply ceval_step_more with (i2 := x + x0) in H0. 365 | rewrite H0 in eqstep. inversion eqstep. omega. 366 | Qed. 367 | 368 | (** [] *) 369 | 370 | Theorem ceval_and_ceval_step_coincide: forall c st st', 371 | c / st || st' 372 | <-> exists i, ceval_step st c i = Some st'. 373 | Proof. 374 | intros c st st'. 375 | split. apply ceval__ceval_step. apply ceval_step__ceval. 376 | Qed. 377 | 378 | (* ####################################################### *) 379 | (** * Determinism of Evaluation (Simpler Proof) *) 380 | 381 | (** Here's a slicker proof showing that the evaluation relation is 382 | deterministic, using the fact that the relational and step-indexed 383 | definition of evaluation are the same. *) 384 | 385 | Theorem ceval_deterministic' : forall c st st1 st2, 386 | c / st || st1 -> 387 | c / st || st2 -> 388 | st1 = st2. 389 | Proof. 390 | intros c st st1 st2 He1 He2. 391 | apply ceval__ceval_step in He1. 392 | apply ceval__ceval_step in He2. 393 | inversion He1 as [i1 E1]. 394 | inversion He2 as [i2 E2]. 395 | apply ceval_step_more with (i2 := i1 + i2) in E1. 396 | apply ceval_step_more with (i2 := i1 + i2) in E2. 397 | rewrite E1 in E2. inversion E2. reflexivity. 398 | omega. omega. Qed. 399 | 400 | (** $Date: 2014-12-31 11:17:56 -0500 (Wed, 31 Dec 2014) $ *) 401 | -------------------------------------------------------------------------------- /ImpParser.v: -------------------------------------------------------------------------------- 1 | (** * ImpParser: Lexing and Parsing in Coq *) 2 | 3 | (** The development of the [Imp] language in Imp.v completely ignores 4 | issues of concrete syntax -- how an ascii string that a programmer 5 | might write gets translated into the abstract syntax trees defined 6 | by the datatypes [aexp], [bexp], and [com]. In this file we 7 | illustrate how the rest of the story can be filled in by building 8 | a simple lexical analyzer and parser using Coq's functional 9 | programming facilities. 10 | 11 | This development is not intended to be understood in detail: the 12 | explanations are fairly terse and there are no exercises. The 13 | main point is simply to demonstrate that it can be done. You are 14 | invited to look through the code -- most of it is not very 15 | complicated, though the parser relies on some "monadic" 16 | programming idioms that may require a little work to make out -- 17 | but most readers will probably want to just skip down to the 18 | Examples section at the very end to get the punchline. *) 19 | 20 | (* ####################################################### *) 21 | (** * Internals *) 22 | 23 | Require Import SfLib. 24 | Require Import Imp. 25 | 26 | Require Import String. 27 | Require Import Ascii. 28 | 29 | Open Scope list_scope. 30 | 31 | (* ####################################################### *) 32 | (** ** Lexical Analysis *) 33 | 34 | Definition isWhite (c : ascii) : bool := 35 | let n := nat_of_ascii c in 36 | orb (orb (beq_nat n 32) (* space *) 37 | (beq_nat n 9)) (* tab *) 38 | (orb (beq_nat n 10) (* linefeed *) 39 | (beq_nat n 13)). (* Carriage return. *) 40 | 41 | Notation "x '<=?' y" := (ble_nat x y) 42 | (at level 70, no associativity) : nat_scope. 43 | 44 | Definition isLowerAlpha (c : ascii) : bool := 45 | let n := nat_of_ascii c in 46 | andb (97 <=? n) (n <=? 122). 47 | 48 | Definition isAlpha (c : ascii) : bool := 49 | let n := nat_of_ascii c in 50 | orb (andb (65 <=? n) (n <=? 90)) 51 | (andb (97 <=? n) (n <=? 122)). 52 | 53 | Definition isDigit (c : ascii) : bool := 54 | let n := nat_of_ascii c in 55 | andb (48 <=? n) (n <=? 57). 56 | 57 | Inductive chartype := white | alpha | digit | other. 58 | 59 | Definition classifyChar (c : ascii) : chartype := 60 | if isWhite c then 61 | white 62 | else if isAlpha c then 63 | alpha 64 | else if isDigit c then 65 | digit 66 | else 67 | other. 68 | 69 | Fixpoint list_of_string (s : string) : list ascii := 70 | match s with 71 | | EmptyString => [] 72 | | String c s => c :: (list_of_string s) 73 | end. 74 | 75 | Fixpoint string_of_list (xs : list ascii) : string := 76 | fold_right String EmptyString xs. 77 | 78 | Definition token := string. 79 | 80 | Fixpoint tokenize_helper (cls : chartype) (acc xs : list ascii) 81 | : list (list ascii) := 82 | let tk := match acc with [] => [] | _::_ => [rev acc] end in 83 | match xs with 84 | | [] => tk 85 | | (x::xs') => 86 | match cls, classifyChar x, x with 87 | | _, _, "(" => tk ++ ["("]::(tokenize_helper other [] xs') 88 | | _, _, ")" => tk ++ [")"]::(tokenize_helper other [] xs') 89 | | _, white, _ => tk ++ (tokenize_helper white [] xs') 90 | | alpha,alpha,x => tokenize_helper alpha (x::acc) xs' 91 | | digit,digit,x => tokenize_helper digit (x::acc) xs' 92 | | other,other,x => tokenize_helper other (x::acc) xs' 93 | | _,tp,x => tk ++ (tokenize_helper tp [x] xs') 94 | end 95 | end %char. 96 | 97 | Definition tokenize (s : string) : list string := 98 | map string_of_list (tokenize_helper white [] (list_of_string s)). 99 | 100 | Example tokenize_ex1 : 101 | tokenize "abc12==3 223*(3+(a+c))" %string 102 | = ["abc"; "12"; "=="; "3"; "223"; 103 | "*"; "("; "3"; "+"; "("; 104 | "a"; "+"; "c"; ")"; ")"]%string. 105 | Proof. reflexivity. Qed. 106 | 107 | (* ####################################################### *) 108 | (** ** Parsing *) 109 | 110 | (* ####################################################### *) 111 | (** *** Options with Errors *) 112 | 113 | (* An option with error messages. *) 114 | Inductive optionE (X:Type) : Type := 115 | | SomeE : X -> optionE X 116 | | NoneE : string -> optionE X. 117 | 118 | Implicit Arguments SomeE [[X]]. 119 | Implicit Arguments NoneE [[X]]. 120 | 121 | (* Some syntactic sugar to make writing nested match-expressions on 122 | optionE more convenient. *) 123 | 124 | Notation "'DO' ( x , y ) <== e1 ; e2" 125 | := (match e1 with 126 | | SomeE (x,y) => e2 127 | | NoneE err => NoneE err 128 | end) 129 | (right associativity, at level 60). 130 | 131 | Notation "'DO' ( x , y ) <-- e1 ; e2 'OR' e3" 132 | := (match e1 with 133 | | SomeE (x,y) => e2 134 | | NoneE err => e3 135 | end) 136 | (right associativity, at level 60, e2 at next level). 137 | 138 | (* ####################################################### *) 139 | (** *** Symbol Table *) 140 | 141 | (* Build a mapping from [tokens] to [nats]. A real parser would do 142 | this incrementally as it encountered new symbols, but passing 143 | around the symbol table inside the parsing functions is a bit 144 | inconvenient, so instead we do it as a first pass. *) 145 | Fixpoint build_symtable (xs : list token) (n : nat) : (token -> nat) := 146 | match xs with 147 | | [] => (fun s => n) 148 | | x::xs => 149 | if (forallb isLowerAlpha (list_of_string x)) 150 | then (fun s => if string_dec s x then n else (build_symtable xs (S n) s)) 151 | else build_symtable xs n 152 | end. 153 | 154 | (* ####################################################### *) 155 | (** *** Generic Combinators for Building Parsers *) 156 | 157 | Open Scope string_scope. 158 | 159 | Definition parser (T : Type) := 160 | list token -> optionE (T * list token). 161 | 162 | Fixpoint many_helper {T} (p : parser T) acc steps xs := 163 | match steps, p xs with 164 | | 0, _ => NoneE "Too many recursive calls" 165 | | _, NoneE _ => SomeE ((rev acc), xs) 166 | | S steps', SomeE (t, xs') => many_helper p (t::acc) steps' xs' 167 | end. 168 | 169 | (* A (step-indexed) parser which expects zero or more [p]s *) 170 | Fixpoint many {T} (p : parser T) (steps : nat) : parser (list T) := 171 | many_helper p [] steps. 172 | 173 | (* A parser which expects a given token, followed by p *) 174 | Definition firstExpect {T} (t : token) (p : parser T) : parser T := 175 | fun xs => match xs with 176 | | x::xs' => if string_dec x t 177 | then p xs' 178 | else NoneE ("expected '" ++ t ++ "'.") 179 | | [] => NoneE ("expected '" ++ t ++ "'.") 180 | end. 181 | 182 | (* A parser which expects a particular token *) 183 | Definition expect (t : token) : parser unit := 184 | firstExpect t (fun xs => SomeE(tt, xs)). 185 | 186 | (* ####################################################### *) 187 | (** *** A Recursive-Descent Parser for Imp *) 188 | 189 | (* Identifiers *) 190 | Definition parseIdentifier (symtable :string->nat) (xs : list token) 191 | : optionE (id * list token) := 192 | match xs with 193 | | [] => NoneE "Expected identifier" 194 | | x::xs' => 195 | if forallb isLowerAlpha (list_of_string x) then 196 | SomeE (Id (symtable x), xs') 197 | else 198 | NoneE ("Illegal identifier:'" ++ x ++ "'") 199 | end. 200 | 201 | (* Numbers *) 202 | Definition parseNumber (xs : list token) : optionE (nat * list token) := 203 | match xs with 204 | | [] => NoneE "Expected number" 205 | | x::xs' => 206 | if forallb isDigit (list_of_string x) then 207 | SomeE (fold_left (fun n d => 208 | 10 * n + (nat_of_ascii d - nat_of_ascii "0"%char)) 209 | (list_of_string x) 210 | 0, 211 | xs') 212 | else 213 | NoneE "Expected number" 214 | end. 215 | 216 | (* Parse arithmetic expressions *) 217 | Fixpoint parsePrimaryExp (steps:nat) symtable (xs : list token) 218 | : optionE (aexp * list token) := 219 | match steps with 220 | | 0 => NoneE "Too many recursive calls" 221 | | S steps' => 222 | DO (i, rest) <-- parseIdentifier symtable xs ; 223 | SomeE (AId i, rest) 224 | OR DO (n, rest) <-- parseNumber xs ; 225 | SomeE (ANum n, rest) 226 | OR (DO (e, rest) <== firstExpect "(" (parseSumExp steps' symtable) xs; 227 | DO (u, rest') <== expect ")" rest ; 228 | SomeE(e,rest')) 229 | end 230 | with parseProductExp (steps:nat) symtable (xs : list token) := 231 | match steps with 232 | | 0 => NoneE "Too many recursive calls" 233 | | S steps' => 234 | DO (e, rest) <== 235 | parsePrimaryExp steps' symtable xs ; 236 | DO (es, rest') <== 237 | many (firstExpect "*" (parsePrimaryExp steps' symtable)) steps' rest; 238 | SomeE (fold_left AMult es e, rest') 239 | end 240 | with parseSumExp (steps:nat) symtable (xs : list token) := 241 | match steps with 242 | | 0 => NoneE "Too many recursive calls" 243 | | S steps' => 244 | DO (e, rest) <== 245 | parseProductExp steps' symtable xs ; 246 | DO (es, rest') <== 247 | many (fun xs => 248 | DO (e,rest') <-- 249 | firstExpect "+" (parseProductExp steps' symtable) xs; 250 | SomeE ( (true, e), rest') 251 | OR DO (e,rest') <== 252 | firstExpect "-" (parseProductExp steps' symtable) xs; 253 | SomeE ( (false, e), rest')) 254 | steps' rest; 255 | SomeE (fold_left (fun e0 term => 256 | match term with 257 | (true, e) => APlus e0 e 258 | | (false, e) => AMinus e0 e 259 | end) 260 | es e, 261 | rest') 262 | end. 263 | 264 | Definition parseAExp := parseSumExp. 265 | 266 | (* Parsing boolean expressions. *) 267 | Fixpoint parseAtomicExp (steps:nat) (symtable : string->nat) (xs : list token) := 268 | match steps with 269 | | 0 => NoneE "Too many recursive calls" 270 | | S steps' => 271 | DO (u,rest) <-- expect "true" xs; 272 | SomeE (BTrue,rest) 273 | OR DO (u,rest) <-- expect "false" xs; 274 | SomeE (BFalse,rest) 275 | OR DO (e,rest) <-- firstExpect "not" (parseAtomicExp steps' symtable) xs; 276 | SomeE (BNot e, rest) 277 | OR DO (e,rest) <-- firstExpect "(" (parseConjunctionExp steps' symtable) xs; 278 | (DO (u,rest') <== expect ")" rest; SomeE (e, rest')) 279 | OR DO (e, rest) <== parseProductExp steps' symtable xs ; 280 | (DO (e', rest') <-- 281 | firstExpect "==" (parseAExp steps' symtable) rest ; 282 | SomeE (BEq e e', rest') 283 | OR DO (e', rest') <-- 284 | firstExpect "<=" (parseAExp steps' symtable) rest ; 285 | SomeE (BLe e e', rest') 286 | OR 287 | NoneE "Expected '==' or '<=' after arithmetic expression") 288 | end 289 | with parseConjunctionExp (steps:nat) (symtable : string->nat) (xs : list token) := 290 | match steps with 291 | | 0 => NoneE "Too many recursive calls" 292 | | S steps' => 293 | DO (e, rest) <== 294 | parseAtomicExp steps' symtable xs ; 295 | DO (es, rest') <== 296 | many (firstExpect "&&" (parseAtomicExp steps' symtable)) steps' rest; 297 | SomeE (fold_left BAnd es e, rest') 298 | end. 299 | 300 | Definition parseBExp := parseConjunctionExp. 301 | 302 | (* 303 | Eval compute in 304 | (parseProductExp 100 (tokenize "x*y*(x*x)*x")). 305 | 306 | Eval compute in 307 | (parseDisjunctionExp 100 (tokenize "not((x==x||x*x<=(x*x)*x)&&x==x)")). 308 | *) 309 | 310 | (* Parsing commands *) 311 | Fixpoint parseSimpleCommand (steps:nat) (symtable:string->nat) (xs : list token) := 312 | match steps with 313 | | 0 => NoneE "Too many recursive calls" 314 | | S steps' => 315 | DO (u, rest) <-- expect "SKIP" xs; 316 | SomeE (SKIP, rest) 317 | OR DO (e,rest) <-- 318 | firstExpect "IF" (parseBExp steps' symtable) xs; 319 | DO (c,rest') <== 320 | firstExpect "THEN" (parseSequencedCommand steps' symtable) rest; 321 | DO (c',rest'') <== 322 | firstExpect "ELSE" (parseSequencedCommand steps' symtable) rest'; 323 | DO (u,rest''') <== 324 | expect "END" rest''; 325 | SomeE(IFB e THEN c ELSE c' FI, rest''') 326 | OR DO (e,rest) <-- 327 | firstExpect "WHILE" (parseBExp steps' symtable) xs; 328 | DO (c,rest') <== 329 | firstExpect "DO" (parseSequencedCommand steps' symtable) rest; 330 | DO (u,rest'') <== 331 | expect "END" rest'; 332 | SomeE(WHILE e DO c END, rest'') 333 | OR DO (i, rest) <== 334 | parseIdentifier symtable xs; 335 | DO (e, rest') <== 336 | firstExpect ":=" (parseAExp steps' symtable) rest; 337 | SomeE(i ::= e, rest') 338 | end 339 | 340 | with parseSequencedCommand (steps:nat) (symtable:string->nat) (xs : list token) := 341 | match steps with 342 | | 0 => NoneE "Too many recursive calls" 343 | | S steps' => 344 | DO (c, rest) <== 345 | parseSimpleCommand steps' symtable xs; 346 | DO (c', rest') <-- 347 | firstExpect ";;" (parseSequencedCommand steps' symtable) rest; 348 | SomeE(c ;; c', rest') 349 | OR 350 | SomeE(c, rest) 351 | end. 352 | 353 | Definition bignumber := 1000. 354 | 355 | Definition parse (str : string) : optionE (com * list token) := 356 | let tokens := tokenize str in 357 | parseSequencedCommand bignumber (build_symtable tokens 0) tokens. 358 | 359 | (* ####################################################### *) 360 | (** * Examples *) 361 | 362 | 363 | 364 | Eval compute in parse " 365 | IF x == y + 1 + 2 - y * 6 + 3 THEN 366 | x := x * 1;; 367 | y := 0 368 | ELSE 369 | SKIP 370 | END ". 371 | (* ====> *) 372 | (* SomeE *) 373 | (* (IFB BEq (AId (Id 0)) *) 374 | (* (APlus *) 375 | (* (AMinus (APlus (APlus (AId (Id 1)) (ANum 1)) (ANum 2)) *) 376 | (* (AMult (AId (Id 1)) (ANum 6))) *) 377 | (* (ANum 3)) *) 378 | (* THEN Id 0 ::= AMult (AId (Id 0)) (ANum 1);; Id 1 ::= ANum 0 *) 379 | (* ELSE SKIP FI, []) *) 380 | 381 | 382 | Eval compute in parse " 383 | SKIP;; 384 | z:=x*y*(x*x);; 385 | WHILE x==x DO 386 | IF z <= z*z && not x == 2 THEN 387 | x := z;; 388 | y := z 389 | ELSE 390 | SKIP 391 | END;; 392 | SKIP 393 | END;; 394 | x:=z ". 395 | (* ====> *) 396 | (* SomeE *) 397 | (* (SKIP;; *) 398 | (* Id 0 ::= AMult (AMult (AId (Id 1)) (AId (Id 2))) *) 399 | (* (AMult (AId (Id 1)) (AId (Id 1)));; *) 400 | (* WHILE BEq (AId (Id 1)) (AId (Id 1)) DO *) 401 | (* IFB BAnd (BLe (AId (Id 0)) (AMult (AId (Id 0)) (AId (Id 0)))) *) 402 | (* (BNot (BEq (AId (Id 1)) (ANum 2))) *) 403 | (* THEN Id 1 ::= AId (Id 0);; Id 2 ::= AId (Id 0) *) 404 | (* ELSE SKIP FI;; *) 405 | (* SKIP *) 406 | (* END;; *) 407 | (* Id 1 ::= AId (Id 0), *) 408 | (* []) *) 409 | 410 | 411 | Eval compute in parse " 412 | SKIP;; 413 | z:=x*y*(x*x);; 414 | WHILE x==x DO 415 | IF z <= z*z && not x == 2 THEN 416 | x := z;; 417 | y := z 418 | ELSE 419 | SKIP 420 | END;; 421 | SKIP 422 | END;; 423 | x:=z ". 424 | (* =====> *) 425 | (* SomeE *) 426 | (* (SKIP;; *) 427 | (* Id 0 ::= AMult (AMult (AId (Id 1)) (AId (Id 2))) *) 428 | (* (AMult (AId (Id 1)) (AId (Id 1)));; *) 429 | (* WHILE BEq (AId (Id 1)) (AId (Id 1)) DO *) 430 | (* IFB BAnd (BLe (AId (Id 0)) (AMult (AId (Id 0)) (AId (Id 0)))) *) 431 | (* (BNot (BEq (AId (Id 1)) (ANum 2))) *) 432 | (* THEN Id 1 ::= AId (Id 0);; *) 433 | (* Id 2 ::= AId (Id 0) *) 434 | (* ELSE SKIP *) 435 | (* FI;; *) 436 | (* SKIP *) 437 | (* END;; *) 438 | (* Id 1 ::= AId (Id 0), *) 439 | (* []). *) 440 | 441 | (** $Date: 2014-12-31 11:17:56 -0500 (Wed, 31 Dec 2014) $ *) 442 | -------------------------------------------------------------------------------- /Logic.v: -------------------------------------------------------------------------------- 1 | (** * Logic: Logic in Coq *) 2 | 3 | Require Export MoreCoq. 4 | 5 | 6 | 7 | (** Coq's built-in logic is very small: the only primitives are 8 | [Inductive] definitions, universal quantification ([forall]), and 9 | implication ([->]), while all the other familiar logical 10 | connectives -- conjunction, disjunction, negation, existential 11 | quantification, even equality -- can be encoded using just these. 12 | 13 | This chapter explains the encodings and shows how the tactics 14 | we've seen can be used to carry out standard forms of logical 15 | reasoning involving these connectives. 16 | 17 | *) 18 | 19 | (* ########################################################### *) 20 | (** * Propositions *) 21 | 22 | (** In previous chapters, we have seen many examples of factual 23 | claims (_propositions_) and ways of presenting evidence of their 24 | truth (_proofs_). In particular, we have worked extensively with 25 | _equality propositions_ of the form [e1 = e2], with 26 | implications ([P -> Q]), and with quantified propositions 27 | ([forall x, P]). 28 | *) 29 | 30 | 31 | (** In Coq, the type of things that can (potentially) 32 | be proven is [Prop]. *) 33 | 34 | (** Here is an example of a provable proposition: *) 35 | 36 | Check (3 = 3). 37 | (* ===> Prop *) 38 | 39 | (** Here is an example of an unprovable proposition: *) 40 | 41 | Check (forall (n:nat), n = 2). 42 | (* ===> Prop *) 43 | 44 | (** Recall that [Check] asks Coq to tell us the type of the indicated 45 | expression. *) 46 | 47 | (* ########################################################### *) 48 | (** * Proofs and Evidence *) 49 | 50 | (** In Coq, propositions have the same status as other types, such as 51 | [nat]. Just as the natural numbers [0], [1], [2], etc. inhabit 52 | the type [nat], a Coq proposition [P] is inhabited by its 53 | _proofs_. We will refer to such inhabitants as _proof term_ or 54 | _proof object_ or _evidence_ for the truth of [P]. 55 | 56 | In Coq, when we state and then prove a lemma such as: 57 | 58 | Lemma silly : 0 * 3 = 0. 59 | Proof. reflexivity. Qed. 60 | 61 | the tactics we use within the [Proof]...[Qed] keywords tell Coq 62 | how to construct a proof term that inhabits the proposition. In 63 | this case, the proposition [0 * 3 = 0] is justified by a 64 | combination of the _definition_ of [mult], which says that [0 * 3] 65 | _simplifies_ to just [0], and the _reflexive_ principle of 66 | equality, which says that [0 = 0]. 67 | 68 | 69 | *) 70 | 71 | (** *** *) 72 | 73 | Lemma silly : 0 * 3 = 0. 74 | Proof. reflexivity. Qed. 75 | 76 | (** We can see which proof term Coq constructs for a given Lemma by 77 | using the [Print] directive: *) 78 | 79 | Print silly. 80 | (* ===> silly = eq_refl : 0 * 3 = 0 *) 81 | 82 | (** Here, the [eq_refl] proof term witnesses the equality. (More on 83 | equality later!)*) 84 | 85 | (** ** Implications _are_ functions *) 86 | 87 | (** Just as we can implement natural number multiplication as a 88 | function: 89 | 90 | [ 91 | mult : nat -> nat -> nat 92 | ] 93 | 94 | The _proof term_ for an implication [P -> Q] is a _function_ that 95 | takes evidence for [P] as input and produces evidence for [Q] as its 96 | output. 97 | *) 98 | 99 | Lemma silly_implication : (1 + 1) = 2 -> 0 * 3 = 0. 100 | Proof. intros H. reflexivity. Qed. 101 | 102 | (** We can see that the proof term for the above lemma is indeed a 103 | function: *) 104 | 105 | Print silly_implication. 106 | (* ===> silly_implication = fun _ : 1 + 1 = 2 => eq_refl 107 | : 1 + 1 = 2 -> 0 * 3 = 0 *) 108 | 109 | (** ** Defining propositions *) 110 | 111 | (** Just as we can create user-defined inductive types (like the 112 | lists, binary representations of natural numbers, etc., that we 113 | seen before), we can also create _user-defined_ propositions. 114 | 115 | Question: How do you define the meaning of a proposition? 116 | *) 117 | 118 | (** *** *) 119 | 120 | (** The meaning of a proposition is given by _rules_ and _definitions_ 121 | that say how to construct _evidence_ for the truth of the 122 | proposition from other evidence. 123 | 124 | - Typically, rules are defined _inductively_, just like any other 125 | datatype. 126 | 127 | - Sometimes a proposition is declared to be true without 128 | substantiating evidence. Such propositions are called _axioms_. 129 | 130 | In this, and subsequence chapters, we'll see more about how these 131 | proof terms work in more detail. 132 | *) 133 | 134 | (* ########################################################### *) 135 | (** * Conjunction (Logical "and") *) 136 | 137 | (** The logical conjunction of propositions [P] and [Q] can be 138 | represented using an [Inductive] definition with one 139 | constructor. *) 140 | 141 | Inductive and (P Q : Prop) : Prop := 142 | conj : P -> Q -> (and P Q). 143 | 144 | (** The intuition behind this definition is simple: to 145 | construct evidence for [and P Q], we must provide evidence 146 | for [P] and evidence for [Q]. More precisely: 147 | 148 | - [conj p q] can be taken as evidence for [and P Q] if [p] 149 | is evidence for [P] and [q] is evidence for [Q]; and 150 | 151 | - this is the _only_ way to give evidence for [and P Q] -- 152 | that is, if someone gives us evidence for [and P Q], we 153 | know it must have the form [conj p q], where [p] is 154 | evidence for [P] and [q] is evidence for [Q]. 155 | 156 | Since we'll be using conjunction a lot, let's introduce a more 157 | familiar-looking infix notation for it. *) 158 | 159 | Notation "P /\ Q" := (and P Q) : type_scope. 160 | 161 | (** (The [type_scope] annotation tells Coq that this notation 162 | will be appearing in propositions, not values.) *) 163 | 164 | (** Consider the "type" of the constructor [conj]: *) 165 | 166 | Check conj. 167 | (* ===> forall P Q : Prop, P -> Q -> P /\ Q *) 168 | 169 | (** Notice that it takes 4 inputs -- namely the propositions [P] 170 | and [Q] and evidence for [P] and [Q] -- and returns as output the 171 | evidence of [P /\ Q]. *) 172 | 173 | (** ** "Introducing" conjunctions *) 174 | (** Besides the elegance of building everything up from a tiny 175 | foundation, what's nice about defining conjunction this way is 176 | that we can prove statements involving conjunction using the 177 | tactics that we already know. For example, if the goal statement 178 | is a conjuction, we can prove it by applying the single 179 | constructor [conj], which (as can be seen from the type of [conj]) 180 | solves the current goal and leaves the two parts of the 181 | conjunction as subgoals to be proved separately. *) 182 | 183 | Theorem and_example : 184 | (0 = 0) /\ (4 = mult 2 2). 185 | Proof. 186 | apply conj. 187 | Case "left". reflexivity. 188 | Case "right". reflexivity. Qed. 189 | 190 | (** Just for convenience, we can use the tactic [split] as a shorthand for 191 | [apply conj]. *) 192 | 193 | Theorem and_example' : 194 | (0 = 0) /\ (4 = mult 2 2). 195 | Proof. 196 | split. 197 | Case "left". reflexivity. 198 | Case "right". reflexivity. Qed. 199 | 200 | (** ** "Eliminating" conjunctions *) 201 | (** Conversely, the [destruct] tactic can be used to take a 202 | conjunction hypothesis in the context, calculate what evidence 203 | must have been used to build it, and add variables representing 204 | this evidence to the proof context. *) 205 | 206 | Theorem proj1 : forall P Q : Prop, 207 | P /\ Q -> P. 208 | Proof. 209 | intros P Q H. 210 | destruct H as [HP HQ]. 211 | apply HP. Qed. 212 | 213 | (** **** Exercise: 1 star, optional (proj2) *) 214 | Theorem proj2 : forall P Q : Prop, 215 | P /\ Q -> Q. 216 | Proof. 217 | intros P Q H. 218 | destruct H. 219 | apply H0. 220 | Qed. 221 | (** [] *) 222 | 223 | Theorem and_commut : forall P Q : Prop, 224 | P /\ Q -> Q /\ P. 225 | Proof. 226 | (* WORKED IN CLASS *) 227 | intros P Q H. 228 | destruct H as [HP HQ]. 229 | split. 230 | Case "left". apply HQ. 231 | Case "right". apply HP. Qed. 232 | 233 | 234 | (** **** Exercise: 2 stars (and_assoc) *) 235 | (** In the following proof, notice how the _nested pattern_ in the 236 | [destruct] breaks the hypothesis [H : P /\ (Q /\ R)] down into 237 | [HP: P], [HQ : Q], and [HR : R]. Finish the proof from there: *) 238 | 239 | Theorem and_assoc : forall P Q R : Prop, 240 | P /\ (Q /\ R) -> (P /\ Q) /\ R. 241 | Proof. 242 | intros P Q R H. 243 | destruct H as [HP [HQ HR]]. 244 | split. split. apply HP. 245 | apply HQ. apply HR. 246 | Qed. 247 | (** [] *) 248 | 249 | 250 | 251 | (* ###################################################### *) 252 | (** * Iff *) 253 | 254 | (** The handy "if and only if" connective is just the conjunction of 255 | two implications. *) 256 | 257 | Definition iff (P Q : Prop) := (P -> Q) /\ (Q -> P). 258 | 259 | Notation "P <-> Q" := (iff P Q) 260 | (at level 95, no associativity) 261 | : type_scope. 262 | 263 | Theorem iff_implies : forall P Q : Prop, 264 | (P <-> Q) -> P -> Q. 265 | Proof. 266 | intros P Q H. 267 | destruct H as [HAB HBA]. apply HAB. Qed. 268 | 269 | Theorem iff_sym : forall P Q : Prop, 270 | (P <-> Q) -> (Q <-> P). 271 | Proof. 272 | (* WORKED IN CLASS *) 273 | intros P Q H. 274 | destruct H as [HAB HBA]. 275 | split. 276 | Case "->". apply HBA. 277 | Case "<-". apply HAB. Qed. 278 | 279 | (** **** Exercise: 1 star, optional (iff_properties) *) 280 | (** Using the above proof that [<->] is symmetric ([iff_sym]) as 281 | a guide, prove that it is also reflexive and transitive. *) 282 | 283 | Theorem iff_refl : forall P : Prop, 284 | P <-> P. 285 | Proof. 286 | intros P. 287 | split. intros H. apply H. 288 | intros H. apply H. 289 | Qed. 290 | 291 | Theorem iff_trans : forall P Q R : Prop, 292 | (P <-> Q) -> (Q <-> R) -> (P <-> R). 293 | Proof. 294 | intros P Q R H1 H2. 295 | destruct H1. destruct H2. 296 | split. intros Hp. apply H in Hp. apply H1 in Hp. 297 | apply Hp. 298 | intros Hr. apply H2 in Hr. apply H0 in Hr. apply Hr. 299 | Qed. 300 | 301 | 302 | (** Hint: If you have an iff hypothesis in the context, you can use 303 | [inversion] to break it into two separate implications. (Think 304 | about why this works.) *) 305 | (** [] *) 306 | 307 | 308 | 309 | (** Some of Coq's tactics treat [iff] statements specially, thus 310 | avoiding the need for some low-level manipulation when reasoning 311 | with them. In particular, [rewrite] can be used with [iff] 312 | statements, not just equalities. *) 313 | 314 | (* ############################################################ *) 315 | (** * Disjunction (Logical "or") *) 316 | 317 | (** ** Implementing disjunction *) 318 | 319 | (** Disjunction ("logical or") can also be defined as an 320 | inductive proposition. *) 321 | 322 | Inductive or (P Q : Prop) : Prop := 323 | | or_introl : P -> or P Q 324 | | or_intror : Q -> or P Q. 325 | 326 | Notation "P \/ Q" := (or P Q) : type_scope. 327 | 328 | (** Consider the "type" of the constructor [or_introl]: *) 329 | 330 | Check or_introl. 331 | (* ===> forall P Q : Prop, P -> P \/ Q *) 332 | 333 | (** It takes 3 inputs, namely the propositions [P], [Q] and 334 | evidence of [P], and returns, as output, the evidence of [P \/ Q]. 335 | Next, look at the type of [or_intror]: *) 336 | 337 | Check or_intror. 338 | (* ===> forall P Q : Prop, Q -> P \/ Q *) 339 | 340 | (** It is like [or_introl] but it requires evidence of [Q] 341 | instead of evidence of [P]. *) 342 | 343 | (** Intuitively, there are two ways of giving evidence for [P \/ Q]: 344 | 345 | - give evidence for [P] (and say that it is [P] you are giving 346 | evidence for -- this is the function of the [or_introl] 347 | constructor), or 348 | 349 | - give evidence for [Q], tagged with the [or_intror] 350 | constructor. *) 351 | 352 | (** *** *) 353 | (** Since [P \/ Q] has two constructors, doing [destruct] on a 354 | hypothesis of type [P \/ Q] yields two subgoals. *) 355 | 356 | Theorem or_commut : forall P Q : Prop, 357 | P \/ Q -> Q \/ P. 358 | Proof. 359 | intros P Q H. 360 | destruct H as [HP | HQ]. 361 | Case "left". apply or_intror. apply HP. 362 | Case "right". apply or_introl. apply HQ. Qed. 363 | 364 | (** From here on, we'll use the shorthand tactics [left] and [right] 365 | in place of [apply or_introl] and [apply or_intror]. *) 366 | 367 | Theorem or_commut' : forall P Q : Prop, 368 | P \/ Q -> Q \/ P. 369 | Proof. 370 | intros P Q H. 371 | destruct H as [HP | HQ]. 372 | Case "left". right. apply HP. 373 | Case "right". left. apply HQ. Qed. 374 | 375 | 376 | 377 | 378 | 379 | Theorem or_distributes_over_and_1 : forall P Q R : Prop, 380 | P \/ (Q /\ R) -> (P \/ Q) /\ (P \/ R). 381 | Proof. 382 | intros P Q R. intros H. destruct H as [HP | [HQ HR]]. 383 | Case "left". split. 384 | SCase "left". left. apply HP. 385 | SCase "right". left. apply HP. 386 | Case "right". split. 387 | SCase "left". right. apply HQ. 388 | SCase "right". right. apply HR. Qed. 389 | 390 | (** **** Exercise: 2 stars (or_distributes_over_and_2) *) 391 | Theorem or_distributes_over_and_2 : forall P Q R : Prop, 392 | (P \/ Q) /\ (P \/ R) -> P \/ (Q /\ R). 393 | Proof. 394 | intros P Q R H. 395 | destruct H. destruct H. left. apply H. 396 | destruct H0. left. apply H0. right. split. apply H. 397 | apply H0. 398 | Qed. 399 | (** [] *) 400 | 401 | (** **** Exercise: 1 star, optional (or_distributes_over_and) *) 402 | Theorem or_distributes_over_and : forall P Q R : Prop, 403 | P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R). 404 | Proof. 405 | intros P Q R. 406 | split. apply or_distributes_over_and_1. 407 | apply or_distributes_over_and_2. 408 | Qed. 409 | (** [] *) 410 | 411 | (* ################################################### *) 412 | (** ** Relating [/\] and [\/] with [andb] and [orb] *) 413 | 414 | (** We've already seen several places where analogous structures 415 | can be found in Coq's computational ([Type]) and logical ([Prop]) 416 | worlds. Here is one more: the boolean operators [andb] and [orb] 417 | are clearly analogs of the logical connectives [/\] and [\/]. 418 | This analogy can be made more precise by the following theorems, 419 | which show how to translate knowledge about [andb] and [orb]'s 420 | behaviors on certain inputs into propositional facts about those 421 | inputs. *) 422 | 423 | Theorem andb_prop : forall b c, 424 | andb b c = true -> b = true /\ c = true. 425 | Proof. 426 | (* WORKED IN CLASS *) 427 | intros b c H. 428 | destruct b. 429 | Case "b = true". destruct c. 430 | SCase "c = true". apply conj. reflexivity. reflexivity. 431 | SCase "c = false". inversion H. 432 | Case "b = false". inversion H. Qed. 433 | 434 | Theorem andb_true_intro : forall b c, 435 | b = true /\ c = true -> andb b c = true. 436 | Proof. 437 | (* WORKED IN CLASS *) 438 | intros b c H. 439 | destruct H. 440 | rewrite H. rewrite H0. reflexivity. Qed. 441 | 442 | (** **** Exercise: 2 stars, optional (andb_false) *) 443 | Theorem andb_false : forall b c, 444 | andb b c = false -> b = false \/ c = false. 445 | Proof. 446 | intros b c H. 447 | destruct b. destruct c. inversion H. 448 | right. reflexivity. left. reflexivity. 449 | Qed. 450 | 451 | (** **** Exercise: 2 stars, optional (orb_false) *) 452 | Theorem orb_prop : forall b c, 453 | orb b c = true -> b = true \/ c = true. 454 | Proof. 455 | intros b c H. 456 | destruct b. 457 | left. reflexivity. 458 | destruct c. right. reflexivity. 459 | inversion H. 460 | Qed. 461 | 462 | (** **** Exercise: 2 stars, optional (orb_false_elim) *) 463 | Theorem orb_false_elim : forall b c, 464 | orb b c = false -> b = false /\ c = false. 465 | Proof. 466 | intros b c H. 467 | destruct b. inversion H. 468 | destruct c. inversion H. 469 | split. reflexivity. reflexivity. 470 | Qed. 471 | (** [] *) 472 | 473 | 474 | 475 | (* ################################################### *) 476 | (** * Falsehood *) 477 | 478 | (** Logical falsehood can be represented in Coq as an inductively 479 | defined proposition with no constructors. *) 480 | 481 | Inductive False : Prop := . 482 | 483 | (** Intuition: [False] is a proposition for which there is no way 484 | to give evidence. *) 485 | 486 | 487 | (** Since [False] has no constructors, inverting an assumption 488 | of type [False] always yields zero subgoals, allowing us to 489 | immediately prove any goal. *) 490 | 491 | Theorem False_implies_nonsense : 492 | False -> 2 + 2 = 5. 493 | Proof. 494 | intros contra. 495 | inversion contra. Qed. 496 | 497 | (** How does this work? The [inversion] tactic breaks [contra] into 498 | each of its possible cases, and yields a subgoal for each case. 499 | As [contra] is evidence for [False], it has _no_ possible cases, 500 | hence, there are no possible subgoals and the proof is done. *) 501 | 502 | (** *** *) 503 | (** Conversely, the only way to prove [False] is if there is already 504 | something nonsensical or contradictory in the context: *) 505 | 506 | Theorem nonsense_implies_False : 507 | 2 + 2 = 5 -> False. 508 | Proof. 509 | intros contra. 510 | inversion contra. Qed. 511 | 512 | (** Actually, since the proof of [False_implies_nonsense] 513 | doesn't actually have anything to do with the specific nonsensical 514 | thing being proved; it can easily be generalized to work for an 515 | arbitrary [P]: *) 516 | 517 | Theorem ex_falso_quodlibet : forall (P:Prop), 518 | False -> P. 519 | Proof. 520 | (* WORKED IN CLASS *) 521 | intros P contra. 522 | inversion contra. Qed. 523 | 524 | (** The Latin _ex falso quodlibet_ means, literally, "from 525 | falsehood follows whatever you please." This theorem is also 526 | known as the _principle of explosion_. *) 527 | 528 | 529 | (* #################################################### *) 530 | (** ** Truth *) 531 | 532 | (** Since we have defined falsehood in Coq, one might wonder whether 533 | it is possible to define truth in the same way. We can. *) 534 | 535 | (** **** Exercise: 2 stars, advanced (True) *) 536 | (** Define [True] as another inductively defined proposition. (The 537 | intution is that [True] should be a proposition for which it is 538 | trivial to give evidence.) *) 539 | 540 | Inductive True : Prop := I : True. 541 | 542 | (** [] *) 543 | 544 | (** However, unlike [False], which we'll use extensively, [True] is 545 | used fairly rarely. By itself, it is trivial (and therefore 546 | uninteresting) to prove as a goal, and it carries no useful 547 | information as a hypothesis. But it can be useful when defining 548 | complex [Prop]s using conditionals, or as a parameter to 549 | higher-order [Prop]s. *) 550 | 551 | (* #################################################### *) 552 | (** * Negation *) 553 | 554 | (** The logical complement of a proposition [P] is written [not 555 | P] or, for shorthand, [~P]: *) 556 | 557 | Definition not (P:Prop) := P -> False. 558 | 559 | (** The intuition is that, if [P] is not true, then anything at 560 | all (even [False]) follows from assuming [P]. *) 561 | 562 | Notation "~ x" := (not x) : type_scope. 563 | 564 | Check not. 565 | (* ===> Prop -> Prop *) 566 | 567 | (** It takes a little practice to get used to working with 568 | negation in Coq. Even though you can see perfectly well why 569 | something is true, it can be a little hard at first to get things 570 | into the right configuration so that Coq can see it! Here are 571 | proofs of a few familiar facts about negation to get you warmed 572 | up. *) 573 | 574 | Theorem not_False : 575 | ~ False. 576 | Proof. 577 | unfold not. intros H. inversion H. Qed. 578 | 579 | (** *** *) 580 | Theorem contradiction_implies_anything : forall P Q : Prop, 581 | (P /\ ~P) -> Q. 582 | Proof. 583 | (* WORKED IN CLASS *) 584 | intros P Q H. destruct H as [HP HNA]. unfold not in HNA. 585 | apply HNA in HP. inversion HP. Qed. 586 | 587 | Theorem double_neg : forall P : Prop, 588 | P -> ~~P. 589 | Proof. 590 | (* WORKED IN CLASS *) 591 | intros P H. unfold not. intros G. apply G. apply H. Qed. 592 | 593 | (** **** Exercise: 2 stars, advanced (double_neg_inf) *) 594 | (** Write an informal proof of [double_neg]: 595 | 596 | _Theorem_: [P] implies [~~P], for any proposition [P]. 597 | 598 | _Proof_: 599 | ... 600 | [] 601 | *) 602 | 603 | (** **** Exercise: 2 stars (contrapositive) *) 604 | Theorem contrapositive : forall P Q : Prop, 605 | (P -> Q) -> (~Q -> ~P). 606 | Proof. 607 | intros P Q H. 608 | unfold not. 609 | intros H1 H2. 610 | apply H in H2. apply H1 in H2. 611 | apply H2. 612 | Qed. 613 | (** [] *) 614 | 615 | (** **** Exercise: 1 star (not_both_true_and_false) *) 616 | Theorem not_both_true_and_false : forall P : Prop, 617 | ~ (P /\ ~P). 618 | Proof. 619 | intros P. 620 | unfold not. 621 | intros H. 622 | destruct H. apply H0 in H. apply H. 623 | Qed. 624 | (** [] *) 625 | 626 | (** **** Exercise: 1 star, advanced (informal_not_PNP) *) 627 | (** Write an informal proof (in English) of the proposition [forall P 628 | : Prop, ~(P /\ ~P)]. *) 629 | 630 | (* ... *) 631 | (** [] *) 632 | 633 | (** *** Constructive logic *) 634 | (** Note that some theorems that are true in classical logic are _not_ 635 | provable in Coq's (constructive) logic. E.g., let's look at how 636 | this proof gets stuck... *) 637 | 638 | Theorem classic_double_neg : forall P : Prop, 639 | ~ ~ P -> P. 640 | Proof. 641 | (* WORKED IN CLASS *) 642 | intros P H. unfold not in H. 643 | (* But now what? There is no way to "invent" evidence for [~P] 644 | from evidence for [P]. *) 645 | Abort. 646 | 647 | (** **** Exercise: 5 stars, advanced, optional (classical_axioms) *) 648 | (** For those who like a challenge, here is an exercise 649 | taken from the Coq'Art book (p. 123). The following five 650 | statements are often considered as characterizations of 651 | classical logic (as opposed to constructive logic, which is 652 | what is "built in" to Coq). We can't prove them in Coq, but 653 | we can consistently add any one of them as an unproven axiom 654 | if we wish to work in classical logic. Prove that these five 655 | propositions are equivalent. *) 656 | 657 | Definition peirce := forall P Q: Prop, 658 | ((P->Q)->P)->P. 659 | Definition classic := forall P:Prop, 660 | ~~P -> P. 661 | Definition excluded_middle := forall P:Prop, 662 | P \/ ~P. 663 | Definition de_morgan_not_and_not := forall P Q:Prop, 664 | ~(~P /\ ~Q) -> P\/Q. 665 | Definition implies_to_or := forall P Q:Prop, 666 | (P->Q) -> (~P\/Q). 667 | 668 | Theorem equivalent_comm : forall P Q R: Prop, 669 | (P <-> Q) -> (Q <-> R) -> (P <-> R). 670 | Proof. 671 | intros. 672 | split. destruct H. destruct H0. 673 | intros. apply H in H3. apply H0 in H3. apply H3. 674 | intros. destruct H. destruct H0. 675 | apply H3 in H1. apply H2 in H1. apply H1. 676 | Qed. 677 | 678 | 679 | Theorem peirce_classic : peirce <-> classic. 680 | Proof. 681 | split. 682 | unfold peirce. unfold classic. 683 | intros. unfold not in H0. 684 | apply H with (Q:=False). 685 | intros. apply H0 in H1. inversion H1. 686 | unfold classic. unfold peirce. 687 | intros. apply H. unfold not. intros. 688 | apply H1. apply H0. 689 | intros. apply H1 in H2. inversion H2. 690 | Qed. 691 | 692 | Theorem classic_excluded_middle : classic <-> excluded_middle. 693 | Proof. 694 | split. 695 | unfold classic. unfold excluded_middle. 696 | intros. apply H. unfold not. intros. 697 | apply H0. right. 698 | intros. destruct H0. left. apply H1. 699 | unfold classic. unfold excluded_middle. 700 | intros. unfold not in H0. 701 | destruct (H P). apply H1. 702 | apply H0 in H1. inversion H1. 703 | Qed. 704 | 705 | Theorem excluded_middle_de_morgan : excluded_middle <-> de_morgan_not_and_not. 706 | Proof. 707 | split. 708 | unfold excluded_middle. unfold de_morgan_not_and_not. 709 | intros. 710 | unfold not in H0. 711 | destruct (H P). left. apply H1. 712 | destruct (H Q). right. apply H2. 713 | destruct H0. split. apply H1. apply H2. 714 | unfold excluded_middle. unfold de_morgan_not_and_not. 715 | intros. apply H. 716 | unfold not. 717 | intros. destruct H0. 718 | apply H1 in H0. apply H0. 719 | Qed. 720 | 721 | Theorem excluded_middle_implies_to_or: excluded_middle <-> implies_to_or. 722 | Proof. 723 | split. 724 | unfold excluded_middle. unfold implies_to_or. 725 | intros. 726 | destruct (H P). 727 | right. apply H0. apply H1. 728 | left. apply H1. 729 | unfold excluded_middle. unfold implies_to_or. 730 | intros. 731 | apply or_commut. apply H. 732 | intros. apply H0. 733 | Qed. 734 | 735 | Theorem de_morgan_implies_to_or : de_morgan_not_and_not <-> implies_to_or. 736 | Proof. 737 | apply equivalent_comm with (Q:=excluded_middle). 738 | apply iff_sym. apply excluded_middle_de_morgan. 739 | apply excluded_middle_implies_to_or. 740 | Qed. 741 | 742 | (* So on and so forth. *) 743 | 744 | (** [] *) 745 | 746 | (** **** Exercise: 3 stars (excluded_middle_irrefutable) *) 747 | (** This theorem implies that it is always safe to add a decidability 748 | axiom (i.e. an instance of excluded middle) for any _particular_ Prop [P]. 749 | Why? Because we cannot prove the negation of such an axiom; if we could, 750 | we would have both [~ (P \/ ~P)] and [~ ~ (P \/ ~P)], a contradiction. *) 751 | 752 | Theorem excluded_middle_irrefutable: forall (P:Prop), ~ ~ (P \/ ~ P). 753 | Proof. 754 | intros P. 755 | unfold not. intros. apply H. 756 | right. intros. apply H. left. assumption. 757 | Qed. 758 | 759 | (* ########################################################## *) 760 | (** ** Inequality *) 761 | 762 | (** Saying [x <> y] is just the same as saying [~(x = y)]. *) 763 | 764 | Notation "x <> y" := (~ (x = y)) : type_scope. 765 | 766 | (** Since inequality involves a negation, it again requires 767 | a little practice to be able to work with it fluently. Here 768 | is one very useful trick. If you are trying to prove a goal 769 | that is nonsensical (e.g., the goal state is [false = true]), 770 | apply the lemma [ex_falso_quodlibet] to change the goal to 771 | [False]. This makes it easier to use assumptions of the form 772 | [~P] that are available in the context -- in particular, 773 | assumptions of the form [x<>y]. *) 774 | 775 | Theorem not_false_then_true : forall b : bool, 776 | b <> false -> b = true. 777 | Proof. 778 | intros b H. destruct b. 779 | Case "b = true". reflexivity. 780 | Case "b = false". 781 | unfold not in H. 782 | apply ex_falso_quodlibet. 783 | apply H. reflexivity. Qed. 784 | 785 | 786 | (** *** *) 787 | 788 | (** *** *) 789 | 790 | (** *** *) 791 | 792 | (** *** *) 793 | 794 | (** *** *) 795 | 796 | (** **** Exercise: 2 stars (false_beq_nat) *) 797 | Theorem false_beq_nat : forall n m : nat, 798 | n <> m -> 799 | beq_nat n m = false. 800 | Proof. 801 | intros. 802 | destruct (beq_nat n m) eqn:eq. 803 | unfold not in H. apply beq_nat_true in eq. 804 | apply H in eq. inversion eq. 805 | reflexivity. 806 | Qed. 807 | (** [] *) 808 | 809 | (** **** Exercise: 2 stars, optional (beq_nat_false) *) 810 | Theorem beq_nat_false : forall n m, 811 | beq_nat n m = false -> n <> m. 812 | Proof. 813 | intros. 814 | unfold not. 815 | intros. 816 | rewrite H0 in H. rewrite <- beq_nat_refl in H. 817 | inversion H. 818 | Qed. 819 | (** [] *) 820 | 821 | 822 | (** $Date: 2014-12-31 11:17:56 -0500 (Wed, 31 Dec 2014) $ *) -------------------------------------------------------------------------------- /MoreLogic.v: -------------------------------------------------------------------------------- 1 | (** * MoreLogic: More on Logic in Coq *) 2 | 3 | Require Export "Prop". 4 | 5 | (* ############################################################ *) 6 | (** * Existential Quantification *) 7 | 8 | (** Another critical logical connective is _existential 9 | quantification_. We can express it with the following 10 | definition: *) 11 | 12 | Inductive ex (X:Type) (P : X->Prop) : Prop := 13 | ex_intro : forall (witness:X), P witness -> ex X P. 14 | 15 | (** That is, [ex] is a family of propositions indexed by a type [X] 16 | and a property [P] over [X]. In order to give evidence for the 17 | assertion "there exists an [x] for which the property [P] holds" 18 | we must actually name a _witness_ -- a specific value [x] -- and 19 | then give evidence for [P x], i.e., evidence that [x] has the 20 | property [P]. 21 | 22 | *) 23 | 24 | 25 | (** *** *) 26 | (** Coq's [Notation] facility can be used to introduce more 27 | familiar notation for writing existentially quantified 28 | propositions, exactly parallel to the built-in syntax for 29 | universally quantified propositions. Instead of writing [ex nat 30 | ev] to express the proposition that there exists some number that 31 | is even, for example, we can write [exists x:nat, ev x]. (It is 32 | not necessary to understand exactly how the [Notation] definition 33 | works.) *) 34 | 35 | Notation "'exists' x , p" := (ex _ (fun x => p)) 36 | (at level 200, x ident, right associativity) : type_scope. 37 | Notation "'exists' x : X , p" := (ex _ (fun x:X => p)) 38 | (at level 200, x ident, right associativity) : type_scope. 39 | 40 | (** *** *) 41 | (** We can use the usual set of tactics for 42 | manipulating existentials. For example, to prove an 43 | existential, we can [apply] the constructor [ex_intro]. Since the 44 | premise of [ex_intro] involves a variable ([witness]) that does 45 | not appear in its conclusion, we need to explicitly give its value 46 | when we use [apply]. *) 47 | 48 | Example exists_example_1 : exists n, n + (n * n) = 6. 49 | Proof. 50 | apply ex_intro with (witness:=2). 51 | reflexivity. Qed. 52 | 53 | (** Note that we have to explicitly give the witness. *) 54 | 55 | (** *** *) 56 | (** Or, instead of writing [apply ex_intro with (witness:=e)] all the 57 | time, we can use the convenient shorthand [exists e], which means 58 | the same thing. *) 59 | 60 | Example exists_example_1' : exists n, n + (n * n) = 6. 61 | Proof. 62 | exists 2. 63 | reflexivity. Qed. 64 | 65 | (** *** *) 66 | (** Conversely, if we have an existential hypothesis in the 67 | context, we can eliminate it with [inversion]. Note the use 68 | of the [as...] pattern to name the variable that Coq 69 | introduces to name the witness value and get evidence that 70 | the hypothesis holds for the witness. (If we don't 71 | explicitly choose one, Coq will just call it [witness], which 72 | makes proofs confusing.) *) 73 | 74 | Theorem exists_example_2 : forall n, 75 | (exists m, n = 4 + m) -> 76 | (exists o, n = 2 + o). 77 | Proof. 78 | intros n H. 79 | inversion H as [m Hm]. 80 | exists (2 + m). 81 | apply Hm. Qed. 82 | 83 | 84 | (** Here is another example of how to work with existentials. *) 85 | Lemma exists_example_3 : 86 | exists (n:nat), even n /\ beautiful n. 87 | Proof. 88 | (* WORKED IN CLASS *) 89 | exists 8. 90 | split. 91 | unfold even. simpl. reflexivity. 92 | apply b_sum with (n:=3) (m:=5). 93 | apply b_3. apply b_5. 94 | Qed. 95 | 96 | (** **** Exercise: 1 star, optional (english_exists) *) 97 | (** In English, what does the proposition 98 | ex nat (fun n => beautiful (S n)) 99 | ]] 100 | mean? *) 101 | 102 | (* 103 | there is a number n so that [n+1] is beautiful. 104 | *) 105 | (** **** Exercise: 1 star (dist_not_exists) *) 106 | (** Prove that "[P] holds for all [x]" implies "there is no [x] for 107 | which [P] does not hold." *) 108 | 109 | Theorem dist_not_exists : forall (X:Type) (P : X -> Prop), 110 | (forall x, P x) -> ~ (exists x, ~ P x). 111 | Proof. 112 | intros. 113 | unfold not. 114 | intros. 115 | inversion H0. apply H1. apply H. 116 | Qed. 117 | (** [] *) 118 | 119 | (** **** Exercise: 3 stars, optional (not_exists_dist) *) 120 | (** (The other direction of this theorem requires the classical "law 121 | of the excluded middle".) *) 122 | 123 | Theorem not_exists_dist : 124 | excluded_middle -> 125 | forall (X:Type) (P : X -> Prop), 126 | ~ (exists x, ~ P x) -> (forall x, P x). 127 | Proof. 128 | unfold excluded_middle. 129 | unfold not. 130 | intros. 131 | destruct (H (P x)). apply H1. 132 | apply ex_falso_quodlibet. 133 | apply H0. exists x. apply H1. 134 | Qed. 135 | (** [] *) 136 | 137 | (** **** Exercise: 2 stars (dist_exists_or) *) 138 | (** Prove that existential quantification distributes over 139 | disjunction. *) 140 | 141 | Theorem dist_exists_or : forall (X:Type) (P Q : X -> Prop), 142 | (exists x, P x \/ Q x) <-> (exists x, P x) \/ (exists x, Q x). 143 | Proof. 144 | split. 145 | intros. 146 | destruct H. destruct H. 147 | left. exists witness. apply H. right. exists witness. apply H. 148 | intros. 149 | destruct H. destruct H. exists witness. left. apply H. 150 | destruct H. exists witness. right. apply H. 151 | Qed. 152 | (** [] *) 153 | 154 | (* ###################################################### *) 155 | (** * Evidence-Carrying Booleans *) 156 | 157 | (** So far we've seen two different forms of equality predicates: 158 | [eq], which produces a [Prop], and the type-specific forms, like 159 | [beq_nat], that produce [boolean] values. The former are more 160 | convenient to reason about, but we've relied on the latter to let 161 | us use equality tests in _computations_. While it is 162 | straightforward to write lemmas (e.g. [beq_nat_true] and 163 | [beq_nat_false]) that connect the two forms, using these lemmas 164 | quickly gets tedious. *) 165 | 166 | (** *** *) 167 | (** It turns out that we can get the benefits of both forms at once by 168 | using a construct called [sumbool]. *) 169 | 170 | Inductive sumbool (A B : Prop) : Set := 171 | | left : A -> sumbool A B 172 | | right : B -> sumbool A B. 173 | 174 | Notation "{ A } + { B }" := (sumbool A B) : type_scope. 175 | 176 | (** Think of [sumbool] as being like the [boolean] type, but instead 177 | of its values being just [true] and [false], they carry _evidence_ 178 | of truth or falsity. This means that when we [destruct] them, we 179 | are left with the relevant evidence as a hypothesis -- just as 180 | with [or]. (In fact, the definition of [sumbool] is almost the 181 | same as for [or]. The only difference is that values of [sumbool] 182 | are declared to be in [Set] rather than in [Prop]; this is a 183 | technical distinction that allows us to compute with them.) *) 184 | 185 | (** *** *) 186 | 187 | (** Here's how we can define a [sumbool] for equality on [nat]s *) 188 | 189 | Theorem eq_nat_dec : forall n m : nat, {n = m} + {n <> m}. 190 | Proof. 191 | (* WORKED IN CLASS *) 192 | intros n. 193 | induction n as [|n']. 194 | Case "n = 0". 195 | intros m. 196 | destruct m as [|m']. 197 | SCase "m = 0". 198 | left. reflexivity. 199 | SCase "m = S m'". 200 | right. intros contra. inversion contra. 201 | Case "n = S n'". 202 | intros m. 203 | destruct m as [|m']. 204 | SCase "m = 0". 205 | right. intros contra. inversion contra. 206 | SCase "m = S m'". 207 | destruct IHn' with (m := m') as [eq | neq]. 208 | left. apply f_equal. apply eq. 209 | right. intros Heq. inversion Heq as [Heq']. apply neq. apply Heq'. 210 | Defined. 211 | 212 | (** Read as a theorem, this says that equality on [nat]s is decidable: 213 | that is, given two [nat] values, we can always produce either 214 | evidence that they are equal or evidence that they are not. Read 215 | computationally, [eq_nat_dec] takes two [nat] values and returns a 216 | [sumbool] constructed with [left] if they are equal and [right] if 217 | they are not; this result can be tested with a [match] or, better, 218 | with an [if-then-else], just like a regular [boolean]. (Notice 219 | that we ended this proof with [Defined] rather than [Qed]. The 220 | only difference this makes is that the proof becomes 221 | _transparent_, meaning that its definition is available when Coq 222 | tries to do reductions, which is important for the computational 223 | interpretation.) *) 224 | 225 | (** *** *) 226 | (** Here's a simple example illustrating the advantages of the 227 | [sumbool] form. *) 228 | 229 | Definition override' {X: Type} (f: nat->X) (k:nat) (x:X) : nat->X:= 230 | fun (k':nat) => if eq_nat_dec k k' then x else f k'. 231 | 232 | Theorem override_same' : forall (X:Type) x1 k1 k2 (f : nat->X), 233 | f k1 = x1 -> 234 | (override' f k1 x1) k2 = f k2. 235 | Proof. 236 | intros X x1 k1 k2 f. intros Hx1. 237 | unfold override'. 238 | destruct (eq_nat_dec k1 k2). (* observe what appears as a hypothesis *) 239 | Case "k1 = k2". 240 | rewrite <- e. 241 | symmetry. apply Hx1. 242 | Case "k1 <> k2". 243 | reflexivity. Qed. 244 | 245 | (** Compare this to the more laborious proof (in MoreCoq.v) for the 246 | version of [override] defined using [beq_nat], where we had to use 247 | the auxiliary lemma [beq_nat_true] to convert a fact about 248 | booleans to a Prop. *) 249 | 250 | (** **** Exercise: 1 star (override_shadow') *) 251 | Theorem override_shadow' : forall (X:Type) x1 x2 k1 k2 (f : nat->X), 252 | (override' (override' f k1 x2) k1 x1) k2 = (override' f k1 x1) k2. 253 | Proof. 254 | intros. 255 | unfold override'. 256 | destruct (eq_nat_dec k1 k2). reflexivity. reflexivity. 257 | Qed. 258 | (** [] *) 259 | 260 | 261 | 262 | 263 | 264 | (* ####################################################### *) 265 | (** * Additional Exercises *) 266 | 267 | (** **** Exercise: 3 stars (all_forallb) *) 268 | (** Inductively define a property [all] of lists, parameterized by a 269 | type [X] and a property [P : X -> Prop], such that [all X P l] 270 | asserts that [P] is true for every element of the list [l]. *) 271 | 272 | Inductive all (X : Type) (P : X -> Prop) : list X -> Prop := 273 | | all_nil : all X P [] 274 | | all_cons : forall (l:list X) (x:X), P x -> all X P l -> all X P (x :: l). 275 | 276 | (** Recall the function [forallb], from the exercise 277 | [forall_exists_challenge] in chapter [MoreCoq]: *) 278 | 279 | Fixpoint forallb {X : Type} (test : X -> bool) (l : list X) : bool := 280 | match l with 281 | | [] => true 282 | | x :: l' => andb (test x) (forallb test l') 283 | end. 284 | 285 | (** Using the property [all], write down a specification for [forallb], 286 | and prove that it satisfies the specification. Try to make your 287 | specification as precise as possible. 288 | 289 | Are there any important properties of the function [forallb] which 290 | are not captured by your specification? *) 291 | 292 | Theorem all_forallb : forall X (l:list X) (P:X->bool), 293 | forallb P l = true <-> all X (fun x => P x = true) l. 294 | Proof. 295 | intros. split. induction l. 296 | intros. apply all_nil. 297 | simpl. intros. apply all_cons. apply andb_true_elim1 in H. apply H. 298 | apply IHl. apply andb_true_elim2 in H. apply H. 299 | intros. induction l. reflexivity. 300 | simpl. inversion H. rewrite H2. simpl. apply IHl. apply H3. 301 | Qed. 302 | (** [] *) 303 | 304 | (** **** Exercise: 4 stars, advanced (filter_challenge) *) 305 | (** One of the main purposes of Coq is to prove that programs match 306 | their specifications. To this end, let's prove that our 307 | definition of [filter] matches a specification. Here is the 308 | specification, written out informally in English. 309 | 310 | Suppose we have a set [X], a function [test: X->bool], and a list 311 | [l] of type [list X]. Suppose further that [l] is an "in-order 312 | merge" of two lists, [l1] and [l2], such that every item in [l1] 313 | satisfies [test] and no item in [l2] satisfies test. Then [filter 314 | test l = l1]. 315 | 316 | A list [l] is an "in-order merge" of [l1] and [l2] if it contains 317 | all the same elements as [l1] and [l2], in the same order as [l1] 318 | and [l2], but possibly interleaved. For example, 319 | [1,4,6,2,3] 320 | is an in-order merge of 321 | [1,6,2] 322 | and 323 | [4,3]. 324 | Your job is to translate this specification into a Coq theorem and 325 | prove it. (Hint: You'll need to begin by defining what it means 326 | for one list to be a merge of two others. Do this with an 327 | inductive relation, not a [Fixpoint].) *) 328 | 329 | Inductive in_order_merge {X:Type} : list X -> list X -> list X -> Prop := 330 | | merge_nil : in_order_merge [] [] [] 331 | | merge1 : forall x l1 l2 l3, in_order_merge l1 l2 l3 -> in_order_merge (x :: l1) l2 (x :: l3) 332 | | merge2 : forall x l1 l2 l3, in_order_merge l1 l2 l3 -> in_order_merge l1 (x :: l2) (x :: l3). 333 | 334 | Theorem filter_merge : forall (X:Type) (test:X->bool) (l1 l2 l3:list X), 335 | in_order_merge l1 l2 l3 -> forallb test l1 = true -> 336 | forallb (fun x => negb (test x)) l2 = true -> 337 | filter test l3 = l1. 338 | Proof. 339 | intros X test l1 l2 l3. generalize dependent l1. generalize dependent l2. 340 | induction l3. 341 | intros. inversion H. reflexivity. intros. inversion H. 342 | simpl. destruct (test x) eqn:testeq. apply f_equal. apply IHl3 with (l2:=l2). 343 | apply H5. rewrite <- H3 in H0. simpl in H0. apply andb_true_elim2 in H0. 344 | apply H0. apply H1. rewrite <- H3 in H0. simpl in H0. rewrite <- H2 in testeq. 345 | rewrite testeq in H0. inversion H0. 346 | simpl. rewrite <- H4 in H1. simpl in H1. destruct (test x) eqn:testeq. 347 | rewrite <- H2 in testeq. rewrite testeq in H1. inversion H1. 348 | apply IHl3 with (l2:=l4). apply H5. apply H0. apply andb_true_elim2 in H1. 349 | apply H1. 350 | Qed. 351 | (** [] *) 352 | 353 | (** **** Exercise: 5 stars, advanced, optional (filter_challenge_2) *) 354 | (** A different way to formally characterize the behavior of [filter] 355 | goes like this: Among all subsequences of [l] with the property 356 | that [test] evaluates to [true] on all their members, [filter test 357 | l] is the longest. Express this claim formally and prove it. *) 358 | 359 | Theorem ble_nat_S : forall a b:nat, ble_nat a b = true -> ble_nat a (S b) = true. 360 | Proof. 361 | intros. apply ble_nat_true_trans with (m:=b). 362 | apply H. apply NatList.ble_n_Sn. 363 | Qed. 364 | 365 | Theorem longest : forall (X:Type) (l1 l2:list X) (test:X->bool), 366 | subseq l1 l2 -> forallb test l1 = true -> 367 | ble_nat (length l1) (length (filter test l2)) = true. 368 | Proof. 369 | intros X l1 l2. generalize dependent l1. induction l2. 370 | intros. inversion H. simpl. reflexivity. 371 | intros. inversion H. reflexivity. 372 | simpl. destruct (test x) eqn:testeq. simpl. apply ble_nat_S. 373 | apply IHl2. apply H3. apply H0. 374 | apply IHl2. apply H3. apply H0. 375 | simpl. destruct (test x) eqn:testeq. 376 | destruct (length (x :: filter test l2)) eqn:leneq. 377 | simpl in leneq. inversion leneq. simpl in leneq. inversion leneq. 378 | apply IHl2. apply H3. rewrite <- H2 in H0. simpl in H0. 379 | apply andb_true_elim2 in H0. apply H0. 380 | rewrite <- H2 in H0. simpl in H0. rewrite H1 in H0. 381 | rewrite testeq in H0. inversion H0. 382 | Qed. 383 | (** [] *) 384 | 385 | (** **** Exercise: 4 stars, advanced (no_repeats) *) 386 | (** The following inductively defined proposition... *) 387 | 388 | Inductive appears_in {X:Type} (a:X) : list X -> Prop := 389 | | ai_here : forall l, appears_in a (a::l) 390 | | ai_later : forall b l, appears_in a l -> appears_in a (b::l). 391 | 392 | (** ...gives us a precise way of saying that a value [a] appears at 393 | least once as a member of a list [l]. 394 | 395 | Here's a pair of warm-ups about [appears_in]. 396 | *) 397 | 398 | Lemma appears_in_app : forall (X:Type) (xs ys : list X) (x:X), 399 | appears_in x (xs ++ ys) -> appears_in x xs \/ appears_in x ys. 400 | Proof. 401 | intros X xs. induction xs. 402 | intros. right. apply H. 403 | intros. inversion H. left. apply ai_here. 404 | apply IHxs in H1. inversion H1. left. apply ai_later. apply H3. 405 | right. apply H3. 406 | Qed. 407 | 408 | Lemma app_appears_in : forall (X:Type) (xs ys : list X) (x:X), 409 | appears_in x xs \/ appears_in x ys -> appears_in x (xs ++ ys). 410 | Proof. 411 | intros X xs. induction xs. intros. inversion H. 412 | inversion H0. apply H0. intros. 413 | inversion H. inversion H0. rewrite cons_app. apply ai_here. 414 | rewrite cons_app. apply ai_later. apply IHxs. left. apply H2. 415 | rewrite cons_app. apply ai_later. apply IHxs. right. apply H0. 416 | Qed. 417 | 418 | 419 | (** Now use [appears_in] to define a proposition [disjoint X l1 l2], 420 | which should be provable exactly when [l1] and [l2] are 421 | lists (with elements of type X) that have no elements in common. *) 422 | 423 | Definition disjoint {X:Type} (l1 l2:list X) : Prop := 424 | forall x, ~ ((appears_in x l1) /\ (appears_in x l2)). 425 | 426 | (** Next, use [appears_in] to define an inductive proposition 427 | [no_repeats X l], which should be provable exactly when [l] is a 428 | list (with elements of type [X]) where every member is different 429 | from every other. For example, [no_repeats nat [1,2,3,4]] and 430 | [no_repeats bool []] should be provable, while [no_repeats nat 431 | [1,2,1]] and [no_repeats bool [true,true]] should not be. *) 432 | 433 | Inductive no_repeats {X:Type} : list X -> Prop := 434 | | nore1 : forall x, no_repeats [x] 435 | | nore_cons : forall x l, ~ (appears_in x l) -> no_repeats l -> no_repeats (x :: l). 436 | 437 | (** Finally, state and prove one or more interesting theorems relating 438 | [disjoint], [no_repeats] and [++] (list append). *) 439 | 440 | Theorem disjoin_nore_append : forall (X:Type) (l1 l2:list X), 441 | no_repeats l1 -> no_repeats l2 -> disjoint l1 l2 -> no_repeats (l1 ++ l2). 442 | Proof. 443 | intros X l1. induction l1. 444 | intros. apply H0. 445 | intros. inversion H. apply nore_cons. 446 | unfold disjoint in H1. 447 | unfold not. intros. destruct (H1 x). 448 | split. apply ai_here. apply H2. apply H0. 449 | rewrite cons_app. apply nore_cons. 450 | unfold not. intros. 451 | unfold disjoint in H1. apply appears_in_app in H6. 452 | destruct H6. apply contradiction_implies_anything with (P:=appears_in x l1). 453 | split. apply H6. apply H4. destruct (H1 x). 454 | split. apply ai_here. apply H6. apply IHl1. 455 | apply H5. apply H0. 456 | unfold disjoint in H1. unfold disjoint. 457 | intros. unfold not. intros. 458 | destruct H6. destruct (H1 x1). split. 459 | apply ai_later. apply H6. apply H7. 460 | Qed. 461 | 462 | (** **** Exercise: 3 stars (nostutter) *) 463 | (** Formulating inductive definitions of predicates is an important 464 | skill you'll need in this course. Try to solve this exercise 465 | without any help at all. 466 | 467 | We say that a list of numbers "stutters" if it repeats the same 468 | number consecutively. The predicate "[nostutter mylist]" means 469 | that [mylist] does not stutter. Formulate an inductive definition 470 | for [nostutter]. (This is different from the [no_repeats] 471 | predicate in the exercise above; the sequence [1;4;1] repeats but 472 | does not stutter.) *) 473 | 474 | Inductive nostutter: list nat -> Prop := 475 | | nostu_nil : nostutter nil 476 | | nostu1 : forall x, nostutter [x] 477 | | nostu_cons : forall x y l, x <> y -> nostutter (y :: l) -> nostutter (x :: y :: l). 478 | 479 | (** Make sure each of these tests succeeds, but you are free 480 | to change the proof if the given one doesn't work for you. 481 | Your definition might be different from mine and still correct, 482 | in which case the examples might need a different proof. 483 | 484 | The suggested proofs for the examples (in comments) use a number 485 | of tactics we haven't talked about, to try to make them robust 486 | with respect to different possible ways of defining [nostutter]. 487 | You should be able to just uncomment and use them as-is, but if 488 | you prefer you can also prove each example with more basic 489 | tactics. *) 490 | 491 | Example test_nostutter_1: nostutter [3;1;4;1;5;6]. 492 | 493 | Proof. repeat constructor; apply beq_nat_false; auto. Qed. 494 | 495 | Example test_nostutter_2: nostutter []. 496 | Proof. apply nostu_nil. Qed. 497 | (* 498 | Proof. repeat constructor; apply beq_nat_false; auto. Qed. 499 | *) 500 | 501 | Example test_nostutter_3: nostutter [5]. 502 | Proof. apply nostu1. Qed. 503 | (* 504 | Proof. repeat constructor; apply beq_nat_false; auto. Qed. 505 | *) 506 | 507 | Example test_nostutter_4: not (nostutter [3;1;1;4]). 508 | Proof. 509 | unfold not. intros. inversion H. 510 | inversion H4. unfold not in H7. 511 | apply H7. reflexivity. 512 | Qed. 513 | (* Proof. intro. *) 514 | (* repeat match goal with *) 515 | (* h: nostutter _ |- _ => inversion h; clear h; subst *) 516 | (* end. *) 517 | (* contradiction H1; auto. Qed. *) 518 | (** [] *) 519 | 520 | (** **** Exercise: 4 stars, advanced (pigeonhole principle) *) 521 | (** The "pigeonhole principle" states a basic fact about counting: 522 | if you distribute more than [n] items into [n] pigeonholes, some 523 | pigeonhole must contain at least two items. As is often the case, 524 | this apparently trivial fact about numbers requires non-trivial 525 | machinery to prove, but we now have enough... *) 526 | 527 | (** First a pair of useful lemmas (we already proved these for lists 528 | of naturals, but not for arbitrary lists). *) 529 | 530 | Lemma app_length : forall (X:Type) (l1 l2 : list X), 531 | length (l1 ++ l2) = length l1 + length l2. 532 | Proof. 533 | intros X l1. induction l1. 534 | simpl. intros. reflexivity. 535 | simpl. intros. apply f_equal. apply IHl1. 536 | Qed. 537 | 538 | Lemma appears_in_app_split : forall (X:Type) (x:X) (l:list X), 539 | appears_in x l -> 540 | exists l1, exists l2, l = l1 ++ (x::l2). 541 | Proof. 542 | intros. induction l. 543 | inversion H. inversion H. 544 | exists nil. exists l. reflexivity. 545 | apply IHl in H1. destruct H1. destruct H1. 546 | exists (x0 :: witness). exists witness0. simpl. rewrite <- H1. 547 | reflexivity. 548 | Qed. 549 | 550 | (** Now define a predicate [repeats] (analogous to [no_repeats] in the 551 | exercise above), such that [repeats X l] asserts that [l] contains 552 | at least one repeated element (of type [X]). *) 553 | 554 | Inductive repeats {X:Type} : list X -> Prop := 555 | | rep_here : forall x l, appears_in x l -> repeats (x :: l) 556 | | rep_later : forall x l, repeats l -> repeats (x :: l). 557 | 558 | (** Now here's a way to formalize the pigeonhole principle. List [l2] 559 | represents a list of pigeonhole labels, and list [l1] represents 560 | the labels assigned to a list of items: if there are more items 561 | than labels, at least two items must have the same label. This 562 | proof is much easier if you use the [excluded_middle] hypothesis 563 | to show that [appears_in] is decidable, i.e. [forall x 564 | l, (appears_in x l) \/ ~ (appears_in x l)]. However, it is also 565 | possible to make the proof go through _without_ assuming that 566 | [appears_in] is decidable; if you can manage to do this, you will 567 | not need the [excluded_middle] hypothesis. *) 568 | Theorem pigeonhole_principle: forall (X:Type) (l1 l2:list X), 569 | excluded_middle -> 570 | (forall x, appears_in x l1 -> appears_in x l2) -> 571 | length l2 < length l1 -> 572 | repeats l1. 573 | Proof. 574 | intros X l1. induction l1 as [|x l1']; intros. 575 | inversion H1. 576 | destruct (H (appears_in x l1')). 577 | apply rep_here. apply H2. apply rep_later. 578 | destruct (H (appears_in x l2)). apply appears_in_app_split in H3. 579 | inversion H3. inversion H4. 580 | apply IHl1' with (l2:=(witness ++ witness0)). 581 | apply H. intros. destruct (H (x0 = x)). subst. contradiction. 582 | apply ai_later with (b:=x) in H6. apply H0 in H6. 583 | rewrite H5 in H6. apply appears_in_app in H6. apply app_appears_in. 584 | destruct H6. left. apply H6. right. 585 | inversion H6. contradiction. assumption. 586 | rewrite H5 in H1. rewrite app_length in H1. 587 | simpl in H1. rewrite <- plus_n_Sm in H1. 588 | apply Sn_le_Sm__n_le_m in H1. 589 | unfold lt. rewrite app_length. apply H1. 590 | apply contradiction_implies_anything with (P:=(appears_in x l2)). 591 | split. apply H0. apply ai_here. apply H3. 592 | Qed. 593 | (** [] *) 594 | 595 | (** $Date: 2014-12-31 16:01:37 -0500 (Wed, 31 Dec 2014) $ *) 596 | -------------------------------------------------------------------------------- /Postscript.v: -------------------------------------------------------------------------------- 1 | (** * Postscript *) 2 | 3 | (** * Looking back... *) 4 | 5 | (** - _Functional programming_ 6 | - "declarative" programming (recursion over persistent data 7 | structures) 8 | - higher-order functions 9 | - polymorphism *) 10 | 11 | (** 12 | - _Logic_, the mathematical basis for software engineering: 13 | << 14 | logic calculus 15 | -------------------- = ---------------------------- 16 | software engineering mechanical/civil engineering 17 | >> 18 | 19 | - inductively defined sets and relations 20 | - inductive proofs 21 | - proof objects *) 22 | 23 | (** 24 | - _Coq_, an industrial-strength proof assistant 25 | - functional core language 26 | - core tactics 27 | - automation 28 | *) 29 | 30 | (** 31 | - _Foundations of programming languages_ 32 | 33 | - notations and definitional techniques for precisely specifying 34 | - abstract syntax 35 | - operational semantics 36 | - big-step style 37 | - small-step style 38 | - type systems 39 | 40 | - program equivalence 41 | 42 | - Hoare logic 43 | 44 | - fundamental metatheory of type systems 45 | 46 | - progress and preservation 47 | 48 | - theory of subtyping 49 | *) 50 | 51 | (* ###################################################################### *) 52 | (** * Looking forward... *) 53 | 54 | (** Some good places to go for more... 55 | 56 | - Several optional chapters of _Software Foundations_ 57 | 58 | - Cutting-edge conferences on programming languages and formal 59 | verification: 60 | - POPL 61 | - PLDI 62 | - OOPSLA 63 | - ICFP 64 | - CAV 65 | - (and many others) 66 | 67 | - More on functional programming 68 | - Learn You a Haskell for Great Good, by Miran 69 | Lipovaca (ebook) 70 | - and many other texts on Haskell, OCaml, Scheme, Scala, ... 71 | 72 | - More on Hoare logic and program verification 73 | - The Formal Semantics of Programming Languages: An 74 | Introduction, by Glynn Winskel. MIT Press, 1993. 75 | - Many practical verification tools, e.g. Microsoft's 76 | Boogie system, Java Extended Static Checking, etc. 77 | 78 | - More on the foundations of programming languages: 79 | - Types and Programming Languages, by Benjamin C. Pierce. MIT 80 | Press, 2002. 81 | - Practical Foundations for Programming Languages, by Robert 82 | Harper. Forthcoming from MIT Press. Manuscript available 83 | from his web page. 84 | - Foundations for Programming Languages, by John C. Mitchell. 85 | MIT Press, 1996. 86 | 87 | - More on Coq: 88 | - Certified Programming with Dependent Types, by Adam 89 | Chlipala. A draft textbook on practical proof 90 | engineering with Coq, available from his web page. 91 | - Interactive Theorem Proving and Program Development: 92 | Coq'Art: The Calculus of Inductive Constructions, by Yves 93 | Bertot and Pierre Casteran. Springer-Verlag, 2004. 94 | - Iron Lambda (http://iron.ouroborus.net/) is a collection 95 | of ​Coq formalisations for functional languages of 96 | increasing complexity. It fills part of the gap between 97 | the end of the​ Software Foundations course and what 98 | appears in current research papers. The collection has 99 | at least Progress and Preservation theorems for a number 100 | of variants of STLC and the polymorphic 101 | lambda-calculus (System F) 102 | 103 | *) 104 | 105 | (* $Date: 2014-08-23 15:24:59 -0400 (Sat, 23 Aug 2014) $ *) 106 | 107 | -------------------------------------------------------------------------------- /Preface.v: -------------------------------------------------------------------------------- 1 | (** * Preface *) 2 | 3 | (* ###################################################################### *) 4 | (** * Welcome *) 5 | 6 | (** This electronic book is a course on _Software Foundations_, the 7 | mathematical underpinnings of reliable software. Topics include 8 | basic concepts of logic, computer-assisted theorem proving, the 9 | Coq proof assistant, functional programming, operational 10 | semantics, Hoare logic, and static type systems. The exposition 11 | is intended for a broad range of readers, from advanced 12 | undergraduates to PhD students and researchers. No specific 13 | background in logic or programming languages is assumed, though a 14 | degree of mathematical maturity will be helpful. 15 | 16 | The principal novelty of the course is that it is one hundred per 17 | cent formalized and machine-checked: the entire text is literally 18 | a script for Coq. It is intended to be read alongside an 19 | interactive session with Coq. All the details in the text are 20 | fully formalized in Coq, and the exercises are designed to be 21 | worked using Coq. 22 | 23 | The files are organized into a sequence of core chapters, covering 24 | about one semester's worth of material and organized into a 25 | coherent linear narrative, plus a number of "appendices" covering 26 | additional topics. All the core chapters are suitable for both 27 | upper-level undergraduate and graduate students. *) 28 | 29 | 30 | (* ###################################################################### *) 31 | (** * Overview *) 32 | 33 | (** Building reliable software is hard. The scale and complexity of 34 | modern systems, the number of people involved in building them, 35 | and the range of demands placed on them make it extremely 36 | difficult even to build software that is more or less correct, 37 | much less to get it 100%% correct. At the same time, the 38 | increasing degree to which information processing is woven into 39 | every aspect of society continually amplifies the cost of bugs and 40 | insecurities. 41 | 42 | Computer scientists and software engineers have responded to these 43 | challenges by developing a whole host of techniques for improving 44 | software reliability, ranging from recommendations about managing 45 | software projects and organizing programming teams (e.g., extreme 46 | programming) to design philosophies for libraries (e.g., 47 | model-view-controller, publish-subscribe, etc.) and programming 48 | languages (e.g., object-oriented programming, aspect-oriented 49 | programming, functional programming, ...) and to mathematical 50 | techniques for specifying and reasoning about properties of 51 | software and tools for helping validate these properties. 52 | 53 | The present course is focused on this last set of techniques. The 54 | text weaves together five conceptual threads: 55 | 56 | (1) basic tools from _logic_ for making and justifying precise 57 | claims about programs; 58 | 59 | (2) the use of _proof assistants_ to construct rigorous logical 60 | arguments; 61 | 62 | (3) the idea of _functional programming_, both as a method of 63 | programming and as a bridge between programming and logic; 64 | 65 | (4) formal techniques for _reasoning about the properties of 66 | specific programs_ (e.g., the fact that a loop terminates on 67 | all inputs, or that a sorting function or a compiler obeys a 68 | particular specification); and 69 | 70 | (5) the use of _type systems_ for establishing well-behavedness 71 | guarantees for _all_ programs in a given programming 72 | language (e.g., the fact that well-typed Java programs cannot 73 | be subverted at runtime). 74 | 75 | Each of these topics is easily rich enough to fill a whole course 76 | in its own right; taking all of them together naturally means that 77 | much will be left unsaid. But we hope readers will find that the 78 | themes illuminate and amplify each other in useful ways, and that 79 | bringing them together creates a foundation from which it will be 80 | easy to dig into any of them more deeply. Some suggestions for 81 | further reading can be found in the [Postscript] chapter. *) 82 | 83 | (** ** Logic *) 84 | 85 | (** Logic is the field of study whose subject matter is _proofs_ -- 86 | unassailable arguments for the truth of particular propositions. 87 | Volumes have been written about the central role of logic in 88 | computer science. Manna and Waldinger called it "the calculus of 89 | computer science," while Halpern et al.'s paper _On the Unusual 90 | Effectiveness of Logic in Computer Science_ catalogs scores of 91 | ways in which logic offers critical tools and insights. Indeed, 92 | they observe that "As a matter of fact, logic has turned out to be 93 | significiantly more effective in computer science than it has been 94 | in mathematics. This is quite remarkable, especially since much 95 | of the impetus for the development of logic during the past one 96 | hundred years came from mathematics." 97 | 98 | In particular, the fundamental notion of inductive proofs is 99 | ubiquitous in all of computer science. You have surely seen them 100 | before, in contexts from discrete math to analysis of algorithms, 101 | but in this course we will examine them much more deeply than you 102 | have probably done so far. *) 103 | 104 | (** ** Proof Assistants *) 105 | 106 | (** The flow of ideas between logic and computer science has not been 107 | in just one direction: CS has also made important contributions to 108 | logic. One of these has been the development of software tools 109 | for helping construct proofs of logical propositions. These tools 110 | fall into two broad categories: 111 | 112 | - _Automated theorem provers_ provide "push-button" operation: 113 | you give them a proposition and they return either _true_, 114 | _false_, or _ran out of time_. Although their capabilities 115 | are limited to fairly specific sorts of reasoning, they have 116 | matured tremendously in recent years and are used now in a 117 | huge variety of settings. Examples of such tools include SAT 118 | solvers, SMT solvers, and model checkers. 119 | 120 | - _Proof assistants_ are hybrid tools that automate the more 121 | routine aspects of building proofs while depending on human 122 | guidance for more difficult aspects. Widely used proof 123 | assistants include Isabelle, Agda, Twelf, ACL2, PVS, and Coq, 124 | among many others. 125 | 126 | This course is based around Coq, a proof assistant that has been 127 | under development since 1983 at a number of French research labs 128 | and universities. Coq provides a rich environment for interactive 129 | development of machine-checked formal reasoning. The kernel of 130 | the Coq system is a simple proof-checker which guarantees that 131 | only correct deduction steps are performed. On top of this 132 | kernel, the Coq environment provides high-level facilities for 133 | proof development, including powerful tactics for constructing 134 | complex proofs semi-automatically, and a large library of common 135 | definitions and lemmas. 136 | 137 | Coq has been a critical enabler for a huge variety of work across 138 | computer science and mathematics: 139 | 140 | - As a _platform for modeling programming languages_, it has become 141 | a standard tool for researchers who need to describe and reason 142 | about complex language definitions. It has been used, for 143 | example, to check the security of the JavaCard platform, 144 | obtaining the highest level of common criteria certification, 145 | and for formal specifications of the x86 and LLVM instruction 146 | sets. 147 | 148 | - As an _environment for developing formally certified software_, 149 | Coq has been used to build CompCert, a fully-verified optimizing 150 | compiler for C, for proving the correctness of subtle algorithms 151 | involving floating point numbers, and as the basis for 152 | Certicrypt, an environment for reasoning about the security of 153 | cryptographic algorithms. 154 | 155 | - As a _realistic environment for programming with dependent 156 | types_, it has inspired numerous innovations. For example, the 157 | Ynot project at Harvard embeds "relational Hoare reasoning" (an 158 | extension of the _Hoare Logic_ we will see later in this course) 159 | in Coq. 160 | 161 | - As a _proof assistant for higher-order logic_, it has been used 162 | to validate a number of important results in mathematics. For 163 | example, its ability to include complex computations inside 164 | proofs made it possible to develop the first formally verified 165 | proof of the 4-color theorem. This proof had previously been 166 | controversial among mathematicians because part of it included 167 | checking a large number of configurations using a program. In 168 | the Coq formalization, everything is checked, including the 169 | correctness of the computational part. More recently, an even 170 | more massive effort led to a Coq formalization of the 171 | Feit-Thompson Theorem -- the first major step in the 172 | classification of finite simple groups. 173 | 174 | By the way, in case you're wondering about the name, here's what 175 | the official Coq web site says: "Some French computer scientists 176 | have a tradition of naming their software as animal species: Caml, 177 | Elan, Foc or Phox are examples of this tacit convention. In French, 178 | 'coq' means rooster, and it sounds like the initials of the 179 | Calculus of Constructions (CoC) on which it is based." The rooster 180 | is also the national symbol of France, and "Coq" are the first 181 | three letters of the name of Thierry Coquand, one of Coq's early 182 | developers. *) 183 | 184 | (** ** Functional Programming *) 185 | 186 | (** The term _functional programming_ refers both to a collection of 187 | programming idioms that can be used in almost any programming 188 | language and to a family of programming languages designed to 189 | emphasize these idioms, including Haskell, OCaml, Standard ML, 190 | F##, Scala, Scheme, Racket, Common Lisp, Clojure, Erlang, and Coq. 191 | 192 | Functional programming has been developed over many decades -- 193 | indeed, its roots go back to Church's lambda-calculus, which was 194 | invented in the 1930s before the era of the computer began! But 195 | since the early '90s it has enjoyed a surge of interest among 196 | industrial engineers and language designers, playing a key role in 197 | high-value systems at companies like Jane St. Capital, Microsoft, 198 | Facebook, and Ericsson. 199 | 200 | The most basic tenet of functional programming is that, as much as 201 | possible, computation should be _pure_, in the sense that the only 202 | effect of execution should be to produce a result: the computation 203 | should be free from _side effects_ such as I/O, assignments to 204 | mutable variables, redirecting pointers, etc. For example, 205 | whereas an _imperative_ sorting function might take a list of 206 | numbers and rearrange its pointers to put the list in order, a 207 | pure sorting function would take the original list and return a 208 | _new_ list containing the same numbers in sorted order. 209 | 210 | One significant benefit of this style of programming is that it 211 | makes programs easier to understand and reason about. If every 212 | operation on a data structure yields a new data structure, leaving 213 | the old one intact, then there is no need to worry about how that 214 | structure is being shared and whether a change by one part of the 215 | program might break an invariant that another part of the program 216 | relies on. These considerations are particularly critical in 217 | concurrent programs, where every piece of mutable state that is 218 | shared between threads is a potential source of pernicious bugs. 219 | Indeed, a large part of the recent interest in functional 220 | programming in industry is due to its simple behavior in the 221 | presence of concurrency. 222 | 223 | Another reason for the current excitement about functional 224 | programming is related to the first: functional programs are often 225 | much easier to parallelize than their imperative counterparts. If 226 | running a computation has no effect other than producing a result, 227 | then it does not matter _where_ it is run. Similarly, if a data 228 | structure is never modified destructively, then it can be copied 229 | freely, across cores or across the network. Indeed, the MapReduce 230 | idiom that lies at the heart of massively distributed query 231 | processors like Hadoop and is used by Google to index the entire 232 | web is a classic example of functional programming. 233 | 234 | For purposes of this course, functional programming has yet 235 | another significant attraction: it serves as a bridge between 236 | logic and computer science. Indeed, Coq itself can be viewed as a 237 | combination of a small but extremely expressive functional 238 | programming language plus with a set of tools for stating and 239 | proving logical assertions. Moreover, when we come to look more 240 | closely, we find that these two sides of Coq are actually aspects 241 | of the very same underlying machinery -- i.e., _proofs are 242 | programs_. *) 243 | 244 | (** ** Program Verification *) 245 | 246 | (** The first third of the book is devoted to developing the 247 | conceptual framework of logic and functional programming and 248 | gaining enough fluency with Coq to use it for modeling and 249 | reasoning about nontrivial artifacts. From this point on, we 250 | increasingly turn our attention to two broad topics of critical 251 | importance to the enterprise of building reliable software (and 252 | hardware): techniques for proving specific properties of 253 | particular _programs_ and for proving general properties of whole 254 | programming _languages_. 255 | 256 | For both of these, the first thing we need is a way of 257 | representing programs as mathematical objects, so we can talk 258 | about them precisely, and ways of describing their behavior in 259 | terms of mathematical functions or relations. Our tools for these 260 | tasks are _abstract syntax_ and _operational semantics_, a method 261 | of specifying the behavior of programs by writing abstract 262 | interpreters. At the beginning, we work with operational 263 | semantics in the so-called "big-step" style, which leads to 264 | somewhat simpler and more readable definitions, in those cases 265 | where it is applicable. Later on, we switch to a more detailed 266 | "small-step" style, which helps make some useful distinctions 267 | between different sorts of "nonterminating" program behaviors and 268 | which is applicable to a broader range of language features, 269 | including concurrency. 270 | 271 | The first programming language we consider in detail is _Imp_, a 272 | tiny toy language capturing the core features of conventional 273 | imperative programming: variables, assignment, conditionals, and 274 | loops. We study two different ways of reasoning about the 275 | properties of Imp programs. 276 | 277 | First, we consider what it means to say that two Imp programs are 278 | _equivalent_ in the sense that they give the same behaviors for 279 | all initial memories. This notion of equivalence then becomes a 280 | criterion for judging the correctness of _metaprograms_ -- 281 | programs that manipulate other programs, such as compilers and 282 | optimizers. We build a simple optimizer for Imp and prove that it 283 | is correct. 284 | 285 | Second, we develop a methodology for proving that Imp programs 286 | satisfy formal specifications of their behavior. We introduce the 287 | notion of _Hoare triples_ -- Imp programs annotated with pre- and 288 | post-conditions describing what should be true about the memory in 289 | which they are started and what they promise to make true about 290 | the memory in which they terminate -- and the reasoning principles 291 | of _Hoare Logic_, a "domain-specific logic" specialized for 292 | convenient compositional reasoning about imperative programs, with 293 | concepts like "loop invariant" built in. 294 | 295 | This part of the course is intended to give readers a taste of the 296 | key ideas and mathematical tools used for a wide variety of 297 | real-world software and hardware verification tasks. 298 | *) 299 | 300 | (** ** Type Systems *) 301 | 302 | (** Our final major topic, covering the last third of the course, is 303 | _type systems_, a powerful set of tools for establishing 304 | properties of _all_ programs in a given language. 305 | 306 | Type systems are the best established and most popular example of 307 | a highly successful class of formal verification techniques known 308 | as _lightweight formal methods_. These are reasoning techniques 309 | of modest power -- modest enough that automatic checkers can be 310 | built into compilers, linkers, or program analyzers and thus be 311 | applied even by programmers unfamiliar with the underlying 312 | theories. (Other examples of lightweight formal methods include 313 | hardware and software model checkers, contract checkers, and 314 | run-time property monitoring techniques for detecting when some 315 | component of a system is not behaving according to specification). 316 | 317 | This topic brings us full circle: the language whose properties we 318 | study in this part, called the _simply typed lambda-calculus_, is 319 | essentially a simplified model of the core of Coq itself! 320 | 321 | *) 322 | 323 | (* ###################################################################### *) 324 | (** * Practicalities *) 325 | 326 | (* ###################################################################### *) 327 | (** ** Chapter Dependencies *) 328 | 329 | (** A diagram of the dependencies between chapters and some suggested 330 | paths through the material can be found in the file [deps.html]. *) 331 | 332 | (* ###################################################################### *) 333 | (** ** System Requirements *) 334 | 335 | (** Coq runs on Windows, Linux, and OS X. You will need: 336 | 337 | - A current installation of Coq, available from the Coq home 338 | page. Everything should work with version 8.4. 339 | 340 | - An IDE for interacting with Coq. Currently, there are two 341 | choices: 342 | 343 | - Proof General is an Emacs-based IDE. It tends to be 344 | preferred by users who are already comfortable with 345 | Emacs. It requires a separate installation (google 346 | "Proof General"). 347 | 348 | - CoqIDE is a simpler stand-alone IDE. It is distributed 349 | with Coq, but on some platforms compiling it involves 350 | installing additional packages for GUI libraries and 351 | such. *) 352 | 353 | (* ###################################################################### *) 354 | (** ** Exercises *) 355 | 356 | (** Each chapter includes numerous exercises. Each is marked with a 357 | "star rating," which can be interpreted as follows: 358 | 359 | - One star: easy exercises that underscore points in the text 360 | and that, for most readers, should take only a minute or two. 361 | Get in the habit of working these as you reach them. 362 | 363 | - Two stars: straightforward exercises (five or ten minutes). 364 | 365 | - Three stars: exercises requiring a bit of thought (ten 366 | minutes to half an hour). 367 | 368 | - Four and five stars: more difficult exercises (half an hour 369 | and up). 370 | 371 | Also, some exercises are marked "advanced", and some are marked 372 | "optional." Doing just the non-optional, non-advanced exercises 373 | should provide good coverage of the core material. Optional 374 | exercises provide a bit of extra practice with key concepts and 375 | introduce secondary themes that may be of interest to some 376 | readers. Advanced exercises are for readers who want an extra 377 | challenge (and, in return, a deeper contact with the material). 378 | 379 | _Please do not post solutions to the exercises in public places_: 380 | Software Foundations is widely used both for self-study and for 381 | university courses. Having solutions easily available makes it 382 | much less useful for courses, which typically have graded homework 383 | assignments. The authors especially request that readers not post 384 | solutions to the exercises anyplace where they can be found by 385 | search engines. 386 | *) 387 | 388 | (* ###################################################################### *) 389 | (** ** Downloading the Coq Files *) 390 | 391 | (** A tar file containing the full sources for the "release version" 392 | of these notes (as a collection of Coq scripts and HTML files) is 393 | available here: 394 | << 395 | http://www.cis.upenn.edu/~bcpierce/sf 396 | >> 397 | If you are using the notes as part of a class, you may be given 398 | access to a locally extended version of the files, which you 399 | should use instead of the release version. 400 | *) 401 | 402 | (* ###################################################################### *) 403 | (** * Note for Instructors *) 404 | 405 | (** If you intend to use these materials in your own course, you will 406 | undoubtedly find things you'd like to change, improve, or add. 407 | Your contributions are welcome! 408 | 409 | Please send an email to Benjamin Pierce describing yourself and 410 | how you would like to use the materials, and including the result 411 | of doing "htpasswd -s -n NAME", where NAME is your preferred user 412 | name. We'll set you up with read/write access to our subversion 413 | repository and developers' mailing list; in the repository you'll 414 | find a [README] with further instructions. *) 415 | 416 | (* ###################################################################### *) 417 | (** * Translations *) 418 | 419 | (** Thanks to the efforts of a team of volunteer translators, _Software 420 | Foundations_ can now be enjoyed in Japanese at [http://proofcafe.org/sf] 421 | *) 422 | 423 | (** $Date: 2014-12-31 15:31:47 -0500 (Wed, 31 Dec 2014) $ *) 424 | 425 | -------------------------------------------------------------------------------- /ProofObjects.v: -------------------------------------------------------------------------------- 1 | (** * ProofObjects: Working with Explicit Evidence in Coq *) 2 | 3 | Require Export MoreLogic. 4 | 5 | (* ##################################################### *) 6 | 7 | (** We have seen that Coq has mechanisms both for _programming_, 8 | using inductive data types (like [nat] or [list]) and functions 9 | over these types, and for _proving_ properties of these programs, 10 | using inductive propositions (like [ev] or [eq]), implication, and 11 | universal quantification. So far, we have treated these mechanisms 12 | as if they were quite separate, and for many purposes this is 13 | a good way to think. But we have also seen hints that Coq's programming and 14 | proving facilities are closely related. For example, the 15 | keyword [Inductive] is used to declare both data types and 16 | propositions, and [->] is used both to describe the type of 17 | functions on data and logical implication. This is not just a 18 | syntactic accident! In fact, programs and proofs in Coq are almost 19 | the same thing. In this chapter we will study how this works. 20 | 21 | We have already seen the fundamental idea: provability in Coq is 22 | represented by concrete _evidence_. When we construct the proof 23 | of a basic proposition, we are actually building a tree of evidence, 24 | which can be thought of as a data structure. If the proposition 25 | is an implication like [A -> B], then its proof will be an 26 | evidence _transformer_: a recipe for converting evidence for 27 | A into evidence for B. So at a fundamental level, proofs are simply 28 | programs that manipulate evidence. 29 | *) 30 | (** 31 | Q. If evidence is data, what are propositions themselves? 32 | 33 | A. They are types! 34 | 35 | Look again at the formal definition of the [beautiful] property. *) 36 | 37 | Print beautiful. 38 | (* ==> 39 | Inductive beautiful : nat -> Prop := 40 | b_0 : beautiful 0 41 | | b_3 : beautiful 3 42 | | b_5 : beautiful 5 43 | | b_sum : forall n m : nat, beautiful n -> beautiful m -> beautiful (n + m) 44 | *) 45 | 46 | (** *** *) 47 | 48 | (** The trick is to introduce an alternative pronunciation of "[:]". 49 | Instead of "has type," we can also say "is a proof of." For 50 | example, the second line in the definition of [beautiful] declares 51 | that [b_0 : beautiful 0]. Instead of "[b_0] has type 52 | [beautiful 0]," we can say that "[b_0] is a proof of [beautiful 0]." 53 | Similarly for [b_3] and [b_5]. *) 54 | 55 | (** *** *) 56 | 57 | (** This pun between types and propositions (between [:] as "has type" 58 | and [:] as "is a proof of" or "is evidence for") is called the 59 | _Curry-Howard correspondence_. It proposes a deep connection 60 | between the world of logic and the world of computation. 61 | << 62 | propositions ~ types 63 | proofs ~ data values 64 | >> 65 | Many useful insights follow from this connection. To begin with, it 66 | gives us a natural interpretation of the type of [b_sum] constructor: *) 67 | 68 | Check b_sum. 69 | (* ===> b_sum : forall n m, 70 | beautiful n -> 71 | beautiful m -> 72 | beautiful (n+m) *) 73 | (** This can be read "[b_sum] is a constructor that takes four 74 | arguments -- two numbers, [n] and [m], and two pieces of evidence, 75 | for the propositions [beautiful n] and [beautiful m], respectively -- 76 | and yields evidence for the proposition [beautiful (n+m)]." *) 77 | 78 | (** Now let's look again at a previous proof involving [beautiful]. *) 79 | 80 | Theorem eight_is_beautiful: beautiful 8. 81 | Proof. 82 | apply b_sum with (n := 3) (m := 5). 83 | apply b_3. 84 | apply b_5. Qed. 85 | 86 | (** Just as with ordinary data values and functions, we can use the [Print] 87 | command to see the _proof object_ that results from this proof script. *) 88 | 89 | Print eight_is_beautiful. 90 | (* ===> eight_is_beautiful = b_sum 3 5 b_3 b_5 91 | : beautiful 8 *) 92 | 93 | (** In view of this, we might wonder whether we can write such 94 | an expression ourselves. Indeed, we can: *) 95 | 96 | Check (b_sum 3 5 b_3 b_5). 97 | (* ===> beautiful (3 + 5) *) 98 | 99 | (** The expression [b_sum 3 5 b_3 b_5] can be thought of as 100 | instantiating the parameterized constructor [b_sum] with the 101 | specific arguments [3] [5] and the corresponding proof objects for 102 | its premises [beautiful 3] and [beautiful 5] (Coq is smart enough 103 | to figure out that 3+5=8). Alternatively, we can think of [b_sum] 104 | as a primitive "evidence constructor" that, when applied to two 105 | particular numbers, wants to be further applied to evidence that 106 | those two numbers are beautiful; its type, 107 | forall n m, beautiful n -> beautiful m -> beautiful (n+m), 108 | expresses this functionality, in the same way that the polymorphic 109 | type [forall X, list X] in the previous chapter expressed the fact 110 | that the constructor [nil] can be thought of as a function from 111 | types to empty lists with elements of that type. *) 112 | 113 | (** This gives us an alternative way to write the proof that [8] is 114 | beautiful: *) 115 | 116 | Theorem eight_is_beautiful': beautiful 8. 117 | Proof. 118 | apply (b_sum 3 5 b_3 b_5). 119 | Qed. 120 | 121 | (** Notice that we're using [apply] here in a new way: instead of just 122 | supplying the _name_ of a hypothesis or previously proved theorem 123 | whose type matches the current goal, we are supplying an 124 | _expression_ that directly builds evidence with the required 125 | type. *) 126 | 127 | 128 | (* ##################################################### *) 129 | (** * Proof Scripts and Proof Objects *) 130 | 131 | (** These proof objects lie at the core of how Coq operates. 132 | 133 | When Coq is following a proof script, what is happening internally 134 | is that it is gradually constructing a proof object -- a term 135 | whose type is the proposition being proved. The tactics between 136 | the [Proof] command and the [Qed] instruct Coq how to build up a 137 | term of the required type. To see this process in action, let's 138 | use the [Show Proof] command to display the current state of the 139 | proof tree at various points in the following tactic proof. *) 140 | 141 | Theorem eight_is_beautiful'': beautiful 8. 142 | Proof. 143 | Show Proof. 144 | apply b_sum with (n:=3) (m:=5). 145 | Show Proof. 146 | apply b_3. 147 | Show Proof. 148 | apply b_5. 149 | Show Proof. 150 | Qed. 151 | 152 | (** At any given moment, Coq has constructed a term with some 153 | "holes" (indicated by [?1], [?2], and so on), and it knows what 154 | type of evidence is needed at each hole. *) 155 | 156 | (** 157 | Each of the holes corresponds to a subgoal, and the proof is 158 | finished when there are no more subgoals. At this point, the 159 | [Theorem] command gives a name to the evidence we've built and 160 | stores it in the global context. *) 161 | 162 | (** Tactic proofs are useful and convenient, but they are not 163 | essential: in principle, we can always construct the required 164 | evidence by hand, as shown above. Then we can use [Definition] 165 | (rather than [Theorem]) to give a global name directly to a 166 | piece of evidence. *) 167 | 168 | Definition eight_is_beautiful''' : beautiful 8 := 169 | b_sum 3 5 b_3 b_5. 170 | 171 | (** All these different ways of building the proof lead to exactly the 172 | same evidence being saved in the global environment. *) 173 | 174 | Print eight_is_beautiful. 175 | (* ===> eight_is_beautiful = b_sum 3 5 b_3 b_5 : beautiful 8 *) 176 | Print eight_is_beautiful'. 177 | (* ===> eight_is_beautiful' = b_sum 3 5 b_3 b_5 : beautiful 8 *) 178 | Print eight_is_beautiful''. 179 | (* ===> eight_is_beautiful'' = b_sum 3 5 b_3 b_5 : beautiful 8 *) 180 | Print eight_is_beautiful'''. 181 | (* ===> eight_is_beautiful''' = b_sum 3 5 b_3 b_5 : beautiful 8 *) 182 | 183 | (** **** Exercise: 1 star (six_is_beautiful) *) 184 | (** Give a tactic proof and a proof object showing that [6] is [beautiful]. *) 185 | 186 | Theorem six_is_beautiful : 187 | beautiful 6. 188 | Proof. 189 | apply (b_sum 3 3 b_3 b_3). 190 | Qed. 191 | 192 | Definition six_is_beautiful' : beautiful 6 := 193 | b_sum 3 3 b_3 b_3. 194 | (** [] *) 195 | 196 | (** **** Exercise: 1 star (nine_is_beautiful) *) 197 | (** Give a tactic proof and a proof object showing that [9] is [beautiful]. *) 198 | 199 | Theorem nine_is_beautiful : 200 | beautiful 9. 201 | Proof. 202 | apply (b_sum 3 6 b_3 six_is_beautiful). 203 | Qed. 204 | 205 | Definition nine_is_beautiful' : beautiful 9 := 206 | b_sum 3 6 b_3 six_is_beautiful. 207 | (** [] *) 208 | 209 | (* ##################################################### *) 210 | (** * Quantification, Implications and Functions *) 211 | 212 | (** In Coq's computational universe (where we've mostly been living 213 | until this chapter), there are two sorts of values with arrows in 214 | their types: _constructors_ introduced by [Inductive]-ly defined 215 | data types, and _functions_. 216 | 217 | Similarly, in Coq's logical universe, there are two ways of giving 218 | evidence for an implication: constructors introduced by 219 | [Inductive]-ly defined propositions, and... functions! 220 | 221 | For example, consider this statement: *) 222 | 223 | Theorem b_plus3: forall n, beautiful n -> beautiful (3+n). 224 | Proof. 225 | intros n H. 226 | apply b_sum. 227 | apply b_3. 228 | apply H. 229 | Qed. 230 | 231 | (** What is the proof object corresponding to [b_plus3]? 232 | 233 | We're looking for an expression whose _type_ is [forall n, 234 | beautiful n -> beautiful (3+n)] -- that is, a _function_ that 235 | takes two arguments (one number and a piece of evidence) and 236 | returns a piece of evidence! Here it is: *) 237 | 238 | Definition b_plus3' : forall n, beautiful n -> beautiful (3+n) := 239 | fun (n : nat) => fun (H : beautiful n) => 240 | b_sum 3 n b_3 H. 241 | 242 | Check b_plus3'. 243 | (* ===> b_plus3' : forall n : nat, beautiful n -> beautiful (3+n) *) 244 | 245 | (** Recall that [fun n => blah] means "the function that, given [n], 246 | yields [blah]." Another equivalent way to write this definition is: *) 247 | 248 | Definition b_plus3'' (n : nat) (H : beautiful n) : beautiful (3+n) := 249 | b_sum 3 n b_3 H. 250 | 251 | Check b_plus3''. 252 | (* ===> b_plus3'' : forall n, beautiful n -> beautiful (3+n) *) 253 | 254 | (** When we view the proposition being proved by [b_plus3] as a function type, 255 | one aspect of it may seem a little unusual. The second argument's 256 | type, [beautiful n], mentions the _value_ of the first argument, [n]. 257 | While such _dependent types_ are not commonly found in programming 258 | languages, even functional ones like ML or Haskell, they can 259 | be useful there too. 260 | 261 | Notice that both implication ([->]) and quantification ([forall]) 262 | correspond to functions on evidence. In fact, they are really the 263 | same thing: [->] is just a shorthand for a degenerate use of 264 | [forall] where there is no dependency, i.e., no need to give a name 265 | to the type on the LHS of the arrow. *) 266 | 267 | (** For example, consider this proposition: *) 268 | 269 | Definition beautiful_plus3 : Prop := 270 | forall n, forall (E : beautiful n), beautiful (n+3). 271 | 272 | (** A proof term inhabiting this proposition would be a function 273 | with two arguments: a number [n] and some evidence [E] that [n] is 274 | beautiful. But the name [E] for this evidence is not used in the 275 | rest of the statement of [funny_prop1], so it's a bit silly to 276 | bother making up a name for it. We could write it like this 277 | instead, using the dummy identifier [_] in place of a real 278 | name: *) 279 | 280 | Definition beautiful_plus3' : Prop := 281 | forall n, forall (_ : beautiful n), beautiful (n+3). 282 | 283 | (** Or, equivalently, we can write it in more familiar notation: *) 284 | 285 | Definition beatiful_plus3'' : Prop := 286 | forall n, beautiful n -> beautiful (n+3). 287 | 288 | (** In general, "[P -> Q]" is just syntactic sugar for 289 | "[forall (_:P), Q]". *) 290 | 291 | 292 | (** **** Exercise: 2 stars b_times2 *) 293 | 294 | (** Give a proof object corresponding to the theorem [b_times2] from Prop.v *) 295 | Definition b_times2': forall n, beautiful n -> beautiful (2*n) := 296 | fun n => fun h => b_times2 n h. 297 | (** [] *) 298 | 299 | 300 | 301 | (** **** Exercise: 2 stars, optional (gorgeous_plus13_po) *) 302 | (** Give a proof object corresponding to the theorem [gorgeous_plus13] from Prop.v *) 303 | 304 | Definition gorgeous_plus13_po: forall n, gorgeous n -> gorgeous (13+n):= 305 | fun n => fun h => gorgeous_plus13 n h. 306 | (** [] *) 307 | 308 | 309 | 310 | 311 | (** It is particularly revealing to look at proof objects involving the 312 | logical connectives that we defined with inductive propositions in Logic.v. *) 313 | 314 | Theorem and_example : 315 | (beautiful 0) /\ (beautiful 3). 316 | Proof. 317 | apply conj. 318 | (* Case "left". *) apply b_0. 319 | (* Case "right". *) apply b_3. Qed. 320 | 321 | (** Let's take a look at the proof object for the above theorem. *) 322 | 323 | Print and_example. 324 | (* ===> conj (beautiful 0) (beautiful 3) b_0 b_3 325 | : beautiful 0 /\ beautiful 3 *) 326 | 327 | (** Note that the proof is of the form 328 | conj (beautiful 0) (beautiful 3) 329 | (...pf of beautiful 3...) (...pf of beautiful 3...) 330 | as you'd expect, given the type of [conj]. *) 331 | 332 | (** **** Exercise: 1 star, optional (case_proof_objects) *) 333 | (** The [Case] tactics were commented out in the proof of 334 | [and_example] to avoid cluttering the proof object. What would 335 | you guess the proof object will look like if we uncomment them? 336 | Try it and see. *) 337 | (** [] *) 338 | 339 | Theorem and_commut : forall P Q : Prop, 340 | P /\ Q -> Q /\ P. 341 | Proof. 342 | intros P Q H. 343 | inversion H as [HP HQ]. 344 | split. 345 | Case "left". apply HQ. 346 | Case "right". apply HP. Qed. 347 | 348 | (** Once again, we have commented out the [Case] tactics to make the 349 | proof object for this theorem easier to understand. It is still 350 | a little complicated, but after performing some simple reduction 351 | steps, we can see that all that is really happening is taking apart 352 | a record containing evidence for [P] and [Q] and rebuilding it in the 353 | opposite order: *) 354 | 355 | Print and_commut. 356 | (* ===> 357 | and_commut = 358 | fun (P Q : Prop) (H : P /\ Q) => 359 | (fun H0 : Q /\ P => H0) 360 | match H with 361 | | conj HP HQ => (fun (HP0 : P) (HQ0 : Q) => conj Q P HQ0 HP0) HP HQ 362 | end 363 | : forall P Q : Prop, P /\ Q -> Q /\ P *) 364 | 365 | (** After simplifying some direct application of [fun] expressions to arguments, 366 | we get: *) 367 | 368 | (* ===> 369 | and_commut = 370 | fun (P Q : Prop) (H : P /\ Q) => 371 | match H with 372 | | conj HP HQ => conj Q P HQ HP 373 | end 374 | : forall P Q : Prop, P /\ Q -> Q /\ P *) 375 | 376 | 377 | 378 | (** **** Exercise: 2 stars, optional (conj_fact) *) 379 | (** Construct a proof object demonstrating the following proposition. *) 380 | 381 | Definition conj_fact : forall P Q R, P /\ Q -> Q /\ R -> P /\ R := 382 | fun P Q R H1 H2 => 383 | match H1 with 384 | | conj HP HQ => match H2 with 385 | | conj HQ HR => 386 | conj P R HP HR 387 | end 388 | end. 389 | (** [] *) 390 | 391 | 392 | 393 | (** **** Exercise: 2 stars, advanced, optional (beautiful_iff_gorgeous) *) 394 | 395 | (** We have seen that the families of propositions [beautiful] and 396 | [gorgeous] actually characterize the same set of numbers. 397 | Prove that [beautiful n <-> gorgeous n] for all [n]. Just for 398 | fun, write your proof as an explicit proof object, rather than 399 | using tactics. (_Hint_: if you make use of previously defined 400 | theorems, you should only need a single line!) *) 401 | 402 | Definition beautiful_iff_gorgeous : 403 | forall n, beautiful n <-> gorgeous n := 404 | fun n => conj (beautiful n -> gorgeous n) (gorgeous n -> beautiful n) (beautiful__gorgeous n) (gorgeous__beautiful n). 405 | (** [] *) 406 | 407 | 408 | (** **** Exercise: 2 stars, optional (or_commut'') *) 409 | (** Try to write down an explicit proof object for [or_commut] (without 410 | using [Print] to peek at the ones we already defined!). *) 411 | 412 | Definition or_commut : forall (P Q:Prop), P \/ Q -> Q \/ P := 413 | fun P Q H => match H with 414 | | or_introl P0 => or_intror Q P P0 415 | | or_intror Q0 => or_introl Q P Q0 416 | end. 417 | (** [] *) 418 | 419 | (** Recall that we model an existential for a property as a pair consisting of 420 | a witness value and a proof that the witness obeys that property. 421 | We can choose to construct the proof explicitly. 422 | 423 | For example, consider this existentially quantified proposition: *) 424 | Check ex. 425 | 426 | Definition some_nat_is_even : Prop := 427 | ex _ ev. 428 | 429 | (** To prove this proposition, we need to choose a particular number 430 | as witness -- say, 4 -- and give some evidence that that number is 431 | even. *) 432 | 433 | Definition snie : some_nat_is_even := 434 | ex_intro _ ev 4 (ev_SS 2 (ev_SS 0 ev_0)). 435 | 436 | 437 | (** **** Exercise: 2 stars, optional (ex_beautiful_Sn) *) 438 | (** Complete the definition of the following proof object: *) 439 | 440 | Definition p : ex _ (fun n => beautiful (S n)) := 441 | ex_intro _ (fun n => beautiful (S n)) 2 b_3. 442 | (** [] *) 443 | 444 | 445 | 446 | (* ##################################################### *) 447 | (** * Giving Explicit Arguments to Lemmas and Hypotheses *) 448 | 449 | (** Even when we are using tactic-based proof, it can be very useful to 450 | understand the underlying functional nature of implications and quantification. 451 | 452 | For example, it is often convenient to [apply] or [rewrite] 453 | using a lemma or hypothesis with one or more quantifiers or 454 | assumptions already instantiated in order to direct what 455 | happens. For example: *) 456 | 457 | Check plus_comm. 458 | (* ==> 459 | plus_comm 460 | : forall n m : nat, n + m = m + n *) 461 | 462 | Lemma plus_comm_r : forall a b c, c + (b + a) = c + (a + b). 463 | Proof. 464 | intros a b c. 465 | (* rewrite plus_comm. *) 466 | (* rewrites in the first possible spot; not what we want *) 467 | rewrite (plus_comm b a). (* directs rewriting to the right spot *) 468 | reflexivity. Qed. 469 | 470 | 471 | (** In this case, giving just one argument would be sufficient. *) 472 | 473 | Lemma plus_comm_r' : forall a b c, c + (b + a) = c + (a + b). 474 | Proof. 475 | intros a b c. 476 | rewrite (plus_comm b). 477 | reflexivity. Qed. 478 | 479 | (** Arguments must be given in order, but wildcards (_) 480 | may be used to skip arguments that Coq can infer. *) 481 | 482 | Lemma plus_comm_r'' : forall a b c, c + (b + a) = c + (a + b). 483 | Proof. 484 | intros a b c. 485 | rewrite (plus_comm _ a). 486 | reflexivity. Qed. 487 | 488 | (** The author of a lemma can choose to declare easily inferable arguments 489 | to be implicit, just as with functions and constructors. 490 | 491 | The [with] clauses we've already seen is really just a way of 492 | specifying selected arguments by name rather than position: *) 493 | 494 | Lemma plus_comm_r''' : forall a b c, c + (b + a) = c + (a + b). 495 | Proof. 496 | intros a b c. 497 | rewrite plus_comm with (n := b). 498 | reflexivity. Qed. 499 | 500 | 501 | (** **** Exercise: 2 stars (trans_eq_example_redux) *) 502 | (** Redo the proof of the following theorem (from MoreCoq.v) using 503 | an [apply] of [trans_eq] but _not_ using a [with] clause. *) 504 | 505 | Example trans_eq_example' : forall (a b c d e f : nat), 506 | [a;b] = [c;d] -> 507 | [c;d] = [e;f] -> 508 | [a;b] = [e;f]. 509 | Proof. 510 | intros. 511 | apply (trans_eq (list nat) [a; b] [c; d] [e; f]). 512 | apply H. apply H0. 513 | Qed. 514 | (** [] *) 515 | 516 | 517 | 518 | (* ##################################################### *) 519 | (** * Programming with Tactics (Advanced) *) 520 | 521 | (** If we can build proofs with explicit terms rather than tactics, 522 | you may be wondering if we can build programs using tactics rather 523 | than explicit terms. Sure! *) 524 | 525 | Definition add1 : nat -> nat. 526 | intro n. 527 | Show Proof. 528 | apply S. 529 | Show Proof. 530 | apply n. Defined. 531 | 532 | Print add1. 533 | (* ==> 534 | add1 = fun n : nat => S n 535 | : nat -> nat 536 | *) 537 | 538 | Eval compute in add1 2. 539 | 540 | Definition add1' (n:nat) :nat. 541 | Show Proof. 542 | apply S. 543 | Show Proof. 544 | apply n. Defined. 545 | 546 | (* ==> 3 : nat *) 547 | 548 | (** Notice that we terminate the [Definition] with a [.] rather than with 549 | [:=] followed by a term. This tells Coq to enter proof scripting mode 550 | to build an object of type [nat -> nat]. Also, we terminate the proof 551 | with [Defined] rather than [Qed]; this makes the definition _transparent_ 552 | so that it can be used in computation like a normally-defined function. 553 | 554 | This feature is mainly useful for writing functions with dependent types, 555 | which we won't explore much further in this book. 556 | But it does illustrate the uniformity and orthogonality of the basic ideas in Coq. *) 557 | 558 | (** $Date: 2014-12-31 15:31:47 -0500 (Wed, 31 Dec 2014) $ *) 559 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Software-Foundations-Solutions 2 | -------------------------------------------------------------------------------- /Rel.v: -------------------------------------------------------------------------------- 1 | (** * Rel: Properties of Relations *) 2 | 3 | Require Export SfLib. 4 | 5 | (** This short, optional chapter develops some basic definitions and a 6 | few theorems about binary relations in Coq. The key definitions 7 | are repeated where they are actually used (in the [Smallstep] 8 | chapter), so readers who are already comfortable with these ideas 9 | can safely skim or skip this chapter. However, relations are also 10 | a good source of exercises for developing facility with Coq's 11 | basic reasoning facilities, so it may be useful to look at it just 12 | after the [Logic] chapter. *) 13 | 14 | (** A (binary) _relation_ on a set [X] is a family of propositions 15 | parameterized by two elements of [X] -- i.e., a proposition about 16 | pairs of elements of [X]. *) 17 | 18 | Definition relation (X: Type) := X -> X -> Prop. 19 | 20 | (** Somewhat confusingly, the Coq standard library hijacks the generic 21 | term "relation" for this specific instance. To maintain 22 | consistency with the library, we will do the same. So, henceforth 23 | the Coq identifier [relation] will always refer to a binary 24 | relation between some set and itself, while the English word 25 | "relation" can refer either to the specific Coq concept or the 26 | more general concept of a relation between any number of possibly 27 | different sets. The context of the discussion should always make 28 | clear which is meant. *) 29 | 30 | (** An example relation on [nat] is [le], the less-that-or-equal-to 31 | relation which we usually write like this [n1 <= n2]. *) 32 | 33 | Print le. 34 | (* ====> Inductive le (n : nat) : nat -> Prop := 35 | le_n : n <= n 36 | | le_S : forall m : nat, n <= m -> n <= S m *) 37 | Check le : nat -> nat -> Prop. 38 | Check le : relation nat. 39 | 40 | (* ######################################################### *) 41 | (** * Basic Properties of Relations *) 42 | 43 | (** As anyone knows who has taken an undergraduate discrete math 44 | course, there is a lot to be said about relations in general -- 45 | ways of classifying relations (are they reflexive, transitive, 46 | etc.), theorems that can be proved generically about classes of 47 | relations, constructions that build one relation from another, 48 | etc. For example... *) 49 | 50 | (** A relation [R] on a set [X] is a _partial function_ if, for every 51 | [x], there is at most one [y] such that [R x y] -- i.e., if [R x 52 | y1] and [R x y2] together imply [y1 = y2]. *) 53 | 54 | Definition partial_function {X: Type} (R: relation X) := 55 | forall x y1 y2 : X, R x y1 -> R x y2 -> y1 = y2. 56 | 57 | (** For example, the [next_nat] relation defined earlier is a partial 58 | function. *) 59 | 60 | Print next_nat. 61 | (* ====> Inductive next_nat (n : nat) : nat -> Prop := 62 | nn : next_nat n (S n) *) 63 | Check next_nat : relation nat. 64 | 65 | Theorem next_nat_partial_function : 66 | partial_function next_nat. 67 | Proof. 68 | unfold partial_function. 69 | intros x y1 y2 H1 H2. 70 | inversion H1. inversion H2. 71 | reflexivity. Qed. 72 | 73 | (** However, the [<=] relation on numbers is not a partial function. 74 | In short: Assume, for a contradiction, that [<=] is a partial 75 | function. But then, since [0 <= 0] and [0 <= 1], it follows that 76 | [0 = 1]. This is nonsense, so our assumption was 77 | contradictory. *) 78 | 79 | Theorem le_not_a_partial_function : 80 | ~ (partial_function le). 81 | Proof. 82 | unfold not. unfold partial_function. intros Hc. 83 | assert (0 = 1) as Nonsense. 84 | Case "Proof of assertion". 85 | apply Hc with (x := 0). 86 | apply le_n. 87 | apply le_S. apply le_n. 88 | inversion Nonsense. Qed. 89 | 90 | (** **** Exercise: 2 stars, optional *) 91 | (** Show that the [total_relation] defined in earlier is not a partial 92 | function. *) 93 | 94 | Print total_relation. 95 | Theorem total_relation_not_a_partial_function : 96 | ~ (partial_function total_relation). 97 | Proof. 98 | unfold not. unfold partial_function. intros. 99 | assert (0 = 1) as Nonsense. 100 | apply H with 0. apply tot. apply tot. 101 | inversion Nonsense. 102 | Qed. 103 | (** [] *) 104 | 105 | (** **** Exercise: 2 stars, optional *) 106 | (** Show that the [empty_relation] defined earlier is a partial 107 | function. *) 108 | 109 | Print empty_relation. 110 | Theorem empty_relation_is_a_partial_function : 111 | partial_function empty_relation. 112 | Proof. 113 | unfold partial_function. intros. 114 | inversion H. 115 | Qed. 116 | (** [] *) 117 | 118 | (** A _reflexive_ relation on a set [X] is one for which every element 119 | of [X] is related to itself. *) 120 | 121 | Definition reflexive {X: Type} (R: relation X) := 122 | forall a : X, R a a. 123 | 124 | Theorem le_reflexive : 125 | reflexive le. 126 | Proof. 127 | unfold reflexive. intros n. apply le_n. Qed. 128 | 129 | (** A relation [R] is _transitive_ if [R a c] holds whenever [R a b] 130 | and [R b c] do. *) 131 | 132 | Definition transitive {X: Type} (R: relation X) := 133 | forall a b c : X, (R a b) -> (R b c) -> (R a c). 134 | 135 | Theorem le_trans : 136 | transitive le. 137 | Proof. 138 | intros n m o Hnm Hmo. 139 | induction Hmo. 140 | Case "le_n". apply Hnm. 141 | Case "le_S". apply le_S. apply IHHmo. Qed. 142 | 143 | Theorem lt_trans: 144 | transitive lt. 145 | Proof. 146 | unfold lt. unfold transitive. 147 | intros n m o Hnm Hmo. 148 | apply le_S in Hnm. 149 | apply le_trans with (a := (S n)) (b := (S m)) (c := o). 150 | apply Hnm. 151 | apply Hmo. Qed. 152 | 153 | (** **** Exercise: 2 stars, optional *) 154 | (** We can also prove [lt_trans] more laboriously by induction, 155 | without using le_trans. Do this.*) 156 | 157 | Theorem lt_trans' : 158 | transitive lt. 159 | Proof. 160 | (* Prove this by induction on evidence that [m] is less than [o]. *) 161 | unfold lt. unfold transitive. 162 | intros n m o Hnm Hmo. 163 | induction Hmo as [| m' Hm'o]. 164 | apply le_S. apply Hnm. apply le_S. apply IHHm'o. 165 | Qed. 166 | (** [] *) 167 | 168 | (** **** Exercise: 2 stars, optional *) 169 | (** Prove the same thing again by induction on [o]. *) 170 | 171 | Theorem lt_trans'' : 172 | transitive lt. 173 | Proof. 174 | unfold lt. unfold transitive. 175 | intros n m o Hnm Hmo. 176 | induction o as [| o']. 177 | inversion Hmo. apply le_S. inversion Hmo. rewrite <- H0. 178 | apply Hnm. apply IHo'. apply H0. 179 | Qed. 180 | (** [] *) 181 | 182 | (** The transitivity of [le], in turn, can be used to prove some facts 183 | that will be useful later (e.g., for the proof of antisymmetry 184 | below)... *) 185 | 186 | Theorem le_Sn_le : forall n m, S n <= m -> n <= m. 187 | Proof. 188 | intros n m H. apply le_trans with (S n). 189 | apply le_S. apply le_n. 190 | apply H. Qed. 191 | 192 | (** **** Exercise: 1 star, optional *) 193 | Theorem le_S_n : forall n m, 194 | (S n <= S m) -> (n <= m). 195 | Proof. 196 | intros. inversion H. reflexivity. 197 | apply le_trans with (S n). apply le_S. apply le_n. 198 | apply H1. 199 | Qed. 200 | (** [] *) 201 | 202 | (** **** Exercise: 2 stars, optional (le_Sn_n_inf) *) 203 | (** Provide an informal proof of the following theorem: 204 | 205 | Theorem: For every [n], [~(S n <= n)] 206 | 207 | A formal proof of this is an optional exercise below, but try 208 | the informal proof without doing the formal proof first. 209 | 210 | Proof: 211 | ... 212 | [] 213 | *) 214 | 215 | (** **** Exercise: 1 star, optional *) 216 | Theorem le_Sn_n : forall n, 217 | ~ (S n <= n). 218 | Proof. 219 | unfold not. intros. 220 | induction n. inversion H. apply IHn. 221 | inversion H. apply H. apply le_trans with (S (S n)). 222 | apply le_S. apply le_n. apply H1. 223 | Qed. 224 | (** [] *) 225 | 226 | (** Reflexivity and transitivity are the main concepts we'll need for 227 | later chapters, but, for a bit of additional practice working with 228 | relations in Coq, here are a few more common ones. 229 | 230 | A relation [R] is _symmetric_ if [R a b] implies [R b a]. *) 231 | 232 | Definition symmetric {X: Type} (R: relation X) := 233 | forall a b : X, (R a b) -> (R b a). 234 | 235 | (** **** Exercise: 2 stars, optional *) 236 | Theorem le_not_symmetric : 237 | ~ (symmetric le). 238 | Proof. 239 | unfold not. unfold symmetric. 240 | intros. 241 | assert (1 <= 0). 242 | apply H. apply le_S. apply le_n. 243 | inversion H0. 244 | Qed. 245 | (** [] *) 246 | 247 | (** A relation [R] is _antisymmetric_ if [R a b] and [R b a] together 248 | imply [a = b] -- that is, if the only "cycles" in [R] are trivial 249 | ones. *) 250 | 251 | Definition antisymmetric {X: Type} (R: relation X) := 252 | forall a b : X, (R a b) -> (R b a) -> a = b. 253 | 254 | (** **** Exercise: 2 stars, optional *) 255 | Theorem le_antisymmetric : 256 | antisymmetric le. 257 | Proof. 258 | unfold antisymmetric. 259 | intros a. induction a. 260 | intros. inversion H. reflexivity. rewrite <- H2 in H0. inversion H0. 261 | intros. destruct b. inversion H. apply f_equal. 262 | apply IHa. apply le_S_n. apply H. apply le_S_n. apply H0. 263 | Qed. 264 | (** [] *) 265 | 266 | (** **** Exercise: 2 stars, optional *) 267 | Theorem le_step : forall n m p, 268 | n < m -> 269 | m <= S p -> 270 | n <= p. 271 | Proof. 272 | unfold lt. 273 | intros. 274 | apply le_S_n. apply le_trans with m. 275 | apply H. apply H0. 276 | Qed. 277 | (** [] *) 278 | 279 | (** A relation is an _equivalence_ if it's reflexive, symmetric, and 280 | transitive. *) 281 | 282 | Definition equivalence {X:Type} (R: relation X) := 283 | (reflexive R) /\ (symmetric R) /\ (transitive R). 284 | 285 | (** A relation is a _partial order_ when it's reflexive, 286 | _anti_-symmetric, and transitive. In the Coq standard library 287 | it's called just "order" for short. *) 288 | 289 | Definition order {X:Type} (R: relation X) := 290 | (reflexive R) /\ (antisymmetric R) /\ (transitive R). 291 | 292 | (** A preorder is almost like a partial order, but doesn't have to be 293 | antisymmetric. *) 294 | 295 | Definition preorder {X:Type} (R: relation X) := 296 | (reflexive R) /\ (transitive R). 297 | 298 | Theorem le_order : 299 | order le. 300 | Proof. 301 | unfold order. split. 302 | Case "refl". apply le_reflexive. 303 | split. 304 | Case "antisym". apply le_antisymmetric. 305 | Case "transitive.". apply le_trans. Qed. 306 | 307 | (* ########################################################### *) 308 | (** * Reflexive, Transitive Closure *) 309 | 310 | (** The _reflexive, transitive closure_ of a relation [R] is the 311 | smallest relation that contains [R] and that is both reflexive and 312 | transitive. Formally, it is defined like this in the Relations 313 | module of the Coq standard library: *) 314 | 315 | Inductive clos_refl_trans {A: Type} (R: relation A) : relation A := 316 | | rt_step : forall x y, R x y -> clos_refl_trans R x y 317 | | rt_refl : forall x, clos_refl_trans R x x 318 | | rt_trans : forall x y z, 319 | clos_refl_trans R x y -> 320 | clos_refl_trans R y z -> 321 | clos_refl_trans R x z. 322 | 323 | (** For example, the reflexive and transitive closure of the 324 | [next_nat] relation coincides with the [le] relation. *) 325 | 326 | Theorem next_nat_closure_is_le : forall n m, 327 | (n <= m) <-> ((clos_refl_trans next_nat) n m). 328 | Proof. 329 | intros n m. split. 330 | Case "->". 331 | intro H. induction H. 332 | SCase "le_n". apply rt_refl. 333 | SCase "le_S". 334 | apply rt_trans with m. apply IHle. apply rt_step. apply nn. 335 | Case "<-". 336 | intro H. induction H. 337 | SCase "rt_step". inversion H. apply le_S. apply le_n. 338 | SCase "rt_refl". apply le_n. 339 | SCase "rt_trans". 340 | apply le_trans with y. 341 | apply IHclos_refl_trans1. 342 | apply IHclos_refl_trans2. Qed. 343 | 344 | (** The above definition of reflexive, transitive closure is 345 | natural -- it says, explicitly, that the reflexive and transitive 346 | closure of [R] is the least relation that includes [R] and that is 347 | closed under rules of reflexivity and transitivity. But it turns 348 | out that this definition is not very convenient for doing 349 | proofs -- the "nondeterminism" of the [rt_trans] rule can sometimes 350 | lead to tricky inductions. 351 | 352 | Here is a more useful definition... *) 353 | 354 | Inductive refl_step_closure {X:Type} (R: relation X) : relation X := 355 | | rsc_refl : forall (x : X), refl_step_closure R x x 356 | | rsc_step : forall (x y z : X), 357 | R x y -> 358 | refl_step_closure R y z -> 359 | refl_step_closure R x z. 360 | 361 | (** (Note that, aside from the naming of the constructors, this 362 | definition is the same as the [multi] step relation used in many 363 | other chapters.) *) 364 | 365 | (** (The following [Tactic Notation] definitions are explained in 366 | another chapter. You can ignore them if you haven't read the 367 | explanation yet.) *) 368 | 369 | Tactic Notation "rt_cases" tactic(first) ident(c) := 370 | first; 371 | [ Case_aux c "rt_step" | Case_aux c "rt_refl" 372 | | Case_aux c "rt_trans" ]. 373 | 374 | Tactic Notation "rsc_cases" tactic(first) ident(c) := 375 | first; 376 | [ Case_aux c "rsc_refl" | Case_aux c "rsc_step" ]. 377 | 378 | (** Our new definition of reflexive, transitive closure "bundles" 379 | the [rt_step] and [rt_trans] rules into the single rule step. 380 | The left-hand premise of this step is a single use of [R], 381 | leading to a much simpler induction principle. 382 | 383 | Before we go on, we should check that the two definitions do 384 | indeed define the same relation... 385 | 386 | First, we prove two lemmas showing that [refl_step_closure] mimics 387 | the behavior of the two "missing" [clos_refl_trans] 388 | constructors. *) 389 | 390 | Theorem rsc_R : forall (X:Type) (R:relation X) (x y : X), 391 | R x y -> refl_step_closure R x y. 392 | Proof. 393 | intros X R x y H. 394 | apply rsc_step with y. apply H. apply rsc_refl. Qed. 395 | 396 | (** **** Exercise: 2 stars, optional (rsc_trans) *) 397 | Theorem rsc_trans : 398 | forall (X:Type) (R: relation X) (x y z : X), 399 | refl_step_closure R x y -> 400 | refl_step_closure R y z -> 401 | refl_step_closure R x z. 402 | Proof. 403 | intros. induction H. apply H0. 404 | apply rsc_step with y. apply H. apply IHrefl_step_closure. 405 | apply H0. 406 | Qed. 407 | (** [] *) 408 | 409 | (** Then we use these facts to prove that the two definitions of 410 | reflexive, transitive closure do indeed define the same 411 | relation. *) 412 | 413 | (** **** Exercise: 3 stars, optional (rtc_rsc_coincide) *) 414 | Theorem rtc_rsc_coincide : 415 | forall (X:Type) (R: relation X) (x y : X), 416 | clos_refl_trans R x y <-> refl_step_closure R x y. 417 | Proof. 418 | split. 419 | Case "clos_refl -> refl_step". 420 | intros. induction H. apply rsc_R. apply H. 421 | apply rsc_refl. apply rsc_trans with y. apply IHclos_refl_trans1. 422 | apply IHclos_refl_trans2. 423 | Case "refl_step -> clos_refl". 424 | intros. induction H. apply rt_refl. 425 | apply rt_trans with y. apply rt_step. apply H. apply IHrefl_step_closure. 426 | Qed. 427 | (** [] *) 428 | 429 | (** $Date: 2014-12-31 15:31:47 -0500 (Wed, 31 Dec 2014) $ *) 430 | -------------------------------------------------------------------------------- /SepLogic.v: -------------------------------------------------------------------------------- 1 | Require Export Imp. 2 | 3 | (* First we define syntax of the language *) 4 | 5 | (* We could reuse aexp and bexp defined for Imp. *) 6 | 7 | (* Redefine commands here. To distinguish them 8 | from Imp commands, we call them scom *) 9 | (* You need to change it into an inductive definition *) 10 | Inductive scom : Type := 11 | | SCSkip : scom 12 | | SCAss : id -> aexp -> scom 13 | | SCSeq : scom -> scom -> scom 14 | | SCIf : bexp -> scom -> scom -> scom 15 | | SCWhile : bexp -> scom -> scom 16 | | SCCons : id -> aexp -> aexp -> scom 17 | | SCLookup : id -> aexp -> scom 18 | | SCMutation : aexp -> aexp -> scom 19 | | SCDispose : aexp -> scom. 20 | 21 | (* Program states, which is called sstate *) 22 | Definition store := id -> nat. 23 | 24 | (* if heap maps a natural number (address) to 25 | None, we say the address is not a valid address, 26 | or it is not in the domain of the heap *) 27 | Definition heap := nat -> option nat. 28 | 29 | Axiom finite_heap : forall h: heap, exists n: nat, 30 | forall n' v: nat, h n' = Some v -> n' < n. 31 | 32 | Axiom functional_extensionality : forall {X Y: Type} {f g : X -> Y}, 33 | (forall (x: X), f x = g x) -> f = g. 34 | 35 | (* Define an empty heap, which contains no memory cells *) 36 | Definition emp_heap : heap := 37 | fun (l: nat) => None. 38 | 39 | Definition in_dom (l: nat) (h: heap) : Prop := 40 | exists n, h l = Some n. 41 | 42 | Definition not_in_dom (l: nat) (h: heap) : Prop := 43 | h l = None. 44 | 45 | Theorem in_not_in_dec : 46 | forall l h, {in_dom l h} + {not_in_dom l h}. 47 | Proof. 48 | intros l h. unfold in_dom. unfold not_in_dom. 49 | destruct (h l). 50 | left. exists n. auto. 51 | right. auto. 52 | Defined. 53 | 54 | (* h1 and h2 have disjoint domain *) 55 | Definition disjoint (h1 h2: heap) : Prop := 56 | forall l, not_in_dom l h1 \/ not_in_dom l h2. 57 | 58 | (* union of two heaps *) 59 | Definition h_union (h1 h2: heap) : heap := 60 | fun l => 61 | if (in_not_in_dec l h1) then h1 l else h2 l. 62 | 63 | (* h1 is a subset of h2 *) 64 | Definition h_subset (h1 h2: heap) : Prop := 65 | forall l n, h1 l = Some n -> h2 l = Some n. 66 | 67 | (* store update *) 68 | Definition st_update (s: store) (x: id) (n: nat) : store := 69 | fun x' => if eq_id_dec x x' then n else s x'. 70 | 71 | (* heap update *) 72 | Definition h_update (h: heap) (l: nat) (n: nat) : heap := 73 | fun l' => if eq_nat_dec l l' then Some n else h l'. 74 | 75 | Definition sstate := (store * heap) %type. 76 | 77 | (* since program may abort, we extend our state 78 | definition to add a special state Abt *) 79 | Inductive ext_state : Type := 80 | St: sstate -> ext_state (* normal state *) 81 | | Abt: ext_state. (* abort *) 82 | 83 | 84 | (* Next we define the operational semantics *) 85 | 86 | (* big-step semantics. You should change it into 87 | an inductive definition *) 88 | Inductive big_step: 89 | scom * sstate -> ext_state -> Prop := 90 | | SE_Skip : forall sst, 91 | big_step (SCSkip, sst) (St sst) 92 | | SE_Ass : forall st h a1 n x, 93 | aeval st a1 = n -> 94 | big_step (SCAss x a1, (st, h)) (St (st_update st x n, h)) 95 | | SE_Seq : forall c1 c2 sst sst' est, 96 | big_step (c1, sst) (St sst') -> 97 | big_step (c2, sst') est -> 98 | big_step (SCSeq c1 c2, sst) est 99 | | SE_Seq_Ab : forall c1 c2 sst, 100 | big_step (c1, sst) Abt -> 101 | big_step (SCSeq c1 c2, sst) Abt 102 | | SE_IfTrue : forall st h b c1 c2 est, 103 | beval st b = true -> 104 | big_step (c1, (st, h)) est -> 105 | big_step (SCIf b c1 c2, (st, h)) est 106 | | SE_IfFalse : forall st h b c1 c2 est, 107 | beval st b = false -> 108 | big_step (c2, (st, h)) est -> 109 | big_step (SCIf b c1 c2, (st, h)) est 110 | | SE_WhileEnd : forall b st h c, 111 | beval st b = false -> 112 | big_step (SCWhile b c, (st, h)) (St (st, h)) 113 | | SE_WhileLoop : forall st h est b c, 114 | beval st b = true -> 115 | big_step (SCSeq c (SCWhile b c), (st, h)) est -> 116 | big_step (SCWhile b c, (st, h)) est 117 | | SE_Cons : forall st h a1 a2 n1 n2 x l, 118 | aeval st a1 = n1 -> 119 | aeval st a2 = n2 -> 120 | h l = None -> 121 | h (l + 1) = None -> 122 | big_step (SCCons x a1 a2, (st, h)) 123 | (St (st_update st x l, 124 | h_update (h_update h (l + 1) n2) l n1)) 125 | | SE_Lookup : forall st h x a1 n1 n2, 126 | aeval st a1 = n1 -> 127 | h n1 = Some n2 -> 128 | big_step (SCLookup x a1, (st, h)) (St (st_update st x n2, h)) 129 | | SE_Lookup_Ab : forall st a1 n1 h x, 130 | aeval st a1 = n1 -> 131 | h n1 = None -> 132 | big_step (SCLookup x a1, (st, h)) Abt 133 | | SE_Mutation : forall st h a1 a2 n1 n2, 134 | aeval st a1 = n1 -> 135 | aeval st a2 = n2 -> 136 | in_dom n1 h -> 137 | big_step (SCMutation a1 a2, (st, h)) (St (st, h_update h n1 n2)) 138 | | SE_Mutation_Ab : forall st h a1 a2 n1, 139 | aeval st a1 = n1 -> 140 | h n1 = None -> 141 | big_step (SCMutation a1 a2, (st, h)) Abt 142 | | SE_Dispose : forall st h a1 n1, 143 | aeval st a1 = n1 -> 144 | in_dom n1 h -> 145 | big_step 146 | (SCDispose a1, (st, h)) 147 | (St (st, fun x => if eq_nat_dec x n1 then None else h x)) 148 | | SE_Dispose_Ab : forall st h a1 n1, 149 | aeval st a1 = n1 -> 150 | h n1 = None -> 151 | big_step (SCDispose a1, (st, h)) Abt. 152 | 153 | (* small-step semantics. Should be inductive too *) 154 | Inductive small_step: 155 | scom * ext_state -> scom * ext_state -> Prop := 156 | | S_Ass : forall st h a n x, 157 | aeval st a = n -> 158 | small_step (SCAss x a, St (st, h)) 159 | (SCSkip, St (st_update st x n, h)) 160 | | S_SeqStep : forall c1 c1' est est' c2, 161 | small_step (c1, est) (c1', est') -> 162 | small_step (SCSeq c1 c2, est) (SCSeq c1' c2, est') 163 | | S_SeqFinish : forall c2 est, 164 | small_step (SCSeq SCSkip c2, est) (c2, est) 165 | | S_IfTrue : forall st h b c1 c2, 166 | beval st b = true -> 167 | small_step (SCIf b c1 c2, St (st, h)) (c1, St (st, h)) 168 | | S_IfFalse : forall st h b c1 c2, 169 | beval st b = false -> 170 | small_step (SCIf b c1 c2, St (st, h)) (c2, St (st, h)) 171 | | S_WhileEnd : forall st h b c, 172 | beval st b = false -> 173 | small_step (SCWhile b c, St (st, h)) (SCSkip, St (st, h)) 174 | | S_WhileLoop : forall st h b c, 175 | beval st b = true -> 176 | small_step (SCWhile b c, St (st, h)) 177 | (SCSeq c (SCWhile b c), St (st, h)) 178 | | S_Cons : forall st h x a1 a2 n1 n2 l, 179 | aeval st a1 = n1 -> 180 | aeval st a2 = n2 -> 181 | h l = None -> 182 | h (l + 1) = None -> 183 | small_step (SCCons x a1 a2, St (st, h)) 184 | (SCSkip, St (st_update st x l, 185 | h_update (h_update h l n1) 186 | (l + 1) n2)) 187 | | S_Lookup : forall st h x a1 n, 188 | h (aeval st a1) = Some n -> 189 | small_step (SCLookup x a1, St (st, h)) 190 | (SCSkip, St (st_update st x n, h)) 191 | | S_Lookup_Ab : forall st h x a1 n1, 192 | aeval st a1 = n1 -> 193 | h n1 = None -> 194 | small_step (SCLookup x a1, St (st, h)) 195 | (SCSkip, Abt) 196 | | S_Mutation : forall st h a1 a2 n1 n2, 197 | aeval st a1 = n1 -> 198 | aeval st a2 = n2 -> 199 | in_dom n1 h -> 200 | small_step (SCMutation a1 a2, St (st, h)) 201 | (SCSkip, St (st, h_update h n1 n2)) 202 | | S_Mutation_Ab : forall st h a1 a2 n1, 203 | aeval st a1 = n1 -> 204 | h n1 = None -> 205 | small_step (SCMutation a1 a2, St (st, h)) 206 | (SCSkip, Abt) 207 | | S_Dispose : forall st h a1 n1, 208 | aeval st a1 = n1 -> 209 | in_dom n1 h -> 210 | small_step 211 | (SCDispose a1, St (st, h)) 212 | (SCSkip, St 213 | (st, fun x => if eq_nat_dec x n1 then None else h x)) 214 | | S_Dispose_Ab : forall st h a1 n1, 215 | aeval st a1 = n1 -> 216 | h n1 = None -> 217 | small_step (SCDispose a1, St (st, h)) 218 | (SCSkip, Abt). 219 | 220 | Hint Constructors small_step. 221 | 222 | (** Assertions **) 223 | Definition sass := sstate -> Prop. 224 | 225 | (* define semantics of assertion emp *) 226 | Definition emp : sass := 227 | fun st: sstate => 228 | snd st = emp_heap. 229 | 230 | (* assertion e1 |-> e2 *) 231 | Definition pto (e1 e2: aexp) : sass := 232 | fun st: sstate => 233 | match st with 234 | | (s, h) => h = h_update emp_heap (aeval s e1) (aeval s e2) 235 | end. 236 | Notation "e1 '|->' e2" := (pto e1 e2) (at level 60). 237 | 238 | (* p * q *) 239 | Definition star (p q : sass) : sass := 240 | fun st: sstate => 241 | match st with 242 | | (s, h) => 243 | exists h1, exists h2, 244 | disjoint h1 h2 /\ h_union h1 h2 = h /\ p (s, h1) /\ q (s, h2) 245 | end. 246 | Notation "p '**' q" := (star p q) (at level 70). 247 | 248 | (* p --* q *) 249 | Definition simp (p q: sass) : sass := 250 | fun (st : sstate) => 251 | match st with 252 | | (s, h) => 253 | forall h', disjoint h' h -> p (s, h') -> q (s, h_union h h') 254 | end. 255 | Notation "p '--*' q" := (simp p q) (at level 80). 256 | 257 | 258 | Definition pure (p: sass) : Prop := 259 | forall s h1 h2, p (s, h1) -> p (s, h2). 260 | 261 | Definition precise (p: sass) : Prop := 262 | forall h h1 h2 s, 263 | h_subset h1 h 264 | -> h_subset h2 h 265 | -> p (s, h1) 266 | -> p (s, h2) 267 | -> h1 = h2. 268 | 269 | Definition intuitionistic (p: sass) : Prop := 270 | forall s h h', p (s, h) -> disjoint h h' -> p (s, h_union h h'). 271 | 272 | 273 | (* continue here *) 274 | 275 | Definition s_conj (p q: sass) : sass := 276 | fun (s: sstate) => p s /\ q s. 277 | Notation "p '//\\' q" := (s_conj p q) (at level 75). 278 | 279 | Definition s_disj (p q: sass) : sass := 280 | fun (s: sstate) => p s \/ q s. 281 | Notation "p '\\//' q" := (s_disj p q) (at level 78). 282 | 283 | Definition s_imp (p q: sass) : sass := 284 | fun (s: sstate) => p s -> q s. 285 | Notation "p '~~>' q" := (s_imp p q) (at level 85). 286 | 287 | Definition strongerThan (p q: sass) : Prop := 288 | forall s: sstate, s_imp p q s. 289 | Notation "p '==>' q" := (strongerThan p q) (at level 90). 290 | 291 | Definition spEquiv (p q: sass) : Prop := 292 | (p ==> q) /\ (q ==> p). 293 | Notation "p '<==>' q" := (spEquiv p q) (at level 90). 294 | 295 | (* Prove the following lemmas *) 296 | Lemma disj_star_distr: forall (p q r: sass), 297 | (p \\// q) ** r <==> (p ** r) \\// (q ** r). 298 | Proof. 299 | split; unfold strongerThan, s_imp; intros; destruct s. 300 | destruct H as [h1 [h2 [H1 [H2 [H3 H4]]]]]. 301 | destruct H3. left. exists h1. eauto. right. exists h1. eauto. 302 | destruct H; destruct H as [h1 [h2 [H1 [H2 [H3 H4]]]]]; 303 | exists h1; exists h2; repeat split; eauto. 304 | left. auto. right. auto. 305 | Qed. 306 | 307 | Lemma conj_star_distr: forall (p q r: sass), 308 | (p //\\ q) ** r ==> (p ** r) //\\ (q ** r). 309 | Proof. 310 | unfold strongerThan, s_imp. intros. destruct s. 311 | destruct H as [h1 [h2 [H1 [H2 [H3 H4]]]]]. destruct H3. 312 | split; exists h1; exists h2; eauto. 313 | Qed. 314 | 315 | Lemma h_union_subst: 316 | forall h1 h2 h, h_union h1 h2 = h -> 317 | disjoint h1 h2 -> 318 | h_subset h2 h. 319 | Proof. 320 | unfold h_subset, h_union. intros; 321 | subst; destruct (in_not_in_dec l h1); auto. 322 | destruct (H0 l); destruct i; unfold not_in_dom in H; 323 | congruence. 324 | Qed. 325 | 326 | Lemma h_union_determ: 327 | forall h1 h1' h2, h_union h1 h2 = h_union h1' h2 -> 328 | disjoint h1 h2 -> 329 | disjoint h1' h2 -> 330 | h1 = h1'. 331 | Proof. 332 | intros. 333 | apply functional_extensionality. intros. 334 | assert ((h_union h1 h2) x = (h_union h1' h2) x). rewrite H. reflexivity. 335 | unfold h_union in H2. 336 | destruct (in_not_in_dec x h1); 337 | destruct (in_not_in_dec x h1'); eauto. 338 | destruct i. destruct (H0 x). congruence. rewrite H3 in H2. congruence. 339 | destruct i. destruct (H1 x). congruence. rewrite H3 in H2. congruence. 340 | unfold not_in_dom in *. rewrite n. rewrite n0. reflexivity. 341 | Qed. 342 | 343 | Hint Resolve h_union_subst. 344 | Hint Resolve h_union_determ. 345 | 346 | Lemma precise_conj_distr: forall (p q r: sass), 347 | precise r -> (p ** r) //\\ (q ** r) ==> (p //\\ q) ** r. 348 | Proof. 349 | unfold strongerThan, s_imp. intros. destruct s. 350 | destruct H0. 351 | destruct H0 as [h1 [h2 [H2 [H3 [H4 H5]]]]]. 352 | destruct H1 as [h1' [h2' [H2' [H3' [H4' H5']]]]]. 353 | unfold precise in H. 354 | assert (h2 = h2'). eapply H; eauto. subst. 355 | assert (h1 = h1'). eauto. subst. 356 | exists h1'. exists h2'. repeat split; eauto. 357 | Qed. 358 | 359 | Inductive multiStep : 360 | scom * ext_state -> scom * ext_state -> Prop := 361 | | step0: forall c s, multiStep (c, s) (c, s) 362 | | stepn: forall c s c' s' c'' s'', 363 | small_step (c, s) (c', s') 364 | -> multiStep (c', s') (c'', s'') 365 | -> multiStep (c, s) (c'', s''). 366 | 367 | Hint Constructors multiStep. 368 | 369 | (* c is safe at state s *) 370 | Definition safeAt (c: scom) (s: sstate) : Prop := 371 | (* ~ multiStep (c, St s) Abt *) 372 | 373 | forall c' s', 374 | multiStep (c, St s) (c', St s') 375 | -> c' = SCSkip \/ exists c'', exists s'', small_step (c', St s') (c'', St s''). 376 | 377 | Lemma small_abt: forall c c' s, small_step (c, Abt) (c', s) -> 378 | s = Abt. 379 | Proof. 380 | induction c; intros; inversion H; subst; eauto. 381 | Qed. 382 | 383 | Lemma multi_abt: forall cs cs', multiStep cs cs' -> 384 | snd cs = Abt -> 385 | snd cs' = Abt. 386 | Proof. 387 | intros. induction H. auto. 388 | destruct s. simpl in H0. inversion H0. inversion H; subst; auto. 389 | apply small_abt in H3. subst. auto. 390 | Qed. 391 | 392 | Definition safeMono (c: scom) : Prop := 393 | forall s h h', 394 | safeAt c (s, h) -> disjoint h h' -> safeAt c (s, h_union h h'). 395 | 396 | Definition frame (c: scom) : Prop := 397 | forall s h1 h2 c' s' h', 398 | safeAt c (s, h1) 399 | -> disjoint h1 h2 400 | -> small_step (c, St (s, h_union h1 h2)) (c', St (s', h')) 401 | -> exists h1', 402 | small_step (c, St (s, h1)) (c', St (s', h1')) 403 | /\ disjoint h1' h2 404 | /\ h_union h1' h2 = h'. 405 | 406 | Lemma multistep_seq: forall cs c2 cs', multiStep cs cs' -> 407 | multiStep (SCSeq (fst cs) c2, (snd cs)) (SCSeq (fst cs') c2, (snd cs')). 408 | Proof. 409 | intros. 410 | induction H. constructor. 411 | econstructor; eauto. 412 | Qed. 413 | 414 | Lemma safeAt_seq: forall c1 c2 s h, safeAt (SCSeq c1 c2) (s, h) -> 415 | safeAt c1 (s, h). 416 | Proof. 417 | unfold safeAt. intros. 418 | assert (multiStep (SCSeq c1 c2, St (s, h)) (SCSeq c' c2, St s')). 419 | remember (c1, St (s, h)) as cs. remember (c', St s') as cs'. 420 | apply multistep_seq with (c2 := c2) in H0. subst. auto. 421 | apply H in H1. destruct H1. inversion H1. destruct H1 as [c'' [s'' H_s]]. 422 | inversion H_s; subst. right. eauto. left. auto. 423 | Qed. 424 | 425 | Lemma union_none: forall h1 h2 x, 426 | h_union h1 h2 x = None -> 427 | h1 x = None /\ h2 x = None. 428 | Proof. 429 | intros. unfold h_union in *. destruct (in_not_in_dec x h1). 430 | split; auto. destruct i. congruence. 431 | split; auto. 432 | Qed. 433 | 434 | Lemma disjoint_update: forall h1 h2 x n, 435 | disjoint h1 h2 -> 436 | h2 x = None -> 437 | disjoint (h_update h1 x n) h2. 438 | Proof. 439 | unfold disjoint, not_in_dom. intros. 440 | unfold h_update. destruct (eq_nat_dec x l). subst. 441 | auto. auto. 442 | Qed. 443 | 444 | Hint Resolve disjoint_update. 445 | 446 | Lemma union_update: forall h1 h2 x n, 447 | h_union (h_update h1 x n) h2 = 448 | h_update (h_union h1 h2) x n. 449 | Proof. 450 | intros. apply functional_extensionality. intros. 451 | unfold h_union, h_update. 452 | destruct (in_not_in_dec x0). destruct i. 453 | destruct (eq_nat_dec x x0). auto. 454 | destruct (in_not_in_dec x0 h1). reflexivity. congruence. 455 | unfold not_in_dom in n0. destruct (eq_nat_dec x x0). congruence. 456 | destruct (in_not_in_dec x0 h1). destruct i. congruence. reflexivity. 457 | Qed. 458 | 459 | Lemma update_disjoint: forall h1 h2 x n, 460 | disjoint h1 h2 -> 461 | in_dom x h1 -> 462 | disjoint (h_update h1 x n) h2. 463 | Proof. 464 | unfold in_dom, h_update, disjoint, not_in_dom. intros. 465 | destruct (eq_nat_dec x l). subst. destruct H0. destruct (H l). 466 | congruence. auto. auto. 467 | Qed. 468 | 469 | Hint Resolve update_disjoint. 470 | 471 | Lemma locality_frame: forall c : scom, frame c. 472 | Proof with eauto. 473 | unfold frame. induction c; intros; inversion H1; subst; try solve [exists h1; eauto]. 474 | Case "Seq". 475 | apply safeAt_seq in H. 476 | eapply IHc1 in H... destruct H as [h'' [H5 [H6 H7]]]. 477 | exists h''. eauto. 478 | Case "Cons". 479 | exists (h_update (h_update h1 l (aeval s a)) (l + 1) (aeval s a0)). 480 | destruct (union_none h1 h2 l H12). 481 | destruct (union_none h1 h2 (l+1) H13). 482 | repeat split. constructor... eapply disjoint_update... 483 | rewrite union_update. rewrite union_update. reflexivity. 484 | Case "Lookup". 485 | assert (multiStep (SCLookup i a, St (s, h1)) (SCLookup i a, St (s, h1))). 486 | constructor. apply H in H2. destruct H2. inversion H2. 487 | destruct H2 as [c'' [s'' H_s]]. inversion H_s; subst. 488 | exists h1. repeat split... unfold h_union in H3. 489 | destruct (in_not_in_dec (aeval s a) h1). rewrite H3 in H4. 490 | inversion H4; subst... congruence. 491 | Case "Mutation". 492 | assert (multiStep (SCMutation a a0, St (s', h1)) (SCMutation a a0, St (s', h1))). 493 | constructor. apply H in H2. destruct H2. inversion H2. 494 | destruct H2 as [c'' [s'' H_s]]. inversion H_s; subst. 495 | exists (h_update h1 (aeval s' a) (aeval s' a0)). 496 | repeat split... rewrite union_update... 497 | Case "Dispose". 498 | assert (multiStep (SCDispose a, St (s', h1)) (SCDispose a, St (s', h1))). 499 | constructor. apply H in H2. destruct H2. inversion H2. 500 | destruct H2 as [c'' [s'' H_s]]. inversion H_s; subst. 501 | exists (fun x => if eq_nat_dec x (aeval s' a) then None else h1 x). 502 | repeat split... unfold disjoint, not_in_dom. intros. 503 | destruct (eq_nat_dec l (aeval s' a))... 504 | apply functional_extensionality. intros. 505 | unfold h_union. destruct (in_not_in_dec x)... 506 | destruct i. destruct (eq_nat_dec x (aeval s' a))... 507 | destruct (in_not_in_dec x h1)... congruence. 508 | unfold not_in_dom in n. destruct (eq_nat_dec x (aeval s' a)). 509 | subst. destruct (H0 (aeval s' a))... destruct H8. congruence. 510 | destruct (in_not_in_dec x h1)... destruct i. congruence. 511 | Qed. 512 | 513 | Lemma small_union: forall c s h c' s' h' h1, 514 | small_step (c, St (s, h)) (c', St (s', h')) -> 515 | disjoint h h1 -> 516 | exists c'', exists sh', 517 | small_step (c, St (s, h_union h h1)) (c'', St sh'). 518 | Proof with eauto. 519 | induction c; intros; inversion H; subst; 520 | try solve [exists c'; eauto]; try solve [exists SCSkip; eauto]. 521 | exists SCSkip. exists (st_update s i (aeval s a), h_union h' h1)... 522 | destruct (IHc1 s h c1' s' h' h1 H2 H0) as [c'' [sh' H_s]]. 523 | exists (SCSeq c'' c2)... 524 | exists (SCSeq c (SCWhile b c))... 525 | Case "Cons". 526 | destruct (finite_heap (h_union h h1)) as [l' H_h]. 527 | assert (h_union h h1 l' = None). destruct (in_not_in_dec l' (h_union h h1))... 528 | destruct i0. apply H_h in H1. omega. 529 | assert (h_union h h1 (l'+1)= None). destruct (in_not_in_dec (l'+1) (h_union h h1))... 530 | destruct i0. apply H_h in H2. omega. 531 | exists SCSkip. exists (st_update s i l', 532 | h_update (h_update (h_union h h1) l' (aeval s a)) 533 | (l'+1) (aeval s a0))... 534 | Case "Lookup". 535 | exists SCSkip. exists (st_update s i n, h_union h' h1). 536 | constructor. unfold h_union. destruct (in_not_in_dec (aeval s a) h')... 537 | congruence. 538 | Case "Mutation". 539 | exists SCSkip. exists (s', h_update (h_union h h1) (aeval s' a) (aeval s' a0)). 540 | constructor... destruct H10. exists x... unfold h_union. 541 | destruct (in_not_in_dec (aeval s' a) h)... congruence. 542 | Case "Dispose". 543 | exists SCSkip. exists (s', fun x => 544 | if eq_nat_dec x (aeval s' a) then None else (h_union h h1 x)). 545 | constructor... destruct H8. exists x. unfold h_union. 546 | destruct (in_not_in_dec (aeval s' a) h)... congruence. 547 | Qed. 548 | 549 | Lemma safeAt_continues: 550 | forall c c' s s' h h', 551 | safeAt c (s, h) -> small_step (c, St (s, h)) (c', St (s', h')) -> 552 | safeAt c' (s', h'). 553 | Proof. 554 | intros. unfold safeAt. intros. 555 | assert (multiStep (c, St (s, h)) (c'0, St s'0)). econstructor; eauto. 556 | apply H in H2. auto. 557 | Qed. 558 | 559 | Lemma locality_safeMono: forall c : scom, safeMono c. 560 | Proof with eauto. 561 | unfold safeMono. intros. 562 | unfold safeAt. intros. 563 | remember (c, St (s, h_union h h')) as cs. 564 | remember (c', St s') as cs'. 565 | generalize dependent c. 566 | generalize dependent s. 567 | generalize dependent h. 568 | induction H1; intros; inversion Heqcs; subst; inversion Heqcs'; subst; 569 | clear Heqcs; clear Heqcs'. 570 | assert (multiStep (c', St (s0, h)) (c', St (s0, h)))... 571 | apply H in H1. destruct H1... destruct H1 as [c'' [s'' H_s]]. 572 | destruct s''. eapply small_union in H_s... 573 | assert (frame c0). apply locality_frame. 574 | destruct s'0. destruct s. 575 | destruct (H3 s0 h h' c'0 s h0)... destruct H4 as [H41 [H42 H43]]. 576 | assert ((c', St s') = (c', St s'))... 577 | eapply IHmultiStep in H4... 578 | eapply safeAt_continues in H2... rewrite H43... 579 | apply multi_abt in H1... inversion H1. 580 | Qed. 581 | 582 | Lemma not_safe : ~ safeMono (SCCons X (ANum 1) (ANum 1)). 583 | Proof. 584 | intro H. unfold safeMono in H. 585 | assert (safeAt (SCCons X (ANum 1) (ANum 1)) (fun id => 0, emp_heap)). 586 | unfold safeAt. intros. inversion H0; subst. right. 587 | exists SCSkip. 588 | exists (st_update (fun id => 0) X 1, h_update (h_update emp_heap 1 1) 2 1). 589 | econstructor; eauto. inversion H4; subst. inversion H6; subst; auto. 590 | inversion H5. 591 | assert (disjoint emp_heap (fun n => Some 1)). 592 | unfold disjoint, not_in_dom. intros. left. reflexivity. 593 | assert (h_union emp_heap (fun n => Some 1) = fun n => Some 1). reflexivity. 594 | eapply H in H0; eauto. rewrite H2 in *. 595 | unfold safeAt in H0. 596 | assert (multiStep (SCCons X (ANum 1) (ANum 1), St (fun _ => 0, fun _ => Some 1)) 597 | (SCCons X (ANum 1) (ANum 1), St (fun _ => 0, fun _ => Some 1))). constructor. 598 | apply H0 in H3. destruct H3. inversion H3. 599 | destruct H3 as [c'' [s'' H_s]]. 600 | inversion H_s. inversion H12. 601 | Qed. 602 | 603 | 604 | Theorem locality: forall c : scom, safeMono c /\ frame c. 605 | Proof. 606 | split. apply locality_safeMono. apply locality_frame. 607 | Qed. -------------------------------------------------------------------------------- /SfLib.v: -------------------------------------------------------------------------------- 1 | (** * SfLib: Software Foundations Library *) 2 | 3 | (** Here we collect together several useful definitions and theorems 4 | from Basics.v, List.v, Poly.v, Ind.v, and Logic.v that are not 5 | already in the Coq standard library. From now on we can [Import] 6 | or [Export] this file, instead of cluttering our environment with 7 | all the examples and false starts in those files. *) 8 | 9 | (** * From the Coq Standard Library *) 10 | 11 | Require Omega. (* needed for using the [omega] tactic *) 12 | Require Export Bool. 13 | Require Export List. 14 | Export ListNotations. 15 | Require Export Arith. 16 | Require Export Arith.EqNat. (* Contains [beq_nat], among other things *) 17 | 18 | (** * From Basics.v *) 19 | 20 | Definition admit {T: Type} : T. Admitted. 21 | 22 | Require String. Open Scope string_scope. 23 | 24 | Ltac move_to_top x := 25 | match reverse goal with 26 | | H : _ |- _ => try move x after H 27 | end. 28 | 29 | Tactic Notation "assert_eq" ident(x) constr(v) := 30 | let H := fresh in 31 | assert (x = v) as H by reflexivity; 32 | clear H. 33 | 34 | Tactic Notation "Case_aux" ident(x) constr(name) := 35 | first [ 36 | set (x := name); move_to_top x 37 | | assert_eq x name; move_to_top x 38 | | fail 1 "because we are working on a different case" ]. 39 | 40 | Tactic Notation "Case" constr(name) := Case_aux Case name. 41 | Tactic Notation "SCase" constr(name) := Case_aux SCase name. 42 | Tactic Notation "SSCase" constr(name) := Case_aux SSCase name. 43 | Tactic Notation "SSSCase" constr(name) := Case_aux SSSCase name. 44 | Tactic Notation "SSSSCase" constr(name) := Case_aux SSSSCase name. 45 | Tactic Notation "SSSSSCase" constr(name) := Case_aux SSSSSCase name. 46 | Tactic Notation "SSSSSSCase" constr(name) := Case_aux SSSSSSCase name. 47 | Tactic Notation "SSSSSSSCase" constr(name) := Case_aux SSSSSSSCase name. 48 | 49 | Fixpoint ble_nat (n m : nat) : bool := 50 | match n with 51 | | O => true 52 | | S n' => 53 | match m with 54 | | O => false 55 | | S m' => ble_nat n' m' 56 | end 57 | end. 58 | 59 | Theorem andb_true_elim1 : forall b c, 60 | andb b c = true -> b = true. 61 | Proof. 62 | intros b c H. 63 | destruct b. 64 | Case "b = true". 65 | reflexivity. 66 | Case "b = false". 67 | rewrite <- H. reflexivity. Qed. 68 | 69 | Theorem andb_true_elim2 : forall b c, 70 | andb b c = true -> c = true. 71 | Proof. 72 | (* An exercise in Basics.v *) 73 | Admitted. 74 | 75 | Theorem beq_nat_sym : forall (n m : nat), 76 | beq_nat n m = beq_nat m n. 77 | (* An exercise in Lists.v *) 78 | Admitted. 79 | 80 | (** * From Props.v *) 81 | 82 | Inductive ev : nat -> Prop := 83 | | ev_0 : ev O 84 | | ev_SS : forall n:nat, ev n -> ev (S (S n)). 85 | 86 | (** * From Logic.v *) 87 | 88 | Theorem andb_true : forall b c, 89 | andb b c = true -> b = true /\ c = true. 90 | Proof. 91 | intros b c H. 92 | destruct b. 93 | destruct c. 94 | apply conj. reflexivity. reflexivity. 95 | inversion H. 96 | inversion H. Qed. 97 | 98 | Theorem false_beq_nat: forall n n' : nat, 99 | n <> n' -> 100 | beq_nat n n' = false. 101 | Proof. 102 | (* An exercise in Logic.v *) 103 | Admitted. 104 | 105 | Theorem ex_falso_quodlibet : forall (P:Prop), 106 | False -> P. 107 | Proof. 108 | intros P contra. 109 | inversion contra. Qed. 110 | 111 | Theorem ev_not_ev_S : forall n, 112 | ev n -> ~ ev (S n). 113 | Proof. 114 | (* An exercise in Logic.v *) 115 | Admitted. 116 | 117 | Theorem ble_nat_true : forall n m, 118 | ble_nat n m = true -> n <= m. 119 | (* An exercise in Logic.v *) 120 | Admitted. 121 | 122 | Theorem ble_nat_false : forall n m, 123 | ble_nat n m = false -> ~(n <= m). 124 | (* An exercise in Logic.v *) 125 | Admitted. 126 | 127 | Inductive appears_in (n : nat) : list nat -> Prop := 128 | | ai_here : forall l, appears_in n (n::l) 129 | | ai_later : forall m l, appears_in n l -> appears_in n (m::l). 130 | 131 | Inductive next_nat (n:nat) : nat -> Prop := 132 | | nn : next_nat n (S n). 133 | 134 | Inductive total_relation : nat -> nat -> Prop := 135 | tot : forall n m : nat, total_relation n m. 136 | 137 | Inductive empty_relation : nat -> nat -> Prop := . 138 | 139 | (** * From Later Files *) 140 | 141 | Definition relation (X:Type) := X -> X -> Prop. 142 | 143 | Definition deterministic {X: Type} (R: relation X) := 144 | forall x y1 y2 : X, R x y1 -> R x y2 -> y1 = y2. 145 | 146 | Inductive multi (X:Type) (R: relation X) 147 | : X -> X -> Prop := 148 | | multi_refl : forall (x : X), 149 | multi X R x x 150 | | multi_step : forall (x y z : X), 151 | R x y -> 152 | multi X R y z -> 153 | multi X R x z. 154 | Implicit Arguments multi [[X]]. 155 | 156 | Tactic Notation "multi_cases" tactic(first) ident(c) := 157 | first; 158 | [ Case_aux c "multi_refl" | Case_aux c "multi_step" ]. 159 | 160 | Theorem multi_R : forall (X:Type) (R:relation X) (x y : X), 161 | R x y -> multi R x y. 162 | Proof. 163 | intros X R x y r. 164 | apply multi_step with y. apply r. apply multi_refl. Qed. 165 | 166 | Theorem multi_trans : 167 | forall (X:Type) (R: relation X) (x y z : X), 168 | multi R x y -> 169 | multi R y z -> 170 | multi R x z. 171 | Proof. 172 | intros. induction H. apply H0. apply multi_step with y. apply H. 173 | apply IHmulti. apply H0. 174 | Qed. 175 | 176 | (** Identifiers and polymorphic partial maps. *) 177 | 178 | Inductive id : Type := 179 | Id : nat -> id. 180 | 181 | Theorem eq_id_dec : forall id1 id2 : id, {id1 = id2} + {id1 <> id2}. 182 | Proof. 183 | intros id1 id2. 184 | destruct id1 as [n1]. destruct id2 as [n2]. 185 | destruct (eq_nat_dec n1 n2) as [Heq | Hneq]. 186 | Case "n1 = n2". 187 | left. rewrite Heq. reflexivity. 188 | Case "n1 <> n2". 189 | right. intros contra. inversion contra. apply Hneq. apply H0. 190 | Defined. 191 | 192 | Lemma eq_id : forall (T:Type) x (p q:T), 193 | (if eq_id_dec x x then p else q) = p. 194 | Proof. 195 | intros. 196 | destruct (eq_id_dec x x); try reflexivity. 197 | apply ex_falso_quodlibet; auto. 198 | Qed. 199 | 200 | Lemma neq_id : forall (T:Type) x y (p q:T), x <> y -> 201 | (if eq_id_dec x y then p else q) = q. 202 | Proof. 203 | intros. destruct (eq_id_dec x y). 204 | apply ex_falso_quodlibet. unfold not in H. apply H. apply e. 205 | reflexivity. 206 | Qed. 207 | 208 | Definition partial_map (A:Type) := id -> option A. 209 | 210 | Definition empty {A:Type} : partial_map A := (fun _ => None). 211 | 212 | Notation "'\empty'" := empty. 213 | 214 | Definition extend {A:Type} (Gamma : partial_map A) (x:id) (T : A) := 215 | fun x' => if eq_id_dec x x' then Some T else Gamma x'. 216 | 217 | Lemma extend_eq : forall A (ctxt: partial_map A) x T, 218 | (extend ctxt x T) x = Some T. 219 | Proof. 220 | intros. unfold extend. rewrite eq_id; auto. 221 | Qed. 222 | 223 | Lemma extend_neq : forall A (ctxt: partial_map A) x1 T x2, 224 | x2 <> x1 -> 225 | (extend ctxt x2 T) x1 = ctxt x1. 226 | Proof. 227 | intros. unfold extend. rewrite neq_id; auto. 228 | Qed. 229 | 230 | Lemma extend_shadow : forall A (ctxt: partial_map A) t1 t2 x1 x2, 231 | extend (extend ctxt x2 t1) x2 t2 x1 = extend ctxt x2 t2 x1. 232 | Proof with auto. 233 | intros. unfold extend. destruct (eq_id_dec x2 x1)... 234 | Qed. 235 | 236 | (** -------------------- *) 237 | 238 | (** * Some useful tactics *) 239 | 240 | Tactic Notation "solve_by_inversion_step" tactic(t) := 241 | match goal with 242 | | H : _ |- _ => solve [ inversion H; subst; t ] 243 | end 244 | || fail "because the goal is not solvable by inversion.". 245 | 246 | Tactic Notation "solve" "by" "inversion" "1" := 247 | solve_by_inversion_step idtac. 248 | Tactic Notation "solve" "by" "inversion" "2" := 249 | solve_by_inversion_step (solve by inversion 1). 250 | Tactic Notation "solve" "by" "inversion" "3" := 251 | solve_by_inversion_step (solve by inversion 2). 252 | Tactic Notation "solve" "by" "inversion" := 253 | solve by inversion 1. 254 | 255 | (** $Date: 2014-12-31 12:04:02 -0500 (Wed, 31 Dec 2014) $ *) 256 | -------------------------------------------------------------------------------- /Symbols.v: -------------------------------------------------------------------------------- 1 | (** * Symbols: Special symbols *) 2 | 3 | (* This file defines some HTML symbols for use by the coqdoc 4 | preprocessor. It is not intended to be read by anybody. *) 5 | 6 | (** printing -> #→# *) 7 | (** printing || #⇓# *) 8 | (** printing ==> #⇒# *) 9 | (** printing ==>* #⇒*# *) 10 | (** printing ==>+ #⇒+# *) 11 | (** printing |- #⊢# *) 12 | (** printing <- #←# *) 13 | (** printing <-> #↔# *) 14 | (** printing forall #∀# *) 15 | (** printing exists #∃# *) 16 | (** printing /\ #∧# *) 17 | (** printing \/ #∨# *) 18 | (** printing ->> #⇾# *) 19 | (** printing <<->> #⇿# *) 20 | (** printing |- #⊢# *) 21 | (** printing Gamma #Γ# *) 22 | (** printing Gamma' #Γ'# *) 23 | (** printing Gamma'' #Γ''# *) 24 | (** printing |-> #↦# *) 25 | 26 | (** $Date: 2014-12-31 11:17:56 -0500 (Wed, 31 Dec 2014) $ *) 27 | 28 | -------------------------------------------------------------------------------- /Typechecking.v: -------------------------------------------------------------------------------- 1 | (** * MoreStlc: A Typechecker for STLC *) 2 | 3 | Require Export Stlc. 4 | 5 | (** The [has_type] relation of the STLC defines what it means for a 6 | term to belong to a type (in some context). But it doesn't, by 7 | itself, tell us how to _check_ whether or not a term is well 8 | typed. 9 | 10 | Fortunately, the rules defining [has_type] are _syntax directed_ 11 | -- they exactly follow the shape of the term. This makes it 12 | straightforward to translate the typing rules into clauses of a 13 | typechecking _function_ that takes a term and a context and either 14 | returns the term's type or else signals that the term is not 15 | typable. *) 16 | 17 | Module STLCChecker. 18 | Import STLC. 19 | 20 | (* ###################################################################### *) 21 | (** ** Comparing Types *) 22 | 23 | (** First, we need a function to compare two types for equality... *) 24 | 25 | Fixpoint beq_ty (T1 T2:ty) : bool := 26 | match T1,T2 with 27 | | TBool, TBool => 28 | true 29 | | TArrow T11 T12, TArrow T21 T22 => 30 | andb (beq_ty T11 T21) (beq_ty T12 T22) 31 | | _,_ => 32 | false 33 | end. 34 | 35 | (** ... and we need to establish the usual two-way connection between 36 | the boolean result returned by [beq_ty] and the logical 37 | proposition that its inputs are equal. *) 38 | 39 | Lemma beq_ty_refl : forall T1, 40 | beq_ty T1 T1 = true. 41 | Proof. 42 | intros T1. induction T1; simpl. 43 | reflexivity. 44 | rewrite IHT1_1. rewrite IHT1_2. reflexivity. Qed. 45 | 46 | Lemma beq_ty__eq : forall T1 T2, 47 | beq_ty T1 T2 = true -> T1 = T2. 48 | Proof with auto. 49 | intros T1. induction T1; intros T2 Hbeq; destruct T2; inversion Hbeq. 50 | Case "T1=TBool". 51 | reflexivity. 52 | Case "T1=TArrow T1_1 T1_2". 53 | apply andb_true in H0. inversion H0 as [Hbeq1 Hbeq2]. 54 | apply IHT1_1 in Hbeq1. apply IHT1_2 in Hbeq2. subst... Qed. 55 | 56 | (* ###################################################################### *) 57 | (** ** The Typechecker *) 58 | 59 | (** Now here's the typechecker. It works by walking over the 60 | structure of the given term, returning either [Some T] or [None]. 61 | Each time we make a recursive call to find out the types of the 62 | subterms, we need to pattern-match on the results to make sure 63 | that they are not [None]. Also, in the [tapp] case, we use 64 | pattern matching to extract the left- and right-hand sides of the 65 | function's arrow type (and fail if the type of the function is not 66 | [TArrow T11 T12] for some [T1] and [T2]). *) 67 | 68 | Fixpoint type_check (Gamma:context) (t:tm) : option ty := 69 | match t with 70 | | tvar x => Gamma x 71 | | tabs x T11 t12 => match type_check (extend Gamma x T11) t12 with 72 | | Some T12 => Some (TArrow T11 T12) 73 | | _ => None 74 | end 75 | | tapp t1 t2 => match type_check Gamma t1, type_check Gamma t2 with 76 | | Some (TArrow T11 T12),Some T2 => 77 | if beq_ty T11 T2 then Some T12 else None 78 | | _,_ => None 79 | end 80 | | ttrue => Some TBool 81 | | tfalse => Some TBool 82 | | tif x t f => match type_check Gamma x with 83 | | Some TBool => 84 | match type_check Gamma t, type_check Gamma f with 85 | | Some T1, Some T2 => 86 | if beq_ty T1 T2 then Some T1 else None 87 | | _,_ => None 88 | end 89 | | _ => None 90 | end 91 | end. 92 | 93 | (* ###################################################################### *) 94 | (** ** Properties *) 95 | 96 | (** To verify that this typechecking algorithm is the correct one, we 97 | show that it is _sound_ and _complete_ for the original [has_type] 98 | relation -- that is, [type_check] and [has_type] define the same 99 | partial function. *) 100 | 101 | Theorem type_checking_sound : forall Gamma t T, 102 | type_check Gamma t = Some T -> has_type Gamma t T. 103 | Proof with eauto. 104 | intros Gamma t. generalize dependent Gamma. 105 | t_cases (induction t) Case; intros Gamma T Htc; inversion Htc. 106 | Case "tvar"... 107 | Case "tapp". 108 | remember (type_check Gamma t1) as TO1. 109 | remember (type_check Gamma t2) as TO2. 110 | destruct TO1 as [T1|]; try solve by inversion; 111 | destruct T1 as [|T11 T12]; try solve by inversion. 112 | destruct TO2 as [T2|]; try solve by inversion. 113 | destruct (beq_ty T11 T2) eqn: Heqb; 114 | try solve by inversion. 115 | apply beq_ty__eq in Heqb. 116 | inversion H0; subst... 117 | Case "tabs". 118 | rename i into y. rename t into T1. 119 | remember (extend Gamma y T1) as G'. 120 | remember (type_check G' t0) as TO2. 121 | destruct TO2; try solve by inversion. 122 | inversion H0; subst... 123 | Case "ttrue"... 124 | Case "tfalse"... 125 | Case "tif". 126 | remember (type_check Gamma t1) as TOc. 127 | remember (type_check Gamma t2) as TO1. 128 | remember (type_check Gamma t3) as TO2. 129 | destruct TOc as [Tc|]; try solve by inversion. 130 | destruct Tc; try solve by inversion. 131 | destruct TO1 as [T1|]; try solve by inversion. 132 | destruct TO2 as [T2|]; try solve by inversion. 133 | destruct (beq_ty T1 T2) eqn:Heqb; 134 | try solve by inversion. 135 | apply beq_ty__eq in Heqb. 136 | inversion H0. subst. subst... 137 | Qed. 138 | 139 | Theorem type_checking_complete : forall Gamma t T, 140 | has_type Gamma t T -> type_check Gamma t = Some T. 141 | Proof with auto. 142 | intros Gamma t T Hty. 143 | has_type_cases (induction Hty) Case; simpl. 144 | Case "T_Var"... 145 | Case "T_Abs". rewrite IHHty... 146 | Case "T_App". 147 | rewrite IHHty1. rewrite IHHty2. 148 | rewrite (beq_ty_refl T11)... 149 | Case "T_True"... 150 | Case "T_False"... 151 | Case "T_If". rewrite IHHty1. rewrite IHHty2. 152 | rewrite IHHty3. rewrite (beq_ty_refl T)... 153 | Qed. 154 | 155 | End STLCChecker. 156 | 157 | (** $Date: 2014-12-31 11:17:56 -0500 (Wed, 31 Dec 2014) $ *) 158 | --------------------------------------------------------------------------------