(** * Software Foundations, Formally Benjamin C. Pierce Version of 9/19/2007 *) Require Export lec04_sol. (** * LECTURE 4 *) Lemma sillyex1 : forall (X : Set) (x y z : X) (l j : list X), x :: y :: l = z :: j -> y :: l = x :: j -> x = y. Proof. intros. inversion H0. trivial. Qed. Lemma sillyex2 : forall (X : Set) (x y z : X) (l j : list X), x :: y :: l = nil _ -> y :: l = z :: j -> x = z. Proof. intros. inversion H. Qed. (* Here is a more realistic use of inversion to prove a property that we will find useful at many points later on... *) Lemma eqnat_yes : forall m n, eqnat m n = yes -> m = n. Proof. intros m. induction m. Case "O". intros n. destruct n. Case "O". simpl. reflexivity. Case "S". simpl. intros contra. inversion contra. Case "S". intros n. destruct n. Case "O". intros contra. inversion contra. Case "S". intros H. simpl in H. apply IHm in H. rewrite -> H. reflexivity. Qed. (* Exercise: The above lemma can also be proved by induction on [m] (though we have to be a little careful about which order we introduce the variables, so that we get a general enough induction hypothesis; this is done for you below). Finish the following proof. To get maximum benefit from the exercise, try first to do it without looking back at the one above. *) Lemma eqnat_yes' : forall n m, eqnat m n = yes -> m = n. Proof. (* Wei: intro will match with the outermost variable, which is n See how the order of m and n is swapped from eqnat_yes *) intros n. induction n. intros. destruct m. trivial. simpl in H. inversion H. intros. destruct m. simpl in H. inversion H. simpl in H. apply IHn in H. rewrite H. trivial. Qed. (* ====================================================================== *) (** * LECTURE 5 *) (* Mini-sermon: Mindless proof-hacking is a terrible temptation in Coq... Please resist it! *) (* ---------------------------------------------------------------------- *) (* The [apply...with...] tactic *) (* The following (silly) example uses two rewrites in a row to get from [ [m,n] ] to [ [r,s] ]. *) Lemma eq_trans_example : forall (a b c d e f : nat), [a,b] = [c,d] -> [c,d] = [e,f] -> [a,b] = [e,f]. Proof. intros a b c d e f eq1 eq2. rewrite -> eq1. rewrite -> eq2. reflexivity. Qed. (* Since this is a common pattern, we might abstract it out as a lemma recording once and for all the fact that equality is transitive. *) Lemma eq_trans : forall (X:Set) (m n o : X), m = n -> n = o -> m = o. Proof. intros X m n o eq1 eq2. rewrite -> eq1. rewrite -> eq2. reflexivity. Qed. (* Now, we should be able to use [eq_trans] to prove the above example. However, to do this we need a slight refinement of the [apply] tactic... *) Lemma eq_trans_example' : forall (a b c d e f : nat), [a,b] = [c,d] -> [c,d] = [e,f] -> [a,b] = [e,f]. Proof. intros a b c d e f eq1 eq2. (* If we simply tell Coq [apply eq_trans] at this point, it can tell (by matching the goal against the conclusion of the lemma) that it should instantiate [X] with [nat], [m] with [[a,b]], and [o] with [[e,f]]. However, the matching process doesn't determine an instantiation for [n]: we have to supply one explicitly by adding [with (n:=[c,d])] to the invocation of [apply]. *) (* Wei: or we can: eapply eq_trans, assuming that a solution _e_xists *) apply eq_trans with (n:=[c,d]). apply eq1. apply eq2. Qed. Lemma eq_trans_exercise : forall (m n o p : nat), (plus m p) = n -> n = (minustwo o) -> (plus m p) = (minustwo o). Proof. intros. eapply eq_trans. apply H. apply H0. Restart. intros. apply eq_trans with (n:=n). trivial. trivial. Qed. (* ---------------------------------------------------------------------- *) (* Practice session *) (* Some nontrivial but not-too-complicated proofs to work together in class, and some for you to work as exercises... *) (* This is a slightly roundabout way of stating a fact that we have already proved above. The extra equalities force us to do a little more equational reasoning and exercise some of the tactics we've seen recently. *) Lemma length_snoc' : forall (X : Set) (v : X) (l : list X) (n : nat), length _ l = n -> length _ (snoc _ l v) = S n. Proof. intros. rewrite length_snoc. rewrite H. trivial. Qed. (* A slightly different way of making the same assertion. *) Lemma length_snoc'' : forall (X : Set) (v : X) (l : list X) (n : nat), S (length _ l) = n -> length _ (snoc _ l v) = n. Proof. intros X v l. induction l. (* FILL IN HERE (and delete "Admitted") Admitted *) simpl. trivial. intros. (* Wei: simplify both the hypothesis and the goal, i.e. * |- * *) simpl in *. destruct n. inversion H. (* Wei: OR discriminate H. *) (* Wei: Backward thinking: what we need is essentially the reverse of S_inj from lec04 *) assert (forall m: nat, m = n -> S m = S n) as S_inj''. intros. rewrite H0. trivial. apply S_inj''. apply IHl. apply S_inj. exact H. (* Wei: Forward thinking: the trick is in the rewrite step: We treat IHl as a function and pass it two arguments: n, H0 Here injection is used, which is essentially equivalent to S_inj above *) Undo 8. injection H. intros. rewrite (IHl n H0). trivial. Qed. Fixpoint double (n:nat) {struct n} := match n with | O => O | S n' => S (S (double n')) end. Lemma double_injective : forall m n, double m = double n -> m = n. Proof. (* Wei: [induction m] is equivalent to [intro m; induction m] We don't want to use [intros] because that way we'll intro n and make a weaker induction hypothesis! *) induction m. Case "m=n=0". destruct n. trivial. Case "m=0,n!=0". (* absurd branch *) simpl. intros. inversion H. Case "m!=0,n=0". (* absurd branch *) destruct n. simpl. intros. inversion H. Case "real". simpl. intros. inversion H. rewrite (IHm n H1). trivial. Qed. Lemma plus_m_m_injective : forall m n, plus m m = plus n n -> m = n. Proof. (* Wei: As suggested above, we shouldn't blindly [intros]! *) induction m. destruct n. trivial. (* m=n=0 *) simpl. intros. inversion H. (* m=0, n!=0, absurd case *) intros. simpl in H. rewrite plus_commut in H. simpl in H. destruct n. simpl in H. inversion H. (* m!=0, n=0, absurd case *) simpl in H. (* Now we come to the hard case, but fortunately we have a powerful IH! [rewrite plus_commut] doesn't directly work because the first occurence of plus is in the form of (plus m m), so we have to shift the equation around. simpl in H. apply eq_symm in H. rewrite plus_commut in H. simpl in H. inversion H. *) (* Or we could make use a lemma we've proved from lec03 *) simpl in H. rewrite dist_succ_plus in H. inversion H. rewrite (IHm n H1). trivial. Qed. (* ---------------------------------------------------------------------- *) (** * Case analysis of compound expressions *) (* We have seen many examples where the [destruct] tactic is used to perform case analysis of the value of some variable. But sometimes we need to reason by cases on the result of some *expression*. We can also do this with [destruct]. *) Definition sillyfun (n : nat) : yesno := if eqnat n three then no else if eqnat n five then no else no. Lemma sillyfun_no : forall (n : nat), sillyfun n = no. Proof. intros. unfold sillyfun. destruct (eqnat n three). trivial. destruct (eqnat n five). trivial. trivial. Qed. (* ---------------------------------------------------------------------- *) (** * Case study: Interpreters *) (* Now it's time to start playing with programming languages. Let's begin with an incredibly simple one: a language of expressions involving just numeric constants and a single binary operator, addition. You may want to refer to Chapter 3 of TAPL as background for this lecture. *) (* Let's enclose the next bit in a module so that we can re-use the names it declares later on in the course without conflicting with the ones defined here (as we did above with lists of numbers and polymorphic lists) *) Module SimpleArith. (* An ABSTRACT SYNTAX of terms. (See the discussion in TAPL of abstract syntax vs. concrete syntax.) *) Inductive tm : Set := | tm_const : nat -> tm | tm_plus : tm -> tm -> tm. (* An INTERPRETER that maps each term to a number. *) Fixpoint interp (t:tm) {struct t} : nat := match t with | tm_const n => n | tm_plus t1 t2 => plus (interp t1) (interp t2) end. Lemma check_interp1: interp (tm_const three) = three. Proof. reflexivity. Qed. Lemma check_interp2: interp (tm_plus (tm_plus (tm_const one) (tm_const two)) (tm_plus (tm_const three) (tm_const four))) = ten. Proof. reflexivity. Qed. (* We can write a variety of programs that operate on terms -- often called METAPROGRAMS because they are programs that manipulate other programs. For example, here is a simple metaprogram that reverses a term by swapping the arguments to each tm_plus node. *) Fixpoint tmreverse (t:tm) {struct t} : tm := match t with | tm_const n => tm_const n | tm_plus t1 t2 => tm_plus (tmreverse t2) (tmreverse t1) end. Lemma check_tmreverse: tmreverse (tm_plus (tm_plus (tm_const one) (tm_const two)) (tm_plus (tm_const three) (tm_const four))) = (tm_plus (tm_plus (tm_const four) (tm_const three)) (tm_plus (tm_const two) (tm_const one))). Proof. reflexivity. Qed. (* As a sanity check for such a program transformation, we should check that it preserves the program's meaning, as defined by [interp]. *) Lemma tmreverse_interp : forall t : tm, interp (tmreverse t) = interp t. Proof. intros t. induction t. Case "tm_const". simpl. reflexivity. Case "tm_plus". simpl. rewrite -> IHt1. rewrite -> IHt2. rewrite -> plus_commut. reflexivity. Qed. (* Here is a more practical (though still extremely simple) program transformation -- an optimization that replaces every subterm of the form [tm_plus (tm_const zero) t] by just [t]. *) Fixpoint simplify_0plus (t:tm) {struct t} : tm := match t with | tm_const n => tm_const n | tm_plus (tm_const zero) t2 => simplify_0plus t2 | tm_plus t1 t2 => tm_plus (simplify_0plus t1) (simplify_0plus t2) end. Lemma check_simplify_0plus: simplify_0plus (tm_plus (tm_plus (tm_const zero) (tm_const two)) (tm_plus (tm_const three) (tm_const zero))) = (tm_plus (tm_const two) (tm_plus (tm_const three) (tm_const zero))). Proof. reflexivity. Qed. Lemma check_simplify_0plus': simplify_0plus (tm_plus (tm_const zero) (tm_plus (tm_const zero) (tm_const three))) = (tm_const three). Proof. reflexivity. Qed. Lemma check_simplify_0plus'': simplify_0plus (tm_plus (tm_const zero) (tm_plus (tm_const two) (tm_plus (tm_const zero) (tm_const three)))) = (tm_plus (tm_const two) (tm_const three)). Proof. reflexivity. Qed. (* And here is the proof that [simplify_0plus] preserves meaning. *) Lemma simplify_0plus_interp : forall (t:tm), interp (simplify_0plus t) = interp t. Proof. induction t. Case "tm_const". simpl. reflexivity. Case "tm_plus". destruct t1. Case "tm_const". destruct n. Case "O". simpl. rewrite -> IHt2. reflexivity. Case "S". simpl. rewrite -> IHt2. reflexivity. Case "tm_plus". simpl. simpl in IHt1. simpl in IHt2. rewrite -> IHt1. rewrite -> IHt2. reflexivity. Qed. (* Now let's look at a more interesting operation on terms: ONE-STEP SIMPLIFICATION. This function identifies the leftmost subterm that is "ready to be simplified" -- i.e., it has the form [tm_plus (tm_const m) (tm_const n)] -- and replaces it with [tm_const (plus m n)], leaving everything else the same. If there is no such subterm (i.e., if the whole term is just a constant), then the simplification function "fails" by returning [None]. *) Fixpoint simplify_step (t:tm) {struct t} : option tm := match t with | tm_const n => None _ | tm_plus t1 t2 => match (t1,t2) with | (tm_const n1, tm_const n2) => Some _ (tm_const (plus n1 n2)) | (tm_const n1, _) => match simplify_step t2 with | Some t2' => Some _ (tm_plus t1 t2') | None => None _ end | (_, _) => match simplify_step t1 with | Some t1' => Some _ (tm_plus t1' t2) | None => None _ end end end. (* A constant is done being simplified -- it cannot take a step: *) Lemma check_simplify_step_1: simplify_step (tm_const five) = None _. Proof. reflexivity. Qed. (* If [t1] can take a step to [t1'], then [tm_plus t1 t2] steps to [plus t1' t2]: *) Lemma check_simplify_step_2: simplify_step (tm_plus (tm_plus (tm_const zero) (tm_const three)) (tm_plus (tm_const two) (tm_const four))) = Some _ (tm_plus (tm_const three) (tm_plus (tm_const two) (tm_const four))). Proof. reflexivity. Qed. (* Right-hand sides of sums can take a step only when the left-hand side is finished: if [t2] can take a step to [t2'], then [tm_plus (tm_const n) t2] steps to [tm_plus (tm_const n) t2']: *) Lemma check_simplify_step_3: simplify_step (tm_plus (tm_const zero) (tm_plus (tm_const two) (tm_plus (tm_const zero) (tm_const three)))) = Some _ (tm_plus (tm_const zero) (tm_plus (tm_const two) (tm_const three))). Proof. reflexivity. Qed. Lemma simplify_step_interp : forall t t', simplify_step t = Some _ t' -> interp t = interp t'. Proof. intros t. induction t. Case "tm_const". intros t'. simpl. intros eq. inversion eq. Case "tm_plus". intros t' eq. simpl. simpl in eq. destruct t1. Case "tm_const". destruct t2. Case "tm_const". simpl. inversion eq. reflexivity. Case "tm_plus". destruct (simplify_step (tm_plus t2_1 t2_2)). Case "Some". inversion eq. assert (interp (tm_plus t2_1 t2_2) = interp t) as H. Case "Proof of assertion". apply IHt2. reflexivity. rewrite -> H. reflexivity. Case "None". inversion eq. Case "tm_plus". destruct (simplify_step (tm_plus t1_1 t1_2)). Case "Some". inversion eq. assert (interp (tm_plus t1_1 t1_2) = interp t) as H. Case "Proof of assertion". apply IHt1. reflexivity. rewrite -> H. reflexivity. Case "None". inversion eq. Qed. End SimpleArith. (* ---------------------------------------------------------------------- *) Module SimpleArithExercise. (* Exercise: The [SimpleArith] module developed a small collection of program transformations for a very simple programming language with just constants and addition. Your task is to extend this development to a very slightly less trivial language with constants, addition, and subtraction. The definition of the language and its meaning (the [interp] function) are given to you, as well as some new test cases for the definitions (to make sure subtraction works correctly) and some parts of the proofs, to get you started. *) Inductive tm : Set := | tm_const : nat -> tm | tm_plus : tm -> tm -> tm | tm_minus : tm -> tm -> tm. Fixpoint interp (t:tm) {struct t} : nat := match t with | tm_const n => n | tm_plus t1 t2 => plus (interp t1) (interp t2) | tm_minus t1 t2 => minus (interp t1) (interp t2) end. Lemma check_interp1: interp (tm_const three) = three. Proof. reflexivity. Qed. Lemma check_interp2: interp (tm_plus (tm_plus (tm_const one) (tm_const two)) (tm_plus (tm_const three) (tm_const four))) = ten. Proof. reflexivity. Qed. (* Subtraction is not a commutative operation, so [tmreverse] should swap the subterms just of [tm_plus] nodes, not [tm_minus] nodes. *) Fixpoint tmreverse (t:tm) {struct t} : tm := match t with | tm_const n => tm_const n | tm_plus t1 t2 => tm_plus (tmreverse t2) (tmreverse t1) | tm_minus t1 t2 => tm_minus (tmreverse t1) (tmreverse t2) end. Lemma check_tmreverse1: tmreverse (tm_plus (tm_plus (tm_const one) (tm_const two)) (tm_plus (tm_const three) (tm_const four))) = (tm_plus (tm_plus (tm_const four) (tm_const three)) (tm_plus (tm_const two) (tm_const one))). Proof. reflexivity. Qed. Lemma check_tmreverse2: tmreverse (tm_plus (tm_minus (tm_const one) (tm_const two)) (tm_plus (tm_const three) (tm_const four))) = (tm_plus (tm_plus (tm_const four) (tm_const three)) (tm_minus (tm_const one) (tm_const two))). Proof. reflexivity. Qed. Lemma check_tmreverse3: tmreverse (tm_minus (tm_minus (tm_const one) (tm_const two)) (tm_plus (tm_const three) (tm_const four))) = (tm_minus (tm_minus (tm_const one) (tm_const two)) (tm_plus (tm_const four) (tm_const three))). Proof. reflexivity. Qed. Lemma tmreverse_interp : forall t : tm, interp (tmreverse t) = interp t. Proof. intros t. induction t. Case "tm_const". simpl. reflexivity. Case "tm_plus". simpl. rewrite -> IHt1. rewrite -> IHt2. rewrite -> plus_commut. reflexivity. Case "tm_minus". simpl. rewrite IHt1. rewrite IHt2. trivial. Qed. Fixpoint simplify_0plus (t:tm) {struct t} : tm := match t with | tm_const n => tm_const n | tm_plus (tm_const zero) t2 => simplify_0plus t2 | tm_plus t1 t2 => tm_plus (simplify_0plus t1) (simplify_0plus t2) | tm_minus t1 t2 => tm_minus (simplify_0plus t1) (simplify_0plus t2) end. Lemma simplify_0plus_interp : forall (t:tm), interp (simplify_0plus t) = interp t. Proof. induction t. Case "tm_const". simpl. reflexivity. Case "tm_plus". destruct t1. Case "tm_const". destruct n. Case "O". simpl. rewrite -> IHt2. reflexivity. Case "S". simpl. rewrite -> IHt2. reflexivity. Case "tm_plus". simpl. simpl in IHt1. simpl in IHt2. rewrite -> IHt1. rewrite -> IHt2. reflexivity. Case "tm_minus". simpl. simpl in IHt1. simpl in IHt2. rewrite IHt1. rewrite IHt2. trivial. Case "tm_minus". (* Wei: We can copy-paste the tedious tm_plus case: destruct t1. Case "tm_const". destruct n. Case "O". simpl. rewrite -> IHt2. reflexivity. Case "S". simpl. rewrite -> IHt2. reflexivity. Case "tm_plus". simpl. simpl in IHt1. simpl in IHt2. rewrite -> IHt1. rewrite -> IHt2. reflexivity. Case "tm_minus". simpl. simpl in IHt1. simpl in IHt2. rewrite IHt1. rewrite IHt2. trivial. Or we can do it more cleverly: *) simpl. rewrite IHt1. rewrite IHt2. trivial. Qed. Fixpoint simplify_step (t:tm) {struct t} : option tm := match t with | tm_const n => None _ | tm_plus t1 t2 => match (t1,t2) with | (tm_const n1, tm_const n2) => Some _ (tm_const (plus n1 n2)) | (tm_const n1, _) => match simplify_step t2 with | Some t2' => Some _ (tm_plus t1 t2') | None => None _ end | (_, _) => match simplify_step t1 with | Some t1' => Some _ (tm_plus t1' t2) | None => None _ end end | tm_minus t1 t2 => match (t1,t2) with | (tm_const n1, tm_const n2) => Some _ (tm_const (minus n1 n2)) | (tm_const n1, _) => match simplify_step t2 with | Some t2' => Some _ (tm_minus t1 t2') | None => None _ end | (_, _) => match simplify_step t1 with | Some t1' => Some _ (tm_minus t1' t2) | None => None _ end end end. Lemma check_simplify_step_1: simplify_step (tm_const five) = None _. Proof. reflexivity. Qed. Lemma check_simplify_step_2: simplify_step (tm_plus (tm_plus (tm_const zero) (tm_const three)) (tm_plus (tm_const two) (tm_const four))) = Some _ (tm_plus (tm_const three) (tm_plus (tm_const two) (tm_const four))). Proof. reflexivity. Qed. Lemma check_simplify_step_3: simplify_step (tm_plus (tm_const zero) (tm_plus (tm_const two) (tm_plus (tm_const zero) (tm_const three)))) = Some _ (tm_plus (tm_const zero) (tm_plus (tm_const two) (tm_const three))). Proof. reflexivity. Qed. (* [tm_minus] behaves like [tm_plus]: *) Lemma check_simplify_step_4: simplify_step (tm_minus (tm_minus (tm_const three) (tm_const one)) (tm_plus (tm_const two) (tm_const four))) = Some _ (tm_minus (tm_const two) (tm_plus (tm_const two) (tm_const four))). Proof. reflexivity. Qed. Lemma check_simplify_step_5: simplify_step (tm_minus (tm_const zero) (tm_minus (tm_const two) (tm_plus (tm_const zero) (tm_const three)))) = Some _ (tm_minus (tm_const zero) (tm_minus (tm_const two) (tm_const three))). Proof. reflexivity. Qed. Lemma simplify_step_interp : forall t t', simplify_step t = Some _ t' -> interp t = interp t'. Proof. intros t. induction t. Case "tm_const". intros t'. simpl. intros eq. inversion eq. Case "tm_plus". intros t' eq. simpl. simpl in eq. destruct t1. Case "tm_const". destruct t2. Case "tm_const". simpl. inversion eq. reflexivity. Case "tm_plus". destruct (simplify_step (tm_plus t2_1 t2_2)). Case "Some". inversion eq. assert (interp (tm_plus t2_1 t2_2) = interp t) as H. Case "Proof of assertion". apply IHt2. reflexivity. rewrite -> H. reflexivity. Case "None". inversion eq. Case "tm_minus". destruct (simplify_step (tm_minus t2_1 t2_2)). Case "Some". inversion eq. assert (interp (tm_minus t2_1 t2_2) = interp t) as H. Case "Proof of assertion". apply IHt2. reflexivity. rewrite -> H. reflexivity. Case "None". inversion eq. Case "tm_plus". destruct (simplify_step (tm_plus t1_1 t1_2)). Case "Some". inversion eq. assert (interp (tm_plus t1_1 t1_2) = interp t) as H. Case "Proof of assertion". apply IHt1. reflexivity. rewrite -> H. reflexivity. Case "None". inversion eq. Case "tm_minus". destruct (simplify_step (tm_minus t1_1 t1_2)). Case "Some". inversion eq. assert (interp (tm_minus t1_1 t1_2) = interp t) as H. Case "Proof of assertion". apply IHt1. reflexivity. rewrite -> H. reflexivity. Case "None". inversion eq. Case "tm_minus". intros t' eq. simpl. simpl in eq. destruct t1. Case "tm_const". destruct t2. Case "tm_const". simpl. inversion eq. reflexivity. Case "tm_plus". destruct (simplify_step (tm_plus t2_1 t2_2)). Case "Some". inversion eq. assert (interp (tm_plus t2_1 t2_2) = interp t) as H. Case "Proof of assertion". apply IHt2. reflexivity. rewrite -> H. reflexivity. Case "None". inversion eq. Case "tm_minus". destruct (simplify_step (tm_minus t2_1 t2_2)). Case "Some". inversion eq. assert (interp (tm_minus t2_1 t2_2) = interp t) as H. Case "Proof of assertion". apply IHt2. reflexivity. rewrite -> H. reflexivity. Case "None". inversion eq. Case "tm_plus". destruct (simplify_step (tm_plus t1_1 t1_2)). Case "Some". inversion eq. assert (interp (tm_plus t1_1 t1_2) = interp t) as H. Case "Proof of assertion". apply IHt1. reflexivity. rewrite -> H. reflexivity. Case "None". inversion eq. Case "tm_minus". destruct (simplify_step (tm_minus t1_1 t1_2)). Case "Some". inversion eq. assert (interp (tm_minus t1_1 t1_2) = interp t) as H. Case "Proof of assertion". apply IHt1. reflexivity. rewrite -> H. reflexivity. Case "None". inversion eq. Qed. End SimpleArithExercise.