-- `list` provides the cons notation "::", `[]` for empty list, -- and the append notation "++". #reduce (1 :: 2 :: 3 :: []) #reduce (1 :: 2 :: [] ++ 3 :: 4 :: []). -- `Prop` is the 'type' of propositions. #print Prop namespace lec3 inductive true : Prop | intro : true lemma true_is_easy : true := begin exact true.intro end . #print true inductive false : Prop #print false lemma bogus : false → 1 = 2 := begin intros, -- there are zero possible cases -- if we hit here, must be due to contrad cases a, end lemma foo' : Type := begin exact bool, end lemma also_bogus: 1 = 2 → false := begin intros, cases a, end /- Note that even equality is defined, not builtin. -/ #print eq /- Here's [yo], another definition of an empty type. -/ inductive yo : Prop | yolo : yo → yo /- We will have to do a little more work to show that [yo] is empty though. -/ lemma yo_implies_false : yo → false := begin intros, cases a, cases a_1, cases a, -- Now this works! induction a_1, assumption end. /- Logical negation in lean is encoded in the `not` type. It work similarly to our `yo_implies_false` proof above. -/ #print not /- Expression Syntax -/ #check (1 + 2). #check (1 + (2 : int)). inductive expr : Type | int : ℤ → expr | var : string → expr | add : expr → expr → expr | mul : expr → expr → expr | lte : expr → expr → expr. /- On paper, we would typically write this type down using a "BNF grammar" as: << expr ::= Z | Var | expr + expr | expr * expr | expr <= expr >> -/ instance nat_to_expr : has_coe ℕ expr := ⟨ fun n, expr.int n ⟩ instance Z_to_expr : has_coe ℤ expr := ⟨ fun z, expr.int z ⟩ instance string_to_expr : has_coe string expr := ⟨ fun str, expr.var str ⟩ -- instance expr.has_add : has_add expr := -- ⟨ fun a b, expr.add a b ⟩ -- instance expr.has_mul : has_add expr := -- ⟨ fun a b, expr.add a b ⟩ -- instance expr.has_le : has_le expr := -- ⟨ fun a b, expr.lte a b ⟩. -- Not sure about pedagogy here, -- is special operators for Coq notation -- overloading or to clarify diff. notation x `[+]` y := expr.add x y notation x `[*]` y := expr.mul x y notation x `[<=]` y := expr.lte x y -- Notation "X [+] Y" := (Eadd X Y) -- (at level 83, left associativity). -- Notation "X [*] Y" := (Emul X Y) -- (at level 82, left associativity). -- Notation "X [<=] Y" := (Elte X Y) -- (at level 84, no associativity). -- talk to leo about nats #check ((1 : nat) [+] (2 : nat)) #check ("x" [+] (2 : nat)) #check ("x" [+] (2 : nat) [<=] "y") #check (expr.lte (expr.add (expr.var "x") (expr.int 2)) (expr.var "y")). /- weird -/ lemma add_comm_bogus : (forall e1 e2, expr.add e1 e2 = expr.add e2 e1) -> false := begin intros, -- we really need specialize have contradiction := (a nat.zero "foo"), cases contradiction, end def number_of_consts : expr → nat | (expr.int _) := 1 | (expr.var _) := 0 | (expr.add e1 e2) := number_of_consts e1 + number_of_consts e2 | (expr.mul e1 e2) := number_of_consts e1 + number_of_consts e2 | (expr.lte e1 e2) := number_of_consts e1 + number_of_consts e2 #reduce (number_of_consts ((1: nat) [*] (2 : nat) [+] "x" [<=] (5 : nat))) #print Exists lemma expr_with_3_consts : ∃ e, number_of_consts e = 3 := begin existsi ((1 : nat) [+] (2 : nat) [+] (3 : nat)), -- we need a tactic for chewing through coercions simp [coe, lift_t], unfold has_lift_t.lift, unfold coe_t has_coe_t.coe coe_b has_coe.coe, simp [number_of_consts], end /- Compute the size of an expression. -/ def expr.size : expr → nat | (expr.int _) := 1 | (expr.var _) := 1 | (expr.add e1 e2) := expr.size e1 + expr.size e2 | (expr.mul e1 e2) := expr.size e1 + expr.size e2 | (expr.lte e1 e2) := expr.size e1 + expr.size e2 #print expr.size lemma number_of_consts_le_size : ∀ e, number_of_consts e <= e.size := begin intros, induction e, { simp [number_of_consts, expr.size] }, { simp [number_of_consts, expr.size], tactic.comp_val }, -- TODO: need arith tactic, do we use z3 as stop gap? { simp [number_of_consts, expr.size], admit }, { simp [number_of_consts, expr.size], admit }, { simp [number_of_consts, expr.size], admit }, end. -- that proof had a lot of copy-pasta :( lemma number_of_consts_le_size' : ∀ e, number_of_consts e <= e.size := begin intros, induction e; { simp [number_of_consts, expr.size]; admit } end #check (<=) -- hover over me #print has_le.le /- [le] is a relation defined as an "inductive predicate". We give rules for when the relation holds: (1) all nats are less than or equal to themselves and (2) if n <= m, then also n <= S m. All proofs of [le] are built up from just these two constructors! We can define our own relations to encode properties of expressions. In the [has_const] inductive predicate below, each constructor corresponds to one way you could prove that an expression has a constant. -/ inductive has_const : expr → Prop | int : ∀ z, has_const (expr.int z) | add_l : ∀ e1 e2, has_const e1 → has_const (expr.add e1 e2) | add_r : ∀ e1 e2, has_const e2 -> has_const (expr.add e1 e2) | mul_l : ∀ e1 e2, has_const e1 -> has_const (expr.mul e1 e2) | mul_r : ∀ e1 e2, has_const e2 -> has_const (expr.mul e1 e2) | cmp_l : ∀ e1 e2, has_const e1 -> has_const (expr.lte e1 e2) | cmp_r : ∀ e1 e2, has_const e2 -> has_const (expr.lte e1 e2) . /- Similarly, we can define a relation that holds on expressions that contain a variable. -/ inductive has_var : expr -> Prop | var : ∀ s, has_var (expr.var s) | add_l : ∀ e1 e2, has_var e1 → has_var (expr.add e1 e2) | add_r : ∀ e1 e2, has_var e2 → has_var (expr.add e1 e2) | mul_l : ∀ e1 e2, has_var e1 → has_var (expr.mul e1 e2) | mul_r : ∀ e1 e2, has_var e2 → has_var (expr.mul e1 e2) | cmp_l : ∀ e1 e2, has_var e1 → has_var (expr.lte e1 e2) | cmp_r : ∀ e1 e2, has_var e2 → has_var (expr.lte e1 e2). /- We can also write boolean functions that check the same properties. Note that [orb] is disjuction over booleans: -/ #print || def hasConst : expr → bool | (expr.int _) := bool.tt | (expr.var _) := bool.ff | (expr.add e1 e2) := (hasConst e1) || (hasConst e2) | (expr.mul e1 e2) := (hasConst e1) || (hasConst e2) | (expr.lte e1 e2) := (hasConst e1) || (hasConst e2) /- We almost always use || in Lean, not the fns, what to do here? We can write that a little more compactly using the "||" notation for [orb] provided by the Bool library. -/ def hasVar : expr → bool -- normal true and false have coercions | (expr.int _) := bool.ff | (expr.var _) := bool.tt | (expr.add e1 e2) := hasVar e1 || hasVar e2 | (expr.mul e1 e2) := hasVar e1 || hasVar e2 | (expr.lte e1 e2) := hasVar e1 || hasVar e2 . /- That looks way easier! However, as the quarter progresses, we'll see that sometime defining a property as an inductive relation is more convenient. -/ --#print yo.induction_on -- #print yo.rec_on /- We can prove that our relational and functional versions agree. This shows that the [hasConst] _function_ is COMPLETE with respect to the relation [has_const]. Thus, anything that satisfies the relation evaluates to "true" under the function [hasConst]. -/ lemma has_const_hasConst: ∀ e, has_const e -> hasConst e = bool.tt := begin intros, induction e, case expr.int { simp [hasConst] }, case expr.var { cases a }, case expr.add { simp [hasConst], cases a, left, apply ih_1, assumption, right, apply ih_2, assumption }, case expr.mul { simp [hasConst], cases a, left, apply ih_1, assumption, right, apply ih_2, assumption }, case expr.lte { simp [hasConst], cases a, left, apply ih_1, assumption, right, apply ih_2, assumption } end. /- Now for the other direction. Here we'll prove that the [hasConst] _function_ is SOUND with respect to the relation. That is, if [hasConst] produces true, then there is some proof of the inductive relation [has_const]. -/ lemma hasConst_has_const: ∀ e, hasConst e = bool.tt → has_const e := begin intros, induction e, case expr.int { constructor }, /- Uh oh, no constructor for has_const can possibly produce a value of our goal type! It's OK though because we have a bogus hypothesis. -/ case expr.var { cases a, }, case expr.add { admit }, case expr.mul { admit }, case expr.lte { admit } end. -- we can stitch these two lemmas together lemma has_const_iff_hasConst: forall e, has_const e ↔ hasConst e = bool.tt := begin intros, split, apply has_const_hasConst, apply hasConst_has_const, end /- Notice all that work was only for the "true" cases! We can prove analogous facts for the "false" cases too. Here we will prove the "false" cases directly. However, note that you could use [has_const_iff_hasConst] to get a much simpler proof. -/ lemma not_has_const_hasConst: ∀ e, ¬ has_const e -> hasConst e = bool.ff := begin unfold not, intros, induction e, case expr.int { exfalso, apply a, constructor, }, case expr.var { simp [hasConst] }, case expr.add { simp [hasConst], split, apply ih_1, intros, apply a, constructor, exact a_2, apply ih_2, intros, apply a, apply has_const.add_r, exact a_2, }, case expr.mul { simp [hasConst], split, apply ih_1, intros, apply a, constructor, exact a_2, apply ih_2, intros, apply a, apply has_const.mul_r, exact a_2, }, case expr.lte { simp [hasConst], split, apply ih_1, intros, apply a, constructor, exact a_2, apply ih_2, intros, apply a, apply has_const.cmp_r, exact a_2, } end /- Here is a more direct proof based on the iff we proved for the true case. -/ lemma not_has_const_hasConst': ∀ e, ¬ has_const e → hasConst e = bool.ff := begin admit end -- Proof. -- intros. -- (** do case analysis on hasConst e *) -- (** eqn:? remembers the result in a hypothesis *) -- destruct (hasConst e) eqn:?. -- - rewrite <- has_const_iff_hasConst in Heqb. -- (** now we have hasConst e = true in our hypothesis *) -- (** We have a contradiction in our hypotheses *) -- (** discriminate won't work this time though *) -- unfold not in H. -- apply H in Heqb. -- inversion Heqb. -- - reflexivity. -- (** For the other case, this is easy *) -- Qed. /- Now the other direction of the false case -/ lemma false_hasConst_hasConst: ∀ e, hasConst e = bool.ff -> ¬ has_const e := begin admit, end -- Proof. -- unfold not. intros. -- induction e; -- (** crunch down everything in subgoals *) -- simpl in *. -- + discriminate. -- + inversion H0. -- + apply orb_false_iff in H. -- (** get both proofs out of a conjunction -- by destructing it *) -- destruct H. -- (** case analysis on H0 *) -- (** DISCUSS: how do we know to do this? *) -- inversion H0. -- - subst. auto. (** auto will chain things for us *) -- - subst. auto. -- + (** Mul case similar *) -- apply orb_false_iff in H; destruct H. -- inversion H0; subst; auto. -- + (** Lte case similar *) -- apply orb_false_iff in H; destruct H. -- inversion H0; subst; auto. -- Qed. /- Since we've proven the iff for the true case *) (** We can use it to prove the false case *) (** This is the same lemma as above, but using our previous results -/ lemma false_hasConst_hasConst': ∀ e, hasConst e = bool.ff → ¬ has_const e := begin intros, -- (** ~ X is just X -> False *) unfold not, intros, rewrite [has_const_iff_hasConst] at a_1, rewrite a_1 at a, cases a, end /- We can also do all the same sorts of proofs for has_var and hasVar -/ lemma has_var_hasVar: forall e, has_var e -> hasVar e = bool.tt := begin admit end lemma hasVar_has_var: forall e, hasVar e = bool.tt -> has_var e := begin admit -- TODO: try this without copying from above end lemma has_var_iff_hasVar: ∀ e, has_var e <-> hasVar e = bool.tt := begin admit -- TODO: try this without copying from above *) end /- we can also prove things about expressions -/ lemma expr_bottoms_out: forall e, has_const e \/ has_var e := begin intros, induction e, case expr.int { admit }, case expr.var { admit }, case expr.add { admit }, case expr.mul { admit }, case expr.lte { admit }, end /- @e could have gotten some of the has_const lemmas by being a little clever! (but then we wouldn't have learned as many tactics ;) ) -/ -- Lemma has_const_hasConst': -- forall e, -- has_const e -> -- hasConst e = true. -- Proof. -- intros. -- induction H; simpl; auto. -- + rewrite orb_true_iff. auto. -- + rewrite orb_true_iff. auto. -- + rewrite orb_true_iff. auto. -- + rewrite orb_true_iff. auto. -- + rewrite orb_true_iff. auto. -- + rewrite orb_true_iff. auto. -- Qed. -- (** or even better *) -- Lemma has_const_hasConst'': -- forall e, -- has_const e -> -- hasConst e = true. -- Proof. -- intros. -- induction H; simpl; auto; -- rewrite orb_true_iff; auto. -- Qed. -- Lemma not_has_const_hasConst'': -- forall e, -- ~ has_const e -> -- hasConst e = false. -- Proof. -- unfold not; intros. -- destruct (hasConst e) eqn:?. -- - exfalso. apply H. -- apply hasConst_has_const; auto. -- - reflexivity. -- Qed. -- Lemma false_hasConst_hasConst'': -- forall e, -- hasConst e = false -> -- ~ has_const e. -- Proof. -- unfold not; intros. -- destruct (hasConst e) eqn:?. -- - discriminate. -- - rewrite has_const_hasConst in Heqb. -- (** NOTE: we got another subgoal! *) -- * discriminate. -- * assumption. -- Qed. /- In general: Relational defns are nice when you want to use inversion. Functional defns are nice when you want to use simpl. -/ end lec3