theory Chapter7
imports "HOL-IMP.Small_Step"
begin

text\<open>
\section*{Chapter 7}

\exercise
Define a function that computes the set of variables that are assigned to
in a command:
\<close>

(* We use static analysis semantics for the notion of "assigned".
  A more precise semantics will use an auxillary function that reasons in terms
  of states, and take the union of assignments among its terminating states.
*)
fun assigned :: "com \<Rightarrow> vname set" where
  "assigned SKIP = {}" |
  "assigned (x ::= _) = {x}" |
  "assigned (c\<^sub>1;;c\<^sub>2) = assigned c\<^sub>1 \<union> assigned c\<^sub>2" |
  "assigned (IF _ THEN c\<^sub>1 ELSE c\<^sub>2) = assigned c\<^sub>1 \<union> assigned c\<^sub>2" |
  "assigned (WHILE _ DO c) = assigned c"

text\<open>
Prove that if some variable is not assigned to in a command,
then that variable is never modified by the command:
\<close>

lemma "\<lbrakk> (c, s) \<Rightarrow> t; x \<notin> assigned c \<rbrakk> \<Longrightarrow> s x = t x"
  by (induct rule: big_step_induct) auto

text \<open>
\endexercise

\exercise
Define a recursive function that determines if a command behaves like @{const SKIP}
and prove its correctness:
\<close>

