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

section \<open>The Integers as Equivalence Classes over Pairs of Natural Numbers\<close>

theory Int
  imports Equiv_Relations Power Quotient Fun_Def
begin

subsection \<open>Definition of integers as a quotient type\<close>

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" by (auto simp: reflp_def)
  show "symp intrel" by (auto simp: symp_def)
  show "transp intrel" by (auto simp: transp_def)
qed

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

subsection \<open>Integers form a commutative ring\<close>

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"
  then have "(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
  then show "(s * w + t * x) + (u * z + v * y) = (u * y + v * z) + (s * x + t * w)"
    by (simp add: algebra_simps)
qed

instance
  by standard (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"
  by (simp add: rel_fun_def int.pcr_cr_eq cr_int_def int_def)

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

subsection \<open>Integers are totally ordered\<close>

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 standard (transfer, force)+

end

instantiation int :: distrib_lattice
begin

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

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

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

end

subsection \<open>Ordering properties of arithmetic operations\<close>

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 \<open>Strict Monotonicity of Multiplication.\<close>

text \<open>Strict, in 1st argument; proof is by induction on \<open>k > 0\<close>.\<close>
lemma zmult_zless_mono2_lemma: "i < j \<Longrightarrow> 0 < k \<Longrightarrow> int k * i < int k * j"
  for i j :: int
proof (induct k)
  case 0
  then show ?case by simp
next
  case (Suc k)
  then show ?case
    by (cases "k = 0") (simp_all add: distrib_right add_strict_mono)
qed

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

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

lemma zmult_zless_mono2: "i < j \<Longrightarrow> 0 < k \<Longrightarrow> k * i < k * j"
  for i j k :: int
  by (drule zero_less_imp_eq_int) (auto simp add: zmult_zless_mono2_lemma)

text \<open>The integers form an ordered integral domain.\<close>

instantiation int :: linordered_idom
begin

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

definition zsgn_def: "sgn (i::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::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 \<le> z"
  for w z :: int
  by transfer clarsimp

lemma zless_iff_Suc_zadd: "w < z \<longleftrightarrow> (\<exists>n. z = w + int (Suc n))"
  for w z :: int
  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

lemma zabs_less_one_iff [simp]: "\<bar>z\<bar> < 1 \<longleftrightarrow> z = 0" (is "?lhs \<longleftrightarrow> ?rhs")
  for z :: int
proof
  assume ?rhs
  then show ?lhs by simp
next
  assume ?lhs
  with zless_imp_add1_zle [of "\<bar>z\<bar>" 1] have "\<bar>z\<bar> + 1 \<le> 1" by simp
  then have "\<bar>z\<bar> \<le> 0" by simp
  then show ?rhs by simp
qed

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 \<open>Embedding of the Integers into any \<open>ring_1\<close>: \<open>of_int\<close>\<close>

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)

lemma mult_of_int_commute: "of_int x * y = y * of_int x"
  by (transfer fixing: times) (auto simp: algebra_simps mult_of_nat_commute)

text \<open>Collapse nested embeddings.\<close>
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 [simp]: "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 \<open>Special cases where either operand is zero.\<close>
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

lemma of_int_eq_1_iff [iff]: "of_int z = 1 \<longleftrightarrow> z = 1"
  using of_int_eq_iff [of z 1] by simp

end

context linordered_idom
begin

text \<open>Every \<open>linordered_idom\<close> has characteristic zero.\<close>
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

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

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

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

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

lemma of_int_pos: "z > 0 \<Longrightarrow> of_int z > 0"
  by simp

lemma of_int_nonneg: "z \<ge> 0 \<Longrightarrow> of_int z \<ge> 0"
  by simp

lemma of_int_abs [simp]: "of_int \<bar>x\<bar> = \<bar>of_int x\<bar>"
  by (auto simp add: abs_if)

lemma of_int_lessD:
  assumes "\<bar>of_int n\<bar> < x"
  shows "n = 0 \<or> x > 1"
proof (cases "n = 0")
  case True
  then show ?thesis by simp
next
  case False
  then have "\<bar>n\<bar> \<noteq> 0" by simp
  then have "\<bar>n\<bar> > 0" by simp
  then have "\<bar>n\<bar> \<ge> 1"
    using zless_imp_add1_zle [of 0 "\<bar>n\<bar>"] by simp
  then have "\<bar>of_int n\<bar> \<ge> 1"
    unfolding of_int_1_le_iff [of "\<bar>n\<bar>", symmetric] by simp
  then have "1 < x" using assms by (rule le_less_trans)
  then show ?thesis ..
qed

lemma of_int_leD:
  assumes "\<bar>of_int n\<bar> \<le> x"
  shows "n = 0 \<or> 1 \<le> x"
proof (cases "n = 0")
  case True
  then show ?thesis by simp
next
  case False
  then have "\<bar>n\<bar> \<noteq> 0" by simp
  then have "\<bar>n\<bar> > 0" by simp
  then have "\<bar>n\<bar> \<ge> 1"
    using zless_imp_add1_zle [of 0 "\<bar>n\<bar>"] by simp
  then have "\<bar>of_int n\<bar> \<ge> 1"
    unfolding of_int_1_le_iff [of "\<bar>n\<bar>", symmetric] by simp
  then have "1 \<le> x" using assms by (rule order_trans)
  then show ?thesis ..
qed

end

text \<open>Comparisons involving @{term of_int}.\<close>

lemma of_int_eq_numeral_iff [iff]: "of_int z = (numeral n :: 'a::ring_char_0) \<longleftrightarrow> z = numeral n"
  using of_int_eq_iff by fastforce

lemma of_int_le_numeral_iff [simp]:
  "of_int z \<le> (numeral n :: 'a::linordered_idom) \<longleftrightarrow> z \<le> numeral n"
  using of_int_le_iff [of z "numeral n"] by simp

lemma of_int_numeral_le_iff [simp]:
  "(numeral n :: 'a::linordered_idom) \<le> of_int z \<longleftrightarrow> numeral n \<le> z"
  using of_int_le_iff [of "numeral n"] by simp

lemma of_int_less_numeral_iff [simp]:
  "of_int z < (numeral n :: 'a::linordered_idom) \<longleftrightarrow> z < numeral n"
  using of_int_less_iff [of z "numeral n"] by simp

lemma of_int_numeral_less_iff [simp]:
  "(numeral n :: 'a::linordered_idom) < of_int z \<longleftrightarrow> numeral n < z"
  using of_int_less_iff [of "numeral n" z] by simp

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
  show "of_int z = id z" for z
    by (cases z rule: int_diff_cases) simp
qed

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

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

subsection \<open>Magnitude of an Integer, as a Natural Number: \<open>nat\<close>\<close>

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

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

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

lemma nat_le_eq_zle: "0 < w \<or> 0 \<le> z \<Longrightarrow> nat w \<le> nat z \<longleftrightarrow> w \<le> z"
  by transfer (clarsimp, arith)

text \<open>An alternative condition is @{term "0 \<le> w"}.\<close>
lemma nat_mono_iff: "0 < z \<Longrightarrow> nat w < nat z \<longleftrightarrow> w < z"
  by (simp add: nat_le_eq_zle linorder_not_le [symmetric])

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

lemma zless_nat_conj [simp]: "nat w < nat z \<longleftrightarrow> 0 < z \<and> 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)

lemma 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 \<Longrightarrow> nat w < m \<longleftrightarrow> 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 = 0 \<longleftrightarrow> i \<le> 0"
  for i :: int
  by transfer clarsimp

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

lemma zero_less_nat_eq [simp]: "0 < nat z \<longleftrightarrow> 0 < z"
  using zless_nat_conj [of 0] by 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 \<longleftrightarrow> int m < z"
  by transfer (clarsimp simp add: less_diff_conv)

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

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 \<open>For termination proofs:\<close>
lemma measure_function_int[measure_function]: "is_measure (nat \<circ> abs)" ..

subsection \<open>Lemmas about the Function @{term of_nat} and Orderings\<close>

lemma negative_zless_0: "- (int (Suc n)) < (0 :: 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]: "\<not> 0 \<le> - int (Suc n)"
  by (subst le_minus_iff) (simp del: of_nat_Suc)

lemma int_zle_neg: "int n \<le> - int m \<longleftrightarrow> n = 0 \<and> m = 0"
  by transfer simp

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

lemma negative_eq_positive [simp]: "- int n = of_nat m \<longleftrightarrow> n = 0 \<and> 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)"
  (is "?lhs \<longleftrightarrow> ?rhs")
proof
  assume ?rhs
  then show ?lhs by auto
next
  assume ?lhs
  then have "0 \<le> z - w" by simp
  then obtain n where "z - w = int n"
    using zero_le_imp_eq_int [of "z - w"] by blast
  then have "z = w + int n" by simp
  then show ?rhs ..
qed

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

text \<open>
  This version is proved for all ordered rings, not just integers!
  It is proved here because attribute \<open>arith_split\<close> is not available
  in theory \<open>Rings\<close>.
  But is it really better than just rewriting with \<open>abs_if\<close>?
\<close>
lemma abs_split [arith_split, no_atp]: "P \<bar>a\<bar> \<longleftrightarrow> (0 \<le> a \<longrightarrow> P a) \<and> (a < 0 \<longrightarrow> P (- a))"
  for a :: "'a::linordered_idom"
  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)
  apply arith
  done

subsection \<open>Cases and induction\<close>

text \<open>
  Now we replace the case analysis rule by a more conventional one:
  whether an integer is negative or not.
\<close>

text \<open>This version is symmetric in the two subgoals.\<close>
lemma int_cases2 [case_names nonneg nonpos, cases type: int]:
  "(\<And>n. z = int n \<Longrightarrow> P) \<Longrightarrow> (\<And>n. z = - (int n) \<Longrightarrow> P) \<Longrightarrow> P"
  by (cases "z < 0") (auto simp add: linorder_not_less dest!: negD nat_0_le [THEN sym])

text \<open>This is the default, with a negative case.\<close>
lemma int_cases [case_names nonneg neg, cases type: int]:
  "(\<And>n. z = int n \<Longrightarrow> P) \<Longrightarrow> (\<And>n. z = - (int (Suc n)) \<Longrightarrow> P) \<Longrightarrow> 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

lemma int_cases3 [case_names zero pos neg]:
  fixes k :: int
  assumes "k = 0 \<Longrightarrow> P" and "\<And>n. k = int n \<Longrightarrow> n > 0 \<Longrightarrow> P"
    and "\<And>n. k = - int n \<Longrightarrow> n > 0 \<Longrightarrow> P"
  shows "P"
