(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_bin_nat_plus_comm
imports "../../Test_Base"
begin

datatype Bin = One | ZeroAnd "Bin" | OneAnd "Bin"

fun s :: "Bin => Bin" where
"s (One) = ZeroAnd One"
| "s (ZeroAnd xs) = OneAnd xs"
| "s (OneAnd ys) = ZeroAnd (s ys)"

fun plus :: "Bin => Bin => Bin" where
"plus (One) y = s y"
| "plus (ZeroAnd z) (One) = s (ZeroAnd z)"
| "plus (ZeroAnd z) (ZeroAnd ys) = ZeroAnd (plus z ys)"
| "plus (ZeroAnd z) (OneAnd xs) = OneAnd (plus z xs)"
| "plus (OneAnd x2) (One) = s (OneAnd x2)"
| "plus (OneAnd x2) (ZeroAnd zs) = OneAnd (plus x2 zs)"
| "plus (OneAnd x2) (OneAnd ys2) = ZeroAnd (s (plus x2 ys2))"

theorem property0 :
  "((plus x y) = (plus y x))"
  oops

end


theory Basics_SetsWithComprehension_E1
imports "$HETS_LIB/Isabelle/MainHCPairs"
uses "$HETS_LIB/Isabelle/prelude"
begin

ML "Header.initialize
    [\"set_comprehension\", \"abbrev_of_set_comprehension\",
     \"function_image\", \"emptySet_empty\", \"allSet_contains_all\",
     \"def_of_isIn\", \"def_of_subset\", \"def_of_union\",
     \"def_of_bigunion\", \"def_of_intersection\",
     \"def_of_difference\", \"def_of_disjoint\", \"def_of_productset\",
     \"emptySet_union_right_unit\", \"function_image_structure\"]"

typedecl ('a1) Set

consts
XLBrace__XRBrace :: "('S => bool) => 'S => bool"
X__XBslashXBslash__X :: "('S => bool) * ('S => bool) => 'S => bool"
X__Xx__X :: "('S => bool) * ('T => bool) => 'S * 'T => bool"
X__disjoint__X :: "('S => bool) => ('S => bool) => bool" ("(_/ disjoint/ _)" [44,44] 42)
X__intersection__X :: "('S => bool) * ('S => bool) => 'S => bool"
X__isIn__X :: "'S => ('S => bool) => bool" ("(_/ isIn/ _)" [44,44] 42)
X__subset__X :: "('S => bool) => ('S => bool) => bool" ("(_/ subset/ _)" [44,44] 42)
X__union__X :: "('S => bool) * ('S => bool) => 'S => bool"
X_allSet :: "'S => bool" ("allSet/'(_')" [3] 999)
X_emptySet :: "'S => bool" ("emptySet/'(_')" [3] 999)
X_image :: "('S => 'T) * ('S => bool) => 'T => bool"
bigunion :: "(('S => bool) => bool) => 'S => bool"
setFromProperty :: "('S => bool) => 'S => bool"

axioms
set_comprehension [rule_format] : "ALL s. XLBrace__XRBrace s = s"

abbrev_of_set_comprehension [rule_format] :
"setFromProperty = XLBrace__XRBrace"

function_image [rule_format] :
"ALL XX. ALL f. X_image (f, XX) = (% x. EX y. y isIn XX & f y = x)"

emptySet_empty [rule_format] : "ALL x. ~ x isIn X_emptySet"

allSet_contains_all [rule_format] : "ALL x. x isIn X_allSet"

def_of_isIn [rule_format] : "ALL s. ALL x. (x isIn s) = s x"

def_of_subset [rule_format] :
"ALL s. ALL s'. (s subset s') = (ALL x. x isIn s --> x isIn s')"

def_of_union [rule_format] :
"ALL s.
 ALL s'.
 ALL x. (x isIn X__union__X (s, s')) = (x isIn s | x isIn s')"

def_of_bigunion [rule_format] :
"ALL XXXX.
 ALL x. (x isIn bigunion XXXX) = (EX XX. XX isIn XXXX & x isIn XX)"

def_of_intersection [rule_format] :
"ALL s.
 ALL s'.
 ALL x.
 (x isIn X__intersection__X (s, s')) = (x isIn s & x isIn s')"

def_of_difference [rule_format] :
"ALL s.
 ALL s'.
 ALL x.
 (x isIn X__XBslashXBslash__X (s, s')) = (x isIn s & ~ x isIn s')"

def_of_disjoint [rule_format] :
"ALL s.
 ALL s'.
 (s disjoint s') = (X__intersection__X (s, s') = X_emptySet)"

def_of_productset [rule_format] :
"ALL s.
 ALL t.
 ALL x.
 ALL y. ((x, y) isIn X__Xx__X (s, t)) = (x isIn s & y isIn t)"

declare emptySet_empty [simp]
declare allSet_contains_all [simp]
declare def_of_isIn [simp]

theorem emptySet_union_right_unit :
"ALL a. X__union__X (a, X_emptySet) = a"
  by (rule allI, rule set_ext,
  (subst mem_def)+,
    subst def_of_isIn [symmetric],
    subst def_of_union,
    subst def_of_isIn [symmetric],
    subst not_not [symmetric], subst emptySet_empty, simp)

ML "Header.record \"emptySet_union_right_unit\""

theorem function_image_structure :
"ALL a.
 ALL f. ALL x. (x isIn X_image (f, a)) = (EX y. y isIn a & f y = x)"
unfolding function_image def_of_isIn by simp

ML "Header.record \"function_image_structure\""

end


theory sort_BSortPermutes
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin

datatype 'a list = Nil2 | Cons2 "'a" "'a list"

datatype Nat = Z | S "Nat"

fun sort2 :: "int => int => int list" where
"sort2 x y =
   (if x <= y then Cons2 x (Cons2 y (Nil2)) else
      Cons2 y (Cons2 x (Nil2)))"

function evens :: "'a list => 'a list"
         and odds :: "'a list => 'a list" where
"evens (Nil2) = Nil2"
| "evens (Cons2 y xs) = Cons2 y (odds xs)"
| "odds (Nil2) = Nil2"
| "odds (Cons2 y xs) = evens xs"
by pat_completeness auto

fun count :: "int => int list => Nat" where
"count x (Nil2) = Z"
| "count x (Cons2 z xs) =
     (if x = z then S (count x xs) else count x xs)"

fun append :: "'a list => 'a list => 'a list" where
"append (Nil2) y = y"
| "append (Cons2 z xs) y = Cons2 z (append xs y)"

fun pairs :: "int list => int list => int list" where
"pairs (Nil2) y = y"
| "pairs (Cons2 z x2) (Nil2) = Cons2 z x2"
| "pairs (Cons2 z x2) (Cons2 x3 x4) =
     append (sort2 z x3) (pairs x2 x4)"

fun stitch :: "int list => int list => int list" where
"stitch (Nil2) y = y"
| "stitch (Cons2 z xs) y = Cons2 z (pairs xs y)"

fun bmerge :: "int list => int list => int list" where
"bmerge (Nil2) y = Nil2"
| "bmerge (Cons2 z x2) (Nil2) = Cons2 z x2"
| "bmerge (Cons2 z (Nil2)) (Cons2 x3 (Nil2)) = sort2 z x3"
| "bmerge (Cons2 z (Nil2)) (Cons2 x3 (Cons2 x5 x6)) =
     stitch
       (bmerge (evens (Cons2 z (Nil2))) (evens (Cons2 x3 (Cons2 x5 x6))))
       (bmerge (odds (Cons2 z (Nil2))) (odds (Cons2 x3 (Cons2 x5 x6))))"
| "bmerge (Cons2 z (Cons2 x7 x8)) (Cons2 x3 x4) =
     stitch
       (bmerge (evens (Cons2 z (Cons2 x7 x8))) (evens (Cons2 x3 x4)))
       (bmerge (odds (Cons2 z (Cons2 x7 x8))) (odds (Cons2 x3 x4)))"

fun bsort :: "int list => int list" where
"bsort (Nil2) = Nil2"
| "bsort (Cons2 y (Nil2)) = Cons2 y (Nil2)"
| "bsort (Cons2 y (Cons2 x2 x3)) =
     bmerge
       (bsort (evens (Cons2 y (Cons2 x2 x3))))
       (bsort (odds (Cons2 y (Cons2 x2 x3))))"

(*hipster sort2
          evens
          odds
          count
          append
          pairs
          stitch
          bmerge
          bsort *)

theorem x0 :
  "!! (x :: int) (y :: int list) . (count x (bsort y)) = (count x y)"
  by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)

end


theory list_return_1
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin

datatype 'a list = Nil2 | Cons2 "'a" "'a list"

fun return :: "'a => 'a list" where
"return x = Cons2 x (Nil2)"

fun append :: "'a list => 'a list => 'a list" where
"append (Nil2) y = y"
| "append (Cons2 z xs) y = Cons2 z (append xs y)"

fun bind :: "'a list => ('a => 'b list) => 'b list" where
"bind (Nil2) y = Nil2"
| "bind (Cons2 z xs) y = append (y z) (bind xs y)"

(*hipster return append bind *)

hipster append bind
lemma lemma_a [thy_expl]: "append x2 Nil2 = x2"
by (hipster_induct_schemes append.simps bind.simps)

lemma lemma_aa [thy_expl]: "append (append x1 y1) z1 = append x1 (append y1 z1)"
by (hipster_induct_schemes append.simps bind.simps)

lemma lemma_ab [thy_expl]: "append (bind x1 y1) (bind z1 y1) = bind (append x1 z1) y1"
by (hipster_induct_schemes append.simps bind.simps)

theorem x0 :
  "!! (x :: 'a) (f :: ('a => 'b list)) . (bind (return x) f) = (f x)"
  by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)

end


theory MuHO1_Semantics_Tarski
  imports MuHO1_Syntax
begin

section "Denotational Semantics"

context ctx
begin

fun
  sem_tm0 :: "(name \<Rightarrow> 'a) \<Rightarrow> (name \<Rightarrow> ('a \<Rightarrow> 'a)) \<Rightarrow> tm0 \<Rightarrow> 'a"
and
  sem_tm1 :: "(name \<Rightarrow> 'a) \<Rightarrow> (name \<Rightarrow> ('a \<Rightarrow> 'a)) \<Rightarrow> tm1 \<Rightarrow> ('a \<Rightarrow> 'a)"
where
"sem_tm0 \<eta>0 \<eta>1 (Var0 x) = (\<eta>0 x)" |
"sem_tm0 \<eta>0 \<eta>1 (Func0 f) = (abs_func0  f)" |
"sem_tm0 \<eta>0 \<eta>1 (App \<phi> \<psi>) = (sem_tm1 \<eta>0 \<eta>1 \<phi>) (sem_tm0 \<eta>0 \<eta>1 \<psi>)" |
"sem_tm0 \<eta>0 \<eta>1 (Mu0 X \<phi>) = \<Sqinter>{d. sem_tm0 (\<eta>0(X := d)) \<eta>1 \<phi> \<le> d}" |

"sem_tm1 \<eta>0 \<eta>1 (Var1 x) = (\<eta>1 x)" |
"sem_tm1 \<eta>0 \<eta>1 (Func1 f) = (abs_func1 f)" |
"sem_tm1 \<eta>0 \<eta>1 (Lam x \<phi>) = (\<lambda>d. sem_tm0 (\<eta>0(x := d)) \<eta>1 \<phi>)" |
"sem_tm1 \<eta>0 \<eta>1 (Mu1 X \<phi>) = \<Sqinter>{d. mono d \<and> sem_tm1 \<eta>0 (\<eta>1(X := d)) \<phi> \<le> d}"

lemma sem_mono:
"\<And>\<eta>0 \<eta>1 \<eta>0' \<eta>1'.
  \<lbrakk> \<forall>z. \<eta>0 z \<le> \<eta>0' z;
    \<forall>f z. (\<eta>1 f) z \<le> (\<eta>1' f) z;
    \<forall>f. mono (\<eta>1 f);
    \<forall>f. mono (\<eta>1' f) \<rbrakk>
  \<Longrightarrow> sem_tm0 \<eta>0 \<eta>1 \<phi> \<le> sem_tm0 \<eta>0' \<eta>1' \<phi>"

"\<And>\<eta>0 \<eta>1 \<eta>0' \<eta>1'.
  \<lbrakk> \<forall>z. \<eta>0 z \<le> \<eta>0' z;
    \<forall>f z. (\<eta>1 f) z \<le> (\<eta>1' f) z;
    \<forall>f. mono (\<eta>1 f);
    \<forall>f. mono (\<eta>1' f) \<rbrakk>
  \<Longrightarrow> sem_tm1 \<eta>0 \<eta>1 \<phi>' \<le> sem_tm1 \<eta>0' \<eta>1' \<phi>'
      \<and> mono (sem_tm1 \<eta>0 \<eta>1 \<phi>') \<and> mono (sem_tm1 \<eta>0' \<eta>1' \<phi>')"
proof (induction \<phi> and \<phi>')
  case (Var0 x)
  then show ?case
    by simp
next
  case (Func0 f)
  then show ?case
    by simp
next
  case (App \<psi> \<phi>)
  have 0: "sem_tm0 \<eta>0 \<eta>1 \<phi> \<le> sem_tm0 \<eta>0' \<eta>1' \<phi>"
    using App.IH(2) App.prems by simp

  have 1: "sem_tm1 \<eta>0 \<eta>1 \<psi> \<le> sem_tm1 \<eta>0' \<eta>1' \<psi>"
    using App.IH(1) App.prems by simp

  from 0 have "(sem_tm1 \<eta>0 \<eta>1 \<psi>) (sem_tm0 \<eta>0 \<eta>1 \<phi>)
                  \<le> (sem_tm1 \<eta>0 \<eta>1 \<psi>) (sem_tm0 \<eta>0' \<eta>1' \<phi>)"
    using App.IH(1) App.prems(3) monoD by blast
  with 1 have "(sem_tm1 \<eta>0 \<eta>1 \<psi>) (sem_tm0 \<eta>0 \<eta>1 \<phi>)
                  \<le> (sem_tm1 \<eta>0' \<eta>1' \<psi>) (sem_tm0 \<eta>0' \<eta>1' \<phi>)"
    by (metis dual_order.trans le_fun_def)
  then show ?case by simp
next
  case (Mu0 x \<phi>)
  then have "sem_tm0 (\<eta>0'(x := d)) \<eta>1' \<phi> \<le> d \<longrightarrow> sem_tm0 (\<eta>0(x := d)) \<eta>1 \<phi> \<le> d" for d
    by (smt (verit, best) order_eq_iff dual_order.trans fun_upd_apply)
  then have "(\<Sqinter>{d. sem_tm0 (\<eta>0(x := d)) \<eta>1 \<phi> \<le> d})
                \<le> (\<Sqinter>{d. sem_tm0 (\<eta>0'(x := d)) \<eta>1' \<phi> \<le> d})"
    by (simp add: Collect_mono Inf_superset_mono)
  then show ?case
    by auto
next
  case (Var1 x)
  then show ?case
    by (simp add: le_fun_def monoI)
next
  case (Func1 f)
  then show ?case
    by (simp add: abs_func1_mono monoI)
next
  case (Lam x \<phi>)
   then have 1: "mono (sem_tm1 \<eta>0 \<eta>1 (Lam x \<phi>))
                    \<and> mono (sem_tm1 \<eta>0' \<eta>1' (Lam x \<phi>))"
      by (simp add: mono_def)

   from Lam have 2: "(\<lambda>d'. sem_tm0 (\<eta>0(x := d')) \<eta>1 \<phi>) d
         \<le> (\<lambda>d'. sem_tm0 (\<eta>0'(x := d')) \<eta>1' \<phi>) d" for d
      by simp

   from 1 2 show ?case by (simp add: le_funI)
next
  case (Mu1 x1a \<phi>)
  then have "mono d \<and> sem_tm1 \<eta>0' (\<eta>1'(x1a := d)) \<phi> \<le> d
              \<longrightarrow> sem_tm1 \<eta>0 (\<eta>1(x1a := d)) \<phi> \<le> d" for d
    by (smt (verit, ccfv_SIG) order_eq_iff dual_order.trans fun_upd_apply monoD)
  then have "(\<Sqinter>{d. mono d \<and> sem_tm1 \<eta>0 (\<eta>1(x1a := d)) \<phi> \<le> d})
                \<le> (\<Sqinter>{d. mono d \<and> sem_tm1 \<eta>0' (\<eta>1'(x1a := d)) \<phi> \<le> d})"
    by (metis (no_types, lifting) Inf_mono mem_Collect_eq order_refl)
  then have 0: "sem_tm1 \<eta>0 \<eta>1 (Mu1 x1a \<phi>) \<le> sem_tm1 \<eta>0' \<eta>1' (Mu1 x1a \<phi>)"
    by simp

  have subset_mono_mono_inter: "S \<subseteq> {d::'a \<Rightarrow>'a. mono d} \<Longrightarrow> mono (\<Sqinter>S)" for S
    by (smt (verit) Ball_Collect INF_superset_mono Inf_apply dual_order.refl monoD monoI)

  have "{d. mono d \<and> sem_tm1 \<eta>0 (\<eta>1(x1a := d)) \<phi> \<le> d} \<subseteq> {d::'a \<Rightarrow> 'a. mono d}"
    by blast
  then have "mono (\<Sqinter>{d. mono d \<and> sem_tm1 \<eta>0 (\<eta>1(x1a := d)) \<phi> \<le> d})"
    by (simp add: subset_mono_mono_inter)
  then have a: "z \<le> z' \<longrightarrow> (sem_tm1 \<eta>0 \<eta>1 (Mu1 x1a \<phi>)) z
                  \<le> (sem_tm1 \<eta>0 \<eta>1 (Mu1 x1a \<phi>)) z'" for z z'
    using monoD by fastforce

  have "{d. mono d \<and> sem_tm1 \<eta>0' (\<eta>1'(x1a := d)) \<phi> \<le> d} \<subseteq> {d::'a \<Rightarrow> 'a. mono d}"
    by blast
  then have "mono (\<Sqinter>{d. mono d \<and> sem_tm1 \<eta>0' (\<eta>1'(x1a := d)) \<phi> \<le> d})"
    by (simp add: subset_mono_mono_inter)
  then have b: "z \<le> z' \<longrightarrow> (sem_tm1 \<eta>0' \<eta>1' (Mu1 x1a \<phi>)) z
                   \<le> (sem_tm1 \<eta>0' \<eta>1' (Mu1 x1a \<phi>)) z'" for z z'
    using monoD by fastforce

  from a b have 1: "mono (sem_tm1 \<eta>0 \<eta>1 (Mu1 x1a \<phi>))
                    \<and> mono (sem_tm1 \<eta>0' \<eta>1' (Mu1 x1a \<phi>))"
    by (simp add: mono_def)

  from 0 1 show ?case
    by blast
qed

lemma sem_tm_fun_upd_mono: "\<lbrakk> \<forall>f. mono (\<eta>1 f); z \<le> z'; mono z; mono z' \<rbrakk>
  \<Longrightarrow> sem_tm1 \<eta>0 (\<eta>1(x := z)) \<phi> \<le> sem_tm1 \<eta>0 (\<eta>1(x := z')) \<phi>"
  by (smt (verit) dual_order.eq_iff fun_upd_apply le_funE sem_mono(2))

end end


theory T35
imports Main
begin
lemma "(
(\<forall> x::nat. \<forall> y::nat. meet(x, y) = meet(y, x)) &
(\<forall> x::nat. \<forall> y::nat. join(x, y) = join(y, x)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, meet(y, z)) = meet(meet(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(x, join(y, z)) = join(join(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. meet(x, join(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. join(x, meet(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, join(y, z)) = join(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(join(x, y), z) = join(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, over(join(mult(x, y), z), y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(y, undr(x, join(mult(x, y), z))) = y) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(over(x, y), y), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(y, undr(y, x)), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. undr(meet(x, y), z) = join(undr(x, z), undr(y, z))) &
(\<forall> x::nat. \<forall> y::nat. invo(join(x, y)) = meet(invo(x), invo(y))) &
(\<forall> x::nat. \<forall> y::nat. invo(meet(x, y)) = join(invo(x), invo(y))) &
(\<forall> x::nat. invo(invo(x)) = x)
) \<longrightarrow>
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(meet(x, y), z) = meet(mult(x, z), mult(y, z)))
"
nitpick[card nat=4,timeout=86400]
oops
end


section \<open>Binary Relations\<close>
theory Bin_Rels
imports Sets
begin

subsection \<open>Basic Setup\<close>

text \<open>No specific domain and range information; compare section below.\<close>

definition [typedef]: "Bin_Rel \<equiv> type (\<lambda>R. \<forall>p \<in> R. p = \<langle>fst p, snd p\<rangle>)"

lemma Bin_RelI [intro]:
  "(\<And>p. p \<in> R \<Longrightarrow> \<langle>fst p, snd p\<rangle> = p) \<Longrightarrow> R : Bin_Rel"
  by unfold_types auto

lemma Bin_RelI' [intro]:
  "(\<And>p. p \<in> R \<Longrightarrow> \<exists>x y. \<langle>x, y\<rangle> = p) \<Longrightarrow> R : Bin_Rel"
  using fst_def snd_def by (intro Bin_RelI) fastforce

lemma Bin_Rel_if_subset_pairs [intro]:
  "R \<subseteq> A \<times> B \<Longrightarrow> R : Bin_Rel"
  by unfold_types auto

lemma Bin_Rel_fst_snd_eq [simp]:
  "\<lbrakk>R : Bin_Rel; p \<in> R\<rbrakk> \<Longrightarrow> \<langle>fst p, snd p\<rangle> = p"
  by unfold_types auto

lemma Bin_Rel_if_subset_dep_pairs: "R \<subseteq> \<Sum>x \<in> A. (B x) \<Longrightarrow> R : Bin_Rel"
  by auto

lemma Bin_Rel_if_Subset_dep_pairs [derive]:
  "R : Subset(\<Sum>x \<in> A. (B x)) \<Longrightarrow> R : Bin_Rel"
  using Bin_Rel_if_subset_dep_pairs by auto

subsection \<open>Domain\<close>

definition "dom R \<equiv> {fst p | p \<in> R}"

lemma fst_mem_dom_if_mem [intro]: "r \<in> R \<Longrightarrow> fst r \<in> dom R"
  unfolding dom_def by auto

lemma mem_domI [intro]: "\<exists>y. \<langle>x, y\<rangle> \<in> R \<Longrightarrow> x \<in> dom R"
  unfolding dom_def by auto

lemma Bin_Rel_ex_snd_mem_if_mem_dom [elim]:
  assumes "x \<in> dom R" and "R : Bin_Rel"
  obtains y where "\<langle>x, y\<rangle> \<in> R"
proof -
  assume h: "(\<And>y. \<langle>x, y\<rangle> \<in> R \<Longrightarrow> thesis)"
  from \<open>x \<in> dom R\<close> obtain p where "p \<in> R" and "x = fst p"
    unfolding dom_def by auto
  with \<open>R : Bin_Rel\<close> have "\<langle>x, snd p\<rangle> \<in> R" by auto
  then show thesis by (rule h)
qed

lemma Bin_Rel_mem_dom_iff: "R : Bin_Rel \<Longrightarrow> x \<in> dom R \<longleftrightarrow> (\<exists>y. \<langle>x, y\<rangle> \<in> R)"
  by auto

lemma not_mem_domE:
  assumes "x \<notin> dom R"
  obtains "\<And>y. \<langle>x, y\<rangle> \<notin> R"
  using assms unfolding dom_def by force

lemma dom_singleton_pair_eq [iff]: "dom {\<langle>x, y\<rangle>} = {x}"
  unfolding dom_def by auto

subsection \<open>Range\<close>

definition "rng R \<equiv> {snd p | p \<in> R}"

lemma snd_mem_rng_if_mem [intro]:
  "r \<in> R \<Longrightarrow> snd r \<in> rng R"
  unfolding rng_def by auto

lemma mem_rngI [intro]: "\<langle>x, y\<rangle> \<in> R \<Longrightarrow> y \<in> rng R"
  unfolding rng_def by auto

lemma Bin_Rel_ex_fst_mem_if_mem_rng [elim]:
  assumes "y \<in> rng R" and "R : Bin_Rel"
  shows "\<exists>x. \<langle>x, y\<rangle> \<in> R"
proof -
  from \<open>y \<in> rng R\<close> obtain p where "p \<in> R" and "y = snd p"
    unfolding rng_def by auto
  with \<open>R : Bin_Rel\<close> have "\<langle>fst p, y\<rangle> \<in> R" by auto
  then show ?thesis by blast
qed

lemma Bin_Rel_subset_pairs_dom_rng:
  assumes "R : Bin_Rel"
  shows "R \<subseteq> dom R \<times> rng R"
proof
  fix x assume "x \<in> R"
  from assms have x_eq: "x = \<langle>fst x, snd x\<rangle>" by auto
  with \<open>x \<in> R\<close> show "x \<in> dom R \<times> rng R"
    by (subst x_eq, intro iffD2[OF mem_dep_pairs_iff]) auto
qed

lemma Bin_Rel_mem_rng_iff:
  "R : Bin_Rel \<Longrightarrow> y \<in> rng R \<longleftrightarrow> (\<exists>x. \<langle>x, y\<rangle> \<in> R)"
  by auto

subsection \<open>Field\<close>

definition "fld R \<equiv> dom R \<union> rng R"

lemma mem_fld_fst: "\<langle>a, b\<rangle> \<in> R \<Longrightarrow> a \<in> fld R"
  unfolding fld_def by auto

lemma mem_fld_snd: "\<langle>a, b\<rangle> \<in> R \<Longrightarrow> b \<in> fld R"
  unfolding fld_def by auto

subsection \<open>Basic equalities\<close>

lemma dom_empty_eq [iff]: "dom {} = {}"
  unfolding dom_def by auto

lemma rng_empty_eq [iff]: "rng {} = {}"
  unfolding rng_def by auto

lemma dom_union_eq [simp]: "dom (\<Union>X) = \<Union>{dom x | x \<in> X}"
  unfolding dom_def by auto

lemma dom_bin_bin_union_eq [iff]: "dom (R \<union> S) = dom R \<union> dom S"
  unfolding dom_def by auto

lemma dom_collect_eq [iff]: "dom {\<langle>f x, g x\<rangle> | x \<in> A} = {f x | x \<in> A}"
  unfolding dom_def by auto

lemma rng_collect_eq [iff]: "rng {\<langle>f x, g x\<rangle> | x \<in> A} = {g x | x \<in> A}"
  unfolding rng_def by auto

lemma dom_insert_eq [simp]: "dom (cons \<langle>x, y\<rangle> A) = cons x (dom A)"
  unfolding dom_def by (auto simp add: repl_insert_eq)

lemma rng_insert_eq [simp]: "rng (cons \<langle>x, y\<rangle> A) = cons y (rng A)"
  unfolding rng_def by (auto simp add: repl_insert_eq)

subsection \<open>Relations With Specified Domain and Range\<close>

definition [typedef]: "Relation A B \<equiv> Subset (A \<times> B)"

lemma Relation_covariant_dom: "R : Relation A B \<Longrightarrow> A \<subseteq> A' \<Longrightarrow> R : Relation A' B"
  unfolding Relation_def using Subset_covariant by auto

lemma Relation_covariant_rng: "R : Relation A B \<Longrightarrow> B \<subseteq> B' \<Longrightarrow> R : Relation A B'"
  unfolding Relation_def using Subset_covariant by auto

lemma RelationI [derive]:
  "R : Subset (A \<times> B) \<Longrightarrow> R : Relation A B"
  unfolding Relation_def by assumption

lemma Bin_Rel_if_Relation [derive]:
  "R : Relation A B \<Longrightarrow> R : Bin_Rel"
  unfolding Relation_def using Bin_Rel_if_subset_dep_pairs by auto

(*Note the issue with standard typechecking blindly using soft type rules:
  loops occur if the following is declared [derive].*)
lemma Relation_if_Bin_Rel:
  "R : Bin_Rel \<Longrightarrow> R : Relation (dom R) (rng R)"
  by (intro RelationI SubsetI Bin_Rel_subset_pairs_dom_rng)

lemma dom_type [type]: "dom : Relation A B \<Rightarrow> Subset A"
  unfolding dom_def by unfold_types auto

lemma rng_type [type]: "rng : Relation A B \<Rightarrow> Subset B"
  unfolding rng_def by unfold_types auto

text \<open>Set model of \<^term>\<open>Relation A B\<close>.\<close>

definition "relations A B = powerset (A \<times> B)"

lemma Relation_if_mem_relations [iff]: "R \<in> relations A B \<longleftrightarrow> R : Relation A B"
  unfolding relations_def by unfold_types

text \<open>Set relation from HOL relation.\<close>

definition "relation_graph D R \<equiv> {p \<in> D \<times> D | R (fst p) (snd p)}"

lemma pair_mem_relation_graph_iff [iff]:
  "\<langle>x, y\<rangle> \<in> relation_graph D R \<longleftrightarrow> x \<in> D \<and> y \<in> D \<and> R x y"
  unfolding relation_graph_def by auto

subsection \<open>Converse relations\<close>

definition converse :: "set \<Rightarrow> set"
  where "converse R \<equiv> {\<langle>snd p, fst p\<rangle> | p \<in> R}"

lemma converse_prod [iff]: "converse (A \<times> B) = B \<times> A"
  unfolding converse_def by (rule eq_if_subset_if_subset) auto

lemma converse_empty [iff]: "converse {} = {}"
  unfolding converse_def by (rule eq_if_subset_if_subset) auto

lemma dom_converse_eq_rng: "dom (converse R) = rng R"
  unfolding dom_def rng_def converse_def by auto

lemma Bin_Rel_pair_mem_converse_iff_mem [iff]:
  "R : Bin_Rel \<Longrightarrow> \<langle>a, b\<rangle> \<in> converse R \<longleftrightarrow> \<langle>b, a\<rangle> \<in> R"
  unfolding converse_def by auto

lemma Bin_Rel_mem_converseE [elim]:
  assumes "p \<in> converse R" "R : Bin_Rel"
  obtains x y where "p = \<langle>y, x\<rangle>" and "\<langle>x, y\<rangle> \<in> R"
  using assms unfolding converse_def by auto

lemma converse_type [type]: "converse : Relation A B \<Rightarrow> Relation B A"
  by unfold_types auto

lemma converse_converse_eq_self: "R : Relation A B \<Longrightarrow> converse (converse R) = R"
  (*TODO: this should be provable without using the dest rule by the type checker*)
  unfolding converse_def by (auto dest: Bin_Rel_if_Relation)

subsection \<open>Diagonal of a set\<close>

definition "diag A \<equiv> {\<langle>a, a\<rangle> | a \<in> A}"

lemma diag_type [type]: "diag : (A : Set) \<Rightarrow> Relation A A"
  unfolding diag_def by (auto intro!: RelationI SubsetI)

lemma
  pair_mem_diag_if_mem: "a \<in> A \<Longrightarrow> \<langle>a, a\<rangle> \<in> diag A" and
  fst_mem_if_mem_diag: "u \<in> diag A \<Longrightarrow> fst u \<in> A" and
  snd_mem_if_mem_diag: "u \<in> diag A \<Longrightarrow> snd u \<in> A" and
  fst_eq_snd_if_mem_diag: "u \<in> diag A \<Longrightarrow> fst u = snd u"
  unfolding diag_def by auto

subsection \<open>Composition\<close>

definition "rel_comp S R \<equiv>
  {u \<in> dom R \<times> rng S | \<exists>z. \<langle>fst u, z\<rangle> \<in> R \<and> \<langle>z, snd u\<rangle> \<in> S}"

bundle isa_set_rel_comp_syntax begin notation rel_comp (infixr "\<circ>\<^sub>r" 60) end
bundle no_isa_set_rel_comp_syntax begin no_notation rel_comp (infixr "\<circ>\<^sub>r" 60) end
unbundle isa_set_rel_comp_syntax

lemma rel_comp_type [type]:
  "rel_comp : (S : Relation B C) \<Rightarrow> (R : Relation A B) \<Rightarrow> Relation A C"
  (*TODO: this should work by just using the type-checker*)
  unfolding rel_comp_def by (unfold_types) auto

lemma rel_comp_Relation_if_Bin_Rel [derive]:
  assumes "S : Bin_Rel" "R : Bin_Rel"
  and "dom S : Subset (rng R)"
  shows "S \<circ>\<^sub>r R : Relation (dom R) (rng S)"
proof -
  have "S : Relation (rng R) (rng S)"
    by (rule Relation_covariant_dom[OF Relation_if_Bin_Rel]) discharge_types
  then show ?thesis by (auto dest: Relation_if_Bin_Rel)
qed

lemma mem_rel_comp_if_mem_if_mem [intro]:
  "\<langle>x, y\<rangle> \<in> R \<Longrightarrow> \<langle>y, z\<rangle> \<in> S \<Longrightarrow> \<langle>x, z\<rangle> \<in> S \<circ>\<^sub>r R"
  unfolding rel_comp_def by auto

lemma mem_rel_compE [elim]:
  assumes "p \<in> S \<circ>\<^sub>r R"
  obtains z where "\<langle>fst p, z\<rangle> \<in> R" and "\<langle>z, snd p\<rangle> \<in> S"
  using assms unfolding rel_comp_def by auto

subsection \<open>Predicates on relations\<close>

definition "reflexive D R \<equiv> \<forall>x \<in> D. \<langle>x, x\<rangle> \<in> R"

definition "irreflexive D R \<equiv> \<forall>x \<in> D. \<langle>x, x\<rangle> \<notin> R"

definition "symmetric D R \<equiv> \<forall>x \<in> D. \<forall>y \<in> D. \<langle>x, y\<rangle> \<in> R \<longrightarrow> \<langle>y, x\<rangle> \<in> R"

definition "antisymmetric D R \<equiv>
  \<forall>x \<in> D. \<forall>y \<in> D. \<langle>x, y\<rangle> \<in> R \<and> \<langle>y, x\<rangle> \<in> R \<longrightarrow> x = y"

definition "transitive D R \<equiv>
  \<forall>x \<in> D. \<forall>y \<in> D. \<forall>z \<in> D. \<langle>x, y\<rangle> \<in> R \<and> \<langle>y, z\<rangle> \<in> R \<longrightarrow> \<langle>x, z\<rangle> \<in> R"

definition "total D R \<equiv> \<forall>x \<in> D. \<forall>y \<in> D. \<langle>x, y\<rangle> \<in> R \<or> x = y \<or> \<langle>y, x\<rangle> \<in> R"

definition "partially_ordered D R \<equiv>
  reflexive D R \<and> antisymmetric D R \<and> transitive D R"

definition "linearly_ordered D R \<equiv> total D R \<and> partially_ordered D R"

subsection \<open>Well-founded and well-ordered relations\<close>

definition "well_founded D R \<equiv>
  \<forall>X. X \<subseteq> D \<and> X \<noteq> {} \<longrightarrow> (\<exists>a \<in> X. \<forall>x \<in> X. \<langle>x, a\<rangle> \<notin> R)"

lemma well_foundedI:
  "(\<And>X. \<lbrakk>X \<subseteq> D; X \<noteq> {}\<rbrakk> \<Longrightarrow> \<exists>a \<in> X. \<forall>x \<in> X. \<langle>x, a\<rangle> \<notin> R) \<Longrightarrow> well_founded D R"
  unfolding well_founded_def by auto

definition "well_ordered D R \<equiv> linearly_ordered D R \<and> well_founded D R"

end


theory GraphAdjList
  imports GraphAdjMap_Specs
begin

section \<open>List Implementation for Sets\<close>

type_synonym 'a lset = "'a list"

definition lset_empty :: "'a lset" ("\<emptyset>\<^sub>l") where [simp]: "lset_empty = []"

fun lset_delete :: "'a \<Rightarrow> 'a lset \<Rightarrow> 'a lset" where
  "lset_delete a as = filter (\<lambda>x. a \<noteq> x) as"

fun lset_insert :: "'a \<Rightarrow> 'a lset \<Rightarrow> 'a lset" where
  "lset_insert a as = List.insert a as"

fun lset_isin :: "'a lset \<Rightarrow> 'a \<Rightarrow> bool" where
  "lset_isin as a = (filter (\<lambda>x. a = x) as \<noteq> [])"

fun lset_set :: "'a lset \<Rightarrow> 'a set" where
  "lset_set as = set as"

fun lset_invar :: "'a lset \<Rightarrow> bool" where
  "lset_invar as = distinct as"

fun lset_inter :: "'a lset \<Rightarrow> 'a lset \<Rightarrow> 'a lset" where
  "lset_inter as bs = filter (\<lambda>a. lset_isin bs a) as"

fun lset_diff :: "'a lset \<Rightarrow> 'a lset \<Rightarrow> 'a lset" where
  "lset_diff as bs = filter (\<lambda>a. \<not> lset_isin bs a) as"

fun lset_union :: "'a lset \<Rightarrow> 'a lset \<Rightarrow> 'a lset" where
  "lset_union as bs = as @ lset_diff bs as"

lemma lset_empty: "lset_set lset_empty = {}"
  by auto

lemma lset_isin: "lset_invar s \<Longrightarrow> lset_isin s x = (x \<in> lset_set s)"
  by (induction s) auto

lemma lset_insert: "lset_invar s \<Longrightarrow> lset_set (lset_insert x s) = lset_set s \<union> {x}"
  by auto

lemma lset_delete: "lset_invar s \<Longrightarrow> lset_set (lset_delete x s) = lset_set s - {x}"
  by (induction s) auto

lemma lset_invar_empty: "lset_invar lset_empty"
  by auto

lemma lset_invar_insert: "lset_invar s \<Longrightarrow> lset_invar (lset_insert x s)"
  by auto

lemma lset_invar_delete: "lset_invar s \<Longrightarrow> lset_invar (lset_delete x s)"
  by auto

lemma lset_inter:
  "lset_invar s1 \<Longrightarrow> lset_invar s2 \<Longrightarrow> lset_set (lset_inter s1 s2) = lset_set s1 \<inter> lset_set s2"
proof (induction s1 arbitrary: s2)
  case (Cons a as)
  then show ?case
    using lset_isin by (cases "lset_isin s2 a") fastforce+
qed auto

lemma lset_diff:
  "lset_invar s1 \<Longrightarrow> lset_invar s2 \<Longrightarrow> lset_set (lset_diff s1 s2) = lset_set s1 - lset_set s2"
proof (induction s1 arbitrary: s2)
  case (Cons a as)
  then show ?case
    using lset_isin by (cases "lset_isin s2 a") fastforce+
qed auto

lemma lset_union:
  "lset_invar s1 \<Longrightarrow> lset_invar s2 \<Longrightarrow> lset_set (lset_union s1 s2) = lset_set s1 \<union> lset_set s2"
  using lset_diff by auto

lemma lset_invar_inter: "lset_invar s1 \<Longrightarrow> lset_invar s2 \<Longrightarrow> lset_invar (lset_inter s1 s2)"
  by auto

lemma lset_invar_diff: "lset_invar s1 \<Longrightarrow> lset_invar s2 \<Longrightarrow> lset_invar (lset_diff s1 s2)"
  by auto

lemma lset_invar_union: "lset_invar s1 \<Longrightarrow> lset_invar s2 \<Longrightarrow> lset_invar (lset_union s1 s2)"
  using lset_diff lset_invar_diff by auto

lemmas lset_specs = lset_empty lset_isin lset_insert lset_delete lset_invar_empty lset_invar_insert
  lset_invar_delete

interpretation lset: Set lset_empty lset_insert lset_delete lset_isin lset_set lset_invar
  using lset_specs by unfold_locales

lemmas lset2_specs = lset_union lset_inter lset_diff lset_invar_union lset_invar_inter
  lset_invar_diff

interpretation lset2: Set2 lset_empty lset_delete lset_isin lset_set lset_invar lset_insert
  lset_union lset_inter lset_diff
  using lset2_specs by unfold_locales

section \<open>List implementation for Maps\<close>

type_synonym ('a,'b) lmap = "('a \<times> 'b) list"

definition lmap_empty :: "('a,'b) lmap" where [simp]: "lmap_empty = []"

fun lmap_delete :: "'a \<Rightarrow> ('a,'b) lmap \<Rightarrow> ('a,'b) lmap" where
  "lmap_delete a M = filter (\<lambda>(x,y). a \<noteq> x) M"

fun lmap_update :: "'a \<Rightarrow> 'b \<Rightarrow> ('a,'b) lmap \<Rightarrow> ('a,'b) lmap" where
  "lmap_update a b M = (a,b)#lmap_delete a M"

fun lmap_lookup :: "('a,'b) lmap \<Rightarrow> 'a \<Rightarrow> 'b option" where
  "lmap_lookup [] a = None"
| "lmap_lookup ((x,y)#M) a = (if a = x then Some y else lmap_lookup M a)"

fun lmap_invar :: "('a,'b) lmap \<Rightarrow> bool" where
  "lmap_invar M = distinct (map fst M)"

lemma lmap_empty: "lmap_lookup lmap_empty = (\<lambda>_. None)"
  unfolding lmap_empty_def by auto

lemma lmap_delete: "lmap_invar M \<Longrightarrow> lmap_lookup (lmap_delete a M) = (lmap_lookup M) (a := None)"
  by (induction M) auto

lemma lmap_update:
  "lmap_invar M \<Longrightarrow> lmap_lookup (lmap_update a b M) = (lmap_lookup M) (a := Some b)"
  by (auto simp add: lmap_delete simp del: lmap_delete.simps)

lemma lmap_invar_empty: "lmap_invar lmap_empty"
  by auto

lemma lmap_invar_update: "lmap_invar M \<Longrightarrow> lmap_invar (lmap_update a b M)"
  by (induction M) auto

lemma lmap_invar_delete: "lmap_invar M \<Longrightarrow> lmap_invar (lmap_delete a M)"
  by (induction M) auto

lemmas lmap_specs = lmap_empty lmap_update lmap_delete lmap_invar_empty lmap_invar_update
  lmap_invar_delete

interpretation list_map: Map lmap_empty lmap_update lmap_delete lmap_lookup lmap_invar
  using lmap_specs by unfold_locales

section \<open>Graph Implementation with Adjacency-Lists\<close>

interpretation ugraph_adj_list: ugraph_adj_map_by_linorder
  lmap_empty lmap_update lmap_delete lmap_lookup lmap_invar
  lset_empty lset_insert lset_delete lset_isin lset_set lset_invar lset_union lset_inter lset_diff
  by unfold_locales

lemma isin_lmap_lookup:
  assumes "lmap_invar G"
  shows "lmap_lookup G u = Some Nu \<longleftrightarrow> (u,Nu) \<in> set G"
  using assms
proof (induction G rule: pair_list.induct)
  case (2 v Nv G)
  thus ?case
    by (cases "u = v") force+
qed auto

lemma isin_lmap_neighborhood:
  assumes "ugraph_adj_list.ugraph_adj_map_invar G" "(u,Nu) \<in> set G"
  shows "ugraph_adj_list.neighborhood G u = Nu"
  unfolding ugraph_adj_list.neighborhood_def
  using assms by (auto simp add: iffD2[OF isin_lmap_lookup])

lemma lmap_unique_assoc:
  assumes "lmap_invar G" "(u,Nu) \<in> set G" "(v,Nv) \<in> set G" "u = v"
  shows "(u,Nu) = (v,Nv)"
proof
  have "lmap_lookup G u = Some Nu" "lmap_lookup G u = Some Nv"
    using assms by (auto intro!: iffD2[OF isin_lmap_lookup])
  thus "u = v \<and> Nu = Nv"
    using assms by auto
qed

fun choose_edge where
  "choose_edge [] = None"
| "choose_edge ((u,[])#G) = choose_edge G"
| "choose_edge ((u,v#Nu)#G) = Some (ugraph_adj_list.rep (uEdge u v))"

lemma choose_edge:
  assumes "ugraph_adj_list.ugraph_adj_map_invar G" "ugraph_adj_list.uedges G \<noteq> {}"
  shows "the (choose_edge G) \<in> ugraph_adj_list.uedges G"
  using assms
  unfolding ugraph_adj_list.uedges_def ugraph_adj_list.edges_def ugraph_adj_list.neighborhood_def
proof (induction G rule: pair_list.induct)
  case 1
  then show ?case
    by auto
next
  case (2 u Nu G)
  thus ?case
  proof (cases Nu)
    case Nil
    then show ?thesis
      using 2
      sorry
  next
    case (Cons v Nu)
    then show ?thesis
      by force
  qed
qed

end


(*
 * Copyright Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: BSD-2-Clause
 *)

(* Author: Jeremy Dawson and Gerwin Klein, NICTA *)

section \<open>Splitting words into lists\<close>

theory Rsplit
  imports "HOL-Library.Word" More_Word Bits_Int
begin

definition word_rsplit :: "'a::len word \<Rightarrow> 'b::len word list"
  where "word_rsplit w = map word_of_int (bin_rsplit LENGTH('b) (LENGTH('a), uint w))"

lemma word_rsplit_no:
  "(word_rsplit (numeral bin :: 'b::len word) :: 'a word list) =
    map word_of_int (bin_rsplit (LENGTH('a::len))
      (LENGTH('b), take_bit (LENGTH('b)) (numeral bin)))"
  by (simp add: word_rsplit_def of_nat_take_bit)

lemmas word_rsplit_no_cl [simp] = word_rsplit_no
  [unfolded bin_rsplitl_def bin_rsplit_l [symmetric]]

text \<open>
  This odd result arises from the fact that the statement of the
  result implies that the decoded words are of the same type,
  and therefore of the same length, as the original word.\<close>

lemma word_rsplit_same: "word_rsplit w = [w]"
  apply (simp add: word_rsplit_def bin_rsplit_all)
  apply transfer
  apply simp
  done

lemma word_rsplit_empty_iff_size: "word_rsplit w = [] \<longleftrightarrow> size w = 0"
  by (simp add: word_rsplit_def bin_rsplit_def word_size bin_rsplit_aux_simp_alt Let_def
      split: prod.split)

lemma test_bit_rsplit:
  "sw = word_rsplit w \<Longrightarrow> m < size (hd sw) \<Longrightarrow>
    k < length sw \<Longrightarrow> bit (rev sw ! k) m = bit w (k * size (hd sw) + m)"
  for sw :: "'a::len word list"
  apply (unfold word_rsplit_def word_test_bit_def)
  apply (rule trans)
   apply (rule_tac f = "\<lambda>x. bit x m" in arg_cong)
   apply (rule nth_map [symmetric])
   apply simp
  apply (rule bin_nth_rsplit)
     apply simp_all
  apply (simp add : word_size rev_map)
  apply (rule trans)
   defer
   apply (rule map_ident [THEN fun_cong])
  apply (rule refl [THEN map_cong])
  apply simp
  using bin_rsplit_size_sign take_bit_int_eq_self_iff by blast

lemma test_bit_rsplit_alt:
  \<open>bit ((word_rsplit w  :: 'b::len word list) ! i) m \<longleftrightarrow>
    bit w ((length (word_rsplit w :: 'b::len word list) - Suc i) * size (hd (word_rsplit w :: 'b::len word list)) + m)\<close>
  if \<open>i < length (word_rsplit w :: 'b::len word list)\<close> \<open>m < size (hd (word_rsplit w :: 'b::len word list))\<close> \<open>0 < length (word_rsplit w :: 'b::len word list)\<close>
  for w :: \<open>'a::len word\<close>
  apply (rule trans)
   apply (rule test_bit_cong)
   apply (rule rev_nth [of _ \<open>rev (word_rsplit w)\<close>, simplified rev_rev_ident])
  apply simp
   apply (rule that(1))
  apply simp
  apply (rule test_bit_rsplit)
    apply (rule refl)
  apply (rule asm_rl)
   apply (rule that(2))
  apply (rule diff_Suc_less)
  apply (rule that(3))
  done

lemma word_rsplit_len_indep [OF refl refl refl refl]:
  "[u,v] = p \<Longrightarrow> [su,sv] = q \<Longrightarrow> word_rsplit u = su \<Longrightarrow>
    word_rsplit v = sv \<Longrightarrow> length su = length sv"
  by (auto simp: word_rsplit_def bin_rsplit_len_indep)

lemma length_word_rsplit_size:
  "n = LENGTH('a::len) \<Longrightarrow>
    length (word_rsplit w :: 'a word list) \<le> m \<longleftrightarrow> size w \<le> m * n"
  by (auto simp: word_rsplit_def word_size bin_rsplit_len_le)

lemmas length_word_rsplit_lt_size =
  length_word_rsplit_size [unfolded Not_eq_iff linorder_not_less [symmetric]]

lemma length_word_rsplit_exp_size:
  "n = LENGTH('a::len) \<Longrightarrow>
    length (word_rsplit w :: 'a word list) = (size w + n - 1) div n"
  by (auto simp: word_rsplit_def word_size bin_rsplit_len)

lemma length_word_rsplit_even_size:
  "n = LENGTH('a::len) \<Longrightarrow> size w = m * n \<Longrightarrow>
    length (word_rsplit w :: 'a word list) = m"
  by (cases \<open>LENGTH('a)\<close>) (simp_all add: length_word_rsplit_exp_size div_nat_eqI)

lemmas length_word_rsplit_exp_size' = refl [THEN length_word_rsplit_exp_size]

\<comment> \<open>alternative proof of \<open>word_rcat_rsplit\<close>\<close>
lemmas tdle = times_div_less_eq_dividend
lemmas dtle = xtrans(4) [OF tdle mult.commute]

lemma word_rcat_rsplit: "word_rcat (word_rsplit w) = w"
  apply (rule word_eqI)
  apply (clarsimp simp: test_bit_rcat word_size)
  apply (subst refl [THEN test_bit_rsplit])
    apply (simp_all add: word_size
      refl [THEN length_word_rsplit_size [simplified not_less [symmetric], simplified]])
   apply safe
   apply (erule xtrans(7), rule dtle)+
  done

lemma size_word_rsplit_rcat_size:
  "word_rcat ws = frcw \<Longrightarrow> size frcw = length ws * LENGTH('a)
    \<Longrightarrow> length (word_rsplit frcw::'a word list) = length ws"
  for ws :: "'a::len word list" and frcw :: "'b::len word"
  by (cases \<open>LENGTH('a)\<close>) (simp_all add: word_size length_word_rsplit_exp_size' div_nat_eqI)

lemma msrevs:
  "0 < n \<Longrightarrow> (k * n + m) div n = m div n + k"
  "(k * n + m) mod n = m mod n"
  for n :: nat
  by (auto simp: add.commute)

lemma word_rsplit_rcat_size [OF refl]:
  "word_rcat ws = frcw \<Longrightarrow>
    size frcw = length ws * LENGTH('a) \<Longrightarrow> word_rsplit frcw = ws"
  for ws :: "'a::len word list"
  apply (frule size_word_rsplit_rcat_size, assumption)
  apply (clarsimp simp add : word_size)
  apply (rule nth_equalityI, assumption)
  apply clarsimp
  apply (rule word_eqI [rule_format])
  apply (rule trans)
   apply (rule test_bit_rsplit_alt)
     apply (clarsimp simp: word_size)+
  apply (rule trans)
   apply (rule test_bit_rcat [OF refl refl])
  apply (simp add: word_size)
  apply (subst rev_nth)
   apply arith
  apply (simp add: le0 [THEN [2] xtrans(7), THEN diff_Suc_less])
  apply safe
  apply (simp add: diff_mult_distrib)
   apply (cases "size ws")
    apply simp_all
  done

lemma word_rsplit_upt:
  "\<lbrakk> size x = LENGTH('a :: len) * n; n \<noteq> 0 \<rbrakk>
    \<Longrightarrow> word_rsplit x = map (\<lambda>i. ucast (drop_bit (i * LENGTH('a)) x) :: 'a word) (rev [0 ..< n])"
  apply (subgoal_tac "length (word_rsplit x :: 'a word list) = n")
   apply (rule nth_equalityI, simp)
   apply (intro allI word_eqI impI)
   apply (simp add: test_bit_rsplit_alt word_size)
   apply (simp add: nth_ucast bit_simps rev_nth field_simps)
  apply (simp add: length_word_rsplit_exp_size)
  apply transfer
  apply (metis (no_types, lifting) Nat.add_diff_assoc Suc_leI add_0_left diff_Suc_less div_less len_gt_0 msrevs(1) mult.commute)
  done

end


(*  Title:      HOL/MicroJava/DFA/Listn.thy
    Author:     Tobias Nipkow
    Copyright   2000 TUM
*)

section \<open>Fixed Length Lists\<close>

theory Listn
imports Err
begin

definition list :: "nat \<Rightarrow> 'a set \<Rightarrow> 'a list set" where
"list n A == {xs. length xs = n & set xs <= A}"

definition le :: "'a ord \<Rightarrow> ('a list)ord" where
"le r == list_all2 (%x y. x <=_r y)"

abbreviation
  lesublist_syntax :: "'a list \<Rightarrow> 'a ord \<Rightarrow> 'a list \<Rightarrow> bool"
       ("(_ /<=[_] _)" [50, 0, 51] 50)
  where "x <=[r] y == x <=_(le r) y"

abbreviation
  lesssublist_syntax :: "'a list \<Rightarrow> 'a ord \<Rightarrow> 'a list \<Rightarrow> bool"
       ("(_ /<[_] _)" [50, 0, 51] 50)
  where "x <[r] y == x <_(le r) y"

definition map2 :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> 'c list" where
"map2 f == (%xs ys. map (case_prod f) (zip xs ys))"

abbreviation
  plussublist_syntax :: "'a list \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'b list \<Rightarrow> 'c list"
       ("(_ /+[_] _)" [65, 0, 66] 65)
  where "x +[f] y == x +_(map2 f) y"

primrec coalesce :: "'a err list \<Rightarrow> 'a list err" where
  "coalesce [] = OK[]"
| "coalesce (ex#exs) = Err.sup (op #) ex (coalesce exs)"

definition sl :: "nat \<Rightarrow> 'a sl \<Rightarrow> 'a list sl" where
"sl n == %(A,r,f). (list n A, le r, map2 f)"

definition sup :: "('a \<Rightarrow> 'b \<Rightarrow> 'c err) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> 'c list err" where
"sup f == %xs ys. if size xs = size ys then coalesce(xs +[f] ys) else Err"

definition upto_esl :: "nat \<Rightarrow> 'a esl \<Rightarrow> 'a list esl" where
"upto_esl m == %(A,r,f). (\<Union>{list n A |n. n <= m}, le r, sup f)"

lemmas [simp] = set_update_subsetI

lemma unfold_lesub_list:
  "xs <=[r] ys == Listn.le r xs ys"
  by (simp add: lesub_def)

lemma Nil_le_conv [iff]:
  "([] <=[r] ys) = (ys = [])"
apply (unfold lesub_def Listn.le_def)
apply simp
done

lemma Cons_notle_Nil [iff]:
  "~ x#xs <=[r] []"
apply (unfold lesub_def Listn.le_def)
apply simp
done

lemma Cons_le_Cons [iff]:
  "x#xs <=[r] y#ys = (x <=_r y & xs <=[r] ys)"
apply (unfold lesub_def Listn.le_def)
apply simp
done

lemma Cons_less_Conss [simp]:
  "order r \<Longrightarrow>
  x#xs <_(Listn.le r) y#ys =
  (x <_r y & xs <=[r] ys  |  x = y & xs <_(Listn.le r) ys)"
apply (unfold lesssub_def)
apply blast
done

lemma list_update_le_cong:
  "\<lbrakk> i<size xs; xs <=[r] ys; x <=_r y \<rbrakk> \<Longrightarrow> xs[i:=x] <=[r] ys[i:=y]"
apply (unfold unfold_lesub_list)
apply (unfold Listn.le_def)
apply (simp add: list_all2_conv_all_nth nth_list_update)
done

lemma le_listD:
  "\<lbrakk> xs <=[r] ys; p < size xs \<rbrakk> \<Longrightarrow> xs!p <=_r ys!p"
apply (unfold Listn.le_def lesub_def)
apply (simp add: list_all2_conv_all_nth)
done

lemma le_list_refl:
  "!x. x <=_r x \<Longrightarrow> xs <=[r] xs"
apply (unfold unfold_lesub_list)
apply (simp add: Listn.le_def list_all2_conv_all_nth)
done

lemma le_list_trans:
  "\<lbrakk> order r; xs <=[r] ys; ys <=[r] zs \<rbrakk> \<Longrightarrow> xs <=[r] zs"
apply (unfold unfold_lesub_list)
apply (simp add: Listn.le_def list_all2_conv_all_nth)
apply clarify
apply simp
apply (blast intro: order_trans)
done

lemma le_list_antisym:
  "\<lbrakk> order r; xs <=[r] ys; ys <=[r] xs \<rbrakk> \<Longrightarrow> xs = ys"
apply (unfold unfold_lesub_list)
apply (simp add: Listn.le_def list_all2_conv_all_nth)
apply (rule nth_equalityI)
 apply blast
apply clarify
apply simp
apply (blast intro: order_antisym)
done

lemma order_listI [simp, intro!]:
  "order r \<Longrightarrow> order(Listn.le r)"
apply (subst Semilat.order_def)
apply (blast intro: le_list_refl le_list_trans le_list_antisym
             dest: order_refl)
done

lemma lesub_list_impl_same_size [simp]:
  "xs <=[r] ys \<Longrightarrow> size ys = size xs"
apply (unfold Listn.le_def lesub_def)
apply (simp add: list_all2_conv_all_nth)
done

lemma lesssub_list_impl_same_size:
  "xs <_(Listn.le r) ys \<Longrightarrow> size ys = size xs"
apply (unfold lesssub_def)
apply auto
done

lemma le_list_appendI:
  "\<And>b c d. a <=[r] b \<Longrightarrow> c <=[r] d \<Longrightarrow> a@c <=[r] b@d"
apply (induct a)
 apply simp
apply (case_tac b)
apply auto
done

lemma le_listI:
  "length a = length b \<Longrightarrow> (\<And>n. n < length a \<Longrightarrow> a!n <=_r b!n) \<Longrightarrow> a <=[r] b"
  apply (unfold lesub_def Listn.le_def)
  apply (simp add: list_all2_conv_all_nth)
  done

lemma listI:
  "\<lbrakk> length xs = n; set xs <= A \<rbrakk> \<Longrightarrow> xs : list n A"
apply (unfold list_def)
apply blast
done

lemma listE_length [simp]:
   "xs : list n A \<Longrightarrow> length xs = n"
apply (unfold list_def)
apply blast
done

lemma less_lengthI:
  "\<lbrakk> xs : list n A; p < n \<rbrakk> \<Longrightarrow> p < length xs"
  by simp

lemma listE_set [simp]:
  "xs : list n A \<Longrightarrow> set xs <= A"
apply (unfold list_def)
apply blast
done

lemma list_0 [simp]:
  "list 0 A = {[]}"
apply (unfold list_def)
apply auto
done

lemma in_list_Suc_iff:
  "(xs : list (Suc n) A) = (\<exists>y\<in> A. \<exists>ys\<in> list n A. xs = y#ys)"
apply (unfold list_def)
apply (case_tac "xs")
apply auto
done

lemma Cons_in_list_Suc [iff]:
  "(x#xs : list (Suc n) A) = (x\<in> A & xs : list n A)"
apply (simp add: in_list_Suc_iff)
done

lemma list_not_empty:
  "\<exists>a. a\<in> A \<Longrightarrow> \<exists>xs. xs : list n A"
apply (induct "n")
 apply simp
apply (simp add: in_list_Suc_iff)
apply blast
done

lemma nth_in [rule_format, simp]:
  "!i n. length xs = n \<longrightarrow> set xs <= A \<longrightarrow> i < n \<longrightarrow> (xs!i) : A"
apply (induct "xs")
 apply simp
apply (simp add: nth_Cons split: nat.split)
done

lemma listE_nth_in:
  "\<lbrakk> xs : list n A; i < n \<rbrakk> \<Longrightarrow> (xs!i) : A"
  by auto

lemma listn_Cons_Suc [elim!]:
  "l#xs \<in> list n A \<Longrightarrow> (\<And>n'. n = Suc n' \<Longrightarrow> l \<in> A \<Longrightarrow> xs \<in> list n' A \<Longrightarrow> P) \<Longrightarrow> P"
  by (cases n) auto

lemma listn_appendE [elim!]:
  "a@b \<in> list n A \<Longrightarrow> (\<And>n1 n2. n=n1+n2 \<Longrightarrow> a \<in> list n1 A \<Longrightarrow> b \<in> list n2 A \<Longrightarrow> P) \<Longrightarrow> P"
proof -
  have "\<And>n. a@b \<in> list n A \<Longrightarrow> \<exists>n1 n2. n=n1+n2 \<and> a \<in> list n1 A \<and> b \<in> list n2 A"
    (is "\<And>n. ?list a n \<Longrightarrow> \<exists>n1 n2. ?P a n n1 n2")
  proof (induct a)
    fix n assume "?list [] n"
    hence "?P [] n 0 n" by simp
    thus "\<exists>n1 n2. ?P [] n n1 n2" by fast
  next
    fix n l ls
    assume "?list (l#ls) n"
    then obtain n' where n: "n = Suc n'" "l \<in> A" and list_n': "ls@b \<in> list n' A" by fastforce
    assume "\<And>n. ls @ b \<in> list n A \<Longrightarrow> \<exists>n1 n2. n = n1 + n2 \<and> ls \<in> list n1 A \<and> b \<in> list n2 A"
    hence "\<exists>n1 n2. n' = n1 + n2 \<and> ls \<in> list n1 A \<and> b \<in> list n2 A" by this (rule list_n')
    then obtain n1 n2 where "n' = n1 + n2" "ls \<in> list n1 A" "b \<in> list n2 A" by fast
    with n have "?P (l#ls) n (n1+1) n2" by simp
    thus "\<exists>n1 n2. ?P (l#ls) n n1 n2" by fastforce
  qed
  moreover
  assume "a@b \<in> list n A" "\<And>n1 n2. n=n1+n2 \<Longrightarrow> a \<in> list n1 A \<Longrightarrow> b \<in> list n2 A \<Longrightarrow> P"
  ultimately
  show ?thesis by blast
qed

lemma listt_update_in_list [simp, intro!]:
  "\<lbrakk> xs : list n A; x\<in> A \<rbrakk> \<Longrightarrow> xs[i := x] : list n A"
apply (unfold list_def)
apply simp
done

lemma plus_list_Nil [simp]:
  "[] +[f] xs = []"
apply (unfold plussub_def map2_def)
apply simp
done

lemma plus_list_Cons [simp]:
  "(x#xs) +[f] ys = (case ys of [] \<Rightarrow> [] | y#ys \<Rightarrow> (x +_f y)#(xs +[f] ys))"
  by (simp add: plussub_def map2_def split: list.split)

lemma length_plus_list [rule_format, simp]:
  "!ys. length(xs +[f] ys) = min(length xs) (length ys)"
apply (induct xs)
 apply simp
apply clarify
apply (simp (no_asm_simp) split: list.split)
done

lemma nth_plus_list [rule_format, simp]:
  "!xs ys i. length xs = n \<longrightarrow> length ys = n \<longrightarrow> i<n \<longrightarrow>
  (xs +[f] ys)!i = (xs!i) +_f (ys!i)"
apply (induct n)
 apply simp
apply clarify
apply (case_tac xs)
 apply simp
apply (force simp add: nth_Cons split: list.split nat.split)
done

lemma (in Semilat) plus_list_ub1 [rule_format]:
 "\<lbrakk> set xs <= A; set ys <= A; size xs = size ys \<rbrakk>
  \<Longrightarrow> xs <=[r] xs +[f] ys"
apply (unfold unfold_lesub_list)
apply (simp add: Listn.le_def list_all2_conv_all_nth)
done

lemma (in Semilat) plus_list_ub2:
 "\<lbrakk>set xs <= A; set ys <= A; size xs = size ys \<rbrakk>
  \<Longrightarrow> ys <=[r] xs +[f] ys"
apply (unfold unfold_lesub_list)
apply (simp add: Listn.le_def list_all2_conv_all_nth)
done

lemma (in Semilat) plus_list_lub [rule_format]:
shows "!xs ys zs. set xs <= A \<longrightarrow> set ys <= A \<longrightarrow> set zs <= A
  \<longrightarrow> size xs = n & size ys = n \<longrightarrow>
  xs <=[r] zs & ys <=[r] zs \<longrightarrow> xs +[f] ys <=[r] zs"
apply (unfold unfold_lesub_list)
apply (simp add: Listn.le_def list_all2_conv_all_nth)
done

lemma (in Semilat) list_update_incr [rule_format]:
 "x\<in> A \<Longrightarrow> set xs <= A \<longrightarrow>
  (!i. i<size xs \<longrightarrow> xs <=[r] xs[i := x +_f xs!i])"
apply (unfold unfold_lesub_list)
apply (simp add: Listn.le_def list_all2_conv_all_nth)
apply (induct xs)
 apply simp
apply (simp add: in_list_Suc_iff)
apply clarify
apply (simp add: nth_Cons split: nat.split)
done

lemma acc_le_listI [intro!]:
  "\<lbrakk> order r; acc r \<rbrakk> \<Longrightarrow> acc(Listn.le r)"
apply (unfold acc_def)
apply (subgoal_tac
 "wf(UN n. {(ys,xs). size xs = n \<and> size ys = n \<and> xs <_(Listn.le r) ys})")
 apply (erule wf_subset)
 apply (blast intro: lesssub_list_impl_same_size)
apply (rule wf_UN)
 prefer 2
 apply clarify
 apply (rename_tac m n)
 apply (case_tac "m=n")
  apply simp
 apply (fast intro!: equals0I dest: not_sym)
apply clarify
apply (rename_tac n)
apply (induct_tac n)
 apply (simp add: lesssub_def cong: conj_cong)
apply (rename_tac k)
apply (simp add: wf_eq_minimal)
apply (simp (no_asm) add: length_Suc_conv cong: conj_cong)
apply clarify
apply (rename_tac M m)
apply (case_tac "\<exists>x xs. size xs = k \<and> x#xs \<in> M")
 prefer 2
 apply (erule thin_rl)
 apply (erule thin_rl)
 apply blast
apply (erule_tac x = "{a. \<exists>xs. size xs = k \<and> a#xs:M}" in allE)
apply (erule impE)
 apply blast
apply (thin_tac "\<exists>x xs. P x xs" for P)
apply clarify
apply (rename_tac maxA xs)
apply (erule_tac x = "{ys. size ys = size xs \<and> maxA#ys \<in> M}" in allE)
apply (erule impE)
 apply blast
apply clarify
apply (thin_tac "m \<in> M")
apply (thin_tac "maxA#xs \<in> M")
apply (rule bexI)
 prefer 2
 apply assumption
apply clarify
apply simp
apply blast
done

lemma closed_listI:
  "closed S f \<Longrightarrow> closed (list n S) (map2 f)"
apply (unfold closed_def)
apply (induct n)
 apply simp
apply clarify
apply (simp add: in_list_Suc_iff)
apply clarify
apply simp
done

lemma Listn_sl_aux:
assumes "semilat (A, r, f)" shows "semilat (Listn.sl n (A,r,f))"
proof -
  interpret Semilat A r f using assms by (rule Semilat.intro)
show ?thesis
apply (unfold Listn.sl_def)
apply (simp (no_asm) only: semilat_Def split_conv)
apply (rule conjI)
 apply simp
apply (rule conjI)
 apply (simp only: closedI closed_listI)
apply (simp (no_asm) only: list_def)
apply (simp (no_asm_simp) add: plus_list_ub1 plus_list_ub2 plus_list_lub)
done
qed

lemma Listn_sl: "\<And>L. semilat L \<Longrightarrow> semilat (Listn.sl n L)"
 by(simp add: Listn_sl_aux split_tupled_all)

lemma coalesce_in_err_list [rule_format]:
  "!xes. xes : list n (err A) \<longrightarrow> coalesce xes : err(list n A)"
apply (induct n)
 apply simp
apply clarify
apply (simp add: in_list_Suc_iff)
apply clarify
apply (simp (no_asm) add: plussub_def Err.sup_def lift2_def split: err.split)
apply force
done

lemma lem: "\<And>x xs. x +_(op #) xs = x#xs"
  by (simp add: plussub_def)

lemma coalesce_eq_OK1_D [rule_format]:
  "semilat(err A, Err.le r, lift2 f) \<Longrightarrow>
  !xs. xs : list n A \<longrightarrow> (!ys. ys : list n A \<longrightarrow>
  (!zs. coalesce (xs +[f] ys) = OK zs \<longrightarrow> xs <=[r] zs))"
apply (induct n)
  apply simp
apply clarify
apply (simp add: in_list_Suc_iff)
apply clarify
apply (simp split: err.split_asm add: lem Err.sup_def lift2_def)
apply (force simp add: semilat_le_err_OK1)
done

lemma coalesce_eq_OK2_D [rule_format]:
  "semilat(err A, Err.le r, lift2 f) \<Longrightarrow>
  !xs. xs : list n A \<longrightarrow> (!ys. ys : list n A \<longrightarrow>
  (!zs. coalesce (xs +[f] ys) = OK zs \<longrightarrow> ys <=[r] zs))"
apply (induct n)
 apply simp
apply clarify
apply (simp add: in_list_Suc_iff)
apply clarify
apply (simp split: err.split_asm add: lem Err.sup_def lift2_def)
apply (force simp add: semilat_le_err_OK2)
done

lemma lift2_le_ub:
  "\<lbrakk> semilat(err A, Err.le r, lift2 f); x\<in> A; y\<in> A; x +_f y = OK z;
      u\<in> A; x <=_r u; y <=_r u \<rbrakk> \<Longrightarrow> z <=_r u"
apply (unfold semilat_Def plussub_def err_def)
apply (simp add: lift2_def)
apply clarify
apply (rotate_tac -3)
apply (erule thin_rl)
apply (erule thin_rl)
apply force
done

lemma coalesce_eq_OK_ub_D [rule_format]:
  "semilat(err A, Err.le r, lift2 f) \<Longrightarrow>
  !xs. xs : list n A \<longrightarrow> (!ys. ys : list n A \<longrightarrow>
  (!zs us. coalesce (xs +[f] ys) = OK zs & xs <=[r] us & ys <=[r] us
           & us : list n A \<longrightarrow> zs <=[r] us))"
apply (induct n)
 apply simp
apply clarify
apply (simp add: in_list_Suc_iff)
apply clarify
apply (simp (no_asm_use) split: err.split_asm add: lem Err.sup_def lift2_def)
apply clarify
apply (rule conjI)
 apply (blast intro: lift2_le_ub)
apply blast
done

lemma lift2_eq_ErrD:
  "\<lbrakk> x +_f y = Err; semilat(err A, Err.le r, lift2 f); x\<in> A; y\<in> A \<rbrakk>
  \<Longrightarrow> ~(\<exists>u\<in> A. x <=_r u & y <=_r u)"
  by (simp add: OK_plus_OK_eq_Err_conv [THEN iffD1])

lemma coalesce_eq_Err_D [rule_format]:
  "\<lbrakk> semilat(err A, Err.le r, lift2 f) \<rbrakk>
  \<Longrightarrow> !xs. xs\<in> list n A \<longrightarrow> (!ys. ys\<in> list n A \<longrightarrow>
      coalesce (xs +[f] ys) = Err \<longrightarrow>
      ~(\<exists>zs\<in> list n A. xs <=[r] zs & ys <=[r] zs))"
apply (induct n)
 apply simp
apply clarify
apply (simp add: in_list_Suc_iff)
apply clarify
apply (simp split: err.split_asm add: lem Err.sup_def lift2_def)
 apply (blast dest: lift2_eq_ErrD)
done

lemma closed_err_lift2_conv:
  "closed (err A) (lift2 f) = (\<forall>x\<in> A. \<forall>y\<in> A. x +_f y : err A)"
apply (unfold closed_def)
apply (simp add: err_def)
done

lemma closed_map2_list [rule_format]:
  "closed (err A) (lift2 f) \<Longrightarrow>
  \<forall>xs. xs : list n A \<longrightarrow> (\<forall>ys. ys : list n A \<longrightarrow>
  map2 f xs ys : list n (err A))"
apply (unfold map2_def)
apply (induct n)
 apply simp
apply clarify
apply (simp add: in_list_Suc_iff)
apply clarify
apply (simp add: plussub_def closed_err_lift2_conv)
done

lemma err_semilat_sup:
  "err_semilat (A,r,f) \<Longrightarrow>
  err_semilat (list n A, Listn.le r, sup f)"
apply (unfold Err.sl_def)
apply (simp only: split_conv)
apply (simp (no_asm) only: semilat_Def plussub_def)
apply (simp (no_asm_simp) only: Semilat.closedI [OF Semilat.intro] closed_lift2_sup)
apply (rule conjI)
 apply (drule Semilat.orderI [OF Semilat.intro])
 apply simp
apply (simp (no_asm) only: unfold_lesub_err Err.le_def err_def sup_def lift2_def)
apply (simp (no_asm_simp) add: coalesce_eq_OK1_D coalesce_eq_OK2_D split: err.split)
apply (blast intro: coalesce_eq_OK_ub_D dest: coalesce_eq_Err_D)
done

lemma err_semilat_upto_esl:
  "\<And>L. err_semilat L \<Longrightarrow> err_semilat(upto_esl m L)"
apply (unfold Listn.upto_esl_def)
apply (simp (no_asm_simp) only: split_tupled_all)
apply simp
apply (fastforce intro!: err_semilat_UnionI err_semilat_sup
                dest: lesub_list_impl_same_size
                simp add: plussub_def Listn.sup_def)
done

end


(*  Title:  HOL/ex/Arith_Examples.thy
    Author: Tjark Weber
*)

section \<open>Arithmetic\<close>

theory Arith_Examples
imports Main
begin

text \<open>
  The \<open>arith\<close> method is used frequently throughout the Isabelle
  distribution.  This file merely contains some additional tests and special
  corner cases.  Some rather technical remarks:

  @{ML Lin_Arith.simple_tac} is a very basic version of the tactic.  It performs no
  meta-to-object-logic conversion, and only some splitting of operators.
  @{ML Lin_Arith.tac} performs meta-to-object-logic conversion, full
  splitting of operators, and NNF normalization of the goal.  The \<open>arith\<close>
  method combines them both, and tries other methods (e.g.~\<open>presburger\<close>)
  as well.  This is the one that you should use in your proofs!

  An \<open>arith\<close>-based simproc is available as well (see @{ML
  Lin_Arith.simproc}), which---for performance
  reasons---however does even less splitting than @{ML Lin_Arith.simple_tac}
  at the moment (namely inequalities only).  (On the other hand, it
  does take apart conjunctions, which @{ML Lin_Arith.simple_tac} currently
  does not do.)
\<close>

subsection \<open>Splitting of Operators: @{term max}, @{term min}, @{term abs},
           @{term minus}, @{term nat}, @{term modulo},
           @{term divide}\<close>

lemma "(i::nat) <= max i j"
  by linarith

lemma "(i::int) <= max i j"
  by linarith

lemma "min i j <= (i::nat)"
  by linarith

lemma "min i j <= (i::int)"
  by linarith

lemma "min (i::nat) j <= max i j"
  by linarith

lemma "min (i::int) j <= max i j"
  by linarith

lemma "min (i::nat) j + max i j = i + j"
  by linarith

lemma "min (i::int) j + max i j = i + j"
  by linarith

lemma "(i::nat) < j ==> min i j < max i j"
  by linarith

lemma "(i::int) < j ==> min i j < max i j"
  by linarith

lemma "(0::int) <= \<bar>i\<bar>"
  by linarith

lemma "(i::int) <= \<bar>i\<bar>"
  by linarith

lemma "\<bar>\<bar>i::int\<bar>\<bar> = \<bar>i\<bar>"
  by linarith

text \<open>Also testing subgoals with bound variables.\<close>

lemma "!!x. (x::nat) <= y ==> x - y = 0"
  by linarith

lemma "!!x. (x::nat) - y = 0 ==> x <= y"
  by linarith

lemma "!!x. ((x::nat) <= y) = (x - y = 0)"
  by linarith

lemma "[| (x::nat) < y; d < 1 |] ==> x - y = d"
  by linarith

lemma "[| (x::nat) < y; d < 1 |] ==> x - y - x = d - x"
  by linarith

lemma "(x::int) < y ==> x - y < 0"
  by linarith

lemma "nat (i + j) <= nat i + nat j"
  by linarith

lemma "i < j ==> nat (i - j) = 0"
  by linarith

lemma "(i::nat) mod 0 = i"
  (* rule split_mod is only declared by default for numerals *)
  using split_mod [of _ _ "0", arith_split]
  by linarith

lemma "(i::nat) mod 1 = 0"
  (* rule split_mod is only declared by default for numerals *)
  using split_mod [of _ _ "1", arith_split]
  by linarith

lemma "(i::nat) mod 42 <= 41"
  by linarith

lemma "(i::int) mod 0 = i"
  (* rule split_zmod is only declared by default for numerals *)
  using split_zmod [of _ _ "0", arith_split]
  by linarith

lemma "(i::int) mod 1 = 0"
  (* rule split_zmod is only declared by default for numerals *)
  using split_zmod [of _ _ "1", arith_split]
  by linarith

lemma "(i::int) mod 42 <= 41"
  by linarith

lemma "-(i::int) * 1 = 0 ==> i = 0"
  by linarith

lemma "[| (0::int) < \<bar>i\<bar>; \<bar>i\<bar> * 1 < \<bar>i\<bar> * j |] ==> 1 < \<bar>i\<bar> * j"
  by linarith

subsection \<open>Meta-Logic\<close>

lemma "x < Suc y == x <= y"
  by linarith

lemma "((x::nat) == z ==> x ~= y) ==> x ~= y | z ~= y"
  by linarith

subsection \<open>Various Other Examples\<close>

lemma "(x < Suc y) = (x <= y)"
  by linarith

lemma "[| (x::nat) < y; y < z |] ==> x < z"
  by linarith

lemma "(x::nat) < y & y < z ==> x < z"
  by linarith

text \<open>This example involves no arithmetic at all, but is solved by
  preprocessing (i.e. NNF normalization) alone.\<close>

lemma "(P::bool) = Q ==> Q = P"
  by linarith

lemma "[| P = (x = 0); (~P) = (y = 0) |] ==> min (x::nat) y = 0"
  by linarith

lemma "[| P = (x = 0); (~P) = (y = 0) |] ==> max (x::nat) y = x + y"
  by linarith

lemma "[| (x::nat) ~= y; a + 2 = b; a < y; y < b; a < x; x < b |] ==> False"
  by linarith

lemma "[| (x::nat) > y; y > z; z > x |] ==> False"
  by linarith

lemma "(x::nat) - 5 > y ==> y < x"
  by linarith

lemma "(x::nat) ~= 0 ==> 0 < x"
  by linarith

lemma "[| (x::nat) ~= y; x <= y |] ==> x < y"
  by linarith

lemma "[| (x::nat) < y; P (x - y) |] ==> P 0"
  by linarith

lemma "(x - y) - (x::nat) = (x - x) - y"
  by linarith

lemma "[| (a::nat) < b; c < d |] ==> (a - b) = (c - d)"
  by linarith

lemma "((a::nat) - (b - (c - (d - e)))) = (a - (b - (c - (d - e))))"
  by linarith

lemma "(n < m & m < n') | (n < m & m = n') | (n < n' & n' < m) |
  (n = n' & n' < m) | (n = m & m < n') |
  (n' < m & m < n) | (n' < m & m = n) |
  (n' < n & n < m) | (n' = n & n < m) | (n' = m & m < n) |
  (m < n & n < n') | (m < n & n' = n) | (m < n' & n' < n) |
  (m = n & n < n') | (m = n' & n' < n) |
  (n' = m & m = (n::nat))"
(* FIXME: this should work in principle, but is extremely slow because     *)
(*        preprocessing negates the goal and tries to compute its negation *)
(*        normal form, which creates lots of separate cases for this       *)
(*        disjunction of conjunctions                                      *)
(* by (tactic {* Lin_Arith.tac 1 *}) *)
oops

lemma "2 * (x::nat) ~= 1"
(* FIXME: this is beyond the scope of the decision procedure at the moment, *)
(*        because its negation is satisfiable in the rationals?             *)
(* by (tactic {* Lin_Arith.simple_tac 1 *}) *)
oops

text \<open>Constants.\<close>

lemma "(0::nat) < 1"
  by linarith

lemma "(0::int) < 1"
  by linarith

lemma "(47::nat) + 11 < 8 * 15"
  by linarith

lemma "(47::int) + 11 < 8 * 15"
  by linarith

text \<open>Splitting of inequalities of different type.\<close>

lemma "[| (a::nat) ~= b; (i::int) ~= j; a < 2; b < 2 |] ==>
  a + b <= nat (max \<bar>i\<bar> \<bar>j\<bar>)"
  by linarith

text \<open>Again, but different order.\<close>

lemma "[| (i::int) ~= j; (a::nat) ~= b; a < 2; b < 2 |] ==>
  a + b <= nat (max \<bar>i\<bar> \<bar>j\<bar>)"
  by linarith

end


(*<*)
theory Bool_nat_list
imports Complex_Main
begin
(*>*)

text\<open>
\vspace{-4ex}
\section{\texorpdfstring{Types \<^typ>\<open>bool\<close>, \<^typ>\<open>nat\<close> and \<open>list\<close>}{Types bool, nat and list}}

These are the most important predefined types. We go through them one by one.
Based on examples we learn how to define (possibly recursive) functions and
prove theorems about them by induction and simplification.

\subsection{Type \indexed{\<^typ>\<open>bool\<close>}{bool}}

The type of boolean values is a predefined datatype
@{datatype[display] bool}
with the two values \indexed{\<^const>\<open>True\<close>}{True} and \indexed{\<^const>\<open>False\<close>}{False} and
with many predefined functions:  \<open>\<not>\<close>, \<open>\<and>\<close>, \<open>\<or>\<close>, \<open>\<longrightarrow>\<close>, etc. Here is how conjunction could be defined by pattern matching:
\<close>

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

text\<open>Both the datatype and function definitions roughly follow the syntax
of functional programming languages.

\subsection{Type \indexed{\<^typ>\<open>nat\<close>}{nat}}

Natural numbers are another predefined datatype:
@{datatype[display] nat}\index{Suc@\<^const>\<open>Suc\<close>}
All values of type \<^typ>\<open>nat\<close> are generated by the constructors
\<open>0\<close> and \<^const>\<open>Suc\<close>. Thus the values of type \<^typ>\<open>nat\<close> are
\<open>0\<close>, \<^term>\<open>Suc 0\<close>, \<^term>\<open>Suc(Suc 0)\<close>, etc.
There are many predefined functions: \<open>+\<close>, \<open>*\<close>, \<open>\<le>\<close>, etc. Here is how you could define your own addition:
\<close>

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

text\<open>And here is a proof of the fact that \<^prop>\<open>add m 0 = m\<close>:\<close>

lemma add_02: "add m 0 = m"
apply(induction m)
apply(auto)
done
(*<*)
lemma "add m 0 = m"
apply(induction m)
(*>*)
txt\<open>The \isacom{lemma} command starts the proof and gives the lemma
a name, \<open>add_02\<close>. Properties of recursively defined functions
need to be established by induction in most cases.
Command \isacom{apply}\<open>(induction m)\<close> instructs Isabelle to
start a proof by induction on \<open>m\<close>. In response, it will show the
following proof state\ifsem\footnote{See page \pageref{proof-state} for how to
display the proof state.}\fi:
@{subgoals[display,indent=0]}
The numbered lines are known as \emph{subgoals}.
The first subgoal is the base case, the second one the induction step.
The prefix \<open>\<And>m.\<close> is Isabelle's way of saying ``for an arbitrary but fixed \<open>m\<close>''. The \<open>\<Longrightarrow>\<close> separates assumptions from the conclusion.
The command \isacom{apply}\<open>(auto)\<close> instructs Isabelle to try
and prove all subgoals automatically, essentially by simplifying them.
Because both subgoals are easy, Isabelle can do it.
The base case \<^prop>\<open>add 0 0 = 0\<close> holds by definition of \<^const>\<open>add\<close>,
and the induction step is almost as simple:
\<open>add\<^latex>\<open>~\<close>(Suc m) 0 = Suc(add m 0) = Suc m\<close>
using first the definition of \<^const>\<open>add\<close> and then the induction hypothesis.
In summary, both subproofs rely on simplification with function definitions and
the induction hypothesis.
As a result of that final \isacom{done}, Isabelle associates the lemma
just proved with its name. You can now inspect the lemma with the command
\<close>

thm add_02

txt\<open>which displays @{thm[show_question_marks,display] add_02} The free
variable \<open>m\<close> has been replaced by the \concept{unknown}
\<open>?m\<close>. There is no logical difference between the two but there is an
operational one: unknowns can be instantiated, which is what you want after
some lemma has been proved.

Note that there is also a proof method \<open>induct\<close>, which behaves almost
like \<open>induction\<close>; the difference is explained in \autoref{ch:Isar}.

\begin{warn}
Terminology: We use \concept{lemma}, \concept{theorem} and \concept{rule}
interchangeably for propositions that have been proved.
\end{warn}
\begin{warn}
  Numerals (\<open>0\<close>, \<open>1\<close>, \<open>2\<close>, \dots) and most of the standard
  arithmetic operations (\<open>+\<close>, \<open>-\<close>, \<open>*\<close>, \<open>\<le>\<close>,
  \<open><\<close>, etc.) are overloaded: they are available
  not just for natural numbers but for other types as well.
  For example, given the goal \<open>x + 0 = x\<close>, there is nothing to indicate
  that you are talking about natural numbers. Hence Isabelle can only infer
  that \<^term>\<open>x\<close> is of some arbitrary type where \<open>0\<close> and \<open>+\<close>
  exist. As a consequence, you will be unable to prove the goal.
%  To alert you to such pitfalls, Isabelle flags numerals without a
%  fixed type in its output: @ {prop"x+0 = x"}.
  In this particular example, you need to include
  an explicit type constraint, for example \<open>x+0 = (x::nat)\<close>. If there
  is enough contextual information this may not be necessary: \<^prop>\<open>Suc x =
  x\<close> automatically implies \<open>x::nat\<close> because \<^term>\<open>Suc\<close> is not
  overloaded.
\end{warn}

\subsubsection{An Informal Proof}

Above we gave some terse informal explanation of the proof of
\<^prop>\<open>add m 0 = m\<close>. A more detailed informal exposition of the lemma
might look like this:
\bigskip

\noindent
\textbf{Lemma} \<^prop>\<open>add m 0 = m\<close>

\noindent
\textbf{Proof} by induction on \<open>m\<close>.
\begin{itemize}
\item Case \<open>0\<close> (the base case): \<^prop>\<open>add 0 0 = 0\<close>
  holds by definition of \<^const>\<open>add\<close>.
\item Case \<^term>\<open>Suc m\<close> (the induction step):
  We assume \<^prop>\<open>add m 0 = m\<close>, the induction hypothesis (IH),
  and we need to show \<open>add (Suc m) 0 = Suc m\<close>.
  The proof is as follows:\smallskip

  \begin{tabular}{@ {}rcl@ {\quad}l@ {}}
  \<^term>\<open>add (Suc m) 0\<close> &\<open>=\<close>& \<^term>\<open>Suc(add m 0)\<close>
  & by definition of \<open>add\<close>\\
              &\<open>=\<close>& \<^term>\<open>Suc m\<close> & by IH
  \end{tabular}
\end{itemize}
Throughout this book, \concept{IH} will stand for ``induction hypothesis''.

We have now seen three proofs of \<^prop>\<open>add m 0 = 0\<close>: the Isabelle one, the
terse four lines explaining the base case and the induction step, and just now a
model of a traditional inductive proof. The three proofs differ in the level
of detail given and the intended reader: the Isabelle proof is for the
machine, the informal proofs are for humans. Although this book concentrates
on Isabelle proofs, it is important to be able to rephrase those proofs
as informal text comprehensible to a reader familiar with traditional
mathematical proofs. Later on we will introduce an Isabelle proof language
that is closer to traditional informal mathematical language and is often
directly readable.

\subsection{Type \indexed{\<open>list\<close>}{list}}

Although lists are already predefined, we define our own copy for
demonstration purposes:
\<close>
(*<*)
apply(auto)
done
declare [[names_short]]
(*>*)
datatype 'a list = Nil | Cons 'a "'a list"
(*<*)
for map: map
(*>*)

text\<open>
\begin{itemize}
\item Type \<^typ>\<open>'a list\<close> is the type of lists over elements of type \<^typ>\<open>'a\<close>. Because \<^typ>\<open>'a\<close> is a type variable, lists are in fact \concept{polymorphic}: the elements of a list can be of arbitrary type (but must all be of the same type).
\item Lists have two constructors: \<^const>\<open>Nil\<close>, the empty list, and \<^const>\<open>Cons\<close>, which puts an element (of type \<^typ>\<open>'a\<close>) in front of a list (of type \<^typ>\<open>'a list\<close>).
Hence all lists are of the form \<^const>\<open>Nil\<close>, or \<^term>\<open>Cons x Nil\<close>,
or \<^term>\<open>Cons x (Cons y Nil)\<close>, etc.
\item \isacom{datatype} requires no quotation marks on the
left-hand side, but on the right-hand side each of the argument
types of a constructor needs to be enclosed in quotation marks, unless
it is just an identifier (e.g., \<^typ>\<open>nat\<close> or \<^typ>\<open>'a\<close>).
\end{itemize}
We also define two standard functions, append and reverse:\<close>

fun app :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" where
"app Nil ys = ys" |
"app (Cons x xs) ys = Cons x (app xs ys)"

fun rev :: "'a list \<Rightarrow> 'a list" where
"rev Nil = Nil" |
"rev (Cons x xs) = app (rev xs) (Cons x Nil)"

text\<open>By default, variables \<open>xs\<close>, \<open>ys\<close> and \<open>zs\<close> are of
\<open>list\<close> type.

Command \indexed{\isacom{value}}{value} evaluates a term. For example,\<close>

value "rev(Cons True (Cons False Nil))"

text\<open>yields the result \<^value>\<open>rev(Cons True (Cons False Nil))\<close>. This works symbolically, too:\<close>

value "rev(Cons a (Cons b Nil))"

text\<open>yields \<^value>\<open>rev(Cons a (Cons b Nil))\<close>.
\medskip

Figure~\ref{fig:MyList} shows the theory created so far.
Because \<open>list\<close>, \<^const>\<open>Nil\<close>, \<^const>\<open>Cons\<close>, etc.\ are already predefined,
 Isabelle prints qualified (long) names when executing this theory, for example, \<open>MyList.Nil\<close>
 instead of \<^const>\<open>Nil\<close>.
 To suppress the qualified names you can insert the command
 \texttt{declare [[names\_short]]}.
 This is not recommended in general but is convenient for this unusual example.
% Notice where the
%quotations marks are needed that we mostly sweep under the carpet.  In
%particular, notice that \isacom{datatype} requires no quotation marks on the
%left-hand side, but that on the right-hand side each of the argument
%types of a constructor needs to be enclosed in quotation marks.

\begin{figure}[htbp]
\begin{alltt}
\input{MyList.thy}\end{alltt}
\caption{A theory of lists}
\label{fig:MyList}
\index{comment}
\end{figure}

\subsubsection{Structural Induction for Lists}

Just as for natural numbers, there is a proof principle of induction for
lists. Induction over a list is essentially induction over the length of
the list, although the length remains implicit. To prove that some property
\<open>P\<close> holds for all lists \<open>xs\<close>, i.e., \mbox{\<^prop>\<open>P(xs)\<close>},
you need to prove
\begin{enumerate}
\item the base case \<^prop>\<open>P(Nil)\<close> and
\item the inductive case \<^prop>\<open>P(Cons x xs)\<close> under the assumption \<^prop>\<open>P(xs)\<close>, for some arbitrary but fixed \<open>x\<close> and \<open>xs\<close>.
\end{enumerate}
This is often called \concept{structural induction} for lists.

\subsection{The Proof Process}

We will now demonstrate the typical proof process, which involves
the formulation and proof of auxiliary lemmas.
Our goal is to show that reversing a list twice produces the original
list.\<close>

theorem rev_rev [simp]: "rev(rev xs) = xs"

txt\<open>Commands \isacom{theorem} and \isacom{lemma} are
interchangeable and merely indicate the importance we attach to a
proposition. Via the bracketed attribute \<open>simp\<close> we also tell Isabelle
to make the eventual theorem a \conceptnoidx{simplification rule}: future proofs
involving simplification will replace occurrences of \<^term>\<open>rev(rev xs)\<close> by
\<^term>\<open>xs\<close>. The proof is by induction:\<close>

apply(induction xs)

txt\<open>
As explained above, we obtain two subgoals, namely the base case (\<^const>\<open>Nil\<close>) and the induction step (\<^const>\<open>Cons\<close>):
@{subgoals[display,indent=0,margin=65]}
Let us try to solve both goals automatically:
\<close>

apply(auto)

txt\<open>Subgoal~1 is proved, and disappears; the simplified version
of subgoal~2 becomes the new subgoal~1:
@{subgoals[display,indent=0,margin=70]}
In order to simplify this subgoal further, a lemma suggests itself.

\subsubsection{A First Lemma}

We insert the following lemma in front of the main theorem:
\<close>
(*<*)
oops
(*>*)
lemma rev_app [simp]: "rev(app xs ys) = app (rev ys) (rev xs)"

txt\<open>There are two variables that we could induct on: \<open>xs\<close> and
\<open>ys\<close>. Because \<^const>\<open>app\<close> is defined by recursion on
the first argument, \<open>xs\<close> is the correct one:
\<close>

apply(induction xs)

txt\<open>This time not even the base case is solved automatically:\<close>
apply(auto)
txt\<open>
\vspace{-5ex}
@{subgoals[display,goals_limit=1]}
Again, we need to abandon this proof attempt and prove another simple lemma
first.

\subsubsection{A Second Lemma}

We again try the canonical proof procedure:
\<close>
(*<*)
oops
(*>*)
lemma app_Nil2 [simp]: "app xs Nil = xs"
apply(induction xs)
apply(auto)
done

text\<open>
Thankfully, this worked.
Now we can continue with our stuck proof attempt of the first lemma:
\<close>

lemma rev_app [simp]: "rev(app xs ys) = app (rev ys) (rev xs)"
apply(induction xs)
apply(auto)

txt\<open>
We find that this time \<open>auto\<close> solves the base case, but the
induction step merely simplifies to
@{subgoals[display,indent=0,goals_limit=1]}
The missing lemma is associativity of \<^const>\<open>app\<close>,
which we insert in front of the failed lemma \<open>rev_app\<close>.

\subsubsection{Associativity of \<^const>\<open>app\<close>}

The canonical proof procedure succeeds without further ado:
\<close>
(*<*)oops(*>*)
lemma app_assoc [simp]: "app (app xs ys) zs = app xs (app ys zs)"
apply(induction xs)
apply(auto)
done
(*<*)
lemma rev_app [simp]: "rev(app xs ys) = app (rev ys)(rev xs)"
apply(induction xs)
apply(auto)
done

theorem rev_rev [simp]: "rev(rev xs) = xs"
apply(induction xs)
apply(auto)
done
(*>*)
text\<open>
Finally the proofs of @{thm[source] rev_app} and @{thm[source] rev_rev}
succeed, too.

\subsubsection{Another Informal Proof}

Here is the informal proof of associativity of \<^const>\<open>app\<close>
corresponding to the Isabelle proof above.
\bigskip

\noindent
\textbf{Lemma} \<^prop>\<open>app (app xs ys) zs = app xs (app ys zs)\<close>

\noindent
\textbf{Proof} by induction on \<open>xs\<close>.
\begin{itemize}
\item Case \<open>Nil\<close>: \ \<^prop>\<open>app (app Nil ys) zs = app ys zs\<close> \<open>=\<close>
  \mbox{\<^term>\<open>app Nil (app ys zs)\<close>} \ holds by definition of \<open>app\<close>.
\item Case \<open>Cons x xs\<close>: We assume
  \begin{center} \hfill \<^term>\<open>app (app xs ys) zs\<close> \<open>=\<close>
  \<^term>\<open>app xs (app ys zs)\<close> \hfill (IH) \end{center}
  and we need to show
  \begin{center} \<^prop>\<open>app (app (Cons x xs) ys) zs = app (Cons x xs) (app ys zs)\<close>.\end{center}
  The proof is as follows:\smallskip

  \begin{tabular}{@ {}l@ {\quad}l@ {}}
  \<^term>\<open>app (app (Cons x xs) ys) zs\<close>\\
  \<open>= app (Cons x (app xs ys)) zs\<close> & by definition of \<open>app\<close>\\
  \<open>= Cons x (app (app xs ys) zs)\<close> & by definition of \<open>app\<close>\\
  \<open>= Cons x (app xs (app ys zs))\<close> & by IH\\
  \<open>= app (Cons x xs) (app ys zs)\<close> & by definition of \<open>app\<close>
  \end{tabular}
\end{itemize}
\medskip

\noindent Didn't we say earlier that all proofs are by simplification? But
in both cases, going from left to right, the last equality step is not a
simplification at all! In the base case it is \<^prop>\<open>app ys zs = app Nil (app
ys zs)\<close>. It appears almost mysterious because we suddenly complicate the
term by appending \<open>Nil\<close> on the left. What is really going on is this:
when proving some equality \mbox{\<^prop>\<open>s = t\<close>}, both \<open>s\<close> and \<open>t\<close> are
simplified until they ``meet in the middle''. This heuristic for equality proofs
works well for a functional programming context like ours. In the base case
both \<^term>\<open>app (app Nil ys) zs\<close> and \<^term>\<open>app Nil (app
ys zs)\<close> are simplified to \<^term>\<open>app ys zs\<close>, the term in the middle.

\subsection{Predefined Lists}
\label{sec:predeflists}

Isabelle's predefined lists are the same as the ones above, but with
more syntactic sugar:
\begin{itemize}
\item \<open>[]\<close> is \indexed{\<^const>\<open>Nil\<close>}{Nil},
\item \<^term>\<open>x # xs\<close> is \<^term>\<open>Cons x xs\<close>\index{Cons@\<^const>\<open>Cons\<close>},
\item \<open>[x\<^sub>1, \<dots>, x\<^sub>n]\<close> is \<open>x\<^sub>1 # \<dots> # x\<^sub>n # []\<close>, and
\item \<^term>\<open>xs @ ys\<close> is \<^term>\<open>app xs ys\<close>.
\end{itemize}
There is also a large library of predefined functions.
The most important ones are the length function
\<open>length :: 'a list \<Rightarrow> nat\<close>\index{length@\<^const>\<open>length\<close>} (with the obvious definition),
and the \indexed{\<^const>\<open>map\<close>}{map} function that applies a function to all elements of a list:
\begin{isabelle}
\isacom{fun} \<^const>\<open>map\<close> \<open>::\<close> @{typ[source] "('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b list"} \isacom{where}\\
\<open>"\<close>@{thm list.map(1) [of f]}\<open>" |\<close>\\
\<open>"\<close>@{thm list.map(2) [of f x xs]}\<open>"\<close>
\end{isabelle}

\ifsem
Also useful are the \concept{head} of a list, its first element,
and the \concept{tail}, the rest of the list:
\begin{isabelle}\index{hd@\<^const>\<open>hd\<close>}
\isacom{fun} \<open>hd :: 'a list \<Rightarrow> 'a\<close>\\
\<^prop>\<open>hd(x#xs) = x\<close>
\end{isabelle}
\begin{isabelle}\index{tl@\<^const>\<open>tl\<close>}
\isacom{fun} \<open>tl :: 'a list \<Rightarrow> 'a list\<close>\\
\<^prop>\<open>tl [] = []\<close> \<open>|\<close>\\
\<^prop>\<open>tl(x#xs) = xs\<close>
\end{isabelle}
Note that since HOL is a logic of total functions, \<^term>\<open>hd []\<close> is defined,
but we do not know what the result is. That is, \<^term>\<open>hd []\<close> is not undefined
but underdefined.
\fi
%

From now on lists are always the predefined lists.

\ifsem\else
\subsection{Types \<^typ>\<open>int\<close> and \<^typ>\<open>real\<close>}

In addition to \<^typ>\<open>nat\<close> there are also the types \<^typ>\<open>int\<close> and \<^typ>\<open>real\<close>, the mathematical integers
and real numbers. As mentioned above, numerals and most of the standard arithmetic operations are overloaded.
In particular they are defined on \<^typ>\<open>int\<close> and \<^typ>\<open>real\<close>.

\begin{warn}
There are two infix exponentiation operators:
\<^term>\<open>(^)\<close> for \<^typ>\<open>nat\<close> and \<^typ>\<open>int\<close> (with exponent of type \<^typ>\<open>nat\<close> in both cases)
and \<^term>\<open>(powr)\<close> for \<^typ>\<open>real\<close>.
\end{warn}
\begin{warn}
Type  \<^typ>\<open>int\<close> is already part of theory \<^theory>\<open>Main\<close>, but in order to use \<^typ>\<open>real\<close> as well, you have to import
theory \<^theory>\<open>Complex_Main\<close> instead of \<^theory>\<open>Main\<close>.
\end{warn}

There are three coercion functions that are inclusions and do not lose information:
\begin{quote}
\begin{tabular}{rcl}
\<^const>\<open>int\<close> &\<open>::\<close>& \<^typ>\<open>nat \<Rightarrow> int\<close>\\
\<^const>\<open>real\<close> &\<open>::\<close>& \<^typ>\<open>nat \<Rightarrow> real\<close>\\
\<^const>\<open>real_of_int\<close> &\<open>::\<close>& \<^typ>\<open>int \<Rightarrow> real\<close>\\
\end{tabular}
\end{quote}

Isabelle inserts these inclusions automatically once you import \<open>Complex_Main\<close>.
If there are multiple type-correct completions, Isabelle chooses an arbitrary one.
For example, the input \noquotes{@{term[source] "(i::int) + (n::nat)"}} has the unique
type-correct completion \<^term>\<open>(i::int) + int(n::nat)\<close>. In contrast,
\noquotes{@{term[source] "((n::nat) + n) :: real"}} has two type-correct completions,
\noquotes{@{term[source]"real(n+n)"}} and \noquotes{@{term[source]"real n + real n"}}.

There are also the coercion functions in the other direction:
\begin{quote}
\begin{tabular}{rcl}
\<^const>\<open>nat\<close> &\<open>::\<close>& \<^typ>\<open>int \<Rightarrow> nat\<close>\\
\<^const>\<open>floor\<close> &\<open>::\<close>& \<^typ>\<open>real \<Rightarrow> int\<close>\\
\<^const>\<open>ceiling\<close> &\<open>::\<close>& \<^typ>\<open>real \<Rightarrow> int\<close>\\
\end{tabular}
\end{quote}
\fi

\subsection*{Exercises}

\begin{exercise}
Use the \isacom{value} command to evaluate the following expressions:
@{term[source] "1 + (2::nat)"}, @{term[source] "1 + (2::int)"},
@{term[source] "1 - (2::nat)"} and @{term[source] "1 - (2::int)"}.
\end{exercise}

\begin{exercise}
Start from the definition of \<^const>\<open>add\<close> given above.
Prove that \<^const>\<open>add\<close> is associative and commutative.
Define a recursive function \<open>double\<close> \<open>::\<close> \<^typ>\<open>nat \<Rightarrow> nat\<close>
and prove \<^prop>\<open>double m = add m m\<close>.
\end{exercise}

\begin{exercise}
Define a function \<open>count ::\<close> \<^typ>\<open>'a \<Rightarrow> 'a list \<Rightarrow> nat\<close>
that counts the number of occurrences of an element in a list. Prove
\<^prop>\<open>count x xs \<le> length xs\<close>.
\end{exercise}

\begin{exercise}
Define a recursive function \<open>snoc ::\<close> \<^typ>\<open>'a list \<Rightarrow> 'a \<Rightarrow> 'a list\<close>
that appends an element to the end of a list. With the help of \<open>snoc\<close>
define a recursive function \<open>reverse ::\<close> \<^typ>\<open>'a list \<Rightarrow> 'a list\<close>
that reverses a list. Prove \<^prop>\<open>reverse(reverse xs) = xs\<close>.
\end{exercise}

\begin{exercise}
Define a recursive function \<open>sum_upto ::\<close> \<^typ>\<open>nat \<Rightarrow> nat\<close> such that
\mbox{\<open>sum_upto n\<close>} \<open>=\<close> \<open>0 + ... + n\<close> and prove
\<^prop>\<open> sum_upto (n::nat) = n * (n+1) div 2\<close>.
\end{exercise}
\<close>
(*<*)
end
(*>*)


theory "HOLCF-Top"
imports
  "~~/src/HOL/HOLCF/HOLCF"
begin

default_sort type

class Top_cpo = cpo +
  assumes most: "\<exists>x. \<forall>y. y \<sqsubseteq> x"
begin

  definition top :: "'a"
    where "top = (THE x. \<forall>y. y \<sqsubseteq> x)"

  notation (xsymbols)
    top ("\<top>")

  lemma maximal [iff]: "x \<sqsubseteq> \<top>"
  unfolding top_def
  apply (rule the1I2)
  apply (rule ex_ex1I)
  apply (rule most)
  apply (blast intro: below_antisym)
  apply simp
  done
end

default_sort cpo

lemma above_top_iff [simp]: "(\<top> \<sqsubseteq> x) = (x = \<top>)"
by (simp add: po_eq_conv)

lemma eq_top_iff: "(x = \<top>) = (\<top> \<sqsubseteq> x)"
by simp

lemma topI: "\<top> \<sqsubseteq> x ==> x = \<top>"
by (subst eq_top_iff)

end


section \<open>Trivia\<close>

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

lemma measure_induct2:
fixes meas :: "'a \<Rightarrow> 'b \<Rightarrow> nat"
assumes "\<And>x1 x2. (\<And>y1 y2. meas y1 y2 < meas x1 x2 \<Longrightarrow> S y1 y2) \<Longrightarrow> S x1 x2"
shows "S x1 x2"
proof-
  let ?m = "\<lambda> x1x2. meas (fst x1x2) (snd x1x2)" let ?S = "\<lambda> x1x2. S (fst x1x2) (snd x1x2)"
  have "?S (x1,x2)"
  apply(rule measure_induct[of ?m ?S])
  using assms by (metis fst_conv snd_conv)
  thus ?thesis by auto
qed

text\<open>Right cons:\<close>

abbreviation Rcons (infix "##" 70) where "xs ## x \<equiv> xs @ [x]"

lemma two_singl_Rcons: "[a,b] = [a] ## b" by auto

(*<*)
end
(*>*)


theory PredicateTransformers
  imports "../Algebra/BBI"
begin

no_notation plus (infixl "+" 65)

text{*
  Predicate transformers are functions from predicates to predicates, abstractly, from
  commutative quantale unital to commutative quantale unital
*}

instantiation "fun" :: (quantale, quantale) quantale
begin

definition "F * G \<equiv> \<lambda>h. \<Squnion> {F f * G g | f g. h = f * g}"

lemma qmult_apply [simp, code]:
  "(F * G) h \<equiv>  \<Squnion> {F f * G g | f g. h = f * g}"
  by (simp add: times_fun_def)

lemma sup_distrib_left_fun: "(f * (g + h)) x = (f * g + f * h) x"
  by (subst qmult_apply, subst sup_apply, subst Sup.qdistl) simp

lemma sup_distrib_right_fun: "((f + g) * h) x = (f * h + g * h) x"
  by (subst qmult_apply, subst sup_apply, subst Sup.qdistr) simp

lemma qSup_distl_fun: "(f * \<Squnion>G) x = (\<Squnion>(op * f ` G)) x"
  apply (auto simp add: qSUP_distl intro!: antisym Sup_least SUP_mono)
  apply (metis (lifting, mono_tags) Sup_upper mem_Collect_eq)
  by (auto intro!: SUP_least Sup_mono) (metis SUP_upper)

lemma qSup_distr_fun: "(\<Squnion>G * f) x = (\<Squnion>((\<lambda>g. g * f) ` G)) x"
  apply (auto simp add: qSUP_distr intro!: antisym Sup_least SUP_mono)
  apply (metis (lifting, mono_tags) Sup_upper mem_Collect_eq)
  by (auto intro!: SUP_least Sup_mono) (metis SUP_upper)

lemma Sup_distl_assoc: "(f :: 'a \<Rightarrow> 'b) y * \<Squnion>{g y' * h z' |y' z' :: 'a. z = y' * z'} = \<Squnion>{f y * (g y' * h z') |y' z'. z = y' * z'}"
  by (auto simp only: Sup.Join_distl intro!: Sup.Join_eqI2)

lemma qSup_distr_assoc: "\<Squnion>{((f :: 'a \<Rightarrow> 'b) y * g y') | y y' :: 'a. z = (y * y')} * h z' = \<Squnion>{(f y * g y') * h z' | y y'. z = (y * y')}"
  by (auto simp only: qSup_distr intro: Sup.Join_eqI2)

lemma qmult_assoc_fun: "(f * (g * h)) x = ((f * g) * h) x"
proof -
  have "(f * (g * h)) x = \<Squnion> {\<Squnion> {(f y * g y') * h z' | y' z'. z = y' * z'} | y z. x = y * z}"
    by (simp add: Sup_distl_assoc mult.assoc)
  also have "... = \<Squnion> {(f y * g y') * h z' | y' z' y z. z = y' * z' \<and> x = y * z}"
    apply (rule antisym, rule Sup_least, safe, rule Sup_mono, auto, rule Sup_least, auto)
    apply (subgoal_tac "\<exists>ya z. y * (y' * z') = ya * z \<and> f y * g y' * h z' \<le> \<Squnion>{f ya * g y' * h z' |y' z'. z = y' * z'}")
    apply (smt Sup_upper2 mem_Collect_eq)
    by (smt Sup_le_iff dual_order.refl mem_Collect_eq)
  also have "... = \<Squnion> {(f y * g y') * h z' | z' y y'. x = y * (y' * z')}"
    by (auto intro: Sup.Join_eqI2)
  also have "... = \<Squnion> {(f y * g y') * h z' | z' y y'. x = (y * y') * z'}"
    by (metis mult.assoc)
  also have "... = \<Squnion> {(f y * g y') * h z' | z' y y' z. z = (y * y') \<and> x = z * z'}"
    by (auto intro: Sup.Join_eqI2)
  also have "... = \<Squnion>{ \<Squnion>{(f y * g y') * h z' | y y'. z = (y * y')} | z z'. x = z * z'}"
    apply (rule antisym, rule Sup_least, auto)
    apply (subgoal_tac "\<exists>z z'a. y * y' * z' = z * z'a \<and> f y * g y' * h z' \<le> \<Squnion>{f y * g y' * h z'a |y y'. z = y * y'}")
    apply (smt Sup_upper2 mem_Collect_eq)
    apply (smt Sup_le_iff dual_order.refl mem_Collect_eq)
    by (rule Sup_least, safe, rule Sup_mono, auto)
  finally show ?thesis
    by (simp add: qSup_distr_assoc)
qed

instance
  apply default
  apply (rule ext, rule qmult_assoc_fun[symmetric])
  apply (rule ext, rule qSup_distr_fun)
  by (metis (lifting, mono_tags) qSup_distl_fun eq_iff le_funI)+
end

text {* Unit is also lifted *}

instantiation "fun" :: (quantale_unital, quantale_unital) quantale_unital
begin

definition
  "1 \<equiv> \<lambda>x. if x = 1 then 1 else \<bottom>"

lemma qunitl_fun[simp]: "(1 * f) x = f x"
  by (auto simp: one_fun_def intro!: Sup_eqI)

lemma qunitr_fun[simp]: "(f * 1) x = f x"
  by (auto simp: one_fun_def intro!: Sup_eqI)

instance
  by default  (auto intro: qunitr_fun qunitl_fun)

end

text {* Commutativity is also lifted *}

instance "fun" :: (comm_quantale, comm_quantale) comm_quantale
proof (default, simp_all add: mult.assoc, rule ext)
  fix f g :: "'a :: comm_quantale \<Rightarrow> 'b :: comm_quantale"
  fix x :: "'a :: comm_quantale"
  have "(f * g) x = \<Squnion> {f y * g z | y z. x = y * z}" by simp
  also have "... = \<Squnion> {g z * f y | z y. x = z * y}"
    by (auto intro!: Sup.Join_eqI2 mult.commute)
  finally show "(f * g) x = (g * f) x" by simp
qed

instance "fun" :: (comm_quantale_unital, comm_quantale_unital) comm_quantale_unital
  by default auto

text {* Distributivity is also lifted *}

instance "fun" :: (distrib_quantale, distrib_quantale) distrib_quantale ..

instance "fun" :: (distrib_comm_quantale_unital, distrib_comm_quantale_unital) distrib_comm_quantale_unital ..

text {* BBI *}

instance "fun" :: (bbi, bbi) bbi ..

end


theory Submission
  imports Defs
begin

lemma subseq_append2 [intro]: "subseq xs ys \<Longrightarrow> subseq xs (zs @ ys)"
  by (induct zs) auto

lemma subseq_prefix [intro]:
  assumes "subseq xs ys" shows "subseq xs (ys @ zs)"
  using assms
  by (induct arbitrary: zs) auto

lemma subseq_ConsD:
  assumes "subseq (x#xs) ys"
  shows "\<exists>us vs. ys = us @ x # vs \<and> subseq xs vs"
using assms
proof (induct x \<equiv> "x # xs" ys arbitrary: x xs)
  case 3
  then show ?case by (metis append_Cons)
next
  case 2
  thus ?case by blast
qed

lemma subseq_Nil_iff [simp]: "xs \<sqsubseteq> [] \<longleftrightarrow> xs = []"
  by (auto elim: subseq.cases)

lemma Cons_subseqD [dest]:
  assumes "x # xs \<sqsubseteq> ys"
  shows   "xs \<sqsubseteq> ys"
  using assms
  by (induction "x # xs" ys rule: subseq.induct) auto

lemma subseq_Cons_same_iff [simp]: "(x # xs) \<sqsubseteq> (x # ys) \<longleftrightarrow> xs \<sqsubseteq> ys"
proof
  assume "x # xs \<sqsubseteq> x # ys"
  thus "xs \<sqsubseteq> ys"
    by (cases rule: subseq.cases) auto
qed auto

lemma subseq_Cons_different_iff [simp]:
  assumes "x \<noteq> y"
  shows   "(x # xs) \<sqsubseteq> (y # ys) \<longleftrightarrow> x # xs \<sqsubseteq> ys"
proof
  assume "x # xs \<sqsubseteq> y # ys"
  thus "x # xs \<sqsubseteq> ys"
    using assms
    by (induction "x # xs" "y # ys" rule: subseq.induct) auto
qed auto

lemma subseq_Cons_iff: "(x # xs) \<sqsubseteq> (y # ys) \<longleftrightarrow> (if x = y then xs \<sqsubseteq> ys else x # xs \<sqsubseteq> ys)"
  by auto

lemma subseq_trans [trans]: "xs \<sqsubseteq> ys \<Longrightarrow> ys \<sqsubseteq> zs \<Longrightarrow> xs \<sqsubseteq> zs"
proof -
  assume "xs \<sqsubseteq> ys" and "ys \<sqsubseteq> zs"
  then show "xs \<sqsubseteq> zs"
  proof (induction arbitrary: zs)
    case 1 show ?case by blast
  next
    case (3 xs ys y)
    from subseq_ConsD [OF \<open>(y#ys) \<sqsubseteq> zs\<close>] obtain us v vs
      where zs: "zs = us @ v # vs" and "ys \<sqsubseteq> vs" by blast
    then have "ys \<sqsubseteq> (v#vs)" by blast
    then have "ys \<sqsubseteq> zs" unfolding zs by (rule subseq_append2)
    from "3.IH" [OF this] show ?case by auto
  next
    case (2 xs ys y)
    from subseq_ConsD[OF 2(3)] obtain us vs where zs: "zs = us @ y # vs \<and> ys \<sqsubseteq> vs"
      by auto
    hence "y # ys \<sqsubseteq> us @ y # vs"
      using 2(2)[of vs] 2(1,3) by auto
    thus ?case using 2 zs
      by auto
  qed
qed

lemma not_proper_subseq_Nil [simp]: "\<not>zs \<sqsubset> []"
  by (auto simp: proper_subseq_def)

lemma subseq_imp_length_le:
  assumes "xs \<sqsubseteq> ys"
  shows   "length xs \<le> length ys"
  using assms by induction auto

lemma not_Cons_suseq_self [simp]: "\<not>x # xs \<sqsubseteq> xs"
  using subseq_imp_length_le[of "x # xs" xs] by auto

lemma subseq_refl [simp]: "xs \<sqsubseteq> xs"
  by (induction xs) auto

lemma subseq_append_left_cancel [simp]: "xs @ ys \<sqsubseteq> xs @ zs \<longleftrightarrow> ys \<sqsubseteq> zs"
  by (induction xs) auto

lemma aux_correct [simp]: "aux xs ys \<longleftrightarrow> xs \<sqsubseteq> ys"
  by (induction xs ys rule: aux.induct) auto

lemma aux2_correct: "aux2 ys acc xs \<longleftrightarrow> (\<forall>zs. zs \<sqsubset> xs \<longrightarrow> acc @ zs \<sqsubseteq> ys)"
proof (induction ys acc xs rule: aux2.induct)
  case (2 ys acc x xs)
  text \<open>
    Idea: we split the proper subsequences of \<^term>\<open>x # xs\<close> into two cases:
      1. the (not necessarily proper) subsequences of \<^term>\<open>xs\<close>
      2. the proper subsequences of \<^term>\<open>xs\<close> with \<^term>\<open>x\<close> slapped in front of each of them
  \<close>
  define ZS where "ZS = {zs. zs \<sqsubset> x # xs}"
  define ZS1 and ZS2 where "ZS1 = {zs. zs \<sqsubseteq> xs}" and "ZS2 = (\<lambda>zs. x # zs) ` {zs. zs \<sqsubset> xs}"

  have "(\<forall>zs. zs \<sqsubset> x # xs \<longrightarrow> acc @ zs \<sqsubseteq> ys) \<longleftrightarrow> (\<forall>zs\<in>ZS. acc @ zs \<sqsubseteq> ys)"
    by (auto simp: ZS_def)
  also have "ZS = ZS1 \<union> ZS2"
  proof (intro equalityI subsetI) (* can be sledgehammered in one line *)
    fix zs assume "zs \<in> ZS1 \<union> ZS2"
    thus "zs \<in> ZS"
      by (auto simp: ZS_def ZS1_def ZS2_def proper_subseq_def)
  next
    fix zs assume "zs \<in> ZS"
    thus "zs \<in> ZS1 \<union> ZS2"
      by (cases zs) (auto simp: ZS_def ZS1_def ZS2_def proper_subseq_def subseq_Cons_iff
                          split: if_splits)
  qed
  also have "(\<forall>zs\<in>ZS1\<union>ZS2. acc @ zs \<sqsubseteq> ys) \<longleftrightarrow> (\<forall>zs\<in>ZS1. acc @ zs \<sqsubseteq> ys) \<and> (\<forall>zs\<in>ZS2. acc @ zs \<sqsubseteq> ys)"
    by blast

  text \<open>
    Due to transitivity, we don't have to check all of \<^term>\<open>ZS1\<close>; it is enough to
    check for the biggest list in it, which is \<^term>\<open>xs\<close> itself.
  \<close>
  also have "(\<forall>zs\<in>ZS1. acc @ zs \<sqsubseteq> ys) \<longleftrightarrow> acc @ xs \<sqsubseteq> ys"
  proof safe
    fix zs assume "zs \<in> ZS1" and *: "acc @ xs \<sqsubseteq> ys"
    have "acc @ zs \<sqsubseteq> acc @ xs"
      using \<open>zs \<in> _\<close> unfolding ZS1_def by auto
    also note \<open>acc @ xs \<sqsubseteq> ys\<close>
    finally show "acc @ zs \<sqsubseteq> ys" .
  qed (auto simp: ZS1_def)
  also have "(\<forall>zs\<in>ZS2. acc @ zs \<sqsubseteq> ys) \<longleftrightarrow> aux2 ys (acc @ [x]) xs"
    using 2 by (auto simp: ZS2_def)
  finally show ?case by simp
qed auto

definition
  "judge2 xs ys \<longleftrightarrow> judge1 xs ys"

theorem judge1_correct: "judge1 xs ys \<longleftrightarrow> all_proper_subseq xs ys"
  by (auto simp: judge1_def all_proper_subseq_def aux2_correct)

theorem judge2_correct:
  "judge2 xs ys \<longleftrightarrow> all_proper_subseq xs ys"
  unfolding judge2_def by (rule judge1_correct)

theorem judge2_is_executable:
  "judge2 ''ab'' ''ab'' \<longleftrightarrow> True"
  "judge2 ''ba'' ''ab'' \<longleftrightarrow> True"
  "judge2 ''abcd'' ''cdabc'' \<longleftrightarrow> False"
  by eval+

end