(* Honestly, the skip property is better captured by reasoning about states,
which does not require the function to be defined recursively.
*)
fun skip :: "com \<Rightarrow> bool" where
  "skip SKIP \<longleftrightarrow> True" |
  "skip (_ ::= _) \<longleftrightarrow> False" |
  "skip (c\<^sub>1;;c\<^sub>2) \<longleftrightarrow> skip c\<^sub>1 \<and> skip c\<^sub>2" |
  "skip (IF _ THEN c\<^sub>1 ELSE c\<^sub>2) \<longleftrightarrow> skip c\<^sub>1 \<and> skip c\<^sub>2" |
  "skip (WHILE _ DO c) \<longleftrightarrow> False"
  (* equivalence requires that the while loop terminates. The while loop terminates
  without mutating state IFF the bexp is contradictory. (Otherwise, there is a state
  that either never terminates, or gets mutated in order to eventually fail the
  guard and proceed. In conventional static analysis semantics, which I presume
  the question means by "behaves like", this means that while loops never
  behaves like skip.
 *)

(* because we have written off while, we can simply induct on the
  inductive definition of c
  *)
lemma "skip c \<Longrightarrow> c \<sim> SKIP"
proof (intro allI)
  fix s t
  assume "skip c"
  then have Hs: "(c, s) \<Rightarrow> s" by (induct c) auto
  show "(c, s) \<Rightarrow> t = (SKIP, s) \<Rightarrow> t"
  proof
    assume "(c, s) \<Rightarrow> t"
    with Hs have "s = t" using big_step_determ by simp
    then show "(SKIP, s) \<Rightarrow> t" using Skip by simp
  next
    assume "(SKIP, s) \<Rightarrow> t"
    moreover have "(SKIP, s) \<Rightarrow> s" by auto
    ultimately have "s = t" using big_step_determ by simp
    with Hs show "(c, s) \<Rightarrow> t" by simp
  qed
qed

text\<open>
\endexercise

\exercise
Define a recursive function
\<close>

fun deskip :: "com \<Rightarrow> com" where
  "deskip (SKIP;;c) = c" |
  "deskip (c;;SKIP) = c" |
  "deskip (IF b THEN c\<^sub>1 ELSE c\<^sub>2) = IF b THEN deskip c\<^sub>1 ELSE deskip c\<^sub>2" |
  "deskip (WHILE b DO c) = WHILE b DO deskip c" |
  "deskip c = c"

text\<open>
that eliminates as many @{const SKIP}s as possible from a command. For example:
@{prop[display]"deskip (SKIP;; WHILE b DO (x::=a;; SKIP)) = WHILE b DO x::=a"}
Prove its correctness by induction on @{text c}: \<close>

lemma "deskip c \<sim> c"
  by (induct c rule: deskip.induct) (auto simp add: sim_while_cong)

text\<open>
Remember lemma @{thm[source]sim_while_cong} for the @{text WHILE} case.
\endexercise

\exercise
A small-step semantics for the evaluation of arithmetic expressions
can be defined like this:
\<close>

inductive astep :: "aexp \<times> state \<Rightarrow> aexp \<Rightarrow> bool" (infix "\<leadsto>" 50) where
"(V x, s) \<leadsto> N (s x)" |
"(Plus (N i) (N j), s) \<leadsto> N (i + j)" |
"(a\<^sub>1, s) \<leadsto> a\<^sub>1' \<Longrightarrow> (Plus a\<^sub>1 a\<^sub>2, s) \<leadsto> Plus a\<^sub>1' a\<^sub>2" |
"(a\<^sub>2, s) \<leadsto> a\<^sub>2' \<Longrightarrow> (Plus (N i) a\<^sub>2, s) \<leadsto> Plus (N i) a\<^sub>2'"

text\<open>
Complete the definition with two rules for @{const Plus}
that model a left-to-right evaluation strategy:
reduce the first argument with @{text"\<leadsto>"} if possible,
reduce the second argument with @{text"\<leadsto>"} if the first argument is a number.
Prove that each @{text"\<leadsto>"} step preserves the value of the expression:
\<close>

lemma "(a, s) \<leadsto> a' \<Longrightarrow> aval a s = aval a' s"
proof (induction rule: astep.induct [split_format (complete)])
  fix x s
  show "aval (V x) s = aval (N (s x)) s" by simp
next
  fix i j s
  show "aval (Plus (N i) (N j)) s = aval (N (i + j)) s" by simp
next
  fix a\<^sub>1 s a\<^sub>1' a\<^sub>2
  assume "(a\<^sub>1, s) \<leadsto> a\<^sub>1'" "aval a\<^sub>1 s = aval a\<^sub>1' s"
  then show "aval (Plus a\<^sub>1 a\<^sub>2) s = aval (Plus a\<^sub>1' a\<^sub>2) s" by simp
next
  fix a\<^sub>2 s a\<^sub>2' i
  assume "(a\<^sub>2, s) \<leadsto> a\<^sub>2'" "aval a\<^sub>2 s = aval a\<^sub>2' s"
  then show "aval (Plus (N i) a\<^sub>2) s = aval (Plus (N i) a\<^sub>2') s" by simp
qed

text\<open>
Do not use the \isacom{case} idiom but write down explicitly what you assume
and show in each case: \isacom{fix} \dots \isacom{assume} \dots \isacom{show} \dots.
\endexercise

\exercise
Prove or disprove (by giving a counterexample):
\<close>

lemma "IF And b\<^sub>1 b\<^sub>2 THEN c\<^sub>1 ELSE c\<^sub>2 \<sim>
          IF b\<^sub>1 THEN IF b\<^sub>2 THEN c\<^sub>1 ELSE c\<^sub>2 ELSE c\<^sub>2"
proof (intro allI)
  fix s t
  show "(IF And b\<^sub>1 b\<^sub>2 THEN c\<^sub>1 ELSE c\<^sub>2, s) \<Rightarrow> t =
           (IF b\<^sub>1 THEN IF b\<^sub>2 THEN c\<^sub>1 ELSE c\<^sub>2 ELSE c\<^sub>2, s) \<Rightarrow> t"
  proof
    assume "(IF And b\<^sub>1 b\<^sub>2 THEN c\<^sub>1 ELSE c\<^sub>2, s) \<Rightarrow> t"
    then show "(IF b\<^sub>1 THEN IF b\<^sub>2 THEN c\<^sub>1 ELSE c\<^sub>2 ELSE c\<^sub>2, s) \<Rightarrow> t"
    proof
      assume Hb: "\<not>bval (And b\<^sub>1 b\<^sub>2) s"
      show "(c\<^sub>2, s) \<Rightarrow> t \<Longrightarrow> ?thesis"
      proof (cases "bval b\<^sub>1 s")
        case True
        with Hb have "\<not>bval b\<^sub>2 s" by auto
        with True show "(c\<^sub>2, s) \<Rightarrow> t \<Longrightarrow> ?thesis" by auto
      qed auto
    qed auto
  qed auto
qed

lemma "\<exists> b\<^sub>1 b\<^sub>2 c. ~WHILE And b\<^sub>1 b\<^sub>2 DO c \<sim> WHILE b\<^sub>1 DO WHILE b\<^sub>2 DO c"
proof (intro exI notI)
  let ?b\<^sub>1 = "(Less (V ''a'') (N 1))"
  let ?b\<^sub>2 = "(Less (V ''b'') (N 2))"
  let ?c  = "''a'' ::= (Plus (V ''a'') (N 1));; ''b'' ::= (Plus (V ''b'') (N 1))"
  assume Hc: "WHILE And ?b\<^sub>1 ?b\<^sub>2 DO ?c \<sim> WHILE ?b\<^sub>1 DO WHILE ?b\<^sub>2 DO ?c"
  let ?s = "<>"
  let ?t\<^sub>1 = "<''a'':=1,''b'':=1>"
  let ?t\<^sub>2 = "<''a'':=2,''b'':=2>"
  have H1: "(WHILE And ?b\<^sub>1 ?b\<^sub>2 DO ?c, ?s) \<Rightarrow> ?t\<^sub>1"
  proof (rule WhileTrue)
    show "bval (And ?b\<^sub>1 ?b\<^sub>2) <>" by (auto simp add: null_state_def)
    show "(?c, <>) \<Rightarrow> ?t\<^sub>1" by (auto simp add: assign_simp null_state_def)
    show "(WHILE And ?b\<^sub>1 ?b\<^sub>2 DO ?c, ?t\<^sub>1) \<Rightarrow> ?t\<^sub>1" by (rule WhileFalse) (auto simp add: null_state_def)
  qed
  with Hc have H1: "(WHILE ?b\<^sub>1 DO WHILE ?b\<^sub>2 DO ?c, ?s) \<Rightarrow> ?t\<^sub>1" by auto
  moreover have H2: "(WHILE ?b\<^sub>1 DO WHILE ?b\<^sub>2 DO ?c, ?s) \<Rightarrow> ?t\<^sub>2"
  proof (rule WhileTrue)
    show "bval ?b\<^sub>1 ?s" by (auto simp add: null_state_def)
    show "(WHILE ?b\<^sub>2 DO ?c, ?s) \<Rightarrow> ?t\<^sub>2"
    proof (rule WhileTrue)
      show "bval ?b\<^sub>2 ?s" by (auto simp add: null_state_def)
      show "(?c, ?s) \<Rightarrow> ?t\<^sub>1" by (auto simp add: assign_simp null_state_def)
      show "(WHILE ?b\<^sub>2 DO ?c, ?t\<^sub>1) \<Rightarrow> ?t\<^sub>2"
      proof
        show "bval ?b\<^sub>2 ?t\<^sub>1" by auto
        show "(?c, ?t\<^sub>1) \<Rightarrow> ?t\<^sub>2" by (auto simp add: assign_simp)
        show "(WHILE ?b\<^sub>2 DO ?c, ?t\<^sub>2) \<Rightarrow> ?t\<^sub>2" by (rule WhileFalse) (auto)
      qed
    qed
    show "(WHILE ?b\<^sub>1 DO WHILE ?b\<^sub>2 DO ?c, ?t\<^sub>2) \<Rightarrow> ?t\<^sub>2" by (rule WhileFalse) (auto)
  qed
  show False using big_step_determ [OF H1 H2, THEN fun_cong, of "''a''"] by simp
qed

definition Or :: "bexp \<Rightarrow> bexp \<Rightarrow> bexp" where
"Or b\<^sub>1 b\<^sub>2 = Not (And (Not b\<^sub>1) (Not b\<^sub>2))"

lemma while_inv: "(WHILE b DO c, s) \<Rightarrow> t \<Longrightarrow> \<not> bval b t"
  by (induct "WHILE b DO c" s t arbitrary: b c rule: big_step_induct) simp

lemma "WHILE Or b\<^sub>1 b\<^sub>2 DO c \<sim>
          WHILE Or b\<^sub>1 b\<^sub>2 DO c;; WHILE b\<^sub>1 DO c"
proof (intro allI)
  fix s t
  show "(WHILE Or b\<^sub>1 b\<^sub>2 DO c, s) \<Rightarrow> t =
             (WHILE Or b\<^sub>1 b\<^sub>2 DO c;; WHILE b\<^sub>1 DO c, s) \<Rightarrow> t"
  proof
    assume HW: "(WHILE Or b\<^sub>1 b\<^sub>2 DO c, s) \<Rightarrow> t"
    show "(WHILE Or b\<^sub>1 b\<^sub>2 DO c;; WHILE b\<^sub>1 DO c, s) \<Rightarrow> t"
    proof (rule Seq)
      from HW show "(WHILE Or b\<^sub>1 b\<^sub>2 DO c, s) \<Rightarrow> t" .
      from HW while_inv have "\<not> bval (Or b\<^sub>1 b\<^sub>2) t" by simp
      then have "\<not> bval b\<^sub>1 t" using Or_def by auto
      then show "(WHILE b\<^sub>1 DO c, t) \<Rightarrow> t" by auto
    qed
  next
    assume "(WHILE Or b\<^sub>1 b\<^sub>2 DO c;; WHILE b\<^sub>1 DO c, s) \<Rightarrow> t"
    then obtain s' where H1: "(WHILE Or b\<^sub>1 b\<^sub>2 DO c, s) \<Rightarrow> s'" and H2: "(WHILE b\<^sub>1 DO c, s') \<Rightarrow> t" by auto
    from H1 while_inv have "\<not> bval (Or b\<^sub>1 b\<^sub>2) s'" by simp
    then have "\<not> bval b\<^sub>1 s'" using Or_def by auto
    then have "s' = t" using H2 big_step_determ by auto
    with H1 show "(WHILE Or b\<^sub>1 b\<^sub>2 DO c, s) \<Rightarrow> t" by simp
  qed
qed

text\<open>
\endexercise

\exercise
Define a new loop construct @{text "DO c WHILE b"} (where @{text c} is
executed once before @{text b} is tested) in terms of the
existing constructs in @{typ com}:
\<close>

definition Do :: "com \<Rightarrow> bexp \<Rightarrow> com" ("DO _ WHILE _"  [0, 61] 61) where
  "DO c WHILE b = c;; WHILE b DO c"

text\<open>
Define a translation on commands that replaces all @{term "WHILE b DO c"}
by suitable commands that use @{term "DO c WHILE b"} instead:
\<close>

fun dewhile :: "com \<Rightarrow> com" where
  "dewhile (IF b THEN c\<^sub>1 ELSE c\<^sub>2) = IF b THEN dewhile c\<^sub>1 ELSE dewhile c\<^sub>2" |
  "dewhile (WHILE b DO c) = IF b THEN DO dewhile c WHILE b ELSE SKIP" |
  "dewhile c = c"

text\<open> Prove that your translation preserves the semantics: \<close>

lemma sim_seq_cong: "\<lbrakk>c\<^sub>1 \<sim> c\<^sub>1'; c\<^sub>2 \<sim> c\<^sub>2'\<rbrakk> \<Longrightarrow> c\<^sub>1 ;; c\<^sub>2 \<sim> c\<^sub>1' ;; c\<^sub>2'" by blast
lemma sim_if_cong: "\<lbrakk>c\<^sub>1 \<sim> c\<^sub>1'; c\<^sub>2 \<sim> c\<^sub>2'\<rbrakk> \<Longrightarrow> IF b THEN c\<^sub>1 ELSE c\<^sub>2 \<sim> IF b THEN c\<^sub>1' ELSE c\<^sub>2'" by blast

declare sim_trans [trans add]

lemma "dewhile c \<sim> c"
proof (induct rule: dewhile.induct)
  case (2 b c)
  have "dewhile (WHILE b DO c) \<sim>
    IF b THEN dewhile c;; WHILE b DO dewhile c ELSE SKIP" using Do_def by simp
  also have "IF b THEN dewhile c;; WHILE b DO dewhile c ELSE SKIP \<sim>
    IF b THEN c;; WHILE b DO c ELSE SKIP" using 2 by (auto simp add: sim_if_cong sim_seq_cong sim_while_cong)
  also have "IF b THEN c;; WHILE b DO c ELSE SKIP \<sim> WHILE b DO c" by blast
  finally show ?case .
qed auto

declare sim_trans [trans del]

text\<open>
\endexercise

\exercise
Let @{text "C :: nat \<Rightarrow> com"} be an infinite sequence of commands and
@{text "S :: nat \<Rightarrow> state"} an infinite sequence of states such that
@{prop"C(0::nat) = c;;d"} and \mbox{@{prop"\<forall>n. (C n, S n) \<rightarrow> (C(Suc n), S(Suc n))"}}.
Then either all @{text"C n"} are of the form \mbox{@{term"c\<^sub>n;;d"}}
and it is always @{text c\<^sub>n} that is reduced or @{text c\<^sub>n} eventually becomes @{const SKIP}.
Prove
\<close>

lemma assumes H0: "C 0 = c;;d" and HI: "\<forall>n. (C n, S n) \<rightarrow> (C(Suc n), S(Suc n))"
shows "(\<forall>n. \<exists>c\<^sub>1 c\<^sub>2. C n = c\<^sub>1;;d \<and> C(Suc n) = c\<^sub>2;;d \<and>
                         (c\<^sub>1, S n) \<rightarrow> (c\<^sub>2, S(Suc n)))
     \<or> (\<exists>k. C k = SKIP;;d)" (is "(\<forall>i. ?P i) \<or> ?Q")
proof (cases ?Q)
  assume HnSKIP: "\<not>?Q"
  have "\<forall>i. ?P i"
  proof
    fix i
    show "?P i"
    proof (induct i)
      case 0
      from HI have "(C 0, S 0) \<rightarrow> (C (Suc 0), S (Suc 0))" by blast
      with H0 have "(c;;d, S 0) \<rightarrow> (C (Suc 0), S (Suc 0))" by simp
      then show ?case
      proof (cases rule: small_step.cases)
        case Seq1
        then have "C 0 = SKIP;; d" using H0 by simp
        with HnSKIP show ?thesis by blast
      next
        case (Seq2 c\<^sub>1')
        with H0 show ?thesis by simp
      qed
    next
      case (Suc i)
      then obtain c\<^sub>1 c\<^sub>2 where Hi: "C i = c\<^sub>1;; d"
        and HSi: "C (Suc i) = c\<^sub>2;; d"
        and HSS: "(c\<^sub>1, S i) \<rightarrow> (c\<^sub>2, S (Suc i))" by blast+
      from HI have "(C (Suc i), S (Suc i)) \<rightarrow> (C (Suc (Suc i)), S (Suc (Suc i)))" by blast
      with HSi have "(c\<^sub>2;; d, S (Suc i)) \<rightarrow> (C (Suc (Suc i)), S (Suc (Suc i)))" by simp
      then show ?case using HSi HnSKIP by (cases rule: small_step.cases) auto
    qed
  qed
  then show ?thesis by simp
qed simp

text\<open>
\endexercise
\bigskip

For the following exercises copy theories
@{short_theory "Com"}, @{short_theory "Big_Step"} and @{short_theory "Small_Step"}
and modify them as required. Those parts of the theories
that do not contribute to the results required in the exercise can be discarded.
If there are multiple proofs of the same result, you may update any one of them.

\begin{exercise}\label{exe:IMP:REPEAT}
Extend IMP with a @{text "REPEAT c UNTIL b"} command by adding the constructor
\begin{alltt}
  Repeat com bexp   ("(REPEAT _/ UNTIL _)"  [0, 61] 61)
\end{alltt}
to datatype @{typ com}.
Adjust the definitions of big-step and small-step semantics,
the proof that the big-step semantics is deterministic and
the equivalence proof between the two semantics.
\end{exercise}

\begin{exercise}\label{exe:IMP:OR}
Extend IMP with a new command @{text "c\<^sub>1 OR c\<^sub>2"} that is a
nondeterministic choice: it may execute either @{text
"c\<^sub>1"} or @{text "c\<^sub>2"}. Add the constructor
\begin{alltt}
  Or com com   ("_ OR/ _" [60, 61] 60)
\end{alltt}
to datatype @{typ com}. Adjust the definitions of big-step
and small-step semantics, prove @{text"(c\<^sub>1 OR c\<^sub>2) \<sim> (c\<^sub>2 OR c\<^sub>1)"}
and update the equivalence proof between the two semantics.
\end{exercise}

\begin{exercise}
Extend IMP with exceptions. Add two constructors @{text THROW} and
@{text "TRY c\<^sub>1 CATCH c\<^sub>2"} to datatype @{typ com}:
\begin{alltt}
  THROW  |  Try com com   ("(TRY _/ CATCH _)"  [0, 61] 61)
\end{alltt}
Command @{text THROW} throws an exception. The only command that can
catch an execption is @{text "TRY c\<^sub>1 CATCH c\<^sub>2"}: if an execption
is thrown by @{text c\<^sub>1}, execution continues with @{text c\<^sub>2},
otherwise @{text c\<^sub>2} is ignored.
Adjust the definitions of big-step and small-step semantics as follows.

The big-step semantics is now of type @{typ "com \<times> state \<Rightarrow> com \<times> state"}.
In a big step @{text "(c,s) \<Rightarrow> (x,t)"}, @{text x} can only be @{term SKIP}
(signalling normal termination) or @{text THROW} (signalling that an exception
was thrown but not caught).

The small-step semantics is of the same type as before. There are two final
configurations now, @{term "(SKIP, t)"} and @{term "(THROW, t)"}.
Exceptions propagate upwards until an enclosing handler is found.
That is, until a configuration @{text "(TRY THROW CATCH c, s)"}
is reached and @{text THROW} can be caught.

Adjust the equivalence proof between the two semantics such that you obtain
@{text "cs \<Rightarrow> (SKIP,t)  \<longleftrightarrow>  cs \<rightarrow>* (SKIP,t)"}
and @{text "cs \<Rightarrow> (THROW,t)  \<longleftrightarrow>  cs \<rightarrow>* (THROW,t)"}.
Also revise the proof of
\noquotes{@{prop [source] "(\<exists>cs'. cs \<Rightarrow> cs')  \<longleftrightarrow>  (\<exists>cs'. cs \<rightarrow>* cs' \<and> final cs')"}}.
\end{exercise}
\<close>

(* Short_Theory_7_8.thy *)
(* Short_Theory_7_9.thy *)
(* Short_Theory_7_10.thy *)

end


(*
    $Id: sol.thy,v 1.4 2011/06/28 18:11:39 webertj Exp $
    Author: Farhad Mehta, Tobias Nipkow
*)

header {* Optimising Compilation for a Register Machine *}

(*<*) theory sol imports Main begin (*>*)

text {*\subsection*{The Source Language: Expressions}*}

text {*
The arithmetic expressions we will work with consist of variables, constants, and an arbitrary binary operator @{text "oper"}.
*}

consts
  oper :: "nat \<Rightarrow> nat \<Rightarrow> nat"

lemma operI:"\<lbrakk>a = c ; b = d\<rbrakk> \<Longrightarrow> oper a b = oper c d"
by simp

type_synonym var = string

datatype exp =
    Const nat
  | Var var
  | Op exp exp

text {*
The state in which an expression is evaluated is modelled by an {\em environment} function that maps variables to constants.
*}

type_synonym env = "var \<Rightarrow> nat"

text {*
The function @{text "value"} evaluates an expression in a given environment.
*}

primrec "value" :: "exp \<Rightarrow> env \<Rightarrow> nat" where
  "value (Const n) e = n"
| "value (Var v) e = (e v)"
| "value (Op e1 e2) e = (oper (value e1 e) (value e2 e))"

text {*\subsection*{The Register Machine}*}

text {*
Register indices and storage cells:
*}

type_synonym regIndex = nat

datatype cell =
    Acc
  | Reg regIndex

text {*The instruction set:*}
datatype instr =
    LI nat
  | LOAD regIndex
  | STORE regIndex
  | OPER regIndex

type_synonym state = "cell \<Rightarrow> nat"

text {*Result of executing a single machine instruction:*}
primrec execi :: "state \<Rightarrow> instr \<Rightarrow> state" where
  "execi s (LI n) = (s (Acc := n))"
| "execi s (LOAD r) = (s (Acc := s(Reg r)))"
| "execi s (STORE r) = (s ((Reg r) := (s Acc)))"
| "execi s (OPER r) = (s (Acc := (oper (s (Reg r)) (s Acc))))"

text {*Result of serially executing a sequence of machine instructions:*}
definition exec :: "state \<Rightarrow> instr list \<Rightarrow> state" where
  "exec s instrs == foldl execi s instrs"

text {*Some lemmas about @{text "exec"}:*}

lemma exec_app:"exec s (p1 @ p2) = exec (exec s p1) p2"
by (clarsimp simp:exec_def)

lemma exec_null:"exec s [] = s"
by (clarsimp simp:exec_def)

lemma exec_cons:"exec s (i#is) = exec (execi s i) is"
by (clarsimp simp:exec_def)

lemma exec_sing:"exec s [i] = execi s i"
by (clarsimp simp:exec_def)

section{*Compilation*}

text {*A {\em mapping} function maps variables to positions in the register file.*}

type_synonym map = "var \<Rightarrow> regIndex"

text {*
The function @{text "cmp"} recursively translates an expression into a sequence of instructions that computes it. At the end of execution, the result is stored in the accumulator. In addition to a {\em mapping} function, @{text "cmp"} takes the next free register index as input.
*}

primrec cmp :: "exp \<Rightarrow> map \<Rightarrow> regIndex \<Rightarrow> instr list" where
  "cmp (Const n) m r = [LI n]"
| "cmp (Var v) m r = [(LOAD (m v))]"
| "cmp (Op e1 e2) m r = (cmp e1 m r)@[STORE r]@
                           (cmp e2 m (Suc r))@[OPER r]"

text {*The correctness lemma for @{text "cmp"}:*}

theorem corr_and_no_se:
  "\<And> st r.
        \<lbrakk>\<forall>v. m v < r; \<forall>v. (env v) = (st (Reg (m v))) \<rbrakk> \<Longrightarrow>
        ((exec st (cmp e m r)) Acc = value e env) \<and>
        (\<forall>x. (x < r) \<longrightarrow> (((exec st (cmp e m r)) (Reg x)) = st (Reg x)))"
  (is "\<And> st r. \<lbrakk>?vars_below_r st r ;?var_vals st r \<rbrakk> \<Longrightarrow>
                                   ?corr st e r \<and> ?no_side_eff st e r")

txt {*
Note:
\begin{itemize}
  \item We need some way of giving @{text "cmp"} the start index @{text "r"} of the free region in the register file. Initially, @{text "r"} should be above all variable mappings. The first assumption ensures this.
  \item All variable mappings should agree with the {\em environment} used in @{text "value"}. The second assumption ensures this.
  \item The first part of the conclusion expresses the correctness of @{text "cmp"}.
  \item The second part of the conclusion expresses the fact that compilation does not use already allocated registers (i.e.\ those below @{text "r"}). This is needed for the inductive proof to go through.
\end{itemize}
*}

proof (induct e)
  case Const show ?case by (clarsimp simp:exec_def)
next
  case Var assume "?var_vals st r" then show ?case by (clarsimp simp:exec_def)
next
  case (Op e1 e2)
  assume hyp1:"\<And> st r. \<lbrakk>?vars_below_r st r ;?var_vals st r \<rbrakk> \<Longrightarrow>
                         ?corr st e1 r \<and> ?no_side_eff st e1 r"
    and hyp2:"\<And> st r. \<lbrakk>?vars_below_r st r ;?var_vals st r \<rbrakk> \<Longrightarrow>
                         ?corr st e2 r \<and> ?no_side_eff st e2 r"
    and vars_below_r:"?vars_below_r st r" and var_vals:"?var_vals st r"

  -- {* Four lemmas useful for simplification of main subgoal *}

  have rw1:"\<And>st x. \<lbrakk> x < (Suc r); ?var_vals st r \<rbrakk> \<Longrightarrow>
                     exec st (cmp e2 m (Suc r)) (Reg x) = st (Reg x)"
  proof -
    fix st x
    assume a:"x < Suc r" and b:"?var_vals st r"
    from vars_below_r have "?vars_below_r st (Suc r)"
      apply clarify
      by (erule_tac x=v in allE, simp)
    with a b hyp2[of "(Suc r)" "st"]  show "?thesis st x" by clarsimp
  qed

  have rw2:"\<And>st.?var_vals st r \<Longrightarrow>
            exec st (cmp e2 m (Suc r)) Acc = value e2 env"
  proof -
    fix st
    assume a:"?var_vals st r"
    from vars_below_r have b: "?vars_below_r st (Suc r)"
      apply clarify
      by (erule_tac x=v in allE, simp)
    from b a show "?thesis st"
      by (rule hyp2[THEN conjunct1,of "(Suc r)" "st"])
  qed

  have rw3:"\<And>st x. \<lbrakk> x < r ; ?var_vals st r \<rbrakk> \<Longrightarrow>
            exec st (cmp e1 m r) (Reg x) = st (Reg x)"
  proof -
    fix st x
    assume a:"x < r" and b:"?var_vals st r"
    with vars_below_r hyp1[of "r" "st"]  show "?thesis st x" by clarsimp
  qed

  from vars_below_r var_vals
  have val_e1:"exec st (cmp e1 m r) Acc = value e1 env"
    by (rule hyp1[THEN conjunct1,of "r" "st"])

  -- {* Two lemmas that express @{text "?var_vals"} also holds for the two states *}
  -- {* encountered in the proof of the main subgoal *}

  from vars_below_r var_vals
  have vB1:"?var_vals ((exec st (cmp e1 m r))
            (Reg r := exec st (cmp e1 m r) Acc)) r"
    by (auto simp:rw3)

  from vars_below_r var_vals
  have vB2:"?var_vals ((exec st (cmp e1 m r))(Reg r := value e1 env)) r"
    by (auto simp:rw3)

  show ?case
  proof
    show "?corr st (Op e1 e2) r"
      apply (simp add:exec_app exec_cons exec_null)
      apply (rule operI)
       apply (simp add:rw1 vB1 val_e1)
       apply (simp add:rw1 val_e1)
      apply (simp add:rw2 vB2)
      done
  next
    show "?no_side_eff st (Op e1 e2) r"
      apply clarify
      apply (simp add:exec_app exec_cons exec_null)
      apply (simp add:rw1 vB1)
      apply (simp add:rw3 var_vals)
      done
  qed
qed

section{*Compiler Optimisation: Common Subexpressions *}

text {*
The optimised compiler @{text "optCmp"}, should evaluate every commonly occurring subexpression only once.

General idea:
\begin{itemize}
  \item Generate a list of all sub-expressions occurring in a given expression. A given sub-expression in this list can only be 'one step' dependent on sub-expressions occurring earlier in the list. For example a possible list of sub-expressions for @{text "(a op b) op (a op b)"} is @{text "[a,b,a op b,a,b,a op b,(a op b) op (a op b)]"}.
  \item Note that the resulting sub-expression list specifies an order of evaluation for the given expression. The list in the above example is an evaluation sequence @{text "cmp"} would use. Since it contains duplicates, it is not what we want.
  \item Remove all duplicates from this list, in such a way, so as not to break the sub-expression list property (i.e.\ in case of a duplicate, remove the later occurance). For our example, this would result in @{text "[a,b,a op b,(a op b) op (a op b)]"}.
  \item Evaluate all expressions in this list in the order that they occur. Store previous results somewhere in the register file and use them to evaluate later sub-expressions.
\end{itemize}
*}

text{* The previous {\em mapping} function is extended to include all expressions, not just variables.*}

type_synonym expMap = "exp \<Rightarrow> regIndex"

text{*
Instead of a single expression, the new compilation function takes as input a list of expressions. It is assumed that this list satisfies the sub-expression property discussed above.

At each step, it will compute the value of an expression, store it in the register file, and update the {\em mapping} function to reflect this.
*}

primrec optCmp :: "exp list \<Rightarrow> expMap \<Rightarrow> regIndex \<Rightarrow> instr list" where
  "optCmp [] m r = []"
| "optCmp (x#xs) m r = (case x of
    (Const n) \<Rightarrow>
      [LI n]@[STORE r]@                      (optCmp xs (m(x := r)) (Suc r)) |
    (Var v) \<Rightarrow>
      [(LOAD (m (Var v)))]@[STORE r]@        (optCmp xs (m(x := r)) (Suc r)) |
    (Op e1 e2) \<Rightarrow>
      [LOAD (m e2)]@[OPER (m e1)]@[STORE r]@ (optCmp xs (m(x := r)) (Suc r))
  )"

text{*
The function @{text "alloc"} returns the register allocation done by @{text "optCmp"}: *}
primrec alloc :: "expMap \<Rightarrow> exp list \<Rightarrow> regIndex \<Rightarrow> expMap" where
  "alloc m [] r = m"
| "alloc m (e#es) r = alloc (m(e := r)) es (Suc r)"

text{*
Some lemmas about @{text "alloc"} and @{text "optCmp"}:*}

lemma allocApp:"\<And> m r. alloc m (as @ bs) r =
                alloc (alloc m as r) bs (r + length as)"
by (induct as, auto)

lemma allocNotIn:"\<And>m r. e \<notin> set es \<Longrightarrow> alloc m es r e = m e"
by (induct es, auto)

text{*Sequential search in a list:*}
primrec search :: "'a \<Rightarrow> 'a list \<Rightarrow> nat" where
  "search a [] = 0"
| "search a (x#xs) = (if (x=a) then 0 else Suc (search a xs))"

lemma searchLessLength:"\<And> a. a:set xs \<Longrightarrow> search a xs < length xs"
by (induct xs, auto)

lemma allocIn:"\<And>m r. \<lbrakk>distinct es; e \<in> set es\<rbrakk> \<Longrightarrow>
                 (alloc m es r e) = r + search e es"
apply (induct es)
 apply (auto)
apply (frule_tac m="(m(e := r))" and r="(Suc r)" in allocNotIn)
apply simp
done

lemma optCmpApp:"\<And> i m r. i = length as \<Longrightarrow>
  optCmp (as@bs) m r = (optCmp as m r) @ (optCmp bs (alloc m as r) (r+i))"
apply (induct as)
 apply clarsimp
apply (case_tac a, auto)
done

text{*
The function  @{text "supExp"} expresses the converse of the sub-expression property discussed earlier:*}
primrec supExp :: "exp list \<Rightarrow> bool" where
  "supExp [] = True"
| "supExp (e#es) = (case e of
                    (Const n) \<Rightarrow> supExp es |
                    (Var v) \<Rightarrow> supExp es  |
                    (Op e1 e2) \<Rightarrow> (supExp es) \<and> (e1 : set es) \<and> (e2 : set es)
  )"

