(*  Title:      HOL/Int.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Author:     Tobias Nipkow, Florian Haftmann, TU Muenchen
*)

section {* The Integers as Equivalence Classes over Pairs of Natural Numbers *}

theory Int
imports Equiv_Relations Power Quotient Fun_Def
begin

subsection {* Definition of integers as a quotient type *}

definition intrel :: "(nat \<times> nat) \<Rightarrow> (nat \<times> nat) \<Rightarrow> bool" where
  "intrel = (\<lambda>(x, y) (u, v). x + v = u + y)"

lemma intrel_iff [simp]: "intrel (x, y) (u, v) \<longleftrightarrow> x + v = u + y"
  by (simp add: intrel_def)

quotient_type int = "nat \<times> nat" / "intrel"
  morphisms Rep_Integ Abs_Integ
proof (rule equivpI)
  show "reflp intrel"
    unfolding reflp_def by auto
  show "symp intrel"
    unfolding symp_def by auto
  show "transp intrel"
    unfolding transp_def by auto
qed

lemma eq_Abs_Integ [case_names Abs_Integ, cases type: int]:
     "(!!x y. z = Abs_Integ (x, y) ==> P) ==> P"
by (induct z) auto

subsection {* Integers form a commutative ring *}

instantiation int :: comm_ring_1
begin

lift_definition zero_int :: "int" is "(0, 0)" .

lift_definition one_int :: "int" is "(1, 0)" .

lift_definition plus_int :: "int \<Rightarrow> int \<Rightarrow> int"
  is "\<lambda>(x, y) (u, v). (x + u, y + v)"
  by clarsimp

lift_definition uminus_int :: "int \<Rightarrow> int"
  is "\<lambda>(x, y). (y, x)"
  by clarsimp

lift_definition minus_int :: "int \<Rightarrow> int \<Rightarrow> int"
  is "\<lambda>(x, y) (u, v). (x + v, y + u)"
  by clarsimp

lift_definition times_int :: "int \<Rightarrow> int \<Rightarrow> int"
  is "\<lambda>(x, y) (u, v). (x*u + y*v, x*v + y*u)"
proof (clarsimp)
  fix s t u v w x y z :: nat
  assume "s + v = u + t" and "w + z = y + x"
  hence "(s + v) * w + (u + t) * x + u * (w + z) + v * (y + x)
       = (u + t) * w + (s + v) * x + u * (y + x) + v * (w + z)"
    by simp
  thus "(s * w + t * x) + (u * z + v * y) = (u * y + v * z) + (s * x + t * w)"
    by (simp add: algebra_simps)
qed

instance
  by default (transfer, clarsimp simp: algebra_simps)+

end

abbreviation int :: "nat \<Rightarrow> int" where
  "int \<equiv> of_nat"

lemma int_def: "int n = Abs_Integ (n, 0)"
  by (induct n, simp add: zero_int.abs_eq,
    simp add: one_int.abs_eq plus_int.abs_eq)

lemma int_transfer [transfer_rule]:
  "(rel_fun (op =) pcr_int) (\<lambda>n. (n, 0)) int"
  unfolding rel_fun_def int.pcr_cr_eq cr_int_def int_def by simp

lemma int_diff_cases:
  obtains (diff) m n where "z = int m - int n"
  by transfer clarsimp

subsection {* Integers are totally ordered *}

instantiation int :: linorder
begin

lift_definition less_eq_int :: "int \<Rightarrow> int \<Rightarrow> bool"
  is "\<lambda>(x, y) (u, v). x + v \<le> u + y"
  by auto

lift_definition less_int :: "int \<Rightarrow> int \<Rightarrow> bool"
  is "\<lambda>(x, y) (u, v). x + v < u + y"
  by auto

instance
  by default (transfer, force)+

end

instantiation int :: distrib_lattice
begin

definition
  "(inf \<Colon> int \<Rightarrow> int \<Rightarrow> int) = min"

definition
  "(sup \<Colon> int \<Rightarrow> int \<Rightarrow> int) = max"

instance
  by intro_classes
    (auto simp add: inf_int_def sup_int_def max_min_distrib2)

end

subsection {* Ordering properties of arithmetic operations *}

instance int :: ordered_cancel_ab_semigroup_add
proof
  fix i j k :: int
  show "i \<le> j \<Longrightarrow> k + i \<le> k + j"
    by transfer clarsimp
qed

text{*Strict Monotonicity of Multiplication*}

text{*strict, in 1st argument; proof is by induction on k>0*}
lemma zmult_zless_mono2_lemma:
     "(i::int)<j ==> 0<k ==> int k * i < int k * j"
apply (induct k)
apply simp
apply (simp add: distrib_right)
apply (case_tac "k=0")
apply (simp_all add: add_strict_mono)
done

lemma zero_le_imp_eq_int: "(0::int) \<le> k ==> \<exists>n. k = int n"
apply transfer
apply clarsimp
apply (rule_tac x="a - b" in exI, simp)
done

lemma zero_less_imp_eq_int: "(0::int) < k ==> \<exists>n>0. k = int n"
apply transfer
apply clarsimp
apply (rule_tac x="a - b" in exI, simp)
done

lemma zmult_zless_mono2: "[| i<j;  (0::int) < k |] ==> k*i < k*j"
apply (drule zero_less_imp_eq_int)
apply (auto simp add: zmult_zless_mono2_lemma)
done

text{*The integers form an ordered integral domain*}
instantiation int :: linordered_idom
begin

definition
  zabs_def: "\<bar>i\<Colon>int\<bar> = (if i < 0 then - i else i)"

definition
  zsgn_def: "sgn (i\<Colon>int) = (if i=0 then 0 else if 0<i then 1 else - 1)"

instance proof
  fix i j k :: int
  show "i < j \<Longrightarrow> 0 < k \<Longrightarrow> k * i < k * j"
    by (rule zmult_zless_mono2)
  show "\<bar>i\<bar> = (if i < 0 then -i else i)"
    by (simp only: zabs_def)
  show "sgn (i\<Colon>int) = (if i=0 then 0 else if 0<i then 1 else - 1)"
    by (simp only: zsgn_def)
qed

end

lemma zless_imp_add1_zle: "w < z \<Longrightarrow> w + (1\<Colon>int) \<le> z"
  by transfer clarsimp

lemma zless_iff_Suc_zadd:
  "(w \<Colon> int) < z \<longleftrightarrow> (\<exists>n. z = w + int (Suc n))"
apply transfer
apply auto
apply (rename_tac a b c d)
apply (rule_tac x="c+b - Suc(a+d)" in exI)
apply arith
done

lemmas int_distrib =
  distrib_right [of z1 z2 w]
  distrib_left [of w z1 z2]
  left_diff_distrib [of z1 z2 w]
  right_diff_distrib [of w z1 z2]
  for z1 z2 w :: int

subsection {* Embedding of the Integers into any @{text ring_1}: @{text of_int}*}

context ring_1
begin

lift_definition of_int :: "int \<Rightarrow> 'a" is "\<lambda>(i, j). of_nat i - of_nat j"
  by (clarsimp simp add: diff_eq_eq eq_diff_eq diff_add_eq
    of_nat_add [symmetric] simp del: of_nat_add)

lemma of_int_0 [simp]: "of_int 0 = 0"
  by transfer simp

lemma of_int_1 [simp]: "of_int 1 = 1"
  by transfer simp

lemma of_int_add [simp]: "of_int (w+z) = of_int w + of_int z"
  by transfer (clarsimp simp add: algebra_simps)

lemma of_int_minus [simp]: "of_int (-z) = - (of_int z)"
  by (transfer fixing: uminus) clarsimp

lemma of_int_diff [simp]: "of_int (w - z) = of_int w - of_int z"
  using of_int_add [of w "- z"] by simp

lemma of_int_mult [simp]: "of_int (w*z) = of_int w * of_int z"
  by (transfer fixing: times) (clarsimp simp add: algebra_simps of_nat_mult)

text{*Collapse nested embeddings*}
lemma of_int_of_nat_eq [simp]: "of_int (int n) = of_nat n"
by (induct n) auto

lemma of_int_numeral [simp, code_post]: "of_int (numeral k) = numeral k"
  by (simp add: of_nat_numeral [symmetric] of_int_of_nat_eq [symmetric])

lemma of_int_neg_numeral [code_post]: "of_int (- numeral k) = - numeral k"
  by simp

lemma of_int_power:
  "of_int (z ^ n) = of_int z ^ n"
  by (induct n) simp_all

end

context ring_char_0
begin

lemma of_int_eq_iff [simp]:
   "of_int w = of_int z \<longleftrightarrow> w = z"
  by transfer (clarsimp simp add: algebra_simps
    of_nat_add [symmetric] simp del: of_nat_add)

text{*Special cases where either operand is zero*}
lemma of_int_eq_0_iff [simp]:
  "of_int z = 0 \<longleftrightarrow> z = 0"
  using of_int_eq_iff [of z 0] by simp

lemma of_int_0_eq_iff [simp]:
  "0 = of_int z \<longleftrightarrow> z = 0"
  using of_int_eq_iff [of 0 z] by simp

end

context linordered_idom
begin

text{*Every @{text linordered_idom} has characteristic zero.*}
subclass ring_char_0 ..

lemma of_int_le_iff [simp]:
  "of_int w \<le> of_int z \<longleftrightarrow> w \<le> z"
  by (transfer fixing: less_eq) (clarsimp simp add: algebra_simps
    of_nat_add [symmetric] simp del: of_nat_add)

lemma of_int_less_iff [simp]:
  "of_int w < of_int z \<longleftrightarrow> w < z"
  by (simp add: less_le order_less_le)

lemma of_int_0_le_iff [simp]:
  "0 \<le> of_int z \<longleftrightarrow> 0 \<le> z"
  using of_int_le_iff [of 0 z] by simp

lemma of_int_le_0_iff [simp]:
  "of_int z \<le> 0 \<longleftrightarrow> z \<le> 0"
  using of_int_le_iff [of z 0] by simp

lemma of_int_0_less_iff [simp]:
  "0 < of_int z \<longleftrightarrow> 0 < z"
  using of_int_less_iff [of 0 z] by simp

lemma of_int_less_0_iff [simp]:
  "of_int z < 0 \<longleftrightarrow> z < 0"
  using of_int_less_iff [of z 0] by simp

end

lemma of_nat_less_of_int_iff:
  "(of_nat n::'a::linordered_idom) < of_int x \<longleftrightarrow> int n < x"
  by (metis of_int_of_nat_eq of_int_less_iff)

lemma of_int_eq_id [simp]: "of_int = id"
proof
  fix z show "of_int z = id z"
    by (cases z rule: int_diff_cases, simp)
qed

instance int :: no_top
  apply default
  apply (rule_tac x="x + 1" in exI)
  apply simp
  done

instance int :: no_bot
  apply default
  apply (rule_tac x="x - 1" in exI)
  apply simp
  done

subsection {* Magnitude of an Integer, as a Natural Number: @{text nat} *}

lift_definition nat :: "int \<Rightarrow> nat" is "\<lambda>(x, y). x - y"
  by auto

lemma nat_int [simp]: "nat (int n) = n"
  by transfer simp

lemma int_nat_eq [simp]: "int (nat z) = (if 0 \<le> z then z else 0)"
  by transfer clarsimp

corollary nat_0_le: "0 \<le> z ==> int (nat z) = z"
by simp

lemma nat_le_0 [simp]: "z \<le> 0 ==> nat z = 0"
  by transfer clarsimp

lemma nat_le_eq_zle: "0 < w | 0 \<le> z ==> (nat w \<le> nat z) = (w\<le>z)"
  by transfer (clarsimp, arith)

text{*An alternative condition is @{term "0 \<le> w"} *}
corollary nat_mono_iff: "0 < z ==> (nat w < nat z) = (w < z)"
by (simp add: nat_le_eq_zle linorder_not_le [symmetric])

corollary nat_less_eq_zless: "0 \<le> w ==> (nat w < nat z) = (w<z)"
by (simp add: nat_le_eq_zle linorder_not_le [symmetric])

lemma zless_nat_conj [simp]: "(nat w < nat z) = (0 < z & w < z)"
  by transfer (clarsimp, arith)

lemma nonneg_eq_int:
  fixes z :: int
  assumes "0 \<le> z" and "\<And>m. z = int m \<Longrightarrow> P"
  shows P
  using assms by (blast dest: nat_0_le sym)

lemma nat_eq_iff:
  "nat w = m \<longleftrightarrow> (if 0 \<le> w then w = int m else m = 0)"
  by transfer (clarsimp simp add: le_imp_diff_is_add)

corollary nat_eq_iff2:
  "m = nat w \<longleftrightarrow> (if 0 \<le> w then w = int m else m = 0)"
  using nat_eq_iff [of w m] by auto

lemma nat_0 [simp]:
  "nat 0 = 0"
  by (simp add: nat_eq_iff)

lemma nat_1 [simp]:
  "nat 1 = Suc 0"
  by (simp add: nat_eq_iff)

lemma nat_numeral [simp]:
  "nat (numeral k) = numeral k"
  by (simp add: nat_eq_iff)

lemma nat_neg_numeral [simp]:
  "nat (- numeral k) = 0"
  by simp

lemma nat_2: "nat 2 = Suc (Suc 0)"
  by simp

lemma nat_less_iff: "0 \<le> w ==> (nat w < m) = (w < of_nat m)"
  by transfer (clarsimp, arith)

lemma nat_le_iff: "nat x \<le> n \<longleftrightarrow> x \<le> int n"
  by transfer (clarsimp simp add: le_diff_conv)

lemma nat_mono: "x \<le> y \<Longrightarrow> nat x \<le> nat y"
  by transfer auto

lemma nat_0_iff[simp]: "nat(i::int) = 0 \<longleftrightarrow> i\<le>0"
  by transfer clarsimp

lemma int_eq_iff: "(of_nat m = z) = (m = nat z & 0 \<le> z)"
by (auto simp add: nat_eq_iff2)

lemma zero_less_nat_eq [simp]: "(0 < nat z) = (0 < z)"
by (insert zless_nat_conj [of 0], auto)

lemma nat_add_distrib:
  "0 \<le> z \<Longrightarrow> 0 \<le> z' \<Longrightarrow> nat (z + z') = nat z + nat z'"
  by transfer clarsimp

lemma nat_diff_distrib':
  "0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> nat (x - y) = nat x - nat y"
  by transfer clarsimp

