(*  Title:      HOL/ex/Functions.thy
    Author:     Alexander Krauss, TU Muenchen
*)

section \<open>Examples of function definitions\<close>

theory Functions
imports MainRLT "HOL-Library.Monad_Syntax"
begin

subsection \<open>Very basic\<close>

fun fib :: "nat \<Rightarrow> nat"
where
  "fib 0 = 1"
| "fib (Suc 0) = 1"
| "fib (Suc (Suc n)) = fib n + fib (Suc n)"

text \<open>Partial simp and induction rules:\<close>
thm fib.psimps
thm fib.pinduct

text \<open>There is also a cases rule to distinguish cases along the definition:\<close>
thm fib.cases

text \<open>Total simp and induction rules:\<close>
thm fib.simps
thm fib.induct

text \<open>Elimination rules:\<close>
thm fib.elims

subsection \<open>Currying\<close>

fun add
where
  "add 0 y = y"
| "add (Suc x) y = Suc (add x y)"

thm add.simps
thm add.induct  \<comment> \<open>Note the curried induction predicate\<close>

subsection \<open>Nested recursion\<close>

function nz
where
  "nz 0 = 0"
| "nz (Suc x) = nz (nz x)"
by pat_completeness auto

lemma nz_is_zero:  \<comment> \<open>A lemma we need to prove termination\<close>
  assumes trm: "nz_dom x"
  shows "nz x = 0"
using trm
by induct (auto simp: nz.psimps)

termination nz
  by (relation "less_than") (auto simp:nz_is_zero)

thm nz.simps
thm nz.induct

subsubsection \<open>Here comes McCarthy's 91-function\<close>

function f91 :: "nat \<Rightarrow> nat"
where
  "f91 n = (if 100 < n then n - 10 else f91 (f91 (n + 11)))"
by pat_completeness auto

text \<open>Prove a lemma before attempting a termination proof:\<close>
lemma f91_estimate:
  assumes trm: "f91_dom n"
  shows "n < f91 n + 11"
using trm by induct (auto simp: f91.psimps)

termination
proof
  let ?R = "measure (\<lambda>x. 101 - x)"
  show "wf ?R" ..

  fix n :: nat
  assume "\<not> 100 < n"  \<comment> \<open>Inner call\<close>
  then show "(n + 11, n) \<in> ?R" by simp

  assume inner_trm: "f91_dom (n + 11)"  \<comment> \<open>Outer call\<close>
  with f91_estimate have "n + 11 < f91 (n + 11) + 11" .
  with \<open>\<not> 100 < n\<close> show "(f91 (n + 11), n) \<in> ?R" by simp
qed

text \<open>Now trivial (even though it does not belong here):\<close>
lemma "f91 n = (if 100 < n then n - 10 else 91)"
  by (induct n rule: f91.induct) auto

subsubsection \<open>Here comes Takeuchi's function\<close>

definition tak_m1 where "tak_m1 = (\<lambda>(x,y,z). if x \<le> y then 0 else 1)"
definition tak_m2 where "tak_m2 = (\<lambda>(x,y,z). nat (Max {x, y, z} - Min {x, y, z}))"
definition tak_m3 where "tak_m3 = (\<lambda>(x,y,z). nat (x - Min {x, y, z}))"

function tak :: "int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int" where
  "tak x y z = (if x \<le> y then y else tak (tak (x-1) y z) (tak (y-1) z x) (tak (z-1) x y))"
  by auto

lemma tak_pcorrect:
  "tak_dom (x, y, z) \<Longrightarrow> tak x y z = (if x \<le> y then y else if y \<le> z then z else x)"
  by (induction x y z rule: tak.pinduct) (auto simp: tak.psimps)

termination
  by (relation "tak_m1 <*mlex*> tak_m2 <*mlex*> tak_m3 <*mlex*> {}")
     (auto simp: mlex_iff wf_mlex tak_pcorrect tak_m1_def tak_m2_def tak_m3_def min_def max_def)

theorem tak_correct: "tak x y z = (if x \<le> y then y else if y \<le> z then z else x)"
  by (induction x y z rule: tak.induct) auto

subsection \<open>More general patterns\<close>

subsubsection \<open>Overlapping patterns\<close>

text \<open>
  Currently, patterns must always be compatible with each other, since
  no automatic splitting takes place. But the following definition of
  GCD is OK, although patterns overlap:
\<close>

fun gcd2 :: "nat \<Rightarrow> nat \<Rightarrow> nat"
where
  "gcd2 x 0 = x"
| "gcd2 0 y = y"
| "gcd2 (Suc x) (Suc y) = (if x < y then gcd2 (Suc x) (y - x)
                                    else gcd2 (x - y) (Suc y))"

thm gcd2.simps
thm gcd2.induct

subsubsection \<open>Guards\<close>

text \<open>We can reformulate the above example using guarded patterns:\<close>

function gcd3 :: "nat \<Rightarrow> nat \<Rightarrow> nat"
where
  "gcd3 x 0 = x"
| "gcd3 0 y = y"
| "gcd3 (Suc x) (Suc y) = gcd3 (Suc x) (y - x)" if "x < y"
| "gcd3 (Suc x) (Suc y) = gcd3 (x - y) (Suc y)" if "\<not> x < y"
  apply (case_tac x, case_tac a, auto)
  apply (case_tac ba, auto)
  done
termination by lexicographic_order

thm gcd3.simps
thm gcd3.induct

text \<open>General patterns allow even strange definitions:\<close>