text{*
A definition of @{text "subExp"} using  @{text "supExp"} (a direct definition is harder!):*}
definition subExp :: "exp list \<Rightarrow> bool" where
  "subExp es == supExp (rev es)"

text{*
The correctness theorem for @{text "optCmp"}:*}
theorem opt_corr_and_no_se:
  "\<And> st r.
        \<lbrakk>\<forall>e. (m e) < r; \<forall>v. (env v) = (st (Reg (m (Var v))));
                                      subExp es; distinct es \<rbrakk> \<Longrightarrow>
        (\<forall>e\<in>set es. (exec st (optCmp es m r)) (Reg ((alloc m es r) e))
        = value e env) \<and>
        (\<forall>x. (x < r) \<longrightarrow> (((exec st (optCmp es m r)) (Reg x)) = st (Reg x)))"
txt {*
Note:
\begin{itemize}
  \item As input, we have an arbitrary expression list that satisfies the sub-expression property.
  \item The assumption that this list is unique is not strictly required, but makes the proof easier.
  \item The rest of theorem bears resemblance to that of @{text "cmp"}.
\end{itemize}
*}
apply (induct es rule:rev_induct)
 apply (clarsimp simp: exec_cons exec_null)
apply (simp only:optCmpApp exec_app subExp_def)
apply (case_tac x)

  --"Const case"
  apply clarsimp
  apply rule
   apply (simp add:allocApp)
   apply (simp add:exec_cons exec_null)
  apply rule
   apply clarsimp
   apply (simp add:allocApp)
   apply rule
    apply (simp add:exec_cons exec_null)
   apply (simp add:exec_cons exec_null)
   apply clarsimp
   apply (frule_tac m="m" and e="e" and r="r" in allocIn)
    apply assumption
   apply (frule searchLessLength)
   apply simp
  apply clarsimp
  apply (simp add:exec_cons exec_null)

  --"Var case"
 apply clarsimp
 apply rule
  apply (simp add:allocApp)
  apply (simp add:exec_cons exec_null)
  apply (frule_tac m="m" and r="r" in allocNotIn)
  apply clarsimp
 apply (simp add:allocApp)
 apply rule
  apply clarsimp
  apply rule
   apply (clarsimp simp add:exec_cons exec_null)
  apply (clarsimp simp add:exec_cons exec_null)
  apply (frule_tac m="m" and e="e" and r="r" in allocIn)
   apply assumption
  apply (frule searchLessLength)
  apply simp
 apply clarsimp
 apply (simp add:exec_cons exec_null)

