-- Lecture 03
namespace more_intro

-- In the last lecture we introduced you to the primitives of Lean's *inductive*
-- types. Lean's mechanism for creating data types.

-- We defined our own versions of `bool`, and `nat` in the previous lecture, but
-- Lean has already defined them for us with extra goodies.

-- VSCode (and Emacs) will allow you to hover over the interaction points
-- (marked by squiggles) below.
#check bool
#check nat

#print bool
#print nat

-- The above calls to print show that the defined very similarly to the way we
-- defined them in `lec01`.

-- VSCode also allows you to go-to-definition on any Lean symbol (show example).

-- The standard library's provides many definitions for the built in types,
-- for example `bool`s have useful operators defined for them, for example
-- `x && y` for logical and.
#check tt
#check ff

-- Try to also hover over the operator `&&` you should be able to see its
-- English name. This feature works for all operators in Lean, if you ever want
-- to know the underlying definition of an operator, just hover.
#check (tt && ff)
#check (tt || ff)

-- The standard library's natural numbers also can be written as numeric
-- literals, as well as many operators.
--
-- i.e `0`, `1000`, and operators.

#eval (1 + 2)
#eval (10 + 11)

#check (1 + 2)
#check 1

namespace last_lecture
-- In the last lecture we defined a list type like the one below, as stated above Lean
-- also defines `list` for us.

inductive list (t : Type) : Type
| nil {} : list
| cons : t → list → list

end last_lecture

-- We will use the builtin List type for the rest of the course, as it provides
-- many useful definitions and theorems.
--
-- If you want to see the definition of `list` simply cmd or ctrl click on the type.

/-- Compute the length of a list. -/
def length {t : Type} : list t → nat
| list.nil := nat.zero
| (list.cons x xs) := nat.succ (length xs)

namespace learn_open
-- Typing out the full namespace for constructors can get annoying quickly.

-- It would be nice if we could just make those names availble in our current scope.

-- We can use the `open` keyword to bring all the names contianed in a namespaces
-- into scope.