function ev :: "nat \<Rightarrow> bool"
where
  "ev (2 * n) = True"
| "ev (2 * n + 1) = False"
proof -  \<comment> \<open>completeness is more difficult here \dots\<close>
  fix P :: bool
  fix x :: nat
  assume c1: "\<And>n. x = 2 * n \<Longrightarrow> P"
    and c2: "\<And>n. x = 2 * n + 1 \<Longrightarrow> P"
  have divmod: "x = 2 * (x div 2) + (x mod 2)" by auto
  show P
  proof (cases "x mod 2 = 0")
    case True
    with divmod have "x = 2 * (x div 2)" by simp
    with c1 show "P" .
  next
    case False
    then have "x mod 2 = 1" by simp
    with divmod have "x = 2 * (x div 2) + 1" by simp
    with c2 show "P" .
  qed
qed presburger+  \<comment> \<open>solve compatibility with presburger\<close>
termination by lexicographic_order

thm ev.simps
thm ev.induct
thm ev.cases

subsection \<open>Mutual Recursion\<close>

fun evn od :: "nat \<Rightarrow> bool"
where
  "evn 0 = True"
| "od 0 = False"
| "evn (Suc n) = od n"
| "od (Suc n) = evn n"

thm evn.simps
thm od.simps

thm evn_od.induct
thm evn_od.termination

thm evn.elims
thm od.elims

subsection \<open>Definitions in local contexts\<close>

locale my_monoid =
  fixes opr :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
    and un :: "'a"
  assumes assoc: "opr (opr x y) z = opr x (opr y z)"
    and lunit: "opr un x = x"
    and runit: "opr x un = x"
begin

fun foldR :: "'a list \<Rightarrow> 'a"
where
  "foldR [] = un"
| "foldR (x # xs) = opr x (foldR xs)"

fun foldL :: "'a list \<Rightarrow> 'a"
where
  "foldL [] = un"
| "foldL [x] = x"
| "foldL (x # y # ys) = foldL (opr x y # ys)"

thm foldL.simps

lemma foldR_foldL: "foldR xs = foldL xs"
  by (induct xs rule: foldL.induct) (auto simp:lunit runit assoc)

thm foldR_foldL

end

thm my_monoid.foldL.simps
thm my_monoid.foldR_foldL

subsection \<open>\<open>fun_cases\<close>\<close>

subsubsection \<open>Predecessor\<close>

fun pred :: "nat \<Rightarrow> nat"
where
  "pred 0 = 0"
| "pred (Suc n) = n"

thm pred.elims

lemma
  assumes "pred x = y"
  obtains "x = 0" "y = 0" | "n" where "x = Suc n" "y = n"
  by (fact pred.elims[OF assms])

text \<open>If the predecessor of a number is 0, that number must be 0 or 1.\<close>

fun_cases pred0E[elim]: "pred n = 0"

lemma "pred n = 0 \<Longrightarrow> n = 0 \<or> n = Suc 0"
  by (erule pred0E) metis+

text \<open>
  Other expressions on the right-hand side also work, but whether the
  generated rule is useful depends on how well the simplifier can
  simplify it. This example works well:
\<close>

fun_cases pred42E[elim]: "pred n = 42"

lemma "pred n = 42 \<Longrightarrow> n = 43"
  by (erule pred42E)

subsubsection \<open>List to option\<close>

fun list_to_option :: "'a list \<Rightarrow> 'a option"
where
  "list_to_option [x] = Some x"
| "list_to_option _ = None"

fun_cases list_to_option_NoneE: "list_to_option xs = None"
  and list_to_option_SomeE: "list_to_option xs = Some x"

lemma "list_to_option xs = Some y \<Longrightarrow> xs = [y]"
  by (erule list_to_option_SomeE)

subsubsection \<open>Boolean Functions\<close>

fun xor :: "bool \<Rightarrow> bool \<Rightarrow> bool"
where
  "xor False False = False"
| "xor True True = False"
| "xor _ _ = True"

thm xor.elims

text \<open>
  \<open>fun_cases\<close> does not only recognise function equations, but also works with
  functions that return a boolean, e.g.:
\<close>

fun_cases xor_TrueE: "xor a b" and xor_FalseE: "\<not>xor a b"
print_theorems

subsubsection \<open>Many parameters\<close>

fun sum4 :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
  where "sum4 a b c d = a + b + c + d"

fun_cases sum40E: "sum4 a b c d = 0"

lemma "sum4 a b c d = 0 \<Longrightarrow> a = 0"
  by (erule sum40E)

subsection \<open>Partial Function Definitions\<close>

text \<open>Partial functions in the option monad:\<close>

partial_function (option)
  collatz :: "nat \<Rightarrow> nat list option"