--"Op case"
apply clarsimp
apply rule
 apply (simp add:allocApp)
 apply (simp add:exec_cons exec_null)
apply (simp add:allocApp)
apply rule
 apply clarsimp
 apply rule
 apply (clarsimp simp add:exec_cons exec_null)
 apply (clarsimp simp add:exec_cons exec_null)
 apply (frule_tac m="m" and e="e" and r="r" in allocIn)
  apply assumption
 apply (frule_tac a="e" in searchLessLength)
 apply simp
apply clarsimp
apply (simp add:exec_cons exec_null)
done

text{*
Till now we have proven that @{text "optCmp"} is correct for an expression list that satisfies some properties. Now we show that one such list can be generated from any given expression.
*}

text{*
Pre-order traversal of an expression:
*}

primrec preOrd :: "exp \<Rightarrow> exp list" where
  "preOrd (Const n) = [Const n]"
| "preOrd (Var v) = [Var v]"
| "preOrd (Op e1 e2) = (Op e1 e2)#(preOrd e1 @ preOrd e2)"

lemma self_in_preOrd:"e \<in> set (preOrd e)"
by(case_tac e, auto)

text{*
The function @{text "optExp"} generates a distinct sub-expression list from a given expression:
*}
definition optExp ::"exp \<Rightarrow> exp list" where
  "optExp e == rev (remdups (preOrd e))"