proof (cases k "0::int" rule: linorder_cases)
  case equal
  with assms(1) show P by simp
next
  case greater
  then have *: "nat k > 0" by simp
  moreover from * have "k = int (nat k)" by auto
  ultimately show P using assms(2) by blast
next
  case less
  then have *: "nat (- k) > 0" by simp
  moreover from * have "k = - int (nat (- k))" by auto
  ultimately show P using assms(3) by blast
qed

lemma int_of_nat_induct [case_names nonneg neg, induct type: int]:
  "(\<And>n. P (int n)) \<Longrightarrow> (\<And>n. P (- (int (Suc n)))) \<Longrightarrow> 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)"
  \<comment> \<open>Unfold all \<open>let\<close>s involving constants\<close>
  by (fact Let_numeral) \<comment> \<open>FIXME drop\<close>

lemma Let_neg_numeral [simp]: "Let (- numeral v) f = f (- numeral v)"
  \<comment> \<open>Unfold all \<open>let\<close>s involving constants\<close>
  by (fact Let_neg_numeral) \<comment> \<open>FIXME drop\<close>

text \<open>Unfold \<open>min\<close> and \<open>max\<close> on numerals.\<close>

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 \<open>Binary comparisons\<close>

text \<open>Preliminaries\<close>

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

lemma odd_less_0_iff: "1 + z + z < 0 \<longleftrightarrow> z < 0"
  for z :: int
proof (cases z)
  case (nonneg n)
  then show ?thesis
    by (simp add: linorder_not_less add.assoc add_increasing le_imp_0_less [THEN order_less_imp_le])
next
  case (neg n)
  then show ?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 \<open>Comparisons, for Ordered Rings\<close>

lemmas double_eq_0_iff = double_zero

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

subsection \<open>The Set of Integers\<close>

context ring_1
begin

definition Ints :: "'a set"  ("\<int>")
  where "\<int> = range of_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_numeral [simp]: "numeral n \<in> \<int>"
  by (subst of_nat_numeral [symmetric], rule Ints_of_nat)

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 \<open>q \<in> \<int>\<close> 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

lemma Nats_subset_Ints: "\<nat> \<subseteq> \<int>"
  unfolding Nats_def Ints_def
  by (rule subsetI, elim imageE, hypsubst, subst of_int_of_nat_eq[symmetric], rule imageI) simp_all

lemma Nats_altdef1: "\<nat> = {of_int n |n. n \<ge> 0}"
proof (intro subsetI equalityI)
  fix x :: 'a
  assume "x \<in> {of_int n |n. n \<ge> 0}"
  then obtain n where "x = of_int n" "n \<ge> 0"
    by (auto elim!: Ints_cases)
  then have "x = of_nat (nat n)"
    by (subst of_nat_nat) simp_all
  then show "x \<in> \<nat>"
    by simp
next
  fix x :: 'a
  assume "x \<in> \<nat>"
  then obtain n where "x = of_nat n"
    by (auto elim!: Nats_cases)
  then have "x = of_int (int n)" by simp
  also have "int n \<ge> 0" by simp
  then have "of_int (int n) \<in> {of_int n |n. n \<ge> 0}" by blast
  finally show "x \<in> {of_int n |n. n \<ge> 0}" .
qed

end

lemma (in linordered_idom) Nats_altdef2: "\<nat> = {n \<in> \<int>. n \<ge> 0}"
proof (intro subsetI equalityI)
  fix x :: 'a
  assume "x \<in> {n \<in> \<int>. n \<ge> 0}"
  then obtain n where "x = of_int n" "n \<ge> 0"
    by (auto elim!: Ints_cases)
  then have "x = of_nat (nat n)"
    by (subst of_nat_nat) simp_all
  then show "x \<in> \<nat>"
    by simp
qed (auto elim!: Nats_cases)

text \<open>The premise involving @{term Ints} prevents @{term "a = 1/2"}.\<close>

lemma Ints_double_eq_0_iff:
  fixes a :: "'a::ring_char_0"
  assumes in_Ints: "a \<in> \<int>"
  shows "a + a = 0 \<longleftrightarrow> a = 0"
    (is "?lhs \<longleftrightarrow> ?rhs")
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 ?rhs
    then show ?lhs by simp
  next
    assume ?lhs
    with a have "of_int (z + z) = (of_int 0 :: 'a)" by simp
    then have "z + z = 0" by (simp only: of_int_eq_iff)
    then have "z = 0" by (simp only: double_eq_0_iff)
    with a show ?rhs by simp
  qed
qed

lemma Ints_odd_nonzero:
  fixes a :: "'a::ring_char_0"
  assumes in_Ints: "a \<in> \<int>"
  shows "1 + a + a \<noteq> 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 "1 + a + a = 0"
    with a have "of_int (1 + z + z) = (of_int 0 :: 'a)" by simp
    then have "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> \<nat>"
  using of_nat_in_Nats [of "numeral w"] by simp

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

subsection \<open>@{term sum} and @{term prod}\<close>

lemma of_nat_sum [simp]: "of_nat (sum f A) = (\<Sum>x\<in>A. of_nat(f x))"
  by (induct A rule: infinite_finite_induct) auto

lemma of_int_sum [simp]: "of_int (sum f A) = (\<Sum>x\<in>A. of_int(f x))"
  by (induct A rule: infinite_finite_induct) auto

lemma of_nat_prod [simp]: "of_nat (prod f A) = (\<Prod>x\<in>A. of_nat(f x))"
  by (induct A rule: infinite_finite_induct) auto

lemma of_int_prod [simp]: "of_int (prod f A) = (\<Prod>x\<in>A. of_int(f x))"
  by (induct A rule: infinite_finite_induct) auto