-- For example to open `list.
open list

#check (cons 1 nil)

#eval (length (list.cons 1 list.nil))
#eval (length (list.cons 2 (list.cons 1 list.nil)))

end learn_open

-- When we close a namespace the names opened are no longer availble, for
-- example this now fails:
#check cons

-- For `list` we actually get some nice syntax, so we don't need to constantly
-- open the namespace.

#check [] -- empty list
#check [1,2,3] -- list with 1,2,3
#check 1 :: 2 :: 3 :: [] -- list with 1,2,3

def countdown : nat → list nat
| 0 := [0]
| (m + 1) := (m + 1) :: (countdown m)

#eval (countdown 0)
#eval (countdown 1)
#eval (countdown 3)
#eval (countdown 10)

-- We can even pattern match using `list` syntax.

/-- 

Apply a function `f : a → b` to a `list a`, produce a new list of type `list b`
containing the elements from the first list transformed by `f`.

-/
def map {a b: Type} (f: a → b) : list a → list b
| [] := list.nil
| (x :: xs) := (f x) :: (map xs)

#eval (map (+ 1) (countdown 3))
#eval (map (λ _, tt) (countdown 3))

def is_zero : nat → bool
| 0 := tt
| (m + 1) := ff

#eval (map is_zero (countdown 3))

def is_even : nat → bool
| 0 := tt
| 1 := ff
| ((m + 1) + 1) := is_even m

#eval (map is_even (countdown 3))

#check length

lemma foo :
  forall A B (f : A -> B) a b,
  a = b ->
  f a = f b :=
begin
  admit
end

lemma map_length_invariant :
  forall (a b : Type) (f : a → b) (l : list a),
  length (map f l) = length l :=
begin
  intros,
  induction l,
  { simp [map, length] },
  { simp [map, length], congr, assumption }
end

/-

What is induction doing here?

Essentially, we're giving a function for how to transform
a value of the type we're inducting over into a proof of
the goal.  The function shows how to do it for *any* value
of the type we're inducting over.  Think of it as telling
you how to replace the nodes in the tree representing a
value given the ability to replace all its child nodes.

-/

def compose {a b c : Type}
  (f : b → c)
  (g : a → b)
  (x : a) : c := f (g x)

lemma map_map_compose:
  forall (a b c: Type)
         (g: a → b) (f : b -> c) (l : list a),
  map f (map g l) = map (compose f g) l :=
begin
  intros ; induction l,
  { simp [map] },
  { simp [map], rw ih_1, reflexivity }
end

def foldr {a b : Type} (f : a → b → b) : list a → b → b
| list.nil b := b
| (list.cons x xs) b := f x (foldr xs b)

-- (**
--  foldr f (cons 1 (cons 2 (cons 3 nil))) x
--  -->
--  f 1 (f 2 (f 3 x))
-- *)

#check (+)

#eval (foldr (+) (countdown 10) 0)
#eval (foldr (+) (countdown 10) 0)

def fact : nat → nat
| 0 := 1
| (m + 1) := nat.mul (m + 1) (fact m)

#eval (fact 0).
#eval (fact 1).
#eval (fact 2).
#eval (fact 3).
#eval (fact 4).

def fact' : nat → nat
| 0 :=
    1
| (nat.succ m) :=
    foldr (nat.mul) (map (+1) (countdown m)) 1

#eval (fact' 0).
#eval (fact' 1).
#eval (fact' 2).
#eval (fact' 3).
#eval (fact' 4).

lemma fact'_step :
  forall n,
  fact' (nat.succ n) = nat.mul (nat.succ n) (fact' n) :=
begin
  intros,
  induction n,
  { reflexivity, },
  { 
    simp [fact', countdown, map, foldr],
  }
end

lemma fact_fact':
  forall n,
  fact n = fact' n :=
begin
  intros,
  induction n,
  { simp [fact, fact'], },
  { simp [fact],  rw fact'_step, rw ih_1, }
end

-- we can also define map using fold
def map' {a b : Type} (f : a → b) (l : list a) : list b :=
  foldr (λ x acc, (f x) :: acc) l []

lemma map_map':
  forall (a b : Type) (f: a → b) (l : list a),
  map f l = map' f l :=
begin
  intros,
  induction l,
  { simp [map, map'], trivial },
  { simp [map, map', foldr] at *, congr, rw ih_1, }
end.

-- We can add another flavor of fold which goes from left.
def foldl (A B: Type) (f: A → B → B) : list A → B → B
| [] b := b
| (x :: xs) b := foldl xs (f x b)

def append {a : Type} : list a → list a → list a
| [] l2 := l2
| (x :: xs) l2 := x :: (append xs l2)

#eval (append [1,2,3])

lemma app_nil :
  forall (a : Type) (l : list a),
  append l [] = l :=
begin
  intros, induction l,
  { simp [append] },
  { simp [append] at *,
    rw ih_1 }
end

theorem app_assoc:
  forall (a : Type) (l1 l2 l3: list a),
  append (append l1 l2) l3 = append l1 (append l2 l3) :=
begin
  intros ; induction l1,
  { simp [append] at *  },
  { simp [append] at *, rw ih_1 }
end

-- (** simple but inefficient way to reverse a list *)
def reverse {a : Type} : list a → list a
| [] := []
| (x :: xs) := append (reverse xs) [x]

#eval (countdown 5)
#eval (reverse (countdown 5))

-- tail recursion is faster, but more complicated
def fast_rev_aux {a : Type} : list a → list a → list a
| [] acc := acc
| (x :: xs) acc := fast_rev_aux xs (x :: acc)

def fast_rev {a : Type} (l : list a) : list a :=
fast_rev_aux l []

-- We now want to prove that our optimization to `reverse`
-- did not change the behavior of it in anyway.
theorem rev_eq_fast_rev_fail :
  forall a (l : list a),
  fast_rev l = reverse l :=
begin
  intros, induction l,
  { simp [fast_rev, fast_rev_aux, reverse] },
  { simp [fast_rev, fast_rev_aux, reverse] at *,
--     this looks like it could be trouble...
--     STUCK! need to know about the rev_aux accumulator (acc)
--     TIP: if your IH seems weak, try proving something more general
     }
end.

lemma fast_rev_aux_ok_fail:
   forall A (l1 l2: list A),
   fast_rev_aux l1 l2 = append (reverse l1) l2 :=
begin
  intros,
  induction l1,
  { reflexivity, }
  { simp [fast_rev_aux], 
  -- STUCK AGAIN!  need to know for *any* l2
  -- TIP: if your IH seems weak, only intro up to the
  --      var you are inducting over
  }
end

lemma fast_rev_aux_ok:
  forall (a : Type) (l1 l2: list a),
  fast_rev_aux l1 l2 = append (reverse l1) l2 :=
begin
  intros a l1,
  induction l1 ; intros,
  { simp [fast_rev_aux, append, reverse] },
  { simp [fast_rev_aux, append, reverse] at *,
    rw ih_1,
    rw app_assoc,
    reflexivity
  }
end

lemma fast_rev_rev_ok:
  forall a (l: list a),
  fast_rev l = reverse l :=
begin
  intros,
  simp [fast_rev, fast_rev_aux_ok, app_nil],
end.

/-- Add an element to the end of a list. -/
def snoc {a : Type} : list a → a → list a
| [] x := [x]
| (y :: ys) x := y :: (snoc ys x).

theorem snoc_app_singleton:
  forall A (l: list A) (x: A),
  snoc l x = append l (x :: []) :=
begin
  intros,
  induction l,
  { simp [snoc, append] },
  { simp [snoc, append, ih_1] },
end

theorem app_snoc_l:
  forall A (l1: list A) (l2: list A) (x: A),
  append (snoc l1 x) l2 = append l1 (x :: l2) :=
begin
  intros,
  induction l1,
  { simp [append, snoc] },
  { simp [append, snoc, ih_1] }
end.

theorem app_snoc_r:
  forall A (l1: list A) (l2: list A) (x: A),
  append l1 (snoc l2 x) = snoc (append l1 l2) x :=
begin
  intros ; induction l1,
  { simp [append, snoc] },
  { simp [append, snoc, ih_1] }
end.

/- A simple but inefficient way to reverse a list. -/
def rev_snoc {a : Type} : list a → list a
| [] := []
| (x :: xs) := snoc (rev_snoc xs) x

lemma fast_rev_aux_ok_snoc:
  forall (a : Type) (l1 l2 : list a),
  fast_rev_aux l1 l2 = append (rev_snoc l1) l2 :=
begin
  intros a l1 ; induction l1 ; intros,
  { simp [fast_rev_aux, append, rev_snoc] },
  { simp [fast_rev_aux, rev_snoc, snoc, app_snoc_l, ih_1] }
end.

lemma fast_rev_ok_snoc:
  forall (a : Type) (l : list a),
  fast_rev l = rev_snoc l :=
begin
  intros,
  induction l,
  { simp [fast_rev, fast_rev_aux, rev_snoc] },
  { simp [fast_rev, fast_rev_aux_ok_snoc, app_nil] }
end

lemma length_app:
  forall (a : Type) (l1 l2: list a),
  length (append l1 l2) = (length l1) + (length l2) :=
begin
  intros ; induction l1,
  { simp [length, append] },
  { simp [length, append, ih_1] }
end.

lemma one_plus_n_succ_n :
  forall n, 1 + n = nat.succ n :=
begin
  intros n,
  induction n,
  { simp },
  { simp [ih_1] }
end

lemma rev_length:
  forall (a : Type) (l : list a),
  length (reverse l) = length l :=
begin
  intros,
  induction l,
  { simp [reverse] },
  { simp [reverse, length_app, length, one_plus_n_succ_n, ih_1] }
end.

lemma rev_app:
  forall (a : Type) (l1 l2: list a),
  reverse (append l1 l2) = append (reverse l2) (reverse l1) :=
begin
  intros,
  induction l1,
  { simp [reverse, append, app_nil] },
  { simp [ih_1, reverse, append, app_assoc] }
end.

lemma rev_involutive:
  forall (a : Type) (l: list a),
  reverse (reverse l) = l :=
begin
  intros,
  induction l,
  { simp [reverse, append] },
  { simp [reverse, append, rev_app, ih_1] }
end.

-- SYNTAX

-- We can define a programming language as an inductive datatype.

/--
  E ::= N | V | E + E | E * E | E ? E
-/
inductive exp : Type
| const : nat -> exp
| var   : string -> exp
| add   : exp -> exp -> exp
| mul   : exp -> exp -> exp
| cmp   : exp -> exp -> exp

/--
  S ::= Skip | V <- E | S ;; S |
        IF E THEN S ELSE S |
        WHILE E {{ S }}
-/
inductive stmt : Type
| skip  : stmt
| assign : string → exp → stmt
| seq : stmt → stmt → stmt
| cond  : exp → stmt → stmt → stmt
| while : exp → stmt → stmt

-- Programs are just elements of type stmt.

open stmt
open exp

def prog_skip : stmt := skip

def prog_set_x : stmt :=
assign "x" (const 1)

def prog_incr_x_forever : stmt :=
while (const 1) (assign "x" (const 1))

def prog_xth_fib_in_y : stmt :=
  seq (assign "y" (const 0)) (
  seq (assign "y0" (const 1)) (
  seq    (assign "y1" (const 0)) (
  seq    (assign "i" (const 0)) (
       (while (cmp (var "i") (var "x")) (
          seq (assign "y" (add (var "y0") (var "y1"))) (
            seq (assign "y0" (var "y1")) (
            seq (assign "y1" (var "y")) (
              (assign "i" (add (var "i") (const 1)
            )))))
        ))))))

-- nobody wants to write programs like this,
-- so Lean provides various notation mechanisms

instance coe_int_to_expr : has_coe nat exp :=
⟨ const ⟩

instance coe_string_to_expr : has_coe string exp :=
⟨ var ⟩

local infixl `<+>`:84 := add
local infixl `<*>`:85 := mul
local infix `<?>`:83 := cmp
local infix `<=`:82:= assign
local infixr `;;`:81 := seq
notation `IF` c `THEN` t:45 `ELSE` e:45 := ite c t e
notation `WHILE`:80 X `{{` Y `}}` := while X Y

def prog_fib : stmt :=
   "y"  <= (0:nat) ;;
   "y0" <= (0:nat) ;;
   "y1" <= (0:nat) ;;
   "i" <= (0:nat) ;;
   WHILE ("i" <?> "x") {{
     "y" <= "y0" <+> "y1" ;;
     "y0" <= "y1" ;;
     "y1" <= "y" ;;
     "i" <= "i" <+> (1:nat)
   }}

-- set_option pp.notation false
-- #print prog_fib

-- Notation provides us with "concrete" syntax which
-- "desugars" to the underlying "abstract syntax tree".

def num_consts : exp → nat
| (exp.const _) := 1
| (exp.var _) := 0
| (exp.add e1 e2) := num_consts e1 + num_consts e2
| (exp.mul e1 e2) := num_consts e1 + num_consts e2
| (exp.cmp e1 e2) := (num_consts e1) + num_consts e2

meta def simp_coe :=
  `[unfold coe lift_t has_lift_t.lift coe_t has_coe_t.coe coe_b has_coe.coe,
    try { dsimp * at * }]