lemma distinct_rev:"distinct (rev xs) = distinct xs"
by (induct xs, auto)

lemma supExp_app:"\<And> bs. \<lbrakk> supExp as ; supExp bs \<rbrakk> \<Longrightarrow> supExp (as @ bs)"
apply (induct as)
 apply clarsimp
apply (case_tac a)
  apply auto
done

lemma supExp_remdups:"\<And> bs. supExp as \<Longrightarrow> supExp (remdups as)"
apply (induct as)
 apply clarsimp
apply (case_tac a)
  apply auto
done

lemma supExp_preOrd:"supExp (preOrd e)"
apply (induct e)
 apply (auto dest:supExp_app simp:self_in_preOrd )
done

text{*
Proof that a list generated by @{text "optExp"} is distinct and satisfies the sub-expression property:
*}

lemma optExpDistinct:"distinct(optExp e)"
by (simp add:optExp_def)

lemma optExpSupExp:"subExp (optExp e)"
apply (induct e)
 apply (auto simp:optExp_def self_in_preOrd subExp_def
        intro:supExp_remdups supExp_preOrd supExp_app)
done

text{*
Do @{text "optCmp"} @{text "optExp"} and generate code that evaluate all common sub-expressions only once?

Yes. Since @{text "optExp"} returns all commonly occurring sub-expressions only once, and @{text "optCmp"} evaluates these only once, all common sub-expressions are evaluated only once.
*}