lemmas int_sum = of_nat_sum [where 'a=int]
lemmas int_prod = of_nat_prod [where 'a=int]

text \<open>Legacy theorems\<close>

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

subsection \<open>Setting up simplification procedures\<close>

lemmas of_int_simps =
  of_int_0 of_int_1 of_int_add of_int_mult

ML_file "Tools/int_arith.ML"
declaration \<open>K Int_Arith.setup\<close>

simproc_setup fast_arith
  ("(m::'a::linordered_idom) < n" |
    "(m::'a::linordered_idom) \<le> n" |
    "(m::'a::linordered_idom) = n") =
  \<open>K Lin_Arith.simproc\<close>

subsection\<open>More Inequality Reasoning\<close>

lemma zless_add1_eq: "w < z + 1 \<longleftrightarrow> w < z \<or> w = z"
  for w z :: int
  by arith

lemma add1_zle_eq: "w + 1 \<le> z \<longleftrightarrow> w < z"
  for w z :: int
  by arith

lemma zle_diff1_eq [simp]: "w \<le> z - 1 \<longleftrightarrow> w < z"
  for w z :: int
  by arith

lemma zle_add1_eq_le [simp]: "w < z + 1 \<longleftrightarrow> w \<le> z"
  for w z :: int
  by arith

lemma int_one_le_iff_zero_less: "1 \<le> z \<longleftrightarrow> 0 < z"
  for z :: int
  by arith

subsection \<open>The functions @{term nat} and @{term int}\<close>

text \<open>Simplify the term @{term "w + - z"}.\<close>

lemma one_less_nat_eq [simp]: "Suc 0 < nat z \<longleftrightarrow> 1 < z"
  using zless_nat_conj [of 1 z] by auto

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

lemma split_nat [arith_split]: "P (nat i) = ((\<forall>n. i = int n \<longrightarrow> P n) \<and> (i < 0 \<longrightarrow> P 0))"
  (is "?P = (?L \<and> ?R)")
  for i :: int
proof (cases "i < 0")
  case True
  then show ?thesis by auto
next
  case False
  have "?P = ?L"
  proof
    assume ?P
    then show ?L using False by auto
  next
    assume ?L
    then show ?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)
qed

end

lemma transfer_rule_of_int:
  fixes R :: "'a::ring_1 \<Rightarrow> 'b::ring_1 \<Rightarrow> bool"
  assumes [transfer_rule]: "R 0 0" "R 1 1"
    "rel_fun R (rel_fun R R) plus plus"
    "rel_fun R R uminus uminus"
  shows "rel_fun HOL.eq R of_int of_int"
proof -
  note transfer_rule_of_nat [transfer_rule]
  have [transfer_rule]: "rel_fun HOL.eq R of_nat of_nat"
    by transfer_prover
  show ?thesis
    by (unfold of_int_of_nat [abs_def]) transfer_prover
qed

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 \<Longrightarrow> nat (z * z') = nat (- z) * nat (- z')"
  for z z' :: int
  apply (rule trans)
   apply (rule_tac [2] nat_mult_distrib)
   apply auto
  done

lemma nat_abs_mult_distrib: "nat \<bar>w * z\<bar> = nat \<bar>w\<bar> * nat \<bar>z\<bar>"
  by (cases "z = 0 \<or> w = 0")
    (auto simp add: abs_if nat_mult_distrib [symmetric]
      nat_mult_distrib_neg [symmetric] mult_less_0_iff)

lemma int_in_range_abs [simp]: "int n \<in> range abs"
proof (rule range_eqI)
  show "int n = \<bar>int n\<bar>" by simp
qed

lemma range_abs_Nats [simp]: "range abs = (\<nat> :: int set)"
proof -
  have "\<bar>k\<bar> \<in> \<nat>" for k :: int
    by (cases k) simp_all
  moreover have "k \<in> range abs" if "k \<in> \<nat>" for k :: int
    using that by induct simp
  ultimately show ?thesis by blast
qed

lemma Suc_nat_eq_nat_zadd1: "0 \<le> z \<Longrightarrow> Suc (nat z) = nat (1 + z)"
  for z :: int
  by (rule sym) (simp add: nat_eq_iff)

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 \<open>Induction principles for int\<close>

text \<open>Well-founded segments of the integers.\<close>

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

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

text \<open>
  This variant looks odd, but is typical of the relations suggested
  by RankFinder.\<close>

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

lemma wf_int_ge_less_than2: "wf (int_ge_less_than2 d)"
proof -
  have "int_ge_less_than2 d \<subseteq> measure (\<lambda>z. nat (1 + z - d))"
    by (auto simp add: int_ge_less_than2_def)
  then show ?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 -
  have "\<And>i::int. n = nat (i - k) \<Longrightarrow> k \<le> i \<Longrightarrow> P i" for n
  proof (induct n)
    case 0
    then have "i = k" by arith
    with base show "P i" by simp
  next
    case (Suc n)
    then have "n = nat ((i - 1) - k)" by arith
    moreover have k: "k \<le> i - 1" using Suc.prems by arith
    ultimately have "P (i - 1)" by (rule Suc.hyps)
    from step [OF k 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]:
  fixes i k :: int
  assumes gr: "k < i"
    and base: "P (k + 1)"
    and step: "\<And>i. k < i \<Longrightarrow> P i \<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)
   apply simp_all
  done

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

theorem int_less_induct [consumes 1, case_names base step]:
  fixes i k :: int
  assumes less: "i < k"
    and base: "P (k - 1)"
    and step: "\<And>i. i < k \<Longrightarrow> P i \<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)
   apply simp_all
  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 \<open>Intermediate value theorems\<close>

lemma int_val_lemma: "(\<forall>i<n. \<bar>f (i + 1) - f i\<bar> \<le> 1) \<longrightarrow> f 0 \<le> k \<longrightarrow> k \<le> f n \<longrightarrow> (\<exists>i \<le> n. f i = k)"
  for n :: nat and k :: int
  unfolding One_nat_def
  apply (induct n)
   apply simp
  apply (intro strip)
  apply (erule impE)
   apply simp
  apply (erule_tac x = n in allE)
  apply simp
  apply (case_tac "k = f (Suc n)")
   apply force
  apply (erule impE)
   apply (simp add: abs_if split: if_split_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 \<and> i < n \<longrightarrow> \<bar>f (i + 1) - f i\<bar> \<le> 1 \<Longrightarrow> m < n \<Longrightarrow>
    f m \<le> k \<Longrightarrow> k \<le> f n \<Longrightarrow> \<exists>i. m \<le> i \<and> i \<le> n \<and> f i = k"
    for f :: "nat \<Rightarrow> int" and k :: int
  apply (cut_tac n = "n-m" and f = "\<lambda>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)
  apply arith
  done

subsection \<open>Products and 1, by T. M. Rasmussen\<close>

lemma abs_zmult_eq_1:
  fixes m n :: int
  assumes mn: "\<bar>m * n\<bar> = 1"
  shows "\<bar>m\<bar> = 1"
proof -
  from mn have 0: "m \<noteq> 0" "n \<noteq> 0" by auto
  have "\<not> 2 \<le> \<bar>m\<bar>"
  proof
    assume "2 \<le> \<bar>m\<bar>"
    then have "2 * \<bar>n\<bar> \<le> \<bar>m\<bar> * \<bar>n\<bar>" by (simp add: mult_mono 0)
    also have "\<dots> = \<bar>m * n\<bar>" by (simp add: abs_mult)
    also from mn have "\<dots> = 1" by simp
    finally have "2 * \<bar>n\<bar> \<le> 1" .
    with 0 show "False" by arith
  qed
  with 0 show ?thesis by auto
qed

lemma pos_zmult_eq_1_iff_lemma: "m * n = 1 \<Longrightarrow> m = 1 \<or> m = - 1"
  for m n :: int
  using abs_zmult_eq_1 [of m n] by arith

lemma pos_zmult_eq_1_iff:
  fixes m n :: int
  assumes "0 < m"
  shows "m * n = 1 \<longleftrightarrow> m = 1 \<and> n = 1"
proof -
  from assms have "m * n = 1 \<Longrightarrow> m = 1"
    by (auto dest: pos_zmult_eq_1_iff_lemma)
  then show ?thesis
    by (auto dest: pos_zmult_eq_1_iff_lemma)
qed

lemma zmult_eq_1_iff: "m * n = 1 \<longleftrightarrow> (m = 1 \<and> n = 1) \<or> (m = - 1 \<and> n = - 1)"
  for m n :: int
  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)
   apply auto
  done

lemma infinite_UNIV_int: "\<not> finite (UNIV::int set)"
proof
  assume "finite (UNIV::int set)"
  moreover have "inj (\<lambda>i::int. 2 * i)"
    by (rule injI) simp
  ultimately have "surj (\<lambda>i::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 \<open>Further theorems on numerals\<close>

subsubsection \<open>Special Simplification for Constants\<close>

text \<open>These distributive laws move literals inside sums and differences.\<close>

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 \<open>These are actually for fields, like real: but where else to put them?\<close>

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 \<open>Replaces \<open>inverse #nn\<close> by \<open>1/#nn\<close>.  It looks
  strange, but then other simprocs simplify the quotient.\<close>

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 \<open>These laws simplify inequalities, moving unary minus from a term
  into the literal.\<close>

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 \<open>Cancellation of constant factors in comparisons (\<open><\<close> and \<open>\<le>\<close>)\<close>

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 \<open>Multiplying out constant divisors in comparisons (\<open><\<close>, \<open>\<le>\<close> and \<open>=\<close>)\<close>

named_theorems divide_const_simps "simplification rules to simplify comparisons involving constant divisors"

lemmas le_divide_eq_numeral1 [simp,divide_const_simps] =
  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,divide_const_simps] =
  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,divide_const_simps] =
  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,divide_const_simps] =
  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,divide_const_simps] =
  eq_divide_eq [of _ _ "numeral w"]
  eq_divide_eq [of _ _ "- numeral w"] for w

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

subsubsection \<open>Optional Simplification Rules Involving Constants\<close>

text \<open>Simplify quotients that are compared with a literal constant.\<close>

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

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

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

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

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

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

text \<open>Not good as automatic simprules because they cause case splits.\<close>
lemmas [divide_const_simps] =
  le_divide_eq_1 divide_le_eq_1 less_divide_eq_1 divide_less_eq_1

subsection \<open>The divides relation\<close>

lemma zdvd_antisym_nonneg: "0 \<le> m \<Longrightarrow> 0 \<le> n \<Longrightarrow> m dvd n \<Longrightarrow> n dvd m \<Longrightarrow> m = n"
  for m n :: int
  by (auto simp add: dvd_def mult.assoc zero_le_mult_iff zmult_eq_1_iff)

lemma zdvd_antisym_abs:
  fixes a b :: int
  assumes "a dvd b" and "b dvd a"
  shows "\<bar>a\<bar> = \<bar>b\<bar>"
proof (cases "a = 0")
  case True
  with assms show ?thesis by simp
next
  case False
  from \<open>a dvd b\<close> obtain k where k: "b = a * k"
    unfolding dvd_def by blast
  from \<open>b dvd a\<close> 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 \<open>a \<noteq> 0\<close> by (simp add: mult.assoc)
  then have "k = 1 \<and> k' = 1 \<or> k = -1 \<and> k' = -1"
    by (simp add: zmult_eq_1_iff)
  with k k' show ?thesis by auto
qed

lemma zdvd_zdiffD: "k dvd m - n \<Longrightarrow> k dvd n \<Longrightarrow> k dvd m"
  for k m n :: int
  using dvd_add_right_iff [of k "- n" m] by simp

lemma zdvd_reduce: "k dvd n + k * m \<longleftrightarrow> k dvd n"
  for k m 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 \<open>d dvd i\<close> obtain k where "i = d * k" ..
  with \<open>i \<noteq> 0\<close> 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 \<open>i = d * k\<close> 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 \<open>0 < m\<close> have "0 < n * k" by auto
  with \<open>0 < n\<close> have "0 < k" by (simp add: zero_less_mult_iff)
  with k \<open>0 < n\<close> \<open>m < n\<close> have "n * k < n * 1" by simp
  with \<open>0 < n\<close> \<open>0 < k\<close> show False unfolding mult_less_cancel_left by auto
qed

lemma zdvd_mult_cancel:
  fixes k m n :: int
  assumes d: "k * m dvd k * n"
    and "k \<noteq> 0"
  shows "m dvd n"
proof -
  from d obtain h where h: "k * n = k * m * h"
    unfolding dvd_def by blast
  have "n = m * h"
  proof (rule ccontr)
    assume "\<not> ?thesis"
    with \<open>k \<noteq> 0\<close> have "k * n \<noteq> k * (m * h)" by simp
    with h show False
      by (simp add: mult.assoc)
  qed
  then show ?thesis by simp
qed

theorem zdvd_int: "x dvd y \<longleftrightarrow> int x dvd int y"
proof -
  have "x dvd y" if "int y = int x * k" for k
  proof (cases k)
    case (nonneg n)
    with that have "y = x * n"
      by (simp del: of_nat_mult add: of_nat_mult [symmetric])
    then show ?thesis ..
  next
    case (neg n)
    with that 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
  then show ?thesis
    by (auto elim!: dvdE simp only: dvd_triv_left of_nat_mult)
qed

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

lemma zdvd_mult_cancel1:
  fixes m :: int
  assumes mp: "m \<noteq> 0"
  shows "m * n dvd m \<longleftrightarrow> \<bar>n\<bar> = 1"
    (is "?lhs \<longleftrightarrow> ?rhs")
proof
  assume ?rhs
  then show ?lhs
    by (cases "n > 0") (auto simp add: minus_equation_iff)
next
  assume ?lhs
  then have "m * n dvd m * 1" by simp
  from zdvd_mult_cancel[OF this mp] show ?rhs
    by (simp only: zdvd1_eq)
qed

lemma int_dvd_iff: "int m dvd z \<longleftrightarrow> m dvd nat \<bar>z\<bar>"
  by (cases "z \<ge> 0") (simp_all add: zdvd_int)

lemma dvd_int_iff: "z dvd int m \<longleftrightarrow> nat \<bar>z\<bar> dvd m"
  by (cases "z \<ge> 0") (simp_all add: zdvd_int)

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

lemma nat_dvd_iff: "nat z dvd m \<longleftrightarrow> (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 \<Longrightarrow> 0 < n \<Longrightarrow> z \<le> n"
  for n z :: 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)"
    (is "?lhs \<longleftrightarrow> ?rhs")
proof -
  from assms obtain k where "d = a * k" by (rule dvdE)
  show ?thesis
  proof
    assume ?lhs
    then obtain l where "x + t = a * l" by (rule dvdE)
    then have "x = a * l - t" by simp
    with \<open>d = a * k\<close> show ?rhs by simp
  next
    assume ?rhs
    then obtain l where "x + c * d + t = a * l" by (rule dvdE)
    then have "x = a * l - c * d - t" by simp
    with \<open>d = a * k\<close> show ?lhs by simp
  qed
qed

subsection \<open>Finiteness of intervals\<close>

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

lemma finite_interval_int2 [iff]: "finite {i :: int. a \<le> i \<and> 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 \<and> i \<le> b}"
  by (rule rev_finite_subset[OF finite_interval_int1[of "a" "b"]]) auto

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

