├── .gitignore ├── Auto.v ├── Basic.v ├── Equiv.v ├── Imp.v ├── IndProp.v ├── Induction.v ├── Lists.v ├── Logic.v ├── Maps.v ├── Poly.v ├── ProofObjects.v ├── README.md └── Tactics.v /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | .*.aux 3 | *.a 4 | *.cma 5 | *.cmi 6 | *.cmo 7 | *.cmx 8 | *.cmxa 9 | *.cmxs 10 | *.glob 11 | *.ml.d 12 | *.ml4.d 13 | *.mli.d 14 | *.mllib.d 15 | *.mlpack.d 16 | *.native 17 | *.o 18 | *.v.d 19 | *.vio 20 | *.vo 21 | .coq-native/ 22 | .csdp.cache 23 | .lia.cache 24 | .nia.cache 25 | .nlia.cache 26 | .nra.cache 27 | csdp.cache 28 | lia.cache 29 | nia.cache 30 | nlia.cache 31 | nra.cache 32 | -------------------------------------------------------------------------------- /Auto.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.omega.Omega. 2 | Require Import Maps. 3 | Require Import Imp. 4 | 5 | Ltac inv H := inversion H; subst; clear H. 6 | 7 | Example auto_example_1 : forall (P Q R: Prop), 8 | (P -> Q) -> (Q -> R) -> P -> R. 9 | Proof. 10 | intros P Q R H1 H2 H3. 11 | apply H2. apply H1. assumption. 12 | Qed. 13 | 14 | Example auto_example_1' : forall (P Q R: Prop), 15 | (P -> Q) -> (Q -> R) -> P -> R. 16 | Proof. 17 | auto. 18 | Qed. 19 | 20 | Example auto_example_2 : forall P Q R S T U : Prop, 21 | (P -> Q) -> 22 | (P -> R) -> 23 | (T -> R) -> 24 | (S -> T -> U) -> 25 | ((P->Q) -> (P->S)) -> 26 | T -> 27 | P -> 28 | U. 29 | Proof. auto. Qed. 30 | 31 | Example auto_example_3 : forall (P Q R S T U: Prop), 32 | (P -> Q) -> 33 | (Q -> R) -> 34 | (R -> S) -> 35 | (S -> T) -> 36 | (T -> U) -> 37 | P -> 38 | U. 39 | Proof. 40 | auto 6. 41 | Qed. 42 | 43 | Lemma le_antisym : forall n m: nat, (n <= m /\ m <= n) -> n = m. 44 | Proof. intros. omega. Qed. 45 | 46 | Example auto_example_6 : forall n m p : nat, 47 | (n <= p -> (n <= m /\ m <= n)) -> 48 | n <= p -> 49 | n = m. 50 | Proof. 51 | intros. 52 | auto using le_antisym. 53 | Qed. 54 | 55 | Hint Resolve le_antisym. 56 | 57 | Example auto_example_6' : forall n m p : nat, 58 | (n<= p -> (n <= m /\ m <= n)) -> 59 | n <= p -> 60 | n = m. 61 | Proof. 62 | intros. 63 | auto. 64 | Qed. 65 | 66 | 67 | Definition is_fortytwo x := x = 42. 68 | 69 | Hint Unfold is_fortytwo. 70 | 71 | Example auto_example_7' : forall x, 72 | (x <=42 /\ 42 <= x) -> is_fortytwo x. 73 | Proof. auto. Qed. 74 | 75 | 76 | Theorem ceval_deterministic': forall c st st1 st2, 77 | c / st \\ st1 -> 78 | c / st \\ st2 -> 79 | st1 = st2. 80 | Proof. 81 | intros c st st1 st2 E1 E2. 82 | generalize dependent st2; 83 | induction E1; intros st2 E2; inv E2; auto. 84 | - assert (st' = st'0) as EQ1 by auto. 85 | subst st'0. 86 | auto. 87 | - rewrite H in H5. inversion H5. 88 | - rewrite H in H5. inversion H5. 89 | - rewrite H in H2. inversion H2. 90 | - rewrite H in H4. inversion H4. 91 | - assert (st' = st'0) as EQ1 by auto. 92 | subst st'0. 93 | auto. 94 | Qed. 95 | 96 | 97 | Theorem ceval_deterministic'_alt: forall c st st1 st2, 98 | c / st \\ st1 -> 99 | c / st \\ st2 -> 100 | st1 = st2. 101 | Proof with auto. 102 | intros c st st1 st2 E1 E2; 103 | generalize dependent st2; 104 | induction E1; intros st2 E2; inv E2... 105 | - assert (st' = st'0) as EQ1... 106 | subst st'0... 107 | - rewrite H in H5. inversion H5. 108 | - rewrite H in H5. inversion H5. 109 | - rewrite H in H2. inversion H2. 110 | - rewrite H in H4. inversion H4. 111 | - assert (st' = st'0) as EQ1... 112 | subst st'0... 113 | Qed. 114 | 115 | 116 | Ltac rwinv H1 H2 := rewrite H1 in H2; inv H2. 117 | 118 | 119 | Theorem ceval_deterministic'': forall c st st1 st2, 120 | c / st \\ st1 -> 121 | c / st \\ st2 -> 122 | st1 = st2. 123 | Proof with auto. 124 | intros c st st1 st2 E1 E2; 125 | generalize dependent st2; 126 | induction E1; intros st2 E2; inv E2... 127 | - assert (st' = st'0) as EQ1... 128 | subst st'0... 129 | - rwinv H H5. 130 | - rwinv H H5. 131 | - rwinv H H2. 132 | - rwinv H H4. 133 | - assert (st' = st'0) as EQ1... 134 | subst st'0... 135 | Qed. 136 | 137 | Ltac find_rwinv := 138 | match goal with 139 | H1: ?E = true, 140 | H2: ?E = false 141 | |- _ => rwinv H1 H2 142 | end. 143 | 144 | Theorem ceval_deterministic''': forall c st st1 st2, 145 | c / st \\ st1 -> 146 | c / st \\ st2 -> 147 | st1 = st2. 148 | Proof with auto. 149 | intros c st st1 st2 E1 E2; 150 | generalize dependent st2; 151 | induction E1; intros st2 E2; inv E2; try find_rwinv... 152 | - assert (st' = st'0) as EQ1... 153 | subst st'0... 154 | - assert (st' = st'0) as EQ1... 155 | subst st'0... 156 | Qed. 157 | 158 | Theorem ceval_deterministic'''': forall c st st1 st2, 159 | c / st \\ st1 -> 160 | c / st \\ st2 -> 161 | st1 = st2. 162 | Proof with auto. 163 | intros c st st1 st2 E1 E2; 164 | generalize dependent st2; 165 | induction E1; intros st2 E2; inv E2; try find_rwinv... 166 | - rewrite (IHE1_1 st'0 H1) in *... 167 | - rewrite (IHE1_1 st'0 H3) in *... 168 | Qed. 169 | 170 | Ltac find_eqn := 171 | match goal with 172 | H1: forall x, ?P x -> ?L = ?r, 173 | H2: ?P ?X 174 | |- _ => rewrite (H1 X H2) in * 175 | end. 176 | 177 | Theorem ceval_deterministic''''': forall c st st1 st2, 178 | c / st \\ st1 -> 179 | c / st \\ st2 -> 180 | st1 = st2. 181 | Proof with auto. 182 | intros c st st1 st2 E1 E2; 183 | generalize dependent st2; 184 | induction E1; intros st2 E2; inv E2; try find_rwinv; 185 | repeat find_eqn... 186 | Qed. 187 | 188 | Module Repeat. 189 | 190 | Inductive com : Type := 191 | | CSkip : com 192 | | CAsgn : id -> aexp -> com 193 | | CSeq : com -> com -> com 194 | | CIf : bexp -> com -> com -> com 195 | | CWhile : bexp -> com -> com 196 | | CRepeat : com -> bexp -> com. 197 | 198 | Notation "'SKIP'" := 199 | CSkip. 200 | Notation "c1 ; c2" := 201 | (CSeq c1 c2) (at level 80, right associativity). 202 | Notation "X '::=' a" := 203 | (CAsgn X a) (at level 60). 204 | Notation "'WHILE' b 'DO' c 'END'" := 205 | (CWhile b c) (at level 80, right associativity). 206 | Notation "'IFB' e1 'THEN' e2 'ELSE' e3 'FI'" := 207 | (CIf e1 e2 e3) (at level 80, right associativity). 208 | Notation "'REPEAT' e1 'UNTIL' b2 'END'" := 209 | (CRepeat e1 b2) (at level 80, right associativity). 210 | 211 | Inductive ceval : state -> com -> state -> Prop := 212 | | E_Skip : forall st, 213 | ceval st SKIP st 214 | | E_Ass : forall st a1 n X, 215 | aeval st a1 = n -> 216 | ceval st (X ::= a1) (t_update st X n) 217 | | E_Seq : forall c1 c2 st st' st'', 218 | ceval st c1 st' -> 219 | ceval st' c2 st'' -> 220 | ceval st (c1 ; c2) st'' 221 | | E_IfTrue : forall st st' b1 c1 c2, 222 | beval st b1 = true -> 223 | ceval st c1 st' -> 224 | ceval st (IFB b1 THEN c1 ELSE c2 FI) st' 225 | | E_IfFalse : forall st st' b1 c1 c2, 226 | beval st b1 = false -> 227 | ceval st c2 st' -> 228 | ceval st (IFB b1 THEN c1 ELSE c2 FI) st' 229 | | E_WhileEnd : forall b1 st c1, 230 | beval st b1 = false -> 231 | ceval st (WHILE b1 DO c1 END) st 232 | | E_WhileLoop : forall st st' st'' b1 c1, 233 | beval st b1 = true -> 234 | ceval st c1 st' -> 235 | ceval st' (WHILE b1 DO c1 END) st'' -> 236 | ceval st (WHILE b1 DO c1 END) st'' 237 | | E_RepeatEnd : forall st st' b1 c1, 238 | ceval st c1 st' -> 239 | beval st' b1 = true -> 240 | ceval st (CRepeat c1 b1) st' 241 | | E_RepeatLoop : forall st st' st'' b1 c1, 242 | ceval st c1 st' -> 243 | beval st' b1 = false -> 244 | ceval st' (CRepeat c1 b1) st'' -> 245 | ceval st (CRepeat c1 b1) st''. 246 | 247 | Notation "c1 '/' st '\\' st'" := (ceval st c1 st') 248 | (at level 40, st at level 39). 249 | 250 | Theorem ceval_deterministic''''': forall c st st1 st2, 251 | c / st \\ st1 -> 252 | c / st \\ st2 -> 253 | st1 = st2. 254 | Proof with auto. 255 | intros c st st1 st2 E1 E2; 256 | generalize dependent st2; 257 | induction E1; intros st2 E2; inv E2; 258 | repeat find_eqn; try find_rwinv... 259 | Qed. 260 | 261 | End Repeat. 262 | 263 | Example ceval'_example1: 264 | (X ::= ANum 2;; 265 | IFB BLe (AId X) (ANum 1) 266 | THEN Y ::= ANum 3 267 | ELSE Z ::= ANum 4 268 | FI) 269 | / empty_state 270 | \\ (t_update (t_update empty_state X 2) Z 4). 271 | Proof. 272 | eapply E_Seq. 273 | - apply E_Ass. 274 | reflexivity. 275 | - apply E_IfFalse. 276 | + reflexivity. 277 | + apply E_Ass. reflexivity. 278 | Qed. 279 | 280 | Hint Constructors ceval. 281 | Hint Transparent state. 282 | Hint Transparent total_map. 283 | 284 | Definition st12 := t_update (t_update empty_state X 1) Y 2. 285 | Definition st21 := t_update (t_update empty_state X 2) Y 1. 286 | 287 | Example auto_example_8 : exists s', 288 | (IFB (BLe (AId X) (AId Y)) 289 | THEN (Z ::= AMinus (AId Y) (AId X)) 290 | ELSE (Y ::= APlus (AId X) (AId Z)) 291 | FI) / st21 \\ s'. 292 | Proof. eauto. Qed. 293 | 294 | -------------------------------------------------------------------------------- /Basic.v: -------------------------------------------------------------------------------- 1 | Inductive day : Type := 2 | | monday : day 3 | | tuesday : day 4 | | wednesday : day 5 | | thursday : day 6 | | friday : day 7 | | saturday : day 8 | | sunday : day. 9 | 10 | Definition next_weekday (d:day) : day := 11 | match d with 12 | | monday => tuesday 13 | | tuesday => wednesday 14 | | wednesday => thursday 15 | | thursday => friday 16 | | friday => saturday 17 | | saturday => sunday 18 | | sunday => monday 19 | end. 20 | 21 | Compute (next_weekday friday). 22 | Compute (next_weekday (next_weekday monday)). 23 | 24 | Example test_next_weekday: 25 | (next_weekday (next_weekday monday)) = wednesday. 26 | Proof. simpl. reflexivity. Qed. 27 | 28 | Inductive bool : Type := 29 | | true : bool 30 | | false : bool. 31 | 32 | Definition negb (b:bool) : bool := 33 | match b with 34 | | true => false 35 | | false => true 36 | end. 37 | 38 | Definition andb (b1:bool) (b2:bool) : bool := 39 | match b1 with 40 | | true => b2 41 | | false => false 42 | end. 43 | 44 | Definition orb (b1:bool) (b2:bool) : bool := 45 | match b1 with 46 | | true => true 47 | | false => b2 48 | end. 49 | 50 | Compute (andb true true). 51 | Compute (andb true false). 52 | Compute (andb false true). 53 | Compute (andb false false). 54 | 55 | Example test_orb1: (orb true false) = true. 56 | Proof. simpl. reflexivity. Qed. 57 | Example test_orb2: (orb false false) = false. 58 | Proof. simpl. reflexivity. Qed. 59 | Example test_orb3: (orb false true) = true. 60 | Proof. simpl. reflexivity. Qed. 61 | Example test_orb4: (orb true true) = true. 62 | Proof. simpl. reflexivity. Qed. 63 | 64 | Infix "&&" := andb. 65 | Infix "||" := orb. 66 | 67 | Example test_orb5: true || true || false = true. 68 | Proof. simpl. reflexivity. Qed. 69 | 70 | Definition nandb (b1:bool) (b2:bool) : bool := 71 | negb (b1 && b2). 72 | 73 | Example test_nandb1: (nandb true false) = true. 74 | Proof. simpl. reflexivity. Qed. 75 | Example test_nandb2: (nandb false false) = true. 76 | Proof. simpl. reflexivity. Qed. 77 | Example test_nandb3: (nandb false true) = true. 78 | Proof. simpl. reflexivity. Qed. 79 | Example test_nandb4: (nandb true true) = false. 80 | Proof. simpl. reflexivity. Qed. 81 | 82 | 83 | Definition andb3 (b1:bool) (b2:bool) (b3:bool) : bool := 84 | b1 && b2 && b3. 85 | 86 | Example test_andb31: (andb3 true true true) = true. 87 | Proof. simpl. reflexivity. Qed. 88 | 89 | Example test_andb32: (andb3 false true true) = false. 90 | Proof. simpl. reflexivity. Qed. 91 | 92 | Example test_andb33: (andb3 true false true) = false. 93 | Proof. simpl. reflexivity. Qed. 94 | 95 | Example test_andb34: (andb3 true true false) = false. 96 | Proof. simpl. reflexivity. Qed. 97 | 98 | Check true. 99 | Check negb. 100 | 101 | 102 | Module Playground1. 103 | 104 | Inductive nat : Type := 105 | | O : nat 106 | | S : nat -> nat. 107 | 108 | Definition pred (n:nat) : nat := 109 | match n with 110 | | O => O 111 | | S n' => n' 112 | end. 113 | 114 | End Playground1. 115 | 116 | Check (S (S O)). 117 | 118 | Definition minusTwo (n:nat) : nat := 119 | pred (pred n). 120 | 121 | Check minusTwo. 122 | 123 | Compute (minusTwo (S (S (S (S O))))). 124 | 125 | Fixpoint evenb (n:nat) : bool := 126 | match n with 127 | | O => true 128 | | S O => false 129 | | S (S n') => evenb n' 130 | end. 131 | 132 | Definition oddb (n:nat) : bool := negb (evenb n). 133 | 134 | Example test_oddb1: oddb 1 = true. 135 | Proof. simpl. reflexivity. Qed. 136 | Example test_oddb2: oddb 4 = false. 137 | Proof. simpl. reflexivity. Qed. 138 | 139 | 140 | Module Playground2. 141 | 142 | Fixpoint plus (n m:nat) : nat := 143 | match m with 144 | | O => n 145 | | S m' => plus (S n) m' 146 | end. 147 | 148 | Compute (plus 3 3). 149 | 150 | Fixpoint mult (n m:nat) : nat := 151 | match m with 152 | | O => O 153 | | S m' => plus n (mult n m') 154 | end. 155 | 156 | Compute (mult 3 4). 157 | 158 | Example test_mult1: (mult 3 3) = 9. 159 | Proof. simpl. reflexivity. Qed. 160 | 161 | Fixpoint minus (n m:nat) : nat := 162 | match n, m with 163 | | O, _ => O 164 | | S _, O => n 165 | | S n', S m' => minus n' m' 166 | end. 167 | 168 | End Playground2. 169 | 170 | Fixpoint exp (base power : nat) : nat := 171 | match power with 172 | | O => S O 173 | | S p' => mult base (exp base p') 174 | end. 175 | 176 | Example test_exp1: (exp 5 2) = 25. 177 | Proof. simpl. reflexivity. Qed. 178 | 179 | Fixpoint factorial (n:nat) : nat := 180 | match n with 181 | | O => 1 182 | | S n' => mult n (factorial n') 183 | end. 184 | 185 | Example test_factorial1: (factorial 5) = 120. 186 | Proof. simpl. reflexivity. Qed. 187 | 188 | Example test_factorial2: (factorial 5) = (mult 10 12). 189 | Proof. simpl. reflexivity. Qed. 190 | 191 | 192 | Notation "x + y" := (plus x y) 193 | (at level 50, left associativity) 194 | : nat_scope. 195 | Notation "x - y" := (minus x y) 196 | (at level 50, left associativity) 197 | : nat_scope. 198 | Notation "x * y" := (mult x y) 199 | (at level 40, left associativity) 200 | : nat_scope. 201 | 202 | Check ((0 + 1) + 1). 203 | 204 | 205 | Fixpoint beq_nat (n m:nat) : bool := 206 | match n, m with 207 | | O, O => true 208 | | O, S _ => false 209 | | S _, O => false 210 | | S n', S m' => beq_nat n' m' 211 | end. 212 | 213 | Example test_beq_nat1: (beq_nat 3 3) = true. 214 | Proof. simpl. reflexivity. Qed. 215 | 216 | Example test_beq_nat2: (beq_nat 4 3) = false. 217 | Proof. simpl. reflexivity. Qed. 218 | 219 | Fixpoint leb (n m:nat) : bool := 220 | match n, m with 221 | | O, _ => true 222 | | S _, O => false 223 | | S n', S m' => leb n' m' 224 | end. 225 | 226 | Example test_leb1: (leb 2 2) = true. 227 | Proof. simpl. reflexivity. Qed. 228 | Example test_leb2: (leb 2 4) = true. 229 | Proof. simpl. reflexivity. Qed. 230 | Example test_leb3: (leb 4 2) = false. 231 | Proof. simpl. reflexivity. Qed. 232 | 233 | Definition blt_nat (n m : nat) : bool := 234 | negb (leb m n). 235 | 236 | Example test_blt_nat1: (blt_nat 2 2) = false. 237 | Proof. simpl. reflexivity. Qed. 238 | Example test_blt_nat2: (blt_nat 2 4) = true. 239 | Proof. simpl. reflexivity. Qed. 240 | Example test_blt_nat3: (blt_nat 4 2) = false. 241 | Proof. simpl. reflexivity. Qed. 242 | 243 | Theorem plus_O_l: forall n : nat, O + n = n. 244 | Proof. 245 | intros n. reflexivity. Qed. 246 | 247 | Theorem plus_1_l: forall n : nat, 1 + n = S n. 248 | Proof. 249 | intros n. reflexivity. Qed. 250 | 251 | Theorem mult_O_l: forall n : nat, O * n = O. 252 | Proof. 253 | intros n. reflexivity. Qed. 254 | 255 | Theorem mult_O_r: forall n: nat, n * O = O. 256 | Proof. 257 | intros. 258 | induction n as [| n' IHn']. 259 | - reflexivity. 260 | - simpl. rewrite -> IHn'. reflexivity. 261 | Qed. 262 | 263 | Theorem plus_O_r: forall n : nat, n = n + O. 264 | Proof. 265 | intros n. 266 | induction n as [| n' IHn']. 267 | - reflexivity. 268 | - simpl. rewrite <- IHn'. reflexivity. 269 | Qed. 270 | 271 | Theorem plus_1_r: forall n: nat, S n = n + 1. 272 | Proof. 273 | intros. 274 | induction n as [| n' IHn']. 275 | - simpl. reflexivity. 276 | - simpl. rewrite -> IHn'. reflexivity. 277 | Qed. 278 | 279 | Theorem plus_id_example: forall n m : nat, 280 | n = m -> 281 | n + n = m + m. 282 | Proof. 283 | intros n m. 284 | intros H. 285 | rewrite -> H. 286 | reflexivity. Qed. 287 | 288 | 289 | Theorem plus_id_exercise: forall n m o : nat, 290 | n = m -> m = o -> n + m = m + o. 291 | Proof. 292 | intros n m o. 293 | intros H1 H2. 294 | rewrite -> H1. 295 | rewrite -> H2. 296 | reflexivity. Qed. 297 | 298 | Theorem mult_O_plus: forall n m : nat, 299 | (O + n) * m = n * m. 300 | Proof. 301 | intros n m. 302 | rewrite -> plus_O_l. 303 | reflexivity. Qed. 304 | 305 | Theorem mult_S_l: forall n m: nat, 306 | m = S n -> m * (1 + n) = m * m. 307 | Proof. 308 | intros n m. 309 | intros H. 310 | rewrite -> plus_1_l. 311 | rewrite <- H. 312 | reflexivity. Qed. 313 | 314 | Theorem plus_1_neq_0: forall n : nat, 315 | beq_nat (n + 1) 0 = false. 316 | Proof. 317 | intros n. destruct n as [| n']. 318 | - reflexivity. 319 | - reflexivity. 320 | Qed. 321 | 322 | Theorem negb_involutive : forall b : bool, 323 | negb (negb b) = b. 324 | Proof. 325 | intros b. destruct b. 326 | - reflexivity. 327 | - reflexivity. 328 | Qed. 329 | 330 | Theorem andb_commutative: forall a b: bool, 331 | a && b = b && a. 332 | Proof. 333 | intros a b. destruct a. 334 | - destruct b. 335 | + reflexivity. 336 | + reflexivity. 337 | - destruct b. 338 | + reflexivity. 339 | + reflexivity. 340 | Qed. 341 | 342 | 343 | Theorem andb_true_elim2 : forall b c: bool, 344 | (b && c) = true -> c = true. 345 | Proof. 346 | intros [] []. 347 | intros H. 348 | - reflexivity. 349 | - simpl. intros. rewrite -> H. reflexivity. 350 | - simpl. intros. reflexivity. 351 | - simpl. intros. rewrite -> H. reflexivity. 352 | Qed. 353 | 354 | Theorem zero_nbeq_plus_1 : forall n: nat, 355 | beq_nat 0 (n + 1) = false. 356 | Proof. 357 | intros [| n']. 358 | - reflexivity. 359 | - reflexivity. Qed. 360 | 361 | (* Fixpoint blah (n: nat) : nat := 362 | match n with 363 | | O => blah (S O) 364 | | _ => n 365 | end. 366 | *) 367 | 368 | 369 | Theorem identity_fn_applied_twice : 370 | forall (f : bool -> bool), (forall (x : bool), f x = x) -> 371 | forall (b : bool), f (f b) = b. 372 | Proof. 373 | intros. 374 | destruct b. 375 | - rewrite -> H. 376 | rewrite -> H. 377 | reflexivity. 378 | - rewrite -> H. 379 | rewrite -> H. 380 | reflexivity. 381 | Qed. 382 | 383 | Theorem negation_fn_applied_twice : forall (f : bool -> bool), 384 | (forall (x : bool), f x = negb x) -> 385 | forall (b : bool), f (f b) = b. 386 | Proof. 387 | intros. 388 | destruct b. 389 | - rewrite -> H. 390 | rewrite -> H. 391 | reflexivity. 392 | - rewrite -> H. 393 | rewrite -> H. 394 | reflexivity. 395 | Qed. 396 | 397 | Theorem andb_eq_orb : forall (b c: bool), 398 | (b && c = b || c) -> b = c. 399 | Proof. 400 | intros b c. 401 | destruct b. 402 | - destruct c. 403 | + reflexivity. 404 | + simpl. intros. rewrite -> H. reflexivity. 405 | - destruct c. 406 | + simpl. intros. rewrite -> H. reflexivity. 407 | + reflexivity. 408 | Qed. 409 | 410 | 411 | Inductive bin : Type := 412 | | Zero : bin 413 | | TwicePlusOne : bin -> bin 414 | | Twice : bin -> bin. 415 | 416 | 417 | Fixpoint incr (b: bin) : bin := 418 | match b with 419 | | Zero => TwicePlusOne Zero 420 | | Twice n => TwicePlusOne n 421 | | TwicePlusOne n => Twice (incr n) 422 | end. 423 | 424 | Fixpoint bin_to_nat (b: bin) : nat := 425 | match b with 426 | | Zero => O 427 | | Twice n => mult 2 (bin_to_nat n) 428 | | TwicePlusOne n => (mult 2 (bin_to_nat n)) + 1 429 | end. 430 | 431 | Compute (bin_to_nat (incr (incr (incr (incr Zero))))). 432 | 433 | Example test_bin_incr1: (bin_to_nat Zero) = 0. 434 | Proof. reflexivity. Qed. 435 | 436 | Example test_bin_incr2: (bin_to_nat (incr Zero)) = 1. 437 | Proof. reflexivity. Qed. 438 | 439 | Example test_bin_incr3: (bin_to_nat (incr (incr Zero))) = 2. 440 | Proof. reflexivity. Qed. 441 | 442 | Example test_bin_incr4: (bin_to_nat (incr (incr (incr Zero)))) = 3. 443 | Proof. reflexivity. Qed. 444 | 445 | Example test_bin_incr5: (bin_to_nat (incr Zero)) = S (bin_to_nat Zero). 446 | Proof. reflexivity. Qed. 447 | 448 | -------------------------------------------------------------------------------- /Equiv.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.Bool.Bool. 2 | Require Import Coq.Arith.Arith. 3 | Require Import Coq.Arith.EqNat. 4 | Require Import Coq.omega.Omega. 5 | Require Import Coq.Lists.List. 6 | Require Import Coq.Logic.FunctionalExtensionality. 7 | Import ListNotations. 8 | Require Import Maps. 9 | Require Import Imp. 10 | 11 | 12 | Definition aequiv (a1 a2: aexp) : Prop := 13 | forall (st: state), 14 | aeval st a1 = aeval st a2. 15 | 16 | Definition bequiv (b1 b2: bexp) : Prop := 17 | forall (st: state), 18 | beval st b1 = beval st b2. 19 | 20 | Theorem aequiv_example: 21 | aequiv (AMinus (AId X) (AId X)) (ANum 0). 22 | Proof. 23 | unfold aequiv. intros. simpl. omega. 24 | Qed. 25 | 26 | Theorem bequiv_example: 27 | bequiv (BEq (AMinus (AId X) (AId X)) (ANum 0)) BTrue. 28 | Proof. 29 | unfold bequiv. intros. 30 | unfold beval. rewrite aequiv_example. 31 | reflexivity. 32 | Qed. 33 | 34 | Definition cequiv (c1 c2: com) : Prop := 35 | forall (st st': state), 36 | (c1 / st \\ st') <-> (c2 / st \\ st'). 37 | 38 | Theorem skip_left: forall c, 39 | cequiv 40 | (SKIP ;; c) 41 | c. 42 | Proof. 43 | unfold cequiv. intros. 44 | split; intros. 45 | - inversion H. subst. 46 | inversion H2. subst. 47 | assumption. 48 | - apply E_Seq with st. 49 | + apply E_Skip. 50 | + assumption. 51 | Qed. 52 | 53 | Theorem skip_right: forall c, 54 | cequiv 55 | (c ;; SKIP) 56 | c. 57 | Proof. 58 | unfold cequiv. intros. 59 | split; intros. 60 | - inversion H. subst. 61 | inversion H5. subst. 62 | assumption. 63 | - apply E_Seq with st'. 64 | + assumption. 65 | + apply E_Skip. 66 | Qed. 67 | 68 | Theorem IFB_true_simple: forall c1 c2, 69 | cequiv 70 | (IFB BTrue THEN c1 ELSE c2 FI) 71 | c1. 72 | Proof. 73 | unfold cequiv. intros. 74 | split; intros. 75 | - inversion H; subst. 76 | + assumption. 77 | + inversion H5. 78 | - apply E_IfTrue. 79 | + reflexivity. 80 | + assumption. 81 | Qed. 82 | 83 | Theorem IFB_true: forall b c1 c2, 84 | bequiv b BTrue -> 85 | cequiv 86 | (IFB b THEN c1 ELSE c2 FI) 87 | c1. 88 | Proof. 89 | unfold bequiv, cequiv. 90 | split; intros. 91 | - inversion H0; subst. 92 | + assumption. 93 | + rewrite H in H6. 94 | inversion H6. 95 | - apply E_IfTrue. 96 | + apply H. 97 | + assumption. 98 | Qed. 99 | 100 | Theorem IFB_false: forall b c1 c2, 101 | bequiv b BFalse -> 102 | cequiv 103 | (IFB b THEN c1 ELSE c2 FI) 104 | c2. 105 | Proof. 106 | unfold bequiv, cequiv. 107 | split; intros. 108 | - inversion H0; subst. 109 | + rewrite H in H6. 110 | inversion H6. 111 | + assumption. 112 | - apply E_IfFalse. 113 | + apply H. 114 | + assumption. 115 | Qed. 116 | 117 | Theorem swap_if_branches: forall b e1 e2, 118 | cequiv 119 | (IFB b THEN e1 ELSE e2 FI) 120 | (IFB BNot b THEN e2 ELSE e1 FI). 121 | Proof. 122 | unfold cequiv. intros. 123 | split; intros. 124 | - inversion H; subst. 125 | + apply E_IfFalse. 126 | * simpl. rewrite H5. reflexivity. 127 | * assumption. 128 | + apply E_IfTrue. 129 | * simpl. rewrite H5. reflexivity. 130 | * assumption. 131 | - inversion H; subst. 132 | + apply E_IfFalse. 133 | * simpl in H5. rewrite negb_true_iff in H5. apply H5. 134 | * assumption. 135 | + apply E_IfTrue. 136 | * simpl in H5. rewrite negb_false_iff in H5. apply H5. 137 | * assumption. 138 | Qed. 139 | 140 | Theorem WHILE_false : forall b c, 141 | bequiv b BFalse -> 142 | cequiv 143 | (WHILE b DO c END) 144 | SKIP. 145 | Proof. 146 | unfold bequiv, cequiv. intros. 147 | split; intros. 148 | - inversion H0; subst. 149 | + apply E_Skip. 150 | + rewrite H in H3. inversion H3. 151 | - inversion H0; subst. 152 | apply E_WhileEnd. 153 | apply H. 154 | Qed. 155 | 156 | 157 | Theorem WHILE_true_nonterm : forall b c st st', 158 | bequiv b BTrue -> 159 | ~( (WHILE b DO c END) / st \\ st'). 160 | Proof. 161 | unfold not, bequiv. intros. 162 | remember (WHILE b DO c END) as cw. 163 | induction H0; 164 | inversion Heqcw; subst. 165 | - rewrite H in H0. inversion H0. 166 | - apply IHceval2. apply Heqcw. 167 | Qed. 168 | 169 | Lemma bequiv_self : forall b, 170 | bequiv b b. 171 | Proof. 172 | unfold bequiv; intros; reflexivity. 173 | Qed. 174 | 175 | Theorem WHILE_true: forall b c, 176 | bequiv b BTrue -> 177 | cequiv 178 | (WHILE b DO c END) 179 | (WHILE BTrue DO SKIP END). 180 | Proof. 181 | unfold cequiv; intros. 182 | split; intros. 183 | - exfalso. 184 | apply (WHILE_true_nonterm b c st st' H). 185 | apply H0. 186 | - inversion H0; subst. 187 | + apply E_WhileEnd. 188 | inversion H5. 189 | + exfalso. 190 | apply (WHILE_true_nonterm BTrue SKIP st st'). 191 | * apply bequiv_self. 192 | * apply H0. 193 | Qed. 194 | 195 | Theorem loop_unrolling: forall b c, 196 | cequiv 197 | (WHILE b DO c END) 198 | (IFB b THEN (c ;; WHILE b DO c END) ELSE SKIP FI). 199 | Proof. 200 | unfold cequiv; intros. 201 | split; intros. 202 | - inversion H; subst. 203 | + apply E_IfFalse. 204 | * assumption. 205 | * apply E_Skip. 206 | + apply E_IfTrue. 207 | * assumption. 208 | * apply E_Seq with (st' := st'0). 209 | assumption. 210 | assumption. 211 | - inversion H; subst. 212 | + inversion H6; subst. 213 | apply E_WhileLoop with (st' := st'0). 214 | * assumption. 215 | * assumption. 216 | * assumption. 217 | + inversion H6; subst. 218 | apply E_WhileEnd. 219 | assumption. 220 | Qed. 221 | 222 | Theorem seq_assoc : forall c1 c2 c3, 223 | cequiv ((c1;;c2);;c3) (c1;;(c2;;c3)). 224 | Proof. 225 | unfold cequiv; intros. 226 | split; intros. 227 | - inversion H; subst. 228 | inversion H2; subst. 229 | apply E_Seq with (st' := st'1). 230 | assumption. 231 | apply E_Seq with (st' := st'0). 232 | assumption. 233 | assumption. 234 | - inversion H; subst. 235 | inversion H5; subst. 236 | apply E_Seq with (st' := st'1). 237 | apply E_Seq with (st' := st'0). 238 | assumption. 239 | assumption. 240 | assumption. 241 | Qed. 242 | 243 | Theorem identity_assignment : forall (X:id), 244 | cequiv 245 | (X ::= AId X) 246 | SKIP. 247 | Proof. 248 | unfold cequiv; intros. 249 | split; intros. 250 | - inversion H; subst. 251 | simpl in *. 252 | replace (t_update st X (st X)) with st. 253 | + apply E_Skip. 254 | + apply functional_extensionality. intros. 255 | rewrite t_update_same. reflexivity. 256 | - replace st' with (t_update st' X (aeval st' (AId X))). 257 | + inversion H; subst. 258 | apply E_Ass. 259 | reflexivity. 260 | + simpl. rewrite t_update_same. reflexivity. 261 | Qed. 262 | 263 | Theorem assign_aequiv : forall X e, 264 | aequiv (AId X) e -> 265 | cequiv SKIP (X ::= e). 266 | Proof. 267 | unfold aequiv; intros. 268 | split; intros. 269 | - inversion H0; subst. 270 | assert (st' = t_update st' X (st' X)). 271 | + apply functional_extensionality. intros. 272 | rewrite t_update_same. 273 | reflexivity. 274 | + rewrite H1 at 2. 275 | apply E_Ass. 276 | rewrite <- H. 277 | reflexivity. 278 | - inversion H0; subst. 279 | assert (st = t_update st X (aeval st e)). 280 | + apply functional_extensionality. intros. 281 | rewrite <- H. 282 | simpl. 283 | rewrite t_update_same. 284 | reflexivity. 285 | + rewrite <- H1. 286 | apply E_Skip. 287 | Qed. 288 | 289 | Lemma refl_aequiv : forall (a : aexp), aequiv a a. 290 | Proof. 291 | unfold aequiv. reflexivity. 292 | Qed. 293 | 294 | Lemma sym_aequiv : forall (a1 a2 : aexp), 295 | aequiv a1 a2 -> aequiv a2 a1. 296 | Proof. 297 | unfold aequiv; intros. 298 | rewrite H. reflexivity. 299 | Qed. 300 | 301 | Lemma trans_aequiv : forall (a1 a2 a3 : aexp), 302 | aequiv a1 a2 -> aequiv a2 a3 -> aequiv a1 a3. 303 | Proof. 304 | unfold aequiv; intros. 305 | rewrite H, H0. 306 | reflexivity. 307 | Qed. 308 | 309 | Definition refl_bequiv := bequiv_self. 310 | 311 | Lemma sym_bequiv : forall (b1 b2 : bexp), 312 | bequiv b1 b2 -> bequiv b2 b1. 313 | Proof. 314 | unfold bequiv; intros. 315 | rewrite H. 316 | reflexivity. 317 | Qed. 318 | 319 | Lemma trans_bequiv : forall (b1 b2 b3 : bexp), 320 | bequiv b1 b2 -> bequiv b2 b3 -> bequiv b1 b3. 321 | Proof. 322 | unfold bequiv; intros. 323 | rewrite H, H0. 324 | reflexivity. 325 | Qed. 326 | 327 | Lemma refl_cequiv : forall (c: com), cequiv c c. 328 | Proof. 329 | unfold cequiv; intros. 330 | reflexivity. 331 | Qed. 332 | 333 | Lemma sym_cequiv : forall (c1 c2 : com), 334 | cequiv c1 c2 -> cequiv c2 c1. 335 | Proof. 336 | unfold cequiv; intros. 337 | rewrite H. 338 | reflexivity. 339 | Qed. 340 | 341 | Lemma iff_trans : forall (P1 P2 P3 : Prop), 342 | (P1 <-> P2) -> (P2 <-> P3) -> (P1 <-> P3). 343 | Proof. 344 | intros. 345 | rewrite H, H0. 346 | reflexivity. 347 | Qed. 348 | 349 | Lemma trans_cequiv : forall (c1 c2 c3 : com), 350 | cequiv c1 c2 -> cequiv c2 c3 -> cequiv c1 c3. 351 | Proof. 352 | unfold cequiv; intros. 353 | apply (iff_trans (c1 / st \\ st') (c2 / st \\ st') (c3 / st \\ st') (H st st') (H0 st st')). 354 | Qed. 355 | 356 | Theorem CAss_congruence : forall i a1 a1', 357 | aequiv a1 a1' -> 358 | cequiv (CAss i a1) (CAss i a1'). 359 | Proof. 360 | unfold aequiv, cequiv; intros. 361 | split; intros; inversion H0; subst; 362 | first [rewrite H | rewrite <- H]; 363 | apply E_Ass; 364 | reflexivity. 365 | Qed. 366 | 367 | Theorem CWhile_congruence : forall b1 b2 c1 c2, 368 | bequiv b1 b2 -> 369 | cequiv c1 c2 -> 370 | cequiv 371 | (WHILE b1 DO c1 END) 372 | (WHILE b2 DO c2 END). 373 | Proof. 374 | unfold bequiv, cequiv; intros. 375 | split; intros. 376 | - remember (WHILE b1 DO c1 END) as cwhile. 377 | induction H1; inversion Heqcwhile; subst. 378 | + apply E_WhileEnd. rewrite <- H. assumption. 379 | + apply E_WhileLoop with (st' := st'). 380 | * rewrite <- H. assumption. 381 | * rewrite <- H0. assumption. 382 | * apply IHceval2. reflexivity. 383 | - remember (WHILE b2 DO c2 END) as cwhile. 384 | induction H1; inversion Heqcwhile; subst. 385 | + apply E_WhileEnd. rewrite H. assumption. 386 | + apply E_WhileLoop with (st' := st'). 387 | * rewrite H. assumption. 388 | * rewrite H0. assumption. 389 | * apply IHceval2. reflexivity. 390 | Qed. 391 | 392 | Theorem CSeq_congruence : forall c1 c1' c2 c2', 393 | cequiv c1 c1' -> cequiv c2 c2' -> 394 | cequiv (c1;;c2) (c1';;c2'). 395 | Proof. 396 | unfold cequiv; intros. 397 | split; intros. 398 | - remember (c1;;c2) as cseq. 399 | destruct H1; inversion Heqcseq; subst. 400 | + apply E_Seq with (st' := st'). 401 | * apply H. assumption. 402 | * apply H0. assumption. 403 | - remember (c1';;c2') as cseq. 404 | destruct H1; inversion Heqcseq; subst. 405 | + apply E_Seq with (st' := st'). 406 | * apply H. assumption. 407 | * apply H0. assumption. 408 | Qed. 409 | 410 | Theorem CIf_congruence : forall b b' c1 c1' c2 c2', 411 | bequiv b b' -> cequiv c1 c1' -> cequiv c2 c2' -> 412 | cequiv (IFB b THEN c1 ELSE c2 FI) 413 | (IFB b' THEN c1' ELSE c2' FI). 414 | Proof. 415 | unfold bequiv, cequiv; intros. 416 | split; intros. 417 | - remember (IFB b THEN c1 ELSE c2 FI) as cif. 418 | destruct H2; inversion Heqcif; subst. 419 | + apply E_IfTrue. 420 | * rewrite <- H. assumption. 421 | * apply H0. assumption. 422 | + apply E_IfFalse. 423 | * rewrite <- H. assumption. 424 | * apply H1. assumption. 425 | - remember (IFB b' THEN c1' ELSE c2' FI) as cif. 426 | destruct H2; inversion Heqcif; subst. 427 | + apply E_IfTrue. 428 | * rewrite H. assumption. 429 | * apply H0. assumption. 430 | + apply E_IfFalse. 431 | * rewrite H. assumption. 432 | * apply H1. assumption. 433 | Qed. 434 | 435 | Example congruence_example: 436 | cequiv 437 | (* Program 1: *) 438 | (X ::= ANum 0;; 439 | IFB (BEq (AId X) (ANum 0)) 440 | THEN 441 | Y ::= ANum 0 442 | ELSE 443 | Y ::= ANum 42 444 | FI) 445 | (* Program 2: *) 446 | (X ::= ANum 0;; 447 | IFB (BEq (AId X) (ANum 0)) 448 | THEN 449 | Y ::= AMinus (AId X) (AId X) (* <--- changed here *) 450 | ELSE 451 | Y ::= ANum 42 452 | FI). 453 | Proof. 454 | apply CSeq_congruence. 455 | - apply refl_cequiv. 456 | - apply CIf_congruence. 457 | + apply refl_bequiv. 458 | + apply CAss_congruence. 459 | unfold aequiv. simpl. 460 | symmetry. 461 | apply minus_diag. 462 | + apply refl_cequiv. 463 | Qed. 464 | 465 | Definition atrans_sound (atrans : aexp -> aexp) : Prop := 466 | forall (a : aexp), 467 | aequiv a (atrans a). 468 | 469 | Definition btrans_sound (btrans : bexp -> bexp) : Prop := 470 | forall (b : bexp), 471 | bequiv b (btrans b). 472 | 473 | Definition ctrans_sound (ctrans : com -> com) : Prop := 474 | forall (c : com), 475 | cequiv c (ctrans c). 476 | 477 | Fixpoint fold_constants_aexp (a : aexp) : aexp := 478 | match a with 479 | | ANum n => ANum n 480 | | AId i => AId i 481 | | APlus a1 a2 => 482 | match (fold_constants_aexp a1, fold_constants_aexp a2) 483 | with 484 | | (ANum n1, ANum n2) => ANum (n1 + n2) 485 | | (a1', a2') => APlus a1' a2' 486 | end 487 | | AMinus a1 a2 => 488 | match (fold_constants_aexp a1, fold_constants_aexp a2) 489 | with 490 | | (ANum n1, ANum n2) => ANum (n1 - n2) 491 | | (a1', a2') => AMinus a1' a2' 492 | end 493 | | AMult a1 a2 => 494 | match (fold_constants_aexp a1, fold_constants_aexp a2) 495 | with 496 | | (ANum n1, ANum n2) => ANum (n1 * n2) 497 | | (a1', a2') => AMult a1' a2' 498 | end 499 | end. 500 | 501 | Example fold_aexp_ex1 : 502 | fold_constants_aexp 503 | (AMult (APlus (ANum 1) (ANum 2)) (AId X)) 504 | = AMult (ANum 3) (AId X). 505 | Proof. 506 | reflexivity. 507 | Qed. 508 | 509 | Example fold_aexp_ex2 : 510 | fold_constants_aexp 511 | (AMinus (AId X) (APlus (AMult (ANum 0) (ANum 6)) 512 | (AId Y))) 513 | = AMinus (AId X) (APlus (ANum 0) (AId Y)). 514 | Proof. reflexivity. Qed. 515 | 516 | Fixpoint fold_constants_bexp (b : bexp) : bexp := 517 | match b with 518 | | BTrue => BTrue 519 | | BFalse => BFalse 520 | | BEq a1 a2 => 521 | match (fold_constants_aexp a1, fold_constants_aexp a2) with 522 | | (ANum n1, ANum n2) => 523 | if beq_nat n1 n2 then BTrue else BFalse 524 | | (a1', a2') => 525 | BEq a1' a2' 526 | end 527 | | BLe a1 a2 => 528 | match (fold_constants_aexp a1, fold_constants_aexp a2) with 529 | | (ANum n1, ANum n2) => 530 | if leb n1 n2 then BTrue else BFalse 531 | | (a1', a2') => 532 | BLe a1' a2' 533 | end 534 | | BNot b1 => 535 | match (fold_constants_bexp b1) with 536 | | BTrue => BFalse 537 | | BFalse => BTrue 538 | | b1' => BNot b1' 539 | end 540 | | BAnd b1 b2 => 541 | match (fold_constants_bexp b1, fold_constants_bexp b2) with 542 | | (BTrue, BTrue) => BTrue 543 | | (BTrue, BFalse) => BFalse 544 | | (BFalse, BTrue) => BFalse 545 | | (BFalse, BFalse) => BFalse 546 | | (b1', b2') => BAnd b1' b2' 547 | end 548 | end. 549 | 550 | Example fold_bexp_ex1 : 551 | fold_constants_bexp (BAnd BTrue (BNot (BAnd BFalse BTrue))) 552 | = BTrue. 553 | Proof. reflexivity. Qed. 554 | 555 | Example fold_bexp_ex2 : 556 | fold_constants_bexp 557 | (BAnd (BEq (AId X) (AId Y)) 558 | (BEq (ANum 0) 559 | (AMinus (ANum 2) (APlus (ANum 1) 560 | (ANum 1))))) 561 | = BAnd (BEq (AId X) (AId Y)) BTrue. 562 | Proof. reflexivity. Qed. 563 | 564 | Fixpoint fold_constants_com (c : com) : com := 565 | match c with 566 | | SKIP => 567 | SKIP 568 | | i ::= a => 569 | i ::= (fold_constants_aexp a) 570 | | c1 ;; c2 => 571 | (fold_constants_com c1) ;; (fold_constants_com c2) 572 | | IFB b THEN c1 ELSE c2 FI => 573 | match fold_constants_bexp b with 574 | | BTrue => fold_constants_com c1 575 | | BFalse => fold_constants_com c2 576 | | b' => IFB b' THEN fold_constants_com c1 577 | ELSE fold_constants_com c2 FI 578 | end 579 | | WHILE b DO c END => 580 | match fold_constants_bexp b with 581 | | BTrue => WHILE BTrue DO SKIP END 582 | | BFalse => SKIP 583 | | b' => WHILE b' DO (fold_constants_com c) END 584 | end 585 | end. 586 | 587 | Example fold_com_ex1 : 588 | fold_constants_com 589 | (* Original program: *) 590 | (X ::= APlus (ANum 4) (ANum 5);; 591 | Y ::= AMinus (AId X) (ANum 3);; 592 | IFB BEq (AMinus (AId X) (AId Y)) 593 | (APlus (ANum 2) (ANum 4)) THEN 594 | SKIP 595 | ELSE 596 | Y ::= ANum 0 597 | FI;; 598 | IFB BLe (ANum 0) 599 | (AMinus (ANum 4) (APlus (ANum 2) (ANum 1))) 600 | THEN 601 | Y ::= ANum 0 602 | ELSE 603 | SKIP 604 | FI;; 605 | WHILE BEq (AId Y) (ANum 0) DO 606 | X ::= APlus (AId X) (ANum 1) 607 | END) 608 | = (* After constant folding: *) 609 | (X ::= ANum 9;; 610 | Y ::= AMinus (AId X) (ANum 3);; 611 | IFB BEq (AMinus (AId X) (AId Y)) (ANum 6) THEN 612 | SKIP 613 | ELSE 614 | (Y ::= ANum 0) 615 | FI;; 616 | Y ::= ANum 0;; 617 | WHILE BEq (AId Y) (ANum 0) DO 618 | X ::= APlus (AId X) (ANum 1) 619 | END). 620 | Proof. reflexivity. Qed. 621 | 622 | 623 | Theorem fold_constants_aexp_sound : 624 | atrans_sound fold_constants_aexp. 625 | Proof. 626 | unfold atrans_sound; 627 | unfold aequiv. intros. 628 | induction a; simpl; try reflexivity; 629 | destruct (fold_constants_aexp a1); 630 | destruct (fold_constants_aexp a2); 631 | rewrite IHa1; rewrite IHa2; 632 | reflexivity. 633 | Qed. 634 | 635 | Theorem fold_constants_bexp_sound: 636 | btrans_sound fold_constants_bexp. 637 | Proof. 638 | unfold btrans_sound; 639 | unfold bequiv. intros. 640 | induction b; try reflexivity. 641 | - rename a into a1. rename a0 into a2. 642 | simpl. 643 | remember (fold_constants_aexp a1) as a1' eqn:Heqa1'. 644 | remember (fold_constants_aexp a2) as a2' eqn:Heqa2'. 645 | replace (aeval st a1) with (aeval st a1'). 646 | replace (aeval st a2) with (aeval st a2'). 647 | destruct a1'; destruct a2'; try reflexivity. 648 | simpl. 649 | destruct (beq_nat n n0); reflexivity. 650 | + rewrite Heqa2'. 651 | rewrite <- fold_constants_aexp_sound. 652 | reflexivity. 653 | + rewrite Heqa1'. 654 | rewrite <- fold_constants_aexp_sound. 655 | reflexivity. 656 | - rename a into a1. rename a0 into a2. 657 | simpl. 658 | remember (fold_constants_aexp a1) as a1' eqn:Heqa1'. 659 | remember (fold_constants_aexp a2) as a2' eqn:Heqa2'. 660 | replace (aeval st a1) with (aeval st a1'). 661 | replace (aeval st a2) with (aeval st a2'). 662 | destruct a1'; destruct a2'; try reflexivity. 663 | simpl. 664 | destruct (leb n n0); reflexivity. 665 | + rewrite Heqa2'. 666 | rewrite <- fold_constants_aexp_sound. 667 | reflexivity. 668 | + rewrite Heqa1'. 669 | rewrite <- fold_constants_aexp_sound. 670 | reflexivity. 671 | - simpl. 672 | remember (fold_constants_bexp b) as b' eqn:Heqb'. 673 | rewrite IHb. 674 | destruct b'; reflexivity. 675 | - simpl. 676 | remember (fold_constants_bexp b1) as b1' eqn:Heqb1'. 677 | remember (fold_constants_bexp b2) as b2' eqn:Heqb2'. 678 | rewrite IHb1, IHb2. 679 | destruct b1'; destruct b2'; reflexivity. 680 | Qed. 681 | 682 | Theorem fold_constants_com_sound : 683 | ctrans_sound fold_constants_com. 684 | Proof. 685 | unfold ctrans_sound; intros. 686 | induction c; simpl. 687 | - apply refl_cequiv. 688 | - apply CAss_congruence. 689 | apply fold_constants_aexp_sound. 690 | - apply CSeq_congruence. 691 | + assumption. 692 | + assumption. 693 | - assert (bequiv b (fold_constants_bexp b)). 694 | { apply fold_constants_bexp_sound. } 695 | destruct (fold_constants_bexp b) eqn:Heqb; 696 | try (apply CIf_congruence; assumption). 697 | + apply trans_cequiv with c1; try assumption. 698 | apply IFB_true. assumption. 699 | + apply trans_cequiv with c2; try assumption. 700 | apply IFB_false. assumption. 701 | - assert (bequiv b (fold_constants_bexp b)). 702 | { apply fold_constants_bexp_sound. } 703 | destruct (fold_constants_bexp b) eqn:Heqb; 704 | try (apply CWhile_congruence; assumption). 705 | + apply (WHILE_true b c H). 706 | + apply (WHILE_false b c H). 707 | Qed. 708 | 709 | Fixpoint optimize_0plus_aexp (e:aexp) : aexp := 710 | match e with 711 | | AId x => AId x 712 | | ANum n => 713 | ANum n 714 | | APlus (ANum 0) e2 => 715 | optimize_0plus_aexp e2 716 | | APlus e1 e2 => 717 | APlus (optimize_0plus_aexp e1) (optimize_0plus_aexp e2) 718 | | AMinus e1 e2 => 719 | AMinus (optimize_0plus_aexp e1) (optimize_0plus_aexp e2) 720 | | AMult e1 e2 => 721 | AMult (optimize_0plus_aexp e1) (optimize_0plus_aexp e2) 722 | end. 723 | 724 | Theorem optimize_0plus_aexp_sound : 725 | atrans_sound optimize_0plus_aexp. 726 | Proof. 727 | unfold atrans_sound, aequiv; intros. 728 | induction a; try reflexivity. 729 | - destruct a1. 730 | + destruct n. 731 | * simpl. apply IHa2. 732 | * simpl. rewrite IHa2. reflexivity. 733 | + simpl. rewrite IHa2. reflexivity. 734 | + simpl. simpl in IHa1. 735 | rewrite IHa1. rewrite IHa2. 736 | reflexivity. 737 | + simpl. simpl in IHa1. 738 | rewrite IHa1. rewrite IHa2. 739 | reflexivity. 740 | + simpl. simpl in IHa1. 741 | rewrite IHa1. rewrite IHa2. 742 | reflexivity. 743 | - simpl. 744 | rewrite IHa1. rewrite IHa2. 745 | reflexivity. 746 | - simpl. 747 | rewrite IHa1. rewrite IHa2. 748 | reflexivity. 749 | Qed. 750 | 751 | Fixpoint optimize_0plus_bexp (b : bexp) : bexp := 752 | match b with 753 | | BEq l r => BEq (optimize_0plus_aexp l) (optimize_0plus_aexp r) 754 | | BLe l r => BLe (optimize_0plus_aexp l) (optimize_0plus_aexp r) 755 | | BNot b' => BNot (optimize_0plus_bexp b') 756 | | BAnd l r => BAnd (optimize_0plus_bexp l) (optimize_0plus_bexp r) 757 | | _ => b 758 | end. 759 | 760 | Theorem optimize_0plus_bexp_sound : 761 | btrans_sound optimize_0plus_bexp. 762 | Proof. 763 | unfold btrans_sound; 764 | unfold bequiv. intros. 765 | induction b; try reflexivity. 766 | - rename a into a1. rename a0 into a2. 767 | simpl. 768 | remember (optimize_0plus_aexp a1) as a1' eqn:Heqa1'. 769 | remember (optimize_0plus_aexp a2) as a2' eqn:Heqa2'. 770 | replace (aeval st a1) with (aeval st a1'). 771 | replace (aeval st a2) with (aeval st a2'). 772 | reflexivity. 773 | + rewrite Heqa2'. 774 | rewrite <- optimize_0plus_aexp_sound. 775 | reflexivity. 776 | + rewrite Heqa1'. 777 | rewrite <- optimize_0plus_aexp_sound. 778 | reflexivity. 779 | - rename a into a1. rename a0 into a2. 780 | simpl. 781 | remember (optimize_0plus_aexp a1) as a1' eqn:Heqa1'. 782 | remember (optimize_0plus_aexp a2) as a2' eqn:Heqa2'. 783 | replace (aeval st a1) with (aeval st a1'). 784 | replace (aeval st a2) with (aeval st a2'). 785 | reflexivity. 786 | + rewrite Heqa2'. 787 | rewrite <- optimize_0plus_aexp_sound. 788 | reflexivity. 789 | + rewrite Heqa1'. 790 | rewrite <- optimize_0plus_aexp_sound. 791 | reflexivity. 792 | - simpl. 793 | remember (optimize_0plus_bexp b) as b' eqn:Heqb'. 794 | rewrite IHb. 795 | destruct b'; reflexivity. 796 | - simpl. 797 | remember (optimize_0plus_bexp b1) as b1' eqn:Heqb1'. 798 | remember (optimize_0plus_bexp b2) as b2' eqn:Heqb2'. 799 | rewrite IHb1, IHb2. 800 | destruct b1'; destruct b2'; reflexivity. 801 | Qed. 802 | 803 | Fixpoint optimize_0plus_com (c : com) : com := 804 | match c with 805 | | SKIP => 806 | SKIP 807 | | i ::= a => 808 | i ::= (optimize_0plus_aexp a) 809 | | c1 ;; c2 => 810 | (optimize_0plus_com c1) ;; (optimize_0plus_com c2) 811 | | IFB b THEN c1 ELSE c2 FI => 812 | match optimize_0plus_bexp b with 813 | | BTrue => optimize_0plus_com c1 814 | | BFalse => optimize_0plus_com c2 815 | | b' => IFB b' THEN optimize_0plus_com c1 816 | ELSE optimize_0plus_com c2 FI 817 | end 818 | | WHILE b DO c END => 819 | match optimize_0plus_bexp b with 820 | | BTrue => WHILE BTrue DO SKIP END 821 | | BFalse => SKIP 822 | | b' => WHILE b' DO (optimize_0plus_com c) END 823 | end 824 | end. 825 | 826 | Theorem optimize_0plus_com_sound : 827 | ctrans_sound optimize_0plus_com. 828 | Proof. 829 | unfold ctrans_sound; intros. 830 | induction c; simpl. 831 | - apply refl_cequiv. 832 | - apply CAss_congruence. 833 | apply optimize_0plus_aexp_sound. 834 | - apply CSeq_congruence. 835 | + assumption. 836 | + assumption. 837 | - assert (bequiv b (optimize_0plus_bexp b)). 838 | { apply optimize_0plus_bexp_sound. } 839 | destruct (optimize_0plus_bexp b) eqn:Heqb; 840 | try (apply CIf_congruence; assumption). 841 | + apply trans_cequiv with c1; try assumption. 842 | apply IFB_true. assumption. 843 | + apply trans_cequiv with c2; try assumption. 844 | apply IFB_false. assumption. 845 | - assert (bequiv b (optimize_0plus_bexp b)). 846 | { apply optimize_0plus_bexp_sound. } 847 | destruct (optimize_0plus_bexp b) eqn:Heqb; 848 | try (apply CWhile_congruence; assumption). 849 | + apply (WHILE_true b c H). 850 | + apply (WHILE_false b c H). 851 | Qed. 852 | 853 | Definition optimizer (c: com) : com := 854 | optimize_0plus_com (fold_constants_com c). 855 | 856 | 857 | Example optimizer_ex : 858 | optimizer 859 | (* Original program: *) 860 | (X ::= APlus (APlus (ANum 0) (ANum 2)) (ANum 5)) 861 | = (* After constant folding: *) 862 | (X ::= ANum 7). 863 | Proof. reflexivity. Qed. 864 | 865 | Theorem optimizer_sound: 866 | ctrans_sound optimizer. 867 | Proof. 868 | unfold ctrans_sound, optimizer; intros. 869 | apply trans_cequiv with (fold_constants_com c). 870 | - apply fold_constants_com_sound. 871 | - apply (optimize_0plus_com_sound (fold_constants_com c)). 872 | Qed. 873 | 874 | 875 | 876 | Fixpoint subst_aexp (i : id) (u : aexp) (a : aexp) : aexp := 877 | match a with 878 | | ANum n => 879 | ANum n 880 | | AId i' => 881 | if beq_id i i' then u else AId i' 882 | | APlus a1 a2 => 883 | APlus (subst_aexp i u a1) (subst_aexp i u a2) 884 | | AMinus a1 a2 => 885 | AMinus (subst_aexp i u a1) (subst_aexp i u a2) 886 | | AMult a1 a2 => 887 | AMult (subst_aexp i u a1) (subst_aexp i u a2) 888 | end. 889 | 890 | Example subst_aexp_ex : 891 | subst_aexp X (APlus (ANum 42) (ANum 53)) 892 | (APlus (AId Y) (AId X)) 893 | = (APlus (AId Y) (APlus (ANum 42) (ANum 53))). 894 | Proof. reflexivity. Qed. 895 | 896 | Definition subst_equiv_property := forall i1 i2 a1 a2, 897 | cequiv (i1 ::= a1;; i2 ::= a2) 898 | (i1 ::= a1;; i2 ::= subst_aexp i1 a1 a2). 899 | 900 | Theorem subst_inequiv : 901 | ~ subst_equiv_property. 902 | Proof. 903 | unfold not, subst_equiv_property. 904 | intros. 905 | remember (X ::= APlus (AId X) (ANum 1);; 906 | Y ::= AId X) 907 | as c1. 908 | remember (X ::= APlus (AId X) (ANum 1);; 909 | Y ::= APlus (AId X) (ANum 1)) 910 | as c2. 911 | assert (cequiv c1 c2) 912 | by (subst; apply H). 913 | remember (t_update (t_update empty_state X 1) Y 1) as st1. 914 | remember (t_update (t_update empty_state X 1) Y 2) as st2. 915 | assert (H1: c1 / empty_state \\ st1); 916 | assert (H2: c2 / empty_state \\ st2); 917 | try (subst; 918 | apply E_Seq with (st' := (t_update empty_state X 1)); 919 | apply E_Ass; reflexivity). 920 | apply H0 in H1. 921 | assert (Hcontra: st1 = st2) 922 | by (apply (ceval_deterministic c2 empty_state); assumption). 923 | assert (Hcontra': st1 Y = st2 Y) 924 | by (rewrite Hcontra; reflexivity). 925 | subst. 926 | inversion Hcontra'. 927 | Qed. 928 | 929 | 930 | Inductive var_not_used_in_aexp (X:id) : aexp -> Prop := 931 | | VNUNum: forall n, var_not_used_in_aexp X (ANum n) 932 | | VNUId: forall Y, X <> Y -> var_not_used_in_aexp X (AId Y) 933 | | VNUPlus: forall a1 a2, 934 | var_not_used_in_aexp X a1 -> 935 | var_not_used_in_aexp X a2 -> 936 | var_not_used_in_aexp X (APlus a1 a2) 937 | | VNUMinus: forall a1 a2, 938 | var_not_used_in_aexp X a1 -> 939 | var_not_used_in_aexp X a2 -> 940 | var_not_used_in_aexp X (AMinus a1 a2) 941 | | VNUMult: forall a1 a2, 942 | var_not_used_in_aexp X a1 -> 943 | var_not_used_in_aexp X a2 -> 944 | var_not_used_in_aexp X (AMult a1 a2). 945 | 946 | Lemma aeval_weakening : forall i st a ni, 947 | var_not_used_in_aexp i a -> 948 | aeval (t_update st i ni) a = aeval st a. 949 | Proof. 950 | intros. 951 | induction a; simpl; inversion H; subst; 952 | try reflexivity; 953 | try ( 954 | apply IHa1 in H2; apply IHa2 in H3; 955 | rewrite H2, H3; 956 | reflexivity 957 | ). 958 | - apply (t_update_neq _ ni i i0 st H1). 959 | Qed. 960 | 961 | (* Theorem not_used_then_subst_equiv_property : forall i1 i2 a1 a2, 962 | var_not_used_in_aexp i1 a1 -> 963 | cequiv (i1 ::= a1;; i2 ::= a2) 964 | (i1 ::= a1;; i2 ::= subst_aexp i1 a1 a2). 965 | Proof. 966 | intros. 967 | apply CSeq_congruence. 968 | - apply refl_cequiv. 969 | - apply CAss_congruence. 970 | unfold aequiv. 971 | remember (subst_aexp i1 a1 a2) as sa. 972 | induction a1; intros; simpl. 973 | + simpl in Heqsa. *) 974 | 975 | Theorem inequiv_exercise: 976 | ~ cequiv (WHILE BTrue DO SKIP END) SKIP. 977 | Proof. 978 | unfold not; intros. 979 | eapply loop_never_stops with empty_state empty_state. 980 | unfold loop. 981 | apply H. 982 | apply E_Skip. 983 | Qed. 984 | 985 | Module Himp. 986 | 987 | Inductive com : Type := 988 | | CSkip : com 989 | | CAss : id -> aexp -> com 990 | | CSeq : com -> com -> com 991 | | CIf : bexp -> com -> com -> com 992 | | CWhile : bexp -> com -> com 993 | | CHavoc : id -> com. 994 | 995 | Notation "'SKIP'" := 996 | CSkip. 997 | Notation "X '::=' a" := 998 | (CAss X a) (at level 60). 999 | Notation "c1 ;; c2" := 1000 | (CSeq c1 c2) (at level 80, right associativity). 1001 | Notation "'WHILE' b 'DO' c 'END'" := 1002 | (CWhile b c) (at level 80, right associativity). 1003 | Notation "'IFB' e1 'THEN' e2 'ELSE' e3 'FI'" := 1004 | (CIf e1 e2 e3) (at level 80, right associativity). 1005 | Notation "'HAVOC' l" := (CHavoc l) (at level 60). 1006 | 1007 | Inductive ceval : com -> state -> state -> Prop := 1008 | | E_Skip : forall st : state, SKIP / st \\ st 1009 | | E_Ass : forall (st : state) (a1 : aexp) (n : nat) (X : id), 1010 | aeval st a1 = n -> 1011 | (X ::= a1) / st \\ t_update st X n 1012 | | E_Seq : forall (c1 c2 : com) (st st' st'' : state), 1013 | c1 / st \\ st' -> 1014 | c2 / st' \\ st'' -> 1015 | (c1 ;; c2) / st \\ st'' 1016 | | E_IfTrue : forall (st st' : state) (b1 : bexp) (c1 c2 : com), 1017 | beval st b1 = true -> 1018 | c1 / st \\ st' -> 1019 | (IFB b1 THEN c1 ELSE c2 FI) / st \\ st' 1020 | | E_IfFalse : forall (st st' : state) (b1 : bexp) (c1 c2 : com), 1021 | beval st b1 = false -> 1022 | c2 / st \\ st' -> 1023 | (IFB b1 THEN c1 ELSE c2 FI) / st \\ st' 1024 | | E_WhileEnd : forall (b1 : bexp) (st : state) (c1 : com), 1025 | beval st b1 = false -> 1026 | (WHILE b1 DO c1 END) / st \\ st 1027 | | E_WhileLoop : forall (st st' st'' : state) (b1 : bexp) (c1 : com), 1028 | beval st b1 = true -> 1029 | c1 / st \\ st' -> 1030 | (WHILE b1 DO c1 END) / st' \\ st'' -> 1031 | (WHILE b1 DO c1 END) / st \\ st'' 1032 | | E_Havoc : forall (X: id) (st: state) (n: nat), 1033 | (HAVOC X) / st \\ t_update st X n 1034 | 1035 | where "c1 '/' st '\\' st'" := (ceval c1 st st'). 1036 | 1037 | Example havoc_example1 : (HAVOC X) / empty_state \\ t_update empty_state X 0. 1038 | Proof. 1039 | apply E_Havoc. 1040 | Qed. 1041 | 1042 | 1043 | Example havoc_example2 : 1044 | (SKIP;; HAVOC Z) / empty_state \\ t_update empty_state Z 42. 1045 | Proof. 1046 | apply E_Seq with (st' := empty_state). 1047 | - apply E_Skip. 1048 | - apply E_Havoc. 1049 | Qed. 1050 | 1051 | Definition cequiv (c1 c2 : com) : Prop := forall st st' : state, 1052 | c1 / st \\ st' <-> c2 / st \\ st'. 1053 | 1054 | 1055 | Definition pXY := 1056 | HAVOC X;; HAVOC Y. 1057 | 1058 | Definition pYX := 1059 | HAVOC Y;; HAVOC X. 1060 | 1061 | Theorem pXY_cequiv_pYX : 1062 | cequiv pXY pYX \/ ~ cequiv pXY pYX. 1063 | Proof. 1064 | left. 1065 | unfold not, cequiv, pXY, pYX; intros. 1066 | split; intros; inversion H; subst. 1067 | - inversion H2; inversion H5; subst. 1068 | apply E_Seq with (st' := (t_update st Y n0)). 1069 | + apply E_Havoc. 1070 | + assert (J : t_update (t_update st X n) Y n0 = t_update (t_update st Y n0) X n). 1071 | { apply t_update_permute. 1072 | unfold not; intros; inversion H0. } 1073 | rewrite J. 1074 | apply E_Havoc. 1075 | - inversion H2; inversion H5; subst. 1076 | apply E_Seq with (st' := (t_update st X n0)). 1077 | + apply E_Havoc. 1078 | + assert (J : t_update (t_update st X n0) Y n = t_update (t_update st Y n) X n0). 1079 | { apply t_update_permute. 1080 | unfold not; intros; inversion H0. } 1081 | rewrite <- J. 1082 | apply E_Havoc. 1083 | Qed. 1084 | 1085 | Definition ptwice := 1086 | HAVOC X;; HAVOC Y. 1087 | 1088 | Definition pcopy := 1089 | HAVOC X;; Y ::= AId X. 1090 | 1091 | Theorem ptwice_cequiv_pcopy : 1092 | cequiv ptwice pcopy \/ ~ cequiv ptwice pcopy. 1093 | Proof. 1094 | right. 1095 | unfold not, cequiv; intros. 1096 | remember (t_update (t_update empty_state X 1) Y 5) as st'. 1097 | assert (ptwice / empty_state \\ st' -> 1098 | pcopy / empty_state \\ st') 1099 | by apply H. 1100 | assert (~ (pcopy / empty_state \\ st')). 1101 | { 1102 | unfold not; intros. 1103 | inversion H1; subst. 1104 | inversion H7; subst. 1105 | simpl in H8. 1106 | assert (t_update (t_update empty_state X 1) Y 5 X = 1). 1107 | { reflexivity. } 1108 | assert (t_update (t_update empty_state X 1) Y 5 Y = 5). 1109 | { reflexivity. } 1110 | rewrite <- H8 in H2, H3. 1111 | assert (st'0 X = 1). 1112 | { apply H2. } 1113 | assert (st'0 X = 5). 1114 | { apply H3. } 1115 | rewrite H5 in H6. 1116 | inversion H6. 1117 | } 1118 | apply H1. 1119 | apply H0. 1120 | unfold ptwice. 1121 | rewrite Heqst'. 1122 | apply E_Seq with (st' := (t_update empty_state X 1)). 1123 | - apply E_Havoc. 1124 | - apply E_Havoc. 1125 | Qed. 1126 | 1127 | 1128 | Definition p1 : com := 1129 | WHILE (BNot (BEq (AId X) (ANum 0))) DO 1130 | HAVOC Y;; 1131 | X ::= APlus (AId X) (ANum 1) 1132 | END. 1133 | 1134 | Definition p2 : com := 1135 | WHILE (BNot (BEq (AId X) (ANum 0))) DO 1136 | SKIP 1137 | END. 1138 | 1139 | Lemma p1_may_diverge : forall st st', st X <> 0 -> 1140 | ~ p1 / st \\ st'. 1141 | Proof. 1142 | unfold not, p1; intros. 1143 | remember (WHILE BNot (BEq (AId X) (ANum 0)) 1144 | DO HAVOC Y;; X ::= APlus (AId X) (ANum 1) END) as p1. 1145 | induction H0; inversion Heqp1. 1146 | - subst. 1147 | apply H. 1148 | simpl in H0. 1149 | apply negb_false_iff in H0. 1150 | apply beq_nat_true in H0. 1151 | assumption. 1152 | - apply IHceval2. 1153 | + rewrite H3 in H0_. 1154 | inversion H0_; subst. 1155 | inversion H8; subst. 1156 | rewrite t_update_eq. 1157 | simpl. 1158 | rewrite <- plus_n_Sm. 1159 | intros. 1160 | inversion H1. 1161 | + assumption. 1162 | Qed. 1163 | 1164 | Lemma p2_may_diverge : forall st st', st X <> 0 -> 1165 | ~ p2 / st \\ st'. 1166 | Proof. 1167 | unfold not, p2; intros. 1168 | remember (WHILE (BNot (BEq (AId X) (ANum 0))) DO 1169 | SKIP 1170 | END) as p2. 1171 | induction H0; inversion Heqp2. 1172 | - apply H. 1173 | rewrite H2 in H0. 1174 | simpl in H0. 1175 | apply negb_false_iff in H0. 1176 | apply beq_nat_true in H0. 1177 | assumption. 1178 | - apply IHceval2. 1179 | + rewrite H3 in H0_. 1180 | inversion H0_; subst. 1181 | assumption. 1182 | + rewrite H2, H3. reflexivity. 1183 | Qed. 1184 | 1185 | Theorem p1_p2_equiv : cequiv p1 p2. 1186 | Proof. 1187 | split; intros; inversion H; subst; 1188 | try (apply E_WhileEnd; assumption); 1189 | try ((apply p1_may_diverge with (st := st) (st' := st') in H); 1190 | inversion H; 1191 | simpl in H2; 1192 | apply negb_true_iff in H2; 1193 | apply beq_nat_false in H2; 1194 | assumption). 1195 | - (apply p1_may_diverge with (st := st) (st' := st') in H). 1196 | inversion H. 1197 | apply negb_true_iff in H2; 1198 | apply beq_nat_false in H2. 1199 | assumption. 1200 | - (apply p2_may_diverge with (st := st) (st' := st') in H). 1201 | inversion H. 1202 | apply negb_true_iff in H2; 1203 | apply beq_nat_false in H2. 1204 | assumption. 1205 | Qed. 1206 | 1207 | -------------------------------------------------------------------------------- /Imp.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.Bool.Bool. 2 | Require Import Coq.Arith.Arith. 3 | Require Import Coq.Arith.EqNat. 4 | Require Import Coq.omega.Omega. 5 | Require Import Coq.Lists.List. 6 | Import ListNotations. 7 | 8 | Require Import Maps. 9 | 10 | Module AExp. 11 | 12 | Inductive aexp : Type := 13 | | ANum: nat -> aexp 14 | | APlus: aexp -> aexp -> aexp 15 | | AMinus: aexp -> aexp -> aexp 16 | | AMult: aexp -> aexp -> aexp. 17 | 18 | Inductive bexp : Type := 19 | | BTrue : bexp 20 | | BFalse : bexp 21 | | BEq : aexp -> aexp -> bexp 22 | | BLe : aexp -> aexp -> bexp 23 | | BNot : bexp -> bexp 24 | | BAnd : bexp -> bexp -> bexp. 25 | 26 | Fixpoint aeval (a: aexp) : nat := 27 | match a with 28 | | ANum n => n 29 | | APlus l r => (aeval l) + (aeval r) 30 | | AMinus l r => (aeval l) - (aeval r) 31 | | AMult l r => (aeval l) * (aeval r) 32 | end. 33 | 34 | Example test_aeval1: 35 | aeval (APlus (ANum 2) (ANum 2)) = 4. 36 | Proof. reflexivity. Qed. 37 | 38 | Fixpoint beval (b: bexp) : bool := 39 | match b with 40 | | BTrue => true 41 | | BFalse => false 42 | | BEq l r => beq_nat (aeval l) (aeval r) 43 | | BLe l r => leb (aeval l) (aeval r) 44 | | BNot b' => negb (beval b') 45 | | BAnd l r => andb (beval l) (beval r) 46 | end. 47 | 48 | Fixpoint optimize_0plus (a: aexp) : aexp := 49 | match a with 50 | | ANum n => ANum n 51 | | APlus (ANum 0) r => (optimize_0plus r) 52 | | APlus l r => APlus (optimize_0plus l) (optimize_0plus r) 53 | | AMinus l r => AMinus (optimize_0plus l) (optimize_0plus r) 54 | | AMult l r => AMult (optimize_0plus l) (optimize_0plus r) 55 | end. 56 | 57 | 58 | Example test_optimize_0plus: 59 | optimize_0plus (APlus (ANum 2) 60 | (APlus (ANum 0) 61 | (APlus (ANum 0) (ANum 1)))) 62 | = APlus (ANum 2) (ANum 1). 63 | Proof. reflexivity. Qed. 64 | 65 | Theorem optimize_0plus_sound: forall a, 66 | aeval (optimize_0plus a) = aeval a. 67 | Proof. 68 | intros. 69 | induction a. 70 | - reflexivity. 71 | - destruct a1. 72 | + destruct n. 73 | * simpl. apply IHa2. 74 | * simpl. rewrite IHa2. reflexivity. 75 | + simpl. simpl in IHa1. 76 | rewrite IHa1. rewrite IHa2. 77 | reflexivity. 78 | + simpl. simpl in IHa1. 79 | rewrite IHa1. rewrite IHa2. 80 | reflexivity. 81 | + simpl. simpl in IHa1. 82 | rewrite IHa1. rewrite IHa2. 83 | reflexivity. 84 | - simpl. 85 | rewrite IHa1. rewrite IHa2. 86 | reflexivity. 87 | - simpl. 88 | rewrite IHa1. rewrite IHa2. 89 | reflexivity. 90 | Qed. 91 | 92 | 93 | Theorem silly1 : forall ae, aeval ae = aeval ae. 94 | Proof. 95 | intros. try reflexivity. 96 | Qed. 97 | 98 | Theorem silly2 : forall (P: Prop), P -> P. 99 | Proof. 100 | intros. 101 | try reflexivity. 102 | apply H. 103 | Qed. 104 | 105 | Lemma foo' : forall (n: nat), leb 0 n = true. 106 | Proof. 107 | intros. 108 | destruct n; simpl; reflexivity. 109 | Qed. 110 | 111 | Theorem optimize_0plus_sound': forall a, 112 | aeval (optimize_0plus a) = aeval a. 113 | Proof. 114 | intros. 115 | induction a; 116 | try reflexivity; 117 | try (simpl; rewrite IHa1; rewrite IHa2; reflexivity). 118 | - destruct a1; 119 | try (simpl; simpl in IHa1; rewrite IHa1; 120 | rewrite IHa2; reflexivity). 121 | + destruct n; 122 | simpl; rewrite IHa2; reflexivity. 123 | Qed. 124 | 125 | 126 | Theorem In10 : In 10 [1;2;3;4;5;6;7;8;9;10]. 127 | Proof. 128 | repeat (try (left; reflexivity); right). 129 | Qed. 130 | 131 | 132 | Theorem In10' : In 10 [1;2;3;4;5;6;7;8;9;10]. 133 | Proof. 134 | repeat (right; try (left; reflexivity)). 135 | Qed. 136 | 137 | 138 | Fixpoint optimize_0plus_b (b : bexp) : bexp := 139 | match b with 140 | | BEq l r => BEq (optimize_0plus l) (optimize_0plus r) 141 | | BLe l r => BLe (optimize_0plus l) (optimize_0plus r) 142 | | BNot b' => BNot (optimize_0plus_b b') 143 | | BAnd l r => BAnd (optimize_0plus_b l) (optimize_0plus_b r) 144 | | _ => b 145 | end. 146 | 147 | 148 | Theorem optimize_0plus_b_sound : forall b, 149 | beval (optimize_0plus_b b) = beval b. 150 | Proof. 151 | intros. 152 | induction b; 153 | try (simpl; reflexivity); 154 | try (simpl; repeat rewrite optimize_0plus_sound; reflexivity). 155 | - simpl. rewrite IHb. reflexivity. 156 | - simpl. rewrite IHb1. rewrite IHb2. reflexivity. 157 | Qed. 158 | 159 | Tactic Notation "simpl_and_try" tactic(c) := 160 | simpl; 161 | try c. 162 | 163 | Example silly_presburger_example : forall m n o p, 164 | m + n <= n + o /\ o + 3 = p + 3 -> 165 | m <= p. 166 | Proof. 167 | intros. omega. 168 | Qed. 169 | 170 | 171 | Module aevalR_first_try. 172 | 173 | Inductive aevalR : aexp -> nat -> Prop := 174 | | E_ANum: forall (n: nat), 175 | aevalR (ANum n) n 176 | | E_APlus: forall (e1 e2: aexp) (n1 n2: nat), 177 | aevalR e1 n1 -> 178 | aevalR e2 n2 -> 179 | aevalR (APlus e1 e2) (n1 + n2) 180 | | E_AMinus: forall (e1 e2: aexp) (n1 n2: nat), 181 | aevalR e1 n1 -> 182 | aevalR e2 n2 -> 183 | aevalR (AMinus e1 e2) (n1 - n2) 184 | | E_AMult: forall (e1 e2: aexp) (n1 n2: nat), 185 | aevalR e1 n1 -> 186 | aevalR e2 n2 -> 187 | aevalR (AMult e1 e2) (n1 * n2). 188 | 189 | 190 | Notation "e '\\' n" 191 | := (aevalR e n) 192 | (at level 50, left associativity) 193 | : type_scope. 194 | 195 | End aevalR_first_try. 196 | 197 | Reserved Notation "e '\\' n" (at level 50, left associativity). 198 | 199 | Inductive aevalR : aexp -> nat -> Prop := 200 | | E_ANum : forall (n:nat), 201 | (ANum n) \\ n 202 | | E_APlus : forall (e1 e2: aexp) (n1 n2 : nat), 203 | (e1 \\ n1) -> (e2 \\ n2) -> (APlus e1 e2) \\ (n1 + n2) 204 | | E_AMinus : forall (e1 e2: aexp) (n1 n2 : nat), 205 | (e1 \\ n1) -> (e2 \\ n2) -> (AMinus e1 e2) \\ (n1 - n2) 206 | | E_AMult : forall (e1 e2: aexp) (n1 n2 : nat), 207 | (e1 \\ n1) -> (e2 \\ n2) -> (AMult e1 e2) \\ (n1 * n2) 208 | 209 | where "e '\\' n" := (aevalR e n) : type_scope. 210 | 211 | Theorem aeval_iff_aevalR : forall a n, 212 | (a \\ n) <-> aeval a = n. 213 | Proof. 214 | intros. 215 | split. 216 | - intros. 217 | induction H; subst; reflexivity. 218 | - intros. generalize dependent n. 219 | induction a; simpl; intros; subst; constructor; 220 | try apply IHa1; try apply IHa2; reflexivity. 221 | Qed. 222 | 223 | Inductive bevalR: bexp -> bool -> Prop := 224 | | E_BTrue: bevalR BTrue true 225 | | E_BFalse: bevalR BFalse false 226 | | E_BEq: forall (e1 e2: aexp) (n1 n2: nat), 227 | (aevalR e1 n1) -> (aevalR e2 n2) -> 228 | (bevalR (BEq e1 e2) (beq_nat n1 n2)) 229 | | E_BLe: forall (e1 e2: aexp) (n1 n2: nat), 230 | (aevalR e1 n1) -> (aevalR e2 n2) -> 231 | (bevalR (BLe e1 e2) (leb n1 n2)) 232 | | E_BNot: forall (e: bexp) (b: bool), 233 | (bevalR e b) -> 234 | (bevalR (BNot e) (negb b)) 235 | | E_BAnd: forall (e1 e2: bexp) (b1 b2: bool), 236 | (bevalR e1 b1) -> (bevalR e2 b2) -> 237 | (bevalR (BAnd e1 e2) (andb b1 b2)). 238 | 239 | 240 | 241 | Lemma beval_iff_bevalR : forall b bv, 242 | bevalR b bv <-> beval b = bv. 243 | Proof. 244 | intros. split. 245 | - intros. 246 | induction H; subst; simpl; 247 | try reflexivity; 248 | try (rewrite aeval_iff_aevalR in H, H0; 249 | rewrite H, H0; 250 | reflexivity). 251 | - intros. generalize dependent bv. 252 | induction b; simpl; intros; subst; constructor; 253 | try (apply aeval_iff_aevalR; reflexivity); 254 | try (apply IHb; reflexivity); 255 | try (apply IHb1; reflexivity); 256 | try (apply IHb2; reflexivity). 257 | Qed. 258 | 259 | 260 | End AExp. 261 | 262 | Module aevalR_division. 263 | 264 | Inductive aexp : Type := 265 | | ANum : nat -> aexp 266 | | APlus : aexp -> aexp -> aexp 267 | | AMinus : aexp -> aexp -> aexp 268 | | AMult : aexp -> aexp -> aexp 269 | | ADiv : aexp -> aexp -> aexp. 270 | 271 | Reserved Notation "e '\\' n" 272 | (at level 50, left associativity). 273 | 274 | Inductive aevalR : aexp -> nat -> Prop := 275 | | E_ANum : forall (n:nat), 276 | (ANum n) \\ n 277 | | E_APlus : forall (a1 a2: aexp) (n1 n2 : nat), 278 | (a1 \\ n1) -> (a2 \\ n2) -> (APlus a1 a2) \\ (n1 + n2) 279 | | E_AMinus : forall (a1 a2: aexp) (n1 n2 : nat), 280 | (a1 \\ n1) -> (a2 \\ n2) -> (AMinus a1 a2) \\ (n1 - n2) 281 | | E_AMult : forall (a1 a2: aexp) (n1 n2 : nat), 282 | (a1 \\ n1) -> (a2 \\ n2) -> (AMult a1 a2) \\ (n1 * n2) 283 | | E_ADiv : forall (a1 a2: aexp) (n1 n2 n3: nat), 284 | (a1 \\ n1) -> (a2 \\ n2) -> (n2 > 0) -> 285 | (mult n2 n3 = n1) -> (ADiv a1 a2) \\ n3 286 | 287 | where "a '\\' n" := (aevalR a n) : type_scope. 288 | 289 | End aevalR_division. 290 | 291 | 292 | Module aevalR_extended. 293 | 294 | Reserved Notation "e '\\' n" (at level 50, left associativity). 295 | 296 | Inductive aexp : Type := 297 | | AAny : aexp (* <--- NEW *) 298 | | ANum : nat -> aexp 299 | | APlus : aexp -> aexp -> aexp 300 | | AMinus : aexp -> aexp -> aexp 301 | | AMult : aexp -> aexp -> aexp. 302 | 303 | 304 | Inductive aevalR : aexp -> nat -> Prop := 305 | | E_Any : forall (n:nat), 306 | AAny \\ n (* <--- new *) 307 | | E_ANum : forall (n:nat), 308 | (ANum n) \\ n 309 | | E_APlus : forall (a1 a2: aexp) (n1 n2 : nat), 310 | (a1 \\ n1) -> (a2 \\ n2) -> (APlus a1 a2) \\ (n1 + n2) 311 | | E_AMinus : forall (a1 a2: aexp) (n1 n2 : nat), 312 | (a1 \\ n1) -> (a2 \\ n2) -> (AMinus a1 a2) \\ (n1 - n2) 313 | | E_AMult : forall (a1 a2: aexp) (n1 n2 : nat), 314 | (a1 \\ n1) -> (a2 \\ n2) -> (AMult a1 a2) \\ (n1 * n2) 315 | 316 | where "a '\\' n" := (aevalR a n) : type_scope. 317 | 318 | End aevalR_extended. 319 | 320 | Definition state := total_map nat. 321 | 322 | Definition empty_state : state := 323 | t_empty 0. 324 | 325 | Inductive aexp : Type := 326 | | ANum : nat -> aexp 327 | | AId : id -> aexp 328 | | APlus : aexp -> aexp -> aexp 329 | | AMinus : aexp -> aexp -> aexp 330 | | AMult : aexp -> aexp -> aexp. 331 | 332 | Definition W : id := Id "W". 333 | Definition X : id := Id "X". 334 | Definition Y : id := Id "Y". 335 | Definition Z : id := Id "Z". 336 | 337 | Inductive bexp : Type := 338 | | BTrue : bexp 339 | | BFalse : bexp 340 | | BEq : aexp -> aexp -> bexp 341 | | BLe : aexp -> aexp -> bexp 342 | | BNot : bexp -> bexp 343 | | BAnd : bexp -> bexp -> bexp. 344 | 345 | Fixpoint aeval (st : state) (a : aexp) : nat := 346 | match a with 347 | | ANum n => n 348 | | AId x => st x (* <----- NEW *) 349 | | APlus a1 a2 => (aeval st a1) + (aeval st a2) 350 | | AMinus a1 a2 => (aeval st a1) - (aeval st a2) 351 | | AMult a1 a2 => (aeval st a1) * (aeval st a2) 352 | end. 353 | 354 | Fixpoint beval (st : state) (b : bexp) : bool := 355 | match b with 356 | | BTrue => true 357 | | BFalse => false 358 | | BEq a1 a2 => beq_nat (aeval st a1) (aeval st a2) 359 | | BLe a1 a2 => leb (aeval st a1) (aeval st a2) 360 | | BNot b1 => negb (beval st b1) 361 | | BAnd b1 b2 => andb (beval st b1) (beval st b2) 362 | end. 363 | 364 | Example aexp1 : 365 | aeval (t_update empty_state X 5) 366 | (APlus (ANum 3) (AMult (AId X) (ANum 2))) 367 | = 13. 368 | Proof. reflexivity. Qed. 369 | 370 | Example bexp1 : 371 | beval (t_update empty_state X 5) 372 | (BAnd BTrue (BNot (BLe (AId X) (ANum 4)))) 373 | = true. 374 | Proof. reflexivity. Qed. 375 | 376 | Inductive com : Type := 377 | | CSkip : com 378 | | CAss : id -> aexp -> com 379 | | CSeq : com -> com -> com 380 | | CIf : bexp -> com -> com -> com 381 | | CWhile : bexp -> com -> com. 382 | 383 | Notation "'SKIP'" := 384 | CSkip. 385 | Notation "x '::=' a" := 386 | (CAss x a) (at level 60). 387 | Notation "c1 ;; c2" := 388 | (CSeq c1 c2) (at level 80, right associativity). 389 | Notation "'WHILE' b 'DO' c 'END'" := 390 | (CWhile b c) (at level 80, right associativity). 391 | Notation "'IFB' b1 'THEN' c2 'ELSE' c3 'FI'" := 392 | (CIf b1 c2 c3) (at level 80, right associativity). 393 | 394 | Definition fact_in_coq : com := 395 | Z ::= AId X;; 396 | Y ::= ANum 1;; 397 | WHILE BNot (BEq (AId Z) (ANum 0)) DO 398 | Y ::= AMult (AId Y) (AId Z);; 399 | Z ::= AMinus (AId Z) (ANum 1) 400 | END. 401 | 402 | Definition plus2 : com := 403 | X ::= (APlus (AId X) (ANum 2)). 404 | 405 | Definition XtimesYinZ : com := 406 | Z ::= (AMult (AId X) (AId Y)). 407 | 408 | Definition subtract_slowly_body : com := 409 | Z ::= AMinus (AId Z) (ANum 1) ;; 410 | X ::= AMinus (AId X) (ANum 1). 411 | 412 | Definition subtract_slowly : com := 413 | WHILE BNot (BEq (AId X) (ANum 0)) DO 414 | subtract_slowly_body 415 | END. 416 | 417 | Definition subtract_3_from_5_slowly : com := 418 | X ::= ANum 3 ;; 419 | Z ::= ANum 5 ;; 420 | subtract_slowly. 421 | 422 | Definition loop : com := 423 | WHILE BTrue DO 424 | SKIP 425 | END. 426 | 427 | Reserved Notation "c1 '/' st '\\' st'" 428 | (at level 40, st at level 39). 429 | 430 | Inductive ceval : com -> state -> state -> Prop := 431 | | E_Skip: forall st, 432 | SKIP / st \\ st 433 | | E_Ass: forall st ae x n, 434 | aeval st ae = n -> 435 | (x ::= ae) / st \\ (t_update st x n) 436 | | E_Seq: forall c1 c2 st st' st'', 437 | c1 / st \\ st' -> 438 | c2 / st' \\ st'' -> 439 | (c1 ;; c2) / st \\ st'' 440 | | E_IfTrue: forall b1 c1 c2 st st', 441 | beval st b1 = true -> 442 | c1 / st \\ st' -> 443 | (IFB b1 THEN c1 ELSE c2 FI) / st \\ st' 444 | | E_IfFalse: forall b1 c1 c2 st st', 445 | beval st b1 = false -> 446 | c2 / st \\ st' -> 447 | (IFB b1 THEN c1 ELSE c2 FI) / st \\ st' 448 | | E_WhileEnd: forall b1 c1 st, 449 | beval st b1 = false -> 450 | (WHILE b1 DO c1 END) / st \\ st 451 | | E_WhileLoop: forall b1 c1 st st' st'', 452 | beval st b1 = true -> 453 | c1 / st \\ st' -> 454 | (WHILE b1 DO c1 END) / st' \\ st'' -> 455 | (WHILE b1 DO c1 END) / st \\ st'' 456 | 457 | where "c1 '/' st '\\' st'" := (ceval c1 st st'). 458 | 459 | 460 | Example ceval_example1: 461 | (X ::= ANum 2;; 462 | IFB BLe (AId X) (ANum 1) 463 | THEN Y ::= ANum 3 464 | ELSE Z ::= ANum 4 465 | FI) 466 | / empty_state 467 | \\ (t_update (t_update empty_state X 2) Z 4). 468 | Proof. 469 | apply E_Seq with (t_update empty_state X 2). 470 | - apply E_Ass. reflexivity. 471 | - apply E_IfFalse. 472 | + reflexivity. 473 | + apply E_Ass. reflexivity. 474 | Qed. 475 | 476 | Example ceval_example2: 477 | (X ::= ANum 0;; Y ::= ANum 1;; Z ::= ANum 2) / empty_state \\ 478 | (t_update (t_update (t_update empty_state X 0) Y 1) Z 2). 479 | Proof. 480 | apply E_Seq with (t_update empty_state X 0). 481 | - apply E_Ass. reflexivity. 482 | - apply E_Seq with (t_update (t_update empty_state X 0) Y 1). 483 | + apply E_Ass. reflexivity. 484 | + apply E_Ass. reflexivity. 485 | Qed. 486 | 487 | Definition pup_to_n : com := 488 | Y ::= (ANum 0);; 489 | WHILE BLe (ANum 1) (AId X) 490 | DO Y ::= (APlus (AId Y) (AId X));; 491 | X ::= (AMinus (AId X) (ANum 1)) 492 | END. 493 | 494 | 495 | Theorem pup_to_2_ceval : 496 | pup_to_n / (t_update empty_state X 2) \\ 497 | t_update (t_update (t_update (t_update (t_update (t_update empty_state X 2) Y 0) Y 2) X 1) Y 3) X 0. 498 | Proof. 499 | apply E_Seq with (t_update (t_update empty_state X 2) Y 0). 500 | - apply E_Ass. reflexivity. 501 | - apply E_WhileLoop with (t_update (t_update (t_update (t_update empty_state X 2) Y 0) Y 2) X 1). 502 | + reflexivity. 503 | + apply E_Seq with (t_update (t_update (t_update empty_state X 2) Y 0) Y 2). 504 | * apply E_Ass. reflexivity. 505 | * apply E_Ass. reflexivity. 506 | + apply E_WhileLoop with (t_update (t_update (t_update (t_update (t_update (t_update empty_state X 2) Y 0) Y 2) X 1) Y 3) X 0). 507 | * reflexivity. 508 | * apply E_Seq with (t_update (t_update (t_update (t_update (t_update empty_state X 2) Y 0) Y 2) X 1) Y 3). 509 | { apply E_Ass. reflexivity. } 510 | { apply E_Ass. reflexivity. } 511 | * apply E_WhileEnd. reflexivity. 512 | Qed. 513 | 514 | Theorem ceval_deterministic: forall c st st1 st2, 515 | c / st \\ st1 -> 516 | c / st \\ st2 -> 517 | st1 = st2. 518 | Proof. 519 | intros. 520 | generalize dependent st2. 521 | induction H; intros st2 H'; inversion H'; subst. 522 | - reflexivity. 523 | - reflexivity. 524 | - assert (st' = st'0). 525 | { apply IHceval1. assumption. } 526 | subst st'0. 527 | apply IHceval2. 528 | assumption. 529 | - apply IHceval. 530 | assumption. 531 | - rewrite H in H6. inversion H6. 532 | - rewrite H in H6. inversion H6. 533 | - apply IHceval. 534 | assumption. 535 | - reflexivity. 536 | - rewrite H in H2. inversion H2. 537 | - rewrite H in H6. inversion H6. 538 | - assert (st' = st'0). 539 | { apply IHceval1. assumption. } 540 | subst st'0. 541 | apply IHceval2. 542 | assumption. 543 | Qed. 544 | 545 | Theorem plus2_spec : forall st n st', 546 | st X = n -> 547 | plus2 / st \\ st' -> 548 | st' X = n + 2. 549 | Proof. 550 | intros st n st' HX Heval. 551 | inversion Heval. 552 | subst. 553 | simpl. 554 | apply t_update_eq. 555 | Qed. 556 | 557 | Theorem XtimesYinZ_spec : forall st x y st', 558 | st X = x -> 559 | st Y = y -> 560 | XtimesYinZ / st \\ st' -> 561 | st' Z = x * y. 562 | Proof. 563 | intros. 564 | inversion H1. 565 | subst. 566 | simpl. 567 | apply t_update_eq. 568 | Qed. 569 | 570 | Theorem loop_never_stops : forall st st', 571 | ~(loop / st \\ st'). 572 | Proof. 573 | intros st st' contra. unfold loop in contra. 574 | remember (WHILE BTrue DO SKIP END) as loopdef 575 | eqn:Heqloopdef. 576 | induction contra; inversion Heqloopdef. 577 | - rewrite H1 in H. inversion H. 578 | - apply IHcontra2. rewrite H1, H2. reflexivity. 579 | Qed. 580 | 581 | Fixpoint no_whiles (c : com) : bool := 582 | match c with 583 | | SKIP => 584 | true 585 | | _ ::= _ => 586 | true 587 | | c1 ;; c2 => 588 | andb (no_whiles c1) (no_whiles c2) 589 | | IFB _ THEN ct ELSE cf FI => 590 | andb (no_whiles ct) (no_whiles cf) 591 | | WHILE _ DO _ END => 592 | false 593 | end. 594 | 595 | Inductive no_whilesR: com -> Prop := 596 | | nw_skip: no_whilesR SKIP 597 | | nw_ass: forall x ex, 598 | no_whilesR (x ::= ex) 599 | | nw_seq: forall c1 c2, 600 | no_whilesR c1 -> 601 | no_whilesR c2 -> 602 | no_whilesR (c1 ;; c2) 603 | | nw_ifb: forall b c1 c2, 604 | no_whilesR c1 -> 605 | no_whilesR c2 -> 606 | no_whilesR (IFB b THEN c1 ELSE c2 FI). 607 | 608 | Theorem no_whiles_eqv: 609 | forall c, no_whiles c = true <-> no_whilesR c. 610 | Proof. 611 | intros. split. 612 | - intros. 613 | induction c. 614 | + apply nw_skip. 615 | + apply nw_ass. 616 | + simpl in H. 617 | apply andb_true_iff in H. 618 | destruct H. 619 | apply nw_seq. 620 | * apply IHc1. apply H. 621 | * apply IHc2. apply H0. 622 | + simpl in H. 623 | apply andb_true_iff in H. 624 | destruct H. 625 | apply nw_ifb. 626 | * apply IHc1. apply H. 627 | * apply IHc2. apply H0. 628 | + simpl in H. inversion H. 629 | - intros. 630 | induction c; simpl. 631 | + reflexivity. 632 | + reflexivity. 633 | + inversion H. 634 | apply andb_true_iff. 635 | split. 636 | * apply IHc1. apply H2. 637 | * apply IHc2. apply H3. 638 | + inversion H. 639 | apply andb_true_iff. 640 | split. 641 | * apply IHc1. apply H2. 642 | * apply IHc2. apply H4. 643 | + inversion H. 644 | Qed. 645 | 646 | Theorem no_whiles_terminating: forall c st, 647 | no_whilesR c -> 648 | exists st', c / st \\ st'. 649 | Proof. 650 | intros. 651 | generalize dependent st. 652 | induction H; intros. 653 | - exists st. 654 | apply E_Skip. 655 | - exists (t_update st x (aeval st ex)). 656 | apply E_Ass. reflexivity. 657 | - destruct (IHno_whilesR1 st). 658 | destruct (IHno_whilesR2 x). 659 | exists x0. 660 | apply (E_Seq c1 c2 st x x0). 661 | + apply H1. 662 | + apply H2. 663 | - destruct (beval st b) eqn:bval. 664 | + destruct (IHno_whilesR1 st). 665 | exists x. 666 | apply E_IfTrue. 667 | apply bval. 668 | apply H1. 669 | + destruct (IHno_whilesR2 st). 670 | exists x. 671 | apply E_IfFalse. 672 | apply bval. 673 | apply H1. 674 | Qed. 675 | 676 | Inductive sinstr : Type := 677 | | SPush : nat -> sinstr 678 | | SLoad : id -> sinstr 679 | | SPlus : sinstr 680 | | SMinus : sinstr 681 | | SMult : sinstr. 682 | 683 | 684 | Fixpoint s_execute (st : state) (stack : list nat) 685 | (prog : list sinstr) 686 | : list nat := 687 | match prog with 688 | | [] => stack 689 | | (SPush n) :: prog' => s_execute st (n :: stack) prog' 690 | | (SLoad k) :: prog' => s_execute st ((st k) :: stack) prog' 691 | | SPlus :: prog' => s_execute st (((hd 0 (tl stack)) + (hd 0 stack)) :: (tl (tl stack))) 692 | prog' 693 | | SMinus :: prog' => s_execute st (((hd 0 (tl stack)) - (hd 0 stack)) :: (tl (tl stack))) 694 | prog' 695 | | SMult :: prog' => s_execute st (((hd 0 (tl stack)) * (hd 0 stack)) :: (tl (tl stack))) 696 | prog' 697 | end. 698 | 699 | 700 | Example s_execute1 : 701 | s_execute empty_state [] 702 | [SPush 5; SPush 3; SPush 1; SMinus] 703 | = [2; 5]. 704 | Proof. reflexivity. Qed. 705 | 706 | Example s_execute2 : 707 | s_execute (t_update empty_state X 3) [3;4] 708 | [SPush 4; SLoad X; SMult; SPlus] 709 | = [15; 4]. 710 | Proof. reflexivity. Qed. 711 | 712 | 713 | Fixpoint s_compile (e : aexp) : list sinstr := 714 | match e with 715 | | ANum x => [SPush x] 716 | | AId k => [SLoad k] 717 | | APlus a1 a2 => (s_compile a1) ++ (s_compile a2) ++ [SPlus] 718 | | AMinus a1 a2 => (s_compile a1) ++ (s_compile a2) ++ [SMinus] 719 | | AMult a1 a2 => (s_compile a1) ++ (s_compile a2) ++ [SMult] 720 | end. 721 | 722 | 723 | Example s_compile1 : 724 | s_compile (AMinus (AId X) (AMult (ANum 2) (AId Y))) 725 | = [SLoad X; SPush 2; SLoad Y; SMult; SMinus]. 726 | Proof. reflexivity. Qed. 727 | 728 | 729 | Lemma s_execute_app: forall st stack si1 si2, 730 | s_execute st stack (si1 ++ si2) = 731 | s_execute st (s_execute st stack si1) si2. 732 | Proof. 733 | intros. 734 | generalize dependent st. 735 | generalize dependent stack. 736 | generalize dependent si2. 737 | induction si1; intros. 738 | - reflexivity. 739 | - destruct a; simpl; apply IHsi1. 740 | Qed. 741 | 742 | Lemma s_compile_append: forall st stack e, 743 | s_execute st stack (s_compile e) = 744 | (aeval st e) :: stack. 745 | Proof. 746 | intros. 747 | generalize dependent st. 748 | generalize dependent stack. 749 | induction e; simpl; intros; 750 | try reflexivity; 751 | repeat rewrite s_execute_app; 752 | rewrite IHe1; rewrite IHe2; 753 | reflexivity. 754 | Qed. 755 | 756 | Theorem s_compile_correct : forall (st : state) (e : aexp), 757 | s_execute st [] (s_compile e) = [ aeval st e ]. 758 | Proof. 759 | intros. 760 | apply s_compile_append. 761 | Qed. 762 | 763 | 764 | Fixpoint beval_ss (st : state) (b : bexp) : bool := 765 | match b with 766 | | BTrue => true 767 | | BFalse => false 768 | | BEq a1 a2 => beq_nat (aeval st a1) (aeval st a2) 769 | | BLe a1 a2 => leb (aeval st a1) (aeval st a2) 770 | | BNot b1 => negb (beval_ss st b1) 771 | | BAnd b1 b2 => if (beval_ss st b1) 772 | then (beval_ss st b2) 773 | else false 774 | end. 775 | 776 | Theorem beval_beval_ss: forall st b, 777 | beval st b = beval_ss st b. 778 | Proof. 779 | intros. 780 | destruct b; reflexivity. 781 | Qed. 782 | 783 | 784 | Module BreakImp. 785 | 786 | Inductive com : Type := 787 | | CSkip : com 788 | | CBreak : com 789 | | CAss : id -> aexp -> com 790 | | CSeq : com -> com -> com 791 | | CIf : bexp -> com -> com -> com 792 | | CWhile : bexp -> com -> com. 793 | 794 | Notation "'SKIP'" := 795 | CSkip. 796 | Notation "'BREAK'" := 797 | CBreak. 798 | Notation "x '::=' a" := 799 | (CAss x a) (at level 60). 800 | Notation "c1 ;; c2" := 801 | (CSeq c1 c2) (at level 80, right associativity). 802 | Notation "'WHILE' b 'DO' c 'END'" := 803 | (CWhile b c) (at level 80, right associativity). 804 | Notation "'IFB' c1 'THEN' c2 'ELSE' c3 'FI'" := 805 | (CIf c1 c2 c3) (at level 80, right associativity). 806 | 807 | Inductive result : Type := 808 | | SContinue : result 809 | | SBreak : result. 810 | 811 | Reserved Notation "c1 '/' st '\\' s '/' st'" 812 | (at level 40, st, s at level 39). 813 | 814 | 815 | Inductive ceval : com -> state -> result -> state -> Prop := 816 | | E_Skip : forall st, 817 | CSkip / st \\ SContinue / st 818 | | E_Break : forall st, 819 | CBreak / st \\ SBreak / st 820 | | E_Ass : forall st a1 n x, 821 | aeval st a1 = n -> 822 | (x ::= a1) / st \\ SContinue / (t_update st x n) 823 | | E_IfTrue : forall st st' b c1 c2 cont, 824 | beval st b = true -> 825 | c1 / st \\ cont / st' -> 826 | (IFB b THEN c1 ELSE c2 FI) / st \\ cont / st' 827 | | E_IfFalse : forall st st' b c1 c2 cont, 828 | beval st b = false -> 829 | c2 / st \\ cont / st' -> 830 | (IFB b THEN c1 ELSE c2 FI) / st \\ cont / st' 831 | | E_SeqBreak : forall st st' c1 c2, 832 | c1 / st \\ SBreak / st' -> 833 | (c1 ;; c2) / st \\ SBreak / st' 834 | | E_SeqContinue : forall st st' st'' c1 c2 prog, 835 | c1 / st \\ SContinue / st' -> 836 | c2 / st' \\ prog / st'' -> 837 | (c1 ;; c2) / st \\ prog / st'' 838 | | E_WhileEnd : forall st b c, 839 | beval st b = false -> 840 | (WHILE b DO c END) / st \\ SContinue / st 841 | | E_WhileLoopBreak : forall st st' b c, 842 | beval st b = true -> 843 | c / st \\ SBreak / st' -> 844 | (WHILE b DO c END) / st \\ SContinue / st' 845 | | E_WhileLoopContinue : forall st st' st'' b c, 846 | beval st b = true -> 847 | c / st \\ SContinue / st' -> 848 | (WHILE b DO c END) / st' \\ SContinue / st'' -> 849 | (WHILE b DO c END) / st \\ SContinue / st'' 850 | 851 | where "c1 '/' st '\\' s '/' st'" := (ceval c1 st s st'). 852 | 853 | 854 | Theorem break_ignore : forall c st st' s, 855 | (BREAK;; c) / st \\ s / st' -> 856 | st = st'. 857 | Proof. 858 | intros. 859 | inversion H; subst. 860 | - inversion H5. reflexivity. 861 | - inversion H2. 862 | Qed. 863 | 864 | 865 | Theorem while_continue : forall b c st st' s, 866 | (WHILE b DO c END) / st \\ s / st' -> 867 | s = SContinue. 868 | Proof. 869 | intros. 870 | inversion H; subst; reflexivity. 871 | Qed. 872 | 873 | Theorem while_stops_on_break : forall b c st st', 874 | beval st b = true -> 875 | c / st \\ SBreak / st' -> 876 | (WHILE b DO c END) / st \\ SContinue / st'. 877 | Proof. 878 | intros. 879 | inversion H0; subst; apply E_WhileLoopBreak; 880 | try apply H; 881 | try apply H0. 882 | Qed. 883 | 884 | Theorem while_break_true : forall b c st st', 885 | (WHILE b DO c END) / st \\ SContinue / st' -> 886 | beval st' b = true -> 887 | exists st'', c / st'' \\ SBreak / st'. 888 | Proof. 889 | intros. 890 | remember (WHILE b DO c END) as loop. 891 | induction H; try inversion Heqloop; try subst. 892 | - rewrite H0 in H. inversion H. 893 | - exists st. apply H1. 894 | - apply IHceval2. 895 | * reflexivity. 896 | * apply H0. 897 | Qed. 898 | 899 | 900 | End BreakImp. -------------------------------------------------------------------------------- /IndProp.v: -------------------------------------------------------------------------------- 1 | 2 | Require Export Logic. 3 | 4 | 5 | Inductive ev : nat -> Prop := 6 | | ev_0 : ev 0 7 | | ev_SS : forall (n: nat), ev n -> ev (S (S n)). 8 | 9 | Theorem ev_4 : ev 4. 10 | Proof. apply ev_SS. apply ev_SS. apply ev_0. Qed. 11 | 12 | Theorem ev_4' : ev 4. 13 | Proof. apply (ev_SS 2 (ev_SS 0 ev_0)). Qed. 14 | 15 | 16 | Theorem ev_plus4 : forall n, ev n -> ev (4 + n). 17 | Proof. 18 | intros. 19 | simpl. 20 | apply ev_SS. 21 | apply ev_SS. 22 | apply H. 23 | Qed. 24 | 25 | 26 | Theorem ev_double : forall n, 27 | ev (double n). 28 | Proof. 29 | intros. 30 | induction n as [| n' IH]. 31 | - simpl. apply ev_0. 32 | - simpl. apply ev_SS. apply IH. 33 | Qed. 34 | 35 | Theorem ev_minus2 : forall n, 36 | ev n -> ev (pred (pred n)). 37 | Proof. 38 | intros. 39 | inversion H as [| n' H']. 40 | - simpl. apply ev_0. 41 | - simpl. apply H'. 42 | Qed. 43 | 44 | Theorem ev_minus2' : forall n, 45 | ev n -> ev (pred (pred n)). 46 | Proof. 47 | intros. 48 | destruct H. 49 | - simpl. apply ev_0. 50 | - simpl. apply H. 51 | Qed. 52 | 53 | Theorem evSS_ev : forall n, 54 | ev (S (S n)) -> ev n. 55 | Proof. 56 | intros. 57 | inversion H. 58 | apply H1. 59 | Qed. 60 | 61 | Theorem one_not_even : ~ ev 1. 62 | Proof. 63 | unfold not. 64 | intros. 65 | inversion H. 66 | Qed. 67 | 68 | Theorem SSSSev__even : forall n, 69 | ev (S (S (S (S n)))) -> ev n. 70 | Proof. 71 | intros. 72 | inversion H. 73 | inversion H1. 74 | apply H3. 75 | Qed. 76 | 77 | Theorem even5_nonsense : 78 | ev 5 -> 2 + 2 = 9. 79 | Proof. 80 | intros. 81 | inversion H. 82 | inversion H1. 83 | inversion H3. 84 | Qed. 85 | 86 | Lemma ev_even : forall n, 87 | ev n -> exists k, n = double k. 88 | Proof. 89 | intros. 90 | induction H as [| n' H' IH]. 91 | - exists 0. reflexivity. 92 | - destruct IH as [k' Hk']. 93 | exists (S k'). 94 | rewrite -> Hk'. 95 | reflexivity. 96 | Qed. 97 | 98 | Theorem ev_even_iff : forall n, 99 | ev n <-> exists k, n = double k. 100 | Proof. 101 | intros. 102 | split. 103 | - apply ev_even. 104 | - intros. 105 | destruct H as [k' Hk']. 106 | rewrite -> Hk'. 107 | apply ev_double. 108 | Qed. 109 | 110 | Theorem ev_sum : forall n m, ev n -> ev m -> ev (n + m). 111 | Proof. 112 | intros. 113 | induction H. 114 | - apply H0. 115 | - simpl. 116 | apply ev_SS. 117 | apply IHev. 118 | Qed. 119 | 120 | 121 | Inductive ev' : nat -> Prop := 122 | | ev'_0 : ev' 0 123 | | ev'_2 : ev' 2 124 | | ev'_sum : forall n m, ev' n -> ev' m -> ev' (n + m). 125 | 126 | Theorem ev'_ev : forall n, ev' n <-> ev n. 127 | Proof. 128 | intros. 129 | split. 130 | - intros. 131 | induction H. 132 | + apply ev_0. 133 | + apply ev_SS. apply ev_0. 134 | + apply (ev_sum n m IHev'1 IHev'2). 135 | - intros. 136 | induction H. 137 | + apply ev'_0. 138 | + rewrite -> plus_1_r. 139 | rewrite -> plus_1_r. 140 | rewrite -> plus_comm. 141 | rewrite <- plus_swap. 142 | simpl. 143 | apply (ev'_sum n 2 IHev ev'_2). 144 | Qed. 145 | 146 | Theorem ev_ev__ev : forall n m, 147 | ev (n+m) -> ev n -> ev m. 148 | Proof. 149 | intros. 150 | induction H0. 151 | - apply H. 152 | - simpl in H. 153 | apply evSS_ev in H. 154 | apply IHev. 155 | apply H. 156 | Qed. 157 | 158 | Theorem ev_plus_plus : forall n m p, 159 | ev (n+m) -> ev (n+p) -> ev (m+p). 160 | Proof. 161 | intros. 162 | apply ev_sum with (n:=n+m) (m:=n+p) in H. 163 | - replace (n + m + (n + p)) with ((n + n) + (m + p)) in H. 164 | + rewrite <- double_plus in H. 165 | apply (ev_ev__ev (double n) (m + p)) in H. 166 | * apply H. 167 | * apply ev_double. 168 | + rewrite -> plus_assoc. 169 | rewrite -> plus_assoc. 170 | replace (n + (m + p)) with (m + (n + p)). 171 | * reflexivity. 172 | * apply plus_swap. 173 | - apply H0. 174 | Qed. 175 | 176 | Module Playground. 177 | 178 | Inductive le : nat -> nat -> Prop := 179 | | le_n: forall n, le n n 180 | | le_S: forall n m, (le n m) -> (le n (S m)). 181 | 182 | Notation "m <= n" := (le m n). 183 | 184 | Theorem test_le1 : 185 | 3 <= 3. 186 | Proof. 187 | apply le_n. 188 | Qed. 189 | 190 | Theorem test_le2 : 191 | 3 <= 6. 192 | Proof. 193 | apply le_S. apply le_S. apply le_S. apply le_n. 194 | Qed. 195 | 196 | Theorem test_le3 : 197 | (2 <= 1) -> 2 + 2 = 5. 198 | Proof. 199 | intros. 200 | inversion H. 201 | inversion H2. 202 | Qed. 203 | 204 | End Playground. 205 | 206 | Definition lt (n m: nat) := le (S n) m. 207 | 208 | Notation "m < n" := (lt m n). 209 | 210 | Inductive square_of : nat -> nat -> Prop := 211 | | sq: forall (n: nat), square_of n (n * n). 212 | 213 | Inductive next_nat : nat -> nat -> Prop := 214 | | nn : forall (n: nat), next_nat n (S n). 215 | 216 | Inductive next_even : nat -> nat -> Prop := 217 | | ne_1: forall (n: nat), (ev (S n)) -> (next_even n (S n)) 218 | | ne_2: forall (n: nat), (ev (S (S n))) -> (next_even n (S (S n))). 219 | 220 | Inductive total_relation : nat -> nat -> Prop := 221 | | tot_rel: forall (n m: nat), total_relation n m. 222 | 223 | Inductive empty_relation : nat -> nat -> Prop := . 224 | 225 | Lemma le_trans : forall m n o, m <= n -> n <= o -> m <= o. 226 | Proof. 227 | intros. 228 | induction H0. 229 | - apply H. 230 | - apply le_S. apply IHle. 231 | Qed. 232 | 233 | Theorem O_le_n : forall n, 234 | 0 <= n. 235 | Proof. 236 | intros. 237 | induction n as [| n' IH]. 238 | - apply le_n. 239 | - apply le_S. apply IH. 240 | Qed. 241 | 242 | Theorem n_le_Sn: forall n, 243 | n <= S n. 244 | Proof. 245 | intros. apply le_S. apply le_n. 246 | Qed. 247 | 248 | Theorem Sn_le_m__n_le_m: forall n m, 249 | (S n) <= m -> n <= m. 250 | Proof. 251 | intros. 252 | apply (le_trans n (S n) m (n_le_Sn n)) in H. 253 | apply H. 254 | Qed. 255 | 256 | Theorem n_le_m__n_le_Sm: forall n m, 257 | n <= m -> n <= S m. 258 | Proof. 259 | intros. 260 | induction H. 261 | - apply le_S. apply le_n. 262 | - apply le_S. apply IHle. 263 | Qed. 264 | 265 | Theorem n_le_m__Sn_le_Sm : forall n m, 266 | n <= m -> S n <= S m. 267 | Proof. 268 | intros. 269 | induction H. 270 | - apply le_n. 271 | - apply le_S. 272 | apply IHle. 273 | Qed. 274 | 275 | Theorem Sn_le_Sm__n_le_m : forall n m, 276 | S n <= S m -> n <= m. 277 | Proof. 278 | intros. 279 | inversion H. 280 | - apply le_n. 281 | - apply le_trans with (n:=S n). 282 | + apply n_le_Sn. 283 | + apply H1. 284 | Qed. 285 | 286 | 287 | Theorem le_plus_l : forall a b, 288 | a <= a + b. 289 | Proof. 290 | intros. 291 | induction a as [| a' IH]. 292 | - apply O_le_n. 293 | - simpl. 294 | apply n_le_m__Sn_le_Sm. 295 | apply IH. 296 | Qed. 297 | 298 | Theorem plus_lt : forall n1 n2 m, 299 | n1 + n2 < m -> 300 | n1 < m /\ n2 < m. 301 | Proof. 302 | unfold lt. 303 | intros. 304 | split. 305 | - assert (I: S n1 <= S (n1 + n2)). 306 | { apply n_le_m__Sn_le_Sm. apply le_plus_l. } 307 | apply (le_trans (S n1) (S (n1 + n2)) m I) in H. 308 | apply H. 309 | - assert (I: S n2 <= S (n1 + n2)). 310 | { apply n_le_m__Sn_le_Sm. 311 | rewrite -> plus_comm. 312 | apply le_plus_l. } 313 | apply (le_trans (S n2) (S (n1 + n2)) m I) in H. 314 | apply H. 315 | Qed. 316 | 317 | Theorem lt_S : forall n m, 318 | n < m -> 319 | n < S m. 320 | Proof. 321 | unfold lt. 322 | intros. 323 | apply n_le_m__Sn_le_Sm. 324 | apply Sn_le_m__n_le_m in H. 325 | apply H. 326 | Qed. 327 | 328 | Theorem leb_complete : forall n m, 329 | leb n m = true -> n <= m. 330 | Proof. 331 | intros. 332 | generalize dependent m. 333 | induction n. 334 | - intros. apply O_le_n. 335 | - intros. 336 | destruct m. 337 | + inversion H. 338 | + rewrite -> plus_1_r in H. 339 | replace (S m) with (m + 1) in H. 340 | rewrite -> plus_comm in H. 341 | replace (m + 1) with (1 + m) in H. 342 | apply n_le_m__Sn_le_Sm. 343 | apply IHn. 344 | apply (plus_ble_compat_l n m 1 H). 345 | apply plus_comm. 346 | rewrite <- plus_1_r. 347 | reflexivity. 348 | Qed. 349 | 350 | 351 | Theorem leb_correct : forall n m, 352 | n <= m -> 353 | leb n m = true. 354 | Proof. 355 | intros. 356 | generalize dependent n. 357 | induction m. 358 | - intros. inversion H. reflexivity. 359 | - intros. 360 | destruct n. 361 | + reflexivity. 362 | + simpl. 363 | apply IHm. 364 | apply Sn_le_Sm__n_le_m in H. 365 | apply H. 366 | Qed. 367 | 368 | Theorem leb_true_trans : forall n m o, 369 | leb n m = true -> leb m o = true -> leb n o = true. 370 | Proof. 371 | intros. 372 | apply leb_correct. 373 | apply leb_complete in H. 374 | apply leb_complete in H0. 375 | apply (le_trans n m o H H0). 376 | Qed. 377 | 378 | Theorem leb_iff : forall n m, 379 | leb n m = true <-> n <= m. 380 | Proof. 381 | intros. 382 | split. 383 | - apply leb_complete. 384 | - apply leb_correct. 385 | Qed. 386 | 387 | Module R. 388 | 389 | Inductive R : nat -> nat -> nat -> Prop := 390 | | c1 : R 0 0 0 391 | | c2 : forall m n o, R m n o -> R (S m) n (S o) 392 | | c3 : forall m n o, R m n o -> R m (S n) (S o) 393 | | c4 : forall m n o, R (S m) (S n) (S (S o)) -> R m n o 394 | | c5 : forall m n o, R m n o -> R n m o. 395 | 396 | Theorem r112: R 1 1 2. 397 | Proof. 398 | intros. 399 | apply c2. apply c3. apply c1. 400 | Qed. 401 | 402 | Definition fR : nat -> nat -> nat := plus. 403 | 404 | Theorem R_equiv_fR : forall m n o, R m n o <-> fR m n = o. 405 | Proof. 406 | intros. 407 | split. 408 | - intros. 409 | unfold fR. 410 | induction H. 411 | + reflexivity. 412 | + simpl. 413 | rewrite -> IHR. 414 | reflexivity. 415 | + rewrite <- plus_n_Sm. 416 | rewrite -> IHR. 417 | reflexivity. 418 | + simpl in IHR. 419 | apply S_injective in IHR. 420 | rewrite <- plus_n_Sm in IHR. 421 | apply S_injective in IHR. 422 | apply IHR. 423 | + rewrite -> plus_comm. 424 | apply IHR. 425 | - unfold fR. 426 | intros. 427 | destruct H. 428 | + induction m. 429 | * induction n. 430 | simpl. apply c1. 431 | simpl. apply c3. simpl in IHn. apply IHn. 432 | * simpl. apply c2. apply IHm. 433 | Qed. 434 | 435 | End R. 436 | 437 | Inductive subseq : list nat -> list nat -> Prop := 438 | | nil_is_subseq: forall (l2: list nat), subseq [] l2 439 | | combine_subseq: forall (l1 l2: list nat) (x: nat), 440 | subseq l1 l2 -> 441 | subseq (x :: l1) (x :: l2) 442 | | subseq_larger: forall (l1 l2: list nat) (x: nat), 443 | subseq l1 l2 -> subseq l1 (x :: l2). 444 | 445 | Theorem subseq_refl : forall (l: list nat), 446 | subseq l l. 447 | Proof. 448 | intros. 449 | induction l as [| h t IH]. 450 | - apply nil_is_subseq. 451 | - apply combine_subseq. apply IH. 452 | Qed. 453 | 454 | Theorem subseq_app : forall (l1 l2 l3: list nat), 455 | subseq l1 l2 -> subseq l1 (l2 ++ l3). 456 | Proof. 457 | intros. 458 | induction H. 459 | - apply nil_is_subseq. 460 | - simpl. apply combine_subseq. apply IHsubseq. 461 | - simpl. apply subseq_larger. apply IHsubseq. 462 | Qed. 463 | 464 | Theorem subseq_trans : forall (l1 l2 l3: list nat), 465 | subseq l1 l2 /\ subseq l2 l3 -> subseq l1 l3. 466 | Proof. 467 | intros. 468 | destruct H. 469 | generalize dependent H. 470 | generalize dependent l1. 471 | induction H0. 472 | - intros. 473 | inversion H. 474 | apply nil_is_subseq. 475 | - intros. 476 | inversion H. 477 | + apply nil_is_subseq. 478 | + apply combine_subseq. 479 | apply IHsubseq. 480 | apply H3. 481 | + apply subseq_larger. 482 | apply IHsubseq. 483 | apply H3. 484 | - intros. 485 | apply subseq_larger. 486 | apply IHsubseq. 487 | apply H. 488 | Qed. 489 | 490 | Inductive R : nat -> list nat -> Prop := 491 | | c1 : R 0 [] 492 | | c2 : forall n l, R n l -> R (S n) (n :: l) 493 | | c3 : forall n l, R (S n) l -> R n l. 494 | 495 | Example r210: R 2 [1;0]. 496 | Proof. 497 | apply c2. apply c2. apply c1. 498 | Qed. 499 | 500 | Example r11210: R 1 [1;2;1;0]. 501 | Proof. 502 | apply c3. apply c2. apply c3. 503 | apply c3. apply c2. apply c2. 504 | apply c2. apply c1. 505 | Qed. 506 | 507 | Inductive reg_exp (T : Type) : Type := 508 | | EmptySet : reg_exp T 509 | | EmptyStr : reg_exp T 510 | | Char : T -> reg_exp T 511 | | App : reg_exp T -> reg_exp T -> reg_exp T 512 | | Union : reg_exp T -> reg_exp T -> reg_exp T 513 | | Star : reg_exp T -> reg_exp T. 514 | 515 | Arguments EmptySet {T}. 516 | Arguments EmptyStr {T}. 517 | Arguments Char {T} _. 518 | Arguments App {T} _ _. 519 | Arguments Union {T} _ _. 520 | Arguments Star {T} _. 521 | 522 | Inductive exp_match {T} : list T -> reg_exp T -> Prop := 523 | | MEmpty : exp_match [] EmptyStr 524 | | MChar : forall x, 525 | exp_match [x] (Char x) 526 | | MApp : forall s1 re1 s2 re2, 527 | exp_match s1 re1 -> exp_match s2 re2 -> 528 | exp_match (s1 ++ s2) (App re1 re2) 529 | | MUnionL : forall s re1 re2, 530 | exp_match s re1 -> 531 | exp_match s (Union re1 re2) 532 | | MUnionR : forall s re1 re2, 533 | exp_match s re2 -> 534 | exp_match s (Union re1 re2) 535 | | MStar0: forall re, 536 | exp_match [] (Star re) 537 | | MStarApp: forall s1 s2 re, 538 | exp_match s1 re -> exp_match s2 (Star re) -> 539 | exp_match (s1 ++ s2) (Star re). 540 | 541 | Notation "s =~ re" := (exp_match s re) (at level 80). 542 | 543 | Example reg_exp_ex1 : [1] =~ Char 1. 544 | Proof. apply MChar. Qed. 545 | 546 | Example reg_exp_ex2 : [1; 2] =~ App (Char 1) (Char 2). 547 | Proof. 548 | apply (MApp [1] _ [2]). 549 | - apply MChar. 550 | - apply MChar. 551 | Qed. 552 | 553 | Example reg_exp_ex3 : ~ ([1; 2] =~ Char 1). 554 | Proof. 555 | unfold not. 556 | intros. 557 | inversion H. 558 | Qed. 559 | 560 | 561 | Fixpoint reg_exp_of_list {T} (l : list T) := 562 | match l with 563 | | [] => EmptyStr 564 | | h :: t => App (Char h) (reg_exp_of_list t) 565 | end. 566 | 567 | Example reg_exp_ex4 : [1; 2; 3] =~ reg_exp_of_list [1; 2; 3]. 568 | Proof. 569 | simpl. 570 | apply (MApp [1]). 571 | { apply MChar. } 572 | apply (MApp [2]). 573 | { apply MChar. } 574 | apply (MApp [3]). 575 | { apply MChar. } 576 | apply MEmpty. 577 | Qed. 578 | 579 | Lemma MStar1 : 580 | forall T s (re : reg_exp T) , 581 | s =~ re -> 582 | s =~ Star re. 583 | Proof. 584 | intros. 585 | rewrite <- (app_nil_r _ s). 586 | apply (MStarApp s [] re). 587 | - apply H. 588 | - apply MStar0. 589 | Qed. 590 | 591 | Lemma empty_is_empty : forall T (s : list T), 592 | ~ (s =~ EmptySet). 593 | Proof. 594 | unfold not. 595 | intros. 596 | inversion H. 597 | Qed. 598 | 599 | Lemma MUnion' : forall T (s : list T) (re1 re2 : reg_exp T), 600 | s =~ re1 \/ s =~ re2 -> 601 | s =~ Union re1 re2. 602 | Proof. 603 | intros. 604 | destruct H. 605 | - apply MUnionL. apply H. 606 | - apply MUnionR. apply H. 607 | Qed. 608 | 609 | Lemma MStar' : forall T (ss : list (list T)) (re : reg_exp T), 610 | (forall s, In s ss -> s =~ re) -> 611 | fold app ss [] =~ Star re. 612 | Proof. 613 | intros. 614 | induction ss. 615 | - simpl. 616 | apply MStar0. 617 | - simpl. 618 | apply MStarApp. 619 | + apply H. 620 | simpl. left. reflexivity. 621 | + simpl. 622 | apply IHss. 623 | intros. 624 | apply H. 625 | simpl. right. apply H0. 626 | Qed. 627 | 628 | Lemma reg_exp_of_list_spec : forall T (s1 s2 : list T), 629 | s1 =~ reg_exp_of_list s2 <-> s1 = s2. 630 | Proof. 631 | intros. 632 | split. 633 | - intros. 634 | generalize dependent s1. 635 | induction s2. 636 | + intros. inversion H. reflexivity. 637 | + intros. simpl in H. 638 | inversion H. 639 | apply IHs2 in H4. 640 | inversion H3. 641 | rewrite -> H4. 642 | reflexivity. 643 | - intros. 644 | generalize dependent s1. 645 | induction s2. 646 | + intros. simpl. rewrite -> H. apply MEmpty. 647 | + intros. simpl. 648 | rewrite -> H. 649 | apply (MApp [x] _ s2). 650 | * apply MChar. 651 | * apply IHs2. reflexivity. 652 | Qed. 653 | 654 | Fixpoint re_chars {T} (re : reg_exp T) : list T := 655 | match re with 656 | | EmptySet => [] 657 | | EmptyStr => [] 658 | | Char x => [x] 659 | | App re1 re2 => re_chars re1 ++ re_chars re2 660 | | Union re1 re2 => re_chars re1 ++ re_chars re2 661 | | Star re => re_chars re 662 | end. 663 | 664 | Theorem in_re_match : forall T (s : list T) (re: reg_exp T) (x: T), 665 | s =~ re -> 666 | In x s -> 667 | In x (re_chars re). 668 | Proof. 669 | intros T s re x Hmatch Hin. 670 | induction Hmatch. 671 | - inversion Hin. 672 | - apply Hin. 673 | - simpl. rewrite -> in_app_iff in *. 674 | destruct Hin. 675 | + left. apply IHHmatch1. apply H. 676 | + right. apply IHHmatch2. apply H. 677 | - simpl. rewrite -> in_app_iff in *. 678 | left. apply IHHmatch. apply Hin. 679 | - simpl. rewrite -> in_app_iff in *. 680 | right. apply IHHmatch. apply Hin. 681 | - inversion Hin. 682 | - rewrite -> in_app_iff in *. 683 | destruct Hin. 684 | + simpl. apply IHHmatch1. apply H. 685 | + apply IHHmatch2. apply H. 686 | Qed. 687 | 688 | Fixpoint re_not_empty {T : Type} (re : reg_exp T) : bool := 689 | match re with 690 | | EmptySet => false 691 | | EmptyStr => true 692 | | Char x => true 693 | | App re1 re2 => re_not_empty re1 && re_not_empty re2 694 | | Union re1 re2 => re_not_empty re1 || re_not_empty re2 695 | | Star re => true 696 | end. 697 | 698 | Lemma re_not_empty_correct : forall T (re : reg_exp T), 699 | (exists s, s =~ re) <-> re_not_empty re = true. 700 | Proof. 701 | intros. 702 | split. 703 | - intros. 704 | destruct H. 705 | induction H. 706 | + reflexivity. 707 | + reflexivity. 708 | + simpl. 709 | rewrite -> IHexp_match1. 710 | rewrite -> IHexp_match2. 711 | reflexivity. 712 | + simpl. 713 | apply orb_true_iff. 714 | left. apply IHexp_match. 715 | + simpl. 716 | apply orb_true_iff. 717 | right. apply IHexp_match. 718 | + reflexivity. 719 | + reflexivity. 720 | - intros. 721 | induction re. 722 | + inversion H. 723 | + exists []. 724 | apply MEmpty. 725 | + exists [t]. 726 | apply MChar. 727 | + simpl in H. 728 | apply andb_true_iff in H. 729 | destruct H. 730 | apply IHre1 in H. apply IHre2 in H0. 731 | destruct H. destruct H0. 732 | exists (x ++ x0). 733 | apply MApp. 734 | * apply H. 735 | * apply H0. 736 | + simpl in H. 737 | apply orb_true_iff in H. 738 | destruct H. 739 | * apply IHre1 in H. 740 | destruct H. 741 | exists x. 742 | apply MUnionL. apply H. 743 | * apply IHre2 in H. 744 | destruct H. 745 | exists x. 746 | apply MUnionR. apply H. 747 | + exists []. 748 | apply MStar0. 749 | Qed. 750 | 751 | Lemma star_app: forall T (s1 s2 : list T) (re : reg_exp T), 752 | s1 =~ Star re -> 753 | s2 =~ Star re -> 754 | s1 ++ s2 =~ Star re. 755 | Proof. 756 | intros T s1 s2 re H1. 757 | remember (Star re) as re'. 758 | generalize dependent s2. 759 | induction H1 as [|x'|s1 re1 s2' re2 Hmatch1 IH1 Hmatch2 IH2 760 | |s1 re1 re2 Hmatch IH|re1 s2' re2 Hmatch IH 761 | |re''|s1 s2' re'' Hmatch1 IH1 Hmatch2 IH2]. 762 | - inversion Heqre'. 763 | - inversion Heqre'. 764 | - inversion Heqre'. 765 | - inversion Heqre'. 766 | - inversion Heqre'. 767 | - inversion Heqre'. 768 | intros. apply H. 769 | - inversion Heqre'. 770 | rewrite -> H0 in IH2, Hmatch1. 771 | intros. rewrite <- app_assoc. 772 | apply MStarApp. 773 | + apply Hmatch1. 774 | + apply IH2. 775 | * reflexivity. 776 | * apply H. 777 | Qed. 778 | 779 | Lemma cons_app_equiv: forall (T: Type) (t: list T) (h: T), 780 | h :: t = [h] ++ t. 781 | Proof. 782 | simpl. reflexivity. 783 | Qed. 784 | 785 | Lemma s_re__s_star_re: forall (T: Type) (s: list T) (re: reg_exp T), 786 | s =~ re -> s =~ Star re. 787 | Proof. 788 | intros. 789 | destruct re. 790 | + inversion H. 791 | + inversion H. 792 | apply MStar0. 793 | + inversion H. 794 | rewrite <- (app_nil_r T [t]). 795 | apply MStarApp. 796 | - apply MChar. 797 | - apply MStar0. 798 | + rewrite <- (app_nil_r T s). 799 | apply MStarApp. 800 | - apply H. 801 | - apply MStar0. 802 | + rewrite <- (app_nil_r T s). 803 | apply MStarApp. 804 | - apply H. 805 | - apply MStar0. 806 | + rewrite <- (app_nil_r T s). 807 | apply MStarApp. 808 | - apply H. 809 | - apply MStar0. 810 | Qed. 811 | 812 | 813 | Lemma MStar'' : forall T (s : list T) (re : reg_exp T), 814 | s =~ Star re -> 815 | exists ss : list (list T), 816 | s = fold app ss [] 817 | /\ forall s', In s' ss -> s' =~ re. 818 | Proof. 819 | intros. 820 | remember (Star re) as re'. 821 | induction H. 822 | - inversion Heqre'. 823 | - inversion Heqre'. 824 | - inversion Heqre'. 825 | - inversion Heqre'. 826 | - inversion Heqre'. 827 | - inversion Heqre'. 828 | exists []. 829 | split. 830 | + reflexivity. 831 | + intros. inversion H. 832 | - inversion Heqre'. 833 | rewrite -> H2 in *. 834 | induction s1. 835 | + intros. simpl. apply IHexp_match2. apply Heqre'. 836 | + intros. 837 | apply IHexp_match2 in Heqre'. 838 | destruct Heqre'. 839 | destruct H1. 840 | exists ((x::s1)::x0). 841 | split. 842 | * rewrite -> H1. simpl. reflexivity. 843 | * intros. simpl. 844 | destruct H4. 845 | { rewrite -> H4. apply H. } 846 | { apply H3 in H4. apply H4. } 847 | Qed. 848 | 849 | 850 | Theorem filter_not_empty_In : forall n l, 851 | filter (beq_nat n) l <> [] -> 852 | In n l. 853 | Proof. 854 | intros. 855 | induction l as [| h t IH]. 856 | - apply H. reflexivity. 857 | - simpl. destruct (beq_nat n h) eqn:beqnh. 858 | + rewrite beq_nat_true_iff in beqnh. 859 | left. apply beqnh. 860 | + simpl in H. rewrite beqnh in H. 861 | right. apply IH. apply H. 862 | Qed. 863 | 864 | Module FirstTry. 865 | 866 | Inductive reflect : Prop -> bool -> Prop := 867 | | ReflectT: forall P:Prop, P -> reflect P true 868 | | ReflectF: forall P:Prop, ~ P -> reflect P false. 869 | 870 | End FirstTry. 871 | 872 | 873 | Inductive reflect (P: Prop) : bool -> Prop := 874 | | ReflectT: P -> reflect P true 875 | | ReflectF: ~ P -> reflect P false. 876 | 877 | Theorem iff_reflect : forall P b, (P <-> b = true) -> reflect P b. 878 | Proof. 879 | intros. destruct b. 880 | - apply ReflectT. 881 | rewrite H. 882 | reflexivity. 883 | - apply ReflectF. 884 | unfold not. intros. 885 | apply H in H0. 886 | inversion H0. 887 | Qed. 888 | 889 | Theorem reflect_iff : forall P b, reflect P b -> (P <-> b = true). 890 | Proof. 891 | intros. 892 | destruct b. 893 | - inversion H. 894 | split. 895 | + intros. 896 | reflexivity. 897 | + intros. 898 | apply H0. 899 | - inversion H. 900 | unfold not in H0. 901 | split. 902 | + intros. 903 | exfalso. 904 | apply H0. 905 | apply H1. 906 | + intros. 907 | inversion H1. 908 | Qed. 909 | 910 | 911 | Lemma beq_natP : forall n m, reflect (n = m) (beq_nat n m). 912 | Proof. 913 | intros. 914 | apply iff_reflect. 915 | rewrite beq_nat_true_iff. 916 | reflexivity. 917 | Qed. 918 | 919 | Theorem filter_not_empty_In' : forall n l, 920 | filter (beq_nat n) l <> [] -> 921 | In n l. 922 | Proof. 923 | intros n l. 924 | induction l as [| h t IH]. 925 | - intros. apply H. reflexivity. 926 | - simpl. destruct (beq_natP n h). 927 | + intros. left. apply H. 928 | + intros. right. apply IH. apply H0. 929 | Qed. 930 | 931 | Fixpoint count n l := 932 | match l with 933 | | [] => 0 934 | | m :: l' => (if beq_nat n m then 1 else 0) + count n l' 935 | end. 936 | 937 | 938 | Theorem beq_natP_practice : forall n l, 939 | count n l = 0 -> ~(In n l). 940 | Proof. 941 | unfold not. 942 | intros n l. 943 | induction l as [| h t IH]. 944 | - intros. inversion H0. 945 | - simpl. destruct (beq_natP n h). 946 | + intros. inversion H0. 947 | + simpl. intros. 948 | apply IH. 949 | * apply H0. 950 | * destruct H1. 951 | { exfalso. apply H. apply H1. } 952 | { apply H1. } 953 | Qed. 954 | 955 | Inductive nostutter {X:Type} : list X -> Prop := 956 | | nostutter_nil: nostutter [] 957 | | nostutter_cons: forall (x:X), nostutter (x :: []) 958 | | nostutter_xy: forall (x y: X) (l: list X), 959 | x <> y -> nostutter (y :: l) -> nostutter (x :: y :: l). 960 | 961 | Example test_nostutter_1: nostutter [3;1;4;1;5;6]. 962 | Proof. 963 | repeat constructor; apply beq_nat_false_iff; auto. 964 | Qed. 965 | 966 | Example test_nostutter_2: nostutter (@nil nat). 967 | Proof. 968 | repeat constructor. 969 | Qed. 970 | 971 | Example test_nostutter_3: nostutter [5]. 972 | Proof. 973 | repeat constructor. 974 | Qed. 975 | 976 | Example test_nostutter_4: not (nostutter [3;1;1;4]). 977 | Proof. intro. 978 | repeat match goal with 979 | h: nostutter _ |- _ => inversion h; clear h; subst 980 | end. 981 | contradiction H1; auto. 982 | Qed. 983 | 984 | 985 | Inductive in_order_merge {X:Type} : list X -> list X -> list X -> Prop := 986 | | iom_nil: in_order_merge [] [] [] 987 | | iom_left: forall (x: X) (l1 l2 l: list X), 988 | in_order_merge l1 l2 l -> 989 | in_order_merge (x :: l1) l2 (x :: l) 990 | | iom_right: forall (x: X) (l1 l2 l: list X), 991 | in_order_merge l1 l2 l -> 992 | in_order_merge l1 (x :: l2) (x :: l). 993 | 994 | 995 | Theorem filter_in_order_merge: forall (X: Type) (test: X -> bool) (l l1 l2: list X), 996 | in_order_merge l1 l2 l -> 997 | All (fun a => test a = true) l1 -> 998 | All (fun b => test b = false) l2 -> 999 | filter test l = l1. 1000 | Proof. 1001 | intros. 1002 | induction H. 1003 | - reflexivity. 1004 | - simpl. 1005 | inversion H0. 1006 | rewrite H2. 1007 | apply tail_eq. 1008 | apply IHin_order_merge. 1009 | + apply H3. 1010 | + apply H1. 1011 | - simpl. 1012 | inversion H1. 1013 | rewrite H2. 1014 | apply IHin_order_merge. 1015 | + apply H0. 1016 | + apply H3. 1017 | Qed. 1018 | 1019 | Inductive pal {X:Type} : list X -> Prop := 1020 | | pal_nil: pal [] 1021 | | pal_single: forall (x: X), pal [x] 1022 | | pal_inductive: forall (x: X) (l: list X), 1023 | pal l -> 1024 | pal (x :: l ++ [x]). 1025 | 1026 | Theorem pal_app_rev: forall (X: Type) (l: list X), 1027 | pal (l ++ rev l). 1028 | Proof. 1029 | intros. 1030 | induction l as [|h t IH]. 1031 | - simpl. apply pal_nil. 1032 | - simpl. 1033 | rewrite -> app_assoc. 1034 | apply (pal_inductive h (t ++ rev t)). 1035 | apply IH. 1036 | Qed. 1037 | 1038 | Theorem pal_rev: forall (X: Type) (l: list X), 1039 | pal l -> l = rev l. 1040 | Proof. 1041 | intros. 1042 | induction H. 1043 | - reflexivity. 1044 | - reflexivity. 1045 | - simpl. 1046 | rewrite -> rev_app_distr. 1047 | rewrite <- IHpal. 1048 | simpl. 1049 | reflexivity. 1050 | Qed. 1051 | 1052 | 1053 | Inductive disjoint {X:Type} : list X -> list X -> Prop := 1054 | | disjoint_nil: disjoint [] [] 1055 | | disjoint_left: forall (x: X) (l1 l2: list X), 1056 | ~ In x l2 -> 1057 | disjoint l1 l2 -> 1058 | disjoint (x :: l1) l2 1059 | | disjoint_right: forall (x: X) (l1 l2: list X), 1060 | ~ In x l1 -> 1061 | disjoint l1 l2 -> 1062 | disjoint l1 (x :: l2). 1063 | 1064 | 1065 | Inductive NoDup {X:Type} : list X -> Prop := 1066 | | nodup_nil: NoDup [] 1067 | | nodup_inductive: forall (x: X) (l: list X), 1068 | ~ In x l -> 1069 | NoDup l -> 1070 | NoDup (x :: l). 1071 | 1072 | Lemma disjoint_nil_r: forall (X: Type) (l: list X), 1073 | disjoint l []. 1074 | Proof. 1075 | intros. 1076 | induction l as [| h t IH]. 1077 | + apply disjoint_nil. 1078 | + apply disjoint_left. 1079 | * intro. destruct H. 1080 | * apply IH. 1081 | Qed. 1082 | 1083 | Lemma disjoint_nil_l: forall (X: Type) (l: list X), 1084 | disjoint [] l. 1085 | Proof. 1086 | intros. 1087 | induction l as [| h t IH]. 1088 | + apply disjoint_nil. 1089 | + apply disjoint_right. 1090 | * intro. destruct H. 1091 | * apply IH. 1092 | Qed. 1093 | 1094 | 1095 | Lemma in_split : forall (X:Type) (x:X) (l:list X), 1096 | In x l -> 1097 | exists l1 l2, l = l1 ++ x :: l2. 1098 | Proof. 1099 | intros. 1100 | generalize dependent x. 1101 | induction l as [| h t IH]. 1102 | - intros. inversion H. 1103 | - intros. 1104 | simpl in H. 1105 | destruct H. 1106 | + rewrite -> H. 1107 | exists []. 1108 | exists t. 1109 | simpl. 1110 | reflexivity. 1111 | + apply IH in H. 1112 | destruct H. 1113 | destruct H. 1114 | exists (h :: x0). 1115 | exists x1. 1116 | simpl. 1117 | rewrite <- H. 1118 | reflexivity. 1119 | Qed. 1120 | 1121 | (* Inductive repeats {X:Type} : list X -> Prop := 1122 | | repeats_any_larger: forall (x: X) (l: list X), 1123 | repeats l -> 1124 | repeats (x :: l) 1125 | | repeats_inductive: forall (x: X) (l: list X), 1126 | In x l -> 1127 | repeats (x :: l). 1128 | 1129 | 1130 | Theorem pigeonhole_principle: forall (X:Type) (l1 l2:list X), 1131 | excluded_middle -> 1132 | (forall x, In x l1 -> In x l2) -> 1133 | length l2 < length l1 -> 1134 | repeats l1. 1135 | Proof. 1136 | intros X l1. 1137 | induction l1 as [|x l1' IHl1']. 1138 | - intros. 1139 | inversion H1. 1140 | - intros. 1141 | 1142 | 1143 | apply (IHl1' (x :: l1') H _ H1). 1144 | + 1145 | aply 1146 | + apply repeats_any_larger. 1147 | apply H. 1148 | + intros. 1149 | rewrite -> cons_app_equiv. 1150 | apply in_app_iff. 1151 | right. 1152 | apply H2. 1153 | + *) 1154 | 1155 | -------------------------------------------------------------------------------- /Induction.v: -------------------------------------------------------------------------------- 1 | Require Export Basic. 2 | 3 | Theorem n_plus_O: forall n:nat, 4 | n = n + O. 5 | Proof. 6 | intros. 7 | induction n as [| n' IHn']. 8 | - reflexivity. 9 | - simpl. rewrite <- IHn'. reflexivity. 10 | Qed. 11 | 12 | Theorem minus_diag: forall n:nat, 13 | n - n = O. 14 | Proof. 15 | intros. 16 | induction n as [| n' IHn']. 17 | - reflexivity. 18 | - simpl. rewrite -> IHn'. reflexivity. 19 | Qed. 20 | 21 | Theorem mult_O_r: forall n:nat, 22 | n * O = O. 23 | Proof. 24 | intros. 25 | induction n as [| n' IHn']. 26 | - reflexivity. 27 | - simpl. rewrite -> IHn'. reflexivity. 28 | Qed. 29 | 30 | Theorem plus_n_Sm: forall n m:nat, 31 | S (n + m) = n + (S m). 32 | Proof. 33 | intros. 34 | induction n as [| n' IHn']. 35 | - simpl. reflexivity. 36 | - simpl. rewrite -> IHn'. reflexivity. 37 | Qed. 38 | 39 | Theorem plus_comm: forall (n m:nat), 40 | n + m = m + n. 41 | Proof. 42 | intros. 43 | induction n as [| n' IHn']. 44 | - simpl. rewrite <- plus_O_r. reflexivity. 45 | - induction m as [| m' IHm']. 46 | + simpl. rewrite <- plus_O_r. reflexivity. 47 | + simpl. rewrite -> IHn'. simpl. rewrite -> plus_n_Sm. reflexivity. 48 | Qed. 49 | 50 | Theorem plus_assoc: forall (n m p: nat), 51 | (n + m) + p = n + (m + p). 52 | Proof. 53 | intros. 54 | induction n as [| n' IHn']. 55 | - simpl. reflexivity. 56 | - simpl. rewrite -> IHn'. reflexivity. 57 | Qed. 58 | 59 | Fixpoint double (n:nat) := 60 | match n with 61 | | O => O 62 | | S n' => S (S (double n')) 63 | end. 64 | 65 | Lemma double_plus: forall n:nat, double n = n + n. 66 | Proof. 67 | intros. 68 | induction n as [| n' IHn']. 69 | - simpl. reflexivity. 70 | - simpl. rewrite -> IHn'. rewrite -> plus_n_Sm. reflexivity. 71 | Qed. 72 | 73 | Theorem evenb_S: forall n: nat, 74 | evenb (S n) = negb (evenb n). 75 | Proof. 76 | intros. 77 | induction n as [| n' IHn']. 78 | - simpl. reflexivity. 79 | - rewrite -> IHn'. simpl. rewrite -> negb_involutive. reflexivity. 80 | Qed. 81 | 82 | Theorem mult_O_plus: forall n m:nat, 83 | (O + n) * m = n * m. 84 | Proof. 85 | intros. 86 | assert (H: O + n = n). { reflexivity. } 87 | rewrite -> H. 88 | reflexivity. 89 | Qed. 90 | 91 | Theorem plus_rearrange : forall n m p q:nat, 92 | (n + m) + (p + q) = (m + n) + (p + q). 93 | Proof. 94 | intros. 95 | assert (H: n + m = m + n). { rewrite -> plus_comm. reflexivity. } 96 | rewrite -> H. 97 | reflexivity. 98 | Qed. 99 | 100 | Theorem plus_swap : forall n m p:nat, 101 | n + (m + p) = m + (n + p). 102 | Proof. 103 | intros. 104 | rewrite <- plus_assoc. 105 | assert (H: m + (n + p) = (m + n) + p). { rewrite -> plus_assoc. reflexivity. } 106 | rewrite -> H. 107 | rewrite <- plus_comm. 108 | assert (I: m + n + p = p + (m + n)). { rewrite -> plus_comm. reflexivity. } 109 | rewrite -> I. 110 | assert (J: n + m = m + n). { rewrite -> plus_comm. reflexivity. } 111 | rewrite -> J. 112 | reflexivity. 113 | Qed. 114 | 115 | Theorem mult_a_Sb: forall a b:nat, 116 | a * S b = a + a * b. 117 | Proof. 118 | intros. 119 | induction a as [| a' IHa']. 120 | - simpl. 121 | reflexivity. 122 | - simpl. 123 | rewrite -> IHa'. 124 | rewrite -> plus_swap. 125 | reflexivity. 126 | Qed. 127 | 128 | Theorem mult_comm: forall n m:nat, 129 | m * n = n * m. 130 | Proof. 131 | intros. 132 | induction n as [| n' IHn']. 133 | - rewrite -> mult_O_l. rewrite -> mult_O_r. reflexivity. 134 | - simpl. rewrite <- IHn'. induction m as [| m' IHm']. 135 | + simpl. reflexivity. 136 | + simpl. 137 | rewrite -> mult_a_Sb. 138 | rewrite -> plus_swap. 139 | reflexivity. 140 | Qed. 141 | 142 | (* exercises *) 143 | Theorem leb_refl : forall n:nat, 144 | true = leb n n. 145 | Proof. 146 | intros. 147 | induction n as [| n' IHn']. 148 | - reflexivity. 149 | - rewrite -> IHn'. reflexivity. 150 | Qed. 151 | 152 | Theorem zero_nbeq_S : forall n:nat, 153 | beq_nat 0 (S n) = false. 154 | Proof. 155 | intros. 156 | destruct n as [| n']. 157 | - reflexivity. 158 | - reflexivity. 159 | Qed. 160 | 161 | Theorem andb_false_r : forall b : bool, 162 | andb b false = false. 163 | Proof. 164 | intros. 165 | destruct b as [| b']. 166 | - reflexivity. 167 | - reflexivity. 168 | Qed. 169 | 170 | Theorem plus_ble_compat_l : forall n m p : nat, 171 | leb n m = true -> leb (p + n) (p + m) = true. 172 | Proof. 173 | intros. 174 | induction p as [| p' IHp']. 175 | - simpl. rewrite -> H. reflexivity. 176 | - simpl. rewrite -> IHp'. reflexivity. 177 | Qed. 178 | 179 | Theorem S_nbeq_0 : forall n:nat, 180 | beq_nat (S n) 0 = false. 181 | Proof. 182 | intros. 183 | replace (S n) with (n + 1). 184 | - rewrite -> plus_1_neq_0. reflexivity. 185 | - rewrite <- plus_1_r. reflexivity. 186 | Qed. 187 | 188 | Theorem mult_1_l : forall n:nat, 1 * n = n. 189 | Proof. 190 | intros. 191 | destruct n as [| n' IHn']. 192 | - reflexivity. 193 | - simpl. rewrite <- plus_O_r. reflexivity. 194 | Qed. 195 | 196 | Theorem all3_spec : forall b c : bool, 197 | orb 198 | (andb b c) 199 | (orb (negb b) 200 | (negb c)) 201 | = true. 202 | Proof. 203 | intros. 204 | destruct b as [| b']. 205 | destruct c as [| c']. 206 | - reflexivity. 207 | - reflexivity. 208 | - reflexivity. 209 | Qed. 210 | 211 | Theorem mult_plus_distr_r : forall n m p : nat, 212 | (n + m) * p = (n * p) + (m * p). 213 | Proof. 214 | intros. 215 | induction n as [| n' IHn']. 216 | - simpl. reflexivity. 217 | - simpl. rewrite -> IHn'. rewrite -> plus_assoc. reflexivity. 218 | Qed. 219 | 220 | Theorem mult_assoc : forall n m p : nat, 221 | n * (m * p) = (n * m) * p. 222 | Proof. 223 | intros. 224 | induction n as [| n' IHn']. 225 | - simpl. reflexivity. 226 | - simpl. rewrite -> IHn'. rewrite -> mult_plus_distr_r. reflexivity. 227 | Qed. 228 | 229 | Theorem beq_nat_refl : forall n : nat, 230 | true = beq_nat n n. 231 | Proof. 232 | intros. 233 | induction n as [| n' IHn']. 234 | - simpl. reflexivity. 235 | - simpl. rewrite -> IHn'. reflexivity. 236 | Qed. 237 | 238 | Theorem plus_swap' : forall n m p:nat, 239 | n + (m + p) = m + (n + p). 240 | Proof. 241 | intros. 242 | intros. 243 | rewrite <- plus_assoc. 244 | assert (H: m + (n + p) = (m + n) + p). { rewrite -> plus_assoc. reflexivity. } 245 | rewrite -> H. 246 | rewrite <- plus_comm. 247 | replace (m + n + p) with (p + (m + n)). 248 | - replace (n + m) with (m + n). 249 | + reflexivity. 250 | + rewrite -> plus_comm. reflexivity. 251 | - rewrite -> plus_comm. reflexivity. 252 | Qed. 253 | 254 | Theorem bin_to_nat_pres_incr: forall b:bin, 255 | (bin_to_nat (incr b)) = S (bin_to_nat b). 256 | Proof. 257 | intros. 258 | induction b as [| b' | b'' IHb']. 259 | - simpl. reflexivity. 260 | - simpl. rewrite -> IHb'. simpl. 261 | replace (bin_to_nat b' + 0) with (bin_to_nat b'). 262 | + rewrite <- plus_1_r. rewrite <- plus_n_Sm. reflexivity. 263 | + rewrite <- plus_O_r. reflexivity. 264 | - simpl. rewrite <- plus_1_r. reflexivity. 265 | Qed. 266 | 267 | (* binary inverse *) 268 | Fixpoint nat_to_bin (n: nat) : bin := 269 | match n with 270 | | O => Zero 271 | | S n' => incr (nat_to_bin n') 272 | end. 273 | 274 | Theorem nat_bin_nat: forall (n: nat), 275 | bin_to_nat (nat_to_bin n) = n. 276 | Proof. 277 | intros. 278 | induction n as [| n' IH]. 279 | - reflexivity. 280 | - simpl. 281 | rewrite -> bin_to_nat_pres_incr. 282 | rewrite -> IH. 283 | reflexivity. 284 | Qed. 285 | 286 | Fixpoint normalize (b: bin) : bin := 287 | match b with 288 | | Zero => Zero 289 | | Twice b' => match (normalize b') with 290 | | Zero => Zero 291 | | _ => Twice (normalize b') 292 | end 293 | | TwicePlusOne b' => TwicePlusOne (normalize b') 294 | end. 295 | 296 | Compute (normalize (TwicePlusOne (Twice (TwicePlusOne (Twice (TwicePlusOne (Twice Zero))))))). 297 | 298 | Compute (normalize (normalize (Twice Zero))). 299 | 300 | Theorem nat_twice_plus_one: forall (n:nat), 301 | nat_to_bin (n + n + 1) = TwicePlusOne (nat_to_bin n). 302 | Proof. 303 | intros. 304 | induction n as [| n' IH]. 305 | - reflexivity. 306 | - simpl. 307 | replace (n' + S n') with (S (n' + n')). 308 | + simpl. 309 | rewrite -> IH. 310 | reflexivity. 311 | + rewrite -> plus_n_Sm. 312 | reflexivity. 313 | Qed. 314 | 315 | Theorem normalize_incr: forall (b: bin), 316 | incr (normalize b) = normalize (incr b). 317 | Proof. 318 | intros. 319 | induction b as [| b' | b'' IH]. 320 | - reflexivity. 321 | - simpl. 322 | rewrite <- IHb'. 323 | destruct (normalize b'). 324 | + reflexivity. 325 | + reflexivity. 326 | + reflexivity. 327 | - simpl. 328 | destruct (normalize b''). 329 | + reflexivity. 330 | + reflexivity. 331 | + reflexivity. 332 | Qed. 333 | 334 | Theorem nat_twice: forall (n: nat), 335 | nat_to_bin (n + n) = normalize (Twice (nat_to_bin n)). 336 | Proof. 337 | intros. 338 | induction n as [| n' IH]. 339 | - reflexivity. 340 | - rewrite <- plus_n_Sm. 341 | simpl. 342 | rewrite <- normalize_incr. 343 | rewrite -> IH. 344 | induction (nat_to_bin n') as [| b | b' IHb]. 345 | + reflexivity. 346 | + reflexivity. 347 | + rewrite <- IH. 348 | Admitted. 349 | 350 | Theorem normalize_idemp: forall (b: bin), 351 | normalize (normalize b) = normalize b. 352 | Proof. 353 | intros. 354 | induction b as [| b' | b'' IH]. 355 | - reflexivity. 356 | - simpl. 357 | rewrite -> IHb'. 358 | reflexivity. 359 | - induction (normalize (Twice b'')). 360 | + reflexivity. 361 | + simpl. 362 | rewrite -> IHb. 363 | reflexivity. 364 | + 365 | rewrite -> IHb. 366 | simpl. 367 | 368 | - induction b'' as [| c | c' IH']. 369 | + reflexivity. 370 | + simpl. 371 | simpl in IH. 372 | rewrite -> IH. 373 | reflexivity. 374 | Admitted. 375 | 376 | 377 | Theorem bin_nat_bin: forall (b: bin), 378 | nat_to_bin (bin_to_nat b) = normalize b. 379 | Proof. 380 | intros. 381 | induction b as [| b' | b'' IH]. 382 | - reflexivity. 383 | - simpl. 384 | rewrite <- plus_O_r. 385 | rewrite -> nat_twice_plus_one. 386 | rewrite -> IHb'. 387 | reflexivity. 388 | - simpl. 389 | rewrite <- plus_O_r. 390 | rewrite -> nat_twice. 391 | simpl. 392 | rewrite -> IH. 393 | rewrite -> normalize_idemp. 394 | reflexivity. 395 | Qed. -------------------------------------------------------------------------------- /Lists.v: -------------------------------------------------------------------------------- 1 | Require Export Induction. 2 | Module NatList. 3 | 4 | Inductive natprod : Type := 5 | | pair : nat -> nat -> natprod. 6 | 7 | Check (pair 3 5). 8 | 9 | Definition fst (p: natprod) : nat := 10 | match p with 11 | | pair x _ => x 12 | end. 13 | 14 | Definition snd (p: natprod) : nat := 15 | match p with 16 | | pair _ y => y 17 | end. 18 | 19 | Compute (fst (pair 3 5)). 20 | 21 | Notation "( x , y )" := (pair x y). 22 | 23 | Compute (snd (4, 7)). 24 | 25 | Definition swap_pair (p: natprod) : natprod := 26 | match p with 27 | | (x, y) => (y, x) 28 | end. 29 | 30 | Theorem surjective_pairing: forall p:natprod, 31 | p = (fst p, snd p). 32 | Proof. 33 | intros. 34 | destruct p as [n m]. 35 | simpl. reflexivity. 36 | Qed. 37 | 38 | Theorem snd_fst_is_swap : forall (p : natprod), 39 | (snd p, fst p) = swap_pair p. 40 | Proof. 41 | intros. 42 | destruct p as [n m]. 43 | simpl. reflexivity. 44 | Qed. 45 | 46 | Theorem fst_swap_is_snd : forall (p: natprod), 47 | fst (swap_pair p) = snd p. 48 | Proof. 49 | intros. 50 | destruct p as [n m]. 51 | simpl. reflexivity. 52 | Qed. 53 | 54 | Inductive natlist : Type := 55 | | nil : natlist 56 | | cons : nat -> natlist -> natlist. 57 | 58 | Definition mylist := cons 1 (cons 2 (cons 3 nil)). 59 | 60 | Notation "x :: l" := (cons x l) 61 | (at level 60, right associativity). 62 | Notation "[ ]" := nil. 63 | Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..). 64 | 65 | Fixpoint repeat (n count: nat) : natlist := 66 | match count with 67 | | O => nil 68 | | S count' => n :: repeat n count' 69 | end. 70 | 71 | Fixpoint length (l: natlist) : nat := 72 | match l with 73 | | [] => O 74 | | _ :: l' => S (length l') 75 | end. 76 | 77 | Fixpoint app (l1 l2: natlist) : natlist := 78 | match l1 with 79 | | nil => l2 80 | | x :: xs => x :: (app xs l2) 81 | end. 82 | 83 | Notation "x ++ y" := (app x y) 84 | (right associativity, at level 60). 85 | 86 | Example test_app1: [1;2;3] ++ [4;5] = [1;2;3;4;5]. 87 | Proof. reflexivity. Qed. 88 | Example test_app2: nil ++ [4;5] = [4;5]. 89 | Proof. reflexivity. Qed. 90 | Example test_app3: [1;2;3] ++ nil = [1;2;3]. 91 | Proof. reflexivity. Qed. 92 | 93 | Definition hd (def:nat) (l:natlist) : nat := 94 | match l with 95 | | nil => def 96 | | h :: _ => h 97 | end. 98 | 99 | Definition tl (l:natlist) : natlist := 100 | match l with 101 | | nil => nil 102 | | _ :: t => t 103 | end. 104 | 105 | Example test_hd1: hd 0 [1;2;3] = 1. 106 | Proof. reflexivity. Qed. 107 | Example test_hd2: hd 0 [] = 0. 108 | Proof. reflexivity. Qed. 109 | Example test_tl: tl [1;2;3] = [2;3]. 110 | Proof. reflexivity. Qed. 111 | 112 | Fixpoint nonzeros (l:natlist) : natlist := 113 | match l with 114 | | nil => nil 115 | | 0 :: t => nonzeros t 116 | | h :: t => h :: nonzeros t 117 | end. 118 | 119 | Example test_nonzeros: 120 | nonzeros [0;1;0;2;3;0;0] = [1;2;3]. 121 | Proof. simpl. reflexivity. Qed. 122 | 123 | Fixpoint oddmembers (l:natlist) : natlist := 124 | match l with 125 | | nil => nil 126 | | h :: t => if (evenb h) then oddmembers t 127 | else h :: oddmembers t 128 | end. 129 | 130 | Example test_oddmembers: 131 | oddmembers [0;1;0;2;3;0;0] = [1;3]. 132 | Proof. simpl. reflexivity. Qed. 133 | 134 | 135 | Definition countoddmembers (l:natlist) : nat := 136 | length (oddmembers l). 137 | 138 | Example test_countoddmembers1: 139 | countoddmembers [1;0;3;1;4;5] = 4. 140 | Proof. simpl. reflexivity. Qed. 141 | 142 | Example test_countoddmembers2: 143 | countoddmembers [0;2;4] = 0. 144 | Proof. simpl. reflexivity. Qed. 145 | 146 | Example test_countoddmembers3: 147 | countoddmembers nil = 0. 148 | Proof. simpl. reflexivity. Qed. 149 | 150 | Fixpoint alternate (l1 l2 : natlist) : natlist := 151 | match l1, l2 with 152 | | [], r2 => r2 153 | | r1, [] => r1 154 | | h1 :: t1, h2 :: t2 => h1 :: h2 :: (alternate t1 t2) 155 | end. 156 | 157 | Example test_alternate1: 158 | alternate [1;2;3] [4;5;6] = [1;4;2;5;3;6]. 159 | Proof. simpl. reflexivity. Qed. 160 | 161 | Example test_alternate2: 162 | alternate [1] [4;5;6] = [1;4;5;6]. 163 | Proof. simpl. reflexivity. Qed. 164 | 165 | Example test_alternate3: 166 | alternate [1;2;3] [4] = [1;4;2;3]. 167 | Proof. simpl. reflexivity. Qed. 168 | 169 | Example test_alternate4: 170 | alternate [] [20;30] = [20;30]. 171 | Proof. simpl. reflexivity. Qed. 172 | 173 | 174 | Definition bag := natlist. 175 | 176 | Fixpoint count (v:nat) (s:bag) : nat := 177 | match s with 178 | | [] => 0 179 | | h :: t => (if beq_nat h v then 1 else 0) + (count v t) 180 | end. 181 | 182 | Example test_count1: count 1 [1;2;3;1;4;1] = 3. 183 | Proof. simpl. reflexivity. Qed. 184 | 185 | Example test_count2: count 6 [1;2;3;1;4;1] = 0. 186 | Proof. simpl. reflexivity. Qed. 187 | 188 | Definition sum : bag -> bag -> bag := app. 189 | 190 | Example test_sum1: count 1 (sum [1;2;3] [1;4;1]) = 3. 191 | Proof. simpl. reflexivity. Qed. 192 | 193 | Definition add (v:nat) (s:bag) : bag := v :: s. 194 | 195 | Example test_add1: count 1 (add 1 [1;4;1]) = 3. 196 | Proof. simpl. reflexivity. Qed. 197 | 198 | Example test_add2: count 5 (add 1 [1;4;1]) = 0. 199 | Proof. simpl. reflexivity. Qed. 200 | 201 | Definition member (v:nat) (s:bag) : bool := 202 | blt_nat 0 (count v s). 203 | 204 | Example test_member1: member 1 [1;4;1] = true. 205 | Proof. simpl. reflexivity. Qed. 206 | 207 | Example test_member2: member 2 [1;4;1] = false. 208 | Proof. simpl. reflexivity. Qed. 209 | 210 | Fixpoint remove_one (v:nat) (s:bag) : bag := 211 | match s with 212 | | [] => [] 213 | | h :: t => if beq_nat v h then t else h :: remove_one v t 214 | end. 215 | 216 | Example test_remove_one1: 217 | count 5 (remove_one 5 [2;1;5;4;1]) = 0. 218 | Proof. simpl. reflexivity. Qed. 219 | 220 | Example test_remove_one2: 221 | count 5 (remove_one 5 [2;1;4;1]) = 0. 222 | Proof. simpl. reflexivity. Qed. 223 | 224 | Example test_remove_one3: 225 | count 4 (remove_one 5 [2;1;4;5;1;4]) = 2. 226 | Proof. simpl. reflexivity. Qed. 227 | 228 | Example test_remove_one4: 229 | count 5 (remove_one 5 [2;1;5;4;5;1;4]) = 1. 230 | Proof. simpl. reflexivity. Qed. 231 | 232 | Fixpoint remove_all (v:nat) (s:bag) : bag := 233 | match s with 234 | | [] => [] 235 | | h :: t => if beq_nat v h then remove_all v t else h :: remove_all v t 236 | end. 237 | 238 | Example test_remove_all1: count 5 (remove_all 5 [2;1;5;4;1]) = 0. 239 | Proof. simpl. reflexivity. Qed. 240 | 241 | Example test_remove_all2: count 5 (remove_all 5 [2;1;4;1]) = 0. 242 | Proof. simpl. reflexivity. Qed. 243 | 244 | Example test_remove_all3: count 4 (remove_all 5 [2;1;4;5;1;4]) = 2. 245 | Proof. simpl. reflexivity. Qed. 246 | 247 | Example test_remove_all4: count 5 (remove_all 5 [2;1;5;4;5;1;4;5;1;4]) = 0. 248 | Proof. simpl. reflexivity. Qed. 249 | 250 | Fixpoint subset (s1:bag) (s2:bag) : bool := 251 | match s1 with 252 | | [] => true 253 | | h :: t => (member h s2) && (subset t (remove_one h s2)) 254 | end. 255 | 256 | Example test_subset1: subset [1;2] [2;1;4;1] = true. 257 | Proof. simpl. reflexivity. Qed. 258 | 259 | Example test_subset2: subset [1;2;2] [2;1;4;1] = false. 260 | Proof. simpl. reflexivity. Qed. 261 | 262 | Theorem nil_app : forall l:natlist, 263 | [] ++ l = l. 264 | Proof. reflexivity. Qed. 265 | 266 | Theorem tl_length_pred : forall l:natlist, 267 | pred (length l) = length (tl l). 268 | Proof. 269 | intros. 270 | destruct l as [| n l']. 271 | - simpl. reflexivity. 272 | - simpl. reflexivity. 273 | Qed. 274 | 275 | Theorem app_assoc : forall l1 l2 l3 : natlist, 276 | (l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3). 277 | Proof. 278 | intros. 279 | induction l1 as [| h1 t1 IH1']. 280 | - simpl. reflexivity. 281 | - simpl. rewrite -> IH1'. reflexivity. 282 | Qed. 283 | 284 | Fixpoint rev (l:natlist) : natlist := 285 | match l with 286 | | [] => [] 287 | | h :: t => (rev t) ++ [h] 288 | end. 289 | 290 | Example test_rev1: rev [1;2;3] = [3;2;1]. 291 | Proof. reflexivity. Qed. 292 | Example test_rev2: rev nil = nil. 293 | Proof. reflexivity. Qed. 294 | 295 | Theorem app_length: forall l1 l2: natlist, 296 | length (l1 ++ l2) = (length l1) + (length l2). 297 | Proof. 298 | intros. 299 | induction l1 as [| n l1' IHl1']. 300 | - simpl. reflexivity. 301 | - simpl. rewrite -> IHl1'. reflexivity. 302 | Qed. 303 | 304 | Theorem rev_length: forall l:natlist, 305 | length (rev l) = length l. 306 | Proof. 307 | intros. 308 | induction l as [| h l' IHl']. 309 | - simpl. reflexivity. 310 | - simpl. 311 | rewrite -> app_length, plus_comm. 312 | rewrite -> IHl'. 313 | reflexivity. 314 | Qed. 315 | 316 | Theorem app_nil_r : forall l : natlist, 317 | l ++ [] = l. 318 | Proof. 319 | intros. 320 | induction l as [| h t IH]. 321 | - simpl. reflexivity. 322 | - simpl. rewrite -> IH. reflexivity. 323 | Qed. 324 | 325 | Theorem rev_app_distr: forall l1 l2 : natlist, 326 | rev (l1 ++ l2) = rev l2 ++ rev l1. 327 | Proof. 328 | intros. 329 | induction l1 as [| h1 t1 IH]. 330 | - simpl. destruct l2 as [| h2 t2]. 331 | + simpl. reflexivity. 332 | + simpl. rewrite -> app_nil_r. reflexivity. 333 | - simpl. destruct l2 as [| h2 t2]. 334 | + simpl. rewrite -> app_nil_r. reflexivity. 335 | + rewrite -> IH. simpl. rewrite -> app_assoc. reflexivity. 336 | Qed. 337 | 338 | 339 | Theorem rev_involutive : forall l : natlist, 340 | rev (rev l) = l. 341 | Proof. 342 | intros. 343 | induction l as [| h t IH]. 344 | - simpl. reflexivity. 345 | - simpl. rewrite -> rev_app_distr. 346 | simpl. rewrite -> IH. 347 | reflexivity. 348 | Qed. 349 | 350 | Theorem app_assoc4 : forall l1 l2 l3 l4 : natlist, 351 | l1 ++ (l2 ++ (l3 ++ l4)) = ((l1 ++ l2) ++ l3) ++ l4. 352 | Proof. 353 | intros. 354 | rewrite -> app_assoc. 355 | rewrite -> app_assoc. 356 | reflexivity. 357 | Qed. 358 | 359 | Lemma nonzeros_app : forall l1 l2 : natlist, 360 | nonzeros (l1 ++ l2) = (nonzeros l1) ++ (nonzeros l2). 361 | Proof. 362 | intros. 363 | induction l1 as [| h t IH]. 364 | - simpl. reflexivity. 365 | - simpl. 366 | destruct h as [| h']. 367 | + simpl. rewrite -> IH. reflexivity. 368 | + simpl. rewrite -> IH. reflexivity. 369 | Qed. 370 | 371 | 372 | Fixpoint beq_natlist (l1 l2 : natlist) : bool := 373 | match l1, l2 with 374 | | [], [] => true 375 | | [], _ => false 376 | | _, [] => true 377 | | h1 :: t1, h2 :: t2 => (beq_nat h1 h2) && (beq_natlist t1 t2) 378 | end. 379 | 380 | Example test_beq_natlist1 : 381 | (beq_natlist nil nil = true). 382 | Proof. reflexivity. Qed. 383 | 384 | Example test_beq_natlist2 : 385 | beq_natlist [1;2;3] [1;2;3] = true. 386 | Proof. reflexivity. Qed. 387 | 388 | Example test_beq_natlist3 : 389 | beq_natlist [1;2;3] [1;2;4] = false. 390 | Proof. reflexivity. Qed. 391 | 392 | Theorem beq_natlist_refl : forall l:natlist, 393 | true = beq_natlist l l. 394 | Proof. 395 | intros. 396 | induction l as [| h t IH]. 397 | - simpl. reflexivity. 398 | - simpl. induction h as [| h' IH']. 399 | + simpl. rewrite <- IH. reflexivity. 400 | + simpl. rewrite <- IH'. reflexivity. 401 | Qed. 402 | 403 | Theorem count_member_nonzero : forall (s : bag), 404 | leb 1 (count 1 (1 :: s)) = true. 405 | Proof. 406 | intros. 407 | destruct s as [| h t]. 408 | - simpl. reflexivity. 409 | - simpl. reflexivity. 410 | Qed. 411 | 412 | 413 | Theorem leb_n_Sn : forall n, 414 | leb n (S n) = true. 415 | Proof. 416 | intros. 417 | induction n as [| n' IH]. 418 | - reflexivity. 419 | - simpl. rewrite -> IH. reflexivity. 420 | Qed. 421 | 422 | Theorem remove_decreases_count: forall (s : bag), 423 | leb (count 0 (remove_one 0 s)) (count 0 s) = true. 424 | Proof. 425 | intros. 426 | induction s as [| h t IH]. 427 | - simpl. reflexivity. 428 | - destruct h as [| h']. 429 | + simpl. rewrite -> leb_n_Sn. reflexivity. 430 | + simpl. rewrite -> IH. reflexivity. 431 | Qed. 432 | 433 | Theorem bag_count_sum: forall (s1 s2:bag), 434 | count 0 (sum s1 s2) = (count 0 s1) + (count 0 s2). 435 | Proof. 436 | intros. 437 | induction s1 as [| h1 t1 IH]. 438 | - simpl. reflexivity. 439 | - destruct h1 as [| h1']. 440 | + simpl. rewrite -> IH. reflexivity. 441 | + simpl. rewrite -> IH. reflexivity. 442 | Qed. 443 | 444 | 445 | Theorem rev_injective: forall (l1 l2 : natlist), 446 | rev l1 = rev l2 -> l1 = l2. 447 | Proof. 448 | intros. 449 | rewrite <- rev_involutive. 450 | rewrite <- H. 451 | rewrite -> rev_involutive. 452 | reflexivity. 453 | Qed. 454 | 455 | 456 | 457 | Inductive natoption : Type := 458 | | Some : nat -> natoption 459 | | None : natoption. 460 | 461 | Fixpoint nth_error (l:natlist) (n:nat) : natoption := 462 | match l with 463 | | [] => None 464 | | x :: l' => match n with 465 | | O => Some x 466 | | S n' => nth_error l' n' 467 | end 468 | end. 469 | 470 | Example test_nth_error1 : nth_error [4;5;6;7] 0 = Some 4. 471 | Proof. reflexivity. Qed. 472 | Example test_nth_error2 : nth_error [4;5;6;7] 3 = Some 7. 473 | Proof. reflexivity. Qed. 474 | Example test_nth_error3 : nth_error [4;5;6;7] 9 = None. 475 | Proof. reflexivity. Qed. 476 | 477 | 478 | Definition option_elim (def : nat) (o : natoption) : nat := 479 | match o with 480 | | None => def 481 | | Some x => x 482 | end. 483 | 484 | Definition hd_error (l : natlist) : natoption := 485 | match l with 486 | | [] => None 487 | | h :: _ => Some h 488 | end. 489 | 490 | Example test_hd_error1 : hd_error [] = None. 491 | Proof. reflexivity. Qed. 492 | 493 | Example test_hd_error2 : hd_error [1] = Some 1. 494 | Proof. reflexivity. Qed. 495 | 496 | Example test_hd_error3 : hd_error [5;6] = Some 5. 497 | Proof. reflexivity. Qed. 498 | 499 | Theorem option_elim_hd : forall (l:natlist) (default:nat), 500 | hd default l = option_elim default (hd_error l). 501 | Proof. 502 | intros. 503 | destruct l. 504 | - reflexivity. 505 | - reflexivity. 506 | Qed. 507 | 508 | End NatList. 509 | 510 | Inductive id : Type := 511 | | Id : nat -> id. 512 | 513 | Definition beq_id (i j: id) := 514 | match i, j with 515 | | Id x, Id y => beq_nat x y 516 | end. 517 | 518 | Theorem beq_id_refl : forall x, true = beq_id x x. 519 | Proof. 520 | intros. 521 | destruct x as [x']. 522 | simpl. rewrite <- beq_nat_refl. 523 | reflexivity. 524 | Qed. 525 | 526 | Module PartialMap. 527 | Export NatList. 528 | 529 | Inductive partial_map : Type := 530 | | empty : partial_map 531 | | record : id -> nat -> partial_map -> partial_map. 532 | 533 | Definition update (d:partial_map) (x:id) (val:nat) := 534 | record x val d. 535 | 536 | Fixpoint find (x:id) (d:partial_map) : natoption := 537 | match d with 538 | | empty => None 539 | | record k v d' => if beq_id x k then Some v 540 | else find x d' 541 | end. 542 | 543 | Theorem update_eq : 544 | forall (d : partial_map) (x : id) (v: nat), 545 | find x (update d x v) = Some v. 546 | Proof. 547 | intros. 548 | simpl. rewrite <- beq_id_refl. reflexivity. 549 | Qed. 550 | 551 | 552 | Theorem update_neq : 553 | forall (d : partial_map) (x y : id) (o: nat), 554 | beq_id x y = false -> find x (update d y o) = find x d. 555 | Proof. 556 | intros. 557 | simpl. rewrite -> H. reflexivity. 558 | Qed. 559 | 560 | End PartialMap. 561 | 562 | -------------------------------------------------------------------------------- /Logic.v: -------------------------------------------------------------------------------- 1 | Require Export Tactics. 2 | 3 | Check (3 = 3). 4 | Check forall n m : nat, n + m = m + n. 5 | 6 | Check forall n : nat, n = 2. 7 | Check 3 = 5. 8 | 9 | Definition plus_fact : Prop := 2 + 2 = 4. 10 | Check plus_fact. 11 | 12 | Theorem plus_fact_is_true : 13 | plus_fact. 14 | Proof. reflexivity. Qed. 15 | 16 | Definition is_three (n : nat) : Prop := 17 | n = 3. 18 | Check is_three. 19 | 20 | Definition injective {A B} (f : A -> B) := 21 | forall x y : A, f x = f y -> x = y. 22 | 23 | Lemma succ_injective: injective S. 24 | Proof. 25 | intros n m H. inversion H. reflexivity. 26 | Qed. 27 | 28 | Check @eq. 29 | 30 | 31 | Example and_example : 3 + 4 = 7 /\ 2 * 2 = 4. 32 | Proof. 33 | split. 34 | - reflexivity. 35 | - reflexivity. 36 | Qed. 37 | 38 | Lemma and_intro: forall A B: Prop, 39 | A -> B -> (A /\ B). 40 | Proof. 41 | intros. 42 | split. 43 | - apply H. 44 | - apply H0. 45 | Qed. 46 | 47 | Example and_example' : 3 + 4 = 7 /\ 2 * 2 = 4. 48 | Proof. 49 | apply and_intro. 50 | - reflexivity. 51 | - reflexivity. 52 | Qed. 53 | 54 | Example and_exercise : 55 | forall n m : nat, n + m = 0 -> n = 0 /\ m = 0. 56 | Proof. 57 | intros. 58 | split. 59 | - destruct n as [| n']. 60 | + reflexivity. 61 | + inversion H. 62 | - destruct m as [| m']. 63 | + reflexivity. 64 | + rewrite -> plus_comm in H. 65 | inversion H. 66 | Qed. 67 | 68 | Lemma and_example2 : 69 | forall n m : nat, n = 0 /\ m = 0 -> n + m = 0. 70 | Proof. 71 | intros. 72 | destruct H as [Hn Hm]. 73 | rewrite -> Hn. 74 | rewrite -> Hm. 75 | reflexivity. 76 | Qed. 77 | 78 | Lemma proj1: forall P Q: Prop, 79 | P /\ Q -> P. 80 | Proof. 81 | intros. 82 | destruct H as [L R]. 83 | apply L. 84 | Qed. 85 | 86 | Lemma and_example3 : 87 | forall n m : nat, n + m = 0 -> n * m = 0. 88 | Proof. 89 | intros. 90 | assert (J: n = 0 /\ m = 0). 91 | { apply and_exercise. apply H. } 92 | destruct J as [L R]. 93 | rewrite -> L. 94 | rewrite -> R. 95 | reflexivity. 96 | Qed. 97 | 98 | Lemma proj2 : forall P Q : Prop, 99 | P /\ Q -> Q. 100 | Proof. 101 | intros. 102 | destruct H as [L R]. 103 | apply R. 104 | Qed. 105 | 106 | Theorem and_commut : forall P Q : Prop, 107 | P /\ Q -> Q /\ P. 108 | Proof. 109 | intros. 110 | destruct H as [L R]. 111 | split. 112 | - apply R. 113 | - apply L. 114 | Qed. 115 | 116 | Theorem and_assoc : forall P Q R : Prop, 117 | P /\ (Q /\ R) -> (P /\ Q) /\ R. 118 | Proof. 119 | intros. 120 | destruct H as [Hl [Hm Hr]]. 121 | split. 122 | - split. 123 | + apply Hl. 124 | + apply Hm. 125 | - apply Hr. 126 | Qed. 127 | 128 | Check and. 129 | 130 | Lemma or_example : 131 | forall n m : nat, n = 0 \/ m = 0 -> n * m = 0. 132 | Proof. 133 | intros. 134 | destruct H as [Hl | Hr]. 135 | - rewrite -> Hl. 136 | reflexivity. 137 | - rewrite -> Hr. 138 | rewrite -> mult_O_r. 139 | reflexivity. 140 | Qed. 141 | 142 | Lemma or_intro : forall A B : Prop, A -> A \/ B. 143 | Proof. 144 | intros. 145 | left. 146 | apply H. 147 | Qed. 148 | 149 | Lemma zero_or_succ : 150 | forall n : nat, n = 0 \/ n = S (pred n). 151 | Proof. 152 | intros. 153 | destruct n as [| n']. 154 | - left. reflexivity. 155 | - right. reflexivity. 156 | Qed. 157 | 158 | 159 | Lemma mult_eq_0 : 160 | forall n m, n * m = 0 -> n = 0 \/ m = 0. 161 | Proof. 162 | intros. 163 | destruct n as [| n']. 164 | - left. reflexivity. 165 | - destruct m as [| m']. 166 | + right. reflexivity. 167 | + inversion H. 168 | Qed. 169 | 170 | Theorem or_commut : forall P Q : Prop, 171 | P \/ Q -> Q \/ P. 172 | Proof. 173 | intros. 174 | destruct H as [Hl | Hr]. 175 | - right. apply Hl. 176 | - left. apply Hr. 177 | Qed. 178 | 179 | Module MyNot. 180 | 181 | Definition not (P:Prop) := P -> False. 182 | 183 | Notation "~ x" := (not x) : type_scope. 184 | 185 | Check not. 186 | 187 | End MyNot. 188 | 189 | 190 | Theorem ex_falso_quodlibet : forall (P:Prop), 191 | False -> P. 192 | Proof. 193 | intros. 194 | destruct H. 195 | Qed. 196 | 197 | Fact not_implies_our_not : forall (P:Prop), 198 | ~P -> (forall (Q:Prop), P -> Q). 199 | Proof. 200 | intros. 201 | destruct H. 202 | apply H0. 203 | Qed. 204 | 205 | Theorem zero_not_one : ~(0 = 1). 206 | Proof. 207 | intros H. inversion H. 208 | Qed. 209 | 210 | Check (0 <> 1). 211 | 212 | Theorem zero_not_one': 0 <> 1. 213 | Proof. 214 | intros H. inversion H. 215 | Qed. 216 | 217 | Theorem not_False : 218 | ~ False. 219 | Proof. 220 | unfold not. 221 | intros. 222 | destruct H. 223 | Qed. 224 | 225 | Theorem contradiction_implies_anything : forall P Q : Prop, 226 | (P /\ ~P) -> Q. 227 | Proof. 228 | intros. 229 | unfold not in H. 230 | destruct H as [Hr Hl]. 231 | destruct Hl. 232 | apply Hr. 233 | Qed. 234 | 235 | Theorem double_neg : forall P : Prop, 236 | P -> ~~P. 237 | Proof. 238 | intros. 239 | unfold not. 240 | intros. 241 | apply H0. 242 | apply H. 243 | Qed. 244 | 245 | Theorem contrapositive : forall P Q : Prop, 246 | (P -> Q) -> (~Q -> ~P). 247 | Proof. 248 | intros. 249 | unfold not. 250 | unfold not in H0. 251 | intros. 252 | apply H0 in H. 253 | apply H. 254 | apply H1. 255 | Qed. 256 | 257 | Theorem not_both_true_and_false : forall P : Prop, 258 | ~ (P /\ ~P). 259 | Proof. 260 | intros. 261 | unfold not. 262 | intros. 263 | destruct H as [Hl Hr]. 264 | apply Hr in Hl. 265 | apply Hl. 266 | Qed. 267 | 268 | 269 | Theorem not_true_is_false : forall b : bool, 270 | b <> true -> b = false. 271 | Proof. 272 | intros. 273 | destruct b. 274 | - unfold not in H. 275 | exfalso. 276 | apply H. 277 | reflexivity. 278 | - reflexivity. 279 | Qed. 280 | 281 | 282 | Lemma True_is_true : True. 283 | Proof. apply I. Qed. 284 | 285 | 286 | Module MyIff. 287 | 288 | Definition iff (P Q : Prop) := (P -> Q) /\ (Q -> P). 289 | 290 | Notation "P <-> Q" := (iff P Q) 291 | (at level 95, no associativity) 292 | : type_scope. 293 | 294 | End MyIff. 295 | 296 | Theorem iff_sym : forall P Q : Prop, 297 | (P <-> Q) -> (Q <-> P). 298 | Proof. 299 | intros. 300 | destruct H as [Hl Hr]. 301 | split. 302 | - apply Hr. 303 | - apply Hl. 304 | Qed. 305 | 306 | Lemma not_true_iff_false : forall b, 307 | b <> true <-> b = false. 308 | Proof. 309 | intros. 310 | split. 311 | - apply not_true_is_false. 312 | - intros. 313 | rewrite -> H. 314 | unfold not. 315 | intros. 316 | inversion H0. 317 | Qed. 318 | 319 | Theorem iff_refl : forall P : Prop, 320 | P <-> P. 321 | Proof. 322 | intros. 323 | split. 324 | - intros. apply H. 325 | - intros. apply H. 326 | Qed. 327 | 328 | Theorem iff_trans : forall P Q R : Prop, 329 | (P <-> Q) -> (Q <-> R) -> (P <-> R). 330 | Proof. 331 | intros. 332 | destruct H as [Hpq Hqp]. 333 | destruct H0 as [Hqr Hrq]. 334 | split. 335 | - intros. 336 | apply Hqr. 337 | apply Hpq. 338 | apply H. 339 | - intros. 340 | apply Hqp. 341 | apply Hrq. 342 | apply H. 343 | Qed. 344 | 345 | Theorem or_distributes_over_and : forall P Q R : Prop, 346 | P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R). 347 | Proof. 348 | intros. 349 | split. 350 | - intros. 351 | split. 352 | + destruct H. 353 | * left. apply H. 354 | * destruct H. 355 | right. 356 | apply H. 357 | + destruct H. 358 | * left. apply H. 359 | * destruct H. 360 | right. 361 | apply H0. 362 | - intros. 363 | destruct H. 364 | destruct H. 365 | + left. apply H. 366 | + destruct H0. 367 | * left. 368 | apply H0. 369 | * right. 370 | split. 371 | apply H. 372 | apply H0. 373 | Qed. 374 | 375 | Require Import Coq.Setoids.Setoid. 376 | 377 | Lemma mult_0 : forall n m, n * m = 0 <-> n = 0 \/ m = 0. 378 | Proof. 379 | intros. 380 | split. 381 | - apply mult_eq_0. 382 | - apply or_example. 383 | Qed. 384 | 385 | Lemma or_assoc : 386 | forall P Q R : Prop, P \/ (Q \/ R) <-> (P \/ Q) \/ R. 387 | Proof. 388 | intros. 389 | split. 390 | - intros. 391 | destruct H. 392 | + left. left. apply H. 393 | + destruct H. 394 | * left. right. apply H. 395 | * right. apply H. 396 | - intros. 397 | destruct H. 398 | + destruct H. 399 | * left. apply H. 400 | * right. left. apply H. 401 | + right. right. apply H. 402 | Qed. 403 | 404 | 405 | Lemma mult_0_3 : 406 | forall n m p, n * m * p = 0 <-> n = 0 \/ m = 0 \/ p = 0. 407 | Proof. 408 | intros. 409 | rewrite -> mult_0. 410 | rewrite -> mult_0. 411 | rewrite -> or_assoc. 412 | reflexivity. 413 | Qed. 414 | 415 | 416 | Lemma apply_iff_example : 417 | forall n m : nat, n * m = 0 -> n = 0 \/ m = 0. 418 | Proof. 419 | intros. 420 | apply mult_0. 421 | apply H. 422 | Qed. 423 | 424 | 425 | Lemma four_is_even : exists n : nat, 4 = n + n. 426 | Proof. 427 | exists 2. reflexivity. 428 | Qed. 429 | 430 | Theorem exists_example_2 : forall n, 431 | (exists m, n = 4 + m) -> 432 | (exists o, n = 2 + o). 433 | Proof. 434 | intros. 435 | destruct H as [m Hm]. 436 | exists (2 + m). 437 | apply Hm. 438 | Qed. 439 | 440 | Theorem dist_not_exists : forall (X:Type) (P : X -> Prop), 441 | (forall x, P x) -> ~ (exists x, ~ P x). 442 | Proof. 443 | intros. 444 | unfold not. 445 | intros. 446 | destruct H0. 447 | apply H0. 448 | apply H. 449 | Qed. 450 | 451 | Theorem dist_exists_or : forall (X:Type) (P Q : X -> Prop), 452 | (exists x, P x \/ Q x) <-> (exists x, P x) \/ (exists x, Q x). 453 | Proof. 454 | intros. 455 | split. 456 | - intros. 457 | destruct H as [x Hx]. 458 | destruct Hx. 459 | + left. exists x. apply H. 460 | + right. exists x. apply H. 461 | - intros. 462 | destruct H. 463 | + destruct H as [x Hx]. 464 | exists x. 465 | left. 466 | apply Hx. 467 | + destruct H as [x Hx]. 468 | exists x. 469 | right. 470 | apply Hx. 471 | Qed. 472 | 473 | Fixpoint In {A : Type} (x : A) (l : list A) : Prop := 474 | match l with 475 | | [] => False 476 | | h :: t => x = h \/ In x t 477 | end. 478 | 479 | Example In_example_1 : In 4 [1; 2; 3; 4; 5]. 480 | Proof. 481 | simpl. 482 | right. right. right. left. 483 | reflexivity. 484 | Qed. 485 | 486 | Example In_example_2 : 487 | forall n, In n [2; 4] -> 488 | exists n', n = 2 * n'. 489 | Proof. 490 | simpl. 491 | intros. 492 | destruct H as [H' | [H' | []]]. 493 | - exists 1. 494 | rewrite -> H'. 495 | reflexivity. 496 | - exists 2. 497 | rewrite -> H'. 498 | reflexivity. 499 | Qed. 500 | 501 | Lemma In_map : 502 | forall (A B : Type) (f : A -> B) (l : list A) (x : A), 503 | In x l -> 504 | In (f x) (map f l). 505 | Proof. 506 | intros. 507 | generalize dependent H. 508 | induction l as [| h t IH]. 509 | - intros. 510 | simpl in H. 511 | destruct H. 512 | - intros. 513 | simpl in H. 514 | destruct H as [Hl | Hr]. 515 | + rewrite -> Hl. 516 | simpl. 517 | left. 518 | reflexivity. 519 | + simpl. 520 | right. 521 | apply IH. 522 | apply Hr. 523 | Qed. 524 | 525 | Lemma In_map_iff : 526 | forall (A B : Type) (f : A -> B) (l : list A) (y : B), 527 | In y (map f l) <-> 528 | exists x, f x = y /\ In x l. 529 | Proof. 530 | intros. 531 | split. 532 | - induction l as [| h t IH]. 533 | + intros. simpl in H. destruct H. 534 | + intros. 535 | simpl. 536 | destruct H. 537 | * exists h. 538 | split. 539 | rewrite -> H. reflexivity. 540 | left. reflexivity. 541 | * apply IH in H. 542 | destruct H. 543 | exists x. 544 | destruct H. 545 | split. 546 | apply H. 547 | right. apply H0. 548 | - induction l as [| h t IH]. 549 | + intros. 550 | simpl. 551 | destruct H. 552 | destruct H. 553 | destruct H0. 554 | + simpl. 555 | intros. 556 | destruct H. 557 | destruct H. 558 | destruct H0. 559 | * rewrite -> H0 in H. 560 | left. 561 | rewrite -> H. 562 | reflexivity. 563 | * simpl. 564 | right. 565 | apply IH. 566 | exists x. 567 | split. 568 | apply H. 569 | apply H0. 570 | Qed. 571 | 572 | Lemma in_app_iff : forall A l l' (a:A), 573 | In a (l++l') <-> In a l \/ In a l'. 574 | Proof. 575 | intros. 576 | split. 577 | - induction l as [| h t IH]. 578 | + simpl. intros. right. apply H. 579 | + simpl. intros. 580 | apply or_assoc. 581 | destruct H. 582 | * left. apply H. 583 | * right. apply IH. apply H. 584 | - induction l as [| h t IH]. 585 | + simpl. intros. destruct H. 586 | destruct H. 587 | apply H. 588 | + simpl. intros. destruct H. destruct H. 589 | left. apply H. 590 | right. apply IH. left. apply H. 591 | right. apply IH. right. apply H. 592 | Qed. 593 | 594 | Fixpoint All {T : Type} (P : T -> Prop) (l : list T) : Prop := 595 | match l with 596 | | [] => True 597 | | h :: t => P h /\ All P t 598 | end. 599 | 600 | Lemma All_In : 601 | forall T (P : T -> Prop) (l : list T), 602 | (forall x, In x l -> P x) <-> 603 | All P l. 604 | Proof. 605 | intros. 606 | split. 607 | - induction l as [| h t IH]. 608 | + simpl. intros. reflexivity. 609 | + simpl. intros. 610 | split. 611 | * apply H. left. reflexivity. 612 | * apply IH. intros. 613 | apply H. right. apply H0. 614 | - induction l as [| h t IH]. 615 | + simpl. intros. destruct H0. 616 | + simpl. intros. 617 | destruct H. 618 | destruct H0. 619 | * rewrite -> H0. apply H. 620 | * apply IH. 621 | apply H1. 622 | apply H0. 623 | Qed. 624 | 625 | Definition combine_odd_even (Podd Peven : nat -> Prop) : nat -> Prop := 626 | fun (x:nat) => if oddb x then Podd x 627 | else Peven x. 628 | 629 | Theorem combine_odd_even_intro : 630 | forall (Podd Peven : nat -> Prop) (n : nat), 631 | (oddb n = true -> Podd n) -> 632 | (oddb n = false -> Peven n) -> 633 | combine_odd_even Podd Peven n. 634 | Proof. 635 | intros. 636 | unfold combine_odd_even. 637 | destruct (oddb n). 638 | - apply H. reflexivity. 639 | - apply H0. reflexivity. 640 | Qed. 641 | 642 | Theorem combine_odd_even_elim_odd : 643 | forall (Podd Peven : nat -> Prop) (n : nat), 644 | combine_odd_even Podd Peven n -> 645 | oddb n = true -> 646 | Podd n. 647 | Proof. 648 | intros. 649 | unfold combine_odd_even in H. 650 | rewrite -> H0 in H. 651 | apply H. 652 | Qed. 653 | 654 | Theorem combine_odd_even_elim_even : 655 | forall (Podd Peven : nat -> Prop) (n : nat), 656 | combine_odd_even Podd Peven n -> 657 | oddb n = false -> 658 | Peven n. 659 | Proof. 660 | intros. 661 | unfold combine_odd_even in H. 662 | rewrite -> H0 in H. 663 | apply H. 664 | Qed. 665 | 666 | Check plus_comm. 667 | 668 | Lemma plus_comm3 : 669 | forall n m p, n + (m + p) = (p + m) + n. 670 | Proof. 671 | intros. 672 | rewrite -> plus_comm. 673 | rewrite -> (plus_comm m). 674 | reflexivity. 675 | Qed. 676 | 677 | Example lemma_application_ex : 678 | forall {n : nat} {ns : list nat}, 679 | In n (map (fun m => m * 0) ns) -> 680 | n = 0. 681 | Proof. 682 | intros. 683 | rewrite (In_map_iff _ _ _ _ _) in H. 684 | destruct H. 685 | apply proj1 in H. 686 | rewrite -> mult_O_r in H. 687 | rewrite -> H. 688 | reflexivity. 689 | Qed. 690 | 691 | 692 | Example function_equality_ex1 : plus 3 = plus (pred 4). 693 | Proof. reflexivity. Qed. 694 | 695 | Axiom functional_extensionality : forall {X Y: Type} {f g: X -> Y}, 696 | (forall (x: X), f x = g x) -> f = g. 697 | 698 | Example function_equality_ex2 : 699 | (fun x => plus x 1) = (fun x => plus 1 x). 700 | Proof. 701 | apply functional_extensionality. 702 | intros. 703 | apply plus_comm. 704 | Qed. 705 | 706 | Print Assumptions function_equality_ex2. 707 | 708 | Fixpoint rev_append {X} (l1 l2: list X) : list X := 709 | match l1 with 710 | | [] => l2 711 | | h :: t => rev_append t (h :: l2) 712 | end. 713 | 714 | Definition tr_rev {X} (l : list X) : list X := 715 | rev_append l []. 716 | 717 | 718 | Lemma rev_append_correct : 719 | forall (X: Type) (l1 l2: list X), 720 | rev_append l1 l2 = rev l1 ++ l2. 721 | Proof. 722 | intros. 723 | generalize dependent l2. 724 | induction l1 as [| h1 t1 IH1]. 725 | - intros. 726 | reflexivity. 727 | - intros. 728 | simpl. 729 | rewrite -> IH1. 730 | rewrite <- app_assoc. 731 | simpl. 732 | reflexivity. 733 | Qed. 734 | 735 | Lemma tr_rev_correct : forall X, @tr_rev X = @rev X. 736 | Proof. 737 | intros. 738 | apply functional_extensionality. 739 | intros. 740 | unfold tr_rev. 741 | rewrite -> rev_append_correct. 742 | apply app_nil_r. 743 | Qed. 744 | 745 | 746 | Theorem evenb_double : forall k, evenb (double k) = true. 747 | Proof. 748 | intros. 749 | induction k as [| k' IH]. 750 | - reflexivity. 751 | - simpl. apply IH. 752 | Qed. 753 | 754 | Theorem evenb_double_conv : forall n, 755 | exists k, n = if evenb n then double k 756 | else S (double k). 757 | Proof. 758 | intros. 759 | induction n as [| n' IH]. 760 | - exists 0. reflexivity. 761 | - rewrite -> evenb_S. 762 | destruct (evenb n'). 763 | + simpl. 764 | destruct IH. 765 | exists x. rewrite -> H. reflexivity. 766 | + simpl. 767 | destruct IH. 768 | exists (S x). rewrite -> H. 769 | reflexivity. 770 | Qed. 771 | 772 | Theorem even_bool_prop : forall n, 773 | evenb n = true <-> exists k, n = double k. 774 | Proof. 775 | intros. 776 | split. 777 | - intros. 778 | destruct (evenb_double_conv n). 779 | rewrite -> H in H0. 780 | exists x. 781 | apply H0. 782 | - intros. 783 | destruct H. 784 | rewrite -> H. 785 | apply evenb_double. 786 | Qed. 787 | 788 | Theorem beq_nat_true_iff : forall n1 n2 : nat, 789 | beq_nat n1 n2 = true <-> n1 = n2. 790 | Proof. 791 | intros. 792 | split. 793 | - intros. 794 | apply beq_nat_true in H. 795 | apply H. 796 | - intros. 797 | rewrite -> H. 798 | rewrite <- beq_nat_refl. 799 | reflexivity. 800 | Qed. 801 | 802 | Lemma andb_true_l: forall (a: bool), 803 | true && a = a. 804 | Proof. 805 | intros. 806 | destruct a. 807 | - reflexivity. 808 | - reflexivity. 809 | Qed. 810 | 811 | Lemma andb_true_iff : forall b1 b2:bool, 812 | b1 && b2 = true <-> b1 = true /\ b2 = true. 813 | Proof. 814 | intros. 815 | split. 816 | - intros. 817 | split. 818 | + destruct b2. 819 | * rewrite -> andb_true_r in H. 820 | apply H. 821 | * destruct b1. 822 | reflexivity. 823 | destruct H. reflexivity. 824 | + destruct b1. 825 | * rewrite -> andb_true_l in H. 826 | apply H. 827 | * inversion H. 828 | - intros. 829 | destruct H. 830 | rewrite -> H. 831 | rewrite -> H0. 832 | reflexivity. 833 | Qed. 834 | 835 | Lemma orb_true_iff : forall b1 b2, 836 | b1 || b2 = true <-> b1 = true \/ b2 = true. 837 | Proof. 838 | intros. 839 | split. 840 | - intros. 841 | destruct b1. 842 | + left. reflexivity. 843 | + destruct b2. 844 | * right. reflexivity. 845 | * simpl in H. inversion H. 846 | - intros. 847 | destruct H. 848 | + rewrite -> H. reflexivity. 849 | + rewrite -> H. 850 | destruct b1. 851 | * reflexivity. 852 | * reflexivity. 853 | Qed. 854 | 855 | Theorem beq_nat_false_iff : forall x y : nat, 856 | beq_nat x y = false <-> x <> y. 857 | Proof. 858 | intros. 859 | split. 860 | - unfold not. 861 | intros. 862 | rewrite -> H0 in H. 863 | rewrite <- beq_nat_refl in H. 864 | inversion H. 865 | - unfold not. 866 | intros. 867 | destruct (beq_nat x y) eqn:beqnatxy. 868 | + exfalso. apply H. apply beq_nat_true_iff in beqnatxy. 869 | apply beqnatxy. 870 | + reflexivity. 871 | Qed. 872 | 873 | Fixpoint beq_list {A : Type} (beq : A -> A -> bool) 874 | (l1 l2 : list A) : bool := 875 | match l1 with 876 | | [] => match l2 with 877 | | [] => true 878 | | _ => false 879 | end 880 | | h1 :: t1 => match l2 with 881 | | [] => false 882 | | h2 :: t2 => (beq h1 h2) && (beq_list beq t1 t2) 883 | end 884 | end. 885 | 886 | Lemma beq_list_true_iff : 887 | forall A (beq : A -> A -> bool), 888 | (forall a1 a2, beq a1 a2 = true <-> a1 = a2) -> 889 | forall l1 l2, beq_list beq l1 l2 = true <-> l1 = l2. 890 | Proof. 891 | intros. 892 | split. 893 | - intros. 894 | generalize dependent l2. 895 | induction l1 as [| h1 t1 IH1]. 896 | + intros. 897 | destruct l2 as [| h2 t2]. 898 | * reflexivity. 899 | * inversion H0. 900 | + intros. 901 | destruct l2 as [| h2 t2]. 902 | * inversion H0. 903 | * simpl in H0. 904 | apply andb_true_iff in H0. 905 | destruct H0. 906 | apply H in H0. 907 | apply IH1 in H1. 908 | rewrite -> H0. 909 | rewrite -> H1. 910 | reflexivity. 911 | - intros. 912 | generalize dependent l2. 913 | induction l1 as [| h t IH]. 914 | + intros. 915 | rewrite <- H0. 916 | reflexivity. 917 | + intros. 918 | rewrite <- H0. 919 | simpl. 920 | apply andb_true_iff. 921 | split. 922 | * apply H. 923 | reflexivity. 924 | * apply IH. 925 | reflexivity. 926 | Qed. 927 | 928 | Lemma forallb_test_elements: 929 | forall X test (h: X) (t: list X), 930 | forallb test (h :: t) = true -> 931 | ((test h = true) /\ (forallb test t = true)). 932 | Proof. 933 | intros. 934 | inversion H. 935 | apply andb_true_iff in H1. 936 | destruct H1. 937 | rewrite -> H0. 938 | rewrite -> H1. 939 | split. 940 | - reflexivity. 941 | - reflexivity. 942 | Qed. 943 | 944 | Theorem forallb_true_iff : forall X test (l : list X), 945 | forallb test l = true <-> All (fun x => test x = true) l. 946 | Proof. 947 | intros. 948 | split. 949 | - induction l as [| h t IH]. 950 | + reflexivity. 951 | + intros. 952 | simpl. 953 | apply forallb_test_elements in H. 954 | destruct H. 955 | split. 956 | * apply H. 957 | * apply IH. 958 | apply H0. 959 | - induction l as [| h t IH]. 960 | + reflexivity. 961 | + intros. 962 | simpl. 963 | destruct H. 964 | rewrite -> H. 965 | rewrite -> andb_true_l. 966 | apply IH. 967 | apply H0. 968 | Qed. 969 | 970 | Definition excluded_middle := forall P : Prop, 971 | P \/ ~ P. 972 | 973 | Theorem restricted_excluded_middle : forall P b, 974 | (P <-> b = true) -> P \/ ~ P. 975 | Proof. 976 | intros. 977 | destruct b. 978 | - left. apply H. reflexivity. 979 | - right. 980 | rewrite -> H. 981 | unfold not. 982 | intros. 983 | inversion H0. 984 | Qed. 985 | 986 | 987 | Theorem restricted_excluded_middle_eq : forall(n m : nat), 988 | n = m \/ n <> m. 989 | Proof. 990 | intros. 991 | apply (restricted_excluded_middle (n = m) (beq_nat n m)). 992 | symmetry. 993 | apply beq_nat_true_iff. 994 | Qed. 995 | 996 | Theorem excluded_middle_irrefutable: forall (P:Prop), 997 | ~ ~ (P \/ ~ P). 998 | Proof. 999 | unfold not. 1000 | intros. 1001 | apply H. 1002 | right. 1003 | intros. 1004 | apply H. 1005 | left. 1006 | apply H0. 1007 | Qed. 1008 | 1009 | Theorem not_exists_dist : 1010 | excluded_middle -> 1011 | forall (X:Type) (P : X -> Prop), 1012 | ~ (exists x, ~ P x) -> (forall x, P x). 1013 | Proof. 1014 | unfold excluded_middle. 1015 | intros. 1016 | assert (P x \/ ~ P x). 1017 | - apply H. 1018 | - destruct H1. 1019 | + apply H1. 1020 | + exfalso. 1021 | apply H0. 1022 | exists x. 1023 | apply H1. 1024 | Qed. 1025 | 1026 | Definition peirce := forall P Q: Prop, 1027 | ((P->Q)->P)->P. 1028 | 1029 | Definition double_negation_elimination := forall P:Prop, 1030 | ~~P -> P. 1031 | 1032 | Definition de_morgan_not_and_not := forall P Q:Prop, 1033 | ~(~P /\ ~Q) -> P\/Q. 1034 | 1035 | Definition implies_to_or := forall P Q:Prop, 1036 | (P->Q) -> (~P\/Q). 1037 | -------------------------------------------------------------------------------- /Maps.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.Arith.Arith. 2 | Require Import Coq.Bool.Bool. 3 | Require Import Coq.Strings.String. 4 | Require Import Coq.Logic.FunctionalExtensionality. 5 | 6 | 7 | Inductive id : Type := 8 | | Id: string -> id. 9 | 10 | Definition beq_id (a b: id) : bool := 11 | match a, b with 12 | | Id a', Id b' => if string_dec a' b' then true else false 13 | end. 14 | 15 | Theorem beq_id_refl : forall x, true = beq_id x x. 16 | Proof. 17 | intros [x']. 18 | simpl. 19 | destruct (string_dec x' x'). 20 | - reflexivity. 21 | - destruct n. reflexivity. 22 | Qed. 23 | 24 | 25 | Theorem beq_id_true_iff : forall x y : id, 26 | beq_id x y = true <-> x = y. 27 | Proof. 28 | intros [x'] [y']. 29 | unfold beq_id. 30 | destruct (string_dec x' y'). 31 | - rewrite -> e. 32 | split. 33 | + reflexivity. 34 | + reflexivity. 35 | - split. 36 | + intros. inversion H. 37 | + intros. inversion H. destruct n. apply H1. 38 | Qed. 39 | 40 | Theorem beq_id_false_iff : forall x y : id, 41 | beq_id x y = false <-> 42 | x <> y. 43 | Proof. 44 | intros. 45 | rewrite <- beq_id_true_iff. 46 | rewrite not_true_iff_false. 47 | reflexivity. 48 | Qed. 49 | 50 | 51 | Theorem false_beq_id : forall x y : id, 52 | x <> y -> 53 | beq_id x y = false. 54 | Proof. 55 | intros. 56 | rewrite -> beq_id_false_iff. 57 | apply H. 58 | Qed. 59 | 60 | Definition total_map (A: Type) := id -> A. 61 | 62 | Definition t_empty {A: Type} (v: A) : total_map A := 63 | fun (_ : id) => v. 64 | 65 | Definition t_update {A: Type} (m: total_map A) (k: id) (v: A) : total_map A := 66 | fun (x : id) => if beq_id k x then v else m x. 67 | 68 | 69 | Definition examplemap := 70 | t_update (t_update (t_empty false) (Id "foo") false) 71 | (Id "bar") true. 72 | 73 | 74 | Example update_example1 : examplemap (Id "baz") = false. 75 | Proof. reflexivity. Qed. 76 | 77 | Example update_example2 : examplemap (Id "foo") = false. 78 | Proof. reflexivity. Qed. 79 | 80 | Example update_example3 : examplemap (Id "quux") = false. 81 | Proof. reflexivity. Qed. 82 | 83 | Example update_example4 : examplemap (Id "bar") = true. 84 | Proof. reflexivity. Qed. 85 | 86 | Lemma t_apply_empty: forall A x v, @t_empty A v x = v. 87 | Proof. 88 | intros. 89 | unfold t_empty. reflexivity. 90 | Qed. 91 | 92 | Lemma t_update_eq : forall A (m: total_map A) x v, 93 | (t_update m x v) x = v. 94 | Proof. 95 | intros. 96 | unfold t_update. 97 | rewrite <- beq_id_refl. 98 | reflexivity. 99 | Qed. 100 | 101 | Theorem t_update_neq : forall (X:Type) v x1 x2 102 | (m : total_map X), 103 | x1 <> x2 -> 104 | (t_update m x1 v) x2 = m x2. 105 | Proof. 106 | intros. 107 | apply false_beq_id in H. 108 | unfold t_update. 109 | rewrite -> H. 110 | reflexivity. 111 | Qed. 112 | 113 | Lemma t_update_shadow : forall A (m: total_map A) v1 v2 x, 114 | t_update (t_update m x v1) x v2 115 | = t_update m x v2. 116 | Proof. 117 | intros. 118 | unfold t_update. 119 | apply functional_extensionality_dep. 120 | intros. 121 | destruct (beq_id x x0). 122 | + reflexivity. 123 | + reflexivity. 124 | Qed. 125 | 126 | Lemma beq_idP : forall x y, reflect (x = y) (beq_id x y). 127 | Proof. 128 | intros. 129 | apply iff_reflect. 130 | rewrite <- beq_id_true_iff. 131 | reflexivity. 132 | Qed. 133 | 134 | Theorem t_update_same : forall X x (m : total_map X), 135 | t_update m x (m x) = m. 136 | Proof. 137 | intros. 138 | unfold t_update. 139 | apply functional_extensionality_dep. 140 | intros. 141 | destruct (beq_idP x x0). 142 | + rewrite -> e. reflexivity. 143 | + reflexivity. 144 | Qed. 145 | 146 | Theorem t_update_permute : forall (X:Type) v1 v2 x1 x2 147 | (m : total_map X), 148 | x2 <> x1 -> 149 | (t_update (t_update m x2 v2) x1 v1) 150 | = (t_update (t_update m x1 v1) x2 v2). 151 | Proof. 152 | intros. 153 | unfold t_update. 154 | apply functional_extensionality_dep. 155 | intros. 156 | destruct (beq_idP x1 x). 157 | - destruct (beq_idP x2 x). 158 | + exfalso. apply H. rewrite e, e0. reflexivity. 159 | + reflexivity. 160 | - destruct (beq_idP x2 x). 161 | + reflexivity. 162 | + reflexivity. 163 | Qed. 164 | 165 | 166 | 167 | Definition partial_map (A:Type) := total_map (option A). 168 | 169 | Definition empty {A: Type} : partial_map A := 170 | t_empty None. 171 | 172 | Definition update {A: Type} (m: partial_map A) (k: id) (v: A) := 173 | t_update m k (Some v). 174 | 175 | 176 | Lemma apply_empty : forall A x, @empty A x = None. 177 | Proof. 178 | intros. unfold empty. rewrite t_apply_empty. reflexivity. 179 | Qed. 180 | 181 | Lemma update_eq : forall A (m: partial_map A) x v, 182 | (update m x v) x = Some v. 183 | Proof. 184 | intros. unfold update. rewrite t_update_eq. reflexivity. 185 | Qed. 186 | 187 | Lemma update_neq : forall A (m: partial_map A) x1 x2 v, 188 | x2 <> x1 -> 189 | (update m x2 v) x1 = m x1. 190 | Proof. 191 | intros. unfold update. rewrite t_update_neq. 192 | - reflexivity. 193 | - apply H. 194 | Qed. 195 | 196 | Lemma update_shadow : forall A (m: partial_map A) x v1 v2, 197 | update (update m x v1) x v2 = update m x v2. 198 | Proof. 199 | intros. unfold update. rewrite t_update_shadow. reflexivity. 200 | Qed. 201 | 202 | Lemma update_same : forall A (m: partial_map A) x v, 203 | m x = Some v -> 204 | update m x v = m. 205 | Proof. 206 | intros. unfold update. rewrite <- H. rewrite t_update_same. reflexivity. 207 | Qed. 208 | 209 | Lemma update_permute : forall A (m: partial_map A) x1 x2 v1 v2, 210 | x2 <> x1 -> 211 | (update (update m x2 v2) x1 v1) = 212 | (update (update m x1 v1) x2 v2). 213 | Proof. 214 | intros. unfold update. rewrite t_update_permute. 215 | - reflexivity. 216 | - apply H. 217 | Qed. 218 | 219 | -------------------------------------------------------------------------------- /Poly.v: -------------------------------------------------------------------------------- 1 | Require Export Lists. 2 | 3 | Inductive list (X:Type) : Type := 4 | | nil : list X 5 | | cons : X -> list X -> list X. 6 | 7 | Check nil. 8 | Check cons. 9 | 10 | Check (cons nat 2 (cons nat 1 (nil nat))). 11 | 12 | Fixpoint repeat (X:Type) (x:X) (n:nat) : list X := 13 | match n with 14 | | O => nil X 15 | | S n' => cons X x (repeat X x n') 16 | end. 17 | 18 | Example test_repeat1 : 19 | repeat nat 4 2 = cons nat 4 (cons nat 4 (nil nat)). 20 | Proof. reflexivity. Qed. 21 | 22 | Example test_repeat2 : 23 | repeat bool false 1 = cons bool false (nil bool). 24 | Proof. reflexivity. Qed. 25 | 26 | 27 | Module MumbleGrumble. 28 | 29 | Inductive mumble : Type := 30 | | a : mumble 31 | | b : mumble -> nat -> mumble 32 | | c : mumble. 33 | 34 | Inductive grumble (X:Type) : Type := 35 | | d : mumble -> grumble X 36 | | e : X -> grumble X. 37 | 38 | Check (c). 39 | 40 | End MumbleGrumble. 41 | 42 | Fixpoint repeat' X x count : list X := 43 | match count with 44 | | 0 => nil X 45 | | S count' => cons X x (repeat' X x count') 46 | end. 47 | 48 | Check repeat'. 49 | 50 | Fixpoint repeat'' X x count : list X := 51 | match count with 52 | | 0 => nil _ 53 | | S count' => cons _ x (repeat' _ x count') 54 | end. 55 | 56 | 57 | Definition list123' := 58 | cons _ 1 (cons _ 2 (cons _ 3 (nil _))). 59 | 60 | 61 | Arguments nil {X}. 62 | 63 | Arguments cons {X} _ _. 64 | 65 | Arguments repeat {X} x n. 66 | 67 | Definition list123'' := cons 1 (cons 2 (cons 3 nil)). 68 | 69 | Fixpoint repeat''' {X : Type} (x : X) (count : nat) : list X := 70 | match count with 71 | | 0 => nil 72 | | S count' => cons x (repeat''' x count') 73 | end. 74 | 75 | Fixpoint app {X:Type} (l1 l2 : list X) : list X := 76 | match l1 with 77 | | nil => l2 78 | | cons h1 t1 => cons h1 (app t1 l2) 79 | end. 80 | 81 | Fixpoint rev {X:Type} (l : list X) : list X := 82 | match l with 83 | | nil => nil 84 | | cons h t => app (rev t) (cons h nil) 85 | end. 86 | 87 | Fixpoint length {X:Type} (l : list X) : nat := 88 | match l with 89 | | nil => 0 90 | | cons h t => 1 + (length t) 91 | end. 92 | 93 | Example test_rev1 : 94 | rev (cons 1 (cons 2 nil)) = (cons 2 (cons 1 nil)). 95 | Proof. reflexivity. Qed. 96 | 97 | Example test_rev2: 98 | rev (cons true nil) = cons true nil. 99 | Proof. reflexivity. Qed. 100 | 101 | Example test_length1: length (cons 1 (cons 2 (cons 3 nil))) = 3. 102 | Proof. reflexivity. Qed. 103 | 104 | 105 | Definition mynil : list nat := nil. 106 | 107 | Check @nil. 108 | Definition mynil' := @nil nat. 109 | 110 | 111 | Notation "x :: y" := (cons x y) 112 | (at level 60, right associativity). 113 | Notation "[ ]" := nil. 114 | Notation "[ x ; .. ; y ]" := (cons x .. (cons y []) ..). 115 | Notation "x ++ y" := (app x y) 116 | (at level 60, right associativity). 117 | 118 | Definition list123''' := [1; 2; 3]. 119 | 120 | 121 | Theorem app_nil_r : forall (X:Type), forall (l:list X), 122 | l ++ [] = l. 123 | Proof. 124 | intros. 125 | induction l as [| h t IH]. 126 | - reflexivity. 127 | - simpl. rewrite -> IH. reflexivity. 128 | Qed. 129 | 130 | Theorem app_assoc : forall A (l m n:list A), 131 | l ++ m ++ n = (l ++ m) ++ n. 132 | Proof. 133 | intros. 134 | induction l as [| h t IH]. 135 | - reflexivity. 136 | - simpl. rewrite -> IH. reflexivity. 137 | Qed. 138 | 139 | Lemma app_length : forall (X:Type) (l1 l2 : list X), 140 | length (l1 ++ l2) = length l1 + length l2. 141 | Proof. 142 | intros. 143 | induction l1 as [| h1 t1 IH1]. 144 | - reflexivity. 145 | - simpl. rewrite -> IH1. reflexivity. 146 | Qed. 147 | 148 | Theorem rev_app_distr: forall X (l1 l2 : list X), 149 | rev (l1 ++ l2) = rev l2 ++ rev l1. 150 | Proof. 151 | intros. 152 | induction l1 as [| h1 t1 IH1]. 153 | - simpl. rewrite -> app_nil_r. reflexivity. 154 | - simpl. rewrite -> IH1. rewrite <- app_assoc. reflexivity. 155 | Qed. 156 | 157 | Theorem rev_involutive : forall X : Type, forall l : list X, 158 | rev (rev l) = l. 159 | Proof. 160 | intros. 161 | induction l as [| h t IH]. 162 | - reflexivity. 163 | - simpl. rewrite -> rev_app_distr. 164 | simpl. rewrite -> IH. 165 | reflexivity. 166 | Qed. 167 | 168 | Inductive prod (X Y : Type) : Type := 169 | | pair : X -> Y -> prod X Y. 170 | 171 | Arguments pair {X} {Y} _ _. 172 | 173 | Notation "( x , y )" := (pair x y). 174 | 175 | Notation "X * Y" := (prod X Y) : type_scope. 176 | 177 | Definition fst {X Y : Type} (p: X * Y) : X := 178 | match p with 179 | | (x, y) => x 180 | end. 181 | 182 | Definition snd {X Y : Type} (p: X * Y) : Y := 183 | match p with 184 | | (x, y) => y 185 | end. 186 | 187 | Fixpoint combine {X Y : Type} (lx : list X) (ly : list Y) 188 | : list (X * Y) := 189 | match lx, ly with 190 | | [], _ => [] 191 | | _, [] => [] 192 | | x :: tx, y :: ty => (x, y) :: (combine tx ty) 193 | end. 194 | 195 | Check @combine. 196 | Compute (combine [1;2] [false;false;true;true]). 197 | 198 | Fixpoint split {X Y : Type} (l : list (X*Y)) 199 | : (list X) * (list Y) := 200 | match l with 201 | | [] => ([],[]) 202 | | (x, y) :: l' => (x :: (fst (split l')), y :: (snd (split l'))) 203 | end. 204 | 205 | Example test_split: 206 | split [(1,false);(2,false)] = ([1;2],[false;false]). 207 | Proof. reflexivity. Qed. 208 | 209 | Inductive option (X: Type) : Type := 210 | | None : option X 211 | | Some : X -> option X. 212 | 213 | Arguments Some {X} _. 214 | Arguments None {X}. 215 | 216 | Fixpoint nth_error {X : Type} (l : list X) (n : nat) 217 | : option X := 218 | match n, l with 219 | | _, [] => None 220 | | O, x :: _ => Some x 221 | | S n', _ :: l' => nth_error l' n' 222 | end. 223 | 224 | Example test_nth_error1 : nth_error [4;5;6;7] 0 = Some 4. 225 | Proof. reflexivity. Qed. 226 | Example test_nth_error2 : nth_error [[1];[2]] 1 = Some [2]. 227 | Proof. reflexivity. Qed. 228 | Example test_nth_error3 : nth_error [true] 2 = None. 229 | Proof. reflexivity. Qed. 230 | 231 | Definition hd_error {X : Type} (l : list X) : option X := 232 | match l with 233 | | [] => None 234 | | h :: _ => Some h 235 | end. 236 | 237 | 238 | Check @hd_error. 239 | 240 | Example test_hd_error1 : hd_error [1;2] = Some 1. 241 | Proof. reflexivity. Qed. 242 | 243 | Example test_hd_error2 : hd_error [[1];[2]] = Some [1]. 244 | Proof. reflexivity. Qed. 245 | 246 | Definition doit3times {X:Type} (f:X -> X) (n:X) : X := 247 | f (f (f n)). 248 | 249 | Check @doit3times. 250 | 251 | Example test_doit3times: doit3times minusTwo 9 = 3. 252 | Proof. reflexivity. Qed. 253 | 254 | Example test_doit3times': doit3times negb true = false. 255 | Proof. reflexivity. Qed. 256 | 257 | 258 | Fixpoint filter {X:Type} (test: X -> bool) (l:list X) 259 | : (list X) := 260 | match l with 261 | | [] => [] 262 | | h :: t => if test h then h :: (filter test t) 263 | else filter test t 264 | end. 265 | 266 | Example test_filter1: filter evenb [1;2;3;4] = [2;4]. 267 | Proof. reflexivity. Qed. 268 | 269 | Definition length_is_1 {X : Type} (l : list X) : bool := 270 | beq_nat (length l) 1. 271 | 272 | Example test_filter2: 273 | filter length_is_1 274 | [ [1; 2]; [3]; [4]; [5;6;7]; []; [8] ] 275 | = [ [3]; [4]; [8] ]. 276 | Proof. reflexivity. Qed. 277 | 278 | Definition countoddmembers' (l:list nat) : nat := 279 | length (filter oddb l). 280 | 281 | Example test_countoddmembers'1: countoddmembers' [1;0;3;1;4;5] = 4. 282 | Proof. reflexivity. Qed. 283 | Example test_countoddmembers'2: countoddmembers' [0;2;4] = 0. 284 | Proof. reflexivity. Qed. 285 | Example test_countoddmembers'3: countoddmembers' nil = 0. 286 | Proof. reflexivity. Qed. 287 | 288 | Example test_anon_fun': 289 | doit3times (fun n => n * n) 2 = 256. 290 | Proof. reflexivity. Qed. 291 | 292 | Example test_filter2': 293 | filter (fun l => beq_nat (length l) 1) 294 | [ [1; 2]; [3]; [4]; [5;6;7]; []; [8] ] 295 | = [ [3]; [4]; [8] ]. 296 | Proof. reflexivity. Qed. 297 | 298 | Definition filter_even_gt7 (l : list nat) : list nat := 299 | filter (fun n => evenb n && blt_nat 7 n) l. 300 | 301 | Example test_filter_even_gt7_1 : 302 | filter_even_gt7 [1;2;6;9;10;3;12;8] = [10;12;8]. 303 | Proof. reflexivity. Qed. 304 | 305 | Example test_filter_even_gt7_2 : 306 | filter_even_gt7 [5;2;6;19;129] = []. 307 | Proof. reflexivity. Qed. 308 | 309 | Definition partition {X : Type} 310 | (test : X -> bool) 311 | (l : list X) 312 | : list X * list X := 313 | (filter test l, filter (fun x => negb (test x)) l). 314 | 315 | Example test_partition1: partition oddb [1;2;3;4;5] = ([1;3;5], [2;4]). 316 | Proof. reflexivity. Qed. 317 | 318 | Example test_partition2: partition (fun x => false) [5;9;0] = ([], [5;9;0]). 319 | Proof. reflexivity. Qed. 320 | 321 | 322 | Fixpoint map {X Y:Type} (f:X -> Y) (l:list X) : (list Y) := 323 | match l with 324 | | [] => [] 325 | | h :: t => (f h) :: (map f t) 326 | end. 327 | 328 | Example test_map1: map (fun x => plus 3 x) [2;0;2] = [5;3;5]. 329 | Proof. reflexivity. Qed. 330 | 331 | Example test_map2: 332 | map oddb [2;1;2;5] = [false;true;false;true]. 333 | Proof. reflexivity. Qed. 334 | 335 | Example test_map3: 336 | map (fun n => [evenb n;oddb n]) [2;1;2;5] 337 | = [[true;false];[false;true];[true;false];[false;true]]. 338 | Proof. reflexivity. Qed. 339 | 340 | Theorem map_app : forall (X Y : Type) (f : X -> Y) (l1 l2 : list X), 341 | map f (l1 ++ l2) = map f l1 ++ (map f l2). 342 | Proof. 343 | intros. 344 | induction l1 as [| h1 t1 IH1]. 345 | - reflexivity. 346 | - simpl. rewrite -> IH1. reflexivity. 347 | Qed. 348 | 349 | Theorem map_rev : forall (X Y : Type) (f : X -> Y) (l : list X), 350 | map f (rev l) = rev (map f l). 351 | Proof. 352 | intros. 353 | induction l as [| h t IH]. 354 | - reflexivity. 355 | - simpl. rewrite -> map_app. 356 | simpl. rewrite -> IH. 357 | reflexivity. 358 | Qed. 359 | 360 | Fixpoint flat_map {X Y:Type} (f:X -> list Y) (l:list X) 361 | : (list Y) := 362 | match l with 363 | | [] => [] 364 | | h :: t => (f h) ++ (flat_map f t) 365 | end. 366 | 367 | Example test_flat_map1: 368 | flat_map (fun n => [n;n;n]) [1;5;4] 369 | = [1; 1; 1; 5; 5; 5; 4; 4; 4]. 370 | Proof. reflexivity. Qed. 371 | 372 | Definition option_map {X Y:Type} (f:X -> Y) (o:option X) : (option Y) := 373 | match o with 374 | | None => None 375 | | Some x => Some (f x) 376 | end. 377 | 378 | Fixpoint fold {X Y:Type} (f:X->Y->Y) (l:list X) (b:Y) : Y := 379 | match l with 380 | | [] => b 381 | | h :: t => f h (fold f t b) 382 | end. 383 | 384 | Compute (fold plus [1;2;3;4] 0). 385 | Check (fold andb). 386 | 387 | Example fold_example1 : 388 | fold mult [1;2;3;4] 1 = 24. 389 | Proof. reflexivity. Qed. 390 | 391 | Example fold_example2 : 392 | fold andb [true;true;false;true] true = false. 393 | Proof. reflexivity. Qed. 394 | 395 | Compute (fold app [[1];[];[2;3];[4]] []). 396 | 397 | Example fold_example3 : 398 | fold app [[1];[];[2;3];[4]] [] = [1;2;3;4]. 399 | Proof. reflexivity. Qed. 400 | 401 | Definition constfun {X:Type} (x:X) : nat -> X := 402 | fun _ => x. 403 | 404 | Definition ftrue := constfun true. 405 | 406 | Example constfun_example1 : ftrue 0 = true. 407 | Proof. reflexivity. Qed. 408 | 409 | Example constfun_example2 : (constfun 5) 99 = 5. 410 | Proof. reflexivity. Qed. 411 | 412 | 413 | Check plus. 414 | 415 | Definition plus3 := plus 3. 416 | Check plus3. 417 | 418 | Example test_plus3 : plus3 4 = 7. 419 | Proof. reflexivity. Qed. 420 | Example test_plus3' : doit3times plus3 0 = 9. 421 | Proof. reflexivity. Qed. 422 | Example test_plus3'' : doit3times (plus 3) 0 = 9. 423 | Proof. reflexivity. Qed. 424 | 425 | Module Exercises. 426 | 427 | Definition fold_length {X : Type} (l : list X) : nat := 428 | fold (fun _ len' => S len') l O. 429 | 430 | Example test_fold_length1 : fold_length [4;7;0] = 3. 431 | Proof. reflexivity. Qed. 432 | 433 | Theorem fold_length_correct : forall X (l : list X), 434 | fold_length l = length l. 435 | Proof. 436 | intros. 437 | induction l as [| h t IH]. 438 | - reflexivity. 439 | - simpl. 440 | rewrite <- IH. 441 | unfold fold_length. 442 | simpl. reflexivity. 443 | Qed. 444 | 445 | Definition fold_map {X Y:Type} (f : X -> Y) (l : list X) : list Y := 446 | fold (fun item acc => (f item) :: acc) l []. 447 | 448 | Theorem fold_map_correct : forall X Y (l : list X) (f: X -> Y), 449 | fold_map f l = map f l. 450 | Proof. 451 | intros. 452 | induction l as [| h t IH]. 453 | - reflexivity. 454 | - simpl. 455 | rewrite <- IH. 456 | unfold fold_map. 457 | simpl. reflexivity. 458 | Qed. 459 | 460 | Definition prod_curry {X Y Z : Type} (f: X * Y -> Z) : X -> Y -> Z := 461 | fun x y => f (x, y). 462 | 463 | Definition prod_uncurry {X Y Z : Type} 464 | (f : X -> Y -> Z) (p : X * Y) : Z := 465 | f (fst p) (snd p). 466 | 467 | Example test_map2: map (plus 3) [2;0;2] = [5;3;5]. 468 | Proof. reflexivity. Qed. 469 | 470 | Check @prod_curry. 471 | Check @prod_uncurry. 472 | 473 | Theorem uncurry_curry : forall (X Y Z : Type) 474 | (f : X -> Y -> Z) 475 | x y, 476 | prod_curry (prod_uncurry f) x y = f x y. 477 | Proof. 478 | intros. 479 | unfold prod_curry. 480 | unfold prod_uncurry. 481 | reflexivity. 482 | Qed. 483 | 484 | Theorem curry_uncurry : forall(X Y Z : Type) 485 | (f : (X * Y) -> Z) (p : X * Y), 486 | prod_uncurry (prod_curry f) p = f p. 487 | Proof. 488 | intros. 489 | unfold prod_uncurry. 490 | unfold prod_curry. 491 | destruct p. reflexivity. 492 | Qed. 493 | 494 | Module Church. 495 | 496 | Definition nat := forall X : Type, 497 | (X -> X) -> X -> X. 498 | 499 | Definition zero : nat := 500 | fun (X : Type) (f : X -> X) (x : X) => x. 501 | 502 | Definition one : nat := 503 | fun (X : Type) (f : X -> X) (x : X) => f x. 504 | 505 | Definition two : nat := 506 | fun (X : Type) (f : X -> X) (x : X) => f (f x). 507 | 508 | Definition three : nat := @doit3times. 509 | 510 | Definition succ (n : nat) : nat := 511 | fun (X : Type) (f : X -> X) (x: X) => f (n X f x). 512 | 513 | Example succ_1 : succ zero = one. 514 | Proof. reflexivity. Qed. 515 | 516 | Example succ_2 : succ one = two. 517 | Proof. reflexivity. Qed. 518 | 519 | Example succ_3 : succ two = three. 520 | Proof. reflexivity. Qed. 521 | 522 | (* Definition plus (n m : nat) : nat := 523 | fun (X : Type) (f : X -> X) (x: X) => n X f (m X f x). 524 | 525 | Example plus_1 : plus zero one = one. 526 | Proof. reflexivity. Qed. 527 | 528 | Example plus_2 : plus two three = plus three two. 529 | Proof. reflexivity. Qed. 530 | 531 | Example plus_3 : 532 | plus (plus two two) three = plus one (plus three three). 533 | Proof. reflexivity. Qed. 534 | 535 | Definition mult (n m : nat) : nat := 536 | fun (X : Type) (f : X -> X) => n X (m X f). 537 | 538 | Example mult_1 : mult one one = one. 539 | Proof. reflexivity. Qed. 540 | 541 | Example mult_2 : mult zero (plus three three) = zero. 542 | Proof. reflexivity. Qed. 543 | 544 | Example mult_3 : mult two three = plus three three. 545 | Proof. reflexivity. Qed. *) 546 | 547 | (* more church stuff todo *) 548 | 549 | End Church. 550 | 551 | End Exercises. 552 | -------------------------------------------------------------------------------- /ProofObjects.v: -------------------------------------------------------------------------------- 1 | Require Export IndProp. 2 | 3 | Theorem ev_4'' : ev 4. 4 | Proof. 5 | Show Proof. 6 | apply ev_SS. 7 | Show Proof. 8 | apply ev_SS. 9 | Show Proof. 10 | apply ev_0. 11 | Show Proof. 12 | Qed. 13 | 14 | 15 | Theorem ev_8 : ev 8. 16 | Proof. 17 | apply ev_SS. 18 | apply ev_SS. 19 | apply ev_SS. 20 | apply ev_SS. 21 | apply ev_0. 22 | Qed. 23 | 24 | Definition ev_8' : ev 8 := 25 | (ev_SS 6 (ev_SS 4 (ev_SS 2 (ev_SS 0 ev_0)))). 26 | 27 | 28 | Theorem ev_plus4 : forall n, ev n -> ev (4 + n). 29 | Proof. 30 | intros n H. simpl. 31 | apply ev_SS. 32 | apply ev_SS. 33 | apply H. 34 | Qed. 35 | 36 | Definition ev_plus4' : forall n, ev n -> ev (4 + n) := 37 | fun (n : nat) => 38 | fun (H : ev n) => 39 | ev_SS (S (S n)) (ev_SS n H). 40 | 41 | Definition ev_plus4'' (n : nat) (H : ev n) : ev (4 + n) := 42 | ev_SS (S (S n)) (ev_SS n H). 43 | 44 | 45 | Definition ev_plus2 : Prop := 46 | forall n, forall (E : ev n), ev (n + 2). 47 | 48 | 49 | Theorem implication_forall: forall (P Q: Prop), 50 | (P -> Q) <-> 51 | forall (_: P), Q. 52 | Proof. 53 | intros. 54 | split. 55 | - intros. apply H. apply H0. 56 | - intros. apply H. apply H0. 57 | Qed. 58 | 59 | 60 | Definition add1 : nat -> nat. 61 | intro n. 62 | Show Proof. 63 | apply S. 64 | Show Proof. 65 | apply n. 66 | Defined. 67 | 68 | Module Props. 69 | 70 | Module And. 71 | 72 | Inductive and (P Q: Prop) : Prop := 73 | | conj: P -> Q -> and P Q. 74 | 75 | End And. 76 | 77 | 78 | Lemma and_comm : forall P Q : Prop, P /\Q <-> Q /\ P. 79 | Proof. 80 | intros. 81 | split. 82 | - intros. destruct H. 83 | split. 84 | + apply H0. 85 | + apply H. 86 | - intros. destruct H. 87 | split. 88 | + apply H0. 89 | + apply H. 90 | Qed. 91 | 92 | Definition and_comm'_aux P Q (H : P /\ Q) := 93 | match H with 94 | | conj p q => conj q p 95 | end. 96 | 97 | Definition and_comm' P Q : P /\ Q <-> Q /\ P := 98 | conj (and_comm'_aux P Q) (and_comm'_aux Q P). 99 | 100 | Definition conj_fact : forall P Q R, P /\ Q -> Q /\ R -> P /\ R := 101 | fun (P Q R: Prop) (PQ: P /\ Q) (QR: Q /\ R) => 102 | conj (proj1 P Q PQ) (proj2 Q R QR). 103 | 104 | 105 | Module Or. 106 | 107 | Inductive or (P Q: Prop) := 108 | | or_introl: P -> or P Q 109 | | or_intror: Q -> or P Q. 110 | 111 | End Or. 112 | 113 | Definition or_comm : forall P Q, P \/ Q -> Q \/ P := 114 | fun (P Q: Prop) (H: P \/ Q) => 115 | match H with 116 | | or_introl P => or_intror P 117 | | or_intror Q => or_introl Q 118 | end. 119 | 120 | 121 | Module Ex. 122 | 123 | Inductive ex {A: Type} (P: A -> Prop) : Prop := 124 | | ex_intro: forall (x : A), P x -> ex P. 125 | 126 | End Ex. 127 | 128 | Definition some_nat_is_even: exists (x: nat), ev x := 129 | ex_intro (fun n => ev n) 0 ev_0. 130 | 131 | Definition ex_ev_Sn : ex (fun n => ev (S n)) := 132 | ex_intro (fun n => ev (S n)) 1 (ev_SS 0 ev_0). 133 | 134 | 135 | Inductive True : Prop := 136 | | I: True. 137 | 138 | Inductive False : Prop :=. 139 | 140 | End Props. 141 | 142 | Module MyEquality. 143 | 144 | Inductive eq {X: Type} : X -> X -> Prop := 145 | | eq_refl: forall x, eq x x. 146 | 147 | Notation "x = y" := (eq x y) 148 | (at level 70, no associativity) 149 | : type_scope. 150 | 151 | Lemma leibniz_equality : forall (X : Type) (x y: X), 152 | x = y -> 153 | forall (P: X -> Prop), P x -> P y. 154 | Proof. 155 | intros. 156 | destruct H. 157 | apply H0. 158 | Qed. 159 | 160 | Lemma four: 2 + 2 = 1 + 3. 161 | Proof. 162 | apply eq_refl. 163 | Qed. 164 | 165 | 166 | Definition four' : 2 + 2 = 1 + 3 := 167 | eq_refl 4. 168 | 169 | Definition singleton : forall (X:Set) (x:X), []++[x] = x::[] := 170 | fun (X:Set) (x:X) => eq_refl [x]. 171 | 172 | End MyEquality. 173 | 174 | Definition quiz6 : exists x, x + 3 = 4 175 | := ex_intro (fun z => (z + 3 = 4)) 1 (refl_equal 4). 176 | 177 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # UPenn Software Foundations 2 | -------------------------------------------------------------------------------- /Tactics.v: -------------------------------------------------------------------------------- 1 | Require Export Poly. 2 | 3 | Theorem silly1 : forall (n m o p : nat), 4 | n = m -> 5 | [n;o] = [n;p] -> 6 | [n;o] = [m;p]. 7 | Proof. 8 | intros. 9 | rewrite <- H. 10 | apply H0. 11 | Qed. 12 | 13 | Theorem silly2 : forall (n m o p : nat), 14 | n = m -> 15 | (forall (q r : nat), q = r -> [q;o] = [r;p]) -> 16 | [n;o] = [m;p]. 17 | Proof. 18 | intros. 19 | apply H0. apply H. 20 | Qed. 21 | 22 | 23 | Theorem silly2a : forall(n m : nat), 24 | (n,n) = (m,m) -> 25 | (forall (q r : nat), (q,q) = (r,r) -> [q] = [r]) -> 26 | [n] = [m]. 27 | Proof. 28 | intros. 29 | apply H0. apply H. 30 | Qed. 31 | 32 | Theorem silly_ex : 33 | (forall n, evenb n = true -> oddb (S n) = true) -> 34 | evenb 3 = true -> 35 | oddb 4 = true. 36 | Proof. 37 | intros. 38 | apply H. 39 | apply H0. 40 | Qed. 41 | 42 | Theorem silly3_firsttry : forall (n : nat), 43 | true = beq_nat n 5 -> 44 | beq_nat (S (S n)) 7 = true. 45 | Proof. 46 | intros. 47 | simpl. 48 | symmetry. 49 | apply H. 50 | Qed. 51 | 52 | Theorem rev_exercise1 : forall (l l' : list nat), 53 | l = rev l' -> 54 | l' = rev l. 55 | Proof. 56 | intros. 57 | rewrite -> H. 58 | symmetry. 59 | apply rev_involutive. 60 | Qed. 61 | 62 | Example trans_eq_example : forall (a b c d e f : nat), 63 | [a;b] = [c;d] -> 64 | [c;d] = [e;f] -> 65 | [a;b] = [e;f]. 66 | Proof. 67 | intros. 68 | rewrite -> H. 69 | rewrite -> H0. 70 | reflexivity. 71 | Qed. 72 | 73 | Theorem trans_eq : forall (X: Type) (n m o: X), 74 | n = m -> m = o -> n = o. 75 | Proof. 76 | intros. 77 | rewrite -> H. 78 | rewrite -> H0. 79 | reflexivity. 80 | Qed. 81 | 82 | Example trans_eq_example' : forall (a b c d e f : nat), 83 | [a;b] = [c;d] -> 84 | [c;d] = [e;f] -> 85 | [a;b] = [e;f]. 86 | Proof. 87 | intros. 88 | apply trans_eq with (m:=[c;d]). 89 | apply H. apply H0. 90 | Qed. 91 | 92 | Example trans_eq_exercise : forall (n m o p : nat), 93 | m = (minusTwo o) -> 94 | (n + p) = m -> 95 | (n + p) = (minusTwo o). 96 | Proof. 97 | intros. 98 | apply trans_eq with (m). 99 | apply H0. apply H. 100 | Qed. 101 | 102 | Theorem S_injective : forall (n m : nat), 103 | S n = S m -> 104 | n = m. 105 | Proof. 106 | intros. 107 | inversion H. 108 | reflexivity. 109 | Qed. 110 | 111 | Lemma S_injective_backwards : forall (n m : nat), 112 | n = m -> 113 | S n = S m. 114 | Proof. 115 | intros. inversion H. reflexivity. 116 | Qed. 117 | 118 | Theorem inversion_ex1 : forall (n m o : nat), 119 | [n; m] = [o; o] -> 120 | [n] = [m]. 121 | Proof. 122 | intros. 123 | inversion H. 124 | reflexivity. 125 | Qed. 126 | 127 | Theorem inversion_ex2 : forall (n m : nat), 128 | [n] = [m] -> 129 | n = m. 130 | Proof. 131 | intros. 132 | inversion H. 133 | reflexivity. 134 | Qed. 135 | 136 | Example inversion_ex3 : forall (X : Type) (x y z : X) (l j : list X), 137 | x :: y :: l = z :: j -> 138 | y :: l = x :: j -> 139 | x = y. 140 | Proof. 141 | intros. 142 | inversion H0. 143 | reflexivity. 144 | Qed. 145 | 146 | Theorem beq_nat_0_l : forall n, 147 | beq_nat 0 n = true -> n = 0. 148 | Proof. 149 | intros. 150 | destruct n as [| n']. 151 | - reflexivity. 152 | - inversion H. 153 | Qed. 154 | 155 | Theorem inversion_ex4 : forall (n : nat), 156 | S n = O -> 157 | 2 + 2 = 5. 158 | Proof. 159 | intros. 160 | inversion H. 161 | Qed. 162 | 163 | Theorem inversion_ex5 : forall (n m : nat), 164 | false = true -> 165 | [n] = [m]. 166 | Proof. 167 | intros. 168 | inversion H. 169 | Qed. 170 | 171 | Example inversion_ex6 : forall (X : Type) 172 | (x y z : X) (l j : list X), 173 | x :: y :: l = [] -> 174 | y :: l = z :: j -> 175 | x = z. 176 | Proof. 177 | intros. 178 | inversion H. 179 | Qed. 180 | 181 | 182 | Theorem f_equal : forall (A B : Type) (f: A -> B) (x y: A), 183 | x = y -> f x = f y. 184 | Proof. 185 | intros. 186 | rewrite -> H. 187 | reflexivity. 188 | Qed. 189 | 190 | Theorem S_inj : forall (n m : nat) (b : bool), 191 | beq_nat (S n) (S m) = b -> 192 | beq_nat n m = b. 193 | Proof. 194 | intros. 195 | simpl in H. apply H. 196 | Qed. 197 | 198 | Theorem silly3' : forall (n : nat), 199 | (beq_nat n 5 = true -> beq_nat (S (S n)) 7 = true) -> 200 | true = beq_nat n 5 -> 201 | true = beq_nat (S (S n)) 7. 202 | Proof. 203 | intros. 204 | symmetry in H0. apply H in H0. symmetry in H0. apply H0. 205 | Qed. 206 | 207 | (* didn't work when I used 'intros.' at the outset... *) 208 | 209 | Theorem plus_n_n_injective : forall n m, 210 | n + n = m + m -> 211 | n = m. 212 | Proof. 213 | intros n. 214 | induction n as [| n' IHn]. 215 | - intros. destruct m as [| m']. 216 | + reflexivity. 217 | + inversion H. 218 | - intros. destruct m as [| m']. 219 | + intros. inversion H. 220 | + intros. inversion H. 221 | rewrite <- plus_n_Sm in H1. 222 | rewrite <- plus_n_Sm in H1. 223 | inversion H1. 224 | apply IHn in H2. 225 | rewrite -> H2. 226 | reflexivity. 227 | Qed. 228 | 229 | 230 | Theorem double_injective : forall n m : nat, 231 | double n = double m -> 232 | n = m. 233 | Proof. 234 | intros n. 235 | induction n as [| n' IHn]. 236 | - intros. 237 | destruct m as [| m']. 238 | + reflexivity. 239 | + inversion H. 240 | - intros. 241 | destruct m as [| m']. 242 | + inversion H. 243 | + apply f_equal. 244 | apply IHn. 245 | inversion H. 246 | reflexivity. 247 | Qed. 248 | 249 | Theorem beq_nat_true : forall n m, 250 | beq_nat n m = true -> n = m. 251 | Proof. 252 | intros n. 253 | induction n as [| n' IHn]. 254 | - intros. 255 | destruct m as [| m']. 256 | + reflexivity. 257 | + inversion H. 258 | - intros. 259 | destruct m as [| m']. 260 | + inversion H. 261 | + apply f_equal. 262 | apply IHn. 263 | inversion H. 264 | reflexivity. 265 | Qed. 266 | 267 | Theorem double_injective_take2 : forall n m, 268 | double n = double m -> 269 | n = m. 270 | Proof. 271 | intros. 272 | generalize dependent n. 273 | induction m as [| m' IHm]. 274 | - intros. 275 | destruct n as [| n']. 276 | + reflexivity. 277 | + inversion H. 278 | - intros. 279 | destruct n as [| n']. 280 | + inversion H. 281 | + apply f_equal. 282 | apply IHm. 283 | inversion H. 284 | reflexivity. 285 | Qed. 286 | 287 | 288 | Theorem beq_id_true : forall x y, 289 | beq_id x y = true -> x = y. 290 | Proof. 291 | intros [m] [n]. 292 | simpl. 293 | intros. 294 | assert (H' : m = n). 295 | - apply beq_nat_true. apply H. 296 | - rewrite -> H'. reflexivity. 297 | Qed. 298 | 299 | 300 | Theorem nth_error_after_last: forall (n : nat) (X : Type) (l : list X), 301 | length l = n -> 302 | nth_error l n = None. 303 | Proof. 304 | intros. 305 | generalize dependent n. 306 | induction l as [| h t IH]. 307 | - intros. 308 | rewrite <- H. 309 | reflexivity. 310 | - intros. 311 | rewrite <- H. 312 | simpl. 313 | apply IH. 314 | reflexivity. 315 | Qed. 316 | 317 | Definition square n := n * n. 318 | 319 | Lemma square_mult : forall n m, square (n * m) = square n * square m. 320 | Proof. 321 | intros. 322 | unfold square. 323 | rewrite -> mult_assoc. 324 | assert (H : n * m * n = n * n * m). 325 | - rewrite -> mult_comm. apply mult_assoc. 326 | - rewrite -> H. rewrite -> mult_assoc. 327 | reflexivity. 328 | Qed. 329 | 330 | Definition foo (x: nat) := 5. 331 | 332 | Fact silly_fact_1 : forall m, foo m + 1 = foo (m + 1) + 1. 333 | Proof. 334 | intros m. 335 | reflexivity. 336 | Qed. 337 | 338 | Definition bar x := 339 | match x with 340 | | O => 5 341 | | S _ => 5 342 | end. 343 | 344 | Fact silly_fact_2_FAILED : forall m, bar m + 1 = bar (m + 1) + 1. 345 | Proof. 346 | intros m. 347 | unfold bar. 348 | destruct m. 349 | - simpl. reflexivity. 350 | - simpl. reflexivity. 351 | Qed. 352 | 353 | Definition sillyfun (n : nat) : bool := 354 | if beq_nat n 3 then false 355 | else if beq_nat n 5 then false 356 | else false. 357 | 358 | Theorem sillyfun_false : forall (n : nat), 359 | sillyfun n = false. 360 | Proof. 361 | intros. 362 | unfold sillyfun. 363 | destruct (beq_nat n 3). 364 | - reflexivity. 365 | - destruct (beq_nat n 5). 366 | + reflexivity. 367 | + reflexivity. 368 | Qed. 369 | 370 | Theorem tail_eq: forall (X: Type) (h: X) (l1 l2: list X), 371 | l1 = l2 -> h :: l1 = h :: l2. 372 | Proof. 373 | intros. apply f_equal. apply H. 374 | Qed. 375 | 376 | Theorem combine_split : forall X Y (l : list (X * Y)) l1 l2, 377 | split l = (l1, l2) -> 378 | combine l1 l2 = l. 379 | Proof. 380 | intros X Y l. 381 | induction l as [| h t IH]. 382 | - intros. 383 | inversion H. 384 | reflexivity. 385 | - intros. 386 | inversion H. 387 | destruct h. 388 | destruct (split t). 389 | simpl in H1. 390 | inversion H1. 391 | simpl. 392 | apply tail_eq. 393 | apply IH. 394 | reflexivity. 395 | Qed. 396 | 397 | 398 | Definition sillyfun1 (n : nat) : bool := 399 | if beq_nat n 3 then true 400 | else if beq_nat n 5 then true 401 | else false. 402 | 403 | Theorem sillyfun1_odd : forall (n : nat), 404 | sillyfun1 n = true -> 405 | oddb n = true. 406 | Proof. 407 | intros. 408 | unfold sillyfun1 in H. 409 | destruct (beq_nat n 3) eqn:neq3. 410 | - apply beq_nat_true in neq3. 411 | rewrite -> neq3. 412 | reflexivity. 413 | - destruct (beq_nat n 5) eqn:neq5. 414 | + apply beq_nat_true in neq5. 415 | rewrite -> neq5. 416 | reflexivity. 417 | + inversion H. 418 | Qed. 419 | 420 | Theorem bool_fn_applied_thrice : 421 | forall (f : bool -> bool) (b : bool), 422 | f (f (f b)) = f b. 423 | Proof. 424 | intros. 425 | destruct b. 426 | - destruct (f true) eqn:fTrue. 427 | + rewrite -> fTrue. 428 | apply fTrue. 429 | + destruct (f false) eqn:fFalse. 430 | * apply fTrue. 431 | * apply fFalse. 432 | - destruct (f false) eqn: fFalse. 433 | + destruct (f true) eqn:fTrue. 434 | * apply fTrue. 435 | * apply fFalse. 436 | + rewrite -> fFalse. 437 | apply fFalse. 438 | Qed. 439 | 440 | Theorem beq_nat_sym : forall (n m : nat), 441 | beq_nat n m = beq_nat m n. 442 | Proof. 443 | intros. 444 | generalize dependent m. 445 | induction n as [| n' IHn]. 446 | - intros. destruct m as [| m']. 447 | + reflexivity. 448 | + reflexivity. 449 | - intros. destruct m as [| m']. 450 | + reflexivity. 451 | + apply IHn. 452 | Qed. 453 | 454 | Theorem beq_nat_trans : forall n m p, 455 | beq_nat n m = true -> 456 | beq_nat m p = true -> 457 | beq_nat n p = true. 458 | Proof. 459 | intros. 460 | destruct n as [| n']. 461 | - apply beq_nat_true in H. 462 | rewrite <- H in H0. 463 | apply beq_nat_true in H0. 464 | rewrite <- H0. 465 | reflexivity. 466 | - apply beq_nat_true in H. 467 | rewrite <- H in H0. 468 | apply H0. 469 | Qed. 470 | 471 | 472 | Definition split_combine_statement : Prop := 473 | forall (X: Type) (l1 l2: list X), 474 | length l1 = length l2 -> 475 | split (combine l1 l2) = (l1, l2). 476 | 477 | Theorem split_combine : split_combine_statement. 478 | Proof. 479 | intros X l1. 480 | induction l1 as [| h1 t1 IH1]. 481 | - intros. 482 | simpl. 483 | destruct l2 as [| h2 t2 IH2]. 484 | + reflexivity. 485 | + inversion H. 486 | - intros. 487 | inversion H. 488 | destruct l2 as [| h2 t2]. 489 | + inversion H1. 490 | + inversion H1. 491 | apply IH1 in H2. 492 | simpl. 493 | rewrite -> H2. 494 | reflexivity. 495 | Qed. 496 | 497 | 498 | Theorem filter_exercise : forall (X : Type) (test : X -> bool) (x : X) (l lf : list X), 499 | filter test l = x :: lf -> 500 | test x = true. 501 | Proof. 502 | intros. 503 | generalize dependent lf. 504 | induction l as [| h t IH]. 505 | - intros. 506 | simpl in H. 507 | inversion H. 508 | - intros. 509 | generalize dependent H. 510 | destruct lf as [| hf tf]. 511 | + simpl. 512 | intros. 513 | destruct (test h) eqn:testH. 514 | * inversion H. 515 | rewrite -> H1 in testH. 516 | apply testH. 517 | * apply IH in H. 518 | apply H. 519 | + simpl. 520 | intros. 521 | destruct (test h) eqn:testH. 522 | * inversion H. 523 | rewrite -> H1 in testH. 524 | apply testH. 525 | * apply IH in H. 526 | apply H. 527 | Qed. 528 | 529 | Fixpoint forallb {X: Type} (test: X -> bool) (l: list X) : bool := 530 | match l with 531 | | [] => true 532 | | h :: t => (test h) && (forallb test t) 533 | end. 534 | 535 | Fixpoint existsb {X: Type} (test: X -> bool) (l: list X) : bool := 536 | match l with 537 | | [] => false 538 | | h :: t => (test h) || (existsb test t) 539 | end. 540 | 541 | Example forallb_1: forallb oddb [1;3;5;7;9] = true. 542 | Proof. reflexivity. Qed. 543 | 544 | Example forallb_2: forallb negb [false;false] = true. 545 | Proof. reflexivity. Qed. 546 | 547 | Example forallb_3: forallb evenb [0;2;4;5] = false. 548 | Proof. reflexivity. Qed. 549 | 550 | Example forallb_4: forallb (beq_nat 5) [] = true. 551 | Proof. reflexivity. Qed. 552 | 553 | Example existsb_1: existsb (beq_nat 5) [0;2;3;6] = false. 554 | Proof. reflexivity. Qed. 555 | 556 | Example existsb_2: existsb (andb true) [true;true;false] = true. 557 | Proof. reflexivity. Qed. 558 | 559 | Example existsb_3: existsb oddb [1;0;0;0;0;3] = true. 560 | Proof. reflexivity. Qed. 561 | 562 | Example existsb_4: existsb evenb [] = false. 563 | Proof. reflexivity. Qed. 564 | 565 | 566 | Definition existsb' {X: Type} (test: X -> bool) (l: list X) := 567 | negb (forallb (fun a => negb (test a)) l). 568 | 569 | Example existsb'_1: existsb' (beq_nat 5) [0;2;3;6] = false. 570 | Proof. reflexivity. Qed. 571 | 572 | Example existsb'_2: existsb' (andb true) [true;true;false] = true. 573 | Proof. reflexivity. Qed. 574 | 575 | Example existsb'_3: existsb' oddb [1;0;0;0;0;3] = true. 576 | Proof. reflexivity. Qed. 577 | 578 | Example existsb'_4: existsb' evenb [] = false. 579 | Proof. reflexivity. Qed. 580 | 581 | 582 | Theorem existsb_existsb': forall (X: Type) (test: X -> bool) (l: list X), 583 | existsb test l = existsb' test l. 584 | Proof. 585 | intros. 586 | unfold existsb. 587 | unfold existsb'. 588 | induction l as [| h t IH]. 589 | - simpl. reflexivity. 590 | - simpl. 591 | destruct (test h) eqn:testH. 592 | + simpl. reflexivity. 593 | + simpl. apply IH. 594 | Qed. 595 | 596 | Definition forallb' {X: Type} (test: X -> bool) (l: list X) : bool := 597 | fold (fun item acc => acc && (test item)) l true. 598 | 599 | Example forallb'_1: forallb' oddb [1;3;5;7;9] = true. 600 | Proof. reflexivity. Qed. 601 | 602 | Example forallb'_2: forallb' negb [false;false] = true. 603 | Proof. reflexivity. Qed. 604 | 605 | Example forallb'_3: forallb' evenb [0;2;4;5] = false. 606 | Proof. reflexivity. Qed. 607 | 608 | Example forallb'_4: forallb' (beq_nat 5) [] = true. 609 | Proof. reflexivity. Qed. 610 | 611 | Theorem andb_true_r: forall (a: bool), 612 | a && true = a. 613 | Proof. 614 | intros. 615 | destruct a. 616 | - reflexivity. 617 | - reflexivity. 618 | Qed. 619 | 620 | Theorem forallb_forallb': forall (X: Type) (test: X -> bool) (l: list X), 621 | forallb test l = forallb' test l. 622 | Proof. 623 | intros. 624 | unfold forallb. 625 | unfold forallb'. 626 | induction l as [| h t IH]. 627 | - simpl. reflexivity. 628 | - simpl. 629 | destruct (test h) eqn:testH. 630 | + simpl. 631 | rewrite -> IH. 632 | rewrite -> andb_true_r. 633 | reflexivity. 634 | + simpl. 635 | rewrite -> andb_false_r. 636 | reflexivity. 637 | Qed. 638 | 639 | Theorem map_length_unchanged: forall (A B: Type) (f: A -> B) (l: list A), 640 | length l = length (map f l). 641 | Proof. 642 | intros. 643 | induction l as [| h t IH]. 644 | - reflexivity. 645 | - simpl. 646 | rewrite -> IH. 647 | reflexivity. 648 | Qed. 649 | 650 | Definition flat_map_fold {X Y: Type} (f: X -> list Y) (l: list X) : list Y := 651 | fold (fun item acc => (f item) ++ acc) l []. 652 | 653 | Theorem flat_map_fold_correct: forall (X Y: Type) (f: X -> list Y) (l: list X), 654 | flat_map f l = flat_map_fold f l. 655 | Proof. 656 | intros. 657 | unfold flat_map_fold. 658 | unfold flat_map. 659 | induction l as [| h t IH]. 660 | - reflexivity. 661 | - simpl. 662 | rewrite -> IH. 663 | reflexivity. 664 | Qed. 665 | --------------------------------------------------------------------------------