lemma nat_diff_distrib:
  "0 \<le> z' \<Longrightarrow> z' \<le> z \<Longrightarrow> nat (z - z') = nat z - nat z'"
  by (rule nat_diff_distrib') auto

lemma nat_zminus_int [simp]: "nat (- int n) = 0"
  by transfer simp

lemma le_nat_iff:
  "k \<ge> 0 \<Longrightarrow> n \<le> nat k \<longleftrightarrow> int n \<le> k"
  by transfer auto

lemma zless_nat_eq_int_zless: "(m < nat z) = (int m < z)"
  by transfer (clarsimp simp add: less_diff_conv)

context ring_1
begin

lemma of_nat_nat: "0 \<le> z \<Longrightarrow> of_nat (nat z) = of_int z"
  by transfer (clarsimp simp add: of_nat_diff)

end

lemma diff_nat_numeral [simp]:
  "(numeral v :: nat) - numeral v' = nat (numeral v - numeral v')"
  by (simp only: nat_diff_distrib' zero_le_numeral nat_numeral)

text {* For termination proofs: *}
lemma measure_function_int[measure_function]: "is_measure (nat o abs)" ..

subsection{*Lemmas about the Function @{term of_nat} and Orderings*}

lemma negative_zless_0: "- (int (Suc n)) < (0 \<Colon> int)"
by (simp add: order_less_le del: of_nat_Suc)

lemma negative_zless [iff]: "- (int (Suc n)) < int m"
by (rule negative_zless_0 [THEN order_less_le_trans], simp)

lemma negative_zle_0: "- int n \<le> 0"
by (simp add: minus_le_iff)

lemma negative_zle [iff]: "- int n \<le> int m"
by (rule order_trans [OF negative_zle_0 of_nat_0_le_iff])

lemma not_zle_0_negative [simp]: "~ (0 \<le> - (int (Suc n)))"
by (subst le_minus_iff, simp del: of_nat_Suc)

lemma int_zle_neg: "(int n \<le> - int m) = (n = 0 & m = 0)"
  by transfer simp

lemma not_int_zless_negative [simp]: "~ (int n < - int m)"
by (simp add: linorder_not_less)

lemma negative_eq_positive [simp]: "(- int n = of_nat m) = (n = 0 & m = 0)"
by (force simp add: order_eq_iff [of "- of_nat n"] int_zle_neg)

lemma zle_iff_zadd: "w \<le> z \<longleftrightarrow> (\<exists>n. z = w + int n)"
proof -
  have "(w \<le> z) = (0 \<le> z - w)"
    by (simp only: le_diff_eq add_0_left)
  also have "\<dots> = (\<exists>n. z - w = of_nat n)"
    by (auto elim: zero_le_imp_eq_int)
  also have "\<dots> = (\<exists>n. z = w + of_nat n)"
    by (simp only: algebra_simps)
  finally show ?thesis .
qed

lemma zadd_int_left: "int m + (int n + z) = int (m + n) + z"
by simp

lemma int_Suc0_eq_1: "int (Suc 0) = 1"
by simp

text{*This version is proved for all ordered rings, not just integers!
      It is proved here because attribute @{text arith_split} is not available
      in theory @{text Rings}.
      But is it really better than just rewriting with @{text abs_if}?*}
lemma abs_split [arith_split, no_atp]:
     "P(abs(a::'a::linordered_idom)) = ((0 \<le> a --> P a) & (a < 0 --> P(-a)))"
by (force dest: order_less_le_trans simp add: abs_if linorder_not_less)

lemma negD: "x < 0 \<Longrightarrow> \<exists>n. x = - (int (Suc n))"
apply transfer
apply clarsimp
apply (rule_tac x="b - Suc a" in exI, arith)
done

subsection {* Cases and induction *}

text{*Now we replace the case analysis rule by a more conventional one:
whether an integer is negative or not.*}

theorem int_cases [case_names nonneg neg, cases type: int]:
  "[|!! n. z = int n ==> P;  !! n. z =  - (int (Suc n)) ==> P |] ==> P"
apply (cases "z < 0")
apply (blast dest!: negD)
apply (simp add: linorder_not_less del: of_nat_Suc)
apply auto
apply (blast dest: nat_0_le [THEN sym])
done

theorem int_of_nat_induct [case_names nonneg neg, induct type: int]:
     "[|!! n. P (int n);  !!n. P (- (int (Suc n))) |] ==> P z"
  by (cases z) auto

lemma nonneg_int_cases:
  assumes "0 \<le> k" obtains n where "k = int n"
  using assms by (rule nonneg_eq_int)

lemma Let_numeral [simp]: "Let (numeral v) f = f (numeral v)"
  -- {* Unfold all @{text let}s involving constants *}
  by (fact Let_numeral) -- {* FIXME drop *}

lemma Let_neg_numeral [simp]: "Let (- numeral v) f = f (- numeral v)"
  -- {* Unfold all @{text let}s involving constants *}
  by (fact Let_neg_numeral) -- {* FIXME drop *}

text {* Unfold @{text min} and @{text max} on numerals. *}

lemmas max_number_of [simp] =
  max_def [of "numeral u" "numeral v"]
  max_def [of "numeral u" "- numeral v"]
  max_def [of "- numeral u" "numeral v"]
  max_def [of "- numeral u" "- numeral v"] for u v

lemmas min_number_of [simp] =
  min_def [of "numeral u" "numeral v"]
  min_def [of "numeral u" "- numeral v"]
  min_def [of "- numeral u" "numeral v"]
  min_def [of "- numeral u" "- numeral v"] for u v

subsubsection {* Binary comparisons *}

text {* Preliminaries *}

lemma even_less_0_iff:
  "a + a < 0 \<longleftrightarrow> a < (0::'a::linordered_idom)"
proof -
  have "a + a < 0 \<longleftrightarrow> (1+1)*a < 0" by (simp add: distrib_right del: one_add_one)
  also have "(1+1)*a < 0 \<longleftrightarrow> a < 0"
    by (simp add: mult_less_0_iff zero_less_two
                  order_less_not_sym [OF zero_less_two])
  finally show ?thesis .
qed

lemma le_imp_0_less:
  assumes le: "0 \<le> z"
  shows "(0::int) < 1 + z"
proof -
  have "0 \<le> z" by fact
  also have "... < z + 1" by (rule less_add_one)
  also have "... = 1 + z" by (simp add: ac_simps)
  finally show "0 < 1 + z" .
qed

lemma odd_less_0_iff:
  "(1 + z + z < 0) = (z < (0::int))"
proof (cases z)
  case (nonneg n)
  thus ?thesis by (simp add: linorder_not_less add.assoc add_increasing
                             le_imp_0_less [THEN order_less_imp_le])
next
  case (neg n)
  thus ?thesis by (simp del: of_nat_Suc of_nat_add of_nat_1
    add: algebra_simps of_nat_1 [where 'a=int, symmetric] of_nat_add [symmetric])
qed

subsubsection {* Comparisons, for Ordered Rings *}

lemmas double_eq_0_iff = double_zero

lemma odd_nonzero:
  "1 + z + z \<noteq> (0::int)"
proof (cases z)
  case (nonneg n)
  have le: "0 \<le> z+z" by (simp add: nonneg add_increasing)
  thus ?thesis using  le_imp_0_less [OF le]
    by (auto simp add: add.assoc)
next
  case (neg n)
  show ?thesis
  proof
    assume eq: "1 + z + z = 0"
    have "(0::int) < 1 + (int n + int n)"
      by (simp add: le_imp_0_less add_increasing)
    also have "... = - (1 + z + z)"
      by (simp add: neg add.assoc [symmetric])
    also have "... = 0" by (simp add: eq)
    finally have "0<0" ..
    thus False by blast
  qed
qed

subsection {* The Set of Integers *}

context ring_1
begin

definition Ints  :: "'a set" where
  "Ints = range of_int"

notation (xsymbols)
  Ints  ("\<int>")

lemma Ints_of_int [simp]: "of_int z \<in> \<int>"
  by (simp add: Ints_def)

lemma Ints_of_nat [simp]: "of_nat n \<in> \<int>"
  using Ints_of_int [of "of_nat n"] by simp

lemma Ints_0 [simp]: "0 \<in> \<int>"
  using Ints_of_int [of "0"] by simp

lemma Ints_1 [simp]: "1 \<in> \<int>"
  using Ints_of_int [of "1"] by simp

lemma Ints_add [simp]: "a \<in> \<int> \<Longrightarrow> b \<in> \<int> \<Longrightarrow> a + b \<in> \<int>"
apply (auto simp add: Ints_def)
apply (rule range_eqI)
apply (rule of_int_add [symmetric])
done

lemma Ints_minus [simp]: "a \<in> \<int> \<Longrightarrow> -a \<in> \<int>"
apply (auto simp add: Ints_def)
apply (rule range_eqI)
apply (rule of_int_minus [symmetric])
done

lemma Ints_diff [simp]: "a \<in> \<int> \<Longrightarrow> b \<in> \<int> \<Longrightarrow> a - b \<in> \<int>"
apply (auto simp add: Ints_def)
apply (rule range_eqI)
apply (rule of_int_diff [symmetric])
done

lemma Ints_mult [simp]: "a \<in> \<int> \<Longrightarrow> b \<in> \<int> \<Longrightarrow> a * b \<in> \<int>"
apply (auto simp add: Ints_def)
apply (rule range_eqI)
apply (rule of_int_mult [symmetric])
done

lemma Ints_power [simp]: "a \<in> \<int> \<Longrightarrow> a ^ n \<in> \<int>"
by (induct n) simp_all

lemma Ints_cases [cases set: Ints]:
  assumes "q \<in> \<int>"
  obtains (of_int) z where "q = of_int z"
  unfolding Ints_def
proof -
  from `q \<in> \<int>` have "q \<in> range of_int" unfolding Ints_def .
  then obtain z where "q = of_int z" ..
  then show thesis ..
qed

lemma Ints_induct [case_names of_int, induct set: Ints]:
  "q \<in> \<int> \<Longrightarrow> (\<And>z. P (of_int z)) \<Longrightarrow> P q"
  by (rule Ints_cases) auto

end

text {* The premise involving @{term Ints} prevents @{term "a = 1/2"}. *}

lemma Ints_double_eq_0_iff:
  assumes in_Ints: "a \<in> Ints"
  shows "(a + a = 0) = (a = (0::'a::ring_char_0))"
proof -
  from in_Ints have "a \<in> range of_int" unfolding Ints_def [symmetric] .
  then obtain z where a: "a = of_int z" ..
  show ?thesis
  proof
    assume "a = 0"
    thus "a + a = 0" by simp
  next
    assume eq: "a + a = 0"
    hence "of_int (z + z) = (of_int 0 :: 'a)" by (simp add: a)
    hence "z + z = 0" by (simp only: of_int_eq_iff)
    hence "z = 0" by (simp only: double_eq_0_iff)
    thus "a = 0" by (simp add: a)
  qed
qed

lemma Ints_odd_nonzero:
  assumes in_Ints: "a \<in> Ints"
  shows "1 + a + a \<noteq> (0::'a::ring_char_0)"
proof -
  from in_Ints have "a \<in> range of_int" unfolding Ints_def [symmetric] .
  then obtain z where a: "a = of_int z" ..
  show ?thesis
  proof
    assume eq: "1 + a + a = 0"
    hence "of_int (1 + z + z) = (of_int 0 :: 'a)" by (simp add: a)
    hence "1 + z + z = 0" by (simp only: of_int_eq_iff)
    with odd_nonzero show False by blast
  qed
qed

lemma Nats_numeral [simp]: "numeral w \<in> Nats"
  using of_nat_in_Nats [of "numeral w"] by simp

lemma Ints_odd_less_0:
  assumes in_Ints: "a \<in> Ints"
  shows "(1 + a + a < 0) = (a < (0::'a::linordered_idom))"
proof -
  from in_Ints have "a \<in> range of_int" unfolding Ints_def [symmetric] .
  then obtain z where a: "a = of_int z" ..
  hence "((1::'a) + a + a < 0) = (of_int (1 + z + z) < (of_int 0 :: 'a))"
    by (simp add: a)
  also have "... = (z < 0)" by (simp only: of_int_less_iff odd_less_0_iff)
  also have "... = (a < 0)" by (simp add: a)
  finally show ?thesis .
qed

subsection {* @{term setsum} and @{term setprod} *}

lemma of_nat_setsum: "of_nat (setsum f A) = (\<Sum>x\<in>A. of_nat(f x))"
  apply (cases "finite A")
  apply (erule finite_induct, auto)
  done

lemma of_int_setsum: "of_int (setsum f A) = (\<Sum>x\<in>A. of_int(f x))"
  apply (cases "finite A")
  apply (erule finite_induct, auto)
  done

lemma of_nat_setprod: "of_nat (setprod f A) = (\<Prod>x\<in>A. of_nat(f x))"
  apply (cases "finite A")
  apply (erule finite_induct, auto simp add: of_nat_mult)
  done

lemma of_int_setprod: "of_int (setprod f A) = (\<Prod>x\<in>A. of_int(f x))"
  apply (cases "finite A")
  apply (erule finite_induct, auto)
  done

lemmas int_setsum = of_nat_setsum [where 'a=int]
lemmas int_setprod = of_nat_setprod [where 'a=int]

text {* Legacy theorems *}

lemmas zle_int = of_nat_le_iff [where 'a=int]
lemmas int_int_eq = of_nat_eq_iff [where 'a=int]
lemmas numeral_1_eq_1 = numeral_One

subsection {* Setting up simplification procedures *}

lemmas of_int_simps =
  of_int_0 of_int_1 of_int_add of_int_mult

lemmas int_arith_rules =
  numeral_One more_arith_simps of_nat_simps of_int_simps

ML_file "Tools/int_arith.ML"
declaration {* K Int_Arith.setup *}

simproc_setup fast_arith ("(m::'a::linordered_idom) < n" |
  "(m::'a::linordered_idom) <= n" |
  "(m::'a::linordered_idom) = n") =
  {* fn _ => fn ss => fn ct => Lin_Arith.simproc ss (term_of ct) *}

subsection{*More Inequality Reasoning*}

lemma zless_add1_eq: "(w < z + (1::int)) = (w<z | w=z)"
by arith

lemma add1_zle_eq: "(w + (1::int) \<le> z) = (w<z)"
by arith

lemma zle_diff1_eq [simp]: "(w \<le> z - (1::int)) = (w<z)"
by arith

lemma zle_add1_eq_le [simp]: "(w < z + (1::int)) = (w\<le>z)"
by arith

lemma int_one_le_iff_zero_less: "((1::int) \<le> z) = (0 < z)"
by arith

subsection{*The functions @{term nat} and @{term int}*}

text{*Simplify the term @{term "w + - z"}*}

lemma one_less_nat_eq [simp]: "(Suc 0 < nat z) = (1 < z)"
apply (insert zless_nat_conj [of 1 z])
apply auto
done

text{*This simplifies expressions of the form @{term "int n = z"} where
      z is an integer literal.*}
lemmas int_eq_iff_numeral [simp] = int_eq_iff [of _ "numeral v"] for v

lemma split_nat [arith_split]:
  "P(nat(i::int)) = ((\<forall>n. i = int n \<longrightarrow> P n) & (i < 0 \<longrightarrow> P 0))"
  (is "?P = (?L & ?R)")
proof (cases "i < 0")
  case True thus ?thesis by auto
next
  case False
  have "?P = ?L"
  proof
    assume ?P thus ?L using False by clarsimp
  next
    assume ?L thus ?P using False by simp
  qed
  with False show ?thesis by simp
qed

lemma nat_abs_int_diff: "nat \<bar>int a - int b\<bar> = (if a \<le> b then b - a else a - b)"
  by auto

lemma nat_int_add: "nat (int a + int b) = a + b"
  by auto

context ring_1
begin

lemma of_int_of_nat [nitpick_simp]:
  "of_int k = (if k < 0 then - of_nat (nat (- k)) else of_nat (nat k))"
proof (cases "k < 0")
  case True then have "0 \<le> - k" by simp
  then have "of_nat (nat (- k)) = of_int (- k)" by (rule of_nat_nat)
  with True show ?thesis by simp
next
  case False then show ?thesis by (simp add: not_less of_nat_nat)
qed

end

lemma nat_mult_distrib:
  fixes z z' :: int
  assumes "0 \<le> z"
  shows "nat (z * z') = nat z * nat z'"
proof (cases "0 \<le> z'")
  case False with assms have "z * z' \<le> 0"
    by (simp add: not_le mult_le_0_iff)
  then have "nat (z * z') = 0" by simp
  moreover from False have "nat z' = 0" by simp
  ultimately show ?thesis by simp
next
  case True with assms have ge_0: "z * z' \<ge> 0" by (simp add: zero_le_mult_iff)
  show ?thesis
    by (rule injD [of "of_nat :: nat \<Rightarrow> int", OF inj_of_nat])
      (simp only: of_nat_mult of_nat_nat [OF True]
         of_nat_nat [OF assms] of_nat_nat [OF ge_0], simp)
qed

lemma nat_mult_distrib_neg: "z \<le> (0::int) ==> nat(z*z') = nat(-z) * nat(-z')"
apply (rule trans)
apply (rule_tac [2] nat_mult_distrib, auto)
done

lemma nat_abs_mult_distrib: "nat (abs (w * z)) = nat (abs w) * nat (abs z)"
apply (cases "z=0 | w=0")
apply (auto simp add: abs_if nat_mult_distrib [symmetric]
                      nat_mult_distrib_neg [symmetric] mult_less_0_iff)
done

lemma Suc_nat_eq_nat_zadd1: "(0::int) <= z ==> Suc (nat z) = nat (1 + z)"
apply (rule sym)
apply (simp add: nat_eq_iff)
done

lemma diff_nat_eq_if:
     "nat z - nat z' =
        (if z' < 0 then nat z
         else let d = z-z' in
              if d < 0 then 0 else nat d)"
by (simp add: Let_def nat_diff_distrib [symmetric])

lemma nat_numeral_diff_1 [simp]:
  "numeral v - (1::nat) = nat (numeral v - 1)"
  using diff_nat_numeral [of v Num.One] by simp

subsection "Induction principles for int"

text{*Well-founded segments of the integers*}

definition
  int_ge_less_than  ::  "int => (int * int) set"
where
  "int_ge_less_than d = {(z',z). d \<le> z' & z' < z}"

theorem wf_int_ge_less_than: "wf (int_ge_less_than d)"
proof -
  have "int_ge_less_than d \<subseteq> measure (%z. nat (z-d))"
    by (auto simp add: int_ge_less_than_def)
  thus ?thesis
    by (rule wf_subset [OF wf_measure])
qed

text{*This variant looks odd, but is typical of the relations suggested
by RankFinder.*}

definition
  int_ge_less_than2 ::  "int => (int * int) set"
where
  "int_ge_less_than2 d = {(z',z). d \<le> z & z' < z}"

theorem wf_int_ge_less_than2: "wf (int_ge_less_than2 d)"
proof -
  have "int_ge_less_than2 d \<subseteq> measure (%z. nat (1+z-d))"
    by (auto simp add: int_ge_less_than2_def)
  thus ?thesis
    by (rule wf_subset [OF wf_measure])
qed

(* `set:int': dummy construction *)
theorem int_ge_induct [case_names base step, induct set: int]:
  fixes i :: int
  assumes ge: "k \<le> i" and
    base: "P k" and
    step: "\<And>i. k \<le> i \<Longrightarrow> P i \<Longrightarrow> P (i + 1)"
  shows "P i"
proof -
  { fix n
    have "\<And>i::int. n = nat (i - k) \<Longrightarrow> k \<le> i \<Longrightarrow> P i"
    proof (induct n)
      case 0
      hence "i = k" by arith
      thus "P i" using base by simp
    next
      case (Suc n)
      then have "n = nat((i - 1) - k)" by arith
      moreover
      have ki1: "k \<le> i - 1" using Suc.prems by arith
      ultimately
      have "P (i - 1)" by (rule Suc.hyps)
      from step [OF ki1 this] show ?case by simp
    qed
  }
  with ge show ?thesis by fast
qed

(* `set:int': dummy construction *)
theorem int_gr_induct [case_names base step, induct set: int]:
  assumes gr: "k < (i::int)" and
        base: "P(k+1)" and
        step: "\<And>i. \<lbrakk>k < i; P i\<rbrakk> \<Longrightarrow> P(i+1)"
  shows "P i"
apply(rule int_ge_induct[of "k + 1"])
  using gr apply arith
 apply(rule base)
apply (rule step, simp+)
done

theorem int_le_induct [consumes 1, case_names base step]:
  assumes le: "i \<le> (k::int)" and
        base: "P(k)" and
        step: "\<And>i. \<lbrakk>i \<le> k; P i\<rbrakk> \<Longrightarrow> P(i - 1)"
  shows "P i"
proof -
  { fix n
    have "\<And>i::int. n = nat(k-i) \<Longrightarrow> i \<le> k \<Longrightarrow> P i"
    proof (induct n)
      case 0
      hence "i = k" by arith
      thus "P i" using base by simp
    next
      case (Suc n)
      hence "n = nat (k - (i + 1))" by arith
      moreover
      have ki1: "i + 1 \<le> k" using Suc.prems by arith
      ultimately
      have "P (i + 1)" by(rule Suc.hyps)
      from step[OF ki1 this] show ?case by simp
    qed
  }
  with le show ?thesis by fast
qed

theorem int_less_induct [consumes 1, case_names base step]:
  assumes less: "(i::int) < k" and
        base: "P(k - 1)" and
        step: "\<And>i. \<lbrakk>i < k; P i\<rbrakk> \<Longrightarrow> P(i - 1)"
  shows "P i"
apply(rule int_le_induct[of _ "k - 1"])
  using less apply arith
 apply(rule base)
apply (rule step, simp+)
done

theorem int_induct [case_names base step1 step2]:
  fixes k :: int
  assumes base: "P k"
    and step1: "\<And>i. k \<le> i \<Longrightarrow> P i \<Longrightarrow> P (i + 1)"
    and step2: "\<And>i. k \<ge> i \<Longrightarrow> P i \<Longrightarrow> P (i - 1)"
  shows "P i"
proof -
  have "i \<le> k \<or> i \<ge> k" by arith
  then show ?thesis
  proof
    assume "i \<ge> k"
    then show ?thesis using base
      by (rule int_ge_induct) (fact step1)
  next
    assume "i \<le> k"
    then show ?thesis using base
      by (rule int_le_induct) (fact step2)
  qed
qed

subsection{*Intermediate value theorems*}

lemma int_val_lemma:
     "(\<forall>i<n::nat. abs(f(i+1) - f i) \<le> 1) -->
      f 0 \<le> k --> k \<le> f n --> (\<exists>i \<le> n. f i = (k::int))"
unfolding One_nat_def
apply (induct n)
apply simp
apply (intro strip)
apply (erule impE, simp)
apply (erule_tac x = n in allE, simp)
apply (case_tac "k = f (Suc n)")
apply force
apply (erule impE)
 apply (simp add: abs_if split add: split_if_asm)
apply (blast intro: le_SucI)
done

lemmas nat0_intermed_int_val = int_val_lemma [rule_format (no_asm)]

lemma nat_intermed_int_val:
     "[| \<forall>i. m \<le> i & i < n --> abs(f(i + 1::nat) - f i) \<le> 1; m < n;
         f m \<le> k; k \<le> f n |] ==> ? i. m \<le> i & i \<le> n & f i = (k::int)"
apply (cut_tac n = "n-m" and f = "%i. f (i+m) " and k = k
       in int_val_lemma)
unfolding One_nat_def
apply simp
apply (erule exE)
apply (rule_tac x = "i+m" in exI, arith)
done

subsection{*Products and 1, by T. M. Rasmussen*}

lemma zabs_less_one_iff [simp]: "(\<bar>z\<bar> < 1) = (z = (0::int))"
by arith

lemma abs_zmult_eq_1:
  assumes mn: "\<bar>m * n\<bar> = 1"
  shows "\<bar>m\<bar> = (1::int)"
proof -
  have 0: "m \<noteq> 0 & n \<noteq> 0" using mn
    by auto
  have "~ (2 \<le> \<bar>m\<bar>)"
  proof
    assume "2 \<le> \<bar>m\<bar>"
    hence "2*\<bar>n\<bar> \<le> \<bar>m\<bar>*\<bar>n\<bar>"
      by (simp add: mult_mono 0)
    also have "... = \<bar>m*n\<bar>"
      by (simp add: abs_mult)
    also have "... = 1"
      by (simp add: mn)
    finally have "2*\<bar>n\<bar> \<le> 1" .
    thus "False" using 0
      by arith
  qed
  thus ?thesis using 0
    by auto
qed

lemma pos_zmult_eq_1_iff_lemma: "(m * n = 1) ==> m = (1::int) | m = -1"
by (insert abs_zmult_eq_1 [of m n], arith)

lemma pos_zmult_eq_1_iff:
  assumes "0 < (m::int)" shows "(m * n = 1) = (m = 1 & n = 1)"
proof -
  from assms have "m * n = 1 ==> m = 1" by (auto dest: pos_zmult_eq_1_iff_lemma)
  thus ?thesis by (auto dest: pos_zmult_eq_1_iff_lemma)
qed

lemma zmult_eq_1_iff: "(m*n = (1::int)) = ((m = 1 & n = 1) | (m = -1 & n = -1))"
apply (rule iffI)
 apply (frule pos_zmult_eq_1_iff_lemma)
 apply (simp add: mult.commute [of m])
 apply (frule pos_zmult_eq_1_iff_lemma, auto)
done

lemma infinite_UNIV_int: "\<not> finite (UNIV::int set)"
proof
  assume "finite (UNIV::int set)"
  moreover have "inj (\<lambda>i\<Colon>int. 2 * i)"
    by (rule injI) simp
  ultimately have "surj (\<lambda>i\<Colon>int. 2 * i)"
    by (rule finite_UNIV_inj_surj)
  then obtain i :: int where "1 = 2 * i" by (rule surjE)
  then show False by (simp add: pos_zmult_eq_1_iff)
qed

subsection {* Further theorems on numerals *}

subsubsection{*Special Simplification for Constants*}

text{*These distributive laws move literals inside sums and differences.*}

lemmas distrib_right_numeral [simp] = distrib_right [of _ _ "numeral v"] for v
lemmas distrib_left_numeral [simp] = distrib_left [of "numeral v"] for v
lemmas left_diff_distrib_numeral [simp] = left_diff_distrib [of _ _ "numeral v"] for v
lemmas right_diff_distrib_numeral [simp] = right_diff_distrib [of "numeral v"] for v

text{*These are actually for fields, like real: but where else to put them?*}

lemmas zero_less_divide_iff_numeral [simp, no_atp] = zero_less_divide_iff [of "numeral w"] for w
lemmas divide_less_0_iff_numeral [simp, no_atp] = divide_less_0_iff [of "numeral w"] for w
lemmas zero_le_divide_iff_numeral [simp, no_atp] = zero_le_divide_iff [of "numeral w"] for w
lemmas divide_le_0_iff_numeral [simp, no_atp] = divide_le_0_iff [of "numeral w"] for w

text {*Replaces @{text "inverse #nn"} by @{text "1/#nn"}.  It looks
  strange, but then other simprocs simplify the quotient.*}

lemmas inverse_eq_divide_numeral [simp] =
  inverse_eq_divide [of "numeral w"] for w

lemmas inverse_eq_divide_neg_numeral [simp] =
  inverse_eq_divide [of "- numeral w"] for w

text {*These laws simplify inequalities, moving unary minus from a term
into the literal.*}

lemmas equation_minus_iff_numeral [no_atp] =
  equation_minus_iff [of "numeral v"] for v

lemmas minus_equation_iff_numeral [no_atp] =
  minus_equation_iff [of _ "numeral v"] for v

lemmas le_minus_iff_numeral [no_atp] =
  le_minus_iff [of "numeral v"] for v

lemmas minus_le_iff_numeral [no_atp] =
  minus_le_iff [of _ "numeral v"] for v

lemmas less_minus_iff_numeral [no_atp] =
  less_minus_iff [of "numeral v"] for v

lemmas minus_less_iff_numeral [no_atp] =
  minus_less_iff [of _ "numeral v"] for v

-- {* FIXME maybe simproc *}

text {*Cancellation of constant factors in comparisons (@{text "<"} and @{text "\<le>"}) *}

lemmas mult_less_cancel_left_numeral [simp, no_atp] = mult_less_cancel_left [of "numeral v"] for v
lemmas mult_less_cancel_right_numeral [simp, no_atp] = mult_less_cancel_right [of _ "numeral v"] for v
lemmas mult_le_cancel_left_numeral [simp, no_atp] = mult_le_cancel_left [of "numeral v"] for v
lemmas mult_le_cancel_right_numeral [simp, no_atp] = mult_le_cancel_right [of _ "numeral v"] for v

text {*Multiplying out constant divisors in comparisons (@{text "<"}, @{text "\<le>"} and @{text "="}) *}

lemmas le_divide_eq_numeral1 [simp] =
  pos_le_divide_eq [of "numeral w", OF zero_less_numeral]
  neg_le_divide_eq [of "- numeral w", OF neg_numeral_less_zero] for w

lemmas divide_le_eq_numeral1 [simp] =
  pos_divide_le_eq [of "numeral w", OF zero_less_numeral]
  neg_divide_le_eq [of "- numeral w", OF neg_numeral_less_zero] for w

lemmas less_divide_eq_numeral1 [simp] =
  pos_less_divide_eq [of "numeral w", OF zero_less_numeral]
  neg_less_divide_eq [of "- numeral w", OF neg_numeral_less_zero] for w

lemmas divide_less_eq_numeral1 [simp] =
  pos_divide_less_eq [of "numeral w", OF zero_less_numeral]
  neg_divide_less_eq [of "- numeral w", OF neg_numeral_less_zero] for w

lemmas eq_divide_eq_numeral1 [simp] =
  eq_divide_eq [of _ _ "numeral w"]
  eq_divide_eq [of _ _ "- numeral w"] for w

lemmas divide_eq_eq_numeral1 [simp] =
  divide_eq_eq [of _ "numeral w"]
  divide_eq_eq [of _ "- numeral w"] for w

subsubsection{*Optional Simplification Rules Involving Constants*}

text{*Simplify quotients that are compared with a literal constant.*}

lemmas le_divide_eq_numeral =
  le_divide_eq [of "numeral w"]
  le_divide_eq [of "- numeral w"] for w

lemmas divide_le_eq_numeral =
  divide_le_eq [of _ _ "numeral w"]
  divide_le_eq [of _ _ "- numeral w"] for w

lemmas less_divide_eq_numeral =
  less_divide_eq [of "numeral w"]
  less_divide_eq [of "- numeral w"] for w

lemmas divide_less_eq_numeral =
  divide_less_eq [of _ _ "numeral w"]
  divide_less_eq [of _ _ "- numeral w"] for w

lemmas eq_divide_eq_numeral =
  eq_divide_eq [of "numeral w"]
  eq_divide_eq [of "- numeral w"] for w

lemmas divide_eq_eq_numeral =
  divide_eq_eq [of _ _ "numeral w"]
  divide_eq_eq [of _ _ "- numeral w"] for w

text{*Not good as automatic simprules because they cause case splits.*}
lemmas divide_const_simps =
  le_divide_eq_numeral divide_le_eq_numeral less_divide_eq_numeral
  divide_less_eq_numeral eq_divide_eq_numeral divide_eq_eq_numeral
  le_divide_eq_1 divide_le_eq_1 less_divide_eq_1 divide_less_eq_1

subsection {* The divides relation *}

lemma zdvd_antisym_nonneg:
    "0 <= m ==> 0 <= n ==> m dvd n ==> n dvd m ==> m = (n::int)"
  apply (simp add: dvd_def, auto)
  apply (auto simp add: mult.assoc zero_le_mult_iff zmult_eq_1_iff)
  done

lemma zdvd_antisym_abs: assumes "(a::int) dvd b" and "b dvd a"
  shows "\<bar>a\<bar> = \<bar>b\<bar>"
proof cases
  assume "a = 0" with assms show ?thesis by simp
next
  assume "a \<noteq> 0"
  from `a dvd b` obtain k where k:"b = a*k" unfolding dvd_def by blast
  from `b dvd a` obtain k' where k':"a = b*k'" unfolding dvd_def by blast
  from k k' have "a = a*k*k'" by simp
  with mult_cancel_left1[where c="a" and b="k*k'"]
  have kk':"k*k' = 1" using `a\<noteq>0` by (simp add: mult.assoc)
  hence "k = 1 \<and> k' = 1 \<or> k = -1 \<and> k' = -1" by (simp add: zmult_eq_1_iff)
  thus ?thesis using k k' by auto
qed

lemma zdvd_zdiffD: "k dvd m - n ==> k dvd n ==> k dvd (m::int)"
  using dvd_add_right_iff [of k "- n" m] by simp

lemma zdvd_reduce: "(k dvd n + k * m) = (k dvd (n::int))"
  using dvd_add_times_triv_right_iff [of k n m] by (simp add: ac_simps)

lemma dvd_imp_le_int:
  fixes d i :: int
  assumes "i \<noteq> 0" and "d dvd i"
  shows "\<bar>d\<bar> \<le> \<bar>i\<bar>"
proof -
  from `d dvd i` obtain k where "i = d * k" ..
  with `i \<noteq> 0` have "k \<noteq> 0" by auto
  then have "1 \<le> \<bar>k\<bar>" and "0 \<le> \<bar>d\<bar>" by auto
  then have "\<bar>d\<bar> * 1 \<le> \<bar>d\<bar> * \<bar>k\<bar>" by (rule mult_left_mono)
  with `i = d * k` show ?thesis by (simp add: abs_mult)
qed

lemma zdvd_not_zless:
  fixes m n :: int
  assumes "0 < m" and "m < n"
  shows "\<not> n dvd m"
proof
  from assms have "0 < n" by auto
  assume "n dvd m" then obtain k where k: "m = n * k" ..
  with `0 < m` have "0 < n * k" by auto
  with `0 < n` have "0 < k" by (simp add: zero_less_mult_iff)
  with k `0 < n` `m < n` have "n * k < n * 1" by simp
  with `0 < n` `0 < k` show False unfolding mult_less_cancel_left by auto
qed

lemma zdvd_mult_cancel: assumes d:"k * m dvd k * n" and kz:"k \<noteq> (0::int)"
  shows "m dvd n"
proof-
  from d obtain h where h: "k*n = k*m * h" unfolding dvd_def by blast
  {assume "n \<noteq> m*h" hence "k* n \<noteq> k* (m*h)" using kz by simp
    with h have False by (simp add: mult.assoc)}
  hence "n = m * h" by blast
  thus ?thesis by simp
qed

theorem zdvd_int: "(x dvd y) = (int x dvd int y)"
proof -
  have "\<And>k. int y = int x * k \<Longrightarrow> x dvd y"
  proof -
    fix k
    assume A: "int y = int x * k"
    then show "x dvd y"
    proof (cases k)
      case (nonneg n)
      with A have "y = x * n" by (simp add: of_nat_mult [symmetric])
      then show ?thesis ..
    next
      case (neg n)
      with A have "int y = int x * (- int (Suc n))" by simp
      also have "\<dots> = - (int x * int (Suc n))" by (simp only: mult_minus_right)
      also have "\<dots> = - int (x * Suc n)" by (simp only: of_nat_mult [symmetric])
      finally have "- int (x * Suc n) = int y" ..
      then show ?thesis by (simp only: negative_eq_positive) auto
    qed
  qed
  then show ?thesis by (auto elim!: dvdE simp only: dvd_triv_left of_nat_mult)
qed

lemma zdvd1_eq[simp]: "(x::int) dvd 1 = (\<bar>x\<bar> = 1)"
proof
  assume d: "x dvd 1" hence "int (nat \<bar>x\<bar>) dvd int (nat 1)" by simp
  hence "nat \<bar>x\<bar> dvd 1" by (simp add: zdvd_int)
  hence "nat \<bar>x\<bar> = 1"  by simp
  thus "\<bar>x\<bar> = 1" by (cases "x < 0") auto
next
  assume "\<bar>x\<bar>=1"
  then have "x = 1 \<or> x = -1" by auto
  then show "x dvd 1" by (auto intro: dvdI)
qed

lemma zdvd_mult_cancel1:
  assumes mp:"m \<noteq>(0::int)" shows "(m * n dvd m) = (\<bar>n\<bar> = 1)"
proof
  assume n1: "\<bar>n\<bar> = 1" thus "m * n dvd m"
    by (cases "n >0") (auto simp add: minus_equation_iff)
next
  assume H: "m * n dvd m" hence H2: "m * n dvd m * 1" by simp
  from zdvd_mult_cancel[OF H2 mp] show "\<bar>n\<bar> = 1" by (simp only: zdvd1_eq)
qed

lemma int_dvd_iff: "(int m dvd z) = (m dvd nat (abs z))"
  unfolding zdvd_int by (cases "z \<ge> 0") simp_all

lemma dvd_int_iff: "(z dvd int m) = (nat (abs z) dvd m)"
  unfolding zdvd_int by (cases "z \<ge> 0") simp_all

lemma dvd_int_unfold_dvd_nat:
  "k dvd l \<longleftrightarrow> nat \<bar>k\<bar> dvd nat \<bar>l\<bar>"
  unfolding dvd_int_iff [symmetric] by simp

lemma nat_dvd_iff: "(nat z dvd m) = (if 0 \<le> z then (z dvd int m) else m = 0)"
  by (auto simp add: dvd_int_iff)

lemma eq_nat_nat_iff:
  "0 \<le> z \<Longrightarrow> 0 \<le> z' \<Longrightarrow> nat z = nat z' \<longleftrightarrow> z = z'"
  by (auto elim!: nonneg_eq_int)

lemma nat_power_eq:
  "0 \<le> z \<Longrightarrow> nat (z ^ n) = nat z ^ n"
  by (induct n) (simp_all add: nat_mult_distrib)

lemma zdvd_imp_le: "[| z dvd n; 0 < n |] ==> z \<le> (n::int)"
  apply (cases n)
  apply (auto simp add: dvd_int_iff)
  apply (cases z)
  apply (auto simp add: dvd_imp_le)
  done

lemma zdvd_period:
  fixes a d :: int
  assumes "a dvd d"
  shows "a dvd (x + t) \<longleftrightarrow> a dvd ((x + c * d) + t)"
proof -
  from assms obtain k where "d = a * k" by (rule dvdE)
  show ?thesis
  proof
    assume "a dvd (x + t)"
    then obtain l where "x + t = a * l" by (rule dvdE)
    then have "x = a * l - t" by simp
    with `d = a * k` show "a dvd x + c * d + t" by simp
  next
    assume "a dvd x + c * d + t"
    then obtain l where "x + c * d + t = a * l" by (rule dvdE)
    then have "x = a * l - c * d - t" by simp
    with `d = a * k` show "a dvd (x + t)" by simp
  qed
qed

subsection {* Finiteness of intervals *}

lemma finite_interval_int1 [iff]: "finite {i :: int. a <= i & i <= b}"
proof (cases "a <= b")
  case True
  from this show ?thesis
  proof (induct b rule: int_ge_induct)
    case base
    have "{i. a <= i & i <= a} = {a}" by auto
    from this show ?case by simp
  next
    case (step b)
    from this have "{i. a <= i & i <= b + 1} = {i. a <= i & i <= b} \<union> {b + 1}" by auto
    from this step show ?case by simp
  qed
next
  case False from this show ?thesis
    by (metis (lifting, no_types) Collect_empty_eq finite.emptyI order_trans)
qed

lemma finite_interval_int2 [iff]: "finite {i :: int. a <= i & i < b}"
by (rule rev_finite_subset[OF finite_interval_int1[of "a" "b"]]) auto

lemma finite_interval_int3 [iff]: "finite {i :: int. a < i & i <= b}"
by (rule rev_finite_subset[OF finite_interval_int1[of "a" "b"]]) auto

lemma finite_interval_int4 [iff]: "finite {i :: int. a < i & i < b}"
by (rule rev_finite_subset[OF finite_interval_int1[of "a" "b"]]) auto

subsection {* Configuration of the code generator *}

text {* Constructors *}

definition Pos :: "num \<Rightarrow> int" where
  [simp, code_abbrev]: "Pos = numeral"

definition Neg :: "num \<Rightarrow> int" where
  [simp, code_abbrev]: "Neg n = - (Pos n)"

code_datatype "0::int" Pos Neg

text {* Auxiliary operations *}

definition dup :: "int \<Rightarrow> int" where
  [simp]: "dup k = k + k"

lemma dup_code [code]:
  "dup 0 = 0"
  "dup (Pos n) = Pos (Num.Bit0 n)"
  "dup (Neg n) = Neg (Num.Bit0 n)"
  unfolding Pos_def Neg_def
  by (simp_all add: numeral_Bit0)

definition sub :: "num \<Rightarrow> num \<Rightarrow> int" where
  [simp]: "sub m n = numeral m - numeral n"

lemma sub_code [code]:
  "sub Num.One Num.One = 0"
  "sub (Num.Bit0 m) Num.One = Pos (Num.BitM m)"
  "sub (Num.Bit1 m) Num.One = Pos (Num.Bit0 m)"
  "sub Num.One (Num.Bit0 n) = Neg (Num.BitM n)"
  "sub Num.One (Num.Bit1 n) = Neg (Num.Bit0 n)"
  "sub (Num.Bit0 m) (Num.Bit0 n) = dup (sub m n)"
  "sub (Num.Bit1 m) (Num.Bit1 n) = dup (sub m n)"
  "sub (Num.Bit1 m) (Num.Bit0 n) = dup (sub m n) + 1"
  "sub (Num.Bit0 m) (Num.Bit1 n) = dup (sub m n) - 1"
  apply (simp_all only: sub_def dup_def numeral.simps Pos_def Neg_def numeral_BitM)
  apply (simp_all only: algebra_simps minus_diff_eq)
  apply (simp_all only: add.commute [of _ "- (numeral n + numeral n)"])
  apply (simp_all only: minus_add add.assoc left_minus)
  done

text {* Implementations *}

lemma one_int_code [code, code_unfold]:
  "1 = Pos Num.One"
  by simp

lemma plus_int_code [code]:
  "k + 0 = (k::int)"
  "0 + l = (l::int)"
  "Pos m + Pos n = Pos (m + n)"
  "Pos m + Neg n = sub m n"
  "Neg m + Pos n = sub n m"
  "Neg m + Neg n = Neg (m + n)"
  by simp_all

lemma uminus_int_code [code]:
  "uminus 0 = (0::int)"
  "uminus (Pos m) = Neg m"
  "uminus (Neg m) = Pos m"
  by simp_all

lemma minus_int_code [code]:
  "k - 0 = (k::int)"
  "0 - l = uminus (l::int)"
  "Pos m - Pos n = sub m n"
  "Pos m - Neg n = Pos (m + n)"
  "Neg m - Pos n = Neg (m + n)"
  "Neg m - Neg n = sub n m"
  by simp_all

lemma times_int_code [code]:
  "k * 0 = (0::int)"
  "0 * l = (0::int)"
  "Pos m * Pos n = Pos (m * n)"
  "Pos m * Neg n = Neg (m * n)"
  "Neg m * Pos n = Neg (m * n)"
  "Neg m * Neg n = Pos (m * n)"
  by simp_all

instantiation int :: equal
begin

definition
  "HOL.equal k l \<longleftrightarrow> k = (l::int)"

instance by default (rule equal_int_def)

end

lemma equal_int_code [code]:
  "HOL.equal 0 (0::int) \<longleftrightarrow> True"
  "HOL.equal 0 (Pos l) \<longleftrightarrow> False"
  "HOL.equal 0 (Neg l) \<longleftrightarrow> False"
  "HOL.equal (Pos k) 0 \<longleftrightarrow> False"
  "HOL.equal (Pos k) (Pos l) \<longleftrightarrow> HOL.equal k l"
  "HOL.equal (Pos k) (Neg l) \<longleftrightarrow> False"
  "HOL.equal (Neg k) 0 \<longleftrightarrow> False"
  "HOL.equal (Neg k) (Pos l) \<longleftrightarrow> False"
  "HOL.equal (Neg k) (Neg l) \<longleftrightarrow> HOL.equal k l"
  by (auto simp add: equal)

lemma equal_int_refl [code nbe]:
  "HOL.equal (k::int) k \<longleftrightarrow> True"
  by (fact equal_refl)

lemma less_eq_int_code [code]:
  "0 \<le> (0::int) \<longleftrightarrow> True"
  "0 \<le> Pos l \<longleftrightarrow> True"
  "0 \<le> Neg l \<longleftrightarrow> False"
  "Pos k \<le> 0 \<longleftrightarrow> False"
  "Pos k \<le> Pos l \<longleftrightarrow> k \<le> l"
  "Pos k \<le> Neg l \<longleftrightarrow> False"
  "Neg k \<le> 0 \<longleftrightarrow> True"
  "Neg k \<le> Pos l \<longleftrightarrow> True"
  "Neg k \<le> Neg l \<longleftrightarrow> l \<le> k"
  by simp_all

lemma less_int_code [code]:
  "0 < (0::int) \<longleftrightarrow> False"
  "0 < Pos l \<longleftrightarrow> True"
  "0 < Neg l \<longleftrightarrow> False"
  "Pos k < 0 \<longleftrightarrow> False"
  "Pos k < Pos l \<longleftrightarrow> k < l"
  "Pos k < Neg l \<longleftrightarrow> False"
  "Neg k < 0 \<longleftrightarrow> True"
  "Neg k < Pos l \<longleftrightarrow> True"
  "Neg k < Neg l \<longleftrightarrow> l < k"
  by simp_all

lemma nat_code [code]:
  "nat (Int.Neg k) = 0"
  "nat 0 = 0"
  "nat (Int.Pos k) = nat_of_num k"
  by (simp_all add: nat_of_num_numeral)

lemma (in ring_1) of_int_code [code]:
  "of_int (Int.Neg k) = - numeral k"
  "of_int 0 = 0"
  "of_int (Int.Pos k) = numeral k"
  by simp_all

text {* Serializer setup *}

code_identifier
  code_module Int \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith

quickcheck_params [default_type = int]

hide_const (open) Pos Neg sub dup

subsection {* Legacy theorems *}

lemmas inj_int = inj_of_nat [where 'a=int]
lemmas zadd_int = of_nat_add [where 'a=int, symmetric]
lemmas int_mult = of_nat_mult [where 'a=int]
lemmas zmult_int = of_nat_mult [where 'a=int, symmetric]
lemmas int_eq_0_conv = of_nat_eq_0_iff [where 'a=int and m="n"] for n
lemmas zless_int = of_nat_less_iff [where 'a=int]
lemmas int_less_0_conv = of_nat_less_0_iff [where 'a=int and m="k"] for k
lemmas zero_less_int_conv = of_nat_0_less_iff [where 'a=int]
lemmas zero_zle_int = of_nat_0_le_iff [where 'a=int]
lemmas int_le_0_conv = of_nat_le_0_iff [where 'a=int and m="n"] for n
lemmas int_0 = of_nat_0 [where 'a=int]
lemmas int_1 = of_nat_1 [where 'a=int]
lemmas int_Suc = of_nat_Suc [where 'a=int]
lemmas int_numeral = of_nat_numeral [where 'a=int]
lemmas abs_int_eq = abs_of_nat [where 'a=int and n="m"] for m
lemmas of_int_int_eq = of_int_of_nat_eq [where 'a=int]
lemmas zdiff_int = of_nat_diff [where 'a=int, symmetric]
lemmas zpower_numeral_even = power_numeral_even [where 'a=int]
lemmas zpower_numeral_odd = power_numeral_odd [where 'a=int]

lemma zpower_zpower:
  "(x ^ y) ^ z = (x ^ (y * z)::int)"
  by (rule power_mult [symmetric])

lemma int_power:
  "int (m ^ n) = int m ^ n"
  by (fact of_nat_power)

lemmas zpower_int = int_power [symmetric]

text {* De-register @{text "int"} as a quotient type: *}

lifting_update int.lifting
lifting_forget int.lifting

end


theory Bin_Search
imports "../sepref/IICF/IICF" "List-Index.List_Index"
begin

  subsection \<open>Binary Search\<close>

  subsubsection \<open>Abstract Algorithm\<close>

  abbreviation "bin_search_invar xs x \<equiv> (\<lambda>(l,h).
        0\<le>l \<and> l\<le>h \<and> h\<le>length xs
      \<and> (\<forall>i<l. xs!i<x) \<and> (\<forall>i\<in>{h..<length xs}. x \<le> xs!i))"

  definition "bin_search xs x \<equiv> do {
    (l,h) \<leftarrow> WHILEIT (bin_search_invar xs x)
      (\<lambda>(l,h). l<h)
      (\<lambda>(l,h). do {
        ASSERT (l<length xs \<and> h\<le>length xs \<and> l\<le>h);
        let m = l + (h-l) div 2;
        if xs!m < x then RETURN (m+1,h) else RETURN (l,m)
      })
      (0,length xs);
    RETURN l
  }"

  definition "fi_spec xs x = SPEC (\<lambda>i. i=find_index (\<lambda>y. x\<le>y) xs)"

  lemma bin_search_correct:
    assumes "sorted xs"
    shows "bin_search xs x \<le> SPEC (\<lambda>i. i=find_index (\<lambda>y. x\<le>y) xs)"
    unfolding bin_search_def
    apply (refine_vcg WHILEIT_rule[where R="measure (\<lambda>(l,h). h-l)"])
    apply (all \<open>(auto;fail)?\<close>)

    apply (clarsimp simp: less_Suc_eq_le)
    subgoal for l h i
      apply (frule sorted_nth_mono[OF assms, of i "l + (h-l) div 2"])
      by auto
    subgoal
      by clarsimp (meson assms leI le_less_trans sorted_iff_nth_mono)

    apply clarsimp
    subgoal for i
      by (simp add: find_index_eqI less_le_not_le)

    done

  lemma bin_search_correct': "(uncurry bin_search,uncurry fi_spec)
    \<in>[\<lambda>(xs,_). sorted xs]\<^sub>f Id \<times>\<^sub>r Id \<rightarrow> \<langle>nat_rel\<rangle>nres_rel"
    using bin_search_correct unfolding fi_spec_def
    by (fastforce intro!: frefI nres_relI)

  subsubsection \<open>Implementation\<close>

  type_synonym size_t = 64
  type_synonym elem_t = 64

  sepref_def bin_search_impl is "uncurry bin_search"
    :: "(larray_assn' TYPE(size_t) (sint_assn' TYPE(elem_t)))\<^sup>k
        *\<^sub>a (sint_assn' TYPE(elem_t))\<^sup>k
       \<rightarrow>\<^sub>a snat_assn' TYPE(size_t)"
    unfolding bin_search_def
    apply (rule hfref_with_rdomI)
    apply (annot_snat_const "TYPE(size_t)")
    apply sepref
    done

  definition [llvm_code, llvm_inline]: "bin_search_impl' a x \<equiv> doM {
    a \<leftarrow> ll_load a;
    bin_search_impl a x
  }"

  export_llvm bin_search_impl' is \<open>int64_t bin_search(larray_t*, elem_t)\<close>
  defines \<open>
    typedef uint64_t elem_t;
    typedef struct {
      int64_t len;
      elem_t *data;
    } larray_t;
  \<close>
  file "../../regression/gencode/bin_search.ll"

  export_llvm bin_search_impl' is \<open>int64_t bin_search(larray_t*, elem_t)\<close>
  defines \<open>
    typedef uint64_t elem_t;
    typedef struct {
      int64_t len;
      elem_t *data;
    } larray_t;
  \<close>
  file "code/bin_search.ll"

  lemmas bs_impl_correct = bin_search_impl.refine[FCOMP bin_search_correct']

  subsubsection \<open>Combined Correctness Theorem\<close>

  theorem bin_search_impl_correct:
    "llvm_htriple
      (larray_assn sint_assn xs xsi ** sint_assn x xi ** \<up>(sorted xs))
      (bin_search_impl xsi xi)
      (\<lambda>ii. EXS i. larray_assn sint_assn xs xsi ** sint_assn x xi ** snat_assn i ii
                  ** \<up>(i=find_index (\<lambda>y. x\<le>y) xs))"
  proof -

    from bin_search_correct have R:
        "(uncurry bin_search, uncurry (\<lambda>xs x. SPEC (\<lambda>i. i = find_index ((\<le>) x) xs)))
      \<in> [\<lambda>(xs,x). sorted xs]\<^sub>f Id \<rightarrow> \<langle>Id\<rangle>nres_rel"
      apply (intro frefI nres_relI)
      apply fastforce
      done

    note bin_search_impl.refine
    note R = bin_search_impl.refine[FCOMP R]
    note R = R[THEN hfrefD, THEN hn_refineD, of "(xs,x)" "(xsi,xi)", simplified]
    note [vcg_rules] = R

    show ?thesis by vcg'
  qed

  theorem bin_search_impl'_correct:
    "llvm_htriple
      (\<upharpoonleft>ll_pto xsi xsip ** larray_assn sint_assn xs xsi ** sint_assn x xi ** \<up>(sorted xs))
      (bin_search_impl' xsip xi)
      (\<lambda>ii. EXS i. \<upharpoonleft>ll_pto xsi xsip ** larray_assn sint_assn xs xsi ** sint_assn x xi ** snat_assn i ii
                  ** \<up>(i=find_index (\<lambda>y. x\<le>y) xs))"
  proof -
    interpret llvm_prim_setup .
    show ?thesis
      unfolding bin_search_impl'_def
      supply [vcg_rules] = bin_search_impl_correct
      by vcg
  qed

end


theory Submission
  imports Defs
begin

type_synonym vname = string

(* Arithmetic expressions *)

datatype aexp = N nat | V vname | Plus aexp aexp

fun subterms :: "aexp ⇒ aexp set" where
  "subterms (N n) = {N n}" |
  "subterms (V v) = {V v}" |
  "subterms (Plus e⇩1 e⇩2) = {Plus e⇩1 e⇩2} ∪ subterms e⇩1 ∪ subterms e⇩2"

lemma e_is_subterm_e: "e ∈ subterms e"
  apply(induction e)
  apply(auto)
  done

definition "strict_subterms e = subterms e - {e}"

lemma strict_subt_le_subt: "strict_subterms e ⊂ subterms e"
  using e_is_subterm_e order_less_le strict_subterms_def by auto

lemma e_does_not_contain_e: "e ∉ strict_subterms e"
  by (simp add: strict_subterms_def)

lemma subt_trans: "f ∈ subterms e ⟹ g ∈ subterms f ⟹ g ∈ subterms e"
  apply(induction e)
  apply(auto)
  done

lemma subt_not_parent: "e ≠ f ⟹ f ∈ subterms e ⟹ e ∉ subterms f"
proof(induction e arbitrary: f)
  case (Plus e1 e2)
  have "f ∈ subterms e1 ∨ f ∈ subterms e2" using Plus.prems(1) Plus.prems(2) by auto
  then show ?case
  proof(cases "f ∈ subterms e1")
    case True
    then show ?thesis
    proof(cases "f = e1")
      case True
      then show ?thesis using Plus.IH(1) Plus.prems(2) by force
    next
      case False
      have "e1 ∉ subterms f" using False Plus.IH(1) True by presburger
      moreover
      have "e1 ∈ subterms (Plus e1 e2)" using e_is_subterm_e by auto
      moreover
      have "(Plus e1 e2) ∉ subterms f" using calculation(1) calculation(2) subt_trans by blast
      ultimately
      show ?thesis by blast
    qed
  next
    case False
    have "f ∈ subterms e2" using False ‹f ∈ subterms e1 ∨ f ∈ subterms e2› by auto
    then show ?thesis
    proof(cases "f = e2")
      case True
      then show ?thesis using Plus.IH(2) Plus.prems(2) by force
    next
      case False
      have "e2 ∉ subterms f" using False Plus.IH(2) ‹f ∈ subterms e2› by presburger
      moreover
      have "e2 ∈ subterms (Plus e1 e2)" using e_is_subterm_e by fastforce
      moreover
      have "(Plus e1 e2) ∉ subterms f" using calculation(1) calculation(2) subt_trans by blast
      ultimately
      show ?thesis by blast
    qed
  qed
qed simp_all

fun strict_subterms' :: "aexp ⇒ aexp set" where
  "strict_subterms' (N _) = {}" |
  "strict_subterms' (V _) = {}" |
  "strict_subterms' (Plus e⇩1 e⇩2) = subterms e⇩1 ∪ subterms e⇩2"

lemma strict_subt_eq_strict_subt': "strict_subterms e = strict_subterms' e"
proof(cases e)
  case (Plus e⇩1 e⇩2)
  have "strict_subterms e = subterms e - {e}" using strict_subterms_def by force
  also have "… = ({Plus e⇩1 e⇩2} ∪ subterms e⇩1 ∪ subterms e⇩2) - {Plus e⇩1 e⇩2}"
    using Plus subterms.simps(3) by presburger
  then show ?thesis
    using Plus Un_insert_left subt_not_parent calculation e_is_subterm_e by fastforce
qed(simp_all add:strict_subterms_def)

corollary strict_subt_of_plus: "strict_subterms (Plus e⇩1 e⇩2) = subterms e⇩1 ∪ subterms e⇩2"
  by (simp add: strict_subt_eq_strict_subt')

fun vars :: "aexp ⇒ vname set" where
  "vars (N n) = {}" |
  "vars (V v) = {v}" |
  "vars (Plus e⇩1 e⇩2) = vars e⇩1 ∪ vars e⇩2"

lemma finite_vars: "finite (vars e)"
  apply(induction e)
  apply(auto)
  done

(* Substitution *)

fun substitute :: "vname ⇒ aexp ⇒ aexp ⇒ aexp" where
  "substitute v (N n) _  = (N n)" |
  "substitute v (V v') e = (if v = v' then e else (V v'))" |
  "substitute v (Plus e⇩1 e⇩2) e = Plus (substitute v e⇩1 e) (substitute v e⇩2 e)"

lemma substitute_eq: "substitute v e (V v) = e"
  apply(induction e)
  apply(auto)
  done

lemma substitute_var_not_int_exp: "v ∉ vars e ⟹ substitute v e x = e"
  apply(induction e)
  apply(auto)
  done

lemma substitute_intermediate_var:
  "y ∉ vars e ⟹ substitute y (substitute x e (V y)) e' = substitute x e e'"
  apply(induction e)
  apply(auto)
  done

lemma substitute_change_order: "x ≠ y ⟹ x ∉ vars u ⟹
    substitute y (substitute x e t) u = substitute x (substitute y e u) (substitute y t u)"
  apply(induction e)
  apply(auto simp add:substitute_var_not_int_exp)
  done

lemma substitute_flip: "x ≠ y ⟹ y ∉ vars t ⟹ x ∉ vars u ⟹
  substitute y (substitute x e t) u = substitute x (substitute y e u) t"
  apply(induction e)
  apply(auto simp add:substitute_var_not_int_exp)
  done

lemma substitution_no_new_vars: "vars (substitute v e t) ⊆ vars e ∪ vars t"
  apply(induction e)
  apply(auto)
  done

lemma substitution_removes_var: "v ∉ vars t ⟹ v ∉ vars (substitute v e t)"
  apply(induction e)
  apply(auto)
  done

lemma no_vars_e_eq_sub_e: "vars e = {} ⟹ substitute v e a = e"
  apply(induction e)
  apply(auto)
  done

lemma subst_adds_subt: "v ∈ vars e ⟹ t ∈ subterms (substitute v e t)"
  apply(induction e)
  apply(auto simp add:e_is_subterm_e)
  done

lemma subst_is_strict_subt: "e ≠ V v ⟹ v ∈ vars e ⟹ t ∈ strict_subterms (substitute v e t)"
proof-
  assume "e ≠ V v" "v ∈ vars e"
  then show ?thesis
  proof(cases e)
    case (N x1)
    then show ?thesis using ‹v ∈ vars e› by auto
  next
    case (V x2)
    then show ?thesis using ‹e ≠ V v› ‹v ∈ vars e› by force
  next
    case (Plus e1 e2)
    have "v ∈ vars e1 ∨ v ∈ vars e2" using Plus ‹v ∈ vars e› by auto
    have "∃f1 f2. substitute v e t = Plus f1 f2" using Plus by force
    from this obtain f1 f2 where 0: "substitute v e t = Plus f1 f2" by blast
    then show ?thesis
    proof(cases "v ∈ vars e1")
      case True
      have "t ∈ subterms f1" using 0 Plus True subst_adds_subt by auto
      then show ?thesis by (simp add: 0 strict_subt_of_plus)
    next
      case False
      have "v ∈ vars e2" using False ‹v ∈ vars e1 ∨ v ∈ vars e2› by force
      hence "t ∈ subterms f2" using 0 Plus ‹v ∈ vars e2› subst_adds_subt by auto
      then show ?thesis by (simp add: 0 strict_subt_of_plus)
    qed
  qed
qed

lemma e_not_eq_subst: "e ≠ V v ⟹ v ∈ vars e ⟹ substitute v e t ≠ t"
proof(induction e)
  case (Plus e1 e2)
  have 0: "v ∈ vars e1 ∨ v ∈ vars e2" using Plus.prems(2) by auto
  then show ?case
  proof(cases "v ∈ vars e1")
    case True
    then show ?thesis
    proof(cases "e1 = V v")
      case False
      then show ?thesis
        by (metis Plus.prems(1) Plus.prems(2) e_does_not_contain_e subst_is_strict_subt)
    qed simp
  next
    case False
    have "v ∈ vars e2" using 0 False by simp
    then show ?thesis
    proof(cases "e2 = V v")
      case False
      then show ?thesis
        by (metis Plus.prems(1) Plus.prems(2) e_does_not_contain_e subst_is_strict_subt)
    qed simp
  qed
qed simp_all

lemma subst_pres_subt: "f ∈ subterms e ⟹ substitute v f t ∈ subterms (substitute v e t)"
  apply(induction e)
  apply(auto simp add:e_is_subterm_e)
  done

lemma subst_other_vars_in_e: "x ≠ v ⟹ x ∈ vars e ⟹ x ∈ vars (substitute v e t)"
  apply(induction e)
  apply(auto)
  done

lemma vars_subst_e_sub_vars_e: "vars t ⊆ vars e ⟹ vars (substitute v e t) ⊆ vars e"
  using substitution_no_new_vars by blast

lemma vars_subst_e_strict_sub_vars_e:
  "vars t ⊆ vars e ⟹ v ∈ vars e ⟹ v ∉ vars t ⟹ vars (substitute v e t) ⊂ vars e"
  by (metis vars_subst_e_sub_vars_e psubsetI substitution_removes_var)

(* Simultaneous Substitutions *)

type_synonym substitutions = "(vname * aexp) list"

fun substitute' :: "substitutions ⇒ aexp ⇒ aexp" where
  "substitute' [] e = e" |
  "substitute' ((v, e')#st) e = substitute' st (substitute v e e')"

lemma no_vars_e_eq_sub'_e: "vars e = {} ⟹ substitute' s e = e"
  apply(induction s)
  apply(auto simp add:no_vars_e_eq_sub_e)
  done

lemma not_eq_impl_subst_not_eq:
  "f ∈ subterms e ⟹ e ≠ f ⟹ substitute v e t ≠ substitute v f t"
proof(induction e)
  case (Plus e1 e2)
  have 0:"f ∈ subterms e1 ∨ f ∈ subterms e2" using Plus.prems(1) Plus.prems(2) by auto
  then show ?case
  proof(cases "f ∈ subterms e1")
    case True
    then show ?thesis
    proof(cases "e1 = f")
      case False
      have "substitute v e1 t ≠ substitute v f t"
        using False Plus.IH(1) True by linarith
      then show ?thesis
        by (metis True Un_iff e_does_not_contain_e strict_subt_of_plus subst_pres_subt substitute.simps(3))
    qed simp
  next
    case False
    have "f ∈ subterms e2" using False 0 by force
    then show ?thesis
    proof(cases "e2 = f")
      case False
      have "substitute v e2 t ≠ substitute v f t"
        using False Plus.IH(2) ‹f ∈ subterms e2› by fastforce
      then show ?thesis
        by (metis UnI2 ‹f ∈ subterms e2› e_is_subterm_e subst_pres_subt subt_not_parent subterms.simps(3))
    qed simp
  qed
qed simp_all

lemma not_eq_impl_subst'_not_eq:
  "f ∈ subterms e ⟹ e ≠ f ⟹ substitute' s e ≠ substitute' s f"
proof(induction s arbitrary: e f)
  case (Cons sh st)
  have "∃a e'. sh = (a, e')" by simp
  from this obtain a e' where "sh = (a, e')" by blast
  have "substitute' (sh#st) e = substitute' st (substitute a e e')" using ‹sh = (a, e')› by auto
  moreover
  have "substitute' (sh#st) f = substitute' st (substitute a f e')" using ‹sh = (a, e')› by auto
  ultimately
  have "substitute a f e' ≠ substitute a e e'"
    by (metis Cons.prems(1) Cons.prems(2) not_eq_impl_subst_not_eq)
  moreover
  have "substitute a f e' ∈ subterms (substitute a e e')"
    using Cons.prems(1) subst_pres_subt by presburger
  ultimately
  show ?case using Cons.IH ‹sh = (a, e')› substitute'.simps(2) by presburger
qed simp

lemma plus_subst_to_plus: "∃f⇩1 f⇩2. substitute' s (Plus e⇩1 e⇩2) = Plus f⇩1 f⇩2"
proof(induction s arbitrary: e⇩1 e⇩2)
  case Nil
  then show ?case by simp
next
  case (Cons sh st)
  have "∃a e'. sh = (a, e')" by simp
  from this obtain a e' where "sh = (a, e')" by blast
  hence "substitute' (Cons sh st) (Plus e⇩1 e⇩2) =
    substitute' st (Plus (substitute a e⇩1 e') (substitute a e⇩2 e'))" by simp
  moreover
  have "∃f⇩1 f⇩2. substitute' st (Plus (substitute a e⇩1 e') (substitute a e⇩2 e')) =
    Plus f⇩1 f⇩2" using local.Cons by force
  ultimately
  show ?case by presburger
qed

(* Unifier *)

definition "unifiable e⇩1 e⇩2 ⟷  (∃s. substitute' s e⇩1 = substitute' s e⇩2)"
definition "unifier s e⇩1 e⇩2 ⟷ (substitute' s e⇩1 = substitute' s e⇩2)"

lemma unifier_eq_unifiable: "unifiable e⇩1 e⇩2 ⟷ (∃s. unifier s e⇩1 e⇩2)"
proof
  assume "unifiable e⇩1 e⇩2"
  then show "∃s. unifier s e⇩1 e⇩2"
    using unifiable_def unifier_def by auto
next
  assume "∃s. unifier s e⇩1 e⇩2"
  then show "unifiable e⇩1 e⇩2"
    using unifiable_def unifier_def by auto
qed

lemma unifier_com: "unifier s e⇩1 e⇩2 ⟷ unifier s e⇩2 e⇩1"
  using unifier_def by fastforce

lemma v_in_e_not_unif: "v ∈ vars e ⟹ V v ≠ e ⟹ ¬unifiable (V v) e"
proof
  assume assm0: "v ∈ vars e"
  assume assm1: "V v ≠ e"
  assume assm2: "unifiable (V v) e"
  hence "∃s. unifier s (V v) e" using unifier_eq_unifiable by auto
  from this obtain s where s_unif: "unifier s (V v) e" by blast
  have "v ∈ vars e ⟹ V v ≠ e ⟹ unifier s (V v) e ⟹ False"
  proof(induction s arbitrary: e)
    case Nil
    then show ?case by (simp add: unifier_def)
  next
    case (Cons sh st)
    have "∃a e'. sh = (a, e')" by simp
    from this obtain a e' where " sh = (a, e')" by blast
    have "(substitute' (Cons sh st) e = substitute' (Cons sh st) (V v))"
      using Cons.prems(3) unifier_def by fastforce
    hence 0: "substitute' st (substitute a e e') = substitute' st (substitute a (V v) e')"
      by (simp add: ‹sh = (a, e')›)
    then show ?case
    proof(cases "a = v")
      case True
      have "substitute a (V v) e' = e'" by (simp add: True)
      moreover
      have "e' ∈ subterms (substitute a e e')" using assm0
        using Cons.prems(1) True subst_adds_subt by presburger
      moreover
      have "substitute a e e' ≠ e'"
        using Cons.prems(1) Cons.prems(2) True e_not_eq_subst by auto
      ultimately
      show ?thesis using 0 not_eq_impl_subst'_not_eq by auto
    next
      case False
      have 1:"substitute a (V v) e' = (V v)" by (simp add: False)
      hence "substitute' st (substitute a e e') = substitute' st (V v)" using 0 by presburger
      moreover
      have "(V v) ∈ subterms (substitute a e e')"
        by (metis Cons.prems(1) 1 subst_adds_subt subst_pres_subt substitute_eq)
      moreover
      have "substitute' st (substitute a e e') ≠ substitute' st (V v)"
        by (metis "1" Cons.prems(1) Cons.prems(2) calculation(2) not_eq_impl_subst'_not_eq not_eq_impl_subst_not_eq psubsetD strict_subt_le_subt subst_is_strict_subt substitute_eq)
      ultimately
      have "False" by blast
      then show ?thesis.
    qed
  qed
  thus False using assm0 assm1 s_unif by fastforce
qed

fun have_common_root :: "aexp ⇒ aexp ⇒ bool" where
  "have_common_root (N _) (N _) = True" |
  "have_common_root (V _) (V _) = True" |
  "have_common_root (Plus _ _) (Plus _ _) = True" |
  "have_common_root _ _ = False"

fun is_var :: "aexp ⇒ bool" where
  "is_var (V _) = True" |
  "is_var _ = False"

lemma no_common_root_no_var_impl_non_unif:
  "¬have_common_root e⇩1 e⇩2 ⟹ ¬is_var e⇩1 ⟹ ¬is_var e⇩2 ⟹ ¬unifiable e⇩1 e⇩2"
proof(induction e⇩1 e⇩2 rule:have_common_root.induct)
  case ("4_3" f⇩1 f⇩2 n)
  have "¬unifiable (Plus f⇩1 f⇩2) (N n)"
  proof(rule ccontr)
    assume "¬¬unifiable (Plus f⇩1 f⇩2) (N n)"
    hence "unifiable (Plus f⇩1 f⇩2) (N n)" by blast
    hence "∃s. unifier s (Plus f⇩1 f⇩2) (N n)" using unifier_eq_unifiable by auto
    from this obtain s where "unifier s (Plus f⇩1 f⇩2) (N n)" by blast
    hence 0: "substitute' s (Plus f⇩1 f⇩2) = substitute' s (N n)" using unifier_def by blast
    hence "∃f⇩1' f⇩2'. substitute' s (Plus f⇩1 f⇩2) = Plus f⇩1' f⇩2'" using plus_subst_to_plus by blast
    from this obtain f⇩1' f⇩2' where "substitute' s (Plus f⇩1 f⇩2) = Plus f⇩1' f⇩2'" by blast
    moreover
    have "substitute' s (N n) = N n" by (simp add: no_vars_e_eq_sub'_e)
    moreover
    have "substitute' s (Plus f⇩1 f⇩2) ≠ substitute' s (N n)"
      by (simp add: calculation(1) calculation(2))
    then show False using 0 by blast
  qed
  then show ?case by simp
next
  case ("4_7" n e⇩1 e⇩2)
  have "unifiable (N n) (Plus e⇩1 e⇩2) = unifiable (Plus e⇩1 e⇩2) (N n)"
    by (simp add: unifier_com unifier_eq_unifiable)
  moreover
  have "¬unifiable (Plus e⇩1 e⇩2) (N n)"
    by (metis aexp.distinct(3) no_vars_e_eq_sub'_e plus_subst_to_plus unifiable_def vars.simps(1))
  then show ?case by (simp add: calculation)
qed simp_all

lemma subst_plus_subst_child:
  "substitute' s (Plus e⇩1 e⇩2) = Plus (substitute' s e⇩1) (substitute' s e⇩2)"
  apply(induction s arbitrary: e⇩1 e⇩2)
  apply(auto)
  done

lemma subst_subst': "substitute' (s@[(a, e')]) e = substitute a (substitute' s e) e'"
  apply(induction s e rule: substitute'.induct)
  apply(auto)
  done

(* Finding a neccessary improvement for the substitution *)

datatype substitution = None | NonSubst | Subst vname aexp

fun find_substitution :: "aexp ⇒ aexp ⇒ substitution" where
  "find_substitution (N n⇩1) (N n⇩2) = (if n⇩1 = n⇩2 then None else NonSubst)" |
  "find_substitution (N n) (V v) = Subst v (N n)" |
  "find_substitution (N _) (Plus _ _) = NonSubst" |
  "find_substitution (V v) (N n) = Subst v (N n)" |
  "find_substitution (V v⇩1) (V v⇩2) = (if v⇩1 = v⇩2 then None else Subst v⇩1 (V v⇩2))" |
  "find_substitution (V v) (Plus e⇩1 e⇩2) = (if v ∈ vars (Plus e⇩1 e⇩2) then NonSubst else Subst v (Plus e⇩1 e⇩2))" |
  "find_substitution (Plus _ _) (N _) = NonSubst" |
  "find_substitution (Plus e⇩1 e⇩2) (V v) = (if v ∈ vars (Plus e⇩1 e⇩2) then NonSubst else Subst v (Plus e⇩1 e⇩2))" |
  "find_substitution (Plus e⇩1 e⇩2) (Plus f⇩1 f⇩2) = (case find_substitution e⇩1 f⇩1 of
      None ⇒ find_substitution e⇩2 f⇩2 |
      NonSubst ⇒ NonSubst |
      Subst v e ⇒ Subst v e
  )"

lemma find_subst_plus_in_child:
  "find_substitution (Plus e⇩1 e⇩2) (Plus f⇩1 f⇩2) = Subst v e ⟹
  find_substitution e⇩1 f⇩1 = Subst v e ∨ find_substitution e⇩2 f⇩2 = Subst v e"
  by (metis find_substitution.simps(9) substitution.exhaust substitution.simps(10) substitution.simps(8) substitution.simps(9))

lemma no_subst_es_eq:"find_substitution e⇩1 e⇩2 = None ⟷ e⇩1 = e⇩2"
  apply(induction e⇩1 e⇩2 rule:find_substitution.induct)
  apply(auto split:substitution.splits)
  done

lemma subst_found_es_eq: "find_substitution e⇩1 e⇩2 = Subst v e' ⟹ e⇩1 ≠ e⇩2"
  apply(induction e⇩1 e⇩2 rule:find_substitution.induct)
  apply(auto split:substitution.splits)
  done

lemma non_subst_es_not_eq: "find_substitution e⇩1 e⇩2 = NonSubst ⟹ e⇩1 ≠ e⇩2"
  apply(induction e⇩1 e⇩2 rule:find_substitution.induct)
  apply(auto split:substitution.splits)
  done

lemma find_subst_e_in_es: "find_substitution e⇩1 e⇩2 = Subst v e ⟹ vars e ⊆ vars e⇩1 ∪ vars e⇩2"
  apply(induction e⇩1 e⇩2 rule:find_substitution.induct)
  apply(auto split:if_splits substitution.splits)
  done

lemma find_subst_var_in_es: "find_substitution e⇩1 e⇩2 = Subst v e ⟹ v ∈ vars e⇩1 ∪ vars e⇩2"
  apply(induction e⇩1 e⇩2 rule:find_substitution.induct)
  apply(auto split:if_splits substitution.splits)
  done

lemma find_subst_v_not_in_e: "find_substitution e⇩1 e⇩2 = Subst v e ⟹ v ∉ vars e"
  apply(induction e⇩1 e⇩2 rule:find_substitution.induct)
  apply(auto split:if_splits substitution.splits)
  done

lemma find_subst_none_impl_unif:
  "find_substitution e⇩1 e⇩2 = None ⟹ unifiable e⇩1 e⇩2"
  by (simp add: no_subst_es_eq unifiable_def)

lemma find_subst_non_subst_impl_not_unif:
  "find_substitution e⇩1 e⇩2 = NonSubst ⟹ ¬unifiable e⇩1 e⇩2"
proof(rule ccontr)
  assume assm0: "find_substitution e⇩1 e⇩2 = NonSubst"
  assume assm1: "¬ ¬unifiable e⇩1 e⇩2"
  hence "unifiable e⇩1 e⇩2" by blast
  hence "∃s. unifier s e⇩1 e⇩2" using unifier_eq_unifiable by blast
  from this obtain s where "unifier s e⇩1 e⇩2" by blast
  have "find_substitution e⇩1 e⇩2 = NonSubst ⟹ unifier s e⇩1 e⇩2 ⟹ False"
  proof(induction e⇩1 e⇩2 rule: find_substitution.induct)
    case (1 n⇩1 n⇩2)
    then show ?case by (simp add: no_vars_e_eq_sub'_e unifier_def)
  next
    case (3 uu uv uw)
    then show ?case using no_common_root_no_var_impl_non_unif unifier_eq_unifiable by auto
  next
    case (5 v⇩1 v⇩2)
    then show ?case by (metis find_substitution.simps(5) substitution.distinct(1) substitution.distinct(5))
  next
    case (6 v e⇩1 e⇩2)
    then show ?case
      by (metis aexp.simps(9) find_substitution.simps(6) substitution.distinct(6) unifier_eq_unifiable v_in_e_not_unif)
  next
    case (7 ux uy uz)
    then show ?case
      using no_common_root_no_var_impl_non_unif unifier_eq_unifiable by auto
  next
    case (8 e⇩1 e⇩2 v)
    then show ?case
      by (metis aexp.distinct(5) find_substitution.simps(8) substitution.distinct(5) unifiable_def unifier_def v_in_e_not_unif)
  next
    case (9 e⇩1 e⇩2 f⇩1 f⇩2)
    then show ?case
    proof(induction "find_substitution e⇩1 f⇩1" rule:substitution.induct)
      case None
      then show ?case using None.hyps None.prems(2) None.prems(4) subst_plus_subst_child unifier_def by auto
    next
      case NonSubst
      then show ?case by (simp add: subst_plus_subst_child unifier_def)
    next
      case (Subst x1 x2)
      then show ?case by (metis find_substitution.simps(9) substitution.distinct(5) substitution.simps(10))
    qed
  qed simp_all
  then show False using ‹unifier s e⇩1 e⇩2› assm0 by blast
qed

lemma find_subst_impl_unif_impl_unif_e:
  "find_substitution e⇩1 e⇩2 = Subst v t ⟹ unifiable (substitute v e⇩1 e) (substitute v e⇩2 e) ⟹ unifiable e⇩1 e⇩2"
  by (metis substitute'.simps(2) unifiable_def)

corollary find_subst_not_unif_impl_subst_not_unif:
  "find_substitution e⇩1 e⇩2 = Subst v e ⟹ ¬unifiable e⇩1 e⇩2 ⟹ ¬unifiable (substitute v e⇩1 e) (substitute v e⇩2 e)"
  using find_subst_impl_unif_impl_unif_e by blast

lemma find_subst_le_vars: "find_substitution e⇩1 e⇩2 = Subst v t ⟹
  vars (substitute v e⇩1 t) ∪ vars (substitute v e⇩2 t) ⊂ vars e⇩1 ∪ vars e⇩2"
  by (metis find_subst_e_in_es find_subst_v_not_in_e find_subst_var_in_es substitute.simps(3) vars.simps(3) vars_subst_e_strict_sub_vars_e)

lemma card_vars_union_decr:
  "find_substitution e⇩1 e⇩2 = Subst v t ⟹
  card (vars (substitute v e⇩1 t) ∪ vars (substitute v e⇩2 t)) < card (vars e⇩1 ∪ vars e⇩2)"
proof-
  assume assm:"find_substitution e⇩1 e⇩2 = Subst v t"
  let ?s⇩1 = "vars (substitute v e⇩1 t) ∪ vars (substitute v e⇩2 t)"
  let ?s⇩2 = "vars e⇩1 ∪ vars e⇩2"
  have "finite ?s⇩2" by (simp add: finite_vars)
  moreover
  have "?s⇩1 ⊂ ?s⇩2" using assm find_subst_le_vars by presburger
  ultimately
  show ?thesis using psubset_card_mono[of ?s⇩2 ?s⇩1] by blast
qed

(* Unification of arithmetic expressions  *)

datatype aexpUnif = NonUnif | Unif substitutions

function unify' :: "substitutions ⇒ aexp ⇒ aexp ⇒ aexpUnif" where
  "unify' s e⇩1 e⇩2 = (case (substitute' s e⇩1, substitute' s e⇩2) of
    (s⇩1, s⇩2) ⇒ (if s⇩1 = s⇩2 then Unif s else
      (case find_substitution s⇩1 s⇩2 of
        None ⇒ NonUnif |
        NonSubst ⇒ NonUnif |
        Subst v e ⇒ unify' (s@[(v, e)]) e⇩1 e⇩2
      )
    )
  )"
by pat_completeness auto
termination
  apply(relation "measure (λ(s, e⇩1, e⇩2). card (vars (substitute' s e⇩1) ∪ vars (substitute' s e⇩2)))")
  by(auto simp add:card_vars_union_decr subst_subst')

definition "unify e⇩1 e⇩2 = unify' [] e⇩1 e⇩2"

value "unify (V x) (N 3)"
value "unify (Plus (V x) (N 3)) (Plus (N 3) (N 3))"
value "unify (Plus (N 4) (N 3)) (Plus (N 3) (N 3))"
value "unify (Plus (V ''x'') (N 3)) (Plus (V ''y'') (N 3))"
value "unify (Plus (N 3) (N 3)) (Plus (V x) (N 3))"
value "unify' [(''x'', N 3)] (N 3) (N 5)"
value "unify (Plus (N 3) (N 4)) (Plus (V ''x'') (N 4))"
value "unify (Plus (Plus (V ''y'') (N 3)) (N 4)) (Plus (V ''x'') (N 4))"

lemma unify'_es_eq:
  "unify' s e⇩1 e⇩2 = Unif s' ⟹ (substitute' s' e⇩1) = (substitute' s' e⇩2)"
proof(induction s e⇩1 e⇩2 arbitrary: s' rule:unify'.induct)
  case (1 s e⇩1 e⇩2)
  let ?s⇩1 = "substitute' s e⇩1"
  let ?s⇩2 = "substitute' s e⇩2"
  from 1 show ?case
  proof(cases "?s⇩1 = ?s⇩2")
    case True
    then show ?thesis using "1.prems" by fastforce
  next
    case False
    have "∃v e. find_substitution ?s⇩1 ?s⇩2 = Subst v e"
      by (smt (verit) "1.prems" False aexpUnif.distinct(1) no_subst_es_eq old.prod.case substitution.exhaust substitution.simps(9) unify'.simps)
    from this obtain v e where 0:"find_substitution ?s⇩1 ?s⇩2 = Subst v e" by blast
    hence "unify' s e⇩1 e⇩2 = unify' (s@[(v, e)]) e⇩1 e⇩2" using False by auto
    moreover
    have "unify' (s@[(v, e)]) e⇩1 e⇩2 = Unif s'"
      using "1.prems" calculation by presburger
    ultimately
    show ?thesis using "1.IH" False 0 by blast
  qed
qed

corollary unifiy'_unifies: "unify' s e⇩1 e⇩2 = Unif s' ⟹ unifier s' e⇩1 e⇩2"
  using unifier_def unify'_es_eq by blast

theorem unify_correct: "unify e⇩1 e⇩2 = Unif s ⟹ unifier s e⇩1 e⇩2"
  by (metis unifiy'_unifies unify_def)

(* TODO *)
lemma unify'_non_unif_invar_under_subst:
  "unify' [] e⇩1 e⇩2 = NonUnif ⟹ unify' [] (substitute v e⇩1 e) (substitute v e⇩2 e) = NonUnif"
  nitpick sorry

lemma unify'_non_unif_no_unifier:
  "unify' [] e⇩1 e⇩2 = NonUnif ⟹ ∄s. unifier s e⇩1 e⇩2"
proof(rule ccontr)
  assume "unify' [] e⇩1 e⇩2 = NonUnif"
  assume "¬(∄s. unifier s e⇩1 e⇩2)"
  hence "∃s. unifier s e⇩1 e⇩2" by simp
  from this obtain s where "unifier s e⇩1 e⇩2" by blast
  have "unify' [] e⇩1 e⇩2 = NonUnif ⟹ unifier s e⇩1 e⇩2 ⟹ False"
  proof(induction s arbitrary: e⇩1 e⇩2)
    case Nil
    then show ?case
      by (simp add: unifier_def)
  next
    case (Cons a s)
    then show ?case
      by (metis prod.exhaust_sel substitute'.simps(2) unifier_def unify'_non_unif_invar_under_subst)
  qed
  then show False using ‹unifier s e⇩1 e⇩2› ‹unify' [] e⇩1 e⇩2 = NonUnif› by fastforce
qed

corollary unify'_correct': "unify' [] e⇩1 e⇩2 = NonUnif ⟹ ¬unifiable e⇩1 e⇩2"
  using unify'_non_unif_no_unifier unifier_eq_unifiable by presburger

corollary unify_correct': "unify e⇩1 e⇩2 = NonUnif ⟹ ¬unifiable e⇩1 e⇩2"
  by (simp add: unify'_correct' unify_def)

lemma unify_complete: "unifiable e⇩1 e⇩2 ⟹ (∃s. unify' [] e⇩1 e⇩2 = Unif s)"
  by (meson aexpUnif.exhaust unify'_correct')

theorem unify_complete_correct: "unifiable e⇩1 e⇩2 ⟷ (∃s. unify e⇩1 e⇩2 = Unif s ∧ unifier s e⇩1 e⇩2)"
  by (metis unifier_eq_unifiable unifiy'_unifies unify_complete unify_def)

corollary unify_complete_correct': "¬unifiable e⇩1 e⇩2 ⟷ unify e⇩1 e⇩2 = NonUnif"
  by (metis aexpUnif.exhaust aexpUnif.simps(3) unify_complete_correct unifiy'_unifies unify_def)

end


(*Author: Giuliano Losa *)

header {* Definition and properties of the longest common postfix of a set of lists *}

theory LCP
imports Main "~~/src/HOL/Library/Sublist"
begin

definition common_postfix_p :: "('a list) set => 'a list => bool"
  -- {*Predicate that recognizes the common postfix of a set of lists*}
  -- {*The common postfix of the empty set is the empty list*}
  where
  "common_postfix_p \<equiv> \<lambda> xss xs . if xss = {} then xs = [] else ALL xs' . xs' \<in> xss \<longrightarrow> suffixeq xs xs'"

definition l_c_p_pred :: "'a list set \<Rightarrow> 'a list => bool"
  -- {*Predicate that recognizes the longest common postfix of a set of lists*}
  where
  "l_c_p_pred \<equiv> \<lambda> xss xs . common_postfix_p xss xs \<and> (ALL xs' . common_postfix_p xss xs' \<longrightarrow> suffixeq xs' xs)"

definition l_c_p:: "'a list set \<Rightarrow> 'a list"
  -- {* The longest common postfix of a set of lists *}
  where
  "l_c_p \<equiv> \<lambda> xss . THE xs . l_c_p_pred xss xs"

lemma l_c_p_ok: "l_c_p_pred xss (l_c_p xss)"
  -- {*Proof that the definition of the longest common postfix of a set of lists is consistent*}
proof %invisible -
  have "\<exists>! x . l_c_p_pred xss x"
  proof (cases)
    assume "xss = {}"
    thus ?thesis by (auto simp add: l_c_p_pred_def common_postfix_p_def)
  next
    assume "xss \<noteq> {}"
    have "\<exists> x . l_c_p_pred xss x"
    proof -
        -- {*By contradiction*}
      { assume "\<forall> x . \<not> l_c_p_pred xss x"
        from `xss \<noteq> {}` obtain xs where "xs \<in> xss" by auto
        { fix n
          have "\<exists> xs . common_postfix_p xss xs \<and> length xs \<ge> n"
          proof (induct n)
            show "\<exists>xs . common_postfix_p xss xs \<and> 0 \<le> length xs" by (auto simp add:common_postfix_p_def)
          next
            fix m
            assume "\<exists> xs . common_postfix_p xss xs \<and> length xs \<ge> m"
            from this obtain xs where "common_postfix_p xss xs" and "length xs \<ge> m" by auto
            from `common_postfix_p xss xs` and  `\<forall> x . \<not> l_c_p_pred xss x` obtain xs' where "common_postfix_p xss xs'" and 1:"\<not> suffixeq xs' xs" by (auto simp add: l_c_p_pred_def)
            from `common_postfix_p xss xs` and `common_postfix_p xss xs'` have 2:"suffixeq xs' xs \<or> suffixeq xs xs'" apply (auto simp add:common_postfix_p_def suffixeq_def split: split_if_asm) by (metis append_eq_append_conv2)
            from 1 and 2 have "suffixeq xs xs'" and "xs \<noteq> xs'" by auto
            hence "length xs' > length xs" by (auto simp add:suffixeq_def)
            with `common_postfix_p xss xs'` and `length xs \<ge> m` show "\<exists> xs . common_postfix_p xss xs \<and> length xs \<ge> Suc m" by auto
          qed
        }
        from this[of "Suc (length xs)"] obtain xs' where "common_postfix_p xss xs'" and "length xs' > length xs" by auto
        with `xs \<in> xss` have False by (auto simp add:common_postfix_p_def suffixeq_def split:split_if_asm)
      }
      thus ?thesis by auto
    qed
    moreover have "\<forall> x y . l_c_p_pred xss x \<and> l_c_p_pred xss y \<longrightarrow> x = y" by (force simp add:l_c_p_pred_def suffixeq_def)
    ultimately show ?thesis by auto
  qed
  thus ?thesis by (auto simp add:l_c_p_def intro: theI'[of "l_c_p_pred xss"])
qed

lemma l_c_p_lemma:
  -- {*A useful lemma*}
  "(ls \<noteq> {} \<and> (\<forall> l \<in> ls . (\<exists> l' . l = l' @ xs))) \<longrightarrow> suffixeq xs (l_c_p ls)"
proof %invisible -
  { assume "ls \<noteq> {}" and "\<forall> l \<in> ls . (\<exists> l' . l = l' @ xs)"
    hence "common_postfix_p ls xs" by (auto simp add:common_postfix_p_def suffixeq_def)
    with l_c_p_ok have "suffixeq xs (l_c_p ls)" by (auto simp add: l_c_p_pred_def)
  }
  thus ?thesis by auto
qed

lemma l_c_p_common_postfix: "common_postfix_p xss (l_c_p xss)"
  using l_c_p_ok[of xss] by (auto simp add:l_c_p_pred_def)

lemma l_c_p_longest: "common_postfix_p xss xs \<longrightarrow> suffixeq xs (l_c_p xss)"
  using l_c_p_ok[of xss] by (auto simp add:l_c_p_pred_def)

end


(*  Title:      HOL/Library/Indicator_Function.thy
    Author:     Johannes Hoelzl (TU Muenchen)
*)

section \<open>Indicator Function\<close>

theory Indicator_Function
imports Complex_MainRLT Disjoint_Sets
begin

definition "indicator S x = of_bool (x \<in> S)"

text\<open>Type constrained version\<close>
abbreviation indicat_real :: "'a set \<Rightarrow> 'a \<Rightarrow> real" where "indicat_real S \<equiv> indicator S"

lemma indicator_simps[simp]:
  "x \<in> S \<Longrightarrow> indicator S x = 1"
  "x \<notin> S \<Longrightarrow> indicator S x = 0"
  unfolding indicator_def by auto

lemma indicator_pos_le[intro, simp]: "(0::'a::linordered_semidom) \<le> indicator S x"
  and indicator_le_1[intro, simp]: "indicator S x \<le> (1::'a::linordered_semidom)"
  unfolding indicator_def by auto

lemma indicator_abs_le_1: "\<bar>indicator S x\<bar> \<le> (1::'a::linordered_idom)"
  unfolding indicator_def by auto

lemma indicator_eq_0_iff: "indicator A x = (0::'a::zero_neq_one) \<longleftrightarrow> x \<notin> A"
  by (auto simp: indicator_def)

lemma indicator_eq_1_iff: "indicator A x = (1::'a::zero_neq_one) \<longleftrightarrow> x \<in> A"
  by (auto simp: indicator_def)

lemma indicator_UNIV [simp]: "indicator UNIV = (\<lambda>x. 1)"
  by auto

lemma indicator_leI:
  "(x \<in> A \<Longrightarrow> y \<in> B) \<Longrightarrow> (indicator A x :: 'a::linordered_nonzero_semiring) \<le> indicator B y"
  by (auto simp: indicator_def)

lemma split_indicator: "P (indicator S x) \<longleftrightarrow> ((x \<in> S \<longrightarrow> P 1) \<and> (x \<notin> S \<longrightarrow> P 0))"
  unfolding indicator_def by auto

lemma split_indicator_asm: "P (indicator S x) \<longleftrightarrow> (\<not> (x \<in> S \<and> \<not> P 1 \<or> x \<notin> S \<and> \<not> P 0))"
  unfolding indicator_def by auto

lemma indicator_inter_arith: "indicator (A \<inter> B) x = indicator A x * (indicator B x::'a::semiring_1)"
  unfolding indicator_def by (auto simp: min_def max_def)

lemma indicator_union_arith:
  "indicator (A \<union> B) x = indicator A x + indicator B x - indicator A x * (indicator B x :: 'a::ring_1)"
  unfolding indicator_def by (auto simp: min_def max_def)

lemma indicator_inter_min: "indicator (A \<inter> B) x = min (indicator A x) (indicator B x::'a::linordered_semidom)"
  and indicator_union_max: "indicator (A \<union> B) x = max (indicator A x) (indicator B x::'a::linordered_semidom)"
  unfolding indicator_def by (auto simp: min_def max_def)

lemma indicator_disj_union:
  "A \<inter> B = {} \<Longrightarrow> indicator (A \<union> B) x = (indicator A x + indicator B x :: 'a::linordered_semidom)"
  by (auto split: split_indicator)

lemma indicator_compl: "indicator (- A) x = 1 - (indicator A x :: 'a::ring_1)"
  and indicator_diff: "indicator (A - B) x = indicator A x * (1 - indicator B x ::'a::ring_1)"
  unfolding indicator_def by (auto simp: min_def max_def)

lemma indicator_times:
  "indicator (A \<times> B) x = indicator A (fst x) * (indicator B (snd x) :: 'a::semiring_1)"
  unfolding indicator_def by (cases x) auto

lemma indicator_sum:
  "indicator (A <+> B) x = (case x of Inl x \<Rightarrow> indicator A x | Inr x \<Rightarrow> indicator B x)"
  unfolding indicator_def by (cases x) auto

lemma indicator_image: "inj f \<Longrightarrow> indicator (f ` X) (f x) = (indicator X x::_::zero_neq_one)"
  by (auto simp: indicator_def inj_def)

lemma indicator_vimage: "indicator (f -` A) x = indicator A (f x)"
  by (auto split: split_indicator)

lemma mult_indicator_cong:
  fixes f g :: "_ \<Rightarrow> 'a :: semiring_1"
  shows "(\<And>x. x \<in> A \<Longrightarrow> f x = g x) \<Longrightarrow> indicator A x * f x = indicator A x * g x"
  by (auto simp: indicator_def)

lemma
  fixes f :: "'a \<Rightarrow> 'b::semiring_1"
  assumes "finite A"
  shows sum_mult_indicator[simp]: "(\<Sum>x \<in> A. f x * indicator B x) = (\<Sum>x \<in> A \<inter> B. f x)"
    and sum_indicator_mult[simp]: "(\<Sum>x \<in> A. indicator B x * f x) = (\<Sum>x \<in> A \<inter> B. f x)"
  unfolding indicator_def
  using assms by (auto intro!: sum.mono_neutral_cong_right split: if_split_asm)

lemma sum_indicator_eq_card:
  assumes "finite A"
  shows "(\<Sum>x \<in> A. indicator B x) = card (A Int B)"
  using sum_mult_indicator [OF assms, of "\<lambda>x. 1::nat"]
  unfolding card_eq_sum by simp

lemma sum_indicator_scaleR[simp]:
  "finite A \<Longrightarrow>
    (\<Sum>x \<in> A. indicator (B x) (g x) *\<^sub>R f x) = (\<Sum>x \<in> {x\<in>A. g x \<in> B x}. f x :: 'a::real_vector)"
  by (auto intro!: sum.mono_neutral_cong_right split: if_split_asm simp: indicator_def)

lemma LIMSEQ_indicator_incseq:
  assumes "incseq A"
  shows "(\<lambda>i. indicator (A i) x :: 'a::{topological_space,zero_neq_one}) \<longlonglongrightarrow> indicator (\<Union>i. A i) x"
proof (cases "\<exists>i. x \<in> A i")
  case True
  then obtain i where "x \<in> A i"
    by auto
  then have *:
    "\<And>n. (indicator (A (n + i)) x :: 'a) = 1"
    "(indicator (\<Union>i. A i) x :: 'a) = 1"
    using incseqD[OF \<open>incseq A\<close>, of i "n + i" for n] \<open>x \<in> A i\<close> by (auto simp: indicator_def)
  show ?thesis
    by (rule LIMSEQ_offset[of _ i]) (use * in simp)
next
  case False
  then show ?thesis by (simp add: indicator_def)
qed

lemma LIMSEQ_indicator_UN:
  "(\<lambda>k. indicator (\<Union>i<k. A i) x :: 'a::{topological_space,zero_neq_one}) \<longlonglongrightarrow> indicator (\<Union>i. A i) x"
proof -
  have "(\<lambda>k. indicator (\<Union>i<k. A i) x::'a) \<longlonglongrightarrow> indicator (\<Union>k. \<Union>i<k. A i) x"
    by (intro LIMSEQ_indicator_incseq) (auto simp: incseq_def intro: less_le_trans)
  also have "(\<Union>k. \<Union>i<k. A i) = (\<Union>i. A i)"
    by auto
  finally show ?thesis .
qed

lemma LIMSEQ_indicator_decseq:
  assumes "decseq A"
  shows "(\<lambda>i. indicator (A i) x :: 'a::{topological_space,zero_neq_one}) \<longlonglongrightarrow> indicator (\<Inter>i. A i) x"
proof (cases "\<exists>i. x \<notin> A i")
  case True
  then obtain i where "x \<notin> A i"
    by auto
  then have *:
    "\<And>n. (indicator (A (n + i)) x :: 'a) = 0"
    "(indicator (\<Inter>i. A i) x :: 'a) = 0"
    using decseqD[OF \<open>decseq A\<close>, of i "n + i" for n] \<open>x \<notin> A i\<close> by (auto simp: indicator_def)
  show ?thesis
    by (rule LIMSEQ_offset[of _ i]) (use * in simp)
next
  case False
  then show ?thesis by (simp add: indicator_def)
qed

lemma LIMSEQ_indicator_INT:
  "(\<lambda>k. indicator (\<Inter>i<k. A i) x :: 'a::{topological_space,zero_neq_one}) \<longlonglongrightarrow> indicator (\<Inter>i. A i) x"
proof -
  have "(\<lambda>k. indicator (\<Inter>i<k. A i) x::'a) \<longlonglongrightarrow> indicator (\<Inter>k. \<Inter>i<k. A i) x"
    by (intro LIMSEQ_indicator_decseq) (auto simp: decseq_def intro: less_le_trans)
  also have "(\<Inter>k. \<Inter>i<k. A i) = (\<Inter>i. A i)"
    by auto
  finally show ?thesis .
qed

lemma indicator_add:
  "A \<inter> B = {} \<Longrightarrow> (indicator A x::_::monoid_add) + indicator B x = indicator (A \<union> B) x"
  unfolding indicator_def by auto

lemma of_real_indicator: "of_real (indicator A x) = indicator A x"
  by (simp split: split_indicator)

lemma real_of_nat_indicator: "real (indicator A x :: nat) = indicator A x"
  by (simp split: split_indicator)

lemma abs_indicator: "\<bar>indicator A x :: 'a::linordered_idom\<bar> = indicator A x"
  by (simp split: split_indicator)

lemma mult_indicator_subset:
  "A \<subseteq> B \<Longrightarrow> indicator A x * indicator B x = (indicator A x :: 'a::comm_semiring_1)"
  by (auto split: split_indicator simp: fun_eq_iff)

lemma indicator_times_eq_if:
  fixes f :: "'a \<Rightarrow> 'b::comm_ring_1"
  shows "indicator S x * f x = (if x \<in> S then f x else 0)" "f x * indicator S x = (if x \<in> S then f x else 0)"
  by auto

lemma indicator_scaleR_eq_if:
  fixes f :: "'a \<Rightarrow> 'b::real_vector"
  shows "indicator S x *\<^sub>R f x = (if x \<in> S then f x else 0)"
  by simp

lemma indicator_sums:
  assumes "\<And>i j. i \<noteq> j \<Longrightarrow> A i \<inter> A j = {}"
  shows "(\<lambda>i. indicator (A i) x::real) sums indicator (\<Union>i. A i) x"
proof (cases "\<exists>i. x \<in> A i")
  case True
  then obtain i where i: "x \<in> A i" ..
  with assms have "(\<lambda>i. indicator (A i) x::real) sums (\<Sum>i\<in>{i}. indicator (A i) x)"
    by (intro sums_finite) (auto split: split_indicator)
  also have "(\<Sum>i\<in>{i}. indicator (A i) x) = indicator (\<Union>i. A i) x"
    using i by (auto split: split_indicator)
  finally show ?thesis .
next
  case False
  then show ?thesis by simp
qed

text \<open>
  The indicator function of the union of a disjoint family of sets is the
  sum over all the individual indicators.
\<close>

lemma indicator_UN_disjoint:
  "finite A \<Longrightarrow> disjoint_family_on f A \<Longrightarrow> indicator (\<Union>(f ` A)) x = (\<Sum>y\<in>A. indicator (f y) x)"
  by (induct A rule: finite_induct)
    (auto simp: disjoint_family_on_def indicator_def split: if_splits)

end