lemma has_3_consts :
  ∃ e, num_consts e = 3 :=
begin
  existsi ((1:nat) <+> (2:nat) <+> (3:nat)),
  simp_coe, simp [num_consts],
end

def expr_with_n_consts : nat → exp
| 0 := "x"
| (nat.succ m) := (0:nat) <+> expr_with_n_consts m

lemma has_n_consts:
  ∀ (n:nat), ∃ e, num_consts e = n :=
begin
  intros,
  existsi (expr_with_n_consts n),
  induction n,
  { simp [expr_with_n_consts], simp_coe,
    simp [num_consts] },
  { simp [expr_with_n_consts], simp_coe,
    simp [num_consts], rw ih_1 }
end

def has_const : exp → bool
| (const _) := tt
| (exp.var _) := ff
| (exp.add e1 e2) := has_const e1 || has_const e2
| (exp.mul e1 e2) := has_const e1 || has_const e2
| (exp.cmp e1 e2) := has_const e1 || has_const e2

def has_var : exp → bool
| (const _) := ff
| (exp.var _) := tt
| (exp.add e1 e2) := has_var e1 || has_var e2
| (exp.mul e1 e2) := has_var e1 || has_var e2
| (exp.cmp e1 e2) := has_var e1 || has_var e2

lemma expr_bottoms_out:
   forall e,
   (has_const e) || (has_var e) = tt :=