text{*
But, for those of little faith:
*}

lemma opt:"\<And>m r. length (filter (\<lambda>e. \<exists>x y. e = (Op x y)) es) =
                length (filter (\<lambda>i. \<exists>x. i = (OPER x)) (optCmp es m r))"
apply (induct es)
 apply clarsimp
apply (case_tac a)
  apply auto
done

end


theory Chapter5
imports Main
begin

(* jEdit(1) *)
lemma "\<not> surj(f :: 'a \<Rightarrow> 'a set)"
proof
  assume 0: "surj f"
  from 0 have 1: "\<forall>A. \<exists>a. A = f a" by auto
  from 1 have 2: "\<exists>a. {x. x \<notin> f x } = f a" by auto
  from 2 show "False" by auto
qed

lemma "\<not> surj(f :: 'a \<Rightarrow> 'a set)"
proof
  assume "surj f"
  from this have "\<exists>a. {x. x \<notin> f x} = f a" by auto
  from this show "False" by auto
qed

lemma "\<not> surj(f :: 'a \<Rightarrow> 'a set)"
proof
  assume "surj f"
  hence "\<exists>a. {x. x \<notin> f x} = f a" by auto
  thus "False" by auto
qed

lemma
  fixes f:: "'a \<Rightarrow> 'a set"
  assumes s: "surj f"
  shows "False"