subsection \<open>Configuration of the code generator\<close>

text \<open>Constructors\<close>

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 \<open>Auxiliary operations.\<close>

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)"
  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 \<open>Implementations.\<close>

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

lemma plus_int_code [code]:
  "k + 0 = k"
  "0 + l = l"
  "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)"
  for k l :: int
  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"
  "0 - l = uminus l"
  "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"
  for k l :: int
  by simp_all

lemma times_int_code [code]:
  "k * 0 = 0"
  "0 * l = 0"
  "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)"
  for k l :: int
  by simp_all

instantiation int :: equal
begin

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

instance
  by standard (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 k \<longleftrightarrow> True"
  for k :: int
  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 \<open>Serializer setup.\<close>

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

text \<open>De-register \<open>int\<close> as a quotient type:\<close>

lifting_update int.lifting
lifting_forget int.lifting

end


(*  Title:      HOL/Computational_Algebra/Group_Closure.thy
    Author:     Johannes Hoelzl, TU Muenchen
    Author:     Florian Haftmann, TU Muenchen
*)

theory Group_Closure
imports
  Main
begin

context ab_group_add
begin

inductive_set group_closure :: "'a set \<Rightarrow> 'a set" for S
  where base: "s \<in> insert 0 S \<Longrightarrow> s \<in> group_closure S"
| diff: "s \<in> group_closure S \<Longrightarrow> t \<in> group_closure S \<Longrightarrow> s - t \<in> group_closure S"

lemma zero_in_group_closure [simp]:
  "0 \<in> group_closure S"
  using group_closure.base [of 0 S] by simp

lemma group_closure_minus_iff [simp]:
  "- s \<in> group_closure S \<longleftrightarrow> s \<in> group_closure S"
  using group_closure.diff [of 0 S s] group_closure.diff [of 0 S "- s"] by auto

lemma group_closure_add:
  "s + t \<in> group_closure S" if "s \<in> group_closure S" and "t \<in> group_closure S"
  using that group_closure.diff [of s S "- t"] by auto

lemma group_closure_empty [simp]:
  "group_closure {} = {0}"
  by (rule ccontr) (auto elim: group_closure.induct)

lemma group_closure_insert_zero [simp]:
  "group_closure (insert 0 S) = group_closure S"
  by (auto elim: group_closure.induct intro: group_closure.intros)

end

context comm_ring_1
begin

lemma group_closure_scalar_mult_left:
  "of_nat n * s \<in> group_closure S" if "s \<in> group_closure S"
  using that by (induction n) (auto simp add: algebra_simps intro: group_closure_add)

lemma group_closure_scalar_mult_right:
  "s * of_nat n \<in> group_closure S" if "s \<in> group_closure S"
  using that group_closure_scalar_mult_left [of s S n] by (simp add: ac_simps)

end

lemma group_closure_abs_iff [simp]:
  "\<bar>s\<bar> \<in> group_closure S \<longleftrightarrow> s \<in> group_closure S" for s :: int
  by (simp add: abs_if)

lemma group_closure_mult_left:
  "s * t \<in> group_closure S" if "s \<in> group_closure S" for s t :: int
proof -
  from that group_closure_scalar_mult_right [of s S "nat \<bar>t\<bar>"]
    have "s * int (nat \<bar>t\<bar>) \<in> group_closure S"
    by (simp only:)
  then show ?thesis
    by (cases "t \<ge> 0") simp_all
qed

lemma group_closure_mult_right:
  "s * t \<in> group_closure S" if "t \<in> group_closure S" for s t :: int
  using that group_closure_mult_left [of t S s] by (simp add: ac_simps)

context idom
begin

lemma group_closure_mult_all_eq:
  "group_closure (times k ` S) = times k ` group_closure S"
proof (rule; rule)
  fix s
  have *: "k * a + k * b = k * (a + b)"
    "k * a - k * b = k * (a - b)" for a b
    by (simp_all add: algebra_simps)
  assume "s \<in> group_closure (times k ` S)"
  then show "s \<in> times k ` group_closure S"
    by induction (auto simp add: * image_iff intro: group_closure.base group_closure.diff bexI [of _ 0])
next
  fix s
  assume "s \<in> times k ` group_closure S"
  then obtain r where r: "r \<in> group_closure S" and s: "s = k * r"
    by auto
  from r have "k * r \<in> group_closure (times k ` S)"
    by (induction arbitrary: s) (auto simp add: algebra_simps intro: group_closure.intros)
  with s show "s \<in> group_closure (times k ` S)"
    by simp
qed

end

lemma Gcd_group_closure_eq_Gcd:
  "Gcd (group_closure S) = Gcd S" for S :: "int set"
proof (rule associated_eqI)
  have "Gcd S dvd s" if "s \<in> group_closure S" for s
    using that by induction auto
  then show "Gcd S dvd Gcd (group_closure S)"
    by auto
  have "Gcd (group_closure S) dvd s" if "s \<in> S" for s
  proof -
    from that have "s \<in> group_closure S"
      by (simp add: group_closure.base)
    then show ?thesis
      by (rule Gcd_dvd)
  qed
  then show "Gcd (group_closure S) dvd Gcd S"
    by auto
qed simp_all

lemma group_closure_sum:
  fixes S :: "int set"
  assumes X: "finite X" "X \<noteq> {}" "X \<subseteq> S"
  shows "(\<Sum>x\<in>X. a x * x) \<in> group_closure S"
  using X by (induction X rule: finite_ne_induct)
    (auto intro: group_closure_mult_right group_closure.base group_closure_add)

lemma Gcd_group_closure_in_group_closure:
  "Gcd (group_closure S) \<in> group_closure S" for S :: "int set"
proof (cases "S \<subseteq> {0}")
  case True
  then have "S = {} \<or> S = {0}"
    by auto
  then show ?thesis
    by auto
next
  case False
  then obtain s where s: "s \<noteq> 0" "s \<in> S"
    by auto
  then have s': "\<bar>s\<bar> \<noteq> 0" "\<bar>s\<bar> \<in> group_closure S"
    by (auto intro: group_closure.base)
  define m where "m = (LEAST n. n > 0 \<and> int n \<in> group_closure S)"
  have "m > 0 \<and> int m \<in> group_closure S"
    unfolding m_def
    apply (rule LeastI [of _ "nat \<bar>s\<bar>"])
    using s'
    by simp
  then have m: "int m \<in> group_closure S" and "0 < m"
    by auto

  have "Gcd (group_closure S) = int m"
  proof (rule associated_eqI)
    from m show "Gcd (group_closure S) dvd int m"
      by (rule Gcd_dvd)
    show "int m dvd Gcd (group_closure S)"
    proof (rule Gcd_greatest)
      fix s
      assume s: "s \<in> group_closure S"
      show "int m dvd s"
      proof (rule ccontr)
        assume "\<not> int m dvd s"
        then have *: "0 < s mod int m"
          using \<open>0 < m\<close> le_less by fastforce
        have "m \<le> nat (s mod int m)"
        proof (subst m_def, rule Least_le, rule)
          from * show "0 < nat (s mod int m)"
            by simp
          from minus_div_mult_eq_mod [symmetric, of s "int m"]
          have "s mod int m = s - s div int m * int m"
            by auto
          also have "s - s div int m * int m \<in> group_closure S"
            by (auto intro: group_closure.diff s group_closure_mult_right m)
          finally  show "int (nat (s mod int m)) \<in> group_closure S"
            by simp
        qed
        with * have "int m \<le> s mod int m"
          by simp
        moreover have "s mod int m < int m"
          using \<open>0 < m\<close> by simp
        ultimately show False
          by auto
      qed
    qed
  qed simp_all
  with m show ?thesis
    by simp
qed

lemma Gcd_in_group_closure:
  "Gcd S \<in> group_closure S" for S :: "int set"
  using Gcd_group_closure_in_group_closure [of S]
  by (simp add: Gcd_group_closure_eq_Gcd)

lemma group_closure_eq:
  "group_closure S = range (times (Gcd S))" for S :: "int set"
proof (auto intro: Gcd_in_group_closure group_closure_mult_left)
  fix s
  assume "s \<in> group_closure S"
  then show "s \<in> range (times (Gcd S))"
  proof induction
    case (base s)
    then have "Gcd S dvd s"
      by (auto intro: Gcd_dvd)
    then obtain t where "s = Gcd S * t" ..
    then show ?case
      by auto
  next
    case (diff s t)
    moreover have "Gcd S * a - Gcd S * b = Gcd S * (a - b)" for a b
      by (simp add: algebra_simps)
    ultimately show ?case
      by auto
  qed
qed

end


theory Imp
imports Main Prop MoreLogic
begin

section {* Imp *}
subsubsection {* Sflib *}

subsection {* Arithmetic and Boolean Expressions *}
subsubsection {* Syntax *}

datatype aexp = ANum nat | APlus aexp aexp | AMinus aexp aexp | AMult aexp aexp
datatype bexp = BTrue | BFalse | BEq aexp aexp | BLe aexp aexp | BNot bexp | BAnd bexp bexp

subsubsection {* Evaluation *}

fun aeval :: "aexp \<Rightarrow> nat" where
  "aeval (ANum n) = n"
  | "aeval (APlus a1 a2) = aeval a1 + aeval a2"
  | "aeval (AMinus a1 a2) = aeval a1 - aeval a2"
  | "aeval (AMult a1 a2) = aeval a1 * aeval a2"

lemma test_aeval1: "aeval (APlus (ANum 2) (ANum 2)) = 4" by simp

fun beval :: "bexp \<Rightarrow> bool" where
  "beval BTrue = True"
  | "beval BFalse = False"
  | "beval (BEq a1 a2) = (aeval a1 = aeval a2)"
  | "beval (BLe a1 a2) = (aeval a1 \<le> aeval a2)"
  | "beval (BNot b1) = (\<not> beval b1)"
  | "beval (BAnd b1 b2) = (beval b1 \<and> beval b2)"

subsubsection {* Optimization *}

fun optimize_0plus :: "aexp \<Rightarrow> aexp" where
  "optimize_0plus (ANum n) = ANum n"
  | "optimize_0plus (APlus (ANum 0) e2) = optimize_0plus e2"
  | "optimize_0plus (APlus e1 e2) = APlus (optimize_0plus e1) (optimize_0plus e2)"
  | "optimize_0plus (AMinus e1 e2) = AMinus (optimize_0plus e1) (optimize_0plus e2)"
  | "optimize_0plus (AMult e1 e2) = AMult (optimize_0plus e1) (optimize_0plus e2)"

lemma test_optimize_0plus:
  "optimize_0plus (APlus (ANum 2) (APlus (ANum 0) (APlus (ANum 0) (ANum 1)))) = APlus (ANum 2) (ANum 1)"
by (subst Suc_1 [symmetric], subst optimize_0plus.simps(3), simp)

theorem optimize_0plus_sound: "aeval (optimize_0plus a) = aeval a"
  apply (induct rule: optimize_0plus.induct, auto)
  done

subsection {* Coq Automation *}

subsubsection {* Tacticals *}
subsubsection {* The repeat Tactical *}

theorem ev100: "ev (100 :: nat)"
proof -
  have 1: "\<And>n::nat. ev (double n)" using double_even by simp
  show "ev 100" using 1 [of 50] by simp
qed

subsubsection {* The try Tactical *}

theorem silly1: "aeval ae = aeval ae" by simp
theorem silly2: "P \<Longrightarrow> P" by simp

subsubsection {* The ; Tactical (Simple Form) *}

lemma foo: "0 \<le> (n :: nat)" by simp

subsubsection {* The ; Tactical (General Form) *}
subsubsection {* Defining New Tactic Notations *}
subsubsection {* Bulletproofing Case Analyses *}

(* Exercise: 3 stars (optimize_0plus_b) *)
fun optimize_0plus_b :: "bexp \<Rightarrow> bexp" where
  "optimize_0plus_b BTrue = BTrue"
  | "optimize_0plus_b BFalse = BFalse"
  | "optimize_0plus_b (BEq a1 a2) = BEq a1 a2"
  | "optimize_0plus_b (BLe a1 a2) = BLe a1 a2"
  | "optimize_0plus_b (BNot b1) = BNot b1"
  | "optimize_0plus_b (BAnd BTrue b2) = b2"
  | "optimize_0plus_b (BAnd BFalse _) = BFalse"
  | "optimize_0plus_b (BAnd b1 b2) = BAnd b1 b2"

theorem optimize_0plus_b_sound: "beval (optimize_0plus_b b) = beval b"
  apply (induct rule: optimize_0plus_b.induct)
  apply auto
  done

(* Exercise: 4 stars, optional (optimizer) *)

subsubsection {* The omega Tactic *}

lemma silly_presburger_example: "(m :: nat) + n \<le> n + o' \<and> o' + 3 = p + 3 \<Longrightarrow> m \<le> p" by simp

subsubsection {* A Few More Handy Tactics *}

subsection {* Evaluation as a Relation *}

inductive aevalR :: "aexp \<Rightarrow> nat \<Rightarrow> bool" (infixl "\<Down>" 70) where
  E_ANum: "aevalR (ANum n) n"
  | E_APlus: "\<lbrakk> aevalR e1 n1; aevalR e2 n2 \<rbrakk> \<Longrightarrow> aevalR (APlus e1 e2) (n1 + n2)"
  | E_AMinus: "\<lbrakk> aevalR e1 n1; aevalR e2 n2 \<rbrakk> \<Longrightarrow> aevalR (AMinus e1 e2) (n1 - n2)"
  | E_AMult: "\<lbrakk> aevalR e1 n1; aevalR e2 n2 \<rbrakk> \<Longrightarrow> aevalR (AMult e1 e2) (n1 * n2)"

subsubsection {* Inference Rule Notation *}
subsubsection {* Equivalence of the Definitions *}

theorem aeval_iff_aevalR: "a \<Down> n \<longleftrightarrow> aeval a = n"
apply auto
apply (erule aevalR.inducts, auto)
apply (rule aeval.induct, auto, rule)
  apply (rule, auto)+
done

(* Exercise: 3 stars (bevalR) *)
inductive bevalR :: "bexp \<Rightarrow> bool \<Rightarrow> bool" where
  E_BTrue: "bevalR BTrue True"
  | E_BFalse: "bevalR BFalse False"
  | E_BEq: "\<lbrakk> aevalR a1 m1; aevalR a2 m2 \<rbrakk> \<Longrightarrow> bevalR (BEq a1 a2) (m1 = m2)"
  | E_BLe: "\<lbrakk> aevalR a1 m1; aevalR a2 m2 \<rbrakk> \<Longrightarrow> bevalR (BLe a1 a2) (m1 \<le> m2)"
  | E_BNot: "bevalR b1 m1 \<Longrightarrow> bevalR (BNot b1) (\<not> m1)"
  | E_BAnd: "\<lbrakk> bevalR b1 m1; bevalR b2 m2 \<rbrakk> \<Longrightarrow> bevalR (BAnd b1 b2) (m1 \<and> m2)"

lemma bevalR_beval: "bevalR b (beval b)"
apply (induct b)
apply (simp, rule)+
apply (fastforce simp add: aeval_iff_aevalR)
apply (fastforce simp add: aeval_iff_aevalR)
apply (simp, metis E_BLe aeval_iff_aevalR)
apply (simp, rule, simp)
apply (simp, rule, simp, simp)
done

theorem beval_iff_bevalR: "bevalR b m \<longleftrightarrow> beval b = m"
apply rule
apply (erule bevalR.inducts, simp, simp)
  apply (simp, fastforce simp add: aeval_iff_aevalR)+
proof -
  assume 1: "beval b = m"
  show "bevalR b m"
    apply (subst 1 [symmetric])
    by (rule bevalR_beval)
qed

subsubsection {* Computational vs. Relational Definitions *}

datatype aexp' = ANum nat | APlus aexp' aexp' | AMinus aexp' aexp' | AMult aexp' aexp'
  | ADiv aexp' aexp'

inductive aevalR' :: "aexp' \<Rightarrow> nat \<Rightarrow> bool" where
  E_ANum: "aevalR' (ANum n) n"
  | E_APlus: "\<lbrakk> aevalR' e1 n1; aevalR' e2 n2 \<rbrakk> \<Longrightarrow> aevalR' (APlus e1 e2) (n1 + n2)"
  | E_AMinus: "\<lbrakk> aevalR' e1 n1; aevalR' e2 n2 \<rbrakk> \<Longrightarrow> aevalR' (AMinus e1 e2) (n1 - n2)"
  | E_AMult: "\<lbrakk> aevalR' e1 n1; aevalR' e2 n2 \<rbrakk> \<Longrightarrow> aevalR' (AMult e1 e2) (n1 * n2)"
  | E_ADiv: "\<lbrakk> aevalR' e1 n1; aevalR' e2 n2; n2 * n3 = n1 \<rbrakk> \<Longrightarrow> aevalR' (ADiv a1 a2) n3"

subsubsection {* Adding nondeterminism *}

datatype aexp'' = AAny | ANum nat | APlus aexp'' aexp'' | AMinus aexp'' aexp'' | AMult aexp'' aexp''

inductive aevalR'' :: "aexp'' \<Rightarrow> nat \<Rightarrow> bool" where
  E_Any: "aevalR'' AAny n"
  | E_ANum: "aevalR'' (ANum n) n"
  | E_APlus: "\<lbrakk> aevalR'' e1 n1; aevalR'' e2 n2 \<rbrakk> \<Longrightarrow> aevalR'' (APlus e1 e2) (n1 + n2)"
  | E_AMinus: "\<lbrakk> aevalR'' e1 n1; aevalR'' e2 n2 \<rbrakk> \<Longrightarrow> aevalR'' (AMinus e1 e2) (n1 - n2)"
  | E_AMult: "\<lbrakk> aevalR'' e1 n1; aevalR'' e2 n2 \<rbrakk> \<Longrightarrow> aevalR'' (AMult e1 e2) (n1 * n2)"

subsection {* Expressions With Variables *}
subsubsection {* Identifiers *}

datatype id = Id nat

theorem eq_id_dec: "\<And>id1 id2 :: id. {id1 = id2} \<bar> {id1 \<noteq> id2}"
apply (case_tac id1, case_tac id2, auto)
by (rule eq_nat_dec)

fun eq_id_dec where
  "eq_id_dec id1 id2 = (id1 = id2)"

lemma eq_id: "(if eq_id_dec x x then p else q) = p" by simp

(* Exercise: 1 star, optional (neq_id) *)
lemma neq_id: "x \<noteq> y \<Longrightarrow> (if eq_id_dec x y then p else q) = q" by simp

subsubsection {* States *}

type_synonym state = "id \<Rightarrow> nat"

fun empty_state :: state where
  "empty_state _ = 0"
fun update :: "state \<Rightarrow> id \<Rightarrow> nat \<Rightarrow> state" where
  "update st x n x' = (if eq_id_dec x x' then n else st x')"

(* Exercise: 1 star (update_eq) *)
theorem update_eq: "update st x n x = n" by simp

(* Exercise: 1 star (update_neq) *)
theorem udpate_neq: "x2 \<noteq> x1 \<Longrightarrow> update st x2 n x1 = st x1" by simp

(* Exercise: 1 star (update_example) *)
theorem update_example: "update empty_state (Id 2) n (Id 3) = 0" by simp

(* Exercise: 1 star (update_shadow) *)
theorem update_shadow: "update (update st x2 n1) x2 n2 x1 = update st x2 n2 x1" by simp

(* Exercise: 2 stars (update_same) *)
theorem update_same: "st x1 = n1 \<Longrightarrow> update st x1 n1 x2 = st x2" by auto

(* Exercise: 3 stars (update_permute) *)
theorem update_permute: "x2 \<noteq> x1 \<Longrightarrow> update (update st x2 n1) x1 n2 x3 = update (update st x1 n2) x2 n1 x3"
by auto

subsubsection {* Syntax *}

datatype aexp3 = ANum nat | AId id | APlus aexp3 aexp3 | AMinus aexp3 aexp3 | AMult aexp3 aexp3
abbreviation X where "X \<equiv> Id 0"
abbreviation Y where "Y \<equiv> Id 1"
abbreviation Z where "Z \<equiv> Id 2"

datatype bexp3 = BTrue | BFalse | BEq aexp3 aexp3 | BLe aexp3 aexp3 | BNot bexp3 | BAnd bexp3 bexp3

subsubsection {* Evaluation *}

fun aeval3 where
  "aeval3 st (ANum n) = n"
  | "aeval3 st (AId x) = st x"
  | "aeval3 st (APlus a1 a2) = aeval3 st a1 + aeval3 st a2"
  | "aeval3 st (AMinus a1 a2) = aeval3 st a1 - aeval3 st a2"
  | "aeval3 st (AMult a1 a2) = aeval3 st a1 * aeval3 st a2"

fun beval3 where
  "beval3 st BTrue = True"
  | "beval3 st BFalse = False"
  | "beval3 st (BEq a1 a2) = (aeval3 st a1 = aeval3 st a2)"
  | "beval3 st (BLe a1 a2) = (aeval3 st a1 \<le> aeval3 st a2)"
  | "beval3 st (BNot b1) = (\<not> beval3 st b1)"
  | "beval3 st (BAnd b1 b2) = (beval3 st b1 \<and> beval3 st b2)"

lemma aexp1: "aeval3 (update empty_state x 5) (APlus (ANum 3) (AMult (AId x) (ANum 2))) = 13"
by (simp add: sumbool.left)

lemma bexp1: "beval3 (update empty_state x 5) (BAnd BTrue (BNot (BLe (AId x) (ANum 4)))) = True"
by (simp add: sumbool.left)

subsection {* Commands *}
subsubsection {* Syntax *}

datatype com = CSkip | CAss id aexp3 | CSeq com com | CIf bexp3 com com | CWhile bexp3 com

notation
  CSkip ("SKIP") and
  CAss ("_ ::= _" [50,50] 90) and
  CSeq (infixr ";;" 30) and
  CWhile ("WHILE _ DO _ END" 90) and
  CIf ("IF _ THEN _ ELSE _ FI" 80)

definition fact_in_Isabelle :: com where
  "fact_in_Isabelle \<equiv>
    Z ::= AId X ;;
    Y ::= ANum 1 ;;
    WHILE BNot (BEq (AId Z) (ANum 0)) DO
      Y ::= AMult (AId Y) (AId Z) ;;
      Z ::= AMinus (AId Z) (ANum 1)
    END"

subsubsection {* Examples *}

definition plus2 where
  "plus2 \<equiv> (X ::= APlus (AId X) (ANum 2))"
definition XtimesYinZ where
  "XtimesYinZ \<equiv> (Z ::= AMult (AId X) (AId Y))"
definition subtract_slowly_body where
  "subtract_slowly_body \<equiv> (
    Z ::= AMinus (AId Z) (ANum 1) ;;
    X ::= AMinus (AId X) (ANum 1)
  )"

