namespace lec3

/- A little magic ... -/
local attribute [intro] and.intro
local attribute [intro] or.inl
local attribute [intro] or.inr

meta def auto := tactic.back_chaining_using_hs
/- End magic ... -/

-- `Prop` is the 'type' of propositions.
#print Prop

/-- `true` is reserved for the type of true propositions, the `true` defined
     in Lean is not built in and is defined exactly the same. -/
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 is no way to build a value of `false`, if
    -- we have one in our context we must of derived a
    -- contradiction which allowed us to prove
    -- false.
    --
    -- `cases` can do case analysis to prove that a
    -- type with zero constructors allows us to prove
    -- anything we want and discharge the goal.
    cases a,
end

lemma foo' : Type :=
begin
  exact bool,
end

lemma also_bogus:
  1 = 2 → false :=
begin
    intros,
    cases a,
end

/- Note: even equality is defined in Lean and not baked into the theory. -/
#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,
  cases a,
  -- Now this works!
  induction a,
  assumption
end.

lemma foo :
  yo -> true :=
begin
  intros,
  induction a,
  assumption,
  -- alternatively...
  -- exact true.intro,

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 ⟩

notation x `[+]` y := expr.add x y
notation x `[*]` y := expr.mul x y
notation x `[<=]` y := expr.lte x y

#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,
  specialize (a nat.zero "foo"),
  cases a,
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

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 },
  { simp [number_of_consts, expr.size],
    apply add_le_add ; assumption },
  { simp [number_of_consts, expr.size],
    apply add_le_add ; assumption },
  { simp [number_of_consts, expr.size],
    apply add_le_add ; assumption },
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).

/- A little more magic. -/
attribute [intro] has_var.var
attribute [intro] has_var.add_r
attribute [intro] has_var.add_l
attribute [intro] has_var.add_l
attribute [intro] has_var.mul_l
attribute [intro] has_var.mul_r
attribute [intro] has_var.add_l
attribute [intro] has_var.cmp_r
attribute [intro] has_var.cmp_l
attribute [intro] has_const.int
attribute [intro] has_const.add_l
attribute [intro] has_const.mul_l
attribute [intro] has_const.mul_r
attribute [intro] has_const.add_l
attribute [intro] has_const.cmp_r
attribute [intro] has_const.cmp_l

/- We can also write boolean functions
   that check the same properties.

    Note that `bor` 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 can write that a little more compactly using
   the `||` notation for `orb` provided by
   the Bool library.
-/

def hasVar : expr → bool
| (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 b {
    cases b,
  },
  case expr.add {
    simp [hasConst] at a,
    cases a,
    apply has_const.add_l,
    apply ih_1,
    assumption,
    apply has_const.add_r,
    apply ih_2,
    assumption,
  },
  case expr.mul {
    simp [hasConst] at a,
    cases a,
    apply has_const.mul_l,
    apply ih_1,
    assumption,
    apply has_const.mul_r,
    apply ih_2,
    assumption,
  },
  case expr.lte {
    simp [hasConst] at a,
    cases a,
    apply has_const.cmp_l,
    apply ih_1,
    assumption,
    apply has_const.cmp_r,
    apply ih_2,
    assumption,
  },
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
  delta 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
  intros,
  destruct (hasConst e); intros,
  { rw has_const_iff_hasConst at a,
    assumption
  },
  { rw has_const_iff_hasConst at a,
    contradiction }
end

/- Now the other direction of the false case -/
lemma false_hasConst_hasConst:
  ∀ e,
  hasConst e = bool.ff ->
  ¬ has_const e :=
begin
  delta not, intros,
  induction e ; intros,
  case expr.int {
    simp [hasConst] at *,
    assumption
  },
  case expr.var {
    cases a_1,
  },
  case expr.add {
    simp [hasConst] at *,
    -- DISCUSS: how do we know to do this?
    cases a; cases a_1 ; auto
  },
  case expr.mul {
    simp [hasConst] at *,
    cases a; cases a_1 ; auto
  },
  case expr.lte {
    simp [hasConst] at *,
    cases a; cases a_1 ; auto
  }
end

/- Since we've proven the ↔ for the true case, we can use
   it to prove the false case. This is the same lemma as above,
   but re-using our previous results. -/
lemma false_hasConst_hasConst':
  ∀ e,
  hasConst e = bool.ff →
  ¬  has_const e :=
begin
  intros,
  -- ¬ X is just X → Fals
  delta 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
  intros, induction e,
  case expr.int { cases a },
  case expr.var { simp [hasVar] },
  case expr.add { simp [hasVar], cases a; auto },
  case expr.mul { simp [hasVar], cases a; auto },
  case expr.lte { simp [hasVar], cases a; auto },
end

#print has_var

lemma hasVar_has_var:
  forall e,
  hasVar e = bool.tt ->
  has_var e :=
begin
  intros,
  induction e,
  { cases a, },
  { constructor },
  { simp [hasVar] at a,
    cases a,
    { auto, },
    { auto, },  }
    ...
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 { left, constructor },
  case expr.var { right, constructor },
  case expr.add { cases ih_1 ; cases ih_2 ; auto },
  case expr.mul { cases ih_1 ; cases ih_2 ; auto },
  case expr.lte { cases ih_1 ; cases ih_2 ; auto },
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 = tt :=
begin
  intros ; induction e ; simp [hasConst] at *,
  cases a,
  cases a; auto,
  cases a; auto,
  cases a; auto
end

-- or even better
lemma has_const_hasConst'':
  forall e,
  has_const e ->
  hasConst e = tt :=
begin
  intros,
  induction a; simp [hasConst]; auto
end

lemma not_has_const_hasConst'':
  forall e,
  ¬ has_const e →
  hasConst e = ff :=
begin
  delta not, intros,
  destruct (hasConst e) ; intros,
  { auto },
  { exfalso, apply a,
    rw has_const_iff_hasConst,
    assumption }
end

lemma false_hasConst_hasConst'':
  forall e,
  hasConst e = ff →
  ¬ has_const e :=
begin
  delta not; intros,
  destruct (hasConst e) ; intros,
  {  rw has_const_hasConst at a,
     contradiction,
     assumption },
  { rw has_const_hasConst at a,
    { contradiction },
    { assumption }
  }
end

/- In general:

   Relational definitions are nice for case analysis.

   Functional defns are nice when you want to
   compute/rewrite with them.
-/

namespace solutions

lemma hasVar_has_var:
  forall e,
  hasVar e = bool.tt ->
  has_var e :=
begin
  intros, induction e,
  case expr.int { cases a },
  all_goals { simp [hasVar] at a; cases a ; auto },
end

lemma has_var_iff_hasVar:
  ∀ e,
  has_var e <-> hasVar e = bool.tt :=
begin
  intros, constructor,
  apply has_var_hasVar,
  apply hasVar_has_var,
end

end solutions

end lec3