diff --git a/src/HOL/Divides.thy b/src/HOL/Divides.thy
--- a/src/HOL/Divides.thy
+++ b/src/HOL/Divides.thy
@@ -1,649 +1,127 @@
 (*  Title:      HOL/Divides.thy
-    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
-    Copyright   1999  University of Cambridge
 *)
 
-section \<open>More on quotient and remainder\<close>
+section \<open>Lemmas of doubtful value\<close>
 
 theory Divides
 imports Parity
 begin
 
-subsection \<open>More on division\<close>
-
-subsubsection \<open>Monotonicity in the First Argument (Dividend)\<close>
-
-lemma unique_quotient_lemma:
-  assumes "b * q' + r' \<le> b * q + r" "0 \<le> r'" "r' < b" "r < b" shows "q' \<le> (q::int)"
-proof -
-  have "r' + b * (q'-q) \<le> r"
-    using assms by (simp add: right_diff_distrib)
-  moreover have "0 < b * (1 + q - q') "
-    using assms by (simp add: right_diff_distrib distrib_left)
-  moreover have "b * q' < b * (1 + q)"
-    using assms by (simp add: right_diff_distrib distrib_left)
-  ultimately show ?thesis
-    using assms by (simp add: mult_less_cancel_left)
-qed
-
-lemma unique_quotient_lemma_neg:
-  "b * q' + r' \<le> b*q + r \<Longrightarrow> r \<le> 0 \<Longrightarrow> b < r \<Longrightarrow> b < r' \<Longrightarrow> q \<le> (q'::int)"
-  using unique_quotient_lemma[where b = "-b" and r = "-r'" and r'="-r"] by auto
-
-lemma zdiv_mono1:
-  \<open>a div b \<le> a' div b\<close>
-  if \<open>a \<le> a'\<close> \<open>0 < b\<close>
-  for a b b' :: int
-proof (rule unique_quotient_lemma)
-  show "b * (a div b) + a mod b \<le> b * (a' div b) + a' mod b"
-    using \<open>a \<le> a'\<close> by auto
-qed (use that in auto)
-
-lemma zdiv_mono1_neg:
-  fixes b::int
-  assumes "a \<le> a'" "b < 0" shows "a' div b \<le> a div b"
-proof (rule unique_quotient_lemma_neg)
-  show "b * (a div b) + a mod b \<le> b * (a' div b) + a' mod b"
-    using assms(1) by auto
-qed (use assms in auto)
-
-
-subsubsection \<open>Monotonicity in the Second Argument (Divisor)\<close>
-
-lemma q_pos_lemma:
-  fixes q'::int
-  assumes "0 \<le> b'*q' + r'" "r' < b'" "0 < b'"
-  shows "0 \<le> q'"
-proof -
-  have "0 < b'* (q' + 1)"
-    using assms by (simp add: distrib_left)
-  with assms show ?thesis
-    by (simp add: zero_less_mult_iff)
-qed
-
-lemma zdiv_mono2_lemma:
-  fixes q'::int
-  assumes eq: "b*q + r = b'*q' + r'" and le: "0 \<le> b'*q' + r'" and "r' < b'" "0 \<le> r" "0 < b'" "b' \<le> b"
-  shows "q \<le> q'"
-proof -
-  have "0 \<le> q'"
-    using q_pos_lemma le \<open>r' < b'\<close> \<open>0 < b'\<close> by blast
-  moreover have "b*q = r' - r + b'*q'"
-    using eq by linarith
-  ultimately have "b*q < b* (q' + 1)"
-    using mult_right_mono assms unfolding distrib_left by fastforce
-  with assms show ?thesis
-    by (simp add: mult_less_cancel_left_pos)
-qed
-
-lemma zdiv_mono2:
-  fixes a::int
-  assumes "0 \<le> a" "0 < b'" "b' \<le> b" shows "a div b \<le> a div b'"
-proof (rule zdiv_mono2_lemma)
-  have "b \<noteq> 0"
-    using assms by linarith
-  show "b * (a div b) + a mod b = b' * (a div b') + a mod b'"
-    by simp
-qed (use assms in auto)
-
-lemma zdiv_mono2_neg_lemma:
-    fixes q'::int
-    assumes "b*q + r = b'*q' + r'" "b'*q' + r' < 0" "r < b" "0 \<le> r'" "0 < b'" "b' \<le> b"
-    shows "q' \<le> q"
-proof -
-  have "b'*q' < 0"
-    using assms by linarith
-  with assms have "q' \<le> 0"
-    by (simp add: mult_less_0_iff)
-  have "b*q' \<le> b'*q'"
-    by (simp add: \<open>q' \<le> 0\<close> assms(6) mult_right_mono_neg)
-  then have "b*q' < b* (q + 1)"
-    using assms by (simp add: distrib_left)
-  then show ?thesis
-    using assms by (simp add: mult_less_cancel_left)
-qed
-
-lemma zdiv_mono2_neg:
-  fixes a::int
-  assumes "a < 0" "0 < b'" "b' \<le> b" shows "a div b' \<le> a div b"
-proof (rule zdiv_mono2_neg_lemma)
-  have "b \<noteq> 0"
-    using assms by linarith
-  show "b * (a div b) + a mod b = b' * (a div b') + a mod b'"
-    by simp
-qed (use assms in auto)
-
-
-subsubsection \<open>Quotients of Signs\<close>
-
-lemma div_eq_minus1: "0 < b \<Longrightarrow> - 1 div b = - 1" for b :: int
-  by (simp add: divide_int_def)
-
-lemma zmod_minus1: "0 < b \<Longrightarrow> - 1 mod b = b - 1" for b :: int
-  by (auto simp add: modulo_int_def)
-
-lemma minus_mod_int_eq:
-  \<open>- k mod l = l - 1 - (k - 1) mod l\<close> if \<open>l \<ge> 0\<close> for k l :: int
-proof (cases \<open>l = 0\<close>)
-  case True
-  then show ?thesis
-    by simp
-next
-  case False
-  with that have \<open>l > 0\<close>
-    by simp
-  then show ?thesis
-  proof (cases \<open>l dvd k\<close>)
-    case True
-    then obtain j where \<open>k = l * j\<close> ..
-    moreover have \<open>(l * j mod l - 1) mod l = l - 1\<close>
-      using \<open>l > 0\<close> by (simp add: zmod_minus1)
-    then have \<open>(l * j - 1) mod l = l - 1\<close>
-      by (simp only: mod_simps)
-    ultimately show ?thesis
-      by simp
-  next
-    case False
-    moreover have 1: \<open>0 < k mod l\<close>
-      using \<open>0 < l\<close> False le_less by fastforce
-    moreover have 2: \<open>k mod l < 1 + l\<close>
-      using \<open>0 < l\<close> pos_mod_bound[of l k] by linarith
-    from 1 2 \<open>l > 0\<close> have \<open>(k mod l - 1) mod l = k mod l - 1\<close>
-      by (simp add: zmod_trivial_iff)
-    ultimately show ?thesis
-      by (simp only: zmod_zminus1_eq_if)
-         (simp add: mod_eq_0_iff_dvd algebra_simps mod_simps)
-  qed
-qed
-
-lemma div_neg_pos_less0:
-  fixes a::int
-  assumes "a < 0" "0 < b" 
-  shows "a div b < 0"
-proof -
-  have "a div b \<le> - 1 div b"
-    using zdiv_mono1 assms by auto
-  also have "... \<le> -1"
-    by (simp add: assms(2) div_eq_minus1)
-  finally show ?thesis 
-    by force
-qed
-
-lemma div_nonneg_neg_le0: "[| (0::int) \<le> a; b < 0 |] ==> a div b \<le> 0"
-  by (drule zdiv_mono1_neg, auto)
-
-lemma div_nonpos_pos_le0: "[| (a::int) \<le> 0; b > 0 |] ==> a div b \<le> 0"
-  by (drule zdiv_mono1, auto)
-
-text\<open>Now for some equivalences of the form \<open>a div b >=< 0 \<longleftrightarrow> \<dots>\<close>
-conditional upon the sign of \<open>a\<close> or \<open>b\<close>. There are many more.
-They should all be simp rules unless that causes too much search.\<close>
-
-lemma pos_imp_zdiv_nonneg_iff:
-      fixes a::int
-      assumes "0 < b" 
-      shows "(0 \<le> a div b) = (0 \<le> a)"
-proof
-  show "0 \<le> a div b \<Longrightarrow> 0 \<le> a"
-    using assms
-    by (simp add: linorder_not_less [symmetric]) (blast intro: div_neg_pos_less0)
-next
-  assume "0 \<le> a"
-  then have "0 div b \<le> a div b"
-    using zdiv_mono1 assms by blast
-  then show "0 \<le> a div b"
-    by auto
-qed
-
-lemma pos_imp_zdiv_pos_iff:
-  "0<k \<Longrightarrow> 0 < (i::int) div k \<longleftrightarrow> k \<le> i"
-  using pos_imp_zdiv_nonneg_iff[of k i] zdiv_eq_0_iff[of i k] by arith
-
-lemma neg_imp_zdiv_nonneg_iff:
-  fixes a::int
-  assumes "b < 0" 
-  shows "(0 \<le> a div b) = (a \<le> 0)"
-  using assms by (simp add: div_minus_minus [of a, symmetric] pos_imp_zdiv_nonneg_iff del: div_minus_minus)
-
-(*But not (a div b \<le> 0 iff a\<le>0); consider a=1, b=2 when a div b = 0.*)
-lemma pos_imp_zdiv_neg_iff: "(0::int) < b ==> (a div b < 0) = (a < 0)"
-  by (simp add: linorder_not_le [symmetric] pos_imp_zdiv_nonneg_iff)
-
-(*Again the law fails for \<le>: consider a = -1, b = -2 when a div b = 0*)
-lemma neg_imp_zdiv_neg_iff: "b < (0::int) ==> (a div b < 0) = (0 < a)"
-  by (simp add: linorder_not_le [symmetric] neg_imp_zdiv_nonneg_iff)
-
-lemma nonneg1_imp_zdiv_pos_iff:
-  fixes a::int
-  assumes "0 \<le> a" 
-  shows "a div b > 0 \<longleftrightarrow> a \<ge> b \<and> b>0"
-proof -
-  have "0 < a div b \<Longrightarrow> b \<le> a"
-    using div_pos_pos_trivial[of a b] assms by arith
-  moreover have "0 < a div b \<Longrightarrow> b > 0"
-    using assms div_nonneg_neg_le0[of a b]  by(cases "b=0"; force)
-  moreover have "b \<le> a \<and> 0 < b \<Longrightarrow> 0 < a div b"
-    using int_one_le_iff_zero_less[of "a div b"] zdiv_mono1[of b a b] by simp
-  ultimately show ?thesis
-    by blast
-qed
-
-lemma zmod_le_nonneg_dividend: "(m::int) \<ge> 0 \<Longrightarrow> m mod k \<le> m"
-  by (rule split_zmod[THEN iffD2]) (fastforce dest: q_pos_lemma intro: split_mult_pos_le)
-
-lemma sgn_div_eq_sgn_mult:
-  \<open>sgn (k div l) = of_bool (k div l \<noteq> 0) * sgn (k * l)\<close>
-  for k l :: int
-proof (cases \<open>k div l = 0\<close>)
-  case True
-  then show ?thesis
-    by simp
-next
-  case False
-  have \<open>0 \<le> \<bar>k\<bar> div \<bar>l\<bar>\<close>
-    by (cases \<open>l = 0\<close>) (simp_all add: pos_imp_zdiv_nonneg_iff)
-  then have \<open>\<bar>k\<bar> div \<bar>l\<bar> \<noteq> 0 \<longleftrightarrow> 0 < \<bar>k\<bar> div \<bar>l\<bar>\<close>
-    by (simp add: less_le)
-  also have \<open>\<dots> \<longleftrightarrow> \<bar>k\<bar> \<ge> \<bar>l\<bar>\<close>
-    using False nonneg1_imp_zdiv_pos_iff by auto
-  finally have *: \<open>\<bar>k\<bar> div \<bar>l\<bar> \<noteq> 0 \<longleftrightarrow> \<bar>l\<bar> \<le> \<bar>k\<bar>\<close> .
-  show ?thesis
-    using \<open>0 \<le> \<bar>k\<bar> div \<bar>l\<bar>\<close> False
-  by (auto simp add: div_eq_div_abs [of k l] div_eq_sgn_abs [of k l]
-    sgn_mult sgn_1_pos sgn_1_neg sgn_eq_0_iff nonneg1_imp_zdiv_pos_iff * dest: sgn_not_eq_imp)
-qed
-
-lemma
-  fixes a b q r :: int
-  assumes \<open>a = b * q + r\<close> \<open>0 \<le> r\<close> \<open>r < b\<close>
-  shows int_div_pos_eq:
-      \<open>a div b = q\<close> (is ?Q)
-    and int_mod_pos_eq:
-      \<open>a mod b = r\<close> (is ?R)
-proof -
-  from assms have \<open>(a div b, a mod b) = (q, r)\<close>
-    by (cases b q r a rule: euclidean_relation_intI)
-      (auto simp add: ac_simps dvd_add_left_iff sgn_1_pos le_less dest: zdvd_imp_le)
-  then show ?Q and ?R
-    by simp_all
-qed
-
-lemma int_div_neg_eq:
-  \<open>a div b = q\<close> if \<open>a = b * q + r\<close> \<open>r \<le> 0\<close> \<open>b < r\<close> for a b q r :: int
-  using that int_div_pos_eq [of a \<open>- b\<close> \<open>- q\<close> \<open>- r\<close>] by simp_all
-
-lemma int_mod_neg_eq:
-  \<open>a mod b = r\<close> if \<open>a = b * q + r\<close> \<open>r \<le> 0\<close> \<open>b < r\<close> for a b q r :: int
-  using that int_div_neg_eq [of a b q r] by simp
-
-
-subsubsection \<open>Further properties\<close>
-
-lemma div_int_pos_iff:
-  "k div l \<ge> 0 \<longleftrightarrow> k = 0 \<or> l = 0 \<or> k \<ge> 0 \<and> l \<ge> 0
-    \<or> k < 0 \<and> l < 0"
-  for k l :: int
-proof (cases "k = 0 \<or> l = 0")
-  case False
-  then have *: "k \<noteq> 0" "l \<noteq> 0"
-    by auto
-  then have "0 \<le> k div l \<Longrightarrow> \<not> k < 0 \<Longrightarrow> 0 \<le> l"
-    by (meson neg_imp_zdiv_neg_iff not_le not_less_iff_gr_or_eq)
-  then show ?thesis
-   using * by (auto simp add: pos_imp_zdiv_nonneg_iff neg_imp_zdiv_nonneg_iff)
-qed auto
-
-lemma mod_int_pos_iff:
-  "k mod l \<ge> 0 \<longleftrightarrow> l dvd k \<or> l = 0 \<and> k \<ge> 0 \<or> l > 0"
-  for k l :: int
-proof (cases "l > 0")
-  case False
-  then show ?thesis 
-    by (simp add: dvd_eq_mod_eq_0) (use neg_mod_sign [of l k] in \<open>auto simp add: le_less not_less\<close>)
-qed auto
-
-text \<open>Simplify expressions in which div and mod combine numerical constants\<close>
-
-lemma abs_div: "(y::int) dvd x \<Longrightarrow> \<bar>x div y\<bar> = \<bar>x\<bar> div \<bar>y\<bar>"
-  unfolding dvd_def by (cases "y=0") (auto simp add: abs_mult)
-
-text\<open>Suggested by Matthias Daum\<close>
-lemma int_power_div_base:
-  fixes k :: int
-  assumes "0 < m" "0 < k"
-  shows "k ^ m div k = (k::int) ^ (m - Suc 0)"
-proof -
-  have eq: "k ^ m = k ^ ((m - Suc 0) + Suc 0)"
-    by (simp add: assms)
-  show ?thesis
-    using assms by (simp only: power_add eq) auto
-qed
-
-text\<open>Suggested by Matthias Daum\<close>
-lemma int_div_less_self:
-  fixes x::int
-  assumes "0 < x" "1 < k"
-  shows  "x div k < x"
-proof -
-  have "nat x div nat k < nat x"
-    by (simp add: assms)
-  with assms show ?thesis
-    by (simp add: nat_div_distrib [symmetric])
-qed
-
-lemma mod_eq_dvd_iff_nat:
-  "m mod q = n mod q \<longleftrightarrow> q dvd m - n" if "m \<ge> n" for m n q :: nat
-proof -
-  have "int m mod int q = int n mod int q \<longleftrightarrow> int q dvd int m - int n"
-    by (simp add: mod_eq_dvd_iff)
-  with that have "int (m mod q) = int (n mod q) \<longleftrightarrow> int q dvd int (m - n)"
-    by (simp only: of_nat_mod of_nat_diff)
-  then show ?thesis
-    by simp
-qed
-
-lemma mod_eq_nat1E:
-  fixes m n q :: nat
-  assumes "m mod q = n mod q" and "m \<ge> n"
-  obtains s where "m = n + q * s"
-proof -
-  from assms have "q dvd m - n"
-    by (simp add: mod_eq_dvd_iff_nat)
-  then obtain s where "m - n = q * s" ..
-  with \<open>m \<ge> n\<close> have "m = n + q * s"
-    by simp
-  with that show thesis .
-qed
-
-lemma mod_eq_nat2E:
-  fixes m n q :: nat
-  assumes "m mod q = n mod q" and "n \<ge> m"
-  obtains s where "n = m + q * s"
-  using assms mod_eq_nat1E [of n q m] by (auto simp add: ac_simps)
-
-lemma nat_mod_eq_lemma:
-  assumes "(x::nat) mod n = y mod n" and "y \<le> x"
-  shows "\<exists>q. x = y + n * q"
-  using assms by (rule mod_eq_nat1E) (rule exI)
-
-lemma nat_mod_eq_iff: "(x::nat) mod n = y mod n \<longleftrightarrow> (\<exists>q1 q2. x + n * q1 = y + n * q2)"
-  (is "?lhs = ?rhs")
-proof
-  assume H: "x mod n = y mod n"
-  {assume xy: "x \<le> y"
-    from H have th: "y mod n = x mod n" by simp
-    from nat_mod_eq_lemma[OF th xy] have ?rhs
-    proof
-      fix q
-      assume "y = x + n * q"
-      then have "x + n * q = y + n * 0"
-        by simp
-      then show "\<exists>q1 q2. x + n * q1 = y + n * q2"
-        by blast
-    qed}
-  moreover
-  {assume xy: "y \<le> x"
-    from nat_mod_eq_lemma[OF H xy] have ?rhs
-    proof
-      fix q
-      assume "x = y + n * q"
-      then have "x + n * 0 = y + n * q"
-        by simp
-      then show "\<exists>q1 q2. x + n * q1 = y + n * q2"
-        by blast
-    qed}
-  ultimately  show ?rhs using linear[of x y] by blast
-next
-  assume ?rhs then obtain q1 q2 where q12: "x + n * q1 = y + n * q2" by blast
-  hence "(x + n * q1) mod n = (y + n * q2) mod n" by simp
-  thus  ?lhs by simp
-qed
-
-
-subsubsection \<open>Computing \<open>div\<close> and \<open>mod\<close> with shifting\<close>
-
-lemma div_pos_geq:
-  fixes k l :: int
-  assumes "0 < l" and "l \<le> k"
-  shows "k div l = (k - l) div l + 1"
-proof -
-  have "k = (k - l) + l" by simp
-  then obtain j where k: "k = j + l" ..
-  with assms show ?thesis by (simp add: div_add_self2)
-qed
-
-lemma mod_pos_geq:
-  fixes k l :: int
-  assumes "0 < l" and "l \<le> k"
-  shows "k mod l = (k - l) mod l"
-proof -
-  have "k = (k - l) + l" by simp
-  then obtain j where k: "k = j + l" ..
-  with assms show ?thesis by simp
-qed
-
-text\<open>computing div by shifting\<close>
-
-lemma pos_zdiv_mult_2: \<open>(1 + 2 * b) div (2 * a) = b div a\<close> (is ?Q)
-  and pos_zmod_mult_2: \<open>(1 + 2 * b) mod (2 * a) = 1 + 2 * (b mod a)\<close> (is ?R)
-  if \<open>0 \<le> a\<close> for a b :: int
-proof -
-  have \<open>((1 + 2 * b) div (2 * a), (1 + 2 * b) mod (2 * a)) = (b div a, 1 + 2 * (b mod a))\<close>
-  proof (cases \<open>2 * a\<close> \<open>b div a\<close> \<open>1 + 2 * (b mod a)\<close> \<open>1 + 2 * b\<close> rule: euclidean_relation_intI)
-    case by0
-    then show ?case
-      by simp
-  next
-    case divides
-    have \<open>even (2 * a)\<close>
-      by simp
-    then have \<open>even (1 + 2 * b)\<close>
-      using \<open>2 * a dvd 1 + 2 * b\<close> by (rule dvd_trans)
-    then show ?case
-      by simp
-  next
-    case euclidean_relation
-    with that have \<open>a > 0\<close>
-      by simp
-    moreover have \<open>b mod a < a\<close>
-      using \<open>a > 0\<close> by simp
-    then have \<open>1 + 2 * (b mod a) < 2 * a\<close>
-      by simp
-    moreover have \<open>2 * (b mod a) + a * (2 * (b div a)) = 2 * (b div a * a + b mod a)\<close>
-      by (simp only: algebra_simps)
-    moreover have \<open>0 \<le> 2 * (b mod a)\<close>
-      using \<open>a > 0\<close> by simp
-    ultimately show ?case
-      by (simp add: algebra_simps)
-  qed
-  then show ?Q and ?R
-    by simp_all
-qed
-
-lemma neg_zdiv_mult_2: \<open>(1 + 2 * b) div (2 * a) = (b + 1) div a\<close> (is ?Q)
-  and neg_zmod_mult_2: \<open>(1 + 2 * b) mod (2 * a) = 2 * ((b + 1) mod a) - 1\<close> (is ?R)
-  if \<open>a \<le> 0\<close> for a b :: int
-proof -
-  have \<open>((1 + 2 * b) div (2 * a), (1 + 2 * b) mod (2 * a)) = ((b + 1) div a, 2 * ((b + 1) mod a) - 1)\<close>
-  proof (cases \<open>2 * a\<close> \<open>(b + 1) div a\<close> \<open>2 * ((b + 1) mod a) - 1\<close> \<open>1 + 2 * b\<close> rule: euclidean_relation_intI)
-    case by0
-    then show ?case
-      by simp
-  next
-    case divides
-    have \<open>even (2 * a)\<close>
-      by simp
-    then have \<open>even (1 + 2 * b)\<close>
-      using \<open>2 * a dvd 1 + 2 * b\<close> by (rule dvd_trans)
-    then show ?case
-      by simp
-  next
-    case euclidean_relation
-    with that have \<open>a < 0\<close>
-      by simp
-    moreover have \<open>(b + 1) mod a > a\<close>
-      using \<open>a < 0\<close> by simp
-    then have \<open>2 * ((b + 1) mod a) > 1 + 2 * a\<close>
-      by simp
-    moreover have \<open>((1 + b) mod a) \<le> 0\<close>
-      using \<open>a < 0\<close> by simp
-    then have \<open>2 * ((1 + b) mod a) \<le> 0\<close>
-      by simp
-    moreover have \<open>2 * ((1 + b) mod a) + a * (2 * ((1 + b) div a)) =
-      2 * ((1 + b) div a * a + (1 + b) mod a)\<close>
-      by (simp only: algebra_simps)
-    ultimately show ?case
-      by (simp add: algebra_simps sgn_mult abs_mult)
-  qed
-  then show ?Q and ?R
-    by simp_all
-qed
-
-lemma zdiv_numeral_Bit0 [simp]:
-  "numeral (Num.Bit0 v) div numeral (Num.Bit0 w) =
-    numeral v div (numeral w :: int)"
-  unfolding numeral.simps unfolding mult_2 [symmetric]
-  by (rule div_mult_mult1, simp)
-
-lemma zdiv_numeral_Bit1 [simp]:
-  "numeral (Num.Bit1 v) div numeral (Num.Bit0 w) =
-    (numeral v div (numeral w :: int))"
-  unfolding numeral.simps
-  unfolding mult_2 [symmetric] add.commute [of _ 1]
-  by (rule pos_zdiv_mult_2, simp)
-
-lemma zmod_numeral_Bit0 [simp]:
-  "numeral (Num.Bit0 v) mod numeral (Num.Bit0 w) =
-    (2::int) * (numeral v mod numeral w)"
-  unfolding numeral_Bit0 [of v] numeral_Bit0 [of w]
-  unfolding mult_2 [symmetric] by (rule mod_mult_mult1)
-
-lemma zmod_numeral_Bit1 [simp]:
-  "numeral (Num.Bit1 v) mod numeral (Num.Bit0 w) =
-    2 * (numeral v mod numeral w) + (1::int)"
-  unfolding numeral_Bit1 [of v] numeral_Bit0 [of w]
-  unfolding mult_2 [symmetric] add.commute [of _ 1]
-  by (rule pos_zmod_mult_2, simp)
-
-  
-code_identifier
-  code_module Divides \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith
-
-
-subsection \<open>Lemmas of doubtful value\<close>
-
 class unique_euclidean_semiring_numeral = unique_euclidean_semiring_with_nat + linordered_semidom +
   assumes div_less: "0 \<le> a \<Longrightarrow> a < b \<Longrightarrow> a div b = 0"
     and mod_less: " 0 \<le> a \<Longrightarrow> a < b \<Longrightarrow> a mod b = a"
     and div_positive: "0 < b \<Longrightarrow> b \<le> a \<Longrightarrow> a div b > 0"
     and mod_less_eq_dividend: "0 \<le> a \<Longrightarrow> a mod b \<le> a"
     and pos_mod_bound: "0 < b \<Longrightarrow> a mod b < b"
     and pos_mod_sign: "0 < b \<Longrightarrow> 0 \<le> a mod b"
     and mod_mult2_eq: "0 \<le> c \<Longrightarrow> a mod (b * c) = b * (a div b mod c) + a mod b"
     and div_mult2_eq: "0 \<le> c \<Longrightarrow> a div (b * c) = a div b div c"
   assumes discrete: "a < b \<longleftrightarrow> a + 1 \<le> b"
 begin
 
 lemma divmod_digit_1:
   assumes "0 \<le> a" "0 < b" and "b \<le> a mod (2 * b)"
   shows "2 * (a div (2 * b)) + 1 = a div b" (is "?P")
     and "a mod (2 * b) - b = a mod b" (is "?Q")
 proof -
   from assms mod_less_eq_dividend [of a "2 * b"] have "b \<le> a"
     by (auto intro: trans)
   with \<open>0 < b\<close> have "0 < a div b" by (auto intro: div_positive)
   then have [simp]: "1 \<le> a div b" by (simp add: discrete)
   with \<open>0 < b\<close> have mod_less: "a mod b < b" by (simp add: pos_mod_bound)
   define w where "w = a div b mod 2"
   then have w_exhaust: "w = 0 \<or> w = 1" by auto
   have mod_w: "a mod (2 * b) = a mod b + b * w"
     by (simp add: w_def mod_mult2_eq ac_simps)
   from assms w_exhaust have "w = 1"
     using mod_less by (auto simp add: mod_w)
   with mod_w have mod: "a mod (2 * b) = a mod b + b" by simp
   have "2 * (a div (2 * b)) = a div b - w"
     by (simp add: w_def div_mult2_eq minus_mod_eq_mult_div ac_simps)
   with \<open>w = 1\<close> have div: "2 * (a div (2 * b)) = a div b - 1" by simp
   then show ?P and ?Q
     by (simp_all add: div mod add_implies_diff [symmetric])
 qed
 
 lemma divmod_digit_0:
   assumes "0 < b" and "a mod (2 * b) < b"
   shows "2 * (a div (2 * b)) = a div b" (is "?P")
     and "a mod (2 * b) = a mod b" (is "?Q")
 proof -
   define w where "w = a div b mod 2"
   then have w_exhaust: "w = 0 \<or> w = 1" by auto
   have mod_w: "a mod (2 * b) = a mod b + b * w"
     by (simp add: w_def mod_mult2_eq ac_simps)
   moreover have "b \<le> a mod b + b"
   proof -
     from \<open>0 < b\<close> pos_mod_sign have "0 \<le> a mod b" by blast
     then have "0 + b \<le> a mod b + b" by (rule add_right_mono)
     then show ?thesis by simp
   qed
   moreover note assms w_exhaust
   ultimately have "w = 0" by auto
   with mod_w have mod: "a mod (2 * b) = a mod b" by simp
   have "2 * (a div (2 * b)) = a div b - w"
     by (simp add: w_def div_mult2_eq minus_mod_eq_mult_div ac_simps)
   with \<open>w = 0\<close> have div: "2 * (a div (2 * b)) = a div b" by simp
   then show ?P and ?Q
     by (simp_all add: div mod)
 qed
 
 lemma mod_double_modulus:
   assumes "m > 0" "x \<ge> 0"
   shows   "x mod (2 * m) = x mod m \<or> x mod (2 * m) = x mod m + m"
 proof (cases "x mod (2 * m) < m")
   case True
   thus ?thesis using assms using divmod_digit_0(2)[of m x] by auto
 next
   case False
   hence *: "x mod (2 * m) - m = x mod m"
     using assms by (intro divmod_digit_1) auto
   hence "x mod (2 * m) = x mod m + m"
     by (subst * [symmetric], subst le_add_diff_inverse2) (use False in auto)
   thus ?thesis by simp
 qed
 
 end
 
 hide_fact (open) div_less mod_less mod_less_eq_dividend mod_mult2_eq div_mult2_eq
 
 instance nat :: unique_euclidean_semiring_numeral
   by standard
     (auto simp add: div_greater_zero_iff div_mult2_eq mod_mult2_eq)
 
 instance int :: unique_euclidean_semiring_numeral
   by standard (auto intro: zmod_le_nonneg_dividend simp add:
     pos_imp_zdiv_pos_iff zmod_zmult2_eq zdiv_zmult2_eq)
 
 lemma div_geq: "m div n = Suc ((m - n) div n)" if "0 < n" and " \<not> m < n" for m n :: nat
   by (rule le_div_geq) (use that in \<open>simp_all add: not_less\<close>)
 
 lemma mod_geq: "m mod n = (m - n) mod n" if "\<not> m < n" for m n :: nat
   by (rule le_mod_geq) (use that in \<open>simp add: not_less\<close>)
 
 lemma mod_eq_0D: "\<exists>q. m = d * q" if "m mod d = 0" for m d :: nat
   using that by (auto simp add: mod_eq_0_iff_dvd)
 
 lemma pos_mod_conj: "0 < b \<Longrightarrow> 0 \<le> a mod b \<and> a mod b < b" for a b :: int
   by simp
 
 lemma neg_mod_conj: "b < 0 \<Longrightarrow> a mod b \<le> 0 \<and> b < a mod b" for a b :: int
   by simp
 
 lemma zmod_eq_0_iff: "m mod d = 0 \<longleftrightarrow> (\<exists>q. m = d * q)" for m d :: int
   by (auto simp add: mod_eq_0_iff_dvd)
 
 (* REVISIT: should this be generalized to all semiring_div types? *)
 lemma zmod_eq_0D [dest!]: "\<exists>q. m = d * q" if "m mod d = 0" for m d :: int
   using that by auto
 
 lemma div_positive_int:
   "k div l > 0" if "k \<ge> l" and "l > 0" for k l :: int
   using that by (simp add: nonneg1_imp_zdiv_pos_iff)
 
+code_identifier
+  code_module Divides \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith
+
 end
diff --git a/src/HOL/Euclidean_Division.thy b/src/HOL/Euclidean_Division.thy
--- a/src/HOL/Euclidean_Division.thy
+++ b/src/HOL/Euclidean_Division.thy
@@ -1,2818 +1,3319 @@
 (*  Title:      HOL/Euclidean_Division.thy
     Author:     Manuel Eberl, TU Muenchen
     Author:     Florian Haftmann, TU Muenchen
 *)
 
 section \<open>Division in euclidean (semi)rings\<close>
 
 theory Euclidean_Division
   imports Int Lattices_Big
 begin
 
 subsection \<open>Euclidean (semi)rings with explicit division and remainder\<close>
-  
-class euclidean_semiring = semidom_modulo + 
+
+class euclidean_semiring = semidom_modulo +
   fixes euclidean_size :: "'a \<Rightarrow> nat"
   assumes size_0 [simp]: "euclidean_size 0 = 0"
-  assumes mod_size_less: 
+  assumes mod_size_less:
     "b \<noteq> 0 \<Longrightarrow> euclidean_size (a mod b) < euclidean_size b"
   assumes size_mult_mono:
     "b \<noteq> 0 \<Longrightarrow> euclidean_size a \<le> euclidean_size (a * b)"
 begin
 
 lemma euclidean_size_eq_0_iff [simp]:
   "euclidean_size b = 0 \<longleftrightarrow> b = 0"
 proof
   assume "b = 0"
   then show "euclidean_size b = 0"
     by simp
 next
   assume "euclidean_size b = 0"
   show "b = 0"
   proof (rule ccontr)
     assume "b \<noteq> 0"
     with mod_size_less have "euclidean_size (b mod b) < euclidean_size b" .
     with \<open>euclidean_size b = 0\<close> show False
       by simp
   qed
 qed
 
 lemma euclidean_size_greater_0_iff [simp]:
   "euclidean_size b > 0 \<longleftrightarrow> b \<noteq> 0"
   using euclidean_size_eq_0_iff [symmetric, of b] by safe simp
 
 lemma size_mult_mono': "b \<noteq> 0 \<Longrightarrow> euclidean_size a \<le> euclidean_size (b * a)"
   by (subst mult.commute) (rule size_mult_mono)
 
 lemma dvd_euclidean_size_eq_imp_dvd:
   assumes "a \<noteq> 0" and "euclidean_size a = euclidean_size b"
-    and "b dvd a" 
+    and "b dvd a"
   shows "a dvd b"
 proof (rule ccontr)
   assume "\<not> a dvd b"
   hence "b mod a \<noteq> 0" using mod_0_imp_dvd [of b a] by blast
   then have "b mod a \<noteq> 0" by (simp add: mod_eq_0_iff_dvd)
   from \<open>b dvd a\<close> have "b dvd b mod a" by (simp add: dvd_mod_iff)
   then obtain c where "b mod a = b * c" unfolding dvd_def by blast
     with \<open>b mod a \<noteq> 0\<close> have "c \<noteq> 0" by auto
   with \<open>b mod a = b * c\<close> have "euclidean_size (b mod a) \<ge> euclidean_size b"
     using size_mult_mono by force
   moreover from \<open>\<not> a dvd b\<close> and \<open>a \<noteq> 0\<close>
   have "euclidean_size (b mod a) < euclidean_size a"
     using mod_size_less by blast
   ultimately show False using \<open>euclidean_size a = euclidean_size b\<close>
     by simp
 qed
 
 lemma euclidean_size_times_unit:
   assumes "is_unit a"
   shows   "euclidean_size (a * b) = euclidean_size b"
 proof (rule antisym)
   from assms have [simp]: "a \<noteq> 0" by auto
   thus "euclidean_size (a * b) \<ge> euclidean_size b" by (rule size_mult_mono')
   from assms have "is_unit (1 div a)" by simp
   hence "1 div a \<noteq> 0" by (intro notI) simp_all
   hence "euclidean_size (a * b) \<le> euclidean_size ((1 div a) * (a * b))"
     by (rule size_mult_mono')
   also from assms have "(1 div a) * (a * b) = b"
     by (simp add: algebra_simps unit_div_mult_swap)
   finally show "euclidean_size (a * b) \<le> euclidean_size b" .
 qed
 
 lemma euclidean_size_unit:
   "is_unit a \<Longrightarrow> euclidean_size a = euclidean_size 1"
   using euclidean_size_times_unit [of a 1] by simp
 
-lemma unit_iff_euclidean_size: 
+lemma unit_iff_euclidean_size:
   "is_unit a \<longleftrightarrow> euclidean_size a = euclidean_size 1 \<and> a \<noteq> 0"
 proof safe
   assume A: "a \<noteq> 0" and B: "euclidean_size a = euclidean_size 1"
   show "is_unit a"
     by (rule dvd_euclidean_size_eq_imp_dvd [OF A B]) simp_all
 qed (auto intro: euclidean_size_unit)
 
 lemma euclidean_size_times_nonunit:
   assumes "a \<noteq> 0" "b \<noteq> 0" "\<not> is_unit a"
   shows   "euclidean_size b < euclidean_size (a * b)"
 proof (rule ccontr)
   assume "\<not>euclidean_size b < euclidean_size (a * b)"
-  with size_mult_mono'[OF assms(1), of b] 
+  with size_mult_mono'[OF assms(1), of b]
     have eq: "euclidean_size (a * b) = euclidean_size b" by simp
   have "a * b dvd b"
     by (rule dvd_euclidean_size_eq_imp_dvd [OF _ eq])
        (use assms in simp_all)
   hence "a * b dvd 1 * b" by simp
   with \<open>b \<noteq> 0\<close> have "is_unit a" by (subst (asm) dvd_times_right_cancel_iff)
   with assms(3) show False by contradiction
 qed
 
 lemma dvd_imp_size_le:
-  assumes "a dvd b" "b \<noteq> 0" 
+  assumes "a dvd b" "b \<noteq> 0"
   shows   "euclidean_size a \<le> euclidean_size b"
   using assms by (auto simp: size_mult_mono)
 
 lemma dvd_proper_imp_size_less:
-  assumes "a dvd b" "\<not> b dvd a" "b \<noteq> 0" 
+  assumes "a dvd b" "\<not> b dvd a" "b \<noteq> 0"
   shows   "euclidean_size a < euclidean_size b"
 proof -
   from assms(1) obtain c where "b = a * c" by (erule dvdE)
   hence z: "b = c * a" by (simp add: mult.commute)
   from z assms have "\<not>is_unit c" by (auto simp: mult.commute mult_unit_dvd_iff)
   with z assms show ?thesis
     by (auto intro!: euclidean_size_times_nonunit)
 qed
 
 lemma unit_imp_mod_eq_0:
   "a mod b = 0" if "is_unit b"
   using that by (simp add: mod_eq_0_iff_dvd unit_imp_dvd)
 
 lemma mod_eq_self_iff_div_eq_0:
   "a mod b = a \<longleftrightarrow> a div b = 0" (is "?P \<longleftrightarrow> ?Q")
 proof
   assume ?P
   with div_mult_mod_eq [of a b] show ?Q
     by auto
 next
   assume ?Q
   with div_mult_mod_eq [of a b] show ?P
     by simp
 qed
 
 lemma coprime_mod_left_iff [simp]:
   "coprime (a mod b) b \<longleftrightarrow> coprime a b" if "b \<noteq> 0"
   by (rule iffI; rule coprimeI)
     (use that in \<open>auto dest!: dvd_mod_imp_dvd coprime_common_divisor simp add: dvd_mod_iff\<close>)
 
 lemma coprime_mod_right_iff [simp]:
   "coprime a (b mod a) \<longleftrightarrow> coprime a b" if "a \<noteq> 0"
   using that coprime_mod_left_iff [of a b] by (simp add: ac_simps)
 
 end
 
 class euclidean_ring = idom_modulo + euclidean_semiring
 begin
 
 lemma dvd_diff_commute [ac_simps]:
   "a dvd c - b \<longleftrightarrow> a dvd b - c"
 proof -
   have "a dvd c - b \<longleftrightarrow> a dvd (c - b) * - 1"
     by (subst dvd_mult_unit_iff) simp_all
   then show ?thesis
     by simp
 qed
- 
+
 end
 
 
 subsection \<open>Euclidean (semi)rings with cancel rules\<close>
 
 class euclidean_semiring_cancel = euclidean_semiring +
   assumes div_mult_self1 [simp]: "b \<noteq> 0 \<Longrightarrow> (a + c * b) div b = c + a div b"
   and div_mult_mult1 [simp]: "c \<noteq> 0 \<Longrightarrow> (c * a) div (c * b) = a div b"
 begin
 
 lemma div_mult_self2 [simp]:
   assumes "b \<noteq> 0"
   shows "(a + b * c) div b = c + a div b"
   using assms div_mult_self1 [of b a c] by (simp add: mult.commute)
 
 lemma div_mult_self3 [simp]:
   assumes "b \<noteq> 0"
   shows "(c * b + a) div b = c + a div b"
   using assms by (simp add: add.commute)
 
 lemma div_mult_self4 [simp]:
   assumes "b \<noteq> 0"
   shows "(b * c + a) div b = c + a div b"
   using assms by (simp add: add.commute)
 
 lemma mod_mult_self1 [simp]: "(a + c * b) mod b = a mod b"
 proof (cases "b = 0")
   case True then show ?thesis by simp
 next
   case False
   have "a + c * b = (a + c * b) div b * b + (a + c * b) mod b"
     by (simp add: div_mult_mod_eq)
   also from False div_mult_self1 [of b a c] have
     "\<dots> = (c + a div b) * b + (a + c * b) mod b"
       by (simp add: algebra_simps)
   finally have "a = a div b * b + (a + c * b) mod b"
     by (simp add: add.commute [of a] add.assoc distrib_right)
   then have "a div b * b + (a + c * b) mod b = a div b * b + a mod b"
     by (simp add: div_mult_mod_eq)
   then show ?thesis by simp
 qed
 
 lemma mod_mult_self2 [simp]:
   "(a + b * c) mod b = a mod b"
   by (simp add: mult.commute [of b])
 
 lemma mod_mult_self3 [simp]:
   "(c * b + a) mod b = a mod b"
   by (simp add: add.commute)
 
 lemma mod_mult_self4 [simp]:
   "(b * c + a) mod b = a mod b"
   by (simp add: add.commute)
 
 lemma mod_mult_self1_is_0 [simp]:
   "b * a mod b = 0"
   using mod_mult_self2 [of 0 b a] by simp
 
 lemma mod_mult_self2_is_0 [simp]:
   "a * b mod b = 0"
   using mod_mult_self1 [of 0 a b] by simp
 
 lemma div_add_self1:
   assumes "b \<noteq> 0"
   shows "(b + a) div b = a div b + 1"
   using assms div_mult_self1 [of b a 1] by (simp add: add.commute)
 
 lemma div_add_self2:
   assumes "b \<noteq> 0"
   shows "(a + b) div b = a div b + 1"
   using assms div_add_self1 [of b a] by (simp add: add.commute)
 
 lemma mod_add_self1 [simp]:
   "(b + a) mod b = a mod b"
   using mod_mult_self1 [of a 1 b] by (simp add: add.commute)
 
 lemma mod_add_self2 [simp]:
   "(a + b) mod b = a mod b"
   using mod_mult_self1 [of a 1 b] by simp
 
 lemma mod_div_trivial [simp]:
   "a mod b div b = 0"
 proof (cases "b = 0")
   assume "b = 0"
   thus ?thesis by simp
 next
   assume "b \<noteq> 0"
   hence "a div b + a mod b div b = (a mod b + a div b * b) div b"
     by (rule div_mult_self1 [symmetric])
   also have "\<dots> = a div b"
     by (simp only: mod_div_mult_eq)
   also have "\<dots> = a div b + 0"
     by simp
   finally show ?thesis
     by (rule add_left_imp_eq)
 qed
 
 lemma mod_mod_trivial [simp]:
   "a mod b mod b = a mod b"
 proof -
   have "a mod b mod b = (a mod b + a div b * b) mod b"
     by (simp only: mod_mult_self1)
   also have "\<dots> = a mod b"
     by (simp only: mod_div_mult_eq)
   finally show ?thesis .
 qed
 
 lemma mod_mod_cancel:
   assumes "c dvd b"
   shows "a mod b mod c = a mod c"
 proof -
   from \<open>c dvd b\<close> obtain k where "b = c * k"
     by (rule dvdE)
   have "a mod b mod c = a mod (c * k) mod c"
     by (simp only: \<open>b = c * k\<close>)
   also have "\<dots> = (a mod (c * k) + a div (c * k) * k * c) mod c"
     by (simp only: mod_mult_self1)
   also have "\<dots> = (a div (c * k) * (c * k) + a mod (c * k)) mod c"
     by (simp only: ac_simps)
   also have "\<dots> = a mod c"
     by (simp only: div_mult_mod_eq)
   finally show ?thesis .
 qed
 
 lemma div_mult_mult2 [simp]:
   "c \<noteq> 0 \<Longrightarrow> (a * c) div (b * c) = a div b"
   by (drule div_mult_mult1) (simp add: mult.commute)
 
 lemma div_mult_mult1_if [simp]:
   "(c * a) div (c * b) = (if c = 0 then 0 else a div b)"
   by simp_all
 
 lemma mod_mult_mult1:
   "(c * a) mod (c * b) = c * (a mod b)"
 proof (cases "c = 0")
   case True then show ?thesis by simp
 next
   case False
   from div_mult_mod_eq
   have "((c * a) div (c * b)) * (c * b) + (c * a) mod (c * b) = c * a" .
   with False have "c * ((a div b) * b + a mod b) + (c * a) mod (c * b)
     = c * a + c * (a mod b)" by (simp add: algebra_simps)
   with div_mult_mod_eq show ?thesis by simp
 qed
 
 lemma mod_mult_mult2:
   "(a * c) mod (b * c) = (a mod b) * c"
   using mod_mult_mult1 [of c a b] by (simp add: mult.commute)
 
 lemma mult_mod_left: "(a mod b) * c = (a * c) mod (b * c)"
   by (fact mod_mult_mult2 [symmetric])
 
 lemma mult_mod_right: "c * (a mod b) = (c * a) mod (c * b)"
   by (fact mod_mult_mult1 [symmetric])
 
 lemma dvd_mod: "k dvd m \<Longrightarrow> k dvd n \<Longrightarrow> k dvd (m mod n)"
   unfolding dvd_def by (auto simp add: mod_mult_mult1)
 
 lemma div_plus_div_distrib_dvd_left:
   "c dvd a \<Longrightarrow> (a + b) div c = a div c + b div c"
   by (cases "c = 0") auto
 
 lemma div_plus_div_distrib_dvd_right:
   "c dvd b \<Longrightarrow> (a + b) div c = a div c + b div c"
   using div_plus_div_distrib_dvd_left [of c b a]
   by (simp add: ac_simps)
 
 lemma sum_div_partition:
   \<open>(\<Sum>a\<in>A. f a) div b = (\<Sum>a\<in>A \<inter> {a. b dvd f a}. f a div b) + (\<Sum>a\<in>A \<inter> {a. \<not> b dvd f a}. f a) div b\<close>
     if \<open>finite A\<close>
 proof -
   have \<open>A = A \<inter> {a. b dvd f a} \<union> A \<inter> {a. \<not> b dvd f a}\<close>
     by auto
   then have \<open>(\<Sum>a\<in>A. f a) = (\<Sum>a\<in>A \<inter> {a. b dvd f a} \<union> A \<inter> {a. \<not> b dvd f a}. f a)\<close>
     by simp
   also have \<open>\<dots> = (\<Sum>a\<in>A \<inter> {a. b dvd f a}. f a) + (\<Sum>a\<in>A \<inter> {a. \<not> b dvd f a}. f a)\<close>
     using \<open>finite A\<close> by (auto intro: sum.union_inter_neutral)
   finally have *: \<open>sum f A = sum f (A \<inter> {a. b dvd f a}) + sum f (A \<inter> {a. \<not> b dvd f a})\<close> .
   define B where B: \<open>B = A \<inter> {a. b dvd f a}\<close>
   with \<open>finite A\<close> have \<open>finite B\<close> and \<open>a \<in> B \<Longrightarrow> b dvd f a\<close> for a
     by simp_all
   then have \<open>(\<Sum>a\<in>B. f a) div b = (\<Sum>a\<in>B. f a div b)\<close> and \<open>b dvd (\<Sum>a\<in>B. f a)\<close>
     by induction (simp_all add: div_plus_div_distrib_dvd_left)
   then show ?thesis using *
     by (simp add: B div_plus_div_distrib_dvd_left)
 qed
 
 named_theorems mod_simps
 
 text \<open>Addition respects modular equivalence.\<close>
 
 lemma mod_add_left_eq [mod_simps]:
   "(a mod c + b) mod c = (a + b) mod c"
 proof -
   have "(a + b) mod c = (a div c * c + a mod c + b) mod c"
     by (simp only: div_mult_mod_eq)
   also have "\<dots> = (a mod c + b + a div c * c) mod c"
     by (simp only: ac_simps)
   also have "\<dots> = (a mod c + b) mod c"
     by (rule mod_mult_self1)
   finally show ?thesis
     by (rule sym)
 qed
 
 lemma mod_add_right_eq [mod_simps]:
   "(a + b mod c) mod c = (a + b) mod c"
   using mod_add_left_eq [of b c a] by (simp add: ac_simps)
 
 lemma mod_add_eq:
   "(a mod c + b mod c) mod c = (a + b) mod c"
   by (simp add: mod_add_left_eq mod_add_right_eq)
 
 lemma mod_sum_eq [mod_simps]:
   "(\<Sum>i\<in>A. f i mod a) mod a = sum f A mod a"
 proof (induct A rule: infinite_finite_induct)
   case (insert i A)
   then have "(\<Sum>i\<in>insert i A. f i mod a) mod a
     = (f i mod a + (\<Sum>i\<in>A. f i mod a)) mod a"
     by simp
   also have "\<dots> = (f i + (\<Sum>i\<in>A. f i mod a) mod a) mod a"
     by (simp add: mod_simps)
   also have "\<dots> = (f i + (\<Sum>i\<in>A. f i) mod a) mod a"
     by (simp add: insert.hyps)
   finally show ?case
     by (simp add: insert.hyps mod_simps)
 qed simp_all
 
 lemma mod_add_cong:
   assumes "a mod c = a' mod c"
   assumes "b mod c = b' mod c"
   shows "(a + b) mod c = (a' + b') mod c"
 proof -
   have "(a mod c + b mod c) mod c = (a' mod c + b' mod c) mod c"
     unfolding assms ..
   then show ?thesis
     by (simp add: mod_add_eq)
 qed
 
 text \<open>Multiplication respects modular equivalence.\<close>
 
 lemma mod_mult_left_eq [mod_simps]:
   "((a mod c) * b) mod c = (a * b) mod c"
 proof -
   have "(a * b) mod c = ((a div c * c + a mod c) * b) mod c"
     by (simp only: div_mult_mod_eq)
   also have "\<dots> = (a mod c * b + a div c * b * c) mod c"
     by (simp only: algebra_simps)
   also have "\<dots> = (a mod c * b) mod c"
     by (rule mod_mult_self1)
   finally show ?thesis
     by (rule sym)
 qed
 
 lemma mod_mult_right_eq [mod_simps]:
   "(a * (b mod c)) mod c = (a * b) mod c"
   using mod_mult_left_eq [of b c a] by (simp add: ac_simps)
 
 lemma mod_mult_eq:
   "((a mod c) * (b mod c)) mod c = (a * b) mod c"
   by (simp add: mod_mult_left_eq mod_mult_right_eq)
 
 lemma mod_prod_eq [mod_simps]:
   "(\<Prod>i\<in>A. f i mod a) mod a = prod f A mod a"
 proof (induct A rule: infinite_finite_induct)
   case (insert i A)
   then have "(\<Prod>i\<in>insert i A. f i mod a) mod a
     = (f i mod a * (\<Prod>i\<in>A. f i mod a)) mod a"
     by simp
   also have "\<dots> = (f i * ((\<Prod>i\<in>A. f i mod a) mod a)) mod a"
     by (simp add: mod_simps)
   also have "\<dots> = (f i * ((\<Prod>i\<in>A. f i) mod a)) mod a"
     by (simp add: insert.hyps)
   finally show ?case
     by (simp add: insert.hyps mod_simps)
 qed simp_all
 
 lemma mod_mult_cong:
   assumes "a mod c = a' mod c"
   assumes "b mod c = b' mod c"
   shows "(a * b) mod c = (a' * b') mod c"
 proof -
   have "(a mod c * (b mod c)) mod c = (a' mod c * (b' mod c)) mod c"
     unfolding assms ..
   then show ?thesis
     by (simp add: mod_mult_eq)
 qed
 
 text \<open>Exponentiation respects modular equivalence.\<close>
 
-lemma power_mod [mod_simps]: 
+lemma power_mod [mod_simps]:
   "((a mod b) ^ n) mod b = (a ^ n) mod b"
 proof (induct n)
   case 0
   then show ?case by simp
 next
   case (Suc n)
   have "(a mod b) ^ Suc n mod b = (a mod b) * ((a mod b) ^ n mod b) mod b"
     by (simp add: mod_mult_right_eq)
   with Suc show ?case
     by (simp add: mod_mult_left_eq mod_mult_right_eq)
 qed
 
 lemma power_diff_power_eq:
   \<open>a ^ m div a ^ n = (if n \<le> m then a ^ (m - n) else 1 div a ^ (n - m))\<close>
     if \<open>a \<noteq> 0\<close>
 proof (cases \<open>n \<le> m\<close>)
   case True
   with that power_diff [symmetric, of a n m] show ?thesis by simp
 next
   case False
   then obtain q where n: \<open>n = m + Suc q\<close>
     by (auto simp add: not_le dest: less_imp_Suc_add)
   then have \<open>a ^ m div a ^ n = (a ^ m * 1) div (a ^ m * a ^ Suc q)\<close>
     by (simp add: power_add ac_simps)
   moreover from that have \<open>a ^ m \<noteq> 0\<close>
     by simp
   ultimately have \<open>a ^ m div a ^ n = 1 div a ^ Suc q\<close>
     by (subst (asm) div_mult_mult1) simp
   with False n show ?thesis
     by simp
 qed
 
 end
 
 
 class euclidean_ring_cancel = euclidean_ring + euclidean_semiring_cancel
 begin
 
 subclass idom_divide ..
 
 lemma div_minus_minus [simp]: "(- a) div (- b) = a div b"
   using div_mult_mult1 [of "- 1" a b] by simp
 
 lemma mod_minus_minus [simp]: "(- a) mod (- b) = - (a mod b)"
   using mod_mult_mult1 [of "- 1" a b] by simp
 
 lemma div_minus_right: "a div (- b) = (- a) div b"
   using div_minus_minus [of "- a" b] by simp
 
 lemma mod_minus_right: "a mod (- b) = - ((- a) mod b)"
   using mod_minus_minus [of "- a" b] by simp
 
 lemma div_minus1_right [simp]: "a div (- 1) = - a"
   using div_minus_right [of a 1] by simp
 
 lemma mod_minus1_right [simp]: "a mod (- 1) = 0"
   using mod_minus_right [of a 1] by simp
 
 text \<open>Negation respects modular equivalence.\<close>
 
 lemma mod_minus_eq [mod_simps]:
   "(- (a mod b)) mod b = (- a) mod b"
 proof -
   have "(- a) mod b = (- (a div b * b + a mod b)) mod b"
     by (simp only: div_mult_mod_eq)
   also have "\<dots> = (- (a mod b) + - (a div b) * b) mod b"
     by (simp add: ac_simps)
   also have "\<dots> = (- (a mod b)) mod b"
     by (rule mod_mult_self1)
   finally show ?thesis
     by (rule sym)
 qed
 
 lemma mod_minus_cong:
   assumes "a mod b = a' mod b"
   shows "(- a) mod b = (- a') mod b"
 proof -
   have "(- (a mod b)) mod b = (- (a' mod b)) mod b"
     unfolding assms ..
   then show ?thesis
     by (simp add: mod_minus_eq)
 qed
 
 text \<open>Subtraction respects modular equivalence.\<close>
 
 lemma mod_diff_left_eq [mod_simps]:
   "(a mod c - b) mod c = (a - b) mod c"
   using mod_add_cong [of a c "a mod c" "- b" "- b"]
   by simp
 
 lemma mod_diff_right_eq [mod_simps]:
   "(a - b mod c) mod c = (a - b) mod c"
   using mod_add_cong [of a c a "- b" "- (b mod c)"] mod_minus_cong [of "b mod c" c b]
   by simp
 
 lemma mod_diff_eq:
   "(a mod c - b mod c) mod c = (a - b) mod c"
   using mod_add_cong [of a c "a mod c" "- b" "- (b mod c)"] mod_minus_cong [of "b mod c" c b]
   by simp
 
 lemma mod_diff_cong:
   assumes "a mod c = a' mod c"
   assumes "b mod c = b' mod c"
   shows "(a - b) mod c = (a' - b') mod c"
   using assms mod_add_cong [of a c a' "- b" "- b'"] mod_minus_cong [of b c "b'"]
   by simp
 
 lemma minus_mod_self2 [simp]:
   "(a - b) mod b = a mod b"
   using mod_diff_right_eq [of a b b]
   by (simp add: mod_diff_right_eq)
 
 lemma minus_mod_self1 [simp]:
   "(b - a) mod b = - a mod b"
   using mod_add_self2 [of "- a" b] by simp
 
 lemma mod_eq_dvd_iff:
   "a mod c = b mod c \<longleftrightarrow> c dvd a - b" (is "?P \<longleftrightarrow> ?Q")
 proof
   assume ?P
   then have "(a mod c - b mod c) mod c = 0"
     by simp
   then show ?Q
     by (simp add: dvd_eq_mod_eq_0 mod_simps)
 next
   assume ?Q
   then obtain d where d: "a - b = c * d" ..
   then have "a = c * d + b"
     by (simp add: algebra_simps)
   then show ?P by simp
 qed
 
 lemma mod_eqE:
   assumes "a mod c = b mod c"
   obtains d where "b = a + c * d"
 proof -
   from assms have "c dvd a - b"
     by (simp add: mod_eq_dvd_iff)
   then obtain d where "a - b = c * d" ..
   then have "b = a + c * - d"
     by (simp add: algebra_simps)
   with that show thesis .
 qed
 
 lemma invertible_coprime:
   "coprime a c" if "a * b mod c = 1"
   by (rule coprimeI) (use that dvd_mod_iff [of _ c "a * b"] in auto)
 
 end
 
-  
+
 subsection \<open>Uniquely determined division\<close>
 
-class unique_euclidean_semiring = euclidean_semiring + 
+class unique_euclidean_semiring = euclidean_semiring +
   assumes euclidean_size_mult: \<open>euclidean_size (a * b) = euclidean_size a * euclidean_size b\<close>
   fixes division_segment :: \<open>'a \<Rightarrow> 'a\<close>
   assumes is_unit_division_segment [simp]: \<open>is_unit (division_segment a)\<close>
     and division_segment_mult:
     \<open>a \<noteq> 0 \<Longrightarrow> b \<noteq> 0 \<Longrightarrow> division_segment (a * b) = division_segment a * division_segment b\<close>
     and division_segment_mod:
     \<open>b \<noteq> 0 \<Longrightarrow> \<not> b dvd a \<Longrightarrow> division_segment (a mod b) = division_segment b\<close>
   assumes div_bounded:
     \<open>b \<noteq> 0 \<Longrightarrow> division_segment r = division_segment b
     \<Longrightarrow> euclidean_size r < euclidean_size b
     \<Longrightarrow> (q * b + r) div b = q\<close>
 begin
 
 lemma division_segment_not_0 [simp]:
   \<open>division_segment a \<noteq> 0\<close>
   using is_unit_division_segment [of a] is_unitE [of \<open>division_segment a\<close>] by blast
 
 lemma euclidean_relationI [case_names by0 divides euclidean_relation]:
   \<open>(a div b, a mod b) = (q, r)\<close>
     if by0: \<open>b = 0 \<Longrightarrow> q = 0 \<and> r = a\<close>
     and divides: \<open>b \<noteq> 0 \<Longrightarrow> b dvd a \<Longrightarrow> r = 0 \<and> a = q * b\<close>
     and euclidean_relation: \<open>b \<noteq> 0 \<Longrightarrow> \<not> b dvd a \<Longrightarrow> division_segment r = division_segment b
       \<and> euclidean_size r < euclidean_size b \<and> a = q * b + r\<close>
 proof (cases \<open>b = 0\<close>)
   case True
   with by0 show ?thesis
     by simp
 next
   case False
   show ?thesis
   proof (cases \<open>b dvd a\<close>)
     case True
     with \<open>b \<noteq> 0\<close> divides
     show ?thesis
       by simp
   next
     case False
     with \<open>b \<noteq> 0\<close> euclidean_relation
     have \<open>division_segment r = division_segment b\<close>
       \<open>euclidean_size r < euclidean_size b\<close> \<open>a = q * b + r\<close>
       by simp_all
     from \<open>b \<noteq> 0\<close> \<open>division_segment r = division_segment b\<close>
       \<open>euclidean_size r < euclidean_size b\<close>
     have \<open>(q * b + r) div b = q\<close>
       by (rule div_bounded)
     with \<open>a = q * b + r\<close>
     have \<open>q = a div b\<close>
       by simp
     from \<open>a = q * b + r\<close>
     have \<open>a div b * b + a mod b = q * b + r\<close>
       by (simp add: div_mult_mod_eq)
     with \<open>q = a div b\<close>
     have \<open>q * b + a mod b = q * b + r\<close>
       by simp
     then have \<open>r = a mod b\<close>
       by simp
     with \<open>q = a div b\<close>
     show ?thesis
       by simp
   qed
 qed
 
 subclass euclidean_semiring_cancel
 proof
   fix a b c
   assume \<open>b \<noteq> 0\<close>
   have \<open>((a + c * b) div b, (a + c * b) mod b) = (c + a div b, a mod b)\<close>
   proof (cases b \<open>c + a div b\<close> \<open>a mod b\<close> \<open>a + c * b\<close> rule: euclidean_relationI)
     case by0
     with \<open>b \<noteq> 0\<close>
     show ?case
       by simp
   next
     case divides
     then show ?case
       by (simp add: algebra_simps dvd_add_left_iff)
   next
     case euclidean_relation
     then have \<open>\<not> b dvd a\<close>
       by (simp add: dvd_add_left_iff)
     have \<open>a mod b + (b * c + b * (a div b)) = b * c + ((a div b) * b + a mod b)\<close>
       by (simp add: ac_simps)
     with \<open>b \<noteq> 0\<close> have *: \<open>a mod b + (b * c + b * (a div b)) = b * c + a\<close>
       by (simp add: div_mult_mod_eq)
     from \<open>\<not> b dvd a\<close> euclidean_relation show ?case
       by (simp_all add: algebra_simps division_segment_mod mod_size_less *)
   qed
   then show \<open>(a + c * b) div b = c + a div b\<close>
     by simp
 next
   fix a b c
   assume \<open>c \<noteq> 0\<close>
   have \<open>((c * a) div (c * b), (c * a) mod (c * b)) = (a div b, c * (a mod b))\<close>
   proof (cases \<open>c * b\<close> \<open>a div b\<close> \<open>c * (a mod b)\<close> \<open>c * a\<close> rule: euclidean_relationI)
     case by0
     with \<open>c \<noteq> 0\<close> show ?case
       by simp
   next
     case divides
     then show ?case
       by (auto simp add: algebra_simps)
   next
     case euclidean_relation
     then have \<open>b \<noteq> 0\<close> \<open>a mod b \<noteq> 0\<close>
       by (simp_all add: mod_eq_0_iff_dvd)
     have \<open>c * (a mod b) + b * (c * (a div b)) = c * ((a div b) * b + a mod b)\<close>
       by (simp add: algebra_simps)
     with \<open>b \<noteq> 0\<close> have *: \<open>c * (a mod b) + b * (c * (a div b)) = c * a\<close>
       by (simp add: div_mult_mod_eq)
     from \<open>b \<noteq> 0\<close> \<open>c \<noteq> 0\<close> have \<open>euclidean_size c * euclidean_size (a mod b)
       < euclidean_size c * euclidean_size b\<close>
       using mod_size_less [of b a] by simp
     with euclidean_relation \<open>b \<noteq> 0\<close> \<open>a mod b \<noteq> 0\<close> show ?case
       by (simp add: algebra_simps division_segment_mult division_segment_mod euclidean_size_mult *)
   qed
   then show \<open>(c * a) div (c * b) = a div b\<close>
     by simp
 qed
 
 lemma div_eq_0_iff:
   \<open>a div b = 0 \<longleftrightarrow> euclidean_size a < euclidean_size b \<or> b = 0\<close> (is "_ \<longleftrightarrow> ?P")
   if \<open>division_segment a = division_segment b\<close>
 proof (cases \<open>a = 0 \<or> b = 0\<close>)
   case True
   then show ?thesis by auto
 next
   case False
   then have \<open>a \<noteq> 0\<close> \<open>b \<noteq> 0\<close>
     by simp_all
   have \<open>a div b = 0 \<longleftrightarrow> euclidean_size a < euclidean_size b\<close>
   proof
     assume \<open>a div b = 0\<close>
     then have \<open>a mod b = a\<close>
       using div_mult_mod_eq [of a b] by simp
     with \<open>b \<noteq> 0\<close> mod_size_less [of b a]
     show \<open>euclidean_size a < euclidean_size b\<close>
       by simp
   next
     assume \<open>euclidean_size a < euclidean_size b\<close>
     have \<open>(a div b, a mod b) = (0, a)\<close>
     proof (cases b 0 a a rule: euclidean_relationI)
       case by0
       show ?case
         by simp
     next
       case divides
       with \<open>euclidean_size a < euclidean_size b\<close> show ?case
         using dvd_imp_size_le [of b a] \<open>a \<noteq> 0\<close> by simp
     next
       case euclidean_relation
       with \<open>euclidean_size a < euclidean_size b\<close> that
       show ?case
         by simp
     qed
     then show \<open>a div b = 0\<close>
       by simp
   qed
   with \<open>b \<noteq> 0\<close> show ?thesis
     by simp
 qed
 
 lemma div_mult1_eq:
   \<open>(a * b) div c = a * (b div c) + a * (b mod c) div c\<close>
 proof -
   have *: \<open>(a * b) mod c + (a * (c * (b div c)) + c * (a * (b mod c) div c)) = a * b\<close> (is \<open>?A + (?B + ?C) = _\<close>)
   proof -
     have \<open>?A = a * (b mod c) mod c\<close>
       by (simp add: mod_mult_right_eq)
     then have \<open>?C + ?A = a * (b mod c)\<close>
       by (simp add: mult_div_mod_eq)
     then have \<open>?B + (?C + ?A) = a * (c * (b div c) + (b mod c))\<close>
       by (simp add: algebra_simps)
     also have \<open>\<dots> = a * b\<close>
       by (simp add: mult_div_mod_eq)
     finally show ?thesis
       by (simp add: algebra_simps)
   qed
   have \<open>((a * b) div c, (a * b) mod c) = (a * (b div c) + a * (b mod c) div c, (a * b) mod c)\<close>
   proof (cases c \<open>a * (b div c) + a * (b mod c) div c\<close> \<open>(a * b) mod c\<close> \<open>a * b\<close> rule: euclidean_relationI)
     case by0
     then show ?case by simp
   next
     case divides
     with * show ?case
       by (simp add: algebra_simps)
   next
     case euclidean_relation
     with * show ?case
       by (simp add: division_segment_mod mod_size_less algebra_simps)
   qed
   then show ?thesis
     by simp
 qed
 
 lemma div_add1_eq:
   \<open>(a + b) div c = a div c + b div c + (a mod c + b mod c) div c\<close>
 proof -
   have *: \<open>(a + b) mod c + (c * (a div c) + (c * (b div c) + c * ((a mod c + b mod c) div c))) = a + b\<close>
     (is \<open>?A + (?B + (?C + ?D)) = _\<close>)
   proof -
     have \<open>?A + (?B + (?C + ?D)) = ?A + ?D + (?B + ?C)\<close>
       by (simp add: ac_simps)
     also have \<open>?A + ?D = (a mod c + b mod c) mod c + ?D\<close>
       by (simp add: mod_add_eq)
     also have \<open>\<dots> = a mod c + b mod c\<close>
       by (simp add: mod_mult_div_eq)
     finally have \<open>?A + (?B + (?C + ?D)) = (a mod c + ?B) + (b mod c + ?C)\<close>
       by (simp add: ac_simps)
     then show ?thesis
       by (simp add: mod_mult_div_eq)
   qed
   have \<open>((a + b) div c, (a + b) mod c) = (a div c + b div c + (a mod c + b mod c) div c, (a + b) mod c)\<close>
   proof (cases c \<open>a div c + b div c + (a mod c + b mod c) div c\<close> \<open>(a + b) mod c\<close> \<open>a + b\<close> rule: euclidean_relationI)
     case by0
     then show ?case
       by simp
   next
     case divides
     with * show ?case
       by (simp add: algebra_simps)
   next
     case euclidean_relation
     with * show ?case
       by (simp add: division_segment_mod mod_size_less algebra_simps)
   qed
   then show ?thesis
     by simp
 qed
 
 end
 
 class unique_euclidean_ring = euclidean_ring + unique_euclidean_semiring
 begin
-  
+
 subclass euclidean_ring_cancel ..
 
 end
 
 
 subsection \<open>Euclidean division on \<^typ>\<open>nat\<close>\<close>
 
 instantiation nat :: normalization_semidom
 begin
 
 definition normalize_nat :: \<open>nat \<Rightarrow> nat\<close>
   where [simp]: \<open>normalize = (id :: nat \<Rightarrow> nat)\<close>
 
 definition unit_factor_nat :: \<open>nat \<Rightarrow> nat\<close>
   where \<open>unit_factor n = of_bool (n > 0)\<close> for n :: nat
 
 lemma unit_factor_simps [simp]:
   \<open>unit_factor 0 = (0::nat)\<close>
   \<open>unit_factor (Suc n) = 1\<close>
   by (simp_all add: unit_factor_nat_def)
 
 definition divide_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
   where \<open>m div n = (if n = 0 then 0 else Max {k. k * n \<le> m})\<close> for m n :: nat
 
 instance
   by standard (auto simp add: divide_nat_def ac_simps unit_factor_nat_def intro: Max_eqI)
 
 end
 
 lemma coprime_Suc_0_left [simp]:
   "coprime (Suc 0) n"
   using coprime_1_left [of n] by simp
 
 lemma coprime_Suc_0_right [simp]:
   "coprime n (Suc 0)"
   using coprime_1_right [of n] by simp
 
 lemma coprime_common_divisor_nat: "coprime a b \<Longrightarrow> x dvd a \<Longrightarrow> x dvd b \<Longrightarrow> x = 1"
   for a b :: nat
   by (drule coprime_common_divisor [of _ _ x]) simp_all
 
 instantiation nat :: unique_euclidean_semiring
 begin
 
 definition euclidean_size_nat :: \<open>nat \<Rightarrow> nat\<close>
   where [simp]: \<open>euclidean_size_nat = id\<close>
 
 definition division_segment_nat :: \<open>nat \<Rightarrow> nat\<close>
   where [simp]: \<open>division_segment n = 1\<close> for n :: nat
 
 definition modulo_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
   where \<open>m mod n = m - (m div n * n)\<close> for m n :: nat
 
 instance proof
   fix m n :: nat
   have ex: "\<exists>k. k * n \<le> l" for l :: nat
     by (rule exI [of _ 0]) simp
   have fin: "finite {k. k * n \<le> l}" if "n > 0" for l
   proof -
     from that have "{k. k * n \<le> l} \<subseteq> {k. k \<le> l}"
       by (cases n) auto
     then show ?thesis
       by (rule finite_subset) simp
   qed
   have mult_div_unfold: "n * (m div n) = Max {l. l \<le> m \<and> n dvd l}"
   proof (cases "n = 0")
     case True
     moreover have "{l. l = 0 \<and> l \<le> m} = {0::nat}"
       by auto
     ultimately show ?thesis
       by simp
   next
     case False
     with ex [of m] fin have "n * Max {k. k * n \<le> m} = Max (times n ` {k. k * n \<le> m})"
       by (auto simp add: nat_mult_max_right intro: hom_Max_commute)
     also have "times n ` {k. k * n \<le> m} = {l. l \<le> m \<and> n dvd l}"
       by (auto simp add: ac_simps elim!: dvdE)
     finally show ?thesis
       using False by (simp add: divide_nat_def ac_simps)
   qed
   have less_eq: "m div n * n \<le> m"
     by (auto simp add: mult_div_unfold ac_simps intro: Max.boundedI)
   then show "m div n * n + m mod n = m"
     by (simp add: modulo_nat_def)
-  assume "n \<noteq> 0" 
+  assume "n \<noteq> 0"
   show "euclidean_size (m mod n) < euclidean_size n"
   proof -
     have "m < Suc (m div n) * n"
     proof (rule ccontr)
       assume "\<not> m < Suc (m div n) * n"
       then have "Suc (m div n) * n \<le> m"
         by (simp add: not_less)
       moreover from \<open>n \<noteq> 0\<close> have "Max {k. k * n \<le> m} < Suc (m div n)"
         by (simp add: divide_nat_def)
       with \<open>n \<noteq> 0\<close> ex fin have "\<And>k. k * n \<le> m \<Longrightarrow> k < Suc (m div n)"
         by auto
       ultimately have "Suc (m div n) < Suc (m div n)"
         by blast
       then show False
         by simp
     qed
     with \<open>n \<noteq> 0\<close> show ?thesis
       by (simp add: modulo_nat_def)
   qed
   show "euclidean_size m \<le> euclidean_size (m * n)"
     using \<open>n \<noteq> 0\<close> by (cases n) simp_all
   fix q r :: nat
   show "(q * n + r) div n = q" if "euclidean_size r < euclidean_size n"
   proof -
     from that have "r < n"
       by simp
     have "k \<le> q" if "k * n \<le> q * n + r" for k
     proof (rule ccontr)
       assume "\<not> k \<le> q"
       then have "q < k"
         by simp
       then obtain l where "k = Suc (q + l)"
         by (auto simp add: less_iff_Suc_add)
       with \<open>r < n\<close> that show False
         by (simp add: algebra_simps)
     qed
     with \<open>n \<noteq> 0\<close> ex fin show ?thesis
       by (auto simp add: divide_nat_def Max_eq_iff)
   qed
 qed simp_all
 
 end
 
 lemma euclidean_relation_natI [case_names by0 divides euclidean_relation]:
   \<open>(m div n, m mod n) = (q, r)\<close>
     if by0: \<open>n = 0 \<Longrightarrow> q = 0 \<and> r = m\<close>
     and divides: \<open>n > 0 \<Longrightarrow> n dvd m \<Longrightarrow> r = 0 \<and> m = q * n\<close>
     and euclidean_relation: \<open>n > 0 \<Longrightarrow> \<not> n dvd m \<Longrightarrow> r < n \<and> m = q * n + r\<close> for m n q r :: nat
   by (rule euclidean_relationI) (use that in simp_all)
 
 lemma div_nat_eqI:
   \<open>m div n = q\<close> if \<open>n * q \<le> m\<close> and \<open>m < n * Suc q\<close> for m n q :: nat
 proof -
   have \<open>(m div n, m mod n) = (q, m - n * q)\<close>
   proof (cases n q \<open>m - n * q\<close>  m rule: euclidean_relation_natI)
     case by0
     with that show ?case
       by simp
   next
     case divides
     from \<open>n dvd m\<close> obtain s where \<open>m = n * s\<close> ..
     with \<open>n > 0\<close> that have \<open>s < Suc q\<close>
       by (simp only: mult_less_cancel1)
     with \<open>m = n * s\<close> \<open>n > 0\<close> that have \<open>q = s\<close>
       by simp
     with \<open>m = n * s\<close> show ?case
       by (simp add: ac_simps)
   next
     case euclidean_relation
     with that show ?case
       by (simp add: ac_simps)
   qed
   then show ?thesis
     by simp
 qed
 
 lemma mod_nat_eqI:
   \<open>m mod n = r\<close> if \<open>r < n\<close> and \<open>r \<le> m\<close> and \<open>n dvd m - r\<close> for m n r :: nat
 proof -
   have \<open>(m div n, m mod n) = ((m - r) div n, r)\<close>
   proof (cases n \<open>(m - r) div n\<close> r  m rule: euclidean_relation_natI)
     case by0
     with that show ?case
       by simp
   next
     case divides
     from that dvd_minus_add [of r \<open>m\<close> 1 n]
     have \<open>n dvd m + (n - r)\<close>
       by simp
     with divides have \<open>n dvd n - r\<close>
       by (simp add: dvd_add_right_iff)
     then have \<open>n \<le> n - r\<close>
       by (rule dvd_imp_le) (use \<open>r < n\<close> in simp)
     with \<open>n > 0\<close> have \<open>r = 0\<close>
       by simp
     with \<open>n > 0\<close> that show ?case
       by simp
   next
     case euclidean_relation
     with that show ?case
       by (simp add: ac_simps)
   qed
   then show ?thesis
     by simp
 qed
 
 text \<open>Tool support\<close>
 
 ML \<open>
 structure Cancel_Div_Mod_Nat = Cancel_Div_Mod
 (
   val div_name = \<^const_name>\<open>divide\<close>;
   val mod_name = \<^const_name>\<open>modulo\<close>;
   val mk_binop = HOLogic.mk_binop;
   val dest_plus = HOLogic.dest_bin \<^const_name>\<open>Groups.plus\<close> HOLogic.natT;
   val mk_sum = Arith_Data.mk_sum;
   fun dest_sum tm =
     if HOLogic.is_zero tm then []
     else
       (case try HOLogic.dest_Suc tm of
         SOME t => HOLogic.Suc_zero :: dest_sum t
       | NONE =>
           (case try dest_plus tm of
             SOME (t, u) => dest_sum t @ dest_sum u
           | NONE => [tm]));
 
   val div_mod_eqs = map mk_meta_eq @{thms cancel_div_mod_rules};
 
   val prove_eq_sums = Arith_Data.prove_conv2 all_tac
     (Arith_Data.simp_all_tac @{thms add_0_left add_0_right ac_simps})
 )
 \<close>
 
 simproc_setup cancel_div_mod_nat ("(m::nat) + n") =
   \<open>K Cancel_Div_Mod_Nat.proc\<close>
 
 lemma div_mult_self_is_m [simp]:
   "m * n div n = m" if "n > 0" for m n :: nat
   using that by simp
 
 lemma div_mult_self1_is_m [simp]:
   "n * m div n = m" if "n > 0" for m n :: nat
   using that by simp
 
 lemma mod_less_divisor [simp]:
   "m mod n < n" if "n > 0" for m n :: nat
   using mod_size_less [of n m] that by simp
 
 lemma mod_le_divisor [simp]:
   "m mod n \<le> n" if "n > 0" for m n :: nat
   using that by (auto simp add: le_less)
 
 lemma div_times_less_eq_dividend [simp]:
   "m div n * n \<le> m" for m n :: nat
   by (simp add: minus_mod_eq_div_mult [symmetric])
 
 lemma times_div_less_eq_dividend [simp]:
   "n * (m div n) \<le> m" for m n :: nat
   using div_times_less_eq_dividend [of m n]
   by (simp add: ac_simps)
 
 lemma dividend_less_div_times:
   "m < n + (m div n) * n" if "0 < n" for m n :: nat
 proof -
   from that have "m mod n < n"
     by simp
   then show ?thesis
     by (simp add: minus_mod_eq_div_mult [symmetric])
 qed
 
 lemma dividend_less_times_div:
   "m < n + n * (m div n)" if "0 < n" for m n :: nat
   using dividend_less_div_times [of n m] that
   by (simp add: ac_simps)
 
 lemma mod_Suc_le_divisor [simp]:
   "m mod Suc n \<le> n"
   using mod_less_divisor [of "Suc n" m] by arith
 
 lemma mod_less_eq_dividend [simp]:
   "m mod n \<le> m" for m n :: nat
 proof (rule add_leD2)
   from div_mult_mod_eq have "m div n * n + m mod n = m" .
   then show "m div n * n + m mod n \<le> m" by auto
 qed
 
 lemma
   div_less [simp]: "m div n = 0"
   and mod_less [simp]: "m mod n = m"
   if "m < n" for m n :: nat
   using that by (auto intro: div_nat_eqI mod_nat_eqI)
- 
+
 lemma split_div:
   \<open>P (m div n) \<longleftrightarrow>
     (n = 0 \<longrightarrow> P 0) \<and>
     (n \<noteq> 0 \<longrightarrow> (\<forall>i j. j < n \<and> m = n * i + j \<longrightarrow> P i))\<close> (is ?div)
   and split_mod:
   \<open>Q (m mod n) \<longleftrightarrow>
     (n = 0 \<longrightarrow> Q m) \<and>
     (n \<noteq> 0 \<longrightarrow> (\<forall>i j. j < n \<and> m = n * i + j \<longrightarrow> Q j))\<close> (is ?mod)
   for m n :: nat
 proof -
   have *: \<open>R (m div n) (m mod n) \<longleftrightarrow>
     (n = 0 \<longrightarrow> R 0 m) \<and>
     (n \<noteq> 0 \<longrightarrow> (\<forall>i j. j < n \<and> m = n * i + j \<longrightarrow> R i j))\<close> for R
     by (cases \<open>n = 0\<close>) auto
   from * [of \<open>\<lambda>q _. P q\<close>] show ?div .
   from * [of \<open>\<lambda>_ r. Q r\<close>] show ?mod .
 qed
 
 declare split_div [of _ _ \<open>numeral n\<close>, linarith_split] for n
 declare split_mod [of _ _ \<open>numeral n\<close>, linarith_split] for n
 
 lemma split_div':
   "P (m div n) \<longleftrightarrow> n = 0 \<and> P 0 \<or> (\<exists>q. (n * q \<le> m \<and> m < n * Suc q) \<and> P q)"
 proof (cases "n = 0")
   case True
   then show ?thesis
     by simp
 next
   case False
   then have "n * q \<le> m \<and> m < n * Suc q \<longleftrightarrow> m div n = q" for q
     by (auto intro: div_nat_eqI dividend_less_times_div)
   then show ?thesis
     by auto
 qed
 
 lemma le_div_geq:
   "m div n = Suc ((m - n) div n)" if "0 < n" and "n \<le> m" for m n :: nat
 proof -
   from \<open>n \<le> m\<close> obtain q where "m = n + q"
     by (auto simp add: le_iff_add)
   with \<open>0 < n\<close> show ?thesis
     by (simp add: div_add_self1)
 qed
 
 lemma le_mod_geq:
   "m mod n = (m - n) mod n" if "n \<le> m" for m n :: nat
 proof -
   from \<open>n \<le> m\<close> obtain q where "m = n + q"
     by (auto simp add: le_iff_add)
   then show ?thesis
     by simp
 qed
 
 lemma div_if:
   "m div n = (if m < n \<or> n = 0 then 0 else Suc ((m - n) div n))"
   by (simp add: le_div_geq)
 
 lemma mod_if:
   "m mod n = (if m < n then m else (m - n) mod n)" for m n :: nat
   by (simp add: le_mod_geq)
 
 lemma div_eq_0_iff:
   "m div n = 0 \<longleftrightarrow> m < n \<or> n = 0" for m n :: nat
   by (simp add: div_eq_0_iff)
 
 lemma div_greater_zero_iff:
   "m div n > 0 \<longleftrightarrow> n \<le> m \<and> n > 0" for m n :: nat
   using div_eq_0_iff [of m n] by auto
 
 lemma mod_greater_zero_iff_not_dvd:
   "m mod n > 0 \<longleftrightarrow> \<not> n dvd m" for m n :: nat
   by (simp add: dvd_eq_mod_eq_0)
 
 lemma div_by_Suc_0 [simp]:
   "m div Suc 0 = m"
   using div_by_1 [of m] by simp
 
 lemma mod_by_Suc_0 [simp]:
   "m mod Suc 0 = 0"
   using mod_by_1 [of m] by simp
 
 lemma div2_Suc_Suc [simp]:
   "Suc (Suc m) div 2 = Suc (m div 2)"
   by (simp add: numeral_2_eq_2 le_div_geq)
 
 lemma Suc_n_div_2_gt_zero [simp]:
   "0 < Suc n div 2" if "n > 0" for n :: nat
   using that by (cases n) simp_all
 
 lemma div_2_gt_zero [simp]:
   "0 < n div 2" if "Suc 0 < n" for n :: nat
   using that Suc_n_div_2_gt_zero [of "n - 1"] by simp
 
 lemma mod2_Suc_Suc [simp]:
   "Suc (Suc m) mod 2 = m mod 2"
   by (simp add: numeral_2_eq_2 le_mod_geq)
 
 lemma add_self_div_2 [simp]:
   "(m + m) div 2 = m" for m :: nat
   by (simp add: mult_2 [symmetric])
 
 lemma add_self_mod_2 [simp]:
   "(m + m) mod 2 = 0" for m :: nat
   by (simp add: mult_2 [symmetric])
 
 lemma mod2_gr_0 [simp]:
   "0 < m mod 2 \<longleftrightarrow> m mod 2 = 1" for m :: nat
 proof -
   have "m mod 2 < 2"
     by (rule mod_less_divisor) simp
   then have "m mod 2 = 0 \<or> m mod 2 = 1"
     by arith
   then show ?thesis
-    by auto     
+    by auto
 qed
 
 lemma mod_Suc_eq [mod_simps]:
   "Suc (m mod n) mod n = Suc m mod n"
 proof -
   have "(m mod n + 1) mod n = (m + 1) mod n"
     by (simp only: mod_simps)
   then show ?thesis
     by simp
 qed
 
 lemma mod_Suc_Suc_eq [mod_simps]:
   "Suc (Suc (m mod n)) mod n = Suc (Suc m) mod n"
 proof -
   have "(m mod n + 2) mod n = (m + 2) mod n"
     by (simp only: mod_simps)
   then show ?thesis
     by simp
 qed
 
 lemma
   Suc_mod_mult_self1 [simp]: "Suc (m + k * n) mod n = Suc m mod n"
   and Suc_mod_mult_self2 [simp]: "Suc (m + n * k) mod n = Suc m mod n"
   and Suc_mod_mult_self3 [simp]: "Suc (k * n + m) mod n = Suc m mod n"
   and Suc_mod_mult_self4 [simp]: "Suc (n * k + m) mod n = Suc m mod n"
   by (subst mod_Suc_eq [symmetric], simp add: mod_simps)+
 
 lemma Suc_0_mod_eq [simp]:
   "Suc 0 mod n = of_bool (n \<noteq> Suc 0)"
   by (cases n) simp_all
 
 lemma div_mult2_eq:
     \<open>m div (n * q) = (m div n) div q\<close> (is ?Q)
   and mod_mult2_eq:
     \<open>m mod (n * q) = n * (m div n mod q) + m mod n\<close> (is ?R)
   for m n q :: nat
 proof -
   have \<open>(m div (n * q), m mod (n * q)) = ((m div n) div q, n * (m div n mod q) + m mod n)\<close>
   proof (cases \<open>n * q\<close> \<open>(m div n) div q\<close> \<open>n * (m div n mod q) + m mod n\<close> m rule: euclidean_relation_natI)
     case by0
     then show ?case
       by auto
   next
     case divides
     from \<open>n * q dvd m\<close> obtain t where \<open>m = n * q * t\<close> ..
     with \<open>n * q > 0\<close> show ?case
       by (simp add: algebra_simps)
   next
     case euclidean_relation
     then have \<open>n > 0\<close> \<open>q > 0\<close>
       by simp_all
     from \<open>n > 0\<close> have \<open>m mod n < n\<close>
       by (rule mod_less_divisor)
     from \<open>q > 0\<close> have \<open>m div n mod q < q\<close>
       by (rule mod_less_divisor)
     then obtain s where \<open>q = Suc (m div n mod q + s)\<close>
       by (blast dest: less_imp_Suc_add)
     moreover have \<open>m mod n + n * (m div n mod q) < n * Suc (m div n mod q + s)\<close>
       using \<open>m mod n < n\<close> by (simp add: add_mult_distrib2)
     ultimately have \<open>m mod n + n * (m div n mod q) < n * q\<close>
       by simp
     then show ?case
       by (simp add: algebra_simps flip: add_mult_distrib2)
   qed
   then show ?Q and ?R
     by simp_all
 qed
 
 lemma div_le_mono:
   "m div k \<le> n div k" if "m \<le> n" for m n k :: nat
 proof -
   from that obtain q where "n = m + q"
     by (auto simp add: le_iff_add)
   then show ?thesis
     by (simp add: div_add1_eq [of m q k])
 qed
 
 text \<open>Antimonotonicity of \<^const>\<open>divide\<close> in second argument\<close>
 
 lemma div_le_mono2:
   "k div n \<le> k div m" if "0 < m" and "m \<le> n" for m n k :: nat
 using that proof (induct k arbitrary: m rule: less_induct)
   case (less k)
   show ?case
   proof (cases "n \<le> k")
     case False
     then show ?thesis
       by simp
   next
     case True
     have "(k - n) div n \<le> (k - m) div n"
       using less.prems
       by (blast intro: div_le_mono diff_le_mono2)
     also have "\<dots> \<le> (k - m) div m"
       using \<open>n \<le> k\<close> less.prems less.hyps [of "k - m" m]
       by simp
     finally show ?thesis
       using \<open>n \<le> k\<close> less.prems
       by (simp add: le_div_geq)
   qed
 qed
 
 lemma div_le_dividend [simp]:
   "m div n \<le> m" for m n :: nat
   using div_le_mono2 [of 1 n m] by (cases "n = 0") simp_all
 
 lemma div_less_dividend [simp]:
   "m div n < m" if "1 < n" and "0 < m" for m n :: nat
 using that proof (induct m rule: less_induct)
   case (less m)
   show ?case
   proof (cases "n < m")
     case False
     with less show ?thesis
       by (cases "n = m") simp_all
   next
     case True
     then show ?thesis
       using less.hyps [of "m - n"] less.prems
       by (simp add: le_div_geq)
   qed
 qed
 
 lemma div_eq_dividend_iff:
   "m div n = m \<longleftrightarrow> n = 1" if "m > 0" for m n :: nat
 proof
   assume "n = 1"
   then show "m div n = m"
     by simp
 next
   assume P: "m div n = m"
   show "n = 1"
   proof (rule ccontr)
     have "n \<noteq> 0"
       by (rule ccontr) (use that P in auto)
     moreover assume "n \<noteq> 1"
     ultimately have "n > 1"
       by simp
     with that have "m div n < m"
       by simp
     with P show False
       by simp
   qed
 qed
 
 lemma less_mult_imp_div_less:
   "m div n < i" if "m < i * n" for m n i :: nat
 proof -
   from that have "i * n > 0"
     by (cases "i * n = 0") simp_all
   then have "i > 0" and "n > 0"
     by simp_all
   have "m div n * n \<le> m"
     by simp
   then have "m div n * n < i * n"
     using that by (rule le_less_trans)
   with \<open>n > 0\<close> show ?thesis
     by simp
 qed
 
 lemma div_less_iff_less_mult:
   \<open>m div q < n \<longleftrightarrow> m < n * q\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
   if \<open>q > 0\<close> for m n q :: nat
 proof
   assume ?Q then show ?P
     by (rule less_mult_imp_div_less)
 next
   assume ?P
   then obtain h where \<open>n = Suc (m div q + h)\<close>
     using less_natE by blast
   moreover have \<open>m < m + (Suc h * q - m mod q)\<close>
     using that by (simp add: trans_less_add1)
   ultimately show ?Q
     by (simp add: algebra_simps flip: minus_mod_eq_mult_div)
 qed
 
 lemma less_eq_div_iff_mult_less_eq:
   \<open>m \<le> n div q \<longleftrightarrow> m * q \<le> n\<close> if \<open>q > 0\<close> for m n q :: nat
   using div_less_iff_less_mult [of q n m] that by auto
 
 text \<open>A fact for the mutilated chess board\<close>
 
 lemma mod_Suc:
   "Suc m mod n = (if Suc (m mod n) = n then 0 else Suc (m mod n))" (is "_ = ?rhs")
 proof (cases "n = 0")
   case True
   then show ?thesis
     by simp
 next
   case False
   have "Suc m mod n = Suc (m mod n) mod n"
     by (simp add: mod_simps)
   also have "\<dots> = ?rhs"
     using False by (auto intro!: mod_nat_eqI intro: neq_le_trans simp add: Suc_le_eq)
   finally show ?thesis .
 qed
 
 lemma Suc_times_mod_eq:
   "Suc (m * n) mod m = 1" if "Suc 0 < m"
   using that by (simp add: mod_Suc)
 
 lemma Suc_times_numeral_mod_eq [simp]:
   "Suc (numeral k * n) mod numeral k = 1" if "numeral k \<noteq> (1::nat)"
   by (rule Suc_times_mod_eq) (use that in simp)
 
 lemma Suc_div_le_mono [simp]:
   "m div n \<le> Suc m div n"
   by (simp add: div_le_mono)
 
 text \<open>These lemmas collapse some needless occurrences of Suc:
   at least three Sucs, since two and fewer are rewritten back to Suc again!
   We already have some rules to simplify operands smaller than 3.\<close>
 
 lemma div_Suc_eq_div_add3 [simp]:
   "m div Suc (Suc (Suc n)) = m div (3 + n)"
   by (simp add: Suc3_eq_add_3)
 
 lemma mod_Suc_eq_mod_add3 [simp]:
   "m mod Suc (Suc (Suc n)) = m mod (3 + n)"
   by (simp add: Suc3_eq_add_3)
 
 lemma Suc_div_eq_add3_div:
   "Suc (Suc (Suc m)) div n = (3 + m) div n"
   by (simp add: Suc3_eq_add_3)
 
 lemma Suc_mod_eq_add3_mod:
   "Suc (Suc (Suc m)) mod n = (3 + m) mod n"
   by (simp add: Suc3_eq_add_3)
 
 lemmas Suc_div_eq_add3_div_numeral [simp] =
   Suc_div_eq_add3_div [of _ "numeral v"] for v
 
 lemmas Suc_mod_eq_add3_mod_numeral [simp] =
   Suc_mod_eq_add3_mod [of _ "numeral v"] for v
 
 lemma (in field_char_0) of_nat_div:
   "of_nat (m div n) = ((of_nat m - of_nat (m mod n)) / of_nat n)"
 proof -
   have "of_nat (m div n) = ((of_nat (m div n * n + m mod n) - of_nat (m mod n)) / of_nat n :: 'a)"
     unfolding of_nat_add by (cases "n = 0") simp_all
   then show ?thesis
     by simp
 qed
 
 text \<open>An ``induction'' law for modulus arithmetic.\<close>
 
 lemma mod_induct [consumes 3, case_names step]:
   "P m" if "P n" and "n < p" and "m < p"
     and step: "\<And>n. n < p \<Longrightarrow> P n \<Longrightarrow> P (Suc n mod p)"
 using \<open>m < p\<close> proof (induct m)
   case 0
   show ?case
   proof (rule ccontr)
     assume "\<not> P 0"
     from \<open>n < p\<close> have "0 < p"
       by simp
     from \<open>n < p\<close> obtain m where "0 < m" and "p = n + m"
       by (blast dest: less_imp_add_positive)
     with \<open>P n\<close> have "P (p - m)"
       by simp
     moreover have "\<not> P (p - m)"
     using \<open>0 < m\<close> proof (induct m)
       case 0
       then show ?case
         by simp
     next
       case (Suc m)
       show ?case
       proof
         assume P: "P (p - Suc m)"
         with \<open>\<not> P 0\<close> have "Suc m < p"
-          by (auto intro: ccontr) 
+          by (auto intro: ccontr)
         then have "Suc (p - Suc m) = p - m"
           by arith
         moreover from \<open>0 < p\<close> have "p - Suc m < p"
           by arith
         with P step have "P ((Suc (p - Suc m)) mod p)"
           by blast
         ultimately show False
           using \<open>\<not> P 0\<close> Suc.hyps by (cases "m = 0") simp_all
       qed
     qed
     ultimately show False
       by blast
   qed
 next
   case (Suc m)
   then have "m < p" and mod: "Suc m mod p = Suc m"
     by simp_all
   from \<open>m < p\<close> have "P m"
     by (rule Suc.hyps)
   with \<open>m < p\<close> have "P (Suc m mod p)"
     by (rule step)
   with mod show ?case
     by simp
 qed
 
 lemma funpow_mod_eq: \<^marker>\<open>contributor \<open>Lars Noschinski\<close>\<close>
   \<open>(f ^^ (m mod n)) x = (f ^^ m) x\<close> if \<open>(f ^^ n) x = x\<close>
 proof -
   have \<open>(f ^^ m) x = (f ^^ (m mod n + m div n * n)) x\<close>
     by simp
   also have \<open>\<dots> = (f ^^ (m mod n)) (((f ^^ n) ^^ (m div n)) x)\<close>
     by (simp only: funpow_add funpow_mult ac_simps) simp
   also have \<open>((f ^^ n) ^^ q) x = x\<close> for q
     by (induction q) (use \<open>(f ^^ n) x = x\<close> in simp_all)
   finally show ?thesis
     by simp
 qed
 
+lemma mod_eq_dvd_iff_nat:
+  \<open>m mod q = n mod q \<longleftrightarrow> q dvd m - n\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
+    if \<open>m \<ge> n\<close> for m n q :: nat
+proof
+  assume ?Q
+  then obtain s where \<open>m - n = q * s\<close> ..
+  with that have \<open>m = q * s + n\<close>
+    by simp
+  then show ?P
+    by simp
+next
+  assume ?P
+  have \<open>m - n = m div q * q + m mod q - (n div q * q + n mod q)\<close>
+    by simp
+  also have \<open>\<dots> = q * (m div q - n div q)\<close>
+    by (simp only: algebra_simps \<open>?P\<close>)
+  finally show ?Q ..
+qed
+
+lemma mod_eq_nat1E:
+  fixes m n q :: nat
+  assumes "m mod q = n mod q" and "m \<ge> n"
+  obtains s where "m = n + q * s"
+proof -
+  from assms have "q dvd m - n"
+    by (simp add: mod_eq_dvd_iff_nat)
+  then obtain s where "m - n = q * s" ..
+  with \<open>m \<ge> n\<close> have "m = n + q * s"
+    by simp
+  with that show thesis .
+qed
+
+lemma mod_eq_nat2E:
+  fixes m n q :: nat
+  assumes "m mod q = n mod q" and "n \<ge> m"
+  obtains s where "n = m + q * s"
+  using assms mod_eq_nat1E [of n q m] by (auto simp add: ac_simps)
+
+lemma nat_mod_eq_iff:
+  "(x::nat) mod n = y mod n \<longleftrightarrow> (\<exists>q1 q2. x + n * q1 = y + n * q2)"  (is "?lhs = ?rhs")
+proof
+  assume H: "x mod n = y mod n"
+  { assume xy: "x \<le> y"
+    from H have th: "y mod n = x mod n" by simp
+    from mod_eq_nat1E [OF th xy] obtain q where "y = x + n * q" .
+    then have "x + n * q = y + n * 0"
+      by simp
+    then have "\<exists>q1 q2. x + n * q1 = y + n * q2"
+      by blast
+  }
+  moreover
+  { assume xy: "y \<le> x"
+    from mod_eq_nat1E [OF H xy] obtain q where "x = y + n * q" .
+    then have "x + n * 0 = y + n * q"
+      by simp
+    then have "\<exists>q1 q2. x + n * q1 = y + n * q2"
+      by blast
+  }
+  ultimately show ?rhs using linear[of x y] by blast
+next
+  assume ?rhs then obtain q1 q2 where q12: "x + n * q1 = y + n * q2" by blast
+  hence "(x + n * q1) mod n = (y + n * q2) mod n" by simp
+  thus  ?lhs by simp
+qed
+
+
 
 subsection \<open>Elementary euclidean division on \<^typ>\<open>int\<close>\<close>
 
 subsubsection \<open>Basic instantiation\<close>
 
 instantiation int :: "{normalization_semidom, idom_modulo}"
 begin
 
 definition normalize_int :: \<open>int \<Rightarrow> int\<close>
   where [simp]: \<open>normalize = (abs :: int \<Rightarrow> int)\<close>
 
 definition unit_factor_int :: \<open>int \<Rightarrow> int\<close>
   where [simp]: \<open>unit_factor = (sgn :: int \<Rightarrow> int)\<close>
 
 definition divide_int :: \<open>int \<Rightarrow> int \<Rightarrow> int\<close>
   where \<open>k div l = (sgn k * sgn l * int (nat \<bar>k\<bar> div nat \<bar>l\<bar>)
     - of_bool (l \<noteq> 0 \<and> sgn k \<noteq> sgn l \<and> \<not> l dvd k))\<close>
 
 lemma divide_int_unfold:
   \<open>(sgn k * int m) div (sgn l * int n) = (sgn k * sgn l * int (m div n)
     - of_bool ((k = 0 \<longleftrightarrow> m = 0) \<and> l \<noteq> 0 \<and> n \<noteq> 0 \<and> sgn k \<noteq> sgn l \<and> \<not> n dvd m))\<close>
   by (simp add: divide_int_def sgn_mult nat_mult_distrib abs_mult sgn_eq_0_iff ac_simps)
 
 definition modulo_int :: \<open>int \<Rightarrow> int \<Rightarrow> int\<close>
   where \<open>k mod l = sgn k * int (nat \<bar>k\<bar> mod nat \<bar>l\<bar>) + l * of_bool (sgn k \<noteq> sgn l \<and> \<not> l dvd k)\<close>
 
 lemma modulo_int_unfold:
   \<open>(sgn k * int m) mod (sgn l * int n) =
     sgn k * int (m mod (of_bool (l \<noteq> 0) * n)) + (sgn l * int n) * of_bool ((k = 0 \<longleftrightarrow> m = 0) \<and> sgn k \<noteq> sgn l \<and> \<not> n dvd m)\<close>
   by (auto simp add: modulo_int_def sgn_mult abs_mult)
 
 instance proof
   fix k :: int show "k div 0 = 0"
   by (simp add: divide_int_def)
 next
   fix k l :: int
   assume "l \<noteq> 0"
-  obtain n m and s t where k: "k = sgn s * int n" and l: "l = sgn t * int m" 
+  obtain n m and s t where k: "k = sgn s * int n" and l: "l = sgn t * int m"
     by (blast intro: int_sgnE elim: that)
   then have "k * l = sgn (s * t) * int (n * m)"
     by (simp add: ac_simps sgn_mult)
   with k l \<open>l \<noteq> 0\<close> show "k * l div l = k"
     by (simp only: divide_int_unfold)
       (auto simp add: algebra_simps sgn_mult sgn_1_pos sgn_0_0)
 next
   fix k l :: int
-  obtain n m and s t where "k = sgn s * int n" and "l = sgn t * int m" 
+  obtain n m and s t where "k = sgn s * int n" and "l = sgn t * int m"
     by (blast intro: int_sgnE elim: that)
   then show "k div l * l + k mod l = k"
     by (simp add: divide_int_unfold modulo_int_unfold algebra_simps modulo_nat_def of_nat_diff)
 qed (auto simp add: sgn_mult mult_sgn_abs abs_eq_iff')
 
 end
 
 
 subsubsection \<open>Algebraic foundations\<close>
 
 lemma coprime_int_iff [simp]:
   "coprime (int m) (int n) \<longleftrightarrow> coprime m n" (is "?P \<longleftrightarrow> ?Q")
 proof
   assume ?P
   show ?Q
   proof (rule coprimeI)
     fix q
     assume "q dvd m" "q dvd n"
     then have "int q dvd int m" "int q dvd int n"
       by simp_all
     with \<open>?P\<close> have "is_unit (int q)"
       by (rule coprime_common_divisor)
     then show "is_unit q"
       by simp
   qed
 next
   assume ?Q
   show ?P
   proof (rule coprimeI)
     fix k
     assume "k dvd int m" "k dvd int n"
     then have "nat \<bar>k\<bar> dvd m" "nat \<bar>k\<bar> dvd n"
       by simp_all
     with \<open>?Q\<close> have "is_unit (nat \<bar>k\<bar>)"
       by (rule coprime_common_divisor)
     then show "is_unit k"
       by simp
   qed
 qed
 
 lemma coprime_abs_left_iff [simp]:
   "coprime \<bar>k\<bar> l \<longleftrightarrow> coprime k l" for k l :: int
   using coprime_normalize_left_iff [of k l] by simp
 
 lemma coprime_abs_right_iff [simp]:
   "coprime k \<bar>l\<bar> \<longleftrightarrow> coprime k l" for k l :: int
   using coprime_abs_left_iff [of l k] by (simp add: ac_simps)
 
 lemma coprime_nat_abs_left_iff [simp]:
   "coprime (nat \<bar>k\<bar>) n \<longleftrightarrow> coprime k (int n)"
 proof -
   define m where "m = nat \<bar>k\<bar>"
   then have "\<bar>k\<bar> = int m"
     by simp
   moreover have "coprime k (int n) \<longleftrightarrow> coprime \<bar>k\<bar> (int n)"
     by simp
   ultimately show ?thesis
     by simp
 qed
 
 lemma coprime_nat_abs_right_iff [simp]:
   "coprime n (nat \<bar>k\<bar>) \<longleftrightarrow> coprime (int n) k"
   using coprime_nat_abs_left_iff [of k n] by (simp add: ac_simps)
 
 lemma coprime_common_divisor_int: "coprime a b \<Longrightarrow> x dvd a \<Longrightarrow> x dvd b \<Longrightarrow> \<bar>x\<bar> = 1"
   for a b :: int
   by (drule coprime_common_divisor [of _ _ x]) simp_all
 
 
 subsubsection \<open>Basic conversions\<close>
 
 lemma div_abs_eq_div_nat:
   "\<bar>k\<bar> div \<bar>l\<bar> = int (nat \<bar>k\<bar> div nat \<bar>l\<bar>)"
   by (auto simp add: divide_int_def)
 
 lemma div_eq_div_abs:
   \<open>k div l = sgn k * sgn l * (\<bar>k\<bar> div \<bar>l\<bar>)
     - of_bool (l \<noteq> 0 \<and> sgn k \<noteq> sgn l \<and> \<not> l dvd k)\<close>
   for k l :: int
   by (simp add: divide_int_def [of k l] div_abs_eq_div_nat)
 
 lemma div_abs_eq:
   \<open>\<bar>k\<bar> div \<bar>l\<bar> = sgn k * sgn l * (k div l + of_bool (sgn k \<noteq> sgn l \<and> \<not> l dvd k))\<close>
   for k l :: int
   by (simp add: div_eq_div_abs [of k l] ac_simps)
 
 lemma mod_abs_eq_div_nat:
   "\<bar>k\<bar> mod \<bar>l\<bar> = int (nat \<bar>k\<bar> mod nat \<bar>l\<bar>)"
   by (simp add: modulo_int_def)
 
 lemma mod_eq_mod_abs:
   \<open>k mod l = sgn k * (\<bar>k\<bar> mod \<bar>l\<bar>) + l * of_bool (sgn k \<noteq> sgn l \<and> \<not> l dvd k)\<close>
   for k l :: int
   by (simp add: modulo_int_def [of k l] mod_abs_eq_div_nat)
 
 lemma mod_abs_eq:
   \<open>\<bar>k\<bar> mod \<bar>l\<bar> = sgn k * (k mod l - l * of_bool (sgn k \<noteq> sgn l \<and> \<not> l dvd k))\<close>
   for k l :: int
   by (auto simp: mod_eq_mod_abs [of k l])
 
 lemma div_sgn_abs_cancel:
   fixes k l v :: int
   assumes "v \<noteq> 0"
   shows "(sgn v * \<bar>k\<bar>) div (sgn v * \<bar>l\<bar>) = \<bar>k\<bar> div \<bar>l\<bar>"
   using assms by (simp add: sgn_mult abs_mult sgn_0_0
     divide_int_def [of "sgn v * \<bar>k\<bar>" "sgn v * \<bar>l\<bar>"] flip: div_abs_eq_div_nat)
 
 lemma div_eq_sgn_abs:
   fixes k l v :: int
   assumes "sgn k = sgn l"
   shows "k div l = \<bar>k\<bar> div \<bar>l\<bar>"
   using assms by (auto simp add: div_abs_eq)
 
 lemma div_dvd_sgn_abs:
   fixes k l :: int
   assumes "l dvd k"
   shows "k div l = (sgn k * sgn l) * (\<bar>k\<bar> div \<bar>l\<bar>)"
   using assms by (auto simp add: div_abs_eq ac_simps)
 
 lemma div_noneq_sgn_abs:
   fixes k l :: int
   assumes "l \<noteq> 0"
   assumes "sgn k \<noteq> sgn l"
   shows "k div l = - (\<bar>k\<bar> div \<bar>l\<bar>) - of_bool (\<not> l dvd k)"
   using assms by (auto simp add: div_abs_eq ac_simps sgn_0_0 dest!: sgn_not_eq_imp)
 
 
 subsubsection \<open>Euclidean division\<close>
 
 instantiation int :: unique_euclidean_ring
 begin
 
 definition euclidean_size_int :: "int \<Rightarrow> nat"
   where [simp]: "euclidean_size_int = (nat \<circ> abs :: int \<Rightarrow> nat)"
 
 definition division_segment_int :: "int \<Rightarrow> int"
   where "division_segment_int k = (if k \<ge> 0 then 1 else - 1)"
 
 lemma division_segment_eq_sgn:
   "division_segment k = sgn k" if "k \<noteq> 0" for k :: int
   using that by (simp add: division_segment_int_def)
 
 lemma abs_division_segment [simp]:
   "\<bar>division_segment k\<bar> = 1" for k :: int
   by (simp add: division_segment_int_def)
 
 lemma abs_mod_less:
   "\<bar>k mod l\<bar> < \<bar>l\<bar>" if "l \<noteq> 0" for k l :: int
 proof -
-  obtain n m and s t where "k = sgn s * int n" and "l = sgn t * int m" 
+  obtain n m and s t where "k = sgn s * int n" and "l = sgn t * int m"
     by (blast intro: int_sgnE elim: that)
   with that show ?thesis
     by (auto simp add: modulo_int_unfold abs_mult mod_greater_zero_iff_not_dvd
         simp flip: right_diff_distrib dest!: sgn_not_eq_imp)
       (simp add: sgn_0_0)
 qed
 
 lemma sgn_mod:
   "sgn (k mod l) = sgn l" if "l \<noteq> 0" "\<not> l dvd k" for k l :: int
 proof -
-  obtain n m and s t where "k = sgn s * int n" and "l = sgn t * int m" 
+  obtain n m and s t where "k = sgn s * int n" and "l = sgn t * int m"
     by (blast intro: int_sgnE elim: that)
   with that show ?thesis
     by (auto simp add: modulo_int_unfold sgn_mult mod_greater_zero_iff_not_dvd
       simp flip: right_diff_distrib dest!: sgn_not_eq_imp)
 qed
 
 instance proof
   fix k l :: int
   show "division_segment (k mod l) = division_segment l" if
     "l \<noteq> 0" and "\<not> l dvd k"
     using that by (simp add: division_segment_eq_sgn dvd_eq_mod_eq_0 sgn_mod)
 next
   fix l q r :: int
   obtain n m and s t
      where l: "l = sgn s * int n" and q: "q = sgn t * int m"
     by (blast intro: int_sgnE elim: that)
   assume \<open>l \<noteq> 0\<close>
   with l have "s \<noteq> 0" and "n > 0"
     by (simp_all add: sgn_0_0)
   assume "division_segment r = division_segment l"
   moreover have "r = sgn r * \<bar>r\<bar>"
     by (simp add: sgn_mult_abs)
   moreover define u where "u = nat \<bar>r\<bar>"
   ultimately have "r = sgn l * int u"
     using division_segment_eq_sgn \<open>l \<noteq> 0\<close> by (cases "r = 0") simp_all
   with l \<open>n > 0\<close> have r: "r = sgn s * int u"
     by (simp add: sgn_mult)
   assume "euclidean_size r < euclidean_size l"
   with l r \<open>s \<noteq> 0\<close> have "u < n"
     by (simp add: abs_mult)
   show "(q * l + r) div l = q"
   proof (cases "q = 0 \<or> r = 0")
     case True
     then show ?thesis
     proof
       assume "q = 0"
       then show ?thesis
         using l r \<open>u < n\<close> by (simp add: divide_int_unfold)
     next
       assume "r = 0"
       from \<open>r = 0\<close> have *: "q * l + r = sgn (t * s) * int (n * m)"
         using q l by (simp add: ac_simps sgn_mult)
       from \<open>s \<noteq> 0\<close> \<open>n > 0\<close> show ?thesis
         by (simp only: *, simp only: * q l divide_int_unfold)
           (auto simp add: sgn_mult ac_simps)
     qed
   next
     case False
     with q r have "t \<noteq> 0" and "m > 0" and "s \<noteq> 0" and "u > 0"
       by (simp_all add: sgn_0_0)
     moreover from \<open>0 < m\<close> \<open>u < n\<close> have "u \<le> m * n"
       using mult_le_less_imp_less [of 1 m u n] by simp
     ultimately have *: "q * l + r = sgn (s * t)
       * int (if t < 0 then m * n - u else m * n + u)"
       using l q r
       by (simp add: sgn_mult algebra_simps of_nat_diff)
     have "(m * n - u) div n = m - 1" if "u > 0"
       using \<open>0 < m\<close> \<open>u < n\<close> that
       by (auto intro: div_nat_eqI simp add: algebra_simps)
     moreover have "n dvd m * n - u \<longleftrightarrow> n dvd u"
       using \<open>u \<le> m * n\<close> dvd_diffD1 [of n "m * n" u]
       by auto
     ultimately show ?thesis
       using \<open>s \<noteq> 0\<close> \<open>m > 0\<close> \<open>u > 0\<close> \<open>u < n\<close> \<open>u \<le> m * n\<close>
       by (simp only: *, simp only: l q divide_int_unfold)
         (auto simp add: sgn_mult sgn_0_0 sgn_1_pos algebra_simps dest: dvd_imp_le)
   qed
 qed (use mult_le_mono2 [of 1] in \<open>auto simp add: division_segment_int_def not_le zero_less_mult_iff mult_less_0_iff abs_mult sgn_mult abs_mod_less sgn_mod nat_mult_distrib\<close>)
 
 end
 
 lemma euclidean_relation_intI [case_names by0 divides euclidean_relation]:
   \<open>(k div l, k mod l) = (q, r)\<close>
     if by0': \<open>l = 0 \<Longrightarrow> q = 0 \<and> r = k\<close>
     and divides': \<open>l \<noteq> 0 \<Longrightarrow> l dvd k \<Longrightarrow> r = 0 \<and> k = q * l\<close>
     and euclidean_relation': \<open>l \<noteq> 0 \<Longrightarrow> \<not> l dvd k \<Longrightarrow> sgn r = sgn l
       \<and> \<bar>r\<bar> < \<bar>l\<bar> \<and> k = q * l + r\<close> for k l :: int
 proof (cases l q r k rule: euclidean_relationI)
   case by0
   then show ?case
     by (rule by0')
 next
   case divides
   then show ?case
     by (rule divides')
 next
   case euclidean_relation
   with euclidean_relation' have \<open>sgn r = sgn l\<close> \<open>\<bar>r\<bar> < \<bar>l\<bar>\<close> \<open>k = q * l + r\<close>
     by simp_all
   from \<open>sgn r = sgn l\<close> \<open>l \<noteq> 0\<close> have \<open>division_segment r = division_segment l\<close>
     by (simp add: division_segment_int_def sgn_if split: if_splits)
   with \<open>\<bar>r\<bar> < \<bar>l\<bar>\<close> \<open>k = q * l + r\<close>
   show ?case
     by simp
 qed
 
 
 subsection \<open>Special case: euclidean rings containing the natural numbers\<close>
 
 class unique_euclidean_semiring_with_nat = semidom + semiring_char_0 + unique_euclidean_semiring +
   assumes of_nat_div: "of_nat (m div n) = of_nat m div of_nat n"
     and division_segment_of_nat [simp]: "division_segment (of_nat n) = 1"
     and division_segment_euclidean_size [simp]: "division_segment a * of_nat (euclidean_size a) = a"
 begin
 
 lemma division_segment_eq_iff:
   "a = b" if "division_segment a = division_segment b"
     and "euclidean_size a = euclidean_size b"
   using that division_segment_euclidean_size [of a] by simp
 
 lemma euclidean_size_of_nat [simp]:
   "euclidean_size (of_nat n) = n"
 proof -
   have "division_segment (of_nat n) * of_nat (euclidean_size (of_nat n)) = of_nat n"
     by (fact division_segment_euclidean_size)
   then show ?thesis by simp
 qed
 
 lemma of_nat_euclidean_size:
   "of_nat (euclidean_size a) = a div division_segment a"
 proof -
   have "of_nat (euclidean_size a) = division_segment a * of_nat (euclidean_size a) div division_segment a"
     by (subst nonzero_mult_div_cancel_left) simp_all
   also have "\<dots> = a div division_segment a"
     by simp
   finally show ?thesis .
 qed
 
 lemma division_segment_1 [simp]:
   "division_segment 1 = 1"
   using division_segment_of_nat [of 1] by simp
 
 lemma division_segment_numeral [simp]:
   "division_segment (numeral k) = 1"
   using division_segment_of_nat [of "numeral k"] by simp
 
 lemma euclidean_size_1 [simp]:
   "euclidean_size 1 = 1"
   using euclidean_size_of_nat [of 1] by simp
 
 lemma euclidean_size_numeral [simp]:
   "euclidean_size (numeral k) = numeral k"
   using euclidean_size_of_nat [of "numeral k"] by simp
 
 lemma of_nat_dvd_iff:
   "of_nat m dvd of_nat n \<longleftrightarrow> m dvd n" (is "?P \<longleftrightarrow> ?Q")
 proof (cases "m = 0")
   case True
   then show ?thesis
     by simp
 next
   case False
   show ?thesis
   proof
     assume ?Q
     then show ?P
       by auto
   next
     assume ?P
     with False have "of_nat n = of_nat n div of_nat m * of_nat m"
       by simp
     then have "of_nat n = of_nat (n div m * m)"
       by (simp add: of_nat_div)
     then have "n = n div m * m"
       by (simp only: of_nat_eq_iff)
     then have "n = m * (n div m)"
       by (simp add: ac_simps)
     then show ?Q ..
   qed
 qed
 
 lemma of_nat_mod:
   "of_nat (m mod n) = of_nat m mod of_nat n"
 proof -
   have "of_nat m div of_nat n * of_nat n + of_nat m mod of_nat n = of_nat m"
     by (simp add: div_mult_mod_eq)
   also have "of_nat m = of_nat (m div n * n + m mod n)"
     by simp
   finally show ?thesis
     by (simp only: of_nat_div of_nat_mult of_nat_add) simp
 qed
 
 lemma one_div_two_eq_zero [simp]:
   "1 div 2 = 0"
 proof -
   from of_nat_div [symmetric] have "of_nat 1 div of_nat 2 = of_nat 0"
     by (simp only:) simp
   then show ?thesis
     by simp
 qed
 
 lemma one_mod_two_eq_one [simp]:
   "1 mod 2 = 1"
 proof -
   from of_nat_mod [symmetric] have "of_nat 1 mod of_nat 2 = of_nat 1"
     by (simp only:) simp
   then show ?thesis
     by simp
 qed
 
 lemma one_mod_2_pow_eq [simp]:
   "1 mod (2 ^ n) = of_bool (n > 0)"
 proof -
   have "1 mod (2 ^ n) = of_nat (1 mod (2 ^ n))"
     using of_nat_mod [of 1 "2 ^ n"] by simp
   also have "\<dots> = of_bool (n > 0)"
     by simp
   finally show ?thesis .
 qed
 
 lemma one_div_2_pow_eq [simp]:
   "1 div (2 ^ n) = of_bool (n = 0)"
   using div_mult_mod_eq [of 1 "2 ^ n"] by auto
 
 lemma div_mult2_eq':
   \<open>a div (of_nat m * of_nat n) = a div of_nat m div of_nat n\<close>
 proof (cases \<open>m = 0 \<or> n = 0\<close>)
   case True
   then show ?thesis
     by auto
 next
   case False
   then have \<open>m > 0\<close> \<open>n > 0\<close>
     by simp_all
   show ?thesis
   proof (cases \<open>of_nat m * of_nat n dvd a\<close>)
     case True
     then obtain b where \<open>a = (of_nat m * of_nat n) * b\<close> ..
     then have \<open>a = of_nat m * (of_nat n * b)\<close>
       by (simp add: ac_simps)
     then show ?thesis
       by simp
   next
     case False
     define q where \<open>q = a div (of_nat m * of_nat n)\<close>
     define r where \<open>r = a mod (of_nat m * of_nat n)\<close>
     from \<open>m > 0\<close> \<open>n > 0\<close> \<open>\<not> of_nat m * of_nat n dvd a\<close> r_def have "division_segment r = 1"
       using division_segment_of_nat [of "m * n"] by (simp add: division_segment_mod)
     with division_segment_euclidean_size [of r]
     have "of_nat (euclidean_size r) = r"
       by simp
     have "a mod (of_nat m * of_nat n) div (of_nat m * of_nat n) = 0"
       by simp
     with \<open>m > 0\<close> \<open>n > 0\<close> r_def have "r div (of_nat m * of_nat n) = 0"
       by simp
     with \<open>of_nat (euclidean_size r) = r\<close>
     have "of_nat (euclidean_size r) div (of_nat m * of_nat n) = 0"
       by simp
     then have "of_nat (euclidean_size r div (m * n)) = 0"
       by (simp add: of_nat_div)
     then have "of_nat (euclidean_size r div m div n) = 0"
       by (simp add: div_mult2_eq)
     with \<open>of_nat (euclidean_size r) = r\<close> have "r div of_nat m div of_nat n = 0"
       by (simp add: of_nat_div)
     with \<open>m > 0\<close> \<open>n > 0\<close> q_def
     have "q = (r div of_nat m + q * of_nat n * of_nat m div of_nat m) div of_nat n"
       by simp
     moreover have \<open>a = q * (of_nat m * of_nat n) + r\<close>
       by (simp add: q_def r_def div_mult_mod_eq)
     ultimately show \<open>a div (of_nat m * of_nat n) = a div of_nat m div of_nat n\<close>
       using q_def [symmetric] div_plus_div_distrib_dvd_right [of \<open>of_nat m\<close> \<open>q * (of_nat m * of_nat n)\<close> r]
       by (simp add: ac_simps)
   qed
 qed
 
 lemma mod_mult2_eq':
   "a mod (of_nat m * of_nat n) = of_nat m * (a div of_nat m mod of_nat n) + a mod of_nat m"
 proof -
   have "a div (of_nat m * of_nat n) * (of_nat m * of_nat n) + a mod (of_nat m * of_nat n) = a div of_nat m div of_nat n * of_nat n * of_nat m + (a div of_nat m mod of_nat n * of_nat m + a mod of_nat m)"
     by (simp add: combine_common_factor div_mult_mod_eq)
   moreover have "a div of_nat m div of_nat n * of_nat n * of_nat m = of_nat n * of_nat m * (a div of_nat m div of_nat n)"
     by (simp add: ac_simps)
   ultimately show ?thesis
     by (simp add: div_mult2_eq' mult_commute)
 qed
 
 lemma div_mult2_numeral_eq:
   "a div numeral k div numeral l = a div numeral (k * l)" (is "?A = ?B")
 proof -
   have "?A = a div of_nat (numeral k) div of_nat (numeral l)"
     by simp
   also have "\<dots> = a div (of_nat (numeral k) * of_nat (numeral l))"
     by (fact div_mult2_eq' [symmetric])
   also have "\<dots> = ?B"
     by simp
   finally show ?thesis .
 qed
 
 lemma numeral_Bit0_div_2:
   "numeral (num.Bit0 n) div 2 = numeral n"
 proof -
   have "numeral (num.Bit0 n) = numeral n + numeral n"
     by (simp only: numeral.simps)
   also have "\<dots> = numeral n * 2"
     by (simp add: mult_2_right)
   finally have "numeral (num.Bit0 n) div 2 = numeral n * 2 div 2"
     by simp
   also have "\<dots> = numeral n"
     by (rule nonzero_mult_div_cancel_right) simp
   finally show ?thesis .
 qed
 
 lemma numeral_Bit1_div_2:
   "numeral (num.Bit1 n) div 2 = numeral n"
 proof -
   have "numeral (num.Bit1 n) = numeral n + numeral n + 1"
     by (simp only: numeral.simps)
   also have "\<dots> = numeral n * 2 + 1"
     by (simp add: mult_2_right)
   finally have "numeral (num.Bit1 n) div 2 = (numeral n * 2 + 1) div 2"
     by simp
   also have "\<dots> = numeral n * 2 div 2 + 1 div 2"
     using dvd_triv_right by (rule div_plus_div_distrib_dvd_left)
   also have "\<dots> = numeral n * 2 div 2"
     by simp
   also have "\<dots> = numeral n"
     by (rule nonzero_mult_div_cancel_right) simp
   finally show ?thesis .
 qed
 
 lemma exp_mod_exp:
   \<open>2 ^ m mod 2 ^ n = of_bool (m < n) * 2 ^ m\<close>
 proof -
   have \<open>(2::nat) ^ m mod 2 ^ n = of_bool (m < n) * 2 ^ m\<close> (is \<open>?lhs = ?rhs\<close>)
     by (auto simp add: not_less monoid_mult_class.power_add dest!: le_Suc_ex)
   then have \<open>of_nat ?lhs = of_nat ?rhs\<close>
     by simp
   then show ?thesis
     by (simp add: of_nat_mod)
 qed
 
 lemma mask_mod_exp:
   \<open>(2 ^ n - 1) mod 2 ^ m = 2 ^ min m n - 1\<close>
 proof -
   have \<open>(2 ^ n - 1) mod 2 ^ m = 2 ^ min m n - (1::nat)\<close> (is \<open>?lhs = ?rhs\<close>)
   proof (cases \<open>n \<le> m\<close>)
     case True
     then show ?thesis
       by (simp add: Suc_le_lessD)
   next
     case False
     then have \<open>m < n\<close>
       by simp
     then obtain q where n: \<open>n = Suc q + m\<close>
       by (auto dest: less_imp_Suc_add)
     then have \<open>min m n = m\<close>
       by simp
     moreover have \<open>(2::nat) ^ m \<le> 2 * 2 ^ q * 2 ^ m\<close>
       using mult_le_mono1 [of 1 \<open>2 * 2 ^ q\<close> \<open>2 ^ m\<close>] by simp
     with n have \<open>2 ^ n - 1 = (2 ^ Suc q - 1) * 2 ^ m + (2 ^ m - (1::nat))\<close>
       by (simp add: monoid_mult_class.power_add algebra_simps)
     ultimately show ?thesis
       by (simp only: euclidean_semiring_cancel_class.mod_mult_self3) simp
   qed
   then have \<open>of_nat ?lhs = of_nat ?rhs\<close>
     by simp
   then show ?thesis
     by (simp add: of_nat_mod of_nat_diff)
 qed
 
 lemma of_bool_half_eq_0 [simp]:
   \<open>of_bool b div 2 = 0\<close>
   by simp
 
 end
 
 class unique_euclidean_ring_with_nat = ring + unique_euclidean_semiring_with_nat
 
 instance nat :: unique_euclidean_semiring_with_nat
   by standard (simp_all add: dvd_eq_mod_eq_0)
 
 instance int :: unique_euclidean_ring_with_nat
   by standard (auto simp add: divide_int_def division_segment_int_def elim: contrapos_np)
 
 
 subsection \<open>More on euclidean division on \<^typ>\<open>int\<close>\<close>
 
 subsubsection \<open>Trivial reduction steps\<close>
 
 lemma div_pos_pos_trivial [simp]:
   "k div l = 0" if "k \<ge> 0" and "k < l" for k l :: int
   using that by (simp add: unique_euclidean_semiring_class.div_eq_0_iff division_segment_int_def)
 
 lemma mod_pos_pos_trivial [simp]:
   "k mod l = k" if "k \<ge> 0" and "k < l" for k l :: int
   using that by (simp add: mod_eq_self_iff_div_eq_0)
 
 lemma div_neg_neg_trivial [simp]:
   "k div l = 0" if "k \<le> 0" and "l < k" for k l :: int
   using that by (cases "k = 0") (simp, simp add: unique_euclidean_semiring_class.div_eq_0_iff division_segment_int_def)
 
 lemma mod_neg_neg_trivial [simp]:
   "k mod l = k" if "k \<le> 0" and "l < k" for k l :: int
   using that by (simp add: mod_eq_self_iff_div_eq_0)
 
-lemma div_pos_neg_trivial:
-  \<open>k div l = - 1\<close> if \<open>0 < k\<close> and \<open>k + l \<le> 0\<close> for k l :: int
-proof (cases \<open>l dvd k\<close>)
-  case True
-  then obtain j where \<open>k = l * j\<close> ..
+lemma
+  div_pos_neg_trivial: \<open>k div l = - 1\<close>  (is ?Q)
+  and mod_pos_neg_trivial: \<open>k mod l = k + l\<close>  (is ?R)
+    if \<open>0 < k\<close> and \<open>k + l \<le> 0\<close> for k l :: int
+proof -
   from that have \<open>l < 0\<close>
     by simp
-  with \<open>k = l * j\<close> \<open>0 < k\<close> have \<open>j \<le> - 1\<close>
-    by (simp add: zero_less_mult_iff)
-  moreover from \<open>k + l \<le> 0\<close> \<open>k = l * j\<close> have \<open>l * (j + 1) \<le> 0\<close>
-    by (simp add: algebra_simps)
-  with \<open>l < 0\<close> have \<open>- 1 \<le> j\<close>
-    by (simp add: mult_le_0_iff)
-  ultimately have \<open>j = - 1\<close>
-    by (rule order.antisym)
-  with \<open>k = l * j\<close> \<open>l < 0\<close> show ?thesis
-    by (simp add: dvd_neg_div)
-next
-  case False
-  have \<open>k + l < 0\<close>
-  proof (rule ccontr)
-    assume \<open>\<not> k + l < 0\<close>
-    with \<open>k + l \<le> 0\<close> have \<open>k + l = 0\<close>
+  have \<open>(k div l, k mod l) = (- 1, k + l)\<close>
+  proof (cases l \<open>- 1 :: int\<close> \<open>k + l\<close> k rule: euclidean_relation_intI)
+    case by0
+    with \<open>l < 0\<close> show ?case
       by simp
-    then have \<open>k = - l\<close>
+  next
+    case divides
+    from \<open>l dvd k\<close> obtain j where \<open>k = l * j\<close> ..
+    with \<open>l < 0\<close> \<open>0 < k\<close> have \<open>j < 0\<close>
+      by (simp add: zero_less_mult_iff)
+    moreover from \<open>k + l \<le> 0\<close> \<open>k = l * j\<close> have \<open>l * (j + 1) \<le> 0\<close>
+      by (simp add: algebra_simps)
+    with \<open>l < 0\<close> have \<open>j + 1 \<ge> 0\<close>
+      by (simp add: mult_le_0_iff)
+    with \<open>j < 0\<close> have \<open>j = - 1\<close>
       by simp
-    then have \<open>l dvd k\<close>
+    with \<open>k = l * j\<close> show ?case
       by simp
-    with \<open>\<not> l dvd k\<close> show False ..
+  next
+    case euclidean_relation
+    with \<open>k + l \<le> 0\<close> have \<open>k + l < 0\<close>
+      by (auto simp add: less_le add_eq_0_iff)
+    with \<open>0 < k\<close> show ?case
+      by simp
   qed
-  with that \<open>\<not> l dvd k\<close> show ?thesis
-    by (simp add: div_eq_div_abs [of k l])
-qed
-
-lemma mod_pos_neg_trivial:
-  \<open>k mod l = k + l\<close> if \<open>0 < k\<close> and \<open>k + l \<le> 0\<close> for k l :: int
-proof -
-  from that have \<open>k mod l = k div l * l + k mod l + l\<close>
-    by (simp add: div_pos_neg_trivial)
-  then show ?thesis by simp
+  then show ?Q and ?R
+    by simp_all
 qed
 
 text \<open>There is neither \<open>div_neg_pos_trivial\<close> nor \<open>mod_neg_pos_trivial\<close>
   because \<^term>\<open>0 div l = 0\<close> would supersede it.\<close>
 
 
+subsubsection \<open>More uniqueness rules\<close>
+
+lemma
+  fixes a b q r :: int
+  assumes \<open>a = b * q + r\<close> \<open>0 \<le> r\<close> \<open>r < b\<close>
+  shows int_div_pos_eq:
+      \<open>a div b = q\<close> (is ?Q)
+    and int_mod_pos_eq:
+      \<open>a mod b = r\<close> (is ?R)
+proof -
+  from assms have \<open>(a div b, a mod b) = (q, r)\<close>
+    by (cases b q r a rule: euclidean_relation_intI)
+      (auto simp add: ac_simps dvd_add_left_iff sgn_1_pos le_less dest: zdvd_imp_le)
+  then show ?Q and ?R
+    by simp_all
+qed
+
+lemma int_div_neg_eq:
+  \<open>a div b = q\<close> if \<open>a = b * q + r\<close> \<open>r \<le> 0\<close> \<open>b < r\<close> for a b q r :: int
+  using that int_div_pos_eq [of a \<open>- b\<close> \<open>- q\<close> \<open>- r\<close>] by simp_all
+
+lemma int_mod_neg_eq:
+  \<open>a mod b = r\<close> if \<open>a = b * q + r\<close> \<open>r \<le> 0\<close> \<open>b < r\<close> for a b q r :: int
+  using that int_div_neg_eq [of a b q r] by simp
+
+
 subsubsection \<open>Laws for unary minus\<close>
 
 lemma zmod_zminus1_not_zero:
   fixes k l :: int
   shows "- k mod l \<noteq> 0 \<Longrightarrow> k mod l \<noteq> 0"
   by (simp add: mod_eq_0_iff_dvd)
 
 lemma zmod_zminus2_not_zero:
   fixes k l :: int
   shows "k mod - l \<noteq> 0 \<Longrightarrow> k mod l \<noteq> 0"
   by (simp add: mod_eq_0_iff_dvd)
 
 lemma zdiv_zminus1_eq_if:
   \<open>(- a) div b = (if a mod b = 0 then - (a div b) else - (a div b) - 1)\<close>
   if \<open>b \<noteq> 0\<close> for a b :: int
   using that sgn_not_eq_imp [of b \<open>- a\<close>]
   by (cases \<open>a = 0\<close>) (auto simp add: div_eq_div_abs [of \<open>- a\<close> b] div_eq_div_abs [of a b] sgn_eq_0_iff)
 
 lemma zdiv_zminus2_eq_if:
   \<open>a div (- b) = (if a mod b = 0 then - (a div b) else - (a div b) - 1)\<close>
   if \<open>b \<noteq> 0\<close> for a b :: int
   using that by (auto simp add: zdiv_zminus1_eq_if div_minus_right)
 
 lemma zmod_zminus1_eq_if:
   \<open>(- a) mod b = (if a mod b = 0 then 0 else b - (a mod b))\<close>
   for a b :: int
   by (cases \<open>b = 0\<close>)
     (auto simp flip: minus_div_mult_eq_mod simp add: zdiv_zminus1_eq_if algebra_simps)
 
 lemma zmod_zminus2_eq_if:
   \<open>a mod (- b) = (if a mod b = 0 then 0 else (a mod b) - b)\<close>
   for a b :: int
   by (auto simp add: zmod_zminus1_eq_if mod_minus_right)
 
 
 subsubsection \<open>Borders\<close>
 
 lemma pos_mod_bound [simp]:
   "k mod l < l" if "l > 0" for k l :: int
 proof -
   obtain m and s where "k = sgn s * int m"
     by (rule int_sgnE)
   moreover from that obtain n where "l = sgn 1 * int n"
     by (cases l) simp_all
   moreover from this that have "n > 0"
     by simp
   ultimately show ?thesis
     by (simp only: modulo_int_unfold)
       (auto simp add: mod_greater_zero_iff_not_dvd sgn_1_pos)
 qed
 
 lemma neg_mod_bound [simp]:
   "l < k mod l" if "l < 0" for k l :: int
 proof -
   obtain m and s where "k = sgn s * int m"
     by (rule int_sgnE)
   moreover from that obtain q where "l = sgn (- 1) * int (Suc q)"
     by (cases l) simp_all
   moreover define n where "n = Suc q"
   then have "Suc q = n"
     by simp
   ultimately show ?thesis
     by (simp only: modulo_int_unfold)
       (auto simp add: mod_greater_zero_iff_not_dvd sgn_1_neg)
 qed
 
 lemma pos_mod_sign [simp]:
   "0 \<le> k mod l" if "l > 0" for k l :: int
 proof -
   obtain m and s where "k = sgn s * int m"
     by (rule int_sgnE)
   moreover from that obtain n where "l = sgn 1 * int n"
     by (cases l) auto
   moreover from this that have "n > 0"
     by simp
   ultimately show ?thesis
     by (simp only: modulo_int_unfold) (auto simp add: sgn_1_pos)
 qed
 
 lemma neg_mod_sign [simp]:
   "k mod l \<le> 0" if "l < 0" for k l :: int
 proof -
   obtain m and s where "k = sgn s * int m"
     by (rule int_sgnE)
   moreover from that obtain q where "l = sgn (- 1) * int (Suc q)"
     by (cases l) simp_all
   moreover define n where "n = Suc q"
   then have "Suc q = n"
     by simp
   moreover have \<open>int (m mod n) \<le> int n\<close>
     using \<open>Suc q = n\<close> by simp
   then have \<open>sgn s * int (m mod n) \<le> int n\<close>
     by (cases s \<open>0::int\<close> rule: linorder_cases) simp_all
   ultimately show ?thesis
     by (simp only: modulo_int_unfold) auto
 qed
 
 
 subsubsection \<open>Splitting Rules for div and mod\<close>
 
 lemma split_zdiv:
   \<open>P (n div k) \<longleftrightarrow>
     (k = 0 \<longrightarrow> P 0) \<and>
     (0 < k \<longrightarrow> (\<forall>i j. 0 \<le> j \<and> j < k \<and> n = k * i + j \<longrightarrow> P i)) \<and>
     (k < 0 \<longrightarrow> (\<forall>i j. k < j \<and> j \<le> 0 \<and> n = k * i + j \<longrightarrow> P i))\<close> (is ?div)
   and split_zmod:
   \<open>Q (n mod k) \<longleftrightarrow>
     (k = 0 \<longrightarrow> Q n) \<and>
     (0 < k \<longrightarrow> (\<forall>i j. 0 \<le> j \<and> j < k \<and> n = k * i + j \<longrightarrow> Q j)) \<and>
     (k < 0 \<longrightarrow> (\<forall>i j. k < j \<and> j \<le> 0 \<and> n = k * i + j \<longrightarrow> Q j))\<close> (is ?mod)
   for n k :: int
 proof -
   have *: \<open>R (n div k) (n mod k) \<longleftrightarrow>
     (k = 0 \<longrightarrow> R 0 n) \<and>
     (0 < k \<longrightarrow> (\<forall>i j. 0 \<le> j \<and> j < k \<and> n = k * i + j \<longrightarrow> R i j)) \<and>
     (k < 0 \<longrightarrow> (\<forall>i j. k < j \<and> j \<le> 0 \<and> n = k * i + j \<longrightarrow> R i j))\<close> for R
     by (cases \<open>k = 0\<close>)
       (auto simp add: linorder_class.neq_iff)
   from * [of \<open>\<lambda>q _. P q\<close>] show ?div .
   from * [of \<open>\<lambda>_ r. Q r\<close>] show ?mod .
 qed
- 
+
 text \<open>Enable (lin)arith to deal with \<^const>\<open>divide\<close> and \<^const>\<open>modulo\<close>
   when these are applied to some constant that is of the form
   \<^term>\<open>numeral k\<close>:\<close>
 declare split_zdiv [of _ _ \<open>numeral n\<close>, linarith_split] for n
 declare split_zdiv [of _ _ \<open>- numeral n\<close>, linarith_split] for n
 declare split_zmod [of _ _ \<open>numeral n\<close>, linarith_split] for n
 declare split_zmod [of _ _ \<open>- numeral n\<close>, linarith_split] for n
 
 lemma zdiv_eq_0_iff:
   "i div k = 0 \<longleftrightarrow> k = 0 \<or> 0 \<le> i \<and> i < k \<or> i \<le> 0 \<and> k < i" (is "?L = ?R")
   for i k :: int
 proof
   assume ?L
   moreover have "?L \<longrightarrow> ?R"
     by (rule split_zdiv [THEN iffD2]) simp
   ultimately show ?R
     by blast
 next
   assume ?R then show ?L
     by auto
 qed
 
 lemma zmod_trivial_iff:
   fixes i k :: int
   shows "i mod k = i \<longleftrightarrow> k = 0 \<or> 0 \<le> i \<and> i < k \<or> i \<le> 0 \<and> k < i"
 proof -
   have "i mod k = i \<longleftrightarrow> i div k = 0"
     using div_mult_mod_eq [of i k] by safe auto
   with zdiv_eq_0_iff
   show ?thesis
     by simp
 qed
 
 
 subsubsection \<open>Algebraic rewrites\<close>
 
 lemma zdiv_zmult2_eq:
   \<open>a div (b * c) = (a div b) div c\<close> if \<open>c \<ge> 0\<close> for a b c :: int
 proof (cases \<open>b \<ge> 0\<close>)
   case True
   with that show ?thesis
     using div_mult2_eq' [of a \<open>nat b\<close> \<open>nat c\<close>] by simp
 next
   case False
   with that show ?thesis
     using div_mult2_eq' [of \<open>- a\<close> \<open>nat (- b)\<close> \<open>nat c\<close>] by simp
 qed
 
 lemma zdiv_zmult2_eq':
   \<open>k div (l * j) = ((sgn j * k) div l) div \<bar>j\<bar>\<close> for k l j :: int
 proof -
   have \<open>k div (l * j) = (sgn j * k) div (sgn j * (l * j))\<close>
     by (simp add: sgn_0_0)
   also have \<open>sgn j * (l * j) = l * \<bar>j\<bar>\<close>
     by (simp add: mult.left_commute [of _ l] abs_sgn) (simp add: ac_simps)
   also have \<open>(sgn j * k) div (l * \<bar>j\<bar>) = ((sgn j * k) div l) div \<bar>j\<bar>\<close>
     by (simp add: zdiv_zmult2_eq)
   finally show ?thesis .
 qed
 
 lemma zmod_zmult2_eq:
   \<open>a mod (b * c) = b * (a div b mod c) + a mod b\<close> if \<open>c \<ge> 0\<close> for a b c :: int
 proof (cases \<open>b \<ge> 0\<close>)
   case True
   with that show ?thesis
     using mod_mult2_eq' [of a \<open>nat b\<close> \<open>nat c\<close>] by simp
 next
   case False
   with that show ?thesis
     using mod_mult2_eq' [of \<open>- a\<close> \<open>nat (- b)\<close> \<open>nat c\<close>] by simp
 qed
 
 lemma half_nonnegative_int_iff [simp]:
   \<open>k div 2 \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int
   by auto
 
 lemma half_negative_int_iff [simp]:
   \<open>k div 2 < 0 \<longleftrightarrow> k < 0\<close> for k :: int
   by auto
 
 
 subsubsection \<open>Distributive laws for conversions.\<close>
 
 lemma zdiv_int:
   "int (a div b) = int a div int b"
   by (fact of_nat_div)
 
 lemma zmod_int:
   "int (a mod b) = int a mod int b"
   by (fact of_nat_mod)
 
 lemma nat_div_distrib:
   \<open>nat (x div y) = nat x div nat y\<close> if \<open>0 \<le> x\<close>
   using that by (simp add: divide_int_def sgn_if)
 
 lemma nat_div_distrib':
   \<open>nat (x div y) = nat x div nat y\<close> if \<open>0 \<le> y\<close>
   using that by (simp add: divide_int_def sgn_if)
 
 lemma nat_mod_distrib: \<comment> \<open>Fails if y<0: the LHS collapses to (nat z) but the RHS doesn't\<close>
   \<open>nat (x mod y) = nat x mod nat y\<close> if \<open>0 \<le> x\<close> \<open>0 \<le> y\<close>
   using that by (simp add: modulo_int_def sgn_if)
 
 
+subsubsection \<open>Monotonicity in the First Argument (Dividend)\<close>
+
+lemma zdiv_mono1:
+  \<open>a div b \<le> a' div b\<close>
+    if \<open>a \<le> a'\<close> \<open>0 < b\<close>
+    for a b b' :: int
+proof -
+  from \<open>a \<le> a'\<close> have \<open>b * (a div b) + a mod b \<le> b * (a' div b) + a' mod b\<close>
+    by simp
+  then have \<open>b * (a div b) \<le> (a' mod b - a mod b) + b * (a' div b)\<close>
+    by (simp add: algebra_simps)
+  moreover have \<open>a' mod b < b + a mod b\<close>
+    by (rule less_le_trans [of _ b]) (use \<open>0 < b\<close> in simp_all)
+  ultimately have \<open>b * (a div b) < b * (1 + a' div b)\<close>
+    by (simp add: distrib_left)
+  with \<open>0 < b\<close> have \<open>a div b < 1 + a' div b\<close>
+    by (simp add: mult_less_cancel_left)
+  then show ?thesis
+    by simp
+qed
+
+lemma zdiv_mono1_neg:
+  \<open>a' div b \<le> a div b\<close>
+    if \<open>a \<le> a'\<close> \<open>b < 0\<close>
+    for a a' b :: int
+  using that zdiv_mono1 [of \<open>- a'\<close> \<open>- a\<close> \<open>- b\<close>] by simp
+
+
+subsubsection \<open>Monotonicity in the Second Argument (Divisor)\<close>
+
+lemma zdiv_mono2:
+  \<open>a div b \<le> a div b'\<close> if \<open>0 \<le> a\<close> \<open>0 < b'\<close> \<open>b' \<le> b\<close> for a b b' :: int
+proof -
+  define q q' r r' where **: \<open>q = a div b\<close> \<open>q' = a div b'\<close> \<open>r = a mod b\<close> \<open>r' = a mod b'\<close>
+  then have *: \<open>b * q + r = b' * q' + r'\<close> \<open>0 \<le> b' * q' + r'\<close>
+    \<open>r' < b'\<close> \<open>0 \<le> r\<close> \<open>0 < b'\<close> \<open>b' \<le> b\<close>
+    using that by simp_all
+  have \<open>0 < b' * (q' + 1)\<close>
+    using * by (simp add: distrib_left)
+  with * have \<open>0 \<le> q'\<close>
+    by (simp add: zero_less_mult_iff)
+  moreover have \<open>b * q = r' - r + b' * q'\<close>
+    using * by linarith
+  ultimately have \<open>b * q < b * (q' + 1)\<close>
+    using mult_right_mono * unfolding distrib_left by fastforce
+  with * have \<open>q \<le> q'\<close>
+    by (simp add: mult_less_cancel_left_pos)
+  with ** show ?thesis
+    by simp
+qed
+
+lemma zdiv_mono2_neg:
+  \<open>a div b' \<le> a div b\<close> if \<open>a < 0\<close> \<open>0 < b'\<close> \<open>b' \<le> b\<close> for a b b' :: int
+proof -
+  define q q' r r' where **: \<open>q = a div b\<close> \<open>q' = a div b'\<close> \<open>r = a mod b\<close> \<open>r' = a mod b'\<close>
+  then have *: \<open>b * q + r = b' * q' + r'\<close> \<open>b' * q' + r' < 0\<close>
+    \<open>r < b\<close> \<open>0 \<le> r'\<close> \<open>0 < b'\<close> \<open>b' \<le> b\<close>
+    using that by simp_all
+  have \<open>b' * q' < 0\<close>
+    using * by linarith
+  with * have \<open>q' \<le> 0\<close>
+    by (simp add: mult_less_0_iff)
+  have \<open>b * q' \<le> b' * q'\<close>
+    by (simp add: \<open>q' \<le> 0\<close> * mult_right_mono_neg)
+  then have "b * q' < b * (q + 1)"
+    using * by (simp add: distrib_left)
+  then have \<open>q' \<le> q\<close>
+    using * by (simp add: mult_less_cancel_left)
+  then show ?thesis
+    by (simp add: **)
+qed
+
+
+subsubsection \<open>Quotients of Signs\<close>
+
+lemma div_eq_minus1:
+  \<open>0 < b \<Longrightarrow> - 1 div b = - 1\<close> for b :: int
+  by (simp add: divide_int_def)
+
+lemma zmod_minus1:
+  \<open>0 < b \<Longrightarrow> - 1 mod b = b - 1\<close> for b :: int
+  by (auto simp add: modulo_int_def)
+
+lemma minus_mod_int_eq:
+  \<open>- k mod l = l - 1 - (k - 1) mod l\<close> if \<open>l \<ge> 0\<close> for k l :: int
+proof (cases \<open>l = 0\<close>)
+  case True
+  then show ?thesis
+    by simp
+next
+  case False
+  with that have \<open>l > 0\<close>
+    by simp
+  then show ?thesis
+  proof (cases \<open>l dvd k\<close>)
+    case True
+    then obtain j where \<open>k = l * j\<close> ..
+    moreover have \<open>(l * j mod l - 1) mod l = l - 1\<close>
+      using \<open>l > 0\<close> by (simp add: zmod_minus1)
+    then have \<open>(l * j - 1) mod l = l - 1\<close>
+      by (simp only: mod_simps)
+    ultimately show ?thesis
+      by simp
+  next
+    case False
+    moreover have 1: \<open>0 < k mod l\<close>
+      using \<open>0 < l\<close> False le_less by fastforce
+    moreover have 2: \<open>k mod l < 1 + l\<close>
+      using \<open>0 < l\<close> pos_mod_bound[of l k] by linarith
+    from 1 2 \<open>l > 0\<close> have \<open>(k mod l - 1) mod l = k mod l - 1\<close>
+      by (simp add: zmod_trivial_iff)
+    ultimately show ?thesis
+      by (simp only: zmod_zminus1_eq_if)
+         (simp add: mod_eq_0_iff_dvd algebra_simps mod_simps)
+  qed
+qed
+
+lemma div_neg_pos_less0:
+  \<open>a div b < 0\<close> if \<open>a < 0\<close> \<open>0 < b\<close> for a b :: int
+proof -
+  have "a div b \<le> - 1 div b"
+    using zdiv_mono1 that by auto
+  also have "... \<le> -1"
+    by (simp add: that(2) div_eq_minus1)
+  finally show ?thesis
+    by force
+qed
+
+lemma div_nonneg_neg_le0:
+  \<open>a div b \<le> 0\<close> if \<open>0 \<le> a\<close> \<open>b < 0\<close> for a b :: int
+  using that by (auto dest: zdiv_mono1_neg)
+
+lemma div_nonpos_pos_le0:
+  \<open>a div b \<le> 0\<close> if \<open>a \<le> 0\<close> \<open>0 < b\<close> for a b :: int
+  using that by (auto dest: zdiv_mono1)
+
+text\<open>Now for some equivalences of the form \<open>a div b >=< 0 \<longleftrightarrow> \<dots>\<close>
+conditional upon the sign of \<open>a\<close> or \<open>b\<close>. There are many more.
+They should all be simp rules unless that causes too much search.\<close>
+
+lemma pos_imp_zdiv_nonneg_iff:
+  \<open>0 \<le> a div b \<longleftrightarrow> 0 \<le> a\<close>
+  if \<open>0 < b\<close> for a b :: int
+proof
+  assume \<open>0 \<le> a div b\<close>
+  show \<open>0 \<le> a\<close>
+  proof (rule ccontr)
+    assume \<open>\<not> 0 \<le> a\<close>
+    then have \<open>a < 0\<close>
+      by simp
+    then have \<open>a div b < 0\<close>
+      using that by (rule div_neg_pos_less0)
+    with \<open>0 \<le> a div b\<close> show False
+      by simp
+  qed
+next
+  assume "0 \<le> a"
+  then have "0 div b \<le> a div b"
+    using zdiv_mono1 that by blast
+  then show "0 \<le> a div b"
+    by auto
+qed
+
+lemma neg_imp_zdiv_nonneg_iff:
+  \<open>0 \<le> a div b \<longleftrightarrow> a \<le> 0\<close> if \<open>b < 0\<close> for a b :: int
+  using that pos_imp_zdiv_nonneg_iff [of \<open>- b\<close> \<open>- a\<close>] by simp
+
+lemma pos_imp_zdiv_pos_iff:
+  \<open>0 < (i::int) div k \<longleftrightarrow> k \<le> i\<close> if \<open>0 < k\<close> for i k :: int
+  using that pos_imp_zdiv_nonneg_iff [of k i] zdiv_eq_0_iff [of i k] by arith
+
+lemma pos_imp_zdiv_neg_iff:
+  \<open>a div b < 0 \<longleftrightarrow> a < 0\<close> if \<open>0 < b\<close> for a b :: int
+    \<comment> \<open>But not \<^prop>\<open>a div b \<le> 0 \<longleftrightarrow> a \<le> 0\<close>; consider \<^prop>\<open>a = 1\<close>, \<^prop>\<open>b = 2\<close> when \<^prop>\<open>a div b = 0\<close>.\<close>
+  using that by (simp add: pos_imp_zdiv_nonneg_iff flip: linorder_not_le)
+
+lemma neg_imp_zdiv_neg_iff:
+    \<comment> \<open>But not \<^prop>\<open>a div b \<le> 0 \<longleftrightarrow> 0 \<le> a\<close>; consider \<^prop>\<open>a = - 1\<close>, \<^prop>\<open>b = - 2\<close> when \<^prop>\<open>a div b = 0\<close>.\<close>
+  \<open>a div b < 0 \<longleftrightarrow> 0 < a\<close> if \<open>b < 0\<close> for a b :: int
+  using that by (simp add: neg_imp_zdiv_nonneg_iff flip: linorder_not_le)
+
+lemma nonneg1_imp_zdiv_pos_iff:
+  \<open>a div b > 0 \<longleftrightarrow> a \<ge> b \<and> b > 0\<close> if \<open>0 \<le> a\<close> for a b :: int
+proof -
+  have "0 < a div b \<Longrightarrow> b \<le> a"
+    using div_pos_pos_trivial[of a b] that by arith
+  moreover have "0 < a div b \<Longrightarrow> b > 0"
+    using that div_nonneg_neg_le0[of a b] by (cases "b=0"; force)
+  moreover have "b \<le> a \<and> 0 < b \<Longrightarrow> 0 < a div b"
+    using int_one_le_iff_zero_less[of "a div b"] zdiv_mono1[of b a b] by simp
+  ultimately show ?thesis
+    by blast
+qed
+
+lemma zmod_le_nonneg_dividend:
+  \<open>m mod k \<le> m\<close> if \<open>(m::int) \<ge> 0\<close> for m k :: int
+proof -
+  from that have \<open>m > 0 \<or> m = 0\<close>
+    by auto
+  then show ?thesis proof
+    assume \<open>m = 0\<close> then show ?thesis
+      by simp
+  next
+    assume \<open>m > 0\<close> then show ?thesis
+    proof (cases k \<open>0::int\<close> rule: linorder_cases)
+      case less
+      moreover define l where \<open>l = - k\<close>
+      ultimately have \<open>l > 0\<close>
+        by simp
+      with \<open>m > 0\<close> have \<open>int (nat m mod nat l) \<le> m\<close>
+        by (simp flip: le_nat_iff)
+      then have \<open>int (nat m mod nat l) - l \<le> m\<close>
+        using \<open>l > 0\<close> by simp
+      with \<open>m > 0\<close> \<open>l > 0\<close> show ?thesis
+        by (simp add: modulo_int_def l_def flip: le_nat_iff)
+    qed (simp_all add: modulo_int_def flip: le_nat_iff)
+  qed
+qed
+
+lemma sgn_div_eq_sgn_mult:
+  \<open>sgn (k div l) = of_bool (k div l \<noteq> 0) * sgn (k * l)\<close>
+  for k l :: int
+proof (cases \<open>k div l = 0\<close>)
+  case True
+  then show ?thesis
+    by simp
+next
+  case False
+  have \<open>0 \<le> \<bar>k\<bar> div \<bar>l\<bar>\<close>
+    by (cases \<open>l = 0\<close>) (simp_all add: pos_imp_zdiv_nonneg_iff)
+  then have \<open>\<bar>k\<bar> div \<bar>l\<bar> \<noteq> 0 \<longleftrightarrow> 0 < \<bar>k\<bar> div \<bar>l\<bar>\<close>
+    by (simp add: less_le)
+  also have \<open>\<dots> \<longleftrightarrow> \<bar>k\<bar> \<ge> \<bar>l\<bar>\<close>
+    using False nonneg1_imp_zdiv_pos_iff by auto
+  finally have *: \<open>\<bar>k\<bar> div \<bar>l\<bar> \<noteq> 0 \<longleftrightarrow> \<bar>l\<bar> \<le> \<bar>k\<bar>\<close> .
+  show ?thesis
+    using \<open>0 \<le> \<bar>k\<bar> div \<bar>l\<bar>\<close> False
+  by (auto simp add: div_eq_div_abs [of k l] div_eq_sgn_abs [of k l]
+    sgn_mult sgn_1_pos sgn_1_neg sgn_eq_0_iff nonneg1_imp_zdiv_pos_iff * dest: sgn_not_eq_imp)
+qed
+
+
+subsubsection \<open>Further properties\<close>
+
+lemma div_int_pos_iff:
+  "k div l \<ge> 0 \<longleftrightarrow> k = 0 \<or> l = 0 \<or> k \<ge> 0 \<and> l \<ge> 0
+    \<or> k < 0 \<and> l < 0"
+  for k l :: int
+proof (cases "k = 0 \<or> l = 0")
+  case False
+  then have *: "k \<noteq> 0" "l \<noteq> 0"
+    by auto
+  then have "0 \<le> k div l \<Longrightarrow> \<not> k < 0 \<Longrightarrow> 0 \<le> l"
+    by (meson neg_imp_zdiv_neg_iff not_le not_less_iff_gr_or_eq)
+  then show ?thesis
+   using * by (auto simp add: pos_imp_zdiv_nonneg_iff neg_imp_zdiv_nonneg_iff)
+qed auto
+
+lemma mod_int_pos_iff:
+  \<open>k mod l \<ge> 0 \<longleftrightarrow> l dvd k \<or> l = 0 \<and> k \<ge> 0 \<or> l > 0\<close>
+  for k l :: int
+proof (cases "l > 0")
+  case False
+  then show ?thesis
+    by (simp add: dvd_eq_mod_eq_0) (use neg_mod_sign [of l k] in \<open>auto simp add: le_less not_less\<close>)
+qed auto
+
+lemma abs_div:
+  \<open>\<bar>x div y\<bar> = \<bar>x\<bar> div \<bar>y\<bar>\<close> if \<open>y dvd x\<close> for x y :: int
+  using that by (cases \<open>y = 0\<close>) (auto simp add: abs_mult)
+
+lemma int_power_div_base: \<^marker>\<open>contributor \<open>Matthias Daum\<close>\<close>
+  \<open>k ^ m div k = k ^ (m - Suc 0)\<close> if \<open>0 < m\<close> \<open>0 < k\<close> for k :: int
+  using that by (cases m) simp_all
+
+lemma int_div_less_self: \<^marker>\<open>contributor \<open>Matthias Daum\<close>\<close>
+  \<open>x div k < x\<close> if \<open>0 < x\<close> \<open>1 < k\<close> for x k :: int
+proof -
+  from that have \<open>nat (x div k) = nat x div nat k\<close>
+    by (simp add: nat_div_distrib)
+  also from that have \<open>nat x div nat k < nat x\<close>
+    by simp
+  finally show ?thesis
+    by simp
+qed
+
+
+subsubsection \<open>Computing \<open>div\<close> and \<open>mod\<close> by shifting\<close>
+
+lemma div_pos_geq:
+  \<open>k div l = (k - l) div l + 1\<close> if \<open>0 < l\<close> \<open>l \<le> k\<close> for k l :: int
+proof -
+  have "k = (k - l) + l" by simp
+  then obtain j where k: "k = j + l" ..
+  with that show ?thesis by (simp add: div_add_self2)
+qed
+
+lemma mod_pos_geq:
+  \<open>k mod l = (k - l) mod l\<close>  if \<open>0 < l\<close> \<open>l \<le> k\<close> for k l :: int
+proof -
+  have "k = (k - l) + l" by simp
+  then obtain j where k: "k = j + l" ..
+  with that show ?thesis by simp
+qed
+
+lemma pos_zdiv_mult_2: \<open>(1 + 2 * b) div (2 * a) = b div a\<close> (is ?Q)
+  and pos_zmod_mult_2: \<open>(1 + 2 * b) mod (2 * a) = 1 + 2 * (b mod a)\<close> (is ?R)
+  if \<open>0 \<le> a\<close> for a b :: int
+proof -
+  have \<open>((1 + 2 * b) div (2 * a), (1 + 2 * b) mod (2 * a)) = (b div a, 1 + 2 * (b mod a))\<close>
+  proof (cases \<open>2 * a\<close> \<open>b div a\<close> \<open>1 + 2 * (b mod a)\<close> \<open>1 + 2 * b\<close> rule: euclidean_relation_intI)
+    case by0
+    then show ?case
+      by simp
+  next
+    case divides
+    have \<open>2 dvd (2 * a)\<close>
+      by simp
+    then have \<open>2 dvd (1 + 2 * b)\<close>
+      using \<open>2 * a dvd 1 + 2 * b\<close> by (rule dvd_trans)
+    then have \<open>2 dvd (1 + b * 2)\<close>
+      by (simp add: ac_simps)
+    then have \<open>is_unit (2 :: int)\<close>
+      by simp
+    then show ?case
+      by simp
+  next
+    case euclidean_relation
+    with that have \<open>a > 0\<close>
+      by simp
+    moreover have \<open>b mod a < a\<close>
+      using \<open>a > 0\<close> by simp
+    then have \<open>1 + 2 * (b mod a) < 2 * a\<close>
+      by simp
+    moreover have \<open>2 * (b mod a) + a * (2 * (b div a)) = 2 * (b div a * a + b mod a)\<close>
+      by (simp only: algebra_simps)
+    moreover have \<open>0 \<le> 2 * (b mod a)\<close>
+      using \<open>a > 0\<close> by simp
+    ultimately show ?case
+      by (simp add: algebra_simps)
+  qed
+  then show ?Q and ?R
+    by simp_all
+qed
+
+lemma neg_zdiv_mult_2: \<open>(1 + 2 * b) div (2 * a) = (b + 1) div a\<close> (is ?Q)
+  and neg_zmod_mult_2: \<open>(1 + 2 * b) mod (2 * a) = 2 * ((b + 1) mod a) - 1\<close> (is ?R)
+  if \<open>a \<le> 0\<close> for a b :: int
+proof -
+  have \<open>((1 + 2 * b) div (2 * a), (1 + 2 * b) mod (2 * a)) = ((b + 1) div a, 2 * ((b + 1) mod a) - 1)\<close>
+  proof (cases \<open>2 * a\<close> \<open>(b + 1) div a\<close> \<open>2 * ((b + 1) mod a) - 1\<close> \<open>1 + 2 * b\<close> rule: euclidean_relation_intI)
+    case by0
+    then show ?case
+      by simp
+  next
+    case divides
+    have \<open>2 dvd (2 * a)\<close>
+      by simp
+    then have \<open>2 dvd (1 + 2 * b)\<close>
+      using \<open>2 * a dvd 1 + 2 * b\<close> by (rule dvd_trans)
+    then have \<open>2 dvd (1 + b * 2)\<close>
+      by (simp add: ac_simps)
+    then have \<open>is_unit (2 :: int)\<close>
+      by simp
+    then show ?case
+      by simp
+  next
+    case euclidean_relation
+    with that have \<open>a < 0\<close>
+      by simp
+    moreover have \<open>(b + 1) mod a > a\<close>
+      using \<open>a < 0\<close> by simp
+    then have \<open>2 * ((b + 1) mod a) > 1 + 2 * a\<close>
+      by simp
+    moreover have \<open>((1 + b) mod a) \<le> 0\<close>
+      using \<open>a < 0\<close> by simp
+    then have \<open>2 * ((1 + b) mod a) \<le> 0\<close>
+      by simp
+    moreover have \<open>2 * ((1 + b) mod a) + a * (2 * ((1 + b) div a)) =
+      2 * ((1 + b) div a * a + (1 + b) mod a)\<close>
+      by (simp only: algebra_simps)
+    ultimately show ?case
+      by (simp add: algebra_simps sgn_mult abs_mult)
+  qed
+  then show ?Q and ?R
+    by simp_all
+qed
+
+lemma zdiv_numeral_Bit0 [simp]:
+  \<open>numeral (Num.Bit0 v) div numeral (Num.Bit0 w) =
+    numeral v div (numeral w :: int)\<close>
+  unfolding numeral.simps unfolding mult_2 [symmetric]
+  by (rule div_mult_mult1) simp
+
+lemma zdiv_numeral_Bit1 [simp]:
+  \<open>numeral (Num.Bit1 v) div numeral (Num.Bit0 w) =
+    (numeral v div (numeral w :: int))\<close>
+  unfolding numeral.simps
+  unfolding mult_2 [symmetric] add.commute [of _ 1]
+  by (rule pos_zdiv_mult_2) simp
+
+lemma zmod_numeral_Bit0 [simp]:
+  \<open>numeral (Num.Bit0 v) mod numeral (Num.Bit0 w) =
+    (2::int) * (numeral v mod numeral w)\<close>
+  unfolding numeral_Bit0 [of v] numeral_Bit0 [of w]
+  unfolding mult_2 [symmetric] by (rule mod_mult_mult1)
+
+lemma zmod_numeral_Bit1 [simp]:
+  \<open>numeral (Num.Bit1 v) mod numeral (Num.Bit0 w) =
+    2 * (numeral v mod numeral w) + (1::int)\<close>
+  unfolding numeral_Bit1 [of v] numeral_Bit0 [of w]
+  unfolding mult_2 [symmetric] add.commute [of _ 1]
+  by (rule pos_zmod_mult_2) simp
+
+
 subsection \<open>Generic symbolic computations\<close>
 
 text \<open>
   The following type class contains everything necessary to formulate
   a division algorithm in ring structures with numerals, restricted
   to its positive segments.
 \<close>
 
 class unique_euclidean_semiring_with_nat_division = unique_euclidean_semiring_with_nat +
   fixes divmod :: \<open>num \<Rightarrow> num \<Rightarrow> 'a \<times> 'a\<close>
     and divmod_step :: \<open>'a \<Rightarrow> 'a \<times> 'a \<Rightarrow> 'a \<times> 'a\<close> \<comment> \<open>
       These are conceptually definitions but force generated code
       to be monomorphic wrt. particular instances of this class which
       yields a significant speedup.\<close>
   assumes divmod_def: \<open>divmod m n = (numeral m div numeral n, numeral m mod numeral n)\<close>
     and divmod_step_def [simp]: \<open>divmod_step l (q, r) =
       (if euclidean_size l \<le> euclidean_size r then (2 * q + 1, r - l)
        else (2 * q, r))\<close> \<comment> \<open>
          This is a formulation of one step (referring to one digit position)
          in school-method division: compare the dividend at the current
          digit position with the remainder from previous division steps
          and evaluate accordingly.\<close>
 begin
 
 lemma fst_divmod:
   \<open>fst (divmod m n) = numeral m div numeral n\<close>
   by (simp add: divmod_def)
 
 lemma snd_divmod:
   \<open>snd (divmod m n) = numeral m mod numeral n\<close>
   by (simp add: divmod_def)
 
 text \<open>
   Following a formulation of school-method division.
   If the divisor is smaller than the dividend, terminate.
   If not, shift the dividend to the right until termination
   occurs and then reiterate single division steps in the
   opposite direction.
 \<close>
 
 lemma divmod_divmod_step:
   \<open>divmod m n = (if m < n then (0, numeral m)
     else divmod_step (numeral n) (divmod m (Num.Bit0 n)))\<close>
 proof (cases \<open>m < n\<close>)
   case True
   then show ?thesis
     by (simp add: prod_eq_iff fst_divmod snd_divmod flip: of_nat_numeral of_nat_div of_nat_mod)
 next
   case False
   define r s t where \<open>r = (numeral m :: nat)\<close> \<open>s = (numeral n :: nat)\<close> \<open>t = 2 * s\<close>
   then have *: \<open>numeral m = of_nat r\<close> \<open>numeral n = of_nat s\<close> \<open>numeral (num.Bit0 n) = of_nat t\<close>
     and \<open>\<not> s \<le> r mod s\<close>
     by (simp_all add: not_le)
   have t: \<open>2 * (r div t) = r div s - r div s mod 2\<close>
     \<open>r mod t = s * (r div s mod 2) + r mod s\<close>
     by (simp add: Rings.minus_mod_eq_mult_div Groups.mult.commute [of 2] Euclidean_Division.div_mult2_eq \<open>t = 2 * s\<close>)
       (use mod_mult2_eq [of r s 2] in \<open>simp add: ac_simps \<open>t = 2 * s\<close>\<close>)
   have rs: \<open>r div s mod 2 = 0 \<or> r div s mod 2 = Suc 0\<close>
     by auto
   from \<open>\<not> s \<le> r mod s\<close> have \<open>s \<le> r mod t \<Longrightarrow>
      r div s = Suc (2 * (r div t)) \<and>
      r mod s = r mod t - s\<close>
     using rs
     by (auto simp add: t)
   moreover have \<open>r mod t < s \<Longrightarrow>
      r div s = 2 * (r div t) \<and>
      r mod s = r mod t\<close>
     using rs
     by (auto simp add: t)
   ultimately show ?thesis
     by (simp add: divmod_def prod_eq_iff split_def Let_def
         not_less mod_eq_0_iff_dvd Rings.mod_eq_0_iff_dvd False not_le *)
     (simp add: flip: of_nat_numeral of_nat_mult add.commute [of 1] of_nat_div of_nat_mod of_nat_Suc of_nat_diff)
 qed
 
 text \<open>The division rewrite proper -- first, trivial results involving \<open>1\<close>\<close>
 
 lemma divmod_trivial [simp]:
   "divmod m Num.One = (numeral m, 0)"
   "divmod num.One (num.Bit0 n) = (0, Numeral1)"
   "divmod num.One (num.Bit1 n) = (0, Numeral1)"
   using divmod_divmod_step [of "Num.One"] by (simp_all add: divmod_def)
 
 text \<open>Division by an even number is a right-shift\<close>
 
 lemma divmod_cancel [simp]:
   \<open>divmod (Num.Bit0 m) (Num.Bit0 n) = (case divmod m n of (q, r) \<Rightarrow> (q, 2 * r))\<close> (is ?P)
   \<open>divmod (Num.Bit1 m) (Num.Bit0 n) = (case divmod m n of (q, r) \<Rightarrow> (q, 2 * r + 1))\<close> (is ?Q)
 proof -
   define r s where \<open>r = (numeral m :: nat)\<close> \<open>s = (numeral n :: nat)\<close>
   then have *: \<open>numeral m = of_nat r\<close> \<open>numeral n = of_nat s\<close>
     \<open>numeral (num.Bit0 m) = of_nat (2 * r)\<close> \<open>numeral (num.Bit0 n) = of_nat (2 * s)\<close>
     \<open>numeral (num.Bit1 m) = of_nat (Suc (2 * r))\<close>
     by simp_all
   have **: \<open>Suc (2 * r) div 2 = r\<close>
     by simp
   show ?P and ?Q
     by (simp_all add: divmod_def *)
       (simp_all flip: of_nat_numeral of_nat_div of_nat_mod of_nat_mult add.commute [of 1] of_nat_Suc
        add: Euclidean_Division.mod_mult_mult1 div_mult2_eq [of _ 2] mod_mult2_eq [of _ 2] **)
 qed
 
 text \<open>The really hard work\<close>
 
 lemma divmod_steps [simp]:
   "divmod (num.Bit0 m) (num.Bit1 n) =
       (if m \<le> n then (0, numeral (num.Bit0 m))
        else divmod_step (numeral (num.Bit1 n))
              (divmod (num.Bit0 m)
                (num.Bit0 (num.Bit1 n))))"
   "divmod (num.Bit1 m) (num.Bit1 n) =
       (if m < n then (0, numeral (num.Bit1 m))
        else divmod_step (numeral (num.Bit1 n))
              (divmod (num.Bit1 m)
                (num.Bit0 (num.Bit1 n))))"
   by (simp_all add: divmod_divmod_step)
 
 lemmas divmod_algorithm_code = divmod_trivial divmod_cancel divmod_steps
 
 text \<open>Special case: divisibility\<close>
 
 definition divides_aux :: "'a \<times> 'a \<Rightarrow> bool"
 where
   "divides_aux qr \<longleftrightarrow> snd qr = 0"
 
 lemma divides_aux_eq [simp]:
   "divides_aux (q, r) \<longleftrightarrow> r = 0"
   by (simp add: divides_aux_def)
 
 lemma dvd_numeral_simp [simp]:
   "numeral m dvd numeral n \<longleftrightarrow> divides_aux (divmod n m)"
   by (simp add: divmod_def mod_eq_0_iff_dvd)
 
-text \<open>Generic computation of quotient and remainder\<close>  
-
-lemma numeral_div_numeral [simp]: 
+text \<open>Generic computation of quotient and remainder\<close>
+
+lemma numeral_div_numeral [simp]:
   "numeral k div numeral l = fst (divmod k l)"
   by (simp add: fst_divmod)
 
-lemma numeral_mod_numeral [simp]: 
+lemma numeral_mod_numeral [simp]:
   "numeral k mod numeral l = snd (divmod k l)"
   by (simp add: snd_divmod)
 
 lemma one_div_numeral [simp]:
   "1 div numeral n = fst (divmod num.One n)"
   by (simp add: fst_divmod)
 
 lemma one_mod_numeral [simp]:
   "1 mod numeral n = snd (divmod num.One n)"
   by (simp add: snd_divmod)
 
 end
 
 instantiation nat :: unique_euclidean_semiring_with_nat_division
 begin
 
 definition divmod_nat :: "num \<Rightarrow> num \<Rightarrow> nat \<times> nat"
 where
   divmod'_nat_def: "divmod_nat m n = (numeral m div numeral n, numeral m mod numeral n)"
 
 definition divmod_step_nat :: "nat \<Rightarrow> nat \<times> nat \<Rightarrow> nat \<times> nat"
 where
   "divmod_step_nat l qr = (let (q, r) = qr
     in if r \<ge> l then (2 * q + 1, r - l)
     else (2 * q, r))"
 
 instance
   by standard (simp_all add: divmod'_nat_def divmod_step_nat_def)
 
 end
 
 declare divmod_algorithm_code [where ?'a = nat, code]
 
 lemma Suc_0_div_numeral [simp]:
   \<open>Suc 0 div numeral Num.One = 1\<close>
   \<open>Suc 0 div numeral (Num.Bit0 n) = 0\<close>
   \<open>Suc 0 div numeral (Num.Bit1 n) = 0\<close>
   by simp_all
 
 lemma Suc_0_mod_numeral [simp]:
   \<open>Suc 0 mod numeral Num.One = 0\<close>
   \<open>Suc 0 mod numeral (Num.Bit0 n) = 1\<close>
   \<open>Suc 0 mod numeral (Num.Bit1 n) = 1\<close>
   by simp_all
 
 instantiation int :: unique_euclidean_semiring_with_nat_division
 begin
 
 definition divmod_int :: "num \<Rightarrow> num \<Rightarrow> int \<times> int"
 where
   "divmod_int m n = (numeral m div numeral n, numeral m mod numeral n)"
 
 definition divmod_step_int :: "int \<Rightarrow> int \<times> int \<Rightarrow> int \<times> int"
 where
   "divmod_step_int l qr = (let (q, r) = qr
     in if \<bar>l\<bar> \<le> \<bar>r\<bar> then (2 * q + 1, r - l)
     else (2 * q, r))"
 
 instance
   by standard (auto simp add: divmod_int_def divmod_step_int_def)
 
 end
 
 declare divmod_algorithm_code [where ?'a = int, code]
 
 context
 begin
-  
+
 qualified definition adjust_div :: "int \<times> int \<Rightarrow> int"
 where
   "adjust_div qr = (let (q, r) = qr in q + of_bool (r \<noteq> 0))"
 
 qualified lemma adjust_div_eq [simp, code]:
   "adjust_div (q, r) = q + of_bool (r \<noteq> 0)"
   by (simp add: adjust_div_def)
 
 qualified definition adjust_mod :: "num \<Rightarrow> int \<Rightarrow> int"
 where
   [simp]: "adjust_mod l r = (if r = 0 then 0 else numeral l - r)"
 
 lemma minus_numeral_div_numeral [simp]:
   "- numeral m div numeral n = - (adjust_div (divmod m n) :: int)"
 proof -
   have "int (fst (divmod m n)) = fst (divmod m n)"
     by (simp only: fst_divmod divide_int_def) auto
   then show ?thesis
     by (auto simp add: split_def Let_def adjust_div_def divides_aux_def divide_int_def)
 qed
 
 lemma minus_numeral_mod_numeral [simp]:
   "- numeral m mod numeral n = adjust_mod n (snd (divmod m n) :: int)"
 proof (cases "snd (divmod m n) = (0::int)")
   case True
   then show ?thesis
     by (simp add: mod_eq_0_iff_dvd divides_aux_def)
 next
   case False
   then have "int (snd (divmod m n)) = snd (divmod m n)" if "snd (divmod m n) \<noteq> (0::int)"
     by (simp only: snd_divmod modulo_int_def) auto
   then show ?thesis
     by (simp add: divides_aux_def adjust_div_def)
       (simp add: divides_aux_def modulo_int_def)
 qed
 
 lemma numeral_div_minus_numeral [simp]:
   "numeral m div - numeral n = - (adjust_div (divmod m n) :: int)"
 proof -
   have "int (fst (divmod m n)) = fst (divmod m n)"
     by (simp only: fst_divmod divide_int_def) auto
   then show ?thesis
     by (auto simp add: split_def Let_def adjust_div_def divides_aux_def divide_int_def)
 qed
-  
+
 lemma numeral_mod_minus_numeral [simp]:
   "numeral m mod - numeral n = - adjust_mod n (snd (divmod m n) :: int)"
 proof (cases "snd (divmod m n) = (0::int)")
   case True
   then show ?thesis
     by (simp add: mod_eq_0_iff_dvd divides_aux_def)
 next
   case False
   then have "int (snd (divmod m n)) = snd (divmod m n)" if "snd (divmod m n) \<noteq> (0::int)"
     by (simp only: snd_divmod modulo_int_def) auto
   then show ?thesis
     by (simp add: divides_aux_def adjust_div_def)
       (simp add: divides_aux_def modulo_int_def)
 qed
 
 lemma minus_one_div_numeral [simp]:
   "- 1 div numeral n = - (adjust_div (divmod Num.One n) :: int)"
-  using minus_numeral_div_numeral [of Num.One n] by simp  
+  using minus_numeral_div_numeral [of Num.One n] by simp
 
 lemma minus_one_mod_numeral [simp]:
   "- 1 mod numeral n = adjust_mod n (snd (divmod Num.One n) :: int)"
   using minus_numeral_mod_numeral [of Num.One n] by simp
 
 lemma one_div_minus_numeral [simp]:
   "1 div - numeral n = - (adjust_div (divmod Num.One n) :: int)"
   using numeral_div_minus_numeral [of Num.One n] by simp
-  
+
 lemma one_mod_minus_numeral [simp]:
   "1 mod - numeral n = - adjust_mod n (snd (divmod Num.One n) :: int)"
   using numeral_mod_minus_numeral [of Num.One n] by simp
 
 lemma [code]:
   fixes k :: int
-  shows 
+  shows
     "k div 0 = 0"
     "k mod 0 = k"
     "0 div k = 0"
     "0 mod k = 0"
     "k div Int.Pos Num.One = k"
     "k mod Int.Pos Num.One = 0"
     "k div Int.Neg Num.One = - k"
     "k mod Int.Neg Num.One = 0"
     "Int.Pos m div Int.Pos n = (fst (divmod m n) :: int)"
     "Int.Pos m mod Int.Pos n = (snd (divmod m n) :: int)"
     "Int.Neg m div Int.Pos n = - (adjust_div (divmod m n) :: int)"
     "Int.Neg m mod Int.Pos n = adjust_mod n (snd (divmod m n) :: int)"
     "Int.Pos m div Int.Neg n = - (adjust_div (divmod m n) :: int)"
     "Int.Pos m mod Int.Neg n = - adjust_mod n (snd (divmod m n) :: int)"
     "Int.Neg m div Int.Neg n = (fst (divmod m n) :: int)"
     "Int.Neg m mod Int.Neg n = - (snd (divmod m n) :: int)"
   by simp_all
 
 end
 
 lemma divmod_BitM_2_eq [simp]:
   \<open>divmod (Num.BitM m) (Num.Bit0 Num.One) = (numeral m - 1, (1 :: int))\<close>
   by (cases m) simp_all
 
 
 subsubsection \<open>Computation by simplification\<close>
 
 lemma euclidean_size_nat_less_eq_iff:
   \<open>euclidean_size m \<le> euclidean_size n \<longleftrightarrow> m \<le> n\<close> for m n :: nat
   by simp
 
 lemma euclidean_size_int_less_eq_iff:
   \<open>euclidean_size k \<le> euclidean_size l \<longleftrightarrow> \<bar>k\<bar> \<le> \<bar>l\<bar>\<close> for k l :: int
   by auto
 
 simproc_setup numeral_divmod
   ("0 div 0 :: 'a :: unique_euclidean_semiring_with_nat_division" | "0 mod 0 :: 'a :: unique_euclidean_semiring_with_nat_division" |
    "0 div 1 :: 'a :: unique_euclidean_semiring_with_nat_division" | "0 mod 1 :: 'a :: unique_euclidean_semiring_with_nat_division" |
    "0 div - 1 :: int" | "0 mod - 1 :: int" |
    "0 div numeral b :: 'a :: unique_euclidean_semiring_with_nat_division" | "0 mod numeral b :: 'a :: unique_euclidean_semiring_with_nat_division" |
    "0 div - numeral b :: int" | "0 mod - numeral b :: int" |
    "1 div 0 :: 'a :: unique_euclidean_semiring_with_nat_division" | "1 mod 0 :: 'a :: unique_euclidean_semiring_with_nat_division" |
    "1 div 1 :: 'a :: unique_euclidean_semiring_with_nat_division" | "1 mod 1 :: 'a :: unique_euclidean_semiring_with_nat_division" |
    "1 div - 1 :: int" | "1 mod - 1 :: int" |
    "1 div numeral b :: 'a :: unique_euclidean_semiring_with_nat_division" | "1 mod numeral b :: 'a :: unique_euclidean_semiring_with_nat_division" |
    "1 div - numeral b :: int" |"1 mod - numeral b :: int" |
    "- 1 div 0 :: int" | "- 1 mod 0 :: int" | "- 1 div 1 :: int" | "- 1 mod 1 :: int" |
    "- 1 div - 1 :: int" | "- 1 mod - 1 :: int" | "- 1 div numeral b :: int" | "- 1 mod numeral b :: int" |
    "- 1 div - numeral b :: int" | "- 1 mod - numeral b :: int" |
    "numeral a div 0 :: 'a :: unique_euclidean_semiring_with_nat_division" | "numeral a mod 0 :: 'a :: unique_euclidean_semiring_with_nat_division" |
    "numeral a div 1 :: 'a :: unique_euclidean_semiring_with_nat_division" | "numeral a mod 1 :: 'a :: unique_euclidean_semiring_with_nat_division" |
    "numeral a div - 1 :: int" | "numeral a mod - 1 :: int" |
    "numeral a div numeral b :: 'a :: unique_euclidean_semiring_with_nat_division" | "numeral a mod numeral b :: 'a :: unique_euclidean_semiring_with_nat_division" |
    "numeral a div - numeral b :: int" | "numeral a mod - numeral b :: int" |
    "- numeral a div 0 :: int" | "- numeral a mod 0 :: int" |
    "- numeral a div 1 :: int" | "- numeral a mod 1 :: int" |
    "- numeral a div - 1 :: int" | "- numeral a mod - 1 :: int" |
    "- numeral a div numeral b :: int" | "- numeral a mod numeral b :: int" |
    "- numeral a div - numeral b :: int" | "- numeral a mod - numeral b :: int") = \<open>
   let
     val if_cong = the (Code.get_case_cong \<^theory> \<^const_name>\<open>If\<close>);
     fun successful_rewrite ctxt ct =
       let
         val thm = Simplifier.rewrite ctxt ct
       in if Thm.is_reflexive thm then NONE else SOME thm end;
   in fn phi =>
     let
       val simps = Morphism.fact phi (@{thms div_0 mod_0 div_by_0 mod_by_0 div_by_1 mod_by_1
         one_div_numeral one_mod_numeral minus_one_div_numeral minus_one_mod_numeral
         one_div_minus_numeral one_mod_minus_numeral
         numeral_div_numeral numeral_mod_numeral minus_numeral_div_numeral minus_numeral_mod_numeral
         numeral_div_minus_numeral numeral_mod_minus_numeral
         div_minus_minus mod_minus_minus Euclidean_Division.adjust_div_eq of_bool_eq one_neq_zero
         numeral_neq_zero neg_equal_0_iff_equal arith_simps arith_special divmod_trivial
         divmod_cancel divmod_steps divmod_step_def fst_conv snd_conv numeral_One
         case_prod_beta rel_simps Euclidean_Division.adjust_mod_def div_minus1_right mod_minus1_right
         minus_minus numeral_times_numeral mult_zero_right mult_1_right
         euclidean_size_nat_less_eq_iff euclidean_size_int_less_eq_iff diff_nat_numeral nat_numeral}
         @ [@{lemma "0 = 0 \<longleftrightarrow> True" by simp}]);
       fun prepare_simpset ctxt = HOL_ss |> Simplifier.simpset_map ctxt
         (Simplifier.add_cong if_cong #> fold Simplifier.add_simp simps)
     in fn ctxt => successful_rewrite (Simplifier.put_simpset (prepare_simpset ctxt) ctxt) end
   end
 \<close> \<comment> \<open>
   There is space for improvement here: the calculation itself
   could be carried out outside the logic, and a generic simproc
-  (simplifier setup) for generic calculation would be helpful. 
+  (simplifier setup) for generic calculation would be helpful.
 \<close>
 
 
 subsubsection \<open>Code generation\<close>
 
 context
 begin
 
 qualified definition divmod_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<times> nat"
   where "divmod_nat m n = (m div n, m mod n)"
 
 qualified lemma divmod_nat_if [code]:
   "divmod_nat m n = (if n = 0 \<or> m < n then (0, m) else
     let (q, r) = divmod_nat (m - n) n in (Suc q, r))"
   by (simp add: divmod_nat_def prod_eq_iff case_prod_beta not_less le_div_geq le_mod_geq)
 
 qualified lemma [code]:
   "m div n = fst (divmod_nat m n)"
   "m mod n = snd (divmod_nat m n)"
   by (simp_all add: divmod_nat_def)
 
 end
 
 code_identifier
   code_module Euclidean_Division \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith
 
 end
diff --git a/src/HOL/Groebner_Basis.thy b/src/HOL/Groebner_Basis.thy
--- a/src/HOL/Groebner_Basis.thy
+++ b/src/HOL/Groebner_Basis.thy
@@ -1,96 +1,100 @@
 (*  Title:      HOL/Groebner_Basis.thy
     Author:     Amine Chaieb, TU Muenchen
 *)
 
 section \<open>Groebner bases\<close>
 
 theory Groebner_Basis
 imports Semiring_Normalization Parity
 begin
 
 subsection \<open>Groebner Bases\<close>
 
 lemmas bool_simps = simp_thms(1-34) \<comment> \<open>FIXME move to \<^theory>\<open>HOL.HOL\<close>\<close>
 
 lemma nnf_simps: \<comment> \<open>FIXME shadows fact binding in \<^theory>\<open>HOL.HOL\<close>\<close>
   "(\<not>(P \<and> Q)) = (\<not>P \<or> \<not>Q)" "(\<not>(P \<or> Q)) = (\<not>P \<and> \<not>Q)"
   "(P \<longrightarrow> Q) = (\<not>P \<or> Q)"
   "(P = Q) = ((P \<and> Q) \<or> (\<not>P \<and> \<not> Q))" "(\<not> \<not>(P)) = P"
   by blast+
 
 lemma dnf:
   "(P \<and> (Q \<or> R)) = ((P\<and>Q) \<or> (P\<and>R))"
   "((Q \<or> R) \<and> P) = ((Q\<and>P) \<or> (R\<and>P))"
   "(P \<and> Q) = (Q \<and> P)"
   "(P \<or> Q) = (Q \<or> P)"
   by blast+
 
 lemmas weak_dnf_simps = dnf bool_simps
 
 lemma PFalse:
     "P \<equiv> False \<Longrightarrow> \<not> P"
     "\<not> P \<Longrightarrow> (P \<equiv> False)"
   by auto
 
 named_theorems algebra "pre-simplification rules for algebraic methods"
 ML_file \<open>Tools/groebner.ML\<close>
 
 method_setup algebra = \<open>
   let
     fun keyword k = Scan.lift (Args.$$$ k -- Args.colon) >> K ()
     val addN = "add"
     val delN = "del"
     val any_keyword = keyword addN || keyword delN
     val thms = Scan.repeats (Scan.unless any_keyword Attrib.multi_thm);
   in
     Scan.optional (keyword addN |-- thms) [] --
      Scan.optional (keyword delN |-- thms) [] >>
     (fn (add_ths, del_ths) => fn ctxt =>
       SIMPLE_METHOD' (Groebner.algebra_tac add_ths del_ths ctxt))
   end
 \<close> "solve polynomial equations over (semi)rings and ideal membership problems using Groebner bases"
 
 declare dvd_def[algebra]
 declare mod_eq_0_iff_dvd[algebra]
 declare mod_div_trivial[algebra]
 declare mod_mod_trivial[algebra]
 declare div_by_0[algebra]
 declare mod_by_0[algebra]
 declare mult_div_mod_eq[algebra]
 declare div_minus_minus[algebra]
 declare mod_minus_minus[algebra]
 declare div_minus_right[algebra]
 declare mod_minus_right[algebra]
 declare div_0[algebra]
 declare mod_0[algebra]
 declare mod_by_1[algebra]
 declare div_by_1[algebra]
 declare mod_minus1_right[algebra]
 declare div_minus1_right[algebra]
 declare mod_mult_self2_is_0[algebra]
 declare mod_mult_self1_is_0[algebra]
-declare zmod_eq_0_iff[algebra]
+
+lemma zmod_eq_0_iff [algebra]:
+  \<open>m mod d = 0 \<longleftrightarrow> (\<exists>q. m = d * q)\<close> for m d :: int
+  by (auto simp add: mod_eq_0_iff_dvd)
+
 declare dvd_0_left_iff[algebra]
 declare zdvd1_eq[algebra]
 declare mod_eq_dvd_iff[algebra]
 declare nat_mod_eq_iff[algebra]
 
 context semiring_parity
 begin
 
 declare even_mult_iff [algebra]
 declare even_power [algebra]
 
 end
 
 context ring_parity
 begin
 
 declare even_minus [algebra]
 
 end
 
 declare even_Suc [algebra]
 declare even_diff_nat [algebra]
 
 end
diff --git a/src/HOL/Main.thy b/src/HOL/Main.thy
--- a/src/HOL/Main.thy
+++ b/src/HOL/Main.thy
@@ -1,108 +1,109 @@
 section \<open>Main HOL\<close>
 
 text \<open>
   Classical Higher-order Logic -- only ``Main'', excluding real and
   complex numbers etc.
 \<close>
 
 theory Main
   imports
     Predicate_Compile
     Quickcheck_Narrowing
     Mirabelle
     Extraction
     Nunchaku
     BNF_Greatest_Fixpoint
     Filter
     Conditionally_Complete_Lattices
     Binomial
     GCD
+    Divides
 begin
 
 subsection \<open>Namespace cleanup\<close>
 
 hide_const (open)
   czero cinfinite cfinite csum cone ctwo Csum cprod cexp image2 image2p vimage2p Gr Grp collect
   fsts snds setl setr convol pick_middlep fstOp sndOp csquare relImage relInvImage Succ Shift
   shift proj id_bnf
 
 hide_fact (open) id_bnf_def type_definition_id_bnf_UNIV
 
 
 subsection \<open>Syntax cleanup\<close>
 
 no_notation
   ordLeq2 (infix "<=o" 50) and
   ordLeq3 (infix "\<le>o" 50) and
   ordLess2 (infix "<o" 50) and
   ordIso2 (infix "=o" 50) and
   card_of ("|_|") and
   BNF_Cardinal_Arithmetic.csum (infixr "+c" 65) and
   BNF_Cardinal_Arithmetic.cprod (infixr "*c" 80) and
   BNF_Cardinal_Arithmetic.cexp (infixr "^c" 90) and
   BNF_Def.convol ("\<langle>(_,/ _)\<rangle>")
 
 bundle cardinal_syntax
 begin
 
 notation
   ordLeq2 (infix "<=o" 50) and
   ordLeq3 (infix "\<le>o" 50) and
   ordLess2 (infix "<o" 50) and
   ordIso2 (infix "=o" 50) and
   card_of ("|_|") and
   BNF_Cardinal_Arithmetic.csum (infixr "+c" 65) and
   BNF_Cardinal_Arithmetic.cprod (infixr "*c" 80) and
   BNF_Cardinal_Arithmetic.cexp (infixr "^c" 90)
 
 alias cinfinite = BNF_Cardinal_Arithmetic.cinfinite
 alias czero = BNF_Cardinal_Arithmetic.czero
 alias cone = BNF_Cardinal_Arithmetic.cone
 alias ctwo = BNF_Cardinal_Arithmetic.ctwo
 
 end
 
 
 subsection \<open>Lattice syntax\<close>
 
 bundle lattice_syntax
 begin
 
 notation
   bot ("\<bottom>") and
   top ("\<top>") and
   inf  (infixl "\<sqinter>" 70) and
   sup  (infixl "\<squnion>" 65) and
   Inf  ("\<Sqinter> _" [900] 900) and
   Sup  ("\<Squnion> _" [900] 900)
 
 syntax
   "_INF1"     :: "pttrns \<Rightarrow> 'b \<Rightarrow> 'b"           ("(3\<Sqinter>_./ _)" [0, 10] 10)
   "_INF"      :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Sqinter>_\<in>_./ _)" [0, 0, 10] 10)
   "_SUP1"     :: "pttrns \<Rightarrow> 'b \<Rightarrow> 'b"           ("(3\<Squnion>_./ _)" [0, 10] 10)
   "_SUP"      :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Squnion>_\<in>_./ _)" [0, 0, 10] 10)
 
 end
 
 bundle no_lattice_syntax
 begin
 
 no_notation
   bot ("\<bottom>") and
   top ("\<top>") and
   inf  (infixl "\<sqinter>" 70) and
   sup  (infixl "\<squnion>" 65) and
   Inf  ("\<Sqinter> _" [900] 900) and
   Sup  ("\<Squnion> _" [900] 900)
 
 no_syntax
   "_INF1"     :: "pttrns \<Rightarrow> 'b \<Rightarrow> 'b"           ("(3\<Sqinter>_./ _)" [0, 10] 10)
   "_INF"      :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Sqinter>_\<in>_./ _)" [0, 0, 10] 10)
   "_SUP1"     :: "pttrns \<Rightarrow> 'b \<Rightarrow> 'b"           ("(3\<Squnion>_./ _)" [0, 10] 10)
   "_SUP"      :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Squnion>_\<in>_./ _)" [0, 0, 10] 10)
 
 end
 
 unbundle no_lattice_syntax
 
 end
diff --git a/src/HOL/Number_Theory/Cong.thy b/src/HOL/Number_Theory/Cong.thy
--- a/src/HOL/Number_Theory/Cong.thy
+++ b/src/HOL/Number_Theory/Cong.thy
@@ -1,770 +1,754 @@
 (*  Title:      HOL/Number_Theory/Cong.thy
     Author:     Christophe Tabacznyj
     Author:     Lawrence C. Paulson
     Author:     Amine Chaieb
     Author:     Thomas M. Rasmussen
     Author:     Jeremy Avigad
 
 Defines congruence (notation: [x = y] (mod z)) for natural numbers and
 integers.
 
 This file combines and revises a number of prior developments.
 
 The original theories "GCD" and "Primes" were by Christophe Tabacznyj
 and Lawrence C. Paulson, based on @{cite davenport92}. They introduced
 gcd, lcm, and prime for the natural numbers.
 
 The original theory "IntPrimes" was by Thomas M. Rasmussen, and
 extended gcd, lcm, primes to the integers. Amine Chaieb provided
 another extension of the notions to the integers, and added a number
 of results to "Primes" and "GCD".
 
 The original theory, "IntPrimes", by Thomas M. Rasmussen, defined and
 developed the congruence relations on the integers. The notion was
 extended to the natural numbers by Chaieb. Jeremy Avigad combined
 these, revised and tidied them, made the development uniform for the
 natural numbers and the integers, and added a number of new theorems.
 *)
 
 section \<open>Congruence\<close>
 
 theory Cong
   imports "HOL-Computational_Algebra.Primes"
 begin
 
 subsection \<open>Generic congruences\<close>
  
 context unique_euclidean_semiring
 begin
 
 definition cong :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool"  (\<open>(1[_ = _] '(' mod _'))\<close>)
   where "cong b c a \<longleftrightarrow> b mod a = c mod a"
   
 abbreviation notcong :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool"  (\<open>(1[_ \<noteq> _] '(' mod _'))\<close>)
   where "notcong b c a \<equiv> \<not> cong b c a"
 
 lemma cong_refl [simp]:
   "[b = b] (mod a)"
   by (simp add: cong_def)
 
 lemma cong_sym: 
   "[b = c] (mod a) \<Longrightarrow> [c = b] (mod a)"
   by (simp add: cong_def)
 
 lemma cong_sym_eq:
   "[b = c] (mod a) \<longleftrightarrow> [c = b] (mod a)"
   by (auto simp add: cong_def)
 
 lemma cong_trans [trans]:
   "[b = c] (mod a) \<Longrightarrow> [c = d] (mod a) \<Longrightarrow> [b = d] (mod a)"
   by (simp add: cong_def)
 
 lemma cong_mult_self_right:
   "[b * a = 0] (mod a)"
   by (simp add: cong_def)
 
 lemma cong_mult_self_left:
   "[a * b = 0] (mod a)"
   by (simp add: cong_def)
 
 lemma cong_mod_left [simp]:
   "[b mod a = c] (mod a) \<longleftrightarrow> [b = c] (mod a)"
   by (simp add: cong_def)  
 
 lemma cong_mod_right [simp]:
   "[b = c mod a] (mod a) \<longleftrightarrow> [b = c] (mod a)"
   by (simp add: cong_def)  
 
 lemma cong_0 [simp, presburger]:
   "[b = c] (mod 0) \<longleftrightarrow> b = c"
   by (simp add: cong_def)
 
 lemma cong_1 [simp, presburger]:
   "[b = c] (mod 1)"
   by (simp add: cong_def)
 
 lemma cong_dvd_iff:
   "a dvd b \<longleftrightarrow> a dvd c" if "[b = c] (mod a)"
   using that by (auto simp: cong_def dvd_eq_mod_eq_0)
 
 lemma cong_0_iff: "[b = 0] (mod a) \<longleftrightarrow> a dvd b"
   by (simp add: cong_def dvd_eq_mod_eq_0)
 
 lemma cong_add:
   "[b = c] (mod a) \<Longrightarrow> [d = e] (mod a) \<Longrightarrow> [b + d = c + e] (mod a)"
   by (auto simp add: cong_def intro: mod_add_cong)
 
 lemma cong_mult:
   "[b = c] (mod a) \<Longrightarrow> [d = e] (mod a) \<Longrightarrow> [b * d = c * e] (mod a)"
   by (auto simp add: cong_def intro: mod_mult_cong)
 
 lemma cong_scalar_right:
   "[b = c] (mod a) \<Longrightarrow> [b * d = c * d] (mod a)"
   by (simp add: cong_mult)
 
 lemma cong_scalar_left:
   "[b = c] (mod a) \<Longrightarrow> [d * b = d * c] (mod a)"
   by (simp add: cong_mult)
 
 lemma cong_pow:
   "[b = c] (mod a) \<Longrightarrow> [b ^ n = c ^ n] (mod a)"
   by (simp add: cong_def power_mod [symmetric, of b n a] power_mod [symmetric, of c n a])
 
 lemma cong_sum:
   "[sum f A = sum g A] (mod a)" if "\<And>x. x \<in> A \<Longrightarrow> [f x = g x] (mod a)"
   using that by (induct A rule: infinite_finite_induct) (auto intro: cong_add)
 
 lemma cong_prod:
   "[prod f A = prod g A] (mod a)" if "(\<And>x. x \<in> A \<Longrightarrow> [f x = g x] (mod a))"
   using that by (induct A rule: infinite_finite_induct) (auto intro: cong_mult)
 
 lemma mod_mult_cong_right:
   "[c mod (a * b) = d] (mod a) \<longleftrightarrow> [c = d] (mod a)"
   by (simp add: cong_def mod_mod_cancel mod_add_left_eq)
 
 lemma mod_mult_cong_left:
   "[c mod (b * a) = d] (mod a) \<longleftrightarrow> [c = d] (mod a)"
   using mod_mult_cong_right [of c a b d] by (simp add: ac_simps)
 
 end
 
 context unique_euclidean_ring
 begin
 
 lemma cong_diff:
   "[b = c] (mod a) \<Longrightarrow> [d = e] (mod a) \<Longrightarrow> [b - d = c - e] (mod a)"
   by (auto simp add: cong_def intro: mod_diff_cong)
 
 lemma cong_diff_iff_cong_0:
   "[b - c = 0] (mod a) \<longleftrightarrow> [b = c] (mod a)" (is "?P \<longleftrightarrow> ?Q")
 proof
   assume ?P
   then have "[b - c + c = 0 + c] (mod a)"
     by (rule cong_add) simp
   then show ?Q
     by simp
 next
   assume ?Q
   with cong_diff [of b c a c c] show ?P
     by simp
 qed
 
 lemma cong_minus_minus_iff:
   "[- b = - c] (mod a) \<longleftrightarrow> [b = c] (mod a)"
   using cong_diff_iff_cong_0 [of b c a] cong_diff_iff_cong_0 [of "- b" "- c" a]
   by (simp add: cong_0_iff dvd_diff_commute)
 
 lemma cong_modulus_minus_iff [iff]:
   "[b = c] (mod - a) \<longleftrightarrow> [b = c] (mod a)"
   using cong_diff_iff_cong_0 [of b c a] cong_diff_iff_cong_0 [of b c " -a"]
   by (simp add: cong_0_iff)
 
 lemma cong_iff_dvd_diff:
   "[a = b] (mod m) \<longleftrightarrow> m dvd (a - b)"
   by (simp add: cong_0_iff [symmetric] cong_diff_iff_cong_0)
 
 lemma cong_iff_lin:
   "[a = b] (mod m) \<longleftrightarrow> (\<exists>k. b = a + m * k)" (is "?P \<longleftrightarrow> ?Q")
 proof -
   have "?P \<longleftrightarrow> m dvd b - a"
     by (simp add: cong_iff_dvd_diff dvd_diff_commute)
   also have "\<dots> \<longleftrightarrow> ?Q"
     by (auto simp add: algebra_simps elim!: dvdE)
   finally show ?thesis
     by simp
 qed
 
 lemma cong_add_lcancel:
   "[a + x = a + y] (mod n) \<longleftrightarrow> [x = y] (mod n)"
   by (simp add: cong_iff_lin algebra_simps)
 
 lemma cong_add_rcancel:
   "[x + a = y + a] (mod n) \<longleftrightarrow> [x = y] (mod n)"
   by (simp add: cong_iff_lin algebra_simps)
 
 lemma cong_add_lcancel_0:
   "[a + x = a] (mod n) \<longleftrightarrow> [x = 0] (mod n)"
   using cong_add_lcancel [of a x 0 n] by simp
 
 lemma cong_add_rcancel_0:
   "[x + a = a] (mod n) \<longleftrightarrow> [x = 0] (mod n)"
   using cong_add_rcancel [of x a 0 n] by simp
 
 lemma cong_dvd_modulus:
   "[x = y] (mod n)" if "[x = y] (mod m)" and "n dvd m"
   using that by (auto intro: dvd_trans simp add: cong_iff_dvd_diff)
 
 lemma cong_modulus_mult:
   "[x = y] (mod m)" if "[x = y] (mod m * n)"
   using that by (simp add: cong_iff_dvd_diff) (rule dvd_mult_left)
 
 end
 
 lemma cong_abs [simp]:
   "[x = y] (mod \<bar>m\<bar>) \<longleftrightarrow> [x = y] (mod m)"
   for x y :: "'a :: {unique_euclidean_ring, linordered_idom}"
   by (simp add: cong_iff_dvd_diff)
 
 lemma cong_square:
   "prime p \<Longrightarrow> 0 < a \<Longrightarrow> [a * a = 1] (mod p) \<Longrightarrow> [a = 1] (mod p) \<or> [a = - 1] (mod p)"
   for a p :: "'a :: {normalization_semidom, linordered_idom, unique_euclidean_ring}"
   by (auto simp add: cong_iff_dvd_diff square_diff_one_factored dest: prime_dvd_multD)
 
 lemma cong_mult_rcancel:
   "[a * k = b * k] (mod m) \<longleftrightarrow> [a = b] (mod m)"
   if "coprime k m" for a k m :: "'a::{unique_euclidean_ring, ring_gcd}"
   using that by (auto simp add: cong_iff_dvd_diff left_diff_distrib [symmetric] ac_simps coprime_dvd_mult_right_iff)
 
 lemma cong_mult_lcancel:
   "[k * a = k * b] (mod m) = [a = b] (mod m)"
   if "coprime k m" for a k m :: "'a::{unique_euclidean_ring, ring_gcd}"
   using that cong_mult_rcancel [of k m a b] by (simp add: ac_simps)
 
 lemma coprime_cong_mult:
   "[a = b] (mod m) \<Longrightarrow> [a = b] (mod n) \<Longrightarrow> coprime m n \<Longrightarrow> [a = b] (mod m * n)"
   for a b :: "'a :: {unique_euclidean_ring, semiring_gcd}"
   by (simp add: cong_iff_dvd_diff divides_mult)
 
 lemma cong_gcd_eq:
   "gcd a m = gcd b m" if "[a = b] (mod m)"
   for a b :: "'a :: {unique_euclidean_semiring, euclidean_semiring_gcd}"
 proof (cases "m = 0")
   case True
   with that show ?thesis
     by simp
 next
   case False
   moreover have "gcd (a mod m) m = gcd (b mod m) m"
     using that by (simp add: cong_def)
   ultimately show ?thesis
     by simp
 qed 
 
 lemma cong_imp_coprime:
   "[a = b] (mod m) \<Longrightarrow> coprime a m \<Longrightarrow> coprime b m"
   for a b :: "'a :: {unique_euclidean_semiring, euclidean_semiring_gcd}"
   by (auto simp add: coprime_iff_gcd_eq_1 dest: cong_gcd_eq)
 
 lemma cong_cong_prod_coprime:
   "[x = y] (mod (\<Prod>i\<in>A. m i))" if
     "(\<forall>i\<in>A. [x = y] (mod m i))"
     "(\<forall>i\<in>A. (\<forall>j\<in>A. i \<noteq> j \<longrightarrow> coprime (m i) (m j)))"
   for x y :: "'a :: {unique_euclidean_ring, semiring_gcd}"
   using that by (induct A rule: infinite_finite_induct)
     (auto intro!: coprime_cong_mult prod_coprime_right)
 
 
 subsection \<open>Congruences on \<^typ>\<open>nat\<close> and \<^typ>\<open>int\<close>\<close>
 
 lemma cong_int_iff:
   "[int m = int q] (mod int n) \<longleftrightarrow> [m = q] (mod n)"
   by (simp add: cong_def of_nat_mod [symmetric])
 
 lemma cong_Suc_0 [simp, presburger]:
   "[m = n] (mod Suc 0)"
   using cong_1 [of m n] by simp
 
 lemma cong_diff_nat:
   "[a - c = b - d] (mod m)" if "[a = b] (mod m)" "[c = d] (mod m)"
     and "a \<ge> c" "b \<ge> d" for a b c d m :: nat
 proof -
   have "[c + (a - c) = d + (b - d)] (mod m)"
     using that by simp
   with \<open>[c = d] (mod m)\<close> have "[c + (a - c) = c + (b - d)] (mod m)"
     using mod_add_cong by (auto simp add: cong_def) fastforce
   then show ?thesis
     by (simp add: cong_def nat_mod_eq_iff)
 qed
 
 lemma cong_diff_iff_cong_0_nat:
   "[a - b = 0] (mod m) \<longleftrightarrow> [a = b] (mod m)" if "a \<ge> b" for a b :: nat
-  using that by (auto simp add: cong_def le_imp_diff_is_add dest: nat_mod_eq_lemma)
+  using that by (simp add: cong_0_iff) (simp add: cong_def mod_eq_dvd_iff_nat)
 
 lemma cong_diff_iff_cong_0_nat':
   "[nat \<bar>int a - int b\<bar> = 0] (mod m) \<longleftrightarrow> [a = b] (mod m)"
 proof (cases "b \<le> a")
   case True
   then show ?thesis
     by (simp add: nat_diff_distrib' cong_diff_iff_cong_0_nat [of b a m])
 next
   case False
   then have "a \<le> b"
     by simp
   then show ?thesis
     by (simp add: nat_diff_distrib' cong_diff_iff_cong_0_nat [of a b m])
       (auto simp add: cong_def)
 qed
 
 lemma cong_altdef_nat:
   "a \<ge> b \<Longrightarrow> [a = b] (mod m) \<longleftrightarrow> m dvd (a - b)"
   for a b :: nat
   by (simp add: cong_0_iff [symmetric] cong_diff_iff_cong_0_nat)
 
 lemma cong_altdef_nat':
   "[a = b] (mod m) \<longleftrightarrow> m dvd nat \<bar>int a - int b\<bar>"
   using cong_diff_iff_cong_0_nat' [of a b m]
   by (simp only: cong_0_iff [symmetric])
 
 lemma cong_mult_rcancel_nat:
   "[a * k = b * k] (mod m) \<longleftrightarrow> [a = b] (mod m)"
   if "coprime k m" for a k m :: nat
 proof -
   have "[a * k = b * k] (mod m) \<longleftrightarrow> m dvd nat \<bar>int (a * k) - int (b * k)\<bar>"
     by (simp add: cong_altdef_nat')
   also have "\<dots> \<longleftrightarrow> m dvd nat \<bar>(int a - int b) * int k\<bar>"
     by (simp add: algebra_simps)
   also have "\<dots> \<longleftrightarrow> m dvd nat \<bar>int a - int b\<bar> * k"
     by (simp add: abs_mult nat_times_as_int)
   also have "\<dots> \<longleftrightarrow> m dvd nat \<bar>int a - int b\<bar>"
     by (rule coprime_dvd_mult_left_iff) (use \<open>coprime k m\<close> in \<open>simp add: ac_simps\<close>)
   also have "\<dots> \<longleftrightarrow> [a = b] (mod m)"
     by (simp add: cong_altdef_nat')
   finally show ?thesis .
 qed
 
 lemma cong_mult_lcancel_nat:
   "[k * a = k * b] (mod m) = [a = b] (mod m)"
   if "coprime k m" for a k m :: nat
   using that by (simp add: cong_mult_rcancel_nat ac_simps)
 
 lemma coprime_cong_mult_nat:
   "[a = b] (mod m) \<Longrightarrow> [a = b] (mod n) \<Longrightarrow> coprime m n \<Longrightarrow> [a = b] (mod m * n)"
   for a b :: nat
   by (simp add: cong_altdef_nat' divides_mult)
 
 lemma cong_less_imp_eq_nat: "0 \<le> a \<Longrightarrow> a < m \<Longrightarrow> 0 \<le> b \<Longrightarrow> b < m \<Longrightarrow> [a = b] (mod m) \<Longrightarrow> a = b"
   for a b :: nat
   by (auto simp add: cong_def)
 
 lemma cong_less_imp_eq_int: "0 \<le> a \<Longrightarrow> a < m \<Longrightarrow> 0 \<le> b \<Longrightarrow> b < m \<Longrightarrow> [a = b] (mod m) \<Longrightarrow> a = b"
   for a b :: int
   by (auto simp add: cong_def)
 
 lemma cong_less_unique_nat: "0 < m \<Longrightarrow> (\<exists>!b. 0 \<le> b \<and> b < m \<and> [a = b] (mod m))"
   for a m :: nat
   by (auto simp: cong_def) (metis mod_less_divisor mod_mod_trivial)
 
 lemma cong_less_unique_int: "0 < m \<Longrightarrow> (\<exists>!b. 0 \<le> b \<and> b < m \<and> [a = b] (mod m))"
   for a m :: int
   by (auto simp: cong_def)  (metis mod_mod_trivial pos_mod_conj)
 
-lemma cong_iff_lin_nat: "([a = b] (mod m)) \<longleftrightarrow> (\<exists>k1 k2. b + k1 * m = a + k2 * m)"
-  (is "?lhs = ?rhs")
+lemma cong_iff_lin_nat: "[a = b] (mod m) \<longleftrightarrow> (\<exists>k1 k2. b + k1 * m = a + k2 * m)"
   for a b :: nat
-proof
-  assume ?lhs
-  show ?rhs
-  proof (cases "b \<le> a")
-    case True
-    with \<open>?lhs\<close> show ?rhs
-      by (metis cong_altdef_nat dvd_def le_add_diff_inverse add_0_right mult_0 mult.commute)
-  next
-    case False
-    with \<open>?lhs\<close> show ?rhs
-      by (metis cong_def mult.commute nat_le_linear nat_mod_eq_lemma)
-  qed
-next
-  assume ?rhs
-  then show ?lhs
-    by (metis cong_def mult.commute nat_mod_eq_iff) 
-qed
+  apply (auto simp add: cong_def nat_mod_eq_iff)
+   apply (metis mult.commute)
+  apply (metis mult.commute)
+  done
 
 lemma cong_cong_mod_nat: "[a = b] (mod m) \<longleftrightarrow> [a mod m = b mod m] (mod m)"
   for a b :: nat
   by simp
 
 lemma cong_cong_mod_int: "[a = b] (mod m) \<longleftrightarrow> [a mod m = b mod m] (mod m)"
   for a b :: int
   by simp
 
 lemma cong_add_lcancel_nat: "[a + x = a + y] (mod n) \<longleftrightarrow> [x = y] (mod n)"
   for a x y :: nat
   by (simp add: cong_iff_lin_nat)
 
 lemma cong_add_rcancel_nat: "[x + a = y + a] (mod n) \<longleftrightarrow> [x = y] (mod n)"
   for a x y :: nat
   by (simp add: cong_iff_lin_nat)
 
 lemma cong_add_lcancel_0_nat: "[a + x = a] (mod n) \<longleftrightarrow> [x = 0] (mod n)"
   for a x :: nat
   using cong_add_lcancel_nat [of a x 0 n] by simp
 
 lemma cong_add_rcancel_0_nat: "[x + a = a] (mod n) \<longleftrightarrow> [x = 0] (mod n)"
   for a x :: nat
   using cong_add_rcancel_nat [of x a 0 n] by simp
 
 lemma cong_dvd_modulus_nat: "[x = y] (mod m) \<Longrightarrow> n dvd m \<Longrightarrow> [x = y] (mod n)"
   for x y :: nat
-  unfolding cong_iff_lin_nat dvd_def
-  by (metis mult.commute mult.left_commute)
+  by (auto simp add: cong_altdef_nat')
 
 lemma cong_to_1_nat:
   fixes a :: nat
   assumes "[a = 1] (mod n)"
   shows "n dvd (a - 1)"
 proof (cases "a = 0")
   case True
   then show ?thesis by force
 next
   case False
   with assms show ?thesis by (metis cong_altdef_nat leI less_one)
 qed
 
 lemma cong_0_1_nat': "[0 = Suc 0] (mod n) \<longleftrightarrow> n = Suc 0"
   by (auto simp: cong_def)
 
 lemma cong_0_1_nat: "[0 = 1] (mod n) \<longleftrightarrow> n = 1"
   for n :: nat
   by (auto simp: cong_def)
 
 lemma cong_0_1_int: "[0 = 1] (mod n) \<longleftrightarrow> n = 1 \<or> n = - 1"
   for n :: int
   by (auto simp: cong_def zmult_eq_1_iff)
 
 lemma cong_to_1'_nat: "[a = 1] (mod n) \<longleftrightarrow> a = 0 \<and> n = 1 \<or> (\<exists>m. a = 1 + m * n)"
   for a :: nat
   by (metis add.right_neutral cong_0_1_nat cong_iff_lin_nat cong_to_1_nat
       dvd_div_mult_self leI le_add_diff_inverse less_one mult_eq_if)
 
 lemma cong_le_nat: "y \<le> x \<Longrightarrow> [x = y] (mod n) \<longleftrightarrow> (\<exists>q. x = q * n + y)"
   for x y :: nat
-  by (auto simp add: cong_altdef_nat le_imp_diff_is_add elim!: dvdE)
-
+  by (auto simp add: cong_altdef_nat le_imp_diff_is_add)
 
 lemma cong_solve_nat:
   fixes a :: nat
   shows "\<exists>x. [a * x = gcd a n] (mod n)"
 proof (cases "a = 0 \<or> n = 0")
   case True
   then show ?thesis
     by (force simp add: cong_0_iff cong_sym)
 next
   case False
   then show ?thesis
     using bezout_nat [of a n]
     by auto (metis cong_add_rcancel_0_nat cong_mult_self_left)
 qed
 
 lemma cong_solve_int:
   fixes a :: int
   shows "\<exists>x. [a * x = gcd a n] (mod n)"
     by (metis bezout_int cong_iff_lin mult.commute)
 
 lemma cong_solve_dvd_nat:
   fixes a :: nat
   assumes "gcd a n dvd d"
   shows "\<exists>x. [a * x = d] (mod n)"
 proof -
   from cong_solve_nat [of a] obtain x where "[a * x = gcd a n](mod n)"
     by auto
   then have "[(d div gcd a n) * (a * x) = (d div gcd a n) * gcd a n] (mod n)"
     using cong_scalar_left by blast
   also from assms have "(d div gcd a n) * gcd a n = d"
     by (rule dvd_div_mult_self)
   also have "(d div gcd a n) * (a * x) = a * (d div gcd a n * x)"
     by auto
   finally show ?thesis
     by auto
 qed
 
 lemma cong_solve_dvd_int:
   fixes a::int
   assumes b: "gcd a n dvd d"
   shows "\<exists>x. [a * x = d] (mod n)"
 proof -
   from cong_solve_int [of a] obtain x where "[a * x = gcd a n](mod n)"
     by auto
   then have "[(d div gcd a n) * (a * x) = (d div gcd a n) * gcd a n] (mod n)"
     using cong_scalar_left by blast
   also from b have "(d div gcd a n) * gcd a n = d"
     by (rule dvd_div_mult_self)
   also have "(d div gcd a n) * (a * x) = a * (d div gcd a n * x)"
     by auto
   finally show ?thesis
     by auto
 qed
 
 lemma cong_solve_coprime_nat:
   "\<exists>x. [a * x = Suc 0] (mod n)" if "coprime a n"
   using that cong_solve_nat [of a n] by auto
 
 lemma cong_solve_coprime_int:
   "\<exists>x. [a * x = 1] (mod n)" if "coprime a n" for a n x :: int
   using that cong_solve_int [of a n] by (auto simp add: zabs_def split: if_splits)
 
 lemma coprime_iff_invertible_nat:
   "coprime a m \<longleftrightarrow> (\<exists>x. [a * x = Suc 0] (mod m))" (is "?P \<longleftrightarrow> ?Q")
 proof
   assume ?P then show ?Q
     by (auto dest!: cong_solve_coprime_nat)
 next
   assume ?Q
   then obtain b where "[a * b = Suc 0] (mod m)"
     by blast
   with coprime_mod_left_iff [of m "a * b"] show ?P
     by (cases "m = 0 \<or> m = 1")
       (unfold cong_def, auto simp add: cong_def)
 qed
 
 lemma coprime_iff_invertible_int:
   "coprime a m \<longleftrightarrow> (\<exists>x. [a * x = 1] (mod m))" (is "?P \<longleftrightarrow> ?Q") for m :: int
 proof
   assume ?P then show ?Q
     by (auto dest: cong_solve_coprime_int)
 next
   assume ?Q
   then obtain b where "[a * b = 1] (mod m)"
     by blast
   with coprime_mod_left_iff [of m "a * b"] show ?P
     by (cases "m = 0 \<or> m = 1")
       (unfold cong_def, auto simp add: zmult_eq_1_iff)
 qed
 
 lemma coprime_iff_invertible'_nat:
   assumes "m > 0"
   shows "coprime a m \<longleftrightarrow> (\<exists>x. 0 \<le> x \<and> x < m \<and> [a * x = Suc 0] (mod m))"
 proof -
   have "\<And>b. \<lbrakk>0 < m; [a * b = Suc 0] (mod m)\<rbrakk> \<Longrightarrow> \<exists>b'<m. [a * b' = Suc 0] (mod m)"
     by (metis cong_def mod_less_divisor [OF assms] mod_mult_right_eq)
   then show ?thesis
     using assms coprime_iff_invertible_nat by auto
 qed
 
 lemma coprime_iff_invertible'_int:
   fixes m :: int
   assumes "m > 0"
   shows "coprime a m \<longleftrightarrow> (\<exists>x. 0 \<le> x \<and> x < m \<and> [a * x = 1] (mod m))"
 proof -
   have "\<And>b. \<lbrakk>0 < m; [a * b = 1] (mod m)\<rbrakk> \<Longrightarrow> \<exists>b'<m. [a * b' = 1] (mod m)"
     by (meson cong_less_unique_int cong_scalar_left cong_sym cong_trans)
   then show ?thesis
     by (metis assms coprime_iff_invertible_int cong_def cong_mult_lcancel mod_pos_pos_trivial pos_mod_conj)
 qed
 
 lemma cong_cong_lcm_nat: "[x = y] (mod a) \<Longrightarrow> [x = y] (mod b) \<Longrightarrow> [x = y] (mod lcm a b)"
   for x y :: nat
   by (meson cong_altdef_nat' lcm_least)
 
 lemma cong_cong_lcm_int: "[x = y] (mod a) \<Longrightarrow> [x = y] (mod b) \<Longrightarrow> [x = y] (mod lcm a b)"
   for x y :: int
   by (auto simp add: cong_iff_dvd_diff lcm_least)
 
 lemma cong_cong_prod_coprime_nat:
   "[x = y] (mod (\<Prod>i\<in>A. m i))" if
     "(\<forall>i\<in>A. [x = y] (mod m i))"
     "(\<forall>i\<in>A. (\<forall>j\<in>A. i \<noteq> j \<longrightarrow> coprime (m i) (m j)))"
   for x y :: nat
   using that by (induct A rule: infinite_finite_induct)
     (auto intro!: coprime_cong_mult_nat prod_coprime_right)
 
 lemma binary_chinese_remainder_nat:
   fixes m1 m2 :: nat
   assumes a: "coprime m1 m2"
   shows "\<exists>x. [x = u1] (mod m1) \<and> [x = u2] (mod m2)"
 proof -
   have "\<exists>b1 b2. [b1 = 1] (mod m1) \<and> [b1 = 0] (mod m2) \<and> [b2 = 0] (mod m1) \<and> [b2 = 1] (mod m2)"
   proof -
     from cong_solve_coprime_nat [OF a] obtain x1 where 1: "[m1 * x1 = 1] (mod m2)"
       by auto
     from a have b: "coprime m2 m1"
       by (simp add: ac_simps)
     from cong_solve_coprime_nat [OF b] obtain x2 where 2: "[m2 * x2 = 1] (mod m1)"
       by auto
     have "[m1 * x1 = 0] (mod m1)"
       by (simp add: cong_mult_self_left)
     moreover have "[m2 * x2 = 0] (mod m2)"
       by (simp add: cong_mult_self_left)
     ultimately show ?thesis
       using 1 2 by blast
   qed
   then obtain b1 b2
     where "[b1 = 1] (mod m1)" and "[b1 = 0] (mod m2)"
       and "[b2 = 0] (mod m1)" and "[b2 = 1] (mod m2)"
     by blast
   let ?x = "u1 * b1 + u2 * b2"
   have "[?x = u1 * 1 + u2 * 0] (mod m1)"
     using \<open>[b1 = 1] (mod m1)\<close> \<open>[b2 = 0] (mod m1)\<close> cong_add cong_scalar_left by blast
   then have "[?x = u1] (mod m1)" by simp
   have "[?x = u1 * 0 + u2 * 1] (mod m2)"
     using \<open>[b1 = 0] (mod m2)\<close> \<open>[b2 = 1] (mod m2)\<close> cong_add cong_scalar_left by blast
   then have "[?x = u2] (mod m2)"
     by simp
   with \<open>[?x = u1] (mod m1)\<close> show ?thesis
     by blast
 qed
 
 lemma binary_chinese_remainder_int:
   fixes m1 m2 :: int
   assumes a: "coprime m1 m2"
   shows "\<exists>x. [x = u1] (mod m1) \<and> [x = u2] (mod m2)"
 proof -
   have "\<exists>b1 b2. [b1 = 1] (mod m1) \<and> [b1 = 0] (mod m2) \<and> [b2 = 0] (mod m1) \<and> [b2 = 1] (mod m2)"
   proof -
     from cong_solve_coprime_int [OF a] obtain x1 where 1: "[m1 * x1 = 1] (mod m2)"
       by auto
     from a have b: "coprime m2 m1"
       by (simp add: ac_simps)
     from cong_solve_coprime_int [OF b] obtain x2 where 2: "[m2 * x2 = 1] (mod m1)"
       by auto
     have "[m1 * x1 = 0] (mod m1)"
      by (simp add: cong_mult_self_left)
     moreover have "[m2 * x2 = 0] (mod m2)"
       by (simp add: cong_mult_self_left)
     ultimately show ?thesis
       using 1 2 by blast
   qed
   then obtain b1 b2
     where "[b1 = 1] (mod m1)" and "[b1 = 0] (mod m2)"
       and "[b2 = 0] (mod m1)" and "[b2 = 1] (mod m2)"
     by blast
   let ?x = "u1 * b1 + u2 * b2"
   have "[?x = u1 * 1 + u2 * 0] (mod m1)"
     using \<open>[b1 = 1] (mod m1)\<close> \<open>[b2 = 0] (mod m1)\<close> cong_add cong_scalar_left by blast
   then have "[?x = u1] (mod m1)" by simp
   have "[?x = u1 * 0 + u2 * 1] (mod m2)"
     using \<open>[b1 = 0] (mod m2)\<close> \<open>[b2 = 1] (mod m2)\<close> cong_add cong_scalar_left by blast
   then have "[?x = u2] (mod m2)" by simp
   with \<open>[?x = u1] (mod m1)\<close> show ?thesis
     by blast
 qed
 
 lemma cong_modulus_mult_nat: "[x = y] (mod m * n) \<Longrightarrow> [x = y] (mod m)"
   for x y :: nat
   by (metis cong_def mod_mult_cong_right)
 
 lemma cong_less_modulus_unique_nat: "[x = y] (mod m) \<Longrightarrow> x < m \<Longrightarrow> y < m \<Longrightarrow> x = y"
   for x y :: nat
   by (simp add: cong_def)
 
 lemma binary_chinese_remainder_unique_nat:
   fixes m1 m2 :: nat
   assumes a: "coprime m1 m2"
     and nz: "m1 \<noteq> 0" "m2 \<noteq> 0"
   shows "\<exists>!x. x < m1 * m2 \<and> [x = u1] (mod m1) \<and> [x = u2] (mod m2)"
 proof -
   obtain y where y1: "[y = u1] (mod m1)" and y2: "[y = u2] (mod m2)"
     using binary_chinese_remainder_nat [OF a] by blast
   let ?x = "y mod (m1 * m2)"
   from nz have less: "?x < m1 * m2"
     by auto
   have 1: "[?x = u1] (mod m1)"
     using y1 mod_mult_cong_right by blast
   have 2: "[?x = u2] (mod m2)"
     using y2 mod_mult_cong_left by blast
   have "z = ?x" if "z < m1 * m2" "[z = u1] (mod m1)"  "[z = u2] (mod m2)" for z
   proof -
     have "[?x = z] (mod m1)"
       by (metis "1" cong_def that(2))
     moreover have "[?x = z] (mod m2)"
       by (metis "2" cong_def that(3))
     ultimately have "[?x = z] (mod m1 * m2)"
       using a by (auto intro: coprime_cong_mult_nat simp add: mod_mult_cong_left mod_mult_cong_right)
     with \<open>z < m1 * m2\<close> \<open>?x < m1 * m2\<close> show "z = ?x"
       by (auto simp add: cong_def)
   qed
   with less 1 2 show ?thesis
     by blast
  qed
 
 lemma chinese_remainder_nat:
   fixes A :: "'a set"
     and m :: "'a \<Rightarrow> nat"
     and u :: "'a \<Rightarrow> nat"
   assumes fin: "finite A"
     and cop: "\<forall>i \<in> A. \<forall>j \<in> A. i \<noteq> j \<longrightarrow> coprime (m i) (m j)"
   shows "\<exists>x. \<forall>i \<in> A. [x = u i] (mod m i)"
 proof -
   have "\<exists>b. (\<forall>i \<in> A. [b i = 1] (mod m i) \<and> [b i = 0] (mod (\<Prod>j \<in> A - {i}. m j)))"
   proof (rule finite_set_choice, rule fin, rule ballI)
     fix i
     assume "i \<in> A"
     with cop have "coprime (\<Prod>j \<in> A - {i}. m j) (m i)"
       by (intro prod_coprime_left) auto
     then have "\<exists>x. [(\<Prod>j \<in> A - {i}. m j) * x = Suc 0] (mod m i)"
       by (elim cong_solve_coprime_nat)
     then obtain x where "[(\<Prod>j \<in> A - {i}. m j) * x = 1] (mod m i)"
       by auto
     moreover have "[(\<Prod>j \<in> A - {i}. m j) * x = 0] (mod (\<Prod>j \<in> A - {i}. m j))"
       by (simp add: cong_0_iff)
     ultimately show "\<exists>a. [a = 1] (mod m i) \<and> [a = 0] (mod prod m (A - {i}))"
       by blast
   qed
   then obtain b where b: "\<And>i. i \<in> A \<Longrightarrow> [b i = 1] (mod m i) \<and> [b i = 0] (mod (\<Prod>j \<in> A - {i}. m j))"
     by blast
   let ?x = "\<Sum>i\<in>A. (u i) * (b i)"
   show ?thesis
   proof (rule exI, clarify)
     fix i
     assume a: "i \<in> A"
     show "[?x = u i] (mod m i)"
     proof -
       from fin a have "?x = (\<Sum>j \<in> {i}. u j * b j) + (\<Sum>j \<in> A - {i}. u j * b j)"
         by (subst sum.union_disjoint [symmetric]) (auto intro: sum.cong)
       then have "[?x = u i * b i + (\<Sum>j \<in> A - {i}. u j * b j)] (mod m i)"
         by auto
       also have "[u i * b i + (\<Sum>j \<in> A - {i}. u j * b j) =
                   u i * 1 + (\<Sum>j \<in> A - {i}. u j * 0)] (mod m i)"
       proof (intro cong_add cong_scalar_left cong_sum)
         show "[b i = 1] (mod m i)"
           using a b by blast
         show "[b x = 0] (mod m i)" if "x \<in> A - {i}" for x
         proof -
           have "x \<in> A" "x \<noteq> i"
             using that by auto
           then show ?thesis
             using a b [OF \<open>x \<in> A\<close>] cong_dvd_modulus_nat fin by blast
         qed
       qed
       finally show ?thesis
         by simp
     qed
   qed
 qed
 
 lemma coprime_cong_prod_nat: "[x = y] (mod (\<Prod>i\<in>A. m i))"
   if "\<And>i j. \<lbrakk>i \<in> A; j \<in> A; i \<noteq> j\<rbrakk> \<Longrightarrow> coprime (m i) (m j)"
     and "\<And>i. i \<in> A \<Longrightarrow> [x = y] (mod m i)" for x y :: nat
   using that 
 proof (induct A rule: infinite_finite_induct)
   case (insert x A)
   then show ?case
     by simp (metis coprime_cong_mult_nat prod_coprime_right)
 qed auto
 
 lemma chinese_remainder_unique_nat:
   fixes A :: "'a set"
     and m :: "'a \<Rightarrow> nat"
     and u :: "'a \<Rightarrow> nat"
   assumes fin: "finite A"
     and nz: "\<forall>i\<in>A. m i \<noteq> 0"
     and cop: "\<forall>i\<in>A. \<forall>j\<in>A. i \<noteq> j \<longrightarrow> coprime (m i) (m j)"
   shows "\<exists>!x. x < (\<Prod>i\<in>A. m i) \<and> (\<forall>i\<in>A. [x = u i] (mod m i))"
 proof -
   from chinese_remainder_nat [OF fin cop]
   obtain y where one: "(\<forall>i\<in>A. [y = u i] (mod m i))"
     by blast
   let ?x = "y mod (\<Prod>i\<in>A. m i)"
   from fin nz have prodnz: "(\<Prod>i\<in>A. m i) \<noteq> 0"
     by auto
   then have less: "?x < (\<Prod>i\<in>A. m i)"
     by auto
   have cong: "\<forall>i\<in>A. [?x = u i] (mod m i)"
     using fin one
     by (auto simp add: cong_def dvd_prod_eqI mod_mod_cancel) 
   have unique: "\<forall>z. z < (\<Prod>i\<in>A. m i) \<and> (\<forall>i\<in>A. [z = u i] (mod m i)) \<longrightarrow> z = ?x"
   proof clarify
     fix z
     assume zless: "z < (\<Prod>i\<in>A. m i)"
     assume zcong: "(\<forall>i\<in>A. [z = u i] (mod m i))"
     have "\<forall>i\<in>A. [?x = z] (mod m i)"
       using cong zcong by (auto simp add: cong_def)
     with fin cop have "[?x = z] (mod (\<Prod>i\<in>A. m i))"
       by (intro coprime_cong_prod_nat) auto
     with zless less show "z = ?x"
       by (auto simp add: cong_def)
   qed
   from less cong unique show ?thesis
     by blast
 qed
 
 end
diff --git a/src/HOL/Numeral_Simprocs.thy b/src/HOL/Numeral_Simprocs.thy
--- a/src/HOL/Numeral_Simprocs.thy
+++ b/src/HOL/Numeral_Simprocs.thy
@@ -1,299 +1,299 @@
 (* Author: Various *)
 
 section \<open>Combination and Cancellation Simprocs for Numeral Expressions\<close>
 
 theory Numeral_Simprocs
-imports Divides
+imports Parity
 begin
 
 ML_file \<open>~~/src/Provers/Arith/assoc_fold.ML\<close>
 ML_file \<open>~~/src/Provers/Arith/cancel_numerals.ML\<close>
 ML_file \<open>~~/src/Provers/Arith/combine_numerals.ML\<close>
 ML_file \<open>~~/src/Provers/Arith/cancel_numeral_factor.ML\<close>
 ML_file \<open>~~/src/Provers/Arith/extract_common_term.ML\<close>
 
 lemmas semiring_norm =
   Let_def arith_simps diff_nat_numeral rel_simps
   if_False if_True
   add_Suc add_numeral_left
   add_neg_numeral_left mult_numeral_left
   numeral_One [symmetric] uminus_numeral_One [symmetric] Suc_eq_plus1
   eq_numeral_iff_iszero not_iszero_Numeral1
 
 text \<open>For \<open>combine_numerals\<close>\<close>
 
 lemma left_add_mult_distrib: "i*u + (j*u + k) = (i+j)*u + (k::nat)"
 by (simp add: add_mult_distrib)
 
 text \<open>For \<open>cancel_numerals\<close>\<close>
 
 lemma nat_diff_add_eq1:
      "j <= (i::nat) ==> ((i*u + m) - (j*u + n)) = (((i-j)*u + m) - n)"
 by (simp split: nat_diff_split add: add_mult_distrib)
 
 lemma nat_diff_add_eq2:
      "i <= (j::nat) ==> ((i*u + m) - (j*u + n)) = (m - ((j-i)*u + n))"
 by (simp split: nat_diff_split add: add_mult_distrib)
 
 lemma nat_eq_add_iff1:
      "j <= (i::nat) ==> (i*u + m = j*u + n) = ((i-j)*u + m = n)"
 by (auto split: nat_diff_split simp add: add_mult_distrib)
 
 lemma nat_eq_add_iff2:
      "i <= (j::nat) ==> (i*u + m = j*u + n) = (m = (j-i)*u + n)"
 by (auto split: nat_diff_split simp add: add_mult_distrib)
 
 lemma nat_less_add_iff1:
      "j <= (i::nat) ==> (i*u + m < j*u + n) = ((i-j)*u + m < n)"
 by (auto split: nat_diff_split simp add: add_mult_distrib)
 
 lemma nat_less_add_iff2:
      "i <= (j::nat) ==> (i*u + m < j*u + n) = (m < (j-i)*u + n)"
 by (auto split: nat_diff_split simp add: add_mult_distrib)
 
 lemma nat_le_add_iff1:
      "j <= (i::nat) ==> (i*u + m <= j*u + n) = ((i-j)*u + m <= n)"
 by (auto split: nat_diff_split simp add: add_mult_distrib)
 
 lemma nat_le_add_iff2:
      "i <= (j::nat) ==> (i*u + m <= j*u + n) = (m <= (j-i)*u + n)"
 by (auto split: nat_diff_split simp add: add_mult_distrib)
 
 text \<open>For \<open>cancel_numeral_factors\<close>\<close>
 
 lemma nat_mult_le_cancel1: "(0::nat) < k ==> (k*m <= k*n) = (m<=n)"
 by auto
 
 lemma nat_mult_less_cancel1: "(0::nat) < k ==> (k*m < k*n) = (m<n)"
 by auto
 
 lemma nat_mult_eq_cancel1: "(0::nat) < k ==> (k*m = k*n) = (m=n)"
 by auto
 
 lemma nat_mult_div_cancel1: "(0::nat) < k ==> (k*m) div (k*n) = (m div n)"
 by auto
 
 lemma nat_mult_dvd_cancel_disj[simp]:
   "(k*m) dvd (k*n) = (k=0 \<or> m dvd (n::nat))"
 by (auto simp: dvd_eq_mod_eq_0 mod_mult_mult1)
 
 lemma nat_mult_dvd_cancel1: "0 < k \<Longrightarrow> (k*m) dvd (k*n::nat) = (m dvd n)"
 by(auto)
 
 text \<open>For \<open>cancel_factor\<close>\<close>
 
 lemmas nat_mult_le_cancel_disj = mult_le_cancel1
 
 lemmas nat_mult_less_cancel_disj = mult_less_cancel1
 
 lemma nat_mult_eq_cancel_disj:
   fixes k m n :: nat
   shows "k * m = k * n \<longleftrightarrow> k = 0 \<or> m = n"
   by (fact mult_cancel_left)
 
 lemma nat_mult_div_cancel_disj:
   fixes k m n :: nat
   shows "(k * m) div (k * n) = (if k = 0 then 0 else m div n)"
   by (fact div_mult_mult1_if)
 
 lemma numeral_times_minus_swap:
   fixes x:: "'a::comm_ring_1" shows  "numeral w * -x = x * - numeral w"
   by (simp add: ac_simps)
 
 ML_file \<open>Tools/numeral_simprocs.ML\<close>
 
 simproc_setup semiring_assoc_fold
   ("(a::'a::comm_semiring_1_cancel) * b") =
   \<open>fn phi => Numeral_Simprocs.assoc_fold\<close>
 
 (* TODO: see whether the type class can be generalized further *)
 simproc_setup int_combine_numerals
   ("(i::'a::comm_ring_1) + j" | "(i::'a::comm_ring_1) - j") =
   \<open>fn phi => Numeral_Simprocs.combine_numerals\<close>
 
 simproc_setup field_combine_numerals
   ("(i::'a::{field,ring_char_0}) + j"
   |"(i::'a::{field,ring_char_0}) - j") =
   \<open>fn phi => Numeral_Simprocs.field_combine_numerals\<close>
 
 simproc_setup inteq_cancel_numerals
   ("(l::'a::comm_ring_1) + m = n"
   |"(l::'a::comm_ring_1) = m + n"
   |"(l::'a::comm_ring_1) - m = n"
   |"(l::'a::comm_ring_1) = m - n"
   |"(l::'a::comm_ring_1) * m = n"
   |"(l::'a::comm_ring_1) = m * n"
   |"- (l::'a::comm_ring_1) = m"
   |"(l::'a::comm_ring_1) = - m") =
   \<open>fn phi => Numeral_Simprocs.eq_cancel_numerals\<close>
 
 simproc_setup intless_cancel_numerals
   ("(l::'a::linordered_idom) + m < n"
   |"(l::'a::linordered_idom) < m + n"
   |"(l::'a::linordered_idom) - m < n"
   |"(l::'a::linordered_idom) < m - n"
   |"(l::'a::linordered_idom) * m < n"
   |"(l::'a::linordered_idom) < m * n"
   |"- (l::'a::linordered_idom) < m"
   |"(l::'a::linordered_idom) < - m") =
   \<open>fn phi => Numeral_Simprocs.less_cancel_numerals\<close>
 
 simproc_setup intle_cancel_numerals
   ("(l::'a::linordered_idom) + m \<le> n"
   |"(l::'a::linordered_idom) \<le> m + n"
   |"(l::'a::linordered_idom) - m \<le> n"
   |"(l::'a::linordered_idom) \<le> m - n"
   |"(l::'a::linordered_idom) * m \<le> n"
   |"(l::'a::linordered_idom) \<le> m * n"
   |"- (l::'a::linordered_idom) \<le> m"
   |"(l::'a::linordered_idom) \<le> - m") =
   \<open>fn phi => Numeral_Simprocs.le_cancel_numerals\<close>
 
 simproc_setup ring_eq_cancel_numeral_factor
   ("(l::'a::{idom,ring_char_0}) * m = n"
   |"(l::'a::{idom,ring_char_0}) = m * n") =
   \<open>fn phi => Numeral_Simprocs.eq_cancel_numeral_factor\<close>
 
 simproc_setup ring_less_cancel_numeral_factor
   ("(l::'a::linordered_idom) * m < n"
   |"(l::'a::linordered_idom) < m * n") =
   \<open>fn phi => Numeral_Simprocs.less_cancel_numeral_factor\<close>
 
 simproc_setup ring_le_cancel_numeral_factor
   ("(l::'a::linordered_idom) * m <= n"
   |"(l::'a::linordered_idom) <= m * n") =
   \<open>fn phi => Numeral_Simprocs.le_cancel_numeral_factor\<close>
 
 (* TODO: remove comm_ring_1 constraint if possible *)
 simproc_setup int_div_cancel_numeral_factors
   ("((l::'a::{euclidean_semiring_cancel,comm_ring_1,ring_char_0}) * m) div n"
   |"(l::'a::{euclidean_semiring_cancel,comm_ring_1,ring_char_0}) div (m * n)") =
   \<open>fn phi => Numeral_Simprocs.div_cancel_numeral_factor\<close>
 
 simproc_setup divide_cancel_numeral_factor
   ("((l::'a::{field,ring_char_0}) * m) / n"
   |"(l::'a::{field,ring_char_0}) / (m * n)"
   |"((numeral v)::'a::{field,ring_char_0}) / (numeral w)") =
   \<open>fn phi => Numeral_Simprocs.divide_cancel_numeral_factor\<close>
 
 simproc_setup ring_eq_cancel_factor
   ("(l::'a::idom) * m = n" | "(l::'a::idom) = m * n") =
   \<open>fn phi => Numeral_Simprocs.eq_cancel_factor\<close>
 
 simproc_setup linordered_ring_le_cancel_factor
   ("(l::'a::linordered_idom) * m <= n"
   |"(l::'a::linordered_idom) <= m * n") =
   \<open>fn phi => Numeral_Simprocs.le_cancel_factor\<close>
 
 simproc_setup linordered_ring_less_cancel_factor
   ("(l::'a::linordered_idom) * m < n"
   |"(l::'a::linordered_idom) < m * n") =
   \<open>fn phi => Numeral_Simprocs.less_cancel_factor\<close>
 
 simproc_setup int_div_cancel_factor
   ("((l::'a::euclidean_semiring_cancel) * m) div n"
   |"(l::'a::euclidean_semiring_cancel) div (m * n)") =
   \<open>fn phi => Numeral_Simprocs.div_cancel_factor\<close>
 
 simproc_setup int_mod_cancel_factor
   ("((l::'a::euclidean_semiring_cancel) * m) mod n"
   |"(l::'a::euclidean_semiring_cancel) mod (m * n)") =
   \<open>fn phi => Numeral_Simprocs.mod_cancel_factor\<close>
 
 simproc_setup dvd_cancel_factor
   ("((l::'a::idom) * m) dvd n"
   |"(l::'a::idom) dvd (m * n)") =
   \<open>fn phi => Numeral_Simprocs.dvd_cancel_factor\<close>
 
 simproc_setup divide_cancel_factor
   ("((l::'a::field) * m) / n"
   |"(l::'a::field) / (m * n)") =
   \<open>fn phi => Numeral_Simprocs.divide_cancel_factor\<close>
 
 ML_file \<open>Tools/nat_numeral_simprocs.ML\<close>
 
 simproc_setup nat_combine_numerals
   ("(i::nat) + j" | "Suc (i + j)") =
   \<open>fn phi => Nat_Numeral_Simprocs.combine_numerals\<close>
 
 simproc_setup nateq_cancel_numerals
   ("(l::nat) + m = n" | "(l::nat) = m + n" |
    "(l::nat) * m = n" | "(l::nat) = m * n" |
    "Suc m = n" | "m = Suc n") =
   \<open>fn phi => Nat_Numeral_Simprocs.eq_cancel_numerals\<close>
 
 simproc_setup natless_cancel_numerals
   ("(l::nat) + m < n" | "(l::nat) < m + n" |
    "(l::nat) * m < n" | "(l::nat) < m * n" |
    "Suc m < n" | "m < Suc n") =
   \<open>fn phi => Nat_Numeral_Simprocs.less_cancel_numerals\<close>
 
 simproc_setup natle_cancel_numerals
   ("(l::nat) + m \<le> n" | "(l::nat) \<le> m + n" |
    "(l::nat) * m \<le> n" | "(l::nat) \<le> m * n" |
    "Suc m \<le> n" | "m \<le> Suc n") =
   \<open>fn phi => Nat_Numeral_Simprocs.le_cancel_numerals\<close>
 
 simproc_setup natdiff_cancel_numerals
   ("((l::nat) + m) - n" | "(l::nat) - (m + n)" |
    "(l::nat) * m - n" | "(l::nat) - m * n" |
    "Suc m - n" | "m - Suc n") =
   \<open>fn phi => Nat_Numeral_Simprocs.diff_cancel_numerals\<close>
 
 simproc_setup nat_eq_cancel_numeral_factor
   ("(l::nat) * m = n" | "(l::nat) = m * n") =
   \<open>fn phi => Nat_Numeral_Simprocs.eq_cancel_numeral_factor\<close>
 
 simproc_setup nat_less_cancel_numeral_factor
   ("(l::nat) * m < n" | "(l::nat) < m * n") =
   \<open>fn phi => Nat_Numeral_Simprocs.less_cancel_numeral_factor\<close>
 
 simproc_setup nat_le_cancel_numeral_factor
   ("(l::nat) * m <= n" | "(l::nat) <= m * n") =
   \<open>fn phi => Nat_Numeral_Simprocs.le_cancel_numeral_factor\<close>
 
 simproc_setup nat_div_cancel_numeral_factor
   ("((l::nat) * m) div n" | "(l::nat) div (m * n)") =
   \<open>fn phi => Nat_Numeral_Simprocs.div_cancel_numeral_factor\<close>
 
 simproc_setup nat_dvd_cancel_numeral_factor
   ("((l::nat) * m) dvd n" | "(l::nat) dvd (m * n)") =
   \<open>fn phi => Nat_Numeral_Simprocs.dvd_cancel_numeral_factor\<close>
 
 simproc_setup nat_eq_cancel_factor
   ("(l::nat) * m = n" | "(l::nat) = m * n") =
   \<open>fn phi => Nat_Numeral_Simprocs.eq_cancel_factor\<close>
 
 simproc_setup nat_less_cancel_factor
   ("(l::nat) * m < n" | "(l::nat) < m * n") =
   \<open>fn phi => Nat_Numeral_Simprocs.less_cancel_factor\<close>
 
 simproc_setup nat_le_cancel_factor
   ("(l::nat) * m <= n" | "(l::nat) <= m * n") =
   \<open>fn phi => Nat_Numeral_Simprocs.le_cancel_factor\<close>
 
 simproc_setup nat_div_cancel_factor
   ("((l::nat) * m) div n" | "(l::nat) div (m * n)") =
   \<open>fn phi => Nat_Numeral_Simprocs.div_cancel_factor\<close>
 
 simproc_setup nat_dvd_cancel_factor
   ("((l::nat) * m) dvd n" | "(l::nat) dvd (m * n)") =
   \<open>fn phi => Nat_Numeral_Simprocs.dvd_cancel_factor\<close>
 
 declaration \<open>
   K (Lin_Arith.add_simprocs
       [\<^simproc>\<open>semiring_assoc_fold\<close>,
        \<^simproc>\<open>int_combine_numerals\<close>,
        \<^simproc>\<open>inteq_cancel_numerals\<close>,
        \<^simproc>\<open>intless_cancel_numerals\<close>,
        \<^simproc>\<open>intle_cancel_numerals\<close>,
        \<^simproc>\<open>field_combine_numerals\<close>,
        \<^simproc>\<open>nat_combine_numerals\<close>,
        \<^simproc>\<open>nateq_cancel_numerals\<close>,
        \<^simproc>\<open>natless_cancel_numerals\<close>,
        \<^simproc>\<open>natle_cancel_numerals\<close>,
        \<^simproc>\<open>natdiff_cancel_numerals\<close>,
        Numeral_Simprocs.field_divide_cancel_numeral_factor])
 \<close>
 
 end
diff --git a/src/HOL/Set_Interval.thy b/src/HOL/Set_Interval.thy
--- a/src/HOL/Set_Interval.thy
+++ b/src/HOL/Set_Interval.thy
@@ -1,2615 +1,2615 @@
 (*  Title:      HOL/Set_Interval.thy
     Author:     Tobias Nipkow, Clemens Ballarin, Jeremy Avigad
 
 lessThan, greaterThan, atLeast, atMost and two-sided intervals
 
 Modern convention: Ixy stands for an interval where x and y
 describe the lower and upper bound and x,y : {c,o,i}
 where c = closed, o = open, i = infinite.
 Examples: Ico = {_ ..< _} and Ici = {_ ..}
 *)
 
 section \<open>Set intervals\<close>
 
 theory Set_Interval
-imports Divides
+imports Parity
 begin
 
 (* Belongs in Finite_Set but 2 is not available there *)
 lemma card_2_iff: "card S = 2 \<longleftrightarrow> (\<exists>x y. S = {x,y} \<and> x \<noteq> y)"
   by (auto simp: card_Suc_eq numeral_eq_Suc)
 
 lemma card_2_iff': "card S = 2 \<longleftrightarrow> (\<exists>x\<in>S. \<exists>y\<in>S. x \<noteq> y \<and> (\<forall>z\<in>S. z = x \<or> z = y))"
   by (auto simp: card_Suc_eq numeral_eq_Suc)
 
 lemma card_3_iff: "card S = 3 \<longleftrightarrow> (\<exists>x y z. S = {x,y,z} \<and> x \<noteq> y \<and> y \<noteq> z \<and> x \<noteq> z)"
   by (fastforce simp: card_Suc_eq numeral_eq_Suc)
 
 context ord
 begin
 
 definition
   lessThan    :: "'a => 'a set" ("(1{..<_})") where
   "{..<u} == {x. x < u}"
 
 definition
   atMost      :: "'a => 'a set" ("(1{.._})") where
   "{..u} == {x. x \<le> u}"
 
 definition
   greaterThan :: "'a => 'a set" ("(1{_<..})") where
   "{l<..} == {x. l<x}"
 
 definition
   atLeast     :: "'a => 'a set" ("(1{_..})") where
   "{l..} == {x. l\<le>x}"
 
 definition
   greaterThanLessThan :: "'a => 'a => 'a set"  ("(1{_<..<_})") where
   "{l<..<u} == {l<..} Int {..<u}"
 
 definition
   atLeastLessThan :: "'a => 'a => 'a set"      ("(1{_..<_})") where
   "{l..<u} == {l..} Int {..<u}"
 
 definition
   greaterThanAtMost :: "'a => 'a => 'a set"    ("(1{_<.._})") where
   "{l<..u} == {l<..} Int {..u}"
 
 definition
   atLeastAtMost :: "'a => 'a => 'a set"        ("(1{_.._})") where
   "{l..u} == {l..} Int {..u}"
 
 end
 
 
 text\<open>A note of warning when using \<^term>\<open>{..<n}\<close> on type \<^typ>\<open>nat\<close>: it is equivalent to \<^term>\<open>{0::nat..<n}\<close> but some lemmas involving
 \<^term>\<open>{m..<n}\<close> may not exist in \<^term>\<open>{..<n}\<close>-form as well.\<close>
 
 syntax (ASCII)
   "_UNION_le"   :: "'a => 'a => 'b set => 'b set"       ("(3UN _<=_./ _)" [0, 0, 10] 10)
   "_UNION_less" :: "'a => 'a => 'b set => 'b set"       ("(3UN _<_./ _)" [0, 0, 10] 10)
   "_INTER_le"   :: "'a => 'a => 'b set => 'b set"       ("(3INT _<=_./ _)" [0, 0, 10] 10)
   "_INTER_less" :: "'a => 'a => 'b set => 'b set"       ("(3INT _<_./ _)" [0, 0, 10] 10)
 
 syntax (latex output)
   "_UNION_le"   :: "'a \<Rightarrow> 'a => 'b set => 'b set"       ("(3\<Union>(\<open>unbreakable\<close>_ \<le> _)/ _)" [0, 0, 10] 10)
   "_UNION_less" :: "'a \<Rightarrow> 'a => 'b set => 'b set"       ("(3\<Union>(\<open>unbreakable\<close>_ < _)/ _)" [0, 0, 10] 10)
   "_INTER_le"   :: "'a \<Rightarrow> 'a => 'b set => 'b set"       ("(3\<Inter>(\<open>unbreakable\<close>_ \<le> _)/ _)" [0, 0, 10] 10)
   "_INTER_less" :: "'a \<Rightarrow> 'a => 'b set => 'b set"       ("(3\<Inter>(\<open>unbreakable\<close>_ < _)/ _)" [0, 0, 10] 10)
 
 syntax
   "_UNION_le"   :: "'a => 'a => 'b set => 'b set"       ("(3\<Union>_\<le>_./ _)" [0, 0, 10] 10)
   "_UNION_less" :: "'a => 'a => 'b set => 'b set"       ("(3\<Union>_<_./ _)" [0, 0, 10] 10)
   "_INTER_le"   :: "'a => 'a => 'b set => 'b set"       ("(3\<Inter>_\<le>_./ _)" [0, 0, 10] 10)
   "_INTER_less" :: "'a => 'a => 'b set => 'b set"       ("(3\<Inter>_<_./ _)" [0, 0, 10] 10)
 
 translations
   "\<Union>i\<le>n. A" \<rightleftharpoons> "\<Union>i\<in>{..n}. A"
   "\<Union>i<n. A" \<rightleftharpoons> "\<Union>i\<in>{..<n}. A"
   "\<Inter>i\<le>n. A" \<rightleftharpoons> "\<Inter>i\<in>{..n}. A"
   "\<Inter>i<n. A" \<rightleftharpoons> "\<Inter>i\<in>{..<n}. A"
 
 
 subsection \<open>Various equivalences\<close>
 
 lemma (in ord) lessThan_iff [iff]: "(i \<in> lessThan k) = (i<k)"
 by (simp add: lessThan_def)
 
 lemma Compl_lessThan [simp]:
     "!!k:: 'a::linorder. -lessThan k = atLeast k"
   by (auto simp add: lessThan_def atLeast_def)
 
 lemma single_Diff_lessThan [simp]: "!!k:: 'a::preorder. {k} - lessThan k = {k}"
   by auto
 
 lemma (in ord) greaterThan_iff [iff]: "(i \<in> greaterThan k) = (k<i)"
   by (simp add: greaterThan_def)
 
 lemma Compl_greaterThan [simp]:
     "!!k:: 'a::linorder. -greaterThan k = atMost k"
   by (auto simp add: greaterThan_def atMost_def)
 
 lemma Compl_atMost [simp]: "!!k:: 'a::linorder. -atMost k = greaterThan k"
   by (metis Compl_greaterThan double_complement)
 
 lemma (in ord) atLeast_iff [iff]: "(i \<in> atLeast k) = (k<=i)"
   by (simp add: atLeast_def)
 
 lemma Compl_atLeast [simp]: "!!k:: 'a::linorder. -atLeast k = lessThan k"
   by (auto simp add: lessThan_def atLeast_def)
 
 lemma (in ord) atMost_iff [iff]: "(i \<in> atMost k) = (i<=k)"
 by (simp add: atMost_def)
 
 lemma atMost_Int_atLeast: "!!n:: 'a::order. atMost n Int atLeast n = {n}"
 by (blast intro: order_antisym)
 
 lemma (in linorder) lessThan_Int_lessThan: "{ a <..} \<inter> { b <..} = { max a b <..}"
   by auto
 
 lemma (in linorder) greaterThan_Int_greaterThan: "{..< a} \<inter> {..< b} = {..< min a b}"
   by auto
 
 subsection \<open>Logical Equivalences for Set Inclusion and Equality\<close>
 
 lemma atLeast_empty_triv [simp]: "{{}..} = UNIV"
   by auto
 
 lemma atMost_UNIV_triv [simp]: "{..UNIV} = UNIV"
   by auto
 
 lemma atLeast_subset_iff [iff]:
   "(atLeast x \<subseteq> atLeast y) = (y \<le> (x::'a::preorder))"
   by (blast intro: order_trans)
 
 lemma atLeast_eq_iff [iff]:
   "(atLeast x = atLeast y) = (x = (y::'a::order))"
   by (blast intro: order_antisym order_trans)
 
 lemma greaterThan_subset_iff [iff]:
   "(greaterThan x \<subseteq> greaterThan y) = (y \<le> (x::'a::linorder))"
   unfolding greaterThan_def by (auto simp: linorder_not_less [symmetric])
 
 lemma greaterThan_eq_iff [iff]:
      "(greaterThan x = greaterThan y) = (x = (y::'a::linorder))"
   by (auto simp: elim!: equalityE)
 
 lemma atMost_subset_iff [iff]: "(atMost x \<subseteq> atMost y) = (x \<le> (y::'a::preorder))"
   by (blast intro: order_trans)
 
 lemma atMost_eq_iff [iff]: "(atMost x = atMost y) = (x = (y::'a::order))"
   by (blast intro: order_antisym order_trans)
 
 lemma lessThan_subset_iff [iff]:
      "(lessThan x \<subseteq> lessThan y) = (x \<le> (y::'a::linorder))"
   unfolding lessThan_def by (auto simp: linorder_not_less [symmetric])
 
 lemma lessThan_eq_iff [iff]:
      "(lessThan x = lessThan y) = (x = (y::'a::linorder))"
   by (auto simp: elim!: equalityE)
 
 lemma lessThan_strict_subset_iff:
   fixes m n :: "'a::linorder"
   shows "{..<m} < {..<n} \<longleftrightarrow> m < n"
   by (metis leD lessThan_subset_iff linorder_linear not_less_iff_gr_or_eq psubset_eq)
 
 lemma (in linorder) Ici_subset_Ioi_iff: "{a ..} \<subseteq> {b <..} \<longleftrightarrow> b < a"
   by auto
 
 lemma (in linorder) Iic_subset_Iio_iff: "{.. a} \<subseteq> {..< b} \<longleftrightarrow> a < b"
   by auto
 
 lemma (in preorder) Ioi_le_Ico: "{a <..} \<subseteq> {a ..}"
   by (auto intro: less_imp_le)
 
 subsection \<open>Two-sided intervals\<close>
 
 context ord
 begin
 
 lemma greaterThanLessThan_iff [simp]: "(i \<in> {l<..<u}) = (l < i \<and> i < u)"
   by (simp add: greaterThanLessThan_def)
 
 lemma atLeastLessThan_iff [simp]: "(i \<in> {l..<u}) = (l \<le> i \<and> i < u)"
   by (simp add: atLeastLessThan_def)
 
 lemma greaterThanAtMost_iff [simp]: "(i \<in> {l<..u}) = (l < i \<and> i \<le> u)"
   by (simp add: greaterThanAtMost_def)
 
 lemma atLeastAtMost_iff [simp]: "(i \<in> {l..u}) = (l \<le> i \<and> i \<le> u)"
   by (simp add: atLeastAtMost_def)
 
 text \<open>The above four lemmas could be declared as iffs. Unfortunately this
 breaks many proofs. Since it only helps blast, it is better to leave them
 alone.\<close>
 
 lemma greaterThanLessThan_eq: "{ a <..< b} = { a <..} \<inter> {..< b }"
   by auto
 
 lemma (in order) atLeastLessThan_eq_atLeastAtMost_diff:
   "{a..<b} = {a..b} - {b}"
   by (auto simp add: atLeastLessThan_def atLeastAtMost_def)
 
 lemma (in order) greaterThanAtMost_eq_atLeastAtMost_diff:
   "{a<..b} = {a..b} - {a}"
   by (auto simp add: greaterThanAtMost_def atLeastAtMost_def)
 
 end
 
 subsubsection\<open>Emptyness, singletons, subset\<close>
 
 context preorder
 begin
 
 lemma atLeastatMost_empty_iff[simp]:
   "{a..b} = {} \<longleftrightarrow> (\<not> a \<le> b)"
   by auto (blast intro: order_trans)
 
 lemma atLeastatMost_empty_iff2[simp]:
   "{} = {a..b} \<longleftrightarrow> (\<not> a \<le> b)"
   by auto (blast intro: order_trans)
 
 lemma atLeastLessThan_empty_iff[simp]:
   "{a..<b} = {} \<longleftrightarrow> (\<not> a < b)"
   by auto (blast intro: le_less_trans)
 
 lemma atLeastLessThan_empty_iff2[simp]:
   "{} = {a..<b} \<longleftrightarrow> (\<not> a < b)"
   by auto (blast intro: le_less_trans)
 
 lemma greaterThanAtMost_empty_iff[simp]: "{k<..l} = {} \<longleftrightarrow> \<not> k < l"
   by auto (blast intro: less_le_trans)
 
 lemma greaterThanAtMost_empty_iff2[simp]: "{} = {k<..l} \<longleftrightarrow> \<not> k < l"
   by auto (blast intro: less_le_trans)
 
 lemma atLeastatMost_subset_iff[simp]:
   "{a..b} \<le> {c..d} \<longleftrightarrow> (\<not> a \<le> b) \<or> c \<le> a \<and> b \<le> d"
   unfolding atLeastAtMost_def atLeast_def atMost_def
   by (blast intro: order_trans)
 
 lemma atLeastatMost_psubset_iff:
   "{a..b} < {c..d} \<longleftrightarrow>
    ((\<not> a \<le> b) \<or> c \<le> a \<and> b \<le> d \<and> (c < a \<or> b < d)) \<and> c \<le> d"
   by(simp add: psubset_eq set_eq_iff less_le_not_le)(blast intro: order_trans)
 
 lemma atLeastAtMost_subseteq_atLeastLessThan_iff:
   "{a..b} \<subseteq> {c ..< d} \<longleftrightarrow> (a \<le> b \<longrightarrow> c \<le> a \<and> b < d)" 
   by auto (blast intro: local.order_trans local.le_less_trans elim: )+
 
 lemma Icc_subset_Ici_iff[simp]:
   "{l..h} \<subseteq> {l'..} = (\<not> l\<le>h \<or> l\<ge>l')"
   by(auto simp: subset_eq intro: order_trans)
 
 lemma Icc_subset_Iic_iff[simp]:
   "{l..h} \<subseteq> {..h'} = (\<not> l\<le>h \<or> h\<le>h')"
   by(auto simp: subset_eq intro: order_trans)
 
 lemma not_Ici_eq_empty[simp]: "{l..} \<noteq> {}"
   by(auto simp: set_eq_iff)
 
 lemma not_Iic_eq_empty[simp]: "{..h} \<noteq> {}"
   by(auto simp: set_eq_iff)
 
 lemmas not_empty_eq_Ici_eq_empty[simp] = not_Ici_eq_empty[symmetric]
 lemmas not_empty_eq_Iic_eq_empty[simp] = not_Iic_eq_empty[symmetric]
 
 end
 
 context order
 begin
 
 lemma atLeastatMost_empty[simp]:
   "b < a \<Longrightarrow> {a..b} = {}"
   by(auto simp: atLeastAtMost_def atLeast_def atMost_def)
 
 lemma atLeastLessThan_empty[simp]:
   "b \<le> a \<Longrightarrow> {a..<b} = {}"
   by(auto simp: atLeastLessThan_def)
 
 lemma greaterThanAtMost_empty[simp]: "l \<le> k ==> {k<..l} = {}"
   by(auto simp:greaterThanAtMost_def greaterThan_def atMost_def)
 
 lemma greaterThanLessThan_empty[simp]:"l \<le> k ==> {k<..<l} = {}"
   by(auto simp:greaterThanLessThan_def greaterThan_def lessThan_def)
 
 lemma atLeastAtMost_singleton [simp]: "{a..a} = {a}"
   by (auto simp add: atLeastAtMost_def atMost_def atLeast_def)
 
 lemma atLeastAtMost_singleton': "a = b \<Longrightarrow> {a .. b} = {a}" by simp
 
 lemma Icc_eq_Icc[simp]:
   "{l..h} = {l'..h'} = (l=l' \<and> h=h' \<or> \<not> l\<le>h \<and> \<not> l'\<le>h')"
   by (simp add: order_class.order.eq_iff) (auto intro: order_trans)
 
 lemma (in linorder) Ico_eq_Ico:
   "{l..<h} = {l'..<h'} = (l=l' \<and> h=h' \<or> \<not> l<h \<and> \<not> l'<h')"
   by (metis atLeastLessThan_empty_iff2 nle_le not_less ord.atLeastLessThan_iff)
 
 lemma atLeastAtMost_singleton_iff[simp]:
   "{a .. b} = {c} \<longleftrightarrow> a = b \<and> b = c"
 proof
   assume "{a..b} = {c}"
   hence *: "\<not> (\<not> a \<le> b)" unfolding atLeastatMost_empty_iff[symmetric] by simp
   with \<open>{a..b} = {c}\<close> have "c \<le> a \<and> b \<le> c" by auto
   with * show "a = b \<and> b = c" by auto
 qed simp
 
 end
 
 context no_top
 begin
 
 (* also holds for no_bot but no_top should suffice *)
 lemma not_UNIV_le_Icc[simp]: "\<not> UNIV \<subseteq> {l..h}"
 using gt_ex[of h] by(auto simp: subset_eq less_le_not_le)
 
 lemma not_UNIV_le_Iic[simp]: "\<not> UNIV \<subseteq> {..h}"
 using gt_ex[of h] by(auto simp: subset_eq less_le_not_le)
 
 lemma not_Ici_le_Icc[simp]: "\<not> {l..} \<subseteq> {l'..h'}"
 using gt_ex[of h']
 by(auto simp: subset_eq less_le)(blast dest:antisym_conv intro: order_trans)
 
 lemma not_Ici_le_Iic[simp]: "\<not> {l..} \<subseteq> {..h'}"
 using gt_ex[of h']
 by(auto simp: subset_eq less_le)(blast dest:antisym_conv intro: order_trans)
 
 end
 
 context no_bot
 begin
 
 lemma not_UNIV_le_Ici[simp]: "\<not> UNIV \<subseteq> {l..}"
 using lt_ex[of l] by(auto simp: subset_eq less_le_not_le)
 
 lemma not_Iic_le_Icc[simp]: "\<not> {..h} \<subseteq> {l'..h'}"
 using lt_ex[of l']
 by(auto simp: subset_eq less_le)(blast dest:antisym_conv intro: order_trans)
 
 lemma not_Iic_le_Ici[simp]: "\<not> {..h} \<subseteq> {l'..}"
 using lt_ex[of l']
 by(auto simp: subset_eq less_le)(blast dest:antisym_conv intro: order_trans)
 
 end
 
 
 context no_top
 begin
 
 (* also holds for no_bot but no_top should suffice *)
 lemma not_UNIV_eq_Icc[simp]: "\<not> UNIV = {l'..h'}"
 using gt_ex[of h'] by(auto simp: set_eq_iff  less_le_not_le)
 
 lemmas not_Icc_eq_UNIV[simp] = not_UNIV_eq_Icc[symmetric]
 
 lemma not_UNIV_eq_Iic[simp]: "\<not> UNIV = {..h'}"
 using gt_ex[of h'] by(auto simp: set_eq_iff  less_le_not_le)
 
 lemmas not_Iic_eq_UNIV[simp] = not_UNIV_eq_Iic[symmetric]
 
 lemma not_Icc_eq_Ici[simp]: "\<not> {l..h} = {l'..}"
 unfolding atLeastAtMost_def using not_Ici_le_Iic[of l'] by blast
 
 lemmas not_Ici_eq_Icc[simp] = not_Icc_eq_Ici[symmetric]
 
 (* also holds for no_bot but no_top should suffice *)
 lemma not_Iic_eq_Ici[simp]: "\<not> {..h} = {l'..}"
 using not_Ici_le_Iic[of l' h] by blast
 
 lemmas not_Ici_eq_Iic[simp] = not_Iic_eq_Ici[symmetric]
 
 end
 
 context no_bot
 begin
 
 lemma not_UNIV_eq_Ici[simp]: "\<not> UNIV = {l'..}"
 using lt_ex[of l'] by(auto simp: set_eq_iff  less_le_not_le)
 
 lemmas not_Ici_eq_UNIV[simp] = not_UNIV_eq_Ici[symmetric]
 
 lemma not_Icc_eq_Iic[simp]: "\<not> {l..h} = {..h'}"
 unfolding atLeastAtMost_def using not_Iic_le_Ici[of h'] by blast
 
 lemmas not_Iic_eq_Icc[simp] = not_Icc_eq_Iic[symmetric]
 
 end
 
 
 context dense_linorder
 begin
 
 lemma greaterThanLessThan_empty_iff[simp]:
   "{ a <..< b } = {} \<longleftrightarrow> b \<le> a"
   using dense[of a b] by (cases "a < b") auto
 
 lemma greaterThanLessThan_empty_iff2[simp]:
   "{} = { a <..< b } \<longleftrightarrow> b \<le> a"
   using dense[of a b] by (cases "a < b") auto
 
 lemma atLeastLessThan_subseteq_atLeastAtMost_iff:
   "{a ..< b} \<subseteq> { c .. d } \<longleftrightarrow> (a < b \<longrightarrow> c \<le> a \<and> b \<le> d)"
   using dense[of "max a d" "b"]
   by (force simp: subset_eq Ball_def not_less[symmetric])
 
 lemma greaterThanAtMost_subseteq_atLeastAtMost_iff:
   "{a <.. b} \<subseteq> { c .. d } \<longleftrightarrow> (a < b \<longrightarrow> c \<le> a \<and> b \<le> d)"
   using dense[of "a" "min c b"]
   by (force simp: subset_eq Ball_def not_less[symmetric])
 
 lemma greaterThanLessThan_subseteq_atLeastAtMost_iff:
   "{a <..< b} \<subseteq> { c .. d } \<longleftrightarrow> (a < b \<longrightarrow> c \<le> a \<and> b \<le> d)"
   using dense[of "a" "min c b"] dense[of "max a d" "b"]
   by (force simp: subset_eq Ball_def not_less[symmetric])
 
 lemma greaterThanLessThan_subseteq_greaterThanLessThan:
   "{a <..< b} \<subseteq> {c <..< d} \<longleftrightarrow> (a < b \<longrightarrow> a \<ge> c \<and> b \<le> d)"
   using dense[of "a" "min c b"] dense[of "max a d" "b"]
   by (force simp: subset_eq Ball_def not_less[symmetric])
 
 lemma greaterThanAtMost_subseteq_atLeastLessThan_iff:
   "{a <.. b} \<subseteq> { c ..< d } \<longleftrightarrow> (a < b \<longrightarrow> c \<le> a \<and> b < d)"
   using dense[of "a" "min c b"]
   by (force simp: subset_eq Ball_def not_less[symmetric])
 
 lemma greaterThanLessThan_subseteq_atLeastLessThan_iff:
   "{a <..< b} \<subseteq> { c ..< d } \<longleftrightarrow> (a < b \<longrightarrow> c \<le> a \<and> b \<le> d)"
   using dense[of "a" "min c b"] dense[of "max a d" "b"]
   by (force simp: subset_eq Ball_def not_less[symmetric])
 
 lemma greaterThanLessThan_subseteq_greaterThanAtMost_iff:
   "{a <..< b} \<subseteq> { c <.. d } \<longleftrightarrow> (a < b \<longrightarrow> c \<le> a \<and> b \<le> d)"
   using dense[of "a" "min c b"] dense[of "max a d" "b"]
   by (force simp: subset_eq Ball_def not_less[symmetric])
 
 end
 
 context no_top
 begin
 
 lemma greaterThan_non_empty[simp]: "{x <..} \<noteq> {}"
   using gt_ex[of x] by auto
 
 end
 
 context no_bot
 begin
 
 lemma lessThan_non_empty[simp]: "{..< x} \<noteq> {}"
   using lt_ex[of x] by auto
 
 end
 
 lemma (in linorder) atLeastLessThan_subset_iff:
   "{a..<b} \<subseteq> {c..<d} \<Longrightarrow> b \<le> a \<or> c\<le>a \<and> b\<le>d"
 proof (cases "a < b")
   case True
   assume assm: "{a..<b} \<subseteq> {c..<d}"
   then have 1: "c \<le> a \<and> a \<le> d"
     using True by (auto simp add: subset_eq Ball_def)
   then have 2: "b \<le> d"
     using assm by (auto simp add: subset_eq)
   from 1 2 show ?thesis
     by simp
 qed (auto)
 
 lemma atLeastLessThan_inj:
   fixes a b c d :: "'a::linorder"
   assumes eq: "{a ..< b} = {c ..< d}" and "a < b" "c < d"
   shows "a = c" "b = d"
 using assms by (metis atLeastLessThan_subset_iff eq less_le_not_le antisym_conv2 subset_refl)+
 
 lemma atLeastLessThan_eq_iff:
   fixes a b c d :: "'a::linorder"
   assumes "a < b" "c < d"
   shows "{a ..< b} = {c ..< d} \<longleftrightarrow> a = c \<and> b = d"
   using atLeastLessThan_inj assms by auto
 
 lemma (in linorder) Ioc_inj: 
   \<open>{a <.. b} = {c <.. d} \<longleftrightarrow> (b \<le> a \<and> d \<le> c) \<or> a = c \<and> b = d\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof
   assume ?Q
   then show ?P
     by auto
 next
   assume ?P
   then have \<open>a < x \<and> x \<le> b \<longleftrightarrow> c < x \<and> x \<le> d\<close> for x
     by (simp add: set_eq_iff)
   from this [of a] this [of b] this [of c] this [of d] show ?Q
     by auto
 qed
 
 lemma (in order) Iio_Int_singleton: "{..<k} \<inter> {x} = (if x < k then {x} else {})"
   by auto
 
 lemma (in linorder) Ioc_subset_iff: "{a<..b} \<subseteq> {c<..d} \<longleftrightarrow> (b \<le> a \<or> c \<le> a \<and> b \<le> d)"
   by (auto simp: subset_eq Ball_def) (metis less_le not_less)
 
 lemma (in order_bot) atLeast_eq_UNIV_iff: "{x..} = UNIV \<longleftrightarrow> x = bot"
 by (auto simp: set_eq_iff intro: le_bot)
 
 lemma (in order_top) atMost_eq_UNIV_iff: "{..x} = UNIV \<longleftrightarrow> x = top"
 by (auto simp: set_eq_iff intro: top_le)
 
 lemma (in bounded_lattice) atLeastAtMost_eq_UNIV_iff:
   "{x..y} = UNIV \<longleftrightarrow> (x = bot \<and> y = top)"
 by (auto simp: set_eq_iff intro: top_le le_bot)
 
 lemma Iio_eq_empty_iff: "{..< n::'a::{linorder, order_bot}} = {} \<longleftrightarrow> n = bot"
   by (auto simp: set_eq_iff not_less le_bot)
 
 lemma lessThan_empty_iff: "{..< n::nat} = {} \<longleftrightarrow> n = 0"
   by (simp add: Iio_eq_empty_iff bot_nat_def)
 
 lemma mono_image_least:
   assumes f_mono: "mono f" and f_img: "f ` {m ..< n} = {m' ..< n'}" "m < n"
   shows "f m = m'"
 proof -
   from f_img have "{m' ..< n'} \<noteq> {}"
     by (metis atLeastLessThan_empty_iff image_is_empty)
   with f_img have "m' \<in> f ` {m ..< n}" by auto
   then obtain k where "f k = m'" "m \<le> k" by auto
   moreover have "m' \<le> f m" using f_img by auto
   ultimately show "f m = m'"
     using f_mono by (auto elim: monoE[where x=m and y=k])
 qed
 
 
 subsection \<open>Infinite intervals\<close>
 
 context dense_linorder
 begin
 
 lemma infinite_Ioo:
   assumes "a < b"
   shows "\<not> finite {a<..<b}"
 proof
   assume fin: "finite {a<..<b}"
   moreover have ne: "{a<..<b} \<noteq> {}"
     using \<open>a < b\<close> by auto
   ultimately have "a < Max {a <..< b}" "Max {a <..< b} < b"
     using Max_in[of "{a <..< b}"] by auto
   then obtain x where "Max {a <..< b} < x" "x < b"
     using dense[of "Max {a<..<b}" b] by auto
   then have "x \<in> {a <..< b}"
     using \<open>a < Max {a <..< b}\<close> by auto
   then have "x \<le> Max {a <..< b}"
     using fin by auto
   with \<open>Max {a <..< b} < x\<close> show False by auto
 qed
 
 lemma infinite_Icc: "a < b \<Longrightarrow> \<not> finite {a .. b}"
   using greaterThanLessThan_subseteq_atLeastAtMost_iff[of a b a b] infinite_Ioo[of a b]
   by (auto dest: finite_subset)
 
 lemma infinite_Ico: "a < b \<Longrightarrow> \<not> finite {a ..< b}"
   using greaterThanLessThan_subseteq_atLeastLessThan_iff[of a b a b] infinite_Ioo[of a b]
   by (auto dest: finite_subset)
 
 lemma infinite_Ioc: "a < b \<Longrightarrow> \<not> finite {a <.. b}"
   using greaterThanLessThan_subseteq_greaterThanAtMost_iff[of a b a b] infinite_Ioo[of a b]
   by (auto dest: finite_subset)
 
 lemma infinite_Ioo_iff [simp]: "infinite {a<..<b} \<longleftrightarrow> a < b"
   using not_less_iff_gr_or_eq by (fastforce simp: infinite_Ioo)
 
 lemma infinite_Icc_iff [simp]: "infinite {a .. b} \<longleftrightarrow> a < b"
   using not_less_iff_gr_or_eq by (fastforce simp: infinite_Icc)
 
 lemma infinite_Ico_iff [simp]: "infinite {a..<b} \<longleftrightarrow> a < b"
   using not_less_iff_gr_or_eq by (fastforce simp: infinite_Ico)
 
 lemma infinite_Ioc_iff [simp]: "infinite {a<..b} \<longleftrightarrow> a < b"
   using not_less_iff_gr_or_eq by (fastforce simp: infinite_Ioc)
 
 end
 
 lemma infinite_Iio: "\<not> finite {..< a :: 'a :: {no_bot, linorder}}"
 proof
   assume "finite {..< a}"
   then have *: "\<And>x. x < a \<Longrightarrow> Min {..< a} \<le> x"
     by auto
   obtain x where "x < a"
     using lt_ex by auto
 
   obtain y where "y < Min {..< a}"
     using lt_ex by auto
   also have "Min {..< a} \<le> x"
     using \<open>x < a\<close> by fact
   also note \<open>x < a\<close>
   finally have "Min {..< a} \<le> y"
     by fact
   with \<open>y < Min {..< a}\<close> show False by auto
 qed
 
 lemma infinite_Iic: "\<not> finite {.. a :: 'a :: {no_bot, linorder}}"
   using infinite_Iio[of a] finite_subset[of "{..< a}" "{.. a}"]
   by (auto simp: subset_eq less_imp_le)
 
 lemma infinite_Ioi: "\<not> finite {a :: 'a :: {no_top, linorder} <..}"
 proof
   assume "finite {a <..}"
   then have *: "\<And>x. a < x \<Longrightarrow> x \<le> Max {a <..}"
     by auto
 
   obtain y where "Max {a <..} < y"
     using gt_ex by auto
 
   obtain x where x: "a < x"
     using gt_ex by auto
   also from x have "x \<le> Max {a <..}"
     by fact
   also note \<open>Max {a <..} < y\<close>
   finally have "y \<le> Max { a <..}"
     by fact
   with \<open>Max {a <..} < y\<close> show False by auto
 qed
 
 lemma infinite_Ici: "\<not> finite {a :: 'a :: {no_top, linorder} ..}"
   using infinite_Ioi[of a] finite_subset[of "{a <..}" "{a ..}"]
   by (auto simp: subset_eq less_imp_le)
 
 subsubsection \<open>Intersection\<close>
 
 context linorder
 begin
 
 lemma Int_atLeastAtMost[simp]: "{a..b} Int {c..d} = {max a c .. min b d}"
 by auto
 
 lemma Int_atLeastAtMostR1[simp]: "{..b} Int {c..d} = {c .. min b d}"
 by auto
 
 lemma Int_atLeastAtMostR2[simp]: "{a..} Int {c..d} = {max a c .. d}"
 by auto
 
 lemma Int_atLeastAtMostL1[simp]: "{a..b} Int {..d} = {a .. min b d}"
 by auto
 
 lemma Int_atLeastAtMostL2[simp]: "{a..b} Int {c..} = {max a c .. b}"
 by auto
 
 lemma Int_atLeastLessThan[simp]: "{a..<b} Int {c..<d} = {max a c ..< min b d}"
 by auto
 
 lemma Int_greaterThanAtMost[simp]: "{a<..b} Int {c<..d} = {max a c <.. min b d}"
 by auto
 
 lemma Int_greaterThanLessThan[simp]: "{a<..<b} Int {c<..<d} = {max a c <..< min b d}"
 by auto
 
 lemma Int_atMost[simp]: "{..a} \<inter> {..b} = {.. min a b}"
   by (auto simp: min_def)
 
 lemma Ioc_disjoint: "{a<..b} \<inter> {c<..d} = {} \<longleftrightarrow> b \<le> a \<or> d \<le> c \<or> b \<le> c \<or> d \<le> a"
   by auto
 
 end
 
 context complete_lattice
 begin
 
 lemma
   shows Sup_atLeast[simp]: "Sup {x ..} = top"
     and Sup_greaterThanAtLeast[simp]: "x < top \<Longrightarrow> Sup {x <..} = top"
     and Sup_atMost[simp]: "Sup {.. y} = y"
     and Sup_atLeastAtMost[simp]: "x \<le> y \<Longrightarrow> Sup { x .. y} = y"
     and Sup_greaterThanAtMost[simp]: "x < y \<Longrightarrow> Sup { x <.. y} = y"
   by (auto intro!: Sup_eqI)
 
 lemma
   shows Inf_atMost[simp]: "Inf {.. x} = bot"
     and Inf_atMostLessThan[simp]: "top < x \<Longrightarrow> Inf {..< x} = bot"
     and Inf_atLeast[simp]: "Inf {x ..} = x"
     and Inf_atLeastAtMost[simp]: "x \<le> y \<Longrightarrow> Inf { x .. y} = x"
     and Inf_atLeastLessThan[simp]: "x < y \<Longrightarrow> Inf { x ..< y} = x"
   by (auto intro!: Inf_eqI)
 
 end
 
 lemma
   fixes x y :: "'a :: {complete_lattice, dense_linorder}"
   shows Sup_lessThan[simp]: "Sup {..< y} = y"
     and Sup_atLeastLessThan[simp]: "x < y \<Longrightarrow> Sup { x ..< y} = y"
     and Sup_greaterThanLessThan[simp]: "x < y \<Longrightarrow> Sup { x <..< y} = y"
     and Inf_greaterThan[simp]: "Inf {x <..} = x"
     and Inf_greaterThanAtMost[simp]: "x < y \<Longrightarrow> Inf { x <.. y} = x"
     and Inf_greaterThanLessThan[simp]: "x < y \<Longrightarrow> Inf { x <..< y} = x"
   by (auto intro!: Inf_eqI Sup_eqI intro: dense_le dense_le_bounded dense_ge dense_ge_bounded)
 
 subsection \<open>Intervals of natural numbers\<close>
 
 subsubsection \<open>The Constant \<^term>\<open>lessThan\<close>\<close>
 
 lemma lessThan_0 [simp]: "lessThan (0::nat) = {}"
 by (simp add: lessThan_def)
 
 lemma lessThan_Suc: "lessThan (Suc k) = insert k (lessThan k)"
 by (simp add: lessThan_def less_Suc_eq, blast)
 
 text \<open>The following proof is convenient in induction proofs where
 new elements get indices at the beginning. So it is used to transform
 \<^term>\<open>{..<Suc n}\<close> to \<^term>\<open>0::nat\<close> and \<^term>\<open>{..< n}\<close>.\<close>
 
 lemma zero_notin_Suc_image [simp]: "0 \<notin> Suc ` A"
   by auto
 
 lemma lessThan_Suc_eq_insert_0: "{..<Suc n} = insert 0 (Suc ` {..<n})"
   by (auto simp: image_iff less_Suc_eq_0_disj)
 
 lemma lessThan_Suc_atMost: "lessThan (Suc k) = atMost k"
 by (simp add: lessThan_def atMost_def less_Suc_eq_le)
 
 lemma atMost_Suc_eq_insert_0: "{.. Suc n} = insert 0 (Suc ` {.. n})"
   unfolding lessThan_Suc_atMost[symmetric] lessThan_Suc_eq_insert_0[of "Suc n"] ..
 
 lemma UN_lessThan_UNIV: "(\<Union>m::nat. lessThan m) = UNIV"
 by blast
 
 subsubsection \<open>The Constant \<^term>\<open>greaterThan\<close>\<close>
 
 lemma greaterThan_0: "greaterThan 0 = range Suc"
   unfolding greaterThan_def
   by (blast dest: gr0_conv_Suc [THEN iffD1])
 
 lemma greaterThan_Suc: "greaterThan (Suc k) = greaterThan k - {Suc k}"
   unfolding greaterThan_def
   by (auto elim: linorder_neqE)
 
 lemma INT_greaterThan_UNIV: "(\<Inter>m::nat. greaterThan m) = {}"
   by blast
 
 subsubsection \<open>The Constant \<^term>\<open>atLeast\<close>\<close>
 
 lemma atLeast_0 [simp]: "atLeast (0::nat) = UNIV"
 by (unfold atLeast_def UNIV_def, simp)
 
 lemma atLeast_Suc: "atLeast (Suc k) = atLeast k - {k}"
   unfolding atLeast_def by (auto simp: order_le_less Suc_le_eq)
 
 lemma atLeast_Suc_greaterThan: "atLeast (Suc k) = greaterThan k"
   by (auto simp add: greaterThan_def atLeast_def less_Suc_eq_le)
 
 lemma UN_atLeast_UNIV: "(\<Union>m::nat. atLeast m) = UNIV"
   by blast
 
 subsubsection \<open>The Constant \<^term>\<open>atMost\<close>\<close>
 
 lemma atMost_0 [simp]: "atMost (0::nat) = {0}"
   by (simp add: atMost_def)
 
 lemma atMost_Suc: "atMost (Suc k) = insert (Suc k) (atMost k)"
   unfolding atMost_def by (auto simp add: less_Suc_eq order_le_less)
 
 lemma UN_atMost_UNIV: "(\<Union>m::nat. atMost m) = UNIV"
   by blast
 
 subsubsection \<open>The Constant \<^term>\<open>atLeastLessThan\<close>\<close>
 
 text\<open>The orientation of the following 2 rules is tricky. The lhs is
 defined in terms of the rhs.  Hence the chosen orientation makes sense
 in this theory --- the reverse orientation complicates proofs (eg
 nontermination). But outside, when the definition of the lhs is rarely
 used, the opposite orientation seems preferable because it reduces a
 specific concept to a more general one.\<close>
 
 lemma atLeast0LessThan [code_abbrev]: "{0::nat..<n} = {..<n}"
   by(simp add:lessThan_def atLeastLessThan_def)
 
 lemma atLeast0AtMost [code_abbrev]: "{0..n::nat} = {..n}"
   by(simp add:atMost_def atLeastAtMost_def)
 
 lemma lessThan_atLeast0: "{..<n} = {0::nat..<n}"
   by (simp add: atLeast0LessThan)
 
 lemma atMost_atLeast0: "{..n} = {0::nat..n}"
   by (simp add: atLeast0AtMost)
 
 lemma atLeastLessThan0: "{m..<0::nat} = {}"
   by (simp add: atLeastLessThan_def)
 
 lemma atLeast0_lessThan_Suc: "{0..<Suc n} = insert n {0..<n}"
   by (simp add: atLeast0LessThan lessThan_Suc)
 
 lemma atLeast0_lessThan_Suc_eq_insert_0: "{0..<Suc n} = insert 0 (Suc ` {0..<n})"
   by (simp add: atLeast0LessThan lessThan_Suc_eq_insert_0)
 
 
 subsubsection \<open>The Constant \<^term>\<open>atLeastAtMost\<close>\<close>
 
 lemma Icc_eq_insert_lb_nat: "m \<le> n \<Longrightarrow> {m..n} = insert m {Suc m..n}"
 by auto
 
 lemma atLeast0_atMost_Suc:
   "{0..Suc n} = insert (Suc n) {0..n}"
   by (simp add: atLeast0AtMost atMost_Suc)
 
 lemma atLeast0_atMost_Suc_eq_insert_0:
   "{0..Suc n} = insert 0 (Suc ` {0..n})"
   by (simp add: atLeast0AtMost atMost_Suc_eq_insert_0)
 
 
 subsubsection \<open>Intervals of nats with \<^term>\<open>Suc\<close>\<close>
 
 text\<open>Not a simprule because the RHS is too messy.\<close>
 lemma atLeastLessThanSuc:
     "{m..<Suc n} = (if m \<le> n then insert n {m..<n} else {})"
 by (auto simp add: atLeastLessThan_def)
 
 lemma atLeastLessThan_singleton [simp]: "{m..<Suc m} = {m}"
 by (auto simp add: atLeastLessThan_def)
 
 lemma atLeastLessThanSuc_atLeastAtMost: "{l..<Suc u} = {l..u}"
   by (simp add: lessThan_Suc_atMost atLeastAtMost_def atLeastLessThan_def)
 
 lemma atLeastSucAtMost_greaterThanAtMost: "{Suc l..u} = {l<..u}"
   by (simp add: atLeast_Suc_greaterThan atLeastAtMost_def
       greaterThanAtMost_def)
 
 lemma atLeastSucLessThan_greaterThanLessThan: "{Suc l..<u} = {l<..<u}"
   by (simp add: atLeast_Suc_greaterThan atLeastLessThan_def
     greaterThanLessThan_def)
 
 lemma atLeastAtMostSuc_conv: "m \<le> Suc n \<Longrightarrow> {m..Suc n} = insert (Suc n) {m..n}"
   by auto
 
 lemma atLeastAtMost_insertL: "m \<le> n \<Longrightarrow> insert m {Suc m..n} = {m ..n}"
   by auto
 
 text \<open>The analogous result is useful on \<^typ>\<open>int\<close>:\<close>
 (* here, because we don't have an own int section *)
 lemma atLeastAtMostPlus1_int_conv:
   "m \<le> 1+n \<Longrightarrow> {m..1+n} = insert (1+n) {m..n::int}"
   by (auto intro: set_eqI)
 
 lemma atLeastLessThan_add_Un: "i \<le> j \<Longrightarrow> {i..<j+k} = {i..<j} \<union> {j..<j+k::nat}"
   by (induct k) (simp_all add: atLeastLessThanSuc)
 
 
 subsubsection \<open>Intervals and numerals\<close>
 
 lemma lessThan_nat_numeral:  \<comment> \<open>Evaluation for specific numerals\<close>
   "lessThan (numeral k :: nat) = insert (pred_numeral k) (lessThan (pred_numeral k))"
   by (simp add: numeral_eq_Suc lessThan_Suc)
 
 lemma atMost_nat_numeral:  \<comment> \<open>Evaluation for specific numerals\<close>
   "atMost (numeral k :: nat) = insert (numeral k) (atMost (pred_numeral k))"
   by (simp add: numeral_eq_Suc atMost_Suc)
 
 lemma atLeastLessThan_nat_numeral:  \<comment> \<open>Evaluation for specific numerals\<close>
   "atLeastLessThan m (numeral k :: nat) =
      (if m \<le> (pred_numeral k) then insert (pred_numeral k) (atLeastLessThan m (pred_numeral k))
                  else {})"
   by (simp add: numeral_eq_Suc atLeastLessThanSuc)
 
 
 subsubsection \<open>Image\<close>
 
 context linordered_semidom
 begin
 
 lemma image_add_atLeast[simp]: "plus k ` {i..} = {k + i..}"
 proof -
   have "n = k + (n - k)" if "i + k \<le> n" for n
   proof -
     have "n = (n - (k + i)) + (k + i)" using that
       by (metis add_commute le_add_diff_inverse)
     then show "n = k + (n - k)"
       by (metis local.add_diff_cancel_left' add_assoc add_commute)
   qed
   then show ?thesis
     by (fastforce simp: add_le_imp_le_diff add.commute)
 qed
 
 lemma image_add_atLeastAtMost [simp]:
   "plus k ` {i..j} = {i + k..j + k}" (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
     by (auto simp add: ac_simps)
 next
   show "?B \<subseteq> ?A"
   proof
     fix n
     assume "n \<in> ?B"
     then have "i \<le> n - k"
       by (simp add: add_le_imp_le_diff)
     have "n = n - k + k"
     proof -
       from \<open>n \<in> ?B\<close> have "n = n - (i + k) + (i + k)"
         by simp
       also have "\<dots> = n - k - i + i + k"
         by (simp add: algebra_simps)
       also have "\<dots> = n - k + k"
         using \<open>i \<le> n - k\<close> by simp
       finally show ?thesis .
     qed
     moreover have "n - k \<in> {i..j}"
       using \<open>n \<in> ?B\<close>
       by (auto simp: add_le_imp_le_diff add_le_add_imp_diff_le)
     ultimately show "n \<in> ?A"
       by (simp add: ac_simps) 
   qed
 qed
 
 lemma image_add_atLeastAtMost' [simp]:
   "(\<lambda>n. n + k) ` {i..j} = {i + k..j + k}"
   by (simp add: add.commute [of _ k])
 
 lemma image_add_atLeastLessThan [simp]:
   "plus k ` {i..<j} = {i + k..<j + k}"
   by (simp add: image_set_diff atLeastLessThan_eq_atLeastAtMost_diff ac_simps)
 
 lemma image_add_atLeastLessThan' [simp]:
   "(\<lambda>n. n + k) ` {i..<j} = {i + k..<j + k}"
   by (simp add: add.commute [of _ k])
 
 lemma image_add_greaterThanAtMost[simp]: "(+) c ` {a<..b} = {c + a<..c + b}"
   by (simp add: image_set_diff greaterThanAtMost_eq_atLeastAtMost_diff ac_simps)
 
 end
 
 context ordered_ab_group_add
 begin
 
 lemma
   fixes x :: 'a
   shows image_uminus_greaterThan[simp]: "uminus ` {x<..} = {..<-x}"
   and image_uminus_atLeast[simp]: "uminus ` {x..} = {..-x}"
 proof safe
   fix y assume "y < -x"
   hence *:  "x < -y" using neg_less_iff_less[of "-y" x] by simp
   have "- (-y) \<in> uminus ` {x<..}"
     by (rule imageI) (simp add: *)
   thus "y \<in> uminus ` {x<..}" by simp
 next
   fix y assume "y \<le> -x"
   have "- (-y) \<in> uminus ` {x..}"
     by (rule imageI) (use \<open>y \<le> -x\<close>[THEN le_imp_neg_le] in \<open>simp\<close>)
   thus "y \<in> uminus ` {x..}" by simp
 qed simp_all
 
 lemma
   fixes x :: 'a
   shows image_uminus_lessThan[simp]: "uminus ` {..<x} = {-x<..}"
   and image_uminus_atMost[simp]: "uminus ` {..x} = {-x..}"
 proof -
   have "uminus ` {..<x} = uminus ` uminus ` {-x<..}"
     and "uminus ` {..x} = uminus ` uminus ` {-x..}" by simp_all
   thus "uminus ` {..<x} = {-x<..}" and "uminus ` {..x} = {-x..}"
     by (simp_all add: image_image
         del: image_uminus_greaterThan image_uminus_atLeast)
 qed
 
 lemma
   fixes x :: 'a
   shows image_uminus_atLeastAtMost[simp]: "uminus ` {x..y} = {-y..-x}"
   and image_uminus_greaterThanAtMost[simp]: "uminus ` {x<..y} = {-y..<-x}"
   and image_uminus_atLeastLessThan[simp]: "uminus ` {x..<y} = {-y<..-x}"
   and image_uminus_greaterThanLessThan[simp]: "uminus ` {x<..<y} = {-y<..<-x}"
   by (simp_all add: atLeastAtMost_def greaterThanAtMost_def atLeastLessThan_def
       greaterThanLessThan_def image_Int[OF inj_uminus] Int_commute)
 
 lemma image_add_atMost[simp]: "(+) c ` {..a} = {..c + a}"
   by (auto intro!: image_eqI[where x="x - c" for x] simp: algebra_simps)
 
 end
 
 lemma image_Suc_atLeastAtMost [simp]:
   "Suc ` {i..j} = {Suc i..Suc j}"
   using image_add_atLeastAtMost [of 1 i j]
     by (simp only: plus_1_eq_Suc) simp
 
 lemma image_Suc_atLeastLessThan [simp]:
   "Suc ` {i..<j} = {Suc i..<Suc j}"
   using image_add_atLeastLessThan [of 1 i j]
     by (simp only: plus_1_eq_Suc) simp
 
 corollary image_Suc_atMost:
   "Suc ` {..n} = {1..Suc n}"
   by (simp add: atMost_atLeast0 atLeastLessThanSuc_atLeastAtMost)
 
 corollary image_Suc_lessThan:
   "Suc ` {..<n} = {1..n}"
   by (simp add: lessThan_atLeast0 atLeastLessThanSuc_atLeastAtMost)
 
 lemma image_diff_atLeastAtMost [simp]:
   fixes d::"'a::linordered_idom" shows "((-) d ` {a..b}) = {d-b..d-a}"
 proof
   show "{d - b..d - a} \<subseteq> (-) d ` {a..b}"
   proof
     fix x
     assume "x \<in> {d - b..d - a}"
     then have "d - x \<in> {a..b}" and "x = d - (d - x)"
       by auto
     then show "x \<in> (-) d ` {a..b}"
       by (rule rev_image_eqI)
   qed
 qed(auto)
 
 lemma image_diff_atLeastLessThan [simp]:
   fixes a b c::"'a::linordered_idom"
   shows "(-) c ` {a..<b} = {c - b<..c - a}"
 proof -
   have "(-) c ` {a..<b} = (+) c ` uminus ` {a ..<b}"
     unfolding image_image by simp
   also have "\<dots> = {c - b<..c - a}" by simp
   finally show ?thesis by simp
 qed
 
 lemma image_minus_const_greaterThanAtMost[simp]:
   fixes a b c::"'a::linordered_idom"
   shows "(-) c ` {a<..b} = {c - b..<c - a}"
 proof -
   have "(-) c ` {a<..b} = (+) c ` uminus ` {a<..b}"
     unfolding image_image by simp
   also have "\<dots> = {c - b..<c - a}" by simp
   finally show ?thesis by simp
 qed
 
 lemma image_minus_const_atLeast[simp]:
   fixes a c::"'a::linordered_idom"
   shows "(-) c ` {a..} = {..c - a}"
 proof -
   have "(-) c ` {a..} = (+) c ` uminus ` {a ..}"
     unfolding image_image by simp
   also have "\<dots> = {..c - a}" by simp
   finally show ?thesis by simp
 qed
 
 lemma image_minus_const_AtMost[simp]:
   fixes b c::"'a::linordered_idom"
   shows "(-) c ` {..b} = {c - b..}"
 proof -
   have "(-) c ` {..b} = (+) c ` uminus ` {..b}"
     unfolding image_image by simp
   also have "\<dots> = {c - b..}" by simp
   finally show ?thesis by simp
 qed
 
 lemma image_minus_const_atLeastAtMost' [simp]:
   "(\<lambda>t. t-d)`{a..b} = {a-d..b-d}" for d::"'a::linordered_idom"
   by (metis (no_types, lifting) diff_conv_add_uminus image_add_atLeastAtMost' image_cong)
 
 context linordered_field
 begin
 
 lemma image_mult_atLeastAtMost [simp]:
   "((*) d ` {a..b}) = {d*a..d*b}" if "d>0"
   using that
   by (auto simp: field_simps mult_le_cancel_right intro: rev_image_eqI [where x="x/d" for x])
 
 lemma image_divide_atLeastAtMost [simp]:
   "((\<lambda>c. c / d) ` {a..b}) = {a/d..b/d}" if "d>0"
 proof -
   from that have "inverse d > 0"
     by simp
   with image_mult_atLeastAtMost [of "inverse d" a b]
   have "(*) (inverse d) ` {a..b} = {inverse d * a..inverse d * b}"
     by blast
   moreover have "(*) (inverse d) = (\<lambda>c. c / d)"
     by (simp add: fun_eq_iff field_simps)
   ultimately show ?thesis
     by simp
 qed
 
 lemma image_mult_atLeastAtMost_if:
   "(*) c ` {x .. y} =
     (if c > 0 then {c * x .. c * y} else if x \<le> y then {c * y .. c * x} else {})"
 proof (cases "c = 0 \<or> x > y")
   case True
   then show ?thesis
     by auto
 next
   case False
   then have "x \<le> y"
     by auto
   from False consider "c < 0"| "c > 0"
     by (auto simp add: neq_iff)
   then show ?thesis
   proof cases
     case 1
     have "(*) c ` {x..y} = {c * y..c * x}"
     proof (rule set_eqI)
       fix d
       from 1 have "inj (\<lambda>z. z / c)"
         by (auto intro: injI)
       then have "d \<in> (*) c ` {x..y} \<longleftrightarrow> d / c \<in> (\<lambda>z. z div c) ` (*) c ` {x..y}"
         by (subst inj_image_mem_iff) simp_all
       also have "\<dots> \<longleftrightarrow> d / c \<in> {x..y}"
         using 1 by (simp add: image_image)
       also have "\<dots> \<longleftrightarrow> d \<in> {c * y..c * x}"
         by (auto simp add: field_simps 1)
       finally show "d \<in> (*) c ` {x..y} \<longleftrightarrow> d \<in> {c * y..c * x}" .
     qed
     with \<open>x \<le> y\<close> show ?thesis
       by auto
   qed (simp add: mult_left_mono_neg)
 qed
 
 lemma image_mult_atLeastAtMost_if':
   "(\<lambda>x. x * c) ` {x..y} =
     (if x \<le> y then if c > 0 then {x * c .. y * c} else {y * c .. x * c} else {})"
   using image_mult_atLeastAtMost_if [of c x y] by (auto simp add: ac_simps)
 
 lemma image_affinity_atLeastAtMost:
   "((\<lambda>x. m * x + c) ` {a..b}) = (if {a..b} = {} then {}
             else if 0 \<le> m then {m * a + c .. m * b + c}
             else {m * b + c .. m * a + c})"
 proof -
   have *: "(\<lambda>x. m * x + c) = ((\<lambda>x. x + c) \<circ> (*) m)"
     by (simp add: fun_eq_iff)
   show ?thesis by (simp only: * image_comp [symmetric] image_mult_atLeastAtMost_if)
     (auto simp add: mult_le_cancel_left)
 qed
 
 lemma image_affinity_atLeastAtMost_diff:
   "((\<lambda>x. m*x - c) ` {a..b}) = (if {a..b}={} then {}
             else if 0 \<le> m then {m*a - c .. m*b - c}
             else {m*b - c .. m*a - c})"
   using image_affinity_atLeastAtMost [of m "-c" a b]
   by simp
 
 lemma image_affinity_atLeastAtMost_div:
   "((\<lambda>x. x/m + c) ` {a..b}) = (if {a..b}={} then {}
             else if 0 \<le> m then {a/m + c .. b/m + c}
             else {b/m + c .. a/m + c})"
   using image_affinity_atLeastAtMost [of "inverse m" c a b]
   by (simp add: field_class.field_divide_inverse algebra_simps inverse_eq_divide)
 
 lemma image_affinity_atLeastAtMost_div_diff:
   "((\<lambda>x. x/m - c) ` {a..b}) = (if {a..b}={} then {}
             else if 0 \<le> m then {a/m - c .. b/m - c}
             else {b/m - c .. a/m - c})"
   using image_affinity_atLeastAtMost_diff [of "inverse m" c a b]
   by (simp add: field_class.field_divide_inverse algebra_simps inverse_eq_divide)
 
 end
 
 lemma atLeast1_lessThan_eq_remove0:
   "{Suc 0..<n} = {..<n} - {0}"
   by auto
 
 lemma atLeast1_atMost_eq_remove0:
   "{Suc 0..n} = {..n} - {0}"
   by auto
 
 lemma image_add_int_atLeastLessThan:
     "(\<lambda>x. x + (l::int)) ` {0..<u-l} = {l..<u}"
   by safe auto
 
 lemma image_minus_const_atLeastLessThan_nat:
   fixes c :: nat
   shows "(\<lambda>i. i - c) ` {x ..< y} =
       (if c < y then {x - c ..< y - c} else if x < y then {0} else {})"
     (is "_ = ?right")
 proof safe
   fix a assume a: "a \<in> ?right"
   show "a \<in> (\<lambda>i. i - c) ` {x ..< y}"
   proof cases
     assume "c < y" with a show ?thesis
       by (auto intro!: image_eqI[of _ _ "a + c"])
   next
     assume "\<not> c < y" with a show ?thesis
       by (auto intro!: image_eqI[of _ _ x] split: if_split_asm)
   qed
 qed auto
 
 lemma image_int_atLeastLessThan:
   "int ` {a..<b} = {int a..<int b}"
   by (auto intro!: image_eqI [where x = "nat x" for x])
 
 lemma image_int_atLeastAtMost:
   "int ` {a..b} = {int a..int b}"
   by (auto intro!: image_eqI [where x = "nat x" for x])
 
 
 subsubsection \<open>Finiteness\<close>
 
 lemma finite_lessThan [iff]: fixes k :: nat shows "finite {..<k}"
   by (induct k) (simp_all add: lessThan_Suc)
 
 lemma finite_atMost [iff]: fixes k :: nat shows "finite {..k}"
   by (induct k) (simp_all add: atMost_Suc)
 
 lemma finite_greaterThanLessThan [iff]:
   fixes l :: nat shows "finite {l<..<u}"
   by (simp add: greaterThanLessThan_def)
 
 lemma finite_atLeastLessThan [iff]:
   fixes l :: nat shows "finite {l..<u}"
   by (simp add: atLeastLessThan_def)
 
 lemma finite_greaterThanAtMost [iff]:
   fixes l :: nat shows "finite {l<..u}"
   by (simp add: greaterThanAtMost_def)
 
 lemma finite_atLeastAtMost [iff]:
   fixes l :: nat shows "finite {l..u}"
   by (simp add: atLeastAtMost_def)
 
 text \<open>A bounded set of natural numbers is finite.\<close>
 lemma bounded_nat_set_is_finite: "(\<forall>i\<in>N. i < (n::nat)) \<Longrightarrow> finite N"
   by (rule finite_subset [OF _ finite_lessThan]) auto
 
 text \<open>A set of natural numbers is finite iff it is bounded.\<close>
 lemma finite_nat_set_iff_bounded:
   "finite(N::nat set) = (\<exists>m. \<forall>n\<in>N. n<m)" (is "?F = ?B")
 proof
   assume f:?F  show ?B
     using Max_ge[OF \<open>?F\<close>, simplified less_Suc_eq_le[symmetric]] by blast
 next
   assume ?B show ?F using \<open>?B\<close> by(blast intro:bounded_nat_set_is_finite)
 qed
 
 lemma finite_nat_set_iff_bounded_le: "finite(N::nat set) = (\<exists>m. \<forall>n\<in>N. n\<le>m)"
   unfolding finite_nat_set_iff_bounded
   by (blast dest:less_imp_le_nat le_imp_less_Suc)
 
 lemma finite_less_ub:
      "\<And>f::nat\<Rightarrow>nat. (!!n. n \<le> f n) \<Longrightarrow> finite {n. f n \<le> u}"
   by (rule finite_subset[of _ "{..u}"])
     (auto intro: order_trans)
 
 lemma bounded_Max_nat:
   fixes P :: "nat \<Rightarrow> bool"
   assumes x: "P x" and M: "\<And>x. P x \<Longrightarrow> x \<le> M"
   obtains m where "P m" "\<And>x. P x \<Longrightarrow> x \<le> m"
 proof -
   have "finite {x. P x}"
     using M finite_nat_set_iff_bounded_le by auto
   then have "Max {x. P x} \<in> {x. P x}"
     using Max_in x by auto
   then show ?thesis
     by (simp add: \<open>finite {x. P x}\<close> that)
 qed
 
 
 text\<open>Any subset of an interval of natural numbers the size of the
 subset is exactly that interval.\<close>
 
 lemma subset_card_intvl_is_intvl:
   assumes "A \<subseteq> {k..<k + card A}"
   shows "A = {k..<k + card A}"
 proof (cases "finite A")
   case True
   from this and assms show ?thesis
   proof (induct A rule: finite_linorder_max_induct)
     case empty thus ?case by auto
   next
     case (insert b A)
     hence *: "b \<notin> A" by auto
     with insert have "A \<le> {k..<k + card A}" and "b = k + card A"
       by fastforce+
     with insert * show ?case by auto
   qed
 next
   case False
   with assms show ?thesis by simp
 qed
 
 
 subsubsection \<open>Proving Inclusions and Equalities between Unions\<close>
 
 lemma UN_le_eq_Un0:
   "(\<Union>i\<le>n::nat. M i) = (\<Union>i\<in>{1..n}. M i) \<union> M 0" (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
   proof
     fix x assume "x \<in> ?A"
     then obtain i where i: "i\<le>n" "x \<in> M i" by auto
     show "x \<in> ?B"
     proof(cases i)
       case 0 with i show ?thesis by simp
     next
       case (Suc j) with i show ?thesis by auto
     qed
   qed
 next
   show "?B \<subseteq> ?A" by fastforce
 qed
 
 lemma UN_le_add_shift:
   "(\<Union>i\<le>n::nat. M(i+k)) = (\<Union>i\<in>{k..n+k}. M i)" (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B" by fastforce
 next
   show "?B \<subseteq> ?A"
   proof
     fix x assume "x \<in> ?B"
     then obtain i where i: "i \<in> {k..n+k}" "x \<in> M(i)" by auto
     hence "i-k\<le>n \<and> x \<in> M((i-k)+k)" by auto
     thus "x \<in> ?A" by blast
   qed
 qed
 
 lemma UN_le_add_shift_strict:
   "(\<Union>i<n::nat. M(i+k)) = (\<Union>i\<in>{k..<n+k}. M i)" (is "?A = ?B")
 proof
   show "?B \<subseteq> ?A"
   proof
     fix x assume "x \<in> ?B"
     then obtain i where i: "i \<in> {k..<n+k}" "x \<in> M(i)" by auto
     then have "i - k < n \<and> x \<in> M((i-k) + k)" by auto
     then show "x \<in> ?A" using UN_le_add_shift by blast
   qed
 qed (fastforce)
 
 lemma UN_UN_finite_eq: "(\<Union>n::nat. \<Union>i\<in>{0..<n}. A i) = (\<Union>n. A n)"
   by (auto simp add: atLeast0LessThan)
 
 lemma UN_finite_subset:
   "(\<And>n::nat. (\<Union>i\<in>{0..<n}. A i) \<subseteq> C) \<Longrightarrow> (\<Union>n. A n) \<subseteq> C"
   by (subst UN_UN_finite_eq [symmetric]) blast
 
 lemma UN_finite2_subset:
   assumes "\<And>n::nat. (\<Union>i\<in>{0..<n}. A i) \<subseteq> (\<Union>i\<in>{0..<n + k}. B i)"
   shows "(\<Union>n. A n) \<subseteq> (\<Union>n. B n)"
 proof (rule UN_finite_subset, rule subsetI)
   fix n and a
   from assms have "(\<Union>i\<in>{0..<n}. A i) \<subseteq> (\<Union>i\<in>{0..<n + k}. B i)" .
   moreover assume "a \<in> (\<Union>i\<in>{0..<n}. A i)"
   ultimately have "a \<in> (\<Union>i\<in>{0..<n + k}. B i)" by blast
   then show "a \<in> (\<Union>i. B i)" by (auto simp add: UN_UN_finite_eq)
 qed
 
 lemma UN_finite2_eq:
   assumes "(\<And>n::nat. (\<Union>i\<in>{0..<n}. A i) = (\<Union>i\<in>{0..<n + k}. B i))"
   shows "(\<Union>n. A n) = (\<Union>n. B n)"
 proof (rule subset_antisym [OF UN_finite_subset UN_finite2_subset])
   fix n
   show "\<Union> (A ` {0..<n}) \<subseteq> (\<Union>n. B n)"
     using assms by auto
 next
   fix n
   show "\<Union> (B ` {0..<n}) \<subseteq> \<Union> (A ` {0..<n + k})"
     using assms by (force simp add: atLeastLessThan_add_Un [of 0])+
 qed
 
 
 subsubsection \<open>Cardinality\<close>
 
 lemma card_lessThan [simp]: "card {..<u} = u"
   by (induct u, simp_all add: lessThan_Suc)
 
 lemma card_atMost [simp]: "card {..u} = Suc u"
   by (simp add: lessThan_Suc_atMost [THEN sym])
 
 lemma card_atLeastLessThan [simp]: "card {l..<u} = u - l"
 proof -
   have "(\<lambda>x. x + l) ` {..<u - l} \<subseteq> {l..<u}"
     by auto
   moreover have "{l..<u} \<subseteq> (\<lambda>x. x + l) ` {..<u-l}"
   proof
     fix x
     assume *: "x \<in> {l..<u}"
     then have "x - l \<in> {..< u -l}"
       by auto
     then have "(x - l) + l \<in> (\<lambda>x. x + l) ` {..< u -l}"
       by auto
     then show "x \<in> (\<lambda>x. x + l) ` {..<u - l}"
       using * by auto
   qed
   ultimately have "{l..<u} = (\<lambda>x. x + l) ` {..<u-l}"
     by auto
   then have "card {l..<u} = card {..<u-l}"
     by (simp add: card_image inj_on_def)
   then show ?thesis
     by simp
 qed
 
 lemma card_atLeastAtMost [simp]: "card {l..u} = Suc u - l"
   by (subst atLeastLessThanSuc_atLeastAtMost [THEN sym], simp)
 
 lemma card_greaterThanAtMost [simp]: "card {l<..u} = u - l"
   by (subst atLeastSucAtMost_greaterThanAtMost [THEN sym], simp)
 
 lemma card_greaterThanLessThan [simp]: "card {l<..<u} = u - Suc l"
   by (subst atLeastSucLessThan_greaterThanLessThan [THEN sym], simp)
 
 lemma subset_eq_atLeast0_lessThan_finite:
   fixes n :: nat
   assumes "N \<subseteq> {0..<n}"
   shows "finite N"
   using assms finite_atLeastLessThan by (rule finite_subset)
 
 lemma subset_eq_atLeast0_atMost_finite:
   fixes n :: nat
   assumes "N \<subseteq> {0..n}"
   shows "finite N"
   using assms finite_atLeastAtMost by (rule finite_subset)
 
 lemma ex_bij_betw_nat_finite:
   "finite M \<Longrightarrow> \<exists>h. bij_betw h {0..<card M} M"
   apply(drule finite_imp_nat_seg_image_inj_on)
   apply(auto simp:atLeast0LessThan[symmetric] lessThan_def[symmetric] card_image bij_betw_def)
   done
 
 lemma ex_bij_betw_finite_nat:
   "finite M \<Longrightarrow> \<exists>h. bij_betw h M {0..<card M}"
   by (blast dest: ex_bij_betw_nat_finite bij_betw_inv)
 
 lemma finite_same_card_bij:
   "finite A \<Longrightarrow> finite B \<Longrightarrow> card A = card B \<Longrightarrow> \<exists>h. bij_betw h A B"
   apply(drule ex_bij_betw_finite_nat)
   apply(drule ex_bij_betw_nat_finite)
   apply(auto intro!:bij_betw_trans)
   done
 
 lemma ex_bij_betw_nat_finite_1:
   "finite M \<Longrightarrow> \<exists>h. bij_betw h {1 .. card M} M"
   by (rule finite_same_card_bij) auto
 
 lemma bij_betw_iff_card:
   assumes "finite A" "finite B"
   shows "(\<exists>f. bij_betw f A B) \<longleftrightarrow> (card A = card B)"
 proof
   assume "card A = card B"
   moreover obtain f where "bij_betw f A {0 ..< card A}"
     using assms ex_bij_betw_finite_nat by blast
   moreover obtain g where "bij_betw g {0 ..< card B} B"
     using assms ex_bij_betw_nat_finite by blast
   ultimately have "bij_betw (g \<circ> f) A B"
     by (auto simp: bij_betw_trans)
   thus "(\<exists>f. bij_betw f A B)" by blast
 qed (auto simp: bij_betw_same_card)
 
 lemma subset_eq_atLeast0_lessThan_card:
   fixes n :: nat
   assumes "N \<subseteq> {0..<n}"
   shows "card N \<le> n"
 proof -
   from assms finite_lessThan have "card N \<le> card {0..<n}"
     using card_mono by blast
   then show ?thesis by simp
 qed
 
 text \<open>Relational version of @{thm [source] card_inj_on_le}:\<close>
 lemma card_le_if_inj_on_rel:
 assumes "finite B"
   "\<And>a. a \<in> A \<Longrightarrow> \<exists>b. b\<in>B \<and> r a b"
   "\<And>a1 a2 b. \<lbrakk> a1 \<in> A;  a2 \<in> A;  b \<in> B;  r a1 b;  r a2 b \<rbrakk> \<Longrightarrow> a1 = a2"
 shows "card A \<le> card B"
 proof -
   let ?P = "\<lambda>a b. b \<in> B \<and> r a b"
   let ?f = "\<lambda>a. SOME b. ?P a b"
   have 1: "?f ` A \<subseteq> B"  by (auto intro: someI2_ex[OF assms(2)])
   have "inj_on ?f A"
     unfolding inj_on_def
   proof safe
     fix a1 a2 assume asms: "a1 \<in> A" "a2 \<in> A" "?f a1 = ?f a2"
     have 0: "?f a1 \<in> B" using "1" \<open>a1 \<in> A\<close> by blast
     have 1: "r a1 (?f a1)" using someI_ex[OF assms(2)[OF \<open>a1 \<in> A\<close>]] by blast
     have 2: "r a2 (?f a1)" using someI_ex[OF assms(2)[OF \<open>a2 \<in> A\<close>]] asms(3) by auto
     show "a1 = a2" using assms(3)[OF asms(1,2) 0 1 2] .
   qed
   with 1 show ?thesis using card_inj_on_le[of ?f A B] assms(1) by simp
 qed
 
 lemma inj_on_funpow_least: \<^marker>\<open>contributor \<open>Lars Noschinski\<close>\<close>
   \<open>inj_on (\<lambda>k. (f ^^ k) s) {0..<n}\<close>
   if \<open>(f ^^ n) s = s\<close> \<open>\<And>m. 0 < m \<Longrightarrow> m < n \<Longrightarrow> (f ^^ m) s \<noteq> s\<close>
 proof -
   { fix k l assume A: "k < n" "l < n" "k \<noteq> l" "(f ^^ k) s = (f ^^ l) s"
     define k' l' where "k' = min k l" and "l' = max k l"
     with A have A': "k' < l'" "(f ^^ k') s = (f ^^ l') s" "l' < n"
       by (auto simp: min_def max_def)
 
     have "s = (f ^^ ((n - l') + l')) s" using that \<open>l' < n\<close> by simp
     also have "\<dots> = (f ^^ (n - l')) ((f ^^ l') s)" by (simp add: funpow_add)
     also have "(f ^^ l') s = (f ^^ k') s" by (simp add: A')
     also have "(f ^^ (n - l')) \<dots> = (f ^^ (n - l' + k')) s" by (simp add: funpow_add)
     finally have "(f ^^ (n - l' + k')) s = s" by simp
     moreover have "n - l' + k' < n" "0 < n - l' + k'"using A' by linarith+
     ultimately have False using that(2) by auto
   }
   then show ?thesis by (intro inj_onI) auto
 qed
 
 
 subsection \<open>Intervals of integers\<close>
 
 lemma atLeastLessThanPlusOne_atLeastAtMost_int: "{l..<u+1} = {l..(u::int)}"
   by (auto simp add: atLeastAtMost_def atLeastLessThan_def)
 
 lemma atLeastPlusOneAtMost_greaterThanAtMost_int: "{l+1..u} = {l<..(u::int)}"
   by (auto simp add: atLeastAtMost_def greaterThanAtMost_def)
 
 lemma atLeastPlusOneLessThan_greaterThanLessThan_int:
     "{l+1..<u} = {l<..<u::int}"
   by (auto simp add: atLeastLessThan_def greaterThanLessThan_def)
 
 subsubsection \<open>Finiteness\<close>
 
 lemma image_atLeastZeroLessThan_int:
   assumes "0 \<le> u"
   shows "{(0::int)..<u} = int ` {..<nat u}"
   unfolding image_def lessThan_def
 proof
   show "{0..<u} \<subseteq> {y. \<exists>x\<in>{x. x < nat u}. y = int x}"
   proof
     fix x
     assume "x \<in> {0..<u}"
     then have "x = int (nat x)" and  "nat x < nat u"
       by (auto simp add: zless_nat_eq_int_zless [THEN sym])
     then have "\<exists>xa<nat u. x = int xa"
       using exI[of _ "(nat x)"] by simp
     then show "x \<in> {y. \<exists>x\<in>{x. x < nat u}. y = int x}"
       by simp
   qed
 qed (auto)
 
 
 lemma finite_atLeastZeroLessThan_int: "finite {(0::int)..<u}"
 proof (cases "0 \<le> u")
   case True
   then show ?thesis
     by (auto simp: image_atLeastZeroLessThan_int)
 qed auto
 
 lemma finite_atLeastLessThan_int [iff]: "finite {l..<u::int}"
   by (simp only: image_add_int_atLeastLessThan [symmetric, of l] finite_imageI finite_atLeastZeroLessThan_int)
 
 lemma finite_atLeastAtMost_int [iff]: "finite {l..(u::int)}"
   by (subst atLeastLessThanPlusOne_atLeastAtMost_int [THEN sym], simp)
 
 lemma finite_greaterThanAtMost_int [iff]: "finite {l<..(u::int)}"
   by (subst atLeastPlusOneAtMost_greaterThanAtMost_int [THEN sym], simp)
 
 lemma finite_greaterThanLessThan_int [iff]: "finite {l<..<u::int}"
   by (subst atLeastPlusOneLessThan_greaterThanLessThan_int [THEN sym], simp)
 
 
 subsubsection \<open>Cardinality\<close>
 
 lemma card_atLeastZeroLessThan_int: "card {(0::int)..<u} = nat u"
 proof (cases "0 \<le> u")
   case True
   then show ?thesis
     by (auto simp: image_atLeastZeroLessThan_int card_image inj_on_def)    
 qed auto
 
 lemma card_atLeastLessThan_int [simp]: "card {l..<u} = nat (u - l)"
 proof -
   have "card {l..<u} = card {0..<u-l}"
     apply (subst image_add_int_atLeastLessThan [symmetric])
     apply (rule card_image)
     apply (simp add: inj_on_def)
     done
   then show ?thesis
     by (simp add: card_atLeastZeroLessThan_int)
 qed
 
 lemma card_atLeastAtMost_int [simp]: "card {l..u} = nat (u - l + 1)"
   apply (subst atLeastLessThanPlusOne_atLeastAtMost_int [THEN sym])
   apply (auto simp add: algebra_simps)
   done
 
 lemma card_greaterThanAtMost_int [simp]: "card {l<..u} = nat (u - l)"
   by (subst atLeastPlusOneAtMost_greaterThanAtMost_int [THEN sym], simp)
 
 lemma card_greaterThanLessThan_int [simp]: "card {l<..<u} = nat (u - (l + 1))"
   by (subst atLeastPlusOneLessThan_greaterThanLessThan_int [THEN sym], simp)
 
 lemma finite_M_bounded_by_nat: "finite {k. P k \<and> k < (i::nat)}"
 proof -
   have "{k. P k \<and> k < i} \<subseteq> {..<i}" by auto
   with finite_lessThan[of "i"] show ?thesis by (simp add: finite_subset)
 qed
 
 lemma card_less:
   assumes zero_in_M: "0 \<in> M"
   shows "card {k \<in> M. k < Suc i} \<noteq> 0"
 proof -
   from zero_in_M have "{k \<in> M. k < Suc i} \<noteq> {}" by auto
   with finite_M_bounded_by_nat show ?thesis by (auto simp add: card_eq_0_iff)
 qed
 
 lemma card_less_Suc2: 
   assumes "0 \<notin> M" shows "card {k. Suc k \<in> M \<and> k < i} = card {k \<in> M. k < Suc i}"
 proof -
   have *: "\<lbrakk>j \<in> M; j < Suc i\<rbrakk> \<Longrightarrow> j - Suc 0 < i \<and> Suc (j - Suc 0) \<in> M \<and> Suc 0 \<le> j" for j
     by (cases j) (use assms in auto)
   show ?thesis
   proof (rule card_bij_eq)
     show "inj_on Suc {k. Suc k \<in> M \<and> k < i}"
       by force
     show "inj_on (\<lambda>x. x - Suc 0) {k \<in> M. k < Suc i}"
       by (rule inj_on_diff_nat) (use * in blast)
   qed (use * in auto)
 qed
 
 lemma card_less_Suc:
   assumes "0 \<in> M"
     shows "Suc (card {k. Suc k \<in> M \<and> k < i}) = card {k \<in> M. k < Suc i}"
 proof -
   have "Suc (card {k. Suc k \<in> M \<and> k < i}) = Suc (card {k. Suc k \<in> M - {0} \<and> k < i})"
     by simp
   also have "\<dots> = Suc (card {k \<in> M - {0}. k < Suc i})"
     apply (subst card_less_Suc2)
     using assms by auto
   also have "\<dots> = Suc (card ({k \<in> M. k < Suc i} - {0}))"
     by (force intro: arg_cong [where f=card])
   also have "\<dots> = card (insert 0 ({k \<in> M. k < Suc i} - {0}))"
     by (simp add: card.insert_remove)
   also have "... = card {k \<in> M. k < Suc i}"
     using assms
     by (force simp add: intro: arg_cong [where f=card])
   finally show ?thesis.
 qed
 
 lemma card_le_Suc_Max: "finite S \<Longrightarrow> card S \<le> Suc (Max S)"
 proof (rule classical)
   assume "finite S" and "\<not> Suc (Max S) \<ge> card S"
   then have "Suc (Max S) < card S"
     by simp
   with \<open>finite S\<close> have "S \<subseteq> {0..Max S}"
     by auto
   hence "card S \<le> card {0..Max S}"
     by (intro card_mono; auto)
   thus "card S \<le> Suc (Max S)"
     by simp
 qed
 
 subsection \<open>Lemmas useful with the summation operator sum\<close>
 
 text \<open>For examples, see Algebra/poly/UnivPoly2.thy\<close>
 
 subsubsection \<open>Disjoint Unions\<close>
 
 text \<open>Singletons and open intervals\<close>
 
 lemma ivl_disj_un_singleton:
   "{l::'a::linorder} Un {l<..} = {l..}"
   "{..<u} Un {u::'a::linorder} = {..u}"
   "(l::'a::linorder) < u ==> {l} Un {l<..<u} = {l..<u}"
   "(l::'a::linorder) < u ==> {l<..<u} Un {u} = {l<..u}"
   "(l::'a::linorder) \<le> u ==> {l} Un {l<..u} = {l..u}"
   "(l::'a::linorder) \<le> u ==> {l..<u} Un {u} = {l..u}"
 by auto
 
 text \<open>One- and two-sided intervals\<close>
 
 lemma ivl_disj_un_one:
   "(l::'a::linorder) < u ==> {..l} Un {l<..<u} = {..<u}"
   "(l::'a::linorder) \<le> u ==> {..<l} Un {l..<u} = {..<u}"
   "(l::'a::linorder) \<le> u ==> {..l} Un {l<..u} = {..u}"
   "(l::'a::linorder) \<le> u ==> {..<l} Un {l..u} = {..u}"
   "(l::'a::linorder) \<le> u ==> {l<..u} Un {u<..} = {l<..}"
   "(l::'a::linorder) < u ==> {l<..<u} Un {u..} = {l<..}"
   "(l::'a::linorder) \<le> u ==> {l..u} Un {u<..} = {l..}"
   "(l::'a::linorder) \<le> u ==> {l..<u} Un {u..} = {l..}"
 by auto
 
 text \<open>Two- and two-sided intervals\<close>
 
 lemma ivl_disj_un_two:
   "[| (l::'a::linorder) < m; m \<le> u |] ==> {l<..<m} Un {m..<u} = {l<..<u}"
   "[| (l::'a::linorder) \<le> m; m < u |] ==> {l<..m} Un {m<..<u} = {l<..<u}"
   "[| (l::'a::linorder) \<le> m; m \<le> u |] ==> {l..<m} Un {m..<u} = {l..<u}"
   "[| (l::'a::linorder) \<le> m; m < u |] ==> {l..m} Un {m<..<u} = {l..<u}"
   "[| (l::'a::linorder) < m; m \<le> u |] ==> {l<..<m} Un {m..u} = {l<..u}"
   "[| (l::'a::linorder) \<le> m; m \<le> u |] ==> {l<..m} Un {m<..u} = {l<..u}"
   "[| (l::'a::linorder) \<le> m; m \<le> u |] ==> {l..<m} Un {m..u} = {l..u}"
   "[| (l::'a::linorder) \<le> m; m \<le> u |] ==> {l..m} Un {m<..u} = {l..u}"
 by auto
 
 lemma ivl_disj_un_two_touch:
   "[| (l::'a::linorder) < m; m < u |] ==> {l<..m} Un {m..<u} = {l<..<u}"
   "[| (l::'a::linorder) \<le> m; m < u |] ==> {l..m} Un {m..<u} = {l..<u}"
   "[| (l::'a::linorder) < m; m \<le> u |] ==> {l<..m} Un {m..u} = {l<..u}"
   "[| (l::'a::linorder) \<le> m; m \<le> u |] ==> {l..m} Un {m..u} = {l..u}"
 by auto
 
 lemmas ivl_disj_un = ivl_disj_un_singleton ivl_disj_un_one ivl_disj_un_two ivl_disj_un_two_touch
 
 subsubsection \<open>Disjoint Intersections\<close>
 
 text \<open>One- and two-sided intervals\<close>
 
 lemma ivl_disj_int_one:
   "{..l::'a::order} Int {l<..<u} = {}"
   "{..<l} Int {l..<u} = {}"
   "{..l} Int {l<..u} = {}"
   "{..<l} Int {l..u} = {}"
   "{l<..u} Int {u<..} = {}"
   "{l<..<u} Int {u..} = {}"
   "{l..u} Int {u<..} = {}"
   "{l..<u} Int {u..} = {}"
   by auto
 
 text \<open>Two- and two-sided intervals\<close>
 
 lemma ivl_disj_int_two:
   "{l::'a::order<..<m} Int {m..<u} = {}"
   "{l<..m} Int {m<..<u} = {}"
   "{l..<m} Int {m..<u} = {}"
   "{l..m} Int {m<..<u} = {}"
   "{l<..<m} Int {m..u} = {}"
   "{l<..m} Int {m<..u} = {}"
   "{l..<m} Int {m..u} = {}"
   "{l..m} Int {m<..u} = {}"
   by auto
 
 lemmas ivl_disj_int = ivl_disj_int_one ivl_disj_int_two
 
 subsubsection \<open>Some Differences\<close>
 
 lemma ivl_diff[simp]:
  "i \<le> n \<Longrightarrow> {i..<m} - {i..<n} = {n..<(m::'a::linorder)}"
 by(auto)
 
 lemma (in linorder) lessThan_minus_lessThan [simp]:
   "{..< n} - {..< m} = {m ..< n}"
   by auto
 
 lemma (in linorder) atLeastAtMost_diff_ends:
   "{a..b} - {a, b} = {a<..<b}"
   by auto
 
 
 subsubsection \<open>Some Subset Conditions\<close>
 
 lemma ivl_subset [simp]: "({i..<j} \<subseteq> {m..<n}) = (j \<le> i \<or> m \<le> i \<and> j \<le> (n::'a::linorder))"
   using linorder_class.le_less_linear[of i n]
   by safe (force intro: leI)+
 
 
 subsection \<open>Generic big monoid operation over intervals\<close>
 
 context semiring_char_0
 begin
 
 lemma inj_on_of_nat [simp]:
   "inj_on of_nat N"
   by (rule inj_onI) simp
 
 lemma bij_betw_of_nat [simp]:
   "bij_betw of_nat N A \<longleftrightarrow> of_nat ` N = A"
   by (simp add: bij_betw_def)
 
 lemma Nats_infinite: "infinite (\<nat> :: 'a set)"
   by (metis Nats_def finite_imageD infinite_UNIV_char_0 inj_on_of_nat)
 
 end
 
 context comm_monoid_set
 begin
 
 lemma atLeastLessThan_reindex:
   "F g {h m..<h n} = F (g \<circ> h) {m..<n}"
   if "bij_betw h {m..<n} {h m..<h n}" for m n ::nat
 proof -
   from that have "inj_on h {m..<n}" and "h ` {m..<n} = {h m..<h n}"
     by (simp_all add: bij_betw_def)
   then show ?thesis
     using reindex [of h "{m..<n}" g] by simp
 qed
 
 lemma atLeastAtMost_reindex:
   "F g {h m..h n} = F (g \<circ> h) {m..n}"
   if "bij_betw h {m..n} {h m..h n}" for m n ::nat
 proof -
   from that have "inj_on h {m..n}" and "h ` {m..n} = {h m..h n}"
     by (simp_all add: bij_betw_def)
   then show ?thesis
     using reindex [of h "{m..n}" g] by simp
 qed
 
 lemma atLeastLessThan_shift_bounds:
   "F g {m + k..<n + k} = F (g \<circ> plus k) {m..<n}"
   for m n k :: nat
   using atLeastLessThan_reindex [of "plus k" m n g]
   by (simp add: ac_simps)
 
 lemma atLeastAtMost_shift_bounds:
   "F g {m + k..n + k} = F (g \<circ> plus k) {m..n}"
   for m n k :: nat
   using atLeastAtMost_reindex [of "plus k" m n g]
   by (simp add: ac_simps)
 
 lemma atLeast_Suc_lessThan_Suc_shift:
   "F g {Suc m..<Suc n} = F (g \<circ> Suc) {m..<n}"
   using atLeastLessThan_shift_bounds [of _ _ 1]
   by (simp add: plus_1_eq_Suc)
 
 lemma atLeast_Suc_atMost_Suc_shift:
   "F g {Suc m..Suc n} = F (g \<circ> Suc) {m..n}"
   using atLeastAtMost_shift_bounds [of _ _ 1]
   by (simp add: plus_1_eq_Suc)
 
 lemma atLeast_atMost_pred_shift:
   "F (g \<circ> (\<lambda>n. n - Suc 0)) {Suc m..Suc n} = F g {m..n}"
   unfolding atLeast_Suc_atMost_Suc_shift by simp
 
 lemma atLeast_lessThan_pred_shift:
   "F (g \<circ> (\<lambda>n. n - Suc 0)) {Suc m..<Suc n} = F g {m..<n}"
   unfolding atLeast_Suc_lessThan_Suc_shift by simp
 
 lemma atLeast_int_lessThan_int_shift:
   "F g {int m..<int n} = F (g \<circ> int) {m..<n}"
   by (rule atLeastLessThan_reindex)
     (simp add: image_int_atLeastLessThan)
 
 lemma atLeast_int_atMost_int_shift:
   "F g {int m..int n} = F (g \<circ> int) {m..n}"
   by (rule atLeastAtMost_reindex)
     (simp add: image_int_atLeastAtMost)
 
 lemma atLeast0_lessThan_Suc:
   "F g {0..<Suc n} = F g {0..<n} \<^bold>* g n"
   by (simp add: atLeast0_lessThan_Suc ac_simps)
 
 lemma atLeast0_atMost_Suc:
   "F g {0..Suc n} = F g {0..n} \<^bold>* g (Suc n)"
   by (simp add: atLeast0_atMost_Suc ac_simps)
 
 lemma atLeast0_lessThan_Suc_shift:
   "F g {0..<Suc n} = g 0 \<^bold>* F (g \<circ> Suc) {0..<n}"
   by (simp add: atLeast0_lessThan_Suc_eq_insert_0 atLeast_Suc_lessThan_Suc_shift)
 
 lemma atLeast0_atMost_Suc_shift:
   "F g {0..Suc n} = g 0 \<^bold>* F (g \<circ> Suc) {0..n}"
   by (simp add: atLeast0_atMost_Suc_eq_insert_0 atLeast_Suc_atMost_Suc_shift)
 
 lemma atLeast_Suc_lessThan:
   "F g {m..<n} = g m \<^bold>* F g {Suc m..<n}" if "m < n"
 proof -
   from that have "{m..<n} = insert m {Suc m..<n}"
     by auto
   then show ?thesis by simp
 qed
 
 lemma atLeast_Suc_atMost:
   "F g {m..n} = g m \<^bold>* F g {Suc m..n}" if "m \<le> n"
 proof -
   from that have "{m..n} = insert m {Suc m..n}"
     by auto
   then show ?thesis by simp
 qed
 
 lemma ivl_cong:
   "a = c \<Longrightarrow> b = d \<Longrightarrow> (\<And>x. c \<le> x \<Longrightarrow> x < d \<Longrightarrow> g x = h x)
     \<Longrightarrow> F g {a..<b} = F h {c..<d}"
   by (rule cong) simp_all
 
 lemma atLeastLessThan_shift_0:
   fixes m n p :: nat
   shows "F g {m..<n} = F (g \<circ> plus m) {0..<n - m}"
   using atLeastLessThan_shift_bounds [of g 0 m "n - m"]
   by (cases "m \<le> n") simp_all
 
 lemma atLeastAtMost_shift_0:
   fixes m n p :: nat
   assumes "m \<le> n"
   shows "F g {m..n} = F (g \<circ> plus m) {0..n - m}"
   using assms atLeastAtMost_shift_bounds [of g 0 m "n - m"] by simp
 
 lemma atLeastLessThan_concat:
   fixes m n p :: nat
   shows "m \<le> n \<Longrightarrow> n \<le> p \<Longrightarrow> F g {m..<n} \<^bold>* F g {n..<p} = F g {m..<p}"
   by (simp add: union_disjoint [symmetric] ivl_disj_un)
 
 lemma atLeastLessThan_rev:
   "F g {n..<m} = F (\<lambda>i. g (m + n - Suc i)) {n..<m}"
   by (rule reindex_bij_witness [where i="\<lambda>i. m + n - Suc i" and j="\<lambda>i. m + n - Suc i"], auto)
 
 lemma atLeastAtMost_rev:
   fixes n m :: nat
   shows "F g {n..m} = F (\<lambda>i. g (m + n - i)) {n..m}"
   by (rule reindex_bij_witness [where i="\<lambda>i. m + n - i" and j="\<lambda>i. m + n - i"]) auto
 
 lemma atLeastLessThan_rev_at_least_Suc_atMost:
   "F g {n..<m} = F (\<lambda>i. g (m + n - i)) {Suc n..m}"
   unfolding atLeastLessThan_rev [of g n m]
   by (cases m) (simp_all add: atLeast_Suc_atMost_Suc_shift atLeastLessThanSuc_atLeastAtMost)
 
 end
 
 
 subsection \<open>Summation indexed over intervals\<close>
 
 syntax (ASCII)
   "_from_to_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(SUM _ = _.._./ _)" [0,0,0,10] 10)
   "_from_upto_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(SUM _ = _..<_./ _)" [0,0,0,10] 10)
   "_upt_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(SUM _<_./ _)" [0,0,10] 10)
   "_upto_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(SUM _<=_./ _)" [0,0,10] 10)
 
 syntax (latex_sum output)
   "_from_to_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
  ("(3\<^latex>\<open>$\\sum_{\<close>_ = _\<^latex>\<open>}^{\<close>_\<^latex>\<open>}$\<close> _)" [0,0,0,10] 10)
   "_from_upto_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
  ("(3\<^latex>\<open>$\\sum_{\<close>_ = _\<^latex>\<open>}^{<\<close>_\<^latex>\<open>}$\<close> _)" [0,0,0,10] 10)
   "_upt_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
  ("(3\<^latex>\<open>$\\sum_{\<close>_ < _\<^latex>\<open>}$\<close> _)" [0,0,10] 10)
   "_upto_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
  ("(3\<^latex>\<open>$\\sum_{\<close>_ \<le> _\<^latex>\<open>}$\<close> _)" [0,0,10] 10)
 
 syntax
   "_from_to_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Sum>_ = _.._./ _)" [0,0,0,10] 10)
   "_from_upto_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Sum>_ = _..<_./ _)" [0,0,0,10] 10)
   "_upt_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Sum>_<_./ _)" [0,0,10] 10)
   "_upto_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Sum>_\<le>_./ _)" [0,0,10] 10)
 
 translations
   "\<Sum>x=a..b. t" == "CONST sum (\<lambda>x. t) {a..b}"
   "\<Sum>x=a..<b. t" == "CONST sum (\<lambda>x. t) {a..<b}"
   "\<Sum>i\<le>n. t" == "CONST sum (\<lambda>i. t) {..n}"
   "\<Sum>i<n. t" == "CONST sum (\<lambda>i. t) {..<n}"
 
 text\<open>The above introduces some pretty alternative syntaxes for
 summation over intervals:
 \begin{center}
 \begin{tabular}{lll}
 Old & New & \LaTeX\\
 @{term[source]"\<Sum>x\<in>{a..b}. e"} & \<^term>\<open>\<Sum>x=a..b. e\<close> & @{term[mode=latex_sum]"\<Sum>x=a..b. e"}\\
 @{term[source]"\<Sum>x\<in>{a..<b}. e"} & \<^term>\<open>\<Sum>x=a..<b. e\<close> & @{term[mode=latex_sum]"\<Sum>x=a..<b. e"}\\
 @{term[source]"\<Sum>x\<in>{..b}. e"} & \<^term>\<open>\<Sum>x\<le>b. e\<close> & @{term[mode=latex_sum]"\<Sum>x\<le>b. e"}\\
 @{term[source]"\<Sum>x\<in>{..<b}. e"} & \<^term>\<open>\<Sum>x<b. e\<close> & @{term[mode=latex_sum]"\<Sum>x<b. e"}
 \end{tabular}
 \end{center}
 The left column shows the term before introduction of the new syntax,
 the middle column shows the new (default) syntax, and the right column
 shows a special syntax. The latter is only meaningful for latex output
 and has to be activated explicitly by setting the print mode to
 \<open>latex_sum\<close> (e.g.\ via \<open>mode = latex_sum\<close> in
 antiquotations). It is not the default \LaTeX\ output because it only
 works well with italic-style formulae, not tt-style.
 
 Note that for uniformity on \<^typ>\<open>nat\<close> it is better to use
 \<^term>\<open>\<Sum>x::nat=0..<n. e\<close> rather than \<open>\<Sum>x<n. e\<close>: \<open>sum\<close> may
 not provide all lemmas available for \<^term>\<open>{m..<n}\<close> also in the
 special form for \<^term>\<open>{..<n}\<close>.\<close>
 
 text\<open>This congruence rule should be used for sums over intervals as
 the standard theorem @{text[source]sum.cong} does not work well
 with the simplifier who adds the unsimplified premise \<^term>\<open>x\<in>B\<close> to
 the context.\<close>
 
 context comm_monoid_set
 begin
 
 lemma zero_middle:
   assumes "1 \<le> p" "k \<le> p"
   shows "F (\<lambda>j. if j < k then g j else if j = k then \<^bold>1 else h (j - Suc 0)) {..p}
        = F (\<lambda>j. if j < k then g j else h j) {..p - Suc 0}"  (is "?lhs = ?rhs")
 proof -
   have [simp]: "{..p - Suc 0} \<inter> {j. j < k} = {..<k}" "{..p - Suc 0} \<inter> - {j. j < k} = {k..p - Suc 0}"
     using assms by auto
   have "?lhs = F g {..<k} \<^bold>* F (\<lambda>j. if j = k then \<^bold>1 else h (j - Suc 0)) {k..p}"
     using union_disjoint [of "{..<k}" "{k..p}"] assms
     by (simp add: ivl_disj_int_one ivl_disj_un_one)
   also have "\<dots> = F g {..<k} \<^bold>* F (\<lambda>j.  h (j - Suc 0)) {Suc k..p}"
     by (simp add: atLeast_Suc_atMost [of k p] assms)
   also have "\<dots> = F g {..<k} \<^bold>* F h {k .. p - Suc 0}"
     using reindex [of Suc "{k..p - Suc 0}"] assms by simp
   also have "\<dots> = ?rhs"
     by (simp add: If_cases)
   finally show ?thesis .
 qed
 
 lemma atMost_Suc [simp]:
   "F g {..Suc n} = F g {..n} \<^bold>* g (Suc n)"
   by (simp add: atMost_Suc ac_simps)
 
 lemma lessThan_Suc [simp]:
   "F g {..<Suc n} = F g {..<n} \<^bold>* g n"
   by (simp add: lessThan_Suc ac_simps)
 
 lemma cl_ivl_Suc [simp]:
   "F g {m..Suc n} = (if Suc n < m then \<^bold>1 else F g {m..n} \<^bold>* g(Suc n))"
   by (auto simp: ac_simps atLeastAtMostSuc_conv)
 
 lemma op_ivl_Suc [simp]:
   "F g {m..<Suc n} = (if n < m then \<^bold>1 else F g {m..<n} \<^bold>* g(n))"
   by (auto simp: ac_simps atLeastLessThanSuc)
 
 lemma head:
   fixes n :: nat
   assumes mn: "m \<le> n"
   shows "F g {m..n} = g m \<^bold>* F g {m<..n}" (is "?lhs = ?rhs")
 proof -
   from mn
   have "{m..n} = {m} \<union> {m<..n}"
     by (auto intro: ivl_disj_un_singleton)
   hence "?lhs = F g ({m} \<union> {m<..n})"
     by (simp add: atLeast0LessThan)
   also have "\<dots> = ?rhs" by simp
   finally show ?thesis .
 qed
 
 lemma last_plus: 
   fixes n::nat  shows "m \<le> n \<Longrightarrow> F g {m..n} = g n \<^bold>* F g {m..<n}"
   by (cases n) (auto simp: atLeastLessThanSuc_atLeastAtMost commute)
 
 lemma head_if:
   fixes n :: nat
   shows "F g {m..n} = (if n < m then \<^bold>1 else  F g {m..<n} \<^bold>* g(n))"
   by (simp add: commute last_plus)
 
 lemma ub_add_nat: 
   assumes "(m::nat) \<le> n + 1"
   shows "F g {m..n + p} = F g {m..n} \<^bold>* F g {n + 1..n + p}"
 proof-
   have "{m .. n+p} = {m..n} \<union> {n+1..n+p}" using \<open>m \<le> n+1\<close> by auto
   thus ?thesis by (auto simp: ivl_disj_int union_disjoint atLeastSucAtMost_greaterThanAtMost)
 qed
 
 lemma nat_group: 
   fixes k::nat shows "F (\<lambda>m. F g {m * k ..< m*k + k}) {..<n} = F g {..< n * k}"
 proof (cases k)
   case (Suc l)
   then have "k > 0"
     by auto
   then show ?thesis
     by (induct n) (simp_all add: atLeastLessThan_concat add.commute atLeast0LessThan[symmetric])
 qed auto   
 
 lemma triangle_reindex:
   fixes n :: nat
   shows "F (\<lambda>(i,j). g i j) {(i,j). i+j < n} = F (\<lambda>k. F (\<lambda>i. g i (k - i)) {..k}) {..<n}"
   apply (simp add: Sigma)
   apply (rule reindex_bij_witness[where j="\<lambda>(i, j). (i+j, i)" and i="\<lambda>(k, i). (i, k - i)"])
   apply auto
   done
 
 lemma triangle_reindex_eq:
   fixes n :: nat
   shows "F (\<lambda>(i,j). g i j) {(i,j). i+j \<le> n} = F (\<lambda>k. F (\<lambda>i. g i (k - i)) {..k}) {..n}"
 using triangle_reindex [of g "Suc n"]
 by (simp only: Nat.less_Suc_eq_le lessThan_Suc_atMost)
 
 lemma nat_diff_reindex: "F (\<lambda>i. g (n - Suc i)) {..<n} = F g {..<n}"
   by (rule reindex_bij_witness[where i="\<lambda>i. n - Suc i" and j="\<lambda>i. n - Suc i"]) auto
 
 lemma shift_bounds_nat_ivl:
   "F g {m+k..<n+k} = F (\<lambda>i. g(i + k)){m..<n::nat}"
 by (induct "n", auto simp: atLeastLessThanSuc)
 
 lemma shift_bounds_cl_nat_ivl:
   "F g {m+k..n+k} = F (\<lambda>i. g(i + k)){m..n::nat}"
   by (rule reindex_bij_witness[where i="\<lambda>i. i + k" and j="\<lambda>i. i - k"]) auto
 
 corollary shift_bounds_cl_Suc_ivl:
   "F g {Suc m..Suc n} = F (\<lambda>i. g(Suc i)){m..n}"
 by (simp add: shift_bounds_cl_nat_ivl[where k="Suc 0", simplified])
 
 corollary Suc_reindex_ivl: "m \<le> n \<Longrightarrow> F g {m..n} \<^bold>* g (Suc n) = g m \<^bold>* F (\<lambda>i. g (Suc i)) {m..n}"
   by (simp add: assoc atLeast_Suc_atMost flip: shift_bounds_cl_Suc_ivl)
 
 corollary shift_bounds_Suc_ivl:
   "F g {Suc m..<Suc n} = F (\<lambda>i. g(Suc i)){m..<n}"
 by (simp add: shift_bounds_nat_ivl[where k="Suc 0", simplified])
 
 lemma atMost_Suc_shift:
   shows "F g {..Suc n} = g 0 \<^bold>* F (\<lambda>i. g (Suc i)) {..n}"
 proof (induct n)
   case 0 show ?case by simp
 next
   case (Suc n) note IH = this
   have "F g {..Suc (Suc n)} = F g {..Suc n} \<^bold>* g (Suc (Suc n))"
     by (rule atMost_Suc)
   also have "F g {..Suc n}  = g 0 \<^bold>* F (\<lambda>i. g (Suc i)) {..n}"
     by (rule IH)
   also have "g 0 \<^bold>* F (\<lambda>i. g (Suc i)) {..n} \<^bold>* g (Suc (Suc n)) =
              g 0 \<^bold>* (F (\<lambda>i. g (Suc i)) {..n} \<^bold>* g (Suc (Suc n)))"
     by (rule assoc)
   also have "F (\<lambda>i. g (Suc i)) {..n} \<^bold>* g (Suc (Suc n)) = F (\<lambda>i. g (Suc i)) {..Suc n}"
     by (rule atMost_Suc [symmetric])
   finally show ?case .
 qed
 
 lemma lessThan_Suc_shift:
   "F g {..<Suc n} = g 0 \<^bold>* F (\<lambda>i. g (Suc i)) {..<n}"
   by (induction n) (simp_all add: ac_simps)
 
 lemma atMost_shift:
   "F g {..n} = g 0 \<^bold>* F (\<lambda>i. g (Suc i)) {..<n}"
   by (metis atLeast0AtMost atLeast0LessThan atLeastLessThanSuc_atLeastAtMost 
        atLeastSucAtMost_greaterThanAtMost le0 head shift_bounds_Suc_ivl)
 
 lemma nested_swap:
      "F (\<lambda>i. F (\<lambda>j. a i j) {0..<i}) {0..n} = F (\<lambda>j. F (\<lambda>i. a i j) {Suc j..n}) {0..<n}"
   by (induction n) (auto simp: distrib)
 
 lemma nested_swap':
      "F (\<lambda>i. F (\<lambda>j. a i j) {..<i}) {..n} = F (\<lambda>j. F (\<lambda>i. a i j) {Suc j..n}) {..<n}"
   by (induction n) (auto simp: distrib)
 
 lemma atLeast1_atMost_eq:
   "F g {Suc 0..n} = F (\<lambda>k. g (Suc k)) {..<n}"
 proof -
   have "F g {Suc 0..n} = F g (Suc ` {..<n})"
     by (simp add: image_Suc_lessThan)
   also have "\<dots> = F (\<lambda>k. g (Suc k)) {..<n}"
     by (simp add: reindex)
   finally show ?thesis .
 qed
 
 lemma atLeastLessThan_Suc: "a \<le> b \<Longrightarrow> F g {a..<Suc b} = F g {a..<b} \<^bold>* g b"
   by (simp add: atLeastLessThanSuc commute)
 
 lemma nat_ivl_Suc':
   assumes "m \<le> Suc n"
   shows   "F g {m..Suc n} = g (Suc n) \<^bold>* F g {m..n}"
 proof -
   from assms have "{m..Suc n} = insert (Suc n) {m..n}" by auto
   also have "F g \<dots> = g (Suc n) \<^bold>* F g {m..n}" by simp
   finally show ?thesis .
 qed
 
 lemma in_pairs: "F g {2*m..Suc(2*n)} = F (\<lambda>i. g(2*i) \<^bold>* g(Suc(2*i))) {m..n}"
 proof (induction n)
   case 0
   show ?case
     by (cases "m=0") auto
 next
   case (Suc n)
   then show ?case
     by (auto simp: assoc split: if_split_asm)
 qed
 
 lemma in_pairs_0: "F g {..Suc(2*n)} = F (\<lambda>i. g(2*i) \<^bold>* g(Suc(2*i))) {..n}"
   using in_pairs [of _ 0 n] by (simp add: atLeast0AtMost)
 
 end
 
 lemma card_sum_le_nat_sum: "\<Sum> {0..<card S} \<le> \<Sum> S"
 proof (cases "finite S")
   case True
   then show ?thesis
   proof (induction "card S" arbitrary: S)
     case (Suc x)
     then have "Max S \<ge> x" using card_le_Suc_Max by fastforce
     let ?S' = "S - {Max S}"
     from Suc have "Max S \<in> S" by (auto intro: Max_in)
     hence cards: "card S = Suc (card ?S')"
       using \<open>finite S\<close> by (intro card.remove; auto)
     hence "\<Sum> {0..<card ?S'} \<le> \<Sum> ?S'"
       using Suc by (intro Suc; auto)
 
     hence "\<Sum> {0..<card ?S'} + x \<le> \<Sum> ?S' + Max S"
       using \<open>Max S \<ge> x\<close> by simp
     also have "... = \<Sum> S"
       using sum.remove[OF \<open>finite S\<close> \<open>Max S \<in> S\<close>, where g="\<lambda>x. x"]
       by simp
     finally show ?case
       using cards Suc by auto
   qed simp
 qed simp
 
 lemma sum_natinterval_diff:
   fixes f:: "nat \<Rightarrow> ('a::ab_group_add)"
   shows  "sum (\<lambda>k. f k - f(k + 1)) {(m::nat) .. n} =
           (if m \<le> n then f m - f(n + 1) else 0)"
 by (induct n, auto simp add: algebra_simps not_le le_Suc_eq)
 
 lemma sum_diff_nat_ivl:
   fixes f :: "nat \<Rightarrow> 'a::ab_group_add"
   shows "\<lbrakk> m \<le> n; n \<le> p \<rbrakk> \<Longrightarrow> sum f {m..<p} - sum f {m..<n} = sum f {n..<p}"
   using sum.atLeastLessThan_concat [of m n p f,symmetric]
   by (simp add: ac_simps)
 
 lemma sum_diff_distrib: "\<forall>x. Q x \<le> P x  \<Longrightarrow> (\<Sum>x<n. P x) - (\<Sum>x<n. Q x) = (\<Sum>x<n. P x - Q x :: nat)"
   by (subst sum_subtractf_nat) auto
 
 
 subsubsection \<open>Shifting bounds\<close>
 
 context comm_monoid_add
 begin
 
 context
   fixes f :: "nat \<Rightarrow> 'a"
   assumes "f 0 = 0"
 begin
 
 lemma sum_shift_lb_Suc0_0_upt:
   "sum f {Suc 0..<k} = sum f {0..<k}"
 proof (cases k)
   case 0
   then show ?thesis
     by simp
 next
   case (Suc k)
   moreover have "{0..<Suc k} = insert 0 {Suc 0..<Suc k}"
     by auto
   ultimately show ?thesis
     using \<open>f 0 = 0\<close> by simp
 qed
 
 lemma sum_shift_lb_Suc0_0: "sum f {Suc 0..k} = sum f {0..k}"
 proof (cases k)
   case 0
   with \<open>f 0 = 0\<close> show ?thesis
     by simp
 next
   case (Suc k)
   moreover have "{0..Suc k} = insert 0 {Suc 0..Suc k}"
     by auto
   ultimately show ?thesis
     using \<open>f 0 = 0\<close> by simp
 qed
 
 end
 
 end
 
 lemma sum_Suc_diff:
   fixes f :: "nat \<Rightarrow> 'a::ab_group_add"
   assumes "m \<le> Suc n"
   shows "(\<Sum>i = m..n. f(Suc i) - f i) = f (Suc n) - f m"
 using assms by (induct n) (auto simp: le_Suc_eq)
 
 lemma sum_Suc_diff':
   fixes f :: "nat \<Rightarrow> 'a::ab_group_add"
   assumes "m \<le> n"
   shows "(\<Sum>i = m..<n. f (Suc i) - f i) = f n - f m"
 using assms by (induct n) (auto simp: le_Suc_eq)
 
 
 subsubsection \<open>Telescoping\<close>
 
 lemma sum_telescope:
   fixes f::"nat \<Rightarrow> 'a::ab_group_add"
   shows "sum (\<lambda>i. f i - f (Suc i)) {.. i} = f 0 - f (Suc i)"
   by (induct i) simp_all
 
 lemma sum_telescope'':
   assumes "m \<le> n"
   shows   "(\<Sum>k\<in>{Suc m..n}. f k - f (k - 1)) = f n - (f m :: 'a :: ab_group_add)"
   by (rule dec_induct[OF assms]) (simp_all add: algebra_simps)
 
 lemma sum_lessThan_telescope:
   "(\<Sum>n<m. f (Suc n) - f n :: 'a :: ab_group_add) = f m - f 0"
   by (induction m) (simp_all add: algebra_simps)
 
 lemma sum_lessThan_telescope':
   "(\<Sum>n<m. f n - f (Suc n) :: 'a :: ab_group_add) = f 0 - f m"
   by (induction m) (simp_all add: algebra_simps)
 
 
 subsubsection \<open>The formula for geometric sums\<close>
 
 lemma sum_power2: "(\<Sum>i=0..<k. (2::nat)^i) = 2^k-1"
   by (induction k) (auto simp: mult_2)
 
 lemma geometric_sum:
   assumes "x \<noteq> 1"
   shows "(\<Sum>i<n. x ^ i) = (x ^ n - 1) / (x - 1::'a::field)"
 proof -
   from assms obtain y where "y = x - 1" and "y \<noteq> 0" by simp_all
   moreover have "(\<Sum>i<n. (y + 1) ^ i) = ((y + 1) ^ n - 1) / y"
     by (induct n) (simp_all add: field_simps \<open>y \<noteq> 0\<close>)
   ultimately show ?thesis by simp
 qed
 
 lemma diff_power_eq_sum:
   fixes y :: "'a::{comm_ring,monoid_mult}"
   shows
     "x ^ (Suc n) - y ^ (Suc n) =
       (x - y) * (\<Sum>p<Suc n. (x ^ p) * y ^ (n - p))"
 proof (induct n)
   case (Suc n)
   have "x ^ Suc (Suc n) - y ^ Suc (Suc n) = x * (x * x^n) - y * (y * y ^ n)"
     by simp
   also have "... = y * (x ^ (Suc n) - y ^ (Suc n)) + (x - y) * (x * x^n)"
     by (simp add: algebra_simps)
   also have "... = y * ((x - y) * (\<Sum>p<Suc n. (x ^ p) * y ^ (n - p))) + (x - y) * (x * x^n)"
     by (simp only: Suc)
   also have "... = (x - y) * (y * (\<Sum>p<Suc n. (x ^ p) * y ^ (n - p))) + (x - y) * (x * x^n)"
     by (simp only: mult.left_commute)
   also have "... = (x - y) * (\<Sum>p<Suc (Suc n). x ^ p * y ^ (Suc n - p))"
     by (simp add: field_simps Suc_diff_le sum_distrib_right sum_distrib_left)
   finally show ?case .
 qed simp
 
 corollary power_diff_sumr2: \<comment> \<open>\<open>COMPLEX_POLYFUN\<close> in HOL Light\<close>
   fixes x :: "'a::{comm_ring,monoid_mult}"
   shows "x^n - y^n = (x - y) * (\<Sum>i<n. y^(n - Suc i) * x^i)"
 using diff_power_eq_sum[of x "n - 1" y]
 by (cases "n = 0") (simp_all add: field_simps)
 
 lemma power_diff_1_eq:
   fixes x :: "'a::{comm_ring,monoid_mult}"
   shows "x^n - 1 = (x - 1) * (\<Sum>i<n. (x^i))"
 using diff_power_eq_sum [of x _ 1]
   by (cases n) auto
 
 lemma one_diff_power_eq':
   fixes x :: "'a::{comm_ring,monoid_mult}"
   shows "1 - x^n = (1 - x) * (\<Sum>i<n. x^(n - Suc i))"
 using diff_power_eq_sum [of 1 _ x]
   by (cases n) auto
 
 lemma one_diff_power_eq:
   fixes x :: "'a::{comm_ring,monoid_mult}"
   shows "1 - x^n = (1 - x) * (\<Sum>i<n. x^i)"
 by (metis one_diff_power_eq' sum.nat_diff_reindex)
 
 lemma sum_gp_basic:
   fixes x :: "'a::{comm_ring,monoid_mult}"
   shows "(1 - x) * (\<Sum>i\<le>n. x^i) = 1 - x^Suc n"
   by (simp only: one_diff_power_eq lessThan_Suc_atMost)
 
 lemma sum_power_shift:
   fixes x :: "'a::{comm_ring,monoid_mult}"
   assumes "m \<le> n"
   shows "(\<Sum>i=m..n. x^i) = x^m * (\<Sum>i\<le>n-m. x^i)"
 proof -
   have "(\<Sum>i=m..n. x^i) = x^m * (\<Sum>i=m..n. x^(i-m))"
     by (simp add: sum_distrib_left power_add [symmetric])
   also have "(\<Sum>i=m..n. x^(i-m)) = (\<Sum>i\<le>n-m. x^i)"
     using \<open>m \<le> n\<close> by (intro sum.reindex_bij_witness[where j="\<lambda>i. i - m" and i="\<lambda>i. i + m"]) auto
   finally show ?thesis .
 qed
 
 lemma sum_gp_multiplied:
   fixes x :: "'a::{comm_ring,monoid_mult}"
   assumes "m \<le> n"
   shows "(1 - x) * (\<Sum>i=m..n. x^i) = x^m - x^Suc n"
 proof -
   have  "(1 - x) * (\<Sum>i=m..n. x^i) = x^m * (1 - x) * (\<Sum>i\<le>n-m. x^i)"
     by (metis mult.assoc mult.commute assms sum_power_shift)
   also have "... =x^m * (1 - x^Suc(n-m))"
     by (metis mult.assoc sum_gp_basic)
   also have "... = x^m - x^Suc n"
     using assms
     by (simp add: algebra_simps) (metis le_add_diff_inverse power_add)
   finally show ?thesis .
 qed
 
 lemma sum_gp:
   fixes x :: "'a::{comm_ring,division_ring}"
   shows   "(\<Sum>i=m..n. x^i) =
                (if n < m then 0
                 else if x = 1 then of_nat((n + 1) - m)
                 else (x^m - x^Suc n) / (1 - x))"
 proof (cases "n < m")
   case False
   assume *: "\<not> n < m"
   then show ?thesis
   proof (cases "x = 1")
     case False
     assume "x \<noteq> 1"
     then have not_zero: "1 - x \<noteq> 0"
       by auto
     have "(1 - x) * (\<Sum>i=m..n. x^i) = x ^ m - x * x ^ n"
       using sum_gp_multiplied [of m n x] * by auto
     then have "(\<Sum>i=m..n. x^i) = (x ^ m - x * x ^ n) / (1 - x) "
       using nonzero_divide_eq_eq mult.commute not_zero
       by metis
     then show ?thesis
       by auto
   qed (auto)
 qed (auto)
 
 
 subsubsection\<open>Geometric progressions\<close>
 
 lemma sum_gp0:
   fixes x :: "'a::{comm_ring,division_ring}"
   shows "(\<Sum>i\<le>n. x^i) = (if x = 1 then of_nat(n + 1) else (1 - x^Suc n) / (1 - x))"
   using sum_gp_basic[of x n]
   by (simp add: mult.commute field_split_simps)
 
 lemma sum_power_add:
   fixes x :: "'a::{comm_ring,monoid_mult}"
   shows "(\<Sum>i\<in>I. x^(m+i)) = x^m * (\<Sum>i\<in>I. x^i)"
   by (simp add: sum_distrib_left power_add)
 
 lemma sum_gp_offset:
   fixes x :: "'a::{comm_ring,division_ring}"
   shows   "(\<Sum>i=m..m+n. x^i) =
        (if x = 1 then of_nat n + 1 else x^m * (1 - x^Suc n) / (1 - x))"
   using sum_gp [of x m "m+n"]
   by (auto simp: power_add algebra_simps)
 
 lemma sum_gp_strict:
   fixes x :: "'a::{comm_ring,division_ring}"
   shows "(\<Sum>i<n. x^i) = (if x = 1 then of_nat n else (1 - x^n) / (1 - x))"
   by (induct n) (auto simp: algebra_simps field_split_simps)
 
 
 subsubsection \<open>The formulae for arithmetic sums\<close>
 
 context comm_semiring_1
 begin
 
 lemma double_gauss_sum:
   "2 * (\<Sum>i = 0..n. of_nat i) = of_nat n * (of_nat n + 1)"
   by (induct n) (simp_all add: sum.atLeast0_atMost_Suc algebra_simps left_add_twice)
 
 lemma double_gauss_sum_from_Suc_0:
   "2 * (\<Sum>i = Suc 0..n. of_nat i) = of_nat n * (of_nat n + 1)"
 proof -
   have "sum of_nat {Suc 0..n} = sum of_nat (insert 0 {Suc 0..n})"
     by simp
   also have "\<dots> = sum of_nat {0..n}"
     by (cases n) (simp_all add: atLeast0_atMost_Suc_eq_insert_0)
   finally show ?thesis
     by (simp add: double_gauss_sum)
 qed
 
 lemma double_arith_series:
   "2 * (\<Sum>i = 0..n. a + of_nat i * d) = (of_nat n + 1) * (2 * a + of_nat n * d)"
 proof -
   have "(\<Sum>i = 0..n. a + of_nat i * d) = ((\<Sum>i = 0..n. a) + (\<Sum>i = 0..n. of_nat i * d))"
     by (rule sum.distrib)
   also have "\<dots> = (of_nat (Suc n) * a + d * (\<Sum>i = 0..n. of_nat i))"
     by (simp add: sum_distrib_left algebra_simps)
   finally show ?thesis
     by (simp add: algebra_simps double_gauss_sum left_add_twice)
 qed
 
 end
 
 context unique_euclidean_semiring_with_nat
 begin
 
 lemma gauss_sum:
   "(\<Sum>i = 0..n. of_nat i) = of_nat n * (of_nat n + 1) div 2"
   using double_gauss_sum [of n, symmetric] by simp
 
 lemma gauss_sum_from_Suc_0:
   "(\<Sum>i = Suc 0..n. of_nat i) = of_nat n * (of_nat n + 1) div 2"
   using double_gauss_sum_from_Suc_0 [of n, symmetric] by simp
 
 lemma arith_series:
   "(\<Sum>i = 0..n. a + of_nat i * d) = (of_nat n + 1) * (2 * a + of_nat n * d) div 2"
   using double_arith_series [of a d n, symmetric] by simp
 
 end
 
 lemma gauss_sum_nat:
   "\<Sum>{0..n} = (n * Suc n) div 2"
   using gauss_sum [of n, where ?'a = nat] by simp
 
 lemma arith_series_nat:
   "(\<Sum>i = 0..n. a + i * d) = Suc n * (2 * a + n * d) div 2"
   using arith_series [of a d n] by simp
 
 lemma Sum_Icc_int:
   "\<Sum>{m..n} = (n * (n + 1) - m * (m - 1)) div 2"
   if "m \<le> n" for m n :: int
 using that proof (induct i \<equiv> "nat (n - m)" arbitrary: m n)
   case 0
   then have "m = n"
     by arith
   then show ?case
     by (simp add: algebra_simps mult_2 [symmetric])
 next
   case (Suc i)
   have 0: "i = nat((n-1) - m)" "m \<le> n-1" using Suc(2,3) by arith+
   have "\<Sum> {m..n} = \<Sum> {m..1+(n-1)}" by simp
   also have "\<dots> = \<Sum> {m..n-1} + n" using \<open>m \<le> n\<close>
     by(subst atLeastAtMostPlus1_int_conv) simp_all
   also have "\<dots> = ((n-1)*(n-1+1) - m*(m-1)) div 2 + n"
     by(simp add: Suc(1)[OF 0])
   also have "\<dots> = ((n-1)*(n-1+1) - m*(m-1) + 2*n) div 2" by simp
   also have "\<dots> = (n*(n+1) - m*(m-1)) div 2"
     by (simp add: algebra_simps mult_2_right)
   finally show ?case .
 qed
 
 lemma Sum_Icc_nat:
   "\<Sum>{m..n} = (n * (n + 1) - m * (m - 1)) div 2" for m n :: nat
 proof (cases "m \<le> n")
   case True
   then have *: "m * (m - 1) \<le> n * (n + 1)"
     by (meson diff_le_self order_trans le_add1 mult_le_mono)
   have "int (\<Sum>{m..n}) = (\<Sum>{int m..int n})"
     by (simp add: sum.atLeast_int_atMost_int_shift)
   also have "\<dots> = (int n * (int n + 1) - int m * (int m - 1)) div 2"
     using \<open>m \<le> n\<close> by (simp add: Sum_Icc_int)
   also have "\<dots> = int ((n * (n + 1) - m * (m - 1)) div 2)"
     using le_square * by (simp add: algebra_simps of_nat_div of_nat_diff)
   finally show ?thesis
     by (simp only: of_nat_eq_iff)
 next
   case False
   then show ?thesis
     by (auto dest: less_imp_Suc_add simp add: not_le algebra_simps)
 qed
 
 lemma Sum_Ico_nat: 
   "\<Sum>{m..<n} = (n * (n - 1) - m * (m - 1)) div 2" for m n :: nat
   by (cases n) (simp_all add: atLeastLessThanSuc_atLeastAtMost Sum_Icc_nat)
 
 
 subsubsection \<open>Division remainder\<close>
 
 lemma range_mod:
   fixes n :: nat
   assumes "n > 0"
   shows "range (\<lambda>m. m mod n) = {0..<n}" (is "?A = ?B")
 proof (rule set_eqI)
   fix m
   show "m \<in> ?A \<longleftrightarrow> m \<in> ?B"
   proof
     assume "m \<in> ?A"
     with assms show "m \<in> ?B"
       by auto
   next
     assume "m \<in> ?B"
     moreover have "m mod n \<in> ?A"
       by (rule rangeI)
     ultimately show "m \<in> ?A"
       by simp
   qed
 qed
 
 
 subsection \<open>Products indexed over intervals\<close>
 
 syntax (ASCII)
   "_from_to_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(PROD _ = _.._./ _)" [0,0,0,10] 10)
   "_from_upto_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(PROD _ = _..<_./ _)" [0,0,0,10] 10)
   "_upt_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(PROD _<_./ _)" [0,0,10] 10)
   "_upto_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(PROD _<=_./ _)" [0,0,10] 10)
 
 syntax (latex_prod output)
   "_from_to_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
  ("(3\<^latex>\<open>$\\prod_{\<close>_ = _\<^latex>\<open>}^{\<close>_\<^latex>\<open>}$\<close> _)" [0,0,0,10] 10)
   "_from_upto_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
  ("(3\<^latex>\<open>$\\prod_{\<close>_ = _\<^latex>\<open>}^{<\<close>_\<^latex>\<open>}$\<close> _)" [0,0,0,10] 10)
   "_upt_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
  ("(3\<^latex>\<open>$\\prod_{\<close>_ < _\<^latex>\<open>}$\<close> _)" [0,0,10] 10)
   "_upto_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
  ("(3\<^latex>\<open>$\\prod_{\<close>_ \<le> _\<^latex>\<open>}$\<close> _)" [0,0,10] 10)
 
 syntax
   "_from_to_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Prod>_ = _.._./ _)" [0,0,0,10] 10)
   "_from_upto_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Prod>_ = _..<_./ _)" [0,0,0,10] 10)
   "_upt_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Prod>_<_./ _)" [0,0,10] 10)
   "_upto_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Prod>_\<le>_./ _)" [0,0,10] 10)
 
 translations
   "\<Prod>x=a..b. t" \<rightleftharpoons> "CONST prod (\<lambda>x. t) {a..b}"
   "\<Prod>x=a..<b. t" \<rightleftharpoons> "CONST prod (\<lambda>x. t) {a..<b}"
   "\<Prod>i\<le>n. t" \<rightleftharpoons> "CONST prod (\<lambda>i. t) {..n}"
   "\<Prod>i<n. t" \<rightleftharpoons> "CONST prod (\<lambda>i. t) {..<n}"
 
 lemma prod_int_plus_eq: "prod int {i..i+j} =  \<Prod>{int i..int (i+j)}"
   by (induct j) (auto simp add: atLeastAtMostSuc_conv atLeastAtMostPlus1_int_conv)
 
 lemma prod_int_eq: "prod int {i..j} =  \<Prod>{int i..int j}"
 proof (cases "i \<le> j")
   case True
   then show ?thesis
     by (metis le_iff_add prod_int_plus_eq)
 next
   case False
   then show ?thesis
     by auto
 qed
 
 subsection \<open>Efficient folding over intervals\<close>
 
 function fold_atLeastAtMost_nat where
   [simp del]: "fold_atLeastAtMost_nat f a (b::nat) acc =
                  (if a > b then acc else fold_atLeastAtMost_nat f (a+1) b (f a acc))"
 by pat_completeness auto
 termination by (relation "measure (\<lambda>(_,a,b,_). Suc b - a)") auto
 
 lemma fold_atLeastAtMost_nat:
   assumes "comp_fun_commute f"
   shows   "fold_atLeastAtMost_nat f a b acc = Finite_Set.fold f acc {a..b}"
 using assms
 proof (induction f a b acc rule: fold_atLeastAtMost_nat.induct, goal_cases)
   case (1 f a b acc)
   interpret comp_fun_commute f by fact
   show ?case
   proof (cases "a > b")
     case True
     thus ?thesis by (subst fold_atLeastAtMost_nat.simps) auto
   next
     case False
     with 1 show ?thesis
       by (subst fold_atLeastAtMost_nat.simps)
          (auto simp: atLeastAtMost_insertL[symmetric] fold_fun_left_comm)
   qed
 qed
 
 lemma sum_atLeastAtMost_code:
   "sum f {a..b} = fold_atLeastAtMost_nat (\<lambda>a acc. f a + acc) a b 0"
 proof -
   have "comp_fun_commute (\<lambda>a. (+) (f a))"
     by unfold_locales (auto simp: o_def add_ac)
   thus ?thesis
     by (simp add: sum.eq_fold fold_atLeastAtMost_nat o_def)
 qed
 
 lemma prod_atLeastAtMost_code:
   "prod f {a..b} = fold_atLeastAtMost_nat (\<lambda>a acc. f a * acc) a b 1"
 proof -
   have "comp_fun_commute (\<lambda>a. (*) (f a))"
     by unfold_locales (auto simp: o_def mult_ac)
   thus ?thesis
     by (simp add: prod.eq_fold fold_atLeastAtMost_nat o_def)
 qed
 
 (* TODO: Add support for folding over more kinds of intervals here *)
 
 end