theory Binary_Arithmetic_Nat
  imports Binary_Arithmetic  Primitives
begin

fun nth_bit_of_num_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"nth_bit_of_num_nat x n  = (if x = 0 then
                              (if n = 0 then
                                 1 \<comment> \<open>x = 0 \<and> n = 0\<close>
                               else
                                 0 \<comment> \<open>x = 0 \<and> n \<noteq> 0\<close>)
                            else
                              if n = 0 then
                                (if hd_nat x = 0 then
                                   0 \<comment> \<open>x \<noteq> 0 \<and> n = 0 \<and> hd_nat x = 0\<close>
                                 else
                                   1 \<comment> \<open>x \<noteq> 0 \<and> n = 0 \<and> hd_nat x \<noteq> 0\<close>)
                              else
                                nth_bit_of_num_nat (tl_nat x) (n-1))"

definition nth_bit_of_num_tail ::"nat \<Rightarrow> nat \<Rightarrow> nat" where
"nth_bit_of_num_tail x n =  nth_bit_of_num_nat x n"

lemma subtail_nth_bit_of_num :"nth_bit_of_num_tail x n =  nth_bit_of_num_nat x n"
  using nth_bit_of_num_tail_def by simp

lemma sub_nth_bit_of_num: "nth_bit_of_num_nat (num_encode x) n = bit_encode (nth_bit_of_num x n)"
     apply (subst nth_bit_of_num_nat.simps)
  apply (induct x n rule:nth_bit_of_num.induct)
       apply (simp_all (no_asm_simp)  only:sub_hd sub_tl num_encode_def
       num_to_list.simps nth_bit_of_num.simps list_encode.simps tail.simps head.simps list_encode_eq
   del: nth_bit_of_num_nat.simps   flip:list_encode.simps )
     apply (simp_all only: flip: nth_bit_of_num_nat.simps num_encode_def)
   apply auto
  done

lemma dom_nth_bit_nat:"nth_bit_nat a n = 0 \<or> nth_bit_nat a n = Suc 0"
  apply (induction n arbitrary: a)
   apply auto
  done

lemma sub_nth_bit : "nth_bit_nat a n = bit_encode (nth_bit a n)"
  apply (cases "nth_bit_nat a n")
  apply (auto simp add: nth_bit_def )
   using  dom_nth_bit_nat
   by (metis Suc_inject old.nat.distinct(2))

fun nth_carry_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
"nth_carry_nat n a b = (if n = 0 then (if (nth_bit_nat a 0 = 1 \<and> nth_bit_nat b 0 = 1) then 1 else 0)
 else (if (nth_bit_nat a n = 1 \<and> nth_bit_nat b n = 1)
  \<or> ((nth_bit_nat a n = 1 \<or> nth_bit_nat b n = 1) \<and> nth_carry_nat (n-1) a b = 1)
  then 1 else 0) )"

fun nth_carry_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow>nat" where
"nth_carry_acc acc diff n a b = (if diff = 0 then acc else
if diff>n then (if (nth_bit_tail a 0 = 1 \<and> nth_bit_tail b 0 = 1) then nth_carry_acc 1 n n a b
   else  nth_carry_acc 0 n n a b )
else (if (nth_bit_tail a (n-diff+1) = 1 \<and> nth_bit_tail b (n-diff+1) = 1)
  \<or> ((nth_bit_tail a (n-diff+1) = 1 \<or> nth_bit_tail b (n-diff+1) = 1) \<and> (acc = 1))
  then nth_carry_acc 1 (diff-1) n a b else nth_carry_acc 0 (diff-1) n a b))"

lemma nth_carry_step:"diff < n \<Longrightarrow> nth_carry_acc (nth_carry_nat (n- Suc diff) a b ) (Suc diff) n a b
=  nth_carry_acc (nth_carry_nat (n-diff) a b) diff n a b "
  apply (subst (1) nth_carry_acc.simps )
  apply (auto simp add: Suc_diff_Suc subtail_nth_bit
            simp del: nth_carry_acc.simps nth_bit_nat.simps nth_carry_nat.simps simp flip: One_nat_def)
  apply (auto  simp add: subtail_nth_bit)
  done

lemma nth_carry_induct:"diff \<le>n \<Longrightarrow> nth_carry_acc (nth_carry_nat (n-diff) a b) diff n a b
= nth_carry_nat n a b"
  apply (induct diff)
  apply simp
   apply (auto simp add: nth_carry_step simp del:nth_carry_acc.simps nth_carry_nat.simps )
  done

lemma nth_carry_base:"nth_carry_nat 0 a b = (if (nth_bit_nat a 0 = 1 \<and> nth_bit_nat b 0 = 1)
            then 1 else 0)"
  apply auto
  done

definition nth_carry_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
"nth_carry_tail n a b = nth_carry_acc 0 (Suc n) n a b"

lemma subtail_nth_carry:
"nth_carry_tail n a b
= nth_carry_nat n a b"
  apply (auto simp only: nth_carry_tail_def)
  apply (subst nth_carry_acc.simps)
  using nth_carry_induct[of n n a b] nth_carry_base subtail_nth_bit
   apply (auto simp add:  simp del:nth_carry_acc.simps nth_carry_nat.simps nth_bit_nat.simps )
  done

lemma sub_nth_carry: "nth_carry_nat n a b = bit_encode (nth_carry n a b)"
  apply (induct n)
  apply (auto simp add: sub_nth_bit)
  done

fun nth_carry_sub_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
"nth_carry_sub_nat n a b = (if n =0
    then (if (nth_bit_nat a 0 = 0 \<and> nth_bit_nat b 0 = 1)
            then 1 else 0)
    else (if (nth_bit_nat a n = 0 \<and> ( nth_bit_nat b n = 1 \<or> nth_carry_sub_nat (n-1) a b = 1))
                \<or> (nth_bit_nat a n = 1 \<and> (nth_bit_nat b n) = 1 \<and> nth_carry_sub_nat (n-1) a b = 1)
           then 1
            else 0))"

fun nth_carry_sub_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
"nth_carry_sub_acc acc diff n a b = (if diff = 0 then acc else
(if diff > n
    then (if (nth_bit_tail a 0 = 0 \<and> nth_bit_tail b 0 = 1)
            then nth_carry_sub_acc 1 n n a b  else nth_carry_sub_acc 0 n n a b)
    else (if (nth_bit_tail a (n-diff+1) = 0 \<and> ( nth_bit_tail b (n-diff+1) = 1 \<or> acc = 1))
                \<or> (nth_bit_tail a (n-diff+1) = 1 \<and> (nth_bit_tail b (n-diff+1) ) = 1 \<and> acc = 1)
           then  nth_carry_sub_acc 1 (diff -1) n a b
            else nth_carry_sub_acc 0 (diff - 1) n a b))
)  "

lemma nth_carry_sub_step:"diff < n \<Longrightarrow> nth_carry_sub_acc (nth_carry_sub_nat (n- Suc diff) a b ) (Suc diff) n a b
=  nth_carry_sub_acc (nth_carry_sub_nat (n-diff) a b) diff n a b "
  apply (subst (1) nth_carry_sub_acc.simps )
  apply (subst (1) nth_carry_sub_nat.simps)
  apply (auto simp add: Suc_diff_Suc subtail_nth_bit
            simp del: nth_carry_sub_acc.simps nth_bit_nat.simps nth_carry_sub_nat.simps simp flip: One_nat_def)
  apply (metis One_nat_def  nth_carry_sub_nat.elims)
  apply auto
  done
lemma nth_carry_sub_induct:"diff \<le>n \<Longrightarrow> nth_carry_sub_acc (nth_carry_sub_nat (n-diff) a b) diff n a b
= nth_carry_sub_nat n a b"
  apply (induct diff)
  apply simp
   apply (auto simp add: nth_carry_sub_step simp del:nth_carry_sub_acc.simps nth_carry_sub_nat.simps )
  done
lemma nth_carry_sub_base:"nth_carry_sub_nat 0 a b = (if (nth_bit_nat a 0 = 0 \<and> nth_bit_nat b 0 = 1)
            then 1 else 0)"
  apply auto
  done

definition nth_carry_sub_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
"nth_carry_sub_tail n a b = nth_carry_sub_acc 0 (Suc n) n a b"

lemma subtail_nth_carry_sub:
"nth_carry_sub_tail n a b
= nth_carry_sub_nat n a b"
  apply (auto simp only: nth_carry_sub_tail_def)
  apply (subst nth_carry_sub_acc.simps)
  using nth_carry_sub_induct[of n n a b] nth_carry_sub_base subtail_nth_bit
   apply (auto simp add:  simp del:nth_carry_sub_acc.simps nth_carry_sub_nat.simps nth_bit_nat.simps )
  done

fun bit_list_to_nat_nat:: "nat \<Rightarrow> nat" where
"bit_list_to_nat_nat n = (if n =0 then 0 else if hd_nat n =0 then 2 *bit_list_to_nat_nat (tl_nat n)
   else  2*bit_list_to_nat_nat (tl_nat n) + 1)"

lemma sub_bit_list_to_nat: "bit_list_to_nat_nat (list_encode (map bit_encode x)) = bit_list_to_nat x"
  apply (induct x)
   apply (simp)
  apply (subst bit_list_to_nat_nat.simps)
  apply (auto simp only: sub_hd sub_tl sub_tail_map tl_def
          sub_head_map bit_list_to_nat.simps split:bit.splits)
   apply (auto)
  done
fun bit_list_to_nat_acc:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"bit_list_to_nat_acc acc n = (if n =0 then acc else if hd_nat n =0 then bit_list_to_nat_acc (2*acc) (tl_nat n)
   else  bit_list_to_nat_acc (2*acc +1) (tl_nat n))"

