(*  Title:      Cube/Cube.thy
    Author:     Tobias Nipkow
*)

section \<open>Barendregt's Lambda-Cube\<close>

theory Cube
imports Pure
begin

setup Pure_Thy.old_appl_syntax_setup

named_theorems rules "Cube inference rules"

typedecl "term"
typedecl "context"
typedecl typing

axiomatization
  Abs :: "[term, term \<Rightarrow> term] \<Rightarrow> term" and
  Prod :: "[term, term \<Rightarrow> term] \<Rightarrow> term" and
  Trueprop :: "[context, typing] \<Rightarrow> prop" and
  MT_context :: "context" and
  Context :: "[typing, context] \<Rightarrow> context" and
  star :: "term"  ("*") and
  box :: "term"  ("\<box>") and
  app :: "[term, term] \<Rightarrow> term"  (infixl "\<cdot>" 20) and
  Has_type :: "[term, term] \<Rightarrow> typing"

nonterminal context' and typing'
syntax
  "_Trueprop" :: "[context', typing'] \<Rightarrow> prop"  ("(_/ \<turnstile> _)")
  "_Trueprop1" :: "typing' \<Rightarrow> prop"  ("(_)")
  "" :: "id \<Rightarrow> context'"  ("_")
  "" :: "var \<Rightarrow> context'"  ("_")
  "_MT_context" :: "context'"  ("")
  "_Context" :: "[typing', context'] \<Rightarrow> context'"  ("_ _")
  "_Has_type" :: "[term, term] \<Rightarrow> typing'"  ("(_:/ _)" [0, 0] 5)
  "_Lam" :: "[idt, term, term] \<Rightarrow> term"  ("(3\<^bold>\<lambda>_:_./ _)" [0, 0, 0] 10)
  "_Pi" :: "[idt, term, term] \<Rightarrow> term"  ("(3\<Prod>_:_./ _)" [0, 0] 10)
  "_arrow" :: "[term, term] \<Rightarrow> term"  (infixr "\<rightarrow>" 10)
translations
  "_Trueprop(G, t)" \<rightleftharpoons> "CONST Trueprop(G, t)"
  ("prop") "x:X" \<rightleftharpoons> ("prop") "\<turnstile> x:X"
  "_MT_context" \<rightleftharpoons> "CONST MT_context"
  "_Context" \<rightleftharpoons> "CONST Context"
  "_Has_type" \<rightleftharpoons> "CONST Has_type"
  "\<^bold>\<lambda>x:A. B" \<rightleftharpoons> "CONST Abs(A, \<lambda>x. B)"
  "\<Prod>x:A. B" \<rightharpoonup> "CONST Prod(A, \<lambda>x. B)"
  "A \<rightarrow> B" \<rightharpoonup> "CONST Prod(A, \<lambda>_. B)"
