├── .coqdeps.d ├── .depend ├── .gitignore ├── Auto.v ├── AutoTest.v ├── Basics.v ├── BasicsTest.v ├── Bib.v ├── BibTest.v ├── Extraction.v ├── ExtractionTest.v ├── Imp.v ├── ImpCEvalFun.v ├── ImpCEvalFunTest.v ├── ImpParser.v ├── ImpParserTest.v ├── ImpTest.v ├── IndPrinciples.v ├── IndPrinciplesTest.v ├── IndProp.v ├── IndPropTest.v ├── Induction.v ├── InductionTest.v ├── LICENSE ├── Lists.v ├── ListsTest.v ├── Logic.v ├── LogicTest.v ├── Makefile ├── Makefile.conf ├── Maps.v ├── MapsTest.v ├── Poly.v ├── PolyTest.v ├── Postscript.v ├── PostscriptTest.v ├── Preface.v ├── PrefaceTest.v ├── ProofObjects.v ├── ProofObjectsTest.v ├── README ├── Rel.v ├── RelTest.v ├── Tactics.v ├── TacticsTest.v ├── _CoqProject ├── deps.gif ├── deps.map ├── imp.ml ├── imp.mli ├── imp1.ml ├── imp1.mli ├── imp2.ml ├── imp2.mli └── impdriver.ml /.coqdeps.d: -------------------------------------------------------------------------------- 1 | Preface.vo Preface.glob Preface.v.beautified: Preface.v 2 | Preface.vio: Preface.v 3 | Basics.vo Basics.glob Basics.v.beautified: Basics.v 4 | Basics.vio: Basics.v 5 | Induction.vo Induction.glob Induction.v.beautified: Induction.v Basics.vo 6 | Induction.vio: Induction.v Basics.vio 7 | Lists.vo Lists.glob Lists.v.beautified: Lists.v Induction.vo 8 | Lists.vio: Lists.v Induction.vio 9 | Poly.vo Poly.glob Poly.v.beautified: Poly.v Lists.vo 10 | Poly.vio: Poly.v Lists.vio 11 | Tactics.vo Tactics.glob Tactics.v.beautified: Tactics.v Poly.vo 12 | Tactics.vio: Tactics.v Poly.vio 13 | Logic.vo Logic.glob Logic.v.beautified: Logic.v Tactics.vo 14 | Logic.vio: Logic.v Tactics.vio 15 | IndProp.vo IndProp.glob IndProp.v.beautified: IndProp.v Logic.vo 16 | IndProp.vio: IndProp.v Logic.vio 17 | Maps.vo Maps.glob Maps.v.beautified: Maps.v 18 | Maps.vio: Maps.v 19 | ProofObjects.vo ProofObjects.glob ProofObjects.v.beautified: ProofObjects.v IndProp.vo 20 | ProofObjects.vio: ProofObjects.v IndProp.vio 21 | IndPrinciples.vo IndPrinciples.glob IndPrinciples.v.beautified: IndPrinciples.v ProofObjects.vo 22 | IndPrinciples.vio: IndPrinciples.v ProofObjects.vio 23 | Rel.vo Rel.glob Rel.v.beautified: Rel.v IndProp.vo 24 | Rel.vio: Rel.v IndProp.vio 25 | Imp.vo Imp.glob Imp.v.beautified: Imp.v Maps.vo 26 | Imp.vio: Imp.v Maps.vio 27 | ImpParser.vo ImpParser.glob ImpParser.v.beautified: ImpParser.v Maps.vo Imp.vo 28 | ImpParser.vio: ImpParser.v Maps.vio Imp.vio 29 | ImpCEvalFun.vo ImpCEvalFun.glob ImpCEvalFun.v.beautified: ImpCEvalFun.v Imp.vo Maps.vo 30 | ImpCEvalFun.vio: ImpCEvalFun.v Imp.vio Maps.vio 31 | Extraction.vo Extraction.glob Extraction.v.beautified: Extraction.v ImpCEvalFun.vo Imp.vo ImpParser.vo Maps.vo 32 | Extraction.vio: Extraction.v ImpCEvalFun.vio Imp.vio ImpParser.vio Maps.vio 33 | Auto.vo Auto.glob Auto.v.beautified: Auto.v Maps.vo Imp.vo 34 | Auto.vio: Auto.v Maps.vio Imp.vio 35 | Postscript.vo Postscript.glob Postscript.v.beautified: Postscript.v 36 | Postscript.vio: Postscript.v 37 | Bib.vo Bib.glob Bib.v.beautified: Bib.v 38 | Bib.vio: Bib.v 39 | PrefaceTest.vo PrefaceTest.glob PrefaceTest.v.beautified: PrefaceTest.v Preface.vo 40 | PrefaceTest.vio: PrefaceTest.v Preface.vio 41 | BasicsTest.vo BasicsTest.glob BasicsTest.v.beautified: BasicsTest.v Basics.vo 42 | BasicsTest.vio: BasicsTest.v Basics.vio 43 | InductionTest.vo InductionTest.glob InductionTest.v.beautified: InductionTest.v Induction.vo 44 | InductionTest.vio: InductionTest.v Induction.vio 45 | ListsTest.vo ListsTest.glob ListsTest.v.beautified: ListsTest.v Lists.vo 46 | ListsTest.vio: ListsTest.v Lists.vio 47 | PolyTest.vo PolyTest.glob PolyTest.v.beautified: PolyTest.v Poly.vo 48 | PolyTest.vio: PolyTest.v Poly.vio 49 | TacticsTest.vo TacticsTest.glob TacticsTest.v.beautified: TacticsTest.v Tactics.vo 50 | TacticsTest.vio: TacticsTest.v Tactics.vio 51 | LogicTest.vo LogicTest.glob LogicTest.v.beautified: LogicTest.v Logic.vo 52 | LogicTest.vio: LogicTest.v Logic.vio 53 | IndPropTest.vo IndPropTest.glob IndPropTest.v.beautified: IndPropTest.v IndProp.vo 54 | IndPropTest.vio: IndPropTest.v IndProp.vio 55 | MapsTest.vo MapsTest.glob MapsTest.v.beautified: MapsTest.v Maps.vo 56 | MapsTest.vio: MapsTest.v Maps.vio 57 | ProofObjectsTest.vo ProofObjectsTest.glob ProofObjectsTest.v.beautified: ProofObjectsTest.v ProofObjects.vo 58 | ProofObjectsTest.vio: ProofObjectsTest.v ProofObjects.vio 59 | IndPrinciplesTest.vo IndPrinciplesTest.glob IndPrinciplesTest.v.beautified: IndPrinciplesTest.v IndPrinciples.vo 60 | IndPrinciplesTest.vio: IndPrinciplesTest.v IndPrinciples.vio 61 | RelTest.vo RelTest.glob RelTest.v.beautified: RelTest.v Rel.vo 62 | RelTest.vio: RelTest.v Rel.vio 63 | ImpTest.vo ImpTest.glob ImpTest.v.beautified: ImpTest.v Imp.vo 64 | ImpTest.vio: ImpTest.v Imp.vio 65 | ImpParserTest.vo ImpParserTest.glob ImpParserTest.v.beautified: ImpParserTest.v ImpParser.vo 66 | ImpParserTest.vio: ImpParserTest.v ImpParser.vio 67 | ImpCEvalFunTest.vo ImpCEvalFunTest.glob ImpCEvalFunTest.v.beautified: ImpCEvalFunTest.v ImpCEvalFun.vo 68 | ImpCEvalFunTest.vio: ImpCEvalFunTest.v ImpCEvalFun.vio 69 | ExtractionTest.vo ExtractionTest.glob ExtractionTest.v.beautified: ExtractionTest.v Extraction.vo 70 | ExtractionTest.vio: ExtractionTest.v Extraction.vio 71 | AutoTest.vo AutoTest.glob AutoTest.v.beautified: AutoTest.v Auto.vo 72 | AutoTest.vio: AutoTest.v Auto.vio 73 | PostscriptTest.vo PostscriptTest.glob PostscriptTest.v.beautified: PostscriptTest.v Postscript.vo 74 | PostscriptTest.vio: PostscriptTest.v Postscript.vio 75 | BibTest.vo BibTest.glob BibTest.v.beautified: BibTest.v Bib.vo 76 | BibTest.vio: BibTest.v Bib.vio 77 | -------------------------------------------------------------------------------- /.depend: -------------------------------------------------------------------------------- 1 | Preface.vo Preface.glob Preface.v.beautified: Preface.v 2 | Preface.vio: Preface.v 3 | Basics.vo Basics.glob Basics.v.beautified: Basics.v 4 | Basics.vio: Basics.v 5 | Induction.vo Induction.glob Induction.v.beautified: Induction.v 6 | Induction.vio: Induction.v 7 | Lists.vo Lists.glob Lists.v.beautified: Lists.v 8 | Lists.vio: Lists.v 9 | Poly.vo Poly.glob Poly.v.beautified: Poly.v 10 | Poly.vio: Poly.v 11 | Tactics.vo Tactics.glob Tactics.v.beautified: Tactics.v 12 | Tactics.vio: Tactics.v 13 | Logic.vo Logic.glob Logic.v.beautified: Logic.v 14 | Logic.vio: Logic.v 15 | IndProp.vo IndProp.glob IndProp.v.beautified: IndProp.v 16 | IndProp.vio: IndProp.v 17 | Maps.vo Maps.glob Maps.v.beautified: Maps.v 18 | Maps.vio: Maps.v 19 | ProofObjects.vo ProofObjects.glob ProofObjects.v.beautified: ProofObjects.v 20 | ProofObjects.vio: ProofObjects.v 21 | IndPrinciples.vo IndPrinciples.glob IndPrinciples.v.beautified: IndPrinciples.v 22 | IndPrinciples.vio: IndPrinciples.v 23 | Rel.vo Rel.glob Rel.v.beautified: Rel.v 24 | Rel.vio: Rel.v 25 | Imp.vo Imp.glob Imp.v.beautified: Imp.v 26 | Imp.vio: Imp.v 27 | ImpParser.vo ImpParser.glob ImpParser.v.beautified: ImpParser.v 28 | ImpParser.vio: ImpParser.v 29 | ImpCEvalFun.vo ImpCEvalFun.glob ImpCEvalFun.v.beautified: ImpCEvalFun.v 30 | ImpCEvalFun.vio: ImpCEvalFun.v 31 | Extraction.vo Extraction.glob Extraction.v.beautified: Extraction.v 32 | Extraction.vio: Extraction.v 33 | Auto.vo Auto.glob Auto.v.beautified: Auto.v 34 | Auto.vio: Auto.v 35 | Postscript.vo Postscript.glob Postscript.v.beautified: Postscript.v 36 | Postscript.vio: Postscript.v 37 | Bib.vo Bib.glob Bib.v.beautified: Bib.v 38 | Bib.vio: Bib.v 39 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | # Created by https://www.gitignore.io/api/vim,coq,emacs 3 | # Edit at https://www.gitignore.io/?templates=vim,coq,emacs 4 | 5 | ### Coq ### 6 | .*.aux 7 | *.a 8 | *.cma 9 | *.cmi 10 | *.cmo 11 | *.cmx 12 | *.cmxa 13 | *.cmxs 14 | *.glob 15 | *.ml.d 16 | *.ml4.d 17 | *.mli.d 18 | *.mllib.d 19 | *.mlpack.d 20 | *.native 21 | *.o 22 | *.v.d 23 | *.vio 24 | *.vo 25 | .coq-native/ 26 | .csdp.cache 27 | .lia.cache 28 | .nia.cache 29 | .nlia.cache 30 | .nra.cache 31 | csdp.cache 32 | lia.cache 33 | nia.cache 34 | nlia.cache 35 | nra.cache 36 | 37 | ### Emacs ### 38 | # -*- mode: gitignore; -*- 39 | *~ 40 | \#*\# 41 | /.emacs.desktop 42 | /.emacs.desktop.lock 43 | *.elc 44 | auto-save-list 45 | tramp 46 | .\#* 47 | 48 | # Org-mode 49 | .org-id-locations 50 | *_archive 51 | 52 | # flymake-mode 53 | *_flymake.* 54 | 55 | # eshell files 56 | /eshell/history 57 | /eshell/lastdir 58 | 59 | # elpa packages 60 | /elpa/ 61 | 62 | # reftex files 63 | *.rel 64 | 65 | # AUCTeX auto folder 66 | /auto/ 67 | 68 | # cask packages 69 | .cask/ 70 | dist/ 71 | 72 | # Flycheck 73 | flycheck_*.el 74 | 75 | # server auth directory 76 | /server/ 77 | 78 | # projectiles files 79 | .projectile 80 | 81 | # directory configuration 82 | .dir-locals.el 83 | 84 | # network security 85 | /network-security.data 86 | 87 | 88 | ### Vim ### 89 | # Swap 90 | [._]*.s[a-v][a-z] 91 | [._]*.sw[a-p] 92 | [._]s[a-rt-v][a-z] 93 | [._]ss[a-gi-z] 94 | [._]sw[a-p] 95 | 96 | # Session 97 | Session.vim 98 | 99 | # Temporary 100 | .netrwhist 101 | # Auto-generated tag files 102 | tags 103 | # Persistent undo 104 | [._]*.un~ 105 | 106 | # End of https://www.gitignore.io/api/vim,coq,emacs 107 | -------------------------------------------------------------------------------- /AutoTest.v: -------------------------------------------------------------------------------- 1 | Set Warnings "-notation-overridden,-parsing". 2 | From Coq Require Export String. 3 | From LF Require Import Auto. 4 | Parameter MISSING: Type. 5 | 6 | Module Check. 7 | 8 | Ltac check_type A B := 9 | match type of A with 10 | | context[MISSING] => idtac "Missing:" A 11 | | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] 12 | end. 13 | 14 | Ltac print_manual_grade A := 15 | match eval compute in A with 16 | | Some (pair ?S ?C) => 17 | idtac "Score:" S; 18 | match eval compute in C with 19 | | ""%string => idtac "Comment: None" 20 | | _ => idtac "Comment:" C 21 | end 22 | | None => 23 | idtac "Score: Ungraded"; 24 | idtac "Comment: None" 25 | end. 26 | 27 | End Check. 28 | 29 | From LF Require Import Auto. 30 | Import Check. 31 | 32 | Goal True. 33 | 34 | idtac " ". 35 | 36 | idtac "Max points - standard: 0". 37 | idtac "Max points - advanced: 0". 38 | Abort. 39 | -------------------------------------------------------------------------------- /BasicsTest.v: -------------------------------------------------------------------------------- 1 | Set Warnings "-notation-overridden,-parsing". 2 | From Coq Require Export String. 3 | From LF Require Import Basics. 4 | Parameter MISSING: Type. 5 | 6 | Module Check. 7 | 8 | Ltac check_type A B := 9 | match type of A with 10 | | context[MISSING] => idtac "Missing:" A 11 | | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] 12 | end. 13 | 14 | Ltac print_manual_grade A := 15 | match eval compute in A with 16 | | Some (pair ?S ?C) => 17 | idtac "Score:" S; 18 | match eval compute in C with 19 | | ""%string => idtac "Comment: None" 20 | | _ => idtac "Comment:" C 21 | end 22 | | None => 23 | idtac "Score: Ungraded"; 24 | idtac "Comment: None" 25 | end. 26 | 27 | End Check. 28 | 29 | From LF Require Import Basics. 30 | Import Check. 31 | 32 | Goal True. 33 | 34 | idtac "------------------- nandb --------------------". 35 | idtac " ". 36 | 37 | idtac "#> test_nandb4". 38 | idtac "Possible points: 1". 39 | check_type @test_nandb4 ((nandb true true = false)). 40 | idtac "Assumptions:". 41 | Abort. 42 | Print Assumptions test_nandb4. 43 | Goal True. 44 | idtac " ". 45 | 46 | idtac "------------------- andb3 --------------------". 47 | idtac " ". 48 | 49 | idtac "#> test_andb34". 50 | idtac "Possible points: 1". 51 | check_type @test_andb34 ((andb3 true true false = false)). 52 | idtac "Assumptions:". 53 | Abort. 54 | Print Assumptions test_andb34. 55 | Goal True. 56 | idtac " ". 57 | 58 | idtac "------------------- factorial --------------------". 59 | idtac " ". 60 | 61 | idtac "#> test_factorial2". 62 | idtac "Possible points: 1". 63 | check_type @test_factorial2 ((factorial 5 = 10 * 12)). 64 | idtac "Assumptions:". 65 | Abort. 66 | Print Assumptions test_factorial2. 67 | Goal True. 68 | idtac " ". 69 | 70 | idtac "------------------- blt_nat --------------------". 71 | idtac " ". 72 | 73 | idtac "#> test_blt_nat3". 74 | idtac "Possible points: 1". 75 | check_type @test_blt_nat3 ((blt_nat 4 2 = false)). 76 | idtac "Assumptions:". 77 | Abort. 78 | Print Assumptions test_blt_nat3. 79 | Goal True. 80 | idtac " ". 81 | 82 | idtac "------------------- plus_id_exercise --------------------". 83 | idtac " ". 84 | 85 | idtac "#> plus_id_exercise". 86 | idtac "Possible points: 1". 87 | check_type @plus_id_exercise ((forall n m o : nat, n = m -> m = o -> n + m = m + o)). 88 | idtac "Assumptions:". 89 | Abort. 90 | Print Assumptions plus_id_exercise. 91 | Goal True. 92 | idtac " ". 93 | 94 | idtac "------------------- mult_S_1 --------------------". 95 | idtac " ". 96 | 97 | idtac "#> mult_S_1". 98 | idtac "Possible points: 2". 99 | check_type @mult_S_1 ((forall n m : nat, m = S n -> m * (1 + n) = m * m)). 100 | idtac "Assumptions:". 101 | Abort. 102 | Print Assumptions mult_S_1. 103 | Goal True. 104 | idtac " ". 105 | 106 | idtac "------------------- andb_true_elim2 --------------------". 107 | idtac " ". 108 | 109 | idtac "#> andb_true_elim2". 110 | idtac "Possible points: 2". 111 | check_type @andb_true_elim2 ((forall b c : bool, b && c = true -> c = true)). 112 | idtac "Assumptions:". 113 | Abort. 114 | Print Assumptions andb_true_elim2. 115 | Goal True. 116 | idtac " ". 117 | 118 | idtac "------------------- zero_nbeq_plus_1 --------------------". 119 | idtac " ". 120 | 121 | idtac "#> zero_nbeq_plus_1". 122 | idtac "Possible points: 1". 123 | check_type @zero_nbeq_plus_1 ((forall n : nat, beq_nat 0 (n + 1) = false)). 124 | idtac "Assumptions:". 125 | Abort. 126 | Print Assumptions zero_nbeq_plus_1. 127 | Goal True. 128 | idtac " ". 129 | 130 | idtac "------------------- boolean_functions --------------------". 131 | idtac " ". 132 | 133 | idtac "#> identity_fn_applied_twice". 134 | idtac "Possible points: 1". 135 | check_type @identity_fn_applied_twice ( 136 | (forall f : bool -> bool, 137 | (forall x : bool, f x = x) -> forall b : bool, f (f b) = b)). 138 | idtac "Assumptions:". 139 | Abort. 140 | Print Assumptions identity_fn_applied_twice. 141 | Goal True. 142 | idtac " ". 143 | 144 | idtac "#> Manually graded: negation_fn_applied_twice". 145 | idtac "Possible points: 1". 146 | print_manual_grade manual_grade_for_negation_fn_applied_twice. 147 | idtac " ". 148 | 149 | idtac "------------------- binary --------------------". 150 | idtac " ". 151 | 152 | idtac "#> Manually graded: binary". 153 | idtac "Possible points: 3". 154 | print_manual_grade manual_grade_for_binary. 155 | idtac " ". 156 | 157 | idtac " ". 158 | 159 | idtac "Max points - standard: 15". 160 | idtac "Max points - advanced: 15". 161 | Abort. 162 | -------------------------------------------------------------------------------- /Bib.v: -------------------------------------------------------------------------------- 1 | (** * Bib: Bibliography *) 2 | 3 | (* ################################################################# *) 4 | (** * Resources cited in this volume *) 5 | 6 | (** 7 | 8 | [Bertot 2004] Interactive Theorem Proving and Program Development: 9 | Coq'Art: The Calculus of Inductive Constructions, by Yves Bertot and 10 | Pierre Casteran. Springer-Verlag, 2004. 11 | http://tinyurl.com/z3o7nqu 12 | 13 | [Chlipala 2013] Certified Programming with Dependent Types, by 14 | Adam Chlipala. MIT Press. 2013. http://tinyurl.com/zqdnyg2 15 | 16 | [Lipovaca 2011] Learn You a Haskell for Great Good! A Beginner's 17 | Guide, by Miran Lipovaca, No Starch Press, April 2011. 18 | http://learnyouahaskell.com 19 | 20 | [O'Sullivan 2008] Bryan O'Sullivan, John Goerzen, and Don Stewart: 21 | Real world Haskell - code you can believe in. O'Reilly 22 | 2008. http://book.realworldhaskell.org 23 | 24 | [Pugh 1991] Pugh, William. "The Omega test: a fast and practical 25 | integer programming algorithm for dependence analysis." Proceedings 26 | of the 1991 ACM/IEEE conference on Supercomputing. ACM, 1991. 27 | http://dl.acm.org/citation.cfm?id=125848 28 | 29 | [Wadler 2015] Philip Wadler. "Propositions as types." 30 | Communications of the ACM 58, no. 12 (2015): 75-84. 31 | http://dl.acm.org/citation.cfm?id=2699407 32 | 33 | *) 34 | 35 | -------------------------------------------------------------------------------- /BibTest.v: -------------------------------------------------------------------------------- 1 | Set Warnings "-notation-overridden,-parsing". 2 | From Coq Require Export String. 3 | From LF Require Import Bib. 4 | Parameter MISSING: Type. 5 | 6 | Module Check. 7 | 8 | Ltac check_type A B := 9 | match type of A with 10 | | context[MISSING] => idtac "Missing:" A 11 | | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] 12 | end. 13 | 14 | Ltac print_manual_grade A := 15 | match eval compute in A with 16 | | Some (pair ?S ?C) => 17 | idtac "Score:" S; 18 | match eval compute in C with 19 | | ""%string => idtac "Comment: None" 20 | | _ => idtac "Comment:" C 21 | end 22 | | None => 23 | idtac "Score: Ungraded"; 24 | idtac "Comment: None" 25 | end. 26 | 27 | End Check. 28 | 29 | From LF Require Import Bib. 30 | Import Check. 31 | 32 | Goal True. 33 | 34 | idtac " ". 35 | 36 | idtac "Max points - standard: 0". 37 | idtac "Max points - advanced: 0". 38 | Abort. 39 | -------------------------------------------------------------------------------- /Extraction.v: -------------------------------------------------------------------------------- 1 | (** * Extraction: Extracting ML from Coq *) 2 | 3 | (* ################################################################# *) 4 | (** * Basic Extraction *) 5 | 6 | (** In its simplest form, extracting an efficient program from one 7 | written in Coq is completely straightforward. 8 | 9 | First we say what language we want to extract into. Options are 10 | OCaml (the most mature), Haskell (mostly works), and Scheme (a bit 11 | out of date). *) 12 | 13 | Require Coq.extraction.Extraction. 14 | Extraction Language OCaml. 15 | 16 | (** Now we load up the Coq environment with some definitions, either 17 | directly or by importing them from other modules. *) 18 | 19 | Require Import Coq.Arith.Arith. 20 | Require Import Coq.Arith.EqNat. 21 | From LF Require Import ImpCEvalFun. 22 | 23 | (** Finally, we tell Coq the name of a definition to extract and the 24 | name of a file to put the extracted code into. *) 25 | 26 | Extraction "imp1.ml" ceval_step. 27 | 28 | (** When Coq processes this command, it generates a file [imp1.ml] 29 | containing an extracted version of [ceval_step], together with 30 | everything that it recursively depends on. Compile the present 31 | [.v] file and have a look at [imp1.ml] now. *) 32 | 33 | (* ################################################################# *) 34 | (** * Controlling Extraction of Specific Types *) 35 | 36 | (** We can tell Coq to extract certain [Inductive] definitions to 37 | specific OCaml types. For each one, we must say 38 | - how the Coq type itself should be represented in OCaml, and 39 | - how each constructor should be translated. *) 40 | 41 | Extract Inductive bool => "bool" [ "true" "false" ]. 42 | 43 | (** Also, for non-enumeration types (where the constructors take 44 | arguments), we give an OCaml expression that can be used as a 45 | "recursor" over elements of the type. (Think Church numerals.) *) 46 | 47 | Extract Inductive nat => "int" 48 | [ "0" "(fun x -> x + 1)" ] 49 | "(fun zero succ n -> 50 | if n=0 then zero () else succ (n-1))". 51 | 52 | (** We can also extract defined constants to specific OCaml terms or 53 | operators. *) 54 | 55 | Extract Constant plus => "( + )". 56 | Extract Constant mult => "( * )". 57 | Extract Constant beq_nat => "( = )". 58 | 59 | (** Important: It is entirely _your responsibility_ to make sure that 60 | the translations you're proving make sense. For example, it might 61 | be tempting to include this one 62 | 63 | Extract Constant minus => "( - )". 64 | 65 | but doing so could lead to serious confusion! (Why?) 66 | *) 67 | 68 | Extraction "imp2.ml" ceval_step. 69 | 70 | (** Have a look at the file [imp2.ml]. Notice how the fundamental 71 | definitions have changed from [imp1.ml]. *) 72 | 73 | (* ################################################################# *) 74 | (** * A Complete Example *) 75 | 76 | (** To use our extracted evaluator to run Imp programs, all we need to 77 | add is a tiny driver program that calls the evaluator and prints 78 | out the result. 79 | 80 | For simplicity, we'll print results by dumping out the first four 81 | memory locations in the final state. 82 | 83 | Also, to make it easier to type in examples, let's extract a 84 | parser from the [ImpParser] Coq module. To do this, we first need 85 | to set up the right correspondence between Coq strings and lists 86 | of OCaml characters. *) 87 | 88 | Require Import ExtrOcamlBasic. 89 | Require Import ExtrOcamlString. 90 | 91 | (** We also need one more variant of booleans. *) 92 | 93 | Extract Inductive sumbool => "bool" ["true" "false"]. 94 | 95 | (** The extraction is the same as always. *) 96 | 97 | From LF Require Import Imp. 98 | From LF Require Import ImpParser. 99 | 100 | From LF Require Import Maps. 101 | Definition empty_state := { --> 0 }. 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 we're using is not certified, since we didn't 123 | prove anything about it! *) 124 | 125 | (* ################################################################# *) 126 | (** * Going Further *) 127 | 128 | (** Further details about extraction can be found in the Extract 129 | chapter in _Verified Functional Algorithms_ (_Software 130 | Foundations_ volume 3). *) 131 | 132 | -------------------------------------------------------------------------------- /ExtractionTest.v: -------------------------------------------------------------------------------- 1 | Set Warnings "-notation-overridden,-parsing". 2 | From Coq Require Export String. 3 | From LF Require Import Extraction. 4 | Parameter MISSING: Type. 5 | 6 | Module Check. 7 | 8 | Ltac check_type A B := 9 | match type of A with 10 | | context[MISSING] => idtac "Missing:" A 11 | | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] 12 | end. 13 | 14 | Ltac print_manual_grade A := 15 | match eval compute in A with 16 | | Some (pair ?S ?C) => 17 | idtac "Score:" S; 18 | match eval compute in C with 19 | | ""%string => idtac "Comment: None" 20 | | _ => idtac "Comment:" C 21 | end 22 | | None => 23 | idtac "Score: Ungraded"; 24 | idtac "Comment: None" 25 | end. 26 | 27 | End Check. 28 | 29 | From LF Require Import Extraction. 30 | Import Check. 31 | 32 | Goal True. 33 | 34 | idtac " ". 35 | 36 | idtac "Max points - standard: 0". 37 | idtac "Max points - advanced: 0". 38 | Abort. 39 | -------------------------------------------------------------------------------- /ImpCEvalFun.v: -------------------------------------------------------------------------------- 1 | (** * ImpCEvalFun: An Evaluation Function for Imp *) 2 | 3 | (** We saw in the [Imp] chapter how a naive approach to defining a 4 | function representing evaluation for Imp runs into difficulties. 5 | There, we adopted the solution of changing from a functional to a 6 | relational definition of evaluation. In this optional chapter, we 7 | consider strategies for getting the functional approach to 8 | work. *) 9 | 10 | (* ################################################################# *) 11 | (** * A Broken Evaluator *) 12 | 13 | Require Import Coq.omega.Omega. 14 | Require Import Coq.Arith.Arith. 15 | From LF Require Import Imp Maps. 16 | 17 | (** Here was our first try at an evaluation function for commands, 18 | omitting [WHILE]. *) 19 | 20 | Fixpoint ceval_step1 (st : state) (c : com) : state := 21 | match c with 22 | | SKIP => 23 | st 24 | | l ::= a1 => 25 | st & { l --> (aeval st a1)} 26 | | c1 ;; c2 => 27 | let st' := ceval_step1 st c1 in 28 | ceval_step1 st' c2 29 | | IFB b THEN c1 ELSE c2 FI => 30 | if (beval st b) 31 | then ceval_step1 st c1 32 | else ceval_step1 st c2 33 | | WHILE b1 DO c1 END => 34 | st (* bogus *) 35 | end. 36 | 37 | (** As we remarked in chapter [Imp], in a traditional functional 38 | programming language like ML or Haskell we could write the WHILE 39 | case as follows: 40 | 41 | | WHILE b1 DO c1 END => if (beval st b1) then ceval_step1 st (c1;; 42 | WHILE b1 DO c1 END) else st 43 | 44 | Coq doesn't accept such a definition ([Error: Cannot guess 45 | decreasing argument of fix]) because the function we want to 46 | define is not guaranteed to terminate. Indeed, the changed 47 | [ceval_step1] function applied to the [loop] program from [Imp.v] 48 | would never terminate. Since Coq is not just a functional 49 | programming language, but also a consistent logic, any potentially 50 | non-terminating function needs to be rejected. Here is an 51 | invalid(!) Coq program showing what would go wrong if Coq allowed 52 | non-terminating recursive functions: 53 | 54 | Fixpoint loop_false (n : nat) : False := loop_false n. 55 | 56 | That is, propositions like [False] would become 57 | provable (e.g., [loop_false 0] would be a proof of [False]), which 58 | would be a disaster for Coq's logical consistency. 59 | 60 | Thus, because it doesn't terminate on all inputs, the full version 61 | of [ceval_step1] cannot be written in Coq -- at least not without 62 | one additional trick... *) 63 | 64 | (* ################################################################# *) 65 | (** * A Step-Indexed Evaluator *) 66 | 67 | (** The trick we need is to pass an _additional_ parameter to the 68 | evaluation function that tells it how long to run. Informally, we 69 | start the evaluator with a certain amount of "gas" in its tank, 70 | and we allow it to run until either it terminates in the usual way 71 | _or_ it runs out of gas, at which point we simply stop evaluating 72 | and say that the final result is the empty memory. (We could also 73 | say that the result is the current state at the point where the 74 | evaluator runs out of gas -- it doesn't really matter because the 75 | result is going to be wrong in either case!) *) 76 | 77 | Fixpoint ceval_step2 (st : state) (c : com) (i : nat) : state := 78 | match i with 79 | | O => { --> 0 } 80 | | S i' => 81 | match c with 82 | | SKIP => 83 | st 84 | | l ::= a1 => 85 | st & { l --> (aeval st a1) } 86 | | c1 ;; c2 => 87 | let st' := ceval_step2 st c1 i' in 88 | ceval_step2 st' c2 i' 89 | | IFB b THEN c1 ELSE c2 FI => 90 | if (beval st b) 91 | then ceval_step2 st c1 i' 92 | else ceval_step2 st c2 i' 93 | | WHILE b1 DO c1 END => 94 | if (beval st b1) 95 | then let st' := ceval_step2 st c1 i' in 96 | ceval_step2 st' c i' 97 | else st 98 | end 99 | end. 100 | 101 | (** _Note_: It is tempting to think that the index [i] here is 102 | counting the "number of steps of evaluation." But if you look 103 | closely you'll see that this is not the case: for example, in the 104 | rule for sequencing, the same [i] is passed to both recursive 105 | calls. Understanding the exact way that [i] is treated will be 106 | important in the proof of [ceval__ceval_step], which is given as 107 | an exercise below. 108 | 109 | One thing that is not so nice about this evaluator is that we 110 | can't tell, from its result, whether it stopped because the 111 | program terminated normally or because it ran out of gas. Our 112 | next version returns an [option state] instead of just a [state], 113 | so that we can distinguish between normal and abnormal 114 | termination. *) 115 | 116 | Fixpoint ceval_step3 (st : state) (c : com) (i : nat) 117 | : option state := 118 | match i with 119 | | O => None 120 | | S i' => 121 | match c with 122 | | SKIP => 123 | Some st 124 | | l ::= a1 => 125 | Some (st & { l --> (aeval st a1) }) 126 | | c1 ;; c2 => 127 | match (ceval_step3 st c1 i') with 128 | | Some st' => ceval_step3 st' c2 i' 129 | | None => None 130 | end 131 | | IFB b THEN c1 ELSE c2 FI => 132 | if (beval st b) 133 | then ceval_step3 st c1 i' 134 | else ceval_step3 st c2 i' 135 | | WHILE b1 DO c1 END => 136 | if (beval st b1) 137 | then match (ceval_step3 st c1 i') with 138 | | Some st' => ceval_step3 st' c i' 139 | | None => None 140 | end 141 | else Some st 142 | end 143 | end. 144 | 145 | (** We can improve the readability of this version by introducing a 146 | bit of auxiliary notation to hide the plumbing involved in 147 | repeatedly matching against optional states. *) 148 | 149 | Notation "'LETOPT' x <== e1 'IN' e2" 150 | := (match e1 with 151 | | Some x => e2 152 | | None => None 153 | end) 154 | (right associativity, at level 60). 155 | 156 | Fixpoint ceval_step (st : state) (c : com) (i : nat) 157 | : option state := 158 | match i with 159 | | O => None 160 | | S i' => 161 | match c with 162 | | SKIP => 163 | Some st 164 | | l ::= a1 => 165 | Some (st & { l --> (aeval st a1)}) 166 | | c1 ;; c2 => 167 | LETOPT st' <== ceval_step st c1 i' IN 168 | ceval_step st' c2 i' 169 | | IFB b THEN c1 ELSE c2 FI => 170 | if (beval st b) 171 | then ceval_step st c1 i' 172 | else ceval_step st c2 i' 173 | | WHILE b1 DO c1 END => 174 | if (beval st b1) 175 | then LETOPT st' <== ceval_step st c1 i' IN 176 | ceval_step st' c i' 177 | else Some st 178 | end 179 | end. 180 | 181 | Definition test_ceval (st:state) (c:com) := 182 | match ceval_step st c 500 with 183 | | None => None 184 | | Some st => Some (st X, st Y, st Z) 185 | end. 186 | 187 | (* Compute 188 | (test_ceval { --> 0 } 189 | (X ::= 2;; 190 | IFB (X <= 1) 191 | THEN Y ::= 3 192 | ELSE Z ::= 4 193 | FI)). 194 | ====> 195 | Some (2, 0, 4) *) 196 | 197 | (** **** Exercise: 2 stars, recommended (pup_to_n) *) 198 | (** Write an Imp program that sums the numbers from [1] to 199 | [X] (inclusive: [1 + 2 + ... + X]) in the variable [Y]. Make sure 200 | your solution satisfies the test that follows. *) 201 | 202 | Definition pup_to_n : com 203 | (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. 204 | 205 | (* 206 | 207 | Example pup_to_n_1 : 208 | test_ceval {X --> 5} pup_to_n 209 | = Some (0, 15, 0). 210 | Proof. reflexivity. Qed. 211 | *) 212 | (** [] *) 213 | 214 | (** **** Exercise: 2 stars, optional (peven) *) 215 | (** Write an [Imp] program that sets [Z] to [0] if [X] is even and 216 | sets [Z] to [1] otherwise. Use [test_ceval] to test your 217 | program. *) 218 | 219 | (* FILL IN HERE *) 220 | (** [] *) 221 | 222 | (* ################################################################# *) 223 | (** * Relational vs. Step-Indexed Evaluation *) 224 | 225 | (** As for arithmetic and boolean expressions, we'd hope that 226 | the two alternative definitions of evaluation would actually 227 | amount to the same thing in the end. This section shows that this 228 | is the case. *) 229 | 230 | Theorem ceval_step__ceval: forall c st st', 231 | (exists i, ceval_step st c i = Some st') -> 232 | c / st \\ st'. 233 | Proof. 234 | intros c st st' H. 235 | inversion H as [i E]. 236 | clear H. 237 | generalize dependent st'. 238 | generalize dependent st. 239 | generalize dependent c. 240 | induction i as [| i' ]. 241 | 242 | - (* i = 0 -- contradictory *) 243 | intros c st st' H. inversion H. 244 | 245 | - (* i = S i' *) 246 | intros c st st' H. 247 | destruct c; 248 | simpl in H; inversion H; subst; clear H. 249 | + (* SKIP *) apply E_Skip. 250 | + (* ::= *) apply E_Ass. reflexivity. 251 | 252 | + (* ;; *) 253 | destruct (ceval_step st c1 i') eqn:Heqr1. 254 | * (* Evaluation of r1 terminates normally *) 255 | apply E_Seq with s. 256 | apply IHi'. rewrite Heqr1. reflexivity. 257 | apply IHi'. simpl in H1. assumption. 258 | * (* Otherwise -- contradiction *) 259 | inversion H1. 260 | 261 | + (* IFB *) 262 | destruct (beval st b) eqn:Heqr. 263 | * (* r = true *) 264 | apply E_IfTrue. rewrite Heqr. reflexivity. 265 | apply IHi'. assumption. 266 | * (* r = false *) 267 | apply E_IfFalse. rewrite Heqr. reflexivity. 268 | apply IHi'. assumption. 269 | 270 | + (* WHILE *) destruct (beval st b) eqn :Heqr. 271 | * (* r = true *) 272 | destruct (ceval_step st c i') eqn:Heqr1. 273 | { (* r1 = Some s *) 274 | apply E_WhileTrue with s. rewrite Heqr. 275 | reflexivity. 276 | apply IHi'. rewrite Heqr1. reflexivity. 277 | apply IHi'. simpl in H1. assumption. } 278 | { (* r1 = None *) inversion H1. } 279 | * (* r = false *) 280 | inversion H1. 281 | apply E_WhileFalse. 282 | rewrite <- Heqr. subst. reflexivity. Qed. 283 | 284 | (** **** Exercise: 4 stars (ceval_step__ceval_inf) *) 285 | (** Write an informal proof of [ceval_step__ceval], following the 286 | usual template. (The template for case analysis on an inductively 287 | defined value should look the same as for induction, except that 288 | there is no induction hypothesis.) Make your proof communicate 289 | the main ideas to a human reader; do not simply transcribe the 290 | steps of the formal proof. *) 291 | 292 | (* FILL IN HERE *) 293 | 294 | (* Do not modify the following line: *) 295 | Definition manual_grade_for_ceval_step__ceval_inf : option (prod nat string) := None. 296 | (** [] *) 297 | 298 | Theorem ceval_step_more: forall i1 i2 st st' c, 299 | i1 <= i2 -> 300 | ceval_step st c i1 = Some st' -> 301 | ceval_step st c i2 = Some st'. 302 | Proof. 303 | induction i1 as [|i1']; intros i2 st st' c Hle Hceval. 304 | - (* i1 = 0 *) 305 | simpl in Hceval. inversion Hceval. 306 | - (* i1 = S i1' *) 307 | destruct i2 as [|i2']. inversion Hle. 308 | assert (Hle': i1' <= i2') by omega. 309 | destruct c. 310 | + (* SKIP *) 311 | simpl in Hceval. inversion Hceval. 312 | reflexivity. 313 | + (* ::= *) 314 | simpl in Hceval. inversion Hceval. 315 | reflexivity. 316 | + (* ;; *) 317 | simpl in Hceval. simpl. 318 | destruct (ceval_step st c1 i1') eqn:Heqst1'o. 319 | * (* st1'o = Some *) 320 | apply (IHi1' i2') in Heqst1'o; try assumption. 321 | rewrite Heqst1'o. simpl. simpl in Hceval. 322 | apply (IHi1' i2') in Hceval; try assumption. 323 | * (* st1'o = None *) 324 | inversion Hceval. 325 | 326 | + (* IFB *) 327 | simpl in Hceval. simpl. 328 | destruct (beval st b); apply (IHi1' i2') in Hceval; 329 | assumption. 330 | 331 | + (* WHILE *) 332 | simpl in Hceval. simpl. 333 | destruct (beval st b); try assumption. 334 | destruct (ceval_step st c i1') eqn: Heqst1'o. 335 | * (* st1'o = Some *) 336 | apply (IHi1' i2') in Heqst1'o; try assumption. 337 | rewrite -> Heqst1'o. simpl. simpl in Hceval. 338 | apply (IHi1' i2') in Hceval; try assumption. 339 | * (* i1'o = None *) 340 | simpl in Hceval. inversion Hceval. Qed. 341 | 342 | (** **** Exercise: 3 stars, recommended (ceval__ceval_step) *) 343 | (** Finish the following proof. You'll need [ceval_step_more] in a 344 | few places, as well as some basic facts about [<=] and [plus]. *) 345 | 346 | Theorem ceval__ceval_step: forall c st st', 347 | c / st \\ st' -> 348 | exists i, ceval_step st c i = Some st'. 349 | Proof. 350 | intros c st st' Hce. 351 | induction Hce. 352 | (* FILL IN HERE *) Admitted. 353 | (** [] *) 354 | 355 | Theorem ceval_and_ceval_step_coincide: forall c st st', 356 | c / st \\ st' 357 | <-> exists i, ceval_step st c i = Some st'. 358 | Proof. 359 | intros c st st'. 360 | split. apply ceval__ceval_step. apply ceval_step__ceval. 361 | Qed. 362 | 363 | (* ################################################################# *) 364 | (** * Determinism of Evaluation Again *) 365 | 366 | (** Using the fact that the relational and step-indexed definition of 367 | evaluation are the same, we can give a slicker proof that the 368 | evaluation _relation_ is deterministic. *) 369 | 370 | Theorem ceval_deterministic' : forall c st st1 st2, 371 | c / st \\ st1 -> 372 | c / st \\ st2 -> 373 | st1 = st2. 374 | Proof. 375 | intros c st st1 st2 He1 He2. 376 | apply ceval__ceval_step in He1. 377 | apply ceval__ceval_step in He2. 378 | inversion He1 as [i1 E1]. 379 | inversion He2 as [i2 E2]. 380 | apply ceval_step_more with (i2 := i1 + i2) in E1. 381 | apply ceval_step_more with (i2 := i1 + i2) in E2. 382 | rewrite E1 in E2. inversion E2. reflexivity. 383 | omega. omega. Qed. 384 | 385 | -------------------------------------------------------------------------------- /ImpCEvalFunTest.v: -------------------------------------------------------------------------------- 1 | Set Warnings "-notation-overridden,-parsing". 2 | From Coq Require Export String. 3 | From LF Require Import ImpCEvalFun. 4 | Parameter MISSING: Type. 5 | 6 | Module Check. 7 | 8 | Ltac check_type A B := 9 | match type of A with 10 | | context[MISSING] => idtac "Missing:" A 11 | | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] 12 | end. 13 | 14 | Ltac print_manual_grade A := 15 | match eval compute in A with 16 | | Some (pair ?S ?C) => 17 | idtac "Score:" S; 18 | match eval compute in C with 19 | | ""%string => idtac "Comment: None" 20 | | _ => idtac "Comment:" C 21 | end 22 | | None => 23 | idtac "Score: Ungraded"; 24 | idtac "Comment: None" 25 | end. 26 | 27 | End Check. 28 | 29 | From LF Require Import ImpCEvalFun. 30 | Import Check. 31 | 32 | Goal True. 33 | 34 | idtac "------------------- pup_to_n --------------------". 35 | idtac " ". 36 | 37 | idtac "#> pup_to_n". 38 | idtac "Possible points: 2". 39 | check_type @pup_to_n (Imp.com). 40 | idtac "Assumptions:". 41 | Abort. 42 | Print Assumptions pup_to_n. 43 | Goal True. 44 | idtac " ". 45 | 46 | idtac "------------------- ceval_step__ceval_inf --------------------". 47 | idtac " ". 48 | 49 | idtac "#> Manually graded: ceval_step__ceval_inf". 50 | idtac "Possible points: 4". 51 | print_manual_grade manual_grade_for_ceval_step__ceval_inf. 52 | idtac " ". 53 | 54 | idtac "------------------- ceval__ceval_step --------------------". 55 | idtac " ". 56 | 57 | idtac "#> ceval__ceval_step". 58 | idtac "Possible points: 3". 59 | check_type @ceval__ceval_step ( 60 | (forall (c : Imp.com) (st st' : Imp.state), 61 | Imp.ceval c st st' -> 62 | exists i : nat, ceval_step st c i = @Some Imp.state st')). 63 | idtac "Assumptions:". 64 | Abort. 65 | Print Assumptions ceval__ceval_step. 66 | Goal True. 67 | idtac " ". 68 | 69 | idtac " ". 70 | 71 | idtac "Max points - standard: 9". 72 | idtac "Max points - advanced: 9". 73 | Abort. 74 | -------------------------------------------------------------------------------- /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 abstract syntax trees defined by 6 | the datatypes [aexp], [bexp], and [com]. In this chapter, 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 | (** It is not important to understand all the details here (and 12 | accordingly, the explanations are fairly terse and there are no 13 | exercises). The main point is simply to demonstrate that it can 14 | be done. You are invited to look through the code -- most of it 15 | is not very complicated, though the parser relies on some 16 | "monadic" programming idioms that may require a little work to 17 | make out -- but most readers will probably want to just skim down 18 | to the Examples section at the very end to get the punchline. *) 19 | 20 | Set Warnings "-notation-overridden,-parsing". 21 | Require Import Coq.Strings.String. 22 | Require Import Coq.Strings.Ascii. 23 | Require Import Coq.Arith.Arith. 24 | Require Import Coq.Arith.EqNat. 25 | Require Import Coq.Lists.List. 26 | Import ListNotations. 27 | From LF Require Import Maps Imp. 28 | 29 | (* ################################################################# *) 30 | (** * Internals *) 31 | 32 | (* ================================================================= *) 33 | (** ** Lexical Analysis *) 34 | 35 | Definition isWhite (c : ascii) : bool := 36 | let n := nat_of_ascii c in 37 | orb (orb (beq_nat n 32) (* space *) 38 | (beq_nat n 9)) (* tab *) 39 | (orb (beq_nat n 10) (* linefeed *) 40 | (beq_nat n 13)). (* Carriage return. *) 41 | 42 | Notation "x '<=?' y" := (leb x y) 43 | (at level 70, no associativity) : nat_scope. 44 | 45 | Definition isLowerAlpha (c : ascii) : bool := 46 | let n := nat_of_ascii c in 47 | andb (97 <=? n) (n <=? 122). 48 | 49 | Definition isAlpha (c : ascii) : bool := 50 | let n := nat_of_ascii c in 51 | orb (andb (65 <=? n) (n <=? 90)) 52 | (andb (97 <=? n) (n <=? 122)). 53 | 54 | Definition isDigit (c : ascii) : bool := 55 | let n := nat_of_ascii c in 56 | andb (48 <=? n) (n <=? 57). 57 | 58 | Inductive chartype := white | alpha | digit | other. 59 | 60 | Definition classifyChar (c : ascii) : chartype := 61 | if isWhite c then 62 | white 63 | else if isAlpha c then 64 | alpha 65 | else if isDigit c then 66 | digit 67 | else 68 | other. 69 | 70 | Fixpoint list_of_string (s : string) : list ascii := 71 | match s with 72 | | EmptyString => [] 73 | | String c s => c :: (list_of_string s) 74 | end. 75 | 76 | Fixpoint string_of_list (xs : list ascii) : string := 77 | fold_right String EmptyString xs. 78 | 79 | Definition token := string. 80 | 81 | Fixpoint tokenize_helper (cls : chartype) (acc xs : list ascii) 82 | : list (list ascii) := 83 | let tk := match acc with [] => [] | _::_ => [rev acc] end in 84 | match xs with 85 | | [] => tk 86 | | (x::xs') => 87 | match cls, classifyChar x, x with 88 | | _, _, "(" => 89 | tk ++ ["("]::(tokenize_helper other [] xs') 90 | | _, _, ")" => 91 | tk ++ [")"]::(tokenize_helper other [] xs') 92 | | _, white, _ => 93 | tk ++ (tokenize_helper white [] xs') 94 | | alpha,alpha,x => 95 | tokenize_helper alpha (x::acc) xs' 96 | | digit,digit,x => 97 | tokenize_helper digit (x::acc) xs' 98 | | other,other,x => 99 | tokenize_helper other (x::acc) xs' 100 | | _,tp,x => 101 | tk ++ (tokenize_helper tp [x] xs') 102 | end 103 | end %char. 104 | 105 | Definition tokenize (s : string) : list string := 106 | map string_of_list (tokenize_helper white [] (list_of_string s)). 107 | 108 | Example tokenize_ex1 : 109 | tokenize "abc12=3 223*(3+(a+c))" %string 110 | = ["abc"; "12"; "="; "3"; "223"; 111 | "*"; "("; "3"; "+"; "("; 112 | "a"; "+"; "c"; ")"; ")"]%string. 113 | Proof. reflexivity. Qed. 114 | 115 | (* ================================================================= *) 116 | (** ** Parsing *) 117 | 118 | (* ----------------------------------------------------------------- *) 119 | (** *** Options With Errors *) 120 | 121 | (** An [option] type with error messages: *) 122 | 123 | Inductive optionE (X:Type) : Type := 124 | | SomeE : X -> optionE X 125 | | NoneE : string -> optionE X. 126 | 127 | Arguments SomeE {X}. 128 | Arguments NoneE {X}. 129 | 130 | (** Some syntactic sugar to make writing nested match-expressions on 131 | optionE more convenient. *) 132 | 133 | Notation "'DO' ( x , y ) <== e1 ; e2" 134 | := (match e1 with 135 | | SomeE (x,y) => e2 136 | | NoneE err => NoneE err 137 | end) 138 | (right associativity, at level 60). 139 | 140 | Notation "'DO' ( x , y ) <-- e1 ; e2 'OR' e3" 141 | := (match e1 with 142 | | SomeE (x,y) => e2 143 | | NoneE err => e3 144 | end) 145 | (right associativity, at level 60, e2 at next level). 146 | 147 | (* ----------------------------------------------------------------- *) 148 | (** *** Generic Combinators for Building Parsers *) 149 | 150 | Open Scope string_scope. 151 | 152 | Definition parser (T : Type) := 153 | list token -> optionE (T * list token). 154 | 155 | Fixpoint many_helper {T} (p : parser T) acc steps xs := 156 | match steps, p xs with 157 | | 0, _ => 158 | NoneE "Too many recursive calls" 159 | | _, NoneE _ => 160 | SomeE ((rev acc), xs) 161 | | S steps', SomeE (t, xs') => 162 | many_helper p (t::acc) steps' xs' 163 | end. 164 | 165 | (** A (step-indexed) parser that expects zero or more [p]s: *) 166 | 167 | Fixpoint many {T} (p : parser T) (steps : nat) : parser (list T) := 168 | many_helper p [] steps. 169 | 170 | (** A parser that expects a given token, followed by [p]: *) 171 | 172 | Definition firstExpect {T} (t : token) (p : parser T) 173 | : parser T := 174 | fun xs => match xs with 175 | | x::xs' => 176 | if string_dec x t 177 | then p xs' 178 | else NoneE ("expected '" ++ t ++ "'.") 179 | | [] => 180 | NoneE ("expected '" ++ t ++ "'.") 181 | end. 182 | 183 | (** A parser that expects a particular token: *) 184 | 185 | Definition expect (t : token) : parser unit := 186 | firstExpect t (fun xs => SomeE(tt, xs)). 187 | 188 | (* ----------------------------------------------------------------- *) 189 | (** *** A Recursive-Descent Parser for Imp *) 190 | 191 | (** Identifiers: *) 192 | 193 | Definition parseIdentifier (xs : list token) 194 | : optionE (string * list token) := 195 | match xs with 196 | | [] => NoneE "Expected identifier" 197 | | x::xs' => 198 | if forallb isLowerAlpha (list_of_string x) then 199 | SomeE (x, xs') 200 | else 201 | NoneE ("Illegal identifier:'" ++ x ++ "'") 202 | end. 203 | 204 | (** Numbers: *) 205 | 206 | Definition parseNumber (xs : list token) 207 | : optionE (nat * list token) := 208 | match xs with 209 | | [] => NoneE "Expected number" 210 | | x::xs' => 211 | if forallb isDigit (list_of_string x) then 212 | SomeE (fold_left 213 | (fun n d => 214 | 10 * n + (nat_of_ascii d - 215 | nat_of_ascii "0"%char)) 216 | (list_of_string x) 217 | 0, 218 | xs') 219 | else 220 | NoneE "Expected number" 221 | end. 222 | 223 | (** Parse arithmetic expressions *) 224 | 225 | Fixpoint parsePrimaryExp (steps:nat) 226 | (xs : list token) 227 | : optionE (aexp * list token) := 228 | match steps with 229 | | 0 => NoneE "Too many recursive calls" 230 | | S steps' => 231 | DO (i, rest) <-- parseIdentifier xs ; 232 | SomeE (AId i, rest) 233 | OR DO (n, rest) <-- parseNumber xs ; 234 | SomeE (ANum n, rest) 235 | OR (DO (e, rest) <== firstExpect "(" 236 | (parseSumExp steps') xs; 237 | DO (u, rest') <== expect ")" rest ; 238 | SomeE(e,rest')) 239 | end 240 | 241 | with parseProductExp (steps:nat) 242 | (xs : list token) := 243 | match steps with 244 | | 0 => NoneE "Too many recursive calls" 245 | | S steps' => 246 | DO (e, rest) <== 247 | parsePrimaryExp steps' xs ; 248 | DO (es, rest') <== 249 | many (firstExpect "*" (parsePrimaryExp steps')) 250 | steps' rest; 251 | SomeE (fold_left AMult es e, rest') 252 | end 253 | 254 | with parseSumExp (steps:nat) (xs : list token) := 255 | match steps with 256 | | 0 => NoneE "Too many recursive calls" 257 | | S steps' => 258 | DO (e, rest) <== 259 | parseProductExp steps' xs ; 260 | DO (es, rest') <== 261 | many (fun xs => 262 | DO (e,rest') <-- 263 | firstExpect "+" 264 | (parseProductExp steps') xs; 265 | SomeE ( (true, e), rest') 266 | OR DO (e,rest') <== 267 | firstExpect "-" 268 | (parseProductExp steps') xs; 269 | SomeE ( (false, e), rest')) 270 | steps' rest; 271 | SomeE (fold_left (fun e0 term => 272 | match term with 273 | (true, e) => APlus e0 e 274 | | (false, e) => AMinus e0 e 275 | end) 276 | es e, 277 | rest') 278 | end. 279 | 280 | Definition parseAExp := parseSumExp. 281 | 282 | (** Parsing boolean expressions: *) 283 | 284 | Fixpoint parseAtomicExp (steps:nat) 285 | (xs : list token) := 286 | match steps with 287 | | 0 => NoneE "Too many recursive calls" 288 | | S steps' => 289 | DO (u,rest) <-- expect "true" xs; 290 | SomeE (BTrue,rest) 291 | OR DO (u,rest) <-- expect "false" xs; 292 | SomeE (BFalse,rest) 293 | OR DO (e,rest) <-- 294 | firstExpect "!" 295 | (parseAtomicExp steps') 296 | xs; 297 | SomeE (BNot e, rest) 298 | OR DO (e,rest) <-- 299 | firstExpect "(" 300 | (parseConjunctionExp steps') xs; 301 | (DO (u,rest') <== expect ")" rest; 302 | SomeE (e, rest')) 303 | OR DO (e, rest) <== parseProductExp steps' xs; 304 | (DO (e', rest') <-- 305 | firstExpect "=" 306 | (parseAExp steps') rest; 307 | SomeE (BEq e e', rest') 308 | OR DO (e', rest') <-- 309 | firstExpect "<=" 310 | (parseAExp steps') rest; 311 | SomeE (BLe e e', rest') 312 | OR 313 | NoneE 314 | "Expected '=' or '<=' after arithmetic expression") 315 | end 316 | 317 | with parseConjunctionExp (steps:nat) 318 | (xs : list token) := 319 | match steps with 320 | | 0 => NoneE "Too many recursive calls" 321 | | S steps' => 322 | DO (e, rest) <== 323 | parseAtomicExp steps' xs ; 324 | DO (es, rest') <== 325 | many (firstExpect "&&" 326 | (parseAtomicExp steps')) 327 | steps' rest; 328 | SomeE (fold_left BAnd es e, rest') 329 | end. 330 | 331 | Definition parseBExp := parseConjunctionExp. 332 | 333 | Check parseConjunctionExp. 334 | 335 | Definition testParsing {X : Type} 336 | (p : nat -> 337 | list token -> 338 | optionE (X * list token)) 339 | (s : string) := 340 | let t := tokenize s in 341 | p 100 t. 342 | 343 | (* 344 | Eval compute in 345 | testParsing parseProductExp "x*y*(x*x)*x". 346 | 347 | Eval compute in 348 | testParsing parseConjunctionExp "not((x=x||x*x<=(x*x)*x)&&x=x". 349 | *) 350 | 351 | (** Parsing commands: *) 352 | 353 | Fixpoint parseSimpleCommand (steps:nat) 354 | (xs : list token) := 355 | match steps with 356 | | 0 => NoneE "Too many recursive calls" 357 | | S steps' => 358 | DO (u, rest) <-- expect "SKIP" xs; 359 | SomeE (SKIP, rest) 360 | OR DO (e,rest) <-- 361 | firstExpect "IFB" (parseBExp steps') xs; 362 | DO (c,rest') <== 363 | firstExpect "THEN" 364 | (parseSequencedCommand steps') rest; 365 | DO (c',rest'') <== 366 | firstExpect "ELSE" 367 | (parseSequencedCommand steps') rest'; 368 | DO (u,rest''') <== 369 | expect "END" rest''; 370 | SomeE(IFB e THEN c ELSE c' FI, rest''') 371 | OR DO (e,rest) <-- 372 | firstExpect "WHILE" 373 | (parseBExp steps') xs; 374 | DO (c,rest') <== 375 | firstExpect "DO" 376 | (parseSequencedCommand steps') rest; 377 | DO (u,rest'') <== 378 | expect "END" rest'; 379 | SomeE(WHILE e DO c END, rest'') 380 | OR DO (i, rest) <== 381 | parseIdentifier xs; 382 | DO (e, rest') <== 383 | firstExpect ":=" (parseAExp steps') rest; 384 | SomeE(i ::= e, rest') 385 | end 386 | 387 | with parseSequencedCommand (steps:nat) 388 | (xs : list token) := 389 | match steps with 390 | | 0 => NoneE "Too many recursive calls" 391 | | S steps' => 392 | DO (c, rest) <== 393 | parseSimpleCommand steps' xs; 394 | DO (c', rest') <-- 395 | firstExpect ";;" 396 | (parseSequencedCommand steps') rest; 397 | SomeE(c ;; c', rest') 398 | OR 399 | SomeE(c, rest) 400 | end. 401 | 402 | Definition bignumber := 1000. 403 | 404 | Definition parse (str : string) : optionE (com * list token) := 405 | let tokens := tokenize str in 406 | parseSequencedCommand bignumber tokens. 407 | 408 | (* ################################################################# *) 409 | (** * Examples *) 410 | 411 | Example eg1 : parse " 412 | IFB x = y + 1 + 2 - y * 6 + 3 THEN 413 | x := x * 1;; 414 | y := 0 415 | ELSE 416 | SKIP 417 | END " 418 | = 419 | SomeE ( 420 | IFB "x" = "y" + 1 + 2 - "y" * 6 + 3 THEN 421 | "x" ::= "x" * 1;; 422 | "y" ::= 0 423 | ELSE 424 | SKIP 425 | FI, 426 | []). 427 | Proof. reflexivity. Qed. 428 | 429 | -------------------------------------------------------------------------------- /ImpParserTest.v: -------------------------------------------------------------------------------- 1 | Set Warnings "-notation-overridden,-parsing". 2 | From Coq Require Export String. 3 | From LF Require Import ImpParser. 4 | Parameter MISSING: Type. 5 | 6 | Module Check. 7 | 8 | Ltac check_type A B := 9 | match type of A with 10 | | context[MISSING] => idtac "Missing:" A 11 | | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] 12 | end. 13 | 14 | Ltac print_manual_grade A := 15 | match eval compute in A with 16 | | Some (pair ?S ?C) => 17 | idtac "Score:" S; 18 | match eval compute in C with 19 | | ""%string => idtac "Comment: None" 20 | | _ => idtac "Comment:" C 21 | end 22 | | None => 23 | idtac "Score: Ungraded"; 24 | idtac "Comment: None" 25 | end. 26 | 27 | End Check. 28 | 29 | From LF Require Import ImpParser. 30 | Import Check. 31 | 32 | Goal True. 33 | 34 | idtac " ". 35 | 36 | idtac "Max points - standard: 0". 37 | idtac "Max points - advanced: 0". 38 | Abort. 39 | -------------------------------------------------------------------------------- /ImpTest.v: -------------------------------------------------------------------------------- 1 | Set Warnings "-notation-overridden,-parsing". 2 | From Coq Require Export String. 3 | From LF Require Import Imp. 4 | Parameter MISSING: Type. 5 | 6 | Module Check. 7 | 8 | Ltac check_type A B := 9 | match type of A with 10 | | context[MISSING] => idtac "Missing:" A 11 | | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] 12 | end. 13 | 14 | Ltac print_manual_grade A := 15 | match eval compute in A with 16 | | Some (pair ?S ?C) => 17 | idtac "Score:" S; 18 | match eval compute in C with 19 | | ""%string => idtac "Comment: None" 20 | | _ => idtac "Comment:" C 21 | end 22 | | None => 23 | idtac "Score: Ungraded"; 24 | idtac "Comment: None" 25 | end. 26 | 27 | End Check. 28 | 29 | From LF Require Import Imp. 30 | Import Check. 31 | 32 | Goal True. 33 | 34 | idtac "------------------- optimize_0plus_b_sound --------------------". 35 | idtac " ". 36 | 37 | idtac "#> AExp.optimize_0plus_b_sound". 38 | idtac "Possible points: 3". 39 | check_type @AExp.optimize_0plus_b_sound ( 40 | (forall b : AExp.bexp, AExp.beval (AExp.optimize_0plus_b b) = AExp.beval b)). 41 | idtac "Assumptions:". 42 | Abort. 43 | Print Assumptions AExp.optimize_0plus_b_sound. 44 | Goal True. 45 | idtac " ". 46 | 47 | idtac "------------------- bevalR --------------------". 48 | idtac " ". 49 | 50 | idtac "#> AExp.beval_iff_bevalR". 51 | idtac "Possible points: 3". 52 | check_type @AExp.beval_iff_bevalR ( 53 | (forall (b : AExp.bexp) (bv : bool), AExp.bevalR b bv <-> AExp.beval b = bv)). 54 | idtac "Assumptions:". 55 | Abort. 56 | Print Assumptions AExp.beval_iff_bevalR. 57 | Goal True. 58 | idtac " ". 59 | 60 | idtac "------------------- ceval_example2 --------------------". 61 | idtac " ". 62 | 63 | idtac "#> ceval_example2". 64 | idtac "Possible points: 2". 65 | check_type @ceval_example2 ( 66 | ((X ::= 0;; Y ::= 1;; Z ::= 2) / @Maps.t_empty nat 0 \\ 67 | {X --> 0; Y --> 1; Z --> 2})). 68 | idtac "Assumptions:". 69 | Abort. 70 | Print Assumptions ceval_example2. 71 | Goal True. 72 | idtac " ". 73 | 74 | idtac "------------------- XtimesYinZ_spec --------------------". 75 | idtac " ". 76 | 77 | idtac "#> Manually graded: XtimesYinZ_spec". 78 | idtac "Possible points: 3". 79 | print_manual_grade manual_grade_for_XtimesYinZ_spec. 80 | idtac " ". 81 | 82 | idtac "------------------- loop_never_stops --------------------". 83 | idtac " ". 84 | 85 | idtac "#> loop_never_stops". 86 | idtac "Possible points: 3". 87 | check_type @loop_never_stops ((forall st st' : state, ~ loop / st \\ st')). 88 | idtac "Assumptions:". 89 | Abort. 90 | Print Assumptions loop_never_stops. 91 | Goal True. 92 | idtac " ". 93 | 94 | idtac "------------------- no_whiles_eqv --------------------". 95 | idtac " ". 96 | 97 | idtac "#> no_whiles_eqv". 98 | idtac "Possible points: 3". 99 | check_type @no_whiles_eqv ((forall c : com, no_whiles c = true <-> no_whilesR c)). 100 | idtac "Assumptions:". 101 | Abort. 102 | Print Assumptions no_whiles_eqv. 103 | Goal True. 104 | idtac " ". 105 | 106 | idtac "------------------- no_whiles_terminating --------------------". 107 | idtac " ". 108 | 109 | idtac "#> Manually graded: no_whiles_terminating". 110 | idtac "Possible points: 4". 111 | print_manual_grade manual_grade_for_no_whiles_terminating. 112 | idtac " ". 113 | 114 | idtac "------------------- stack_compiler --------------------". 115 | idtac " ". 116 | 117 | idtac "#> s_execute1". 118 | idtac "Possible points: 0.5". 119 | check_type @s_execute1 ( 120 | (s_execute (@Maps.t_empty nat 0) (@nil nat) 121 | (SPush 5 :: (SPush 3 :: SPush 1 :: SMinus :: @nil sinstr)%list) = 122 | (2 :: 5 :: @nil nat)%list)). 123 | idtac "Assumptions:". 124 | Abort. 125 | Print Assumptions s_execute1. 126 | Goal True. 127 | idtac " ". 128 | 129 | idtac "#> s_execute2". 130 | idtac "Possible points: 0.5". 131 | check_type @s_execute2 ( 132 | (s_execute {X --> 3} (3 :: (4 :: @nil nat)%list) 133 | (SPush 4 :: (SLoad X :: SMult :: SPlus :: @nil sinstr)%list) = 134 | (15 :: 4 :: @nil nat)%list)). 135 | idtac "Assumptions:". 136 | Abort. 137 | Print Assumptions s_execute2. 138 | Goal True. 139 | idtac " ". 140 | 141 | idtac "#> s_compile1". 142 | idtac "Possible points: 2". 143 | check_type @s_compile1 ( 144 | (s_compile (X - 2 * Y) = 145 | (SLoad X :: SPush 2 :: SLoad Y :: SMult :: SMinus :: @nil sinstr)%list)). 146 | idtac "Assumptions:". 147 | Abort. 148 | Print Assumptions s_compile1. 149 | Goal True. 150 | idtac " ". 151 | 152 | idtac "------------------- stack_compiler_correct --------------------". 153 | idtac " ". 154 | 155 | idtac "#> s_compile_correct". 156 | idtac "Advanced". 157 | idtac "Possible points: 4". 158 | check_type @s_compile_correct ( 159 | (forall (st : state) (e : aexp), 160 | s_execute st (@nil nat) (s_compile e) = (aeval st e :: @nil nat)%list)). 161 | idtac "Assumptions:". 162 | Abort. 163 | Print Assumptions s_compile_correct. 164 | Goal True. 165 | idtac " ". 166 | 167 | idtac "------------------- break_imp --------------------". 168 | idtac " ". 169 | 170 | idtac "#> BreakImp.break_ignore". 171 | idtac "Advanced". 172 | idtac "Possible points: 1". 173 | check_type @BreakImp.break_ignore ( 174 | (forall (c : BreakImp.com) (st st' : state) (s : BreakImp.result), 175 | BreakImp.ceval (BreakImp.CSeq BreakImp.CBreak c) st s st' -> st = st')). 176 | idtac "Assumptions:". 177 | Abort. 178 | Print Assumptions BreakImp.break_ignore. 179 | Goal True. 180 | idtac " ". 181 | 182 | idtac "#> BreakImp.while_continue". 183 | idtac "Advanced". 184 | idtac "Possible points: 1". 185 | check_type @BreakImp.while_continue ( 186 | (forall (b : bexp) (c : BreakImp.com) (st st' : state) (s : BreakImp.result), 187 | BreakImp.ceval (BreakImp.CWhile b c) st s st' -> s = BreakImp.SContinue)). 188 | idtac "Assumptions:". 189 | Abort. 190 | Print Assumptions BreakImp.while_continue. 191 | Goal True. 192 | idtac " ". 193 | 194 | idtac "#> BreakImp.while_stops_on_break". 195 | idtac "Advanced". 196 | idtac "Possible points: 2". 197 | check_type @BreakImp.while_stops_on_break ( 198 | (forall (b : bexp) (c : BreakImp.com) (st st' : state), 199 | beval st b = true -> 200 | BreakImp.ceval c st BreakImp.SBreak st' -> 201 | BreakImp.ceval (BreakImp.CWhile b c) st BreakImp.SContinue st')). 202 | idtac "Assumptions:". 203 | Abort. 204 | Print Assumptions BreakImp.while_stops_on_break. 205 | Goal True. 206 | idtac " ". 207 | 208 | idtac " ". 209 | 210 | idtac "Max points - standard: 24". 211 | idtac "Max points - advanced: 32". 212 | Abort. 213 | -------------------------------------------------------------------------------- /IndPrinciplesTest.v: -------------------------------------------------------------------------------- 1 | Set Warnings "-notation-overridden,-parsing". 2 | From Coq Require Export String. 3 | From LF Require Import IndPrinciples. 4 | Parameter MISSING: Type. 5 | 6 | Module Check. 7 | 8 | Ltac check_type A B := 9 | match type of A with 10 | | context[MISSING] => idtac "Missing:" A 11 | | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] 12 | end. 13 | 14 | Ltac print_manual_grade A := 15 | match eval compute in A with 16 | | Some (pair ?S ?C) => 17 | idtac "Score:" S; 18 | match eval compute in C with 19 | | ""%string => idtac "Comment: None" 20 | | _ => idtac "Comment:" C 21 | end 22 | | None => 23 | idtac "Score: Ungraded"; 24 | idtac "Comment: None" 25 | end. 26 | 27 | End Check. 28 | 29 | From LF Require Import IndPrinciples. 30 | Import Check. 31 | 32 | Goal True. 33 | 34 | idtac " ". 35 | 36 | idtac "Max points - standard: 0". 37 | idtac "Max points - advanced: 0". 38 | Abort. 39 | -------------------------------------------------------------------------------- /IndPropTest.v: -------------------------------------------------------------------------------- 1 | Set Warnings "-notation-overridden,-parsing". 2 | From Coq Require Export String. 3 | From LF Require Import IndProp. 4 | Parameter MISSING: Type. 5 | 6 | Module Check. 7 | 8 | Ltac check_type A B := 9 | match type of A with 10 | | context[MISSING] => idtac "Missing:" A 11 | | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] 12 | end. 13 | 14 | Ltac print_manual_grade A := 15 | match eval compute in A with 16 | | Some (pair ?S ?C) => 17 | idtac "Score:" S; 18 | match eval compute in C with 19 | | ""%string => idtac "Comment: None" 20 | | _ => idtac "Comment:" C 21 | end 22 | | None => 23 | idtac "Score: Ungraded"; 24 | idtac "Comment: None" 25 | end. 26 | 27 | End Check. 28 | 29 | From LF Require Import IndProp. 30 | Import Check. 31 | 32 | Goal True. 33 | 34 | idtac "------------------- ev_double --------------------". 35 | idtac " ". 36 | 37 | idtac "#> ev_double". 38 | idtac "Possible points: 1". 39 | check_type @ev_double ((forall n : nat, ev (double n))). 40 | idtac "Assumptions:". 41 | Abort. 42 | Print Assumptions ev_double. 43 | Goal True. 44 | idtac " ". 45 | 46 | idtac "------------------- SSSSev__even --------------------". 47 | idtac " ". 48 | 49 | idtac "#> SSSSev__even". 50 | idtac "Possible points: 1". 51 | check_type @SSSSev__even ((forall n : nat, ev (S (S (S (S n)))) -> ev n)). 52 | idtac "Assumptions:". 53 | Abort. 54 | Print Assumptions SSSSev__even. 55 | Goal True. 56 | idtac " ". 57 | 58 | idtac "------------------- even5_nonsense --------------------". 59 | idtac " ". 60 | 61 | idtac "#> even5_nonsense". 62 | idtac "Possible points: 1". 63 | check_type @even5_nonsense ((ev 5 -> 2 + 2 = 9)). 64 | idtac "Assumptions:". 65 | Abort. 66 | Print Assumptions even5_nonsense. 67 | Goal True. 68 | idtac " ". 69 | 70 | idtac "------------------- ev_sum --------------------". 71 | idtac " ". 72 | 73 | idtac "#> ev_sum". 74 | idtac "Possible points: 2". 75 | check_type @ev_sum ((forall n m : nat, ev n -> ev m -> ev (n + m))). 76 | idtac "Assumptions:". 77 | Abort. 78 | Print Assumptions ev_sum. 79 | Goal True. 80 | idtac " ". 81 | 82 | idtac "------------------- ev_ev__ev --------------------". 83 | idtac " ". 84 | 85 | idtac "#> ev_ev__ev". 86 | idtac "Advanced". 87 | idtac "Possible points: 3". 88 | check_type @ev_ev__ev ((forall n m : nat, ev (n + m) -> ev n -> ev m)). 89 | idtac "Assumptions:". 90 | Abort. 91 | Print Assumptions ev_ev__ev. 92 | Goal True. 93 | idtac " ". 94 | 95 | idtac "------------------- R_provability --------------------". 96 | idtac " ". 97 | 98 | idtac "#> Manually graded: R.R_provability". 99 | idtac "Possible points: 3". 100 | print_manual_grade R.manual_grade_for_R_provability. 101 | idtac " ". 102 | 103 | idtac "------------------- subsequence --------------------". 104 | idtac " ". 105 | 106 | idtac "#> Manually graded: subsequence". 107 | idtac "Advanced". 108 | idtac "Possible points: 4". 109 | print_manual_grade manual_grade_for_subsequence. 110 | idtac " ". 111 | 112 | idtac "------------------- exp_match_ex1 --------------------". 113 | idtac " ". 114 | 115 | idtac "#> empty_is_empty". 116 | idtac "Possible points: 1". 117 | check_type @empty_is_empty ((forall (T : Type) (s : list T), ~ (s =~ @EmptySet T))). 118 | idtac "Assumptions:". 119 | Abort. 120 | Print Assumptions empty_is_empty. 121 | Goal True. 122 | idtac " ". 123 | 124 | idtac "#> MUnion'". 125 | idtac "Possible points: 1". 126 | check_type @MUnion' ( 127 | (forall (T : Type) (s : list T) (re1 re2 : @reg_exp T), 128 | s =~ re1 \/ s =~ re2 -> s =~ @Union T re1 re2)). 129 | idtac "Assumptions:". 130 | Abort. 131 | Print Assumptions MUnion'. 132 | Goal True. 133 | idtac " ". 134 | 135 | idtac "#> MStar'". 136 | idtac "Possible points: 1". 137 | check_type @MStar' ( 138 | (forall (T : Type) (ss : list (list T)) (re : @reg_exp T), 139 | (forall s : list T, @In (list T) s ss -> s =~ re) -> 140 | @fold (list T) (list T) (@app T) ss [ ] =~ @Star T re)). 141 | idtac "Assumptions:". 142 | Abort. 143 | Print Assumptions MStar'. 144 | Goal True. 145 | idtac " ". 146 | 147 | idtac "------------------- re_not_empty --------------------". 148 | idtac " ". 149 | 150 | idtac "#> re_not_empty". 151 | idtac "Possible points: 2". 152 | check_type @re_not_empty ((forall T : Type, @reg_exp T -> bool)). 153 | idtac "Assumptions:". 154 | Abort. 155 | Print Assumptions re_not_empty. 156 | Goal True. 157 | idtac " ". 158 | 159 | idtac "#> re_not_empty_correct". 160 | idtac "Possible points: 2". 161 | check_type @re_not_empty_correct ( 162 | (forall (T : Type) (re : @reg_exp T), 163 | (exists s : list T, s =~ re) <-> @re_not_empty T re = true)). 164 | idtac "Assumptions:". 165 | Abort. 166 | Print Assumptions re_not_empty_correct. 167 | Goal True. 168 | idtac " ". 169 | 170 | idtac "------------------- pumping --------------------". 171 | idtac " ". 172 | 173 | idtac "#> Pumping.pumping". 174 | idtac "Advanced". 175 | idtac "Possible points: 5". 176 | check_type @Pumping.pumping ( 177 | (forall (T : Type) (re : @reg_exp T) (s : list T), 178 | s =~ re -> 179 | @Pumping.pumping_constant T re <= @length T s -> 180 | exists s1 s2 s3 : list T, 181 | s = s1 ++ s2 ++ s3 /\ 182 | s2 <> [ ] /\ (forall m : nat, s1 ++ @Pumping.napp T m s2 ++ s3 =~ re))). 183 | idtac "Assumptions:". 184 | Abort. 185 | Print Assumptions Pumping.pumping. 186 | Goal True. 187 | idtac " ". 188 | 189 | idtac "------------------- reflect_iff --------------------". 190 | idtac " ". 191 | 192 | idtac "#> reflect_iff". 193 | idtac "Possible points: 2". 194 | check_type @reflect_iff ((forall (P : Prop) (b : bool), reflect P b -> P <-> b = true)). 195 | idtac "Assumptions:". 196 | Abort. 197 | Print Assumptions reflect_iff. 198 | Goal True. 199 | idtac " ". 200 | 201 | idtac "------------------- beq_natP_practice --------------------". 202 | idtac " ". 203 | 204 | idtac "#> beq_natP_practice". 205 | idtac "Possible points: 3". 206 | check_type @beq_natP_practice ( 207 | (forall (n : nat) (l : list nat), count n l = 0 -> ~ @In nat n l)). 208 | idtac "Assumptions:". 209 | Abort. 210 | Print Assumptions beq_natP_practice. 211 | Goal True. 212 | idtac " ". 213 | 214 | idtac "------------------- nostutter_defn --------------------". 215 | idtac " ". 216 | 217 | idtac "#> Manually graded: nostutter". 218 | idtac "Possible points: 3". 219 | print_manual_grade manual_grade_for_nostutter. 220 | idtac " ". 221 | 222 | idtac "------------------- filter_challenge --------------------". 223 | idtac " ". 224 | 225 | idtac "#> Manually graded: filter_challenge". 226 | idtac "Advanced". 227 | idtac "Possible points: 4". 228 | print_manual_grade manual_grade_for_filter_challenge. 229 | idtac " ". 230 | 231 | idtac " ". 232 | 233 | idtac "Max points - standard: 23". 234 | idtac "Max points - advanced: 39". 235 | Abort. 236 | -------------------------------------------------------------------------------- /InductionTest.v: -------------------------------------------------------------------------------- 1 | Set Warnings "-notation-overridden,-parsing". 2 | From Coq Require Export String. 3 | From LF Require Import Induction. 4 | Parameter MISSING: Type. 5 | 6 | Module Check. 7 | 8 | Ltac check_type A B := 9 | match type of A with 10 | | context[MISSING] => idtac "Missing:" A 11 | | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] 12 | end. 13 | 14 | Ltac print_manual_grade A := 15 | match eval compute in A with 16 | | Some (pair ?S ?C) => 17 | idtac "Score:" S; 18 | match eval compute in C with 19 | | ""%string => idtac "Comment: None" 20 | | _ => idtac "Comment:" C 21 | end 22 | | None => 23 | idtac "Score: Ungraded"; 24 | idtac "Comment: None" 25 | end. 26 | 27 | End Check. 28 | 29 | From LF Require Import Induction. 30 | Import Check. 31 | 32 | Goal True. 33 | 34 | idtac "------------------- basic_induction --------------------". 35 | idtac " ". 36 | 37 | idtac "#> mult_0_r". 38 | idtac "Possible points: 0.5". 39 | check_type @mult_0_r ((forall n : nat, n * 0 = 0)). 40 | idtac "Assumptions:". 41 | Abort. 42 | Print Assumptions mult_0_r. 43 | Goal True. 44 | idtac " ". 45 | 46 | idtac "#> plus_n_Sm". 47 | idtac "Possible points: 0.5". 48 | check_type @plus_n_Sm ((forall n m : nat, S (n + m) = n + S m)). 49 | idtac "Assumptions:". 50 | Abort. 51 | Print Assumptions plus_n_Sm. 52 | Goal True. 53 | idtac " ". 54 | 55 | idtac "#> plus_comm". 56 | idtac "Possible points: 0.5". 57 | check_type @plus_comm ((forall n m : nat, n + m = m + n)). 58 | idtac "Assumptions:". 59 | Abort. 60 | Print Assumptions plus_comm. 61 | Goal True. 62 | idtac " ". 63 | 64 | idtac "#> plus_assoc". 65 | idtac "Possible points: 0.5". 66 | check_type @plus_assoc ((forall n m p : nat, n + (m + p) = n + m + p)). 67 | idtac "Assumptions:". 68 | Abort. 69 | Print Assumptions plus_assoc. 70 | Goal True. 71 | idtac " ". 72 | 73 | idtac "------------------- double_plus --------------------". 74 | idtac " ". 75 | 76 | idtac "#> double_plus". 77 | idtac "Possible points: 2". 78 | check_type @double_plus ((forall n : nat, double n = n + n)). 79 | idtac "Assumptions:". 80 | Abort. 81 | Print Assumptions double_plus. 82 | Goal True. 83 | idtac " ". 84 | 85 | idtac "------------------- destruct_induction --------------------". 86 | idtac " ". 87 | 88 | idtac "#> Manually graded: destruct_induction". 89 | idtac "Possible points: 1". 90 | print_manual_grade manual_grade_for_destruct_induction. 91 | idtac " ". 92 | 93 | idtac "------------------- plus_comm_informal --------------------". 94 | idtac " ". 95 | 96 | idtac "#> Manually graded: plus_comm_informal". 97 | idtac "Advanced". 98 | idtac "Possible points: 2". 99 | print_manual_grade manual_grade_for_plus_comm_informal. 100 | idtac " ". 101 | 102 | idtac "------------------- mult_comm --------------------". 103 | idtac " ". 104 | 105 | idtac "#> mult_comm". 106 | idtac "Possible points: 3". 107 | check_type @mult_comm ((forall m n : nat, m * n = n * m)). 108 | idtac "Assumptions:". 109 | Abort. 110 | Print Assumptions mult_comm. 111 | Goal True. 112 | idtac " ". 113 | 114 | idtac "------------------- binary_commute --------------------". 115 | idtac " ". 116 | 117 | idtac "#> Manually graded: binary_commute". 118 | idtac "Possible points: 3". 119 | print_manual_grade manual_grade_for_binary_commute. 120 | idtac " ". 121 | 122 | idtac "------------------- binary_inverse --------------------". 123 | idtac " ". 124 | 125 | idtac "#> Manually graded: binary_inverse". 126 | idtac "Advanced". 127 | idtac "Possible points: 5". 128 | print_manual_grade manual_grade_for_binary_inverse. 129 | idtac " ". 130 | 131 | idtac " ". 132 | 133 | idtac "Max points - standard: 11". 134 | idtac "Max points - advanced: 18". 135 | Abort. 136 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is 8 | furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in 11 | all copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 19 | THE SOFTWARE. 20 | -------------------------------------------------------------------------------- /ListsTest.v: -------------------------------------------------------------------------------- 1 | Set Warnings "-notation-overridden,-parsing". 2 | From Coq Require Export String. 3 | From LF Require Import Lists. 4 | Parameter MISSING: Type. 5 | 6 | Module Check. 7 | 8 | Ltac check_type A B := 9 | match type of A with 10 | | context[MISSING] => idtac "Missing:" A 11 | | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] 12 | end. 13 | 14 | Ltac print_manual_grade A := 15 | match eval compute in A with 16 | | Some (pair ?S ?C) => 17 | idtac "Score:" S; 18 | match eval compute in C with 19 | | ""%string => idtac "Comment: None" 20 | | _ => idtac "Comment:" C 21 | end 22 | | None => 23 | idtac "Score: Ungraded"; 24 | idtac "Comment: None" 25 | end. 26 | 27 | End Check. 28 | 29 | From LF Require Import Lists. 30 | Import Check. 31 | 32 | Goal True. 33 | 34 | idtac "------------------- snd_fst_is_swap --------------------". 35 | idtac " ". 36 | 37 | idtac "#> NatList.snd_fst_is_swap". 38 | idtac "Possible points: 1". 39 | check_type @NatList.snd_fst_is_swap ( 40 | (forall p : NatList.natprod, 41 | NatList.pair (NatList.snd p) (NatList.fst p) = NatList.swap_pair p)). 42 | idtac "Assumptions:". 43 | Abort. 44 | Print Assumptions NatList.snd_fst_is_swap. 45 | Goal True. 46 | idtac " ". 47 | 48 | idtac "------------------- list_funs --------------------". 49 | idtac " ". 50 | 51 | idtac "#> NatList.test_nonzeros". 52 | idtac "Possible points: 0.5". 53 | check_type @NatList.test_nonzeros ( 54 | (NatList.nonzeros 55 | (NatList.cons 0 56 | (NatList.cons 1 57 | (NatList.cons 0 58 | (NatList.cons 2 59 | (NatList.cons 3 (NatList.cons 0 (NatList.cons 0 NatList.nil))))))) = 60 | NatList.cons 1 (NatList.cons 2 (NatList.cons 3 NatList.nil)))). 61 | idtac "Assumptions:". 62 | Abort. 63 | Print Assumptions NatList.test_nonzeros. 64 | Goal True. 65 | idtac " ". 66 | 67 | idtac "#> NatList.test_oddmembers". 68 | idtac "Possible points: 0.5". 69 | check_type @NatList.test_oddmembers ( 70 | (NatList.oddmembers 71 | (NatList.cons 0 72 | (NatList.cons 1 73 | (NatList.cons 0 74 | (NatList.cons 2 75 | (NatList.cons 3 (NatList.cons 0 (NatList.cons 0 NatList.nil))))))) = 76 | NatList.cons 1 (NatList.cons 3 NatList.nil))). 77 | idtac "Assumptions:". 78 | Abort. 79 | Print Assumptions NatList.test_oddmembers. 80 | Goal True. 81 | idtac " ". 82 | 83 | idtac "#> NatList.test_countoddmembers2". 84 | idtac "Possible points: 0.5". 85 | check_type @NatList.test_countoddmembers2 ( 86 | (NatList.countoddmembers 87 | (NatList.cons 0 (NatList.cons 2 (NatList.cons 4 NatList.nil))) = 0)). 88 | idtac "Assumptions:". 89 | Abort. 90 | Print Assumptions NatList.test_countoddmembers2. 91 | Goal True. 92 | idtac " ". 93 | 94 | idtac "#> NatList.test_countoddmembers3". 95 | idtac "Possible points: 0.5". 96 | check_type @NatList.test_countoddmembers3 ((NatList.countoddmembers NatList.nil = 0)). 97 | idtac "Assumptions:". 98 | Abort. 99 | Print Assumptions NatList.test_countoddmembers3. 100 | Goal True. 101 | idtac " ". 102 | 103 | idtac "------------------- alternate --------------------". 104 | idtac " ". 105 | 106 | idtac "#> NatList.test_alternate1". 107 | idtac "Advanced". 108 | idtac "Possible points: 1". 109 | check_type @NatList.test_alternate1 ( 110 | (NatList.alternate 111 | (NatList.cons 1 (NatList.cons 2 (NatList.cons 3 NatList.nil))) 112 | (NatList.cons 4 (NatList.cons 5 (NatList.cons 6 NatList.nil))) = 113 | NatList.cons 1 114 | (NatList.cons 4 115 | (NatList.cons 2 116 | (NatList.cons 5 (NatList.cons 3 (NatList.cons 6 NatList.nil))))))). 117 | idtac "Assumptions:". 118 | Abort. 119 | Print Assumptions NatList.test_alternate1. 120 | Goal True. 121 | idtac " ". 122 | 123 | idtac "#> NatList.test_alternate2". 124 | idtac "Advanced". 125 | idtac "Possible points: 1". 126 | check_type @NatList.test_alternate2 ( 127 | (NatList.alternate (NatList.cons 1 NatList.nil) 128 | (NatList.cons 4 (NatList.cons 5 (NatList.cons 6 NatList.nil))) = 129 | NatList.cons 1 130 | (NatList.cons 4 (NatList.cons 5 (NatList.cons 6 NatList.nil))))). 131 | idtac "Assumptions:". 132 | Abort. 133 | Print Assumptions NatList.test_alternate2. 134 | Goal True. 135 | idtac " ". 136 | 137 | idtac "#> NatList.test_alternate4". 138 | idtac "Advanced". 139 | idtac "Possible points: 1". 140 | check_type @NatList.test_alternate4 ( 141 | (NatList.alternate NatList.nil 142 | (NatList.cons 20 (NatList.cons 30 NatList.nil)) = 143 | NatList.cons 20 (NatList.cons 30 NatList.nil))). 144 | idtac "Assumptions:". 145 | Abort. 146 | Print Assumptions NatList.test_alternate4. 147 | Goal True. 148 | idtac " ". 149 | 150 | idtac "------------------- bag_functions --------------------". 151 | idtac " ". 152 | 153 | idtac "#> NatList.test_count2". 154 | idtac "Possible points: 0.5". 155 | check_type @NatList.test_count2 ( 156 | (NatList.count 6 157 | (NatList.cons 1 158 | (NatList.cons 2 159 | (NatList.cons 3 160 | (NatList.cons 1 (NatList.cons 4 (NatList.cons 1 NatList.nil)))))) = 161 | 0)). 162 | idtac "Assumptions:". 163 | Abort. 164 | Print Assumptions NatList.test_count2. 165 | Goal True. 166 | idtac " ". 167 | 168 | idtac "#> NatList.test_sum1". 169 | idtac "Possible points: 0.5". 170 | check_type @NatList.test_sum1 ( 171 | (NatList.count 1 172 | (NatList.sum 173 | (NatList.cons 1 (NatList.cons 2 (NatList.cons 3 NatList.nil))) 174 | (NatList.cons 1 (NatList.cons 4 (NatList.cons 1 NatList.nil)))) = 3)). 175 | idtac "Assumptions:". 176 | Abort. 177 | Print Assumptions NatList.test_sum1. 178 | Goal True. 179 | idtac " ". 180 | 181 | idtac "#> NatList.test_add1". 182 | idtac "Possible points: 0.5". 183 | check_type @NatList.test_add1 ( 184 | (NatList.count 1 185 | (NatList.add 1 186 | (NatList.cons 1 (NatList.cons 4 (NatList.cons 1 NatList.nil)))) = 3)). 187 | idtac "Assumptions:". 188 | Abort. 189 | Print Assumptions NatList.test_add1. 190 | Goal True. 191 | idtac " ". 192 | 193 | idtac "#> NatList.test_add2". 194 | idtac "Possible points: 0.5". 195 | check_type @NatList.test_add2 ( 196 | (NatList.count 5 197 | (NatList.add 1 198 | (NatList.cons 1 (NatList.cons 4 (NatList.cons 1 NatList.nil)))) = 0)). 199 | idtac "Assumptions:". 200 | Abort. 201 | Print Assumptions NatList.test_add2. 202 | Goal True. 203 | idtac " ". 204 | 205 | idtac "#> NatList.test_member1". 206 | idtac "Possible points: 0.5". 207 | check_type @NatList.test_member1 ( 208 | (NatList.member 1 209 | (NatList.cons 1 (NatList.cons 4 (NatList.cons 1 NatList.nil))) = true)). 210 | idtac "Assumptions:". 211 | Abort. 212 | Print Assumptions NatList.test_member1. 213 | Goal True. 214 | idtac " ". 215 | 216 | idtac "#> NatList.test_member2". 217 | idtac "Possible points: 0.5". 218 | check_type @NatList.test_member2 ( 219 | (NatList.member 2 220 | (NatList.cons 1 (NatList.cons 4 (NatList.cons 1 NatList.nil))) = false)). 221 | idtac "Assumptions:". 222 | Abort. 223 | Print Assumptions NatList.test_member2. 224 | Goal True. 225 | idtac " ". 226 | 227 | idtac "------------------- bag_theorem --------------------". 228 | idtac " ". 229 | 230 | idtac "#> Manually graded: NatList.bag_theorem". 231 | idtac "Possible points: 3". 232 | print_manual_grade NatList.manual_grade_for_bag_theorem. 233 | idtac " ". 234 | 235 | idtac "------------------- list_exercises --------------------". 236 | idtac " ". 237 | 238 | idtac "#> NatList.app_nil_r". 239 | idtac "Possible points: 0.5". 240 | check_type @NatList.app_nil_r ( 241 | (forall l : NatList.natlist, NatList.app l NatList.nil = l)). 242 | idtac "Assumptions:". 243 | Abort. 244 | Print Assumptions NatList.app_nil_r. 245 | Goal True. 246 | idtac " ". 247 | 248 | idtac "#> NatList.rev_app_distr". 249 | idtac "Possible points: 0.5". 250 | check_type @NatList.rev_app_distr ( 251 | (forall l1 l2 : NatList.natlist, 252 | NatList.rev (NatList.app l1 l2) = 253 | NatList.app (NatList.rev l2) (NatList.rev l1))). 254 | idtac "Assumptions:". 255 | Abort. 256 | Print Assumptions NatList.rev_app_distr. 257 | Goal True. 258 | idtac " ". 259 | 260 | idtac "#> NatList.rev_involutive". 261 | idtac "Possible points: 0.5". 262 | check_type @NatList.rev_involutive ( 263 | (forall l : NatList.natlist, NatList.rev (NatList.rev l) = l)). 264 | idtac "Assumptions:". 265 | Abort. 266 | Print Assumptions NatList.rev_involutive. 267 | Goal True. 268 | idtac " ". 269 | 270 | idtac "#> NatList.app_assoc4". 271 | idtac "Possible points: 0.5". 272 | check_type @NatList.app_assoc4 ( 273 | (forall l1 l2 l3 l4 : NatList.natlist, 274 | NatList.app l1 (NatList.app l2 (NatList.app l3 l4)) = 275 | NatList.app (NatList.app (NatList.app l1 l2) l3) l4)). 276 | idtac "Assumptions:". 277 | Abort. 278 | Print Assumptions NatList.app_assoc4. 279 | Goal True. 280 | idtac " ". 281 | 282 | idtac "#> NatList.nonzeros_app". 283 | idtac "Possible points: 1". 284 | check_type @NatList.nonzeros_app ( 285 | (forall l1 l2 : NatList.natlist, 286 | NatList.nonzeros (NatList.app l1 l2) = 287 | NatList.app (NatList.nonzeros l1) (NatList.nonzeros l2))). 288 | idtac "Assumptions:". 289 | Abort. 290 | Print Assumptions NatList.nonzeros_app. 291 | Goal True. 292 | idtac " ". 293 | 294 | idtac "------------------- beq_natlist --------------------". 295 | idtac " ". 296 | 297 | idtac "#> NatList.beq_natlist_refl". 298 | idtac "Possible points: 2". 299 | check_type @NatList.beq_natlist_refl ( 300 | (forall l : NatList.natlist, true = NatList.beq_natlist l l)). 301 | idtac "Assumptions:". 302 | Abort. 303 | Print Assumptions NatList.beq_natlist_refl. 304 | Goal True. 305 | idtac " ". 306 | 307 | idtac "------------------- count_member_nonzero --------------------". 308 | idtac " ". 309 | 310 | idtac "#> NatList.count_member_nonzero". 311 | idtac "Possible points: 1". 312 | check_type @NatList.count_member_nonzero ( 313 | (forall s : NatList.bag, leb 1 (NatList.count 1 (NatList.cons 1 s)) = true)). 314 | idtac "Assumptions:". 315 | Abort. 316 | Print Assumptions NatList.count_member_nonzero. 317 | Goal True. 318 | idtac " ". 319 | 320 | idtac "------------------- remove_does_not_increase_count --------------------". 321 | idtac " ". 322 | 323 | idtac "#> NatList.remove_does_not_increase_count". 324 | idtac "Advanced". 325 | idtac "Possible points: 3". 326 | check_type @NatList.remove_does_not_increase_count ( 327 | (forall s : NatList.bag, 328 | leb (NatList.count 0 (NatList.remove_one 0 s)) (NatList.count 0 s) = true)). 329 | idtac "Assumptions:". 330 | Abort. 331 | Print Assumptions NatList.remove_does_not_increase_count. 332 | Goal True. 333 | idtac " ". 334 | 335 | idtac "------------------- rev_injective --------------------". 336 | idtac " ". 337 | 338 | idtac "#> Manually graded: NatList.rev_injective". 339 | idtac "Advanced". 340 | idtac "Possible points: 4". 341 | print_manual_grade NatList.manual_grade_for_rev_injective. 342 | idtac " ". 343 | 344 | idtac "------------------- hd_error --------------------". 345 | idtac " ". 346 | 347 | idtac "#> NatList.hd_error". 348 | idtac "Possible points: 2". 349 | check_type @NatList.hd_error ((NatList.natlist -> NatList.natoption)). 350 | idtac "Assumptions:". 351 | Abort. 352 | Print Assumptions NatList.hd_error. 353 | Goal True. 354 | idtac " ". 355 | 356 | idtac "------------------- beq_id_refl --------------------". 357 | idtac " ". 358 | 359 | idtac "#> beq_id_refl". 360 | idtac "Possible points: 1". 361 | check_type @beq_id_refl ((forall x : id, true = beq_id x x)). 362 | idtac "Assumptions:". 363 | Abort. 364 | Print Assumptions beq_id_refl. 365 | Goal True. 366 | idtac " ". 367 | 368 | idtac "------------------- update_eq --------------------". 369 | idtac " ". 370 | 371 | idtac "#> PartialMap.update_eq". 372 | idtac "Possible points: 1". 373 | check_type @PartialMap.update_eq ( 374 | (forall (d : PartialMap.partial_map) (x : id) (v : nat), 375 | PartialMap.find x (PartialMap.update d x v) = NatList.Some v)). 376 | idtac "Assumptions:". 377 | Abort. 378 | Print Assumptions PartialMap.update_eq. 379 | Goal True. 380 | idtac " ". 381 | 382 | idtac "------------------- update_neq --------------------". 383 | idtac " ". 384 | 385 | idtac "#> PartialMap.update_neq". 386 | idtac "Possible points: 1". 387 | check_type @PartialMap.update_neq ( 388 | (forall (d : PartialMap.partial_map) (x y : id) (o : nat), 389 | beq_id x y = false -> 390 | PartialMap.find x (PartialMap.update d y o) = PartialMap.find x d)). 391 | idtac "Assumptions:". 392 | Abort. 393 | Print Assumptions PartialMap.update_neq. 394 | Goal True. 395 | idtac " ". 396 | 397 | idtac "------------------- baz_num_elts --------------------". 398 | idtac " ". 399 | 400 | idtac "#> Manually graded: baz_num_elts". 401 | idtac "Possible points: 2". 402 | print_manual_grade manual_grade_for_baz_num_elts. 403 | idtac " ". 404 | 405 | idtac " ". 406 | 407 | idtac "Max points - standard: 22". 408 | idtac "Max points - advanced: 32". 409 | Abort. 410 | -------------------------------------------------------------------------------- /LogicTest.v: -------------------------------------------------------------------------------- 1 | Set Warnings "-notation-overridden,-parsing". 2 | From Coq Require Export String. 3 | From LF Require Import Logic. 4 | Parameter MISSING: Type. 5 | 6 | Module Check. 7 | 8 | Ltac check_type A B := 9 | match type of A with 10 | | context[MISSING] => idtac "Missing:" A 11 | | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] 12 | end. 13 | 14 | Ltac print_manual_grade A := 15 | match eval compute in A with 16 | | Some (pair ?S ?C) => 17 | idtac "Score:" S; 18 | match eval compute in C with 19 | | ""%string => idtac "Comment: None" 20 | | _ => idtac "Comment:" C 21 | end 22 | | None => 23 | idtac "Score: Ungraded"; 24 | idtac "Comment: None" 25 | end. 26 | 27 | End Check. 28 | 29 | From LF Require Import Logic. 30 | Import Check. 31 | 32 | Goal True. 33 | 34 | idtac "------------------- and_exercise --------------------". 35 | idtac " ". 36 | 37 | idtac "#> and_exercise". 38 | idtac "Possible points: 2". 39 | check_type @and_exercise ((forall n m : nat, n + m = 0 -> n = 0 /\ m = 0)). 40 | idtac "Assumptions:". 41 | Abort. 42 | Print Assumptions and_exercise. 43 | Goal True. 44 | idtac " ". 45 | 46 | idtac "------------------- and_assoc --------------------". 47 | idtac " ". 48 | 49 | idtac "#> and_assoc". 50 | idtac "Possible points: 2". 51 | check_type @and_assoc ((forall P Q R : Prop, P /\ Q /\ R -> (P /\ Q) /\ R)). 52 | idtac "Assumptions:". 53 | Abort. 54 | Print Assumptions and_assoc. 55 | Goal True. 56 | idtac " ". 57 | 58 | idtac "------------------- mult_eq_0 --------------------". 59 | idtac " ". 60 | 61 | idtac "#> mult_eq_0". 62 | idtac "Possible points: 1". 63 | check_type @mult_eq_0 ((forall n m : nat, n * m = 0 -> n = 0 \/ m = 0)). 64 | idtac "Assumptions:". 65 | Abort. 66 | Print Assumptions mult_eq_0. 67 | Goal True. 68 | idtac " ". 69 | 70 | idtac "------------------- or_commut --------------------". 71 | idtac " ". 72 | 73 | idtac "#> or_commut". 74 | idtac "Possible points: 1". 75 | check_type @or_commut ((forall P Q : Prop, P \/ Q -> Q \/ P)). 76 | idtac "Assumptions:". 77 | Abort. 78 | Print Assumptions or_commut. 79 | Goal True. 80 | idtac " ". 81 | 82 | idtac "------------------- double_neg_inf --------------------". 83 | idtac " ". 84 | 85 | idtac "#> Manually graded: double_neg_inf". 86 | idtac "Advanced". 87 | idtac "Possible points: 2". 88 | print_manual_grade manual_grade_for_double_neg_inf. 89 | idtac " ". 90 | 91 | idtac "------------------- contrapositive --------------------". 92 | idtac " ". 93 | 94 | idtac "#> contrapositive". 95 | idtac "Possible points: 2". 96 | check_type @contrapositive ((forall P Q : Prop, (P -> Q) -> ~ Q -> ~ P)). 97 | idtac "Assumptions:". 98 | Abort. 99 | Print Assumptions contrapositive. 100 | Goal True. 101 | idtac " ". 102 | 103 | idtac "------------------- not_both_true_and_false --------------------". 104 | idtac " ". 105 | 106 | idtac "#> not_both_true_and_false". 107 | idtac "Possible points: 1". 108 | check_type @not_both_true_and_false ((forall P : Prop, ~ (P /\ ~ P))). 109 | idtac "Assumptions:". 110 | Abort. 111 | Print Assumptions not_both_true_and_false. 112 | Goal True. 113 | idtac " ". 114 | 115 | idtac "------------------- informal_not_PNP --------------------". 116 | idtac " ". 117 | 118 | idtac "#> Manually graded: informal_not_PNP". 119 | idtac "Advanced". 120 | idtac "Possible points: 1". 121 | print_manual_grade manual_grade_for_informal_not_PNP. 122 | idtac " ". 123 | 124 | idtac "------------------- or_distributes_over_and --------------------". 125 | idtac " ". 126 | 127 | idtac "#> or_distributes_over_and". 128 | idtac "Possible points: 3". 129 | check_type @or_distributes_over_and ( 130 | (forall P Q R : Prop, P \/ Q /\ R <-> (P \/ Q) /\ (P \/ R))). 131 | idtac "Assumptions:". 132 | Abort. 133 | Print Assumptions or_distributes_over_and. 134 | Goal True. 135 | idtac " ". 136 | 137 | idtac "------------------- dist_not_exists --------------------". 138 | idtac " ". 139 | 140 | idtac "#> dist_not_exists". 141 | idtac "Possible points: 1". 142 | check_type @dist_not_exists ( 143 | (forall (X : Type) (P : X -> Prop), 144 | (forall x : X, P x) -> ~ (exists x : X, ~ P x))). 145 | idtac "Assumptions:". 146 | Abort. 147 | Print Assumptions dist_not_exists. 148 | Goal True. 149 | idtac " ". 150 | 151 | idtac "------------------- dist_exists_or --------------------". 152 | idtac " ". 153 | 154 | idtac "#> dist_exists_or". 155 | idtac "Possible points: 2". 156 | check_type @dist_exists_or ( 157 | (forall (X : Type) (P Q : X -> Prop), 158 | (exists x : X, P x \/ Q x) <-> (exists x : X, P x) \/ (exists x : X, Q x))). 159 | idtac "Assumptions:". 160 | Abort. 161 | Print Assumptions dist_exists_or. 162 | Goal True. 163 | idtac " ". 164 | 165 | idtac "------------------- In_map_iff --------------------". 166 | idtac " ". 167 | 168 | idtac "#> In_map_iff". 169 | idtac "Possible points: 2". 170 | check_type @In_map_iff ( 171 | (forall (A B : Type) (f : A -> B) (l : list A) (y : B), 172 | @In B y (@map A B f l) <-> (exists x : A, f x = y /\ @In A x l))). 173 | idtac "Assumptions:". 174 | Abort. 175 | Print Assumptions In_map_iff. 176 | Goal True. 177 | idtac " ". 178 | 179 | idtac "------------------- In_app_iff --------------------". 180 | idtac " ". 181 | 182 | idtac "#> In_app_iff". 183 | idtac "Possible points: 2". 184 | check_type @In_app_iff ( 185 | (forall (A : Type) (l l' : list A) (a : A), 186 | @In A a (l ++ l') <-> @In A a l \/ @In A a l')). 187 | idtac "Assumptions:". 188 | Abort. 189 | Print Assumptions In_app_iff. 190 | Goal True. 191 | idtac " ". 192 | 193 | idtac "------------------- All --------------------". 194 | idtac " ". 195 | 196 | idtac "#> All". 197 | idtac "Possible points: 3". 198 | check_type @All ((forall T : Type, (T -> Prop) -> list T -> Prop)). 199 | idtac "Assumptions:". 200 | Abort. 201 | Print Assumptions All. 202 | Goal True. 203 | idtac " ". 204 | 205 | idtac "------------------- combine_odd_even --------------------". 206 | idtac " ". 207 | 208 | idtac "#> combine_odd_even". 209 | idtac "Possible points: 3". 210 | check_type @combine_odd_even (((nat -> Prop) -> (nat -> Prop) -> nat -> Prop)). 211 | idtac "Assumptions:". 212 | Abort. 213 | Print Assumptions combine_odd_even. 214 | Goal True. 215 | idtac " ". 216 | 217 | idtac "------------------- tr_rev_correct --------------------". 218 | idtac " ". 219 | 220 | idtac "#> tr_rev_correct". 221 | idtac "Possible points: 4". 222 | check_type @tr_rev_correct ((forall X : Type, @tr_rev X = @rev X)). 223 | idtac "Assumptions:". 224 | Abort. 225 | Print Assumptions tr_rev_correct. 226 | Goal True. 227 | idtac " ". 228 | 229 | idtac "------------------- evenb_double_conv --------------------". 230 | idtac " ". 231 | 232 | idtac "#> evenb_double_conv". 233 | idtac "Possible points: 3". 234 | check_type @evenb_double_conv ( 235 | (forall n : nat, 236 | exists k : nat, n = (if evenb n then double k else S (double k)))). 237 | idtac "Assumptions:". 238 | Abort. 239 | Print Assumptions evenb_double_conv. 240 | Goal True. 241 | idtac " ". 242 | 243 | idtac "------------------- logical_connectives --------------------". 244 | idtac " ". 245 | 246 | idtac "#> andb_true_iff". 247 | idtac "Possible points: 1". 248 | check_type @andb_true_iff ( 249 | (forall b1 b2 : bool, b1 && b2 = true <-> b1 = true /\ b2 = true)). 250 | idtac "Assumptions:". 251 | Abort. 252 | Print Assumptions andb_true_iff. 253 | Goal True. 254 | idtac " ". 255 | 256 | idtac "#> orb_true_iff". 257 | idtac "Possible points: 1". 258 | check_type @orb_true_iff ( 259 | (forall b1 b2 : bool, b1 || b2 = true <-> b1 = true \/ b2 = true)). 260 | idtac "Assumptions:". 261 | Abort. 262 | Print Assumptions orb_true_iff. 263 | Goal True. 264 | idtac " ". 265 | 266 | idtac "------------------- beq_nat_false_iff --------------------". 267 | idtac " ". 268 | 269 | idtac "#> beq_nat_false_iff". 270 | idtac "Possible points: 1". 271 | check_type @beq_nat_false_iff ((forall x y : nat, beq_nat x y = false <-> x <> y)). 272 | idtac "Assumptions:". 273 | Abort. 274 | Print Assumptions beq_nat_false_iff. 275 | Goal True. 276 | idtac " ". 277 | 278 | idtac "------------------- beq_list --------------------". 279 | idtac " ". 280 | 281 | idtac "#> beq_list". 282 | idtac "Possible points: 3". 283 | check_type @beq_list ((forall A : Type, (A -> A -> bool) -> list A -> list A -> bool)). 284 | idtac "Assumptions:". 285 | Abort. 286 | Print Assumptions beq_list. 287 | Goal True. 288 | idtac " ". 289 | 290 | idtac "------------------- All_forallb --------------------". 291 | idtac " ". 292 | 293 | idtac "#> forallb_true_iff". 294 | idtac "Possible points: 2". 295 | check_type @forallb_true_iff ( 296 | (forall (X : Type) (test : X -> bool) (l : list X), 297 | @forallb X test l = true <-> @All X (fun x : X => test x = true) l)). 298 | idtac "Assumptions:". 299 | Abort. 300 | Print Assumptions forallb_true_iff. 301 | Goal True. 302 | idtac " ". 303 | 304 | idtac "------------------- excluded_middle_irrefutable --------------------". 305 | idtac " ". 306 | 307 | idtac "#> excluded_middle_irrefutable". 308 | idtac "Possible points: 3". 309 | check_type @excluded_middle_irrefutable ((forall P : Prop, ~ ~ (P \/ ~ P))). 310 | idtac "Assumptions:". 311 | Abort. 312 | Print Assumptions excluded_middle_irrefutable. 313 | Goal True. 314 | idtac " ". 315 | 316 | idtac "------------------- not_exists_dist --------------------". 317 | idtac " ". 318 | 319 | idtac "#> not_exists_dist". 320 | idtac "Advanced". 321 | idtac "Possible points: 3". 322 | check_type @not_exists_dist ( 323 | (excluded_middle -> 324 | forall (X : Type) (P : X -> Prop), 325 | ~ (exists x : X, ~ P x) -> forall x : X, P x)). 326 | idtac "Assumptions:". 327 | Abort. 328 | Print Assumptions not_exists_dist. 329 | Goal True. 330 | idtac " ". 331 | 332 | idtac " ". 333 | 334 | idtac "Max points - standard: 43". 335 | idtac "Max points - advanced: 49". 336 | Abort. 337 | -------------------------------------------------------------------------------- /Makefile.conf: -------------------------------------------------------------------------------- 1 | # This configuration file was generated by running: 2 | # coq_makefile -Q . LF OTHERFLAGS = '-Q . LF ' COQLIBS = '' -install none Preface.v Basics.v Induction.v Lists.v Poly.v Tactics.v Logic.v IndProp.v Maps.v ProofObjects.v IndPrinciples.v Rel.v Imp.v ImpParser.v ImpCEvalFun.v Extraction.v Auto.v Postscript.v Bib.v PrefaceTest.v BasicsTest.v InductionTest.v ListsTest.v PolyTest.v TacticsTest.v LogicTest.v IndPropTest.v MapsTest.v ProofObjectsTest.v IndPrinciplesTest.v RelTest.v ImpTest.v ImpParserTest.v ImpCEvalFunTest.v ExtractionTest.v AutoTest.v PostscriptTest.v BibTest.v -o Makefile 3 | 4 | 5 | ############################################################################### 6 | # # 7 | # Project files. # 8 | # # 9 | ############################################################################### 10 | 11 | COQMF_VFILES = Preface.v Basics.v Induction.v Lists.v Poly.v Tactics.v Logic.v IndProp.v Maps.v ProofObjects.v IndPrinciples.v Rel.v Imp.v ImpParser.v ImpCEvalFun.v Extraction.v Auto.v Postscript.v Bib.v PrefaceTest.v BasicsTest.v InductionTest.v ListsTest.v PolyTest.v TacticsTest.v LogicTest.v IndPropTest.v MapsTest.v ProofObjectsTest.v IndPrinciplesTest.v RelTest.v ImpTest.v ImpParserTest.v ImpCEvalFunTest.v ExtractionTest.v AutoTest.v PostscriptTest.v BibTest.v 12 | COQMF_MLIFILES = 13 | COQMF_MLFILES = 14 | COQMF_ML4FILES = 15 | COQMF_MLPACKFILES = 16 | COQMF_MLLIBFILES = 17 | COQMF_CMDLINE_VFILES = Preface.v Basics.v Induction.v Lists.v Poly.v Tactics.v Logic.v IndProp.v Maps.v ProofObjects.v IndPrinciples.v Rel.v Imp.v ImpParser.v ImpCEvalFun.v Extraction.v Auto.v Postscript.v Bib.v PrefaceTest.v BasicsTest.v InductionTest.v ListsTest.v PolyTest.v TacticsTest.v LogicTest.v IndPropTest.v MapsTest.v ProofObjectsTest.v IndPrinciplesTest.v RelTest.v ImpTest.v ImpParserTest.v ImpCEvalFunTest.v ExtractionTest.v AutoTest.v PostscriptTest.v BibTest.v 18 | 19 | ############################################################################### 20 | # # 21 | # Path directives (-I, -R, -Q). # 22 | # # 23 | ############################################################################### 24 | 25 | COQMF_OCAMLLIBS = 26 | COQMF_SRC_SUBDIRS = 27 | COQMF_COQLIBS = -Q . LF 28 | COQMF_COQLIBS_NOML = -Q . LF 29 | COQMF_CMDLINE_COQLIBS = -Q . LF 30 | 31 | ############################################################################### 32 | # # 33 | # Coq configuration. # 34 | # # 35 | ############################################################################### 36 | 37 | COQMF_LOCAL=0 38 | COQMF_COQLIB=/usr/lib/coq/ 39 | COQMF_DOCDIR=/usr/share/doc/coq/ 40 | COQMF_OCAMLFIND=/usr/bin/ocamlfind 41 | COQMF_CAMLP5O=/usr/bin/camlp5o 42 | COQMF_CAMLP5BIN=/usr/bin/ 43 | COQMF_CAMLP5LIB=/dev/null 44 | COQMF_CAMLP5OPTIONS=-loc loc 45 | COQMF_CAMLFLAGS=-thread -rectypes -w +a-4-9-27-41-42-44-45-48-50-58-59 -safe-string 46 | COQMF_HASNATDYNLINK=true 47 | COQMF_COQ_SRC_SUBDIRS=config dev lib clib kernel library engine pretyping interp parsing proofs tactics toplevel printing intf grammar ide stm vernac plugins/btauto plugins/cc plugins/derive plugins/extraction plugins/firstorder plugins/fourier plugins/funind plugins/ltac plugins/micromega plugins/nsatz plugins/omega plugins/quote plugins/romega plugins/rtauto plugins/setoid_ring plugins/ssr plugins/ssrmatching plugins/syntax plugins/xml 48 | COQMF_WINDRIVE= 49 | 50 | ############################################################################### 51 | # # 52 | # Extra variables. # 53 | # # 54 | ############################################################################### 55 | 56 | OTHERFLAGS = -Q . LF 57 | COQLIBS = 58 | COQMF_OTHERFLAGS = 59 | COQMF_INSTALLCOQDOCROOT = LF 60 | -------------------------------------------------------------------------------- /Maps.v: -------------------------------------------------------------------------------- 1 | (** * Maps: Total and Partial Maps *) 2 | 3 | (** _Maps_ (or _dictionaries_) are ubiquitous data structures both 4 | generally and in the theory of programming languages in 5 | particular; we're going to need them in many places in the coming 6 | chapters. They also make a nice case study using ideas we've seen 7 | in previous chapters, including building data structures out of 8 | higher-order functions (from [Basics] and [Poly]) and the use of 9 | reflection to streamline proofs (from [IndProp]). 10 | 11 | We'll define two flavors of maps: _total_ maps, which include a 12 | "default" element to be returned when a key being looked up 13 | doesn't exist, and _partial_ maps, which return an [option] to 14 | indicate success or failure. The latter is defined in terms of 15 | the former, using [None] as the default element. *) 16 | 17 | (* ################################################################# *) 18 | (** * The Coq Standard Library *) 19 | 20 | (** One small digression before we begin... 21 | 22 | Unlike the chapters we have seen so far, this one does not 23 | [Require Import] the chapter before it (and, transitively, all the 24 | earlier chapters). Instead, in this chapter and from now, on 25 | we're going to import the definitions and theorems we need 26 | directly from Coq's standard library stuff. You should not notice 27 | much difference, though, because we've been careful to name our 28 | own definitions and theorems the same as their counterparts in the 29 | standard library, wherever they overlap. *) 30 | 31 | Require Import Coq.Arith.Arith. 32 | Require Import Coq.Bool.Bool. 33 | Require Export Coq.Strings.String. 34 | Require Import Coq.Logic.FunctionalExtensionality. 35 | Require Import Coq.Lists.List. 36 | Import ListNotations. 37 | 38 | (** Documentation for the standard library can be found at 39 | http://coq.inria.fr/library/. 40 | 41 | The [Search] command is a good way to look for theorems involving 42 | objects of specific types. Take a minute now to experiment with it. *) 43 | 44 | (* ################################################################# *) 45 | (** * Identifiers *) 46 | 47 | (** First, we need a type for the keys that we use to index into our 48 | maps. For this purpose, we will simply use plain [string]s. *) 49 | 50 | (** To compare strings, we define the function [beq_string], which 51 | internally uses the function [string_dec] from Coq's string library. 52 | We then establish its fundamental properties. *) 53 | 54 | Definition beq_string x y := 55 | if string_dec x y then true else false. 56 | 57 | (** (The function [string_dec] comes from Coq's string library. 58 | If you check the result type of [string_dec], you'll see that it 59 | does not actually return a [bool], but rather a type that looks 60 | like [{x = y} + {x <> y}], called a [sumbool], which can be 61 | thought of as an "evidence-carrying boolean." Formally, an 62 | element of [sumbool] is either a proof that two things are equal 63 | or a proof that they are unequal, together with a tag indicating 64 | which. But for present purposes you can think of it as just a 65 | fancy [bool].) *) 66 | 67 | Theorem beq_string_refl : forall s, true = beq_string s s. 68 | Proof. intros s. unfold beq_string. destruct (string_dec s s) as [|Hs]. 69 | - reflexivity. 70 | - destruct Hs. reflexivity. 71 | Qed. 72 | 73 | (** The following useful property of [beq_string] follows from an 74 | analogous lemma about strings: *) 75 | 76 | Theorem beq_string_true_iff : forall x y : string, 77 | beq_string x y = true <-> x = y. 78 | Proof. 79 | intros x y. 80 | unfold beq_string. 81 | destruct (string_dec x y) as [|Hs]. 82 | - subst. split. reflexivity. reflexivity. 83 | - split. 84 | + intros contra. inversion contra. 85 | + intros H. inversion H. subst. destruct Hs. reflexivity. 86 | Qed. 87 | 88 | (** Similarly: *) 89 | 90 | Theorem beq_string_false_iff : forall x y : string, 91 | beq_string x y = false 92 | <-> x <> y. 93 | Proof. 94 | intros x y. rewrite <- beq_string_true_iff. 95 | rewrite not_true_iff_false. reflexivity. Qed. 96 | 97 | (** This useful variant follows just by rewriting: *) 98 | 99 | Theorem false_beq_string : forall x y : string, 100 | x <> y -> beq_string x y = false. 101 | Proof. 102 | intros x y. rewrite beq_string_false_iff. 103 | intros H. apply H. Qed. 104 | 105 | (* ################################################################# *) 106 | (** * Total Maps *) 107 | 108 | (** Our main job in this chapter will be to build a definition of 109 | partial maps that is similar in behavior to the one we saw in the 110 | [Lists] chapter, plus accompanying lemmas about its behavior. 111 | 112 | This time around, though, we're going to use _functions_, rather 113 | than lists of key-value pairs, to build maps. The advantage of 114 | this representation is that it offers a more _extensional_ view of 115 | maps, where two maps that respond to queries in the same way will 116 | be represented as literally the same thing (the very same function), 117 | rather than just "equivalent" data structures. This, in turn, 118 | simplifies proofs that use maps. *) 119 | 120 | (** We build partial maps in two steps. First, we define a type of 121 | _total maps_ that return a default value when we look up a key 122 | that is not present in the map. *) 123 | 124 | Definition total_map (A:Type) := string -> A. 125 | 126 | (** Intuitively, a total map over an element type [A] is just a 127 | function that can be used to look up [string]s, yielding [A]s. *) 128 | 129 | (** The function [t_empty] yields an empty total map, given a default 130 | element; this map always returns the default element when applied 131 | to any string. *) 132 | 133 | Definition t_empty {A:Type} (v : A) : total_map A := 134 | (fun _ => v). 135 | 136 | (** More interesting is the [update] function, which (as before) takes 137 | a map [m], a key [x], and a value [v] and returns a new map that 138 | takes [x] to [v] and takes every other key to whatever [m] does. *) 139 | 140 | Definition t_update {A:Type} (m : total_map A) 141 | (x : string) (v : A) := 142 | fun x' => if beq_string x x' then v else m x'. 143 | 144 | (** This definition is a nice example of higher-order programming: 145 | [t_update] takes a _function_ [m] and yields a new function 146 | [fun x' => ...] that behaves like the desired map. *) 147 | 148 | (** For example, we can build a map taking [string]s to [bool]s, where 149 | ["foo"] and ["bar"] are mapped to [true] and every other key is 150 | mapped to [false], like this: *) 151 | 152 | Definition examplemap := 153 | t_update (t_update (t_empty false) "foo" true) 154 | "bar" true. 155 | 156 | (** Next, let's introduce some new notations to facilitate working 157 | with maps. *) 158 | 159 | (** First, we will use the following notation to create an empty total map 160 | with a default value. *) 161 | Notation "{ --> d }" := (t_empty d) (at level 0). 162 | 163 | (** We then introduce a convenient notation for extending an existing 164 | map with some bindings. *) 165 | 166 | (** (The definition of the notation is a bit ugly, but because the 167 | notation mechanism of Coq is not very well suited for recursive 168 | notations, it's the best we can do.) *) 169 | 170 | Notation "m '&' { a --> x }" := 171 | (t_update m a x) (at level 20). 172 | Notation "m '&' { a --> x ; b --> y }" := 173 | (t_update (m & { a --> x }) b y) (at level 20). 174 | Notation "m '&' { a --> x ; b --> y ; c --> z }" := 175 | (t_update (m & { a --> x ; b --> y }) c z) (at level 20). 176 | Notation "m '&' { a --> x ; b --> y ; c --> z ; d --> t }" := 177 | (t_update (m & { a --> x ; b --> y ; c --> z }) d t) (at level 20). 178 | Notation "m '&' { a --> x ; b --> y ; c --> z ; d --> t ; e --> u }" := 179 | (t_update (m & { a --> x ; b --> y ; c --> z ; d --> t }) e u) (at level 20). 180 | Notation "m '&' { a --> x ; b --> y ; c --> z ; d --> t ; e --> u ; f --> v }" := 181 | (t_update (m & { a --> x ; b --> y ; c --> z ; d --> t ; e --> u }) f v) (at level 20). 182 | 183 | (** The [examplemap] above can now be defined as follows: *) 184 | 185 | Definition examplemap' := 186 | { --> false } & { "foo" --> true ; "bar" --> true }. 187 | 188 | (** This completes the definition of total maps. Note that we 189 | don't need to define a [find] operation because it is just 190 | function application! *) 191 | 192 | Example update_example1 : examplemap' "baz" = false. 193 | Proof. reflexivity. Qed. 194 | 195 | Example update_example2 : examplemap' "foo" = true. 196 | Proof. reflexivity. Qed. 197 | 198 | Example update_example3 : examplemap' "quux" = false. 199 | Proof. reflexivity. Qed. 200 | 201 | Example update_example4 : examplemap' "bar" = true. 202 | Proof. reflexivity. Qed. 203 | 204 | (** To use maps in later chapters, we'll need several fundamental 205 | facts about how they behave. *) 206 | 207 | (** Even if you don't work the following exercises, make sure 208 | you thoroughly understand the statements of the lemmas! *) 209 | 210 | (** (Some of the proofs require the functional extensionality axiom, 211 | which is discussed in the [Logic] chapter.) *) 212 | 213 | (** **** Exercise: 1 star, optional (t_apply_empty) *) 214 | (** First, the empty map returns its default element for all keys: *) 215 | 216 | Lemma t_apply_empty: forall (A:Type) (x: string) (v: A), { --> v } x = v. 217 | Proof. 218 | (* FILL IN HERE *) Admitted. 219 | (** [] *) 220 | 221 | (** **** Exercise: 2 stars, optional (t_update_eq) *) 222 | (** Next, if we update a map [m] at a key [x] with a new value [v] 223 | and then look up [x] in the map resulting from the [update], we 224 | get back [v]: *) 225 | 226 | Lemma t_update_eq : forall A (m: total_map A) x v, 227 | (m & {x --> v}) x = v. 228 | Proof. 229 | (* FILL IN HERE *) Admitted. 230 | (** [] *) 231 | 232 | (** **** Exercise: 2 stars, optional (t_update_neq) *) 233 | (** On the other hand, if we update a map [m] at a key [x1] and then 234 | look up a _different_ key [x2] in the resulting map, we get the 235 | same result that [m] would have given: *) 236 | 237 | Theorem t_update_neq : forall (X:Type) v x1 x2 238 | (m : total_map X), 239 | x1 <> x2 -> 240 | (m & {x1 --> v}) x2 = m x2. 241 | Proof. 242 | (* FILL IN HERE *) Admitted. 243 | (** [] *) 244 | 245 | (** **** Exercise: 2 stars, optional (t_update_shadow) *) 246 | (** If we update a map [m] at a key [x] with a value [v1] and then 247 | update again with the same key [x] and another value [v2], the 248 | resulting map behaves the same (gives the same result when applied 249 | to any key) as the simpler map obtained by performing just 250 | the second [update] on [m]: *) 251 | 252 | Lemma t_update_shadow : forall A (m: total_map A) v1 v2 x, 253 | m & {x --> v1 ; x --> v2} = m & {x --> v2}. 254 | Proof. 255 | (* FILL IN HERE *) Admitted. 256 | (** [] *) 257 | 258 | (** For the final two lemmas about total maps, it's convenient to use 259 | the reflection idioms introduced in chapter [IndProp]. We begin 260 | by proving a fundamental _reflection lemma_ relating the equality 261 | proposition on [id]s with the boolean function [beq_id]. *) 262 | 263 | (** **** Exercise: 2 stars, optional (beq_stringP) *) 264 | (** Use the proof of [beq_natP] in chapter [IndProp] as a template to 265 | prove the following: *) 266 | 267 | Lemma beq_stringP : forall x y, reflect (x = y) (beq_string x y). 268 | Proof. 269 | (* FILL IN HERE *) Admitted. 270 | (** [] *) 271 | 272 | (** Now, given [string]s [x1] and [x2], we can use the [destruct (beq_stringP 273 | x1 x2)] to simultaneously perform case analysis on the result of 274 | [beq_string x1 x2] and generate hypotheses about the equality (in the 275 | sense of [=]) of [x1] and [x2]. *) 276 | 277 | (** **** Exercise: 2 stars (t_update_same) *) 278 | (** With the example in chapter [IndProp] as a template, use 279 | [beq_stringP] to prove the following theorem, which states that if we 280 | update a map to assign key [x] the same value as it already has in 281 | [m], then the result is equal to [m]: *) 282 | 283 | Theorem t_update_same : forall X x (m : total_map X), 284 | m & { x --> m x } = m. 285 | Proof. 286 | (* FILL IN HERE *) Admitted. 287 | (** [] *) 288 | 289 | (** **** Exercise: 3 stars, recommended (t_update_permute) *) 290 | (** Use [beq_stringP] to prove one final property of the [update] 291 | function: If we update a map [m] at two distinct keys, it doesn't 292 | matter in which order we do the updates. *) 293 | 294 | Theorem t_update_permute : forall (X:Type) v1 v2 x1 x2 295 | (m : total_map X), 296 | x2 <> x1 -> 297 | m & { x2 --> v2 ; x1 --> v1 } 298 | = m & { x1 --> v1 ; x2 --> v2 }. 299 | Proof. 300 | (* FILL IN HERE *) Admitted. 301 | (** [] *) 302 | 303 | (* ################################################################# *) 304 | (** * Partial maps *) 305 | 306 | (** Finally, we define _partial maps_ on top of total maps. A partial 307 | map with elements of type [A] is simply a total map with elements 308 | of type [option A] and default element [None]. *) 309 | 310 | Definition partial_map (A:Type) := total_map (option A). 311 | 312 | Definition empty {A:Type} : partial_map A := 313 | t_empty None. 314 | 315 | Definition update {A:Type} (m : partial_map A) 316 | (x : string) (v : A) := 317 | m & { x --> (Some v) }. 318 | 319 | (** We introduce a similar notation for partial maps, using double 320 | curly-brackets. **) 321 | 322 | Notation "m '&' {{ a --> x }}" := 323 | (update m a x) (at level 20). 324 | Notation "m '&' {{ a --> x ; b --> y }}" := 325 | (update (m & {{ a --> x }}) b y) (at level 20). 326 | Notation "m '&' {{ a --> x ; b --> y ; c --> z }}" := 327 | (update (m & {{ a --> x ; b --> y }}) c z) (at level 20). 328 | Notation "m '&' {{ a --> x ; b --> y ; c --> z ; d --> t }}" := 329 | (update (m & {{ a --> x ; b --> y ; c --> z }}) d t) (at level 20). 330 | Notation "m '&' {{ a --> x ; b --> y ; c --> z ; d --> t ; e --> u }}" := 331 | (update (m & {{ a --> x ; b --> y ; c --> z ; d --> t }}) e u) (at level 20). 332 | Notation "m '&' {{ a --> x ; b --> y ; c --> z ; d --> t ; e --> u ; f --> v }}" := 333 | (update (m & {{ a --> x ; b --> y ; c --> z ; d --> t ; e --> u }}) f v) (at level 20). 334 | 335 | (** We now straightforwardly lift all of the basic lemmas about total 336 | maps to partial maps. *) 337 | 338 | Lemma apply_empty : forall (A: Type) (x: string), @empty A x = None. 339 | Proof. 340 | intros. unfold empty. rewrite t_apply_empty. 341 | reflexivity. 342 | Qed. 343 | 344 | Lemma update_eq : forall A (m: partial_map A) x v, 345 | (m & {{ x --> v }}) x = Some v. 346 | Proof. 347 | intros. unfold update. rewrite t_update_eq. 348 | reflexivity. 349 | Qed. 350 | 351 | Theorem update_neq : forall (X:Type) v x1 x2 352 | (m : partial_map X), 353 | x2 <> x1 -> 354 | (m & {{ x2 --> v }}) x1 = m x1. 355 | Proof. 356 | intros X v x1 x2 m H. 357 | unfold update. rewrite t_update_neq. reflexivity. 358 | apply H. Qed. 359 | 360 | Lemma update_shadow : forall A (m: partial_map A) v1 v2 x, 361 | m & {{ x --> v1 ; x --> v2 }} = m & {{x --> v2}}. 362 | Proof. 363 | intros A m v1 v2 x1. unfold update. rewrite t_update_shadow. 364 | reflexivity. 365 | Qed. 366 | 367 | Theorem update_same : forall X v x (m : partial_map X), 368 | m x = Some v -> 369 | m & {{x --> v}} = m. 370 | Proof. 371 | intros X v x m H. unfold update. rewrite <- H. 372 | apply t_update_same. 373 | Qed. 374 | 375 | Theorem update_permute : forall (X:Type) v1 v2 x1 x2 376 | (m : partial_map X), 377 | x2 <> x1 -> 378 | m & {{x2 --> v2 ; x1 --> v1}} 379 | = m & {{x1 --> v1 ; x2 --> v2}}. 380 | Proof. 381 | intros X v1 v2 x1 x2 m. unfold update. 382 | apply t_update_permute. 383 | Qed. 384 | 385 | 386 | -------------------------------------------------------------------------------- /MapsTest.v: -------------------------------------------------------------------------------- 1 | Set Warnings "-notation-overridden,-parsing". 2 | From Coq Require Export String. 3 | From LF Require Import Maps. 4 | Parameter MISSING: Type. 5 | 6 | Module Check. 7 | 8 | Ltac check_type A B := 9 | match type of A with 10 | | context[MISSING] => idtac "Missing:" A 11 | | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] 12 | end. 13 | 14 | Ltac print_manual_grade A := 15 | match eval compute in A with 16 | | Some (pair ?S ?C) => 17 | idtac "Score:" S; 18 | match eval compute in C with 19 | | ""%string => idtac "Comment: None" 20 | | _ => idtac "Comment:" C 21 | end 22 | | None => 23 | idtac "Score: Ungraded"; 24 | idtac "Comment: None" 25 | end. 26 | 27 | End Check. 28 | 29 | From LF Require Import Maps. 30 | Import Check. 31 | 32 | Goal True. 33 | 34 | idtac "------------------- t_update_same --------------------". 35 | idtac " ". 36 | 37 | idtac "#> t_update_same". 38 | idtac "Possible points: 2". 39 | check_type @t_update_same ( 40 | (forall (X : Type) (x : string) (m : total_map X), m & {x --> m x} = m)). 41 | idtac "Assumptions:". 42 | Abort. 43 | Print Assumptions t_update_same. 44 | Goal True. 45 | idtac " ". 46 | 47 | idtac "------------------- t_update_permute --------------------". 48 | idtac " ". 49 | 50 | idtac "#> t_update_permute". 51 | idtac "Possible points: 3". 52 | check_type @t_update_permute ( 53 | (forall (X : Type) (v1 v2 : X) (x1 x2 : string) (m : total_map X), 54 | x2 <> x1 -> m & {x2 --> v2; x1 --> v1} = m & {x1 --> v1; x2 --> v2})). 55 | idtac "Assumptions:". 56 | Abort. 57 | Print Assumptions t_update_permute. 58 | Goal True. 59 | idtac " ". 60 | 61 | idtac " ". 62 | 63 | idtac "Max points - standard: 5". 64 | idtac "Max points - advanced: 5". 65 | Abort. 66 | -------------------------------------------------------------------------------- /PolyTest.v: -------------------------------------------------------------------------------- 1 | Set Warnings "-notation-overridden,-parsing". 2 | From Coq Require Export String. 3 | From LF Require Import Poly. 4 | Parameter MISSING: Type. 5 | 6 | Module Check. 7 | 8 | Ltac check_type A B := 9 | match type of A with 10 | | context[MISSING] => idtac "Missing:" A 11 | | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] 12 | end. 13 | 14 | Ltac print_manual_grade A := 15 | match eval compute in A with 16 | | Some (pair ?S ?C) => 17 | idtac "Score:" S; 18 | match eval compute in C with 19 | | ""%string => idtac "Comment: None" 20 | | _ => idtac "Comment:" C 21 | end 22 | | None => 23 | idtac "Score: Ungraded"; 24 | idtac "Comment: None" 25 | end. 26 | 27 | End Check. 28 | 29 | From LF Require Import Poly. 30 | Import Check. 31 | 32 | Goal True. 33 | 34 | idtac "------------------- mumble_grumble --------------------". 35 | idtac " ". 36 | 37 | idtac "#> Manually graded: mumble_grumble". 38 | idtac "Possible points: 2". 39 | print_manual_grade manual_grade_for_mumble_grumble. 40 | idtac " ". 41 | 42 | idtac "------------------- split --------------------". 43 | idtac " ". 44 | 45 | idtac "#> split". 46 | idtac "Possible points: 1". 47 | check_type @split ((forall X Y : Type, list (X * Y) -> list X * list Y)). 48 | idtac "Assumptions:". 49 | Abort. 50 | Print Assumptions split. 51 | Goal True. 52 | idtac " ". 53 | 54 | idtac "#> test_split". 55 | idtac "Possible points: 1". 56 | check_type @test_split ( 57 | (@split nat bool [(1, false); (2, false)] = ([1; 2], [false; false]))). 58 | idtac "Assumptions:". 59 | Abort. 60 | Print Assumptions test_split. 61 | Goal True. 62 | idtac " ". 63 | 64 | idtac "------------------- filter_even_gt7 --------------------". 65 | idtac " ". 66 | 67 | idtac "#> test_filter_even_gt7_1". 68 | idtac "Possible points: 1". 69 | check_type @test_filter_even_gt7_1 ( 70 | (filter_even_gt7 [1; 2; 6; 9; 10; 3; 12; 8] = [10; 12; 8])). 71 | idtac "Assumptions:". 72 | Abort. 73 | Print Assumptions test_filter_even_gt7_1. 74 | Goal True. 75 | idtac " ". 76 | 77 | idtac "#> test_filter_even_gt7_2". 78 | idtac "Possible points: 1". 79 | check_type @test_filter_even_gt7_2 ((filter_even_gt7 [5; 2; 6; 19; 129] = [ ])). 80 | idtac "Assumptions:". 81 | Abort. 82 | Print Assumptions test_filter_even_gt7_2. 83 | Goal True. 84 | idtac " ". 85 | 86 | idtac "------------------- partition --------------------". 87 | idtac " ". 88 | 89 | idtac "#> partition". 90 | idtac "Possible points: 1". 91 | check_type @partition ((forall X : Type, (X -> bool) -> list X -> list X * list X)). 92 | idtac "Assumptions:". 93 | Abort. 94 | Print Assumptions partition. 95 | Goal True. 96 | idtac " ". 97 | 98 | idtac "#> test_partition1". 99 | idtac "Possible points: 1". 100 | check_type @test_partition1 ((@partition nat oddb [1; 2; 3; 4; 5] = ([1; 3; 5], [2; 4]))). 101 | idtac "Assumptions:". 102 | Abort. 103 | Print Assumptions test_partition1. 104 | Goal True. 105 | idtac " ". 106 | 107 | idtac "#> test_partition2". 108 | idtac "Possible points: 1". 109 | check_type @test_partition2 ( 110 | (@partition nat (fun _ : nat => false) [5; 9; 0] = ([ ], [5; 9; 0]))). 111 | idtac "Assumptions:". 112 | Abort. 113 | Print Assumptions test_partition2. 114 | Goal True. 115 | idtac " ". 116 | 117 | idtac "------------------- map_rev --------------------". 118 | idtac " ". 119 | 120 | idtac "#> map_rev". 121 | idtac "Possible points: 3". 122 | check_type @map_rev ( 123 | (forall (X Y : Type) (f : X -> Y) (l : list X), 124 | @map X Y f (@rev X l) = @rev Y (@map X Y f l))). 125 | idtac "Assumptions:". 126 | Abort. 127 | Print Assumptions map_rev. 128 | Goal True. 129 | idtac " ". 130 | 131 | idtac "------------------- flat_map --------------------". 132 | idtac " ". 133 | 134 | idtac "#> flat_map". 135 | idtac "Possible points: 1". 136 | check_type @flat_map ((forall X Y : Type, (X -> list Y) -> list X -> list Y)). 137 | idtac "Assumptions:". 138 | Abort. 139 | Print Assumptions flat_map. 140 | Goal True. 141 | idtac " ". 142 | 143 | idtac "#> test_flat_map1". 144 | idtac "Possible points: 1". 145 | check_type @test_flat_map1 ( 146 | (@flat_map nat nat (fun n : nat => [n; n; n]) [1; 5; 4] = 147 | [1; 1; 1; 5; 5; 5; 4; 4; 4])). 148 | idtac "Assumptions:". 149 | Abort. 150 | Print Assumptions test_flat_map1. 151 | Goal True. 152 | idtac " ". 153 | 154 | idtac "------------------- fold_types_different --------------------". 155 | idtac " ". 156 | 157 | idtac "#> Manually graded: fold_types_different". 158 | idtac "Advanced". 159 | idtac "Possible points: 1". 160 | print_manual_grade manual_grade_for_fold_types_different. 161 | idtac " ". 162 | 163 | idtac "------------------- fold_length --------------------". 164 | idtac " ". 165 | 166 | idtac "#> Exercises.fold_length_correct". 167 | idtac "Possible points: 2". 168 | check_type @Exercises.fold_length_correct ( 169 | (forall (X : Type) (l : list X), @Exercises.fold_length X l = @length X l)). 170 | idtac "Assumptions:". 171 | Abort. 172 | Print Assumptions Exercises.fold_length_correct. 173 | Goal True. 174 | idtac " ". 175 | 176 | idtac "------------------- fold_map --------------------". 177 | idtac " ". 178 | 179 | idtac "#> Manually graded: Exercises.fold_map". 180 | idtac "Possible points: 3". 181 | print_manual_grade Exercises.manual_grade_for_fold_map. 182 | idtac " ". 183 | 184 | idtac "------------------- currying --------------------". 185 | idtac " ". 186 | 187 | idtac "#> Exercises.uncurry_curry". 188 | idtac "Advanced". 189 | idtac "Possible points: 1". 190 | check_type @Exercises.uncurry_curry ( 191 | (forall (X Y Z : Type) (f : X -> Y -> Z) (x : X) (y : Y), 192 | @Exercises.prod_curry X Y Z (@Exercises.prod_uncurry X Y Z f) x y = f x y)). 193 | idtac "Assumptions:". 194 | Abort. 195 | Print Assumptions Exercises.uncurry_curry. 196 | Goal True. 197 | idtac " ". 198 | 199 | idtac "#> Exercises.curry_uncurry". 200 | idtac "Advanced". 201 | idtac "Possible points: 1". 202 | check_type @Exercises.curry_uncurry ( 203 | (forall (X Y Z : Type) (f : X * Y -> Z) (p : X * Y), 204 | @Exercises.prod_uncurry X Y Z (@Exercises.prod_curry X Y Z f) p = f p)). 205 | idtac "Assumptions:". 206 | Abort. 207 | Print Assumptions Exercises.curry_uncurry. 208 | Goal True. 209 | idtac " ". 210 | 211 | idtac "------------------- nth_error_informal --------------------". 212 | idtac " ". 213 | 214 | idtac "#> Manually graded: Exercises.informal_proof". 215 | idtac "Advanced". 216 | idtac "Possible points: 2". 217 | print_manual_grade Exercises.manual_grade_for_informal_proof. 218 | idtac " ". 219 | 220 | idtac "------------------- church_numerals --------------------". 221 | idtac " ". 222 | 223 | idtac "#> Manually graded: Exercises.succ_plus_mult_exp". 224 | idtac "Advanced". 225 | idtac "Possible points: 4". 226 | print_manual_grade Exercises.manual_grade_for_succ_plus_mult_exp. 227 | idtac " ". 228 | 229 | idtac " ". 230 | 231 | idtac "Max points - standard: 19". 232 | idtac "Max points - advanced: 28". 233 | Abort. 234 | -------------------------------------------------------------------------------- /Postscript.v: -------------------------------------------------------------------------------- 1 | (** * Postscript *) 2 | 3 | (** Congratulations: We've made it to the end! *) 4 | 5 | (* ################################################################# *) 6 | (** * Looking Back *) 7 | 8 | (** We've covered quite a bit of ground so far. Here's a quick review... 9 | 10 | - _Functional programming_: 11 | - "declarative" programming style (recursion over immutable 12 | data structures, rather than looping over mutable arrays 13 | or pointer structures) 14 | - higher-order functions 15 | - polymorphism *) 16 | 17 | (** 18 | - _Logic_, the mathematical basis for software engineering: 19 | 20 | logic calculus 21 | -------------------- ~ ---------------------------- 22 | software engineering mechanical/civil engineering 23 | 24 | 25 | - inductively defined sets and relations 26 | - inductive proofs 27 | - proof objects *) 28 | 29 | (** 30 | - _Coq_, an industrial-strength proof assistant 31 | - functional core language 32 | - core tactics 33 | - automation 34 | *) 35 | 36 | (* ################################################################# *) 37 | (** * Looking Forward *) 38 | 39 | (** If what you've seen so far has whetted your interest, you have two 40 | choices for further reading in the _Software Foundations_ series: 41 | 42 | - _Programming Language Foundations_ (volume 2, by a set of 43 | authors similar to this book's) covers material that 44 | might be found in a graduate course on the theory of 45 | programming languages, including Hoare logic, operational 46 | semantics, and type systems. 47 | 48 | - _Verified Functional Algorithms_ (volume 3, by Andrew 49 | Appel) builds on the themes of functional programming and 50 | program verification in Coq, addressing a range of topics 51 | that might be found in a standard data structures course, 52 | with an eye to formal verification. *) 53 | 54 | (* ################################################################# *) 55 | (** * Other sources *) 56 | 57 | (** Here are some other good places to learn more... 58 | 59 | - This book includes some optional chapters covering topics 60 | that you may find useful. Take a look at the table of contents and the chapter dependency diagram to find 61 | them. 62 | 63 | - For questions about Coq, the [#coq] area of Stack 64 | Overflow (https://stackoverflow.com/questions/tagged/coq) 65 | is an excellent community resource. 66 | 67 | - Here are some great books on functional programming 68 | - Learn You a Haskell for Great Good, by Miran Lipovaca 69 | [Lipovaca 2011] (in Bib.v). 70 | - Real World Haskell, by Bryan O'Sullivan, John Goerzen, 71 | and Don Stewart [O'Sullivan 2008] (in Bib.v) 72 | - ...and many other excellent books on Haskell, OCaml, 73 | Scheme, Racket, Scala, F sharp, etc., etc. 74 | 75 | - And some further resources for Coq: 76 | - Certified Programming with Dependent Types, by Adam 77 | Chlipala [Chlipala 2013] (in Bib.v). 78 | - Interactive Theorem Proving and Program Development: 79 | Coq'Art: The Calculus of Inductive Constructions, by Yves 80 | Bertot and Pierre Casteran [Bertot 2004] (in Bib.v). 81 | 82 | - If you're interested in real-world applications of formal 83 | verification to critical software, see the Postscript chapter 84 | of _Programming Language Foundations_. 85 | 86 | - For applications of Coq in building verified systems, the 87 | lectures and course materials for the 2017 DeepSpec Summer 88 | School are a great resource. 89 | https://deepspec.org/event/dsss17/index.html 90 | *) 91 | -------------------------------------------------------------------------------- /PostscriptTest.v: -------------------------------------------------------------------------------- 1 | Set Warnings "-notation-overridden,-parsing". 2 | From Coq Require Export String. 3 | From LF Require Import Postscript. 4 | Parameter MISSING: Type. 5 | 6 | Module Check. 7 | 8 | Ltac check_type A B := 9 | match type of A with 10 | | context[MISSING] => idtac "Missing:" A 11 | | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] 12 | end. 13 | 14 | Ltac print_manual_grade A := 15 | match eval compute in A with 16 | | Some (pair ?S ?C) => 17 | idtac "Score:" S; 18 | match eval compute in C with 19 | | ""%string => idtac "Comment: None" 20 | | _ => idtac "Comment:" C 21 | end 22 | | None => 23 | idtac "Score: Ungraded"; 24 | idtac "Comment: None" 25 | end. 26 | 27 | End Check. 28 | 29 | From LF Require Import Postscript. 30 | Import Check. 31 | 32 | Goal True. 33 | 34 | idtac " ". 35 | 36 | idtac "Max points - standard: 0". 37 | idtac "Max points - advanced: 0". 38 | Abort. 39 | -------------------------------------------------------------------------------- /Preface.v: -------------------------------------------------------------------------------- 1 | (** * Preface *) 2 | 3 | (* ################################################################# *) 4 | (** * Welcome *) 5 | 6 | (** This is the entry point in a series of electronic textbooks on 7 | various aspects of _Software Foundations_ -- the mathematical 8 | underpinnings of reliable software. Topics in the series include 9 | basic concepts of logic, computer-assisted theorem proving, the 10 | Coq proof assistant, functional programming, operational 11 | semantics, logics for reasoning about programs, and static type 12 | systems. The exposition is intended for a broad range of readers, 13 | from advanced undergraduates to PhD students and researchers. No 14 | specific background in logic or programming languages is assumed, 15 | though a degree of mathematical maturity will be helpful. 16 | 17 | The principal novelty of the series is that it is one hundred 18 | percent formalized and machine-checked: each text is literally a 19 | script for Coq. The books are intended to be read alongside (or 20 | inside) an interactive session with Coq. All the details in the 21 | text are fully formalized in Coq, and most of the exercises are 22 | designed to be worked using Coq. 23 | 24 | The files in each book are organized into a sequence of core 25 | chapters, covering about one semester's worth of material and 26 | organized into a coherent linear narrative, plus a number of 27 | "offshoot" chapters covering additional topics. All the core 28 | chapters are suitable for both upper-level undergraduate and 29 | graduate students. 30 | 31 | This book, _Logical Foundations_, lays groundwork for the others, 32 | introducing the reader to the basic ideas of functional 33 | programming, constructive logic, and the Coq proof assistant. *) 34 | 35 | 36 | (* ################################################################# *) 37 | (** * Overview *) 38 | 39 | (** Building reliable software is really hard. The scale and 40 | complexity of modern systems, the number of people involved, and 41 | the range of demands placed on them make it extremely difficult to 42 | build software that is even more-or-less correct, much less 100%% 43 | correct. At the same time, the increasing degree to which 44 | information processing is woven into every aspect of society 45 | greatly amplifies the cost of bugs and insecurities. 46 | 47 | Computer scientists and software engineers have responded to these 48 | challenges by developing a whole host of techniques for improving 49 | software reliability, ranging from recommendations about managing 50 | software projects teams (e.g., extreme programming) to design 51 | philosophies for libraries (e.g., model-view-controller, 52 | publish-subscribe, etc.) and programming languages (e.g., 53 | object-oriented programming, aspect-oriented programming, 54 | functional programming, ...) to mathematical techniques for 55 | specifying and reasoning about properties of software and tools 56 | for helping validate these properties. The _Software Foundations_ 57 | series is focused on this last set of techniques. 58 | 59 | The text is constructed around three conceptual threads: 60 | 61 | (1) basic tools from _logic_ for making and justifying precise 62 | claims about programs; 63 | 64 | (2) the use of _proof assistants_ to construct rigorous logical 65 | arguments; 66 | 67 | (3) _functional programming_, both as a method of programming that 68 | simplifies reasoning about programs and as a bridge between 69 | programming and logic. 70 | 71 | Some suggestions for further reading can be found in the 72 | [Postscript] chapter. Bibliographic information for all 73 | cited works can be found in the file [Bib]. *) 74 | 75 | (* ================================================================= *) 76 | (** ** Logic *) 77 | 78 | (** Logic is the field of study whose subject matter is _proofs_ -- 79 | unassailable arguments for the truth of particular propositions. 80 | Volumes have been written about the central role of logic in 81 | computer science. Manna and Waldinger called it "the calculus of 82 | computer science," while Halpern et al.'s paper _On the Unusual 83 | Effectiveness of Logic in Computer Science_ catalogs scores of 84 | ways in which logic offers critical tools and insights. Indeed, 85 | they observe that, "As a matter of fact, logic has turned out to 86 | be significantly more effective in computer science than it has 87 | been in mathematics. This is quite remarkable, especially since 88 | much of the impetus for the development of logic during the past 89 | one hundred years came from mathematics." 90 | 91 | In particular, the fundamental tools of _inductive proof_ are 92 | ubiquitous in all of computer science. You have surely seen them 93 | before, perhaps in a course on discrete math or analysis of 94 | algorithms, but in this course we will examine them more deeply 95 | than you have probably done so far. *) 96 | 97 | (* ================================================================= *) 98 | (** ** Proof Assistants *) 99 | 100 | (** The flow of ideas between logic and computer science has not been 101 | unidirectional: CS has also made important contributions to logic. 102 | One of these has been the development of software tools for 103 | helping construct proofs of logical propositions. These tools 104 | fall into two broad categories: 105 | 106 | - _Automated theorem provers_ provide "push-button" operation: 107 | you give them a proposition and they return either _true_ or 108 | _false_ (or, sometimes, _don't know: ran out of time_). 109 | Although their capabilities are still limited to specific 110 | domains, they have matured tremendously in recent years and 111 | are used now in a multitude of settings. Examples of such 112 | tools include SAT solvers, SMT solvers, and model checkers. 113 | 114 | - _Proof assistants_ are hybrid tools that automate the more 115 | routine aspects of building proofs while depending on human 116 | guidance for more difficult aspects. Widely used proof 117 | assistants include Isabelle, Agda, Twelf, ACL2, PVS, and Coq, 118 | among many others. 119 | 120 | This course is based around Coq, a proof assistant that has been 121 | under development since 1983 and that in recent years has 122 | attracted a large community of users in both research and 123 | industry. Coq provides a rich environment for interactive 124 | development of machine-checked formal reasoning. The kernel of 125 | the Coq system is a simple proof-checker, which guarantees that 126 | only correct deduction steps are ever performed. On top of this 127 | kernel, the Coq environment provides high-level facilities for 128 | proof development, including a large library of common definitions 129 | and lemmas, powerful tactics for constructing complex proofs 130 | semi-automatically, and a special-purpose programming language for 131 | defining new proof-automation tactics for specific situations. 132 | 133 | Coq has been a critical enabler for a huge variety of work across 134 | computer science and mathematics: 135 | 136 | - As a _platform for modeling programming languages_, it has 137 | become a standard tool for researchers who need to describe and 138 | reason about complex language definitions. It has been used, 139 | for example, to check the security of the JavaCard platform, 140 | obtaining the highest level of common criteria certification, 141 | and for formal specifications of the x86 and LLVM instruction 142 | sets and programming languages such as C. 143 | 144 | - As an _environment for developing formally certified software 145 | and hardware_, Coq has been used, for example, to build 146 | CompCert, a fully-verified optimizing compiler for C, and 147 | CertiKos, a fully verified hypervisor, for proving the 148 | correctness of subtle algorithms involving floating point 149 | numbers, and as the basis for CertiCrypt, an environment for 150 | reasoning about the security of cryptographic algorithms. It is 151 | also being used to build verified implementations of the 152 | open-source RISC-V processor. 153 | 154 | - As a _realistic environment for functional programming with 155 | dependent types_, it has inspired numerous innovations. For 156 | example, the Ynot system embeds "relational Hoare reasoning" (an 157 | extension of the _Hoare Logic_ we will see later in this course) 158 | in Coq. 159 | 160 | - As a _proof assistant for higher-order logic_, it has been used 161 | to validate a number of important results in mathematics. For 162 | example, its ability to include complex computations inside 163 | proofs made it possible to develop the first formally verified 164 | proof of the 4-color theorem. This proof had previously been 165 | controversial among mathematicians because part of it included 166 | checking a large number of configurations using a program. In 167 | the Coq formalization, everything is checked, including the 168 | correctness of the computational part. More recently, an even 169 | more massive effort led to a Coq formalization of the 170 | Feit-Thompson Theorem -- the first major step in the 171 | classification of finite simple groups. 172 | 173 | By the way, in case you're wondering about the name, here's what 174 | the official Coq web site at INRIA (the French national research 175 | lab where Coq has mostly been developed) says about it: "Some 176 | French computer scientists have a tradition of naming their 177 | software as animal species: Caml, Elan, Foc or Phox are examples of 178 | this tacit convention. In French, 'coq' means rooster, and it 179 | sounds like the initials of the Calculus of Constructions (CoC) on 180 | which it is based." The rooster is also the national symbol of 181 | France, and C-o-q are the first three letters of the name of 182 | Thierry Coquand, one of Coq's early developers. *) 183 | 184 | (* ================================================================= *) 185 | (** ** Functional Programming *) 186 | 187 | (** The term _functional programming_ refers both to a collection of 188 | programming idioms that can be used in almost any programming 189 | language and to a family of programming languages designed to 190 | emphasize these idioms, including Haskell, OCaml, Standard ML, 191 | F##, Scala, Scheme, Racket, Common Lisp, Clojure, Erlang, and Coq. 192 | 193 | Functional programming has been developed over many decades -- 194 | indeed, its roots go back to Church's lambda-calculus, which was 195 | invented in the 1930s, well before the first computers (at least 196 | the first electronic ones)! But since the early '90s it has 197 | enjoyed a surge of interest among industrial engineers and 198 | language designers, playing a key role in high-value systems at 199 | companies like Jane St. Capital, Microsoft, Facebook, and 200 | Ericsson. 201 | 202 | The most basic tenet of functional programming is that, as much as 203 | possible, computation should be _pure_, in the sense that the only 204 | effect of execution should be to produce a result: it should be 205 | free from _side effects_ such as I/O, assignments to mutable 206 | variables, redirecting pointers, etc. For example, whereas an 207 | _imperative_ sorting function might take a list of numbers and 208 | rearrange its pointers to put the list in order, a pure sorting 209 | function would take the original list and return a _new_ list 210 | containing the same numbers in sorted order. 211 | 212 | A significant benefit of this style of programming is that it 213 | makes programs easier to understand and reason about. If every 214 | operation on a data structure yields a new data structure, leaving 215 | the old one intact, then there is no need to worry about how that 216 | structure is being shared and whether a change by one part of the 217 | program might break an invariant that another part of the program 218 | relies on. These considerations are particularly critical in 219 | concurrent systems, where every piece of mutable state that is 220 | shared between threads is a potential source of pernicious bugs. 221 | Indeed, a large part of the recent interest in functional 222 | programming in industry is due to its simpler behavior in the 223 | presence of concurrency. 224 | 225 | Another reason for the current excitement about functional 226 | programming is related to the first: functional programs are often 227 | much easier to parallelize than their imperative counterparts. If 228 | running a computation has no effect other than producing a result, 229 | then it does not matter _where_ it is run. Similarly, if a data 230 | structure is never modified destructively, then it can be copied 231 | freely, across cores or across the network. Indeed, the 232 | "Map-Reduce" idiom, which lies at the heart of massively 233 | distributed query processors like Hadoop and is used by Google to 234 | index the entire web is a classic example of functional 235 | programming. 236 | 237 | For purposes of this course, functional programming has yet 238 | another significant attraction: it serves as a bridge between 239 | logic and computer science. Indeed, Coq itself can be viewed as a 240 | combination of a small but extremely expressive functional 241 | programming language plus a set of tools for stating and proving 242 | logical assertions. Moreover, when we come to look more closely, 243 | we find that these two sides of Coq are actually aspects of the 244 | very same underlying machinery -- i.e., _proofs are programs_. *) 245 | 246 | 247 | (* ================================================================= *) 248 | (** ** Further Reading *) 249 | 250 | (** This text is intended to be self contained, but readers looking 251 | for a deeper treatment of particular topics will find some 252 | suggestions for further reading in the [Postscript] 253 | chapter. *) 254 | 255 | (* ################################################################# *) 256 | (** * Practicalities *) 257 | 258 | (* ================================================================= *) 259 | (** ** Chapter Dependencies *) 260 | 261 | (** A diagram of the dependencies between chapters and some suggested 262 | paths through the material can be found in the file [deps.html]. *) 263 | 264 | (* ================================================================= *) 265 | (** ** System Requirements *) 266 | 267 | (** Coq runs on Windows, Linux, and macOS. You will need: 268 | 269 | - A current installation of Coq, available from the Coq home 270 | page. These files have been tested with Coq 8.8.0. 271 | 272 | - An IDE for interacting with Coq. Currently, there are two 273 | choices: 274 | 275 | - Proof General is an Emacs-based IDE. It tends to be 276 | preferred by users who are already comfortable with 277 | Emacs. It requires a separate installation (google 278 | "Proof General"). 279 | 280 | Adventurous users of Coq within Emacs may also want to 281 | check out extensions such as [company-coq] and 282 | [control-lock]. 283 | 284 | - CoqIDE is a simpler stand-alone IDE. It is distributed 285 | with Coq, so it should be available once you have Coq 286 | installed. It can also be compiled from scratch, but on 287 | some platforms this may involve installing additional 288 | packages for GUI libraries and such. *) 289 | 290 | (* ================================================================= *) 291 | (** ** Exercises *) 292 | 293 | (** Each chapter includes numerous exercises. Each is marked with a 294 | "star rating," which can be interpreted as follows: 295 | 296 | - One star: easy exercises that underscore points in the text 297 | and that, for most readers, should take only a minute or two. 298 | Get in the habit of working these as you reach them. 299 | 300 | - Two stars: straightforward exercises (five or ten minutes). 301 | 302 | - Three stars: exercises requiring a bit of thought (ten 303 | minutes to half an hour). 304 | 305 | - Four and five stars: more difficult exercises (half an hour 306 | and up). 307 | 308 | Also, some exercises are marked "advanced," and some are marked 309 | "optional." Doing just the non-optional, non-advanced exercises 310 | should provide good coverage of the core material. Optional 311 | exercises provide a bit of extra practice with key concepts and 312 | introduce secondary themes that may be of interest to some 313 | readers. Advanced exercises are for readers who want an extra 314 | challenge and a deeper cut at the material. 315 | 316 | _Please do not post solutions to the exercises in a public place_. 317 | Software Foundations is widely used both for self-study and for 318 | university courses. Having solutions easily available makes it 319 | much less useful for courses, which typically have graded homework 320 | assignments. We especially request that readers not post 321 | solutions to the exercises anyplace where they can be found by 322 | search engines. *) 323 | 324 | (* ================================================================= *) 325 | (** ** Downloading the Coq Files *) 326 | 327 | (** A tar file containing the full sources for the "release version" 328 | of this book (as a collection of Coq scripts and HTML files) is 329 | available at http://softwarefoundations.cis.upenn.edu. 330 | 331 | (If you are using the book as part of a class, your professor may 332 | give you access to a locally modified version of the files, which 333 | you should use instead of the release version.) *) 334 | 335 | (* ================================================================= *) 336 | (** ** Lecture Videos *) 337 | 338 | (** Lectures for an intensive summer course based on _Logical 339 | Foundations_ (part of the DeepSpec summer school in 2017) can be 340 | found at https://deepspec.org/event/dsss17/coq_intensive.html. 341 | The video quality is poor at the beginning but gets better in the 342 | later lectures. *) 343 | 344 | (* ################################################################# *) 345 | (** * Note for Instructors *) 346 | 347 | (** If you plan to use these materials in your own course, you will 348 | undoubtedly find things you'd like to change, improve, or add. 349 | Your contributions are welcome! 350 | 351 | In order to keep the legalities simple and to have a single point 352 | of responsibility in case the need should ever arise to adjust the 353 | license terms, sublicense, etc., we ask all contributors (i.e., 354 | everyone with access to the developers' repository) to assign 355 | copyright in their contributions to the appropriate "author of 356 | record," as follows: 357 | 358 | - I hereby assign copyright in my past and future contributions 359 | to the Software Foundations project to the Author of Record of 360 | each volume or component, to be licensed under the same terms 361 | as the rest of Software Foundations. I understand that, at 362 | present, the Authors of Record are as follows: For Volumes 1 363 | and 2, known until 2016 as "Software Foundations" and from 364 | 2016 as (respectively) "Logical Foundations" and "Programming 365 | Foundations," and for Volume 4, "QuickChick: Property-Based 366 | Testing in Coq," the Author of Record is Benjamin C. Pierce. 367 | For Volume 3, "Verified Functional Algorithms", the Author of 368 | Record is Andrew W. Appel. For components outside of 369 | designated volumes (e.g., typesetting and grading tools and 370 | other software infrastructure), the Author of Record is 371 | Benjamin Pierce. 372 | 373 | To get started, please send an email to Benjamin Pierce, 374 | describing yourself and how you plan to use the materials and 375 | including (1) the above copyright transfer text and (2) your 376 | github username. 377 | 378 | We'll set you up with access to the git repository and developers' 379 | mailing lists. In the repository you'll find a file [INSTRUCTORS] 380 | with further instructions. *) 381 | 382 | (* ################################################################# *) 383 | (** * Translations *) 384 | 385 | (** Thanks to the efforts of a team of volunteer translators, 386 | _Software Foundations_ can be enjoyed in Japanese at 387 | http://proofcafe.org/sf. A Chinese translation is also underway; 388 | you can preview it at https://coq-zh.github.io/SF-zh/. *) 389 | 390 | (* ################################################################# *) 391 | (** * Thanks *) 392 | 393 | (** Development of the _Software Foundations_ series has been 394 | supported, in part, by the National Science Foundation under the 395 | NSF Expeditions grant 1521523, _The Science of Deep 396 | Specification_. *) 397 | 398 | -------------------------------------------------------------------------------- /PrefaceTest.v: -------------------------------------------------------------------------------- 1 | Set Warnings "-notation-overridden,-parsing". 2 | From Coq Require Export String. 3 | From LF Require Import Preface. 4 | Parameter MISSING: Type. 5 | 6 | Module Check. 7 | 8 | Ltac check_type A B := 9 | match type of A with 10 | | context[MISSING] => idtac "Missing:" A 11 | | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] 12 | end. 13 | 14 | Ltac print_manual_grade A := 15 | match eval compute in A with 16 | | Some (pair ?S ?C) => 17 | idtac "Score:" S; 18 | match eval compute in C with 19 | | ""%string => idtac "Comment: None" 20 | | _ => idtac "Comment:" C 21 | end 22 | | None => 23 | idtac "Score: Ungraded"; 24 | idtac "Comment: None" 25 | end. 26 | 27 | End Check. 28 | 29 | From LF Require Import Preface. 30 | Import Check. 31 | 32 | Goal True. 33 | 34 | idtac " ". 35 | 36 | idtac "Max points - standard: 0". 37 | idtac "Max points - advanced: 0". 38 | Abort. 39 | -------------------------------------------------------------------------------- /ProofObjects.v: -------------------------------------------------------------------------------- 1 | (** * ProofObjects: The Curry-Howard Correspondence *) 2 | 3 | Set Warnings "-notation-overridden,-parsing". 4 | From LF Require Export IndProp. 5 | 6 | (** "_Algorithms are the computational content of proofs_." --Robert Harper *) 7 | 8 | (** We have seen that Coq has mechanisms both for _programming_, 9 | using inductive data types like [nat] or [list] and functions over 10 | these types, and for _proving_ properties of these programs, using 11 | inductive propositions (like [ev]), implication, universal 12 | quantification, and the like. So far, we have mostly treated 13 | these mechanisms as if they were quite separate, and for many 14 | purposes this is a good way to think. But we have also seen hints 15 | that Coq's programming and proving facilities are closely related. 16 | For example, the keyword [Inductive] is used to declare both data 17 | types and propositions, and [->] is used both to describe the type 18 | of functions on data and logical implication. This is not just a 19 | syntactic accident! In fact, programs and proofs in Coq are 20 | almost the same thing. In this chapter we will study how this 21 | works. 22 | 23 | We have already seen the fundamental idea: provability in Coq is 24 | represented by concrete _evidence_. When we construct the proof 25 | of a basic proposition, we are actually building a tree of 26 | evidence, which can be thought of as a data structure. 27 | 28 | If the proposition is an implication like [A -> B], then its proof 29 | will be an evidence _transformer_: a recipe for converting 30 | evidence for A into evidence for B. So at a fundamental level, 31 | proofs are simply programs that manipulate evidence. *) 32 | 33 | (** Question: If evidence is data, what are propositions themselves? 34 | 35 | Answer: They are types! *) 36 | 37 | (** Look again at the formal definition of the [ev] property. *) 38 | 39 | Print ev. 40 | (* ==> 41 | Inductive ev : nat -> Prop := 42 | | ev_0 : ev 0 43 | | ev_SS : forall n, ev n -> ev (S (S n)). 44 | *) 45 | 46 | (** Suppose we introduce an alternative pronunciation of "[:]". 47 | Instead of "has type," we can say "is a proof of." For example, 48 | the second line in the definition of [ev] declares that [ev_0 : ev 49 | 0]. Instead of "[ev_0] has type [ev 0]," we can say that "[ev_0] 50 | is a proof of [ev 0]." *) 51 | 52 | (** This pun between types and propositions -- between [:] as "has type" 53 | and [:] as "is a proof of" or "is evidence for" -- is called the 54 | _Curry-Howard correspondence_. It proposes a deep connection 55 | between the world of logic and the world of computation: 56 | 57 | propositions ~ types 58 | proofs ~ data values 59 | 60 | See [Wadler 2015] (in Bib.v) for a brief history and up-to-date exposition. *) 61 | 62 | (** Many useful insights follow from this connection. To begin with, 63 | it gives us a natural interpretation of the type of the [ev_SS] 64 | constructor: *) 65 | 66 | Check ev_SS. 67 | (* ===> ev_SS : forall n, 68 | ev n -> 69 | ev (S (S n)) *) 70 | 71 | (** This can be read "[ev_SS] is a constructor that takes two 72 | arguments -- a number [n] and evidence for the proposition [ev 73 | n] -- and yields evidence for the proposition [ev (S (S n))]." *) 74 | 75 | (** Now let's look again at a previous proof involving [ev]. *) 76 | 77 | Theorem ev_4 : ev 4. 78 | Proof. 79 | apply ev_SS. apply ev_SS. apply ev_0. Qed. 80 | 81 | (** As with ordinary data values and functions, we can use the [Print] 82 | command to see the _proof object_ that results from this proof 83 | script. *) 84 | 85 | Print ev_4. 86 | (* ===> ev_4 = ev_SS 2 (ev_SS 0 ev_0) 87 | : ev 4 *) 88 | 89 | (** Indeed, we can also write down this proof object _directly_, 90 | without the need for a separate proof script: *) 91 | 92 | Check (ev_SS 2 (ev_SS 0 ev_0)). 93 | (* ===> ev 4 *) 94 | 95 | (** The expression [ev_SS 2 (ev_SS 0 ev_0)] can be thought of as 96 | instantiating the parameterized constructor [ev_SS] with the 97 | specific arguments [2] and [0] plus the corresponding proof 98 | objects for its premises [ev 2] and [ev 0]. Alternatively, we can 99 | think of [ev_SS] as a primitive "evidence constructor" that, when 100 | applied to a particular number, wants to be further applied to 101 | evidence that that number is even; its type, 102 | 103 | forall n, ev n -> ev (S (S n)), 104 | 105 | expresses this functionality, in the same way that the polymorphic 106 | type [forall X, list X] expresses the fact that the constructor 107 | [nil] can be thought of as a function from types to empty lists 108 | with elements of that type. *) 109 | 110 | (** We saw in the [Logic] chapter that we can use function 111 | application syntax to instantiate universally quantified variables 112 | in lemmas, as well as to supply evidence for assumptions that 113 | these lemmas impose. For instance: *) 114 | 115 | Theorem ev_4': ev 4. 116 | Proof. 117 | apply (ev_SS 2 (ev_SS 0 ev_0)). 118 | Qed. 119 | 120 | (* ################################################################# *) 121 | (** * Proof Scripts *) 122 | 123 | (** The _proof objects_ we've been discussing lie at the core of how 124 | Coq operates. When Coq is following a proof script, what is 125 | happening internally is that it is gradually constructing a proof 126 | object -- a term whose type is the proposition being proved. The 127 | tactics between [Proof] and [Qed] tell it how to build up a term 128 | of the required type. To see this process in action, let's use 129 | the [Show Proof] command to display the current state of the proof 130 | tree at various points in the following tactic proof. *) 131 | 132 | Theorem ev_4'' : ev 4. 133 | Proof. 134 | Show Proof. 135 | apply ev_SS. 136 | Show Proof. 137 | apply ev_SS. 138 | Show Proof. 139 | apply ev_0. 140 | Show Proof. 141 | Qed. 142 | 143 | (** At any given moment, Coq has constructed a term with a 144 | "hole" (indicated by [?Goal] here, and so on), and it knows what 145 | type of evidence is needed to fill this hole. 146 | 147 | Each hole corresponds to a subgoal, and the proof is 148 | finished when there are no more subgoals. At this point, the 149 | evidence we've built stored in the global context under the name 150 | given in the [Theorem] command. *) 151 | 152 | (** Tactic proofs are useful and convenient, but they are not 153 | essential: in principle, we can always construct the required 154 | evidence by hand, as shown above. Then we can use [Definition] 155 | (rather than [Theorem]) to give a global name directly to this 156 | evidence. *) 157 | 158 | Definition ev_4''' : ev 4 := 159 | ev_SS 2 (ev_SS 0 ev_0). 160 | 161 | (** All these different ways of building the proof lead to exactly the 162 | same evidence being saved in the global environment. *) 163 | 164 | Print ev_4. 165 | (* ===> ev_4 = ev_SS 2 (ev_SS 0 ev_0) : ev 4 *) 166 | Print ev_4'. 167 | (* ===> ev_4' = ev_SS 2 (ev_SS 0 ev_0) : ev 4 *) 168 | Print ev_4''. 169 | (* ===> ev_4'' = ev_SS 2 (ev_SS 0 ev_0) : ev 4 *) 170 | Print ev_4'''. 171 | (* ===> ev_4''' = ev_SS 2 (ev_SS 0 ev_0) : ev 4 *) 172 | 173 | (** **** Exercise: 2 stars (eight_is_even) *) 174 | (** Give a tactic proof and a proof object showing that [ev 8]. *) 175 | 176 | Theorem ev_8 : ev 8. 177 | Proof. 178 | (* FILL IN HERE *) Admitted. 179 | 180 | Definition ev_8' : ev 8 181 | (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. 182 | (** [] *) 183 | 184 | (* ################################################################# *) 185 | (** * Quantifiers, Implications, Functions *) 186 | 187 | (** In Coq's computational universe (where data structures and 188 | programs live), there are two sorts of values with arrows in their 189 | types: _constructors_ introduced by [Inductive]ly defined data 190 | types, and _functions_. 191 | 192 | Similarly, in Coq's logical universe (where we carry out proofs), 193 | there are two ways of giving evidence for an implication: 194 | constructors introduced by [Inductive]ly defined propositions, 195 | and... functions! *) 196 | 197 | (** For example, consider this statement: *) 198 | 199 | Theorem ev_plus4 : forall n, ev n -> ev (4 + n). 200 | Proof. 201 | intros n H. simpl. 202 | apply ev_SS. 203 | apply ev_SS. 204 | apply H. 205 | Qed. 206 | 207 | (** What is the proof object corresponding to [ev_plus4]? 208 | 209 | We're looking for an expression whose _type_ is [forall n, ev n -> 210 | ev (4 + n)] -- that is, a _function_ that takes two arguments (one 211 | number and a piece of evidence) and returns a piece of evidence! 212 | 213 | Here it is: *) 214 | 215 | Definition ev_plus4' : forall n, ev n -> ev (4 + n) := 216 | fun (n : nat) => fun (H : ev n) => 217 | ev_SS (S (S n)) (ev_SS n H). 218 | 219 | (** Recall that [fun n => blah] means "the function that, given [n], 220 | yields [blah]," and that Coq treats [4 + n] and [S (S (S (S n)))] 221 | as synonyms. Another equivalent way to write this definition is: *) 222 | 223 | Definition ev_plus4'' (n : nat) (H : ev n) 224 | : ev (4 + n) := 225 | ev_SS (S (S n)) (ev_SS n H). 226 | 227 | Check ev_plus4''. 228 | (* ===> 229 | : forall n : nat, ev n -> ev (4 + n) *) 230 | 231 | (** When we view the proposition being proved by [ev_plus4] as a 232 | function type, one interesting point becomes apparent: The second 233 | argument's type, [ev n], mentions the _value_ of the first 234 | argument, [n]. 235 | 236 | While such _dependent types_ are not found in conventional 237 | programming languages, they can be useful in programming too, as 238 | the recent flurry of activity in the functional programming 239 | community demonstrates. *) 240 | 241 | (** Notice that both implication ([->]) and quantification ([forall]) 242 | correspond to functions on evidence. In fact, they are really the 243 | same thing: [->] is just a shorthand for a degenerate use of 244 | [forall] where there is no dependency, i.e., no need to give a 245 | name to the type on the left-hand side of the arrow: 246 | 247 | forall (x:nat), nat 248 | = forall (_:nat), nat 249 | = nat -> nat 250 | *) 251 | 252 | 253 | (** For example, consider this proposition: *) 254 | 255 | Definition ev_plus2 : Prop := 256 | forall n, forall (E : ev n), ev (n + 2). 257 | 258 | (** A proof term inhabiting this proposition would be a function 259 | with two arguments: a number [n] and some evidence [E] that [n] is 260 | even. But the name [E] for this evidence is not used in the rest 261 | of the statement of [ev_plus2], so it's a bit silly to bother 262 | making up a name for it. We could write it like this instead, 263 | using the dummy identifier [_] in place of a real name: *) 264 | 265 | Definition ev_plus2' : Prop := 266 | forall n, forall (_ : ev n), ev (n + 2). 267 | 268 | (** Or, equivalently, we can write it in more familiar notation: *) 269 | 270 | Definition ev_plus2'' : Prop := 271 | forall n, ev n -> ev (n + 2). 272 | 273 | (** In general, "[P -> Q]" is just syntactic sugar for 274 | "[forall (_:P), Q]". *) 275 | 276 | (* ################################################################# *) 277 | (** * Programming with Tactics *) 278 | 279 | (** If we can build proofs by giving explicit terms rather than 280 | executing tactic scripts, you may be wondering whether we can 281 | build _programs_ using _tactics_ rather than explicit terms. 282 | Naturally, the answer is yes! *) 283 | 284 | Definition add1 : nat -> nat. 285 | intro n. 286 | Show Proof. 287 | apply S. 288 | Show Proof. 289 | apply n. Defined. 290 | 291 | Print add1. 292 | (* ==> 293 | add1 = fun n : nat => S n 294 | : nat -> nat 295 | *) 296 | 297 | Compute add1 2. 298 | (* ==> 3 : nat *) 299 | 300 | (** Notice that we terminate the [Definition] with a [.] rather than 301 | with [:=] followed by a term. This tells Coq to enter _proof 302 | scripting mode_ to build an object of type [nat -> nat]. Also, we 303 | terminate the proof with [Defined] rather than [Qed]; this makes 304 | the definition _transparent_ so that it can be used in computation 305 | like a normally-defined function. ([Qed]-defined objects are 306 | opaque during computation.) 307 | 308 | This feature is mainly useful for writing functions with dependent 309 | types, which we won't explore much further in this book. But it 310 | does illustrate the uniformity and orthogonality of the basic 311 | ideas in Coq. *) 312 | 313 | 314 | (* ################################################################# *) 315 | (** * Logical Connectives as Inductive Types *) 316 | 317 | (** Inductive definitions are powerful enough to express most of the 318 | connectives and quantifiers we have seen so far. Indeed, only 319 | universal quantification (and thus implication) is built into Coq; 320 | all the others are defined inductively. We'll see these 321 | definitions in this section. *) 322 | 323 | Module Props. 324 | 325 | (** ** Conjunction 326 | 327 | To prove that [P /\ Q] holds, we must present evidence for both 328 | [P] and [Q]. Thus, it makes sense to define a proof object for [P 329 | /\ Q] as consisting of a pair of two proofs: one for [P] and 330 | another one for [Q]. This leads to the following definition. *) 331 | 332 | Module And. 333 | 334 | Inductive and (P Q : Prop) : Prop := 335 | | conj : P -> Q -> and P Q. 336 | 337 | End And. 338 | 339 | (** Notice the similarity with the definition of the [prod] type, 340 | given in chapter [Poly]; the only difference is that [prod] takes 341 | [Type] arguments, whereas [and] takes [Prop] arguments. *) 342 | 343 | Print prod. 344 | (* ===> 345 | Inductive prod (X Y : Type) : Type := 346 | | pair : X -> Y -> X * Y. *) 347 | 348 | (** This should clarify why [destruct] and [intros] patterns can be 349 | used on a conjunctive hypothesis. Case analysis allows us to 350 | consider all possible ways in which [P /\ Q] was proved -- here 351 | just one (the [conj] constructor). Similarly, the [split] tactic 352 | actually works for any inductively defined proposition with only 353 | one constructor. In particular, it works for [and]: *) 354 | 355 | Lemma and_comm : forall P Q : Prop, P /\ Q <-> Q /\ P. 356 | Proof. 357 | intros P Q. split. 358 | - intros [HP HQ]. split. 359 | + apply HQ. 360 | + apply HP. 361 | - intros [HP HQ]. split. 362 | + apply HQ. 363 | + apply HP. 364 | Qed. 365 | 366 | (** This shows why the inductive definition of [and] can be 367 | manipulated by tactics as we've been doing. We can also use it to 368 | build proofs directly, using pattern-matching. For instance: *) 369 | 370 | Definition and_comm'_aux P Q (H : P /\ Q) := 371 | match H with 372 | | conj HP HQ => conj HQ HP 373 | end. 374 | 375 | Definition and_comm' P Q : P /\ Q <-> Q /\ P := 376 | conj (and_comm'_aux P Q) (and_comm'_aux Q P). 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 | (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. 383 | (** [] *) 384 | 385 | 386 | 387 | (** ** Disjunction 388 | 389 | The inductive definition of disjunction uses two constructors, one 390 | for each side of the disjunct: *) 391 | 392 | Module Or. 393 | 394 | Inductive or (P Q : Prop) : Prop := 395 | | or_introl : P -> or P Q 396 | | or_intror : Q -> or P Q. 397 | 398 | End Or. 399 | 400 | (** This declaration explains the behavior of the [destruct] tactic on 401 | a disjunctive hypothesis, since the generated subgoals match the 402 | shape of the [or_introl] and [or_intror] constructors. 403 | 404 | Once again, we can also directly write proof objects for theorems 405 | involving [or], without resorting to tactics. *) 406 | 407 | (** **** Exercise: 2 stars, optional (or_commut'') *) 408 | (** Try to write down an explicit proof object for [or_commut] (without 409 | using [Print] to peek at the ones we already defined!). *) 410 | 411 | Definition or_comm : forall P Q, P \/ Q -> Q \/ P 412 | (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. 413 | (** [] *) 414 | 415 | (** ** Existential Quantification 416 | 417 | To give evidence for an existential quantifier, we package a 418 | witness [x] together with a proof that [x] satisfies the property 419 | [P]: *) 420 | 421 | Module Ex. 422 | 423 | Inductive ex {A : Type} (P : A -> Prop) : Prop := 424 | | ex_intro : forall x : A, P x -> ex P. 425 | 426 | End Ex. 427 | 428 | (** This may benefit from a little unpacking. The core definition is 429 | for a type former [ex] that can be used to build propositions of 430 | the form [ex P], where [P] itself is a _function_ from witness 431 | values in the type [A] to propositions. The [ex_intro] 432 | constructor then offers a way of constructing evidence for [ex P], 433 | given a witness [x] and a proof of [P x]. *) 434 | 435 | (** The more familiar form [exists x, P x] desugars to an expression 436 | involving [ex]: *) 437 | 438 | Check ex (fun n => ev n). 439 | (* ===> exists n : nat, ev n 440 | : Prop *) 441 | 442 | (** Here's how to define an explicit proof object involving [ex]: *) 443 | 444 | Definition some_nat_is_even : exists n, ev n := 445 | ex_intro ev 4 (ev_SS 2 (ev_SS 0 ev_0)). 446 | 447 | (** **** Exercise: 2 stars, optional (ex_ev_Sn) *) 448 | (** Complete the definition of the following proof object: *) 449 | 450 | Definition ex_ev_Sn : ex (fun n => ev (S n)) 451 | (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. 452 | (** [] *) 453 | 454 | (* ================================================================= *) 455 | (** ** [True] and [False] *) 456 | 457 | (** The inductive definition of the [True] proposition is simple: *) 458 | 459 | Inductive True : Prop := 460 | | I : True. 461 | 462 | (** It has one constructor (so every proof of [True] is the same, so 463 | being given a proof of [True] is not informative.) *) 464 | 465 | (** [False] is equally simple -- indeed, so simple it may look 466 | syntactically wrong at first glance! *) 467 | 468 | Inductive False : Prop :=. 469 | 470 | (** That is, [False] is an inductive type with _no_ constructors -- 471 | i.e., no way to build evidence for it. *) 472 | 473 | End Props. 474 | 475 | (* ################################################################# *) 476 | (** * Equality *) 477 | 478 | (** Even Coq's equality relation is not built in. It has the 479 | following inductive definition. (Actually, the definition in the 480 | standard library is a small variant of this, which gives an 481 | induction principle that is slightly easier to use.) *) 482 | 483 | Module MyEquality. 484 | 485 | Inductive eq {X:Type} : X -> X -> Prop := 486 | | eq_refl : forall x, eq x x. 487 | 488 | Notation "x = y" := (eq x y) 489 | (at level 70, no associativity) 490 | : type_scope. 491 | 492 | (** The way to think about this definition is that, given a set [X], 493 | it defines a _family_ of propositions "[x] is equal to [y]," 494 | indexed by pairs of values ([x] and [y]) from [X]. There is just 495 | one way of constructing evidence for each member of this family: 496 | applying the constructor [eq_refl] to a type [X] and a value [x : 497 | X] yields evidence that [x] is equal to [x]. *) 498 | 499 | (** We can use [eq_refl] to construct evidence that, for example, [2 = 500 | 2]. Can we also use it to construct evidence that [1 + 1 = 2]? 501 | Yes, we can. Indeed, it is the very same piece of evidence! 502 | 503 | The reason is that Coq treats as "the same" any two terms that are 504 | _convertible_ according to a simple set of computation rules. 505 | 506 | These rules, which are similar to those used by [Compute], include 507 | evaluation of function application, inlining of definitions, and 508 | simplification of [match]es. *) 509 | 510 | Lemma four: 2 + 2 = 1 + 3. 511 | Proof. 512 | apply eq_refl. 513 | Qed. 514 | 515 | (** The [reflexivity] tactic that we have used to prove equalities up 516 | to now is essentially just short-hand for [apply eq_refl]. 517 | 518 | In tactic-based proofs of equality, the conversion rules are 519 | normally hidden in uses of [simpl] (either explicit or implicit in 520 | other tactics such as [reflexivity]). 521 | 522 | But you can see them directly at work in the following explicit 523 | proof objects: *) 524 | 525 | Definition four' : 2 + 2 = 1 + 3 := 526 | eq_refl 4. 527 | 528 | Definition singleton : forall (X:Type) (x:X), []++[x] = x::[] := 529 | fun (X:Type) (x:X) => eq_refl [x]. 530 | 531 | End MyEquality. 532 | 533 | 534 | (** **** Exercise: 2 stars (equality__leibniz_equality) *) 535 | (** The inductive definition of equality implies _Leibniz equality_: 536 | what we mean when we say "[x] and [y] are equal" is that every 537 | property on [P] that is true of [x] is also true of [y]. *) 538 | 539 | Lemma equality__leibniz_equality : forall (X : Type) (x y: X), 540 | x = y -> forall P:X->Prop, P x -> P y. 541 | Proof. 542 | (* FILL IN HERE *) Admitted. 543 | (** [] *) 544 | 545 | (** **** Exercise: 5 stars, optional (leibniz_equality__equality) *) 546 | (** Show that, in fact, the inductive definition of equality is 547 | _equivalent_ to Leibniz equality: *) 548 | 549 | Lemma leibniz_equality__equality : forall (X : Type) (x y: X), 550 | (forall P:X->Prop, P x -> P y) -> x = y. 551 | Proof. 552 | (* FILL IN HERE *) Admitted. 553 | (** [] *) 554 | 555 | (* ================================================================= *) 556 | (** ** Inversion, Again *) 557 | 558 | (** We've seen [inversion] used with both equality hypotheses and 559 | hypotheses about inductively defined propositions. Now that we've 560 | seen that these are actually the same thing, we're in a position 561 | to take a closer look at how [inversion] behaves. 562 | 563 | In general, the [inversion] tactic... 564 | 565 | - takes a hypothesis [H] whose type [P] is inductively defined, 566 | and 567 | 568 | - for each constructor [C] in [P]'s definition, 569 | 570 | - generates a new subgoal in which we assume [H] was 571 | built with [C], 572 | 573 | - adds the arguments (premises) of [C] to the context of 574 | the subgoal as extra hypotheses, 575 | 576 | - matches the conclusion (result type) of [C] against the 577 | current goal and calculates a set of equalities that must 578 | hold in order for [C] to be applicable, 579 | 580 | - adds these equalities to the context (and, for convenience, 581 | rewrites them in the goal), and 582 | 583 | - if the equalities are not satisfiable (e.g., they involve 584 | things like [S n = O]), immediately solves the subgoal. *) 585 | 586 | (** _Example_: If we invert a hypothesis built with [or], there are 587 | two constructors, so two subgoals get generated. The 588 | conclusion (result type) of the constructor ([P \/ Q]) doesn't 589 | place any restrictions on the form of [P] or [Q], so we don't get 590 | any extra equalities in the context of the subgoal. *) 591 | 592 | (** _Example_: If we invert a hypothesis built with [and], there is 593 | only one constructor, so only one subgoal gets generated. Again, 594 | the conclusion (result type) of the constructor ([P /\ Q]) doesn't 595 | place any restrictions on the form of [P] or [Q], so we don't get 596 | any extra equalities in the context of the subgoal. The 597 | constructor does have two arguments, though, and these can be seen 598 | in the context in the subgoal. *) 599 | 600 | (** _Example_: If we invert a hypothesis built with [eq], there is 601 | again only one constructor, so only one subgoal gets generated. 602 | Now, though, the form of the [refl_equal] constructor does give us 603 | some extra information: it tells us that the two arguments to [eq] 604 | must be the same! The [inversion] tactic adds this fact to the 605 | context. *) 606 | 607 | 608 | -------------------------------------------------------------------------------- /ProofObjectsTest.v: -------------------------------------------------------------------------------- 1 | Set Warnings "-notation-overridden,-parsing". 2 | From Coq Require Export String. 3 | From LF Require Import ProofObjects. 4 | Parameter MISSING: Type. 5 | 6 | Module Check. 7 | 8 | Ltac check_type A B := 9 | match type of A with 10 | | context[MISSING] => idtac "Missing:" A 11 | | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] 12 | end. 13 | 14 | Ltac print_manual_grade A := 15 | match eval compute in A with 16 | | Some (pair ?S ?C) => 17 | idtac "Score:" S; 18 | match eval compute in C with 19 | | ""%string => idtac "Comment: None" 20 | | _ => idtac "Comment:" C 21 | end 22 | | None => 23 | idtac "Score: Ungraded"; 24 | idtac "Comment: None" 25 | end. 26 | 27 | End Check. 28 | 29 | From LF Require Import ProofObjects. 30 | Import Check. 31 | 32 | Goal True. 33 | 34 | idtac "------------------- eight_is_even --------------------". 35 | idtac " ". 36 | 37 | idtac "#> ev_8". 38 | idtac "Possible points: 1". 39 | check_type @ev_8 ((ev 8)). 40 | idtac "Assumptions:". 41 | Abort. 42 | Print Assumptions ev_8. 43 | Goal True. 44 | idtac " ". 45 | 46 | idtac "#> ev_8'". 47 | idtac "Possible points: 1". 48 | check_type @ev_8' ((ev 8)). 49 | idtac "Assumptions:". 50 | Abort. 51 | Print Assumptions ev_8'. 52 | Goal True. 53 | idtac " ". 54 | 55 | idtac "------------------- equality__leibniz_equality --------------------". 56 | idtac " ". 57 | 58 | idtac "#> equality__leibniz_equality". 59 | idtac "Possible points: 2". 60 | check_type @equality__leibniz_equality ( 61 | (forall (X : Type) (x y : X), x = y -> forall P : X -> Prop, P x -> P y)). 62 | idtac "Assumptions:". 63 | Abort. 64 | Print Assumptions equality__leibniz_equality. 65 | Goal True. 66 | idtac " ". 67 | 68 | idtac " ". 69 | 70 | idtac "Max points - standard: 4". 71 | idtac "Max points - advanced: 4". 72 | Abort. 73 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | ######################################################################### 2 | SOFTWARE FOUNDATIONS 3 | ######################################################################### 4 | 5 | This directory contains both Coq scripts (.v files) and more readable 6 | HTML files for the Software Foundations electronic textbook. 7 | 8 | - Preface.v or Preface.html 9 | The place to start reading, including details on how to install 10 | required software 11 | 12 | - index.html 13 | The book's cover page and navigation starting point 14 | 15 | - deps.html 16 | Overview of the ordering of chapters 17 | 18 | - LICENSE 19 | Explanation of how these files may be redistributed -------------------------------------------------------------------------------- /Rel.v: -------------------------------------------------------------------------------- 1 | (** * Rel: Properties of Relations *) 2 | 3 | (** This short (and optional) chapter develops some basic definitions 4 | and a few theorems about binary relations in Coq. The key 5 | definitions are repeated where they are actually used (in the 6 | [Smallstep] chapter of _Programming Language Foundations_), 7 | so readers who are already comfortable with these ideas can safely 8 | skim or skip this chapter. However, relations are also a good 9 | source of exercises for developing facility with Coq's basic 10 | reasoning facilities, so it may be useful to look at this material 11 | just after the [IndProp] chapter. *) 12 | 13 | Set Warnings "-notation-overridden,-parsing". 14 | From LF Require Export IndProp. 15 | 16 | (* ################################################################# *) 17 | (** * Relations *) 18 | 19 | (** A binary _relation_ on a set [X] is a family of propositions 20 | parameterized by two elements of [X] -- i.e., a proposition about 21 | pairs of elements of [X]. *) 22 | 23 | Definition relation (X: Type) := X -> X -> Prop. 24 | 25 | (** Confusingly, the Coq standard library hijacks the generic term 26 | "relation" for this specific instance of the idea. To maintain 27 | consistency with the library, we will do the same. So, henceforth 28 | the Coq identifier [relation] will always refer to a binary 29 | relation between some set and itself, whereas the English word 30 | "relation" can refer either to the specific Coq concept or the 31 | more general concept of a relation between any number of possibly 32 | different sets. The context of the discussion should always make 33 | clear which is meant. *) 34 | 35 | (** An example relation on [nat] is [le], the less-than-or-equal-to 36 | relation, which we usually write [n1 <= n2]. *) 37 | 38 | Print le. 39 | (* ====> Inductive le (n : nat) : nat -> Prop := 40 | le_n : n <= n 41 | | le_S : forall m : nat, n <= m -> n <= S m *) 42 | Check le : nat -> nat -> Prop. 43 | Check le : relation nat. 44 | (** (Why did we write it this way instead of starting with [Inductive 45 | le : relation nat...]? Because we wanted to put the first [nat] 46 | to the left of the [:], which makes Coq generate a somewhat nicer 47 | induction principle for reasoning about [<=].) *) 48 | 49 | (* ################################################################# *) 50 | (** * Basic Properties *) 51 | 52 | (** As anyone knows who has taken an undergraduate discrete math 53 | course, there is a lot to be said about relations in general, 54 | including ways of classifying relations (as reflexive, transitive, 55 | etc.), theorems that can be proved generically about certain sorts 56 | of relations, constructions that build one relation from another, 57 | etc. For example... *) 58 | 59 | (* ----------------------------------------------------------------- *) 60 | (** *** Partial Functions *) 61 | 62 | (** A relation [R] on a set [X] is a _partial function_ if, for every 63 | [x], there is at most one [y] such that [R x y] -- i.e., [R x y1] 64 | and [R x y2] together imply [y1 = y2]. *) 65 | 66 | Definition partial_function {X: Type} (R: relation X) := 67 | forall x y1 y2 : X, R x y1 -> R x y2 -> y1 = y2. 68 | 69 | (** For example, the [next_nat] relation defined earlier is a partial 70 | function. *) 71 | 72 | Print next_nat. 73 | (* ====> Inductive next_nat (n : nat) : nat -> Prop := 74 | nn : next_nat n (S n) *) 75 | Check next_nat : relation nat. 76 | 77 | Theorem next_nat_partial_function : 78 | partial_function next_nat. 79 | Proof. 80 | unfold partial_function. 81 | intros x y1 y2 H1 H2. 82 | inversion H1. inversion H2. 83 | reflexivity. Qed. 84 | 85 | (** However, the [<=] relation on numbers is not a partial 86 | function. (Assume, for a contradiction, that [<=] is a partial 87 | function. But then, since [0 <= 0] and [0 <= 1], it follows that 88 | [0 = 1]. This is nonsense, so our assumption was 89 | contradictory.) *) 90 | 91 | Theorem le_not_a_partial_function : 92 | ~ (partial_function le). 93 | Proof. 94 | unfold not. unfold partial_function. intros Hc. 95 | assert (0 = 1) as Nonsense. { 96 | apply Hc with (x := 0). 97 | - apply le_n. 98 | - apply le_S. apply le_n. } 99 | inversion Nonsense. Qed. 100 | 101 | (** **** Exercise: 2 stars, optional (total_relation_not_partial) *) 102 | (** Show that the [total_relation] defined in earlier is not a partial 103 | function. *) 104 | 105 | (* FILL IN HERE *) 106 | (** [] *) 107 | 108 | (** **** Exercise: 2 stars, optional (empty_relation_partial) *) 109 | (** Show that the [empty_relation] that we defined earlier is a 110 | partial function. *) 111 | 112 | (* FILL IN HERE *) 113 | (** [] *) 114 | 115 | (* ----------------------------------------------------------------- *) 116 | (** *** Reflexive Relations *) 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 | (* ----------------------------------------------------------------- *) 130 | (** *** Transitive Relations *) 131 | 132 | (** A relation [R] is _transitive_ if [R a c] holds whenever [R a b] 133 | and [R b c] do. *) 134 | 135 | Definition transitive {X: Type} (R: relation X) := 136 | forall a b c : X, (R a b) -> (R b c) -> (R a c). 137 | 138 | Theorem le_trans : 139 | transitive le. 140 | Proof. 141 | intros n m o Hnm Hmo. 142 | induction Hmo. 143 | - (* le_n *) apply Hnm. 144 | - (* le_S *) apply le_S. apply IHHmo. Qed. 145 | 146 | Theorem lt_trans: 147 | transitive lt. 148 | Proof. 149 | unfold lt. unfold transitive. 150 | intros n m o Hnm Hmo. 151 | apply le_S in Hnm. 152 | apply le_trans with (a := (S n)) (b := (S m)) (c := o). 153 | apply Hnm. 154 | apply Hmo. Qed. 155 | 156 | (** **** Exercise: 2 stars, optional (le_trans_hard_way) *) 157 | (** We can also prove [lt_trans] more laboriously by induction, 158 | without using [le_trans]. Do this.*) 159 | 160 | Theorem lt_trans' : 161 | transitive lt. 162 | Proof. 163 | (* Prove this by induction on evidence that [m] is less than [o]. *) 164 | unfold lt. unfold transitive. 165 | intros n m o Hnm Hmo. 166 | induction Hmo as [| m' Hm'o]. 167 | (* FILL IN HERE *) Admitted. 168 | (** [] *) 169 | 170 | (** **** Exercise: 2 stars, optional (lt_trans'') *) 171 | (** Prove the same thing again by induction on [o]. *) 172 | 173 | Theorem lt_trans'' : 174 | transitive lt. 175 | Proof. 176 | unfold lt. unfold transitive. 177 | intros n m o Hnm Hmo. 178 | induction o as [| o']. 179 | (* FILL IN HERE *) Admitted. 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. 191 | Qed. 192 | 193 | (** **** Exercise: 1 star, optional (le_S_n) *) 194 | Theorem le_S_n : forall n m, 195 | (S n <= S m) -> (n <= m). 196 | Proof. 197 | (* FILL IN HERE *) Admitted. 198 | (** [] *) 199 | 200 | (** **** Exercise: 2 stars, optional (le_Sn_n_inf) *) 201 | (** Provide an informal proof of the following theorem: 202 | 203 | Theorem: For every [n], [~ (S n <= n)] 204 | 205 | A formal proof of this is an optional exercise below, but try 206 | writing an informal proof without doing the formal proof first. 207 | 208 | Proof: *) 209 | (* FILL IN HERE *) 210 | (** [] *) 211 | 212 | (** **** Exercise: 1 star, optional (le_Sn_n) *) 213 | Theorem le_Sn_n : forall n, 214 | ~ (S n <= n). 215 | Proof. 216 | (* FILL IN HERE *) Admitted. 217 | (** [] *) 218 | 219 | (** Reflexivity and transitivity are the main concepts we'll need for 220 | later chapters, but, for a bit of additional practice working with 221 | relations in Coq, let's look at a few other common ones... *) 222 | 223 | (* ----------------------------------------------------------------- *) 224 | (** *** Symmetric and Antisymmetric Relations *) 225 | 226 | (** A relation [R] is _symmetric_ if [R a b] implies [R b a]. *) 227 | 228 | Definition symmetric {X: Type} (R: relation X) := 229 | forall a b : X, (R a b) -> (R b a). 230 | 231 | (** **** Exercise: 2 stars, optional (le_not_symmetric) *) 232 | Theorem le_not_symmetric : 233 | ~ (symmetric le). 234 | Proof. 235 | (* FILL IN HERE *) Admitted. 236 | (** [] *) 237 | 238 | (** A relation [R] is _antisymmetric_ if [R a b] and [R b a] together 239 | imply [a = b] -- that is, if the only "cycles" in [R] are trivial 240 | ones. *) 241 | 242 | Definition antisymmetric {X: Type} (R: relation X) := 243 | forall a b : X, (R a b) -> (R b a) -> a = b. 244 | 245 | (** **** Exercise: 2 stars, optional (le_antisymmetric) *) 246 | Theorem le_antisymmetric : 247 | antisymmetric le. 248 | Proof. 249 | (* FILL IN HERE *) Admitted. 250 | (** [] *) 251 | 252 | (** **** Exercise: 2 stars, optional (le_step) *) 253 | Theorem le_step : forall n m p, 254 | n < m -> 255 | m <= S p -> 256 | n <= p. 257 | Proof. 258 | (* FILL IN HERE *) Admitted. 259 | (** [] *) 260 | 261 | (* ----------------------------------------------------------------- *) 262 | (** *** Equivalence Relations *) 263 | 264 | (** A relation is an _equivalence_ if it's reflexive, symmetric, and 265 | transitive. *) 266 | 267 | Definition equivalence {X:Type} (R: relation X) := 268 | (reflexive R) /\ (symmetric R) /\ (transitive R). 269 | 270 | (* ----------------------------------------------------------------- *) 271 | (** *** Partial Orders and Preorders *) 272 | 273 | (** A relation is a _partial order_ when it's reflexive, 274 | _anti_-symmetric, and transitive. In the Coq standard library 275 | it's called just "order" for short. *) 276 | 277 | Definition order {X:Type} (R: relation X) := 278 | (reflexive R) /\ (antisymmetric R) /\ (transitive R). 279 | 280 | (** A preorder is almost like a partial order, but doesn't have to be 281 | antisymmetric. *) 282 | 283 | Definition preorder {X:Type} (R: relation X) := 284 | (reflexive R) /\ (transitive R). 285 | 286 | Theorem le_order : 287 | order le. 288 | Proof. 289 | unfold order. split. 290 | - (* refl *) apply le_reflexive. 291 | - split. 292 | + (* antisym *) apply le_antisymmetric. 293 | + (* transitive. *) apply le_trans. Qed. 294 | 295 | (* ################################################################# *) 296 | (** * Reflexive, Transitive Closure *) 297 | 298 | (** The _reflexive, transitive closure_ of a relation [R] is the 299 | smallest relation that contains [R] and that is both reflexive and 300 | transitive. Formally, it is defined like this in the Relations 301 | module of the Coq standard library: *) 302 | 303 | Inductive clos_refl_trans {A: Type} (R: relation A) : relation A := 304 | | rt_step : forall x y, R x y -> clos_refl_trans R x y 305 | | rt_refl : forall x, clos_refl_trans R x x 306 | | rt_trans : forall x y z, 307 | clos_refl_trans R x y -> 308 | clos_refl_trans R y z -> 309 | clos_refl_trans R x z. 310 | 311 | (** For example, the reflexive and transitive closure of the 312 | [next_nat] relation coincides with the [le] relation. *) 313 | 314 | Theorem next_nat_closure_is_le : forall n m, 315 | (n <= m) <-> ((clos_refl_trans next_nat) n m). 316 | Proof. 317 | intros n m. split. 318 | - (* -> *) 319 | intro H. induction H. 320 | + (* le_n *) apply rt_refl. 321 | + (* le_S *) 322 | apply rt_trans with m. apply IHle. apply rt_step. 323 | apply nn. 324 | - (* <- *) 325 | intro H. induction H. 326 | + (* rt_step *) inversion H. apply le_S. apply le_n. 327 | + (* rt_refl *) apply le_n. 328 | + (* rt_trans *) 329 | apply le_trans with y. 330 | apply IHclos_refl_trans1. 331 | apply IHclos_refl_trans2. Qed. 332 | 333 | (** The above definition of reflexive, transitive closure is natural: 334 | it says, explicitly, that the reflexive and transitive closure of 335 | [R] is the least relation that includes [R] and that is closed 336 | under rules of reflexivity and transitivity. But it turns out 337 | that this definition is not very convenient for doing proofs, 338 | since the "nondeterminism" of the [rt_trans] rule can sometimes 339 | lead to tricky inductions. Here is a more useful definition: *) 340 | 341 | Inductive clos_refl_trans_1n {A : Type} 342 | (R : relation A) (x : A) 343 | : A -> Prop := 344 | | rt1n_refl : clos_refl_trans_1n R x x 345 | | rt1n_trans (y z : A) : 346 | R x y -> clos_refl_trans_1n R y z -> 347 | clos_refl_trans_1n R x z. 348 | 349 | (** Our new definition of reflexive, transitive closure "bundles" 350 | the [rt_step] and [rt_trans] rules into the single rule step. 351 | The left-hand premise of this step is a single use of [R], 352 | leading to a much simpler induction principle. 353 | 354 | Before we go on, we should check that the two definitions do 355 | indeed define the same relation... 356 | 357 | First, we prove two lemmas showing that [clos_refl_trans_1n] mimics 358 | the behavior of the two "missing" [clos_refl_trans] 359 | constructors. *) 360 | 361 | Lemma rsc_R : forall (X:Type) (R:relation X) (x y : X), 362 | R x y -> clos_refl_trans_1n R x y. 363 | Proof. 364 | intros X R x y H. 365 | apply rt1n_trans with y. apply H. apply rt1n_refl. Qed. 366 | 367 | (** **** Exercise: 2 stars, optional (rsc_trans) *) 368 | Lemma rsc_trans : 369 | forall (X:Type) (R: relation X) (x y z : X), 370 | clos_refl_trans_1n R x y -> 371 | clos_refl_trans_1n R y z -> 372 | clos_refl_trans_1n R x z. 373 | Proof. 374 | (* FILL IN HERE *) Admitted. 375 | (** [] *) 376 | 377 | (** Then we use these facts to prove that the two definitions of 378 | reflexive, transitive closure do indeed define the same 379 | relation. *) 380 | 381 | (** **** Exercise: 3 stars, optional (rtc_rsc_coincide) *) 382 | Theorem rtc_rsc_coincide : 383 | forall (X:Type) (R: relation X) (x y : X), 384 | clos_refl_trans R x y <-> clos_refl_trans_1n R x y. 385 | Proof. 386 | (* FILL IN HERE *) Admitted. 387 | (** [] *) 388 | 389 | -------------------------------------------------------------------------------- /RelTest.v: -------------------------------------------------------------------------------- 1 | Set Warnings "-notation-overridden,-parsing". 2 | From Coq Require Export String. 3 | From LF Require Import Rel. 4 | Parameter MISSING: Type. 5 | 6 | Module Check. 7 | 8 | Ltac check_type A B := 9 | match type of A with 10 | | context[MISSING] => idtac "Missing:" A 11 | | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] 12 | end. 13 | 14 | Ltac print_manual_grade A := 15 | match eval compute in A with 16 | | Some (pair ?S ?C) => 17 | idtac "Score:" S; 18 | match eval compute in C with 19 | | ""%string => idtac "Comment: None" 20 | | _ => idtac "Comment:" C 21 | end 22 | | None => 23 | idtac "Score: Ungraded"; 24 | idtac "Comment: None" 25 | end. 26 | 27 | End Check. 28 | 29 | From LF Require Import Rel. 30 | Import Check. 31 | 32 | Goal True. 33 | 34 | idtac " ". 35 | 36 | idtac "Max points - standard: 0". 37 | idtac "Max points - advanced: 0". 38 | Abort. 39 | -------------------------------------------------------------------------------- /TacticsTest.v: -------------------------------------------------------------------------------- 1 | Set Warnings "-notation-overridden,-parsing". 2 | From Coq Require Export String. 3 | From LF Require Import Tactics. 4 | Parameter MISSING: Type. 5 | 6 | Module Check. 7 | 8 | Ltac check_type A B := 9 | match type of A with 10 | | context[MISSING] => idtac "Missing:" A 11 | | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] 12 | end. 13 | 14 | Ltac print_manual_grade A := 15 | match eval compute in A with 16 | | Some (pair ?S ?C) => 17 | idtac "Score:" S; 18 | match eval compute in C with 19 | | ""%string => idtac "Comment: None" 20 | | _ => idtac "Comment:" C 21 | end 22 | | None => 23 | idtac "Score: Ungraded"; 24 | idtac "Comment: None" 25 | end. 26 | 27 | End Check. 28 | 29 | From LF Require Import Tactics. 30 | Import Check. 31 | 32 | Goal True. 33 | 34 | idtac "------------------- apply_exercise1 --------------------". 35 | idtac " ". 36 | 37 | idtac "#> rev_exercise1". 38 | idtac "Possible points: 3". 39 | check_type @rev_exercise1 ((forall l l' : list nat, l = @rev nat l' -> l' = @rev nat l)). 40 | idtac "Assumptions:". 41 | Abort. 42 | Print Assumptions rev_exercise1. 43 | Goal True. 44 | idtac " ". 45 | 46 | idtac "------------------- inversion_ex3 --------------------". 47 | idtac " ". 48 | 49 | idtac "#> inversion_ex3". 50 | idtac "Possible points: 1". 51 | check_type @inversion_ex3 ( 52 | (forall (X : Type) (x y z w : X) (l j : list X), 53 | x :: y :: l = w :: z :: j -> x :: l = z :: j -> x = y)). 54 | idtac "Assumptions:". 55 | Abort. 56 | Print Assumptions inversion_ex3. 57 | Goal True. 58 | idtac " ". 59 | 60 | idtac "------------------- inversion_ex6 --------------------". 61 | idtac " ". 62 | 63 | idtac "#> inversion_ex6". 64 | idtac "Possible points: 1". 65 | check_type @inversion_ex6 ( 66 | (forall (X : Type) (x y z : X) (l j : list X), 67 | x :: y :: l = [ ] -> y :: l = z :: j -> x = z)). 68 | idtac "Assumptions:". 69 | Abort. 70 | Print Assumptions inversion_ex6. 71 | Goal True. 72 | idtac " ". 73 | 74 | idtac "------------------- plus_n_n_injective --------------------". 75 | idtac " ". 76 | 77 | idtac "#> plus_n_n_injective". 78 | idtac "Possible points: 3". 79 | check_type @plus_n_n_injective ((forall n m : nat, n + n = m + m -> n = m)). 80 | idtac "Assumptions:". 81 | Abort. 82 | Print Assumptions plus_n_n_injective. 83 | Goal True. 84 | idtac " ". 85 | 86 | idtac "------------------- beq_nat_true --------------------". 87 | idtac " ". 88 | 89 | idtac "#> beq_nat_true". 90 | idtac "Possible points: 2". 91 | check_type @beq_nat_true ((forall n m : nat, beq_nat n m = true -> n = m)). 92 | idtac "Assumptions:". 93 | Abort. 94 | Print Assumptions beq_nat_true. 95 | Goal True. 96 | idtac " ". 97 | 98 | idtac "------------------- beq_nat_true_informal --------------------". 99 | idtac " ". 100 | 101 | idtac "#> Manually graded: informal_proof". 102 | idtac "Advanced". 103 | idtac "Possible points: 2". 104 | print_manual_grade manual_grade_for_informal_proof. 105 | idtac " ". 106 | 107 | idtac "------------------- gen_dep_practice --------------------". 108 | idtac " ". 109 | 110 | idtac "#> nth_error_after_last". 111 | idtac "Possible points: 3". 112 | check_type @nth_error_after_last ( 113 | (forall (n : nat) (X : Type) (l : list X), 114 | @length X l = n -> @nth_error X l n = @None X)). 115 | idtac "Assumptions:". 116 | Abort. 117 | Print Assumptions nth_error_after_last. 118 | Goal True. 119 | idtac " ". 120 | 121 | idtac "------------------- destruct_eqn_practice --------------------". 122 | idtac " ". 123 | 124 | idtac "#> bool_fn_applied_thrice". 125 | idtac "Possible points: 2". 126 | check_type @bool_fn_applied_thrice ( 127 | (forall (f : bool -> bool) (b : bool), f (f (f b)) = f b)). 128 | idtac "Assumptions:". 129 | Abort. 130 | Print Assumptions bool_fn_applied_thrice. 131 | Goal True. 132 | idtac " ". 133 | 134 | idtac "------------------- beq_nat_sym --------------------". 135 | idtac " ". 136 | 137 | idtac "#> beq_nat_sym". 138 | idtac "Possible points: 3". 139 | check_type @beq_nat_sym ((forall n m : nat, beq_nat n m = beq_nat m n)). 140 | idtac "Assumptions:". 141 | Abort. 142 | Print Assumptions beq_nat_sym. 143 | Goal True. 144 | idtac " ". 145 | 146 | idtac "------------------- split_combine --------------------". 147 | idtac " ". 148 | 149 | idtac "#> Manually graded: split_combine". 150 | idtac "Advanced". 151 | idtac "Possible points: 3". 152 | print_manual_grade manual_grade_for_split_combine. 153 | idtac " ". 154 | 155 | idtac "------------------- filter_exercise --------------------". 156 | idtac " ". 157 | 158 | idtac "#> filter_exercise". 159 | idtac "Advanced". 160 | idtac "Possible points: 3". 161 | check_type @filter_exercise ( 162 | (forall (X : Type) (test : X -> bool) (x : X) (l lf : list X), 163 | @filter X test l = x :: lf -> test x = true)). 164 | idtac "Assumptions:". 165 | Abort. 166 | Print Assumptions filter_exercise. 167 | Goal True. 168 | idtac " ". 169 | 170 | idtac "------------------- forall_exists_challenge --------------------". 171 | idtac " ". 172 | 173 | idtac "#> Manually graded: forall_exists_challenge". 174 | idtac "Advanced". 175 | idtac "Possible points: 4". 176 | print_manual_grade manual_grade_for_forall_exists_challenge. 177 | idtac " ". 178 | 179 | idtac " ". 180 | 181 | idtac "Max points - standard: 18". 182 | idtac "Max points - advanced: 30". 183 | Abort. 184 | -------------------------------------------------------------------------------- /_CoqProject: -------------------------------------------------------------------------------- 1 | -Q . LF 2 | -------------------------------------------------------------------------------- /deps.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neshkeev/Logical-Foundations/f529036b8e483f1beb737386c02fc5d18e6deae2/deps.gif -------------------------------------------------------------------------------- /deps.map: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | -------------------------------------------------------------------------------- /imp.mli: -------------------------------------------------------------------------------- 1 | 2 | val negb : bool -> bool 3 | 4 | val app : 'a1 list -> 'a1 list -> 'a1 list 5 | 6 | val add : int -> int -> int 7 | 8 | val mul : int -> int -> int 9 | 10 | val sub : int -> int -> int 11 | 12 | module Nat : 13 | sig 14 | val eqb : int -> int -> bool 15 | 16 | val leb : int -> int -> bool 17 | end 18 | 19 | type positive = 20 | | XI of positive 21 | | XO of positive 22 | | XH 23 | 24 | type n = 25 | | N0 26 | | Npos of positive 27 | 28 | module Pos : 29 | sig 30 | val succ : positive -> positive 31 | 32 | val add : positive -> positive -> positive 33 | 34 | val add_carry : positive -> positive -> positive 35 | 36 | val mul : positive -> positive -> positive 37 | 38 | val iter_op : ('a1 -> 'a1 -> 'a1) -> positive -> 'a1 -> 'a1 39 | 40 | val to_nat : positive -> int 41 | end 42 | 43 | module N : 44 | sig 45 | val add : n -> n -> n 46 | 47 | val mul : n -> n -> n 48 | 49 | val to_nat : n -> int 50 | end 51 | 52 | val rev : 'a1 list -> 'a1 list 53 | 54 | val map : ('a1 -> 'a2) -> 'a1 list -> 'a2 list 55 | 56 | val fold_left : ('a1 -> 'a2 -> 'a1) -> 'a2 list -> 'a1 -> 'a1 57 | 58 | val fold_right : ('a2 -> 'a1 -> 'a1) -> 'a1 -> 'a2 list -> 'a1 59 | 60 | val forallb : ('a1 -> bool) -> 'a1 list -> bool 61 | 62 | val n_of_digits : bool list -> n 63 | 64 | val n_of_ascii : char -> n 65 | 66 | val nat_of_ascii : char -> int 67 | 68 | val string_dec : char list -> char list -> bool 69 | 70 | val append : char list -> char list -> char list 71 | 72 | val beq_string : char list -> char list -> bool 73 | 74 | type 'a total_map = char list -> 'a 75 | 76 | val t_empty : 'a1 -> 'a1 total_map 77 | 78 | val t_update : 'a1 total_map -> char list -> 'a1 -> char list -> 'a1 79 | 80 | type state = int total_map 81 | 82 | type aexp = 83 | | ANum of int 84 | | AId of char list 85 | | APlus of aexp * aexp 86 | | AMinus of aexp * aexp 87 | | AMult of aexp * aexp 88 | 89 | type bexp = 90 | | BTrue 91 | | BFalse 92 | | BEq of aexp * aexp 93 | | BLe of aexp * aexp 94 | | BNot of bexp 95 | | BAnd of bexp * bexp 96 | 97 | val aeval : state -> aexp -> int 98 | 99 | val beval : state -> bexp -> bool 100 | 101 | type com = 102 | | CSkip 103 | | CAss of char list * aexp 104 | | CSeq of com * com 105 | | CIf of bexp * com * com 106 | | CWhile of bexp * com 107 | 108 | val ceval_step : state -> com -> int -> state option 109 | 110 | val isWhite : char -> bool 111 | 112 | val isLowerAlpha : char -> bool 113 | 114 | val isAlpha : char -> bool 115 | 116 | val isDigit : char -> bool 117 | 118 | type chartype = 119 | | White 120 | | Alpha 121 | | Digit 122 | | Other 123 | 124 | val classifyChar : char -> chartype 125 | 126 | val list_of_string : char list -> char list 127 | 128 | val string_of_list : char list -> char list 129 | 130 | type token = char list 131 | 132 | val tokenize_helper : chartype -> char list -> char list -> char list list 133 | 134 | val tokenize : char list -> char list list 135 | 136 | type 'x optionE = 137 | | SomeE of 'x 138 | | NoneE of char list 139 | 140 | type 't parser0 = token list -> ('t * token list) optionE 141 | 142 | val many_helper : 143 | 'a1 parser0 -> 'a1 list -> int -> token list -> ('a1 list * token list) 144 | optionE 145 | 146 | val many : 'a1 parser0 -> int -> 'a1 list parser0 147 | 148 | val firstExpect : token -> 'a1 parser0 -> 'a1 parser0 149 | 150 | val expect : token -> unit parser0 151 | 152 | val parseIdentifier : token list -> (char list * token list) optionE 153 | 154 | val parseNumber : token list -> (int * token list) optionE 155 | 156 | val parsePrimaryExp : int -> token list -> (aexp * token list) optionE 157 | 158 | val parseProductExp : int -> token list -> (aexp * token list) optionE 159 | 160 | val parseSumExp : int -> token list -> (aexp * token list) optionE 161 | 162 | val parseAExp : int -> token list -> (aexp * token list) optionE 163 | 164 | val parseAtomicExp : int -> token list -> (bexp * token list) optionE 165 | 166 | val parseConjunctionExp : int -> token list -> (bexp * token list) optionE 167 | 168 | val parseBExp : int -> token list -> (bexp * token list) optionE 169 | 170 | val parseSimpleCommand : int -> token list -> (com * token list) optionE 171 | 172 | val parseSequencedCommand : int -> token list -> (com * token list) optionE 173 | 174 | val bignumber : int 175 | 176 | val parse : char list -> (com * token list) optionE 177 | 178 | val empty_state : int total_map 179 | -------------------------------------------------------------------------------- /imp1.ml: -------------------------------------------------------------------------------- 1 | 2 | type bool = 3 | | True 4 | | False 5 | 6 | (** val negb : bool -> bool **) 7 | 8 | let negb = function 9 | | True -> False 10 | | False -> True 11 | 12 | type nat = 13 | | O 14 | | S of nat 15 | 16 | type 'a option = 17 | | Some of 'a 18 | | None 19 | 20 | type sumbool = 21 | | Left 22 | | Right 23 | 24 | (** val add : nat -> nat -> nat **) 25 | 26 | let rec add n m = 27 | match n with 28 | | O -> m 29 | | S p -> S (add p m) 30 | 31 | (** val mul : nat -> nat -> nat **) 32 | 33 | let rec mul n m = 34 | match n with 35 | | O -> O 36 | | S p -> add m (mul p m) 37 | 38 | (** val sub : nat -> nat -> nat **) 39 | 40 | let rec sub n m = 41 | match n with 42 | | O -> n 43 | | S k -> (match m with 44 | | O -> n 45 | | S l -> sub k l) 46 | 47 | (** val bool_dec : bool -> bool -> sumbool **) 48 | 49 | let bool_dec b1 b2 = 50 | match b1 with 51 | | True -> (match b2 with 52 | | True -> Left 53 | | False -> Right) 54 | | False -> (match b2 with 55 | | True -> Right 56 | | False -> Left) 57 | 58 | module Nat = 59 | struct 60 | (** val eqb : nat -> nat -> bool **) 61 | 62 | let rec eqb n m = 63 | match n with 64 | | O -> (match m with 65 | | O -> True 66 | | S _ -> False) 67 | | S n' -> (match m with 68 | | O -> False 69 | | S m' -> eqb n' m') 70 | 71 | (** val leb : nat -> nat -> bool **) 72 | 73 | let rec leb n m = 74 | match n with 75 | | O -> True 76 | | S n' -> (match m with 77 | | O -> False 78 | | S m' -> leb n' m') 79 | end 80 | 81 | type ascii = 82 | | Ascii of bool * bool * bool * bool * bool * bool * bool * bool 83 | 84 | (** val ascii_dec : ascii -> ascii -> sumbool **) 85 | 86 | let ascii_dec a b = 87 | let Ascii (x, x0, x1, x2, x3, x4, x5, x6) = a in 88 | let Ascii (b8, b9, b10, b11, b12, b13, b14, b15) = b in 89 | (match bool_dec x b8 with 90 | | Left -> 91 | (match bool_dec x0 b9 with 92 | | Left -> 93 | (match bool_dec x1 b10 with 94 | | Left -> 95 | (match bool_dec x2 b11 with 96 | | Left -> 97 | (match bool_dec x3 b12 with 98 | | Left -> 99 | (match bool_dec x4 b13 with 100 | | Left -> 101 | (match bool_dec x5 b14 with 102 | | Left -> bool_dec x6 b15 103 | | Right -> Right) 104 | | Right -> Right) 105 | | Right -> Right) 106 | | Right -> Right) 107 | | Right -> Right) 108 | | Right -> Right) 109 | | Right -> Right) 110 | 111 | type string = 112 | | EmptyString 113 | | String of ascii * string 114 | 115 | (** val string_dec : string -> string -> sumbool **) 116 | 117 | let rec string_dec s x = 118 | match s with 119 | | EmptyString -> (match x with 120 | | EmptyString -> Left 121 | | String (_, _) -> Right) 122 | | String (a, s0) -> 123 | (match x with 124 | | EmptyString -> Right 125 | | String (a0, s1) -> 126 | (match ascii_dec a a0 with 127 | | Left -> string_dec s0 s1 128 | | Right -> Right)) 129 | 130 | (** val beq_string : string -> string -> bool **) 131 | 132 | let beq_string x y = 133 | match string_dec x y with 134 | | Left -> True 135 | | Right -> False 136 | 137 | type 'a total_map = string -> 'a 138 | 139 | (** val t_update : 'a1 total_map -> string -> 'a1 -> string -> 'a1 **) 140 | 141 | let t_update m x v x' = 142 | match beq_string x x' with 143 | | True -> v 144 | | False -> m x' 145 | 146 | type state = nat total_map 147 | 148 | type aexp = 149 | | ANum of nat 150 | | AId of string 151 | | APlus of aexp * aexp 152 | | AMinus of aexp * aexp 153 | | AMult of aexp * aexp 154 | 155 | type bexp = 156 | | BTrue 157 | | BFalse 158 | | BEq of aexp * aexp 159 | | BLe of aexp * aexp 160 | | BNot of bexp 161 | | BAnd of bexp * bexp 162 | 163 | (** val aeval : state -> aexp -> nat **) 164 | 165 | let rec aeval st = function 166 | | ANum n -> n 167 | | AId x -> st x 168 | | APlus (a1, a2) -> add (aeval st a1) (aeval st a2) 169 | | AMinus (a1, a2) -> sub (aeval st a1) (aeval st a2) 170 | | AMult (a1, a2) -> mul (aeval st a1) (aeval st a2) 171 | 172 | (** val beval : state -> bexp -> bool **) 173 | 174 | let rec beval st = function 175 | | BTrue -> True 176 | | BFalse -> False 177 | | BEq (a1, a2) -> Nat.eqb (aeval st a1) (aeval st a2) 178 | | BLe (a1, a2) -> Nat.leb (aeval st a1) (aeval st a2) 179 | | BNot b1 -> negb (beval st b1) 180 | | BAnd (b1, b2) -> 181 | (match beval st b1 with 182 | | True -> beval st b2 183 | | False -> False) 184 | 185 | type com = 186 | | CSkip 187 | | CAss of string * aexp 188 | | CSeq of com * com 189 | | CIf of bexp * com * com 190 | | CWhile of bexp * com 191 | 192 | (** val ceval_step : state -> com -> nat -> state option **) 193 | 194 | let rec ceval_step st c = function 195 | | O -> None 196 | | S i' -> 197 | (match c with 198 | | CSkip -> Some st 199 | | CAss (l, a1) -> Some (t_update st l (aeval st a1)) 200 | | CSeq (c1, c2) -> 201 | (match ceval_step st c1 i' with 202 | | Some st' -> ceval_step st' c2 i' 203 | | None -> None) 204 | | CIf (b, c1, c2) -> 205 | (match beval st b with 206 | | True -> ceval_step st c1 i' 207 | | False -> ceval_step st c2 i') 208 | | CWhile (b1, c1) -> 209 | (match beval st b1 with 210 | | True -> 211 | (match ceval_step st c1 i' with 212 | | Some st' -> ceval_step st' c i' 213 | | None -> None) 214 | | False -> Some st)) 215 | -------------------------------------------------------------------------------- /imp1.mli: -------------------------------------------------------------------------------- 1 | 2 | type bool = 3 | | True 4 | | False 5 | 6 | val negb : bool -> bool 7 | 8 | type nat = 9 | | O 10 | | S of nat 11 | 12 | type 'a option = 13 | | Some of 'a 14 | | None 15 | 16 | type sumbool = 17 | | Left 18 | | Right 19 | 20 | val add : nat -> nat -> nat 21 | 22 | val mul : nat -> nat -> nat 23 | 24 | val sub : nat -> nat -> nat 25 | 26 | val bool_dec : bool -> bool -> sumbool 27 | 28 | module Nat : 29 | sig 30 | val eqb : nat -> nat -> bool 31 | 32 | val leb : nat -> nat -> bool 33 | end 34 | 35 | type ascii = 36 | | Ascii of bool * bool * bool * bool * bool * bool * bool * bool 37 | 38 | val ascii_dec : ascii -> ascii -> sumbool 39 | 40 | type string = 41 | | EmptyString 42 | | String of ascii * string 43 | 44 | val string_dec : string -> string -> sumbool 45 | 46 | val beq_string : string -> string -> bool 47 | 48 | type 'a total_map = string -> 'a 49 | 50 | val t_update : 'a1 total_map -> string -> 'a1 -> string -> 'a1 51 | 52 | type state = nat total_map 53 | 54 | type aexp = 55 | | ANum of nat 56 | | AId of string 57 | | APlus of aexp * aexp 58 | | AMinus of aexp * aexp 59 | | AMult of aexp * aexp 60 | 61 | type bexp = 62 | | BTrue 63 | | BFalse 64 | | BEq of aexp * aexp 65 | | BLe of aexp * aexp 66 | | BNot of bexp 67 | | BAnd of bexp * bexp 68 | 69 | val aeval : state -> aexp -> nat 70 | 71 | val beval : state -> bexp -> bool 72 | 73 | type com = 74 | | CSkip 75 | | CAss of string * aexp 76 | | CSeq of com * com 77 | | CIf of bexp * com * com 78 | | CWhile of bexp * com 79 | 80 | val ceval_step : state -> com -> nat -> state option 81 | -------------------------------------------------------------------------------- /imp2.ml: -------------------------------------------------------------------------------- 1 | 2 | (** val negb : bool -> bool **) 3 | 4 | let negb = function 5 | | true -> false 6 | | false -> true 7 | 8 | type 'a option = 9 | | Some of 'a 10 | | None 11 | 12 | type sumbool = 13 | | Left 14 | | Right 15 | 16 | (** val add : int -> int -> int **) 17 | 18 | let rec add = ( + ) 19 | 20 | (** val mul : int -> int -> int **) 21 | 22 | let rec mul = ( * ) 23 | 24 | (** val sub : int -> int -> int **) 25 | 26 | let rec sub n m = 27 | (fun zero succ n -> 28 | if n=0 then zero () else succ (n-1)) 29 | (fun _ -> n) 30 | (fun k -> 31 | (fun zero succ n -> 32 | if n=0 then zero () else succ (n-1)) 33 | (fun _ -> n) 34 | (fun l -> sub k l) 35 | m) 36 | n 37 | 38 | (** val bool_dec : bool -> bool -> sumbool **) 39 | 40 | let bool_dec b1 b2 = 41 | if b1 then if b2 then Left else Right else if b2 then Right else Left 42 | 43 | module Nat = 44 | struct 45 | (** val eqb : int -> int -> bool **) 46 | 47 | let rec eqb = ( = ) 48 | 49 | (** val leb : int -> int -> bool **) 50 | 51 | let rec leb n m = 52 | (fun zero succ n -> 53 | if n=0 then zero () else succ (n-1)) 54 | (fun _ -> true) 55 | (fun n' -> 56 | (fun zero succ n -> 57 | if n=0 then zero () else succ (n-1)) 58 | (fun _ -> false) 59 | (fun m' -> leb n' m') 60 | m) 61 | n 62 | end 63 | 64 | type ascii = 65 | | Ascii of bool * bool * bool * bool * bool * bool * bool * bool 66 | 67 | (** val ascii_dec : ascii -> ascii -> sumbool **) 68 | 69 | let ascii_dec a b = 70 | let Ascii (x, x0, x1, x2, x3, x4, x5, x6) = a in 71 | let Ascii (b8, b9, b10, b11, b12, b13, b14, b15) = b in 72 | (match bool_dec x b8 with 73 | | Left -> 74 | (match bool_dec x0 b9 with 75 | | Left -> 76 | (match bool_dec x1 b10 with 77 | | Left -> 78 | (match bool_dec x2 b11 with 79 | | Left -> 80 | (match bool_dec x3 b12 with 81 | | Left -> 82 | (match bool_dec x4 b13 with 83 | | Left -> 84 | (match bool_dec x5 b14 with 85 | | Left -> bool_dec x6 b15 86 | | Right -> Right) 87 | | Right -> Right) 88 | | Right -> Right) 89 | | Right -> Right) 90 | | Right -> Right) 91 | | Right -> Right) 92 | | Right -> Right) 93 | 94 | type string = 95 | | EmptyString 96 | | String of ascii * string 97 | 98 | (** val string_dec : string -> string -> sumbool **) 99 | 100 | let rec string_dec s x = 101 | match s with 102 | | EmptyString -> (match x with 103 | | EmptyString -> Left 104 | | String (_, _) -> Right) 105 | | String (a, s0) -> 106 | (match x with 107 | | EmptyString -> Right 108 | | String (a0, s1) -> 109 | (match ascii_dec a a0 with 110 | | Left -> string_dec s0 s1 111 | | Right -> Right)) 112 | 113 | (** val beq_string : string -> string -> bool **) 114 | 115 | let beq_string x y = 116 | match string_dec x y with 117 | | Left -> true 118 | | Right -> false 119 | 120 | type 'a total_map = string -> 'a 121 | 122 | (** val t_update : 'a1 total_map -> string -> 'a1 -> string -> 'a1 **) 123 | 124 | let t_update m x v x' = 125 | if beq_string x x' then v else m x' 126 | 127 | type state = int total_map 128 | 129 | type aexp = 130 | | ANum of int 131 | | AId of string 132 | | APlus of aexp * aexp 133 | | AMinus of aexp * aexp 134 | | AMult of aexp * aexp 135 | 136 | type bexp = 137 | | BTrue 138 | | BFalse 139 | | BEq of aexp * aexp 140 | | BLe of aexp * aexp 141 | | BNot of bexp 142 | | BAnd of bexp * bexp 143 | 144 | (** val aeval : state -> aexp -> int **) 145 | 146 | let rec aeval st = function 147 | | ANum n -> n 148 | | AId x -> st x 149 | | APlus (a1, a2) -> add (aeval st a1) (aeval st a2) 150 | | AMinus (a1, a2) -> sub (aeval st a1) (aeval st a2) 151 | | AMult (a1, a2) -> mul (aeval st a1) (aeval st a2) 152 | 153 | (** val beval : state -> bexp -> bool **) 154 | 155 | let rec beval st = function 156 | | BTrue -> true 157 | | BFalse -> false 158 | | BEq (a1, a2) -> Nat.eqb (aeval st a1) (aeval st a2) 159 | | BLe (a1, a2) -> Nat.leb (aeval st a1) (aeval st a2) 160 | | BNot b1 -> negb (beval st b1) 161 | | BAnd (b1, b2) -> if beval st b1 then beval st b2 else false 162 | 163 | type com = 164 | | CSkip 165 | | CAss of string * aexp 166 | | CSeq of com * com 167 | | CIf of bexp * com * com 168 | | CWhile of bexp * com 169 | 170 | (** val ceval_step : state -> com -> int -> state option **) 171 | 172 | let rec ceval_step st c i = 173 | (fun zero succ n -> 174 | if n=0 then zero () else succ (n-1)) 175 | (fun _ -> None) 176 | (fun i' -> 177 | match c with 178 | | CSkip -> Some st 179 | | CAss (l, a1) -> Some (t_update st l (aeval st a1)) 180 | | CSeq (c1, c2) -> 181 | (match ceval_step st c1 i' with 182 | | Some st' -> ceval_step st' c2 i' 183 | | None -> None) 184 | | CIf (b, c1, c2) -> 185 | if beval st b then ceval_step st c1 i' else ceval_step st c2 i' 186 | | CWhile (b1, c1) -> 187 | if beval st b1 188 | then (match ceval_step st c1 i' with 189 | | Some st' -> ceval_step st' c i' 190 | | None -> None) 191 | else Some st) 192 | i 193 | -------------------------------------------------------------------------------- /imp2.mli: -------------------------------------------------------------------------------- 1 | 2 | val negb : bool -> bool 3 | 4 | type 'a option = 5 | | Some of 'a 6 | | None 7 | 8 | type sumbool = 9 | | Left 10 | | Right 11 | 12 | val add : int -> int -> int 13 | 14 | val mul : int -> int -> int 15 | 16 | val sub : int -> int -> int 17 | 18 | val bool_dec : bool -> bool -> sumbool 19 | 20 | module Nat : 21 | sig 22 | val eqb : int -> int -> bool 23 | 24 | val leb : int -> int -> bool 25 | end 26 | 27 | type ascii = 28 | | Ascii of bool * bool * bool * bool * bool * bool * bool * bool 29 | 30 | val ascii_dec : ascii -> ascii -> sumbool 31 | 32 | type string = 33 | | EmptyString 34 | | String of ascii * string 35 | 36 | val string_dec : string -> string -> sumbool 37 | 38 | val beq_string : string -> string -> bool 39 | 40 | type 'a total_map = string -> 'a 41 | 42 | val t_update : 'a1 total_map -> string -> 'a1 -> string -> 'a1 43 | 44 | type state = int total_map 45 | 46 | type aexp = 47 | | ANum of int 48 | | AId of string 49 | | APlus of aexp * aexp 50 | | AMinus of aexp * aexp 51 | | AMult of aexp * aexp 52 | 53 | type bexp = 54 | | BTrue 55 | | BFalse 56 | | BEq of aexp * aexp 57 | | BLe of aexp * aexp 58 | | BNot of bexp 59 | | BAnd of bexp * bexp 60 | 61 | val aeval : state -> aexp -> int 62 | 63 | val beval : state -> bexp -> bool 64 | 65 | type com = 66 | | CSkip 67 | | CAss of string * aexp 68 | | CSeq of com * com 69 | | CIf of bexp * com * com 70 | | CWhile of bexp * com 71 | 72 | val ceval_step : state -> com -> int -> state option 73 | -------------------------------------------------------------------------------- /impdriver.ml: -------------------------------------------------------------------------------- 1 | open Imp 2 | 3 | let explode s = 4 | let rec exp i l = 5 | if i < 0 then l else exp (i - 1) (s.[i] :: l) in 6 | exp (String.length s - 1) [];; 7 | 8 | let test s = 9 | print_endline s; 10 | let parse_res = parse (explode s) in 11 | (match parse_res with 12 | NoneE _ -> print_endline ("Syntax error"); 13 | | SomeE (c, _) -> 14 | let fuel = 1000 in 15 | match (ceval_step empty_state c fuel) with 16 | None -> 17 | print_endline 18 | ("Still running after " ^ string_of_int fuel ^ " steps") 19 | | Some res -> 20 | print_endline ( 21 | "Result: [" 22 | ^ string_of_int (res ['w']) ^ " " 23 | ^ string_of_int (res ['x']) ^ " " 24 | ^ string_of_int (res ['y']) ^ " " 25 | ^ string_of_int (res ['z']) ^ " ...]")); 26 | print_newline(); 27 | ;; 28 | 29 | test "x:=1 ;; y:=2";; 30 | 31 | test "true";; (* syntax error *) 32 | test "SKIP";; 33 | test "SKIP;;SKIP";; 34 | test "WHILE true DO SKIP END";; 35 | test "x:=3";; 36 | test "x:=3;; WHILE 0<=x DO SKIP END";; 37 | test "x:=3;; WHILE 1<=x DO y:=y+1;; x:=x-1 END";; 38 | --------------------------------------------------------------------------------