begin
  intros,
  induction e,
  case exp.const {
    simp [has_const],
  },
  case exp.var {
    simp [has_const, has_var],
  },
  case exp.add e1 e2 {
    destruct (has_const e1) ; intros,
    { simp [has_const, has_var, *] at * },
    { destruct (has_const e2) ; intros,
      simp [has_const, has_var] at *,
      rewrite a_1 at ih_2,
      cases ih_2, contradiction,
      rw a at ih_1,
      simp [ih_1, *],
      simp [has_const],
      simp [a, a_1],
    },
  },
  case exp.mul e1 e2 {
    destruct (has_const e1) ; intros,
    { simp [has_const, has_var, *] at * },
    { destruct (has_const e2) ; intros,
      simp [has_const, has_var] at *,
      rewrite a_1 at ih_2,
      cases ih_2, contradiction,
      rw a at ih_1,
      simp [ih_1, *],
      simp [has_const],
      simp [a, a_1],
    },
  },
  case exp.cmp e1 e2 {
    destruct (has_const e1) ; intros,
    { simp [has_const, has_var, *] at * },
    { destruct (has_const e2) ; intros,
      simp [has_const, has_var] at *,
      rewrite a_1 at ih_2,
      cases ih_2, contradiction,
      rw a at ih_1,
      simp [ih_1, *],
      simp [has_const],
      simp [a, a_1],
    },
  },
end

-- THE ABOVE PROOF IS VERY BAD.  Make it better!
-- Hint: think about how to rearrange the orbs.

/- Some Interesting Types -/

section my_little_types

inductive true : Prop
| intro : true

inductive false : Prop

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

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

inductive yo : Prop
| yolo : yo → yo

lemma yoyo : yo → false :=
begin
  intros,
  cases a,
  -- Well, that didn't work
  induction a,
  assumption
end

end my_little_types
end more_intro