proof-
  have "\<exists>a. {x. x \<notin> f x} = f a" using s
    by auto
  thus "False" by auto
qed

(* obtain *)
lemma "\<not> surj (f:: 'a \<Rightarrow> 'a set)"
proof
  assume "surj f"
  hence "\<exists> a. {x. x \<notin> f x} = f a" by auto
  then obtain a where "{x. x \<notin> f x} = f a" by auto
  hence "a \<notin> f a \<longleftrightarrow> a \<in> f a" by auto
  thus "False" by auto
qed

(* case analysis *)
lemma
  fixes P:: "bool"
  shows "P = True \<or> P = False"
proof (cases P)
  case True
  then show ?thesis by auto
  next
  case False
  then show ?thesis by auto
qed

thm dvd_def

value "(18::nat) dvd 9"
value "(18::nat) dvd 36"

(* raw proof block *)
lemma
  fixes a b :: int
  assumes "b dvd (a + b)" shows "b dvd a"
proof -
  { fix k
    assume k : "a + b = b * k"
    have "\<exists>k'. a = b * k'"
    proof
      show "a = b * (k - 1)" using k by (simp add: algebra_simps)
    qed
  }
  then show ?thesis using assms by (auto simp add: dvd_def)
qed

(* Ex 5.1 *)
lemma assumes T: "\<forall>x y. T x y \<or> T y x"
  and A: "\<forall> x y. A x y \<and> A y x \<longrightarrow> x = y"
  and TA: "\<forall> x y. T x y \<longrightarrow> A x y" and "A x y"
shows "T x y"
proof cases
  assume "T x y"
  thus "T x y" by auto
next
  assume "\<not> T x y"
  then have "T y x" using T by auto
  then have "A y x" using TA by auto
  then have "x = y" using assms by auto
  thus "T x y" using T by auto
qed

(* Ex 5.2 *)
(* lemma "(\<exists>ys zs. xs = ys @ zs \<and> length ys = length zs) \<or>
       (\<exists>ys zs. xs = ys @ zs \<and> length ys = length zs + 1)"
proof (induction xs)
  sorry *)

(* datatype case analysis *)
lemma "length (tl xs) = length xs - 1"
proof (cases xs)
  assume "xs = []" (* Nil *)
  thus ?thesis by simp
next
  fix y ys
  assume "xs = y # ys" (* Cons y ys *)
  thus ?thesis by simp
qed

(* structural induction *)
lemma "\<Sum> {0..n::nat} = n * (n + 1) div 2"
proof (induction n)
  show "\<Sum> {0..0::nat} = 0 * (0 + 1) div 2" by simp
next
  fix n
  assume "\<Sum> {0..n::nat} = n * (n + 1) div 2"
  thus "\<Sum> {0..Suc n} = Suc n * (Suc n + 1) div 2" by simp
qed

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

(* rule induction *)

inductive ev :: "nat \<Rightarrow> bool" where
  ev0: "ev 0"
| evSS: "ev n \<Longrightarrow> ev (Suc (Suc n))"

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