subsubsection {* Loops *}

definition subtract_slowly where
  "subtract_slowly \<equiv> (
    WHILE BNot (BEq (AId X) (ANum 0)) DO
      subtract_slowly_body
    END
  )"
definition subtract_3_from_5_slowly where
  "subtract_3_from_5_slowly \<equiv> (
    X ::= ANum 3 ;;
    Z ::= ANum 5 ;;
    subtract_slowly
  )"

subsubsection {* An infinite loop *}

definition loop where
  "loop \<equiv> WHILE BTrue DO SKIP END"

subsection {* Evaluation *}
subsubsection {* Evaluation as a Function (Failed Attempt) *}

fun ceval_fun_no_while where
  "ceval_fun_no_while st SKIP = st"
  | "ceval_fun_no_while st (x ::= a1) = update st x (aeval3 st a1)"
  | "ceval_fun_no_while st (c1 ;; c2) = ceval_fun_no_while (ceval_fun_no_while st c1) c2"
  | "ceval_fun_no_while st (IF b THEN c1 ELSE c2 FI) = (if (beval3 st b)
      then ceval_fun_no_while st c1
      else ceval_fun_no_while st c2)"
  | "ceval_fun_no_while st (WHILE b DO c END) = st" (* bogus *)

subsubsection {* Evaluation as a Relation *}
subsubsection {* Operational Semantics *}