lemma bit_list_to_nat_induct: "bit_list_to_nat_nat (append_nat (reverse_nat ys) xs) = bit_list_to_nat_acc (bit_list_to_nat_nat xs) ys"
  apply(induct ys arbitrary:xs rule: length_nat.induct)
  apply (auto simp only: reverse_nat_0 append_nat.simps)
  apply(subst bit_list_to_nat_acc.simps)
   apply(auto simp del: bit_list_to_nat_nat.simps bit_list_to_nat_acc.simps
          simp add: append_rev_nat )
  apply(subst(2) bit_list_to_nat_acc.simps)
     apply(auto simp del: bit_list_to_nat_nat.simps bit_list_to_nat_acc.simps cons_def
          simp add: append_rev_nat )
     apply(subst bit_list_to_nat_nat.simps)
          apply(auto simp del:   bit_list_to_nat_nat.simps bit_list_to_nat_acc.simps cons_def
          simp add: append_cons_nat_0 cons_Nil tl_cons hd_cons)
  apply(subst bit_list_to_nat_nat.simps)
 apply(auto simp del:   bit_list_to_nat_nat.simps bit_list_to_nat_acc.simps cons_def
          simp add: append_cons_nat_0 cons_Nil tl_cons hd_cons)
  done

lemma bit_list_to_nat_inverse:
"bit_list_to_nat_nat (append_nat ys xs) = bit_list_to_nat_acc (bit_list_to_nat_nat xs) (reverse_nat ys)"
  using rev_rev_nat bit_list_to_nat_induct by metis

definition bit_list_to_nat_tail :: "nat \<Rightarrow> nat" where
"bit_list_to_nat_tail ys =  bit_list_to_nat_acc 0 (reverse_nat ys)"

lemma subtail_bit_list_to_nat:
" bit_list_to_nat_tail ys = bit_list_to_nat_nat ys"
  using bit_list_to_nat_inverse [of ys 0] append_nat_0
  by (auto simp add: bit_list_to_nat_tail_def)

end


(*  Title:       A General Method for the Proof of Theorems on Tail-recursive Functions
    Author:      Pasquale Noce, Security Certification Specialist at Arjowiggins Security
                 (pasquale dot noce at arjowiggins-it dot com)
*)

header "Case study 2"

theory CaseStudy2
imports Main "~~/src/HOL/Library/Multiset"
begin

text {*
\null

In the second case study, the problem will be examined of defining a function
@{text t_ins} performing item insertion into binary search trees (admitting value
repetitions) of elements of a linear order, and then proving the correctness of
this definition, i.e. that the trees output by the function still be sorted if
the input ones are and contain one more occurrence of the inserted value, the
number of occurrences of any other value being left unaltered.

Here below is a naive tail-recursive definition of such function:

\null
*}

datatype 'a bintree = Leaf | Branch 'a "'a bintree" "'a bintree"

function (sequential) t_ins_naive ::
 "bool \<Rightarrow> 'a::linorder \<Rightarrow> 'a bintree list \<Rightarrow> 'a bintree"
