theory Demo9 = Main:


-- {* a recursive data type: *}
datatype 'a tree = Tip | Node "'a tree" 'a "'a tree"

print_theorems

-- {* distincteness of constructors automatic: *}
lemma "Tip ~= Node l x r" by simp


-- {* case sytax, case distinction manual *}
lemma "(1::nat) \<le> (case t of Tip \<Rightarrow> 1 | Node l x r \<Rightarrow> x+1)"
  apply(case_tac t)
  apply auto
  done

-- {* inifinitely branching: *}
datatype 'a inftree = Tp | Nd 'a "nat \<Rightarrow> 'a inftree"

-- {* mutually recursive *}
datatype 
  ty = Integer | Real | RefT ref
  and
  ref = Class | Array ty



-- -----------------------------------------------------------------  

-- {* primitive recursion *}

consts
  app :: "'a list => 'a list => 'a list"
  rv :: "'a list => 'a list"

primrec
  "app Nil ys = ys"
  "app (Cons x xs) ys = Cons x (app xs ys)"

print_theorems

primrec
  "rv [] = []"
  (* complete *)


-- {* on trees *}
consts
  mirror :: "'a tree => 'a tree"
primrec
  "mirror Tip = Tip"
  "mirror (Node l x r) = Node (mirror r) x (mirror l)"

print_theorems


-- {* mutual recursion *}
consts
  has_int :: "ty \<Rightarrow> bool"
  has_int_ref :: "ref \<Rightarrow> bool"

primrec
  "has_int Integer       = True"
  "has_int Real          = False"
  "has_int (RefT T)      = has_int_ref T"

  "has_int_ref Class     = False"
  "has_int_ref (Array T) = has_int T"



-- ------------------------------------------------------------------

-- {* structural induction *}

-- {* finding lemmas *}

theorem rv_rv: "rv (rv xs) = xs"
  oops


-- {* induction heuristics *}

consts 
  itrev :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list"
primrec
  "itrev [] ys = ys"
  "itrev (x#xs) ys = itrev xs (x#ys)"

lemma "itrev xs ys = rev xs @ ys"
  oops


-- ------------------------------------------------------------------


-- {* case distinction *}

declare length_tl[simp del]

lemma "length(tl xs) = length xs - 1"
proof (cases xs)
  case Nil thus ?thesis by simp
next
  case Cons thus ?thesis by simp
qed


-- {* structural induction *}

lemma "2 * (\<Sum>i<n+1. i) = n*(n+1::nat)"
  by (induct n, simp_all)


lemma "2 * (\<Sum>i<n+1. i) = n*(n+1::nat)" (is "?P n")
proof (induct n)
  show "?P 0" by simp
next
  fix n assume "?P n"
  thus "?P (Suc n)" by simp
qed


lemma "2 * (\<Sum>i<n+1. i) = n*(n+1::nat)"
proof (induct n)
  case 0 show ?case by simp
next
  case Suc thus ?case by simp
qed


lemma fixes n::nat shows "n < n*n + 1"
proof (induct n)
  case 0 show ?case by simp
next
  case (Suc i) thus "Suc i < Suc i * Suc i + 1" by simp
qed



-- {* induction with @{text"\<And>"} or @{text"\<Longrightarrow>"} *}

lemma 
  assumes A: "(\<And>n. (\<And>m. m < n \<Longrightarrow> P m) \<Longrightarrow> P n)"
  shows "P (n::nat)"
proof (rule A)
  show "\<And>m. m < n \<Longrightarrow> P m"
  proof (induct n)
    case 0 thus ?case by simp
  next
    case (Suc n)   
    show ?case    
    proof cases
      assume eq: "m = n"
      from Suc and A have "P n" by blast
      with eq show "P m" by simp
    next
      assume "m \<noteq> n"
      with Suc have "m < n" by arith
      thus "P m" by(rule Suc)
    qed
  qed
qed


end