inductive ceval :: "com \<Rightarrow> state \<Rightarrow> state \<Rightarrow> bool" ("_ %: _ \<Down> _" [39] 40) where
  E_Skip: "SKIP %: st \<Down> st"
  | E_Ass: "aeval3 st a1 = n \<Longrightarrow> (x ::= a1) %: st \<Down> (update st x n)"
  | E_Seq: "\<lbrakk> c1 %: st \<Down> st'; c2 %: st' \<Down> st'' \<rbrakk> \<Longrightarrow> (c1 ;; c2) %: st \<Down> st''"
  | E_IfTrue: "\<lbrakk> beval3 st b = True; c1 %: st \<Down> st' \<rbrakk> \<Longrightarrow> (IF b THEN c1 ELSE c2 FI) %: st \<Down> st'"
  | E_IfFalse: "\<lbrakk> beval3 st b = False; c2 %: st \<Down> st' \<rbrakk> \<Longrightarrow> (IF b THEN c1 ELSE c2 FI) %: st \<Down> st'"
  | E_WhileEnd: "beval3 st b = False \<Longrightarrow> (WHILE b DO c END) %: st \<Down> st"
  | E_WhileLoop: "\<lbrakk> beval3 st b = True; c %: st \<Down> st'; (WHILE b DO c END) %: st' \<Down> st'' \<rbrakk> \<Longrightarrow> (WHILE b DO c END) %: st \<Down> st''"

lemma eval_example1: "(
  X ::= ANum 2 ;;
  IF BLe (AId X) (ANum 1)
    THEN Y ::= ANum 3
    ELSE Z ::= ANum 4
  FI) %: empty_state \<Down> (update (update empty_state X 2) Z 4)"
by (rule+, auto, rule, simp)

(* Exercise: 2 stars (ceval_example2) *)
lemma ceval_example2: "(X ::= ANum 0;; Y ::= ANum 1;; Z ::= ANum 2)
  %: empty_state \<Down> (update (update (update empty_state X 0) Y 1) Z 2)"
by (auto, rule+, auto, rule, simp)

(* Exercise: 3 stars, advanced (pup_to_n) *)
definition pup_to_n where
  "pup_to_n \<equiv> (
    Y ::= ANum 0;;
    WHILE BLe (ANum 1) (AId X) DO
      Y ::= APlus (AId Y) (AId X);;
      X ::= AMinus (AId X) (ANum 1)
    END
  )"

theorem pup_to_2_ceval:
  "pup_to_n %: (update empty_state X 2) \<Down>
    update (update (update (update (update (update empty_state X 2) Y 0) Y 2) X 1) Y 3) X 0"
unfolding pup_to_n_def
apply (rule, simp, rule, simp)
apply (rule, simp, rule, rule, simp, rule, simp)
apply (rule, simp, rule, rule, simp, rule, rule, simp)
apply (subst Num.numeral_3_eq_3, subst Num.numeral_2_eq_2, rule E_WhileEnd, simp)
done

subsubsection {* Determinism of Evaluation *}

lemma ceval_deterministic_lemma: "c %: st \<Down> st' \<Longrightarrow> (\<And>u. c %: st \<Down> u \<Longrightarrow> st' = u)"
using ceval.induct [of c st st' "\<lambda>c0 st0 st'0. ((c0 %: st0 \<Down> st'0) \<longrightarrow> (\<forall>u. (c0 %: st0 \<Down> u) \<longrightarrow> (st'0 = u)))"]
apply rule
apply simp
proof-
  fix u sta
  assume "c %: st \<Down> st'" "c %: st \<Down> u"
  show "(SKIP %: sta \<Down> sta) \<longrightarrow> (\<forall>u. (SKIP %: sta \<Down> u) \<longrightarrow> sta = u)"
    by (auto, erule ceval.cases, auto, erule ceval.cases, auto)
next
  fix u sta a1 n x
  assume a: "c %: st \<Down> st'" "c %: st \<Down> u" "aeval3 sta a1 = n"
  show "(x ::= a1 %: sta \<Down> update sta x n) \<longrightarrow> (\<forall>u. (x ::= a1 %: sta \<Down> u) \<longrightarrow> update sta x n = u)"
    apply (auto, erule ceval.cases, auto)
    apply (erule ceval.cases, auto simp add: a)
    done
next
  fix u c1 sta st'a c2 st''
  assume a1: "c %: st \<Down> st'" "c %: st \<Down> u"
  and a2: "c1 %: sta \<Down> st'a" "(c1 %: sta \<Down> st'a) \<longrightarrow> (\<forall>u. (c1 %: sta \<Down> u) \<longrightarrow> st'a = u)"
  and a3: "c2 %: st'a \<Down> st''" "(c2 %: st'a \<Down> st'') \<longrightarrow> (\<forall>u. (c2 %: st'a \<Down> u) \<longrightarrow> st'' = u)"
  show "((c1 ;; c2) %: sta \<Down> st'') \<longrightarrow> (\<forall>u. ((c1 ;; c2) %: sta \<Down> u) \<longrightarrow> st'' = u)"
    proof auto
      fix u
      assume "(c1 ;; c2) %: sta \<Down> st''" "(c1 ;; c2) %: sta \<Down> u"
      from this(2) obtain u0 where
        u0: "c1 %: sta \<Down> u0" "c2 %: u0 \<Down> u" by (rule, auto)
      have 1: "st'a = u0" using u0(1) a2 by simp
      show "st'' = u" using a3(2) u0(2) by (simp add: a3(1), simp add: 1)
    qed
next
  fix u sta b c1 st'a c2
  assume a: "c %: st \<Down> st'" "c %: st \<Down> u" "beval3 sta b = True" "c1 %: sta \<Down> st'a" "(c1 %: sta \<Down> st'a) \<longrightarrow> (\<forall>u. (c1 %: sta \<Down> u) \<longrightarrow> st'a = u)"
  show "(IF b THEN c1 ELSE c2 FI %: sta \<Down> st'a) \<longrightarrow> (\<forall>u. (IF b THEN c1 ELSE c2 FI %: sta \<Down> u) \<longrightarrow> st'a = u)"
    proof auto
      fix u
      assume "IF b THEN c1 ELSE c2 FI %: sta \<Down> st'a" "IF b THEN c1 ELSE c2 FI %: sta \<Down> u"
      from this(2) have "c1 %: sta \<Down> u" by (rule, auto, auto simp add: a(3))
      thus "st'a = u" using a(5) a(4) by simp
    qed
next
  fix u sta b c2 st'a c1
  assume a: "c %: st \<Down> st'" "c %: st \<Down> u" "beval3 sta b = False" "c2 %: sta \<Down> st'a" "(c2 %: sta \<Down> st'a) \<longrightarrow> (\<forall>u. (c2 %: sta \<Down> u) \<longrightarrow> st'a = u)"
  show "(IF b THEN c1 ELSE c2 FI %: sta \<Down> st'a) \<longrightarrow> (\<forall>u. (IF b THEN c1 ELSE c2 FI %: sta \<Down> u) \<longrightarrow> st'a = u)"
    proof auto
      fix u
      assume "IF b THEN c1 ELSE c2 FI %: sta \<Down> st'a" "IF b THEN c1 ELSE c2 FI %: sta \<Down> u"
      from this(2) have "c2 %: sta \<Down> u" by (rule, auto, auto simp add: a(3))
      thus "st'a = u" using a(5) a(4) by simp
    qed