where
"t_ins_naive False x (Branch y yl yr # ts) = (if x \<le> y
  then t_ins_naive False x (yl # Branch y yl yr # ts)
  else t_ins_naive False x (yr # Branch y yl yr # ts))" |
"t_ins_naive False x (Leaf # ts) =
  t_ins_naive True x (Branch x Leaf Leaf # ts)" |
"t_ins_naive True x (xt # Branch y yl yr # ts) = (if x \<le> y
  then t_ins_naive True x (Branch y xt yr # ts)
  else t_ins_naive True x (Branch y yl xt # ts))" |
"t_ins_naive True x [xt] = xt"
by pat_completeness auto

text {*
\null

The list appearing as the third argument, deputed to initially contain the sole
tree into which the second argument has to be inserted, is used to unfold all the
involved subtrees until a leaf is reached; then, such leaf is replaced with a branch
whose root value matches the second argument, and the subtree list is folded again.
The information on whether unfolding or folding is taking place is conveyed by the
first argument, whose value will respectively be @{text False} or @{text True}.

According to this plan, the computation is meant to terminate in correspondence
with pattern @{text True}, @{text _}, @{text "[_]"}. Hence, the above naive
definition comprises a non-recursive equation for this pattern only, so that the
residual ones @{text True}, @{text _}, @{text "_ # Leaf # _"} and @{text _},
@{text _}, @{text "[]"} are not covered by any equation.

That which decreases in recursive calls is the size of the head of the subtree
list during unfolding, and the length of the list during folding. Furthermore,
unfolding precedes folding in the recursive call pipeline, viz. there is a
recursive equation switching from unfolding to folding, but no one carrying out
the opposite transition. These considerations suggest that a measure function
suitable to prove the termination of function @{text t_ins_naive} should roughly
match the sum of the length of the list and the size of the list head during
unfolding, and the length of the list alone during folding.

This idea can be refined by observing that the length of the list increases by one
at each recursive call during unfolding, and does not change in the recursive call
leading from unfolding to folding, at which the size of the input list head (a
leaf) equals zero. Therefore, in order that the measure function value be strictly
decreasing in each recursive call, the size of the list head has to be counted more
than once during unfolding -- e.g. twice --, and the length of the list has to be
decremented by one during folding -- no more than that, as otherwise the function
value would not change in the passage from a two-item to a one-item list.

As a result, a suitable measure function and the corresponding termination proof
are as follows:

\null
*}

fun t_ins_naive_measure :: "bool \<times> 'a \<times> 'a bintree list \<Rightarrow> nat" where
"t_ins_naive_measure (b, x, ts) = (if b
  then length ts - 1
  else length ts + 2 * size (hd ts))"

termination t_ins_naive
by (relation "measure t_ins_naive_measure", simp_all)

text {*
\null

Some further functions are needed to express the aforesaid correctness
properties of function @{text t_ins_naive}:

\null
*}

primrec t_set :: "'a bintree \<Rightarrow> 'a set" where
"t_set Leaf = {}" |
"t_set (Branch x xl xr) = {x} \<union> t_set xl \<union> t_set xr"

primrec t_multiset :: "'a bintree \<Rightarrow> 'a multiset" where
"t_multiset Leaf = {#}" |
"t_multiset (Branch x xl xr) = {#x#} + t_multiset xl + t_multiset xr"

lemma t_set_multiset: "t_set xt = set_of (t_multiset xt)"
by (induction, simp_all)

primrec t_sorted :: "'a::linorder bintree \<Rightarrow> bool" where
"t_sorted Leaf = True" |
"t_sorted (Branch x xl xr) =
  ((\<forall>y \<in> t_set xl. y \<le> x) \<and> (\<forall>y \<in> t_set xr. x < y) \<and> t_sorted xl \<and> t_sorted xr)"

definition t_count :: "'a \<Rightarrow> 'a bintree \<Rightarrow> nat" where
"t_count x xt \<equiv> count (t_multiset xt) x"

text {*
\null

Functions @{text t_set} and @{text t_multiset} return the set and the multiset,
respectively, of the items of the input tree; the connection between them
expressed by lemma @{text t_set_multiset} will be used in step 9.

The target correctness theorems can then be enunciated as follows:

\null

@{text "t_sorted xt \<longrightarrow> t_sorted (t_ins_naive False x [xt])"}

\null

@{text "t_count y (t_ins_naive False x [xt]) ="}

@{text "(if y = x then Suc else id) (t_count y xt)"}
*}

subsection "Step 1"

text {*
This time, the Cartesian product of the input types will be implemented as a
record type. The second command instructs the system to regard such type as a
datatype, thus enabling record patterns:

\null
*}

record 'a t_type =
 folding :: bool
 item :: 'a
 subtrees :: "'a bintree list"

function (sequential) t_ins_aux :: "'a::linorder t_type \<Rightarrow> 'a t_type" where
"t_ins_aux \<lparr>folding = False, item = x, subtrees = Branch y yl yr # ts\<rparr> =
  (if x \<le> y
  then t_ins_aux \<lparr>folding = False, item = x,
    subtrees = yl # Branch y yl yr # ts\<rparr>
  else t_ins_aux \<lparr>folding = False, item = x,
    subtrees = yr # Branch y yl yr # ts\<rparr>)" |
"t_ins_aux \<lparr>folding = False, item = x, subtrees = Leaf # ts\<rparr> =
  t_ins_aux \<lparr>folding = True, item = x, subtrees = Branch x Leaf Leaf # ts\<rparr>" |
"t_ins_aux \<lparr>folding = True, item = x, subtrees = xt # Branch y yl yr # ts\<rparr> =
  (if x \<le> y
  then t_ins_aux \<lparr>folding = True, item = x, subtrees = Branch y xt yr # ts\<rparr>
  else t_ins_aux \<lparr>folding = True, item = x, subtrees = Branch y yl xt # ts\<rparr>)" |
"t_ins_aux X = X"
by pat_completeness auto

text {*
\null

Observe that the pattern appearing in the non-recursive equation matches any
one of the residual patterns
@{text "\<lparr>folding = True, item = _, subtrees = [_]\<rparr>"},
@{text "\<lparr>folding = True, item = _, subtrees = _ # Leaf # _\<rparr>"},
@{text "\<lparr>folding = _, item = _, subtrees = []\<rparr>"}, thus complying with the
requirement that the definition of function @{text t_ins_aux} be total.

Since the arguments of recursive calls in the definition of function
@{text t_ins_aux} are the same as those of function @{text t_ins_naive},
the termination proof developed for the latter can be applied to the former
as well by just turning the input product type of the previous measure
function into the input record type of function @{text t_ins_aux}.

\null
*}

fun t_ins_aux_measure :: "'a t_type \<Rightarrow> nat" where
"t_ins_aux_measure \<lparr>folding = b, item = x, subtrees = ts\<rparr> = (if b
  then length ts - 1
  else length ts + 2 * size (hd ts))"

termination t_ins_aux
by (relation "measure t_ins_aux_measure", simp_all)

subsection "Step 2"

definition t_ins_in :: "'a \<Rightarrow> 'a bintree \<Rightarrow> 'a t_type" where
"t_ins_in x xt \<equiv> \<lparr>folding = False, item = x, subtrees = [xt]\<rparr>"

definition t_ins_out :: "'a t_type \<Rightarrow> 'a bintree" where
"t_ins_out X \<equiv> hd (subtrees X)"

definition t_ins :: "'a::linorder \<Rightarrow> 'a bintree \<Rightarrow> 'a bintree" where
"t_ins x xt \<equiv> t_ins_out (t_ins_aux (t_ins_in x xt))"

text {*
\null

Since the significant inputs of function @{text t_ins_naive} match pattern
@{text False}, @{text _}, @{text "[_]"}, those of function @{text t_ins_aux}
match pattern @{text "\<lparr>folding = False, item = _, subtrees = [_]\<rparr>"}, thus
being in a one-to-one correspondence with the Cartesian product of the types
of the second and the third component.

Then, the target correctness theorems can be put into the following equivalent
form:

\null

@{text "t_sorted xt \<longrightarrow> t_sorted (t_ins x xt)"}

\null

@{text "t_count y (t_ins x xt) = "}
@{text "(if y = x then Suc else id) (t_count y xt)"}
*}

subsection "Step 3"

inductive_set t_ins_set :: "'a::linorder t_type \<Rightarrow> 'a t_type set"
for X :: "'a t_type" where
R0: "X \<in> t_ins_set X" |
R1: "\<lbrakk>\<lparr>folding = False, item = x, subtrees = Branch y yl yr # ts\<rparr> \<in> t_ins_set X;
     x \<le> y\<rbrakk> \<Longrightarrow>
     \<lparr>folding = False, item = x, subtrees = yl # Branch y yl yr # ts\<rparr>
       \<in> t_ins_set X" |
R2: "\<lbrakk>\<lparr>folding = False, item = x, subtrees = Branch y yl yr # ts\<rparr> \<in> t_ins_set X;
     \<not> x \<le> y\<rbrakk> \<Longrightarrow>
     \<lparr>folding = False, item = x, subtrees = yr # Branch y yl yr # ts\<rparr>
       \<in> t_ins_set X" |
R3: "\<lparr>folding = False, item = x, subtrees = Leaf # ts\<rparr> \<in> t_ins_set X \<Longrightarrow>
     \<lparr>folding = True, item = x, subtrees = Branch x Leaf Leaf # ts\<rparr>
       \<in> t_ins_set X" |
R4: "\<lbrakk>\<lparr>folding = True, item = x, subtrees = xt # Branch y yl yr # ts\<rparr>
       \<in> t_ins_set X; x \<le> y\<rbrakk> \<Longrightarrow>
     \<lparr>folding = True, item = x, subtrees = Branch y xt yr # ts\<rparr> \<in> t_ins_set X" |
R5: "\<lbrakk>\<lparr>folding = True, item = x, subtrees = xt # Branch y yl yr # ts\<rparr>
       \<in> t_ins_set X; \<not> x \<le> y\<rbrakk> \<Longrightarrow>
     \<lparr>folding = True, item = x, subtrees = Branch y yl xt # ts\<rparr> \<in> t_ins_set X"

subsection "Step 4"

lemma t_ins_subset:
  assumes XY: "Y \<in> t_ins_set X"
  shows "t_ins_set Y \<subseteq> t_ins_set X"
proof (rule subsetI, erule t_ins_set.induct)
  show "Y \<in> t_ins_set X" using XY .
next
  fix x y yl yr ts
  assume
   "\<lparr>folding = False, item = x, subtrees = Branch y yl yr # ts\<rparr> \<in> t_ins_set X"
  and "x \<le> y"
  thus "\<lparr>folding = False, item = x, subtrees = yl # Branch y yl yr # ts\<rparr>
   \<in> t_ins_set X" by (rule R1)
next
  fix x y yl yr ts
  assume
   "\<lparr>folding = False, item = x, subtrees = Branch y yl yr # ts\<rparr> \<in> t_ins_set X"
  and "\<not> x \<le> y"
  thus "\<lparr>folding = False, item = x, subtrees = yr # Branch y yl yr # ts\<rparr>
   \<in> t_ins_set X" by (rule R2)
next
  fix x ts
  assume "\<lparr>folding = False, item = x, subtrees = Leaf # ts\<rparr> \<in> t_ins_set X"
  thus "\<lparr>folding = True, item = x, subtrees = Branch x Leaf Leaf # ts\<rparr>
   \<in> t_ins_set X" by (rule R3)
next
  fix x xt y yl yr ts
  assume
   "\<lparr>folding = True, item = x, subtrees = xt # Branch y yl yr # ts\<rparr> \<in> t_ins_set X"
  and "x \<le> y"
  thus "\<lparr>folding = True, item = x, subtrees = Branch y xt yr # ts\<rparr> \<in> t_ins_set X"
   by (rule R4)
next
  fix x xt y yl yr ts
  assume
   "\<lparr>folding = True, item = x, subtrees = xt # Branch y yl yr # ts\<rparr> \<in> t_ins_set X"
  and "\<not> x \<le> y"
  thus "\<lparr>folding = True, item = x, subtrees = Branch y yl xt # ts\<rparr> \<in> t_ins_set X"
   by (rule R5)
qed

lemma t_ins_aux_set: "t_ins_aux X \<in> t_ins_set X"
proof (induction rule: t_ins_aux.induct,
 simp_all add: R0 del: t_ins_aux.simps(1, 3))
  fix x :: 'a and y yl yr ts
  let
   ?X = "\<lparr>folding = False, item = x, subtrees = Branch y yl yr # ts\<rparr>" and
   ?X' = "\<lparr>folding = False, item = x, subtrees = yl # Branch y yl yr # ts\<rparr>" and
   ?X'' = "\<lparr>folding = False, item = x, subtrees = yr # Branch y yl yr # ts\<rparr>"
  assume
   case1: "x \<le> y \<Longrightarrow> t_ins_aux ?X' \<in> t_ins_set ?X'" and
   case2: "\<not> x \<le> y \<Longrightarrow> t_ins_aux ?X'' \<in> t_ins_set ?X''"
  have 0: "?X \<in> t_ins_set ?X" by (rule R0)
  show "t_ins_aux ?X \<in> t_ins_set ?X"
  proof (cases "x \<le> y", simp_all)
    assume "x \<le> y"
    with 0 have "?X' \<in> t_ins_set ?X" by (rule R1)
    hence "t_ins_set ?X' \<subseteq> t_ins_set ?X" by (rule t_ins_subset)
    moreover have "t_ins_aux ?X' \<in> t_ins_set ?X'"
     using case1 and `x \<le> y` by simp
    ultimately show "t_ins_aux ?X' \<in> t_ins_set ?X" by (rule subsetD)
  next
    assume "\<not> x \<le> y"
    with 0 have "?X'' \<in> t_ins_set ?X" by (rule R2)
    hence "t_ins_set ?X'' \<subseteq> t_ins_set ?X" by (rule t_ins_subset)
    moreover have "t_ins_aux ?X'' \<in> t_ins_set ?X''"
     using case2 and `\<not> x \<le> y` by simp
    ultimately show "t_ins_aux ?X'' \<in> t_ins_set ?X" by (rule subsetD)
  qed
next
  fix x :: 'a and ts
  let
   ?X = "\<lparr>folding = False, item = x, subtrees = Leaf # ts\<rparr>" and
   ?X' = "\<lparr>folding = True, item = x, subtrees = Branch x Leaf Leaf # ts\<rparr>"
  have "?X \<in> t_ins_set ?X" by (rule R0)
  hence "?X' \<in> t_ins_set ?X" by (rule R3)
  hence "t_ins_set ?X' \<subseteq> t_ins_set ?X" by (rule t_ins_subset)
  moreover assume "t_ins_aux ?X' \<in> t_ins_set ?X'"
  ultimately show "t_ins_aux ?X' \<in> t_ins_set ?X" by (rule subsetD)
next
  fix x :: 'a and xt y yl yr ts
  let
   ?X = "\<lparr>folding = True, item = x, subtrees = xt # Branch y yl yr # ts\<rparr>" and
   ?X' = "\<lparr>folding = True, item = x, subtrees = Branch y xt yr # ts\<rparr>" and
   ?X'' = "\<lparr>folding = True, item = x, subtrees = Branch y yl xt # ts\<rparr>"
  assume
   case1: "x \<le> y \<Longrightarrow> t_ins_aux ?X' \<in> t_ins_set ?X'" and
   case2: "\<not> x \<le> y \<Longrightarrow> t_ins_aux ?X'' \<in> t_ins_set ?X''"
  have 0: "?X \<in> t_ins_set ?X" by (rule R0)
  show "t_ins_aux ?X \<in> t_ins_set ?X"
  proof (cases "x \<le> y", simp_all)
    assume "x \<le> y"
    with 0 have "?X' \<in> t_ins_set ?X" by (rule R4)
    hence "t_ins_set ?X' \<subseteq> t_ins_set ?X" by (rule t_ins_subset)
    moreover have "t_ins_aux ?X' \<in> t_ins_set ?X'"
     using case1 and `x \<le> y` by simp
    ultimately show "t_ins_aux ?X' \<in> t_ins_set ?X" by (rule subsetD)
  next
    assume "\<not> x \<le> y"
    with 0 have "?X'' \<in> t_ins_set ?X" by (rule R5)
    hence "t_ins_set ?X'' \<subseteq> t_ins_set ?X" by (rule t_ins_subset)
    moreover have "t_ins_aux ?X'' \<in> t_ins_set ?X''"
     using case2 and `\<not> x \<le> y` by simp
    ultimately show "t_ins_aux ?X'' \<in> t_ins_set ?X" by (rule subsetD)
  qed
qed

subsection "Step 5"

primrec t_val :: "'a bintree \<Rightarrow> 'a" where
"t_val (Branch x xl xr) = x"

primrec t_left :: "'a bintree \<Rightarrow> 'a bintree" where
"t_left (Branch x xl xr) = xl"

primrec t_right :: "'a bintree \<Rightarrow> 'a bintree" where
"t_right (Branch x xl xr) = xr"

text {*
\null

The partiality of the definition of the previous functions, which merely return
the root value and either subtree of the input branch, does not matter as they
will be applied to branches only.

These functions are used to define the following invariant -- this time, a single
invariant for both of the target correctness theorems:

\null
*}

fun t_ins_inv :: "'a::linorder \<Rightarrow> 'a bintree \<Rightarrow> 'a t_type \<Rightarrow> bool" where
"t_ins_inv x xt \<lparr>folding = b, item = y, subtrees = ts\<rparr> =
  (y = x \<and>
  (\<forall>n \<in> {..<length ts}.
    (t_sorted xt \<longrightarrow> t_sorted (ts ! n)) \<and>
    (0 < n \<longrightarrow> (\<exists>y yl yr. ts ! n = Branch y yl yr)) \<and>
    (let ts' = ts @ [Branch x xt Leaf] in t_multiset (ts ! n) =
      (if b \<and> n = 0 then {#x#} else {#}) +
      (if x \<le> t_val (ts' ! Suc n)
        then t_multiset (t_left (ts' ! Suc n))
        else t_multiset (t_right (ts' ! Suc n))))))"

text {*
\null

More precisely, the invariant, whose type has to match @{text "'a t_type \<Rightarrow> bool"}
according to the method specification, shall be comprised of function
@{text "t_ins_inv x xt"}, where @{text x}, @{text xt} are the free variables
appearing in the target theorems as the arguments of function @{text t_ins}.
*}

subsection "Step 6"

lemma t_ins_input: "t_ins_inv x xt \<lparr>folding = False, item = x, subtrees = [xt]\<rparr>"
by simp

subsection "Step 7"

fun t_ins_form :: "'a t_type \<Rightarrow> bool" where
"t_ins_form \<lparr>folding = True, item = _, subtrees = [_]\<rparr> = True" |
"t_ins_form \<lparr>folding = True, item = _, subtrees = _ # Leaf # _\<rparr> = True" |
"t_ins_form _ = False"

lemma t_ins_intro_1:
 "\<lbrakk>t_ins_inv x xt X; t_ins_form X\<rbrakk> \<Longrightarrow>
  t_sorted xt \<longrightarrow> t_sorted (t_ins_out X)"
proof (rule t_ins_form.cases [of X], simp_all add: t_ins_out_def)
qed (erule conjE, drule_tac x = "Suc 0" in bspec, simp_all)

lemma t_ins_intro_2:
 "\<lbrakk>t_ins_inv x xt X; t_ins_form X\<rbrakk> \<Longrightarrow>
  t_count y (t_ins_out X) = (if y = x then Suc else id) (t_count y xt)"
proof (rule t_ins_form.cases [of X], simp_all add: t_ins_out_def t_count_def)
qed (erule conjE, drule_tac x = "Suc 0" in bspec, simp_all)

text {*
\null

Defining predicate @{text t_ins_form} by means of pattern matching rather than
quantifiers permits a faster proof of the introduction rules through a case
distinction followed by simplification. These steps leave the subgoal
corresponding to pattern
@{text "\<lparr>folding = True, item = _, subtrees = _ # Leaf # _\<rparr>"} to be proven, which
can be done \emph{ad absurdum} as this pattern is incompatible with the invariant,
stating that all the subtrees in the list except for its head are branches.

The reason why this pattern, unlike
@{text "\<lparr>folding = _, item = _, subtrees = []\<rparr>"}, is not filtered by predicate
@{text t_ins_form}, is that the lack of its occurrences in recursive calls in
correspondence with significant inputs cannot be proven by rule inversion,
being it compatible with the patterns introduced by rules @{text R3},
@{text R4}, and @{text R5}.
*}

subsection "Step 8"

text {*
This step will be accomplished by first proving by recursion induction that
the outputs of function @{text t_ins_aux} match either of the patterns
satisfying predicate @{text t_ins_form} or else the residual one
@{text "\<lparr>folding = _, item = _, subtrees = []\<rparr>"}, and then proving by rule
inversion that the last pattern may not occur in recursive calls in
correspondence with significant inputs.

\null
*}

definition t_ins_form_all :: "'a t_type \<Rightarrow> bool" where
"t_ins_form_all X \<equiv> t_ins_form X \<or> subtrees X = []"

lemma t_ins_form_aux_all: "t_ins_form_all (t_ins_aux X)"
by (rule t_ins_aux.induct [of "\<lambda>X. t_ins_form_all (t_ins_aux X)"],
 simp_all add: t_ins_form_all_def)

lemma t_ins_form_aux:
 "t_ins_form (t_ins_aux \<lparr>folding = False, item = x, subtrees = [xt]\<rparr>)"
 (is "_ (t_ins_aux ?X)")
using t_ins_aux_set [of ?X]
proof (rule t_ins_set.cases, insert t_ins_form_aux_all [of ?X])
qed (simp_all add: t_ins_form_all_def)

subsection "Step 9"

lemma t_ins_invariance:
  assumes XY: "Y \<in> t_ins_set X" and X: "t_ins_inv x xt X"
  shows "t_ins_inv x xt Y"
using XY
proof (rule t_ins_set.induct, simp_all split del: split_if)
  show "t_ins_inv x xt X" using X .
next
  fix z :: "'a::linorder" and y yl yr ts
  assume "z = x \<and>
   (\<forall>n \<in> {..<Suc (length ts)}.
     (t_sorted xt \<longrightarrow> t_sorted ((Branch y yl yr # ts) ! n)) \<and>
     (0 < n \<longrightarrow> (\<exists>y' yl' yr'. ts ! (n - Suc 0) = Branch y' yl' yr')) \<and>
     (let ts' = Branch y yl yr # ts @ [Branch x xt Leaf]
       in t_multiset ((Branch y yl yr # ts) ! n) =
         (if x \<le> t_val ((ts @ [Branch x xt Leaf]) ! n)
           then t_multiset (t_left (ts' ! Suc n))
           else t_multiset (t_right (ts' ! Suc n)))))"
   (is "_ \<and> (\<forall>n \<in> {..<Suc (length ts)}. ?P n)")
  hence I: "\<forall>n \<in> {..<Suc (length ts)}. ?P n" ..
  assume xy: "x \<le> y"
  show
   "\<forall>n \<in> {..<Suc (Suc (length ts))}.
     (t_sorted xt \<longrightarrow> t_sorted ((yl # Branch y yl yr # ts) ! n)) \<and>
     (0 < n \<longrightarrow> (\<exists>y' yl' yr'. (Branch y yl yr # ts) ! (n - Suc 0) =
       Branch y' yl' yr')) \<and>
     (let ts' = yl # Branch y yl yr # ts @ [Branch x xt Leaf]
       in t_multiset ((yl # Branch y yl yr # ts) ! n) =
         (if x \<le> t_val ((Branch y yl yr # ts @ [Branch x xt Leaf]) ! n)
           then t_multiset (t_left (ts' ! Suc n))
           else t_multiset (t_right (ts' ! Suc n))))"
   (is "\<forall>n \<in> {..<Suc (Suc (length ts))}. ?Q n")
  proof
    fix n
    assume n: "n \<in> {..<Suc (Suc (length ts))}"
    show "?Q n"
    proof (cases n)
      case 0
      have "0 \<in> {..<Suc (length ts)}" by simp
      with I have "?P 0" ..
      thus ?thesis by (simp add: Let_def xy 0)
    next
      case (Suc m)
      hence "m \<in> {..<Suc (length ts)}" using n by simp
      with I have "?P m" ..
      thus ?thesis
      proof (simp add: Let_def Suc)
      qed (cases m, simp_all)
    qed
  qed
next
  fix z :: "'a::linorder" and y yl yr ts
  assume "z = x \<and>
   (\<forall>n \<in> {..<Suc (length ts)}.
     (t_sorted xt \<longrightarrow> t_sorted ((Branch y yl yr # ts) ! n)) \<and>
     (0 < n \<longrightarrow> (\<exists>y' yl' yr'. ts ! (n - Suc 0) = Branch y' yl' yr')) \<and>
     (let ts' = Branch y yl yr # ts @ [Branch x xt Leaf]
       in t_multiset ((Branch y yl yr # ts) ! n) =
         (if x \<le> t_val ((ts @ [Branch x xt Leaf]) ! n)
           then t_multiset (t_left (ts' ! Suc n))
           else t_multiset (t_right (ts' ! Suc n)))))"
   (is "_ \<and> (\<forall>n \<in> {..<Suc (length ts)}. ?P n)")
  hence I: "\<forall>n \<in> {..<Suc (length ts)}. ?P n" ..
  assume xy: "\<not> x \<le> y"
  show
   "\<forall>n \<in> {..<Suc (Suc (length ts))}.
     (t_sorted xt \<longrightarrow> t_sorted ((yr # Branch y yl yr # ts) ! n)) \<and>
     (0 < n \<longrightarrow> (\<exists>y' yl' yr'. (Branch y yl yr # ts) ! (n - Suc 0) =
       Branch y' yl' yr')) \<and>
     (let ts' = yr # Branch y yl yr # ts @ [Branch x xt Leaf]
       in t_multiset ((yr # Branch y yl yr # ts) ! n) =
         (if x \<le> t_val ((Branch y yl yr # ts @ [Branch x xt Leaf]) ! n)
           then t_multiset (t_left (ts' ! Suc n))
           else t_multiset (t_right (ts' ! Suc n))))"
   (is "\<forall>n \<in> {..<Suc (Suc (length ts))}. ?Q n")
  proof
    fix n
    assume n: "n \<in> {..<Suc (Suc (length ts))}"
    show "?Q n"
    proof (cases n)
      case 0
      have "0 \<in> {..<Suc (length ts)}" by simp
      with I have "?P 0" ..
      thus ?thesis by (simp add: Let_def xy 0)
    next
      case (Suc m)
      hence "m \<in> {..<Suc (length ts)}" using n by simp
      with I have "?P m" ..
      thus ?thesis
      proof (simp add: Let_def Suc)
      qed (cases m, simp_all)
    qed
  qed
next
  fix z :: 'a and ts
  assume "z = x \<and>
   (\<forall>n \<in> {..<Suc (length ts)}.
     (t_sorted xt \<longrightarrow> t_sorted ((Leaf # ts) ! n)) \<and>
     (0 < n \<longrightarrow> (\<exists>y yl yr. ts ! (n - Suc 0) = Branch y yl yr)) \<and>
     (let ts' = Leaf # ts @ [Branch x xt Leaf]
       in t_multiset ((Leaf # ts) ! n) =
         (if x \<le> t_val ((ts @ [Branch x xt Leaf]) ! n)
           then t_multiset (t_left (ts' ! Suc n))
           else t_multiset (t_right (ts' ! Suc n)))))"
   (is "_ \<and> (\<forall>n \<in> {..<Suc (length ts)}. ?P n)")
  hence I: "\<forall>n \<in> {..<Suc (length ts)}. ?P n" ..
  show
   "\<forall>n \<in> {..<Suc (length ts)}.
     (t_sorted xt \<longrightarrow> t_sorted ((Branch x Leaf Leaf # ts) ! n)) \<and>
     (let ts' = Branch x Leaf Leaf # ts @ [Branch x xt Leaf]
       in t_multiset ((Branch x Leaf Leaf # ts) ! n) =
         (if n = 0 then {#x#} else {#}) +
         (if x \<le> t_val ((ts @ [Branch x xt Leaf]) ! n)
           then t_multiset (t_left (ts' ! Suc n))
           else t_multiset (t_right (ts' ! Suc n))))"
   (is "\<forall>n \<in> {..<Suc (length ts)}. ?Q n")
  proof
    fix n
    assume n: "n \<in> {..<Suc (length ts)}"
    show "?Q n"
    proof (cases n)
      case 0
      have "0 \<in> {..<Suc (length ts)}" by simp
      with I have "?P 0" ..
      thus ?thesis by (simp add: Let_def 0 split add: split_if_asm)
    next
      case (Suc m)
      have "?P n" using I and n ..
      thus ?thesis by (simp add: Let_def Suc)
    qed
  qed
next
  fix z :: 'a and zt y yl yr ts
  assume "z = x \<and>
   (\<forall>n \<in> {..<Suc (Suc (length ts))}.
     (t_sorted xt \<longrightarrow> t_sorted ((zt # Branch y yl yr # ts) ! n)) \<and>
     (0 < n \<longrightarrow> (\<exists>y' yl' yr'. (Branch y yl yr # ts) ! (n - Suc 0) =
       Branch y' yl' yr')) \<and>
     (let ts' = zt # Branch y yl yr # ts @ [Branch x xt Leaf]
       in t_multiset ((zt # Branch y yl yr # ts) ! n) =
         (if n = 0 then {#x#} else {#}) +
         (if x \<le> t_val ((Branch y yl yr # ts @ [Branch x xt Leaf]) ! n)
           then t_multiset (t_left (ts' ! Suc n))
           else t_multiset (t_right (ts' ! Suc n)))))"
   (is "_ \<and> (\<forall>n \<in> {..<Suc (Suc (length ts))}. ?P n)")
  hence I: "\<forall>n \<in> {..<Suc (Suc (length ts))}. ?P n" ..
  assume xy: "x \<le> y"
  show
   "\<forall>n \<in> {..<Suc (length ts)}.
     (t_sorted xt \<longrightarrow> t_sorted ((Branch y zt yr # ts) ! n)) \<and>
     (0 < n \<longrightarrow> (\<exists>y' yl' yr'. ts ! (n - Suc 0) = Branch y' yl' yr')) \<and>
     (let ts' = Branch y zt yr # ts @ [Branch x xt Leaf]
       in t_multiset ((Branch y zt yr # ts) ! n) =
         (if n = 0 then {#x#} else {#}) +
         (if x \<le> t_val ((ts @ [Branch x xt Leaf]) ! n)
           then t_multiset (t_left (ts' ! Suc n))
           else t_multiset (t_right (ts' ! Suc n))))"
   (is "\<forall>n \<in> {..<Suc (length ts)}. ?Q n")
  proof
    fix n
    assume n: "n \<in> {..<Suc (length ts)}"
    show "?Q n"
    proof (cases n)
      case 0
      have "0 \<in> {..<Suc (Suc (length ts))}" by simp
      with I have "?P 0" ..
      hence I0: "(t_sorted xt \<longrightarrow> t_sorted zt) \<and>
       t_multiset zt = {#x#} + t_multiset yl"
       by (simp add: Let_def xy)
      have "Suc 0 \<in> {..<Suc (Suc (length ts))}" by simp
      with I have "?P (Suc 0)" ..
      hence I1: "(t_sorted xt \<longrightarrow> t_sorted (Branch y yl yr)) \<and>
       t_multiset (Branch y yl yr) =
       (if x \<le> t_val ((ts @ [Branch x xt Leaf]) ! 0)
        then t_multiset (t_left ((ts @ [Branch x xt Leaf]) ! 0))
        else t_multiset (t_right ((ts @ [Branch x xt Leaf]) ! 0)))"
       by (simp add: Let_def)
      show ?thesis
      proof (simp add: Let_def 0 del: t_sorted.simps split del: split_if,
       rule conjI, simp_all add: Let_def 0 del: t_sorted.simps,
       rule_tac [2] conjI, rule_tac [!] impI)
        assume s: "t_sorted xt"
        hence "t_sorted zt" using I0 by simp
        moreover have "t_sorted (Branch y yl yr)" using I1 and s by simp
        moreover have "t_set zt = {x} \<union> t_set yl" using I0
         by (simp add: t_set_multiset)
        ultimately show "t_sorted (Branch y zt yr)" using xy by simp
      next
        assume "x \<le> t_val ((ts @ [Branch x xt Leaf]) ! 0)"
        hence "t_multiset (t_left ((ts @ [Branch x xt Leaf]) ! 0)) =
         t_multiset (Branch y yl yr)" using I1 by simp
        thus "{#y#} + t_multiset zt + t_multiset yr =
         {#x#} + t_multiset (t_left ((ts @ [Branch x xt Leaf]) ! 0))" using I0
         by (simp add: ac_simps)
      next
        assume "\<not> x \<le> t_val ((ts @ [Branch x xt Leaf]) ! 0)"
        hence "t_multiset (t_right ((ts @ [Branch x xt Leaf]) ! 0)) =
         t_multiset (Branch y yl yr)" using I1 by simp
        thus "{#y#} + t_multiset zt + t_multiset yr =
         {#x#} + t_multiset (t_right ((ts @ [Branch x xt Leaf]) ! 0))" using I0
         by (simp add: ac_simps)
      qed
    next
      case (Suc m)
      have "Suc n \<in> {..<Suc (Suc (length ts))}" using n by simp
      with I have "?P (Suc n)" ..
      thus ?thesis by (simp add: Let_def Suc)
    qed
  qed
next
  fix z :: 'a and zt y yl yr ts
  assume "z = x \<and>
   (\<forall>n \<in> {..<Suc (Suc (length ts))}.
     (t_sorted xt \<longrightarrow> t_sorted ((zt # Branch y yl yr # ts) ! n)) \<and>
     (0 < n \<longrightarrow> (\<exists>y' yl' yr'. (Branch y yl yr # ts) ! (n - Suc 0) =
       Branch y' yl' yr')) \<and>
     (let ts' = zt # Branch y yl yr # ts @ [Branch x xt Leaf]
       in t_multiset ((zt # Branch y yl yr # ts) ! n) =
         (if n = 0 then {#x#} else {#}) +
         (if x \<le> t_val ((Branch y yl yr # ts @ [Branch x xt Leaf]) ! n)
           then t_multiset (t_left (ts' ! Suc n))
           else t_multiset (t_right (ts' ! Suc n)))))"
   (is "_ \<and> (\<forall>n \<in> {..<Suc (Suc (length ts))}. ?P n)")
  hence I: "\<forall>n \<in> {..<Suc (Suc (length ts))}. ?P n" ..
  assume xy: "\<not> x \<le> y"
  show
   "\<forall>n \<in> {..<Suc (length ts)}.
     (t_sorted xt \<longrightarrow> t_sorted ((Branch y yl zt # ts) ! n)) \<and>
     (0 < n \<longrightarrow> (\<exists>y' yl' yr'. ts ! (n - Suc 0) = Branch y' yl' yr')) \<and>
     (let ts' = Branch y yl zt # ts @ [Branch x xt Leaf]
       in t_multiset ((Branch y yl zt # ts) ! n) =
         (if n = 0 then {#x#} else {#}) +
         (if x \<le> t_val ((ts @ [Branch x xt Leaf]) ! n)
           then t_multiset (t_left (ts' ! Suc n))
           else t_multiset (t_right (ts' ! Suc n))))"
   (is "\<forall>n \<in> {..<Suc (length ts)}. ?Q n")
  proof
    fix n
    assume n: "n \<in> {..<Suc (length ts)}"
    show "?Q n"
    proof (cases n)
      case 0
      have "0 \<in> {..<Suc (Suc (length ts))}" by simp
      with I have "?P 0" ..
      hence I0: "(t_sorted xt \<longrightarrow> t_sorted zt) \<and>
       t_multiset zt = {#x#} + t_multiset yr"
       by (simp add: Let_def xy)
      have "Suc 0 \<in> {..<Suc (Suc (length ts))}" by simp
      with I have "?P (Suc 0)" ..
      hence I1: "(t_sorted xt \<longrightarrow> t_sorted (Branch y yl yr)) \<and>
       t_multiset (Branch y yl yr) =
       (if x \<le> t_val ((ts @ [Branch x xt Leaf]) ! 0)
        then t_multiset (t_left ((ts @ [Branch x xt Leaf]) ! 0))
        else t_multiset (t_right ((ts @ [Branch x xt Leaf]) ! 0)))"
       by (simp add: Let_def)
      show ?thesis
      proof (simp add: Let_def 0 del: t_sorted.simps split del: split_if,
       rule conjI, simp_all add: Let_def 0 del: t_sorted.simps,
       rule_tac [2] conjI, rule_tac [!] impI)
        assume s: "t_sorted xt"
        hence "t_sorted zt" using I0 by simp
        moreover have "t_sorted (Branch y yl yr)" using I1 and s by simp
        moreover have "t_set zt = {x} \<union> t_set yr" using I0
         by (simp add: t_set_multiset)
        ultimately show "t_sorted (Branch y yl zt)" using xy by simp
      next
        assume "x \<le> t_val ((ts @ [Branch x xt Leaf]) ! 0)"
        hence "t_multiset (t_left ((ts @ [Branch x xt Leaf]) ! 0)) =
         t_multiset (Branch y yl yr)" using I1 by simp
        thus "{#y#} + t_multiset yl + t_multiset zt =
         {#x#} + t_multiset (t_left ((ts @ [Branch x xt Leaf]) ! 0))" using I0
         by (simp add: ac_simps)
      next
        assume "\<not> x \<le> t_val ((ts @ [Branch x xt Leaf]) ! 0)"
        hence "t_multiset (t_right ((ts @ [Branch x xt Leaf]) ! 0)) =
         t_multiset (Branch y yl yr)" using I1 by simp
        thus "{#y#} + t_multiset yl + t_multiset zt =
         {#x#} + t_multiset (t_right ((ts @ [Branch x xt Leaf]) ! 0))" using I0
         by (simp add: ac_simps)
      qed
    next
      case (Suc m)
      have "Suc n \<in> {..<Suc (Suc (length ts))}" using n by simp
      with I have "?P (Suc n)" ..
      thus ?thesis by (simp add: Let_def Suc)
    qed
  qed
qed

subsection "Step 10"

theorem "t_sorted xt \<longrightarrow> t_sorted (t_ins x xt)"
proof -
  let ?X = "\<lparr>folding = False, item = x, subtrees = [xt]\<rparr>"
  have "t_ins_aux ?X \<in> t_ins_set ?X" by (rule t_ins_aux_set)
  moreover have "t_ins_inv x xt ?X" by (rule t_ins_input)
  ultimately have "t_ins_inv x xt (t_ins_aux ?X)" by (rule t_ins_invariance)
  moreover have "t_ins_form (t_ins_aux ?X)" by (rule t_ins_form_aux)
  ultimately have "t_sorted xt \<longrightarrow> t_sorted (t_ins_out (t_ins_aux ?X))"
   by (rule t_ins_intro_1)
  moreover have "?X = t_ins_in x xt" by (simp add: t_ins_in_def)
  ultimately show ?thesis by (simp add: t_ins_def)
qed

theorem "t_count y (t_ins x xt) = (if y = x then Suc else id) (t_count y xt)"
proof -
  let ?X = "\<lparr>folding = False, item = x, subtrees = [xt]\<rparr>"
  have "t_ins_aux ?X \<in> t_ins_set ?X" by (rule t_ins_aux_set)
  moreover have "t_ins_inv x xt ?X" by (rule t_ins_input)
  ultimately have "t_ins_inv x xt (t_ins_aux ?X)" by (rule t_ins_invariance)
  moreover have "t_ins_form (t_ins_aux ?X)" by (rule t_ins_form_aux)
  ultimately have "t_count y (t_ins_out (t_ins_aux ?X)) =
   (if y = x then Suc else id) (t_count y xt)"
   by (rule t_ins_intro_2)
  moreover have "?X = t_ins_in x xt" by (simp add: t_ins_in_def)
  ultimately show ?thesis by (simp add: t_ins_def)
qed

end


section "Splay Heap"

theory Splay_Heap
imports
  "HOL-Library.Tree_Multiset"
begin

text\<open>Splay heaps were invented by Okasaki~\<^cite>\<open>"Okasaki"\<close>. They represent
priority queues by splay trees, not by heaps!\<close>

fun get_min :: "('a::linorder) tree \<Rightarrow> 'a" where
"get_min(Node l m r) = (if l = Leaf then m else get_min l)"

fun partition :: "'a::linorder \<Rightarrow> 'a tree \<Rightarrow> 'a tree * 'a tree" where
"partition p Leaf = (Leaf,Leaf)" |
"partition p (Node al a ar) =
  (if a \<le> p then
     case ar of
       Leaf \<Rightarrow> (Node al a ar, Leaf) |
       Node bl b br \<Rightarrow>
         if b \<le> p
         then let (pl,pr) = partition p br in (Node (Node al a bl) b pl, pr)
         else let (pl,pr) = partition p bl in (Node al a pl, Node pr b br)
   else case al of
       Leaf \<Rightarrow> (Leaf, Node al a ar) |
       Node bl b br \<Rightarrow>
         if b \<le> p
         then let (pl,pr) = partition p br in (Node bl b pl, Node pr a ar)
         else let (pl,pr) = partition p bl in (pl, Node pr b (Node br a ar)))"

definition insert :: "'a::linorder \<Rightarrow> 'a tree \<Rightarrow> 'a tree" where
"insert x h = (let (l,r) = partition x h in Node l x r)"

fun del_min :: "'a::linorder tree \<Rightarrow> 'a tree" where
"del_min Leaf = Leaf" |
"del_min (Node Leaf _ r) = r" |
"del_min (Node (Node ll a lr) b r) =
  (if ll = Leaf then Node lr b r else Node (del_min ll) a (Node lr b r))"

lemma get_min_in:
  "h \<noteq> Leaf \<Longrightarrow> get_min h \<in> set_tree h"
by(induction h) auto

lemma get_min_min:
  "\<lbrakk> bst_wrt (\<le>) h; h \<noteq> Leaf \<rbrakk> \<Longrightarrow> \<forall>x \<in> set_tree h. get_min h \<le> x"
proof(induction h)
  case (Node l x r) thus ?case using get_min_in[of l] get_min_in[of r]
    by auto (blast intro: order_trans)
qed simp

lemma size_partition: "partition p t = (l',r') \<Longrightarrow> size t = size l' + size r'"
by (induction p t arbitrary: l' r' rule: partition.induct)
   (auto split: if_splits tree.splits prod.splits)

lemma set_partition: "\<lbrakk> bst_wrt (\<le>) t; partition p t = (l',r') \<rbrakk>
 \<Longrightarrow> set_tree t = set_tree l' \<union> set_tree r'"
by (metis mset_partition set_mset_tree set_mset_union)

lemma bst_partition:
  "partition p t = (l',r') \<Longrightarrow> bst_wrt (\<le>) t \<Longrightarrow> bst_wrt (\<le>) (Node l' p r')"
proof(induction p t arbitrary: l' r' rule: partition.induct)
  case 1 thus ?case by simp
next
  case (2 p l a r)
  show ?case
  proof cases
    assume "a \<le> p"
    show ?thesis
    proof (cases r)
      case Leaf thus ?thesis using \<open>a \<le> p\<close> "2.prems" by fastforce
    next
      case (Node rl b rr)
      show ?thesis
      proof cases
        assume "b \<le> p"
        thus ?thesis
          using Node \<open>a \<le> p\<close> "2.prems" "2.IH"(1)[OF _ Node] set_partition[of rr]
          by (fastforce split: prod.splits)
      next
        assume "\<not> b \<le> p"
        thus ?thesis
          using Node \<open>a \<le> p\<close> "2.prems" "2.IH"(2)[OF _ Node] set_partition[of rl]
          by (fastforce split: prod.splits)
      qed
    qed
  next
    assume "\<not> a \<le> p"
    show ?thesis
    proof (cases l)
      case Leaf thus ?thesis using \<open>\<not> a \<le> p\<close> "2.prems" by fastforce
    next
      case (Node ll b lr)
      show ?thesis
      proof cases
        assume "b \<le> p"
        thus ?thesis
          using Node \<open>\<not> a \<le> p\<close> "2.prems" "2.IH"(3)[OF _ Node] set_partition[of lr]
          by (fastforce split: prod.splits)
      next
        assume "\<not> b \<le> p"
        thus ?thesis
          using Node \<open>\<not> a \<le> p\<close> "2.prems" "2.IH"(4)[OF _ Node] set_partition[of ll]
          by (fastforce split: prod.splits)
      qed
    qed
  qed
qed

lemma size_del_min[simp]: "size(del_min t) = size t - 1"
by(induction t rule: del_min.induct) (auto simp: neq_Leaf_iff)

lemma mset_del_min: "mset_tree (del_min h) = mset_tree h - {# get_min h #}"
proof(induction h rule: del_min.induct)
  case (3 ll)
  show ?case
  proof cases
    assume "ll = Leaf" thus ?thesis using 3 by (simp add: ac_simps)
  next
    assume "ll \<noteq> Leaf"
    hence "get_min ll \<in># mset_tree ll"
      by (simp add: get_min_in)
    then obtain A where "mset_tree ll = add_mset (get_min ll) A"
      by (blast dest: multi_member_split)
    then show ?thesis using 3 by auto
  qed
qed auto

lemma bst_del_min: "bst_wrt (\<le>) t \<Longrightarrow> bst_wrt (\<le>) (del_min t)"
apply(induction t rule: del_min.induct)
  apply simp
 apply simp
apply auto
by (metis Multiset.diff_subset_eq_self subsetD set_mset_mono set_mset_tree mset_del_min)

end


chapter\<open>Examples\<close>
text\<open>In this chapter, we provide some examples of EFSMs and proofs over them. We first present a
formalisation of a simple drinks machine. Next, we prove observational equivalence of an alternative
model. Finally, we prove some temporal properties of the first example.\<close>

section\<open>Drinks Machine\<close>
text\<open>This theory formalises a simple drinks machine. The \emph{select} operation takes one
argument - the desired beverage. The \emph{coin} operation also takes one parameter representing
the value of the coin. The \emph{vend} operation has two flavours - one which dispenses the drink if
the customer has inserted enough money, and one which dispenses nothing if the user has not inserted
sufficient funds.

We first define a datatype \emph{statemane} which corresponds to $S$ in the formal definition.
Note that, while statename has four elements, the drinks machine presented here only requires three
states. The fourth element is included here so that the \emph{statename} datatype may be used in
the next example.\<close>
theory Drinks_Machine
  imports "Extended_Finite_State_Machines.EFSM"
begin

text_raw\<open>\snip{selectdef}{1}{2}{%\<close>
definition select :: "transition" where
"select \<equiv> \<lparr>
        Label = STR ''select'',
        Arity = 1,
        Guards = [],
        Outputs = [],
        Updates = [
                    (1, V (I 0)),
                    (2, L (Num 0))
                  ]
      \<rparr>"
text_raw\<open>}%endsnip\<close>

text_raw\<open>\snip{coindef}{1}{2}{%\<close>
definition coin :: "transition" where
"coin \<equiv> \<lparr>
        Label = STR ''coin'',
        Arity = 1,
        Guards = [],
        Outputs = [Plus (V (R 2)) (V (I 0))],
        Updates = [
                    (1, V (R 1)),
                    (2, Plus (V (R 2)) (V (I 0)))
                  ]
      \<rparr>"
text_raw\<open>}%endsnip\<close>

text_raw\<open>\snip{venddef}{1}{2}{%\<close>
definition vend:: "transition" where
"vend\<equiv> \<lparr>
        Label = STR ''vend'',
        Arity = 0,
        Guards = [(Ge (V (R 2)) (L (Num 100)))],
        Outputs =  [(V (R 1))],
        Updates = [(1, V (R 1)), (2, V (R 2))]
      \<rparr>"
text_raw\<open>}%endsnip\<close>

text_raw\<open>\snip{vendfaildef}{1}{2}{%\<close>
definition vend_fail :: "transition" where
"vend_fail \<equiv> \<lparr>
        Label = STR ''vend'',
        Arity = 0,
        Guards = [(Lt (V (R 2)) (L (Num 100)))],
        Outputs =  [],
        Updates = [(1, V (R 1)), (2, V (R 2))]
      \<rparr>"
text_raw\<open>}%endsnip\<close>

text_raw\<open>\snip{drinksdef}{1}{2}{%\<close>
definition drinks :: "transition_matrix" where
"drinks \<equiv> {|
          ((0,1), select),
          ((1,1), coin),
          ((1,1), vend_fail),
          ((1,2), vend)
         |}"
text_raw\<open>}%endsnip\<close>

lemmas transitions = select_def coin_def vend_def vend_fail_def

lemma drinks_states: "S drinks = {|0, 1, 2|}"
  apply (simp add: S_def drinks_def)
  by auto

lemma possible_steps_0:
  "length i = 1 \<Longrightarrow>
   possible_steps drinks 0 r (STR ''select'') i = {|(1, select)|}"
  apply (simp add: possible_steps_singleton drinks_def)
  apply safe
  by (simp_all add: transitions apply_guards_def)

lemma first_step_select:
  "(s', t) |\<in>| possible_steps drinks 0 r aa b \<Longrightarrow> s' = 1 \<and> t = select"
  apply (simp add: possible_steps_def fimage_def ffilter_def fmember_def Abs_fset_inverse Set.filter_def drinks_def)
  apply safe
  by (simp_all add: transitions)

lemma drinks_vend_insufficient:
  "r $ 2 = Some (Num x1) \<Longrightarrow>
   x1 < 100 \<Longrightarrow>
   possible_steps drinks 1 r (STR ''vend'') [] = {|(1, vend_fail)|}"
  apply (simp add: possible_steps_singleton drinks_def)
  apply safe
  by (simp_all add: transitions apply_guards_def value_gt_def join_ir_def connectives)

lemma drinks_vend_invalid:
  "\<nexists>n. r $ 2 = Some (Num n) \<Longrightarrow>
   possible_steps drinks 1 r (STR ''vend'') [] = {||}"
  apply (simp add: possible_steps_empty drinks_def can_take_transition_def can_take_def transitions)
  by (simp add: MaybeBoolInt_not_num_1 value_gt_def)

lemma possible_steps_1_coin:
  "length i = 1 \<Longrightarrow> possible_steps drinks 1 r (STR ''coin'') i = {|(1, coin)|}"
  apply (simp add: possible_steps_singleton drinks_def)
  apply safe
  by (simp_all add: transitions)

lemma possible_steps_2_vend:
  "\<exists>n. r $ 2 = Some (Num n) \<and> n \<ge> 100 \<Longrightarrow>
   possible_steps drinks 1 r (STR ''vend'') [] = {|(2, vend)|}"
  apply (simp add: possible_steps_singleton drinks_def)
  apply safe
  by (simp_all add: transitions apply_guards_def value_gt_def join_ir_def connectives)

lemma recognises_from_2:
  "recognises_execution drinks 1 <1 $:= d, 2 $:= Some (Num 100)> [(STR ''vend'', [])]"
  apply (rule recognises_execution.step)
  apply (rule_tac x="(2, vend)" in fBexI)
   apply simp
  by (simp add: possible_steps_2_vend)

lemma recognises_from_1a:
  "recognises_execution drinks 1 <1 $:= d, 2 $:= Some (Num 50)> [(STR ''coin'', [Num 50]), (STR ''vend'', [])]"
  apply (rule recognises_execution.step)
  apply (rule_tac x="(1, coin)" in fBexI)
   apply (simp add: apply_updates_def coin_def finfun_update_twist value_plus_def recognises_from_2)
  by (simp add: possible_steps_1_coin)

lemma recognises_from_1: "recognises_execution drinks 1 <2 $:= Some (Num 0), 1 $:= Some d>
     [(STR ''coin'', [Num 50]), (STR ''coin'', [Num 50]), (STR ''vend'', [])]"
  apply (rule recognises_execution.step)
  apply (rule_tac x="(1, coin)" in fBexI)
   apply (simp add: apply_updates_def coin_def value_plus_def finfun_update_twist recognises_from_1a)
  by (simp add: possible_steps_1_coin)

lemma rejects_input:
  "l \<noteq> STR ''coin'' \<Longrightarrow>
   l \<noteq> STR ''vend'' \<Longrightarrow>
   \<not> recognises_execution drinks 1 d' [(l, i)]"
  apply (rule no_possible_steps_rejects)
  by (simp add: possible_steps_empty drinks_def can_take_transition_def can_take_def transitions)

lemma rejects_recognises_prefix: "l \<noteq> STR ''coin'' \<Longrightarrow>
   l \<noteq> STR ''vend'' \<Longrightarrow>
   \<not> (recognises drinks [(STR ''select'', [Str ''coke'']), (l, i)])"
  apply (rule trace_reject_later)
  apply (simp add: possible_steps_0 select_def join_ir_def input2state_def)
  using rejects_input by blast

lemma rejects_termination:
  "observe_execution drinks 0 <> [(STR ''select'', [Str ''coke'']), (STR ''rejects'', [Num 50]), (STR ''coin'', [Num 50])] = [[]]"
  apply (rule observe_execution_step)
   apply (simp add: step_def possible_steps_0 select_def)
  apply (rule observe_execution_no_possible_step)
  by (simp add: possible_steps_empty drinks_def can_take_transition_def can_take_def transitions)

(* Part of Example 2 in Foster et. al. *)
lemma r2_0_vend:
  "can_take_transition vend i r \<Longrightarrow>
   \<exists>n. r $ 2 = Some (Num n) \<and> n \<ge> 100" (* You can't take vendimmediately after taking select *)
  apply (simp add: can_take_transition_def can_take_def vend_def apply_guards_def maybe_negate_true maybe_or_false connectives value_gt_def)
  using MaybeBoolInt.elims by force

lemma drinks_vend_sufficient: "r $ 2 = Some (Num x1) \<Longrightarrow>
                x1 \<ge> 100 \<Longrightarrow>
                possible_steps drinks 1 r (STR ''vend'') [] = {|(2, vend)|}"
  using possible_steps_2_vend by blast

lemma drinks_end: "possible_steps drinks 2 r a b = {||}"
  apply (simp add: possible_steps_def drinks_def transitions)
  by force

lemma drinks_vend_r2_String:
  "r $ 2 = Some (value.Str x2) \<Longrightarrow>
   possible_steps drinks 1 r (STR ''vend'') [] = {||}"
  apply (simp add: possible_steps_empty drinks_def can_take_transition_def can_take_def transitions)
  by (simp add: value_gt_def)

lemma drinks_vend_r2_rejects:
  "\<nexists>n. r $ 2 = Some (Num n) \<Longrightarrow> step drinks 1 r (STR ''vend'') [] = None"
  apply (rule no_possible_steps_1)
  apply (simp add: possible_steps_empty drinks_def can_take_transition_def can_take_def transitions)
  by (simp add: MaybeBoolInt_not_num_1 value_gt_def)

lemma drinks_0_rejects:
  "\<not> (fst a = STR ''select'' \<and> length (snd a) = 1) \<Longrightarrow>
    (possible_steps drinks 0 r (fst a) (snd a)) = {||}"
  apply (simp add: drinks_def possible_steps_def transitions)
  by force

lemma drinks_vend_empty: "(possible_steps drinks 0 <> (STR ''vend'') []) = {||}"
  using drinks_0_rejects
  by auto

lemma drinks_1_rejects:
  "fst a = STR ''coin'' \<longrightarrow> length (snd a) \<noteq> 1 \<Longrightarrow>
          a \<noteq> (STR ''vend'', []) \<Longrightarrow>
          possible_steps drinks 1 r (fst a) (snd a) = {||}"
  apply (simp add: possible_steps_empty drinks_def can_take_transition_def can_take_def transitions)
  by (metis prod.collapse)

lemma drinks_rejects_future: "\<not> recognises_execution drinks 2 d ((l, i)#t)"
  apply (rule no_possible_steps_rejects)
  by (simp add: possible_steps_empty drinks_def)

lemma drinks_1_rejects_trace:
  assumes not_vend: "e \<noteq> (STR ''vend'', [])"
      and not_coin: "\<nexists>i. e = (STR ''coin'', [i])"
  shows "\<not> recognises_execution drinks 1 r (e # es)"
proof-
  show ?thesis
    apply (cases e, simp)
    subgoal for a b
      apply (rule no_possible_steps_rejects)
      apply (simp add: possible_steps_empty drinks_def can_take_transition_def can_take_def transitions)
      apply (case_tac b)
      using not_vend apply simp
      using not_coin by auto
    done
qed

lemma rejects_state_step: "s > 1 \<Longrightarrow> step drinks s r l i = None"
  apply (rule no_possible_steps_1)
  by (simp add: possible_steps_empty drinks_def)

lemma invalid_other_states:
  "s > 1 \<Longrightarrow> \<not> recognises_execution drinks s r ((aa, b) # t)"
  apply (rule no_possible_steps_rejects)
  by (simp add: possible_steps_empty drinks_def)

lemma vend_ge_100:
  "possible_steps drinks 1 r l i = {|(2, vend)|} \<Longrightarrow>
   \<not>? value_gt (Some (Num 100)) (r $ 2) = trilean.true"
  apply (insert possible_steps_apply_guards[of drinks 1 r l i 2 vend])
  by (simp add: possible_steps_def apply_guards_def vend_def)

lemma drinks_no_possible_steps_1:
  assumes not_coin: "\<not> (a = STR ''coin'' \<and> length b = 1)"
      and not_vend: "\<not> (a = STR ''vend'' \<and> b = [])"
    shows "possible_steps drinks 1 r a b = {||}"
  using drinks_1_rejects not_coin not_vend by auto

lemma possible_steps_select_wrong_arity: "a = STR ''select'' \<Longrightarrow>
       length b \<noteq> 1 \<Longrightarrow>
       possible_steps drinks 0 <> a b = {||}"
  apply (simp add: possible_steps_def ffilter_def fset_both_sides Abs_fset_inverse Set.filter_def drinks_def)
  apply safe
  by (simp_all add: select_def)

lemma possible_steps_0_invalid:
  "\<not> (l = STR ''select'' \<and> length i = 1) \<Longrightarrow>
   possible_steps drinks 0 <> l i = {||}"
  using possible_steps_0_not_select possible_steps_select_wrong_arity by fastforce

end


theory Isar_exercises
imports Main
begin

(*==================Propositional Logic=========================*)
lemma "A \<longrightarrow> A"
proof (rule impI)
  assume a: "A"
  show "A" by (rule a)
qed

lemma "A \<longrightarrow> A"
(*Command proof automatically tries to select an introduction rule based on the goal and predefined
list of rules*)
proof
  assume a: "A"
  show "A" by (rule a)
qed

lemma "A \<longrightarrow> A \<and> A"
proof
  assume a:"A"
  show "A \<and> A" (* by (rule conjI) . *)
    by (simp add: a)
qed

lemma "A \<and> B \<longrightarrow> B \<and> A"
proof
  assume AB: "A \<and> B"
  show "B \<and> A"
  proof (rule conjE[OF AB])
    assume "A" "B"
    show ?thesis (*?thesis always stands for current goal, show/have statement*)
      by (simp add: AB)
  qed
qed

lemma "A \<and> B \<longrightarrow> B \<and> A"
proof
  assume AB: "A \<and> B"
  from AB show "B \<and> A"
  proof
    assume "A" "B"
    show ?thesis
      by (simp add: AB)
  qed
qed

lemma "A \<and> B \<longrightarrow> B \<and> A"
proof
  assume AB: "A \<and> B"
  from this show "B \<and> A"
  proof
    assume "A" "B"
    show ?thesis
      using AB by auto
  qed
qed

(*Forward Reasoning*)
(*Proving intermediate propositions 'have' on the way to the final 'show', when we cannot bridge
the gap between the assumptions and the conclusion in one step.*)
lemma "A \<and> B \<longrightarrow> B \<and> A"
proof
  assume AB: "A \<and> B"
  from AB have a: "A"
    by simp
  from AB have b: "B"
    by simp
  from b a show "B \<and> A"
    by blast
qed

(*
lemma "\<not>(A \<and> B) \<longrightarrow> \<not>A \<or> \<not>B"
proof
  assume n: "\<not>(A \<and> B)"
  show "\<not>A \<or> \<not>B"
  proof (rule ccontr)
    assume nn: "\<not>(\<not>A \<and> B)"
    have "\<not>A"
    proof
      assume "A"
      have "\<not>B"
      proof
        assume "B"
        have "A \<and> B"
          by (simp add: \<open>A\<close> \<open>B\<close>)
        with n show False
          by simp
      qed
      hence "\<not>A \<or> \<not>B" by blast
      with nn show False
        sorry
    qed
*)

lemma assumes AB: "A \<or> B" shows "B \<or> A"
proof -
  from AB show ?thesis
  proof
    assume "A" show ?thesis
      by (simp add: \<open>A\<close>)
  next
    assume "B" show ?thesis
      by (simp add: \<open>B\<close>)
  qed
qed

(*==================Predicate Calculus=========================*)
lemma assumes P: "\<forall>x. P x" shows "\<forall>x. P(f x)"
(*fix introduces new local variables into a proof*)
(*pair fix-show corresponds to \<And>, universal quantifier at meta-level,
like assume-show corresponds to \<Longrightarrow>*)
proof (*allI: (\<And>x. ?P x) \<Longrightarrow> \<forall>x. ?P x*)
  fix a
  from P show "P(f a)" (*allE: \<lbrakk>\<forall>x. ?P x; ?P ?x \<Longrightarrow> ?R\<rbrakk> \<Longrightarrow> ?R*)
    by simp
qed

lemma assumes Pf: "\<exists>x. P(f x)" shows "\<exists>y. P y"
proof -
(*obtain for existential quantifier. Similar to fix and assume.*)
  from Pf obtain a where "P(f a)" by blast
  then show "\<exists>y. P y" by blast
qed

lemma assumes ex: "\<exists>x. \<forall>y. P x y" shows "\<forall>y. \<exists>x. P x y"
proof
  fix y
  from ex obtain x where "\<forall>y. P x y" by blast
  then have "P x y" by blast
  then show "\<exists>x. P x y" by blast
qed

(*Cantor's theorem*)
theorem "\<exists>S. S \<notin> range (f :: 'a \<Rightarrow> 'a set)"
proof
  let ?S = "{x. x \<notin> f x}" (*let introduces an abbreviation for a term*)
  show "?S \<notin> range f"
  proof
    assume "?S \<in> range f"
    then obtain y where fy: "?S = f y" by blast
    show False
    proof cases (*starts a proof by cases. Note it remains implicit what the two cases are.
Merely expected that the two subproofs prove P \<Longrightarrow> ?thesis and \<not>P \<Longrightarrow> ?thesis for some P, in this order*)
      assume "y \<in> ?S"
      with fy show False by blast
    next
      assume "y \<notin> ?S"
      with fy show False by blast
    qed
  qed
qed

(*Detailed version of Cantor's theorem*)
theorem "\<exists>S. S \<notin> range (f :: 'a \<Rightarrow> 'a set)"
proof
  let ?S = "{x. x \<notin> f x}"
  show "?S \<notin> range f"
  proof
    assume "?S \<in> range f"
    then obtain y where fy: "?S = f y" by blast
    show False
    proof cases
      assume "y \<in> ?S"
      hence "y \<notin> f y" by simp
      hence "y \<notin> ?S" by (simp add: fy)
      thus False
        using \<open>y \<in> {x. x \<notin> f x}\<close> by blast
    next
      assume "y \<notin> ?S"
      hence "y \<in> f y" by simp
      hence "y \<in> ?S" by (simp add: fy)
      thus False
        using \<open>y \<notin> {x. x \<notin> f x}\<close> by auto
    qed
  qed
qed

lemma "\<forall>x y. A x y \<and> B x y \<longrightarrow> C x y"
proof -
  have "\<And>x y. \<lbrakk>A x y; B x y\<rbrakk> \<Longrightarrow> C x y"
  proof -
    fix x y assume "A x y" "B x y"
    show "C x y" sorry
  qed
  thus ?thesis by blast
qed

end