lemma "ev n \<Longrightarrow> evn n"
proof (induction rule: ev.induct)
  case ev0
  show ?case by simp
next
  case evSS
  from this show ?case by simp
qed

lemma "ev n \<Longrightarrow> evn n"
proof (induction rule: ev.induct)
  case ev0
  then show ?case by simp
next
  case (evSS n)
  have "evn (Suc (Suc n)) = evn n" by simp
  thus ?case using `evn n` by blast
qed

(* rule inversion *)
lemma "\<not> ev (Suc 0)"
proof
  assume "ev (Suc 0)"
  thus False by cases
qed

lemma
  assumes a: "ev (Suc (Suc n))"
  shows "ev n"
proof -

(* simple exeicise *)
lemma "\<not> ev (Suc (Suc (Suc 0)))"
proof
  assume "ev (Suc (Suc (Suc 0)))"
  thus False
  proof -
    from this have "ev (Suc 0)" by (simp add: ev.evSS)

(* advanced rule induction *)
lemma "ev (Suc m) \<Longrightarrow> \<not> ev m"
proof (induction "Suc m" arbitrary: m rule: ev.induct)
  fix n
  assume IH: "\<And>m. n = Suc m \<Longrightarrow> \<not> ev m"
  show "\<not> ev (Suc n)"
  proof
    assume "ev (Suc n)"
    thus False
    proof cases
      fix k
      assume "n = Suc k" "ev k"
      thus False using IH by auto
    qed
  qed
qed

end


theory GabrielaLimonta
imports Main
begin

(** Score: 6/10
  4.1: Proof missing, only Nil-case: 1/5

**)

(* Homework 4.1 *)
type_synonym ('q, 'l) lts = "'q \<Rightarrow> 'l \<Rightarrow> 'q \<Rightarrow> bool"

inductive word :: "('q, 'l) lts \<Rightarrow> 'q \<Rightarrow> 'l list \<Rightarrow> 'q \<Rightarrow> bool" for \<delta> where
  E: "word \<delta> u [] u" |
  NE: "\<lbrakk>\<delta> u w x ; word \<delta> x ws v\<rbrakk> \<Longrightarrow> word \<delta> u (w#ws) v"

definition "det \<delta>  \<equiv> \<forall> q a q1 q2. \<delta> q a q1 \<and> \<delta> q a q2 \<longrightarrow> q1 = q2"

inductive_cases empty_elim: "word \<delta> q [] q'"
inductive_simps empty_simp: "word \<delta> q [] q'"

(** Note the theorem that the above statement generated.
  Very similar to what you prove below!
**)
thm empty_simp

lemma aux[simp]: "word \<delta> q [] q' \<longleftrightarrow> q=q'"
proof
  assume a: "word \<delta> q [] q'"
  thus "q = q'" using empty_elim empty_simp by (metis a)
next
  assume "q=q'"
  thus "word \<delta> q [] q'" using word.E by simp
qed

lemma
  assumes det: "det \<delta>"
  shows "word \<delta> q w q' \<Longrightarrow> word \<delta> q w q'' \<Longrightarrow> q' = q''"
  proof (induction rule: word.induct)
  print_cases
  case E show ?case using E by auto
next
  case (NE u w x ws v)
  show ?case using assms NE aux
  using [[simp_trace]]
sorry
qed

(* Homework 4.2 *)
datatype ab = a | b

inductive_set S :: "ab list set" where
  left: "w1 \<in> S \<Longrightarrow> w2 \<in> S \<Longrightarrow> [a] @ w1 @ [b] @ w2 \<in> S"
| nil: "[] \<in> S"

inductive_set T :: "ab list set" where
  right: "w1 \<in> T \<Longrightarrow> w2 \<in> T \<Longrightarrow> w1 @ [a] @ w2 @ [b] \<in> T"
| nil: "[] \<in> T"

lemma S_SS[simp]:
  assumes "w1 \<in> S"
  assumes "w2 \<in> S"
  shows "w1 @ w2 \<in> S"
using assms
proof (induction rule: S.induct)
print_cases
  case nil show ?case using nil.prems S.left S.nil by simp
next
  case (left w1 w2)
  show ?case using S.left left append_assoc append_Cons append_Nil by auto
qed

lemma T_TT[simp]:
  assumes "w1 \<in> T"
  assumes "w2 \<in> T"
  shows "w2 @ w1 \<in> T"
using assms
proof (induction rule: T.induct)
print_cases
  case nil show ?case using nil.prems T.right T.nil by simp
next
  case (right w1 w2)
  show ?case using right append_assoc append_Cons append_Nil by (metis T.right)
qed

lemma S_imp_T:
  assumes w: "w \<in> S"
  shows "w \<in> T"
  using assms
proof (induction rule: S.induct)
print_cases
  case nil show ?case using T.nil by simp
next
  case (left w1 w2)
  show ?case
  using left T.intros append_assoc append_Cons append_Nil T_TT
  by (metis Tp_T_eq)
qed

lemma T_imp_S:
  assumes w: "w \<in> T"
  shows "w \<in> S"
using assms
proof (induction rule: T.induct)
print_cases
  case nil show ?case using S.nil by simp
next
  case (right w1 w2)
  show ?case
  using right S.intros append_assoc append_Cons append_Nil S_SS by simp
qed

lemma "S = T"
proof
  show "S \<subseteq> T"
  using S_imp_T by auto
next
  show "T \<subseteq> S"
  using T_imp_S by auto
qed

end


theory Exercise7
  imports Main
begin

datatype 'a tree2 =
  Tip
  | Leaf 'a
  | Branch "'a tree2" 'a "'a tree2"

fun mirror :: "'a tree2 \<Rightarrow> 'a tree2" where
  "mirror Tip = Tip"
  | "mirror (Leaf l) = Leaf l"
  | "mirror (Branch l v r) = Branch (mirror r) v (mirror l)"

fun pre_order :: "'a tree2 \<Rightarrow> 'a list" where
  "pre_order Tip = Nil"
  | "pre_order (Leaf l) = [l]"
  | "pre_order (Branch l v r) = [v] @ (pre_order l) @ (pre_order r)"

fun post_order :: "'a tree2 \<Rightarrow> 'a list" where
  "post_order Tip = Nil"
  | "post_order (Leaf l) = [l]"
  | "post_order (Branch l v r) = (post_order l) @ (post_order r) @ [v]"

theorem pre_mirror_is_rev_post [simp]: "pre_order (mirror t) = rev (post_order t)"
  apply (induction t)
  apply auto
done

end