print_translation \<open>
  [(\<^const_syntax>\<open>Prod\<close>,
    fn _ => Syntax_Trans.dependent_tr' (\<^syntax_const>\<open>_Pi\<close>, \<^syntax_const>\<open>_arrow\<close>))]
\<close>

axiomatization where
  s_b: "*: \<box>"  and

  strip_s: "\<lbrakk>A:*; a:A \<Longrightarrow> G \<turnstile> x:X\<rbrakk> \<Longrightarrow> a:A G \<turnstile> x:X" and
  strip_b: "\<lbrakk>A:\<box>; a:A \<Longrightarrow> G \<turnstile> x:X\<rbrakk> \<Longrightarrow> a:A G \<turnstile> x:X" and

  app: "\<lbrakk>F:Prod(A, B); C:A\<rbrakk> \<Longrightarrow> F\<cdot>C: B(C)" and

  pi_ss: "\<lbrakk>A:*; \<And>x. x:A \<Longrightarrow> B(x):*\<rbrakk> \<Longrightarrow> Prod(A, B):*" and

  lam_ss: "\<lbrakk>A:*; \<And>x. x:A \<Longrightarrow> f(x):B(x); \<And>x. x:A \<Longrightarrow> B(x):* \<rbrakk>
            \<Longrightarrow> Abs(A, f) : Prod(A, B)" and

  beta: "Abs(A, f)\<cdot>a \<equiv> f(a)"

lemmas [rules] = s_b strip_s strip_b app lam_ss pi_ss

lemma imp_elim:
  assumes "f:A\<rightarrow>B" and "a:A" and "f\<cdot>a:B \<Longrightarrow> PROP P"
  shows "PROP P" by (rule app assms)+

lemma pi_elim:
  assumes "F:Prod(A,B)" and "a:A" and "F\<cdot>a:B(a) \<Longrightarrow> PROP P"
  shows "PROP P" by (rule app assms)+

locale L2 =
  assumes pi_bs: "\<lbrakk>A:\<box>; \<And>x. x:A \<Longrightarrow> B(x):*\<rbrakk> \<Longrightarrow> Prod(A,B):*"
    and lam_bs: "\<lbrakk>A:\<box>; \<And>x. x:A \<Longrightarrow> f(x):B(x); \<And>x. x:A \<Longrightarrow> B(x):*\<rbrakk>
                   \<Longrightarrow> Abs(A,f) : Prod(A,B)"
begin

lemmas [rules] = lam_bs pi_bs

end

locale Lomega =
  assumes
    pi_bb: "\<lbrakk>A:\<box>; \<And>x. x:A \<Longrightarrow> B(x):\<box>\<rbrakk> \<Longrightarrow> Prod(A,B):\<box>"
    and lam_bb: "\<lbrakk>A:\<box>; \<And>x. x:A \<Longrightarrow> f(x):B(x); \<And>x. x:A \<Longrightarrow> B(x):\<box>\<rbrakk>
                   \<Longrightarrow> Abs(A,f) : Prod(A,B)"
begin

lemmas [rules] = lam_bb pi_bb

end

locale LP =
  assumes pi_sb: "\<lbrakk>A:*; \<And>x. x:A \<Longrightarrow> B(x):\<box>\<rbrakk> \<Longrightarrow> Prod(A,B):\<box>"
    and lam_sb: "\<lbrakk>A:*; \<And>x. x:A \<Longrightarrow> f(x):B(x); \<And>x. x:A \<Longrightarrow> B(x):\<box>\<rbrakk>
                   \<Longrightarrow> Abs(A,f) : Prod(A,B)"
begin

lemmas [rules] = lam_sb pi_sb

end

locale LP2 = LP + L2
begin

lemmas [rules] = lam_bs pi_bs lam_sb pi_sb

end

locale Lomega2 = L2 + Lomega
begin

lemmas [rules] = lam_bs pi_bs lam_bb pi_bb

end

locale LPomega = LP + Lomega
begin

lemmas [rules] = lam_bb pi_bb lam_sb pi_sb

end

locale CC = L2 + LP + Lomega
begin

lemmas [rules] = lam_bs pi_bs lam_bb pi_bb lam_sb pi_sb

end

end


(* Author: Dmitry Traytel *)

theory List_More
imports Main "../List-Index/List_Index" "~~/src/HOL/Library/Multiset"
begin

subsection {* Library Functions *}

abbreviation "bool_product_lists n \<equiv> product_lists (replicate n [True, False])"

lemma in_set_bool_product_lists[simp]:
  "bs \<in> set (bool_product_lists n) \<longleftrightarrow> length bs = n"
proof (induct n arbitrary: bs)
  case (Suc n) thus ?case by (cases bs) auto
qed simp

text {* More on sort and remdups *}

lemma insort_min[simp]: "\<forall>y \<in> set xs. x < y \<Longrightarrow> insort x xs = x # xs"
  by (induct xs) auto

lemma insort_max[simp]: "\<forall>y \<in> set xs. x > y \<Longrightarrow> insort x xs = xs @ [x]"
  by (induct xs) auto

lemma insort_snoc[simp]: "\<forall>z \<in> set xs. y > z \<Longrightarrow>
  insort x (xs @ [y]) = (if x < y then insort x xs @ [y] else xs @ [y, x])"
  by (induct xs) auto

declare set_insort[simp]

lemma insort_remdups[simp]: "\<lbrakk>sorted xs; a \<notin> set xs\<rbrakk> \<Longrightarrow> insort a (remdups xs) = remdups (insort a xs)"
proof (induct xs)
  case (Cons x xs) thus ?case by (cases xs) (auto simp: sorted_Cons)
qed simp

lemma remdups_insort[simp]: "a \<in> set xs \<Longrightarrow> remdups (insort a xs) = remdups xs"
  by (induct xs) auto

lemma sort_remdups[simp]: "sort (remdups xs) = remdups (sort xs)"
  by (induct xs) auto

lemma sort_map_insort[simp]: "sorted xs \<Longrightarrow> sort (map f (insort a xs)) = insort (f a) (sort (map f xs))"
  by (induct xs) (auto simp: sorted_Cons insort_left_comm)

lemma sort_map_sort[simp]: "sort (map f (sort xs)) = sort (map f xs)"
  by (induct xs) auto

lemma remdups_append: "remdups (xs @ ys) = remdups (filter (\<lambda>x. x \<notin> set ys) xs) @ remdups ys"
  by (induct xs) auto

lemma remdups_concat_map_remdups:
  "remdups (concat (map f (remdups xs))) = remdups (concat (map f xs))"
  by (induct xs) (auto simp: remdups_append filter_empty_conv)

(*remdups'*)

primrec remdups' where
  "remdups' f [] = []"
| "remdups' f (x # xs) =
    (case List.find (\<lambda>y. f x = f y) xs of None \<Rightarrow> x # remdups' f xs | _ \<Rightarrow> remdups' f xs)"

lemma map_remdups'[simp]: "map f (remdups' f xs) = remdups (map f xs)"
  by (induct xs) (auto split: option.splits simp add: find_Some_iff find_None_iff)

lemma remdups'_map[simp]: "remdups' f (map g xs) = map g (remdups' (f o g) xs)"
  by (induct xs) (auto split: option.splits simp add: find_None_iff,
                auto simp: find_Some_iff elim: imageI[OF nth_mem])

lemma map_apfst_remdups':
  "map (f o fst) (remdups' snd xs) = map fst (remdups' snd (map (apfst f) xs))"
  by (auto simp: comp_def)

lemma set_remdups'[simp]: "f ` set (remdups' f xs) = f ` set xs"
  by (induct xs) (auto split: option.splits simp add: find_Some_iff)

lemma subset_remdups': "set (remdups' f xs) \<subseteq> set xs"
  by (induct xs) (auto split: option.splits)

lemma find_append[simp]:
  "List.find P (xs @ ys) = None = (List.find P xs = None \<and> List.find P ys = None)"
  by (induct xs) auto

lemma subset_remdups'_append: "set (remdups' f (xs @ ys)) \<subseteq> set (remdups' f xs) \<union> set (remdups' f ys)"
  by (induct xs arbitrary: ys) (auto split: option.splits)

lemmas mp_remdups' = set_mp[OF subset_remdups']
lemmas mp_remdups'_append = set_mp[OF subset_remdups'_append]

lemma inj_on_set_remdups'[simp]: "inj_on f (set (remdups' f xs))"
  by (induct xs) (auto split: option.splits simp add: find_None_iff dest!: mp_remdups')

lemma distinct_remdups'[simp]: "distinct (map f (remdups' f xs))"
  by (induct xs) (auto split: option.splits simp: find_None_iff)

lemma distinct_remdups'_strong: "(\<forall>x\<in>set xs. \<forall>y\<in>set xs. g x = g y \<longrightarrow> f x = f y) \<Longrightarrow>
  distinct (map g (remdups' f xs))"
proof (induct xs)
  case (Cons x xs) thus ?case
    by (auto split: option.splits) (fastforce simp: find_None_iff dest!: mp_remdups')
qed simp

lemma set_remdups'_strong: "(\<forall>x\<in>set xs. \<forall>y\<in>set xs. g x = g y \<longrightarrow> f x = f y) \<Longrightarrow>
  f ` set (remdups' g xs) = f ` set xs"
proof (induct xs)
  case (Cons x xs) thus ?case
    by (clarsimp split: option.splits simp add: find_Some_iff)
       (intro insert_absorb[symmetric] image_eqI[OF _ nth_mem, of _ f xs], auto)
qed simp

(*multisets only needed below*)
lemma multiset_concat_gen: "M + multiset_of (concat xs) = fold (\<lambda>x M. M + multiset_of x) xs M"
  by (induct xs arbitrary: M) (auto, metis union_assoc)

corollary multiset_concat: "multiset_of (concat xs) = fold (\<lambda>x M. M + multiset_of x) xs {#}"
  using multiset_concat_gen[of "{#}" xs] by simp

lemma fold_multiset_of_insort[simp]: "fold (\<lambda>x M. M + multiset_of (f x)) (insort x xs) M =
  fold (\<lambda>x M. M + multiset_of (f x)) xs (multiset_of (f x) + M)"
  by (induct xs arbitrary: M) (auto simp: ac_simps)

lemma fold_multiset_of_sort[simp]:
  "fold (\<lambda>x M. M + multiset_of (f x)) (sort xs) M = fold (\<lambda>x M. M + multiset_of (f x)) xs M"
  by (induct xs arbitrary: M) (auto simp: ac_simps)

lemma multiset_concat_map_sort[simp]:
  "multiset_of (concat (map f (sort xs))) = multiset_of (concat (map f xs))"
  by (auto simp: multiset_concat fold_map o_def)

lemma sort_concat_map_sort[simp]: "sort (concat (map f (sort xs))) = sort (concat (map f xs))"
  by (auto intro: properties_for_sort)

end


section \<open> Meta-theory for Relation Library \<close>

theory Relation_Lib
  imports
    Countable_Set_Extra Positive Infinity Enum_Type Record_Default_Instance Def_Const
    Relation_Extra Partial_Fun Partial_Inj Finite_Fun Finite_Inj Total_Fun List_Extra
    Trace_Algebra
begin

text \<open> This theory marks the boundary between reusable library utilities and the creation of the
  Z notation. We avoid overriding any HOL syntax up until this point, but we do supply some optional
  bundles. \<close>

lemma if_eqE [elim!]: "\<lbrakk> (if b then e else f) = v; \<lbrakk> b; e = v \<rbrakk> \<Longrightarrow> P; \<lbrakk> \<not> b; f = v \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
  by (cases b, auto)

bundle Z_Type_Syntax
begin

type_notation bool ("\<bool>")
type_notation nat ("\<nat>")
type_notation int ("\<int>")
type_notation rat ("\<rat>")
type_notation real ("\<real>")

type_notation set ("\<bbbP> _" [999] 999)

type_notation tfun (infixr "\<rightarrow>" 0)

notation Pow ("\<bbbP>")
notation Fpow ("\<bbbF>")

end

class refine =
  fixes ref_by :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
  and sref_by :: "'a \<Rightarrow> 'a \<Rightarrow> bool"  (infix "\<sqsubset>" 50)
  assumes ref_by_order: "class.preorder (\<sqsubseteq>) (\<sqsubset>)"

interpretation ref_preorder: preorder "(\<sqsubseteq>)" "(\<sqsubset>)"
  by (fact ref_by_order)

lemma ref_by_trans [trans]: "\<lbrakk> P \<sqsubseteq> Q; Q \<sqsubseteq> R \<rbrakk> \<Longrightarrow> P \<sqsubseteq> R"
  using ref_preorder.dual_order.trans by auto

abbreviation (input) refines (infix "\<sqsupseteq>" 50) where "Q \<sqsupseteq> P \<equiv> P \<sqsubseteq> Q"
abbreviation (input) srefines (infix "\<sqsupset>" 50) where "Q \<sqsupset> P \<equiv> P \<sqsubset> Q"

instantiation "bool" :: refine
begin

definition "ref_by_bool P Q = (Q \<longrightarrow> P)"
definition "sref_by_bool P Q = (\<not> Q \<and> P)"

instance by (intro_classes, unfold_locales, auto simp add: ref_by_bool_def sref_by_bool_def)

end

instantiation "fun" :: (type, refine) refine
begin

definition ref_by_fun :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool" where "ref_by_fun f g = (\<forall> x. f(x) \<sqsubseteq> g(x))"
definition sref_by_fun :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool" where "sref_by_fun f g = (f \<sqsubseteq> g \<and> \<not> (g \<sqsubseteq> f))"

instance
  by (intro_classes, unfold_locales)
     (auto simp add: ref_by_fun_def sref_by_fun_def ref_preorder.less_le_not_le intro: ref_preorder.order.trans)
end

end


(* Title: thys/Recs.thy
   Author: Christian Urban
*)
theory Recs
  imports Main
    "HOL-Library.Nat_Bijection"
    "HOL-Library.Discrete"
begin

text\<open>
  A more streamlined and cleaned-up version of Recursive
  Functions following

    A Course in Formal Languages, Automata and Groups
    I. M. Chiswell

  and

    Lecture on Undecidability
    Michael M. Wolf
\<close>

declare One_nat_def[simp del]

lemma if_zero_one [simp]:
  "(if P then 1 else 0) = (0::nat) \<longleftrightarrow> \<not> P"
  "(0::nat) < (if P then 1 else 0) = P"
  "(if P then 0 else 1) = (if \<not>P then 1 else (0::nat))"
  by (simp_all)

lemma nth:
  "(x # xs) ! 0 = x"
  "(x # y # xs) ! 1 = y"
  "(x # y # z # xs) ! 2 = z"
  "(x # y # z # u # xs) ! 3 = u"
  by (simp_all)

section \<open>Some auxiliary lemmas about \<open>\<Sum>\<close> and \<open>\<Prod>\<close>\<close>

lemma setprod_atMost_Suc[simp]:
  "(\<Prod>i \<le> Suc n. f i) = (\<Prod>i \<le> n. f i) * f(Suc n)"
  by(simp add:atMost_Suc mult_ac)

lemma setprod_lessThan_Suc[simp]:
  "(\<Prod>i < Suc n. f i) = (\<Prod>i < n. f i) * f n"
  by (simp add:lessThan_Suc mult_ac)

lemma setsum_add_nat_ivl2: "n \<le> p  \<Longrightarrow>
  sum f {..<n} + sum f {n..p} = sum f {..p::nat}"
  apply(subst sum.union_disjoint[symmetric])
     apply(auto simp add: ivl_disj_un_one)
  done

lemma setsum_eq_zero [simp]:
  fixes f::"nat \<Rightarrow> nat"
  shows "(\<Sum>i < n. f i) = 0 \<longleftrightarrow> (\<forall>i < n. f i = 0)"
    "(\<Sum>i \<le> n. f i) = 0 \<longleftrightarrow> (\<forall>i \<le> n. f i = 0)"
  by (auto)

lemma setprod_eq_zero [simp]:
  fixes f::"nat \<Rightarrow> nat"
  shows "(\<Prod>i < n. f i) = 0 \<longleftrightarrow> (\<exists>i < n. f i = 0)"
    "(\<Prod>i \<le> n. f i) = 0 \<longleftrightarrow> (\<exists>i \<le> n. f i = 0)"
  by (auto)

lemma setsum_one_less:
  fixes n::nat
  assumes "\<forall>i < n. f i \<le> 1"
  shows "(\<Sum>i < n. f i) \<le> n"
  using assms
  by (induct n) (auto)

lemma setsum_one_le:
  fixes n::nat
  assumes "\<forall>i \<le> n. f i \<le> 1"
  shows "(\<Sum>i \<le> n. f i) \<le> Suc n"
  using assms
  by (induct n) (auto)

lemma setsum_eq_one_le:
  fixes n::nat
  assumes "\<forall>i \<le> n. f i = 1"
  shows "(\<Sum>i \<le> n. f i) = Suc n"
  using assms
  by (induct n) (auto)

lemma setsum_least_eq:
  fixes f::"nat \<Rightarrow> nat"
  assumes h0: "p \<le> n"
  assumes h1: "\<forall>i \<in> {..<p}. f i = 1"
  assumes h2: "\<forall>i \<in> {p..n}. f i = 0"
  shows "(\<Sum>i \<le> n. f i) = p"
proof -
  have eq_p: "(\<Sum>i \<in> {..<p}. f i) = p"
    using h1 by (induct p) (simp_all)
  have eq_zero: "(\<Sum>i \<in> {p..n}. f i) = 0"
    using h2 by auto
  have "(\<Sum>i \<le> n. f i) = (\<Sum>i \<in> {..<p}. f i) + (\<Sum>i \<in> {p..n}. f i)"
    using h0 by (simp add: setsum_add_nat_ivl2)
  also have "... = (\<Sum>i \<in> {..<p}. f i)" using eq_zero by simp
  finally show "(\<Sum>i \<le> n. f i) = p" using eq_p by simp
qed

lemma nat_mult_le_one:
  fixes m n::nat
  assumes "m \<le> 1" "n \<le> 1"
  shows "m * n \<le> 1"
  using assms by (induct n) (auto)

lemma setprod_one_le:
  fixes f::"nat \<Rightarrow> nat"
  assumes "\<forall>i \<le> n. f i \<le> 1"
  shows "(\<Prod>i \<le> n. f i) \<le> 1"
  using assms
  by (induct n) (auto intro: nat_mult_le_one)

lemma setprod_greater_zero:
  fixes f::"nat \<Rightarrow> nat"
  assumes "\<forall>i \<le> n. f i \<ge> 0"
  shows "(\<Prod>i \<le> n. f i) \<ge> 0"
  using assms by (induct n) (auto)

lemma setprod_eq_one:
  fixes f::"nat \<Rightarrow> nat"
  assumes "\<forall>i \<le> n. f i = Suc 0"
  shows "(\<Prod>i \<le> n. f i) = Suc 0"
  using assms by (induct n) (auto)

lemma setsum_cut_off_less:
  fixes f::"nat \<Rightarrow> nat"
  assumes h1: "m \<le> n"
    and     h2: "\<forall>i \<in> {m..<n}. f i = 0"
  shows "(\<Sum>i < n. f i) = (\<Sum>i < m. f i)"
proof -
  have eq_zero: "(\<Sum>i \<in> {m..<n}. f i) = 0"
    using h2 by auto
  have "(\<Sum>i < n. f i) = (\<Sum>i \<in> {..<m}. f i) + (\<Sum>i \<in> {m..<n}. f i)"
    using h1 by (metis atLeast0LessThan le0 sum.atLeastLessThan_concat)
  also have "... = (\<Sum>i \<in> {..<m}. f i)" using eq_zero by simp
  finally show "(\<Sum>i < n. f i) = (\<Sum>i < m. f i)" by simp
qed

lemma setsum_cut_off_le:
  fixes f::"nat \<Rightarrow> nat"
  assumes h1: "m \<le> n"
    and     h2: "\<forall>i \<in> {m..n}. f i = 0"
  shows "(\<Sum>i \<le> n. f i) = (\<Sum>i < m. f i)"
proof -
  have eq_zero: "(\<Sum>i \<in> {m..n}. f i) = 0"
    using h2 by auto
  have "(\<Sum>i \<le> n. f i) = (\<Sum>i \<in> {..<m}. f i) + (\<Sum>i \<in> {m..n}. f i)"
    using h1 by (simp add: setsum_add_nat_ivl2)
  also have "... = (\<Sum>i \<in> {..<m}. f i)" using eq_zero by simp
  finally show "(\<Sum>i \<le> n. f i) = (\<Sum>i < m. f i)" by simp
qed

lemma setprod_one [simp]:
  fixes n::nat
  shows "(\<Prod>i < n. Suc 0) = Suc 0"
    "(\<Prod>i \<le> n. Suc 0) = Suc 0"
  by (induct n) (simp_all)

section \<open>Recursive Functions\<close>

datatype recf =  Z
  |  S
  |  Id nat nat
  |  Cn nat recf "recf list"
  |  Pr nat recf recf
  |  Mn nat recf

fun arity :: "recf \<Rightarrow> nat"
  where
    "arity Z = 1"
  | "arity S = 1"
  | "arity (Id m n) = m"
  | "arity (Cn n f gs) = n"
  | "arity (Pr n f g) = Suc n"
  | "arity (Mn n f) = n"

text \<open>Abbreviations for calculating the arity of the constructors\<close>

abbreviation
  "CN f gs \<equiv> Cn (arity (hd gs)) f gs"

abbreviation
  "PR f g \<equiv> Pr (arity f) f g"

abbreviation
  "MN f \<equiv> Mn (arity f - 1) f"

text \<open>the evaluation function and termination relation\<close>

fun rec_eval :: "recf \<Rightarrow> nat list \<Rightarrow> nat"
  where
    "rec_eval Z xs = 0"
  | "rec_eval S xs = Suc (xs ! 0)"
  | "rec_eval (Id m n) xs = xs ! n"
  | "rec_eval (Cn n f gs) xs = rec_eval f (map (\<lambda>x. rec_eval x xs) gs)"
  | "rec_eval (Pr n f g) (0 # xs) = rec_eval f xs"
  | "rec_eval (Pr n f g) (Suc x # xs) =
     rec_eval g (x # (rec_eval (Pr n f g) (x # xs)) # xs)"
  | "rec_eval (Mn n f) xs = (LEAST x. rec_eval f (x # xs) = 0)"

inductive
  terminates :: "recf \<Rightarrow> nat list \<Rightarrow> bool"
  where
    termi_z: "terminates Z [n]"
  | termi_s: "terminates S [n]"
  | termi_id: "\<lbrakk>n < m; length xs = m\<rbrakk> \<Longrightarrow> terminates (Id m n) xs"
  | termi_cn: "\<lbrakk>terminates f (map (\<lambda>g. rec_eval g xs) gs);
              \<forall>g \<in> set gs. terminates g xs; length xs = n\<rbrakk> \<Longrightarrow> terminates (Cn n f gs) xs"
  | termi_pr: "\<lbrakk>\<forall> y < x. terminates g (y # (rec_eval (Pr n f g) (y # xs) # xs));
              terminates f xs;
              length xs = n\<rbrakk>
              \<Longrightarrow> terminates (Pr n f g) (x # xs)"
  | termi_mn: "\<lbrakk>length xs = n; terminates f (r # xs);
              rec_eval f (r # xs) = 0;
              \<forall> i < r. terminates f (i # xs) \<and> rec_eval f (i # xs) > 0\<rbrakk> \<Longrightarrow> terminates (Mn n f) xs"

section \<open>Arithmetic Functions\<close>

text \<open>
  \<open>constn n\<close> is the recursive function which computes
  natural number \<open>n\<close>.
\<close>
fun constn :: "nat \<Rightarrow> recf"
  where
    "constn 0 = Z"  |
    "constn (Suc n) = CN S [constn n]"

definition
  "rec_swap f = CN f [Id 2 1, Id 2 0]"

definition
  "rec_add = PR (Id 1 0) (CN S [Id 3 1])"

definition
  "rec_mult = PR Z (CN rec_add [Id 3 1, Id 3 2])"

definition
  "rec_power = rec_swap (PR (constn 1) (CN rec_mult [Id 3 1, Id 3 2]))"

definition
  "rec_fact_aux = PR (constn 1) (CN rec_mult [CN S [Id 3 0], Id 3 1])"

definition
  "rec_fact = CN rec_fact_aux [Id 1 0, Id 1 0]"

definition
  "rec_predecessor = CN (PR Z (Id 3 0)) [Id 1 0, Id 1 0]"

definition
  "rec_minus = rec_swap (PR (Id 1 0) (CN rec_predecessor [Id 3 1]))"

lemma constn_

lemma swap_lemma [simp]:
  "rec_eval (rec_swap f) [x, y] = rec_eval f [y, x]"
  by (simp add: rec_swap_def)

lemma add_lemma [simp]:
  "rec_eval rec_add [x, y] =  x + y"
  by (induct x) (simp_all add: rec_add_def)

lemma mult_lemma [simp]:
  "rec_eval rec_mult [x, y] = x * y"
  by (induct x) (simp_all add: rec_mult_def)

lemma power_lemma [simp]:
  "rec_eval rec_power [x, y] = x ^ y"
  by (induct y) (simp_all add: rec_power_def)

lemma fact_aux_lemma [simp]:
  "rec_eval rec_fact_aux [x, y] = fact x"
  by (induct x) (simp_all add: rec_fact_aux_def)

lemma fact_lemma [simp]:
  "rec_eval rec_fact [x] = fact x"
  by (simp add: rec_fact_def)

lemma pred_lemma [simp]:
  "rec_eval rec_predecessor [x] =  x - 1"
  by (induct x) (simp_all add: rec_predecessor_def)

lemma minus_lemma [simp]:
  "rec_eval rec_minus [x, y] = x - y"
  by (induct y) (simp_all add: rec_minus_def)

section \<open>Logical functions\<close>

text \<open>
  The \<open>sign\<close> function returns 1 when the input argument
  is greater than \<open>0\<close>.\<close>

definition
  "rec_sign = CN rec_minus [constn 1, CN rec_minus [constn 1, Id 1 0]]"

definition
  "rec_not = CN rec_minus [constn 1, Id 1 0]"

text \<open>
  \<open>rec_eq\<close> compares two arguments: returns \<open>1\<close>
  if they are equal; \<open>0\<close> otherwise.\<close>
definition
  "rec_eq = CN rec_minus [CN (constn 1) [Id 2 0], CN rec_add [rec_minus, rec_swap rec_minus]]"

definition
  "rec_noteq = CN rec_not [rec_eq]"

definition
  "rec_conj = CN rec_sign [rec_mult]"

definition
  "rec_disj = CN rec_sign [rec_add]"

definition
  "rec_imp = CN rec_disj [CN rec_not [Id 2 0], Id 2 1]"

text \<open>@{term "rec_ifz [z, x, y]"} returns x if z is zero,
  y otherwise;  @{term "rec_if [z, x, y]"} returns x if z is *not*
  zero, y otherwise\<close>

definition
  "rec_ifz = PR (Id 2 0) (Id 4 3)"

definition
  "rec_if = CN rec_ifz [CN rec_not [Id 3 0], Id 3 1, Id 3 2]"

lemma sign_lemma [simp]:
  "rec_eval rec_sign [x] = (if x = 0 then 0 else 1)"
  by (simp add: rec_sign_def)

lemma not_lemma [simp]:
  "rec_eval rec_not [x] = (if x = 0 then 1 else 0)"
  by (simp add: rec_not_def)

lemma eq_lemma [simp]:
  "rec_eval rec_eq [x, y] = (if x = y then 1 else 0)"
  by (simp add: rec_eq_def)

lemma noteq_lemma [simp]:
  "rec_eval rec_noteq [x, y] = (if x \<noteq> y then 1 else 0)"
  by (simp add: rec_noteq_def)

lemma conj_lemma [simp]:
  "rec_eval rec_conj [x, y] = (if x = 0 \<or> y = 0 then 0 else 1)"
  by (simp add: rec_conj_def)

lemma disj_lemma [simp]:
  "rec_eval rec_disj [x, y] = (if x = 0 \<and> y = 0 then 0 else 1)"
  by (simp add: rec_disj_def)

lemma imp_lemma [simp]:
  "rec_eval rec_imp [x, y] = (if 0 < x \<and> y = 0 then 0 else 1)"
  by (simp add: rec_imp_def)

lemma ifz_lemma [simp]:
  "rec_eval rec_ifz [z, x, y] = (if z = 0 then x else y)"
  by (cases z) (simp_all add: rec_ifz_def)

lemma if_lemma [simp]:
  "rec_eval rec_if [z, x, y] = (if 0 < z then x else y)"
  by (simp add: rec_if_def)

section \<open>Less and Le Relations\<close>

text \<open>
  \<open>rec_less\<close> compares two arguments and returns \<open>1\<close> if
  the first is less than the second; otherwise returns \<open>0\<close>.\<close>

definition
  "rec_less = CN rec_sign [rec_swap rec_minus]"

definition
  "rec_le = CN rec_disj [rec_less, rec_eq]"

lemma less_lemma [simp]:
  "rec_eval rec_less [x, y] = (if x < y then 1 else 0)"
  by (simp add: rec_less_def)

lemma le_lemma [simp]:
  "rec_eval rec_le [x, y] = (if (x \<le> y) then 1 else 0)"
  by(simp add: rec_le_def)

section \<open>Summation and Product Functions\<close>

definition
  "rec_sigma1 f = PR (CN f [CN Z [Id 1 0], Id 1 0])
                     (CN rec_add [Id 3 1, CN f [CN S [Id 3 0], Id 3 2]])"

definition
  "rec_sigma2 f = PR (CN f [CN Z [Id 2 0], Id 2 0, Id 2 1])
                     (CN rec_add [Id 4 1, CN f [CN S [Id 4 0], Id 4 2, Id 4 3]])"

definition
  "rec_accum1 f = PR (CN f [CN Z [Id 1 0], Id 1 0])
                     (CN rec_mult [Id 3 1, CN f [CN S [Id 3 0], Id 3 2]])"

definition
  "rec_accum2 f = PR (CN f [CN Z [Id 2 0], Id 2 0, Id 2 1])
                     (CN rec_mult [Id 4 1, CN f [CN S [Id 4 0], Id 4 2, Id 4 3]])"

definition
  "rec_accum3 f = PR (CN f [CN Z [Id 3 0], Id 3 0, Id 3 1, Id 3 2])
                     (CN rec_mult [Id 5 1, CN f [CN S [Id 5 0], Id 5 2, Id 5 3, Id 5 4]])"

lemma sigma1_lemma [simp]:
  shows "rec_eval (rec_sigma1 f) [x, y] = (\<Sum> z \<le> x. rec_eval f [z, y])"
  by (induct x) (simp_all add: rec_sigma1_def)

lemma sigma2_lemma [simp]:
  shows "rec_eval (rec_sigma2 f) [x, y1, y2] = (\<Sum> z \<le> x. rec_eval f  [z, y1, y2])"
  by (induct x) (simp_all add: rec_sigma2_def)

lemma accum1_lemma [simp]:
  shows "rec_eval (rec_accum1 f) [x, y] = (\<Prod> z \<le> x. rec_eval f  [z, y])"
  by (induct x) (simp_all add: rec_accum1_def)

lemma accum2_lemma [simp]:
  shows "rec_eval (rec_accum2 f) [x, y1, y2] = (\<Prod> z \<le> x. rec_eval f  [z, y1, y2])"
  by (induct x) (simp_all add: rec_accum2_def)

lemma accum3_lemma [simp]:
  shows "rec_eval (rec_accum3 f) [x, y1, y2, y3] = (\<Prod> z \<le> x. (rec_eval f)  [z, y1, y2, y3])"
  by (induct x) (simp_all add: rec_accum3_def)

section \<open>Bounded Quantifiers\<close>

definition
  "rec_all1 f = CN rec_sign [rec_accum1 f]"

definition
  "rec_all2 f = CN rec_sign [rec_accum2 f]"

definition
  "rec_all3 f = CN rec_sign [rec_accum3 f]"

definition
  "rec_all1_less f = (let cond1 = CN rec_eq [Id 3 0, Id 3 1] in
                      let cond2 = CN f [Id 3 0, Id 3 2]
                      in CN (rec_all2 (CN rec_disj [cond1, cond2])) [Id 2 0, Id 2 0, Id 2 1])"

definition
  "rec_all2_less f = (let cond1 = CN rec_eq [Id 4 0, Id 4 1] in
                      let cond2 = CN f [Id 4 0, Id 4 2, Id 4 3] in
                      CN (rec_all3 (CN rec_disj [cond1, cond2])) [Id 3 0, Id 3 0, Id 3 1, Id 3 2])"

definition
  "rec_ex1 f = CN rec_sign [rec_sigma1 f]"

definition
  "rec_ex2 f = CN rec_sign [rec_sigma2 f]"

lemma ex1_lemma [simp]:
  "rec_eval (rec_ex1 f) [x, y] = (if (\<exists>z \<le> x. 0 < rec_eval f [z, y]) then 1 else 0)"
  by (simp add: rec_ex1_def)

lemma all1_lemma [simp]:
  "rec_eval (rec_all1 f) [x, y] = (if (\<forall>z \<le> x. 0 < rec_eval f [z, y]) then 1 else 0)"
  by (simp add: rec_all1_def)

lemma all2_lemma [simp]:
  "rec_eval (rec_all2 f) [x, y1, y2] = (if (\<forall>z \<le> x. 0 < rec_eval f [z, y1, y2]) then 1 else 0)"
  by (simp add: rec_all2_def)

lemma all3_lemma [simp]:
  "rec_eval (rec_all3 f) [x, y1, y2, y3] = (if (\<forall>z \<le> x. 0 < rec_eval f [z, y1, y2, y3]) then 1 else 0)"
  by (simp add: rec_all3_def)

lemma all1_less_lemma [simp]:
  "rec_eval (rec_all1_less f) [x, y] = (if (\<forall>z < x. 0 < rec_eval f [z, y]) then 1 else 0)"
  apply(auto simp add: Let_def rec_all1_less_def)
   apply (metis nat_less_le)+
  done

lemma all2_less_lemma [simp]:
  "rec_eval (rec_all2_less f) [x, y1, y2] = (if (\<forall>z < x. 0 < rec_eval f [z, y1, y2]) then 1 else 0)"
  apply(auto simp add: Let_def rec_all2_less_def)
   apply(metis nat_less_le)+
  done

section \<open>Quotients\<close>

definition
  "rec_quo = (let lhs = CN S [Id 3 0] in
              let rhs = CN rec_mult [Id 3 2, CN S [Id 3 1]] in
              let cond = CN rec_eq [lhs, rhs] in
              let if_stmt = CN rec_if [cond, CN S [Id 3 1], Id 3 1]
              in PR Z if_stmt)"

fun Quo where
  "Quo x 0 = 0"
| "Quo x (Suc y) = (if (Suc y = x * (Suc (Quo x y))) then Suc (Quo x y) else Quo x y)"

lemma Quo0:
  shows "Quo 0 y = 0"
  by (induct y) (auto)

lemma Quo1:
  "x * (Quo x y) \<le> y"
  by (induct y) (simp_all)

lemma Quo2:
  "b * (Quo b a) + a mod b = a"
  by (induct a) (auto simp add: mod_Suc)

lemma Quo3:
  "n * (Quo n m) = m - m mod n"
  using Quo2[of n m] by (auto)

lemma Quo4:
  assumes h: "0 < x"
  shows "y < x + x * Quo x y"
proof -
  have "x - (y mod x) > 0" using mod_less_divisor assms by auto
  then have "y < y + (x - (y mod x))" by simp
  then have "y < x + (y - (y mod x))" by simp
  then show "y < x + x * (Quo x y)" by (simp add: Quo3)
qed

lemma Quo_div:
  shows "Quo x y = y div x"
  by (metis Quo0 Quo1 Quo4 div_by_0 div_nat_eqI mult_Suc_right neq0_conv)

lemma Quo_rec_quo:
  shows "rec_eval rec_quo [y, x] = Quo x y"
  by (induct y) (simp_all add: rec_quo_def)

lemma quo_lemma [simp]:
  shows "rec_eval rec_quo [y, x] = y div x"
  by (simp add: Quo_div Quo_rec_quo)

section \<open>Iteration\<close>

definition
  "rec_iter f = PR (Id 1 0) (CN f [Id 3 1])"

fun Iter where
  "Iter f 0 = id"
| "Iter f (Suc n) = f \<circ> (Iter f n)"

lemma Iter_comm:
  "(Iter f n) (f x) = f ((Iter f n) x)"
  by (induct n) (simp_all)

lemma iter_lemma [simp]:
  "rec_eval (rec_iter f) [n, x] =  Iter (\<lambda>x. rec_eval f [x]) n x"
  by (induct n) (simp_all add: rec_iter_def)

section \<open>Bounded Maximisation\<close>

fun BMax_rec where
  "BMax_rec R 0 = 0"
| "BMax_rec R (Suc n) = (if R (Suc n) then (Suc n) else BMax_rec R n)"

definition
  BMax_set :: "(nat \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> nat"
  where
    "BMax_set R x = Max ({z. z \<le> x \<and> R z} \<union> {0})"

lemma BMax_rec_eq1:
  "BMax_rec R x = (GREATEST z. (R z \<and> z \<le> x) \<or> z = 0)"
  apply(induct x)
   apply(auto intro: Greatest_equality Greatest_equality[symmetric])
  apply(simp add: le_Suc_eq)
  by metis

lemma BMax_rec_eq2:
  "BMax_rec R x = Max ({z. z \<le> x \<and> R z} \<union> {0})"
  apply(induct x)
   apply(auto intro: Max_eqI Max_eqI[symmetric])
  apply(simp add: le_Suc_eq)
  by metis

lemma BMax_rec_eq3:
  "BMax_rec R x = Max (Set.filter (\<lambda>z. R z) {..x} \<union> {0})"
  by (simp add: BMax_rec_eq2 Set.filter_def)

definition
  "rec_max1 f = PR Z (CN rec_ifz [CN f [CN S [Id 3 0], Id 3 2], CN S [Id 3 0], Id 3 1])"

lemma max1_lemma [simp]:
  "rec_eval (rec_max1 f) [x, y] = BMax_rec (\<lambda>u. rec_eval f [u, y] = 0) x"
  by (induct x) (simp_all add: rec_max1_def)

definition
  "rec_max2 f = PR Z (CN rec_ifz [CN f [CN S [Id 4 0], Id 4 2, Id 4 3], CN S [Id 4 0], Id 4 1])"

lemma max2_lemma [simp]:
  "rec_eval (rec_max2 f) [x, y1, y2] = BMax_rec (\<lambda>u. rec_eval f [u, y1, y2] = 0) x"
  by (induct x) (simp_all add: rec_max2_def)

section \<open>Encodings using Cantor's pairing function\<close>

text \<open>
  We use Cantor's pairing function from Nat-Bijection.
  However, we need to prove that the formulation of the
  decoding function there is recursive. For this we first
  prove that we can extract the maximal triangle number
  using @{term prod_decode}.
\<close>

abbreviation Max_triangle_aux where
  "Max_triangle_aux k z \<equiv> fst (prod_decode_aux k z) + snd (prod_decode_aux k z)"

abbreviation Max_triangle where
  "Max_triangle z \<equiv> Max_triangle_aux 0 z"

abbreviation
  "pdec1 z \<equiv> fst (prod_decode z)"

abbreviation
  "pdec2 z \<equiv> snd (prod_decode z)"

abbreviation
  "penc m n \<equiv> prod_encode (m, n)"

lemma fst_prod_decode:
  "pdec1 z = z - triangle (Max_triangle z)"
  by (subst (3) prod_decode_inverse[symmetric])
    (simp add: prod_encode_def prod_decode_def split: prod.split)

lemma snd_prod_decode:
  "pdec2 z = Max_triangle z - pdec1 z"
  by (simp only: prod_decode_def)

lemma le_triangle:
  "m \<le> triangle (n + m)"
  by (induct m) (simp_all)

lemma Max_triangle_triangle_le:
  "triangle (Max_triangle z) \<le> z"
  by (subst (9) prod_decode_inverse[symmetric])
    (simp add: prod_decode_def prod_encode_def split: prod.split)

lemma Max_triangle_le:
  "Max_triangle z \<le> z"
proof -
  have "Max_triangle z \<le> triangle (Max_triangle z)"
    using le_triangle[of _ 0, simplified] by simp
  also have "... \<le> z" by (rule Max_triangle_triangle_le)
  finally show "Max_triangle z \<le> z" .
qed

lemma w_aux:
  "Max_triangle (triangle k + m) = Max_triangle_aux k m"
  by (simp add: prod_decode_def[symmetric] prod_decode_triangle_add)

lemma y_aux: "y \<le> Max_triangle_aux y k"
  apply(induct k arbitrary: y rule: nat_less_induct)
  apply(subst (1 2) prod_decode_aux.simps)
  by(auto dest!:spec mp elim:Suc_leD)

lemma Max_triangle_greatest:
  "Max_triangle z = (GREATEST k. (triangle k \<le> z \<and> k \<le> z) \<or> k = 0)"
  apply(rule Greatest_equality[symmetric])
   apply(rule disjI1)
   apply(rule conjI)
    apply(rule Max_triangle_triangle_le)
   apply(rule Max_triangle_le)
  apply(erule disjE)
   apply(erule conjE)
   apply(subst (asm) (1) le_iff_add)
   apply(erule exE)
   apply(clarify)
   apply(simp only: w_aux)
   apply(rule y_aux)
  apply(simp)
  done

definition
  "rec_triangle = CN rec_quo [CN rec_mult [Id 1 0, S], constn 2]"

definition
  "rec_max_triangle =
       (let cond = CN rec_not [CN rec_le [CN rec_triangle [Id 2 0], Id 2 1]] in
        CN (rec_max1 cond) [Id 1 0, Id 1 0])"

lemma triangle_lemma [simp]:
  "rec_eval rec_triangle [x] = triangle x"
  by (simp add: rec_triangle_def triangle_def)

lemma max_triangle_lemma [simp]:
  "rec_eval rec_max_triangle [x] = Max_triangle x"
  by (simp add: Max_triangle_greatest rec_max_triangle_def Let_def BMax_rec_eq1)

text \<open>Encodings for Products\<close>

definition
  "rec_penc = CN rec_add [CN rec_triangle [CN rec_add [Id 2 0, Id 2 1]], Id 2 0]"

definition
  "rec_pdec1 = CN rec_minus [Id 1 0, CN rec_triangle [CN rec_max_triangle [Id 1 0]]]"

definition
  "rec_pdec2 = CN rec_minus [CN rec_max_triangle [Id 1 0], CN rec_pdec1 [Id 1 0]]"

lemma pdec1_lemma [simp]:
  "rec_eval rec_pdec1 [z] = pdec1 z"
  by (simp add: rec_pdec1_def fst_prod_decode)

lemma pdec2_lemma [simp]:
  "rec_eval rec_pdec2 [z] = pdec2 z"
  by (simp add: rec_pdec2_def snd_prod_decode)

lemma penc_lemma [simp]:
  "rec_eval rec_penc [m, n] = penc m n"
  by (simp add: rec_penc_def prod_encode_def)

text \<open>Encodings of Lists\<close>

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

fun
  ldec :: "nat \<Rightarrow> nat \<Rightarrow> nat"
  where
    "ldec z 0 = (pdec1 z) - 1"
  | "ldec z (Suc n) = ldec (pdec2 z) n"

lemma pdec_zero_simps [simp]:
  "pdec1 0 = 0"
  "pdec2 0 = 0"
  by (simp_all add: prod_decode_def prod_decode_aux.simps)

lemma ldec_zero:
  "ldec 0 n = 0"
  by (induct n) (simp_all add: prod_decode_def prod_decode_aux.simps)

lemma list_encode_inverse:
  "ldec (lenc xs) n = (if n < length xs then xs ! n else 0)"
  by (induct xs arbitrary: n rule: lenc.induct)
    (auto simp add: ldec_zero nth_Cons split: nat.splits)

lemma lenc_length_le:
  "length xs \<le> lenc xs"
  by (induct xs) (simp_all add: prod_encode_def)

text \<open>Membership for the List Encoding\<close>

fun inside :: "nat \<Rightarrow> nat \<Rightarrow> bool" where
  "inside z 0 = (0 < z)"
| "inside z (Suc n) = inside (pdec2 z) n"

definition enclen :: "nat \<Rightarrow> nat" where
  "enclen z = BMax_rec (\<lambda>x. inside z (x - 1)) z"

lemma inside_False [simp]:
  "inside 0 n = False"
  by (induct n) (simp_all)

lemma inside_length [simp]:
  "inside (lenc xs) s = (s < length xs)"
proof(induct s arbitrary: xs)
  case 0
  then show ?case by (cases xs) (simp_all add: prod_encode_def)
next
  case (Suc s)
  then show ?case by (cases xs;auto)
qed

text \<open>Length of Encoded Lists\<close>

lemma enclen_length [simp]:
  "enclen (lenc xs) = length xs"
  unfolding enclen_def
  apply(simp add: BMax_rec_eq1)
  apply(rule Greatest_equality)
   apply(auto simp add: lenc_length_le)
  done

lemma enclen_penc [simp]:
  "enclen (penc (Suc x) (lenc xs)) = Suc (enclen (lenc xs))"
  by (simp only: lenc.simps[symmetric] enclen_length) (simp)

text \<open>Recursive Definitions for List Encodings\<close>

fun
  rec_lenc :: "recf list \<Rightarrow> recf"
  where
    "rec_lenc [] = Z"
  | "rec_lenc (f # fs) = CN rec_penc [CN S [f], rec_lenc fs]"

definition
  "rec_ldec = CN rec_predecessor [CN rec_pdec1 [rec_swap (rec_iter rec_pdec2)]]"

definition
  "rec_inside = CN rec_less [Z, rec_swap (rec_iter rec_pdec2)]"

definition
  "rec_enclen = CN (rec_max1 (CN rec_not [CN rec_inside [Id 2 1, CN rec_predecessor [Id 2 0]]])) [Id 1 0, Id 1 0]"

lemma ldec_iter:
  "ldec z n = pdec1 (Iter pdec2 n z) - 1"
  by (induct n arbitrary: z) (simp | subst Iter_comm)+

lemma inside_iter:
  "inside z n = (0 < Iter pdec2 n z)"
  by (induct n arbitrary: z) (simp | subst Iter_comm)+

lemma lenc_lemma [simp]:
  "rec_eval (rec_lenc fs) xs = lenc (map (\<lambda>f. rec_eval f xs) fs)"
  by (induct fs) (simp_all)

lemma ldec_lemma [simp]:
  "rec_eval rec_ldec [z, n] = ldec z n"
  by (simp add: ldec_iter rec_ldec_def)

lemma inside_lemma [simp]:
  "rec_eval rec_inside [z, n] = (if inside z n then 1 else 0)"
  by (simp add: inside_iter rec_inside_def)

lemma enclen_lemma [simp]:
  "rec_eval rec_enclen [z] = enclen z"
  by (simp add: rec_enclen_def enclen_def)

end


\<^marker>\<open>creator "Alexander Krauss"\<close>
\<^marker>\<open>creator "Kevin Kappelmann"\<close>
\<^marker>\<open>creator "Larry Paulson"\<close>
section \<open>Pairs (\<Sigma>-types)\<close>
theory Pairs
  imports
    Foundation
begin

definition pair :: \<open>set \<Rightarrow> set \<Rightarrow> set\<close>
  where "pair a b \<equiv> {{a}, {a, b}}"

definition fst :: \<open>set \<Rightarrow> set\<close>
  where "fst p \<equiv> THE a. \<exists>b. p = pair a b"

definition snd :: \<open>set \<Rightarrow> set\<close>
  where "snd p \<equiv> THE b. \<exists>a. p = pair a b"

bundle hotg_tuple_syntax
begin
syntax "_tuple" :: \<open>args \<Rightarrow> set\<close> ("\<langle>_\<rangle>")
end
bundle no_hotg_tuple_syntax
begin
no_syntax "_tuple" :: \<open>args \<Rightarrow> set\<close> ("\<langle>_\<rangle>")
end
unbundle hotg_tuple_syntax

translations
  "\<langle>x, y, z\<rangle>" \<rightleftharpoons> "\<langle>x, \<langle>y, z\<rangle>\<rangle>"
  "\<langle>x, y\<rangle>" \<rightleftharpoons> "CONST pair x y"

lemma pair_eq_iff [iff]: "\<langle>a, b\<rangle> = \<langle>c, d\<rangle> \<longleftrightarrow> a = c \<and> b = d"
  unfolding pair_def by (auto dest: iffD1[OF upair_eq_iff])

lemma eq_if_pair_eq_left: "\<langle>a, b\<rangle> = \<langle>c, d\<rangle> \<Longrightarrow> a = c" by simp

lemma eq_if_pair_eq_right: "\<langle>a, b\<rangle> = \<langle>c, d\<rangle> \<Longrightarrow> b = d" by simp

lemma fst_pair_eq [simp]: "fst \<langle>a, b\<rangle> = a"
  by (simp add: fst_def)

lemma snd_pair_eq [simp]: "snd \<langle>a, b\<rangle> = b"
  by (simp add: snd_def)

lemma pair_ne_empty [iff]: "\<langle>a, b\<rangle> \<noteq> {}"
  unfolding pair_def by blast

lemma fst_snd_eq_if_eq_pair [simp]: "p = \<langle>a, b\<rangle> \<Longrightarrow> \<langle>fst p, snd p\<rangle> = p"
  by simp

lemma pair_ne_fst [iff]: "\<langle>a, b\<rangle> \<noteq> a"
  unfolding pair_def using not_mem_if_mem
  by (intro ne_if_ex_mem_not_mem, intro exI[where x="{a}"]) auto

lemma pair_ne_snd [iff]: "\<langle>a, b\<rangle> \<noteq> b"
  unfolding pair_def using not_mem_if_mem
  by (intro ne_if_ex_mem_not_mem, intro exI[where x="{a, b}"]) auto

lemma pair_not_mem_fst [iff]: "\<langle>a, b\<rangle> \<notin> a"
  unfolding pair_def using not_mem_if_mem_if_mem by auto

lemma pair_not_mem_snd [iff]: "\<langle>a, b\<rangle> \<notin> b"
  unfolding pair_def by (auto dest: not_mem_if_mem_if_mem)

subsection \<open>Set-Theoretic Dependent Pair Type\<close>

definition dep_pairs :: \<open>set \<Rightarrow> (set \<Rightarrow> set) \<Rightarrow> set\<close>
  where "dep_pairs A B \<equiv> \<Union>x \<in> A. \<Union>y \<in> B x. {\<langle>x, y\<rangle>}"

bundle hotg_dependent_pairs_syntax
begin
syntax
  "_dep_pairs" :: \<open>[pttrn, set, set \<Rightarrow> set] \<Rightarrow> set\<close> ("\<Sum>_ \<in> _./ _" [0, 0, 100] 51)
end
bundle no_hotg_dependent_pairs_syntax
begin
no_syntax
  "_dep_pairs" :: \<open>[pttrn, set, set \<Rightarrow> set] \<Rightarrow> set\<close> ("\<Sum>_ \<in> _./ _" [0, 0, 100] 51)
end
unbundle hotg_dependent_pairs_syntax

translations
  "\<Sum>x \<in> A. B" \<rightleftharpoons> "CONST dep_pairs A (\<lambda>x. B)"

abbreviation pairs :: \<open>set \<Rightarrow> set \<Rightarrow> set\<close>
  where "pairs A B \<equiv> \<Sum>_ \<in> A. B"

bundle hotg_pairs_syntax begin notation pairs (infixl "\<times>" 80) end
bundle no_hotg_pairs_syntax begin no_notation pairs (infixl "\<times>" 80) end

unbundle hotg_pairs_syntax

lemma mem_dep_pairs_iff [iff]: "\<langle>a, b\<rangle> \<in> (\<Sum>x \<in> A. B x) \<longleftrightarrow> a \<in> A \<and> b \<in> B a"
  unfolding dep_pairs_def by blast

lemma mem_if_mem_dep_pairs_fst: "\<langle>a, b\<rangle> \<in> (\<Sum>x \<in> A. B x) \<Longrightarrow> a \<in> A" by simp
lemma mem_if_mem_dep_pairs_snd: "\<langle>a, b\<rangle> \<in> (\<Sum>x \<in> A. B x) \<Longrightarrow> b \<in> B a" by simp

lemma mem_dep_pairsE [elim!]:
  assumes "p \<in> \<Sum>x \<in> A. B x"
  obtains x y where "x \<in> A" "y \<in> B x" "p = \<langle>x, y\<rangle>"
  using assms unfolding dep_pairs_def by blast

lemma dep_pairs_cong [cong]:
  "\<lbrakk>A = A'; \<And>x. x \<in> A' \<Longrightarrow> B x = B' x\<rbrakk> \<Longrightarrow> (\<Sum>x \<in> A. B x) = (\<Sum>x \<in> A'. B' x)"
  unfolding dep_pairs_def by auto

lemma fst_mem_if_mem_dep_pairs: "p \<in> \<Sum>x \<in> A. B x \<Longrightarrow> fst p \<in> A"
  by auto

lemma snd_mem_if_mem_dep_pairs: "p \<in> \<Sum>x \<in> A. B x \<Longrightarrow> snd p \<in> B (fst p)"
  by auto

lemma fst_snd_eq_pair_if_mem_dep_pairs [simp]:
  "p \<in> \<Sum>x \<in> P. B x \<Longrightarrow> \<langle>fst p, snd p\<rangle> = p"
  by auto

lemma dep_pairs_empty_dom_eq_empty [simp]: "\<Sum>x \<in> {}. B x = {}"
  by auto

lemma dep_pairs_empty_eq_empty [simp]: "\<Sum>x \<in> A. {} = {}"
  by auto

lemma pairs_empty_iff [iff]: "A \<times> B = {} \<longleftrightarrow> A = {} \<or> B = {}"
  by (auto intro!: eqI)

lemma pairs_singleton_eq [simp]: "{a} \<times> {b} = {\<langle>a, b\<rangle>}"
  by (rule eqI) auto

lemma dep_pairs_subset_pairs: "\<Sum>x \<in> A. B x \<subseteq> A \<times> (\<Union>x \<in> A. B x)"
  by auto

text \<open>Splitting quantifiers:\<close>

lemma bex_dep_pairs_iff_bex_bex [iff]:
  "(\<exists>z \<in> \<Sum>x \<in> A. B x. P z) \<longleftrightarrow> (\<exists>x \<in> A. \<exists>y \<in> B x. P \<langle>x, y\<rangle>)"
  by blast

lemma ball_dep_pairs_iff_ball_ball [iff]:
  "(\<forall>z \<in> \<Sum>x \<in> A. B x. P z) \<longleftrightarrow> (\<forall>x \<in> A. \<forall>y \<in> B x. P \<langle>x,y\<rangle>)"
  by blast

subsection \<open>Monotonicity\<close>

lemma mono_dep_pairs:
  assumes "A \<subseteq> A'"
  and "\<And>x. x \<in> A \<Longrightarrow> B x \<subseteq> B' x"
  shows "(\<Sum>x \<in> A. B x) \<subseteq> (\<Sum>x \<in> A'. B' x)"
  using assms by auto

lemma mono_dep_pairs_dom:
  assumes "A \<subseteq> A'"
  shows "(\<Sum>x \<in> A. B x) \<subseteq> (\<Sum>x \<in> A'. B x)"
  using assms by (intro mono_dep_pairs) auto

lemma mono_dep_pairs_rng:
  assumes "\<And>x. x \<in> A \<Longrightarrow> B x \<subseteq> B' x"
  shows "(\<Sum>x \<in> A. B x) \<subseteq> (\<Sum>x \<in> A. (B' x))"
  using assms by (intro mono_dep_pairs) auto

lemma mono_pairs_dom: "mono (\<lambda>A. A \<times> B)"
  by (intro monoI) auto

lemma mono_pairs_rng: "mono (\<lambda>B. A \<times> B)"
  by (intro monoI) auto

subsection \<open>Functions on Dependent Pairs\<close>

definition "uncurry f p \<equiv> f (fst p) (snd p)"

bundle hotg_uncurry_syntax
begin
syntax "_uncurry_args"  :: "args => pttrn" ("\<langle>_\<rangle>")
end
bundle no_hotg_uncurry_syntax
begin
no_syntax "_uncurry_args"  :: "args => pttrn" ("\<langle>_\<rangle>")
end
unbundle hotg_uncurry_syntax

translations
  "\<lambda>\<langle>x, y, zs\<rangle>. b" \<rightleftharpoons> "CONST uncurry (\<lambda>x \<langle>y, zs\<rangle>. b)"
  "\<lambda>\<langle>x, y\<rangle>. b" \<rightleftharpoons> "CONST uncurry (\<lambda>x y. b)"

lemma uncurry [simp]: "uncurry f \<langle>a, b\<rangle> = f a b"
  unfolding uncurry_def by simp

definition "swap p = \<langle>snd p, fst p\<rangle>"

lemma swap_pair_eq [simp]: "swap \<langle>x, y\<rangle> = \<langle>y, x\<rangle>" unfolding swap_def by simp

end


(*<*)
theory Fundata imports Main begin
(*>*)
datatype (dead 'a,'i) bigtree = Tip | Br 'a "'i \<Rightarrow> ('a,'i)bigtree"

text\<open>\noindent
Parameter \<^typ>\<open>'a\<close> is the type of values stored in
the \<^term>\<open>Br\<close>anches of the tree, whereas \<^typ>\<open>'i\<close> is the index
type over which the tree branches. If \<^typ>\<open>'i\<close> is instantiated to
\<^typ>\<open>bool\<close>, the result is a binary tree; if it is instantiated to
\<^typ>\<open>nat\<close>, we have an infinitely branching tree because each node
has as many subtrees as there are natural numbers. How can we possibly
write down such a tree? Using functional notation! For example, the term
@{term[display]"Br (0::nat) (\<lambda>i. Br i (\<lambda>n. Tip))"}
of type \<^typ>\<open>(nat,nat)bigtree\<close> is the tree whose
root is labeled with 0 and whose $i$th subtree is labeled with $i$ and
has merely \<^term>\<open>Tip\<close>s as further subtrees.

Function \<^term>\<open>map_bt\<close> applies a function to all labels in a \<open>bigtree\<close>:
\<close>

primrec map_bt :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a,'i)bigtree \<Rightarrow> ('b,'i)bigtree"
where
"map_bt f Tip      = Tip" |
"map_bt f (Br a F) = Br (f a) (\<lambda>i. map_bt f (F i))"

text\<open>\noindent This is a valid \isacommand{primrec} definition because the
recursive calls of \<^term>\<open>map_bt\<close> involve only subtrees of
\<^term>\<open>F\<close>, which is itself a subterm of the left-hand side. Thus termination
is assured.  The seasoned functional programmer might try expressing
\<^term>\<open>%i. map_bt f (F i)\<close> as \<^term>\<open>map_bt f o F\<close>, which Isabelle
however will reject.  Applying \<^term>\<open>map_bt\<close> to only one of its arguments
makes the termination proof less obvious.

The following lemma has a simple proof by induction:\<close>

lemma "map_bt (g o f) T = map_bt g (map_bt f T)"
apply(induct_tac T, simp_all)
done
(*<*)lemma "map_bt (g o f) T = map_bt g (map_bt f T)"
apply(induct_tac T, rename_tac[2] F)(*>*)
txt\<open>\noindent
Because of the function type, the proof state after induction looks unusual.
Notice the quantified induction hypothesis:
@{subgoals[display,indent=0]}
\<close>
(*<*)
oops
end
(*>*)


header {* General utility lemmas *}
theory Utils imports Main
begin

text {*
This is a potpourri of various lemmas not specific to our project. Some of them could very well be included in the default Isabelle library.
*}

text {*
Lemmas about the @{text single_valued} predicate.
*}

lemma single_valued_empty[simp]:"single_valued {}"
by (rule single_valuedI) auto

lemma single_valued_insert:
  assumes "single_valued rel"
      and "\<And> x y . \<lbrakk>(x,y) \<in> rel; x=a\<rbrakk> \<Longrightarrow> y = b"
  shows "single_valued (insert (a,b) rel)"
using assms
by (auto intro:single_valuedI dest:single_valuedD)

text {*
Lemmas about @{text ran}, the range of a finite map.
*}

lemma ran_upd: "ran (m (k \<mapsto> v)) \<subseteq> ran m \<union> {v}"
unfolding ran_def by auto

lemma ran_map_of: "ran (map_of xs) \<subseteq> snd ` set xs"
 by (induct xs)(auto simp del:fun_upd_apply dest: ran_upd[THEN subsetD])

lemma ran_concat: "ran (m1 ++ m2) \<subseteq> ran m1 \<union> ran m2"
unfolding ran_def
by auto

lemma ran_upds:
  assumes eq_length: "length ks = length vs"
  shows "ran (map_upds m ks vs) \<subseteq> ran m \<union> set vs"
proof-
  have "ran (map_upds m ks vs) \<subseteq> ran (m++map_of (rev (zip ks vs)))"
    unfolding map_upds_def by simp
  also have "\<dots> \<subseteq> ran m \<union> ran (map_of (rev (zip ks vs)))" by (rule ran_concat)
  also have "\<dots> \<subseteq> ran m \<union> snd ` set (rev (zip ks vs))"
    by (intro Un_mono[of "ran m" "ran m"] subset_refl ran_map_of)
  also have "\<dots>\<subseteq> ran m \<union> set vs"
    by (auto intro:Un_mono[of "ran m" "ran m"] subset_refl simp del:set_map simp add:set_map[THEN sym] map_snd_zip[OF eq_length])
  finally show ?thesis .
qed

lemma ran_upd_mem[simp]: "v \<in> ran (m (k \<mapsto> v))"
unfolding ran_def by auto

text {*
Lemmas about @{text map}, @{text zip} and @{text fst}/@{text snd}
*}

lemma map_fst_zip: "length xs = length ys \<Longrightarrow> map fst (zip xs ys) = xs"
apply (induct xs ys rule:list_induct2) by auto

lemma map_snd_zip: "length xs = length ys \<Longrightarrow> map snd (zip xs ys) = ys"
apply (induct xs ys rule:list_induct2) by auto

end