where
  "collatz n =
    (if n \<le> 1 then Some [n]
     else if even n
       then do { ns \<leftarrow> collatz (n div 2); Some (n # ns) }
       else do { ns \<leftarrow> collatz (3 * n + 1);  Some (n # ns)})"

declare collatz.simps[code]
value "collatz 23"

text \<open>Tail-recursive functions:\<close>

partial_function (tailrec) fixpoint :: "('a \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a"
where
  "fixpoint f x = (if f x = x then x else fixpoint f (f x))"

subsection \<open>Regression tests\<close>

text \<open>
  The following examples mainly serve as tests for the
  function package.
\<close>

fun listlen :: "'a list \<Rightarrow> nat"
where
  "listlen [] = 0"
| "listlen (x#xs) = Suc (listlen xs)"

subsubsection \<open>Context recursion\<close>

fun f :: "nat \<Rightarrow> nat"
where
  zero: "f 0 = 0"
| succ: "f (Suc n) = (if f n = 0 then 0 else f n)"

subsubsection \<open>A combination of context and nested recursion\<close>

function h :: "nat \<Rightarrow> nat"
where
  "h 0 = 0"
| "h (Suc n) = (if h n = 0 then h (h n) else h n)"
by pat_completeness auto

subsubsection \<open>Context, but no recursive call\<close>

fun i :: "nat \<Rightarrow> nat"
where
  "i 0 = 0"
| "i (Suc n) = (if n = 0 then 0 else i n)"

subsubsection \<open>Tupled nested recursion\<close>

fun fa :: "nat \<Rightarrow> nat \<Rightarrow> nat"
where
  "fa 0 y = 0"
| "fa (Suc n) y = (if fa n y = 0 then 0 else fa n y)"

subsubsection \<open>Let\<close>

fun j :: "nat \<Rightarrow> nat"
where
  "j 0 = 0"
| "j (Suc n) = (let u = n in Suc (j u))"

text \<open>There were some problems with fresh names \dots\<close>
function  k :: "nat \<Rightarrow> nat"
where
  "k x = (let a = x; b = x in k x)"
  by pat_completeness auto

function f2 :: "(nat \<times> nat) \<Rightarrow> (nat \<times> nat)"
where
  "f2 p = (let (x,y) = p in f2 (y,x))"
  by pat_completeness auto

subsubsection \<open>Abbreviations\<close>

fun f3 :: "'a set \<Rightarrow> bool"
where
  "f3 x = finite x"

subsubsection \<open>Simple Higher-Order Recursion\<close>

datatype 'a tree = Leaf 'a | Branch "'a tree list"

fun treemap :: "('a \<Rightarrow> 'a) \<Rightarrow> 'a tree \<Rightarrow> 'a tree"
where
  "treemap fn (Leaf n) = (Leaf (fn n))"
| "treemap fn (Branch l) = (Branch (map (treemap fn) l))"

fun tinc :: "nat tree \<Rightarrow> nat tree"
where
  "tinc (Leaf n) = Leaf (Suc n)"
| "tinc (Branch l) = Branch (map tinc l)"

fun testcase :: "'a tree \<Rightarrow> 'a list"
where
  "testcase (Leaf a) = [a]"
| "testcase (Branch x) =
    (let xs = concat (map testcase x);
         ys = concat (map testcase x) in
     xs @ ys)"

subsubsection \<open>Pattern matching on records\<close>

record point =
  Xcoord :: int
  Ycoord :: int

function swp :: "point \<Rightarrow> point"
where
  "swp \<lparr> Xcoord = x, Ycoord = y \<rparr> = \<lparr> Xcoord = y, Ycoord = x \<rparr>"
proof -
  fix P x
  assume "\<And>xa y. x = \<lparr>Xcoord = xa, Ycoord = y\<rparr> \<Longrightarrow> P"
  then show P by (cases x)
qed auto
termination by rule auto

subsubsection \<open>The diagonal function\<close>

fun diag :: "bool \<Rightarrow> bool \<Rightarrow> bool \<Rightarrow> nat"
where
  "diag x True False = 1"
| "diag False y True = 2"
| "diag True False z = 3"
| "diag True True True = 4"
| "diag False False False = 5"

subsubsection \<open>Many equations (quadratic blowup)\<close>

datatype DT =
  A | B | C | D | E | F | G | H | I | J | K | L | M | N | P
| Q | R | S | T | U | V

fun big :: "DT \<Rightarrow> nat"
where
  "big A = 0"
| "big B = 0"
| "big C = 0"
| "big D = 0"
| "big E = 0"
| "big F = 0"
| "big G = 0"
| "big H = 0"
| "big I = 0"
| "big J = 0"
| "big K = 0"
| "big L = 0"
| "big M = 0"
| "big N = 0"
| "big P = 0"
| "big Q = 0"
| "big R = 0"
| "big S = 0"
| "big T = 0"
| "big U = 0"
| "big V = 0"

subsubsection \<open>Automatic pattern splitting\<close>

fun f4 :: "nat \<Rightarrow> nat \<Rightarrow> bool"
where
  "f4 0 0 = True"
| "f4 _ _ = False"

subsubsection \<open>Polymorphic partial-function\<close>

partial_function (option) f5 :: "'a list \<Rightarrow> 'a option"
where
  "f5 x = f5 x"

end


theory Chapter13_7
imports "HOL-IMP.Abs_Int2" "Short_Theory"
begin

text\<open>
\setcounter{exercise}{15}
\exercise
Give a readable proof that if @{text "\<gamma> ::"} \noquotes{@{typ[source]"'a::lattice \<Rightarrow> 'b::lattice"}}
is a monotone function, then @{prop "\<gamma> (a\<^sub>1 \<sqinter> a\<^sub>2) \<le> \<gamma> a\<^sub>1 \<sqinter> \<gamma> a\<^sub>2"}:
\<close>

lemma fixes \<gamma> :: "'a::lattice \<Rightarrow> 'b :: lattice"
assumes mono: "\<And>x y. x \<le> y \<Longrightarrow> \<gamma> x \<le> \<gamma> y"
shows "\<gamma> (a\<^sub>1 \<sqinter> a\<^sub>2) \<le> \<gamma> a\<^sub>1 \<sqinter> \<gamma> a\<^sub>2"
(* your definition/proof here *)

text\<open>
Give an example of two lattices and a monotone @{text \<gamma>}
where @{prop"\<gamma> a\<^sub>1 \<sqinter> \<gamma> a\<^sub>2 \<le> \<gamma> (a\<^sub>1 \<sqinter> a\<^sub>2)"} does not hold.
\<close>

text\<open>
\endexercise

\exercise
Consider a simple sign analysis based on this abstract domain:
\<close>

datatype sign = None | Neg | Pos0 | Any

fun \<gamma> :: "sign \<Rightarrow> val set" where
"\<gamma> None = {}" |
"\<gamma> Neg = {i. i < 0}" |
"\<gamma> Pos0 = {i. i \<ge> 0}" |
"\<gamma> Any = UNIV"

text\<open>
Define inverse analyses for \<open>\<close>@{text"+"}'' and \<open>\<close>@{text"<"}''
and prove the required correctness properties:
\<close>

fun inv_plus' :: "sign \<Rightarrow> sign \<Rightarrow> sign \<Rightarrow> sign * sign" where
(* your definition/proof here *)

lemma
  "\<lbrakk> inv_plus' a a1 a2 = (a1',a2');  i1 \<in> \<gamma> a1;  i2 \<in> \<gamma> a2; i1+i2 \<in> \<gamma> a \<rbrakk>
  \<Longrightarrow> i1 \<in> \<gamma> a1' \<and> i2 \<in> \<gamma> a2' "
(* your definition/proof here *)

fun inv_less' :: "bool \<Rightarrow> sign \<Rightarrow> sign \<Rightarrow> sign * sign" where
(* your definition/proof here *)

lemma
  "\<lbrakk> inv_less' bv a1 a2 = (a1',a2');  i1 \<in> \<gamma> a1;  i2 \<in> \<gamma> a2; (i1<i2) = bv \<rbrakk>
  \<Longrightarrow> i1 \<in> \<gamma> a1' \<and> i2 \<in> \<gamma> a2'"
(* your definition/proof here *)

text\<open>
\indent
For the ambitious: turn the above fragment into a full-blown abstract interpreter
by replacing the interval analysis in theory @{short_theory "Abs_Int2"}@{text"_ivl"}
by a sign analysis.
\endexercise
\<close>

end


theory hw1
imports Main
begin

(*1.*)
value "1 + (2::nat)"
value "1 + (2::int)"
value "1 - (2::nat)"
value "1 - (2::int)"

(*2.*)
fun add :: "nat \<Rightarrow> nat \<Rightarrow> nat"
  where "add 0 n = n " |
  "add (Suc m) n = Suc (add m n)"

lemma null_add[simp]: "add y 0 = y"
  apply (induction y)
   apply auto
  done

lemma ass_add[simp]: "add (add x y) z = add x (add y z)"
  apply (induction x)
   apply auto
  done

lemma suc_ass[simp]: "Suc (add y x) = add y (Suc x)"
  apply (induction y)
   apply auto
  done

lemma cum_add[simp]: "add x y = add y x"
  apply (induction x)
   apply auto
  done

fun double  :: "nat \<Rightarrow> nat"
  where "double  0 =  0" |
"double (Suc x) = Suc (Suc (double x))"

lemma double_prop[simp] : "double x = add x x"
  apply (induction x)
   apply (auto)
  done

(*3.*)
fun count :: "'a \<Rightarrow> 'a list \<Rightarrow> nat"
  where  "count a [] = 0" |
"count a (x#xs) = (if a = x then add 1 (count a xs) else count a xs)"

value "count (2::nat) [2, 0, 2, 2, 1, 0, 1, 1, 2, 0, 2, 2, 1]"

lemma max_count[simp] : "count a xs \<le> length xs"
  apply(induction xs)
  apply(auto)
  done

(*4.*)
fun snoc :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a list"
  where  "snoc [] a = [a]" |
"snoc (x#xs) a= x#snoc xs a"

value "snoc [2, 0, 2, 2, 1, 0, 1, 1, 2, 0, 2, 2, 1::int] 0"

fun reverse :: "'a list \<Rightarrow> 'a list"
  where "reverse [] = []" |
"reverse (x#xs) = snoc (reverse xs) x"

value "reverse [2, 0, 2, 2, 1, 0, 1, 1, 2, 0, 2, 2, 1::int]"

lemma about_reverse2[simp] : " reverse(snoc xs a) = (a # reverse(xs)) "
  apply (induction xs)
   apply (auto)
  done

(*lemma snoc_rev[simp] : " reverse (a # xs) = snoc (reverse xs) a "
  apply(induction xs)
  apply(auto)
  done*)

lemma rev_reverse[simp] : "reverse (reverse xs) = xs"
  apply(induction xs)
  apply auto
  done

(*5.*)
fun sum_upto :: "nat \<Rightarrow> nat"
  where "sum_upto 0 = 0" |
"sum_upto (Suc a) = Suc a + (sum_upto (a))"

value "sum_upto 10"

lemma auto_sum[simp] : "sum_upto a = ((a * (a + 1)) div 2)"
  apply(induction a)
  apply auto
  done

end


theory Tree2
imports Main
begin

datatype ('a,'b) tree =
  Leaf ("\<langle>\<rangle>") |
  Node 'b "('a,'b)tree" 'a "('a,'b) tree" ("(1\<langle>_,/ _,/ _,/ _\<rangle>)")

fun inorder :: "('a,'b)tree \<Rightarrow> 'a list" where
"inorder Leaf = []" |
"inorder (Node _ l a r) = inorder l @ a # inorder r"

fun height :: "('a,'b) tree \<Rightarrow> nat" where
"height Leaf = 0" |
"height (Node _ l a r) = max (height l) (height r) + 1"

definition size1 :: "('a,'b) tree \<Rightarrow> nat" where
"size1 t = size t + 1"

lemma size1_simps[simp]:
  "size1 \<langle>\<rangle> = 1"
  "size1 \<langle>u, l, x, r\<rangle> = size1 l + size1 r"
by (simp_all add: size1_def)

lemma size1_ge0[simp]: "0 < size1 t"
by (simp add: size1_def)

end


theory Chapter3_2
imports Main
begin
type_synonym vname = string
datatype aexp = N int | V vname | Plus aexp aexp | Times aexp aexp

type_synonym val = int
type_synonym state = "vname \<Rightarrow> val"

fun aval::"aexp \<Rightarrow> state \<Rightarrow> val" where
"aval (N n) s = n" |
"aval (V x) s = s x" |
"aval (Plus a1 a2) s = aval a1 s + aval a2 s" |
"aval (Times a1 a2) s = aval a1 s * aval a2 s"

fun plus:: "aexp \<Rightarrow> aexp \<Rightarrow> aexp" where
"plus (N i1) (N i2) = N(i1 + i2)" |
"plus (N i) a = (if i = 0 then a else Plus (N i) a)" |
"plus a (N i) = (if i = 0 then a else Plus a (N i))" |
"plus a1 a2 = Plus a1 a2"

lemma aval_plus: "aval (plus a1 a2) s = aval a1 s + aval a2 s"
  apply (induction rule: plus.induct)
  apply (auto)
  done

fun times:: "aexp \<Rightarrow> aexp \<Rightarrow> aexp" where
"times (N i1) (N i2) = N(i1 * i2)" |
"times (N i) a = (if (i = 0) then (N 0) else if (i = 1) then a else Times (N i) a)" |
"times a (N i) = (if (i = 0) then (N 0) else if (i = 1) then a else Times a (N i))" |
"times a1 a2 = Times a1 a2"

lemma aval_times: "aval (times a1 a2) s = aval a1 s * aval a2 s"
  apply (induction rule: times.induct)
  apply (auto)
  done

fun asimp::"aexp \<Rightarrow> aexp" where
"asimp (N n) = N n" |
"asimp (V x) = V x" |
"asimp (Plus a1 a2) = plus (asimp a1) (asimp a2)" |
"asimp (Times a1 a2) = times (asimp a1) (asimp a2)"

lemma aval_asimp: "aval (asimp a) s = aval a s"
  apply (induction a)
    apply (auto split: aexp.split)
  apply (simp_all add: aval_plus aval_times)
  done

fun subst::"vname \<Rightarrow> aexp \<Rightarrow> aexp \<Rightarrow> aexp" where
"subst x y (V n) = (if x = n then y else (V n))" |
"subst x y (N n) = N n" |
"subst x y (Plus a1 a2) = Plus (subst x y a1) (subst x y a2)" |
"subst x y (Times a1 a2) = Times (subst x y a1) (subst x y a2)"

lemma substitution_lemma: "aval (subst x a e) s = aval e (s(x := aval a s))"
  apply (induction e)
  apply (auto split: if_splits)
  done

lemma subst_eq: "aval a1 s = aval a2 s \<Longrightarrow> aval (subst x a1 e) s = aval (subst x a2 e) s"
  apply (induction a1 arbitrary: a2)
  apply (auto simp add: substitution_lemma)
  done

datatype aexp2 = N2 int | V2 vname |
  Plus2 aexp2 aexp2 | Times2 aexp2 aexp2 |
  PostInc vname | Div aexp2 aexp2

fun aval2::"aexp2 \<Rightarrow> state \<Rightarrow> (val \<times> state) option" where
"aval2 (N2 n) s = Some (n, s)" |
"aval2 (V2 x) s = Some (s x, s)" |
"aval2 (PostInc x) s = Some (s x, s(x := (s x) + 1))" |
"aval2 (Plus2 a1 a2) s =
(case (aval2 a1 s) of
  Some (v1, s1) \<Rightarrow>
    (case (aval2 a2 s1) of
      Some (v2, s2) \<Rightarrow> Some (v1 + v2, s2) |
      None          \<Rightarrow> None) |
  None \<Rightarrow> None)" | (*TODO: learn about monads*)
"aval2 (Times2 a1 a2) s = (case (aval2 a1 s) of
  Some (v1, s1) \<Rightarrow>
    (case (aval2 a2 s1) of
      Some (v2, s2) \<Rightarrow> Some (v1 * v2, s2) |
      None          \<Rightarrow> None) |
  None \<Rightarrow> None)" |
"aval2 (Div a1 a2) s = (case (aval2 a1 s) of
  Some (v1, s1) \<Rightarrow>
    (case (aval2 a2 s1) of
      Some (v2, s2) \<Rightarrow> (if (v2 \<noteq> 0) then Some (v1 div v2, s2) else None) |
      None          \<Rightarrow> None) |
  None \<Rightarrow> None)"

datatype lexp = Nl int | Vl vname | Plusl lexp lexp | LET vname lexp lexp

fun lval::"lexp \<Rightarrow> state \<Rightarrow> int" where
"lval (Nl i) s = i" |
"lval (Vl x) s = s x" |
"lval (Plusl l1 l2) s = (lval l1 s) + (lval l2 s)" |
"lval (LET x l1 l2) s = lval l2 (s(x := (lval l1 s)))"

fun inline::"lexp \<Rightarrow> aexp" where
"inline (Nl i) = N i" |
"inline (Vl x) = V x" |
"inline (Plusl l1 l2) = Plus (inline l1) (inline l2)" |
"inline (LET x l1 l2) = subst x (inline l1) (inline l2)"

lemma inline_aval: "aval (inline l) = lval l"
  apply (induction l)
  apply (auto simp add: substitution_lemma)
  done

datatype bexp = Bc bool | Not bexp | And bexp bexp | Less aexp aexp

fun bval::"bexp \<Rightarrow> state \<Rightarrow> bool" where
"bval (Bc v) s = v" |
"bval (Not b) s = (\<not> bval b s)" |
"bval (And b1 b2) s = (bval b1 s \<and> bval b2 s)" |
"bval (Less a1 a2) s = (aval a1 s < aval a2 s)"

fun not::"bexp \<Rightarrow> bexp" where
"not (Bc True) = Bc False" |
"not (Bc False) = Bc True" |
"not b = Not b"

fun "and"::"bexp \<Rightarrow> bexp \<Rightarrow> bexp" where
"and (Bc True) b = b" |
"and b (Bc True) = b" |
"and (Bc False) b = Bc False" |
"and b (Bc False) = Bc False" |
"and b1 b2 = And b1 b2"

fun less::"aexp \<Rightarrow> aexp \<Rightarrow> bexp" where
"less (N n1) (N n2) = Bc (n1 < n2)" |
"less a1 a2 = Less a1 a2"

fun bsimp::"bexp \<Rightarrow> bexp" where
"bsimp (Bc v) = Bc v" |
"bsimp (Not b) = not (bsimp b)" |
"bsimp (And b1 b2) = and (bsimp b1) (bsimp b2)" |
"bsimp (Less a1 a2) = less (asimp a1) (asimp a2)"

fun Eq::"aexp \<Rightarrow> aexp \<Rightarrow> bexp" where
"Eq a1 a2 = And (Not (less a1 a2)) (Not (less a2 a1))"

fun Le::"aexp \<Rightarrow> aexp \<Rightarrow> bexp" where
"Le a1 a2 = Not (less a2 a1)"

lemma less_corr: "bval (less a1 a2) s = (aval a1 s < aval a2 s)"
  apply (induction rule: less.induct)
     apply (auto)
  done

lemma Eq_corr: "bval (Eq a1 a2) s = (aval a1 s = aval a2 s)"
  apply (auto simp add: less_corr)
  done

lemma Le_corr: "bval (Le a1 a2) s = (aval a1 s \<le> aval a2 s)"
  apply (auto simp add: less_corr)
  done

datatype ifexp = Bc2 bool | If ifexp ifexp ifexp | Less2 aexp aexp

fun ifval::"ifexp \<Rightarrow> state \<Rightarrow> bool" where
"ifval (Bc2 b) s = b" |
"ifval (If cond e1 e2) s = ((ifval cond s) \<and> (ifval e1 s) \<or> \<not>(ifval cond s) \<and> (ifval e2 s))" |
"ifval (Less2 a1 a2) s = (aval a1 s < aval a2 s)"

fun b2ifexp::"bexp \<Rightarrow> ifexp" where
"b2ifexp (Bc b) = Bc2 b" |
"b2ifexp (Not b) = If (b2ifexp b) (Bc2 False) (Bc2 True)" |
"b2ifexp (And b1 b2) = If (b2ifexp b1) (b2ifexp b2) (Bc2 False)" |
"b2ifexp (Less a1 a2) = Less2 a1 a2"

lemma "bval b = ifval (b2ifexp b)"
  apply (induction b)
     apply (auto)
  done

fun if2bexp::"ifexp \<Rightarrow> bexp" where
"if2bexp (Bc2 b) = Bc b" |
"if2bexp (If cond e1 e2) =
Not (And
  (Not (And (if2bexp cond) (if2bexp e1)))
  (Not (And (Not (if2bexp cond)) (if2bexp e2)))
)" |
"if2bexp (Less2 e1 e2) = Less e1 e2"

lemma "ifval i = bval (if2bexp i)"
  apply (induction i)
  apply (auto)
  done

datatype pbexp = VAR vname | NOT pbexp | AND pbexp pbexp | OR pbexp pbexp

fun pbval::"pbexp \<Rightarrow> (vname \<Rightarrow> bool) \<Rightarrow> bool" where
"pbval (VAR x) s = s x" |
"pbval (NOT b) s = (\<not>pbval b s)" |
"pbval (AND b1 b2) s = (pbval b1 s \<and> pbval b2 s)" |
"pbval (OR b1 b2) s = (pbval b1 s \<or> pbval b2 s)"

fun is_nnf::"pbexp \<Rightarrow> bool" where
"is_nnf (VAR x) = True" |
"is_nnf (NOT (VAR x)) = True" |
"is_nnf (AND b1 b2) = (is_nnf b1 \<and> is_nnf b2)" |
"is_nnf (OR b1 b2) = (is_nnf b1 \<and> is_nnf b2)" |
"is_nnf (NOT b) = False"

fun nnf::"pbexp \<Rightarrow> pbexp" where
"nnf (NOT (VAR x)) = NOT (VAR x)" |
"nnf (NOT (NOT b)) = nnf b" |
"nnf (NOT (AND b1 b2)) = OR (nnf (NOT b1)) (nnf (NOT b2))" |
"nnf (NOT (OR b1 b2)) = AND (nnf (NOT b1)) (nnf (NOT b2))" |
"nnf (VAR x) = VAR x" |
"nnf (AND b1 b2) = AND (nnf b1) (nnf b2)" |
"nnf (OR b1 b2) = OR (nnf b1) (nnf b2)"

lemma nnf_pbval [simp]: "pbval (nnf b) = pbval b"
  apply (induction rule: nnf.induct)
  apply (auto)
  done

lemma nnf_correct [simp]: "is_nnf (nnf b)"
  apply (induction b rule: nnf.induct)
  apply (auto)
  done

fun no_or::"pbexp \<Rightarrow> bool" where
"no_or (VAR x) = True" |
"no_or (NOT b) = no_or b" |
"no_or (AND b1 b2) = (no_or b1 \<and> no_or b2)" |
"no_or (OR b1 b2) = False"

fun dnf_aux::"pbexp \<Rightarrow> bool" where
"dnf_aux (VAR x) = True" |
"dnf_aux (NOT b) = dnf_aux b" |
"dnf_aux (AND b1 b2) = (no_or b1 \<and> no_or b2)" |
"dnf_aux (OR b1 b2) = (dnf_aux b1 \<and> dnf_aux b2)"

fun is_dnf::"pbexp \<Rightarrow> bool" where
"is_dnf b = (is_nnf b \<and> dnf_aux b)"

fun dist_and::"pbexp \<Rightarrow> pbexp \<Rightarrow> pbexp" where
"dist_and (OR b1 b2) b3 = OR (dist_and b1 b3) (dist_and b2 b3)" |
"dist_and  b1 (OR b2 b3) = OR (dist_and  b1 b2) (dist_and b1 b3)" |
"dist_and b1 b2 = AND b1 b2"

fun dnf_of_nnf::"pbexp \<Rightarrow> pbexp" where
"dnf_of_nnf (VAR n) = VAR n" |
"dnf_of_nnf (NOT b) = NOT (dnf_of_nnf b)" |
"dnf_of_nnf (OR b1 b2) = OR (dnf_of_nnf b1) (dnf_of_nnf b2)" |
"dnf_of_nnf (AND b1 b2) = dist_and (dnf_of_nnf b1) (dnf_of_nnf b2)"

lemma dist_and_corr: "pbval (dist_and b1 b2) s = pbval (AND b1 b2) s"
  apply (induction b1 b2 rule: dist_and.induct)
    apply (auto)
  done

lemma dnf_of_nnf_pbval: "pbval (dnf_of_nnf b) s = pbval b s"
  apply (induction b)
    apply (auto simp add: dist_and_corr)
  done

lemma dist_and_pres_nnf: "is_nnf (AND b1 b2) \<Longrightarrow> is_nnf (dist_and b1 b2)"
  apply (induction b1 b2 rule: dist_and.induct)
   apply (auto)
  done

lemma [simp]: "is_nnf (NOT b) \<Longrightarrow> dnf_aux (dnf_of_nnf b)"
  apply (induction b rule: is_nnf.induct)
  apply (auto)
  done

lemma dist_and_pres_dnf: "dnf_aux b1 \<Longrightarrow> dnf_aux b2 \<Longrightarrow>
    is_nnf b1 \<Longrightarrow> is_nnf b2 \<Longrightarrow> dnf_aux (dist_and b1 b2)"
  apply (induction b1 b2 rule: dist_and.induct)
    apply (auto)
  done

lemma dnf_of_nnf_pres_nnf [simp]: "is_nnf b \<Longrightarrow> is_nnf (dnf_of_nnf b)"
  apply (induction b rule: is_nnf.induct)
   apply (auto simp add: dist_and_pres_nnf)
  done

lemma dnf_of_nnf_est_dnf_aux [simp]: "is_nnf b \<Longrightarrow> dnf_aux (dnf_of_nnf b)"
  apply (induction b)
  apply (auto simp add: dist_and_pres_nnf dist_and_pres_dnf)
  done

lemma dnf_converts_correctly: "is_nnf b \<Longrightarrow> is_dnf (dnf_of_nnf b)"
  apply (auto) (*TODO: why does simp add: not work here? the above lemmas needed the [simp] tag*)
  done

datatype instr = LOADI val | LOAD vname | ADD | TIMES

type_synonym stack = "val list"

abbreviation hd2::"'a list \<Rightarrow> 'a" where
"hd2 l \<equiv> hd (tl l)"

abbreviation tl2::"'a list \<Rightarrow> 'a list" where
"tl2 l \<equiv> tl (tl l)"

fun exec1::"instr \<Rightarrow> state \<Rightarrow> stack \<Rightarrow> (stack option)" where
"exec1 (LOADI n) _ stk = Some (n # stk)" |
"exec1 (LOAD x) s stk = Some ((s x) # stk)" |
"exec1 ADD _ stk = (if (length stk) \<ge> 2 then Some ((hd stk + hd2 stk) # (tl2 stk)) else None)" |
"exec1 TIMES _ stk = (if (length stk) \<ge> 2 then Some ((hd stk * hd2 stk) # (tl2 stk)) else None)"

fun exec::"instr list \<Rightarrow> state \<Rightarrow> stack \<Rightarrow> (stack option)" where
"exec Nil _ stk = (Some stk)" |
"exec (i#is) s stk = (case (exec1 i s stk) of
  None \<Rightarrow> None |
  (Some stk1) \<Rightarrow> (exec is s stk1)
)"

fun comp::"aexp \<Rightarrow> instr list" where
"comp (N n) = [LOADI n]" |
"comp (V x) = [LOAD x]" |
"comp (Plus e1 e2) = (comp e1) @ (comp e2) @ [ADD]" |
"comp (Times e1 e2) = (comp e1) @ (comp e2) @ [TIMES]"

lemma [simp]: "exec is1 s stk = (Some stk1) \<Longrightarrow> exec (is1 @ is2) s stk = exec is2 s stk1"
  apply (induction is1 arbitrary: s stk stk1 is2)
  apply (auto split: option.splits)
  done

lemma "stk1 = aval a s # stk \<Longrightarrow> (exec (comp a) s stk) = Some stk1 "
  apply (induction a arbitrary: s stk stk1)
     apply (auto split: option.splits)
  done

type_synonym reg = "nat"

datatype instr1 = LDI int reg | LD vname reg | ADD reg reg | MULT reg reg

fun exec_reg1::"instr1 \<Rightarrow> state \<Rightarrow> (reg \<Rightarrow> int) \<Rightarrow> reg \<Rightarrow> int" where
"exec_reg1 (LDI i r) s rs = rs(r := i)"  |
"exec_reg1 (LD x r) s rs = rs(r := (s x))" |
"exec_reg1 (ADD r1 r2) s rs = rs(r1 := (rs r1 + rs r2))" |
"exec_reg1 (MULT r1 r2) s rs = rs(r1 := (rs r1 * rs r2))"

fun exec_reg::"instr1 list \<Rightarrow> state \<Rightarrow> (reg \<Rightarrow> int) \<Rightarrow> reg \<Rightarrow> int" where
"exec_reg [] s rs = rs" |
"exec_reg (i#is) s rs = exec_reg is s (exec_reg1 i s rs)"

fun comp_reg::"aexp \<Rightarrow> reg \<Rightarrow> instr1 list" where
"comp_reg (N n) r = [LDI n r]" |
"comp_reg (V x) r = [LD x r]" |
"comp_reg (Plus a1 a2) r = (comp_reg a1 r) @ (comp_reg a2 (Suc r)) @ [ADD r (Suc r)]" |
"comp_reg (Times a1 a2) r = (comp_reg a1 r) @ (comp_reg a2 (Suc r)) @ [MULT r (Suc r)]"

lemma [simp]: "exec_reg (a1s@a2s) s rs = exec_reg a2s s (exec_reg a1s s rs)"
  apply (induction a1s arbitrary: s rs)
  apply (auto)
  done

lemma [simp]: "exec_reg (comp_reg a1 r1 @ comp_reg a2 r2) s rs = exec_reg (comp_reg a2 r2) s (exec_reg (comp_reg a1 r1) s rs)"
  apply (induction a1 arbitrary: s rs)
  apply (auto)
  done

lemma [simp]: "r2 < r1 \<Longrightarrow> exec_reg (comp_reg a r1) s rs r2 = rs r2"
  apply (induction a arbitrary: r1 r2 rs s)
  apply (auto)
  done

lemma [simp]: "exec_reg (comp_reg a r) s rs r = aval a s"
  apply (induction a arbitrary: rs r)
     apply (auto)
  done

datatype instr0 = LDI0 val | LD0 vname | MV0 reg | ADD0 reg | MULT0 reg

type_synonym reg_state = "reg \<Rightarrow> int"

fun exec0'::"instr0 \<Rightarrow> state \<Rightarrow> reg_state \<Rightarrow> reg_state" where
"exec0' (LDI0 v) s rs = rs(0 := v)" |
"exec0' (LD0 n) s rs = rs(0 := (s n))" |
"exec0' (MV0 r) s rs = rs(r := (rs 0))" |
"exec0' (ADD0 r) s rs = rs(0 := (rs 0) + (rs r))" |
"exec0' (MULT0 r) s rs = rs(0 := (rs 0) * (rs r))"

fun exec0::"instr0 list \<Rightarrow> state \<Rightarrow> reg_state \<Rightarrow> reg_state" where
"exec0 Nil _ rs = rs" |
"exec0 (i#is) s rs = exec0 is s (exec0' i s rs)"

fun comp0::"aexp \<Rightarrow> reg \<Rightarrow> instr0 list" where
"comp0 (N n) _ = [LDI0 n]" |
"comp0 (V x) _ = [LD0 x]" |
"comp0 (Plus a1 a2) r = (comp0 a1 r) @ [MV0 r] @ (comp0 a2 (Suc r)) @ [ADD0 r]" |
"comp0 (Times a1 a2) r = (comp0 a1 r) @ [MV0 r] @ (comp0 a2 (Suc r)) @ [MULT0 r]"

lemma [simp]: "exec0 (a1s@a2s) s rs = exec0 a2s s (exec0 a1s s rs)"
  apply (induction a1s arbitrary: a2s rs)
  apply (auto)
  done

lemma [simp]: "0 < r1 \<Longrightarrow> r1 < r2 \<Longrightarrow> exec0 (comp0 a r2) s rs r1 = rs r1"
  apply (induction a arbitrary: rs s r1 r2)
  apply (auto)
  done

lemma "0 < r \<Longrightarrow> exec0 (comp0 a r) s rs 0 = aval a s"
  apply (induction a arbitrary: r s rs)
  apply (auto)
  done

end