next
  fix u sta b ca
  assume a: "c %: st \<Down> st'" "c %: st \<Down> u" "beval3 sta b = False"
  show "(WHILE b DO ca END %: sta \<Down> sta) \<longrightarrow> (\<forall>u. (WHILE b DO ca END %: sta \<Down> u) \<longrightarrow> sta = u)"
    proof auto
      fix u
      assume "WHILE b DO ca END %: sta \<Down> sta" "WHILE b DO ca END %: sta \<Down> u"
      from this(2) show "sta = u"
        by (rule, auto, auto simp add: a(3))
    qed
next
  fix u sta b ca st'a st''
  assume "c %: st \<Down> st'" "c %: st \<Down> u"
  and a: "beval3 sta b = True" "ca %: sta \<Down> st'a" "(ca %: sta \<Down> st'a) \<longrightarrow> (\<forall>u. (ca %: sta \<Down> u) \<longrightarrow> st'a = u)"
  and a2: "WHILE b DO ca END %: st'a \<Down> st''" "(WHILE b DO ca END %: st'a \<Down> st'') \<longrightarrow> (\<forall>u. (WHILE b DO ca END %: st'a \<Down> u) \<longrightarrow> st'' = u)"

  have b1: "\<And>u. ca %: sta \<Down> u \<Longrightarrow> st'a = u" using a by simp
  have b2: "\<And>u. (WHILE b DO ca END) %: st'a \<Down> u \<Longrightarrow> st'' = u" using a2 by simp
  show "(WHILE b DO ca END %: sta \<Down> st'') \<longrightarrow> (\<forall>u. (WHILE b DO ca END %: sta \<Down> u) \<longrightarrow> st'' = u)"
    proof auto
      fix u
      assume a4: "WHILE b DO ca END %: sta \<Down> st''" "WHILE b DO ca END %: sta \<Down> u"
      from this(2) obtain u' where
        u': "ca %: sta \<Down> u'" "(WHILE b DO ca END) %: u' \<Down> u" by (rule, auto, auto simp add: a(1))
      have "st'a = u'" using b1 [OF u'(1)] by simp
      thus "st'' = u" using b2 u'(2) by auto
    qed
qed (auto)

theorem ceval_deterministic: "\<lbrakk> c %: st \<Down> st1; c %: st \<Down> st2 \<rbrakk> \<Longrightarrow> st1 = st2"
by (auto simp add: ceval_deterministic_lemma)

subsection {* Reasoning About Imp Programs *}

theorem plus2_spec: "\<lbrakk> st X = n; plus2 %: st \<Down> st' \<rbrakk> \<Longrightarrow> st' X = n + 2"
unfolding plus2_def
by (erule ceval.cases, auto)

(* Exercise: 3 stars (XtimesYinZ_spec) *)
theorem XtimesYinZ_spec: "XtimesYinZ %: st \<Down> st' \<Longrightarrow> st' Z = st X * st Y"
unfolding XtimesYinZ_def
by (erule ceval.cases, auto)

(* Exercise: 3 stars (loop_never_stops) *)
lemma while_induction:
  assumes red: "(WHILE b DO c END) %: st \<Down> st'"
  and base: "\<And>t t'. \<lbrakk> beval3 t b = False; t' = t \<rbrakk> \<Longrightarrow> P t t'"
  and step: "\<And>t t' t''. \<lbrakk> beval3 t b = True; c %: t \<Down> t'; (WHILE b DO c END) %: t' \<Down> t''; P t' t'' \<rbrakk> \<Longrightarrow> P t t''"
  shows "P st st'"
proof-
  have "(WHILE b DO c END) %: st \<Down> st' \<Longrightarrow> P st st'"
    using ceval.induct [of _ _ _ "\<lambda>c0 t t'. WHILE b DO c END = c0 \<longrightarrow> P t t'"] apply rule
    apply (simp, auto, simp add: base)
    apply (fastforce simp add: step)
    apply (fastforce simp add: step)
    done
  thus ?thesis by (simp add: red)
qed

theorem loop_never_stops: "\<not> (loop %: st \<Down> st')"
proof (unfold loop_def, auto)
  assume p: "WHILE BTrue DO SKIP END %: st \<Down> st'"
  show "False"
    using while_induction [of BTrue SKIP st st' "\<lambda>_. \<lambda>_. False"]
    by (rule, simp add: p, auto)
qed

(* Exercise: 3 stars (no_whilesR) *)
primrec no_whiles where
  "no_whiles SKIP = True"
  | "no_whiles (_ ::= _) = True"
  | "no_whiles (c1 ;; c2) = (no_whiles c1 \<and> no_whiles c2)"
  | "no_whiles (IF _ THEN ct ELSE cf FI) = (no_whiles ct \<and> no_whiles cf)"
  | "no_whiles (WHILE _ DO _ END) = False"

inductive no_whilesR where
  NW_Skip: "no_whilesR SKIP"
  | NW_Seq: "no_whilesR (x ::= aexp)"
  | NW_Ass: "\<lbrakk> no_whilesR e1; no_whilesR e2 \<rbrakk> \<Longrightarrow> no_whilesR (e1 ;; e2)"
  | NW_If: "\<lbrakk> no_whilesR e1; no_whilesR e2 \<rbrakk> \<Longrightarrow> no_whilesR (IF b THEN e1 ELSE e2 FI)"

theorem no_whiles_eqv: "no_whiles c \<longleftrightarrow> no_whilesR c"
apply rule
  apply (induct c, auto, rule+, auto, rule, auto)
  apply (erule no_whilesR.induct, auto)
done

(* Exercise: 4 stars (no_whiles_terminating) *)
theorem no_whiles_terminating: "no_whilesR c \<Longrightarrow> (\<And>st. c %: st \<Down> (ceval_fun_no_while st c))"
using no_whilesR.induct [of c "\<lambda>c0. \<forall>st. c0 %: st \<Down> (ceval_fun_no_while st c0)"] apply (rule, simp)
proof-
  fix st
  assume "no_whilesR c" show "\<forall>x. SKIP %: x \<Down> ceval_fun_no_while x SKIP" by (auto, rule)
next
  fix st x aexp
  assume "no_whilesR c" show "\<forall>xa. x ::= aexp %: xa \<Down> ceval_fun_no_while xa (x ::= aexp)" by (auto, rule, simp)
next
  fix st e1 e2
  assume a: "no_whilesR c" "no_whilesR e1" "\<forall>x. e1 %: x \<Down> ceval_fun_no_while x e1" "no_whilesR e2" "\<forall>x. e2 %: x \<Down> ceval_fun_no_while x e2"
  show "\<forall>x. (e1 ;; e2) %: x \<Down> ceval_fun_no_while x (e1 ;; e2)"
    proof (rule, rule)
      fix x
      {
        show "e1 %: x \<Down> ceval_fun_no_while x e1"
          using a(3) by simp
      }
      {
        show "e2 %: ceval_fun_no_while x e1 \<Down> ceval_fun_no_while x (e1 ;; e2)"
          using a(5) by simp
      }
    qed
next
  fix st e1 e2 b
  assume "no_whilesR c"
  and a1: "no_whilesR e1" "\<forall>x. e1 %: x \<Down> ceval_fun_no_while x e1"
  and a2: "no_whilesR e2" "\<forall>x. e2 %: x \<Down> ceval_fun_no_while x e2"
  show "\<forall>x. IF b THEN e1 ELSE e2 FI %: x \<Down> ceval_fun_no_while x (IF b THEN e1 ELSE e2 FI)"
    apply (auto)
    apply (rule E_IfTrue, simp, simp add: a1(2))
    apply (rule E_IfFalse, simp, simp add: a2(2))
    done
qed (auto)

subsection {* Additional Exercises *}

(* Exercise: 3 stars (stack_compiler) *)

datatype sinstr = SPush nat | SLoad id | SPlus | SMinus | SMult

fun s_execute :: "state \<Rightarrow> nat list \<Rightarrow> sinstr list \<Rightarrow> nat list" where
  "s_execute st l [] = l"
  | "s_execute st l ((SPush n) # xs) = s_execute st (n # l) xs"
  | "s_execute st l ((SLoad x) # xs) = s_execute st (st x # l) xs"
  | "s_execute st [] (SPlus # xs) = s_execute st [] xs"
  | "s_execute st [y] (SPlus # xs) = s_execute st [y] xs"
  | "s_execute st (y1 # y2 # ys) (SPlus # xs) = s_execute st ((y2 + y1) # ys) xs"
  | "s_execute st [] (SMinus # xs) = s_execute st [] xs"
  | "s_execute st [y] (SMinus # xs) = s_execute st [y] xs"
  | "s_execute st (y1 # y2 # ys) (SMinus # xs) = s_execute st ((y2 - y1) # ys) xs"
  | "s_execute st [] (SMult # xs) = s_execute st [] xs"
  | "s_execute st [y] (SMult # xs) = s_execute st [y] xs"
  | "s_execute st (y1 # y2 # ys) (SMult # xs) = s_execute st ((y2 * y1) # ys) xs"

lemma s_execute1: "s_execute empty_state [] [SPush 5, SPush 3, SPush 1, SMinus] = [2,5]"
by simp

lemma s_execute2: "s_execute (update empty_state X 3) [3,4] [SPush 4, SLoad X, SMult, SPlus] = [15, 4]"
by simp

fun s_compile :: "aexp3 \<Rightarrow> sinstr list" where
  "s_compile (ANum n) = [SPush n]"
  | "s_compile (AId x) = [SLoad x]"
  | "s_compile (APlus y1 y2) = s_compile y1 @ s_compile y2 @ [SPlus]"
  | "s_compile (AMinus y1 y2) = s_compile y1 @ s_compile y2 @ [SMinus]"
  | "s_compile (AMult y1 y2) = s_compile y1 @ s_compile y2 @ [SMult]"

lemma s_compile1: "s_compile (AMinus (AId X) (AMult (ANum 2) (AId Y))) = [SLoad X, SPush 2, SLoad Y, SMult, SMinus]"
by simp

(* Exercise: 3 stars, advanced (stack_compiler_correct) *)

lemma s_compile_correct_app: "\<And>st l. s_execute st l (e1 @ e2) = s_execute st (s_execute st l e1) e2"
apply (induct e1, auto)
apply (case_tac a, auto)
apply (case_tac l, auto, case_tac list, auto)
apply (case_tac l, auto, case_tac list, auto)
apply (case_tac l, auto, case_tac list, auto)
done

lemma s_compile_correct': "\<And>st l. s_execute st l (s_compile e) \<equiv> [aeval3 st e] @ l"
apply (induct e, auto) by (auto simp add: s_compile_correct_app)

theorem s_compile_correct: "s_execute st [] (s_compile e) = [aeval3 st e]"
by (simp add: s_compile_correct' [of st "[]"])

(* Exercise: 5 stars, advanced (break_imp) *)
datatype com' = CSkip | CBreak | CAss id aexp3 | CSeq com' com' | CIf bexp3 com' com' | CWhile bexp3 com'

notation
  CSkip ("SKIP'") and
  CBreak ("BREAK'") and
  CAss ("_ ::=' _" [50,50] 90) and
  CSeq (infixr ";;;" 30) and
  CWhile ("WHILE' _ DO _ END" 90) and
  CIf ("IF' _ THEN _ ELSE _ FI" 80)

datatype status = SContinue | SBreak

inductive ceval' :: "com' \<Rightarrow> state \<Rightarrow> status \<Rightarrow> state \<Rightarrow> bool" ("_ %: _ \<Down> _ %: _") where
  E_Skip: "SKIP' %: st \<Down> SContinue %: st"
  | E_Break: "BREAK' %: st \<Down> SBreak %: st"
  | E_Ass: "aeval3 st a1 = n \<Longrightarrow> (x ::=' a1) %: st \<Down> SContinue %: (update st x n)"
  | E_Seq_Break: "c1 %: st \<Down> SBreak %: st' \<Longrightarrow> (c1 ;;; c2) %: st \<Down> SBreak %: st'"
  | E_Seq_Continue: "\<lbrakk> c1 %: st \<Down> SContinue %: st'; c2 %: st' \<Down> s %: st'' \<rbrakk> \<Longrightarrow> (c1 ;;; c2) %: st \<Down> s %: st''"
  | E_IfTrue: "\<lbrakk> beval3 st b = True; c1 %: st \<Down> s %: st' \<rbrakk> \<Longrightarrow> (IF' b THEN c1 ELSE c2 FI) %: st \<Down> s %: st'"
  | E_IfFalse: "\<lbrakk> beval3 st b = False; c2 %: st \<Down> s %: st' \<rbrakk> \<Longrightarrow> (IF' b THEN c1 ELSE c2 FI) %: st \<Down> s %: st'"
  | E_WhileEnd: "beval3 st b = False \<Longrightarrow> (WHILE' b DO c END) %: st \<Down> SContinue %: st"
  | E_WhileLoop_Break: "\<lbrakk> beval3 st b = True; c %: st \<Down> SBreak %: st' \<rbrakk> \<Longrightarrow> (WHILE' b DO c END) %: st \<Down> SContinue %: st''"
  | E_WhileLoop_Continue: "\<lbrakk> beval3 st b = True; c %: st \<Down> SContinue %: st'; (WHILE' b DO c END) %: st' \<Down> SContinue %: st'' \<rbrakk>
      \<Longrightarrow> (WHILE' b DO c END) %: st \<Down> SContinue %: st''"

theorem break_ignore: "(BREAK' ;;; c) %: st \<Down> s %: st' \<Longrightarrow> st = st'"
apply (induct c)
  apply (erule ceval'.cases, auto)
  apply (erule ceval'.cases, auto)
  apply (erule ceval'.cases, auto)
  apply (erule ceval'.cases, auto)
  apply (erule ceval'.cases, auto)
  apply (erule ceval'.cases, auto)
  apply (erule ceval'.cases, auto)
  apply (erule ceval'.cases, auto)
  apply (erule ceval'.cases, auto)
  apply (erule ceval'.cases, auto)
  apply (erule ceval'.cases, auto)
  apply (erule ceval'.cases, auto)
  apply (erule ceval'.cases, auto)
  apply (erule ceval'.cases, auto)
  apply (erule ceval'.cases, auto)
  apply (erule ceval'.cases, auto)
  apply (erule ceval'.cases, auto)
  apply (erule ceval'.cases, auto)
done

theorem while_continue: "WHILE' b DO c END %: st \<Down> s %: st' \<Longrightarrow> s = SContinue"
by (erule ceval'.cases, auto)

theorem while_stops_on_break: "\<lbrakk> beval3 st b; c %: st \<Down> SBreak %: st' \<rbrakk> \<Longrightarrow> WHILE' b DO c END %: st \<Down> SContinue %: st'"
by (rule E_WhileLoop_Break, auto)

(*
(* Exercise: 3 stars, advanced, optional (while_break_true) *)
theorem while_break_true: "\<lbrakk> WHILE' b DO c END %: st \<Down> SContinue %: st'; beval3 st' b \<rbrakk>
  \<Longrightarrow> \<exists>st''. (c %: st'' \<Down> SBreak %: st')"
sorry

(* Exercise: 4 stars, advanced, optional (ceval_deterministic) *)
theorem ceval'_deterministic: "\<lbrakk> c %: st \<Down> s1 %: st1; c %: st \<Down> s2 %: st2 \<rbrakk> \<Longrightarrow> st1 = st2 \<and> s1 = s2"
sorry

(*
counterexample ?

  c = WHILE' bexp3.BTrue DO BREAK' END
  s1 = SContinue
  s2 = SContinue
  st = (\<lambda>x. ?)(i\<^sub>1 := 2, i\<^sub>2 := 3)
  st1 = (\<lambda>x. ?)(i\<^sub>1 := 2, i\<^sub>2 := 2)
  st2 = (\<lambda>x. ?)(i\<^sub>1 := 2, i\<^sub>2 := 3)
*)

*)

(* Exercise: 3 stars, optional (short_circuit) *)
fun beval3_shortcircuit :: "state \<Rightarrow> bexp3 \<Rightarrow> bool" where
  "beval3_shortcircuit st BTrue = True"
  | "beval3_shortcircuit st BFalse = False"
  | "beval3_shortcircuit st (BEq a1 a2) = (aeval3 st a1 = aeval3 st a2)"
  | "beval3_shortcircuit st (BLe a1 a2) = (aeval3 st a1 \<le> aeval3 st a2)"
  | "beval3_shortcircuit st (BNot b1) = (\<not> beval3_shortcircuit st b1)"
  | "beval3_shortcircuit st (BAnd b1 b2) = (if beval3_shortcircuit st b1 then beval3_shortcircuit st b2 else False)"

theorem short_circuit: "beval3 st b = beval3_shortcircuit st b"
by (induct b, auto)

(* Exercise: 4 stars, optional (add_for_loop) *)
(* Omitted *)

end


(*  Title:      Util_MinMax.thy
    Date:       Oct 2006
    Author:     David Trachtenherz
*)

header {* Order and linear order: min and max *}

theory Util_MinMax
imports Main
begin

subsection {* Additional lemmata about @{term min} and @{term max} *}

thm min_less_iff_conj
lemma min_less_imp_conj: "(z::'a::linorder) < min x y \<Longrightarrow> z < x \<and> z < y" by simp
lemma conj_less_imp_min: "\<lbrakk> z < x; z < y \<rbrakk> \<Longrightarrow> (z::'a::linorder) < min x y" by simp

(*lemma min_le_iff_conj: "((z::'a::linorder) \<le> min x y) = (z \<le> x \<and> z \<le> y)"*)
lemmas min_le_iff_conj = min.bounded_iff
lemma min_le_imp_conj: "(z::'a::linorder) \<le> min x y \<Longrightarrow> z \<le> x \<and> z \<le> y" by simp
(*lemma conj_le_imp_min: "\<lbrakk> z \<le> x; z \<le> y \<rbrakk> \<Longrightarrow> (z::'a::linorder) \<le> min x y"*)
lemmas conj_le_imp_min = min.boundedI

thm min.absorb1
(*lemma min_eqL:"\<lbrakk> (x::('a::linorder)) \<le> y \<rbrakk> \<Longrightarrow> min x y = x"*)
lemmas min_eqL = min.absorb1
(*lemma min_eqR:"\<lbrakk> (y::('a::linorder)) \<le> x \<rbrakk> \<Longrightarrow> min x y = y"*)
lemmas min_eqR = min.absorb2
lemmas min_eq = min_eqL min_eqR
thm min_eq

thm max_less_iff_conj
lemma max_less_imp_conj:"max x y < b \<Longrightarrow> x < (b::('a::linorder)) \<and> y < b" by simp

(*lemma max_le_iff_conj: "(max x y \<le> b) = (x \<le> (b::('a::linorder)) \<and> y \<le> b)"*)
lemmas max_le_iff_conj = max.bounded_iff
lemma max_le_imp_conj:"max x y \<le> b \<Longrightarrow> x \<le> (b::('a::linorder)) \<and> y \<le> b" by simp
(*lemma conj_le_imp_max:"\<lbrakk> x \<le> (b::('a::linorder)); y \<le> b \<rbrakk> \<Longrightarrow> max x y \<le> b"*)
lemmas conj_le_imp_max =  max.boundedI

thm max.absorb1
(*lemma max_eqL:"\<lbrakk> (y::('a::linorder)) \<le> x \<rbrakk> \<Longrightarrow> max x y = x"*)
lemmas max_eqL = max.absorb1
(*lemma max_eqR:"\<lbrakk> (x::('a::linorder)) \<le> y \<rbrakk> \<Longrightarrow> max x y = y"*)
lemmas max_eqR =  max.absorb2
lemmas max_eq = max_eqL max_eqR
thm max_eq

thm
  max.cobounded1
  max.cobounded2
(*lemma le_minI1:"min x y \<le> (x::('a::linorder))"*)
lemmas le_minI1 = min.cobounded1
(*lemma le_minI2:"min x y \<le> (y::('a::linorder))"*)
lemmas le_minI2 = min.cobounded2

lemma
  min_le_monoR: "(a::'a::linorder) \<le> b \<Longrightarrow> min x a \<le> min x b" and
  min_le_monoL: "(a::'a::linorder) \<le> b \<Longrightarrow> min a x \<le> min b x"
by (fastforce simp: min.mono min_def)+
lemma
  max_le_monoR: "(a::'a::linorder) \<le> b \<Longrightarrow> max x a \<le> max x b" and
  max_le_monoL: "(a::'a::linorder) \<le> b \<Longrightarrow> max a x \<le> max b x"
by (fastforce simp: max.mono max_def)+

end