diff --git a/src/HOL/Divides.thy b/src/HOL/Divides.thy
--- a/src/HOL/Divides.thy
+++ b/src/HOL/Divides.thy
@@ -1,1359 +1,1359 @@
 (*  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>
 
 theory Divides
 imports Parity
 begin
 
 subsection \<open>More on division\<close>
 
 inductive eucl_rel_int :: "int \<Rightarrow> int \<Rightarrow> int \<times> int \<Rightarrow> bool"
   where eucl_rel_int_by0: "eucl_rel_int k 0 (0, k)"
   | eucl_rel_int_dividesI: "l \<noteq> 0 \<Longrightarrow> k = q * l \<Longrightarrow> eucl_rel_int k l (q, 0)"
   | eucl_rel_int_remainderI: "sgn r = sgn l \<Longrightarrow> \<bar>r\<bar> < \<bar>l\<bar>
       \<Longrightarrow> k = q * l + r \<Longrightarrow> eucl_rel_int k l (q, r)"
 
 lemma eucl_rel_int_iff:    
   "eucl_rel_int k l (q, r) \<longleftrightarrow> 
     k = l * q + r \<and>
      (if 0 < l then 0 \<le> r \<and> r < l else if l < 0 then l < r \<and> r \<le> 0 else q = 0)"
   by (cases "r = 0")
     (auto elim!: eucl_rel_int.cases intro: eucl_rel_int_by0 eucl_rel_int_dividesI eucl_rel_int_remainderI
     simp add: ac_simps sgn_1_pos sgn_1_neg)
 
 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)"
   by (rule_tac b = "-b" and r = "-r'" and r' = "-r" in unique_quotient_lemma) auto
 
 lemma unique_quotient:
   "eucl_rel_int a b (q, r) \<Longrightarrow> eucl_rel_int a b (q', r') \<Longrightarrow> q = q'"
   apply (rule order_antisym)
    apply (simp_all add: eucl_rel_int_iff linorder_neq_iff split: if_split_asm)
      apply (blast intro: order_eq_refl [THEN unique_quotient_lemma] order_eq_refl [THEN unique_quotient_lemma_neg] sym)+
   done
 
 lemma unique_remainder:
   "eucl_rel_int a b (q, r) \<Longrightarrow> eucl_rel_int a b (q', r') \<Longrightarrow> r = r'"
 apply (subgoal_tac "q = q'")
  apply (simp add: eucl_rel_int_iff)
 apply (blast intro: unique_quotient)
 done
 
 lemma eucl_rel_int:
   "eucl_rel_int k l (k div l, k mod l)"
 proof (cases k rule: int_cases3)
   case zero
   then show ?thesis
     by (simp add: eucl_rel_int_iff divide_int_def modulo_int_def)
 next
   case (pos n)
   then show ?thesis
     using div_mult_mod_eq [of n]
     by (cases l rule: int_cases3)
       (auto simp del: of_nat_mult of_nat_add
         simp add: mod_greater_zero_iff_not_dvd of_nat_mult [symmetric] of_nat_add [symmetric] algebra_simps
         eucl_rel_int_iff divide_int_def modulo_int_def)
 next
   case (neg n)
   then show ?thesis
     using div_mult_mod_eq [of n]
     by (cases l rule: int_cases3)
       (auto simp del: of_nat_mult of_nat_add
         simp add: mod_greater_zero_iff_not_dvd of_nat_mult [symmetric] of_nat_add [symmetric] algebra_simps
         eucl_rel_int_iff divide_int_def modulo_int_def)
 qed
 
 lemma divmod_int_unique:
   assumes "eucl_rel_int k l (q, r)"
   shows div_int_unique: "k div l = q" and mod_int_unique: "k mod l = r"
   using assms eucl_rel_int [of k l]
   using unique_quotient [of k l] unique_remainder [of k l]
   by auto
 
 lemma div_abs_eq_div_nat:
   "\<bar>k\<bar> div \<bar>l\<bar> = int (nat \<bar>k\<bar> div nat \<bar>l\<bar>)"
   by (simp add: divide_int_def)
 
 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 zdiv_int:
   "int (a div b) = int a div int b"
   by (simp add: divide_int_def)
 
 lemma zmod_int:
   "int (a mod b) = int a mod int b"
   by (simp add: modulo_int_def)
 
 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>"
 proof -
   from assms have "sgn v = - 1 \<or> sgn v = 1"
     by (cases "v \<ge> 0") auto
   then show ?thesis
     using assms unfolding divide_int_def [of "sgn v * \<bar>k\<bar>" "sgn v * \<bar>l\<bar>"]
     by (fastforce simp add: not_less div_abs_eq_div_nat)
 qed
 
 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>"
 proof (cases "l = 0")
   case True
   then show ?thesis
     by simp
 next
   case False
   with assms have "(sgn k * \<bar>k\<bar>) div (sgn l * \<bar>l\<bar>) = \<bar>k\<bar> div \<bar>l\<bar>"
     using div_sgn_abs_cancel [of l k l] by simp
   then show ?thesis
     by (simp add: sgn_mult_abs)
 qed
 
 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>)"
 proof (cases "k = 0 \<or> l = 0")
   case True
   then show ?thesis
     by auto
 next
   case False
   then have "k \<noteq> 0" and "l \<noteq> 0"
     by auto
   show ?thesis
   proof (cases "sgn l = sgn k")
     case True
     then show ?thesis
-      by (simp add: div_eq_sgn_abs)
+      by (auto simp add: div_eq_sgn_abs)
   next
     case False
     with \<open>k \<noteq> 0\<close> \<open>l \<noteq> 0\<close>
     have "sgn l * sgn k = - 1"
       by (simp add: sgn_if split: if_splits)
     with assms show ?thesis
       unfolding divide_int_def [of k l]
       by (auto simp add: zdiv_int ac_simps)
   qed
 qed
 
 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 (simp only: divide_int_def [of k l], auto simp add: not_less zdiv_int)
   
 
 subsubsection \<open>Laws for div and mod with Unary Minus\<close>
 
 lemma zminus1_lemma:
      "eucl_rel_int a b (q, r) ==> b \<noteq> 0
       ==> eucl_rel_int (-a) b (if r=0 then -q else -q - 1,
                           if r=0 then 0 else b-r)"
 by (force simp add: eucl_rel_int_iff right_diff_distrib)
 
 
 lemma zdiv_zminus1_eq_if:
      "b \<noteq> (0::int)
       \<Longrightarrow> (-a) div b = (if a mod b = 0 then - (a div b) else  - (a div b) - 1)"
 by (blast intro: eucl_rel_int [THEN zminus1_lemma, THEN div_int_unique])
 
 lemma zmod_zminus1_eq_if:
      "(-a::int) mod b = (if a mod b = 0 then 0 else  b - (a mod b))"
 proof (cases "b = 0")
   case False
   then show ?thesis
     by (blast intro: eucl_rel_int [THEN zminus1_lemma, THEN mod_int_unique])
 qed auto
 
 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_zminus2_eq_if:
   "b \<noteq> (0::int)
       ==> a div (-b) =
           (if a mod b = 0 then - (a div b) else  - (a div b) - 1)"
   by (auto simp add: zdiv_zminus1_eq_if div_minus_right)
 
 lemma zmod_zminus2_eq_if:
   "a mod (-b::int) = (if a mod b = 0 then 0 else  (a mod b) - b)"
   by (auto simp add: zmod_zminus1_eq_if mod_minus_right)
 
 
 subsubsection \<open>Monotonicity in the First Argument (Dividend)\<close>
 
 lemma zdiv_mono1:
   fixes b::int
   assumes "a \<le> a'" "0 < b" shows "a div b \<le> a' div b"
 proof (rule unique_quotient_lemma)
   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)
 
 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)
 
 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
 
 
 subsubsection \<open>Splitting Rules for div and mod\<close>
 
 text\<open>The proofs of the two lemmas below are essentially identical\<close>
 
 lemma split_pos_lemma:
  "0<k \<Longrightarrow>
     P(n div k :: int)(n mod k) = (\<forall>i j. 0\<le>j \<and> j<k \<and> n = k*i + j \<longrightarrow> P i j)"
   by auto
 
 lemma split_neg_lemma:
  "k<0 \<Longrightarrow>
     P(n div k :: int)(n mod k) = (\<forall>i j. k<j \<and> j\<le>0 \<and> n = k*i + j \<longrightarrow> P i j)"
   by auto
 
 lemma split_zdiv:
  "P(n div k :: int) =
   ((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)))"
 proof (cases "k = 0")
   case False
   then show ?thesis
     unfolding linorder_neq_iff
     by (auto simp add: split_pos_lemma [of concl: "\<lambda>x y. P x"] split_neg_lemma [of concl: "\<lambda>x y. P x"])
 qed auto
 
 lemma split_zmod:
  "P(n mod k :: int) =
   ((k = 0 \<longrightarrow> P n) \<and>
    (0<k \<longrightarrow> (\<forall>i j. 0\<le>j \<and> j<k \<and> n = k*i + j \<longrightarrow> P j)) \<and>
    (k<0 \<longrightarrow> (\<forall>i j. k<j \<and> j\<le>0 \<and> n = k*i + j \<longrightarrow> P j)))"
 proof (cases "k = 0")
   case False
   then show ?thesis
     unfolding linorder_neq_iff
     by (auto simp add: split_pos_lemma [of concl: "\<lambda>x y. P y"] split_neg_lemma [of concl: "\<lambda>x y. P y"])
 qed auto
 
 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 _ _ "numeral k", arith_split] for k
 declare split_zmod [of _ _ "numeral k", arith_split] for k
 
 
 subsubsection \<open>Computing \<open>div\<close> and \<open>mod\<close> with shifting\<close>
 
 lemma pos_eucl_rel_int_mult_2:
   assumes "0 \<le> b"
   assumes "eucl_rel_int a b (q, r)"
   shows "eucl_rel_int (1 + 2*a) (2*b) (q, 1 + 2*r)"
   using assms unfolding eucl_rel_int_iff by auto
 
 lemma neg_eucl_rel_int_mult_2:
   assumes "b \<le> 0"
   assumes "eucl_rel_int (a + 1) b (q, r)"
   shows "eucl_rel_int (1 + 2*a) (2*b) (q, 2*r - 1)"
   using assms unfolding eucl_rel_int_iff by auto
 
 text\<open>computing div by shifting\<close>
 
 lemma pos_zdiv_mult_2: "(0::int) \<le> a ==> (1 + 2*b) div (2*a) = b div a"
   using pos_eucl_rel_int_mult_2 [OF _ eucl_rel_int]
   by (rule div_int_unique)
 
 lemma neg_zdiv_mult_2:
   assumes A: "a \<le> (0::int)" shows "(1 + 2*b) div (2*a) = (b+1) div a"
   using neg_eucl_rel_int_mult_2 [OF A eucl_rel_int]
   by (rule div_int_unique)
 
 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 pos_zmod_mult_2:
   fixes a b :: int
   assumes "0 \<le> a"
   shows "(1 + 2 * b) mod (2 * a) = 1 + 2 * (b mod a)"
   using pos_eucl_rel_int_mult_2 [OF assms eucl_rel_int]
   by (rule mod_int_unique)
 
 lemma neg_zmod_mult_2:
   fixes a b :: int
   assumes "a \<le> 0"
   shows "(1 + 2 * b) mod (2 * a) = 2 * ((b + 1) mod a) - 1"
   using neg_eucl_rel_int_mult_2 [OF assms eucl_rel_int]
   by (rule mod_int_unique)
 
 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)
 
 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"
     by safe (insert div_mult_mod_eq [of i k], auto)
   with zdiv_eq_0_iff
   show ?thesis
     by simp
 qed
 
   
 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 \<open>0 < k mod l\<close> \<open>k mod l < 1 + l\<close>
       using \<open>0 < l\<close> le_imp_0_less False apply auto
       using le_less apply fastforce
       using pos_mod_bound [of l k] apply linarith 
       done
     with \<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
       apply (simp only: zmod_zminus1_eq_if)
       apply (simp add: mod_eq_0_iff_dvd algebra_simps mod_simps)
       done
   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)
 
 
 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 show ?thesis
    apply (auto simp add: pos_imp_zdiv_nonneg_iff neg_imp_zdiv_nonneg_iff)
     by (meson neg_imp_zdiv_neg_iff not_le not_less_iff_gr_or_eq)
 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 int_div_pos_eq: "\<lbrakk>(a::int) = b * q + r; 0 \<le> r; r < b\<rbrakk> \<Longrightarrow> a div b = q"
   by (rule div_int_unique [of a b q r]) (simp add: eucl_rel_int_iff)
 
 lemma int_div_neg_eq: "\<lbrakk>(a::int) = b * q + r; r \<le> 0; b < r\<rbrakk> \<Longrightarrow> a div b = q"
   by (rule div_int_unique [of a b q r],
     simp add: eucl_rel_int_iff)
 
 lemma int_mod_pos_eq: "\<lbrakk>(a::int) = b * q + r; 0 \<le> r; r < b\<rbrakk> \<Longrightarrow> a mod b = r"
   by (rule mod_int_unique [of a b q r],
     simp add: eucl_rel_int_iff)
 
 lemma int_mod_neg_eq: "\<lbrakk>(a::int) = b * q + r; r \<le> 0; b < r\<rbrakk> \<Longrightarrow> a mod b = r"
   by (rule mod_int_unique [of a b q r],
     simp add: eucl_rel_int_iff)
 
 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
 
 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
       apply clarify  apply (rule_tac x="q" in exI) by (rule exI[where x="0"], simp)}
   moreover
   {assume xy: "y \<le> x"
     from nat_mod_eq_lemma[OF H xy] have ?rhs
       apply clarify  apply (rule_tac x="0" in exI) by (rule_tac x="q" in exI, simp)}
   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>Numeral division with a pragmatic type class\<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.  This is its primary motivation, and it
   could surely be formulated using a more fine-grained, more algebraic
   and less technical class hierarchy.
 \<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"
   fixes divmod :: "num \<Rightarrow> num \<Rightarrow> 'a \<times> 'a"
     and divmod_step :: "num \<Rightarrow> 'a \<times> 'a \<Rightarrow> 'a \<times> 'a"
   assumes divmod_def: "divmod m n = (numeral m div numeral n, numeral m mod numeral n)"
     and divmod_step_def: "divmod_step l qr = (let (q, r) = qr
     in if r \<ge> numeral l then (2 * q + 1, r - numeral l)
     else (2 * q, r))"
     \<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>
 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"
     by (auto simp add: mod_w) (insert mod_less, auto)
   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
 
 lemma fst_divmod:
   "fst (divmod m n) = numeral m div numeral n"
   by (simp add: divmod_def)
 
 lemma snd_divmod:
   "snd (divmod m n) = numeral m mod numeral n"
   by (simp add: divmod_def)
 
 text \<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>
 
 lemma divmod_step_eq [simp]:
   "divmod_step l (q, r) = (if numeral l \<le> r
     then (2 * q + 1, r - numeral l) else (2 * q, r))"
   by (simp add: divmod_step_def)
 
 text \<open>
   This is 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:
   "divmod m n = (if m < n then (0, numeral m)
     else divmod_step n (divmod m (Num.Bit0 n)))"
 proof (cases "m < n")
   case True then have "numeral m < numeral n" by simp
   then show ?thesis
     by (simp add: prod_eq_iff div_less mod_less fst_divmod snd_divmod)
 next
   case False
   have "divmod m n =
     divmod_step n (numeral m div (2 * numeral n),
       numeral m mod (2 * numeral n))"
   proof (cases "numeral n \<le> numeral m mod (2 * numeral n)")
     case True
     with divmod_step_eq
       have "divmod_step n (numeral m div (2 * numeral n), numeral m mod (2 * numeral n)) =
         (2 * (numeral m div (2 * numeral n)) + 1, numeral m mod (2 * numeral n) - numeral n)"
         by simp
     moreover from True divmod_digit_1 [of "numeral m" "numeral n"]
       have "2 * (numeral m div (2 * numeral n)) + 1 = numeral m div numeral n"
       and "numeral m mod (2 * numeral n) - numeral n = numeral m mod numeral n"
       by simp_all
     ultimately show ?thesis by (simp only: divmod_def)
   next
     case False then have *: "numeral m mod (2 * numeral n) < numeral n"
       by (simp add: not_le)
     with divmod_step_eq
       have "divmod_step n (numeral m div (2 * numeral n), numeral m mod (2 * numeral n)) =
         (2 * (numeral m div (2 * numeral n)), numeral m mod (2 * numeral n))"
         by auto
     moreover from * divmod_digit_0 [of "numeral n" "numeral m"]
       have "2 * (numeral m div (2 * numeral n)) = numeral m div numeral n"
       and "numeral m mod (2 * numeral n) = numeral m mod numeral n"
       by (simp_all only: zero_less_numeral)
     ultimately show ?thesis by (simp only: divmod_def)
   qed
   then have "divmod m n =
     divmod_step n (numeral m div numeral (Num.Bit0 n),
       numeral m mod numeral (Num.Bit0 n))"
     by (simp only: numeral.simps distrib mult_1)
   then have "divmod m n = divmod_step n (divmod m (Num.Bit0 n))"
     by (simp add: divmod_def)
   with False show ?thesis by simp
 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]:
   "divmod (Num.Bit0 m) (Num.Bit0 n) = (case divmod m n of (q, r) \<Rightarrow> (q, 2 * r))" (is ?P)
   "divmod (Num.Bit1 m) (Num.Bit0 n) = (case divmod m n of (q, r) \<Rightarrow> (q, 2 * r + 1))" (is ?Q)
 proof -
   have *: "\<And>q. numeral (Num.Bit0 q) = 2 * numeral q"
     "\<And>q. numeral (Num.Bit1 q) = 2 * numeral q + 1"
     by (simp_all only: numeral_mult numeral.simps distrib) simp_all
   have "1 div 2 = 0" "1 mod 2 = 1" by (auto intro: div_less mod_less)
   then show ?P and ?Q
     by (simp_all add: fst_divmod snd_divmod prod_eq_iff split_def * [of m] * [of n] mod_mult_mult1
       div_mult2_eq [of _ _ 2] mod_mult2_eq [of _ _ 2]
       add.commute del: numeral_times_numeral)
 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 (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 (num.Bit1 n)
              (divmod (num.Bit1 m)
                (num.Bit0 (num.Bit1 n))))"
   by (simp_all add: divmod_divmod_step)
 
 lemmas divmod_algorithm_code = divmod_step_eq 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]: 
   "numeral k div numeral l = fst (divmod k l)"
   by (simp add: fst_divmod)
 
 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)
 
 text \<open>Computing congruences modulo \<open>2 ^ q\<close>\<close>
 
 lemma cong_exp_iff_simps:
   "numeral n mod numeral Num.One = 0
     \<longleftrightarrow> True"
   "numeral (Num.Bit0 n) mod numeral (Num.Bit0 q) = 0
     \<longleftrightarrow> numeral n mod numeral q = 0"
   "numeral (Num.Bit1 n) mod numeral (Num.Bit0 q) = 0
     \<longleftrightarrow> False"
   "numeral m mod numeral Num.One = (numeral n mod numeral Num.One)
     \<longleftrightarrow> True"
   "numeral Num.One mod numeral (Num.Bit0 q) = (numeral Num.One mod numeral (Num.Bit0 q))
     \<longleftrightarrow> True"
   "numeral Num.One mod numeral (Num.Bit0 q) = (numeral (Num.Bit0 n) mod numeral (Num.Bit0 q))
     \<longleftrightarrow> False"
   "numeral Num.One mod numeral (Num.Bit0 q) = (numeral (Num.Bit1 n) mod numeral (Num.Bit0 q))
     \<longleftrightarrow> (numeral n mod numeral q) = 0"
   "numeral (Num.Bit0 m) mod numeral (Num.Bit0 q) = (numeral Num.One mod numeral (Num.Bit0 q))
     \<longleftrightarrow> False"
   "numeral (Num.Bit0 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit0 n) mod numeral (Num.Bit0 q))
     \<longleftrightarrow> numeral m mod numeral q = (numeral n mod numeral q)"
   "numeral (Num.Bit0 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit1 n) mod numeral (Num.Bit0 q))
     \<longleftrightarrow> False"
   "numeral (Num.Bit1 m) mod numeral (Num.Bit0 q) = (numeral Num.One mod numeral (Num.Bit0 q))
     \<longleftrightarrow> (numeral m mod numeral q) = 0"
   "numeral (Num.Bit1 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit0 n) mod numeral (Num.Bit0 q))
     \<longleftrightarrow> False"
   "numeral (Num.Bit1 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit1 n) mod numeral (Num.Bit0 q))
     \<longleftrightarrow> numeral m mod numeral q = (numeral n mod numeral q)"
   by (auto simp add: case_prod_beta dest: arg_cong [of _ _ even])
 
 end
 
 hide_fact (open) div_less mod_less mod_less_eq_dividend mod_mult2_eq div_mult2_eq
 
 instantiation nat :: unique_euclidean_semiring_numeral
 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 :: "num \<Rightarrow> nat \<times> nat \<Rightarrow> nat \<times> nat"
 where
   "divmod_step_nat l qr = (let (q, r) = qr
     in if r \<ge> numeral l then (2 * q + 1, r - numeral l)
     else (2 * q, r))"
 
 instance by standard
   (auto simp add: divmod'_nat_def divmod_step_nat_def div_greater_zero_iff div_mult2_eq mod_mult2_eq)
 
 end
 
 declare divmod_algorithm_code [where ?'a = nat, code]
 
 lemma Suc_0_div_numeral [simp]:
   fixes k l :: num
   shows "Suc 0 div numeral k = fst (divmod Num.One k)"
   by (simp_all add: fst_divmod)
 
 lemma Suc_0_mod_numeral [simp]:
   fixes k l :: num
   shows "Suc 0 mod numeral k = snd (divmod Num.One k)"
   by (simp_all add: snd_divmod)
 
 instantiation int :: unique_euclidean_semiring_numeral
 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 :: "num \<Rightarrow> int \<times> int \<Rightarrow> int \<times> int"
 where
   "divmod_step_int l qr = (let (q, r) = qr
     in if r \<ge> numeral l then (2 * q + 1, r - numeral l)
     else (2 * q, r))"
 
 instance
   by standard (auto intro: zmod_le_nonneg_dividend simp add: divmod_int_def divmod_step_int_def
     pos_imp_zdiv_pos_iff zmod_zmult2_eq zdiv_zmult2_eq)
 
 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 :: "int \<Rightarrow> int \<Rightarrow> int"
 where
   [simp]: "adjust_mod l r = (if r = 0 then 0 else 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 (numeral 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 (numeral 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  
 
 lemma minus_one_mod_numeral [simp]:
   "- 1 mod numeral n = adjust_mod (numeral 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 (numeral n) (snd (divmod Num.One n) :: int)"
   using numeral_mod_minus_numeral [of Num.One n] by simp
 
 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
 
 lemma bit_numeral_Bit0_Suc_iff [simp]:
   \<open>bit (numeral (Num.Bit0 m) :: int) (Suc n) \<longleftrightarrow> bit (numeral m :: int) n\<close>
   by (simp add: bit_Suc)
 
 lemma bit_numeral_Bit1_Suc_iff [simp]:
   \<open>bit (numeral (Num.Bit1 m) :: int) (Suc n) \<longleftrightarrow> bit (numeral m :: int) n\<close>
   by (simp add: bit_Suc)
 
 lemma div_positive_int:
   "k div l > 0" if "k \<ge> l" and "l > 0" for k l :: int
   using that div_positive [of l k] by blast
 
 
 subsubsection \<open>Dedicated simproc for calculation\<close>
 
 text \<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. 
 \<close>
 
 simproc_setup numeral_divmod
   ("0 div 0 :: 'a :: unique_euclidean_semiring_numeral" | "0 mod 0 :: 'a :: unique_euclidean_semiring_numeral" |
    "0 div 1 :: 'a :: unique_euclidean_semiring_numeral" | "0 mod 1 :: 'a :: unique_euclidean_semiring_numeral" |
    "0 div - 1 :: int" | "0 mod - 1 :: int" |
    "0 div numeral b :: 'a :: unique_euclidean_semiring_numeral" | "0 mod numeral b :: 'a :: unique_euclidean_semiring_numeral" |
    "0 div - numeral b :: int" | "0 mod - numeral b :: int" |
    "1 div 0 :: 'a :: unique_euclidean_semiring_numeral" | "1 mod 0 :: 'a :: unique_euclidean_semiring_numeral" |
    "1 div 1 :: 'a :: unique_euclidean_semiring_numeral" | "1 mod 1 :: 'a :: unique_euclidean_semiring_numeral" |
    "1 div - 1 :: int" | "1 mod - 1 :: int" |
    "1 div numeral b :: 'a :: unique_euclidean_semiring_numeral" | "1 mod numeral b :: 'a :: unique_euclidean_semiring_numeral" |
    "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_numeral" | "numeral a mod 0 :: 'a :: unique_euclidean_semiring_numeral" |
    "numeral a div 1 :: 'a :: unique_euclidean_semiring_numeral" | "numeral a mod 1 :: 'a :: unique_euclidean_semiring_numeral" |
    "numeral a div - 1 :: int" | "numeral a mod - 1 :: int" |
    "numeral a div numeral b :: 'a :: unique_euclidean_semiring_numeral" | "numeral a mod numeral b :: 'a :: unique_euclidean_semiring_numeral" |
    "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 Divides.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_eq fst_conv snd_conv numeral_One
         case_prod_beta rel_simps Divides.adjust_mod_def div_minus1_right mod_minus1_right
         minus_minus numeral_times_numeral mult_zero_right mult_1_right}
         @ [@{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>
 
 
 subsubsection \<open>Code generation\<close>
 
 definition divmod_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<times> nat"
   where "divmod_nat m n = (m div n, m mod n)"
 
 lemma fst_divmod_nat [simp]:
   "fst (divmod_nat m n) = m div n"
   by (simp add: divmod_nat_def)
 
 lemma snd_divmod_nat [simp]:
   "snd (divmod_nat m n) = m mod n"
   by (simp add: divmod_nat_def)
 
 lemma divmod_nat_if [code]:
   "Divides.divmod_nat m n = (if n = 0 \<or> m < n then (0, m) else
     let (q, r) = Divides.divmod_nat (m - n) n in (Suc q, r))"
   by (simp add: prod_eq_iff case_prod_beta not_less le_div_geq le_mod_geq)
 
 lemma [code]:
   "m div n = fst (divmod_nat m n)"
   "m mod n = snd (divmod_nat m n)"
   by simp_all
 
 lemma [code]:
   fixes k :: int
   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 = - (Divides.adjust_div (divmod m n) :: int)"
     "Int.Neg m mod Int.Pos n = Divides.adjust_mod (Int.Pos n) (snd (divmod m n) :: int)"
     "Int.Pos m div Int.Neg n = - (Divides.adjust_div (divmod m n) :: int)"
     "Int.Pos m mod Int.Neg n = - Divides.adjust_mod (Int.Pos 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
 
 code_identifier
   code_module Divides \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith
 
 
 subsection \<open>More on bit operations\<close>
 
 lemma take_bit_incr_eq:
   \<open>take_bit n (k + 1) = 1 + take_bit n k\<close> if \<open>take_bit n k \<noteq> 2 ^ n - 1\<close>
   for k :: int
 proof -
   from that have \<open>2 ^ n \<noteq> k mod 2 ^ n + 1\<close>
     by (simp add: take_bit_eq_mod)
   moreover have \<open>k mod 2 ^ n < 2 ^ n\<close>
     by simp
   ultimately have *: \<open>k mod 2 ^ n + 1 < 2 ^ n\<close>
     by linarith
   have \<open>(k + 1) mod 2 ^ n = (k mod 2 ^ n + 1) mod 2 ^ n\<close>
     by (simp add: mod_simps)
   also have \<open>\<dots> = k mod 2 ^ n + 1\<close>
     using * by (simp add: zmod_trivial_iff)
   finally have \<open>(k + 1) mod 2 ^ n = k mod 2 ^ n + 1\<close> .
   then show ?thesis
     by (simp add: take_bit_eq_mod)
 qed
 
 lemma take_bit_decr_eq:
   \<open>take_bit n (k - 1) = take_bit n k - 1\<close> if \<open>take_bit n k \<noteq> 0\<close>
   for k :: int
 proof -
   from that have \<open>k mod 2 ^ n \<noteq> 0\<close>
     by (simp add: take_bit_eq_mod)
   moreover have \<open>k mod 2 ^ n \<ge> 0\<close> \<open>k mod 2 ^ n < 2 ^ n\<close>
     by simp_all
   ultimately have *: \<open>k mod 2 ^ n > 0\<close>
     by linarith
   have \<open>(k - 1) mod 2 ^ n = (k mod 2 ^ n - 1) mod 2 ^ n\<close>
     by (simp add: mod_simps)
   also have \<open>\<dots> = k mod 2 ^ n - 1\<close>
     by (simp add: zmod_trivial_iff)
       (use \<open>k mod 2 ^ n < 2 ^ n\<close> * in linarith)
   finally have \<open>(k - 1) mod 2 ^ n = k mod 2 ^ n - 1\<close> .
   then show ?thesis
     by (simp add: take_bit_eq_mod)
 qed
 
 lemma take_bit_int_greater_eq:
   \<open>k + 2 ^ n \<le> take_bit n k\<close> if \<open>k < 0\<close> for k :: int
 proof -
   have \<open>k + 2 ^ n \<le> take_bit n (k + 2 ^ n)\<close>
   proof (cases \<open>k > - (2 ^ n)\<close>)
     case False
     then have \<open>k + 2 ^ n \<le> 0\<close>
       by simp
     also note take_bit_nonnegative
     finally show ?thesis .
   next
     case True
     with that have \<open>0 \<le> k + 2 ^ n\<close> and \<open>k + 2 ^ n < 2 ^ n\<close>
       by simp_all
     then show ?thesis
       by (simp only: take_bit_eq_mod mod_pos_pos_trivial)
   qed
   then show ?thesis
     by (simp add: take_bit_eq_mod)
 qed
 
 lemma take_bit_int_less_eq:
   \<open>take_bit n k \<le> k - 2 ^ n\<close> if \<open>2 ^ n \<le> k\<close> and \<open>n > 0\<close> for k :: int
   using that zmod_le_nonneg_dividend [of \<open>k - 2 ^ n\<close> \<open>2 ^ n\<close>]
   by (simp add: take_bit_eq_mod)
 
 lemma take_bit_int_less_eq_self_iff:
   \<open>take_bit n k \<le> k \<longleftrightarrow> 0 \<le> k\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
   for k :: int
 proof
   assume ?P
   show ?Q
   proof (rule ccontr)
     assume \<open>\<not> 0 \<le> k\<close>
     then have \<open>k < 0\<close>
       by simp
     with \<open>?P\<close>
     have \<open>take_bit n k < 0\<close>
       by (rule le_less_trans)
     then show False
       by simp
   qed
 next
   assume ?Q
   then show ?P
     by (simp add: take_bit_eq_mod zmod_le_nonneg_dividend)
 qed
 
 lemma take_bit_int_less_self_iff:
   \<open>take_bit n k < k \<longleftrightarrow> 2 ^ n \<le> k\<close>
   for k :: int
   by (auto simp add: less_le take_bit_int_less_eq_self_iff take_bit_int_eq_self_iff
     intro: order_trans [of 0 \<open>2 ^ n\<close> k])
 
 lemma take_bit_int_greater_self_iff:
   \<open>k < take_bit n k \<longleftrightarrow> k < 0\<close>
   for k :: int
   using take_bit_int_less_eq_self_iff [of n k] by auto
 
 lemma take_bit_int_greater_eq_self_iff:
   \<open>k \<le> take_bit n k \<longleftrightarrow> k < 2 ^ n\<close>
   for k :: int
   by (auto simp add: le_less take_bit_int_greater_self_iff take_bit_int_eq_self_iff
     dest: sym not_sym intro: less_trans [of k 0 \<open>2 ^ n\<close>])
 
 
 subsection \<open>Lemmas of doubtful value\<close>
 
 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
 
 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,2086 +1,2086 @@
 (*  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 + 
   fixes euclidean_size :: "'a \<Rightarrow> nat"
   assumes size_0 [simp]: "euclidean_size 0 = 0"
   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" 
   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: 
   "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] 
     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]) (insert assms, 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" 
   shows   "euclidean_size a \<le> euclidean_size b"
   using assms by (auto elim!: dvdE simp: size_mult_mono)
 
 lemma dvd_proper_imp_size_less:
   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; 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 elim: dvdE)
 
 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]: 
   "((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 + 
   assumes euclidean_size_mult: "euclidean_size (a * b) = euclidean_size a * euclidean_size b"
   fixes division_segment :: "'a \<Rightarrow> 'a"
   assumes is_unit_division_segment [simp]: "is_unit (division_segment a)"
     and division_segment_mult:
     "a \<noteq> 0 \<Longrightarrow> b \<noteq> 0 \<Longrightarrow> division_segment (a * b) = division_segment a * division_segment b"
     and division_segment_mod:
     "b \<noteq> 0 \<Longrightarrow> \<not> b dvd a \<Longrightarrow> division_segment (a mod b) = division_segment b"
   assumes div_bounded:
     "b \<noteq> 0 \<Longrightarrow> division_segment r = division_segment b
     \<Longrightarrow> euclidean_size r < euclidean_size b
     \<Longrightarrow> (q * b + r) div b = q"
 begin
 
 lemma division_segment_not_0 [simp]:
   "division_segment a \<noteq> 0"
   using is_unit_division_segment [of a] is_unitE [of "division_segment a"] by blast
 
 lemma divmod_cases [case_names divides remainder by0]:
   obtains 
     (divides) q where "b \<noteq> 0"
       and "a div b = q"
       and "a mod b = 0"
       and "a = q * b"
   | (remainder) q r where "b \<noteq> 0"
       and "division_segment r = division_segment b"
       and "euclidean_size r < euclidean_size b"
       and "r \<noteq> 0"
       and "a div b = q"
       and "a mod b = r"
       and "a = q * b + r"
   | (by0) "b = 0"
 proof (cases "b = 0")
   case True
   then show thesis
   by (rule by0)
 next
   case False
   show thesis
   proof (cases "b dvd a")
     case True
     then obtain q where "a = b * q" ..
     with \<open>b \<noteq> 0\<close> divides
     show thesis
       by (simp add: ac_simps)
   next
     case False
     then have "a mod b \<noteq> 0"
       by (simp add: mod_eq_0_iff_dvd)
     moreover from \<open>b \<noteq> 0\<close> \<open>\<not> b dvd a\<close> have "division_segment (a mod b) = division_segment b"
       by (rule division_segment_mod)
     moreover have "euclidean_size (a mod b) < euclidean_size b"
       using \<open>b \<noteq> 0\<close> by (rule mod_size_less)
     moreover have "a = a div b * b + a mod b"
       by (simp add: div_mult_mod_eq)
     ultimately show thesis
       using \<open>b \<noteq> 0\<close> by (blast intro!: remainder)
   qed
 qed
 
 lemma div_eqI:
   "a div b = q" if "b \<noteq> 0" "division_segment r = division_segment b"
     "euclidean_size r < euclidean_size b" "q * b + r = a"
 proof -
   from that have "(q * b + r) div b = q"
     by (auto intro: div_bounded)
   with that show ?thesis
     by simp
 qed
 
 lemma mod_eqI:
   "a mod b = r" if "b \<noteq> 0" "division_segment r = division_segment b"
     "euclidean_size r < euclidean_size b" "q * b + r = a" 
 proof -
   from that have "a div b = q"
     by (rule div_eqI)
   moreover have "a div b * b + a mod b = a"
     by (fact div_mult_mod_eq)
   ultimately have "a div b * b + a mod b = a div b * b + r"
     using \<open>q * b + r = a\<close> by simp
   then show ?thesis
     by simp
 qed
 
 subclass euclidean_semiring_cancel
 proof
   show "(a + c * b) div b = c + a div b" if "b \<noteq> 0" for a b c
   proof (cases a b rule: divmod_cases)
     case by0
     with \<open>b \<noteq> 0\<close> show ?thesis
       by simp
   next
     case (divides q)
     then show ?thesis
       by (simp add: ac_simps)
   next
     case (remainder q r)
     then show ?thesis
       by (auto intro: div_eqI simp add: algebra_simps)
   qed
 next
   show"(c * a) div (c * b) = a div b" if "c \<noteq> 0" for a b c
   proof (cases a b rule: divmod_cases)
     case by0
     then show ?thesis
       by simp
   next
     case (divides q)
     with \<open>c \<noteq> 0\<close> show ?thesis
       by (simp add: mult.left_commute [of c])
   next
     case (remainder q r)
     from \<open>b \<noteq> 0\<close> \<open>c \<noteq> 0\<close> have "b * c \<noteq> 0"
       by simp
     from remainder \<open>c \<noteq> 0\<close>
     have "division_segment (r * c) = division_segment (b * c)"
       and "euclidean_size (r * c) < euclidean_size (b * c)"
       by (simp_all add: division_segment_mult division_segment_mod euclidean_size_mult)
     with remainder show ?thesis
       by (auto intro!: div_eqI [of _ "c * (a mod b)"] simp add: algebra_simps)
         (use \<open>b * c \<noteq> 0\<close> in simp)
   qed
 qed
 
 lemma div_mult1_eq:
   "(a * b) div c = a * (b div c) + a * (b mod c) div c"
 proof (cases "a * (b mod c)" c rule: divmod_cases)
   case (divides q)
   have "a * b = a * (b div c * c + b mod c)"
     by (simp add: div_mult_mod_eq)
   also have "\<dots> = (a * (b div c) + q) * c"
     using divides by (simp add: algebra_simps)
   finally have "(a * b) div c = \<dots> div c"
     by simp
   with divides show ?thesis
     by simp
 next
   case (remainder q r)
   from remainder(1-3) show ?thesis
   proof (rule div_eqI)
     have "a * b = a * (b div c * c + b mod c)"
       by (simp add: div_mult_mod_eq)
     also have "\<dots> = a * c * (b div c) + q * c + r"
       using remainder by (simp add: algebra_simps)
     finally show "(a * (b div c) + a * (b mod c) div c) * c + r = a * b"
       using remainder(5-7) by (simp add: algebra_simps)
   qed
 next
   case by0
   then show ?thesis
     by simp
 qed
 
 lemma div_add1_eq:
   "(a + b) div c = a div c + b div c + (a mod c + b mod c) div c"
 proof (cases "a mod c + b mod c" c rule: divmod_cases)
   case (divides q)
   have "a + b = (a div c * c + a mod c) + (b div c * c + b mod c)"
     using mod_mult_div_eq [of a c] mod_mult_div_eq [of b c] by (simp add: ac_simps)
   also have "\<dots> = (a div c + b div c) * c + (a mod c + b mod c)"
     by (simp add: algebra_simps)
   also have "\<dots> = (a div c + b div c + q) * c"
     using divides by (simp add: algebra_simps)
   finally have "(a + b) div c = (a div c + b div c + q) * c div c"
     by simp
   with divides show ?thesis
     by simp
 next
   case (remainder q r)
   from remainder(1-3) show ?thesis
   proof (rule div_eqI)
     have "(a div c + b div c + q) * c + r + (a mod c + b mod c) =
         (a div c * c + a mod c) + (b div c * c + b mod c) + q * c + r"
       by (simp add: algebra_simps)
     also have "\<dots> = a + b + (a mod c + b mod c)"
       by (simp add: div_mult_mod_eq remainder) (simp add: ac_simps)
     finally show "(a div c + b div c + (a mod c + b mod c) div c) * c + r = a + b"
       using remainder by simp
   qed
 next
   case by0
   then show ?thesis
     by simp
 qed
 
 lemma div_eq_0_iff:
   "a div b = 0 \<longleftrightarrow> euclidean_size a < euclidean_size b \<or> b = 0" (is "_ \<longleftrightarrow> ?P")
   if "division_segment a = division_segment b"
 proof
   assume ?P
   with that show "a div b = 0"
     by (cases "b = 0") (auto intro: div_eqI)
 next
   assume "a div b = 0"
   then have "a mod b = a"
     using div_mult_mod_eq [of a b] by simp
   with mod_size_less [of b a] show ?P
     by auto
 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 :: "nat \<Rightarrow> nat"
   where [simp]: "normalize = (id :: nat \<Rightarrow> nat)"
 
 definition unit_factor_nat :: "nat \<Rightarrow> nat"
   where "unit_factor n = (if n = 0 then 0 else 1 :: nat)"
 
 lemma unit_factor_simps [simp]:
   "unit_factor 0 = (0::nat)"
   "unit_factor (Suc n) = 1"
   by (simp_all add: unit_factor_nat_def)
 
 definition divide_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat"
   where "m div n = (if n = 0 then 0 else Max {k::nat. k * n \<le> m})"
 
 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 :: "nat \<Rightarrow> nat"
   where [simp]: "euclidean_size_nat = id"
 
 definition division_segment_nat :: "nat \<Rightarrow> nat"
   where [simp]: "division_segment_nat n = 1"
 
 definition modulo_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat"
   where "m mod n = m - (m div n * (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" 
   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
 
 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_nat_eqI:
   "m div n = q" if "n * q \<le> m" and "m < n * Suc q" for m n q :: nat
   by (rule div_eqI [of _ "m - n * q"]) (use that in \<open>simp_all add: algebra_simps\<close>)
 
 lemma mod_nat_eqI:
   "m mod n = r" if "r < n" and "r \<le> m" and "n dvd m - r" for m n r :: nat
   by (rule mod_eqI [of _ _ "(m - r) div n"]) (use that in \<open>simp_all add: algebra_simps\<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_eqI mod_eqI) 
 
 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     
 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
 
 context
   fixes m n q :: nat
 begin
 
 private lemma eucl_rel_mult2:
   "m mod n + n * (m div n mod q) < n * q"
   if "n > 0" and "q > 0"
 proof -
   from \<open>n > 0\<close> have "m mod n < n"
     by (rule mod_less_divisor)
   from \<open>q > 0\<close> have "m div n mod q < q"
     by (rule mod_less_divisor)
   then obtain s where "q = Suc (m div n mod q + s)"
     by (blast dest: less_imp_Suc_add)
   moreover have "m mod n + n * (m div n mod q) < n * Suc (m div n mod q + s)"
     using \<open>m mod n < n\<close> by (simp add: add_mult_distrib2)
   ultimately show ?thesis
     by simp
 qed
 
 lemma div_mult2_eq:
   "m div (n * q) = (m div n) div q"
 proof (cases "n = 0 \<or> q = 0")
   case True
   then show ?thesis
     by auto
 next
   case False
   with eucl_rel_mult2 show ?thesis
     by (auto intro: div_eqI [of _ "n * (m div n mod q) + m mod n"]
       simp add: algebra_simps add_mult_distrib2 [symmetric])
 qed
 
 lemma mod_mult2_eq:
   "m mod (n * q) = n * (m div n mod q) + m mod n"
 proof (cases "n = 0 \<or> q = 0")
   case True
   then show ?thesis
     by auto
 next
   case False
   with eucl_rel_mult2 show ?thesis
     by (auto intro: mod_eqI [of _ _ "(m div n) div q"]
       simp add: algebra_simps add_mult_distrib2 [symmetric])
 qed
 
 end
 
 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
 
 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) 
         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 split_div:
   "P (m div n) \<longleftrightarrow> (n = 0 \<longrightarrow> P 0) \<and> (n \<noteq> 0 \<longrightarrow>
      (\<forall>i j. j < n \<longrightarrow> m = n * i + j \<longrightarrow> P i))"
      (is "?P = ?Q") for m n :: nat
 proof (cases "n = 0")
   case True
   then show ?thesis
     by simp
 next
   case False
   show ?thesis
   proof
     assume ?P
     with False show ?Q
       by auto
   next
     assume ?Q
     with False have *: "\<And>i j. j < n \<Longrightarrow> m = n * i + j \<Longrightarrow> P i"
       by simp
     with False show ?P
       by (auto intro: * [of "m mod n"])
   qed
 qed
 
 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 split_mod:
   "P (m mod n) \<longleftrightarrow> (n = 0 \<longrightarrow> P m) \<and> (n \<noteq> 0 \<longrightarrow>
      (\<forall>i j. j < n \<longrightarrow> m = n * i + j \<longrightarrow> P j))"
      (is "?P \<longleftrightarrow> ?Q") for m n :: nat
 proof (cases "n = 0")
   case True
   then show ?thesis
     by simp
 next
   case False
   show ?thesis
   proof
     assume ?P
     with False show ?Q
       by auto
   next
     assume ?Q
     with False have *: "\<And>i j. j < n \<Longrightarrow> m = n * i + j \<Longrightarrow> P j"
       by simp
     with False show ?P
       by (auto intro: * [of _ "m div n"])
   qed
 qed
 
 
 subsection \<open>Euclidean division on \<^typ>\<open>int\<close>\<close>
 
 instantiation int :: normalization_semidom
 begin
 
 definition normalize_int :: "int \<Rightarrow> int"
   where [simp]: "normalize = (abs :: int \<Rightarrow> int)"
 
 definition unit_factor_int :: "int \<Rightarrow> int"
   where [simp]: "unit_factor = (sgn :: int \<Rightarrow> int)"
 
 definition divide_int :: "int \<Rightarrow> int \<Rightarrow> int"
   where "k div l = (if l = 0 then 0
     else if sgn k = sgn l
       then int (nat \<bar>k\<bar> div nat \<bar>l\<bar>)
       else - int (nat \<bar>k\<bar> div nat \<bar>l\<bar> + of_bool (\<not> l dvd k)))"
 
 lemma divide_int_unfold:
   "(sgn k * int m) div (sgn l * int n) =
    (if sgn l = 0 \<or> sgn k = 0 \<or> n = 0 then 0
     else if sgn k = sgn l
       then int (m div n)
       else - int (m div n + of_bool (\<not> n dvd m)))"
   by (auto simp add: divide_int_def sgn_0_0 sgn_1_pos sgn_mult abs_mult
     nat_mult_distrib)
 
 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" 
     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)
 qed (auto simp add: sgn_mult mult_sgn_abs abs_eq_iff')
 
 end
 
 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
 
 instantiation int :: idom_modulo
 begin
 
 definition modulo_int :: "int \<Rightarrow> int \<Rightarrow> int"
   where "k mod l = (if l = 0 then k
     else if sgn k = sgn l
       then sgn l * int (nat \<bar>k\<bar> mod nat \<bar>l\<bar>)
       else sgn l * (\<bar>l\<bar> * of_bool (\<not> l dvd k) - int (nat \<bar>k\<bar> mod nat \<bar>l\<bar>)))"
 
 lemma modulo_int_unfold:
   "(sgn k * int m) mod (sgn l * int n) =
    (if sgn l = 0 \<or> sgn k = 0 \<or> n = 0 then sgn k * int m
     else if sgn k = sgn l
       then sgn l * int (m mod n)
       else sgn l * (int (n * of_bool (\<not> n dvd m)) - int (m mod n)))"
   by (auto simp add: modulo_int_def sgn_0_0 sgn_1_pos sgn_mult abs_mult
     nat_mult_distrib)
 
 instance proof
   fix k l :: int
   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 (auto simp add: divide_int_unfold modulo_int_unfold algebra_simps dest!: sgn_not_eq_imp)
        (simp_all add: of_nat_mult [symmetric] of_nat_add [symmetric]
          distrib_left [symmetric] minus_mult_right
          del: of_nat_mult minus_mult_right [symmetric])
 qed
 
 end
 
 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" 
     by (blast intro: int_sgnE elim: that)
   with that show ?thesis
     by (simp add: modulo_int_unfold sgn_0_0 sgn_1_pos sgn_1_neg
       abs_mult mod_greater_zero_iff_not_dvd)
 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" 
     by (blast intro: int_sgnE elim: that)
   with that show ?thesis
-    by (simp add: modulo_int_unfold sgn_0_0 sgn_1_pos sgn_1_neg
-      sgn_mult mod_eq_0_iff_dvd)
+    by (simp add: modulo_int_unfold sgn_0_0 sgn_1_pos sgn_1_neg sgn_mult)
+      (simp add: dvd_eq_mod_eq_0)
 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 sgn_0_0 sgn_1_pos)
     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 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)
       (simp add: mod_greater_zero_iff_not_dvd)
 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)
       (simp add: mod_greater_zero_iff_not_dvd)
 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) simp
 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
   ultimately show ?thesis
     by (simp only: modulo_int_unfold) simp
 qed
 
 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:
   "k div l = - 1" if "0 < k" and "k + l \<le> 0" for k l :: int
 proof (cases \<open>l = - k\<close>)
   case True
   with that show ?thesis
     by (simp add: divide_int_def)
 next
   case False
   show ?thesis
     apply (rule div_eqI [of _ "k + l"])
     using False that apply (simp_all add: division_segment_int_def)
     done
 qed
 
 lemma mod_pos_neg_trivial:
   "k mod l = k + l" if "0 < k" and "k + l \<le> 0" for k l :: int
 proof (cases \<open>l = - k\<close>)
   case True
   with that show ?thesis
     by (simp add: divide_int_def)
 next
   case False
   show ?thesis
     apply (rule mod_eqI [of _ _ \<open>- 1\<close>])
     using False that apply (simp_all add: division_segment_int_def)
     done
 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>
 
 text \<open>Distributive laws for function \<open>nat\<close>.\<close>
 
 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)
 
 
 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':
   "a div (of_nat m * of_nat n) = a div of_nat m div of_nat n"
 proof (cases a "of_nat m * of_nat n" rule: divmod_cases)
   case (divides q)
   then show ?thesis
     using nonzero_mult_div_cancel_right [of "of_nat m" "q * of_nat n"]
     by (simp add: ac_simps)
 next
   case (remainder q r)
   then have "division_segment r = 1"
     using division_segment_of_nat [of "m * n"] by simp
   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 remainder(6) 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 remainder(1)
   have "q = (r div of_nat m + q * of_nat n * of_nat m div of_nat m) div of_nat n"
     by simp
   with remainder(5) remainder(7) show ?thesis
     using div_plus_div_distrib_dvd_right [of "of_nat m" "q * (of_nat m * of_nat n)" r]
     by (simp add: ac_simps)
 next
   case by0
   then show ?thesis
     by auto
 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 min.absorb2)
   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 (simp_all add: dvd_eq_mod_eq_0 divide_int_def division_segment_int_def)
 
 
 subsection \<open>Code generation\<close>
 
 code_identifier
   code_module Euclidean_Division \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith
 
 end
diff --git a/src/HOL/Groups_Big.thy b/src/HOL/Groups_Big.thy
--- a/src/HOL/Groups_Big.thy
+++ b/src/HOL/Groups_Big.thy
@@ -1,1654 +1,1673 @@
 (*  Title:      HOL/Groups_Big.thy
     Author:     Tobias Nipkow
     Author:     Lawrence C Paulson
     Author:     Markus Wenzel
     Author:     Jeremy Avigad
 *)
 
 section \<open>Big sum and product over finite (non-empty) sets\<close>
 
 theory Groups_Big
   imports Power
 begin
 
 subsection \<open>Generic monoid operation over a set\<close>
 
 locale comm_monoid_set = comm_monoid
 begin
 
 subsubsection \<open>Standard sum or product indexed by a finite set\<close>
 
 interpretation comp_fun_commute f
   by standard (simp add: fun_eq_iff left_commute)
 
 interpretation comp?: comp_fun_commute "f \<circ> g"
   by (fact comp_comp_fun_commute)
 
 definition F :: "('b \<Rightarrow> 'a) \<Rightarrow> 'b set \<Rightarrow> 'a"
   where eq_fold: "F g A = Finite_Set.fold (f \<circ> g) \<^bold>1 A"
 
 lemma infinite [simp]: "\<not> finite A \<Longrightarrow> F g A = \<^bold>1"
   by (simp add: eq_fold)
 
 lemma empty [simp]: "F g {} = \<^bold>1"
   by (simp add: eq_fold)
 
 lemma insert [simp]: "finite A \<Longrightarrow> x \<notin> A \<Longrightarrow> F g (insert x A) = g x \<^bold>* F g A"
   by (simp add: eq_fold)
 
 lemma remove:
   assumes "finite A" and "x \<in> A"
   shows "F g A = g x \<^bold>* F g (A - {x})"
 proof -
   from \<open>x \<in> A\<close> obtain B where B: "A = insert x B" and "x \<notin> B"
     by (auto dest: mk_disjoint_insert)
   moreover from \<open>finite A\<close> B have "finite B" by simp
   ultimately show ?thesis by simp
 qed
 
 lemma insert_remove: "finite A \<Longrightarrow> F g (insert x A) = g x \<^bold>* F g (A - {x})"
   by (cases "x \<in> A") (simp_all add: remove insert_absorb)
 
 lemma insert_if: "finite A \<Longrightarrow> F g (insert x A) = (if x \<in> A then F g A else g x \<^bold>* F g A)"
   by (cases "x \<in> A") (simp_all add: insert_absorb)
 
 lemma neutral: "\<forall>x\<in>A. g x = \<^bold>1 \<Longrightarrow> F g A = \<^bold>1"
   by (induct A rule: infinite_finite_induct) simp_all
 
 lemma neutral_const [simp]: "F (\<lambda>_. \<^bold>1) A = \<^bold>1"
   by (simp add: neutral)
 
 lemma union_inter:
   assumes "finite A" and "finite B"
   shows "F g (A \<union> B) \<^bold>* F g (A \<inter> B) = F g A \<^bold>* F g B"
   \<comment> \<open>The reversed orientation looks more natural, but LOOPS as a simprule!\<close>
   using assms
 proof (induct A)
   case empty
   then show ?case by simp
 next
   case (insert x A)
   then show ?case
     by (auto simp: insert_absorb Int_insert_left commute [of _ "g x"] assoc left_commute)
 qed
 
 corollary union_inter_neutral:
   assumes "finite A" and "finite B"
     and "\<forall>x \<in> A \<inter> B. g x = \<^bold>1"
   shows "F g (A \<union> B) = F g A \<^bold>* F g B"
   using assms by (simp add: union_inter [symmetric] neutral)
 
 corollary union_disjoint:
   assumes "finite A" and "finite B"
   assumes "A \<inter> B = {}"
   shows "F g (A \<union> B) = F g A \<^bold>* F g B"
   using assms by (simp add: union_inter_neutral)
 
 lemma union_diff2:
   assumes "finite A" and "finite B"
   shows "F g (A \<union> B) = F g (A - B) \<^bold>* F g (B - A) \<^bold>* F g (A \<inter> B)"
 proof -
   have "A \<union> B = A - B \<union> (B - A) \<union> A \<inter> B"
     by auto
   with assms show ?thesis
     by simp (subst union_disjoint, auto)+
 qed
 
 lemma subset_diff:
   assumes "B \<subseteq> A" and "finite A"
   shows "F g A = F g (A - B) \<^bold>* F g B"
 proof -
   from assms have "finite (A - B)" by auto
   moreover from assms have "finite B" by (rule finite_subset)
   moreover from assms have "(A - B) \<inter> B = {}" by auto
   ultimately have "F g (A - B \<union> B) = F g (A - B) \<^bold>* F g B" by (rule union_disjoint)
   moreover from assms have "A \<union> B = A" by auto
   ultimately show ?thesis by simp
 qed
 
 lemma Int_Diff:
   assumes "finite A"
   shows "F g A = F g (A \<inter> B) \<^bold>* F g (A - B)"
   by (subst subset_diff [where B = "A - B"]) (auto simp:  Diff_Diff_Int assms)
 
 lemma setdiff_irrelevant:
   assumes "finite A"
   shows "F g (A - {x. g x = z}) = F g A"
   using assms by (induct A) (simp_all add: insert_Diff_if)
 
 lemma not_neutral_contains_not_neutral:
   assumes "F g A \<noteq> \<^bold>1"
   obtains a where "a \<in> A" and "g a \<noteq> \<^bold>1"
 proof -
   from assms have "\<exists>a\<in>A. g a \<noteq> \<^bold>1"
   proof (induct A rule: infinite_finite_induct)
     case infinite
     then show ?case by simp
   next
     case empty
     then show ?case by simp
   next
     case (insert a A)
     then show ?case by fastforce
   qed
   with that show thesis by blast
 qed
 
 lemma reindex:
   assumes "inj_on h A"
   shows "F g (h ` A) = F (g \<circ> h) A"
 proof (cases "finite A")
   case True
   with assms show ?thesis
     by (simp add: eq_fold fold_image comp_assoc)
 next
   case False
   with assms have "\<not> finite (h ` A)" by (blast dest: finite_imageD)
   with False show ?thesis by simp
 qed
 
 lemma cong [fundef_cong]:
   assumes "A = B"
   assumes g_h: "\<And>x. x \<in> B \<Longrightarrow> g x = h x"
   shows "F g A = F h B"
   using g_h unfolding \<open>A = B\<close>
   by (induct B rule: infinite_finite_induct) auto
 
 lemma cong_simp [cong]:
   "\<lbrakk> A = B;  \<And>x. x \<in> B =simp=> g x = h x \<rbrakk> \<Longrightarrow> F (\<lambda>x. g x) A = F (\<lambda>x. h x) B"
 by (rule cong) (simp_all add: simp_implies_def)
 
 lemma reindex_cong:
   assumes "inj_on l B"
   assumes "A = l ` B"
   assumes "\<And>x. x \<in> B \<Longrightarrow> g (l x) = h x"
   shows "F g A = F h B"
   using assms by (simp add: reindex)
 
 lemma image_eq:
   assumes "inj_on g A"  
   shows "F (\<lambda>x. x) (g ` A) = F g A"
   using assms reindex_cong by fastforce
 
 lemma UNION_disjoint:
   assumes "finite I" and "\<forall>i\<in>I. finite (A i)"
     and "\<forall>i\<in>I. \<forall>j\<in>I. i \<noteq> j \<longrightarrow> A i \<inter> A j = {}"
   shows "F g (\<Union>(A ` I)) = F (\<lambda>x. F g (A x)) I"
   using assms
 proof (induction rule: finite_induct)
   case (insert i I)
   then have "\<forall>j\<in>I. j \<noteq> i"
     by blast
   with insert.prems have "A i \<inter> \<Union>(A ` I) = {}"
     by blast
   with insert show ?case
     by (simp add: union_disjoint)
 qed auto
 
 lemma Union_disjoint:
   assumes "\<forall>A\<in>C. finite A" "\<forall>A\<in>C. \<forall>B\<in>C. A \<noteq> B \<longrightarrow> A \<inter> B = {}"
   shows "F g (\<Union>C) = (F \<circ> F) g C"
 proof (cases "finite C")
   case True
   from UNION_disjoint [OF this assms] show ?thesis by simp
 next
   case False
   then show ?thesis by (auto dest: finite_UnionD intro: infinite)
 qed
 
 lemma distrib: "F (\<lambda>x. g x \<^bold>* h x) A = F g A \<^bold>* F h A"
   by (induct A rule: infinite_finite_induct) (simp_all add: assoc commute left_commute)
 
 lemma Sigma:
   assumes "finite A" "\<forall>x\<in>A. finite (B x)"
   shows "F (\<lambda>x. F (g x) (B x)) A = F (case_prod g) (SIGMA x:A. B x)"
   unfolding Sigma_def
 proof (subst UNION_disjoint)
   show "F (\<lambda>x. F (g x) (B x)) A = F (\<lambda>x. F (\<lambda>(x, y). g x y) (\<Union>y\<in>B x. {(x, y)})) A"
   proof (rule cong [OF refl])
     show "F (g x) (B x) = F (\<lambda>(x, y). g x y) (\<Union>y\<in>B x. {(x, y)})"
       if "x \<in> A" for x
       using that assms by (simp add: UNION_disjoint)
   qed
 qed (use assms in auto)
 
 lemma related:
   assumes Re: "R \<^bold>1 \<^bold>1"
     and Rop: "\<forall>x1 y1 x2 y2. R x1 x2 \<and> R y1 y2 \<longrightarrow> R (x1 \<^bold>* y1) (x2 \<^bold>* y2)"
     and fin: "finite S"
     and R_h_g: "\<forall>x\<in>S. R (h x) (g x)"
   shows "R (F h S) (F g S)"
   using fin by (rule finite_subset_induct) (use assms in auto)
 
 lemma mono_neutral_cong_left:
   assumes "finite T"
     and "S \<subseteq> T"
     and "\<forall>i \<in> T - S. h i = \<^bold>1"
     and "\<And>x. x \<in> S \<Longrightarrow> g x = h x"
   shows "F g S = F h T"
 proof-
   have eq: "T = S \<union> (T - S)" using \<open>S \<subseteq> T\<close> by blast
   have d: "S \<inter> (T - S) = {}" using \<open>S \<subseteq> T\<close> by blast
   from \<open>finite T\<close> \<open>S \<subseteq> T\<close> have f: "finite S" "finite (T - S)"
     by (auto intro: finite_subset)
   show ?thesis using assms(4)
     by (simp add: union_disjoint [OF f d, unfolded eq [symmetric]] neutral [OF assms(3)])
 qed
 
 lemma mono_neutral_cong_right:
   "finite T \<Longrightarrow> S \<subseteq> T \<Longrightarrow> \<forall>i \<in> T - S. g i = \<^bold>1 \<Longrightarrow> (\<And>x. x \<in> S \<Longrightarrow> g x = h x) \<Longrightarrow>
     F g T = F h S"
   by (auto intro!: mono_neutral_cong_left [symmetric])
 
 lemma mono_neutral_left: "finite T \<Longrightarrow> S \<subseteq> T \<Longrightarrow> \<forall>i \<in> T - S. g i = \<^bold>1 \<Longrightarrow> F g S = F g T"
   by (blast intro: mono_neutral_cong_left)
 
 lemma mono_neutral_right: "finite T \<Longrightarrow> S \<subseteq> T \<Longrightarrow> \<forall>i \<in> T - S. g i = \<^bold>1 \<Longrightarrow> F g T = F g S"
   by (blast intro!: mono_neutral_left [symmetric])
 
 lemma mono_neutral_cong:
   assumes [simp]: "finite T" "finite S"
     and *: "\<And>i. i \<in> T - S \<Longrightarrow> h i = \<^bold>1" "\<And>i. i \<in> S - T \<Longrightarrow> g i = \<^bold>1"
     and gh: "\<And>x. x \<in> S \<inter> T \<Longrightarrow> g x = h x"
  shows "F g S = F h T"
 proof-
   have "F g S = F g (S \<inter> T)"
     by(rule mono_neutral_right)(auto intro: *)
   also have "\<dots> = F h (S \<inter> T)" using refl gh by(rule cong)
   also have "\<dots> = F h T"
     by(rule mono_neutral_left)(auto intro: *)
   finally show ?thesis .
 qed
 
 lemma reindex_bij_betw: "bij_betw h S T \<Longrightarrow> F (\<lambda>x. g (h x)) S = F g T"
   by (auto simp: bij_betw_def reindex)
 
 lemma reindex_bij_witness:
   assumes witness:
     "\<And>a. a \<in> S \<Longrightarrow> i (j a) = a"
     "\<And>a. a \<in> S \<Longrightarrow> j a \<in> T"
     "\<And>b. b \<in> T \<Longrightarrow> j (i b) = b"
     "\<And>b. b \<in> T \<Longrightarrow> i b \<in> S"
   assumes eq:
     "\<And>a. a \<in> S \<Longrightarrow> h (j a) = g a"
   shows "F g S = F h T"
 proof -
   have "bij_betw j S T"
     using bij_betw_byWitness[where A=S and f=j and f'=i and A'=T] witness by auto
   moreover have "F g S = F (\<lambda>x. h (j x)) S"
     by (intro cong) (auto simp: eq)
   ultimately show ?thesis
     by (simp add: reindex_bij_betw)
 qed
 
 lemma reindex_bij_betw_not_neutral:
   assumes fin: "finite S'" "finite T'"
   assumes bij: "bij_betw h (S - S') (T - T')"
   assumes nn:
     "\<And>a. a \<in> S' \<Longrightarrow> g (h a) = z"
     "\<And>b. b \<in> T' \<Longrightarrow> g b = z"
   shows "F (\<lambda>x. g (h x)) S = F g T"
 proof -
   have [simp]: "finite S \<longleftrightarrow> finite T"
     using bij_betw_finite[OF bij] fin by auto
   show ?thesis
   proof (cases "finite S")
     case True
     with nn have "F (\<lambda>x. g (h x)) S = F (\<lambda>x. g (h x)) (S - S')"
       by (intro mono_neutral_cong_right) auto
     also have "\<dots> = F g (T - T')"
       using bij by (rule reindex_bij_betw)
     also have "\<dots> = F g T"
       using nn \<open>finite S\<close> by (intro mono_neutral_cong_left) auto
     finally show ?thesis .
   next
     case False
     then show ?thesis by simp
   qed
 qed
 
 lemma reindex_nontrivial:
   assumes "finite A"
     and nz: "\<And>x y. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<noteq> y \<Longrightarrow> h x = h y \<Longrightarrow> g (h x) = \<^bold>1"
   shows "F g (h ` A) = F (g \<circ> h) A"
 proof (subst reindex_bij_betw_not_neutral [symmetric])
   show "bij_betw h (A - {x \<in> A. (g \<circ> h) x = \<^bold>1}) (h ` A - h ` {x \<in> A. (g \<circ> h) x = \<^bold>1})"
     using nz by (auto intro!: inj_onI simp: bij_betw_def)
 qed (use \<open>finite A\<close> in auto)
 
 lemma reindex_bij_witness_not_neutral:
   assumes fin: "finite S'" "finite T'"
   assumes witness:
     "\<And>a. a \<in> S - S' \<Longrightarrow> i (j a) = a"
     "\<And>a. a \<in> S - S' \<Longrightarrow> j a \<in> T - T'"
     "\<And>b. b \<in> T - T' \<Longrightarrow> j (i b) = b"
     "\<And>b. b \<in> T - T' \<Longrightarrow> i b \<in> S - S'"
   assumes nn:
     "\<And>a. a \<in> S' \<Longrightarrow> g a = z"
     "\<And>b. b \<in> T' \<Longrightarrow> h b = z"
   assumes eq:
     "\<And>a. a \<in> S \<Longrightarrow> h (j a) = g a"
   shows "F g S = F h T"
 proof -
   have bij: "bij_betw j (S - (S' \<inter> S)) (T - (T' \<inter> T))"
     using witness by (intro bij_betw_byWitness[where f'=i]) auto
   have F_eq: "F g S = F (\<lambda>x. h (j x)) S"
     by (intro cong) (auto simp: eq)
   show ?thesis
     unfolding F_eq using fin nn eq
     by (intro reindex_bij_betw_not_neutral[OF _ _ bij]) auto
 qed
 
 lemma delta_remove:
   assumes fS: "finite S"
   shows "F (\<lambda>k. if k = a then b k else c k) S = (if a \<in> S then b a \<^bold>* F c (S-{a}) else F c (S-{a}))"
 proof -
   let ?f = "(\<lambda>k. if k = a then b k else c k)"
   show ?thesis
   proof (cases "a \<in> S")
     case False
     then have "\<forall>k\<in>S. ?f k = c k" by simp
     with False show ?thesis by simp
   next
     case True
     let ?A = "S - {a}"
     let ?B = "{a}"
     from True have eq: "S = ?A \<union> ?B" by blast
     have dj: "?A \<inter> ?B = {}" by simp
     from fS have fAB: "finite ?A" "finite ?B" by auto
     have "F ?f S = F ?f ?A \<^bold>* F ?f ?B"
       using union_disjoint [OF fAB dj, of ?f, unfolded eq [symmetric]] by simp
     with True show ?thesis
       using comm_monoid_set.remove comm_monoid_set_axioms fS by fastforce
   qed
 qed
 
 lemma delta [simp]:
   assumes fS: "finite S"
   shows "F (\<lambda>k. if k = a then b k else \<^bold>1) S = (if a \<in> S then b a else \<^bold>1)"
   by (simp add: delta_remove [OF assms])
 
 lemma delta' [simp]:
   assumes fin: "finite S"
   shows "F (\<lambda>k. if a = k then b k else \<^bold>1) S = (if a \<in> S then b a else \<^bold>1)"
   using delta [OF fin, of a b, symmetric] by (auto intro: cong)
 
 lemma If_cases:
   fixes P :: "'b \<Rightarrow> bool" and g h :: "'b \<Rightarrow> 'a"
   assumes fin: "finite A"
   shows "F (\<lambda>x. if P x then h x else g x) A = F h (A \<inter> {x. P x}) \<^bold>* F g (A \<inter> - {x. P x})"
 proof -
   have a: "A = A \<inter> {x. P x} \<union> A \<inter> -{x. P x}" "(A \<inter> {x. P x}) \<inter> (A \<inter> -{x. P x}) = {}"
     by blast+
   from fin have f: "finite (A \<inter> {x. P x})" "finite (A \<inter> -{x. P x})" by auto
   let ?g = "\<lambda>x. if P x then h x else g x"
   from union_disjoint [OF f a(2), of ?g] a(1) show ?thesis
     by (subst (1 2) cong) simp_all
 qed
 
 lemma cartesian_product: "F (\<lambda>x. F (g x) B) A = F (case_prod g) (A \<times> B)"
 proof (cases "A = {} \<or> B = {}")
   case True
   then show ?thesis
     by auto
 next
   case False
   then have "A \<noteq> {}" "B \<noteq> {}" by auto
   show ?thesis
   proof (cases "finite A \<and> finite B")
     case True
     then show ?thesis
       by (simp add: Sigma)
   next
     case False
     then consider "infinite A" | "infinite B" by auto
     then have "infinite (A \<times> B)"
       by cases (use \<open>A \<noteq> {}\<close> \<open>B \<noteq> {}\<close> in \<open>auto dest: finite_cartesian_productD1 finite_cartesian_productD2\<close>)
     then show ?thesis
       using False by auto
   qed
 qed
 
 lemma inter_restrict:
   assumes "finite A"
   shows "F g (A \<inter> B) = F (\<lambda>x. if x \<in> B then g x else \<^bold>1) A"
 proof -
   let ?g = "\<lambda>x. if x \<in> A \<inter> B then g x else \<^bold>1"
   have "\<forall>i\<in>A - A \<inter> B. (if i \<in> A \<inter> B then g i else \<^bold>1) = \<^bold>1" by simp
   moreover have "A \<inter> B \<subseteq> A" by blast
   ultimately have "F ?g (A \<inter> B) = F ?g A"
     using \<open>finite A\<close> by (intro mono_neutral_left) auto
   then show ?thesis by simp
 qed
 
 lemma inter_filter:
   "finite A \<Longrightarrow> F g {x \<in> A. P x} = F (\<lambda>x. if P x then g x else \<^bold>1) A"
   by (simp add: inter_restrict [symmetric, of A "{x. P x}" g, simplified mem_Collect_eq] Int_def)
 
 lemma Union_comp:
   assumes "\<forall>A \<in> B. finite A"
     and "\<And>A1 A2 x. A1 \<in> B \<Longrightarrow> A2 \<in> B \<Longrightarrow> A1 \<noteq> A2 \<Longrightarrow> x \<in> A1 \<Longrightarrow> x \<in> A2 \<Longrightarrow> g x = \<^bold>1"
   shows "F g (\<Union>B) = (F \<circ> F) g B"
   using assms
 proof (induct B rule: infinite_finite_induct)
   case (infinite A)
   then have "\<not> finite (\<Union>A)" by (blast dest: finite_UnionD)
   with infinite show ?case by simp
 next
   case empty
   then show ?case by simp
 next
   case (insert A B)
   then have "finite A" "finite B" "finite (\<Union>B)" "A \<notin> B"
     and "\<forall>x\<in>A \<inter> \<Union>B. g x = \<^bold>1"
     and H: "F g (\<Union>B) = (F \<circ> F) g B" by auto
   then have "F g (A \<union> \<Union>B) = F g A \<^bold>* F g (\<Union>B)"
     by (simp add: union_inter_neutral)
   with \<open>finite B\<close> \<open>A \<notin> B\<close> show ?case
     by (simp add: H)
 qed
 
 lemma swap: "F (\<lambda>i. F (g i) B) A = F (\<lambda>j. F (\<lambda>i. g i j) A) B"
   unfolding cartesian_product
   by (rule reindex_bij_witness [where i = "\<lambda>(i, j). (j, i)" and j = "\<lambda>(i, j). (j, i)"]) auto
 
 lemma swap_restrict:
   "finite A \<Longrightarrow> finite B \<Longrightarrow>
     F (\<lambda>x. F (g x) {y. y \<in> B \<and> R x y}) A = F (\<lambda>y. F (\<lambda>x. g x y) {x. x \<in> A \<and> R x y}) B"
   by (simp add: inter_filter) (rule swap)
 
 lemma image_gen:
   assumes fin: "finite S"
   shows "F h S = F (\<lambda>y. F h {x. x \<in> S \<and> g x = y}) (g ` S)"
 proof -
   have "{y. y\<in> g`S \<and> g x = y} = {g x}" if "x \<in> S" for x
     using that by auto
   then have "F h S = F (\<lambda>x. F (\<lambda>y. h x) {y. y\<in> g`S \<and> g x = y}) S"
     by simp
   also have "\<dots> = F (\<lambda>y. F h {x. x \<in> S \<and> g x = y}) (g ` S)"
     by (rule swap_restrict [OF fin finite_imageI [OF fin]])
   finally show ?thesis .
 qed
 
 lemma group:
   assumes fS: "finite S" and fT: "finite T" and fST: "g ` S \<subseteq> T"
   shows "F (\<lambda>y. F h {x. x \<in> S \<and> g x = y}) T = F h S"
   unfolding image_gen[OF fS, of h g]
   by (auto intro: neutral mono_neutral_right[OF fT fST])
 
 lemma Plus:
   fixes A :: "'b set" and B :: "'c set"
   assumes fin: "finite A" "finite B"
   shows "F g (A <+> B) = F (g \<circ> Inl) A \<^bold>* F (g \<circ> Inr) B"
 proof -
   have "A <+> B = Inl ` A \<union> Inr ` B" by auto
   moreover from fin have "finite (Inl ` A)" "finite (Inr ` B)" by auto
   moreover have "Inl ` A \<inter> Inr ` B = {}" by auto
   moreover have "inj_on Inl A" "inj_on Inr B" by (auto intro: inj_onI)
   ultimately show ?thesis
     using fin by (simp add: union_disjoint reindex)
 qed
 
 lemma same_carrier:
   assumes "finite C"
   assumes subset: "A \<subseteq> C" "B \<subseteq> C"
   assumes trivial: "\<And>a. a \<in> C - A \<Longrightarrow> g a = \<^bold>1" "\<And>b. b \<in> C - B \<Longrightarrow> h b = \<^bold>1"
   shows "F g A = F h B \<longleftrightarrow> F g C = F h C"
 proof -
   have "finite A" and "finite B" and "finite (C - A)" and "finite (C - B)"
     using \<open>finite C\<close> subset by (auto elim: finite_subset)
   from subset have [simp]: "A - (C - A) = A" by auto
   from subset have [simp]: "B - (C - B) = B" by auto
   from subset have "C = A \<union> (C - A)" by auto
   then have "F g C = F g (A \<union> (C - A))" by simp
   also have "\<dots> = F g (A - (C - A)) \<^bold>* F g (C - A - A) \<^bold>* F g (A \<inter> (C - A))"
     using \<open>finite A\<close> \<open>finite (C - A)\<close> by (simp only: union_diff2)
   finally have *: "F g C = F g A" using trivial by simp
   from subset have "C = B \<union> (C - B)" by auto
   then have "F h C = F h (B \<union> (C - B))" by simp
   also have "\<dots> = F h (B - (C - B)) \<^bold>* F h (C - B - B) \<^bold>* F h (B \<inter> (C - B))"
     using \<open>finite B\<close> \<open>finite (C - B)\<close> by (simp only: union_diff2)
   finally have "F h C = F h B"
     using trivial by simp
   with * show ?thesis by simp
 qed
 
 lemma same_carrierI:
   assumes "finite C"
   assumes subset: "A \<subseteq> C" "B \<subseteq> C"
   assumes trivial: "\<And>a. a \<in> C - A \<Longrightarrow> g a = \<^bold>1" "\<And>b. b \<in> C - B \<Longrightarrow> h b = \<^bold>1"
   assumes "F g C = F h C"
   shows "F g A = F h B"
   using assms same_carrier [of C A B] by simp
 
 lemma eq_general:
   assumes B: "\<And>y. y \<in> B \<Longrightarrow> \<exists>!x. x \<in> A \<and> h x = y" and A: "\<And>x. x \<in> A \<Longrightarrow> h x \<in> B \<and> \<gamma>(h x) = \<phi> x"
   shows "F \<phi> A = F \<gamma> B"
 proof -
   have eq: "B = h ` A"
     by (auto dest: assms)
   have h: "inj_on h A"
     using assms by (blast intro: inj_onI)
   have "F \<phi> A = F (\<gamma> \<circ> h) A"
     using A by auto
   also have "\<dots> = F \<gamma> B"
     by (simp add: eq reindex h)
   finally show ?thesis .
 qed
 
 lemma eq_general_inverses:
   assumes B: "\<And>y. y \<in> B \<Longrightarrow> k y \<in> A \<and> h(k y) = y" and A: "\<And>x. x \<in> A \<Longrightarrow> h x \<in> B \<and> k(h x) = x \<and> \<gamma>(h x) = \<phi> x"
   shows "F \<phi> A = F \<gamma> B"
   by (rule eq_general [where h=h]) (force intro: dest: A B)+
 
 subsubsection \<open>HOL Light variant: sum/product indexed by the non-neutral subset\<close>
 text \<open>NB only a subset of the properties above are proved\<close>
 
 definition G :: "['b \<Rightarrow> 'a,'b set] \<Rightarrow> 'a"
   where "G p I \<equiv> if finite {x \<in> I. p x \<noteq> \<^bold>1} then F p {x \<in> I. p x \<noteq> \<^bold>1} else \<^bold>1"
 
 lemma finite_Collect_op:
   shows "\<lbrakk>finite {i \<in> I. x i \<noteq> \<^bold>1}; finite {i \<in> I. y i \<noteq> \<^bold>1}\<rbrakk> \<Longrightarrow> finite {i \<in> I. x i \<^bold>* y i \<noteq> \<^bold>1}"
   apply (rule finite_subset [where B = "{i \<in> I. x i \<noteq> \<^bold>1} \<union> {i \<in> I. y i \<noteq> \<^bold>1}"]) 
   using left_neutral by force+
 
 lemma empty' [simp]: "G p {} = \<^bold>1"
   by (auto simp: G_def)
 
 lemma eq_sum [simp]: "finite I \<Longrightarrow> G p I = F p I"
   by (auto simp: G_def intro: mono_neutral_cong_left)
 
 lemma insert' [simp]:
   assumes "finite {x \<in> I. p x \<noteq> \<^bold>1}"
   shows "G p (insert i I) = (if i \<in> I then G p I else p i \<^bold>* G p I)"
 proof -
   have "{x. x = i \<and> p x \<noteq> \<^bold>1 \<or> x \<in> I \<and> p x \<noteq> \<^bold>1} = (if p i = \<^bold>1 then {x \<in> I. p x \<noteq> \<^bold>1} else insert i {x \<in> I. p x \<noteq> \<^bold>1})"
     by auto
   then show ?thesis
     using assms by (simp add: G_def conj_disj_distribR insert_absorb)
 qed
 
 lemma distrib_triv':
   assumes "finite I"
   shows "G (\<lambda>i. g i \<^bold>* h i) I = G g I \<^bold>* G h I"
   by (simp add: assms local.distrib)
 
 lemma non_neutral': "G g {x \<in> I. g x \<noteq> \<^bold>1} = G g I"
   by (simp add: G_def)
 
 lemma distrib':
   assumes "finite {x \<in> I. g x \<noteq> \<^bold>1}" "finite {x \<in> I. h x \<noteq> \<^bold>1}"
   shows "G (\<lambda>i. g i \<^bold>* h i) I = G g I \<^bold>* G h I"
 proof -
   have "a \<^bold>* a \<noteq> a \<Longrightarrow> a \<noteq> \<^bold>1" for a
     by auto
   then have "G (\<lambda>i. g i \<^bold>* h i) I = G (\<lambda>i. g i \<^bold>* h i) ({i \<in> I. g i \<noteq> \<^bold>1} \<union> {i \<in> I. h i \<noteq> \<^bold>1})"
     using assms  by (force simp: G_def finite_Collect_op intro!: mono_neutral_cong)
   also have "\<dots> = G g I \<^bold>* G h I"
   proof -
     have "F g ({i \<in> I. g i \<noteq> \<^bold>1} \<union> {i \<in> I. h i \<noteq> \<^bold>1}) = G g I"
          "F h ({i \<in> I. g i \<noteq> \<^bold>1} \<union> {i \<in> I. h i \<noteq> \<^bold>1}) = G h I"
       by (auto simp: G_def assms intro: mono_neutral_right)
     then show ?thesis
       using assms by (simp add: distrib)
   qed
   finally show ?thesis .
 qed
 
 lemma cong':
   assumes "A = B"
   assumes g_h: "\<And>x. x \<in> B \<Longrightarrow> g x = h x"
   shows "G g A = G h B"
   using assms by (auto simp: G_def cong: conj_cong intro: cong)
 
 
 lemma mono_neutral_cong_left':
   assumes "S \<subseteq> T"
     and "\<And>i. i \<in> T - S \<Longrightarrow> h i = \<^bold>1"
     and "\<And>x. x \<in> S \<Longrightarrow> g x = h x"
   shows "G g S = G h T"
 proof -
   have *: "{x \<in> S. g x \<noteq> \<^bold>1} = {x \<in> T. h x \<noteq> \<^bold>1}"
     using assms by (metis DiffI subset_eq) 
   then have "finite {x \<in> S. g x \<noteq> \<^bold>1} = finite {x \<in> T. h x \<noteq> \<^bold>1}"
     by simp
   then show ?thesis
     using assms by (auto simp add: G_def * intro: cong)
 qed
 
 lemma mono_neutral_cong_right':
   "S \<subseteq> T \<Longrightarrow> \<forall>i \<in> T - S. g i = \<^bold>1 \<Longrightarrow> (\<And>x. x \<in> S \<Longrightarrow> g x = h x) \<Longrightarrow>
     G g T = G h S"
   by (auto intro!: mono_neutral_cong_left' [symmetric])
 
 lemma mono_neutral_left': "S \<subseteq> T \<Longrightarrow> \<forall>i \<in> T - S. g i = \<^bold>1 \<Longrightarrow> G g S = G g T"
   by (blast intro: mono_neutral_cong_left')
 
 lemma mono_neutral_right': "S \<subseteq> T \<Longrightarrow> \<forall>i \<in> T - S. g i = \<^bold>1 \<Longrightarrow> G g T = G g S"
   by (blast intro!: mono_neutral_left' [symmetric])
 
 end
 
 
 subsection \<open>Generalized summation over a set\<close>
 
 context comm_monoid_add
 begin
 
 sublocale sum: comm_monoid_set plus 0
   defines sum = sum.F and sum' = sum.G ..
 
 abbreviation Sum ("\<Sum>")
   where "\<Sum> \<equiv> sum (\<lambda>x. x)"
 
 end
 
 text \<open>Now: lots of fancy syntax. First, \<^term>\<open>sum (\<lambda>x. e) A\<close> is written \<open>\<Sum>x\<in>A. e\<close>.\<close>
 
 syntax (ASCII)
   "_sum" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b::comm_monoid_add"  ("(3SUM (_/:_)./ _)" [0, 51, 10] 10)
 syntax
   "_sum" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b::comm_monoid_add"  ("(2\<Sum>(_/\<in>_)./ _)" [0, 51, 10] 10)
 translations \<comment> \<open>Beware of argument permutation!\<close>
   "\<Sum>i\<in>A. b" \<rightleftharpoons> "CONST sum (\<lambda>i. b) A"
 
 text \<open>Instead of \<^term>\<open>\<Sum>x\<in>{x. P}. e\<close> we introduce the shorter \<open>\<Sum>x|P. e\<close>.\<close>
 
 syntax (ASCII)
   "_qsum" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a"  ("(3SUM _ |/ _./ _)" [0, 0, 10] 10)
 syntax
   "_qsum" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a"  ("(2\<Sum>_ | (_)./ _)" [0, 0, 10] 10)
 translations
   "\<Sum>x|P. t" => "CONST sum (\<lambda>x. t) {x. P}"
 
 print_translation \<open>
 let
   fun sum_tr' [Abs (x, Tx, t), Const (\<^const_syntax>\<open>Collect\<close>, _) $ Abs (y, Ty, P)] =
         if x <> y then raise Match
         else
           let
             val x' = Syntax_Trans.mark_bound_body (x, Tx);
             val t' = subst_bound (x', t);
             val P' = subst_bound (x', P);
           in
             Syntax.const \<^syntax_const>\<open>_qsum\<close> $ Syntax_Trans.mark_bound_abs (x, Tx) $ P' $ t'
           end
     | sum_tr' _ = raise Match;
 in [(\<^const_syntax>\<open>sum\<close>, K sum_tr')] end
 \<close>
 
 
 subsubsection \<open>Properties in more restricted classes of structures\<close>
 
 lemma sum_Un:
   "finite A \<Longrightarrow> finite B \<Longrightarrow> sum f (A \<union> B) = sum f A + sum f B - sum f (A \<inter> B)"
   for f :: "'b \<Rightarrow> 'a::ab_group_add"
   by (subst sum.union_inter [symmetric]) (auto simp add: algebra_simps)
 
 lemma sum_Un2:
   assumes "finite (A \<union> B)"
   shows "sum f (A \<union> B) = sum f (A - B) + sum f (B - A) + sum f (A \<inter> B)"
 proof -
   have "A \<union> B = A - B \<union> (B - A) \<union> A \<inter> B"
     by auto
   with assms show ?thesis
     by simp (subst sum.union_disjoint, auto)+
 qed
 
 lemma sum_diff1:
   fixes f :: "'b \<Rightarrow> 'a::ab_group_add"
   assumes "finite A"
   shows "sum f (A - {a}) = (if a \<in> A then sum f A - f a else sum f A)"
   using assms by induct (auto simp: insert_Diff_if)
 
 lemma sum_diff:
   fixes f :: "'b \<Rightarrow> 'a::ab_group_add"
   assumes "finite A" "B \<subseteq> A"
   shows "sum f (A - B) = sum f A - sum f B"
 proof -
   from assms(2,1) have "finite B" by (rule finite_subset)
   from this \<open>B \<subseteq> A\<close>
   show ?thesis
   proof induct
     case empty
     thus ?case by simp
   next
     case (insert x F)
     with \<open>finite A\<close> \<open>finite B\<close> show ?case
       by (simp add: Diff_insert[where a=x and B=F] sum_diff1 insert_absorb)
   qed
 qed
 
 lemma sum_diff1'_aux:
   fixes f :: "'a \<Rightarrow> 'b::ab_group_add"
   assumes "finite F" "{i \<in> I. f i \<noteq> 0} \<subseteq> F"
   shows "sum' f (I - {i}) = (if i \<in> I then sum' f I - f i else sum' f I)"
   using assms
 proof induct
   case (insert x F)
   have 1: "finite {x \<in> I. f x \<noteq> 0} \<Longrightarrow> finite {x \<in> I. x \<noteq> i \<and> f x \<noteq> 0}"
     by (erule rev_finite_subset) auto
   have 2: "finite {x \<in> I. x \<noteq> i \<and> f x \<noteq> 0} \<Longrightarrow> finite {x \<in> I. f x \<noteq> 0}"
     apply (drule finite_insert [THEN iffD2])
     by (erule rev_finite_subset) auto
   have 3: "finite {i \<in> I. f i \<noteq> 0}"
     using finite_subset insert by blast
   show ?case
     using insert sum_diff1 [of "{i \<in> I. f i \<noteq> 0}" f i]
     by (auto simp: sum.G_def 1 2 3 set_diff_eq conj_ac)
 qed (simp add: sum.G_def)
 
 lemma sum_diff1':
   fixes f :: "'a \<Rightarrow> 'b::ab_group_add"
   assumes "finite {i \<in> I. f i \<noteq> 0}"
   shows "sum' f (I - {i}) = (if i \<in> I then sum' f I - f i else sum' f I)"
   by (rule sum_diff1'_aux [OF assms order_refl])
 
 lemma (in ordered_comm_monoid_add) sum_mono:
   "(\<And>i. i\<in>K \<Longrightarrow> f i \<le> g i) \<Longrightarrow> (\<Sum>i\<in>K. f i) \<le> (\<Sum>i\<in>K. g i)"
   by (induct K rule: infinite_finite_induct) (use add_mono in auto)
 
 lemma (in strict_ordered_comm_monoid_add) sum_strict_mono:
   assumes "finite A" "A \<noteq> {}"
     and "\<And>x. x \<in> A \<Longrightarrow> f x < g x"
   shows "sum f A < sum g A"
   using assms
 proof (induct rule: finite_ne_induct)
   case singleton
   then show ?case by simp
 next
   case insert
   then show ?case by (auto simp: add_strict_mono)
 qed
 
 lemma sum_strict_mono_ex1:
   fixes f g :: "'i \<Rightarrow> 'a::ordered_cancel_comm_monoid_add"
   assumes "finite A"
     and "\<forall>x\<in>A. f x \<le> g x"
     and "\<exists>a\<in>A. f a < g a"
   shows "sum f A < sum g A"
 proof-
   from assms(3) obtain a where a: "a \<in> A" "f a < g a" by blast
   have "sum f A = sum f ((A - {a}) \<union> {a})"
     by(simp add: insert_absorb[OF \<open>a \<in> A\<close>])
   also have "\<dots> = sum f (A - {a}) + sum f {a}"
     using \<open>finite A\<close> by(subst sum.union_disjoint) auto
   also have "sum f (A - {a}) \<le> sum g (A - {a})"
     by (rule sum_mono) (simp add: assms(2))
   also from a have "sum f {a} < sum g {a}" by simp
   also have "sum g (A - {a}) + sum g {a} = sum g((A - {a}) \<union> {a})"
     using \<open>finite A\<close> by (subst sum.union_disjoint[symmetric]) auto
   also have "\<dots> = sum g A" by (simp add: insert_absorb[OF \<open>a \<in> A\<close>])
   finally show ?thesis
     by (auto simp add: add_right_mono add_strict_left_mono)
 qed
 
 lemma sum_mono_inv:
   fixes f g :: "'i \<Rightarrow> 'a :: ordered_cancel_comm_monoid_add"
   assumes eq: "sum f I = sum g I"
   assumes le: "\<And>i. i \<in> I \<Longrightarrow> f i \<le> g i"
   assumes i: "i \<in> I"
   assumes I: "finite I"
   shows "f i = g i"
 proof (rule ccontr)
   assume "\<not> ?thesis"
   with le[OF i] have "f i < g i" by simp
   with i have "\<exists>i\<in>I. f i < g i" ..
   from sum_strict_mono_ex1[OF I _ this] le have "sum f I < sum g I"
     by blast
   with eq show False by simp
 qed
 
 lemma member_le_sum:
   fixes f :: "_ \<Rightarrow> 'b::{semiring_1, ordered_comm_monoid_add}"
   assumes "i \<in> A"
     and le: "\<And>x. x \<in> A - {i} \<Longrightarrow> 0 \<le> f x"
     and "finite A"
   shows "f i \<le> sum f A"
 proof -
   have "f i \<le> sum f (A \<inter> {i})"
     by (simp add: assms)
   also have "... = (\<Sum>x\<in>A. if x \<in> {i} then f x else 0)"
     using assms sum.inter_restrict by blast
   also have "... \<le> sum f A"
     apply (rule sum_mono)
     apply (auto simp: le)
     done
   finally show ?thesis .
 qed
 
 lemma sum_negf: "(\<Sum>x\<in>A. - f x) = - (\<Sum>x\<in>A. f x)"
   for f :: "'b \<Rightarrow> 'a::ab_group_add"
   by (induct A rule: infinite_finite_induct) auto
 
 lemma sum_subtractf: "(\<Sum>x\<in>A. f x - g x) = (\<Sum>x\<in>A. f x) - (\<Sum>x\<in>A. g x)"
   for f g :: "'b \<Rightarrow>'a::ab_group_add"
   using sum.distrib [of f "- g" A] by (simp add: sum_negf)
 
 lemma sum_subtractf_nat:
   "(\<And>x. x \<in> A \<Longrightarrow> g x \<le> f x) \<Longrightarrow> (\<Sum>x\<in>A. f x - g x) = (\<Sum>x\<in>A. f x) - (\<Sum>x\<in>A. g x)"
   for f g :: "'a \<Rightarrow> nat"
   by (induct A rule: infinite_finite_induct) (auto simp: sum_mono)
 
 context ordered_comm_monoid_add
 begin
 
 lemma sum_nonneg: "(\<And>x. x \<in> A \<Longrightarrow> 0 \<le> f x) \<Longrightarrow> 0 \<le> sum f A"
 proof (induct A rule: infinite_finite_induct)
   case infinite
   then show ?case by simp
 next
   case empty
   then show ?case by simp
 next
   case (insert x F)
   then have "0 + 0 \<le> f x + sum f F" by (blast intro: add_mono)
   with insert show ?case by simp
 qed
 
 lemma sum_nonpos: "(\<And>x. x \<in> A \<Longrightarrow> f x \<le> 0) \<Longrightarrow> sum f A \<le> 0"
 proof (induct A rule: infinite_finite_induct)
   case infinite
   then show ?case by simp
 next
   case empty
   then show ?case by simp
 next
   case (insert x F)
   then have "f x + sum f F \<le> 0 + 0" by (blast intro: add_mono)
   with insert show ?case by simp
 qed
 
 lemma sum_nonneg_eq_0_iff:
   "finite A \<Longrightarrow> (\<And>x. x \<in> A \<Longrightarrow> 0 \<le> f x) \<Longrightarrow> sum f A = 0 \<longleftrightarrow> (\<forall>x\<in>A. f x = 0)"
   by (induct set: finite) (simp_all add: add_nonneg_eq_0_iff sum_nonneg)
 
 lemma sum_nonneg_0:
   "finite s \<Longrightarrow> (\<And>i. i \<in> s \<Longrightarrow> f i \<ge> 0) \<Longrightarrow> (\<Sum> i \<in> s. f i) = 0 \<Longrightarrow> i \<in> s \<Longrightarrow> f i = 0"
   by (simp add: sum_nonneg_eq_0_iff)
 
 lemma sum_nonneg_leq_bound:
   assumes "finite s" "\<And>i. i \<in> s \<Longrightarrow> f i \<ge> 0" "(\<Sum>i \<in> s. f i) = B" "i \<in> s"
   shows "f i \<le> B"
 proof -
   from assms have "f i \<le> f i + (\<Sum>i \<in> s - {i}. f i)"
     by (intro add_increasing2 sum_nonneg) auto
   also have "\<dots> = B"
     using sum.remove[of s i f] assms by simp
   finally show ?thesis by auto
 qed
 
 lemma sum_mono2:
   assumes fin: "finite B"
     and sub: "A \<subseteq> B"
     and nn: "\<And>b. b \<in> B-A \<Longrightarrow> 0 \<le> f b"
   shows "sum f A \<le> sum f B"
 proof -
   have "sum f A \<le> sum f A + sum f (B-A)"
     by (auto intro: add_increasing2 [OF sum_nonneg] nn)
   also from fin finite_subset[OF sub fin] have "\<dots> = sum f (A \<union> (B-A))"
     by (simp add: sum.union_disjoint del: Un_Diff_cancel)
   also from sub have "A \<union> (B-A) = B" by blast
   finally show ?thesis .
 qed
 
 lemma sum_le_included:
   assumes "finite s" "finite t"
   and "\<forall>y\<in>t. 0 \<le> g y" "(\<forall>x\<in>s. \<exists>y\<in>t. i y = x \<and> f x \<le> g y)"
   shows "sum f s \<le> sum g t"
 proof -
   have "sum f s \<le> sum (\<lambda>y. sum g {x. x\<in>t \<and> i x = y}) s"
   proof (rule sum_mono)
     fix y
     assume "y \<in> s"
     with assms obtain z where z: "z \<in> t" "y = i z" "f y \<le> g z" by auto
     with assms show "f y \<le> sum g {x \<in> t. i x = y}" (is "?A y \<le> ?B y")
       using order_trans[of "?A (i z)" "sum g {z}" "?B (i z)", intro]
       by (auto intro!: sum_mono2)
   qed
   also have "\<dots> \<le> sum (\<lambda>y. sum g {x. x\<in>t \<and> i x = y}) (i ` t)"
     using assms(2-4) by (auto intro!: sum_mono2 sum_nonneg)
   also have "\<dots> \<le> sum g t"
     using assms by (auto simp: sum.image_gen[symmetric])
   finally show ?thesis .
 qed
 
 end
 
 lemma (in canonically_ordered_monoid_add) sum_eq_0_iff [simp]:
   "finite F \<Longrightarrow> (sum f F = 0) = (\<forall>a\<in>F. f a = 0)"
   by (intro ballI sum_nonneg_eq_0_iff zero_le)
 
 context semiring_0
 begin
 
 lemma sum_distrib_left: "r * sum f A = (\<Sum>n\<in>A. r * f n)"
   by (induct A rule: infinite_finite_induct) (simp_all add: algebra_simps)
 
 lemma sum_distrib_right: "sum f A * r = (\<Sum>n\<in>A. f n * r)"
   by (induct A rule: infinite_finite_induct) (simp_all add: algebra_simps)
 
 end
 
 lemma sum_divide_distrib: "sum f A / r = (\<Sum>n\<in>A. f n / r)"
   for r :: "'a::field"
 proof (induct A rule: infinite_finite_induct)
   case infinite
   then show ?case by simp
 next
   case empty
   then show ?case by simp
 next
   case insert
   then show ?case by (simp add: add_divide_distrib)
 qed
 
 lemma sum_abs[iff]: "\<bar>sum f A\<bar> \<le> sum (\<lambda>i. \<bar>f i\<bar>) A"
   for f :: "'a \<Rightarrow> 'b::ordered_ab_group_add_abs"
 proof (induct A rule: infinite_finite_induct)
   case infinite
   then show ?case by simp
 next
   case empty
   then show ?case by simp
 next
   case insert
   then show ?case by (auto intro: abs_triangle_ineq order_trans)
 qed
 
 lemma sum_abs_ge_zero[iff]: "0 \<le> sum (\<lambda>i. \<bar>f i\<bar>) A"
   for f :: "'a \<Rightarrow> 'b::ordered_ab_group_add_abs"
   by (simp add: sum_nonneg)
 
 lemma abs_sum_abs[simp]: "\<bar>\<Sum>a\<in>A. \<bar>f a\<bar>\<bar> = (\<Sum>a\<in>A. \<bar>f a\<bar>)"
   for f :: "'a \<Rightarrow> 'b::ordered_ab_group_add_abs"
 proof (induct A rule: infinite_finite_induct)
   case infinite
   then show ?case by simp
 next
   case empty
   then show ?case by simp
 next
   case (insert a A)
   then have "\<bar>\<Sum>a\<in>insert a A. \<bar>f a\<bar>\<bar> = \<bar>\<bar>f a\<bar> + (\<Sum>a\<in>A. \<bar>f a\<bar>)\<bar>" by simp
   also from insert have "\<dots> = \<bar>\<bar>f a\<bar> + \<bar>\<Sum>a\<in>A. \<bar>f a\<bar>\<bar>\<bar>" by simp
   also have "\<dots> = \<bar>f a\<bar> + \<bar>\<Sum>a\<in>A. \<bar>f a\<bar>\<bar>" by (simp del: abs_of_nonneg)
   also from insert have "\<dots> = (\<Sum>a\<in>insert a A. \<bar>f a\<bar>)" by simp
   finally show ?case .
 qed
 
 lemma sum_product:
   fixes f :: "'a \<Rightarrow> 'b::semiring_0"
   shows "sum f A * sum g B = (\<Sum>i\<in>A. \<Sum>j\<in>B. f i * g j)"
   by (simp add: sum_distrib_left sum_distrib_right) (rule sum.swap)
 
 lemma sum_mult_sum_if_inj:
   fixes f :: "'a \<Rightarrow> 'b::semiring_0"
   shows "inj_on (\<lambda>(a, b). f a * g b) (A \<times> B) \<Longrightarrow>
     sum f A * sum g B = sum id {f a * g b |a b. a \<in> A \<and> b \<in> B}"
   by(auto simp: sum_product sum.cartesian_product intro!: sum.reindex_cong[symmetric])
 
 lemma sum_SucD: "sum f A = Suc n \<Longrightarrow> \<exists>a\<in>A. 0 < f a"
   by (induct A rule: infinite_finite_induct) auto
 
 lemma sum_eq_Suc0_iff:
   "finite A \<Longrightarrow> sum f A = Suc 0 \<longleftrightarrow> (\<exists>a\<in>A. f a = Suc 0 \<and> (\<forall>b\<in>A. a \<noteq> b \<longrightarrow> f b = 0))"
   by (induct A rule: finite_induct) (auto simp add: add_is_1)
 
 lemmas sum_eq_1_iff = sum_eq_Suc0_iff[simplified One_nat_def[symmetric]]
 
 lemma sum_Un_nat:
   "finite A \<Longrightarrow> finite B \<Longrightarrow> sum f (A \<union> B) = sum f A + sum f B - sum f (A \<inter> B)"
   for f :: "'a \<Rightarrow> nat"
   \<comment> \<open>For the natural numbers, we have subtraction.\<close>
   by (subst sum.union_inter [symmetric]) (auto simp: algebra_simps)
 
 lemma sum_diff1_nat: "sum f (A - {a}) = (if a \<in> A then sum f A - f a else sum f A)"
   for f :: "'a \<Rightarrow> nat"
 proof (induct A rule: infinite_finite_induct)
   case infinite
   then show ?case by simp
 next
   case empty
   then show ?case by simp
 next
   case insert
   then show ?case
     apply (auto simp: insert_Diff_if)
     apply (drule mk_disjoint_insert)
     apply auto
     done
 qed
 
 lemma sum_diff_nat:
   fixes f :: "'a \<Rightarrow> nat"
   assumes "finite B" and "B \<subseteq> A"
   shows "sum f (A - B) = sum f A - sum f B"
   using assms
 proof induct
   case empty
   then show ?case by simp
 next
   case (insert x F)
   note IH = \<open>F \<subseteq> A \<Longrightarrow> sum f (A - F) = sum f A - sum f F\<close>
   from \<open>x \<notin> F\<close> \<open>insert x F \<subseteq> A\<close> have "x \<in> A - F" by simp
   then have A: "sum f ((A - F) - {x}) = sum f (A - F) - f x"
     by (simp add: sum_diff1_nat)
   from \<open>insert x F \<subseteq> A\<close> have "F \<subseteq> A" by simp
   with IH have "sum f (A - F) = sum f A - sum f F" by simp
   with A have B: "sum f ((A - F) - {x}) = sum f A - sum f F - f x"
     by simp
   from \<open>x \<notin> F\<close> have "A - insert x F = (A - F) - {x}" by auto
   with B have C: "sum f (A - insert x F) = sum f A - sum f F - f x"
     by simp
   from \<open>finite F\<close> \<open>x \<notin> F\<close> have "sum f (insert x F) = sum f F + f x"
     by simp
   with C have "sum f (A - insert x F) = sum f A - sum f (insert x F)"
     by simp
   then show ?case by simp
 qed
 
 lemma sum_comp_morphism:
   "h 0 = 0 \<Longrightarrow> (\<And>x y. h (x + y) = h x + h y) \<Longrightarrow> sum (h \<circ> g) A = h (sum g A)"
   by (induct A rule: infinite_finite_induct) simp_all
 
 lemma (in comm_semiring_1) dvd_sum: "(\<And>a. a \<in> A \<Longrightarrow> d dvd f a) \<Longrightarrow> d dvd sum f A"
   by (induct A rule: infinite_finite_induct) simp_all
 
 lemma (in ordered_comm_monoid_add) sum_pos:
   "finite I \<Longrightarrow> I \<noteq> {} \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> 0 < f i) \<Longrightarrow> 0 < sum f I"
   by (induct I rule: finite_ne_induct) (auto intro: add_pos_pos)
 
 lemma (in ordered_comm_monoid_add) sum_pos2:
   assumes I: "finite I" "i \<in> I" "0 < f i" "\<And>i. i \<in> I \<Longrightarrow> 0 \<le> f i"
   shows "0 < sum f I"
 proof -
   have "0 < f i + sum f (I - {i})"
     using assms by (intro add_pos_nonneg sum_nonneg) auto
   also have "\<dots> = sum f I"
     using assms by (simp add: sum.remove)
   finally show ?thesis .
 qed
 
 lemma sum_strict_mono2:
   fixes f :: "'a \<Rightarrow> 'b::ordered_cancel_comm_monoid_add"
   assumes "finite B" "A \<subseteq> B" "b \<in> B-A" "f b > 0" and "\<And>x. x \<in> B \<Longrightarrow> f x \<ge> 0"
   shows "sum f A < sum f B"
 proof -
   have "B - A \<noteq> {}"
     using assms(3) by blast
   have "sum f (B-A) > 0"
     by (rule sum_pos2) (use assms in auto)
   moreover have "sum f B = sum f (B-A) + sum f A"
     by (rule sum.subset_diff) (use assms in auto)
   ultimately show ?thesis
     using add_strict_increasing by auto
 qed
 
 lemma sum_cong_Suc:
   assumes "0 \<notin> A" "\<And>x. Suc x \<in> A \<Longrightarrow> f (Suc x) = g (Suc x)"
   shows "sum f A = sum g A"
 proof (rule sum.cong)
   fix x
   assume "x \<in> A"
   with assms(1) show "f x = g x"
     by (cases x) (auto intro!: assms(2))
 qed simp_all
 
 
 subsubsection \<open>Cardinality as special case of \<^const>\<open>sum\<close>\<close>
 
 lemma card_eq_sum: "card A = sum (\<lambda>x. 1) A"
 proof -
   have "plus \<circ> (\<lambda>_. Suc 0) = (\<lambda>_. Suc)"
     by (simp add: fun_eq_iff)
   then have "Finite_Set.fold (plus \<circ> (\<lambda>_. Suc 0)) = Finite_Set.fold (\<lambda>_. Suc)"
     by (rule arg_cong)
   then have "Finite_Set.fold (plus \<circ> (\<lambda>_. Suc 0)) 0 A = Finite_Set.fold (\<lambda>_. Suc) 0 A"
     by (blast intro: fun_cong)
   then show ?thesis
     by (simp add: card.eq_fold sum.eq_fold)
 qed
 
 context semiring_1
 begin
 
 lemma sum_constant [simp]:
   "(\<Sum>x \<in> A. y) = of_nat (card A) * y"
   by (induct A rule: infinite_finite_induct) (simp_all add: algebra_simps)
 
+context
+  fixes A
+  assumes \<open>finite A\<close>
+begin
+
+lemma sum_of_bool_eq [simp]:
+  \<open>(\<Sum>x \<in> A. of_bool (P x)) = of_nat (card (A \<inter> {x. P x}))\<close> if \<open>finite A\<close>
+  using \<open>finite A\<close> by induction simp_all
+
+lemma sum_mult_of_bool_eq [simp]:
+  \<open>(\<Sum>x \<in> A. f x * of_bool (P x)) = (\<Sum>x \<in> (A \<inter> {x. P x}). f x)\<close>
+  by (rule sum.mono_neutral_cong) (use \<open>finite A\<close> in auto)
+
+lemma sum_of_bool_mult_eq [simp]:
+  \<open>(\<Sum>x \<in> A. of_bool (P x) * f x) = (\<Sum>x \<in> (A \<inter> {x. P x}). f x)\<close>
+  by (rule sum.mono_neutral_cong) (use \<open>finite A\<close> in auto)
+
+end
+
 end
 
 lemma sum_Suc: "sum (\<lambda>x. Suc(f x)) A = sum f A + card A"
   using sum.distrib[of f "\<lambda>_. 1" A] by simp
 
 lemma sum_bounded_above:
   fixes K :: "'a::{semiring_1,ordered_comm_monoid_add}"
   assumes le: "\<And>i. i\<in>A \<Longrightarrow> f i \<le> K"
   shows "sum f A \<le> of_nat (card A) * K"
 proof (cases "finite A")
   case True
   then show ?thesis
     using le sum_mono[where K=A and g = "\<lambda>x. K"] by simp
 next
   case False
   then show ?thesis by simp
 qed
 
 lemma sum_bounded_above_divide:
   fixes K :: "'a::linordered_field"
   assumes le: "\<And>i. i\<in>A \<Longrightarrow> f i \<le> K / of_nat (card A)" and fin: "finite A" "A \<noteq> {}"
   shows "sum f A \<le> K"
   using sum_bounded_above [of A f "K / of_nat (card A)", OF le] fin by simp
 
 lemma sum_bounded_above_strict:
   fixes K :: "'a::{ordered_cancel_comm_monoid_add,semiring_1}"
   assumes "\<And>i. i\<in>A \<Longrightarrow> f i < K" "card A > 0"
   shows "sum f A < of_nat (card A) * K"
   using assms sum_strict_mono[where A=A and g = "\<lambda>x. K"]
   by (simp add: card_gt_0_iff)
 
 lemma sum_bounded_below:
   fixes K :: "'a::{semiring_1,ordered_comm_monoid_add}"
   assumes le: "\<And>i. i\<in>A \<Longrightarrow> K \<le> f i"
   shows "of_nat (card A) * K \<le> sum f A"
 proof (cases "finite A")
   case True
   then show ?thesis
     using le sum_mono[where K=A and f = "\<lambda>x. K"] by simp
 next
   case False
   then show ?thesis by simp
 qed
 
 lemma convex_sum_bound_le:
   fixes x :: "'a \<Rightarrow> 'b::linordered_idom"
   assumes 0: "\<And>i. i \<in> I \<Longrightarrow> 0 \<le> x i" and 1: "sum x I = 1"
       and \<delta>: "\<And>i. i \<in> I \<Longrightarrow> \<bar>a i - b\<bar> \<le> \<delta>"
     shows "\<bar>(\<Sum>i\<in>I. a i * x i) - b\<bar> \<le> \<delta>"
 proof -
   have [simp]: "(\<Sum>i\<in>I. c * x i) = c" for c
     by (simp flip: sum_distrib_left 1)
   then have "\<bar>(\<Sum>i\<in>I. a i * x i) - b\<bar> = \<bar>\<Sum>i\<in>I. (a i - b) * x i\<bar>"
     by (simp add: sum_subtractf left_diff_distrib)
   also have "\<dots> \<le> (\<Sum>i\<in>I. \<bar>(a i - b) * x i\<bar>)"
     using abs_abs abs_of_nonneg by blast
   also have "\<dots> \<le> (\<Sum>i\<in>I. \<bar>(a i - b)\<bar> * x i)"
     by (simp add: abs_mult 0)
   also have "\<dots> \<le> (\<Sum>i\<in>I. \<delta> * x i)"
     by (rule sum_mono) (use \<delta> "0" mult_right_mono in blast)
   also have "\<dots> = \<delta>"
     by simp
   finally show ?thesis .
 qed
 
 lemma card_UN_disjoint:
   assumes "finite I" and "\<forall>i\<in>I. finite (A i)"
     and "\<forall>i\<in>I. \<forall>j\<in>I. i \<noteq> j \<longrightarrow> A i \<inter> A j = {}"
   shows "card (\<Union>(A ` I)) = (\<Sum>i\<in>I. card(A i))"
 proof -
   have "(\<Sum>i\<in>I. card (A i)) = (\<Sum>i\<in>I. \<Sum>x\<in>A i. 1)"
     by simp
   with assms show ?thesis
     by (simp add: card_eq_sum sum.UNION_disjoint del: sum_constant)
 qed
 
 lemma card_Union_disjoint:
   assumes "pairwise disjnt C" and fin: "\<And>A. A \<in> C \<Longrightarrow> finite A"
   shows "card (\<Union>C) = sum card C"
 proof (cases "finite C")
   case True
   then show ?thesis
     using card_UN_disjoint [OF True, of "\<lambda>x. x"] assms
     by (simp add: disjnt_def fin pairwise_def)
 next
   case False
   then show ?thesis
     using assms card_eq_0_iff finite_UnionD by fastforce
 qed
 
 lemma card_Union_le_sum_card:
   fixes U :: "'a set set"
   assumes "\<forall>u \<in> U. finite u"
   shows "card (\<Union>U) \<le> sum card U"
 proof (cases "finite U")
   case False
   then show "card (\<Union>U) \<le> sum card U"
     using card_eq_0_iff finite_UnionD by auto
 next
   case True
   then show "card (\<Union>U) \<le> sum card U"
   proof (induct U rule: finite_induct)
     case empty
     then show ?case by auto
   next
     case (insert x F)
     then have "card(\<Union>(insert x F)) \<le> card(x) + card (\<Union>F)" using card_Un_le by auto
     also have "... \<le> card(x) + sum card F" using insert.hyps by auto
     also have "... = sum card (insert x F)" using sum.insert_if and insert.hyps by auto
     finally show ?case .
   qed
 qed
 
 lemma card_UN_le:
   assumes "finite I"
   shows "card(\<Union>i\<in>I. A i) \<le> (\<Sum>i\<in>I. card(A i))"
   using assms
 proof induction
   case (insert i I)
   then show ?case
     using card_Un_le nat_add_left_cancel_le by (force intro: order_trans) 
 qed auto
 
 lemma sum_multicount_gen:
   assumes "finite s" "finite t" "\<forall>j\<in>t. (card {i\<in>s. R i j} = k j)"
   shows "sum (\<lambda>i. (card {j\<in>t. R i j})) s = sum k t"
     (is "?l = ?r")
 proof-
   have "?l = sum (\<lambda>i. sum (\<lambda>x.1) {j\<in>t. R i j}) s"
     by auto
   also have "\<dots> = ?r"
     unfolding sum.swap_restrict [OF assms(1-2)]
     using assms(3) by auto
   finally show ?thesis .
 qed
 
 lemma sum_multicount:
   assumes "finite S" "finite T" "\<forall>j\<in>T. (card {i\<in>S. R i j} = k)"
   shows "sum (\<lambda>i. card {j\<in>T. R i j}) S = k * card T" (is "?l = ?r")
 proof-
   have "?l = sum (\<lambda>i. k) T"
     by (rule sum_multicount_gen) (auto simp: assms)
   also have "\<dots> = ?r" by (simp add: mult.commute)
   finally show ?thesis by auto
 qed
 
 lemma sum_card_image:
   assumes "finite A"
   assumes "pairwise (\<lambda>s t. disjnt (f s) (f t)) A"
   shows "sum card (f ` A) = sum (\<lambda>a. card (f a)) A"
 using assms
 proof (induct A)
   case (insert a A)
   show ?case
   proof cases
     assume "f a = {}"
     with insert show ?case
       by (subst sum.mono_neutral_right[where S="f ` A"]) (auto simp: pairwise_insert)
   next
     assume "f a \<noteq> {}"
     then have "sum card (insert (f a) (f ` A)) = card (f a) + sum card (f ` A)"
       using insert
       by (subst sum.insert) (auto simp: pairwise_insert)
     with insert show ?case by (simp add: pairwise_insert)
   qed
 qed simp
 
 
 subsubsection \<open>Cardinality of products\<close>
 
 lemma card_SigmaI [simp]:
   "finite A \<Longrightarrow> \<forall>a\<in>A. finite (B a) \<Longrightarrow> card (SIGMA x: A. B x) = (\<Sum>a\<in>A. card (B a))"
   by (simp add: card_eq_sum sum.Sigma del: sum_constant)
 
 (*
 lemma SigmaI_insert: "y \<notin> A ==>
   (SIGMA x:(insert y A). B x) = (({y} \<times> (B y)) \<union> (SIGMA x: A. B x))"
   by auto
 *)
 
 lemma card_cartesian_product: "card (A \<times> B) = card A * card B"
   by (cases "finite A \<and> finite B")
     (auto simp add: card_eq_0_iff dest: finite_cartesian_productD1 finite_cartesian_productD2)
 
 lemma card_cartesian_product_singleton:  "card ({x} \<times> A) = card A"
   by (simp add: card_cartesian_product)
 
 
 subsection \<open>Generalized product over a set\<close>
 
 context comm_monoid_mult
 begin
 
 sublocale prod: comm_monoid_set times 1
   defines prod = prod.F and prod' = prod.G ..
 
 abbreviation Prod ("\<Prod>_" [1000] 999)
   where "\<Prod>A \<equiv> prod (\<lambda>x. x) A"
 
 end
 
 syntax (ASCII)
   "_prod" :: "pttrn => 'a set => 'b => 'b::comm_monoid_mult"  ("(4PROD (_/:_)./ _)" [0, 51, 10] 10)
 syntax
   "_prod" :: "pttrn => 'a set => 'b => 'b::comm_monoid_mult"  ("(2\<Prod>(_/\<in>_)./ _)" [0, 51, 10] 10)
 translations \<comment> \<open>Beware of argument permutation!\<close>
   "\<Prod>i\<in>A. b" == "CONST prod (\<lambda>i. b) A"
 
 text \<open>Instead of \<^term>\<open>\<Prod>x\<in>{x. P}. e\<close> we introduce the shorter \<open>\<Prod>x|P. e\<close>.\<close>
 
 syntax (ASCII)
   "_qprod" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a"  ("(4PROD _ |/ _./ _)" [0, 0, 10] 10)
 syntax
   "_qprod" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a"  ("(2\<Prod>_ | (_)./ _)" [0, 0, 10] 10)
 translations
   "\<Prod>x|P. t" => "CONST prod (\<lambda>x. t) {x. P}"
 
 context comm_monoid_mult
 begin
 
 lemma prod_dvd_prod: "(\<And>a. a \<in> A \<Longrightarrow> f a dvd g a) \<Longrightarrow> prod f A dvd prod g A"
 proof (induct A rule: infinite_finite_induct)
   case infinite
   then show ?case by (auto intro: dvdI)
 next
   case empty
   then show ?case by (auto intro: dvdI)
 next
   case (insert a A)
   then have "f a dvd g a" and "prod f A dvd prod g A"
     by simp_all
   then obtain r s where "g a = f a * r" and "prod g A = prod f A * s"
     by (auto elim!: dvdE)
   then have "g a * prod g A = f a * prod f A * (r * s)"
     by (simp add: ac_simps)
   with insert.hyps show ?case
     by (auto intro: dvdI)
 qed
 
 lemma prod_dvd_prod_subset: "finite B \<Longrightarrow> A \<subseteq> B \<Longrightarrow> prod f A dvd prod f B"
   by (auto simp add: prod.subset_diff ac_simps intro: dvdI)
 
 end
 
 
 subsubsection \<open>Properties in more restricted classes of structures\<close>
 
 context linordered_nonzero_semiring
 begin
 
 lemma prod_ge_1: "(\<And>x. x \<in> A \<Longrightarrow> 1 \<le> f x) \<Longrightarrow> 1 \<le> prod f A"
 proof (induct A rule: infinite_finite_induct)
   case infinite
   then show ?case by simp
 next
   case empty
   then show ?case by simp
 next
   case (insert x F)
   have "1 * 1 \<le> f x * prod f F"
     by (rule mult_mono') (use insert in auto)
   with insert show ?case by simp
 qed
 
 lemma prod_le_1:
   fixes f :: "'b \<Rightarrow> 'a"
   assumes "\<And>x. x \<in> A \<Longrightarrow> 0 \<le> f x \<and> f x \<le> 1"
   shows "prod f A \<le> 1"
     using assms
 proof (induct A rule: infinite_finite_induct)
   case infinite
   then show ?case by simp
 next
   case empty
   then show ?case by simp
 next
   case (insert x F)
   then show ?case by (force simp: mult.commute intro: dest: mult_le_one)
 qed
 
 end
 
 context comm_semiring_1
 begin
 
 lemma dvd_prod_eqI [intro]:
   assumes "finite A" and "a \<in> A" and "b = f a"
   shows "b dvd prod f A"
 proof -
   from \<open>finite A\<close> have "prod f (insert a (A - {a})) = f a * prod f (A - {a})"
     by (intro prod.insert) auto
   also from \<open>a \<in> A\<close> have "insert a (A - {a}) = A"
     by blast
   finally have "prod f A = f a * prod f (A - {a})" .
   with \<open>b = f a\<close> show ?thesis
     by simp
 qed
 
 lemma dvd_prodI [intro]: "finite A \<Longrightarrow> a \<in> A \<Longrightarrow> f a dvd prod f A"
   by auto
 
 lemma prod_zero:
   assumes "finite A" and "\<exists>a\<in>A. f a = 0"
   shows "prod f A = 0"
   using assms
 proof (induct A)
   case empty
   then show ?case by simp
 next
   case (insert a A)
   then have "f a = 0 \<or> (\<exists>a\<in>A. f a = 0)" by simp
   then have "f a * prod f A = 0" by rule (simp_all add: insert)
   with insert show ?case by simp
 qed
 
 lemma prod_dvd_prod_subset2:
   assumes "finite B" and "A \<subseteq> B" and "\<And>a. a \<in> A \<Longrightarrow> f a dvd g a"
   shows "prod f A dvd prod g B"
 proof -
   from assms have "prod f A dvd prod g A"
     by (auto intro: prod_dvd_prod)
   moreover from assms have "prod g A dvd prod g B"
     by (auto intro: prod_dvd_prod_subset)
   ultimately show ?thesis by (rule dvd_trans)
 qed
 
 end
 
 lemma (in semidom) prod_zero_iff [simp]:
   fixes f :: "'b \<Rightarrow> 'a"
   assumes "finite A"
   shows "prod f A = 0 \<longleftrightarrow> (\<exists>a\<in>A. f a = 0)"
   using assms by (induct A) (auto simp: no_zero_divisors)
 
 lemma (in semidom_divide) prod_diff1:
   assumes "finite A" and "f a \<noteq> 0"
   shows "prod f (A - {a}) = (if a \<in> A then prod f A div f a else prod f A)"
 proof (cases "a \<notin> A")
   case True
   then show ?thesis by simp
 next
   case False
   with assms show ?thesis
   proof induct
     case empty
     then show ?case by simp
   next
     case (insert b B)
     then show ?case
     proof (cases "a = b")
       case True
       with insert show ?thesis by simp
     next
       case False
       with insert have "a \<in> B" by simp
       define C where "C = B - {a}"
       with \<open>finite B\<close> \<open>a \<in> B\<close> have "B = insert a C" "finite C" "a \<notin> C"
         by auto
       with insert show ?thesis
         by (auto simp add: insert_commute ac_simps)
     qed
   qed
 qed
 
 lemma sum_zero_power [simp]: "(\<Sum>i\<in>A. c i * 0^i) = (if finite A \<and> 0 \<in> A then c 0 else 0)"
   for c :: "nat \<Rightarrow> 'a::division_ring"
   by (induct A rule: infinite_finite_induct) auto
 
 lemma sum_zero_power' [simp]:
   "(\<Sum>i\<in>A. c i * 0^i / d i) = (if finite A \<and> 0 \<in> A then c 0 / d 0 else 0)"
   for c :: "nat \<Rightarrow> 'a::field"
   using sum_zero_power [of "\<lambda>i. c i / d i" A] by auto
 
 lemma (in field) prod_inversef: "prod (inverse \<circ> f) A = inverse (prod f A)"
  proof (cases "finite A")
    case True
    then show ?thesis
      by (induct A rule: finite_induct) simp_all
  next
    case False
    then show ?thesis
      by auto
  qed
 
 lemma (in field) prod_dividef: "(\<Prod>x\<in>A. f x / g x) = prod f A / prod g A"
   using prod_inversef [of g A] by (simp add: divide_inverse prod.distrib)
 
 lemma prod_Un:
   fixes f :: "'b \<Rightarrow> 'a :: field"
   assumes "finite A" and "finite B"
     and "\<forall>x\<in>A \<inter> B. f x \<noteq> 0"
   shows "prod f (A \<union> B) = prod f A * prod f B / prod f (A \<inter> B)"
 proof -
   from assms have "prod f A * prod f B = prod f (A \<union> B) * prod f (A \<inter> B)"
     by (simp add: prod.union_inter [symmetric, of A B])
   with assms show ?thesis
     by simp
 qed
 
 context linordered_semidom
 begin
 
 lemma prod_nonneg: "(\<forall>a\<in>A. 0 \<le> f a) \<Longrightarrow> 0 \<le> prod f A"
   by (induct A rule: infinite_finite_induct) simp_all
 
 lemma prod_pos: "(\<forall>a\<in>A. 0 < f a) \<Longrightarrow> 0 < prod f A"
   by (induct A rule: infinite_finite_induct) simp_all
 
 lemma prod_mono:
   "(\<And>i. i \<in> A \<Longrightarrow> 0 \<le> f i \<and> f i \<le> g i) \<Longrightarrow> prod f A \<le> prod g A"
   by (induct A rule: infinite_finite_induct) (force intro!: prod_nonneg mult_mono)+
 
 lemma prod_mono_strict:
   assumes "finite A" "\<And>i. i \<in> A \<Longrightarrow> 0 \<le> f i \<and> f i < g i" "A \<noteq> {}"
   shows "prod f A < prod g A"
   using assms
 proof (induct A rule: finite_induct)
   case empty
   then show ?case by simp
 next
   case insert
   then show ?case by (force intro: mult_strict_mono' prod_nonneg)
 qed
 
 end
 
 lemma prod_mono2:
   fixes f :: "'a \<Rightarrow> 'b :: linordered_idom"
   assumes fin: "finite B"
     and sub: "A \<subseteq> B"
     and nn: "\<And>b. b \<in> B-A \<Longrightarrow> 1 \<le> f b"
     and A: "\<And>a. a \<in> A \<Longrightarrow> 0 \<le> f a"
   shows "prod f A \<le> prod f B"
 proof -
   have "prod f A \<le> prod f A * prod f (B-A)"
     by (metis prod_ge_1 A mult_le_cancel_left1 nn not_less prod_nonneg)
   also from fin finite_subset[OF sub fin] have "\<dots> = prod f (A \<union> (B-A))"
     by (simp add: prod.union_disjoint del: Un_Diff_cancel)
   also from sub have "A \<union> (B-A) = B" by blast
   finally show ?thesis .
 qed
 
 lemma less_1_prod:
   fixes f :: "'a \<Rightarrow> 'b::linordered_idom"
   shows "finite I \<Longrightarrow> I \<noteq> {} \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> 1 < f i) \<Longrightarrow> 1 < prod f I"
   by (induct I rule: finite_ne_induct) (auto intro: less_1_mult)
 
 lemma less_1_prod2:
   fixes f :: "'a \<Rightarrow> 'b::linordered_idom"
   assumes I: "finite I" "i \<in> I" "1 < f i" "\<And>i. i \<in> I \<Longrightarrow> 1 \<le> f i"
   shows "1 < prod f I"
 proof -
   have "1 < f i * prod f (I - {i})"
     using assms
     by (meson DiffD1 leI less_1_mult less_le_trans mult_le_cancel_left1 prod_ge_1)
   also have "\<dots> = prod f I"
     using assms by (simp add: prod.remove)
   finally show ?thesis .
 qed
 
 lemma (in linordered_field) abs_prod: "\<bar>prod f A\<bar> = (\<Prod>x\<in>A. \<bar>f x\<bar>)"
   by (induct A rule: infinite_finite_induct) (simp_all add: abs_mult)
 
 lemma prod_eq_1_iff [simp]: "finite A \<Longrightarrow> prod f A = 1 \<longleftrightarrow> (\<forall>a\<in>A. f a = 1)"
   for f :: "'a \<Rightarrow> nat"
   by (induct A rule: finite_induct) simp_all
 
 lemma prod_pos_nat_iff [simp]: "finite A \<Longrightarrow> prod f A > 0 \<longleftrightarrow> (\<forall>a\<in>A. f a > 0)"
   for f :: "'a \<Rightarrow> nat"
   using prod_zero_iff by (simp del: neq0_conv add: zero_less_iff_neq_zero)
 
 lemma prod_constant [simp]: "(\<Prod>x\<in> A. y) = y ^ card A"
   for y :: "'a::comm_monoid_mult"
   by (induct A rule: infinite_finite_induct) simp_all
 
 lemma prod_power_distrib: "prod f A ^ n = prod (\<lambda>x. (f x) ^ n) A"
   for f :: "'a \<Rightarrow> 'b::comm_semiring_1"
   by (induct A rule: infinite_finite_induct) (auto simp add: power_mult_distrib)
 
 lemma power_sum: "c ^ (\<Sum>a\<in>A. f a) = (\<Prod>a\<in>A. c ^ f a)"
   by (induct A rule: infinite_finite_induct) (simp_all add: power_add)
 
 lemma prod_gen_delta:
   fixes b :: "'b \<Rightarrow> 'a::comm_monoid_mult"
   assumes fin: "finite S"
   shows "prod (\<lambda>k. if k = a then b k else c) S =
     (if a \<in> S then b a * c ^ (card S - 1) else c ^ card S)"
 proof -
   let ?f = "(\<lambda>k. if k=a then b k else c)"
   show ?thesis
   proof (cases "a \<in> S")
     case False
     then have "\<forall> k\<in> S. ?f k = c" by simp
     with False show ?thesis by (simp add: prod_constant)
   next
     case True
     let ?A = "S - {a}"
     let ?B = "{a}"
     from True have eq: "S = ?A \<union> ?B" by blast
     have disjoint: "?A \<inter> ?B = {}" by simp
     from fin have fin': "finite ?A" "finite ?B" by auto
     have f_A0: "prod ?f ?A = prod (\<lambda>i. c) ?A"
       by (rule prod.cong) auto
     from fin True have card_A: "card ?A = card S - 1" by auto
     have f_A1: "prod ?f ?A = c ^ card ?A"
       unfolding f_A0 by (rule prod_constant)
     have "prod ?f ?A * prod ?f ?B = prod ?f S"
       using prod.union_disjoint[OF fin' disjoint, of ?f, unfolded eq[symmetric]]
       by simp
     with True card_A show ?thesis
       by (simp add: f_A1 field_simps cong add: prod.cong cong del: if_weak_cong)
   qed
 qed
 
 lemma sum_image_le:
   fixes g :: "'a \<Rightarrow> 'b::ordered_comm_monoid_add"
   assumes "finite I" "\<And>i. i \<in> I \<Longrightarrow> 0 \<le> g(f i)"
     shows "sum g (f ` I) \<le> sum (g \<circ> f) I"
   using assms
 proof induction
   case empty
   then show ?case by auto
 next
   case (insert x F)
   from insertI1 have "0 \<le> g (f x)" by (rule insert)
   hence 1: "sum g (f ` F) \<le> g (f x) + sum g (f ` F)" using add_increasing by blast
   have 2: "sum g (f ` F) \<le> sum (g \<circ> f) F" using insert by blast
   have "sum g (f ` insert x F) = sum g (insert (f x) (f ` F))" by simp
   also have "\<dots> \<le> g (f x) + sum g (f ` F)" by (simp add: 1 insert sum.insert_if)
   also from 2 have "\<dots> \<le> g (f x) + sum (g \<circ> f) F" by (rule add_left_mono)
   also from insert(1, 2) have "\<dots> = sum (g \<circ> f) (insert x F)" by (simp add: sum.insert_if)
   finally show ?case .
 qed
 
 end
diff --git a/src/HOL/Groups_List.thy b/src/HOL/Groups_List.thy
--- a/src/HOL/Groups_List.thy
+++ b/src/HOL/Groups_List.thy
@@ -1,582 +1,583 @@
 (* Author: Tobias Nipkow, TU Muenchen *)
 
 section \<open>Sum and product over lists\<close>
 
 theory Groups_List
 imports List
 begin
 
 locale monoid_list = monoid
 begin
 
 definition F :: "'a list \<Rightarrow> 'a"
 where
   eq_foldr [code]: "F xs = foldr f xs \<^bold>1"
 
 lemma Nil [simp]:
   "F [] = \<^bold>1"
   by (simp add: eq_foldr)
 
 lemma Cons [simp]:
   "F (x # xs) = x \<^bold>* F xs"
   by (simp add: eq_foldr)
 
 lemma append [simp]:
   "F (xs @ ys) = F xs \<^bold>* F ys"
   by (induct xs) (simp_all add: assoc)
 
 end
 
 locale comm_monoid_list = comm_monoid + monoid_list
 begin
 
 lemma rev [simp]:
   "F (rev xs) = F xs"
   by (simp add: eq_foldr foldr_fold  fold_rev fun_eq_iff assoc left_commute)
 
 end
 
 locale comm_monoid_list_set = list: comm_monoid_list + set: comm_monoid_set
 begin
 
 lemma distinct_set_conv_list:
   "distinct xs \<Longrightarrow> set.F g (set xs) = list.F (map g xs)"
   by (induct xs) simp_all
 
 lemma set_conv_list [code]:
   "set.F g (set xs) = list.F (map g (remdups xs))"
   by (simp add: distinct_set_conv_list [symmetric])
 
 end
 
 
 subsection \<open>List summation\<close>
 
 context monoid_add
 begin
 
 sublocale sum_list: monoid_list plus 0
 defines
   sum_list = sum_list.F ..
 
 end
 
 context comm_monoid_add
 begin
 
 sublocale sum_list: comm_monoid_list plus 0
 rewrites
   "monoid_list.F plus 0 = sum_list"
 proof -
   show "comm_monoid_list plus 0" ..
   then interpret sum_list: comm_monoid_list plus 0 .
   from sum_list_def show "monoid_list.F plus 0 = sum_list" by simp
 qed
 
 sublocale sum: comm_monoid_list_set plus 0
 rewrites
   "monoid_list.F plus 0 = sum_list"
   and "comm_monoid_set.F plus 0 = sum"
 proof -
   show "comm_monoid_list_set plus 0" ..
   then interpret sum: comm_monoid_list_set plus 0 .
   from sum_list_def show "monoid_list.F plus 0 = sum_list" by simp
   from sum_def show "comm_monoid_set.F plus 0 = sum" by (auto intro: sym)
 qed
 
 end
 
 text \<open>Some syntactic sugar for summing a function over a list:\<close>
 syntax (ASCII)
   "_sum_list" :: "pttrn => 'a list => 'b => 'b"    ("(3SUM _<-_. _)" [0, 51, 10] 10)
 syntax
   "_sum_list" :: "pttrn => 'a list => 'b => 'b"    ("(3\<Sum>_\<leftarrow>_. _)" [0, 51, 10] 10)
 translations \<comment> \<open>Beware of argument permutation!\<close>
   "\<Sum>x\<leftarrow>xs. b" == "CONST sum_list (CONST map (\<lambda>x. b) xs)"
 
 context
   includes lifting_syntax
 begin
 
 lemma sum_list_transfer [transfer_rule]:
   "(list_all2 A ===> A) sum_list sum_list"
     if [transfer_rule]: "A 0 0" "(A ===> A ===> A) (+) (+)"
   unfolding sum_list.eq_foldr [abs_def]
   by transfer_prover
 
 end
 
 text \<open>TODO duplicates\<close>
 lemmas sum_list_simps = sum_list.Nil sum_list.Cons
 lemmas sum_list_append = sum_list.append
 lemmas sum_list_rev = sum_list.rev
 
 lemma (in monoid_add) fold_plus_sum_list_rev:
   "fold plus xs = plus (sum_list (rev xs))"
 proof
   fix x
   have "fold plus xs x = sum_list (rev xs @ [x])"
     by (simp add: foldr_conv_fold sum_list.eq_foldr)
   also have "\<dots> = sum_list (rev xs) + x"
     by simp
   finally show "fold plus xs x = sum_list (rev xs) + x"
     .
 qed
 
 lemma (in comm_monoid_add) sum_list_map_remove1:
   "x \<in> set xs \<Longrightarrow> sum_list (map f xs) = f x + sum_list (map f (remove1 x xs))"
   by (induct xs) (auto simp add: ac_simps)
 
 lemma (in monoid_add) size_list_conv_sum_list:
   "size_list f xs = sum_list (map f xs) + size xs"
   by (induct xs) auto
 
 lemma (in monoid_add) length_concat:
   "length (concat xss) = sum_list (map length xss)"
   by (induct xss) simp_all
 
 lemma (in monoid_add) length_product_lists:
   "length (product_lists xss) = foldr (*) (map length xss) 1"
 proof (induct xss)
   case (Cons xs xss) then show ?case by (induct xs) (auto simp: length_concat o_def)
 qed simp
 
 lemma (in monoid_add) sum_list_map_filter:
   assumes "\<And>x. x \<in> set xs \<Longrightarrow> \<not> P x \<Longrightarrow> f x = 0"
   shows "sum_list (map f (filter P xs)) = sum_list (map f xs)"
   using assms by (induct xs) auto
 
 lemma sum_list_filter_le_nat:
   fixes f :: "'a \<Rightarrow> nat"
   shows "sum_list (map f (filter P xs)) \<le> sum_list (map f xs)"
 by(induction xs; simp)
 
 lemma (in comm_monoid_add) distinct_sum_list_conv_Sum:
   "distinct xs \<Longrightarrow> sum_list xs = Sum (set xs)"
   by (induct xs) simp_all
 
 lemma sum_list_upt[simp]:
   "m \<le> n \<Longrightarrow> sum_list [m..<n] = \<Sum> {m..<n}"
 by(simp add: distinct_sum_list_conv_Sum)
 
 context ordered_comm_monoid_add
 begin
 
 lemma sum_list_nonneg: "(\<And>x. x \<in> set xs \<Longrightarrow> 0 \<le> x) \<Longrightarrow> 0 \<le> sum_list xs"
 by (induction xs) auto
 
 lemma sum_list_nonpos: "(\<And>x. x \<in> set xs \<Longrightarrow> x \<le> 0) \<Longrightarrow> sum_list xs \<le> 0"
 by (induction xs) (auto simp: add_nonpos_nonpos)
 
 lemma sum_list_nonneg_eq_0_iff:
   "(\<And>x. x \<in> set xs \<Longrightarrow> 0 \<le> x) \<Longrightarrow> sum_list xs = 0 \<longleftrightarrow> (\<forall>x\<in> set xs. x = 0)"
 by (induction xs) (simp_all add: add_nonneg_eq_0_iff sum_list_nonneg)
 
 end
 
 context canonically_ordered_monoid_add
 begin
 
 lemma sum_list_eq_0_iff [simp]:
   "sum_list ns = 0 \<longleftrightarrow> (\<forall>n \<in> set ns. n = 0)"
 by (simp add: sum_list_nonneg_eq_0_iff)
 
 lemma member_le_sum_list:
   "x \<in> set xs \<Longrightarrow> x \<le> sum_list xs"
 by (induction xs) (auto simp: add_increasing add_increasing2)
 
 lemma elem_le_sum_list:
   "k < size ns \<Longrightarrow> ns ! k \<le> sum_list (ns)"
 by (rule member_le_sum_list) simp
 
 end
 
 lemma (in ordered_cancel_comm_monoid_diff) sum_list_update:
   "k < size xs \<Longrightarrow> sum_list (xs[k := x]) = sum_list xs + x - xs ! k"
 apply(induction xs arbitrary:k)
  apply (auto simp: add_ac split: nat.split)
 apply(drule elem_le_sum_list)
 by (simp add: local.add_diff_assoc local.add_increasing)
 
 lemma (in monoid_add) sum_list_triv:
   "(\<Sum>x\<leftarrow>xs. r) = of_nat (length xs) * r"
   by (induct xs) (simp_all add: distrib_right)
 
 lemma (in monoid_add) sum_list_0 [simp]:
   "(\<Sum>x\<leftarrow>xs. 0) = 0"
   by (induct xs) (simp_all add: distrib_right)
 
 text\<open>For non-Abelian groups \<open>xs\<close> needs to be reversed on one side:\<close>
 lemma (in ab_group_add) uminus_sum_list_map:
   "- sum_list (map f xs) = sum_list (map (uminus \<circ> f) xs)"
   by (induct xs) simp_all
 
 lemma (in comm_monoid_add) sum_list_addf:
   "(\<Sum>x\<leftarrow>xs. f x + g x) = sum_list (map f xs) + sum_list (map g xs)"
   by (induct xs) (simp_all add: algebra_simps)
 
 lemma (in ab_group_add) sum_list_subtractf:
   "(\<Sum>x\<leftarrow>xs. f x - g x) = sum_list (map f xs) - sum_list (map g xs)"
   by (induct xs) (simp_all add: algebra_simps)
 
 lemma (in semiring_0) sum_list_const_mult:
   "(\<Sum>x\<leftarrow>xs. c * f x) = c * (\<Sum>x\<leftarrow>xs. f x)"
   by (induct xs) (simp_all add: algebra_simps)
 
 lemma (in semiring_0) sum_list_mult_const:
   "(\<Sum>x\<leftarrow>xs. f x * c) = (\<Sum>x\<leftarrow>xs. f x) * c"
   by (induct xs) (simp_all add: algebra_simps)
 
 lemma (in ordered_ab_group_add_abs) sum_list_abs:
   "\<bar>sum_list xs\<bar> \<le> sum_list (map abs xs)"
   by (induct xs) (simp_all add: order_trans [OF abs_triangle_ineq])
 
 lemma sum_list_mono:
   fixes f g :: "'a \<Rightarrow> 'b::{monoid_add, ordered_ab_semigroup_add}"
   shows "(\<And>x. x \<in> set xs \<Longrightarrow> f x \<le> g x) \<Longrightarrow> (\<Sum>x\<leftarrow>xs. f x) \<le> (\<Sum>x\<leftarrow>xs. g x)"
 by (induct xs) (simp, simp add: add_mono)
 
 lemma sum_list_strict_mono:
   fixes f g :: "'a \<Rightarrow> 'b::{monoid_add, strict_ordered_ab_semigroup_add}"
   shows "\<lbrakk> xs \<noteq> [];  \<And>x. x \<in> set xs \<Longrightarrow> f x < g x \<rbrakk>
     \<Longrightarrow> sum_list (map f xs) < sum_list (map g xs)"
 proof (induction xs)
   case Nil thus ?case by simp
 next
   case C: (Cons _ xs)
   show ?case
   proof (cases xs)
     case Nil thus ?thesis using C.prems by simp
   next
     case Cons thus ?thesis using C by(simp add: add_strict_mono)
   qed
 qed
 
 lemma (in monoid_add) sum_list_distinct_conv_sum_set:
   "distinct xs \<Longrightarrow> sum_list (map f xs) = sum f (set xs)"
   by (induct xs) simp_all
 
 lemma (in monoid_add) interv_sum_list_conv_sum_set_nat:
   "sum_list (map f [m..<n]) = sum f (set [m..<n])"
   by (simp add: sum_list_distinct_conv_sum_set)
 
 lemma (in monoid_add) interv_sum_list_conv_sum_set_int:
   "sum_list (map f [k..l]) = sum f (set [k..l])"
   by (simp add: sum_list_distinct_conv_sum_set)
 
 text \<open>General equivalence between \<^const>\<open>sum_list\<close> and \<^const>\<open>sum\<close>\<close>
 lemma (in monoid_add) sum_list_sum_nth:
   "sum_list xs = (\<Sum> i = 0 ..< length xs. xs ! i)"
   using interv_sum_list_conv_sum_set_nat [of "(!) xs" 0 "length xs"] by (simp add: map_nth)
 
 lemma sum_list_map_eq_sum_count:
   "sum_list (map f xs) = sum (\<lambda>x. count_list xs x * f x) (set xs)"
 proof(induction xs)
   case (Cons x xs)
   show ?case (is "?l = ?r")
   proof cases
     assume "x \<in> set xs"
     have "?l = f x + (\<Sum>x\<in>set xs. count_list xs x * f x)" by (simp add: Cons.IH)
     also have "set xs = insert x (set xs - {x})" using \<open>x \<in> set xs\<close>by blast
     also have "f x + (\<Sum>x\<in>insert x (set xs - {x}). count_list xs x * f x) = ?r"
       by (simp add: sum.insert_remove eq_commute)
     finally show ?thesis .
   next
     assume "x \<notin> set xs"
     hence "\<And>xa. xa \<in> set xs \<Longrightarrow> x \<noteq> xa" by blast
     thus ?thesis by (simp add: Cons.IH \<open>x \<notin> set xs\<close>)
   qed
 qed simp
 
 lemma sum_list_map_eq_sum_count2:
 assumes "set xs \<subseteq> X" "finite X"
 shows "sum_list (map f xs) = sum (\<lambda>x. count_list xs x * f x) X"
 proof-
   let ?F = "\<lambda>x. count_list xs x * f x"
   have "sum ?F X = sum ?F (set xs \<union> (X - set xs))"
     using Un_absorb1[OF assms(1)] by(simp)
   also have "\<dots> = sum ?F (set xs)"
     using assms(2)
     by(simp add: sum.union_disjoint[OF _ _ Diff_disjoint] del: Un_Diff_cancel)
   finally show ?thesis by(simp add:sum_list_map_eq_sum_count)
 qed
 
 lemma sum_list_replicate: "sum_list (replicate n c) = of_nat n * c"
 by(induction n)(auto simp add: distrib_right)
 
 
 lemma sum_list_nonneg:
     "(\<And>x. x \<in> set xs \<Longrightarrow> (x :: 'a :: ordered_comm_monoid_add) \<ge> 0) \<Longrightarrow> sum_list xs \<ge> 0"
   by (induction xs) simp_all
 
 lemma sum_list_Suc:
   "sum_list (map (\<lambda>x. Suc(f x)) xs) = sum_list (map f xs) + length xs"
 by(induction xs; simp)
 
 lemma (in monoid_add) sum_list_map_filter':
   "sum_list (map f (filter P xs)) = sum_list (map (\<lambda>x. if P x then f x else 0) xs)"
   by (induction xs) simp_all
 
 text \<open>Summation of a strictly ascending sequence with length \<open>n\<close>
   can be upper-bounded by summation over \<open>{0..<n}\<close>.\<close>
 
 lemma sorted_wrt_less_sum_mono_lowerbound:
   fixes f :: "nat \<Rightarrow> ('b::ordered_comm_monoid_add)"
   assumes mono: "\<And>x y. x\<le>y \<Longrightarrow> f x \<le> f y"
   shows "sorted_wrt (<) ns \<Longrightarrow>
     (\<Sum>i\<in>{0..<length ns}. f i) \<le> (\<Sum>i\<leftarrow>ns. f i)"
 proof (induction ns rule: rev_induct)
   case Nil
   then show ?case by simp
 next
   case (snoc n ns)
   have "sum f {0..<length (ns @ [n])}
       = sum f {0..<length ns} + f (length ns)"
     by simp
   also have "sum f {0..<length ns} \<le> sum_list (map f ns)"
     using snoc by (auto simp: sorted_wrt_append)
   also have "length ns \<le> n"
     using sorted_wrt_less_idx[OF snoc.prems(1), of "length ns"] by auto
   finally have "sum f {0..<length (ns @ [n])} \<le> sum_list (map f ns) + f n"
     using mono add_mono by blast
   thus ?case by simp
 qed
 
 
 subsection \<open>Horner sums\<close>
 
 context comm_semiring_0
 begin
 
 definition horner_sum :: \<open>('b \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'b list \<Rightarrow> 'a\<close>
   where horner_sum_foldr: \<open>horner_sum f a xs = foldr (\<lambda>x b. f x + a * b) xs 0\<close>
 
 lemma horner_sum_simps [simp]:
   \<open>horner_sum f a [] = 0\<close>
   \<open>horner_sum f a (x # xs) = f x + a * horner_sum f a xs\<close>
   by (simp_all add: horner_sum_foldr)
 
 lemma horner_sum_eq_sum_funpow:
   \<open>horner_sum f a xs = (\<Sum>n = 0..<length xs. ((*) a ^^ n) (f (xs ! n)))\<close>
 proof (induction xs)
   case Nil
   then show ?case
     by simp
 next
   case (Cons x xs)
   then show ?case
     by (simp add: sum.atLeast0_lessThan_Suc_shift sum_distrib_left del: sum.op_ivl_Suc)
 qed
 
 end
 
 context
   includes lifting_syntax
 begin
 
 lemma horner_sum_transfer [transfer_rule]:
   \<open>((B ===> A) ===> A ===> list_all2 B ===> A) horner_sum horner_sum\<close>
   if [transfer_rule]: \<open>A 0 0\<close>
     and [transfer_rule]: \<open>(A ===> A ===> A) (+) (+)\<close>
     and [transfer_rule]: \<open>(A ===> A ===> A) (*) (*)\<close>
   by (unfold horner_sum_foldr) transfer_prover
 
 end
 
 context comm_semiring_1
 begin
 
 lemma horner_sum_eq_sum:
   \<open>horner_sum f a xs = (\<Sum>n = 0..<length xs. f (xs ! n) * a ^ n)\<close>
 proof -
   have \<open>(*) a ^^ n = (*) (a ^ n)\<close> for n
     by (induction n) (simp_all add: ac_simps)
   then show ?thesis
     by (simp add: horner_sum_eq_sum_funpow ac_simps)
 qed
 
 lemma horner_sum_append:
   \<open>horner_sum f a (xs @ ys) = horner_sum f a xs + a ^ length xs * horner_sum f a ys\<close>
   using sum.atLeastLessThan_shift_bounds [of _ 0 \<open>length xs\<close> \<open>length ys\<close>]
     atLeastLessThan_add_Un [of 0 \<open>length xs\<close> \<open>length ys\<close>]
   by (simp add: horner_sum_eq_sum sum_distrib_left sum.union_disjoint ac_simps nth_append power_add)
 
 end
 
 context semiring_bit_shifts
 begin
 
 lemma horner_sum_bit_eq_take_bit:
   \<open>horner_sum of_bool 2 (map (bit a) [0..<n]) = take_bit n a\<close>
 proof (induction a arbitrary: n rule: bits_induct)
   case (stable a)
   moreover have \<open>bit a = (\<lambda>_. odd a)\<close>
     using stable by (simp add: stable_imp_bit_iff_odd fun_eq_iff)
   moreover have \<open>{q. q < n} = {0..<n}\<close>
     by auto
   ultimately show ?case
     by (simp add: stable_imp_take_bit_eq horner_sum_eq_sum mask_eq_sum_exp)
 next
   case (rec a b)
   show ?case
   proof (cases n)
     case 0
     then show ?thesis
       by simp
   next
     case (Suc m)
     have \<open>map (bit (of_bool b + 2 * a)) [0..<Suc m] = b # map (bit (of_bool b + 2 * a)) [Suc 0..<Suc m]\<close>
       by (simp only: upt_conv_Cons) simp
     also have \<open>\<dots> = b # map (bit a) [0..<m]\<close>
       by (simp only: flip: map_Suc_upt) (simp add: bit_Suc rec.hyps)
     finally show ?thesis
-      using Suc rec.IH [of m] by (simp add: take_bit_Suc rec.hyps, simp add: ac_simps mod_2_eq_odd)
+      using Suc rec.IH [of m] by (simp add: take_bit_Suc rec.hyps)
+        (simp_all add: ac_simps mod_2_eq_odd)
   qed
 qed
 
 end
 
 context unique_euclidean_semiring_with_bit_shifts
 begin
 
 lemma bit_horner_sum_bit_iff [bit_simps]:
   \<open>bit (horner_sum of_bool 2 bs) n \<longleftrightarrow> n < length bs \<and> bs ! n\<close>
 proof (induction bs arbitrary: n)
   case Nil
   then show ?case
     by simp
 next
   case (Cons b bs)
   show ?case
   proof (cases n)
     case 0
     then show ?thesis
       by simp
   next
     case (Suc m)
     with bit_rec [of _ n] Cons.prems Cons.IH [of m]
     show ?thesis by simp
   qed
 qed
 
 lemma take_bit_horner_sum_bit_eq:
   \<open>take_bit n (horner_sum of_bool 2 bs) = horner_sum of_bool 2 (take n bs)\<close>
   by (auto simp add: bit_eq_iff bit_take_bit_iff bit_horner_sum_bit_iff)
 
 end
 
 lemma horner_sum_of_bool_2_less:
   \<open>(horner_sum of_bool 2 bs :: int) < 2 ^ length bs\<close>
 proof -
   have \<open>(\<Sum>n = 0..<length bs. of_bool (bs ! n) * (2::int) ^ n) \<le> (\<Sum>n = 0..<length bs. 2 ^ n)\<close>
     by (rule sum_mono) simp
   also have \<open>\<dots> = 2 ^ length bs - 1\<close>
     by (induction bs) simp_all
   finally show ?thesis
     by (simp add: horner_sum_eq_sum)
 qed
 
 
 subsection \<open>Further facts about \<^const>\<open>List.n_lists\<close>\<close>
 
 lemma length_n_lists: "length (List.n_lists n xs) = length xs ^ n"
   by (induct n) (auto simp add: comp_def length_concat sum_list_triv)
 
 lemma distinct_n_lists:
   assumes "distinct xs"
   shows "distinct (List.n_lists n xs)"
 proof (rule card_distinct)
   from assms have card_length: "card (set xs) = length xs" by (rule distinct_card)
   have "card (set (List.n_lists n xs)) = card (set xs) ^ n"
   proof (induct n)
     case 0 then show ?case by simp
   next
     case (Suc n)
     moreover have "card (\<Union>ys\<in>set (List.n_lists n xs). (\<lambda>y. y # ys) ` set xs)
       = (\<Sum>ys\<in>set (List.n_lists n xs). card ((\<lambda>y. y # ys) ` set xs))"
       by (rule card_UN_disjoint) auto
     moreover have "\<And>ys. card ((\<lambda>y. y # ys) ` set xs) = card (set xs)"
       by (rule card_image) (simp add: inj_on_def)
     ultimately show ?case by auto
   qed
   also have "\<dots> = length xs ^ n" by (simp add: card_length)
   finally show "card (set (List.n_lists n xs)) = length (List.n_lists n xs)"
     by (simp add: length_n_lists)
 qed
 
 
 subsection \<open>Tools setup\<close>
 
 lemmas sum_code = sum.set_conv_list
 
 lemma sum_set_upto_conv_sum_list_int [code_unfold]:
   "sum f (set [i..j::int]) = sum_list (map f [i..j])"
   by (simp add: interv_sum_list_conv_sum_set_int)
 
 lemma sum_set_upt_conv_sum_list_nat [code_unfold]:
   "sum f (set [m..<n]) = sum_list (map f [m..<n])"
   by (simp add: interv_sum_list_conv_sum_set_nat)
 
 
 subsection \<open>List product\<close>
 
 context monoid_mult
 begin
 
 sublocale prod_list: monoid_list times 1
 defines
   prod_list = prod_list.F ..
 
 end
 
 context comm_monoid_mult
 begin
 
 sublocale prod_list: comm_monoid_list times 1
 rewrites
   "monoid_list.F times 1 = prod_list"
 proof -
   show "comm_monoid_list times 1" ..
   then interpret prod_list: comm_monoid_list times 1 .
   from prod_list_def show "monoid_list.F times 1 = prod_list" by simp
 qed
 
 sublocale prod: comm_monoid_list_set times 1
 rewrites
   "monoid_list.F times 1 = prod_list"
   and "comm_monoid_set.F times 1 = prod"
 proof -
   show "comm_monoid_list_set times 1" ..
   then interpret prod: comm_monoid_list_set times 1 .
   from prod_list_def show "monoid_list.F times 1 = prod_list" by simp
   from prod_def show "comm_monoid_set.F times 1 = prod" by (auto intro: sym)
 qed
 
 end
 
 text \<open>Some syntactic sugar:\<close>
 
 syntax (ASCII)
   "_prod_list" :: "pttrn => 'a list => 'b => 'b"    ("(3PROD _<-_. _)" [0, 51, 10] 10)
 syntax
   "_prod_list" :: "pttrn => 'a list => 'b => 'b"    ("(3\<Prod>_\<leftarrow>_. _)" [0, 51, 10] 10)
 translations \<comment> \<open>Beware of argument permutation!\<close>
   "\<Prod>x\<leftarrow>xs. b" \<rightleftharpoons> "CONST prod_list (CONST map (\<lambda>x. b) xs)"
 
 context
   includes lifting_syntax
 begin
 
 lemma prod_list_transfer [transfer_rule]:
   "(list_all2 A ===> A) prod_list prod_list"
     if [transfer_rule]: "A 1 1" "(A ===> A ===> A) (*) (*)"
   unfolding prod_list.eq_foldr [abs_def]
   by transfer_prover
 
 end
 
 lemma prod_list_zero_iff:
   "prod_list xs = 0 \<longleftrightarrow> (0 :: 'a :: {semiring_no_zero_divisors, semiring_1}) \<in> set xs"
   by (induction xs) simp_all
 
 end
diff --git a/src/HOL/Library/Bit_Operations.thy b/src/HOL/Library/Bit_Operations.thy
--- a/src/HOL/Library/Bit_Operations.thy
+++ b/src/HOL/Library/Bit_Operations.thy
@@ -1,1850 +1,1855 @@
 (*  Author:  Florian Haftmann, TUM
 *)
 
 section \<open>Bit operations in suitable algebraic structures\<close>
 
 theory Bit_Operations
   imports
     Main
     "HOL-Library.Boolean_Algebra"
 begin
 
 subsection \<open>Bit operations\<close>
 
 class semiring_bit_operations = semiring_bit_shifts +
   fixes "and" :: \<open>'a \<Rightarrow> 'a \<Rightarrow> 'a\<close>  (infixr \<open>AND\<close> 64)
     and or :: \<open>'a \<Rightarrow> 'a \<Rightarrow> 'a\<close>  (infixr \<open>OR\<close>  59)
     and xor :: \<open>'a \<Rightarrow> 'a \<Rightarrow> 'a\<close>  (infixr \<open>XOR\<close> 59)
     and mask :: \<open>nat \<Rightarrow> 'a\<close>
   assumes bit_and_iff [bit_simps]: \<open>\<And>n. bit (a AND b) n \<longleftrightarrow> bit a n \<and> bit b n\<close>
     and bit_or_iff [bit_simps]: \<open>\<And>n. bit (a OR b) n \<longleftrightarrow> bit a n \<or> bit b n\<close>
     and bit_xor_iff [bit_simps]: \<open>\<And>n. bit (a XOR b) n \<longleftrightarrow> bit a n \<noteq> bit b n\<close>
     and mask_eq_exp_minus_1: \<open>mask n = 2 ^ n - 1\<close>
 begin
 
 text \<open>
   We want the bitwise operations to bind slightly weaker
   than \<open>+\<close> and \<open>-\<close>.
   For the sake of code generation
   the operations \<^const>\<open>and\<close>, \<^const>\<open>or\<close> and \<^const>\<open>xor\<close>
   are specified as definitional class operations.
 \<close>
 
 sublocale "and": semilattice \<open>(AND)\<close>
   by standard (auto simp add: bit_eq_iff bit_and_iff)
 
 sublocale or: semilattice_neutr \<open>(OR)\<close> 0
   by standard (auto simp add: bit_eq_iff bit_or_iff)
 
 sublocale xor: comm_monoid \<open>(XOR)\<close> 0
   by standard (auto simp add: bit_eq_iff bit_xor_iff)
 
 lemma even_and_iff:
   \<open>even (a AND b) \<longleftrightarrow> even a \<or> even b\<close>
   using bit_and_iff [of a b 0] by auto
 
 lemma even_or_iff:
   \<open>even (a OR b) \<longleftrightarrow> even a \<and> even b\<close>
   using bit_or_iff [of a b 0] by auto
 
 lemma even_xor_iff:
   \<open>even (a XOR b) \<longleftrightarrow> (even a \<longleftrightarrow> even b)\<close>
   using bit_xor_iff [of a b 0] by auto
 
 lemma zero_and_eq [simp]:
   "0 AND a = 0"
   by (simp add: bit_eq_iff bit_and_iff)
 
 lemma and_zero_eq [simp]:
   "a AND 0 = 0"
   by (simp add: bit_eq_iff bit_and_iff)
 
 lemma one_and_eq:
   "1 AND a = a mod 2"
   by (simp add: bit_eq_iff bit_and_iff) (auto simp add: bit_1_iff)
 
 lemma and_one_eq:
   "a AND 1 = a mod 2"
   using one_and_eq [of a] by (simp add: ac_simps)
 
 lemma one_or_eq:
   "1 OR a = a + of_bool (even a)"
   by (simp add: bit_eq_iff bit_or_iff add.commute [of _ 1] even_bit_succ_iff) (auto simp add: bit_1_iff)
 
 lemma or_one_eq:
   "a OR 1 = a + of_bool (even a)"
   using one_or_eq [of a] by (simp add: ac_simps)
 
 lemma one_xor_eq:
   "1 XOR a = a + of_bool (even a) - of_bool (odd a)"
   by (simp add: bit_eq_iff bit_xor_iff add.commute [of _ 1] even_bit_succ_iff) (auto simp add: bit_1_iff odd_bit_iff_bit_pred elim: oddE)
 
 lemma xor_one_eq:
   "a XOR 1 = a + of_bool (even a) - of_bool (odd a)"
   using one_xor_eq [of a] by (simp add: ac_simps)
 
 lemma take_bit_and [simp]:
   \<open>take_bit n (a AND b) = take_bit n a AND take_bit n b\<close>
   by (auto simp add: bit_eq_iff bit_take_bit_iff bit_and_iff)
 
 lemma take_bit_or [simp]:
   \<open>take_bit n (a OR b) = take_bit n a OR take_bit n b\<close>
   by (auto simp add: bit_eq_iff bit_take_bit_iff bit_or_iff)
 
 lemma take_bit_xor [simp]:
   \<open>take_bit n (a XOR b) = take_bit n a XOR take_bit n b\<close>
   by (auto simp add: bit_eq_iff bit_take_bit_iff bit_xor_iff)
 
 lemma push_bit_and [simp]:
   \<open>push_bit n (a AND b) = push_bit n a AND push_bit n b\<close>
   by (rule bit_eqI) (auto simp add: bit_push_bit_iff bit_and_iff)
 
 lemma push_bit_or [simp]:
   \<open>push_bit n (a OR b) = push_bit n a OR push_bit n b\<close>
   by (rule bit_eqI) (auto simp add: bit_push_bit_iff bit_or_iff)
 
 lemma push_bit_xor [simp]:
   \<open>push_bit n (a XOR b) = push_bit n a XOR push_bit n b\<close>
   by (rule bit_eqI) (auto simp add: bit_push_bit_iff bit_xor_iff)
 
 lemma drop_bit_and [simp]:
   \<open>drop_bit n (a AND b) = drop_bit n a AND drop_bit n b\<close>
   by (rule bit_eqI) (auto simp add: bit_drop_bit_eq bit_and_iff)
 
 lemma drop_bit_or [simp]:
   \<open>drop_bit n (a OR b) = drop_bit n a OR drop_bit n b\<close>
   by (rule bit_eqI) (auto simp add: bit_drop_bit_eq bit_or_iff)
 
 lemma drop_bit_xor [simp]:
   \<open>drop_bit n (a XOR b) = drop_bit n a XOR drop_bit n b\<close>
   by (rule bit_eqI) (auto simp add: bit_drop_bit_eq bit_xor_iff)
 
 lemma bit_mask_iff [bit_simps]:
   \<open>bit (mask m) n \<longleftrightarrow> 2 ^ n \<noteq> 0 \<and> n < m\<close>
   by (simp add: mask_eq_exp_minus_1 bit_mask_iff)
 
 lemma even_mask_iff:
   \<open>even (mask n) \<longleftrightarrow> n = 0\<close>
   using bit_mask_iff [of n 0] by auto
 
 lemma mask_0 [simp]:
   \<open>mask 0 = 0\<close>
   by (simp add: mask_eq_exp_minus_1)
 
 lemma mask_Suc_0 [simp]:
   \<open>mask (Suc 0) = 1\<close>
   by (simp add: mask_eq_exp_minus_1 add_implies_diff sym)
 
 lemma mask_Suc_exp:
   \<open>mask (Suc n) = 2 ^ n OR mask n\<close>
   by (rule bit_eqI)
     (auto simp add: bit_or_iff bit_mask_iff bit_exp_iff not_less le_less_Suc_eq)
 
 lemma mask_Suc_double:
   \<open>mask (Suc n) = 1 OR 2 * mask n\<close>
 proof (rule bit_eqI)
   fix q
   assume \<open>2 ^ q \<noteq> 0\<close>
   show \<open>bit (mask (Suc n)) q \<longleftrightarrow> bit (1 OR 2 * mask n) q\<close>
     by (cases q)
       (simp_all add: even_mask_iff even_or_iff bit_or_iff bit_mask_iff bit_exp_iff bit_double_iff not_less le_less_Suc_eq bit_1_iff, auto simp add: mult_2)
 qed
 
 lemma mask_numeral:
   \<open>mask (numeral n) = 1 + 2 * mask (pred_numeral n)\<close>
   by (simp add: numeral_eq_Suc mask_Suc_double one_or_eq ac_simps)
 
 lemma take_bit_mask [simp]:
   \<open>take_bit m (mask n) = mask (min m n)\<close>
   by (rule bit_eqI) (simp add: bit_simps)
 
 lemma take_bit_eq_mask:
   \<open>take_bit n a = a AND mask n\<close>
   by (rule bit_eqI)
     (auto simp add: bit_take_bit_iff bit_and_iff bit_mask_iff)
 
 lemma or_eq_0_iff:
   \<open>a OR b = 0 \<longleftrightarrow> a = 0 \<and> b = 0\<close>
   by (auto simp add: bit_eq_iff bit_or_iff)
 
 lemma disjunctive_add:
   \<open>a + b = a OR b\<close> if \<open>\<And>n. \<not> bit a n \<or> \<not> bit b n\<close>
   by (rule bit_eqI) (use that in \<open>simp add: bit_disjunctive_add_iff bit_or_iff\<close>)
 
 lemma bit_iff_and_drop_bit_eq_1:
   \<open>bit a n \<longleftrightarrow> drop_bit n a AND 1 = 1\<close>
   by (simp add: bit_iff_odd_drop_bit and_one_eq odd_iff_mod_2_eq_one)
 
 lemma bit_iff_and_push_bit_not_eq_0:
   \<open>bit a n \<longleftrightarrow> a AND push_bit n 1 \<noteq> 0\<close>
   apply (cases \<open>2 ^ n = 0\<close>)
   apply (simp_all add: push_bit_of_1 bit_eq_iff bit_and_iff bit_push_bit_iff exp_eq_0_imp_not_bit)
   apply (simp_all add: bit_exp_iff)
   done
 
 end
 
 class ring_bit_operations = semiring_bit_operations + ring_parity +
   fixes not :: \<open>'a \<Rightarrow> 'a\<close>  (\<open>NOT\<close>)
   assumes bit_not_iff [bit_simps]: \<open>\<And>n. bit (NOT a) n \<longleftrightarrow> 2 ^ n \<noteq> 0 \<and> \<not> bit a n\<close>
   assumes minus_eq_not_minus_1: \<open>- a = NOT (a - 1)\<close>
 begin
 
 text \<open>
   For the sake of code generation \<^const>\<open>not\<close> is specified as
   definitional class operation.  Note that \<^const>\<open>not\<close> has no
   sensible definition for unlimited but only positive bit strings
   (type \<^typ>\<open>nat\<close>).
 \<close>
 
 lemma bits_minus_1_mod_2_eq [simp]:
   \<open>(- 1) mod 2 = 1\<close>
   by (simp add: mod_2_eq_odd)
 
 lemma not_eq_complement:
   \<open>NOT a = - a - 1\<close>
   using minus_eq_not_minus_1 [of \<open>a + 1\<close>] by simp
 
 lemma minus_eq_not_plus_1:
   \<open>- a = NOT a + 1\<close>
   using not_eq_complement [of a] by simp
 
 lemma bit_minus_iff [bit_simps]:
   \<open>bit (- a) n \<longleftrightarrow> 2 ^ n \<noteq> 0 \<and> \<not> bit (a - 1) n\<close>
   by (simp add: minus_eq_not_minus_1 bit_not_iff)
 
 lemma even_not_iff [simp]:
   "even (NOT a) \<longleftrightarrow> odd a"
   using bit_not_iff [of a 0] by auto
 
 lemma bit_not_exp_iff [bit_simps]:
   \<open>bit (NOT (2 ^ m)) n \<longleftrightarrow> 2 ^ n \<noteq> 0 \<and> n \<noteq> m\<close>
   by (auto simp add: bit_not_iff bit_exp_iff)
 
 lemma bit_minus_1_iff [simp]:
   \<open>bit (- 1) n \<longleftrightarrow> 2 ^ n \<noteq> 0\<close>
   by (simp add: bit_minus_iff)
 
 lemma bit_minus_exp_iff [bit_simps]:
   \<open>bit (- (2 ^ m)) n \<longleftrightarrow> 2 ^ n \<noteq> 0 \<and> n \<ge> m\<close>
   by (auto simp add: bit_simps simp flip: mask_eq_exp_minus_1)
 
 lemma bit_minus_2_iff [simp]:
   \<open>bit (- 2) n \<longleftrightarrow> 2 ^ n \<noteq> 0 \<and> n > 0\<close>
   by (simp add: bit_minus_iff bit_1_iff)
 
 lemma not_one [simp]:
   "NOT 1 = - 2"
   by (simp add: bit_eq_iff bit_not_iff) (simp add: bit_1_iff)
 
 sublocale "and": semilattice_neutr \<open>(AND)\<close> \<open>- 1\<close>
   by standard (rule bit_eqI, simp add: bit_and_iff)
 
 sublocale bit: boolean_algebra \<open>(AND)\<close> \<open>(OR)\<close> NOT 0 \<open>- 1\<close>
   rewrites \<open>bit.xor = (XOR)\<close>
 proof -
   interpret bit: boolean_algebra \<open>(AND)\<close> \<open>(OR)\<close> NOT 0 \<open>- 1\<close>
     by standard (auto simp add: bit_and_iff bit_or_iff bit_not_iff intro: bit_eqI)
   show \<open>boolean_algebra (AND) (OR) NOT 0 (- 1)\<close>
     by standard
   show \<open>boolean_algebra.xor (AND) (OR) NOT = (XOR)\<close>
     by (rule ext, rule ext, rule bit_eqI)
       (auto simp add: bit.xor_def bit_and_iff bit_or_iff bit_xor_iff bit_not_iff)
 qed
 
 lemma and_eq_not_not_or:
   \<open>a AND b = NOT (NOT a OR NOT b)\<close>
   by simp
 
 lemma or_eq_not_not_and:
   \<open>a OR b = NOT (NOT a AND NOT b)\<close>
   by simp
 
 lemma not_add_distrib:
   \<open>NOT (a + b) = NOT a - b\<close>
   by (simp add: not_eq_complement algebra_simps)
 
 lemma not_diff_distrib:
   \<open>NOT (a - b) = NOT a + b\<close>
   using not_add_distrib [of a \<open>- b\<close>] by simp
 
 lemma (in ring_bit_operations) and_eq_minus_1_iff:
   \<open>a AND b = - 1 \<longleftrightarrow> a = - 1 \<and> b = - 1\<close>
 proof
   assume \<open>a = - 1 \<and> b = - 1\<close>
   then show \<open>a AND b = - 1\<close>
     by simp
 next
   assume \<open>a AND b = - 1\<close>
   have *: \<open>bit a n\<close> \<open>bit b n\<close> if \<open>2 ^ n \<noteq> 0\<close> for n
   proof -
     from \<open>a AND b = - 1\<close>
     have \<open>bit (a AND b) n = bit (- 1) n\<close>
       by (simp add: bit_eq_iff)
     then show \<open>bit a n\<close> \<open>bit b n\<close>
       using that by (simp_all add: bit_and_iff)
   qed
   have \<open>a = - 1\<close>
     by (rule bit_eqI) (simp add: *)
   moreover have \<open>b = - 1\<close>
     by (rule bit_eqI) (simp add: *)
   ultimately show \<open>a = - 1 \<and> b = - 1\<close>
     by simp
 qed
 
 lemma disjunctive_diff:
   \<open>a - b = a AND NOT b\<close> if \<open>\<And>n. bit b n \<Longrightarrow> bit a n\<close>
 proof -
   have \<open>NOT a + b = NOT a OR b\<close>
     by (rule disjunctive_add) (auto simp add: bit_not_iff dest: that)
   then have \<open>NOT (NOT a + b) = NOT (NOT a OR b)\<close>
     by simp
   then show ?thesis
     by (simp add: not_add_distrib)
 qed
 
 lemma push_bit_minus:
   \<open>push_bit n (- a) = - push_bit n a\<close>
   by (simp add: push_bit_eq_mult)
 
 lemma take_bit_not_take_bit:
   \<open>take_bit n (NOT (take_bit n a)) = take_bit n (NOT a)\<close>
   by (auto simp add: bit_eq_iff bit_take_bit_iff bit_not_iff)
 
 lemma take_bit_not_iff:
   "take_bit n (NOT a) = take_bit n (NOT b) \<longleftrightarrow> take_bit n a = take_bit n b"
   apply (simp add: bit_eq_iff)
   apply (simp add: bit_not_iff bit_take_bit_iff bit_exp_iff)
   apply (use exp_eq_0_imp_not_bit in blast)
   done
 
 lemma take_bit_not_eq_mask_diff:
   \<open>take_bit n (NOT a) = mask n - take_bit n a\<close>
 proof -
   have \<open>take_bit n (NOT a) = take_bit n (NOT (take_bit n a))\<close>
     by (simp add: take_bit_not_take_bit)
   also have \<open>\<dots> = mask n AND NOT (take_bit n a)\<close>
     by (simp add: take_bit_eq_mask ac_simps)
   also have \<open>\<dots> = mask n - take_bit n a\<close>
     by (subst disjunctive_diff)
       (auto simp add: bit_take_bit_iff bit_mask_iff exp_eq_0_imp_not_bit)
   finally show ?thesis
     by simp
 qed
 
 lemma mask_eq_take_bit_minus_one:
   \<open>mask n = take_bit n (- 1)\<close>
   by (simp add: bit_eq_iff bit_mask_iff bit_take_bit_iff conj_commute)
 
 lemma take_bit_minus_one_eq_mask:
   \<open>take_bit n (- 1) = mask n\<close>
   by (simp add: mask_eq_take_bit_minus_one)
 
 lemma minus_exp_eq_not_mask:
   \<open>- (2 ^ n) = NOT (mask n)\<close>
   by (rule bit_eqI) (simp add: bit_minus_iff bit_not_iff flip: mask_eq_exp_minus_1)
 
 lemma push_bit_minus_one_eq_not_mask:
   \<open>push_bit n (- 1) = NOT (mask n)\<close>
   by (simp add: push_bit_eq_mult minus_exp_eq_not_mask)
 
 lemma take_bit_not_mask_eq_0:
   \<open>take_bit m (NOT (mask n)) = 0\<close> if \<open>n \<ge> m\<close>
   by (rule bit_eqI) (use that in \<open>simp add: bit_take_bit_iff bit_not_iff bit_mask_iff\<close>)
 
 lemma take_bit_mask [simp]:
   \<open>take_bit m (mask n) = mask (min m n)\<close>
   by (simp add: mask_eq_take_bit_minus_one)
 
 definition set_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
   where \<open>set_bit n a = a OR push_bit n 1\<close>
 
 definition unset_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
   where \<open>unset_bit n a = a AND NOT (push_bit n 1)\<close>
 
 definition flip_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
   where \<open>flip_bit n a = a XOR push_bit n 1\<close>
 
 lemma bit_set_bit_iff [bit_simps]:
   \<open>bit (set_bit m a) n \<longleftrightarrow> bit a n \<or> (m = n \<and> 2 ^ n \<noteq> 0)\<close>
   by (auto simp add: set_bit_def push_bit_of_1 bit_or_iff bit_exp_iff)
 
 lemma even_set_bit_iff:
   \<open>even (set_bit m a) \<longleftrightarrow> even a \<and> m \<noteq> 0\<close>
   using bit_set_bit_iff [of m a 0] by auto
 
 lemma bit_unset_bit_iff [bit_simps]:
   \<open>bit (unset_bit m a) n \<longleftrightarrow> bit a n \<and> m \<noteq> n\<close>
   by (auto simp add: unset_bit_def push_bit_of_1 bit_and_iff bit_not_iff bit_exp_iff exp_eq_0_imp_not_bit)
 
 lemma even_unset_bit_iff:
   \<open>even (unset_bit m a) \<longleftrightarrow> even a \<or> m = 0\<close>
   using bit_unset_bit_iff [of m a 0] by auto
 
 lemma bit_flip_bit_iff [bit_simps]:
   \<open>bit (flip_bit m a) n \<longleftrightarrow> (m = n \<longleftrightarrow> \<not> bit a n) \<and> 2 ^ n \<noteq> 0\<close>
   by (auto simp add: flip_bit_def push_bit_of_1 bit_xor_iff bit_exp_iff exp_eq_0_imp_not_bit)
 
 lemma even_flip_bit_iff:
   \<open>even (flip_bit m a) \<longleftrightarrow> \<not> (even a \<longleftrightarrow> m = 0)\<close>
   using bit_flip_bit_iff [of m a 0] by auto
 
 lemma set_bit_0 [simp]:
   \<open>set_bit 0 a = 1 + 2 * (a div 2)\<close>
 proof (rule bit_eqI)
   fix m
   assume *: \<open>2 ^ m \<noteq> 0\<close>
   then show \<open>bit (set_bit 0 a) m = bit (1 + 2 * (a div 2)) m\<close>
     by (simp add: bit_set_bit_iff bit_double_iff even_bit_succ_iff)
       (cases m, simp_all add: bit_Suc)
 qed
 
 lemma set_bit_Suc:
   \<open>set_bit (Suc n) a = a mod 2 + 2 * set_bit n (a div 2)\<close>
 proof (rule bit_eqI)
   fix m
   assume *: \<open>2 ^ m \<noteq> 0\<close>
   show \<open>bit (set_bit (Suc n) a) m \<longleftrightarrow> bit (a mod 2 + 2 * set_bit n (a div 2)) m\<close>
   proof (cases m)
     case 0
     then show ?thesis
       by (simp add: even_set_bit_iff)
   next
     case (Suc m)
     with * have \<open>2 ^ m \<noteq> 0\<close>
       using mult_2 by auto
     show ?thesis
       by (cases a rule: parity_cases)
         (simp_all add: bit_set_bit_iff bit_double_iff even_bit_succ_iff *,
         simp_all add: Suc \<open>2 ^ m \<noteq> 0\<close> bit_Suc)
   qed
 qed
 
 lemma unset_bit_0 [simp]:
   \<open>unset_bit 0 a = 2 * (a div 2)\<close>
 proof (rule bit_eqI)
   fix m
   assume *: \<open>2 ^ m \<noteq> 0\<close>
   then show \<open>bit (unset_bit 0 a) m = bit (2 * (a div 2)) m\<close>
     by (simp add: bit_unset_bit_iff bit_double_iff)
       (cases m, simp_all add: bit_Suc)
 qed
 
 lemma unset_bit_Suc:
   \<open>unset_bit (Suc n) a = a mod 2 + 2 * unset_bit n (a div 2)\<close>
 proof (rule bit_eqI)
   fix m
   assume *: \<open>2 ^ m \<noteq> 0\<close>
   then show \<open>bit (unset_bit (Suc n) a) m \<longleftrightarrow> bit (a mod 2 + 2 * unset_bit n (a div 2)) m\<close>
   proof (cases m)
     case 0
     then show ?thesis
       by (simp add: even_unset_bit_iff)
   next
     case (Suc m)
     show ?thesis
       by (cases a rule: parity_cases)
         (simp_all add: bit_unset_bit_iff bit_double_iff even_bit_succ_iff *,
          simp_all add: Suc bit_Suc)
   qed
 qed
 
 lemma flip_bit_0 [simp]:
   \<open>flip_bit 0 a = of_bool (even a) + 2 * (a div 2)\<close>
 proof (rule bit_eqI)
   fix m
   assume *: \<open>2 ^ m \<noteq> 0\<close>
   then show \<open>bit (flip_bit 0 a) m = bit (of_bool (even a) + 2 * (a div 2)) m\<close>
     by (simp add: bit_flip_bit_iff bit_double_iff even_bit_succ_iff)
       (cases m, simp_all add: bit_Suc)
 qed
 
 lemma flip_bit_Suc:
   \<open>flip_bit (Suc n) a = a mod 2 + 2 * flip_bit n (a div 2)\<close>
 proof (rule bit_eqI)
   fix m
   assume *: \<open>2 ^ m \<noteq> 0\<close>
   show \<open>bit (flip_bit (Suc n) a) m \<longleftrightarrow> bit (a mod 2 + 2 * flip_bit n (a div 2)) m\<close>
   proof (cases m)
     case 0
     then show ?thesis
       by (simp add: even_flip_bit_iff)
   next
     case (Suc m)
     with * have \<open>2 ^ m \<noteq> 0\<close>
       using mult_2 by auto
     show ?thesis
       by (cases a rule: parity_cases)
         (simp_all add: bit_flip_bit_iff bit_double_iff even_bit_succ_iff,
         simp_all add: Suc \<open>2 ^ m \<noteq> 0\<close> bit_Suc)
   qed
 qed
 
 lemma flip_bit_eq_if:
   \<open>flip_bit n a = (if bit a n then unset_bit else set_bit) n a\<close>
   by (rule bit_eqI) (auto simp add: bit_set_bit_iff bit_unset_bit_iff bit_flip_bit_iff)
 
 lemma take_bit_set_bit_eq:
   \<open>take_bit n (set_bit m a) = (if n \<le> m then take_bit n a else set_bit m (take_bit n a))\<close>
   by (rule bit_eqI) (auto simp add: bit_take_bit_iff bit_set_bit_iff)
 
 lemma take_bit_unset_bit_eq:
   \<open>take_bit n (unset_bit m a) = (if n \<le> m then take_bit n a else unset_bit m (take_bit n a))\<close>
   by (rule bit_eqI) (auto simp add: bit_take_bit_iff bit_unset_bit_iff)
 
 lemma take_bit_flip_bit_eq:
   \<open>take_bit n (flip_bit m a) = (if n \<le> m then take_bit n a else flip_bit m (take_bit n a))\<close>
   by (rule bit_eqI) (auto simp add: bit_take_bit_iff bit_flip_bit_iff)
 
 end
 
 
 subsection \<open>Instance \<^typ>\<open>int\<close>\<close>
 
 lemma int_bit_bound:
   fixes k :: int
   obtains n where \<open>\<And>m. n \<le> m \<Longrightarrow> bit k m \<longleftrightarrow> bit k n\<close>
     and \<open>n > 0 \<Longrightarrow> bit k (n - 1) \<noteq> bit k n\<close>
 proof -
   obtain q where *: \<open>\<And>m. q \<le> m \<Longrightarrow> bit k m \<longleftrightarrow> bit k q\<close>
   proof (cases \<open>k \<ge> 0\<close>)
     case True
     moreover from power_gt_expt [of 2 \<open>nat k\<close>]
     have \<open>k < 2 ^ nat k\<close> by simp
     ultimately have *: \<open>k div 2 ^ nat k = 0\<close>
       by simp
     show thesis
     proof (rule that [of \<open>nat k\<close>])
       fix m
       assume \<open>nat k \<le> m\<close>
       then show \<open>bit k m \<longleftrightarrow> bit k (nat k)\<close>
         by (auto simp add: * bit_iff_odd power_add zdiv_zmult2_eq dest!: le_Suc_ex)
     qed
   next
     case False
     moreover from power_gt_expt [of 2 \<open>nat (- k)\<close>]
     have \<open>- k \<le> 2 ^ nat (- k)\<close>
       by simp
     ultimately have \<open>- k div - (2 ^ nat (- k)) = - 1\<close>
       by (subst div_pos_neg_trivial) simp_all
     then have *: \<open>k div 2 ^ nat (- k) = - 1\<close>
       by simp
     show thesis
     proof (rule that [of \<open>nat (- k)\<close>])
       fix m
       assume \<open>nat (- k) \<le> m\<close>
       then show \<open>bit k m \<longleftrightarrow> bit k (nat (- k))\<close>
         by (auto simp add: * bit_iff_odd power_add zdiv_zmult2_eq minus_1_div_exp_eq_int dest!: le_Suc_ex)
     qed
   qed
   show thesis
   proof (cases \<open>\<forall>m. bit k m \<longleftrightarrow> bit k q\<close>)
     case True
     then have \<open>bit k 0 \<longleftrightarrow> bit k q\<close>
       by blast
     with True that [of 0] show thesis
       by simp
   next
     case False
     then obtain r where **: \<open>bit k r \<noteq> bit k q\<close>
       by blast
     have \<open>r < q\<close>
       by (rule ccontr) (use * [of r] ** in simp)
     define N where \<open>N = {n. n < q \<and> bit k n \<noteq> bit k q}\<close>
     moreover have \<open>finite N\<close> \<open>r \<in> N\<close>
       using ** N_def \<open>r < q\<close> by auto
     moreover define n where \<open>n = Suc (Max N)\<close>
     ultimately have \<open>\<And>m. n \<le> m \<Longrightarrow> bit k m \<longleftrightarrow> bit k n\<close>
       apply auto
          apply (metis (full_types, lifting) "*" Max_ge_iff Suc_n_not_le_n \<open>finite N\<close> all_not_in_conv mem_Collect_eq not_le)
         apply (metis "*" Max_ge Suc_n_not_le_n \<open>finite N\<close> linorder_not_less mem_Collect_eq)
         apply (metis "*" Max_ge Suc_n_not_le_n \<open>finite N\<close> linorder_not_less mem_Collect_eq)
       apply (metis (full_types, lifting) "*" Max_ge_iff Suc_n_not_le_n \<open>finite N\<close> all_not_in_conv mem_Collect_eq not_le)
       done
     have \<open>bit k (Max N) \<noteq> bit k n\<close>
       by (metis (mono_tags, lifting) "*" Max_in N_def \<open>\<And>m. n \<le> m \<Longrightarrow> bit k m = bit k n\<close> \<open>finite N\<close> \<open>r \<in> N\<close> empty_iff le_cases mem_Collect_eq)
     show thesis apply (rule that [of n])
       using \<open>\<And>m. n \<le> m \<Longrightarrow> bit k m = bit k n\<close> apply blast
       using \<open>bit k (Max N) \<noteq> bit k n\<close> n_def by auto
   qed
 qed
 
 instantiation int :: ring_bit_operations
 begin
 
 definition not_int :: \<open>int \<Rightarrow> int\<close>
   where \<open>not_int k = - k - 1\<close>
 
 lemma not_int_rec:
   "NOT k = of_bool (even k) + 2 * NOT (k div 2)" for k :: int
   by (auto simp add: not_int_def elim: oddE)
 
 lemma even_not_iff_int:
   \<open>even (NOT k) \<longleftrightarrow> odd k\<close> for k :: int
   by (simp add: not_int_def)
 
 lemma not_int_div_2:
   \<open>NOT k div 2 = NOT (k div 2)\<close> for k :: int
   by (simp add: not_int_def)
 
 lemma bit_not_int_iff [bit_simps]:
   \<open>bit (NOT k) n \<longleftrightarrow> \<not> bit k n\<close>
   for k :: int
   by (simp add: bit_not_int_iff' not_int_def)
 
 function and_int :: \<open>int \<Rightarrow> int \<Rightarrow> int\<close>
   where \<open>(k::int) AND l = (if k \<in> {0, - 1} \<and> l \<in> {0, - 1}
     then - of_bool (odd k \<and> odd l)
     else of_bool (odd k \<and> odd l) + 2 * ((k div 2) AND (l div 2)))\<close>
   by auto
 
 termination
   by (relation \<open>measure (\<lambda>(k, l). nat (\<bar>k\<bar> + \<bar>l\<bar>))\<close>) auto
 
 declare and_int.simps [simp del]
 
 lemma and_int_rec:
   \<open>k AND l = of_bool (odd k \<and> odd l) + 2 * ((k div 2) AND (l div 2))\<close>
     for k l :: int
 proof (cases \<open>k \<in> {0, - 1} \<and> l \<in> {0, - 1}\<close>)
   case True
   then show ?thesis
     by auto (simp_all add: and_int.simps)
 next
   case False
   then show ?thesis
     by (auto simp add: ac_simps and_int.simps [of k l])
 qed
 
 lemma bit_and_int_iff:
   \<open>bit (k AND l) n \<longleftrightarrow> bit k n \<and> bit l n\<close> for k l :: int
 proof (induction n arbitrary: k l)
   case 0
   then show ?case
     by (simp add: and_int_rec [of k l])
 next
   case (Suc n)
   then show ?case
     by (simp add: and_int_rec [of k l] bit_Suc)
 qed
 
 lemma even_and_iff_int:
   \<open>even (k AND l) \<longleftrightarrow> even k \<or> even l\<close> for k l :: int
   using bit_and_int_iff [of k l 0] by auto
 
 definition or_int :: \<open>int \<Rightarrow> int \<Rightarrow> int\<close>
   where \<open>k OR l = NOT (NOT k AND NOT l)\<close> for k l :: int
 
 lemma or_int_rec:
   \<open>k OR l = of_bool (odd k \<or> odd l) + 2 * ((k div 2) OR (l div 2))\<close>
   for k l :: int
   using and_int_rec [of \<open>NOT k\<close> \<open>NOT l\<close>]
   by (simp add: or_int_def even_not_iff_int not_int_div_2)
-    (simp add: not_int_def)
+    (simp_all add: not_int_def)
 
 lemma bit_or_int_iff:
   \<open>bit (k OR l) n \<longleftrightarrow> bit k n \<or> bit l n\<close> for k l :: int
   by (simp add: or_int_def bit_not_int_iff bit_and_int_iff)
 
 definition xor_int :: \<open>int \<Rightarrow> int \<Rightarrow> int\<close>
   where \<open>k XOR l = k AND NOT l OR NOT k AND l\<close> for k l :: int
 
 lemma xor_int_rec:
   \<open>k XOR l = of_bool (odd k \<noteq> odd l) + 2 * ((k div 2) XOR (l div 2))\<close>
   for k l :: int
   by (simp add: xor_int_def or_int_rec [of \<open>k AND NOT l\<close> \<open>NOT k AND l\<close>] even_and_iff_int even_not_iff_int)
     (simp add: and_int_rec [of \<open>NOT k\<close> \<open>l\<close>] and_int_rec [of \<open>k\<close> \<open>NOT l\<close>] not_int_div_2)
 
 lemma bit_xor_int_iff:
   \<open>bit (k XOR l) n \<longleftrightarrow> bit k n \<noteq> bit l n\<close> for k l :: int
   by (auto simp add: xor_int_def bit_or_int_iff bit_and_int_iff bit_not_int_iff)
 
 definition mask_int :: \<open>nat \<Rightarrow> int\<close>
   where \<open>mask n = (2 :: int) ^ n - 1\<close>
 
 instance proof
   fix k l :: int and n :: nat
   show \<open>- k = NOT (k - 1)\<close>
     by (simp add: not_int_def)
   show \<open>bit (k AND l) n \<longleftrightarrow> bit k n \<and> bit l n\<close>
     by (fact bit_and_int_iff)
   show \<open>bit (k OR l) n \<longleftrightarrow> bit k n \<or> bit l n\<close>
     by (fact bit_or_int_iff)
   show \<open>bit (k XOR l) n \<longleftrightarrow> bit k n \<noteq> bit l n\<close>
     by (fact bit_xor_int_iff)
 qed (simp_all add: bit_not_int_iff mask_int_def)
 
 end
 
 
 lemma mask_half_int:
   \<open>mask n div 2 = (mask (n - 1) :: int)\<close>
   by (cases n) (simp_all add: mask_eq_exp_minus_1 algebra_simps)
 
 lemma mask_nonnegative_int [simp]:
   \<open>mask n \<ge> (0::int)\<close>
   by (simp add: mask_eq_exp_minus_1)
 
 lemma not_mask_negative_int [simp]:
   \<open>\<not> mask n < (0::int)\<close>
   by (simp add: not_less)
 
 lemma not_nonnegative_int_iff [simp]:
   \<open>NOT k \<ge> 0 \<longleftrightarrow> k < 0\<close> for k :: int
   by (simp add: not_int_def)
 
 lemma not_negative_int_iff [simp]:
   \<open>NOT k < 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int
   by (subst Not_eq_iff [symmetric]) (simp add: not_less not_le)
 
 lemma and_nonnegative_int_iff [simp]:
   \<open>k AND l \<ge> 0 \<longleftrightarrow> k \<ge> 0 \<or> l \<ge> 0\<close> for k l :: int
 proof (induction k arbitrary: l rule: int_bit_induct)
   case zero
   then show ?case
     by simp
 next
   case minus
   then show ?case
     by simp
 next
   case (even k)
   then show ?case
     using and_int_rec [of \<open>k * 2\<close> l] by (simp add: pos_imp_zdiv_nonneg_iff)
 next
   case (odd k)
   from odd have \<open>0 \<le> k AND l div 2 \<longleftrightarrow> 0 \<le> k \<or> 0 \<le> l div 2\<close>
     by simp
   then have \<open>0 \<le> (1 + k * 2) div 2 AND l div 2 \<longleftrightarrow> 0 \<le> (1 + k * 2) div 2\<or> 0 \<le> l div 2\<close>
     by simp
   with and_int_rec [of \<open>1 + k * 2\<close> l]
   show ?case
     by auto
 qed
 
 lemma and_negative_int_iff [simp]:
   \<open>k AND l < 0 \<longleftrightarrow> k < 0 \<and> l < 0\<close> for k l :: int
   by (subst Not_eq_iff [symmetric]) (simp add: not_less)
 
 lemma and_less_eq:
   \<open>k AND l \<le> k\<close> if \<open>l < 0\<close> for k l :: int
 using that proof (induction k arbitrary: l rule: int_bit_induct)
   case zero
   then show ?case
     by simp
 next
   case minus
   then show ?case
     by simp
 next
   case (even k)
   from even.IH [of \<open>l div 2\<close>] even.hyps even.prems
   show ?case
     by (simp add: and_int_rec [of _ l])
 next
   case (odd k)
   from odd.IH [of \<open>l div 2\<close>] odd.hyps odd.prems
   show ?case
     by (simp add: and_int_rec [of _ l])
 qed
 
 lemma or_nonnegative_int_iff [simp]:
   \<open>k OR l \<ge> 0 \<longleftrightarrow> k \<ge> 0 \<and> l \<ge> 0\<close> for k l :: int
   by (simp only: or_eq_not_not_and not_nonnegative_int_iff) simp
 
 lemma or_negative_int_iff [simp]:
   \<open>k OR l < 0 \<longleftrightarrow> k < 0 \<or> l < 0\<close> for k l :: int
   by (subst Not_eq_iff [symmetric]) (simp add: not_less)
 
 lemma or_greater_eq:
   \<open>k OR l \<ge> k\<close> if \<open>l \<ge> 0\<close> for k l :: int
 using that proof (induction k arbitrary: l rule: int_bit_induct)
   case zero
   then show ?case
     by simp
 next
   case minus
   then show ?case
     by simp
 next
   case (even k)
   from even.IH [of \<open>l div 2\<close>] even.hyps even.prems
   show ?case
     by (simp add: or_int_rec [of _ l])
 next
   case (odd k)
   from odd.IH [of \<open>l div 2\<close>] odd.hyps odd.prems
   show ?case
     by (simp add: or_int_rec [of _ l])
 qed
 
 lemma xor_nonnegative_int_iff [simp]:
   \<open>k XOR l \<ge> 0 \<longleftrightarrow> (k \<ge> 0 \<longleftrightarrow> l \<ge> 0)\<close> for k l :: int
   by (simp only: bit.xor_def or_nonnegative_int_iff) auto
 
 lemma xor_negative_int_iff [simp]:
   \<open>k XOR l < 0 \<longleftrightarrow> (k < 0) \<noteq> (l < 0)\<close> for k l :: int
   by (subst Not_eq_iff [symmetric]) (auto simp add: not_less)
 
 lemma OR_upper: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
   fixes x y :: int
   assumes "0 \<le> x" "x < 2 ^ n" "y < 2 ^ n"
   shows "x OR y < 2 ^ n"
 using assms proof (induction x arbitrary: y n rule: int_bit_induct)
   case zero
   then show ?case
     by simp
 next
   case minus
   then show ?case
     by simp
 next
   case (even x)
   from even.IH [of \<open>n - 1\<close> \<open>y div 2\<close>] even.prems even.hyps
   show ?case 
     by (cases n) (auto simp add: or_int_rec [of \<open>_ * 2\<close>] elim: oddE)
 next
   case (odd x)
   from odd.IH [of \<open>n - 1\<close> \<open>y div 2\<close>] odd.prems odd.hyps
   show ?case
     by (cases n) (auto simp add: or_int_rec [of \<open>1 + _ * 2\<close>], linarith)
 qed
 
 lemma XOR_upper: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
   fixes x y :: int
   assumes "0 \<le> x" "x < 2 ^ n" "y < 2 ^ n"
   shows "x XOR y < 2 ^ n"
 using assms proof (induction x arbitrary: y n rule: int_bit_induct)
   case zero
   then show ?case
     by simp
 next
   case minus
   then show ?case
     by simp
 next
   case (even x)
   from even.IH [of \<open>n - 1\<close> \<open>y div 2\<close>] even.prems even.hyps
   show ?case 
     by (cases n) (auto simp add: xor_int_rec [of \<open>_ * 2\<close>] elim: oddE)
 next
   case (odd x)
   from odd.IH [of \<open>n - 1\<close> \<open>y div 2\<close>] odd.prems odd.hyps
   show ?case
     by (cases n) (auto simp add: xor_int_rec [of \<open>1 + _ * 2\<close>])
 qed
 
 lemma AND_lower [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
   fixes x y :: int
   assumes "0 \<le> x"
   shows "0 \<le> x AND y"
   using assms by simp
 
 lemma OR_lower [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
   fixes x y :: int
   assumes "0 \<le> x" "0 \<le> y"
   shows "0 \<le> x OR y"
   using assms by simp
 
 lemma XOR_lower [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
   fixes x y :: int
   assumes "0 \<le> x" "0 \<le> y"
   shows "0 \<le> x XOR y"
   using assms by simp
 
 lemma AND_upper1 [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
   fixes x y :: int
   assumes "0 \<le> x"
   shows "x AND y \<le> x"
-  using assms by (induction x arbitrary: y rule: int_bit_induct)
-    (simp_all add: and_int_rec [of \<open>_ * 2\<close>] and_int_rec [of \<open>1 + _ * 2\<close>] add_increasing)
+using assms proof (induction x arbitrary: y rule: int_bit_induct)
+  case (odd k)
+  then have \<open>k AND y div 2 \<le> k\<close>
+    by simp
+  then show ?case 
+    by (simp add: and_int_rec [of \<open>1 + _ * 2\<close>])
+qed (simp_all add: and_int_rec [of \<open>_ * 2\<close>])
 
 lemmas AND_upper1' [simp] = order_trans [OF AND_upper1] \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
 lemmas AND_upper1'' [simp] = order_le_less_trans [OF AND_upper1] \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
 
 lemma AND_upper2 [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
   fixes x y :: int
   assumes "0 \<le> y"
   shows "x AND y \<le> y"
   using assms AND_upper1 [of y x] by (simp add: ac_simps)
 
 lemmas AND_upper2' [simp] = order_trans [OF AND_upper2] \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
 lemmas AND_upper2'' [simp] = order_le_less_trans [OF AND_upper2] \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
 
 lemma plus_and_or: \<open>(x AND y) + (x OR y) = x + y\<close> for x y :: int
 proof (induction x arbitrary: y rule: int_bit_induct)
   case zero
   then show ?case
     by simp
 next
   case minus
   then show ?case
     by simp
 next
   case (even x)
   from even.IH [of \<open>y div 2\<close>]
   show ?case
     by (auto simp add: and_int_rec [of _ y] or_int_rec [of _ y] elim: oddE)
 next
   case (odd x)
   from odd.IH [of \<open>y div 2\<close>]
   show ?case
     by (auto simp add: and_int_rec [of _ y] or_int_rec [of _ y] elim: oddE)
 qed
 
 lemma set_bit_nonnegative_int_iff [simp]:
   \<open>set_bit n k \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int
   by (simp add: set_bit_def)
 
 lemma set_bit_negative_int_iff [simp]:
   \<open>set_bit n k < 0 \<longleftrightarrow> k < 0\<close> for k :: int
   by (simp add: set_bit_def)
 
 lemma unset_bit_nonnegative_int_iff [simp]:
   \<open>unset_bit n k \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int
   by (simp add: unset_bit_def)
 
 lemma unset_bit_negative_int_iff [simp]:
   \<open>unset_bit n k < 0 \<longleftrightarrow> k < 0\<close> for k :: int
   by (simp add: unset_bit_def)
 
 lemma flip_bit_nonnegative_int_iff [simp]:
   \<open>flip_bit n k \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int
   by (simp add: flip_bit_def)
 
 lemma flip_bit_negative_int_iff [simp]:
   \<open>flip_bit n k < 0 \<longleftrightarrow> k < 0\<close> for k :: int
   by (simp add: flip_bit_def)
 
 lemma set_bit_greater_eq:
   \<open>set_bit n k \<ge> k\<close> for k :: int
   by (simp add: set_bit_def or_greater_eq)
 
 lemma unset_bit_less_eq:
   \<open>unset_bit n k \<le> k\<close> for k :: int
   by (simp add: unset_bit_def and_less_eq)
 
 lemma set_bit_eq:
   \<open>set_bit n k = k + of_bool (\<not> bit k n) * 2 ^ n\<close> for k :: int
 proof (rule bit_eqI)
   fix m
   show \<open>bit (set_bit n k) m \<longleftrightarrow> bit (k + of_bool (\<not> bit k n) * 2 ^ n) m\<close>
   proof (cases \<open>m = n\<close>)
     case True
     then show ?thesis
       apply (simp add: bit_set_bit_iff)
       apply (simp add: bit_iff_odd div_plus_div_distrib_dvd_right)
       done
   next
     case False
     then show ?thesis
       apply (clarsimp simp add: bit_set_bit_iff)
       apply (subst disjunctive_add)
       apply (clarsimp simp add: bit_exp_iff)
       apply (clarsimp simp add: bit_or_iff bit_exp_iff)
       done
   qed
 qed
 
 lemma unset_bit_eq:
   \<open>unset_bit n k = k - of_bool (bit k n) * 2 ^ n\<close> for k :: int
 proof (rule bit_eqI)
   fix m
   show \<open>bit (unset_bit n k) m \<longleftrightarrow> bit (k - of_bool (bit k n) * 2 ^ n) m\<close>
   proof (cases \<open>m = n\<close>)
     case True
     then show ?thesis
       apply (simp add: bit_unset_bit_iff)
       apply (simp add: bit_iff_odd)
       using div_plus_div_distrib_dvd_right [of \<open>2 ^ n\<close> \<open>- (2 ^ n)\<close> k]
       apply (simp add: dvd_neg_div)
       done
   next
     case False
     then show ?thesis
       apply (clarsimp simp add: bit_unset_bit_iff)
       apply (subst disjunctive_diff)
       apply (clarsimp simp add: bit_exp_iff)
       apply (clarsimp simp add: bit_and_iff bit_not_iff bit_exp_iff)
       done
   qed
 qed
 
 lemma take_bit_eq_mask_iff:
   \<open>take_bit n k = mask n \<longleftrightarrow> take_bit n (k + 1) = 0\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
   for k :: int
 proof
   assume ?P
   then have \<open>take_bit n (take_bit n k + take_bit n 1) = 0\<close>
     by (simp add: mask_eq_exp_minus_1)
   then show ?Q
     by (simp only: take_bit_add)
 next
   assume ?Q
   then have \<open>take_bit n (k + 1) - 1 = - 1\<close>
     by simp
   then have \<open>take_bit n (take_bit n (k + 1) - 1) = take_bit n (- 1)\<close>
     by simp
   moreover have \<open>take_bit n (take_bit n (k + 1) - 1) = take_bit n k\<close>
     by (simp add: take_bit_eq_mod mod_simps)
   ultimately show ?P
     by (simp add: take_bit_minus_one_eq_mask)
 qed
 
 lemma take_bit_eq_mask_iff_exp_dvd:
   \<open>take_bit n k = mask n \<longleftrightarrow> 2 ^ n dvd k + 1\<close>
   for k :: int
   by (simp add: take_bit_eq_mask_iff flip: take_bit_eq_0_iff)
 
 context ring_bit_operations
 begin
 
 lemma even_of_int_iff:
   \<open>even (of_int k) \<longleftrightarrow> even k\<close>
   by (induction k rule: int_bit_induct) simp_all
 
 lemma bit_of_int_iff [bit_simps]:
   \<open>bit (of_int k) n \<longleftrightarrow> (2::'a) ^ n \<noteq> 0 \<and> bit k n\<close>
 proof (cases \<open>(2::'a) ^ n = 0\<close>)
   case True
   then show ?thesis
     by (simp add: exp_eq_0_imp_not_bit)
 next
   case False
   then have \<open>bit (of_int k) n \<longleftrightarrow> bit k n\<close>
   proof (induction k arbitrary: n rule: int_bit_induct)
     case zero
     then show ?case
       by simp
   next
     case minus
     then show ?case
       by simp
   next
     case (even k)
     then show ?case
       using bit_double_iff [of \<open>of_int k\<close> n] Parity.bit_double_iff [of k n]
       by (cases n) (auto simp add: ac_simps dest: mult_not_zero)
   next
     case (odd k)
     then show ?case
       using bit_double_iff [of \<open>of_int k\<close> n]
       by (cases n) (auto simp add: ac_simps bit_double_iff even_bit_succ_iff Parity.bit_Suc dest: mult_not_zero)
   qed
   with False show ?thesis
     by simp
 qed
 
 lemma push_bit_of_int:
   \<open>push_bit n (of_int k) = of_int (push_bit n k)\<close>
   by (simp add: push_bit_eq_mult semiring_bit_shifts_class.push_bit_eq_mult)
 
 lemma of_int_push_bit:
   \<open>of_int (push_bit n k) = push_bit n (of_int k)\<close>
   by (simp add: push_bit_eq_mult semiring_bit_shifts_class.push_bit_eq_mult)
 
 lemma take_bit_of_int:
   \<open>take_bit n (of_int k) = of_int (take_bit n k)\<close>
   by (rule bit_eqI) (simp add: bit_take_bit_iff Parity.bit_take_bit_iff bit_of_int_iff)
 
 lemma of_int_take_bit:
   \<open>of_int (take_bit n k) = take_bit n (of_int k)\<close>
   by (rule bit_eqI) (simp add: bit_take_bit_iff Parity.bit_take_bit_iff bit_of_int_iff)
 
 lemma of_int_not_eq:
   \<open>of_int (NOT k) = NOT (of_int k)\<close>
   by (rule bit_eqI) (simp add: bit_not_iff Bit_Operations.bit_not_iff bit_of_int_iff)
 
 lemma of_int_and_eq:
   \<open>of_int (k AND l) = of_int k AND of_int l\<close>
   by (rule bit_eqI) (simp add: bit_of_int_iff bit_and_iff Bit_Operations.bit_and_iff)
 
 lemma of_int_or_eq:
   \<open>of_int (k OR l) = of_int k OR of_int l\<close>
   by (rule bit_eqI) (simp add: bit_of_int_iff bit_or_iff Bit_Operations.bit_or_iff)
 
 lemma of_int_xor_eq:
   \<open>of_int (k XOR l) = of_int k XOR of_int l\<close>
   by (rule bit_eqI) (simp add: bit_of_int_iff bit_xor_iff Bit_Operations.bit_xor_iff)
 
 lemma of_int_mask_eq:
   \<open>of_int (mask n) = mask n\<close>
   by (induction n) (simp_all add: mask_Suc_double Bit_Operations.mask_Suc_double of_int_or_eq)
 
 end
 
 text \<open>FIXME: The rule sets below are very large (24 rules for each
   operator). Is there a simpler way to do this?\<close>
 
 context
 begin
 
 private lemma eqI:
   \<open>k = l\<close>
   if num: \<open>\<And>n. bit k (numeral n) \<longleftrightarrow> bit l (numeral n)\<close>
     and even: \<open>even k \<longleftrightarrow> even l\<close>
   for k l :: int
 proof (rule bit_eqI)
   fix n
   show \<open>bit k n \<longleftrightarrow> bit l n\<close>
   proof (cases n)
     case 0
     with even show ?thesis
       by simp
   next
     case (Suc n)
     with num [of \<open>num_of_nat (Suc n)\<close>] show ?thesis
       by (simp only: numeral_num_of_nat)
   qed
 qed
 
 lemma int_and_numerals [simp]:
   "numeral (Num.Bit0 x) AND numeral (Num.Bit0 y) = (2 :: int) * (numeral x AND numeral y)"
   "numeral (Num.Bit0 x) AND numeral (Num.Bit1 y) = (2 :: int) * (numeral x AND numeral y)"
   "numeral (Num.Bit1 x) AND numeral (Num.Bit0 y) = (2 :: int) * (numeral x AND numeral y)"
   "numeral (Num.Bit1 x) AND numeral (Num.Bit1 y) = 1 + (2 :: int) * (numeral x AND numeral y)"
   "numeral (Num.Bit0 x) AND - numeral (Num.Bit0 y) = (2 :: int) * (numeral x AND - numeral y)"
   "numeral (Num.Bit0 x) AND - numeral (Num.Bit1 y) = (2 :: int) * (numeral x AND - numeral (y + Num.One))"
   "numeral (Num.Bit1 x) AND - numeral (Num.Bit0 y) = (2 :: int) * (numeral x AND - numeral y)"
   "numeral (Num.Bit1 x) AND - numeral (Num.Bit1 y) = 1 + (2 :: int) * (numeral x AND - numeral (y + Num.One))"
   "- numeral (Num.Bit0 x) AND numeral (Num.Bit0 y) = (2 :: int) * (- numeral x AND numeral y)"
   "- numeral (Num.Bit0 x) AND numeral (Num.Bit1 y) = (2 :: int) * (- numeral x AND numeral y)"
   "- numeral (Num.Bit1 x) AND numeral (Num.Bit0 y) = (2 :: int) * (- numeral (x + Num.One) AND numeral y)"
   "- numeral (Num.Bit1 x) AND numeral (Num.Bit1 y) = 1 + (2 :: int) * (- numeral (x + Num.One) AND numeral y)"
   "- numeral (Num.Bit0 x) AND - numeral (Num.Bit0 y) = (2 :: int) * (- numeral x AND - numeral y)"
   "- numeral (Num.Bit0 x) AND - numeral (Num.Bit1 y) = (2 :: int) * (- numeral x AND - numeral (y + Num.One))"
   "- numeral (Num.Bit1 x) AND - numeral (Num.Bit0 y) = (2 :: int) * (- numeral (x + Num.One) AND - numeral y)"
   "- numeral (Num.Bit1 x) AND - numeral (Num.Bit1 y) = 1 + (2 :: int) * (- numeral (x + Num.One) AND - numeral (y + Num.One))"
   "(1::int) AND numeral (Num.Bit0 y) = 0"
   "(1::int) AND numeral (Num.Bit1 y) = 1"
   "(1::int) AND - numeral (Num.Bit0 y) = 0"
   "(1::int) AND - numeral (Num.Bit1 y) = 1"
   "numeral (Num.Bit0 x) AND (1::int) = 0"
   "numeral (Num.Bit1 x) AND (1::int) = 1"
   "- numeral (Num.Bit0 x) AND (1::int) = 0"
   "- numeral (Num.Bit1 x) AND (1::int) = 1"
   by (auto simp add: bit_and_iff bit_minus_iff even_and_iff bit_double_iff even_bit_succ_iff add_One sub_inc_One_eq intro: eqI)
 
 lemma int_or_numerals [simp]:
   "numeral (Num.Bit0 x) OR numeral (Num.Bit0 y) = (2 :: int) * (numeral x OR numeral y)"
   "numeral (Num.Bit0 x) OR numeral (Num.Bit1 y) = 1 + (2 :: int) * (numeral x OR numeral y)"
   "numeral (Num.Bit1 x) OR numeral (Num.Bit0 y) = 1 + (2 :: int) * (numeral x OR numeral y)"
   "numeral (Num.Bit1 x) OR numeral (Num.Bit1 y) = 1 + (2 :: int) * (numeral x OR numeral y)"
   "numeral (Num.Bit0 x) OR - numeral (Num.Bit0 y) = (2 :: int) * (numeral x OR - numeral y)"
   "numeral (Num.Bit0 x) OR - numeral (Num.Bit1 y) = 1 + (2 :: int) * (numeral x OR - numeral (y + Num.One))"
   "numeral (Num.Bit1 x) OR - numeral (Num.Bit0 y) = 1 + (2 :: int) * (numeral x OR - numeral y)"
   "numeral (Num.Bit1 x) OR - numeral (Num.Bit1 y) = 1 + (2 :: int) * (numeral x OR - numeral (y + Num.One))"
   "- numeral (Num.Bit0 x) OR numeral (Num.Bit0 y) = (2 :: int) * (- numeral x OR numeral y)"
   "- numeral (Num.Bit0 x) OR numeral (Num.Bit1 y) = 1 + (2 :: int) * (- numeral x OR numeral y)"
   "- numeral (Num.Bit1 x) OR numeral (Num.Bit0 y) = 1 + (2 :: int) * (- numeral (x + Num.One) OR numeral y)"
   "- numeral (Num.Bit1 x) OR numeral (Num.Bit1 y) = 1 + (2 :: int) * (- numeral (x + Num.One) OR numeral y)"
   "- numeral (Num.Bit0 x) OR - numeral (Num.Bit0 y) = (2 :: int) * (- numeral x OR - numeral y)"
   "- numeral (Num.Bit0 x) OR - numeral (Num.Bit1 y) = 1 + (2 :: int) * (- numeral x OR - numeral (y + Num.One))"
   "- numeral (Num.Bit1 x) OR - numeral (Num.Bit0 y) = 1 + (2 :: int) * (- numeral (x + Num.One) OR - numeral y)"
   "- numeral (Num.Bit1 x) OR - numeral (Num.Bit1 y) = 1 + (2 :: int) * (- numeral (x + Num.One) OR - numeral (y + Num.One))"
   "(1::int) OR numeral (Num.Bit0 y) = numeral (Num.Bit1 y)"
   "(1::int) OR numeral (Num.Bit1 y) = numeral (Num.Bit1 y)"
   "(1::int) OR - numeral (Num.Bit0 y) = - numeral (Num.BitM y)"
   "(1::int) OR - numeral (Num.Bit1 y) = - numeral (Num.Bit1 y)"
   "numeral (Num.Bit0 x) OR (1::int) = numeral (Num.Bit1 x)"
   "numeral (Num.Bit1 x) OR (1::int) = numeral (Num.Bit1 x)"
   "- numeral (Num.Bit0 x) OR (1::int) = - numeral (Num.BitM x)"
   "- numeral (Num.Bit1 x) OR (1::int) = - numeral (Num.Bit1 x)"
   by (auto simp add: bit_or_iff bit_minus_iff even_or_iff bit_double_iff even_bit_succ_iff add_One sub_inc_One_eq sub_BitM_One_eq intro: eqI)
 
 lemma int_xor_numerals [simp]:
   "numeral (Num.Bit0 x) XOR numeral (Num.Bit0 y) = (2 :: int) * (numeral x XOR numeral y)"
   "numeral (Num.Bit0 x) XOR numeral (Num.Bit1 y) = 1 + (2 :: int) * (numeral x XOR numeral y)"
   "numeral (Num.Bit1 x) XOR numeral (Num.Bit0 y) = 1 + (2 :: int) * (numeral x XOR numeral y)"
   "numeral (Num.Bit1 x) XOR numeral (Num.Bit1 y) = (2 :: int) * (numeral x XOR numeral y)"
   "numeral (Num.Bit0 x) XOR - numeral (Num.Bit0 y) = (2 :: int) * (numeral x XOR - numeral y)"
   "numeral (Num.Bit0 x) XOR - numeral (Num.Bit1 y) = 1 + (2 :: int) * (numeral x XOR - numeral (y + Num.One))"
   "numeral (Num.Bit1 x) XOR - numeral (Num.Bit0 y) = 1 + (2 :: int) * (numeral x XOR - numeral y)"
   "numeral (Num.Bit1 x) XOR - numeral (Num.Bit1 y) = (2 :: int) * (numeral x XOR - numeral (y + Num.One))"
   "- numeral (Num.Bit0 x) XOR numeral (Num.Bit0 y) = (2 :: int) * (- numeral x XOR numeral y)"
   "- numeral (Num.Bit0 x) XOR numeral (Num.Bit1 y) = 1 + (2 :: int) * (- numeral x XOR numeral y)"
   "- numeral (Num.Bit1 x) XOR numeral (Num.Bit0 y) = 1 + (2 :: int) * (- numeral (x + Num.One) XOR numeral y)"
   "- numeral (Num.Bit1 x) XOR numeral (Num.Bit1 y) = (2 :: int) * (- numeral (x + Num.One) XOR numeral y)"
   "- numeral (Num.Bit0 x) XOR - numeral (Num.Bit0 y) = (2 :: int) * (- numeral x XOR - numeral y)"
   "- numeral (Num.Bit0 x) XOR - numeral (Num.Bit1 y) = 1 + (2 :: int) * (- numeral x XOR - numeral (y + Num.One))"
   "- numeral (Num.Bit1 x) XOR - numeral (Num.Bit0 y) = 1 + (2 :: int) * (- numeral (x + Num.One) XOR - numeral y)"
   "- numeral (Num.Bit1 x) XOR - numeral (Num.Bit1 y) = (2 :: int) * (- numeral (x + Num.One) XOR - numeral (y + Num.One))"
   "(1::int) XOR numeral (Num.Bit0 y) = numeral (Num.Bit1 y)"
   "(1::int) XOR numeral (Num.Bit1 y) = numeral (Num.Bit0 y)"
   "(1::int) XOR - numeral (Num.Bit0 y) = - numeral (Num.BitM y)"
   "(1::int) XOR - numeral (Num.Bit1 y) = - numeral (Num.Bit0 (y + Num.One))"
   "numeral (Num.Bit0 x) XOR (1::int) = numeral (Num.Bit1 x)"
   "numeral (Num.Bit1 x) XOR (1::int) = numeral (Num.Bit0 x)"
   "- numeral (Num.Bit0 x) XOR (1::int) = - numeral (Num.BitM x)"
   "- numeral (Num.Bit1 x) XOR (1::int) = - numeral (Num.Bit0 (x + Num.One))"
   by (auto simp add: bit_xor_iff bit_minus_iff even_xor_iff bit_double_iff even_bit_succ_iff add_One sub_inc_One_eq sub_BitM_One_eq intro: eqI)
 
 end
 
 
 subsection \<open>Bit concatenation\<close>
 
 definition concat_bit :: \<open>nat \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int\<close>
   where \<open>concat_bit n k l = take_bit n k OR push_bit n l\<close>
 
 lemma bit_concat_bit_iff [bit_simps]:
   \<open>bit (concat_bit m k l) n \<longleftrightarrow> n < m \<and> bit k n \<or> m \<le> n \<and> bit l (n - m)\<close>
   by (simp add: concat_bit_def bit_or_iff bit_and_iff bit_take_bit_iff bit_push_bit_iff ac_simps)
 
 lemma concat_bit_eq:
   \<open>concat_bit n k l = take_bit n k + push_bit n l\<close>
   by (simp add: concat_bit_def take_bit_eq_mask
     bit_and_iff bit_mask_iff bit_push_bit_iff disjunctive_add)
 
 lemma concat_bit_0 [simp]:
   \<open>concat_bit 0 k l = l\<close>
   by (simp add: concat_bit_def)
 
 lemma concat_bit_Suc:
   \<open>concat_bit (Suc n) k l = k mod 2 + 2 * concat_bit n (k div 2) l\<close>
   by (simp add: concat_bit_eq take_bit_Suc push_bit_double)
 
 lemma concat_bit_of_zero_1 [simp]:
   \<open>concat_bit n 0 l = push_bit n l\<close>
   by (simp add: concat_bit_def)
 
 lemma concat_bit_of_zero_2 [simp]:
   \<open>concat_bit n k 0 = take_bit n k\<close>
   by (simp add: concat_bit_def take_bit_eq_mask)
 
 lemma concat_bit_nonnegative_iff [simp]:
   \<open>concat_bit n k l \<ge> 0 \<longleftrightarrow> l \<ge> 0\<close>
   by (simp add: concat_bit_def)
 
 lemma concat_bit_negative_iff [simp]:
   \<open>concat_bit n k l < 0 \<longleftrightarrow> l < 0\<close>
   by (simp add: concat_bit_def)
 
 lemma concat_bit_assoc:
   \<open>concat_bit n k (concat_bit m l r) = concat_bit (m + n) (concat_bit n k l) r\<close>
   by (rule bit_eqI) (auto simp add: bit_concat_bit_iff ac_simps)
 
 lemma concat_bit_assoc_sym:
   \<open>concat_bit m (concat_bit n k l) r = concat_bit (min m n) k (concat_bit (m - n) l r)\<close>
   by (rule bit_eqI) (auto simp add: bit_concat_bit_iff ac_simps min_def)
 
 lemma concat_bit_eq_iff:
   \<open>concat_bit n k l = concat_bit n r s
     \<longleftrightarrow> take_bit n k = take_bit n r \<and> l = s\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof
   assume ?Q
   then show ?P
     by (simp add: concat_bit_def)
 next
   assume ?P
   then have *: \<open>bit (concat_bit n k l) m = bit (concat_bit n r s) m\<close> for m
     by (simp add: bit_eq_iff)
   have \<open>take_bit n k = take_bit n r\<close>
   proof (rule bit_eqI)
     fix m
     from * [of m]
     show \<open>bit (take_bit n k) m \<longleftrightarrow> bit (take_bit n r) m\<close>
       by (auto simp add: bit_take_bit_iff bit_concat_bit_iff)
   qed
   moreover have \<open>push_bit n l = push_bit n s\<close>
   proof (rule bit_eqI)
     fix m
     from * [of m]
     show \<open>bit (push_bit n l) m \<longleftrightarrow> bit (push_bit n s) m\<close>
       by (auto simp add: bit_push_bit_iff bit_concat_bit_iff)
   qed
   then have \<open>l = s\<close>
     by (simp add: push_bit_eq_mult)
   ultimately show ?Q
     by (simp add: concat_bit_def)
 qed
 
 lemma take_bit_concat_bit_eq:
   \<open>take_bit m (concat_bit n k l) = concat_bit (min m n) k (take_bit (m - n) l)\<close>
   by (rule bit_eqI)
     (auto simp add: bit_take_bit_iff bit_concat_bit_iff min_def)  
 
 lemma concat_bit_take_bit_eq:
   \<open>concat_bit n (take_bit n b) = concat_bit n b\<close>
   by (simp add: concat_bit_def [abs_def])
 
 
 subsection \<open>Taking bits with sign propagation\<close>
 
 context ring_bit_operations
 begin
 
 definition signed_take_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
   where \<open>signed_take_bit n a = take_bit n a OR (of_bool (bit a n) * NOT (mask n))\<close>
 
 lemma signed_take_bit_eq_if_positive:
   \<open>signed_take_bit n a = take_bit n a\<close> if \<open>\<not> bit a n\<close>
   using that by (simp add: signed_take_bit_def)
 
 lemma signed_take_bit_eq_if_negative:
   \<open>signed_take_bit n a = take_bit n a OR NOT (mask n)\<close> if \<open>bit a n\<close>
   using that by (simp add: signed_take_bit_def)
 
 lemma even_signed_take_bit_iff:
   \<open>even (signed_take_bit m a) \<longleftrightarrow> even a\<close>
   by (auto simp add: signed_take_bit_def even_or_iff even_mask_iff bit_double_iff)
 
 lemma bit_signed_take_bit_iff [bit_simps]:
   \<open>bit (signed_take_bit m a) n \<longleftrightarrow> 2 ^ n \<noteq> 0 \<and> bit a (min m n)\<close>
   by (simp add: signed_take_bit_def bit_take_bit_iff bit_or_iff bit_not_iff bit_mask_iff min_def not_le)
     (use exp_eq_0_imp_not_bit in blast)
 
 lemma signed_take_bit_0 [simp]:
   \<open>signed_take_bit 0 a = - (a mod 2)\<close>
   by (simp add: signed_take_bit_def odd_iff_mod_2_eq_one)
 
 lemma signed_take_bit_Suc:
   \<open>signed_take_bit (Suc n) a = a mod 2 + 2 * signed_take_bit n (a div 2)\<close>
 proof (rule bit_eqI)
   fix m
   assume *: \<open>2 ^ m \<noteq> 0\<close>
   show \<open>bit (signed_take_bit (Suc n) a) m \<longleftrightarrow>
     bit (a mod 2 + 2 * signed_take_bit n (a div 2)) m\<close>
   proof (cases m)
     case 0
     then show ?thesis
       by (simp add: even_signed_take_bit_iff)
   next
     case (Suc m)
     with * have \<open>2 ^ m \<noteq> 0\<close>
       by (metis mult_not_zero power_Suc)
     with Suc show ?thesis
       by (simp add: bit_signed_take_bit_iff mod2_eq_if bit_double_iff even_bit_succ_iff
         ac_simps flip: bit_Suc)
   qed
 qed
 
 lemma signed_take_bit_of_0 [simp]:
   \<open>signed_take_bit n 0 = 0\<close>
   by (simp add: signed_take_bit_def)
 
 lemma signed_take_bit_of_minus_1 [simp]:
   \<open>signed_take_bit n (- 1) = - 1\<close>
   by (simp add: signed_take_bit_def take_bit_minus_one_eq_mask mask_eq_exp_minus_1)
 
 lemma signed_take_bit_Suc_1 [simp]:
   \<open>signed_take_bit (Suc n) 1 = 1\<close>
   by (simp add: signed_take_bit_Suc)
 
 lemma signed_take_bit_rec:
   \<open>signed_take_bit n a = (if n = 0 then - (a mod 2) else a mod 2 + 2 * signed_take_bit (n - 1) (a div 2))\<close>
   by (cases n) (simp_all add: signed_take_bit_Suc)
 
 lemma signed_take_bit_eq_iff_take_bit_eq:
   \<open>signed_take_bit n a = signed_take_bit n b \<longleftrightarrow> take_bit (Suc n) a = take_bit (Suc n) b\<close>
 proof -
   have \<open>bit (signed_take_bit n a) = bit (signed_take_bit n b) \<longleftrightarrow> bit (take_bit (Suc n) a) = bit (take_bit (Suc n) b)\<close>
     by (simp add: fun_eq_iff bit_signed_take_bit_iff bit_take_bit_iff not_le less_Suc_eq_le min_def)
       (use exp_eq_0_imp_not_bit in fastforce)
   then show ?thesis
     by (simp add: bit_eq_iff fun_eq_iff)
 qed
 
 lemma signed_take_bit_signed_take_bit [simp]:
   \<open>signed_take_bit m (signed_take_bit n a) = signed_take_bit (min m n) a\<close>
 proof (rule bit_eqI)
   fix q
   show \<open>bit (signed_take_bit m (signed_take_bit n a)) q \<longleftrightarrow>
     bit (signed_take_bit (min m n) a) q\<close>
     by (simp add: bit_signed_take_bit_iff min_def bit_or_iff bit_not_iff bit_mask_iff bit_take_bit_iff)
       (use le_Suc_ex exp_add_not_zero_imp in blast)
 qed
 
 lemma signed_take_bit_take_bit:
   \<open>signed_take_bit m (take_bit n a) = (if n \<le> m then take_bit n else signed_take_bit m) a\<close>
   by (rule bit_eqI) (auto simp add: bit_signed_take_bit_iff min_def bit_take_bit_iff)
 
 lemma take_bit_signed_take_bit:
   \<open>take_bit m (signed_take_bit n a) = take_bit m a\<close> if \<open>m \<le> Suc n\<close>
   using that by (rule le_SucE; intro bit_eqI)
    (auto simp add: bit_take_bit_iff bit_signed_take_bit_iff min_def less_Suc_eq)
 
 end
 
 text \<open>Modulus centered around 0\<close>
 
 lemma signed_take_bit_eq_concat_bit:
   \<open>signed_take_bit n k = concat_bit n k (- of_bool (bit k n))\<close>
   by (simp add: concat_bit_def signed_take_bit_def push_bit_minus_one_eq_not_mask)
 
 lemma signed_take_bit_add:
   \<open>signed_take_bit n (signed_take_bit n k + signed_take_bit n l) = signed_take_bit n (k + l)\<close>
   for k l :: int
 proof -
   have \<open>take_bit (Suc n)
      (take_bit (Suc n) (signed_take_bit n k) +
       take_bit (Suc n) (signed_take_bit n l)) =
     take_bit (Suc n) (k + l)\<close>
     by (simp add: take_bit_signed_take_bit take_bit_add)
   then show ?thesis
     by (simp only: signed_take_bit_eq_iff_take_bit_eq take_bit_add)
 qed
 
 lemma signed_take_bit_diff:
   \<open>signed_take_bit n (signed_take_bit n k - signed_take_bit n l) = signed_take_bit n (k - l)\<close>
   for k l :: int
 proof -
   have \<open>take_bit (Suc n)
      (take_bit (Suc n) (signed_take_bit n k) -
       take_bit (Suc n) (signed_take_bit n l)) =
     take_bit (Suc n) (k - l)\<close>
     by (simp add: take_bit_signed_take_bit take_bit_diff)
   then show ?thesis
     by (simp only: signed_take_bit_eq_iff_take_bit_eq take_bit_diff)
 qed
 
 lemma signed_take_bit_minus:
   \<open>signed_take_bit n (- signed_take_bit n k) = signed_take_bit n (- k)\<close>
   for k :: int
 proof -
   have \<open>take_bit (Suc n)
      (- take_bit (Suc n) (signed_take_bit n k)) =
     take_bit (Suc n) (- k)\<close>
     by (simp add: take_bit_signed_take_bit take_bit_minus)
   then show ?thesis
     by (simp only: signed_take_bit_eq_iff_take_bit_eq take_bit_minus)
 qed
 
 lemma signed_take_bit_mult:
   \<open>signed_take_bit n (signed_take_bit n k * signed_take_bit n l) = signed_take_bit n (k * l)\<close>
   for k l :: int
 proof -
   have \<open>take_bit (Suc n)
      (take_bit (Suc n) (signed_take_bit n k) *
       take_bit (Suc n) (signed_take_bit n l)) =
     take_bit (Suc n) (k * l)\<close>
     by (simp add: take_bit_signed_take_bit take_bit_mult)
   then show ?thesis
     by (simp only: signed_take_bit_eq_iff_take_bit_eq take_bit_mult)
 qed
 
 lemma signed_take_bit_eq_take_bit_minus:
   \<open>signed_take_bit n k = take_bit (Suc n) k - 2 ^ Suc n * of_bool (bit k n)\<close>
   for k :: int
 proof (cases \<open>bit k n\<close>)
   case True
   have \<open>signed_take_bit n k = take_bit (Suc n) k OR NOT (mask (Suc n))\<close>
     by (rule bit_eqI) (auto simp add: bit_signed_take_bit_iff min_def bit_take_bit_iff bit_or_iff bit_not_iff bit_mask_iff less_Suc_eq True)
   then have \<open>signed_take_bit n k = take_bit (Suc n) k + NOT (mask (Suc n))\<close>
     by (simp add: disjunctive_add bit_take_bit_iff bit_not_iff bit_mask_iff)
   with True show ?thesis
     by (simp flip: minus_exp_eq_not_mask)
 next
   case False
   show ?thesis
     by (rule bit_eqI) (simp add: False bit_signed_take_bit_iff bit_take_bit_iff min_def less_Suc_eq)
 qed
 
 lemma signed_take_bit_eq_take_bit_shift:
   \<open>signed_take_bit n k = take_bit (Suc n) (k + 2 ^ n) - 2 ^ n\<close>
   for k :: int
 proof -
   have *: \<open>take_bit n k OR 2 ^ n = take_bit n k + 2 ^ n\<close>
     by (simp add: disjunctive_add bit_exp_iff bit_take_bit_iff)
   have \<open>take_bit n k - 2 ^ n = take_bit n k + NOT (mask n)\<close>
     by (simp add: minus_exp_eq_not_mask)
   also have \<open>\<dots> = take_bit n k OR NOT (mask n)\<close>
     by (rule disjunctive_add)
       (simp add: bit_exp_iff bit_take_bit_iff bit_not_iff bit_mask_iff)
   finally have **: \<open>take_bit n k - 2 ^ n = take_bit n k OR NOT (mask n)\<close> .
   have \<open>take_bit (Suc n) (k + 2 ^ n) = take_bit (Suc n) (take_bit (Suc n) k + take_bit (Suc n) (2 ^ n))\<close>
     by (simp only: take_bit_add)
   also have \<open>take_bit (Suc n) k = 2 ^ n * of_bool (bit k n) + take_bit n k\<close>
     by (simp add: take_bit_Suc_from_most)
   finally have \<open>take_bit (Suc n) (k + 2 ^ n) = take_bit (Suc n) (2 ^ (n + of_bool (bit k n)) + take_bit n k)\<close>
     by (simp add: ac_simps)
   also have \<open>2 ^ (n + of_bool (bit k n)) + take_bit n k = 2 ^ (n + of_bool (bit k n)) OR take_bit n k\<close>
     by (rule disjunctive_add)
       (auto simp add: disjunctive_add bit_take_bit_iff bit_double_iff bit_exp_iff)
   finally show ?thesis
     using * ** by (simp add: signed_take_bit_def concat_bit_Suc min_def ac_simps)
 qed
 
 lemma signed_take_bit_nonnegative_iff [simp]:
   \<open>0 \<le> signed_take_bit n k \<longleftrightarrow> \<not> bit k n\<close>
   for k :: int
   by (simp add: signed_take_bit_def not_less concat_bit_def)
 
 lemma signed_take_bit_negative_iff [simp]:
   \<open>signed_take_bit n k < 0 \<longleftrightarrow> bit k n\<close>
   for k :: int
   by (simp add: signed_take_bit_def not_less concat_bit_def)
 
 lemma signed_take_bit_int_eq_self_iff:
   \<open>signed_take_bit n k = k \<longleftrightarrow> - (2 ^ n) \<le> k \<and> k < 2 ^ n\<close>
   for k :: int
   by (auto simp add: signed_take_bit_eq_take_bit_shift take_bit_int_eq_self_iff algebra_simps)
 
 lemma signed_take_bit_int_eq_self:
   \<open>signed_take_bit n k = k\<close> if \<open>- (2 ^ n) \<le> k\<close> \<open>k < 2 ^ n\<close>
   for k :: int
   using that by (simp add: signed_take_bit_int_eq_self_iff)
 
 lemma signed_take_bit_int_less_eq_self_iff:
   \<open>signed_take_bit n k \<le> k \<longleftrightarrow> - (2 ^ n) \<le> k\<close>
   for k :: int
   by (simp add: signed_take_bit_eq_take_bit_shift take_bit_int_less_eq_self_iff algebra_simps)
     linarith
 
 lemma signed_take_bit_int_less_self_iff:
   \<open>signed_take_bit n k < k \<longleftrightarrow> 2 ^ n \<le> k\<close>
   for k :: int
   by (simp add: signed_take_bit_eq_take_bit_shift take_bit_int_less_self_iff algebra_simps)
 
 lemma signed_take_bit_int_greater_self_iff:
   \<open>k < signed_take_bit n k \<longleftrightarrow> k < - (2 ^ n)\<close>
   for k :: int
   by (simp add: signed_take_bit_eq_take_bit_shift take_bit_int_greater_self_iff algebra_simps)
     linarith
 
 lemma signed_take_bit_int_greater_eq_self_iff:
   \<open>k \<le> signed_take_bit n k \<longleftrightarrow> k < 2 ^ n\<close>
   for k :: int
   by (simp add: signed_take_bit_eq_take_bit_shift take_bit_int_greater_eq_self_iff algebra_simps)
 
 lemma signed_take_bit_int_greater_eq:
   \<open>k + 2 ^ Suc n \<le> signed_take_bit n k\<close> if \<open>k < - (2 ^ n)\<close>
   for k :: int
   using that take_bit_int_greater_eq [of \<open>k + 2 ^ n\<close> \<open>Suc n\<close>]
   by (simp add: signed_take_bit_eq_take_bit_shift)
 
 lemma signed_take_bit_int_less_eq:
   \<open>signed_take_bit n k \<le> k - 2 ^ Suc n\<close> if \<open>k \<ge> 2 ^ n\<close>
   for k :: int
   using that take_bit_int_less_eq [of \<open>Suc n\<close> \<open>k + 2 ^ n\<close>]
   by (simp add: signed_take_bit_eq_take_bit_shift)
 
 lemma signed_take_bit_Suc_bit0 [simp]:
   \<open>signed_take_bit (Suc n) (numeral (Num.Bit0 k)) = signed_take_bit n (numeral k) * (2 :: int)\<close>
   by (simp add: signed_take_bit_Suc)
 
 lemma signed_take_bit_Suc_bit1 [simp]:
   \<open>signed_take_bit (Suc n) (numeral (Num.Bit1 k)) = signed_take_bit n (numeral k) * 2 + (1 :: int)\<close>
   by (simp add: signed_take_bit_Suc)
 
 lemma signed_take_bit_Suc_minus_bit0 [simp]:
   \<open>signed_take_bit (Suc n) (- numeral (Num.Bit0 k)) = signed_take_bit n (- numeral k) * (2 :: int)\<close>
   by (simp add: signed_take_bit_Suc)
 
 lemma signed_take_bit_Suc_minus_bit1 [simp]:
   \<open>signed_take_bit (Suc n) (- numeral (Num.Bit1 k)) = signed_take_bit n (- numeral k - 1) * 2 + (1 :: int)\<close>
   by (simp add: signed_take_bit_Suc)
 
 lemma signed_take_bit_numeral_bit0 [simp]:
   \<open>signed_take_bit (numeral l) (numeral (Num.Bit0 k)) = signed_take_bit (pred_numeral l) (numeral k) * (2 :: int)\<close>
   by (simp add: signed_take_bit_rec)
 
 lemma signed_take_bit_numeral_bit1 [simp]:
   \<open>signed_take_bit (numeral l) (numeral (Num.Bit1 k)) = signed_take_bit (pred_numeral l) (numeral k) * 2 + (1 :: int)\<close>
   by (simp add: signed_take_bit_rec)
 
 lemma signed_take_bit_numeral_minus_bit0 [simp]:
   \<open>signed_take_bit (numeral l) (- numeral (Num.Bit0 k)) = signed_take_bit (pred_numeral l) (- numeral k) * (2 :: int)\<close>
   by (simp add: signed_take_bit_rec)
 
 lemma signed_take_bit_numeral_minus_bit1 [simp]:
   \<open>signed_take_bit (numeral l) (- numeral (Num.Bit1 k)) = signed_take_bit (pred_numeral l) (- numeral k - 1) * 2 + (1 :: int)\<close>
   by (simp add: signed_take_bit_rec)
 
 lemma signed_take_bit_code [code]:
   \<open>signed_take_bit n a =
   (let l = take_bit (Suc n) a
    in if bit l n then l + push_bit (Suc n) (- 1) else l)\<close>
 proof -
   have *: \<open>take_bit (Suc n) a + push_bit n (- 2) =
     take_bit (Suc n) a OR NOT (mask (Suc n))\<close>
     by (auto simp add: bit_take_bit_iff bit_push_bit_iff bit_not_iff bit_mask_iff disjunctive_add
        simp flip: push_bit_minus_one_eq_not_mask)
   show ?thesis
     by (rule bit_eqI)
       (auto simp add: Let_def * bit_signed_take_bit_iff bit_take_bit_iff min_def less_Suc_eq bit_not_iff bit_mask_iff bit_or_iff)
 qed
 
 lemma not_minus_numeral_inc_eq:
   \<open>NOT (- numeral (Num.inc n)) = (numeral n :: int)\<close>
   by (simp add: not_int_def sub_inc_One_eq)
 
 
 subsection \<open>Instance \<^typ>\<open>nat\<close>\<close>
 
 instantiation nat :: semiring_bit_operations
 begin
 
 definition and_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
   where \<open>m AND n = nat (int m AND int n)\<close> for m n :: nat
 
 definition or_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
   where \<open>m OR n = nat (int m OR int n)\<close> for m n :: nat
 
 definition xor_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
   where \<open>m XOR n = nat (int m XOR int n)\<close> for m n :: nat
 
 definition mask_nat :: \<open>nat \<Rightarrow> nat\<close>
   where \<open>mask n = (2 :: nat) ^ n - 1\<close>
 
 instance proof
   fix m n q :: nat
   show \<open>bit (m AND n) q \<longleftrightarrow> bit m q \<and> bit n q\<close>
     by (simp add: and_nat_def bit_simps)
   show \<open>bit (m OR n) q \<longleftrightarrow> bit m q \<or> bit n q\<close>
     by (simp add: or_nat_def bit_simps)
   show \<open>bit (m XOR n) q \<longleftrightarrow> bit m q \<noteq> bit n q\<close>
     by (simp add: xor_nat_def bit_simps)
 qed (simp add: mask_nat_def)
 
 end
 
 lemma and_nat_rec:
   \<open>m AND n = of_bool (odd m \<and> odd n) + 2 * ((m div 2) AND (n div 2))\<close> for m n :: nat
   by (simp add: and_nat_def and_int_rec [of \<open>int m\<close> \<open>int n\<close>] zdiv_int nat_add_distrib nat_mult_distrib)
 
 lemma or_nat_rec:
   \<open>m OR n = of_bool (odd m \<or> odd n) + 2 * ((m div 2) OR (n div 2))\<close> for m n :: nat
   by (simp add: or_nat_def or_int_rec [of \<open>int m\<close> \<open>int n\<close>] zdiv_int nat_add_distrib nat_mult_distrib)
 
 lemma xor_nat_rec:
   \<open>m XOR n = of_bool (odd m \<noteq> odd n) + 2 * ((m div 2) XOR (n div 2))\<close> for m n :: nat
   by (simp add: xor_nat_def xor_int_rec [of \<open>int m\<close> \<open>int n\<close>] zdiv_int nat_add_distrib nat_mult_distrib)
 
 lemma Suc_0_and_eq [simp]:
   \<open>Suc 0 AND n = n mod 2\<close>
   using one_and_eq [of n] by simp
 
 lemma and_Suc_0_eq [simp]:
   \<open>n AND Suc 0 = n mod 2\<close>
   using and_one_eq [of n] by simp
 
 lemma Suc_0_or_eq:
   \<open>Suc 0 OR n = n + of_bool (even n)\<close>
   using one_or_eq [of n] by simp
 
 lemma or_Suc_0_eq:
   \<open>n OR Suc 0 = n + of_bool (even n)\<close>
   using or_one_eq [of n] by simp
 
 lemma Suc_0_xor_eq:
   \<open>Suc 0 XOR n = n + of_bool (even n) - of_bool (odd n)\<close>
   using one_xor_eq [of n] by simp
 
 lemma xor_Suc_0_eq:
   \<open>n XOR Suc 0 = n + of_bool (even n) - of_bool (odd n)\<close>
   using xor_one_eq [of n] by simp
 
 context semiring_bit_operations
 begin
 
 lemma of_nat_and_eq:
   \<open>of_nat (m AND n) = of_nat m AND of_nat n\<close>
   by (rule bit_eqI) (simp add: bit_of_nat_iff bit_and_iff Bit_Operations.bit_and_iff)
 
 lemma of_nat_or_eq:
   \<open>of_nat (m OR n) = of_nat m OR of_nat n\<close>
   by (rule bit_eqI) (simp add: bit_of_nat_iff bit_or_iff Bit_Operations.bit_or_iff)
 
 lemma of_nat_xor_eq:
   \<open>of_nat (m XOR n) = of_nat m XOR of_nat n\<close>
   by (rule bit_eqI) (simp add: bit_of_nat_iff bit_xor_iff Bit_Operations.bit_xor_iff)
 
 end
 
 context ring_bit_operations
 begin
 
 lemma of_nat_mask_eq:
   \<open>of_nat (mask n) = mask n\<close>
   by (induction n) (simp_all add: mask_Suc_double Bit_Operations.mask_Suc_double of_nat_or_eq)
 
 end
 
 lemma Suc_mask_eq_exp:
   \<open>Suc (mask n) = 2 ^ n\<close>
   by (simp add: mask_eq_exp_minus_1)
 
 lemma less_eq_mask:
   \<open>n \<le> mask n\<close>
   by (simp add: mask_eq_exp_minus_1 le_diff_conv2)
     (metis Suc_mask_eq_exp diff_Suc_1 diff_le_diff_pow diff_zero le_refl not_less_eq_eq power_0)
 
 lemma less_mask:
   \<open>n < mask n\<close> if \<open>Suc 0 < n\<close>
 proof -
   define m where \<open>m = n - 2\<close>
   with that have *: \<open>n = m + 2\<close>
     by simp
   have \<open>Suc (Suc (Suc m)) < 4 * 2 ^ m\<close>
     by (induction m) simp_all
   then have \<open>Suc (m + 2) < Suc (mask (m + 2))\<close>
     by (simp add: Suc_mask_eq_exp)
   then have \<open>m + 2 < mask (m + 2)\<close>
     by (simp add: less_le)
   with * show ?thesis
     by simp
 qed
 
 
 subsection \<open>Instances for \<^typ>\<open>integer\<close> and \<^typ>\<open>natural\<close>\<close>
 
 unbundle integer.lifting natural.lifting
 
 instantiation integer :: ring_bit_operations
 begin
 
 lift_definition not_integer :: \<open>integer \<Rightarrow> integer\<close>
   is not .
 
 lift_definition and_integer :: \<open>integer \<Rightarrow> integer \<Rightarrow> integer\<close>
   is \<open>and\<close> .
 
 lift_definition or_integer :: \<open>integer \<Rightarrow> integer \<Rightarrow> integer\<close>
   is or .
 
 lift_definition xor_integer ::  \<open>integer \<Rightarrow> integer \<Rightarrow> integer\<close>
   is xor .
 
 lift_definition mask_integer :: \<open>nat \<Rightarrow> integer\<close>
   is mask .
 
 instance by (standard; transfer)
   (simp_all add: minus_eq_not_minus_1 mask_eq_exp_minus_1
     bit_not_iff bit_and_iff bit_or_iff bit_xor_iff)
 
 end
 
 lemma [code]:
   \<open>mask n = 2 ^ n - (1::integer)\<close>
   by (simp add: mask_eq_exp_minus_1)
 
 instantiation natural :: semiring_bit_operations
 begin
 
 lift_definition and_natural :: \<open>natural \<Rightarrow> natural \<Rightarrow> natural\<close>
   is \<open>and\<close> .
 
 lift_definition or_natural :: \<open>natural \<Rightarrow> natural \<Rightarrow> natural\<close>
   is or .
 
 lift_definition xor_natural ::  \<open>natural \<Rightarrow> natural \<Rightarrow> natural\<close>
   is xor .
 
 lift_definition mask_natural :: \<open>nat \<Rightarrow> natural\<close>
   is mask .
 
 instance by (standard; transfer)
   (simp_all add: mask_eq_exp_minus_1 bit_and_iff bit_or_iff bit_xor_iff)
 
 end
 
 lemma [code]:
   \<open>integer_of_natural (mask n) = mask n\<close>
   by transfer (simp add: mask_eq_exp_minus_1 of_nat_diff)
 
 lifting_update integer.lifting
 lifting_forget integer.lifting
 
 lifting_update natural.lifting
 lifting_forget natural.lifting
 
 
 subsection \<open>Key ideas of bit operations\<close>
 
 text \<open>
   When formalizing bit operations, it is tempting to represent
   bit values as explicit lists over a binary type. This however
   is a bad idea, mainly due to the inherent ambiguities in
   representation concerning repeating leading bits.
 
   Hence this approach avoids such explicit lists altogether
   following an algebraic path:
 
   \<^item> Bit values are represented by numeric types: idealized
     unbounded bit values can be represented by type \<^typ>\<open>int\<close>,
     bounded bit values by quotient types over \<^typ>\<open>int\<close>.
 
   \<^item> (A special case are idealized unbounded bit values ending
     in @{term [source] 0} which can be represented by type \<^typ>\<open>nat\<close> but
     only support a restricted set of operations).
 
   \<^item> From this idea follows that
 
       \<^item> multiplication by \<^term>\<open>2 :: int\<close> is a bit shift to the left and
 
       \<^item> division by \<^term>\<open>2 :: int\<close> is a bit shift to the right.
 
   \<^item> Concerning bounded bit values, iterated shifts to the left
     may result in eliminating all bits by shifting them all
     beyond the boundary.  The property \<^prop>\<open>(2 :: int) ^ n \<noteq> 0\<close>
     represents that \<^term>\<open>n\<close> is \<^emph>\<open>not\<close> beyond that boundary.
 
   \<^item> The projection on a single bit is then @{thm bit_iff_odd [where ?'a = int, no_vars]}.
 
   \<^item> This leads to the most fundamental properties of bit values:
 
       \<^item> Equality rule: @{thm bit_eqI [where ?'a = int, no_vars]}
 
       \<^item> Induction rule: @{thm bits_induct [where ?'a = int, no_vars]}
 
   \<^item> Typical operations are characterized as follows:
 
       \<^item> Singleton \<^term>\<open>n\<close>th bit: \<^term>\<open>(2 :: int) ^ n\<close>
 
       \<^item> Bit mask upto bit \<^term>\<open>n\<close>: @{thm mask_eq_exp_minus_1 [where ?'a = int, no_vars]}
 
       \<^item> Left shift: @{thm push_bit_eq_mult [where ?'a = int, no_vars]}
 
       \<^item> Right shift: @{thm drop_bit_eq_div [where ?'a = int, no_vars]}
 
       \<^item> Truncation: @{thm take_bit_eq_mod [where ?'a = int, no_vars]}
 
       \<^item> Negation: @{thm bit_not_iff [where ?'a = int, no_vars]}
 
       \<^item> And: @{thm bit_and_iff [where ?'a = int, no_vars]}
 
       \<^item> Or: @{thm bit_or_iff [where ?'a = int, no_vars]}
 
       \<^item> Xor: @{thm bit_xor_iff [where ?'a = int, no_vars]}
 
       \<^item> Set a single bit: @{thm set_bit_def [where ?'a = int, no_vars]}
 
       \<^item> Unset a single bit: @{thm unset_bit_def [where ?'a = int, no_vars]}
 
       \<^item> Flip a single bit: @{thm flip_bit_def [where ?'a = int, no_vars]}
 
       \<^item> Signed truncation, or modulus centered around \<^term>\<open>0::int\<close>: @{thm signed_take_bit_def [no_vars]}
 
       \<^item> Bit concatenation: @{thm concat_bit_def [no_vars]}
 
       \<^item> (Bounded) conversion from and to a list of bits: @{thm horner_sum_bit_eq_take_bit [where ?'a = int, no_vars]}
 \<close>
 
 code_identifier
   type_class semiring_bits \<rightharpoonup>
   (SML) Bit_Operations.semiring_bits and (OCaml) Bit_Operations.semiring_bits and (Haskell) Bit_Operations.semiring_bits and (Scala) Bit_Operations.semiring_bits
 | class_relation semiring_bits < semiring_parity \<rightharpoonup>
   (SML) Bit_Operations.semiring_parity_semiring_bits and (OCaml) Bit_Operations.semiring_parity_semiring_bits and (Haskell) Bit_Operations.semiring_parity_semiring_bits and (Scala) Bit_Operations.semiring_parity_semiring_bits
 | constant bit \<rightharpoonup>
   (SML) Bit_Operations.bit and (OCaml) Bit_Operations.bit and (Haskell) Bit_Operations.bit and (Scala) Bit_Operations.bit
 | class_instance nat :: semiring_bits \<rightharpoonup>
   (SML) Bit_Operations.semiring_bits_nat and (OCaml) Bit_Operations.semiring_bits_nat and (Haskell) Bit_Operations.semiring_bits_nat and (Scala) Bit_Operations.semiring_bits_nat
 | class_instance int :: semiring_bits \<rightharpoonup>
   (SML) Bit_Operations.semiring_bits_int and (OCaml) Bit_Operations.semiring_bits_int and (Haskell) Bit_Operations.semiring_bits_int and (Scala) Bit_Operations.semiring_bits_int
 | type_class semiring_bit_shifts \<rightharpoonup>
   (SML) Bit_Operations.semiring_bit_shifts and (OCaml) Bit_Operations.semiring_bit_shifts and (Haskell) Bit_Operations.semiring_bits and (Scala) Bit_Operations.semiring_bit_shifts
 | class_relation semiring_bit_shifts < semiring_bits \<rightharpoonup>
   (SML) Bit_Operations.semiring_bits_semiring_bit_shifts and (OCaml) Bit_Operations.semiring_bits_semiring_bit_shifts and (Haskell) Bit_Operations.semiring_bits_semiring_bit_shifts and (Scala) Bit_Operations.semiring_bits_semiring_bit_shifts
 | constant push_bit \<rightharpoonup>
   (SML) Bit_Operations.push_bit and (OCaml) Bit_Operations.push_bit and (Haskell) Bit_Operations.push_bit and (Scala) Bit_Operations.push_bit
 | constant drop_bit \<rightharpoonup>
   (SML) Bit_Operations.drop_bit and (OCaml) Bit_Operations.drop_bit and (Haskell) Bit_Operations.drop_bit and (Scala) Bit_Operations.drop_bit
 | constant take_bit \<rightharpoonup>
   (SML) Bit_Operations.take_bit and (OCaml) Bit_Operations.take_bit and (Haskell) Bit_Operations.take_bit and (Scala) Bit_Operations.take_bit
 | class_instance nat :: semiring_bit_shifts \<rightharpoonup>
   (SML) Bit_Operations.semiring_bit_shifts and (OCaml) Bit_Operations.semiring_bit_shifts and (Haskell) Bit_Operations.semiring_bit_shifts and (Scala) Bit_Operations.semiring_bit_shifts
 | class_instance int :: semiring_bit_shifts \<rightharpoonup>
   (SML) Bit_Operations.semiring_bit_shifts and (OCaml) Bit_Operations.semiring_bit_shifts and (Haskell) Bit_Operations.semiring_bit_shifts and (Scala) Bit_Operations.semiring_bit_shifts
 
 end
diff --git a/src/HOL/Library/Word.thy b/src/HOL/Library/Word.thy
--- a/src/HOL/Library/Word.thy
+++ b/src/HOL/Library/Word.thy
@@ -1,4368 +1,4368 @@
 (*  Title:      HOL/Library/Word.thy
     Author:     Jeremy Dawson and Gerwin Klein, NICTA, et. al.
 *)
 
 section \<open>A type of finite bit strings\<close>
 
 theory Word
 imports
   "HOL-Library.Type_Length"
   "HOL-Library.Boolean_Algebra"
   "HOL-Library.Bit_Operations"
 begin
 
 subsection \<open>Preliminaries\<close>
 
 lemma signed_take_bit_decr_length_iff:
   \<open>signed_take_bit (LENGTH('a::len) - Suc 0) k = signed_take_bit (LENGTH('a) - Suc 0) l
     \<longleftrightarrow> take_bit LENGTH('a) k = take_bit LENGTH('a) l\<close>
   by (cases \<open>LENGTH('a)\<close>)
     (simp_all add: signed_take_bit_eq_iff_take_bit_eq)
 
 
 subsection \<open>Fundamentals\<close>
 
 subsubsection \<open>Type definition\<close>
 
 quotient_type (overloaded) 'a word = int / \<open>\<lambda>k l. take_bit LENGTH('a) k = take_bit LENGTH('a::len) l\<close>
   morphisms rep Word by (auto intro!: equivpI reflpI sympI transpI)
 
 hide_const (open) rep \<comment> \<open>only for foundational purpose\<close>
 hide_const (open) Word \<comment> \<open>only for code generation\<close>
 
 
 subsubsection \<open>Basic arithmetic\<close>
 
 instantiation word :: (len) comm_ring_1
 begin
 
 lift_definition zero_word :: \<open>'a word\<close>
   is 0 .
 
 lift_definition one_word :: \<open>'a word\<close>
   is 1 .
 
 lift_definition plus_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
   is \<open>(+)\<close>
   by (auto simp add: take_bit_eq_mod intro: mod_add_cong)
 
 lift_definition minus_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
   is \<open>(-)\<close>
   by (auto simp add: take_bit_eq_mod intro: mod_diff_cong)
 
 lift_definition uminus_word :: \<open>'a word \<Rightarrow> 'a word\<close>
   is uminus
   by (auto simp add: take_bit_eq_mod intro: mod_minus_cong)
 
 lift_definition times_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
   is \<open>(*)\<close>
   by (auto simp add: take_bit_eq_mod intro: mod_mult_cong)
 
 instance
   by (standard; transfer) (simp_all add: algebra_simps)
 
 end
 
 context
   includes lifting_syntax
   notes
     power_transfer [transfer_rule]
     transfer_rule_of_bool [transfer_rule]
     transfer_rule_numeral [transfer_rule]
     transfer_rule_of_nat [transfer_rule]
     transfer_rule_of_int [transfer_rule]
 begin
 
 lemma power_transfer_word [transfer_rule]:
   \<open>(pcr_word ===> (=) ===> pcr_word) (^) (^)\<close>
   by transfer_prover
 
 lemma [transfer_rule]:
   \<open>((=) ===> pcr_word) of_bool of_bool\<close>
   by transfer_prover
 
 lemma [transfer_rule]:
   \<open>((=) ===> pcr_word) numeral numeral\<close>
   by transfer_prover
 
 lemma [transfer_rule]:
   \<open>((=) ===> pcr_word) int of_nat\<close>
   by transfer_prover
 
 lemma [transfer_rule]:
   \<open>((=) ===> pcr_word) (\<lambda>k. k) of_int\<close>
 proof -
   have \<open>((=) ===> pcr_word) of_int of_int\<close>
     by transfer_prover
   then show ?thesis by (simp add: id_def)
 qed
 
 lemma [transfer_rule]:
   \<open>(pcr_word ===> (\<longleftrightarrow>)) even ((dvd) 2 :: 'a::len word \<Rightarrow> bool)\<close>
 proof -
   have even_word_unfold: "even k \<longleftrightarrow> (\<exists>l. take_bit LENGTH('a) k = take_bit LENGTH('a) (2 * l))" (is "?P \<longleftrightarrow> ?Q")
     for k :: int
   proof
     assume ?P
     then show ?Q
       by auto
   next
     assume ?Q
     then obtain l where "take_bit LENGTH('a) k = take_bit LENGTH('a) (2 * l)" ..
     then have "even (take_bit LENGTH('a) k)"
       by simp
     then show ?P
       by simp
   qed
   show ?thesis by (simp only: even_word_unfold [abs_def] dvd_def [where ?'a = "'a word", abs_def])
     transfer_prover
 qed
 
 end
 
 lemma exp_eq_zero_iff [simp]:
   \<open>2 ^ n = (0 :: 'a::len word) \<longleftrightarrow> n \<ge> LENGTH('a)\<close>
-  by transfer simp
+  by transfer auto
 
 lemma word_exp_length_eq_0 [simp]:
   \<open>(2 :: 'a::len word) ^ LENGTH('a) = 0\<close>
   by simp
 
 
 subsubsection \<open>Basic tool setup\<close>
 
 ML_file \<open>Tools/word_lib.ML\<close>
 
 
 subsubsection \<open>Basic code generation setup\<close>
 
 context
 begin
 
 qualified lift_definition the_int :: \<open>'a::len word \<Rightarrow> int\<close>
   is \<open>take_bit LENGTH('a)\<close> .
 
 end
 
 lemma [code abstype]:
   \<open>Word.Word (Word.the_int w) = w\<close>
   by transfer simp
 
 lemma Word_eq_word_of_int [code_post, simp]:
   \<open>Word.Word = of_int\<close>
   by (rule; transfer) simp
 
 quickcheck_generator word
   constructors:
     \<open>0 :: 'a::len word\<close>,
     \<open>numeral :: num \<Rightarrow> 'a::len word\<close>
 
 instantiation word :: (len) equal
 begin
 
 lift_definition equal_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> bool\<close>
   is \<open>\<lambda>k l. take_bit LENGTH('a) k = take_bit LENGTH('a) l\<close>
   by simp
 
 instance
   by (standard; transfer) rule
 
 end
 
 lemma [code]:
   \<open>HOL.equal v w \<longleftrightarrow> HOL.equal (Word.the_int v) (Word.the_int w)\<close>
   by transfer (simp add: equal)
 
 lemma [code]:
   \<open>Word.the_int 0 = 0\<close>
   by transfer simp
 
 lemma [code]:
   \<open>Word.the_int 1 = 1\<close>
   by transfer simp
 
 lemma [code]:
   \<open>Word.the_int (v + w) = take_bit LENGTH('a) (Word.the_int v + Word.the_int w)\<close>
   for v w :: \<open>'a::len word\<close>
   by transfer (simp add: take_bit_add)
 
 lemma [code]:
   \<open>Word.the_int (- w) = (let k = Word.the_int w in if w = 0 then 0 else 2 ^ LENGTH('a) - k)\<close>
   for w :: \<open>'a::len word\<close>
   by transfer (auto simp add: take_bit_eq_mod zmod_zminus1_eq_if)
 
 lemma [code]:
   \<open>Word.the_int (v - w) = take_bit LENGTH('a) (Word.the_int v - Word.the_int w)\<close>
   for v w :: \<open>'a::len word\<close>
   by transfer (simp add: take_bit_diff)
 
 lemma [code]:
   \<open>Word.the_int (v * w) = take_bit LENGTH('a) (Word.the_int v * Word.the_int w)\<close>
   for v w :: \<open>'a::len word\<close>
   by transfer (simp add: take_bit_mult)
 
 
 subsubsection \<open>Basic conversions\<close>
 
 abbreviation word_of_nat :: \<open>nat \<Rightarrow> 'a::len word\<close>
   where \<open>word_of_nat \<equiv> of_nat\<close>
 
 abbreviation word_of_int :: \<open>int \<Rightarrow> 'a::len word\<close>
   where \<open>word_of_int \<equiv> of_int\<close>
 
 lemma word_of_nat_eq_iff:
   \<open>word_of_nat m = (word_of_nat n :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) m = take_bit LENGTH('a) n\<close>
   by transfer (simp add: take_bit_of_nat)
 
 lemma word_of_int_eq_iff:
   \<open>word_of_int k = (word_of_int l :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) k = take_bit LENGTH('a) l\<close>
   by transfer rule
 
 lemma word_of_nat_eq_0_iff [simp]:
   \<open>word_of_nat n = (0 :: 'a::len word) \<longleftrightarrow> 2 ^ LENGTH('a) dvd n\<close>
   using word_of_nat_eq_iff [where ?'a = 'a, of n 0] by (simp add: take_bit_eq_0_iff)
 
 lemma word_of_int_eq_0_iff [simp]:
   \<open>word_of_int k = (0 :: 'a::len word) \<longleftrightarrow> 2 ^ LENGTH('a) dvd k\<close>
   using word_of_int_eq_iff [where ?'a = 'a, of k 0] by (simp add: take_bit_eq_0_iff)
 
 context semiring_1
 begin
 
 lift_definition unsigned :: \<open>'b::len word \<Rightarrow> 'a\<close>
   is \<open>of_nat \<circ> nat \<circ> take_bit LENGTH('b)\<close>
   by simp
 
 lemma unsigned_0 [simp]:
   \<open>unsigned 0 = 0\<close>
   by transfer simp
 
 lemma unsigned_1 [simp]:
   \<open>unsigned 1 = 1\<close>
   by transfer simp
 
 lemma unsigned_numeral [simp]:
   \<open>unsigned (numeral n :: 'b::len word) = of_nat (take_bit LENGTH('b) (numeral n))\<close>
   by transfer (simp add: nat_take_bit_eq)
 
 lemma unsigned_neg_numeral [simp]:
   \<open>unsigned (- numeral n :: 'b::len word) = of_nat (nat (take_bit LENGTH('b) (- numeral n)))\<close>
   by transfer simp
 
 end
 
 context semiring_1
 begin
 
 lemma unsigned_of_nat [simp]:
   \<open>unsigned (word_of_nat n :: 'b::len word) = of_nat (take_bit LENGTH('b) n)\<close>
   by transfer (simp add: nat_eq_iff take_bit_of_nat)
 
 lemma unsigned_of_int [simp]:
   \<open>unsigned (word_of_int k :: 'b::len word) = of_nat (nat (take_bit LENGTH('b) k))\<close>
   by transfer simp
 
 end
 
 context semiring_char_0
 begin
 
 lemma unsigned_word_eqI:
   \<open>v = w\<close> if \<open>unsigned v = unsigned w\<close>
   using that by transfer (simp add: eq_nat_nat_iff)
 
 lemma word_eq_iff_unsigned:
   \<open>v = w \<longleftrightarrow> unsigned v = unsigned w\<close>
   by (auto intro: unsigned_word_eqI)
 
 lemma inj_unsigned [simp]:
   \<open>inj unsigned\<close>
   by (rule injI) (simp add: unsigned_word_eqI)
 
 lemma unsigned_eq_0_iff:
   \<open>unsigned w = 0 \<longleftrightarrow> w = 0\<close>
   using word_eq_iff_unsigned [of w 0] by simp
 
 end
 
 context ring_1
 begin
 
 lift_definition signed :: \<open>'b::len word \<Rightarrow> 'a\<close>
   is \<open>of_int \<circ> signed_take_bit (LENGTH('b) - Suc 0)\<close>
   by (simp flip: signed_take_bit_decr_length_iff)
 
 lemma signed_0 [simp]:
   \<open>signed 0 = 0\<close>
   by transfer simp
 
 lemma signed_1 [simp]:
   \<open>signed (1 :: 'b::len word) = (if LENGTH('b) = 1 then - 1 else 1)\<close>
   by (transfer fixing: uminus; cases \<open>LENGTH('b)\<close>) (auto dest: gr0_implies_Suc)
 
 lemma signed_minus_1 [simp]:
   \<open>signed (- 1 :: 'b::len word) = - 1\<close>
   by (transfer fixing: uminus) simp
 
 lemma signed_numeral [simp]:
   \<open>signed (numeral n :: 'b::len word) = of_int (signed_take_bit (LENGTH('b) - 1) (numeral n))\<close>
   by transfer simp
 
 lemma signed_neg_numeral [simp]:
   \<open>signed (- numeral n :: 'b::len word) = of_int (signed_take_bit (LENGTH('b) - 1) (- numeral n))\<close>
   by transfer simp
 
 lemma signed_of_nat [simp]:
   \<open>signed (word_of_nat n :: 'b::len word) = of_int (signed_take_bit (LENGTH('b) - Suc 0) (int n))\<close>
   by transfer simp
 
 lemma signed_of_int [simp]:
   \<open>signed (word_of_int n :: 'b::len word) = of_int (signed_take_bit (LENGTH('b) - Suc 0) n)\<close>
   by transfer simp
 
 end
 
 context ring_char_0
 begin
 
 lemma signed_word_eqI:
   \<open>v = w\<close> if \<open>signed v = signed w\<close>
   using that by transfer (simp flip: signed_take_bit_decr_length_iff)
 
 lemma word_eq_iff_signed:
   \<open>v = w \<longleftrightarrow> signed v = signed w\<close>
   by (auto intro: signed_word_eqI)
 
 lemma inj_signed [simp]:
   \<open>inj signed\<close>
   by (rule injI) (simp add: signed_word_eqI)
 
 lemma signed_eq_0_iff:
   \<open>signed w = 0 \<longleftrightarrow> w = 0\<close>
   using word_eq_iff_signed [of w 0] by simp
 
 end
 
 abbreviation unat :: \<open>'a::len word \<Rightarrow> nat\<close>
   where \<open>unat \<equiv> unsigned\<close>
 
 abbreviation uint :: \<open>'a::len word \<Rightarrow> int\<close>
   where \<open>uint \<equiv> unsigned\<close>
 
 abbreviation sint :: \<open>'a::len word \<Rightarrow> int\<close>
   where \<open>sint \<equiv> signed\<close>
 
 abbreviation ucast :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
   where \<open>ucast \<equiv> unsigned\<close>
 
 abbreviation scast :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
   where \<open>scast \<equiv> signed\<close>
 
 context
   includes lifting_syntax
 begin
 
 lemma [transfer_rule]:
   \<open>(pcr_word ===> (=)) (nat \<circ> take_bit LENGTH('a)) (unat :: 'a::len word \<Rightarrow> nat)\<close>
   using unsigned.transfer [where ?'a = nat] by simp
 
 lemma [transfer_rule]:
   \<open>(pcr_word ===> (=)) (take_bit LENGTH('a)) (uint :: 'a::len word \<Rightarrow> int)\<close>
   using unsigned.transfer [where ?'a = int] by (simp add: comp_def)
 
 lemma [transfer_rule]:
   \<open>(pcr_word ===> (=)) (signed_take_bit (LENGTH('a) - Suc 0)) (sint :: 'a::len word \<Rightarrow> int)\<close>
   using signed.transfer [where ?'a = int] by simp
 
 lemma [transfer_rule]:
   \<open>(pcr_word ===> pcr_word) (take_bit LENGTH('a)) (ucast :: 'a::len word \<Rightarrow> 'b::len word)\<close>
 proof (rule rel_funI)
   fix k :: int and w :: \<open>'a word\<close>
   assume \<open>pcr_word k w\<close>
   then have \<open>w = word_of_int k\<close>
     by (simp add: pcr_word_def cr_word_def relcompp_apply)
   moreover have \<open>pcr_word (take_bit LENGTH('a) k) (ucast (word_of_int k :: 'a word))\<close>
     by transfer (simp add: pcr_word_def cr_word_def relcompp_apply)
   ultimately show \<open>pcr_word (take_bit LENGTH('a) k) (ucast w)\<close>
     by simp
 qed
 
 lemma [transfer_rule]:
   \<open>(pcr_word ===> pcr_word) (signed_take_bit (LENGTH('a) - Suc 0)) (scast :: 'a::len word \<Rightarrow> 'b::len word)\<close>
 proof (rule rel_funI)
   fix k :: int and w :: \<open>'a word\<close>
   assume \<open>pcr_word k w\<close>
   then have \<open>w = word_of_int k\<close>
     by (simp add: pcr_word_def cr_word_def relcompp_apply)
   moreover have \<open>pcr_word (signed_take_bit (LENGTH('a) - Suc 0) k) (scast (word_of_int k :: 'a word))\<close>
     by transfer (simp add: pcr_word_def cr_word_def relcompp_apply)
   ultimately show \<open>pcr_word (signed_take_bit (LENGTH('a) - Suc 0) k) (scast w)\<close>
     by simp
 qed
 
 end
 
 lemma of_nat_unat [simp]:
   \<open>of_nat (unat w) = unsigned w\<close>
   by transfer simp
 
 lemma of_int_uint [simp]:
   \<open>of_int (uint w) = unsigned w\<close>
   by transfer simp
 
 lemma of_int_sint [simp]:
   \<open>of_int (sint a) = signed a\<close>
   by transfer (simp_all add: take_bit_signed_take_bit)
 
 lemma nat_uint_eq [simp]:
   \<open>nat (uint w) = unat w\<close>
   by transfer simp
 
 lemma sgn_uint_eq [simp]:
   \<open>sgn (uint w) = of_bool (w \<noteq> 0)\<close>
   by transfer (simp add: less_le)
 
 text \<open>Aliasses only for code generation\<close>
 
 context
 begin
 
 qualified lift_definition of_int :: \<open>int \<Rightarrow> 'a::len word\<close>
   is \<open>take_bit LENGTH('a)\<close> .
 
 qualified lift_definition of_nat :: \<open>nat \<Rightarrow> 'a::len word\<close>
   is \<open>int \<circ> take_bit LENGTH('a)\<close> .
 
 qualified lift_definition the_nat :: \<open>'a::len word \<Rightarrow> nat\<close>
   is \<open>nat \<circ> take_bit LENGTH('a)\<close> by simp
 
 qualified lift_definition the_signed_int :: \<open>'a::len word \<Rightarrow> int\<close>
   is \<open>signed_take_bit (LENGTH('a) - Suc 0)\<close> by (simp add: signed_take_bit_decr_length_iff)
 
 qualified lift_definition cast :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
   is \<open>take_bit LENGTH('a)\<close> by simp
 
 qualified lift_definition signed_cast :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
   is \<open>signed_take_bit (LENGTH('a) - Suc 0)\<close> by (metis signed_take_bit_decr_length_iff)
 
 end
 
 lemma [code_abbrev, simp]:
   \<open>Word.the_int = uint\<close>
   by transfer rule
 
 lemma [code]:
   \<open>Word.the_int (Word.of_int k :: 'a::len word) = take_bit LENGTH('a) k\<close>
   by transfer simp
 
 lemma [code_abbrev, simp]:
   \<open>Word.of_int = word_of_int\<close>
   by (rule; transfer) simp
 
 lemma [code]:
   \<open>Word.the_int (Word.of_nat n :: 'a::len word) = take_bit LENGTH('a) (int n)\<close>
   by transfer (simp add: take_bit_of_nat)
 
 lemma [code_abbrev, simp]:
   \<open>Word.of_nat = word_of_nat\<close>
   by (rule; transfer) (simp add: take_bit_of_nat)
 
 lemma [code]:
   \<open>Word.the_nat w = nat (Word.the_int w)\<close>
   by transfer simp
 
 lemma [code_abbrev, simp]:
   \<open>Word.the_nat = unat\<close>
   by (rule; transfer) simp
 
 lemma [code]:
   \<open>Word.the_signed_int w = signed_take_bit (LENGTH('a) - Suc 0) (Word.the_int w)\<close>
   for w :: \<open>'a::len word\<close>
   by transfer (simp add: signed_take_bit_take_bit)
 
 lemma [code_abbrev, simp]:
   \<open>Word.the_signed_int = sint\<close>
   by (rule; transfer) simp
 
 lemma [code]:
   \<open>Word.the_int (Word.cast w :: 'b::len word) = take_bit LENGTH('b) (Word.the_int w)\<close>
   for w :: \<open>'a::len word\<close>
   by transfer simp
 
 lemma [code_abbrev, simp]:
   \<open>Word.cast = ucast\<close>
   by (rule; transfer) simp
 
 lemma [code]:
   \<open>Word.the_int (Word.signed_cast w :: 'b::len word) = take_bit LENGTH('b) (Word.the_signed_int w)\<close>
   for w :: \<open>'a::len word\<close>
   by transfer simp
 
 lemma [code_abbrev, simp]:
   \<open>Word.signed_cast = scast\<close>
   by (rule; transfer) simp
 
 lemma [code]:
   \<open>unsigned w = of_nat (nat (Word.the_int w))\<close>
   by transfer simp
 
 lemma [code]:
   \<open>signed w = of_int (Word.the_signed_int w)\<close>
   by transfer simp
 
 
 subsubsection \<open>Basic ordering\<close>
 
 instantiation word :: (len) linorder
 begin
 
 lift_definition less_eq_word :: "'a word \<Rightarrow> 'a word \<Rightarrow> bool"
   is "\<lambda>a b. take_bit LENGTH('a) a \<le> take_bit LENGTH('a) b"
   by simp
 
 lift_definition less_word :: "'a word \<Rightarrow> 'a word \<Rightarrow> bool"
   is "\<lambda>a b. take_bit LENGTH('a) a < take_bit LENGTH('a) b"
   by simp
 
 instance
   by (standard; transfer) auto
 
 end
 
 interpretation word_order: ordering_top \<open>(\<le>)\<close> \<open>(<)\<close> \<open>- 1 :: 'a::len word\<close>
   by (standard; transfer) (simp add: take_bit_eq_mod zmod_minus1)
 
 interpretation word_coorder: ordering_top \<open>(\<ge>)\<close> \<open>(>)\<close> \<open>0 :: 'a::len word\<close>
   by (standard; transfer) simp
 
 lemma word_of_nat_less_eq_iff:
   \<open>word_of_nat m \<le> (word_of_nat n :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) m \<le> take_bit LENGTH('a) n\<close>
   by transfer (simp add: take_bit_of_nat)
 
 lemma word_of_int_less_eq_iff:
   \<open>word_of_int k \<le> (word_of_int l :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) k \<le> take_bit LENGTH('a) l\<close>
   by transfer rule
 
 lemma word_of_nat_less_iff:
   \<open>word_of_nat m < (word_of_nat n :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) m < take_bit LENGTH('a) n\<close>
   by transfer (simp add: take_bit_of_nat)
 
 lemma word_of_int_less_iff:
   \<open>word_of_int k < (word_of_int l :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) k < take_bit LENGTH('a) l\<close>
   by transfer rule
 
 lemma word_le_def [code]:
   "a \<le> b \<longleftrightarrow> uint a \<le> uint b"
   by transfer rule
 
 lemma word_less_def [code]:
   "a < b \<longleftrightarrow> uint a < uint b"
   by transfer rule
 
 lemma word_greater_zero_iff:
   \<open>a > 0 \<longleftrightarrow> a \<noteq> 0\<close> for a :: \<open>'a::len word\<close>
   by transfer (simp add: less_le)
 
 lemma of_nat_word_less_eq_iff:
   \<open>of_nat m \<le> (of_nat n :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) m \<le> take_bit LENGTH('a) n\<close>
   by transfer (simp add: take_bit_of_nat)
 
 lemma of_nat_word_less_iff:
   \<open>of_nat m < (of_nat n :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) m < take_bit LENGTH('a) n\<close>
   by transfer (simp add: take_bit_of_nat)
 
 lemma of_int_word_less_eq_iff:
   \<open>of_int k \<le> (of_int l :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) k \<le> take_bit LENGTH('a) l\<close>
   by transfer rule
 
 lemma of_int_word_less_iff:
   \<open>of_int k < (of_int l :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) k < take_bit LENGTH('a) l\<close>
   by transfer rule
 
 
 
 subsection \<open>Enumeration\<close>
 
 lemma inj_on_word_of_nat:
   \<open>inj_on (word_of_nat :: nat \<Rightarrow> 'a::len word) {0..<2 ^ LENGTH('a)}\<close>
   by (rule inj_onI; transfer) (simp_all add: take_bit_int_eq_self)
 
 lemma UNIV_word_eq_word_of_nat:
   \<open>(UNIV :: 'a::len word set) = word_of_nat ` {0..<2 ^ LENGTH('a)}\<close> (is \<open>_ = ?A\<close>)
 proof
   show \<open>word_of_nat ` {0..<2 ^ LENGTH('a)} \<subseteq> UNIV\<close>
     by simp
   show \<open>UNIV \<subseteq> ?A\<close>
   proof
     fix w :: \<open>'a word\<close>
     show \<open>w \<in> (word_of_nat ` {0..<2 ^ LENGTH('a)} :: 'a word set)\<close>
       by (rule image_eqI [of _ _ \<open>unat w\<close>]; transfer) simp_all
   qed
 qed
 
 instantiation word :: (len) enum
 begin
 
 definition enum_word :: \<open>'a word list\<close>
   where \<open>enum_word = map word_of_nat [0..<2 ^ LENGTH('a)]\<close>
 
 definition enum_all_word :: \<open>('a word \<Rightarrow> bool) \<Rightarrow> bool\<close>
   where \<open>enum_all_word = Ball UNIV\<close>
 
 definition enum_ex_word :: \<open>('a word \<Rightarrow> bool) \<Rightarrow> bool\<close>
   where \<open>enum_ex_word = Bex UNIV\<close>
 
 lemma [code]:
   \<open>Enum.enum_all P \<longleftrightarrow> Ball UNIV P\<close>
   \<open>Enum.enum_ex P \<longleftrightarrow> Bex UNIV P\<close> for P :: \<open>'a word \<Rightarrow> bool\<close>
   by (simp_all add: enum_all_word_def enum_ex_word_def)
 
 instance
   by standard (simp_all add: UNIV_word_eq_word_of_nat inj_on_word_of_nat enum_word_def enum_all_word_def enum_ex_word_def distinct_map)
 
 end
 
 
 subsection \<open>Bit-wise operations\<close>
 
 instantiation word :: (len) semiring_modulo
 begin
 
 lift_definition divide_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
   is \<open>\<lambda>a b. take_bit LENGTH('a) a div take_bit LENGTH('a) b\<close>
   by simp
 
 lift_definition modulo_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
   is \<open>\<lambda>a b. take_bit LENGTH('a) a mod take_bit LENGTH('a) b\<close>
   by simp
 
 instance proof
   show "a div b * b + a mod b = a" for a b :: "'a word"
   proof transfer
     fix k l :: int
     define r :: int where "r = 2 ^ LENGTH('a)"
     then have r: "take_bit LENGTH('a) k = k mod r" for k
       by (simp add: take_bit_eq_mod)
     have "k mod r = ((k mod r) div (l mod r) * (l mod r)
       + (k mod r) mod (l mod r)) mod r"
       by (simp add: div_mult_mod_eq)
     also have "... = (((k mod r) div (l mod r) * (l mod r)) mod r
       + (k mod r) mod (l mod r)) mod r"
       by (simp add: mod_add_left_eq)
     also have "... = (((k mod r) div (l mod r) * l) mod r
       + (k mod r) mod (l mod r)) mod r"
       by (simp add: mod_mult_right_eq)
     finally have "k mod r = ((k mod r) div (l mod r) * l
       + (k mod r) mod (l mod r)) mod r"
       by (simp add: mod_simps)
     with r show "take_bit LENGTH('a) (take_bit LENGTH('a) k div take_bit LENGTH('a) l * l
       + take_bit LENGTH('a) k mod take_bit LENGTH('a) l) = take_bit LENGTH('a) k"
       by simp
   qed
 qed
 
 end
 
 instance word :: (len) semiring_parity
 proof
   show "\<not> 2 dvd (1::'a word)"
     by transfer simp
   show even_iff_mod_2_eq_0: "2 dvd a \<longleftrightarrow> a mod 2 = 0"
     for a :: "'a word"
     by transfer (simp_all add: mod_2_eq_odd take_bit_Suc)
   show "\<not> 2 dvd a \<longleftrightarrow> a mod 2 = 1"
     for a :: "'a word"
     by transfer (simp_all add: mod_2_eq_odd take_bit_Suc)
 qed
 
 lemma word_bit_induct [case_names zero even odd]:
   \<open>P a\<close> if word_zero: \<open>P 0\<close>
     and word_even: \<open>\<And>a. P a \<Longrightarrow> 0 < a \<Longrightarrow> a < 2 ^ (LENGTH('a) - Suc 0) \<Longrightarrow> P (2 * a)\<close>
     and word_odd: \<open>\<And>a. P a \<Longrightarrow> a < 2 ^ (LENGTH('a) - Suc 0) \<Longrightarrow> P (1 + 2 * a)\<close>
   for P and a :: \<open>'a::len word\<close>
 proof -
   define m :: nat where \<open>m = LENGTH('a) - Suc 0\<close>
   then have l: \<open>LENGTH('a) = Suc m\<close>
     by simp
   define n :: nat where \<open>n = unat a\<close>
   then have \<open>n < 2 ^ LENGTH('a)\<close>
     by transfer (simp add: take_bit_eq_mod)
   then have \<open>n < 2 * 2 ^ m\<close>
     by (simp add: l)
   then have \<open>P (of_nat n)\<close>
   proof (induction n rule: nat_bit_induct)
     case zero
     show ?case
       by simp (rule word_zero)
   next
     case (even n)
     then have \<open>n < 2 ^ m\<close>
       by simp
     with even.IH have \<open>P (of_nat n)\<close>
       by simp
     moreover from \<open>n < 2 ^ m\<close> even.hyps have \<open>0 < (of_nat n :: 'a word)\<close>
       by (auto simp add: word_greater_zero_iff l)
     moreover from \<open>n < 2 ^ m\<close> have \<open>(of_nat n :: 'a word) < 2 ^ (LENGTH('a) - Suc 0)\<close>
       using of_nat_word_less_iff [where ?'a = 'a, of n \<open>2 ^ m\<close>]
       by (simp add: l take_bit_eq_mod)
     ultimately have \<open>P (2 * of_nat n)\<close>
       by (rule word_even)
     then show ?case
       by simp
   next
     case (odd n)
     then have \<open>Suc n \<le> 2 ^ m\<close>
       by simp
     with odd.IH have \<open>P (of_nat n)\<close>
       by simp
     moreover from \<open>Suc n \<le> 2 ^ m\<close> have \<open>(of_nat n :: 'a word) < 2 ^ (LENGTH('a) - Suc 0)\<close>
       using of_nat_word_less_iff [where ?'a = 'a, of n \<open>2 ^ m\<close>]
       by (simp add: l take_bit_eq_mod)
     ultimately have \<open>P (1 + 2 * of_nat n)\<close>
       by (rule word_odd)
     then show ?case
       by simp
   qed
   moreover have \<open>of_nat (nat (uint a)) = a\<close>
     by transfer simp
   ultimately show ?thesis
     by (simp add: n_def)
 qed
 
 lemma bit_word_half_eq:
   \<open>(of_bool b + a * 2) div 2 = a\<close>
     if \<open>a < 2 ^ (LENGTH('a) - Suc 0)\<close>
     for a :: \<open>'a::len word\<close>
 proof (cases \<open>2 \<le> LENGTH('a::len)\<close>)
   case False
   have \<open>of_bool (odd k) < (1 :: int) \<longleftrightarrow> even k\<close> for k :: int
     by auto
   with False that show ?thesis
     by transfer (simp add: eq_iff)
 next
   case True
   obtain n where length: \<open>LENGTH('a) = Suc n\<close>
     by (cases \<open>LENGTH('a)\<close>) simp_all
   show ?thesis proof (cases b)
     case False
     moreover have \<open>a * 2 div 2 = a\<close>
     using that proof transfer
       fix k :: int
       from length have \<open>k * 2 mod 2 ^ LENGTH('a) = (k mod 2 ^ n) * 2\<close>
         by simp
       moreover assume \<open>take_bit LENGTH('a) k < take_bit LENGTH('a) (2 ^ (LENGTH('a) - Suc 0))\<close>
       with \<open>LENGTH('a) = Suc n\<close>
       have \<open>k mod 2 ^ LENGTH('a) = k mod 2 ^ n\<close>
         by (simp add: take_bit_eq_mod divmod_digit_0)
       ultimately have \<open>take_bit LENGTH('a) (k * 2) = take_bit LENGTH('a) k * 2\<close>
         by (simp add: take_bit_eq_mod)
       with True show \<open>take_bit LENGTH('a) (take_bit LENGTH('a) (k * 2) div take_bit LENGTH('a) 2)
         = take_bit LENGTH('a) k\<close>
         by simp
     qed
     ultimately show ?thesis
       by simp
   next
     case True
     moreover have \<open>(1 + a * 2) div 2 = a\<close>
     using that proof transfer
       fix k :: int
       from length have \<open>(1 + k * 2) mod 2 ^ LENGTH('a) = 1 + (k mod 2 ^ n) * 2\<close>
         using pos_zmod_mult_2 [of \<open>2 ^ n\<close> k] by (simp add: ac_simps)
       moreover assume \<open>take_bit LENGTH('a) k < take_bit LENGTH('a) (2 ^ (LENGTH('a) - Suc 0))\<close>
       with \<open>LENGTH('a) = Suc n\<close>
       have \<open>k mod 2 ^ LENGTH('a) = k mod 2 ^ n\<close>
         by (simp add: take_bit_eq_mod divmod_digit_0)
       ultimately have \<open>take_bit LENGTH('a) (1 + k * 2) = 1 + take_bit LENGTH('a) k * 2\<close>
         by (simp add: take_bit_eq_mod)
       with True show \<open>take_bit LENGTH('a) (take_bit LENGTH('a) (1 + k * 2) div take_bit LENGTH('a) 2)
         = take_bit LENGTH('a) k\<close>
         by (auto simp add: take_bit_Suc)
     qed
     ultimately show ?thesis
       by simp
   qed
 qed
 
 lemma even_mult_exp_div_word_iff:
   \<open>even (a * 2 ^ m div 2 ^ n) \<longleftrightarrow> \<not> (
     m \<le> n \<and>
     n < LENGTH('a) \<and> odd (a div 2 ^ (n - m)))\<close> for a :: \<open>'a::len word\<close>
   by transfer
     (auto simp flip: drop_bit_eq_div simp add: even_drop_bit_iff_not_bit bit_take_bit_iff,
       simp_all flip: push_bit_eq_mult add: bit_push_bit_iff_int)
 
 instantiation word :: (len) semiring_bits
 begin
 
 lift_definition bit_word :: \<open>'a word \<Rightarrow> nat \<Rightarrow> bool\<close>
   is \<open>\<lambda>k n. n < LENGTH('a) \<and> bit k n\<close>
 proof
   fix k l :: int and n :: nat
   assume *: \<open>take_bit LENGTH('a) k = take_bit LENGTH('a) l\<close>
   show \<open>n < LENGTH('a) \<and> bit k n \<longleftrightarrow> n < LENGTH('a) \<and> bit l n\<close>
   proof (cases \<open>n < LENGTH('a)\<close>)
     case True
     from * have \<open>bit (take_bit LENGTH('a) k) n \<longleftrightarrow> bit (take_bit LENGTH('a) l) n\<close>
       by simp
     then show ?thesis
       by (simp add: bit_take_bit_iff)
   next
     case False
     then show ?thesis
       by simp
   qed
 qed
 
 instance proof
   show \<open>P a\<close> if stable: \<open>\<And>a. a div 2 = a \<Longrightarrow> P a\<close>
     and rec: \<open>\<And>a b. P a \<Longrightarrow> (of_bool b + 2 * a) div 2 = a \<Longrightarrow> P (of_bool b + 2 * a)\<close>
   for P and a :: \<open>'a word\<close>
   proof (induction a rule: word_bit_induct)
     case zero
     have \<open>0 div 2 = (0::'a word)\<close>
       by transfer simp
     with stable [of 0] show ?case
       by simp
   next
     case (even a)
     with rec [of a False] show ?case
       using bit_word_half_eq [of a False] by (simp add: ac_simps)
   next
     case (odd a)
     with rec [of a True] show ?case
       using bit_word_half_eq [of a True] by (simp add: ac_simps)
   qed
   show \<open>bit a n \<longleftrightarrow> odd (a div 2 ^ n)\<close> for a :: \<open>'a word\<close> and n
     by transfer (simp flip: drop_bit_eq_div add: drop_bit_take_bit bit_iff_odd_drop_bit)
   show \<open>0 div a = 0\<close>
     for a :: \<open>'a word\<close>
     by transfer simp
   show \<open>a div 1 = a\<close>
     for a :: \<open>'a word\<close>
     by transfer simp
   have \<section>: "\<And>i n. (i::int) mod 2 ^ n = 0 \<or> 0 < i mod 2 ^ n"
     by (metis le_less take_bit_eq_mod take_bit_nonnegative)
   have less_power: "\<And>n i p. (i::int) mod numeral p ^ n < numeral p ^ n"
     by simp
   show \<open>a mod b div b = 0\<close>
     for a b :: \<open>'a word\<close>
     apply transfer
     apply (simp add: take_bit_eq_mod mod_eq_0_iff_dvd dvd_def)
     by (metis (no_types, hide_lams) "\<section>" Euclidean_Division.pos_mod_bound Euclidean_Division.pos_mod_sign le_less_trans mult_eq_0_iff take_bit_eq_mod take_bit_nonnegative zdiv_eq_0_iff zmod_le_nonneg_dividend)
   show \<open>(1 + a) div 2 = a div 2\<close>
     if \<open>even a\<close>
     for a :: \<open>'a word\<close>
     using that by transfer
-      (auto dest: le_Suc_ex simp add: mod_2_eq_odd take_bit_Suc elim!: evenE)
+      (auto dest: le_Suc_ex simp add: take_bit_Suc elim!: evenE)
   show \<open>(2 :: 'a word) ^ m div 2 ^ n = of_bool ((2 :: 'a word) ^ m \<noteq> 0 \<and> n \<le> m) * 2 ^ (m - n)\<close>
     for m n :: nat
     by transfer (simp, simp add: exp_div_exp_eq)
   show "a div 2 ^ m div 2 ^ n = a div 2 ^ (m + n)"
     for a :: "'a word" and m n :: nat
     apply transfer
     apply (auto simp add: not_less take_bit_drop_bit ac_simps simp flip: drop_bit_eq_div)
     apply (simp add: drop_bit_take_bit)
     done
   show "a mod 2 ^ m mod 2 ^ n = a mod 2 ^ min m n"
     for a :: "'a word" and m n :: nat
     by transfer (auto simp flip: take_bit_eq_mod simp add: ac_simps)
   show \<open>a * 2 ^ m mod 2 ^ n = a mod 2 ^ (n - m) * 2 ^ m\<close>
     if \<open>m \<le> n\<close> for a :: "'a word" and m n :: nat
     using that apply transfer
     apply (auto simp flip: take_bit_eq_mod)
            apply (auto simp flip: push_bit_eq_mult simp add: push_bit_take_bit split: split_min_lin)
     done
   show \<open>a div 2 ^ n mod 2 ^ m = a mod (2 ^ (n + m)) div 2 ^ n\<close>
     for a :: "'a word" and m n :: nat
     by transfer (auto simp add: not_less take_bit_drop_bit ac_simps simp flip: take_bit_eq_mod drop_bit_eq_div split: split_min_lin)
   show \<open>even ((2 ^ m - 1) div (2::'a word) ^ n) \<longleftrightarrow> 2 ^ n = (0::'a word) \<or> m \<le> n\<close>
     for m n :: nat
     by transfer (auto simp add: take_bit_of_mask even_mask_div_iff)
   show \<open>even (a * 2 ^ m div 2 ^ n) \<longleftrightarrow> n < m \<or> (2::'a word) ^ n = 0 \<or> m \<le> n \<and> even (a div 2 ^ (n - m))\<close>
     for a :: \<open>'a word\<close> and m n :: nat
   proof transfer
     show \<open>even (take_bit LENGTH('a) (k * 2 ^ m) div take_bit LENGTH('a) (2 ^ n)) \<longleftrightarrow>
       n < m
       \<or> take_bit LENGTH('a) ((2::int) ^ n) = take_bit LENGTH('a) 0
       \<or> (m \<le> n \<and> even (take_bit LENGTH('a) k div take_bit LENGTH('a) (2 ^ (n - m))))\<close>
     for m n :: nat and k l :: int
       by (auto simp flip: take_bit_eq_mod drop_bit_eq_div push_bit_eq_mult
         simp add: div_push_bit_of_1_eq_drop_bit drop_bit_take_bit drop_bit_push_bit_int [of n m])
   qed
 qed
 
 end
 
 lemma bit_word_eqI:
   \<open>a = b\<close> if \<open>\<And>n. n < LENGTH('a) \<Longrightarrow> bit a n \<longleftrightarrow> bit b n\<close>
   for a b :: \<open>'a::len word\<close>
   using that by transfer (auto simp add: nat_less_le bit_eq_iff bit_take_bit_iff)
 
 lemma bit_imp_le_length:
   \<open>n < LENGTH('a)\<close> if \<open>bit w n\<close>
     for w :: \<open>'a::len word\<close>
   using that by transfer simp
 
 lemma not_bit_length [simp]:
   \<open>\<not> bit w LENGTH('a)\<close> for w :: \<open>'a::len word\<close>
   by transfer simp
 
 lemma finite_bit_word [simp]:
   \<open>finite {n. bit w n}\<close>
   for w :: \<open>'a::len word\<close>
 proof -
   have \<open>{n. bit w n} \<subseteq> {0..LENGTH('a)}\<close>
     by (auto dest: bit_imp_le_length)
   moreover have \<open>finite {0..LENGTH('a)}\<close>
     by simp
   ultimately show ?thesis
     by (rule finite_subset)
 qed
 
 instantiation word :: (len) semiring_bit_shifts
 begin
 
 lift_definition push_bit_word :: \<open>nat \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
   is push_bit
 proof -
   show \<open>take_bit LENGTH('a) (push_bit n k) = take_bit LENGTH('a) (push_bit n l)\<close>
     if \<open>take_bit LENGTH('a) k = take_bit LENGTH('a) l\<close> for k l :: int and n :: nat
   proof -
     from that
     have \<open>take_bit (LENGTH('a) - n) (take_bit LENGTH('a) k)
       = take_bit (LENGTH('a) - n) (take_bit LENGTH('a) l)\<close>
       by simp
     moreover have \<open>min (LENGTH('a) - n) LENGTH('a) = LENGTH('a) - n\<close>
       by simp
     ultimately show ?thesis
       by (simp add: take_bit_push_bit)
   qed
 qed
 
 lift_definition drop_bit_word :: \<open>nat \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
   is \<open>\<lambda>n. drop_bit n \<circ> take_bit LENGTH('a)\<close>
   by (simp add: take_bit_eq_mod)
 
 lift_definition take_bit_word :: \<open>nat \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
   is \<open>\<lambda>n. take_bit (min LENGTH('a) n)\<close>
   by (simp add: ac_simps) (simp only: flip: take_bit_take_bit)
 
 instance proof
   show \<open>push_bit n a = a * 2 ^ n\<close> for n :: nat and a :: \<open>'a word\<close>
     by transfer (simp add: push_bit_eq_mult)
   show \<open>drop_bit n a = a div 2 ^ n\<close> for n :: nat and a :: \<open>'a word\<close>
     by transfer (simp flip: drop_bit_eq_div add: drop_bit_take_bit)
   show \<open>take_bit n a = a mod 2 ^ n\<close> for n :: nat and a :: \<open>'a word\<close>
     by transfer (auto simp flip: take_bit_eq_mod)
 qed
 
 end
 
 lemma [code]:
   \<open>push_bit n w = w * 2 ^ n\<close> for w :: \<open>'a::len word\<close>
   by (fact push_bit_eq_mult)
 
 lemma [code]:
   \<open>Word.the_int (drop_bit n w) = drop_bit n (Word.the_int w)\<close>
   by transfer (simp add: drop_bit_take_bit min_def le_less less_diff_conv)
 
 lemma [code]:
   \<open>Word.the_int (take_bit n w) = (if n < LENGTH('a::len) then take_bit n (Word.the_int w) else Word.the_int w)\<close>
   for w :: \<open>'a::len word\<close>
   by transfer (simp add: not_le not_less ac_simps min_absorb2)
 
 
 instantiation word :: (len) ring_bit_operations
 begin
 
 lift_definition not_word :: \<open>'a word \<Rightarrow> 'a word\<close>
   is not
   by (simp add: take_bit_not_iff)
 
 lift_definition and_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
   is \<open>and\<close>
   by simp
 
 lift_definition or_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
   is or
   by simp
 
 lift_definition xor_word ::  \<open>'a word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close>
   is xor
   by simp
 
 lift_definition mask_word :: \<open>nat \<Rightarrow> 'a word\<close>
   is mask
   .
 
 instance by (standard; transfer)
   (auto simp add: minus_eq_not_minus_1 mask_eq_exp_minus_1
     bit_not_iff bit_and_iff bit_or_iff bit_xor_iff)
 
 end
 
 lemma [code_abbrev]:
   \<open>push_bit n 1 = (2 :: 'a::len word) ^ n\<close>
   by (fact push_bit_of_1)
 
 lemma [code]:
   \<open>NOT w = Word.of_int (NOT (Word.the_int w))\<close>
   for w :: \<open>'a::len word\<close>
   by transfer (simp add: take_bit_not_take_bit) 
 
 lemma [code]:
   \<open>Word.the_int (v AND w) = Word.the_int v AND Word.the_int w\<close>
   by transfer simp
 
 lemma [code]:
   \<open>Word.the_int (v OR w) = Word.the_int v OR Word.the_int w\<close>
   by transfer simp
 
 lemma [code]:
   \<open>Word.the_int (v XOR w) = Word.the_int v XOR Word.the_int w\<close>
   by transfer simp
 
 lemma [code]:
   \<open>Word.the_int (mask n :: 'a::len word) = mask (min LENGTH('a) n)\<close>
   by transfer simp
 
 context
   includes lifting_syntax
 begin
 
 lemma set_bit_word_transfer [transfer_rule]:
   \<open>((=) ===> pcr_word ===> pcr_word) set_bit set_bit\<close>
   by (unfold set_bit_def) transfer_prover
 
 lemma unset_bit_word_transfer [transfer_rule]:
   \<open>((=) ===> pcr_word ===> pcr_word) unset_bit unset_bit\<close>
   by (unfold unset_bit_def) transfer_prover
 
 lemma flip_bit_word_transfer [transfer_rule]:
   \<open>((=) ===> pcr_word ===> pcr_word) flip_bit flip_bit\<close>
   by (unfold flip_bit_def) transfer_prover
 
 lemma signed_take_bit_word_transfer [transfer_rule]:
   \<open>((=) ===> pcr_word ===> pcr_word)
     (\<lambda>n k. signed_take_bit n (take_bit LENGTH('a::len) k))
     (signed_take_bit :: nat \<Rightarrow> 'a word \<Rightarrow> 'a word)\<close>
 proof -
   let ?K = \<open>\<lambda>n (k :: int). take_bit (min LENGTH('a) n) k OR of_bool (n < LENGTH('a) \<and> bit k n) * NOT (mask n)\<close>
   let ?W = \<open>\<lambda>n (w :: 'a word). take_bit n w OR of_bool (bit w n) * NOT (mask n)\<close>
   have \<open>((=) ===> pcr_word ===> pcr_word) ?K ?W\<close>
     by transfer_prover
   also have \<open>?K = (\<lambda>n k. signed_take_bit n (take_bit LENGTH('a::len) k))\<close>
     by (simp add: fun_eq_iff signed_take_bit_def bit_take_bit_iff ac_simps)
   also have \<open>?W = signed_take_bit\<close>
     by (simp add: fun_eq_iff signed_take_bit_def)
   finally show ?thesis .
 qed
 
 end
 
 
 subsection \<open>Conversions including casts\<close>
 
 subsubsection \<open>Generic unsigned conversion\<close>
 
 context semiring_bits
 begin
 
 lemma bit_unsigned_iff [bit_simps]:
   \<open>bit (unsigned w) n \<longleftrightarrow> 2 ^ n \<noteq> 0 \<and> bit w n\<close>
   for w :: \<open>'b::len word\<close>
   by (transfer fixing: bit) (simp add: bit_of_nat_iff bit_nat_iff bit_take_bit_iff)
 
 end
 
 context semiring_bit_shifts
 begin
 
 lemma unsigned_push_bit_eq:
   \<open>unsigned (push_bit n w) = take_bit LENGTH('b) (push_bit n (unsigned w))\<close>
   for w :: \<open>'b::len word\<close>
 proof (rule bit_eqI)
   fix m
   assume \<open>2 ^ m \<noteq> 0\<close>
   show \<open>bit (unsigned (push_bit n w)) m = bit (take_bit LENGTH('b) (push_bit n (unsigned w))) m\<close>
   proof (cases \<open>n \<le> m\<close>)
     case True
     with \<open>2 ^ m \<noteq> 0\<close> have \<open>2 ^ (m - n) \<noteq> 0\<close>
       by (metis (full_types) diff_add exp_add_not_zero_imp)
     with True show ?thesis
       by (simp add: bit_unsigned_iff bit_push_bit_iff Parity.bit_push_bit_iff bit_take_bit_iff not_le exp_eq_zero_iff ac_simps)
   next
     case False
     then show ?thesis
       by (simp add: not_le bit_unsigned_iff bit_push_bit_iff Parity.bit_push_bit_iff bit_take_bit_iff)
   qed
 qed
 
 lemma unsigned_take_bit_eq:
   \<open>unsigned (take_bit n w) = take_bit n (unsigned w)\<close>
   for w :: \<open>'b::len word\<close>
   by (rule bit_eqI) (simp add: bit_unsigned_iff bit_take_bit_iff Parity.bit_take_bit_iff)
 
 end
 
 context unique_euclidean_semiring_with_bit_shifts
 begin
 
 lemma unsigned_drop_bit_eq:
   \<open>unsigned (drop_bit n w) = drop_bit n (take_bit LENGTH('b) (unsigned w))\<close>
   for w :: \<open>'b::len word\<close>
   by (rule bit_eqI) (auto simp add: bit_unsigned_iff bit_take_bit_iff bit_drop_bit_eq Parity.bit_drop_bit_eq dest: bit_imp_le_length)
 
 end
 
 context semiring_bit_operations
 begin
 
 lemma unsigned_and_eq:
   \<open>unsigned (v AND w) = unsigned v AND unsigned w\<close>
   for v w :: \<open>'b::len word\<close>
   by (rule bit_eqI) (simp add: bit_unsigned_iff bit_and_iff Bit_Operations.bit_and_iff)
 
 lemma unsigned_or_eq:
   \<open>unsigned (v OR w) = unsigned v OR unsigned w\<close>
   for v w :: \<open>'b::len word\<close>
   by (rule bit_eqI) (simp add: bit_unsigned_iff bit_or_iff Bit_Operations.bit_or_iff)
 
 lemma unsigned_xor_eq:
   \<open>unsigned (v XOR w) = unsigned v XOR unsigned w\<close>
   for v w :: \<open>'b::len word\<close>
   by (rule bit_eqI) (simp add: bit_unsigned_iff bit_xor_iff Bit_Operations.bit_xor_iff)
 
 end
 
 context ring_bit_operations
 begin
 
 lemma unsigned_not_eq:
   \<open>unsigned (NOT w) = take_bit LENGTH('b) (NOT (unsigned w))\<close>
   for w :: \<open>'b::len word\<close>
   by (rule bit_eqI)
     (simp add: bit_unsigned_iff bit_take_bit_iff bit_not_iff Bit_Operations.bit_not_iff exp_eq_zero_iff not_le)
 
 end
 
 context unique_euclidean_semiring_numeral
 begin
 
 lemma unsigned_greater_eq [simp]:
   \<open>0 \<le> unsigned w\<close> for w :: \<open>'b::len word\<close>
   by (transfer fixing: less_eq) simp
 
 lemma unsigned_less [simp]:
   \<open>unsigned w < 2 ^ LENGTH('b)\<close> for w :: \<open>'b::len word\<close>
   by (transfer fixing: less) simp
 
 end
 
 context linordered_semidom
 begin
 
 lemma word_less_eq_iff_unsigned:
   "a \<le> b \<longleftrightarrow> unsigned a \<le> unsigned b"
   by (transfer fixing: less_eq) (simp add: nat_le_eq_zle)
 
 lemma word_less_iff_unsigned:
   "a < b \<longleftrightarrow> unsigned a < unsigned b"
   by (transfer fixing: less) (auto dest: preorder_class.le_less_trans [OF take_bit_nonnegative])
 
 end
 
 
 subsubsection \<open>Generic signed conversion\<close>
 
 context ring_bit_operations
 begin
 
 lemma bit_signed_iff [bit_simps]:
   \<open>bit (signed w) n \<longleftrightarrow> 2 ^ n \<noteq> 0 \<and> bit w (min (LENGTH('b) - Suc 0) n)\<close>
   for w :: \<open>'b::len word\<close>
   by (transfer fixing: bit)
     (auto simp add: bit_of_int_iff Bit_Operations.bit_signed_take_bit_iff min_def)
 
 lemma signed_push_bit_eq:
   \<open>signed (push_bit n w) = signed_take_bit (LENGTH('b) - Suc 0) (push_bit n (signed w :: 'a))\<close>
   for w :: \<open>'b::len word\<close>
 proof (rule bit_eqI)
   fix m
   assume \<open>2 ^ m \<noteq> 0\<close>
   define q where \<open>q = LENGTH('b) - Suc 0\<close>
   then have *: \<open>LENGTH('b) = Suc q\<close>
     by simp
   show \<open>bit (signed (push_bit n w)) m \<longleftrightarrow>
     bit (signed_take_bit (LENGTH('b) - Suc 0) (push_bit n (signed w :: 'a))) m\<close>
   proof (cases \<open>q \<le> m\<close>)
     case True
     moreover define r where \<open>r = m - q\<close>
     ultimately have \<open>m = q + r\<close>
       by simp
     moreover from \<open>m = q + r\<close> \<open>2 ^ m \<noteq> 0\<close> have \<open>2 ^ q \<noteq> 0\<close> \<open>2 ^ r \<noteq> 0\<close>
       using exp_add_not_zero_imp_left [of q r] exp_add_not_zero_imp_right [of q r]
       by simp_all
     moreover from \<open>2 ^ q \<noteq> 0\<close> have \<open>2 ^ (q - n) \<noteq> 0\<close>
       by (rule exp_not_zero_imp_exp_diff_not_zero)
     ultimately show ?thesis
       by (auto simp add: bit_signed_iff bit_signed_take_bit_iff bit_push_bit_iff Parity.bit_push_bit_iff
       min_def * exp_eq_zero_iff le_diff_conv2)
   next
     case False
     then show ?thesis
       using exp_not_zero_imp_exp_diff_not_zero [of m n]
       by (auto simp add: bit_signed_iff bit_signed_take_bit_iff bit_push_bit_iff Parity.bit_push_bit_iff
       min_def not_le not_less * le_diff_conv2 less_diff_conv2 Parity.exp_eq_0_imp_not_bit exp_eq_0_imp_not_bit
       exp_eq_zero_iff)
   qed
 qed
 
 lemma signed_take_bit_eq:
   \<open>signed (take_bit n w) = (if n < LENGTH('b) then take_bit n (signed w) else signed w)\<close>
   for w :: \<open>'b::len word\<close>
   by (transfer fixing: take_bit; cases \<open>LENGTH('b)\<close>)
     (auto simp add: Bit_Operations.signed_take_bit_take_bit Bit_Operations.take_bit_signed_take_bit take_bit_of_int min_def less_Suc_eq)
 
 lemma signed_not_eq:
   \<open>signed (NOT w) = signed_take_bit LENGTH('b) (NOT (signed w))\<close>
   for w :: \<open>'b::len word\<close>
 proof (rule bit_eqI)
   fix n
   assume \<open>2 ^ n \<noteq> 0\<close>
   define q where \<open>q = LENGTH('b) - Suc 0\<close>
   then have *: \<open>LENGTH('b) = Suc q\<close>
     by simp
   show \<open>bit (signed (NOT w)) n \<longleftrightarrow>
     bit (signed_take_bit LENGTH('b) (NOT (signed w))) n\<close>
   proof (cases \<open>q < n\<close>)
     case True
     moreover define r where \<open>r = n - Suc q\<close>
     ultimately have \<open>n = r + Suc q\<close>
       by simp
     moreover from \<open>2 ^ n \<noteq> 0\<close> \<open>n = r + Suc q\<close>
       have \<open>2 ^ Suc q \<noteq> 0\<close>
       using exp_add_not_zero_imp_right by blast 
     ultimately show ?thesis
       by (simp add: * bit_signed_iff bit_not_iff bit_signed_take_bit_iff Bit_Operations.bit_not_iff min_def
         exp_eq_zero_iff)
   next
     case False
     then show ?thesis
       by (auto simp add: * bit_signed_iff bit_not_iff bit_signed_take_bit_iff Bit_Operations.bit_not_iff min_def
         exp_eq_zero_iff)
   qed
 qed
 
 lemma signed_and_eq:
   \<open>signed (v AND w) = signed v AND signed w\<close>
   for v w :: \<open>'b::len word\<close>
   by (rule bit_eqI) (simp add: bit_signed_iff bit_and_iff Bit_Operations.bit_and_iff)
 
 lemma signed_or_eq:
   \<open>signed (v OR w) = signed v OR signed w\<close>
   for v w :: \<open>'b::len word\<close>
   by (rule bit_eqI) (simp add: bit_signed_iff bit_or_iff Bit_Operations.bit_or_iff)
 
 lemma signed_xor_eq:
   \<open>signed (v XOR w) = signed v XOR signed w\<close>
   for v w :: \<open>'b::len word\<close>
   by (rule bit_eqI) (simp add: bit_signed_iff bit_xor_iff Bit_Operations.bit_xor_iff)
 
 end
 
 
 subsubsection \<open>More\<close>
 
 lemma sint_greater_eq:
   \<open>- (2 ^ (LENGTH('a) - Suc 0)) \<le> sint w\<close> for w :: \<open>'a::len word\<close>
 proof (cases \<open>bit w (LENGTH('a) - Suc 0)\<close>)
   case True
   then show ?thesis
     by transfer (simp add: signed_take_bit_eq_if_negative minus_exp_eq_not_mask or_greater_eq ac_simps)
 next
   have *: \<open>- (2 ^ (LENGTH('a) - Suc 0)) \<le> (0::int)\<close>
     by simp
   case False
   then show ?thesis
     by transfer (auto simp add: signed_take_bit_eq intro: order_trans *)
 qed
 
 lemma sint_less:
   \<open>sint w < 2 ^ (LENGTH('a) - Suc 0)\<close> for w :: \<open>'a::len word\<close>
   by (cases \<open>bit w (LENGTH('a) - Suc 0)\<close>; transfer)
     (simp_all add: signed_take_bit_eq signed_take_bit_def not_eq_complement mask_eq_exp_minus_1 OR_upper)
 
 lemma unat_div_distrib:
   \<open>unat (v div w) = unat v div unat w\<close>
 proof transfer
   fix k l
   have \<open>nat (take_bit LENGTH('a) k) div nat (take_bit LENGTH('a) l) \<le> nat (take_bit LENGTH('a) k)\<close>
     by (rule div_le_dividend)
   also have \<open>nat (take_bit LENGTH('a) k) < 2 ^ LENGTH('a)\<close>
     by (simp add: nat_less_iff)
   finally show \<open>(nat \<circ> take_bit LENGTH('a)) (take_bit LENGTH('a) k div take_bit LENGTH('a) l) =
     (nat \<circ> take_bit LENGTH('a)) k div (nat \<circ> take_bit LENGTH('a)) l\<close>
     by (simp add: nat_take_bit_eq div_int_pos_iff nat_div_distrib take_bit_nat_eq_self_iff)
 qed
 
 lemma unat_mod_distrib:
   \<open>unat (v mod w) = unat v mod unat w\<close>
 proof transfer
   fix k l
   have \<open>nat (take_bit LENGTH('a) k) mod nat (take_bit LENGTH('a) l) \<le> nat (take_bit LENGTH('a) k)\<close>
     by (rule mod_less_eq_dividend)
   also have \<open>nat (take_bit LENGTH('a) k) < 2 ^ LENGTH('a)\<close>
     by (simp add: nat_less_iff)
   finally show \<open>(nat \<circ> take_bit LENGTH('a)) (take_bit LENGTH('a) k mod take_bit LENGTH('a) l) =
     (nat \<circ> take_bit LENGTH('a)) k mod (nat \<circ> take_bit LENGTH('a)) l\<close>
     by (simp add: nat_take_bit_eq mod_int_pos_iff less_le nat_mod_distrib take_bit_nat_eq_self_iff)
 qed
 
 lemma uint_div_distrib:
   \<open>uint (v div w) = uint v div uint w\<close>
 proof -
   have \<open>int (unat (v div w)) = int (unat v div unat w)\<close>
     by (simp add: unat_div_distrib)
   then show ?thesis
     by (simp add: of_nat_div)
 qed
 
 lemma unat_drop_bit_eq:
   \<open>unat (drop_bit n w) = drop_bit n (unat w)\<close>
   by (rule bit_eqI) (simp add: bit_unsigned_iff bit_drop_bit_eq)
 
 lemma uint_mod_distrib:
   \<open>uint (v mod w) = uint v mod uint w\<close>
 proof -
   have \<open>int (unat (v mod w)) = int (unat v mod unat w)\<close>
     by (simp add: unat_mod_distrib)
   then show ?thesis
     by (simp add: of_nat_mod)
 qed
 
 context semiring_bit_shifts
 begin
 
 lemma unsigned_ucast_eq:
   \<open>unsigned (ucast w :: 'c::len word) = take_bit LENGTH('c) (unsigned w)\<close>
   for w :: \<open>'b::len word\<close>
   by (rule bit_eqI) (simp add: bit_unsigned_iff Word.bit_unsigned_iff bit_take_bit_iff exp_eq_zero_iff not_le)
 
 end
 
 context ring_bit_operations
 begin
 
 lemma signed_ucast_eq:
   \<open>signed (ucast w :: 'c::len word) = signed_take_bit (LENGTH('c) - Suc 0) (unsigned w)\<close>
   for w :: \<open>'b::len word\<close>
 proof (rule bit_eqI)
   fix n
   assume \<open>2 ^ n \<noteq> 0\<close>
   then have \<open>2 ^ (min (LENGTH('c) - Suc 0) n) \<noteq> 0\<close>
     by (simp add: min_def)
       (metis (mono_tags) diff_diff_cancel exp_not_zero_imp_exp_diff_not_zero)
   then show \<open>bit (signed (ucast w :: 'c::len word)) n \<longleftrightarrow> bit (signed_take_bit (LENGTH('c) - Suc 0) (unsigned w)) n\<close>
     by (simp add: bit_signed_iff bit_unsigned_iff Word.bit_unsigned_iff bit_signed_take_bit_iff exp_eq_zero_iff not_le)
 qed
 
 lemma signed_scast_eq:
   \<open>signed (scast w :: 'c::len word) = signed_take_bit (LENGTH('c) - Suc 0) (signed w)\<close>
   for w :: \<open>'b::len word\<close>
 proof (rule bit_eqI)
   fix n
   assume \<open>2 ^ n \<noteq> 0\<close>
   then have \<open>2 ^ (min (LENGTH('c) - Suc 0) n) \<noteq> 0\<close>
     by (simp add: min_def)
       (metis (mono_tags) diff_diff_cancel exp_not_zero_imp_exp_diff_not_zero)
   then show \<open>bit (signed (scast w :: 'c::len word)) n \<longleftrightarrow> bit (signed_take_bit (LENGTH('c) - Suc 0) (signed w)) n\<close>
     by (simp add: bit_signed_iff bit_unsigned_iff Word.bit_signed_iff bit_signed_take_bit_iff exp_eq_zero_iff not_le)
 qed
 
 end
 
 lemma uint_nonnegative: "0 \<le> uint w"
   by (fact unsigned_greater_eq)
 
 lemma uint_bounded: "uint w < 2 ^ LENGTH('a)"
   for w :: "'a::len word"
   by (fact unsigned_less)
 
 lemma uint_idem: "uint w mod 2 ^ LENGTH('a) = uint w"
   for w :: "'a::len word"
   by transfer (simp add: take_bit_eq_mod)
 
 lemma word_uint_eqI: "uint a = uint b \<Longrightarrow> a = b"
   by (fact unsigned_word_eqI)
 
 lemma word_uint_eq_iff: "a = b \<longleftrightarrow> uint a = uint b"
   by (fact word_eq_iff_unsigned)
 
 lemma uint_word_of_int_eq:
   \<open>uint (word_of_int k :: 'a::len word) = take_bit LENGTH('a) k\<close>
   by transfer rule
 
 lemma uint_word_of_int: "uint (word_of_int k :: 'a::len word) = k mod 2 ^ LENGTH('a)"
   by (simp add: uint_word_of_int_eq take_bit_eq_mod)
   
 lemma word_of_int_uint: "word_of_int (uint w) = w"
   by transfer simp
 
 lemma word_div_def [code]:
   "a div b = word_of_int (uint a div uint b)"
   by transfer rule
 
 lemma word_mod_def [code]:
   "a mod b = word_of_int (uint a mod uint b)"
   by transfer rule
 
 lemma split_word_all: "(\<And>x::'a::len word. PROP P x) \<equiv> (\<And>x. PROP P (word_of_int x))"
 proof
   fix x :: "'a word"
   assume "\<And>x. PROP P (word_of_int x)"
   then have "PROP P (word_of_int (uint x))" .
   then show "PROP P x"
     by (simp only: word_of_int_uint)
 qed
 
 lemma sint_uint:
   \<open>sint w = signed_take_bit (LENGTH('a) - Suc 0) (uint w)\<close>
   for w :: \<open>'a::len word\<close>
   by (cases \<open>LENGTH('a)\<close>; transfer) (simp_all add: signed_take_bit_take_bit)
 
 lemma unat_eq_nat_uint:
   \<open>unat w = nat (uint w)\<close>
   by simp
 
 lemma ucast_eq:
   \<open>ucast w = word_of_int (uint w)\<close>
   by transfer simp
 
 lemma scast_eq:
   \<open>scast w = word_of_int (sint w)\<close>
   by transfer simp
 
 lemma uint_0_eq:
   \<open>uint 0 = 0\<close>
   by (fact unsigned_0)
 
 lemma uint_1_eq:
   \<open>uint 1 = 1\<close>
   by (fact unsigned_1)
 
 lemma word_m1_wi: "- 1 = word_of_int (- 1)"
   by simp
 
 lemma uint_0_iff: "uint x = 0 \<longleftrightarrow> x = 0"
   by (auto simp add: unsigned_word_eqI)
 
 lemma unat_0_iff: "unat x = 0 \<longleftrightarrow> x = 0"
   by (auto simp add: unsigned_word_eqI)
 
 lemma unat_0: "unat 0 = 0"
   by (fact unsigned_0)
 
 lemma unat_gt_0: "0 < unat x \<longleftrightarrow> x \<noteq> 0"
   by (auto simp: unat_0_iff [symmetric])
 
 lemma ucast_0: "ucast 0 = 0"
   by (fact unsigned_0)
 
 lemma sint_0: "sint 0 = 0"
   by (fact signed_0)
 
 lemma scast_0: "scast 0 = 0"
   by (fact signed_0)
 
 lemma sint_n1: "sint (- 1) = - 1"
   by (fact signed_minus_1)
 
 lemma scast_n1: "scast (- 1) = - 1"
   by (fact signed_minus_1)
 
 lemma uint_1: "uint (1::'a::len word) = 1"
   by (fact uint_1_eq)
 
 lemma unat_1: "unat (1::'a::len word) = 1"
   by (fact unsigned_1)
 
 lemma ucast_1: "ucast (1::'a::len word) = 1"
   by (fact unsigned_1)
 
 instantiation word :: (len) size
 begin
 
 lift_definition size_word :: \<open>'a word \<Rightarrow> nat\<close>
   is \<open>\<lambda>_. LENGTH('a)\<close> ..
 
 instance ..
 
 end
 
 lemma word_size [code]:
   \<open>size w = LENGTH('a)\<close> for w :: \<open>'a::len word\<close>
   by (fact size_word.rep_eq)
 
 lemma word_size_gt_0 [iff]: "0 < size w"
   for w :: "'a::len word"
   by (simp add: word_size)
 
 lemmas lens_gt_0 = word_size_gt_0 len_gt_0
 
 lemma lens_not_0 [iff]:
   \<open>size w \<noteq> 0\<close> for  w :: \<open>'a::len word\<close>
   by auto
 
 lift_definition source_size :: \<open>('a::len word \<Rightarrow> 'b) \<Rightarrow> nat\<close>
   is \<open>\<lambda>_. LENGTH('a)\<close> .
 
 lift_definition target_size :: \<open>('a \<Rightarrow> 'b::len word) \<Rightarrow> nat\<close>
   is \<open>\<lambda>_. LENGTH('b)\<close> ..
 
 lift_definition is_up :: \<open>('a::len word \<Rightarrow> 'b::len word) \<Rightarrow> bool\<close>
   is \<open>\<lambda>_. LENGTH('a) \<le> LENGTH('b)\<close> ..
 
 lift_definition is_down :: \<open>('a::len word \<Rightarrow> 'b::len word) \<Rightarrow> bool\<close>
   is \<open>\<lambda>_. LENGTH('a) \<ge> LENGTH('b)\<close> ..
 
 lemma is_up_eq:
   \<open>is_up f \<longleftrightarrow> source_size f \<le> target_size f\<close>
   for f :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
   by (simp add: source_size.rep_eq target_size.rep_eq is_up.rep_eq)
 
 lemma is_down_eq:
   \<open>is_down f \<longleftrightarrow> target_size f \<le> source_size f\<close>
   for f :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
   by (simp add: source_size.rep_eq target_size.rep_eq is_down.rep_eq)
 
 lift_definition word_int_case :: \<open>(int \<Rightarrow> 'b) \<Rightarrow> 'a::len word \<Rightarrow> 'b\<close>
   is \<open>\<lambda>f. f \<circ> take_bit LENGTH('a)\<close> by simp
 
 lemma word_int_case_eq_uint [code]:
   \<open>word_int_case f w = f (uint w)\<close>
   by transfer simp
 
 translations
   "case x of XCONST of_int y \<Rightarrow> b" \<rightleftharpoons> "CONST word_int_case (\<lambda>y. b) x"
   "case x of (XCONST of_int :: 'a) y \<Rightarrow> b" \<rightharpoonup> "CONST word_int_case (\<lambda>y. b) x"
 
 
 subsection \<open>Arithmetic operations\<close>
 
 text \<open>Legacy theorems:\<close>
 
 lemma word_add_def [code]:
   "a + b = word_of_int (uint a + uint b)"
   by transfer (simp add: take_bit_add)
 
 lemma word_sub_wi [code]:
   "a - b = word_of_int (uint a - uint b)"
   by transfer (simp add: take_bit_diff)
 
 lemma word_mult_def [code]:
   "a * b = word_of_int (uint a * uint b)"
   by transfer (simp add: take_bit_eq_mod mod_simps)
 
 lemma word_minus_def [code]:
   "- a = word_of_int (- uint a)"
   by transfer (simp add: take_bit_minus)
 
 lemma word_0_wi:
   "0 = word_of_int 0"
   by transfer simp
 
 lemma word_1_wi:
   "1 = word_of_int 1"
   by transfer simp
 
 lift_definition word_succ :: "'a::len word \<Rightarrow> 'a word" is "\<lambda>x. x + 1"
   by (auto simp add: take_bit_eq_mod intro: mod_add_cong)
 
 lift_definition word_pred :: "'a::len word \<Rightarrow> 'a word" is "\<lambda>x. x - 1"
   by (auto simp add: take_bit_eq_mod intro: mod_diff_cong)
 
 lemma word_succ_alt [code]:
   "word_succ a = word_of_int (uint a + 1)"
   by transfer (simp add: take_bit_eq_mod mod_simps)
 
 lemma word_pred_alt [code]:
   "word_pred a = word_of_int (uint a - 1)"
   by transfer (simp add: take_bit_eq_mod mod_simps)
 
 lemmas word_arith_wis = 
   word_add_def word_sub_wi word_mult_def
   word_minus_def word_succ_alt word_pred_alt
   word_0_wi word_1_wi
 
 lemma wi_homs:
   shows wi_hom_add: "word_of_int a + word_of_int b = word_of_int (a + b)"
     and wi_hom_sub: "word_of_int a - word_of_int b = word_of_int (a - b)"
     and wi_hom_mult: "word_of_int a * word_of_int b = word_of_int (a * b)"
     and wi_hom_neg: "- word_of_int a = word_of_int (- a)"
     and wi_hom_succ: "word_succ (word_of_int a) = word_of_int (a + 1)"
     and wi_hom_pred: "word_pred (word_of_int a) = word_of_int (a - 1)"
   by (transfer, simp)+
 
 lemmas wi_hom_syms = wi_homs [symmetric]
 
 lemmas word_of_int_homs = wi_homs word_0_wi word_1_wi
 
 lemmas word_of_int_hom_syms = word_of_int_homs [symmetric]
 
 lemma double_eq_zero_iff:
   \<open>2 * a = 0 \<longleftrightarrow> a = 0 \<or> a = 2 ^ (LENGTH('a) - Suc 0)\<close>
   for a :: \<open>'a::len word\<close>
 proof -
   define n where \<open>n = LENGTH('a) - Suc 0\<close>
   then have *: \<open>LENGTH('a) = Suc n\<close>
     by simp
   have \<open>a = 0\<close> if \<open>2 * a = 0\<close> and \<open>a \<noteq> 2 ^ (LENGTH('a) - Suc 0)\<close>
     using that by transfer
       (auto simp add: take_bit_eq_0_iff take_bit_eq_mod *)
   moreover have \<open>2 ^ LENGTH('a) = (0 :: 'a word)\<close>
     by transfer simp
   then have \<open>2 * 2 ^ (LENGTH('a) - Suc 0) = (0 :: 'a word)\<close>
     by (simp add: *)
   ultimately show ?thesis
     by auto
 qed
 
 
 subsection \<open>Ordering\<close>
 
 lift_definition word_sle :: \<open>'a::len word \<Rightarrow> 'a word \<Rightarrow> bool\<close>
   is \<open>\<lambda>k l. signed_take_bit (LENGTH('a) - Suc 0) k \<le> signed_take_bit (LENGTH('a) - Suc 0) l\<close>
   by (simp flip: signed_take_bit_decr_length_iff)
 
 lift_definition word_sless :: \<open>'a::len word \<Rightarrow> 'a word \<Rightarrow> bool\<close>
   is \<open>\<lambda>k l. signed_take_bit (LENGTH('a) - Suc 0) k < signed_take_bit (LENGTH('a) - Suc 0) l\<close>
   by (simp flip: signed_take_bit_decr_length_iff)
 
 notation
   word_sle    ("'(\<le>s')") and
   word_sle    ("(_/ \<le>s _)"  [51, 51] 50) and
   word_sless  ("'(<s')") and
   word_sless  ("(_/ <s _)"  [51, 51] 50)
 
 notation (input)
   word_sle    ("(_/ <=s _)"  [51, 51] 50)
 
 lemma word_sle_eq [code]:
   \<open>a <=s b \<longleftrightarrow> sint a \<le> sint b\<close>
   by transfer simp
 
 lemma [code]:
   \<open>a <s b \<longleftrightarrow> sint a < sint b\<close>
   by transfer simp
 
 lemma signed_ordering: \<open>ordering word_sle word_sless\<close>
   apply (standard; transfer)
   using signed_take_bit_decr_length_iff by force+
 
 lemma signed_linorder: \<open>class.linorder word_sle word_sless\<close>
   by (standard; transfer) (auto simp add: signed_take_bit_decr_length_iff)
 
 interpretation signed: linorder word_sle word_sless
   by (fact signed_linorder)
 
 lemma word_sless_eq:
   \<open>x <s y \<longleftrightarrow> x <=s y \<and> x \<noteq> y\<close>
   by (fact signed.less_le)
 
 lemma word_less_alt: "a < b \<longleftrightarrow> uint a < uint b"
   by (fact word_less_def)
 
 lemma word_zero_le [simp]: "0 \<le> y"
   for y :: "'a::len word"
   by (fact word_coorder.extremum)
 
 lemma word_m1_ge [simp] : "word_pred 0 \<ge> y" (* FIXME: delete *)
   by transfer (simp add: take_bit_minus_one_eq_mask mask_eq_exp_minus_1 )
 
 lemma word_n1_ge [simp]: "y \<le> -1"
   for y :: "'a::len word"
   by (fact word_order.extremum)
 
 lemmas word_not_simps [simp] =
   word_zero_le [THEN leD] word_m1_ge [THEN leD] word_n1_ge [THEN leD]
 
 lemma word_gt_0: "0 < y \<longleftrightarrow> 0 \<noteq> y"
   for y :: "'a::len word"
   by (simp add: less_le)
 
 lemmas word_gt_0_no [simp] = word_gt_0 [of "numeral y"] for y
 
 lemma word_sless_alt: "a <s b \<longleftrightarrow> sint a < sint b"
   by transfer simp
 
 lemma word_le_nat_alt: "a \<le> b \<longleftrightarrow> unat a \<le> unat b"
   by transfer (simp add: nat_le_eq_zle)
 
 lemma word_less_nat_alt: "a < b \<longleftrightarrow> unat a < unat b"
   by transfer (auto simp add: less_le [of 0])
 
 lemmas unat_mono = word_less_nat_alt [THEN iffD1]
 
 instance word :: (len) wellorder
 proof
   fix P :: "'a word \<Rightarrow> bool" and a
   assume *: "(\<And>b. (\<And>a. a < b \<Longrightarrow> P a) \<Longrightarrow> P b)"
   have "wf (measure unat)" ..
   moreover have "{(a, b :: ('a::len) word). a < b} \<subseteq> measure unat"
     by (auto simp add: word_less_nat_alt)
   ultimately have "wf {(a, b :: ('a::len) word). a < b}"
     by (rule wf_subset)
   then show "P a" using *
     by induction blast
 qed
 
 lemma wi_less:
   "(word_of_int n < (word_of_int m :: 'a::len word)) =
     (n mod 2 ^ LENGTH('a) < m mod 2 ^ LENGTH('a))"
   by transfer (simp add: take_bit_eq_mod)
 
 lemma wi_le:
   "(word_of_int n \<le> (word_of_int m :: 'a::len word)) =
     (n mod 2 ^ LENGTH('a) \<le> m mod 2 ^ LENGTH('a))"
   by transfer (simp add: take_bit_eq_mod)
 
 
 subsection \<open>Bit-wise operations\<close>
 
 lemma uint_take_bit_eq:
   \<open>uint (take_bit n w) = take_bit n (uint w)\<close>
   by transfer (simp add: ac_simps)
 
 lemma take_bit_word_eq_self:
   \<open>take_bit n w = w\<close> if \<open>LENGTH('a) \<le> n\<close> for w :: \<open>'a::len word\<close>
   using that by transfer simp
 
 lemma take_bit_length_eq [simp]:
   \<open>take_bit LENGTH('a) w = w\<close> for w :: \<open>'a::len word\<close>
   by (rule take_bit_word_eq_self) simp
 
 lemma bit_word_of_int_iff:
   \<open>bit (word_of_int k :: 'a::len word) n \<longleftrightarrow> n < LENGTH('a) \<and> bit k n\<close>
   by transfer rule
 
 lemma bit_uint_iff:
   \<open>bit (uint w) n \<longleftrightarrow> n < LENGTH('a) \<and> bit w n\<close>
     for w :: \<open>'a::len word\<close>
   by transfer (simp add: bit_take_bit_iff)
 
 lemma bit_sint_iff:
   \<open>bit (sint w) n \<longleftrightarrow> n \<ge> LENGTH('a) \<and> bit w (LENGTH('a) - 1) \<or> bit w n\<close>
   for w :: \<open>'a::len word\<close>
   by transfer (auto simp add: bit_signed_take_bit_iff min_def le_less not_less)
 
 lemma bit_word_ucast_iff:
   \<open>bit (ucast w :: 'b::len word) n \<longleftrightarrow> n < LENGTH('a) \<and> n < LENGTH('b) \<and> bit w n\<close>
   for w :: \<open>'a::len word\<close>
   by transfer (simp add: bit_take_bit_iff ac_simps)
 
 lemma bit_word_scast_iff:
   \<open>bit (scast w :: 'b::len word) n \<longleftrightarrow>
     n < LENGTH('b) \<and> (bit w n \<or> LENGTH('a) \<le> n \<and> bit w (LENGTH('a) - Suc 0))\<close>
   for w :: \<open>'a::len word\<close>
   by transfer (auto simp add: bit_signed_take_bit_iff le_less min_def)
 
 lift_definition shiftl1 :: \<open>'a::len word \<Rightarrow> 'a word\<close>
   is \<open>(*) 2\<close>
   by (auto simp add: take_bit_eq_mod intro: mod_mult_cong)
 
 lemma shiftl1_eq:
   \<open>shiftl1 w = word_of_int (2 * uint w)\<close>
   by transfer (simp add: take_bit_eq_mod mod_simps)
 
 lemma shiftl1_eq_mult_2:
   \<open>shiftl1 = (*) 2\<close>
   by (rule ext, transfer) simp
 
 lemma bit_shiftl1_iff [bit_simps]:
   \<open>bit (shiftl1 w) n \<longleftrightarrow> 0 < n \<and> n < LENGTH('a) \<and> bit w (n - 1)\<close>
     for w :: \<open>'a::len word\<close>
   by (simp add: shiftl1_eq_mult_2 bit_double_iff not_le) (simp add: ac_simps)
 
 lift_definition shiftr1 :: \<open>'a::len word \<Rightarrow> 'a word\<close>
   \<comment> \<open>shift right as unsigned or as signed, ie logical or arithmetic\<close>
   is \<open>\<lambda>k. take_bit LENGTH('a) k div 2\<close> 
   by simp
 
 lemma shiftr1_eq_div_2:
   \<open>shiftr1 w = w div 2\<close>
   by transfer simp
 
 lemma bit_shiftr1_iff [bit_simps]:
   \<open>bit (shiftr1 w) n \<longleftrightarrow> bit w (Suc n)\<close>
   by transfer (auto simp flip: bit_Suc simp add: bit_take_bit_iff)
 
 lemma shiftr1_eq:
   \<open>shiftr1 w = word_of_int (uint w div 2)\<close>
   by transfer simp
 
 lemma bit_word_iff_drop_bit_and [code]:
   \<open>bit a n \<longleftrightarrow> drop_bit n a AND 1 = 1\<close> for a :: \<open>'a::len word\<close>
   by (simp add: bit_iff_odd_drop_bit odd_iff_mod_2_eq_one and_one_eq)
 
 lemma
   word_not_def: "NOT (a::'a::len word) = word_of_int (NOT (uint a))"
     and word_and_def: "(a::'a word) AND b = word_of_int (uint a AND uint b)"
     and word_or_def: "(a::'a word) OR b = word_of_int (uint a OR uint b)"
     and word_xor_def: "(a::'a word) XOR b = word_of_int (uint a XOR uint b)"
   by (transfer, simp add: take_bit_not_take_bit)+
 
 lift_definition setBit :: \<open>'a::len word \<Rightarrow> nat \<Rightarrow> 'a word\<close>
   is \<open>\<lambda>k n. set_bit n k\<close>
   by (simp add: take_bit_set_bit_eq)
 
 lemma set_Bit_eq:
   \<open>setBit w n = set_bit n w\<close>
   by transfer simp
 
 lemma bit_setBit_iff [bit_simps]:
   \<open>bit (setBit w m) n \<longleftrightarrow> (m = n \<and> n < LENGTH('a) \<or> bit w n)\<close>
   for w :: \<open>'a::len word\<close>
   by transfer (auto simp add: bit_set_bit_iff)
 
 lift_definition clearBit :: \<open>'a::len word \<Rightarrow> nat \<Rightarrow> 'a word\<close>
   is \<open>\<lambda>k n. unset_bit n k\<close>
   by (simp add: take_bit_unset_bit_eq)
 
 lemma clear_Bit_eq:
   \<open>clearBit w n = unset_bit n w\<close>
   by transfer simp
 
 lemma bit_clearBit_iff [bit_simps]:
   \<open>bit (clearBit w m) n \<longleftrightarrow> m \<noteq> n \<and> bit w n\<close>
   for w :: \<open>'a::len word\<close>
   by transfer (auto simp add: bit_unset_bit_iff)
 
 definition even_word :: \<open>'a::len word \<Rightarrow> bool\<close>
   where [code_abbrev]: \<open>even_word = even\<close>
 
 lemma even_word_iff [code]:
   \<open>even_word a \<longleftrightarrow> a AND 1 = 0\<close>
   by (simp add: and_one_eq even_iff_mod_2_eq_zero even_word_def)
 
 lemma map_bit_range_eq_if_take_bit_eq:
   \<open>map (bit k) [0..<n] = map (bit l) [0..<n]\<close>
   if \<open>take_bit n k = take_bit n l\<close> for k l :: int
 using that proof (induction n arbitrary: k l)
   case 0
   then show ?case
     by simp
 next
   case (Suc n)
   from Suc.prems have \<open>take_bit n (k div 2) = take_bit n (l div 2)\<close>
     by (simp add: take_bit_Suc)
   then have \<open>map (bit (k div 2)) [0..<n] = map (bit (l div 2)) [0..<n]\<close>
     by (rule Suc.IH)
   moreover have \<open>bit (r div 2) = bit r \<circ> Suc\<close> for r :: int
     by (simp add: fun_eq_iff bit_Suc)
   moreover from Suc.prems have \<open>even k \<longleftrightarrow> even l\<close>
     by (auto simp add: take_bit_Suc elim!: evenE oddE) arith+
   ultimately show ?case
     by (simp only: map_Suc_upt upt_conv_Cons flip: list.map_comp) simp
 qed
 
 lemma
   take_bit_word_Bit0_eq [simp]: \<open>take_bit (numeral n) (numeral (num.Bit0 m) :: 'a::len word)
     = 2 * take_bit (pred_numeral n) (numeral m)\<close> (is ?P)
   and take_bit_word_Bit1_eq [simp]: \<open>take_bit (numeral n) (numeral (num.Bit1 m) :: 'a::len word)
     = 1 + 2 * take_bit (pred_numeral n) (numeral m)\<close> (is ?Q)
   and take_bit_word_minus_Bit0_eq [simp]: \<open>take_bit (numeral n) (- numeral (num.Bit0 m) :: 'a::len word)
     = 2 * take_bit (pred_numeral n) (- numeral m)\<close> (is ?R)
   and take_bit_word_minus_Bit1_eq [simp]: \<open>take_bit (numeral n) (- numeral (num.Bit1 m) :: 'a::len word)
     = 1 + 2 * take_bit (pred_numeral n) (- numeral (Num.inc m))\<close> (is ?S)
 proof -
   define w :: \<open>'a::len word\<close>
     where \<open>w = numeral m\<close>
   moreover define q :: nat
     where \<open>q = pred_numeral n\<close>
   ultimately have num:
     \<open>numeral m = w\<close>
     \<open>numeral (num.Bit0 m) = 2 * w\<close>
     \<open>numeral (num.Bit1 m) = 1 + 2 * w\<close>
     \<open>numeral (Num.inc m) = 1 + w\<close>
     \<open>pred_numeral n = q\<close>
     \<open>numeral n = Suc q\<close>
     by (simp_all only: w_def q_def numeral_Bit0 [of m] numeral_Bit1 [of m] ac_simps
       numeral_inc numeral_eq_Suc flip: mult_2)
   have even: \<open>take_bit (Suc q) (2 * w) = 2 * take_bit q w\<close> for w :: \<open>'a::len word\<close>
     by (rule bit_word_eqI)
       (auto simp add: bit_take_bit_iff bit_double_iff)
   have odd: \<open>take_bit (Suc q) (1 + 2 * w) = 1 + 2 * take_bit q w\<close> for w :: \<open>'a::len word\<close>
     by (rule bit_eqI)
       (auto simp add: bit_take_bit_iff bit_double_iff even_bit_succ_iff)
   show ?P
     using even [of w] by (simp add: num)
   show ?Q
     using odd [of w] by (simp add: num)
   show ?R
     using even [of \<open>- w\<close>] by (simp add: num)
   show ?S
     using odd [of \<open>- (1 + w)\<close>] by (simp add: num)
 qed
 
 
 subsection \<open>More shift operations\<close>
 
 lift_definition signed_drop_bit :: \<open>nat \<Rightarrow> 'a word \<Rightarrow> 'a::len word\<close>
   is \<open>\<lambda>n. drop_bit n \<circ> signed_take_bit (LENGTH('a) - Suc 0)\<close>
   using signed_take_bit_decr_length_iff
   by (simp add: take_bit_drop_bit) force
 
 lemma bit_signed_drop_bit_iff [bit_simps]:
   \<open>bit (signed_drop_bit m w) n \<longleftrightarrow> bit w (if LENGTH('a) - m \<le> n \<and> n < LENGTH('a) then LENGTH('a) - 1 else m + n)\<close>
   for w :: \<open>'a::len word\<close>
   apply transfer
   apply (auto simp add: bit_drop_bit_eq bit_signed_take_bit_iff not_le min_def)
    apply (metis add.commute le_antisym less_diff_conv less_eq_decr_length_iff)
   apply (metis le_antisym less_eq_decr_length_iff)
   done
 
 lemma [code]:
   \<open>Word.the_int (signed_drop_bit n w) = take_bit LENGTH('a) (drop_bit n (Word.the_signed_int w))\<close>
   for w :: \<open>'a::len word\<close>
   by transfer simp
 
 lemma signed_drop_bit_signed_drop_bit [simp]:
   \<open>signed_drop_bit m (signed_drop_bit n w) = signed_drop_bit (m + n) w\<close>
   for w :: \<open>'a::len word\<close>
 proof (cases \<open>LENGTH('a)\<close>)
   case 0
   then show ?thesis
     using len_not_eq_0 by blast
 next
   case (Suc n)
   then show ?thesis
     by (force simp add: bit_signed_drop_bit_iff not_le less_diff_conv ac_simps intro!: bit_word_eqI)
 qed
 
 lemma signed_drop_bit_0 [simp]:
   \<open>signed_drop_bit 0 w = w\<close>
   by transfer (simp add: take_bit_signed_take_bit)
 
 lemma sint_signed_drop_bit_eq:
   \<open>sint (signed_drop_bit n w) = drop_bit n (sint w)\<close>
 proof (cases \<open>LENGTH('a) = 0 \<or> n=0\<close>)
   case False
   then show ?thesis
     apply simp
     apply (rule bit_eqI)
     by (auto simp add: bit_sint_iff bit_drop_bit_eq bit_signed_drop_bit_iff dest: bit_imp_le_length)
 qed auto
 
 lift_definition sshiftr1 :: \<open>'a::len word \<Rightarrow> 'a word\<close>
   is \<open>\<lambda>k. take_bit LENGTH('a) (signed_take_bit (LENGTH('a) - Suc 0) k div 2)\<close>
   by (simp flip: signed_take_bit_decr_length_iff)
 
 lift_definition bshiftr1 :: \<open>bool \<Rightarrow> 'a::len word \<Rightarrow> 'a word\<close>
   is \<open>\<lambda>b k. take_bit LENGTH('a) k div 2 + of_bool b * 2 ^ (LENGTH('a) - Suc 0)\<close>
   by (fact arg_cong)
 
 lemma sshiftr1_eq_signed_drop_bit_Suc_0:
   \<open>sshiftr1 = signed_drop_bit (Suc 0)\<close>
   by (rule ext) (transfer, simp add: drop_bit_Suc)
 
 lemma sshiftr1_eq:
   \<open>sshiftr1 w = word_of_int (sint w div 2)\<close>
   by transfer simp
 
 
 subsection \<open>Rotation\<close>
 
 lift_definition word_rotr :: \<open>nat \<Rightarrow> 'a::len word \<Rightarrow> 'a::len word\<close>
   is \<open>\<lambda>n k. concat_bit (LENGTH('a) - n mod LENGTH('a))
     (drop_bit (n mod LENGTH('a)) (take_bit LENGTH('a) k))
     (take_bit (n mod LENGTH('a)) k)\<close>
   subgoal for n k l
     by (simp add: concat_bit_def nat_le_iff less_imp_le
       take_bit_tightened [of \<open>LENGTH('a)\<close> k l \<open>n mod LENGTH('a::len)\<close>])
   done
 
 lift_definition word_rotl :: \<open>nat \<Rightarrow> 'a::len word \<Rightarrow> 'a::len word\<close>
   is \<open>\<lambda>n k. concat_bit (n mod LENGTH('a))
     (drop_bit (LENGTH('a) - n mod LENGTH('a)) (take_bit LENGTH('a) k))
     (take_bit (LENGTH('a) - n mod LENGTH('a)) k)\<close>
   subgoal for n k l
     by (simp add: concat_bit_def nat_le_iff less_imp_le
       take_bit_tightened [of \<open>LENGTH('a)\<close> k l \<open>LENGTH('a) - n mod LENGTH('a::len)\<close>])
   done
 
 lift_definition word_roti :: \<open>int \<Rightarrow> 'a::len word \<Rightarrow> 'a::len word\<close>
   is \<open>\<lambda>r k. concat_bit (LENGTH('a) - nat (r mod int LENGTH('a)))
     (drop_bit (nat (r mod int LENGTH('a))) (take_bit LENGTH('a) k))
     (take_bit (nat (r mod int LENGTH('a))) k)\<close>
   subgoal for r k l
     by (simp add: concat_bit_def nat_le_iff less_imp_le
       take_bit_tightened [of \<open>LENGTH('a)\<close> k l \<open>nat (r mod int LENGTH('a::len))\<close>])
   done
 
 lemma word_rotl_eq_word_rotr [code]:
   \<open>word_rotl n = (word_rotr (LENGTH('a) - n mod LENGTH('a)) :: 'a::len word \<Rightarrow> 'a word)\<close>
   by (rule ext, cases \<open>n mod LENGTH('a) = 0\<close>; transfer) simp_all
 
 lemma word_roti_eq_word_rotr_word_rotl [code]:
   \<open>word_roti i w =
     (if i \<ge> 0 then word_rotr (nat i) w else word_rotl (nat (- i)) w)\<close>
 proof (cases \<open>i \<ge> 0\<close>)
   case True
   moreover define n where \<open>n = nat i\<close>
   ultimately have \<open>i = int n\<close>
     by simp
   moreover have \<open>word_roti (int n) = (word_rotr n :: _ \<Rightarrow> 'a word)\<close>
     by (rule ext, transfer) (simp add: nat_mod_distrib)
   ultimately show ?thesis
     by simp
 next
   case False
   moreover define n where \<open>n = nat (- i)\<close>
   ultimately have \<open>i = - int n\<close> \<open>n > 0\<close>
     by simp_all
   moreover have \<open>word_roti (- int n) = (word_rotl n :: _ \<Rightarrow> 'a word)\<close>
     by (rule ext, transfer)
       (simp add: zmod_zminus1_eq_if flip: of_nat_mod of_nat_diff)
   ultimately show ?thesis
     by simp
 qed
 
 lemma bit_word_rotr_iff [bit_simps]:
   \<open>bit (word_rotr m w) n \<longleftrightarrow>
     n < LENGTH('a) \<and> bit w ((n + m) mod LENGTH('a))\<close>
   for w :: \<open>'a::len word\<close>
 proof transfer
   fix k :: int and m n :: nat
   define q where \<open>q = m mod LENGTH('a)\<close>
   have \<open>q < LENGTH('a)\<close> 
     by (simp add: q_def)
   then have \<open>q \<le> LENGTH('a)\<close>
     by simp
   have \<open>m mod LENGTH('a) = q\<close>
     by (simp add: q_def)
   moreover have \<open>(n + m) mod LENGTH('a) = (n + q) mod LENGTH('a)\<close>
     by (subst mod_add_right_eq [symmetric]) (simp add: \<open>m mod LENGTH('a) = q\<close>)
   moreover have \<open>n < LENGTH('a) \<and>
     bit (concat_bit (LENGTH('a) - q) (drop_bit q (take_bit LENGTH('a) k)) (take_bit q k)) n \<longleftrightarrow>
     n < LENGTH('a) \<and> bit k ((n + q) mod LENGTH('a))\<close>
     using \<open>q < LENGTH('a)\<close>
     by (cases \<open>q + n \<ge> LENGTH('a)\<close>)
      (auto simp add: bit_concat_bit_iff bit_drop_bit_eq
         bit_take_bit_iff le_mod_geq ac_simps)
   ultimately show \<open>n < LENGTH('a) \<and>
     bit (concat_bit (LENGTH('a) - m mod LENGTH('a))
       (drop_bit (m mod LENGTH('a)) (take_bit LENGTH('a) k))
       (take_bit (m mod LENGTH('a)) k)) n
     \<longleftrightarrow> n < LENGTH('a) \<and>
       (n + m) mod LENGTH('a) < LENGTH('a) \<and>
       bit k ((n + m) mod LENGTH('a))\<close>
     by simp
 qed
 
 lemma bit_word_rotl_iff [bit_simps]:
   \<open>bit (word_rotl m w) n \<longleftrightarrow>
     n < LENGTH('a) \<and> bit w ((n + (LENGTH('a) - m mod LENGTH('a))) mod LENGTH('a))\<close>
   for w :: \<open>'a::len word\<close>
   by (simp add: word_rotl_eq_word_rotr bit_word_rotr_iff)
 
 lemma bit_word_roti_iff [bit_simps]:
   \<open>bit (word_roti k w) n \<longleftrightarrow>
     n < LENGTH('a) \<and> bit w (nat ((int n + k) mod int LENGTH('a)))\<close>
   for w :: \<open>'a::len word\<close>
 proof transfer
   fix k l :: int and n :: nat
   define m where \<open>m = nat (k mod int LENGTH('a))\<close>
   have \<open>m < LENGTH('a)\<close> 
     by (simp add: nat_less_iff m_def)
   then have \<open>m \<le> LENGTH('a)\<close>
     by simp
   have \<open>k mod int LENGTH('a) = int m\<close>
     by (simp add: nat_less_iff m_def)
   moreover have \<open>(int n + k) mod int LENGTH('a) = int ((n + m) mod LENGTH('a))\<close>
     by (subst mod_add_right_eq [symmetric]) (simp add: of_nat_mod \<open>k mod int LENGTH('a) = int m\<close>)
   moreover have \<open>n < LENGTH('a) \<and>
     bit (concat_bit (LENGTH('a) - m) (drop_bit m (take_bit LENGTH('a) l)) (take_bit m l)) n \<longleftrightarrow>
     n < LENGTH('a) \<and> bit l ((n + m) mod LENGTH('a))\<close>
     using \<open>m < LENGTH('a)\<close>
     by (cases \<open>m + n \<ge> LENGTH('a)\<close>)
      (auto simp add: bit_concat_bit_iff bit_drop_bit_eq
         bit_take_bit_iff nat_less_iff not_le not_less ac_simps
         le_diff_conv le_mod_geq)
   ultimately show \<open>n < LENGTH('a)
     \<and> bit (concat_bit (LENGTH('a) - nat (k mod int LENGTH('a)))
              (drop_bit (nat (k mod int LENGTH('a))) (take_bit LENGTH('a) l))
              (take_bit (nat (k mod int LENGTH('a))) l)) n \<longleftrightarrow>
        n < LENGTH('a) 
     \<and> nat ((int n + k) mod int LENGTH('a)) < LENGTH('a)
     \<and> bit l (nat ((int n + k) mod int LENGTH('a)))\<close>
     by simp
 qed
 
 lemma uint_word_rotr_eq:
   \<open>uint (word_rotr n w) = concat_bit (LENGTH('a) - n mod LENGTH('a))
     (drop_bit (n mod LENGTH('a)) (uint w))
     (uint (take_bit (n mod LENGTH('a)) w))\<close>
   for w :: \<open>'a::len word\<close>
   apply transfer
   by (simp add: min.absorb2 take_bit_concat_bit_eq)
 
 lemma [code]:
   \<open>Word.the_int (word_rotr n w) = concat_bit (LENGTH('a) - n mod LENGTH('a))
     (drop_bit (n mod LENGTH('a)) (Word.the_int w))
     (Word.the_int (take_bit (n mod LENGTH('a)) w))\<close>
   for w :: \<open>'a::len word\<close>
   using uint_word_rotr_eq [of n w] by simp
 
     
 subsection \<open>Split and cat operations\<close>
 
 lift_definition word_cat :: \<open>'a::len word \<Rightarrow> 'b::len word \<Rightarrow> 'c::len word\<close>
   is \<open>\<lambda>k l. concat_bit LENGTH('b) l (take_bit LENGTH('a) k)\<close>
   by (simp add: bit_eq_iff bit_concat_bit_iff bit_take_bit_iff)
 
 lemma word_cat_eq:
   \<open>(word_cat v w :: 'c::len word) = push_bit LENGTH('b) (ucast v) + ucast w\<close>
   for v :: \<open>'a::len word\<close> and w :: \<open>'b::len word\<close>
   by transfer (simp add: concat_bit_eq ac_simps)
 
 lemma word_cat_eq' [code]:
   \<open>word_cat a b = word_of_int (concat_bit LENGTH('b) (uint b) (uint a))\<close>
   for a :: \<open>'a::len word\<close> and b :: \<open>'b::len word\<close>
   by transfer (simp add: concat_bit_take_bit_eq)
 
 lemma bit_word_cat_iff [bit_simps]:
   \<open>bit (word_cat v w :: 'c::len word) n \<longleftrightarrow> n < LENGTH('c) \<and> (if n < LENGTH('b) then bit w n else bit v (n - LENGTH('b)))\<close> 
   for v :: \<open>'a::len word\<close> and w :: \<open>'b::len word\<close>
   by transfer (simp add: bit_concat_bit_iff bit_take_bit_iff)
 
 definition word_split :: \<open>'a::len word \<Rightarrow> 'b::len word \<times> 'c::len word\<close>
   where \<open>word_split w =
     (ucast (drop_bit LENGTH('c) w) :: 'b::len word, ucast w :: 'c::len word)\<close>
 
 definition word_rcat :: \<open>'a::len word list \<Rightarrow> 'b::len word\<close>
   where \<open>word_rcat = word_of_int \<circ> horner_sum uint (2 ^ LENGTH('a)) \<circ> rev\<close>
 
 abbreviation (input) max_word :: \<open>'a::len word\<close>
   \<comment> \<open>Largest representable machine integer.\<close>
   where "max_word \<equiv> - 1"
 
 
 subsection \<open>More on conversions\<close>
 
 lemma int_word_sint:
   \<open>sint (word_of_int x :: 'a::len word) = (x + 2 ^ (LENGTH('a) - 1)) mod 2 ^ LENGTH('a) - 2 ^ (LENGTH('a) - 1)\<close>
   by transfer (simp flip: take_bit_eq_mod add: signed_take_bit_eq_take_bit_shift)
 
 lemma sint_sbintrunc': "sint (word_of_int bin :: 'a word) = signed_take_bit (LENGTH('a::len) - 1) bin"
   by simp
 
 lemma uint_sint: "uint w = take_bit LENGTH('a) (sint w)"
   for w :: "'a::len word"
   by transfer (simp add: take_bit_signed_take_bit)
 
 lemma bintr_uint: "LENGTH('a) \<le> n \<Longrightarrow> take_bit n (uint w) = uint w"
   for w :: "'a::len word"
   by transfer (simp add: min_def)
 
 lemma wi_bintr:
   "LENGTH('a::len) \<le> n \<Longrightarrow>
     word_of_int (take_bit n w) = (word_of_int w :: 'a word)"
   by transfer simp
 
 lemma word_numeral_alt: "numeral b = word_of_int (numeral b)"
   by (induct b, simp_all only: numeral.simps word_of_int_homs)
 
 declare word_numeral_alt [symmetric, code_abbrev]
 
 lemma word_neg_numeral_alt: "- numeral b = word_of_int (- numeral b)"
   by (simp only: word_numeral_alt wi_hom_neg)
 
 declare word_neg_numeral_alt [symmetric, code_abbrev]
 
 lemma uint_bintrunc [simp]:
   "uint (numeral bin :: 'a word) =
     take_bit (LENGTH('a::len)) (numeral bin)"
   by transfer rule
 
 lemma uint_bintrunc_neg [simp]:
   "uint (- numeral bin :: 'a word) = take_bit (LENGTH('a::len)) (- numeral bin)"
   by transfer rule
 
 lemma sint_sbintrunc [simp]:
   "sint (numeral bin :: 'a word) = signed_take_bit (LENGTH('a::len) - 1) (numeral bin)"
   by transfer simp
 
 lemma sint_sbintrunc_neg [simp]:
   "sint (- numeral bin :: 'a word) = signed_take_bit (LENGTH('a::len) - 1) (- numeral bin)"
   by transfer simp
 
 lemma unat_bintrunc [simp]:
   "unat (numeral bin :: 'a::len word) = nat (take_bit (LENGTH('a)) (numeral bin))"
   by transfer simp
 
 lemma unat_bintrunc_neg [simp]:
   "unat (- numeral bin :: 'a::len word) = nat (take_bit (LENGTH('a)) (- numeral bin))"
   by transfer simp
 
 lemma size_0_eq: "size w = 0 \<Longrightarrow> v = w"
   for v w :: "'a::len word"
   by transfer simp
 
 lemma uint_ge_0 [iff]: "0 \<le> uint x"
   by (fact unsigned_greater_eq)
 
 lemma uint_lt2p [iff]: "uint x < 2 ^ LENGTH('a)"
   for x :: "'a::len word"
   by (fact unsigned_less)
 
 lemma sint_ge: "- (2 ^ (LENGTH('a) - 1)) \<le> sint x"
   for x :: "'a::len word"
   using sint_greater_eq [of x] by simp
 
 lemma sint_lt: "sint x < 2 ^ (LENGTH('a) - 1)"
   for x :: "'a::len word"
   using sint_less [of x] by simp
 
 lemma uint_m2p_neg: "uint x - 2 ^ LENGTH('a) < 0"
   for x :: "'a::len word"
   by (simp only: diff_less_0_iff_less uint_lt2p)
 
 lemma uint_m2p_not_non_neg: "\<not> 0 \<le> uint x - 2 ^ LENGTH('a)"
   for x :: "'a::len word"
   by (simp only: not_le uint_m2p_neg)
 
 lemma lt2p_lem: "LENGTH('a) \<le> n \<Longrightarrow> uint w < 2 ^ n"
   for w :: "'a::len word"
   using uint_bounded [of w] by (rule less_le_trans) simp
 
 lemma uint_le_0_iff [simp]: "uint x \<le> 0 \<longleftrightarrow> uint x = 0"
   by (fact uint_ge_0 [THEN leD, THEN antisym_conv1])
 
 lemma uint_nat: "uint w = int (unat w)"
   by transfer simp
 
 lemma uint_numeral: "uint (numeral b :: 'a::len word) = numeral b mod 2 ^ LENGTH('a)"
   by (simp flip: take_bit_eq_mod add: of_nat_take_bit)
 
 lemma uint_neg_numeral: "uint (- numeral b :: 'a::len word) = - numeral b mod 2 ^ LENGTH('a)"
   by (simp flip: take_bit_eq_mod add: of_nat_take_bit)
 
 lemma unat_numeral: "unat (numeral b :: 'a::len word) = numeral b mod 2 ^ LENGTH('a)"
   by transfer (simp add: take_bit_eq_mod nat_mod_distrib nat_power_eq)
 
 lemma sint_numeral:
   "sint (numeral b :: 'a::len word) =
     (numeral b + 2 ^ (LENGTH('a) - 1)) mod 2 ^ LENGTH('a) - 2 ^ (LENGTH('a) - 1)"
   by (metis int_word_sint word_numeral_alt)
 
 lemma word_of_int_0 [simp, code_post]: "word_of_int 0 = 0"
   by (fact of_int_0)
 
 lemma word_of_int_1 [simp, code_post]: "word_of_int 1 = 1"
   by (fact of_int_1)
 
 lemma word_of_int_neg_1 [simp]: "word_of_int (- 1) = - 1"
   by (simp add: wi_hom_syms)
 
 lemma word_of_int_numeral [simp] : "(word_of_int (numeral bin) :: 'a::len word) = numeral bin"
   by (fact of_int_numeral)
 
 lemma word_of_int_neg_numeral [simp]:
   "(word_of_int (- numeral bin) :: 'a::len word) = - numeral bin"
   by (fact of_int_neg_numeral)
 
 lemma word_int_case_wi:
   "word_int_case f (word_of_int i :: 'b word) = f (i mod 2 ^ LENGTH('b::len))"
   by transfer (simp add: take_bit_eq_mod)
 
 lemma word_int_split:
   "P (word_int_case f x) =
     (\<forall>i. x = (word_of_int i :: 'b::len word) \<and> 0 \<le> i \<and> i < 2 ^ LENGTH('b) \<longrightarrow> P (f i))"
   by transfer (auto simp add: take_bit_eq_mod)
 
 lemma word_int_split_asm:
   "P (word_int_case f x) =
     (\<nexists>n. x = (word_of_int n :: 'b::len word) \<and> 0 \<le> n \<and> n < 2 ^ LENGTH('b::len) \<and> \<not> P (f n))"
   by transfer (auto simp add: take_bit_eq_mod)
 
 lemma uint_range_size: "0 \<le> uint w \<and> uint w < 2 ^ size w"
   by transfer simp
 
 lemma sint_range_size: "- (2 ^ (size w - Suc 0)) \<le> sint w \<and> sint w < 2 ^ (size w - Suc 0)"
   by (simp add: word_size sint_greater_eq sint_less)
 
 lemma sint_above_size: "2 ^ (size w - 1) \<le> x \<Longrightarrow> sint w < x"
   for w :: "'a::len word"
   unfolding word_size by (rule less_le_trans [OF sint_lt])
 
 lemma sint_below_size: "x \<le> - (2 ^ (size w - 1)) \<Longrightarrow> x \<le> sint w"
   for w :: "'a::len word"
   unfolding word_size by (rule order_trans [OF _ sint_ge])
 
 
 subsection \<open>Testing bits\<close>
 
 lemma bin_nth_uint_imp: "bit (uint w) n \<Longrightarrow> n < LENGTH('a)"
   for w :: "'a::len word"
   by transfer (simp add: bit_take_bit_iff)
 
 lemma bin_nth_sint:
   "LENGTH('a) \<le> n \<Longrightarrow>
     bit (sint w) n = bit (sint w) (LENGTH('a) - 1)"
   for w :: "'a::len word"
   by (transfer fixing: n) (simp add: bit_signed_take_bit_iff le_diff_conv min_def)
 
 lemma num_of_bintr':
   "take_bit (LENGTH('a::len)) (numeral a :: int) = (numeral b) \<Longrightarrow>
     numeral a = (numeral b :: 'a word)"
 proof (transfer fixing: a b)
   assume \<open>take_bit LENGTH('a) (numeral a :: int) = numeral b\<close>
   then have \<open>take_bit LENGTH('a) (take_bit LENGTH('a) (numeral a :: int)) = take_bit LENGTH('a) (numeral b)\<close>
     by simp
   then show \<open>take_bit LENGTH('a) (numeral a :: int) = take_bit LENGTH('a) (numeral b)\<close>
     by simp
 qed
 
 lemma num_of_sbintr':
   "signed_take_bit (LENGTH('a::len) - 1) (numeral a :: int) = (numeral b) \<Longrightarrow>
     numeral a = (numeral b :: 'a word)"
 proof (transfer fixing: a b)
   assume \<open>signed_take_bit (LENGTH('a) - 1) (numeral a :: int) = numeral b\<close>
   then have \<open>take_bit LENGTH('a) (signed_take_bit (LENGTH('a) - 1) (numeral a :: int)) = take_bit LENGTH('a) (numeral b)\<close>
     by simp
   then show \<open>take_bit LENGTH('a) (numeral a :: int) = take_bit LENGTH('a) (numeral b)\<close>
     by (simp add: take_bit_signed_take_bit)
 qed
  
 lemma num_abs_bintr:
   "(numeral x :: 'a word) =
     word_of_int (take_bit (LENGTH('a::len)) (numeral x))"
   by transfer simp
 
 lemma num_abs_sbintr:
   "(numeral x :: 'a word) =
     word_of_int (signed_take_bit (LENGTH('a::len) - 1) (numeral x))"
   by transfer (simp add: take_bit_signed_take_bit)
 
 text \<open>
   \<open>cast\<close> -- note, no arg for new length, as it's determined by type of result,
   thus in \<open>cast w = w\<close>, the type means cast to length of \<open>w\<close>!
 \<close>
 
 lemma bit_ucast_iff:
   \<open>bit (ucast a :: 'a::len word) n \<longleftrightarrow> n < LENGTH('a::len) \<and> Parity.bit a n\<close>
   by transfer (simp add: bit_take_bit_iff)
 
 lemma ucast_id [simp]: "ucast w = w"
   by transfer simp
 
 lemma scast_id [simp]: "scast w = w"
   by transfer (simp add: take_bit_signed_take_bit)
 
 lemma ucast_mask_eq:
   \<open>ucast (mask n :: 'b word) = mask (min LENGTH('b::len) n)\<close>
   by (simp add: bit_eq_iff) (auto simp add: bit_mask_iff bit_ucast_iff exp_eq_zero_iff)
 
 \<comment> \<open>literal u(s)cast\<close>
 lemma ucast_bintr [simp]:
   "ucast (numeral w :: 'a::len word) =
     word_of_int (take_bit (LENGTH('a)) (numeral w))"
   by transfer simp
 
 (* TODO: neg_numeral *)
 
 lemma scast_sbintr [simp]:
   "scast (numeral w ::'a::len word) =
     word_of_int (signed_take_bit (LENGTH('a) - Suc 0) (numeral w))"
   by transfer simp
 
 lemma source_size: "source_size (c::'a::len word \<Rightarrow> _) = LENGTH('a)"
   by transfer simp
 
 lemma target_size: "target_size (c::_ \<Rightarrow> 'b::len word) = LENGTH('b)"
   by transfer simp
 
 lemma is_down: "is_down c \<longleftrightarrow> LENGTH('b) \<le> LENGTH('a)"
   for c :: "'a::len word \<Rightarrow> 'b::len word"
   by transfer simp
 
 lemma is_up: "is_up c \<longleftrightarrow> LENGTH('a) \<le> LENGTH('b)"
   for c :: "'a::len word \<Rightarrow> 'b::len word"
   by transfer simp
 
 lemma is_up_down:
   \<open>is_up c \<longleftrightarrow> is_down d\<close>
   for c :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
   and d :: \<open>'b::len word \<Rightarrow> 'a::len word\<close>
   by transfer simp
 
 context
   fixes dummy_types :: \<open>'a::len \<times> 'b::len\<close>
 begin
 
 private abbreviation (input) UCAST :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
   where \<open>UCAST == ucast\<close>
 
 private abbreviation (input) SCAST :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
   where \<open>SCAST == scast\<close>
 
 lemma down_cast_same:
   \<open>UCAST = scast\<close> if \<open>is_down UCAST\<close>
   by (rule ext, use that in transfer) (simp add: take_bit_signed_take_bit)
 
 lemma sint_up_scast:
   \<open>sint (SCAST w) = sint w\<close> if \<open>is_up SCAST\<close>
   using that by transfer (simp add: min_def Suc_leI le_diff_iff)
 
 lemma uint_up_ucast:
   \<open>uint (UCAST w) = uint w\<close> if \<open>is_up UCAST\<close>
   using that by transfer (simp add: min_def)
 
 lemma ucast_up_ucast:
   \<open>ucast (UCAST w) = ucast w\<close> if \<open>is_up UCAST\<close>
   using that by transfer (simp add: ac_simps)
 
 lemma ucast_up_ucast_id:
   \<open>ucast (UCAST w) = w\<close> if \<open>is_up UCAST\<close>
   using that by (simp add: ucast_up_ucast)
 
 lemma scast_up_scast:
   \<open>scast (SCAST w) = scast w\<close> if \<open>is_up SCAST\<close>
   using that by transfer (simp add: ac_simps)
 
 lemma scast_up_scast_id:
   \<open>scast (SCAST w) = w\<close> if \<open>is_up SCAST\<close>
   using that by (simp add: scast_up_scast)
 
 lemma isduu:
   \<open>is_up UCAST\<close> if \<open>is_down d\<close>
     for d :: \<open>'b word \<Rightarrow> 'a word\<close>
   using that is_up_down [of UCAST d] by simp
 
 lemma isdus:
   \<open>is_up SCAST\<close> if \<open>is_down d\<close>
     for d :: \<open>'b word \<Rightarrow> 'a word\<close>
   using that is_up_down [of SCAST d] by simp
 
 lemmas ucast_down_ucast_id = isduu [THEN ucast_up_ucast_id]
 lemmas scast_down_scast_id = isdus [THEN scast_up_scast_id]
 
 lemma up_ucast_surj:
   \<open>surj (ucast :: 'b word \<Rightarrow> 'a word)\<close> if \<open>is_up UCAST\<close>
   by (rule surjI) (use that in \<open>rule ucast_up_ucast_id\<close>)
 
 lemma up_scast_surj:
   \<open>surj (scast :: 'b word \<Rightarrow> 'a word)\<close> if \<open>is_up SCAST\<close>
   by (rule surjI) (use that in \<open>rule scast_up_scast_id\<close>)
 
 lemma down_ucast_inj:
   \<open>inj_on UCAST A\<close> if \<open>is_down (ucast :: 'b word \<Rightarrow> 'a word)\<close>
   by (rule inj_on_inverseI) (use that in \<open>rule ucast_down_ucast_id\<close>)
 
 lemma down_scast_inj:
   \<open>inj_on SCAST A\<close> if \<open>is_down (scast :: 'b word \<Rightarrow> 'a word)\<close>
   by (rule inj_on_inverseI) (use that in \<open>rule scast_down_scast_id\<close>)
   
 lemma ucast_down_wi:
   \<open>UCAST (word_of_int x) = word_of_int x\<close> if \<open>is_down UCAST\<close>
   using that by transfer simp
 
 lemma ucast_down_no:
   \<open>UCAST (numeral bin) = numeral bin\<close> if \<open>is_down UCAST\<close>
   using that by transfer simp
 
 end
 
 lemmas word_log_defs = word_and_def word_or_def word_xor_def word_not_def
 
 lemma bit_last_iff:
   \<open>bit w (LENGTH('a) - Suc 0) \<longleftrightarrow> sint w < 0\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
   for w :: \<open>'a::len word\<close>
 proof -
   have \<open>?P \<longleftrightarrow> bit (uint w) (LENGTH('a) - Suc 0)\<close>
     by (simp add: bit_uint_iff)
   also have \<open>\<dots> \<longleftrightarrow> ?Q\<close>
     by (simp add: sint_uint)
   finally show ?thesis .
 qed
 
 lemma drop_bit_eq_zero_iff_not_bit_last:
   \<open>drop_bit (LENGTH('a) - Suc 0) w = 0 \<longleftrightarrow> \<not> bit w (LENGTH('a) - Suc 0)\<close>
   for w :: "'a::len word"
 proof (cases \<open>LENGTH('a)\<close>)
   case (Suc n)
   then show ?thesis
     apply transfer
     apply (simp add: take_bit_drop_bit)
     by (simp add: bit_iff_odd_drop_bit drop_bit_take_bit min.absorb2 odd_iff_mod_2_eq_one)
 qed auto
 
 
 subsection \<open>Word Arithmetic\<close>
 
 lemmas word_div_no [simp] = word_div_def [of "numeral a" "numeral b"] for a b
 lemmas word_mod_no [simp] = word_mod_def [of "numeral a" "numeral b"] for a b
 lemmas word_less_no [simp] = word_less_def [of "numeral a" "numeral b"] for a b
 lemmas word_le_no [simp] = word_le_def [of "numeral a" "numeral b"] for a b
 lemmas word_sless_no [simp] = word_sless_eq [of "numeral a" "numeral b"] for a b
 lemmas word_sle_no [simp] = word_sle_eq [of "numeral a" "numeral b"] for a b
 
 lemma size_0_same': "size w = 0 \<Longrightarrow> w = v"
   for v w :: "'a::len word"
   by (unfold word_size) simp
 
 lemmas size_0_same = size_0_same' [unfolded word_size]
 
 lemmas unat_eq_0 = unat_0_iff
 lemmas unat_eq_zero = unat_0_iff
 
 
 subsection \<open>Transferring goals from words to ints\<close>
 
 lemma word_ths:
   shows word_succ_p1: "word_succ a = a + 1"
     and word_pred_m1: "word_pred a = a - 1"
     and word_pred_succ: "word_pred (word_succ a) = a"
     and word_succ_pred: "word_succ (word_pred a) = a"
     and word_mult_succ: "word_succ a * b = b + a * b"
   by (transfer, simp add: algebra_simps)+
 
 lemma uint_cong: "x = y \<Longrightarrow> uint x = uint y"
   by simp
 
 lemma uint_word_ariths:
   fixes a b :: "'a::len word"
   shows "uint (a + b) = (uint a + uint b) mod 2 ^ LENGTH('a::len)"
     and "uint (a - b) = (uint a - uint b) mod 2 ^ LENGTH('a)"
     and "uint (a * b) = uint a * uint b mod 2 ^ LENGTH('a)"
     and "uint (- a) = - uint a mod 2 ^ LENGTH('a)"
     and "uint (word_succ a) = (uint a + 1) mod 2 ^ LENGTH('a)"
     and "uint (word_pred a) = (uint a - 1) mod 2 ^ LENGTH('a)"
     and "uint (0 :: 'a word) = 0 mod 2 ^ LENGTH('a)"
     and "uint (1 :: 'a word) = 1 mod 2 ^ LENGTH('a)"
   by (simp_all only: word_arith_wis uint_word_of_int_eq flip: take_bit_eq_mod)
 
 lemma uint_word_arith_bintrs:
   fixes a b :: "'a::len word"
   shows "uint (a + b) = take_bit (LENGTH('a)) (uint a + uint b)"
     and "uint (a - b) = take_bit (LENGTH('a)) (uint a - uint b)"
     and "uint (a * b) = take_bit (LENGTH('a)) (uint a * uint b)"
     and "uint (- a) = take_bit (LENGTH('a)) (- uint a)"
     and "uint (word_succ a) = take_bit (LENGTH('a)) (uint a + 1)"
     and "uint (word_pred a) = take_bit (LENGTH('a)) (uint a - 1)"
     and "uint (0 :: 'a word) = take_bit (LENGTH('a)) 0"
     and "uint (1 :: 'a word) = take_bit (LENGTH('a)) 1"
   by (simp_all add: uint_word_ariths take_bit_eq_mod)
 
 lemma sint_word_ariths:
   fixes a b :: "'a::len word"
   shows "sint (a + b) = signed_take_bit (LENGTH('a) - 1) (sint a + sint b)"
     and "sint (a - b) = signed_take_bit (LENGTH('a) - 1) (sint a - sint b)"
     and "sint (a * b) = signed_take_bit (LENGTH('a) - 1) (sint a * sint b)"
     and "sint (- a) = signed_take_bit (LENGTH('a) - 1) (- sint a)"
     and "sint (word_succ a) = signed_take_bit (LENGTH('a) - 1) (sint a + 1)"
     and "sint (word_pred a) = signed_take_bit (LENGTH('a) - 1) (sint a - 1)"
     and "sint (0 :: 'a word) = signed_take_bit (LENGTH('a) - 1) 0"
     and "sint (1 :: 'a word) = signed_take_bit (LENGTH('a) - 1) 1"
   subgoal
     by transfer (simp add: signed_take_bit_add)
   subgoal
     by transfer (simp add: signed_take_bit_diff)
   subgoal
     by transfer (simp add: signed_take_bit_mult)
   subgoal
     by transfer (simp add: signed_take_bit_minus)
      apply (metis of_int_sint scast_id sint_sbintrunc' wi_hom_succ)
     apply (metis of_int_sint scast_id sint_sbintrunc' wi_hom_pred)
    apply (simp_all add: sint_uint)
   done
 
 lemma word_pred_0_n1: "word_pred 0 = word_of_int (- 1)"
   unfolding word_pred_m1 by simp
 
 lemma succ_pred_no [simp]:
     "word_succ (numeral w) = numeral w + 1"
     "word_pred (numeral w) = numeral w - 1"
     "word_succ (- numeral w) = - numeral w + 1"
     "word_pred (- numeral w) = - numeral w - 1"
   by (simp_all add: word_succ_p1 word_pred_m1)
 
 lemma word_sp_01 [simp]:
   "word_succ (- 1) = 0 \<and> word_succ 0 = 1 \<and> word_pred 0 = - 1 \<and> word_pred 1 = 0"
   by (simp_all add: word_succ_p1 word_pred_m1)
 
 \<comment> \<open>alternative approach to lifting arithmetic equalities\<close>
 lemma word_of_int_Ex: "\<exists>y. x = word_of_int y"
   by (rule_tac x="uint x" in exI) simp
 
 
 subsection \<open>Order on fixed-length words\<close>
 
 lift_definition udvd :: \<open>'a::len word \<Rightarrow> 'a::len word \<Rightarrow> bool\<close> (infixl \<open>udvd\<close> 50)
   is \<open>\<lambda>k l. take_bit LENGTH('a) k dvd take_bit LENGTH('a) l\<close> by simp
 
 lemma udvd_iff_dvd:
   \<open>x udvd y \<longleftrightarrow> unat x dvd unat y\<close>
   by transfer (simp add: nat_dvd_iff)
 
 lemma udvd_iff_dvd_int:
   \<open>v udvd w \<longleftrightarrow> uint v dvd uint w\<close>
   by transfer rule
 
 lemma udvdI [intro]:
   \<open>v udvd w\<close> if \<open>unat w = unat v * unat u\<close>
 proof -
   from that have \<open>unat v dvd unat w\<close> ..
   then show ?thesis
     by (simp add: udvd_iff_dvd)
 qed
 
 lemma udvdE [elim]:
   fixes v w :: \<open>'a::len word\<close>
   assumes \<open>v udvd w\<close>
   obtains u :: \<open>'a word\<close> where \<open>unat w = unat v * unat u\<close>
 proof (cases \<open>v = 0\<close>)
   case True
   moreover from True \<open>v udvd w\<close> have \<open>w = 0\<close>
     by transfer simp
   ultimately show thesis
     using that by simp
 next
   case False
   then have \<open>unat v > 0\<close>
     by (simp add: unat_gt_0)
   from \<open>v udvd w\<close> have \<open>unat v dvd unat w\<close>
     by (simp add: udvd_iff_dvd)
   then obtain n where \<open>unat w = unat v * n\<close> ..
   moreover have \<open>n < 2 ^ LENGTH('a)\<close>
   proof (rule ccontr)
     assume \<open>\<not> n < 2 ^ LENGTH('a)\<close>
     then have \<open>n \<ge> 2 ^ LENGTH('a)\<close>
       by (simp add: not_le)
     then have \<open>unat v * n \<ge> 2 ^ LENGTH('a)\<close>
       using \<open>unat v > 0\<close> mult_le_mono [of 1 \<open>unat v\<close> \<open>2 ^ LENGTH('a)\<close> n]
       by simp
     with \<open>unat w = unat v * n\<close>
     have \<open>unat w \<ge> 2 ^ LENGTH('a)\<close>
       by simp
     with unsigned_less [of w, where ?'a = nat] show False
       by linarith
   qed
   ultimately have \<open>unat w = unat v * unat (word_of_nat n :: 'a word)\<close>
     by (auto simp add: take_bit_nat_eq_self_iff intro: sym)
   with that show thesis .
 qed
 
 lemma udvd_imp_mod_eq_0:
   \<open>w mod v = 0\<close> if \<open>v udvd w\<close>
   using that by transfer simp
 
 lemma mod_eq_0_imp_udvd [intro?]:
   \<open>v udvd w\<close> if \<open>w mod v = 0\<close>
 proof -
   from that have \<open>unat (w mod v) = unat 0\<close>
     by simp
   then have \<open>unat w mod unat v = 0\<close>
     by (simp add: unat_mod_distrib)
   then have \<open>unat v dvd unat w\<close> ..
   then show ?thesis
     by (simp add: udvd_iff_dvd)
 qed
 
 lemma udvd_imp_dvd:
   \<open>v dvd w\<close> if \<open>v udvd w\<close> for v w :: \<open>'a::len word\<close>
 proof -
   from that obtain u :: \<open>'a word\<close> where \<open>unat w = unat v * unat u\<close> ..
   then have \<open>(word_of_nat (unat w) :: 'a word) = word_of_nat (unat v * unat u)\<close>
     by simp
   then have \<open>w = v * u\<close>
     by simp
   then show \<open>v dvd w\<close> ..
 qed
 
 lemma exp_dvd_iff_exp_udvd:
   \<open>2 ^ n dvd w \<longleftrightarrow> 2 ^ n udvd w\<close> for v w :: \<open>'a::len word\<close>
 proof
   assume \<open>2 ^ n udvd w\<close> then show \<open>2 ^ n dvd w\<close>
     by (rule udvd_imp_dvd) 
 next
   assume \<open>2 ^ n dvd w\<close>
   then obtain u :: \<open>'a word\<close> where \<open>w = 2 ^ n * u\<close> ..
   then have \<open>w = push_bit n u\<close>
     by (simp add: push_bit_eq_mult)
   then show \<open>2 ^ n udvd w\<close>
     by transfer (simp add: take_bit_push_bit dvd_eq_mod_eq_0 flip: take_bit_eq_mod)
 qed
 
 lemma udvd_nat_alt:
   \<open>a udvd b \<longleftrightarrow> (\<exists>n. unat b = n * unat a)\<close>
   by (auto simp add: udvd_iff_dvd)
 
 lemma udvd_unfold_int:
   \<open>a udvd b \<longleftrightarrow> (\<exists>n\<ge>0. uint b = n * uint a)\<close>
   unfolding udvd_iff_dvd_int
   by (metis dvd_div_mult_self dvd_triv_right uint_div_distrib uint_ge_0)
 
 lemma unat_minus_one:
   \<open>unat (w - 1) = unat w - 1\<close> if \<open>w \<noteq> 0\<close>
 proof -
   have "0 \<le> uint w" by (fact uint_nonnegative)
   moreover from that have "0 \<noteq> uint w"
     by (simp add: uint_0_iff)
   ultimately have "1 \<le> uint w"
     by arith
   from uint_lt2p [of w] have "uint w - 1 < 2 ^ LENGTH('a)"
     by arith
   with \<open>1 \<le> uint w\<close> have "(uint w - 1) mod 2 ^ LENGTH('a) = uint w - 1"
     by (auto intro: mod_pos_pos_trivial)
   with \<open>1 \<le> uint w\<close> have "nat ((uint w - 1) mod 2 ^ LENGTH('a)) = nat (uint w) - 1"
     by (auto simp del: nat_uint_eq)
   then show ?thesis
     by (simp only: unat_eq_nat_uint word_arith_wis mod_diff_right_eq)
       (metis of_int_1 uint_word_of_int unsigned_1)
 qed
 
 lemma measure_unat: "p \<noteq> 0 \<Longrightarrow> unat (p - 1) < unat p"
   by (simp add: unat_minus_one) (simp add: unat_0_iff [symmetric])
 
 lemmas uint_add_ge0 [simp] = add_nonneg_nonneg [OF uint_ge_0 uint_ge_0]
 lemmas uint_mult_ge0 [simp] = mult_nonneg_nonneg [OF uint_ge_0 uint_ge_0]
 
 lemma uint_sub_lt2p [simp]: "uint x - uint y < 2 ^ LENGTH('a)"
   for x :: "'a::len word" and y :: "'b::len word"
   using uint_ge_0 [of y] uint_lt2p [of x] by arith
 
 
 subsection \<open>Conditions for the addition (etc) of two words to overflow\<close>
 
 lemma uint_add_lem:
   "(uint x + uint y < 2 ^ LENGTH('a)) =
     (uint (x + y) = uint x + uint y)"
   for x y :: "'a::len word"
   by (metis add.right_neutral add_mono_thms_linordered_semiring(1) mod_pos_pos_trivial of_nat_0_le_iff uint_lt2p uint_nat uint_word_ariths(1))
 
 lemma uint_mult_lem:
   "(uint x * uint y < 2 ^ LENGTH('a)) =
     (uint (x * y) = uint x * uint y)"
   for x y :: "'a::len word"
   by (metis mod_pos_pos_trivial uint_lt2p uint_mult_ge0 uint_word_ariths(3))
 
 lemma uint_sub_lem: "uint x \<ge> uint y \<longleftrightarrow> uint (x - y) = uint x - uint y"
   by (metis diff_ge_0_iff_ge of_nat_0_le_iff uint_nat uint_sub_lt2p uint_word_of_int unique_euclidean_semiring_numeral_class.mod_less word_sub_wi)
 
 lemma uint_add_le: "uint (x + y) \<le> uint x + uint y"
   unfolding uint_word_ariths by (simp add: zmod_le_nonneg_dividend) 
 
 lemma uint_sub_ge: "uint (x - y) \<ge> uint x - uint y"
   unfolding uint_word_ariths
   by (simp flip: take_bit_eq_mod add: take_bit_int_greater_eq_self_iff)
 
 lemma int_mod_ge: \<open>a \<le> a mod n\<close> if \<open>a < n\<close> \<open>0 < n\<close>
   for a n :: int
 proof (cases \<open>a < 0\<close>)
   case True
   with \<open>0 < n\<close> show ?thesis
     by (metis less_trans not_less pos_mod_conj)
     
 next
   case False
   with \<open>a < n\<close> show ?thesis
     by simp
 qed
 
 lemma mod_add_if_z:
   "\<lbrakk>x < z; y < z; 0 \<le> y; 0 \<le> x; 0 \<le> z\<rbrakk> \<Longrightarrow>
     (x + y) mod z = (if x + y < z then x + y else x + y - z)"
   for x y z :: int
   apply (simp add: not_less)
   by (metis (no_types) add_strict_mono diff_ge_0_iff_ge diff_less_eq minus_mod_self2 mod_pos_pos_trivial)
 
 lemma uint_plus_if':
   "uint (a + b) =
     (if uint a + uint b < 2 ^ LENGTH('a) then uint a + uint b
      else uint a + uint b - 2 ^ LENGTH('a))"
   for a b :: "'a::len word"
   using mod_add_if_z [of "uint a" _ "uint b"] by (simp add: uint_word_ariths)
 
 lemma mod_sub_if_z:
   "\<lbrakk>x < z; y < z; 0 \<le> y; 0 \<le> x; 0 \<le> z\<rbrakk> \<Longrightarrow>
     (x - y) mod z = (if y \<le> x then x - y else x - y + z)"
   for x y z :: int
   using mod_pos_pos_trivial [of "x - y + z" z] by (auto simp add: not_le)
 
 lemma uint_sub_if':
   "uint (a - b) =
     (if uint b \<le> uint a then uint a - uint b
      else uint a - uint b + 2 ^ LENGTH('a))"
   for a b :: "'a::len word"
   using mod_sub_if_z [of "uint a" _ "uint b"] by (simp add: uint_word_ariths)
 
 
 subsection \<open>Definition of \<open>uint_arith\<close>\<close>
 
 lemma word_of_int_inverse:
   "word_of_int r = a \<Longrightarrow> 0 \<le> r \<Longrightarrow> r < 2 ^ LENGTH('a) \<Longrightarrow> uint a = r"
   for a :: "'a::len word"
   by transfer (simp add: take_bit_int_eq_self)
 
 lemma uint_split:
   "P (uint x) = (\<forall>i. word_of_int i = x \<and> 0 \<le> i \<and> i < 2^LENGTH('a) \<longrightarrow> P i)"
   for x :: "'a::len word"
   by transfer (auto simp add: take_bit_eq_mod)
 
 lemma uint_split_asm:
   "P (uint x) = (\<nexists>i. word_of_int i = x \<and> 0 \<le> i \<and> i < 2^LENGTH('a) \<and> \<not> P i)"
   for x :: "'a::len word"
   by auto (metis take_bit_int_eq_self_iff)
 
 lemmas uint_splits = uint_split uint_split_asm
 
 lemmas uint_arith_simps =
   word_le_def word_less_alt
   word_uint_eq_iff
   uint_sub_if' uint_plus_if'
 
 \<comment> \<open>use this to stop, eg. \<open>2 ^ LENGTH(32)\<close> being simplified\<close>
 lemma power_False_cong: "False \<Longrightarrow> a ^ b = c ^ d"
   by auto
 
 \<comment> \<open>\<open>uint_arith_tac\<close>: reduce to arithmetic on int, try to solve by arith\<close>
 ML \<open>
 val uint_arith_simpset =
   @{context}
   |> fold Simplifier.add_simp @{thms uint_arith_simps}
   |> fold Splitter.add_split @{thms if_split_asm}
   |> fold Simplifier.add_cong @{thms power_False_cong}
   |> simpset_of;
   
 fun uint_arith_tacs ctxt =
   let
     fun arith_tac' n t =
       Arith_Data.arith_tac ctxt n t
         handle Cooper.COOPER _ => Seq.empty;
   in
     [ clarify_tac ctxt 1,
       full_simp_tac (put_simpset uint_arith_simpset ctxt) 1,
       ALLGOALS (full_simp_tac
         (put_simpset HOL_ss ctxt
           |> fold Splitter.add_split @{thms uint_splits}
           |> fold Simplifier.add_cong @{thms power_False_cong})),
       rewrite_goals_tac ctxt @{thms word_size},
       ALLGOALS  (fn n => REPEAT (resolve_tac ctxt [allI, impI] n) THEN
                          REPEAT (eresolve_tac ctxt [conjE] n) THEN
                          REPEAT (dresolve_tac ctxt @{thms word_of_int_inverse} n
                                  THEN assume_tac ctxt n
                                  THEN assume_tac ctxt n)),
       TRYALL arith_tac' ]
   end
 
 fun uint_arith_tac ctxt = SELECT_GOAL (EVERY (uint_arith_tacs ctxt))
 \<close>
 
 method_setup uint_arith =
   \<open>Scan.succeed (SIMPLE_METHOD' o uint_arith_tac)\<close>
   "solving word arithmetic via integers and arith"
 
 
 subsection \<open>More on overflows and monotonicity\<close>
 
 lemma no_plus_overflow_uint_size: "x \<le> x + y \<longleftrightarrow> uint x + uint y < 2 ^ size x"
   for x y :: "'a::len word"
   unfolding word_size by uint_arith
 
 lemmas no_olen_add = no_plus_overflow_uint_size [unfolded word_size]
 
 lemma no_ulen_sub: "x \<ge> x - y \<longleftrightarrow> uint y \<le> uint x"
   for x y :: "'a::len word"
   by uint_arith
 
 lemma no_olen_add': "x \<le> y + x \<longleftrightarrow> uint y + uint x < 2 ^ LENGTH('a)"
   for x y :: "'a::len word"
   by (simp add: ac_simps no_olen_add)
 
 lemmas olen_add_eqv = trans [OF no_olen_add no_olen_add' [symmetric]]
 
 lemmas uint_plus_simple_iff = trans [OF no_olen_add uint_add_lem]
 lemmas uint_plus_simple = uint_plus_simple_iff [THEN iffD1]
 lemmas uint_minus_simple_iff = trans [OF no_ulen_sub uint_sub_lem]
 lemmas uint_minus_simple_alt = uint_sub_lem [folded word_le_def]
 lemmas word_sub_le_iff = no_ulen_sub [folded word_le_def]
 lemmas word_sub_le = word_sub_le_iff [THEN iffD2]
 
 lemma word_less_sub1: "x \<noteq> 0 \<Longrightarrow> 1 < x \<longleftrightarrow> 0 < x - 1"
   for x :: "'a::len word"
   by uint_arith
 
 lemma word_le_sub1: "x \<noteq> 0 \<Longrightarrow> 1 \<le> x \<longleftrightarrow> 0 \<le> x - 1"
   for x :: "'a::len word"
   by uint_arith
 
 lemma sub_wrap_lt: "x < x - z \<longleftrightarrow> x < z"
   for x z :: "'a::len word"
   by uint_arith
 
 lemma sub_wrap: "x \<le> x - z \<longleftrightarrow> z = 0 \<or> x < z"
   for x z :: "'a::len word"
   by uint_arith
 
 lemma plus_minus_not_NULL_ab: "x \<le> ab - c \<Longrightarrow> c \<le> ab \<Longrightarrow> c \<noteq> 0 \<Longrightarrow> x + c \<noteq> 0"
   for x ab c :: "'a::len word"
   by uint_arith
 
 lemma plus_minus_no_overflow_ab: "x \<le> ab - c \<Longrightarrow> c \<le> ab \<Longrightarrow> x \<le> x + c"
   for x ab c :: "'a::len word"
   by uint_arith
 
 lemma le_minus': "a + c \<le> b \<Longrightarrow> a \<le> a + c \<Longrightarrow> c \<le> b - a"
   for a b c :: "'a::len word"
   by uint_arith
 
 lemma le_plus': "a \<le> b \<Longrightarrow> c \<le> b - a \<Longrightarrow> a + c \<le> b"
   for a b c :: "'a::len word"
   by uint_arith
 
 lemmas le_plus = le_plus' [rotated]
 
 lemmas le_minus = leD [THEN thin_rl, THEN le_minus'] (* FIXME *)
 
 lemma word_plus_mono_right: "y \<le> z \<Longrightarrow> x \<le> x + z \<Longrightarrow> x + y \<le> x + z"
   for x y z :: "'a::len word"
   by uint_arith
 
 lemma word_less_minus_cancel: "y - x < z - x \<Longrightarrow> x \<le> z \<Longrightarrow> y < z"
   for x y z :: "'a::len word"
   by uint_arith
 
 lemma word_less_minus_mono_left: "y < z \<Longrightarrow> x \<le> y \<Longrightarrow> y - x < z - x"
   for x y z :: "'a::len word"
   by uint_arith
 
 lemma word_less_minus_mono: "a < c \<Longrightarrow> d < b \<Longrightarrow> a - b < a \<Longrightarrow> c - d < c \<Longrightarrow> a - b < c - d"
   for a b c d :: "'a::len word"
   by uint_arith
 
 lemma word_le_minus_cancel: "y - x \<le> z - x \<Longrightarrow> x \<le> z \<Longrightarrow> y \<le> z"
   for x y z :: "'a::len word"
   by uint_arith
 
 lemma word_le_minus_mono_left: "y \<le> z \<Longrightarrow> x \<le> y \<Longrightarrow> y - x \<le> z - x"
   for x y z :: "'a::len word"
   by uint_arith
 
 lemma word_le_minus_mono:
   "a \<le> c \<Longrightarrow> d \<le> b \<Longrightarrow> a - b \<le> a \<Longrightarrow> c - d \<le> c \<Longrightarrow> a - b \<le> c - d"
   for a b c d :: "'a::len word"
   by uint_arith
 
 lemma plus_le_left_cancel_wrap: "x + y' < x \<Longrightarrow> x + y < x \<Longrightarrow> x + y' < x + y \<longleftrightarrow> y' < y"
   for x y y' :: "'a::len word"
   by uint_arith
 
 lemma plus_le_left_cancel_nowrap: "x \<le> x + y' \<Longrightarrow> x \<le> x + y \<Longrightarrow> x + y' < x + y \<longleftrightarrow> y' < y"
   for x y y' :: "'a::len word"
   by uint_arith
 
 lemma word_plus_mono_right2: "a \<le> a + b \<Longrightarrow> c \<le> b \<Longrightarrow> a \<le> a + c"
   for a b c :: "'a::len word"
   by uint_arith
 
 lemma word_less_add_right: "x < y - z \<Longrightarrow> z \<le> y \<Longrightarrow> x + z < y"
   for x y z :: "'a::len word"
   by uint_arith
 
 lemma word_less_sub_right: "x < y + z \<Longrightarrow> y \<le> x \<Longrightarrow> x - y < z"
   for x y z :: "'a::len word"
   by uint_arith
 
 lemma word_le_plus_either: "x \<le> y \<or> x \<le> z \<Longrightarrow> y \<le> y + z \<Longrightarrow> x \<le> y + z"
   for x y z :: "'a::len word"
   by uint_arith
 
 lemma word_less_nowrapI: "x < z - k \<Longrightarrow> k \<le> z \<Longrightarrow> 0 < k \<Longrightarrow> x < x + k"
   for x z k :: "'a::len word"
   by uint_arith
 
 lemma inc_le: "i < m \<Longrightarrow> i + 1 \<le> m"
   for i m :: "'a::len word"
   by uint_arith
 
 lemma inc_i: "1 \<le> i \<Longrightarrow> i < m \<Longrightarrow> 1 \<le> i + 1 \<and> i + 1 \<le> m"
   for i m :: "'a::len word"
   by uint_arith
 
 lemma udvd_incr_lem:
   "up < uq \<Longrightarrow> up = ua + n * uint K \<Longrightarrow>
     uq = ua + n' * uint K \<Longrightarrow> up + uint K \<le> uq"
   by auto (metis int_distrib(1) linorder_not_less mult.left_neutral mult_right_mono uint_nonnegative zless_imp_add1_zle)
 
 lemma udvd_incr':
   "p < q \<Longrightarrow> uint p = ua + n * uint K \<Longrightarrow>
     uint q = ua + n' * uint K \<Longrightarrow> p + K \<le> q"
   unfolding word_less_alt word_le_def
   by (metis (full_types) order_trans udvd_incr_lem uint_add_le)
 
 lemma udvd_decr':
   assumes "p < q" "uint p = ua + n * uint K" "uint q = ua + n' * uint K"
     shows "uint q = ua + n' * uint K \<Longrightarrow> p \<le> q - K"
 proof -
   have "\<And>w wa. uint (w::'a word) \<le> uint wa + uint (w - wa)"
     by (metis (no_types) add_diff_cancel_left' diff_add_cancel uint_add_le)
   moreover have "uint K + uint p \<le> uint q"
     using assms by (metis (no_types) add_diff_cancel_left' diff_add_cancel udvd_incr_lem word_less_def)
   ultimately show ?thesis
     by (meson add_le_cancel_left order_trans word_less_eq_iff_unsigned)
 qed
 
 lemmas udvd_incr_lem0 = udvd_incr_lem [where ua=0, unfolded add_0_left]
 lemmas udvd_incr0 = udvd_incr' [where ua=0, unfolded add_0_left]
 lemmas udvd_decr0 = udvd_decr' [where ua=0, unfolded add_0_left]
 
 lemma udvd_minus_le': "xy < k \<Longrightarrow> z udvd xy \<Longrightarrow> z udvd k \<Longrightarrow> xy \<le> k - z"
   unfolding udvd_unfold_int
   by (meson udvd_decr0)
 
 lemma udvd_incr2_K:
   "p < a + s \<Longrightarrow> a \<le> a + s \<Longrightarrow> K udvd s \<Longrightarrow> K udvd p - a \<Longrightarrow> a \<le> p \<Longrightarrow>
     0 < K \<Longrightarrow> p \<le> p + K \<and> p + K \<le> a + s"
   unfolding udvd_unfold_int
   apply (simp add: uint_arith_simps split: if_split_asm)
   apply (metis (no_types, hide_lams) le_add_diff_inverse le_less_trans udvd_incr_lem)
   using uint_lt2p [of s] by simp
 
 
 subsection \<open>Arithmetic type class instantiations\<close>
 
 lemmas word_le_0_iff [simp] =
   word_zero_le [THEN leD, THEN antisym_conv1]
 
 lemma word_of_int_nat: "0 \<le> x \<Longrightarrow> word_of_int x = of_nat (nat x)"
   by simp
 
 text \<open>
   note that \<open>iszero_def\<close> is only for class \<open>comm_semiring_1_cancel\<close>,
   which requires word length \<open>\<ge> 1\<close>, ie \<open>'a::len word\<close>
 \<close>
 lemma iszero_word_no [simp]:
   "iszero (numeral bin :: 'a::len word) =
     iszero (take_bit LENGTH('a) (numeral bin :: int))"
   by (metis iszero_def uint_0_iff uint_bintrunc)
 
 text \<open>Use \<open>iszero\<close> to simplify equalities between word numerals.\<close>
 
 lemmas word_eq_numeral_iff_iszero [simp] =
   eq_numeral_iff_iszero [where 'a="'a::len word"]
 
 
 subsection \<open>Word and nat\<close>
 
 lemma word_nchotomy: "\<forall>w :: 'a::len word. \<exists>n. w = of_nat n \<and> n < 2 ^ LENGTH('a)"
   by (metis of_nat_unat ucast_id unsigned_less)
 
 lemma of_nat_eq: "of_nat n = w \<longleftrightarrow> (\<exists>q. n = unat w + q * 2 ^ LENGTH('a))"
   for w :: "'a::len word"
   using mod_div_mult_eq [of n "2 ^ LENGTH('a)", symmetric]
   by (auto simp flip: take_bit_eq_mod)
 
 lemma of_nat_eq_size: "of_nat n = w \<longleftrightarrow> (\<exists>q. n = unat w + q * 2 ^ size w)"
   unfolding word_size by (rule of_nat_eq)
 
 lemma of_nat_0: "of_nat m = (0::'a::len word) \<longleftrightarrow> (\<exists>q. m = q * 2 ^ LENGTH('a))"
   by (simp add: of_nat_eq)
 
 lemma of_nat_2p [simp]: "of_nat (2 ^ LENGTH('a)) = (0::'a::len word)"
   by (fact mult_1 [symmetric, THEN iffD2 [OF of_nat_0 exI]])
 
 lemma of_nat_gt_0: "of_nat k \<noteq> 0 \<Longrightarrow> 0 < k"
   by (cases k) auto
 
 lemma of_nat_neq_0: "0 < k \<Longrightarrow> k < 2 ^ LENGTH('a::len) \<Longrightarrow> of_nat k \<noteq> (0 :: 'a word)"
   by (auto simp add : of_nat_0)
 
 lemma Abs_fnat_hom_add: "of_nat a + of_nat b = of_nat (a + b)"
   by simp
 
 lemma Abs_fnat_hom_mult: "of_nat a * of_nat b = (of_nat (a * b) :: 'a::len word)"
   by (simp add: wi_hom_mult)
 
 lemma Abs_fnat_hom_Suc: "word_succ (of_nat a) = of_nat (Suc a)"
   by transfer (simp add: ac_simps)
 
 lemma Abs_fnat_hom_0: "(0::'a::len word) = of_nat 0"
   by simp
 
 lemma Abs_fnat_hom_1: "(1::'a::len word) = of_nat (Suc 0)"
   by simp
 
 lemmas Abs_fnat_homs =
   Abs_fnat_hom_add Abs_fnat_hom_mult Abs_fnat_hom_Suc
   Abs_fnat_hom_0 Abs_fnat_hom_1
 
 lemma word_arith_nat_add: "a + b = of_nat (unat a + unat b)"
   by simp
 
 lemma word_arith_nat_mult: "a * b = of_nat (unat a * unat b)"
   by simp
 
 lemma word_arith_nat_Suc: "word_succ a = of_nat (Suc (unat a))"
   by (subst Abs_fnat_hom_Suc [symmetric]) simp
 
 lemma word_arith_nat_div: "a div b = of_nat (unat a div unat b)"
   by (metis of_int_of_nat_eq of_nat_unat of_nat_div word_div_def)
   
 lemma word_arith_nat_mod: "a mod b = of_nat (unat a mod unat b)"
   by (metis of_int_of_nat_eq of_nat_mod of_nat_unat word_mod_def)
 
 lemmas word_arith_nat_defs =
   word_arith_nat_add word_arith_nat_mult
   word_arith_nat_Suc Abs_fnat_hom_0
   Abs_fnat_hom_1 word_arith_nat_div
   word_arith_nat_mod
 
 lemma unat_cong: "x = y \<Longrightarrow> unat x = unat y"
   by (fact arg_cong)
 
 lemma unat_of_nat:
   \<open>unat (word_of_nat x :: 'a::len word) = x mod 2 ^ LENGTH('a)\<close>
   by transfer (simp flip: take_bit_eq_mod add: nat_take_bit_eq)
 
 lemmas unat_word_ariths = word_arith_nat_defs
   [THEN trans [OF unat_cong unat_of_nat]]
 
 lemmas word_sub_less_iff = word_sub_le_iff
   [unfolded linorder_not_less [symmetric] Not_eq_iff]
 
 lemma unat_add_lem:
   "unat x + unat y < 2 ^ LENGTH('a) \<longleftrightarrow> unat (x + y) = unat x + unat y"
   for x y :: "'a::len word"
   by (metis mod_less unat_word_ariths(1) unsigned_less)
 
 lemma unat_mult_lem:
   "unat x * unat y < 2 ^ LENGTH('a) \<longleftrightarrow> unat (x * y) = unat x * unat y"
   for x y :: "'a::len word"
   by (metis mod_less unat_word_ariths(2) unsigned_less)
 
 lemma unat_plus_if':
   \<open>unat (a + b) =
     (if unat a + unat b < 2 ^ LENGTH('a)
     then unat a + unat b
     else unat a + unat b - 2 ^ LENGTH('a))\<close> for a b :: \<open>'a::len word\<close>
   apply (auto simp: unat_word_ariths not_less le_iff_add)
   by (metis add.commute add_less_cancel_right add_strict_mono mod_less unsigned_less)
 
 lemma le_no_overflow: "x \<le> b \<Longrightarrow> a \<le> a + b \<Longrightarrow> x \<le> a + b"
   for a b x :: "'a::len word"
   using word_le_plus_either by blast
 
 lemmas un_ui_le =
   trans [OF word_le_nat_alt [symmetric] word_le_def]
 
 lemma unat_sub_if_size:
   "unat (x - y) =
     (if unat y \<le> unat x
      then unat x - unat y
      else unat x + 2 ^ size x - unat y)"
 proof -
   { assume xy: "\<not> uint y \<le> uint x"
     have "nat (uint x - uint y + 2 ^ LENGTH('a)) = nat (uint x + 2 ^ LENGTH('a) - uint y)"
       by simp
     also have "... = nat (uint x + 2 ^ LENGTH('a)) - nat (uint y)"
       by (simp add: nat_diff_distrib')
     also have "... = nat (uint x) + 2 ^ LENGTH('a) - nat (uint y)"
       by (metis nat_add_distrib nat_eq_numeral_power_cancel_iff order_less_imp_le unsigned_0 unsigned_greater_eq unsigned_less)
     finally have "nat (uint x - uint y + 2 ^ LENGTH('a)) = nat (uint x) + 2 ^ LENGTH('a) - nat (uint y)" .
   }
   then show ?thesis
   unfolding word_size
   by (metis nat_diff_distrib' uint_sub_if' un_ui_le unat_eq_nat_uint unsigned_greater_eq)
 qed
 
 lemmas unat_sub_if' = unat_sub_if_size [unfolded word_size]
 
 lemma uint_div:
   \<open>uint (x div y) = uint x div uint y\<close>
   by (fact uint_div_distrib)
 
 lemma unat_div:
   \<open>unat (x div y) = unat x div unat y\<close>
   by (fact unat_div_distrib)
 
 lemma uint_mod:
   \<open>uint (x mod y) = uint x mod uint y\<close>
   by (fact uint_mod_distrib)
   
 lemma unat_mod:
   \<open>unat (x mod y) = unat x mod unat y\<close>
   by (fact unat_mod_distrib)
 
 
 text \<open>Definition of \<open>unat_arith\<close> tactic\<close>
 
 lemma unat_split: "P (unat x) \<longleftrightarrow> (\<forall>n. of_nat n = x \<and> n < 2^LENGTH('a) \<longrightarrow> P n)"
   for x :: "'a::len word"
   by auto (metis take_bit_nat_eq_self_iff)
 
 lemma unat_split_asm: "P (unat x) \<longleftrightarrow> (\<nexists>n. of_nat n = x \<and> n < 2^LENGTH('a) \<and> \<not> P n)"
   for x :: "'a::len word"
   by auto (metis take_bit_nat_eq_self_iff)
 
 lemma of_nat_inverse:
   \<open>word_of_nat r = a \<Longrightarrow> r < 2 ^ LENGTH('a) \<Longrightarrow> unat a = r\<close>
   for a :: \<open>'a::len word\<close>
   by (metis mod_if unat_of_nat)
 
 lemma word_unat_eq_iff:
   \<open>v = w \<longleftrightarrow> unat v = unat w\<close>
   for v w :: \<open>'a::len word\<close>
   by (fact word_eq_iff_unsigned)
 
 lemmas unat_splits = unat_split unat_split_asm
 
 lemmas unat_arith_simps =
   word_le_nat_alt word_less_nat_alt
   word_unat_eq_iff
   unat_sub_if' unat_plus_if' unat_div unat_mod
 
 \<comment> \<open>\<open>unat_arith_tac\<close>: tactic to reduce word arithmetic to \<open>nat\<close>, try to solve via \<open>arith\<close>\<close>
 ML \<open>
 val unat_arith_simpset =
   @{context} (* TODO: completely explicitly determined simpset *)
   |> fold Simplifier.del_simp @{thms unsigned_of_nat unsigned_of_int}
   |> fold Simplifier.add_simp @{thms unat_arith_simps}
   |> fold Splitter.add_split @{thms if_split_asm}
   |> fold Simplifier.add_cong @{thms power_False_cong}
   |> simpset_of
 
 fun unat_arith_tacs ctxt =
   let
     fun arith_tac' n t =
       Arith_Data.arith_tac ctxt n t
         handle Cooper.COOPER _ => Seq.empty;
   in
     [ clarify_tac ctxt 1,
       full_simp_tac (put_simpset unat_arith_simpset ctxt) 1,
       ALLGOALS (full_simp_tac
         (put_simpset HOL_ss ctxt
           |> fold Splitter.add_split @{thms unat_splits}
           |> fold Simplifier.add_cong @{thms power_False_cong})),
       rewrite_goals_tac ctxt @{thms word_size},
       ALLGOALS (fn n => REPEAT (resolve_tac ctxt [allI, impI] n) THEN
                          REPEAT (eresolve_tac ctxt [conjE] n) THEN
                          REPEAT (dresolve_tac ctxt @{thms of_nat_inverse} n THEN assume_tac ctxt n)),
       TRYALL arith_tac' ]
   end
 
 fun unat_arith_tac ctxt = SELECT_GOAL (EVERY (unat_arith_tacs ctxt))
 \<close>
 
 method_setup unat_arith =
   \<open>Scan.succeed (SIMPLE_METHOD' o unat_arith_tac)\<close>
   "solving word arithmetic via natural numbers and arith"
 
 lemma no_plus_overflow_unat_size: "x \<le> x + y \<longleftrightarrow> unat x + unat y < 2 ^ size x"
   for x y :: "'a::len word"
   unfolding word_size by unat_arith
 
 lemmas no_olen_add_nat =
   no_plus_overflow_unat_size [unfolded word_size]
 
 lemmas unat_plus_simple =
   trans [OF no_olen_add_nat unat_add_lem]
 
 lemma word_div_mult: "\<lbrakk>0 < y; unat x * unat y < 2 ^ LENGTH('a)\<rbrakk> \<Longrightarrow> x * y div y = x"
   for x y :: "'a::len word"
   by (simp add: unat_eq_zero unat_mult_lem word_arith_nat_div)
 
 lemma div_lt': "i \<le> k div x \<Longrightarrow> unat i * unat x < 2 ^ LENGTH('a)"
   for i k x :: "'a::len word"
   by unat_arith (meson le_less_trans less_mult_imp_div_less not_le unsigned_less)
 
 lemmas div_lt'' = order_less_imp_le [THEN div_lt']
 
 lemma div_lt_mult: "\<lbrakk>i < k div x; 0 < x\<rbrakk> \<Longrightarrow> i * x < k"
   for i k x :: "'a::len word"
   by (metis div_le_mono div_lt'' not_le unat_div word_div_mult word_less_iff_unsigned)
 
 lemma div_le_mult: "\<lbrakk>i \<le> k div x; 0 < x\<rbrakk> \<Longrightarrow> i * x \<le> k"
   for i k x :: "'a::len word"
   by (metis div_lt' less_mult_imp_div_less not_less unat_arith_simps(2) unat_div unat_mult_lem)
 
 lemma div_lt_uint': "i \<le> k div x \<Longrightarrow> uint i * uint x < 2 ^ LENGTH('a)"
   for i k x :: "'a::len word"
   unfolding uint_nat
   by (metis div_lt' int_ops(7) of_nat_unat uint_mult_lem unat_mult_lem)
 
 lemmas div_lt_uint'' = order_less_imp_le [THEN div_lt_uint']
 
 lemma word_le_exists': "x \<le> y \<Longrightarrow> \<exists>z. y = x + z \<and> uint x + uint z < 2 ^ LENGTH('a)"
   for x y z :: "'a::len word"
   by (metis add.commute diff_add_cancel no_olen_add)
   
 lemmas plus_minus_not_NULL = order_less_imp_le [THEN plus_minus_not_NULL_ab]
 
 lemmas plus_minus_no_overflow =
   order_less_imp_le [THEN plus_minus_no_overflow_ab]
 
 lemmas mcs = word_less_minus_cancel word_less_minus_mono_left
   word_le_minus_cancel word_le_minus_mono_left
 
 lemmas word_l_diffs = mcs [where y = "w + x", unfolded add_diff_cancel] for w x
 lemmas word_diff_ls = mcs [where z = "w + x", unfolded add_diff_cancel] for w x
 lemmas word_plus_mcs = word_diff_ls [where y = "v + x", unfolded add_diff_cancel] for v x
 
 lemma le_unat_uoi:
   \<open>y \<le> unat z \<Longrightarrow> unat (word_of_nat y :: 'a word) = y\<close>
   for z :: \<open>'a::len word\<close>
   by transfer (simp add: nat_take_bit_eq take_bit_nat_eq_self_iff le_less_trans)
 
 lemmas thd = times_div_less_eq_dividend
 
 lemmas uno_simps [THEN le_unat_uoi] = mod_le_divisor div_le_dividend
 
 lemma word_mod_div_equality: "(n div b) * b + (n mod b) = n"
   for n b :: "'a::len word"
   by (fact div_mult_mod_eq)
 
 lemma word_div_mult_le: "a div b * b \<le> a"
   for a b :: "'a::len word"
   by (metis div_le_mult mult_not_zero order.not_eq_order_implies_strict order_refl word_zero_le)
 
 lemma word_mod_less_divisor: "0 < n \<Longrightarrow> m mod n < n"
   for m n :: "'a::len word"
   by (simp add: unat_arith_simps)
   
 lemma word_of_int_power_hom: "word_of_int a ^ n = (word_of_int (a ^ n) :: 'a::len word)"
   by (induct n) (simp_all add: wi_hom_mult [symmetric])
 
 lemma word_arith_power_alt: "a ^ n = (word_of_int (uint a ^ n) :: 'a::len word)"
   by (simp add : word_of_int_power_hom [symmetric])
 
 lemma unatSuc: "1 + n \<noteq> 0 \<Longrightarrow> unat (1 + n) = Suc (unat n)"
   for n :: "'a::len word"
   by unat_arith
 
 
 subsection \<open>Cardinality, finiteness of set of words\<close>
 
 lemma inj_on_word_of_int: \<open>inj_on (word_of_int :: int \<Rightarrow> 'a word) {0..<2 ^ LENGTH('a::len)}\<close>
   unfolding inj_on_def
   by (metis atLeastLessThan_iff word_of_int_inverse)
 
 lemma range_uint: \<open>range (uint :: 'a word \<Rightarrow> int) = {0..<2 ^ LENGTH('a::len)}\<close>
   apply transfer
   apply (auto simp add: image_iff)
   apply (metis take_bit_int_eq_self_iff)
   done
 
 lemma UNIV_eq: \<open>(UNIV :: 'a word set) = word_of_int ` {0..<2 ^ LENGTH('a::len)}\<close>
   by (auto simp add: image_iff) (metis atLeastLessThan_iff linorder_not_le uint_split)
 
 lemma card_word: "CARD('a word) = 2 ^ LENGTH('a::len)"
   by (simp add: UNIV_eq card_image inj_on_word_of_int)
 
 lemma card_word_size: "CARD('a word) = 2 ^ size x"
   for x :: "'a::len word"
   unfolding word_size by (rule card_word)
 
 instance word :: (len) finite
   by standard (simp add: UNIV_eq)
 
 
 subsection \<open>Bitwise Operations on Words\<close>
 
 lemma word_wi_log_defs:
   "NOT (word_of_int a) = word_of_int (NOT a)"
   "word_of_int a AND word_of_int b = word_of_int (a AND b)"
   "word_of_int a OR word_of_int b = word_of_int (a OR b)"
   "word_of_int a XOR word_of_int b = word_of_int (a XOR b)"
   by (transfer, rule refl)+
 
 lemma word_no_log_defs [simp]:
   "NOT (numeral a) = word_of_int (NOT (numeral a))"
   "NOT (- numeral a) = word_of_int (NOT (- numeral a))"
   "numeral a AND numeral b = word_of_int (numeral a AND numeral b)"
   "numeral a AND - numeral b = word_of_int (numeral a AND - numeral b)"
   "- numeral a AND numeral b = word_of_int (- numeral a AND numeral b)"
   "- numeral a AND - numeral b = word_of_int (- numeral a AND - numeral b)"
   "numeral a OR numeral b = word_of_int (numeral a OR numeral b)"
   "numeral a OR - numeral b = word_of_int (numeral a OR - numeral b)"
   "- numeral a OR numeral b = word_of_int (- numeral a OR numeral b)"
   "- numeral a OR - numeral b = word_of_int (- numeral a OR - numeral b)"
   "numeral a XOR numeral b = word_of_int (numeral a XOR numeral b)"
   "numeral a XOR - numeral b = word_of_int (numeral a XOR - numeral b)"
   "- numeral a XOR numeral b = word_of_int (- numeral a XOR numeral b)"
   "- numeral a XOR - numeral b = word_of_int (- numeral a XOR - numeral b)"
   by (transfer, rule refl)+
 
 text \<open>Special cases for when one of the arguments equals 1.\<close>
 
 lemma word_bitwise_1_simps [simp]:
   "NOT (1::'a::len word) = -2"
   "1 AND numeral b = word_of_int (1 AND numeral b)"
   "1 AND - numeral b = word_of_int (1 AND - numeral b)"
   "numeral a AND 1 = word_of_int (numeral a AND 1)"
   "- numeral a AND 1 = word_of_int (- numeral a AND 1)"
   "1 OR numeral b = word_of_int (1 OR numeral b)"
   "1 OR - numeral b = word_of_int (1 OR - numeral b)"
   "numeral a OR 1 = word_of_int (numeral a OR 1)"
   "- numeral a OR 1 = word_of_int (- numeral a OR 1)"
   "1 XOR numeral b = word_of_int (1 XOR numeral b)"
   "1 XOR - numeral b = word_of_int (1 XOR - numeral b)"
   "numeral a XOR 1 = word_of_int (numeral a XOR 1)"
   "- numeral a XOR 1 = word_of_int (- numeral a XOR 1)"
   by (transfer, simp)+
 
 text \<open>Special cases for when one of the arguments equals -1.\<close>
 
 lemma word_bitwise_m1_simps [simp]:
   "NOT (-1::'a::len word) = 0"
   "(-1::'a::len word) AND x = x"
   "x AND (-1::'a::len word) = x"
   "(-1::'a::len word) OR x = -1"
   "x OR (-1::'a::len word) = -1"
   " (-1::'a::len word) XOR x = NOT x"
   "x XOR (-1::'a::len word) = NOT x"
   by (transfer, simp)+
 
 lemma uint_and:
   \<open>uint (x AND y) = uint x AND uint y\<close>
   by transfer simp
 
 lemma uint_or:
   \<open>uint (x OR y) = uint x OR uint y\<close>
   by transfer simp
 
 lemma uint_xor:
   \<open>uint (x XOR y) = uint x XOR uint y\<close>
   by transfer simp
 
 \<comment> \<open>get from commutativity, associativity etc of \<open>int_and\<close> etc to same for \<open>word_and etc\<close>\<close>
 lemmas bwsimps =
   wi_hom_add
   word_wi_log_defs
 
 lemma word_bw_assocs:
   "(x AND y) AND z = x AND y AND z"
   "(x OR y) OR z = x OR y OR z"
   "(x XOR y) XOR z = x XOR y XOR z"
   for x :: "'a::len word"
   by (fact ac_simps)+
 
 lemma word_bw_comms:
   "x AND y = y AND x"
   "x OR y = y OR x"
   "x XOR y = y XOR x"
   for x :: "'a::len word"
   by (fact ac_simps)+
 
 lemma word_bw_lcs:
   "y AND x AND z = x AND y AND z"
   "y OR x OR z = x OR y OR z"
   "y XOR x XOR z = x XOR y XOR z"
   for x :: "'a::len word"
   by (fact ac_simps)+
 
 lemma word_log_esimps:
   "x AND 0 = 0"
   "x AND -1 = x"
   "x OR 0 = x"
   "x OR -1 = -1"
   "x XOR 0 = x"
   "x XOR -1 = NOT x"
   "0 AND x = 0"
   "-1 AND x = x"
   "0 OR x = x"
   "-1 OR x = -1"
   "0 XOR x = x"
   "-1 XOR x = NOT x"
   for x :: "'a::len word"
   by simp_all
 
 lemma word_not_dist:
   "NOT (x OR y) = NOT x AND NOT y"
   "NOT (x AND y) = NOT x OR NOT y"
   for x :: "'a::len word"
   by simp_all
 
 lemma word_bw_same:
   "x AND x = x"
   "x OR x = x"
   "x XOR x = 0"
   for x :: "'a::len word"
   by simp_all
 
 lemma word_ao_absorbs [simp]:
   "x AND (y OR x) = x"
   "x OR y AND x = x"
   "x AND (x OR y) = x"
   "y AND x OR x = x"
   "(y OR x) AND x = x"
   "x OR x AND y = x"
   "(x OR y) AND x = x"
   "x AND y OR x = x"
   for x :: "'a::len word"
   by (auto intro: bit_eqI simp add: bit_and_iff bit_or_iff)
 
 lemma word_not_not [simp]: "NOT (NOT x) = x"
   for x :: "'a::len word"
   by (fact bit.double_compl)
 
 lemma word_ao_dist: "(x OR y) AND z = x AND z OR y AND z"
   for x :: "'a::len word"
   by (fact bit.conj_disj_distrib2)
 
 lemma word_oa_dist: "x AND y OR z = (x OR z) AND (y OR z)"
   for x :: "'a::len word"
   by (fact bit.disj_conj_distrib2)
   
 lemma word_add_not [simp]: "x + NOT x = -1"
   for x :: "'a::len word"
   by (simp add: not_eq_complement)
   
 lemma word_plus_and_or [simp]: "(x AND y) + (x OR y) = x + y"
   for x :: "'a::len word"
   by transfer (simp add: plus_and_or)
 
 lemma leoa: "w = x OR y \<Longrightarrow> y = w AND y"
   for x :: "'a::len word"
   by auto
 
 lemma leao: "w' = x' AND y' \<Longrightarrow> x' = x' OR w'"
   for x' :: "'a::len word"
   by auto
 
 lemma word_ao_equiv: "w = w OR w' \<longleftrightarrow> w' = w AND w'"
   for w w' :: "'a::len word"
   by (auto intro: leoa leao)
 
 lemma le_word_or2: "x \<le> x OR y"
   for x y :: "'a::len word"
   by (simp add: or_greater_eq uint_or word_le_def)
 
 lemmas le_word_or1 = xtrans(3) [OF word_bw_comms (2) le_word_or2]
 lemmas word_and_le1 = xtrans(3) [OF word_ao_absorbs (4) [symmetric] le_word_or2]
 lemmas word_and_le2 = xtrans(3) [OF word_ao_absorbs (8) [symmetric] le_word_or2]
 
 lemma bit_horner_sum_bit_word_iff [bit_simps]:
   \<open>bit (horner_sum of_bool (2 :: 'a::len word) bs) n
     \<longleftrightarrow> n < min LENGTH('a) (length bs) \<and> bs ! n\<close>
   by transfer (simp add: bit_horner_sum_bit_iff)
 
 definition word_reverse :: \<open>'a::len word \<Rightarrow> 'a word\<close>
   where \<open>word_reverse w = horner_sum of_bool 2 (rev (map (bit w) [0..<LENGTH('a)]))\<close>
 
 lemma bit_word_reverse_iff [bit_simps]:
   \<open>bit (word_reverse w) n \<longleftrightarrow> n < LENGTH('a) \<and> bit w (LENGTH('a) - Suc n)\<close>
   for w :: \<open>'a::len word\<close>
   by (cases \<open>n < LENGTH('a)\<close>)
     (simp_all add: word_reverse_def bit_horner_sum_bit_word_iff rev_nth)
 
 lemma word_rev_rev [simp] : "word_reverse (word_reverse w) = w"
   by (rule bit_word_eqI)
     (auto simp add: bit_word_reverse_iff bit_imp_le_length Suc_diff_Suc)
 
 lemma word_rev_gal: "word_reverse w = u \<Longrightarrow> word_reverse u = w"
   by (metis word_rev_rev)
 
 lemma word_rev_gal': "u = word_reverse w \<Longrightarrow> w = word_reverse u"
   by simp
 
 lemma uint_2p: "(0::'a::len word) < 2 ^ n \<Longrightarrow> uint (2 ^ n::'a::len word) = 2 ^ n"
   by (cases \<open>n < LENGTH('a)\<close>; transfer; force)
 
 lemma word_of_int_2p: "(word_of_int (2 ^ n) :: 'a::len word) = 2 ^ n"
   by (induct n) (simp_all add: wi_hom_syms)
 
 
 subsection \<open>Shifting, Rotating, and Splitting Words\<close>
 
 lemma shiftl1_wi [simp]: "shiftl1 (word_of_int w) = word_of_int (2 * w)"
   by transfer simp
 
 lemma shiftl1_numeral [simp]: "shiftl1 (numeral w) = numeral (Num.Bit0 w)"
   unfolding word_numeral_alt shiftl1_wi by simp
 
 lemma shiftl1_neg_numeral [simp]: "shiftl1 (- numeral w) = - numeral (Num.Bit0 w)"
   unfolding word_neg_numeral_alt shiftl1_wi by simp
 
 lemma shiftl1_0 [simp] : "shiftl1 0 = 0"
   by transfer simp
 
 lemma shiftl1_def_u: "shiftl1 w = word_of_int (2 * uint w)"
   by (fact shiftl1_eq)
 
 lemma shiftl1_def_s: "shiftl1 w = word_of_int (2 * sint w)"
   by (simp add: shiftl1_def_u wi_hom_syms)
 
 lemma shiftr1_0 [simp]: "shiftr1 0 = 0"
   by transfer simp
 
 lemma sshiftr1_0 [simp]: "sshiftr1 0 = 0"
   by transfer simp
 
 lemma sshiftr1_n1 [simp]: "sshiftr1 (- 1) = - 1"
   by transfer simp
 
 text \<open>
   see paper page 10, (1), (2), \<open>shiftr1_def\<close> is of the form of (1),
   where \<open>f\<close> (ie \<open>_ div 2\<close>) takes normal arguments to normal results,
   thus we get (2) from (1)
 \<close>
 
 lemma uint_shiftr1: "uint (shiftr1 w) = uint w div 2"
   using drop_bit_eq_div [of 1 \<open>uint w\<close>, symmetric]
   by transfer (simp add: drop_bit_take_bit min_def)
 
 lemma bit_sshiftr1_iff [bit_simps]:
   \<open>bit (sshiftr1 w) n \<longleftrightarrow> bit w (if n = LENGTH('a) - 1 then LENGTH('a) - 1 else Suc n)\<close>
   for w :: \<open>'a::len word\<close>
   apply transfer
   by (auto simp add: bit_take_bit_iff bit_signed_take_bit_iff min_def le_Suc_eq simp flip: bit_Suc)
 
 lemma shiftr1_div_2: "uint (shiftr1 w) = uint w div 2"
   by (fact uint_shiftr1)
 
 lemma sshiftr1_div_2: "sint (sshiftr1 w) = sint w div 2"
   using sint_signed_drop_bit_eq [of 1 w]
   by (simp add: drop_bit_Suc sshiftr1_eq_signed_drop_bit_Suc_0) 
 
 lemma bit_bshiftr1_iff [bit_simps]:
   \<open>bit (bshiftr1 b w) n \<longleftrightarrow> b \<and> n = LENGTH('a) - 1 \<or> bit w (Suc n)\<close>
   for w :: \<open>'a::len word\<close>
   apply transfer
     apply (subst disjunctive_add)
    apply (auto simp add: bit_take_bit_iff bit_or_iff bit_exp_iff simp flip: bit_Suc)
   done
 
 
 subsubsection \<open>shift functions in terms of lists of bools\<close>
 
 lemma shiftl1_rev: "shiftl1 w = word_reverse (shiftr1 (word_reverse w))"
   by (intro bit_word_eqI) (auto simp add: bit_shiftl1_iff bit_word_reverse_iff bit_shiftr1_iff Suc_diff_Suc)
 
 \<comment> \<open>note -- the following results use \<open>'a::len word < number_ring\<close>\<close>
 
 lemma shiftl1_2t: "shiftl1 w = 2 * w"
   for w :: "'a::len word"
   by (simp add: shiftl1_eq wi_hom_mult [symmetric])
 
 lemma shiftl1_p: "shiftl1 w = w + w"
   for w :: "'a::len word"
   by (simp add: shiftl1_2t)
 
 lemma shiftr1_bintr [simp]:
   "(shiftr1 (numeral w) :: 'a::len word) =
     word_of_int (take_bit LENGTH('a) (numeral w) div 2)"
   by transfer simp
 
 lemma sshiftr1_sbintr [simp]:
   "(sshiftr1 (numeral w) :: 'a::len word) =
     word_of_int (signed_take_bit (LENGTH('a) - 1) (numeral w) div 2)"
   by transfer simp
 
 text \<open>TODO: rules for \<^term>\<open>- (numeral n)\<close>\<close>
 
 lemma drop_bit_word_numeral [simp]:
   \<open>drop_bit (numeral n) (numeral k) =
     (word_of_int (drop_bit (numeral n) (take_bit LENGTH('a) (numeral k))) :: 'a::len word)\<close>
   by transfer simp
 
 lemma False_map2_or: "\<lbrakk>set xs \<subseteq> {False}; length ys = length xs\<rbrakk> \<Longrightarrow> map2 (\<or>) xs ys = ys"
   by (induction xs arbitrary: ys) (auto simp: length_Suc_conv)
 
 lemma align_lem_or:
   assumes "length xs = n + m" "length ys = n + m" 
     and "drop m xs = replicate n False" "take m ys = replicate m False"
   shows "map2 (\<or>) xs ys = take m xs @ drop m ys"
   using assms
 proof (induction xs arbitrary: ys m)
   case (Cons a xs)
   then show ?case
     by (cases m) (auto simp: length_Suc_conv False_map2_or)
 qed auto
 
 lemma False_map2_and: "\<lbrakk>set xs \<subseteq> {False}; length ys = length xs\<rbrakk> \<Longrightarrow> map2 (\<and>) xs ys = xs"
   by (induction xs arbitrary: ys) (auto simp: length_Suc_conv)
 
 lemma align_lem_and:
   assumes "length xs = n + m" "length ys = n + m" 
     and "drop m xs = replicate n False" "take m ys = replicate m False"
   shows "map2 (\<and>) xs ys = replicate (n + m) False"
   using assms
 proof (induction xs arbitrary: ys m)
   case (Cons a xs)
   then show ?case
     by (cases m) (auto simp: length_Suc_conv set_replicate_conv_if False_map2_and)
 qed auto
 
 
 subsubsection \<open>Mask\<close>
 
 lemma minus_1_eq_mask:
   \<open>- 1 = (mask LENGTH('a) :: 'a::len word)\<close>
   by (rule bit_eqI) (simp add: bit_exp_iff bit_mask_iff exp_eq_zero_iff)
 
 lemma mask_eq_decr_exp:
   \<open>mask n = 2 ^ n - (1 :: 'a::len word)\<close>
   by (fact mask_eq_exp_minus_1)
 
 lemma mask_Suc_rec:
   \<open>mask (Suc n) = 2 * mask n + (1 :: 'a::len word)\<close>
   by (simp add: mask_eq_exp_minus_1)
 
 context
 begin
 
 qualified lemma bit_mask_iff [bit_simps]:
   \<open>bit (mask m :: 'a::len word) n \<longleftrightarrow> n < min LENGTH('a) m\<close>
   by (simp add: bit_mask_iff exp_eq_zero_iff not_le)
 
 end
 
 lemma mask_bin: "mask n = word_of_int (take_bit n (- 1))"
   by transfer (simp add: take_bit_minus_one_eq_mask) 
 
 lemma and_mask_bintr: "w AND mask n = word_of_int (take_bit n (uint w))"
   by transfer (simp add: ac_simps take_bit_eq_mask)
 
 lemma and_mask_wi: "word_of_int i AND mask n = word_of_int (take_bit n i)"
   by (auto simp add: and_mask_bintr min_def not_le wi_bintr)
 
 lemma and_mask_wi':
   "word_of_int i AND mask n = (word_of_int (take_bit (min LENGTH('a) n) i) :: 'a::len word)"
   by (auto simp add: and_mask_wi min_def wi_bintr)
 
 lemma and_mask_no: "numeral i AND mask n = word_of_int (take_bit n (numeral i))"
   unfolding word_numeral_alt by (rule and_mask_wi)
 
 lemma and_mask_mod_2p: "w AND mask n = word_of_int (uint w mod 2 ^ n)"
   by (simp only: and_mask_bintr take_bit_eq_mod)
 
 lemma uint_mask_eq:
   \<open>uint (mask n :: 'a::len word) = mask (min LENGTH('a) n)\<close>
   by transfer simp
 
 lemma and_mask_lt_2p: "uint (w AND mask n) < 2 ^ n"
   by (metis take_bit_eq_mask take_bit_int_less_exp unsigned_take_bit_eq)
 
 lemma mask_eq_iff: "w AND mask n = w \<longleftrightarrow> uint w < 2 ^ n"
   apply (auto simp flip: take_bit_eq_mask)
    apply (metis take_bit_int_eq_self_iff uint_take_bit_eq)
   apply (simp add: take_bit_int_eq_self unsigned_take_bit_eq word_uint_eqI)
   done
 
 lemma and_mask_dvd: "2 ^ n dvd uint w \<longleftrightarrow> w AND mask n = 0"
   by (simp flip: take_bit_eq_mask take_bit_eq_mod unsigned_take_bit_eq add: dvd_eq_mod_eq_0 uint_0_iff)
 
 lemma and_mask_dvd_nat: "2 ^ n dvd unat w \<longleftrightarrow> w AND mask n = 0"
   by (simp flip: take_bit_eq_mask take_bit_eq_mod unsigned_take_bit_eq add: dvd_eq_mod_eq_0 unat_0_iff uint_0_iff)
 
 lemma word_2p_lem: "n < size w \<Longrightarrow> w < 2 ^ n = (uint w < 2 ^ n)"
   for w :: "'a::len word"
   by transfer simp
 
 lemma less_mask_eq:
   fixes x :: "'a::len word"
   assumes "x < 2 ^ n" shows "x AND mask n = x"
   by (metis (no_types) assms lt2p_lem mask_eq_iff not_less word_2p_lem word_size)
 
 lemmas mask_eq_iff_w2p = trans [OF mask_eq_iff word_2p_lem [symmetric]]
 
 lemmas and_mask_less' = iffD2 [OF word_2p_lem and_mask_lt_2p, simplified word_size]
 
 lemma and_mask_less_size: "n < size x \<Longrightarrow> x AND mask n < 2 ^ n"
   for x :: \<open>'a::len word\<close>
   unfolding word_size by (erule and_mask_less')
 
 lemma word_mod_2p_is_mask [OF refl]: "c = 2 ^ n \<Longrightarrow> c > 0 \<Longrightarrow> x mod c = x AND mask n"
   for c x :: "'a::len word"
   by (auto simp: word_mod_def uint_2p and_mask_mod_2p)
 
 lemma mask_eqs:
   "(a AND mask n) + b AND mask n = a + b AND mask n"
   "a + (b AND mask n) AND mask n = a + b AND mask n"
   "(a AND mask n) - b AND mask n = a - b AND mask n"
   "a - (b AND mask n) AND mask n = a - b AND mask n"
   "a * (b AND mask n) AND mask n = a * b AND mask n"
   "(b AND mask n) * a AND mask n = b * a AND mask n"
   "(a AND mask n) + (b AND mask n) AND mask n = a + b AND mask n"
   "(a AND mask n) - (b AND mask n) AND mask n = a - b AND mask n"
   "(a AND mask n) * (b AND mask n) AND mask n = a * b AND mask n"
   "- (a AND mask n) AND mask n = - a AND mask n"
   "word_succ (a AND mask n) AND mask n = word_succ a AND mask n"
   "word_pred (a AND mask n) AND mask n = word_pred a AND mask n"
   using word_of_int_Ex [where x=a] word_of_int_Ex [where x=b]
   unfolding take_bit_eq_mask [symmetric]
   by (transfer; simp add: take_bit_eq_mod mod_simps)+
 
 lemma mask_power_eq: "(x AND mask n) ^ k AND mask n = x ^ k AND mask n"
   for x :: \<open>'a::len word\<close>
   using word_of_int_Ex [where x=x]
   unfolding take_bit_eq_mask [symmetric]
   by (transfer; simp add: take_bit_eq_mod mod_simps)+
 
 lemma mask_full [simp]: "mask LENGTH('a) = (- 1 :: 'a::len word)"
   by transfer (simp add: take_bit_minus_one_eq_mask)
 
 
 subsubsection \<open>Slices\<close>
 
 definition slice1 :: \<open>nat \<Rightarrow> 'a::len word \<Rightarrow> 'b::len word\<close>
   where \<open>slice1 n w = (if n < LENGTH('a)
     then ucast (drop_bit (LENGTH('a) - n) w)
     else push_bit (n - LENGTH('a)) (ucast w))\<close>
 
 lemma bit_slice1_iff [bit_simps]:
   \<open>bit (slice1 m w :: 'b::len word) n \<longleftrightarrow> m - LENGTH('a) \<le> n \<and> n < min LENGTH('b) m
     \<and> bit w (n + (LENGTH('a) - m) - (m - LENGTH('a)))\<close>
   for w :: \<open>'a::len word\<close>
   by (auto simp add: slice1_def bit_ucast_iff bit_drop_bit_eq bit_push_bit_iff not_less not_le ac_simps
     dest: bit_imp_le_length)
 
 definition slice :: \<open>nat \<Rightarrow> 'a::len word \<Rightarrow> 'b::len word\<close>
   where \<open>slice n = slice1 (LENGTH('a) - n)\<close>
 
 lemma bit_slice_iff [bit_simps]:
   \<open>bit (slice m w :: 'b::len word) n \<longleftrightarrow> n < min LENGTH('b) (LENGTH('a) - m) \<and> bit w (n + LENGTH('a) - (LENGTH('a) - m))\<close>
   for w :: \<open>'a::len word\<close>
   by (simp add: slice_def word_size bit_slice1_iff)
 
 lemma slice1_0 [simp] : "slice1 n 0 = 0"
   unfolding slice1_def by simp
 
 lemma slice_0 [simp] : "slice n 0 = 0"
   unfolding slice_def by auto
 
 lemma ucast_slice1: "ucast w = slice1 (size w) w"
   unfolding slice1_def by (simp add: size_word.rep_eq)
 
 lemma ucast_slice: "ucast w = slice 0 w"
   by (simp add: slice_def slice1_def)
 
 lemma slice_id: "slice 0 t = t"
   by (simp only: ucast_slice [symmetric] ucast_id)
 
 lemma rev_slice1:
   \<open>slice1 n (word_reverse w :: 'b::len word) = word_reverse (slice1 k w :: 'a::len word)\<close>
   if \<open>n + k = LENGTH('a) + LENGTH('b)\<close>
 proof (rule bit_word_eqI)
   fix m
   assume *: \<open>m < LENGTH('a)\<close>
   from that have **: \<open>LENGTH('b) = n + k - LENGTH('a)\<close>
     by simp
   show \<open>bit (slice1 n (word_reverse w :: 'b word) :: 'a word) m \<longleftrightarrow> bit (word_reverse (slice1 k w :: 'a word)) m\<close>
     unfolding bit_slice1_iff bit_word_reverse_iff
     using * **
     by (cases \<open>n \<le> LENGTH('a)\<close>; cases \<open>k \<le> LENGTH('a)\<close>) auto
 qed
 
 lemma rev_slice:
   "n + k + LENGTH('a::len) = LENGTH('b::len) \<Longrightarrow>
     slice n (word_reverse (w::'b word)) = word_reverse (slice k w :: 'a word)"
   unfolding slice_def word_size
   by (simp add: rev_slice1)
 
 
 subsubsection \<open>Revcast\<close>
 
 definition revcast :: \<open>'a::len word \<Rightarrow> 'b::len word\<close>
   where \<open>revcast = slice1 LENGTH('b)\<close>
 
 lemma bit_revcast_iff [bit_simps]:
   \<open>bit (revcast w :: 'b::len word) n \<longleftrightarrow> LENGTH('b) - LENGTH('a) \<le> n \<and> n < LENGTH('b)
     \<and> bit w (n + (LENGTH('a) - LENGTH('b)) - (LENGTH('b) - LENGTH('a)))\<close>
   for w :: \<open>'a::len word\<close>
   by (simp add: revcast_def bit_slice1_iff)
 
 lemma revcast_slice1 [OF refl]: "rc = revcast w \<Longrightarrow> slice1 (size rc) w = rc"
   by (simp add: revcast_def word_size)
 
 lemma revcast_rev_ucast [OF refl refl refl]:
   "cs = [rc, uc] \<Longrightarrow> rc = revcast (word_reverse w) \<Longrightarrow> uc = ucast w \<Longrightarrow>
     rc = word_reverse uc"
   by (metis rev_slice1 revcast_slice1 ucast_slice1 word_size)
 
 lemma revcast_ucast: "revcast w = word_reverse (ucast (word_reverse w))"
   using revcast_rev_ucast [of "word_reverse w"] by simp
 
 lemma ucast_revcast: "ucast w = word_reverse (revcast (word_reverse w))"
   by (fact revcast_rev_ucast [THEN word_rev_gal'])
 
 lemma ucast_rev_revcast: "ucast (word_reverse w) = word_reverse (revcast w)"
   by (fact revcast_ucast [THEN word_rev_gal'])
 
 
 text "linking revcast and cast via shift"
 
 lemmas wsst_TYs = source_size target_size word_size
 
 lemmas sym_notr =
   not_iff [THEN iffD2, THEN not_sym, THEN not_iff [THEN iffD1]]
 
 
 subsection \<open>Split and cat\<close>
 
 lemmas word_split_bin' = word_split_def
 lemmas word_cat_bin' = word_cat_eq
 
 \<comment> \<open>this odd result is analogous to \<open>ucast_id\<close>,
       result to the length given by the result type\<close>
 
 lemma word_cat_id: "word_cat a b = b"
   by transfer (simp add: take_bit_concat_bit_eq)
 
 lemma word_cat_split_alt: "\<lbrakk>size w \<le> size u + size v; word_split w = (u,v)\<rbrakk> \<Longrightarrow> word_cat u v = w"
   unfolding word_split_def
   by (rule bit_word_eqI) (auto simp add: bit_word_cat_iff not_less word_size bit_ucast_iff bit_drop_bit_eq)
 
 lemmas word_cat_split_size = sym [THEN [2] word_cat_split_alt [symmetric]]
 
 
 subsubsection \<open>Split and slice\<close>
 
 lemma split_slices:
   assumes "word_split w = (u, v)"
   shows "u = slice (size v) w \<and> v = slice 0 w"
   unfolding word_size
 proof (intro conjI)
   have \<section>: "\<And>n. \<lbrakk>ucast (drop_bit LENGTH('b) w) = u; LENGTH('c) < LENGTH('b)\<rbrakk> \<Longrightarrow> \<not> bit u n"
     by (metis bit_take_bit_iff bit_word_of_int_iff diff_is_0_eq' drop_bit_take_bit less_imp_le less_nat_zero_code of_int_uint unsigned_drop_bit_eq)
   show "u = slice LENGTH('b) w"
   proof (rule bit_word_eqI)
     show "bit u n = bit ((slice LENGTH('b) w)::'a word) n" if "n < LENGTH('a)" for n
       using assms bit_imp_le_length
       unfolding word_split_def bit_slice_iff
       by (fastforce simp add: \<section> ac_simps word_size bit_ucast_iff bit_drop_bit_eq)
   qed
   show "v = slice 0 w"
     by (metis Pair_inject assms ucast_slice word_split_bin')
 qed
 
 
 lemma slice_cat1 [OF refl]:
   "\<lbrakk>wc = word_cat a b; size a + size b \<le> size wc\<rbrakk> \<Longrightarrow> slice (size b) wc = a"
   by (rule bit_word_eqI) (auto simp add: bit_slice_iff bit_word_cat_iff word_size)
 
 lemmas slice_cat2 = trans [OF slice_id word_cat_id]
 
 lemma cat_slices:
   "\<lbrakk>a = slice n c; b = slice 0 c; n = size b; size c \<le> size a + size b\<rbrakk> \<Longrightarrow> word_cat a b = c"
   by (rule bit_word_eqI) (auto simp add: bit_slice_iff bit_word_cat_iff word_size)
 
 lemma word_split_cat_alt:
   assumes "w = word_cat u v" and size: "size u + size v \<le> size w"
   shows "word_split w = (u,v)"
 proof -
   have "ucast ((drop_bit LENGTH('c) (word_cat u v))::'a word) = u" "ucast ((word_cat u v)::'a word) = v"
     using assms
     by (auto simp add: word_size bit_ucast_iff bit_drop_bit_eq bit_word_cat_iff intro: bit_eqI)
   then show ?thesis
     by (simp add: assms(1) word_split_bin')
 qed
 
 lemma horner_sum_uint_exp_Cons_eq:
   \<open>horner_sum uint (2 ^ LENGTH('a)) (w # ws) =
     concat_bit LENGTH('a) (uint w) (horner_sum uint (2 ^ LENGTH('a)) ws)\<close>
   for ws :: \<open>'a::len word list\<close>
   by (simp add: bintr_uint concat_bit_eq push_bit_eq_mult)
 
 lemma bit_horner_sum_uint_exp_iff:
   \<open>bit (horner_sum uint (2 ^ LENGTH('a)) ws) n \<longleftrightarrow>
     n div LENGTH('a) < length ws \<and> bit (ws ! (n div LENGTH('a))) (n mod LENGTH('a))\<close>
   for ws :: \<open>'a::len word list\<close>
 proof (induction ws arbitrary: n)
   case Nil
   then show ?case
     by simp
 next
   case (Cons w ws)
   then show ?case
     by (cases \<open>n \<ge> LENGTH('a)\<close>)
       (simp_all only: horner_sum_uint_exp_Cons_eq, simp_all add: bit_concat_bit_iff le_div_geq le_mod_geq bit_uint_iff Cons)
 qed
 
 
 subsection \<open>Rotation\<close>
 
 lemma word_rotr_word_rotr_eq: \<open>word_rotr m (word_rotr n w) = word_rotr (m + n) w\<close>
   by (rule bit_word_eqI) (simp add: bit_word_rotr_iff ac_simps mod_add_right_eq)
 
 lemma word_rot_lem: "\<lbrakk>l + k = d + k mod l; n < l\<rbrakk> \<Longrightarrow> ((d + n) mod l) = n" for l::nat
   by (metis (no_types, lifting) add.commute add.right_neutral add_diff_cancel_left' mod_if mod_mult_div_eq mod_mult_self2 mod_self)
  
 lemma word_rot_rl [simp]: \<open>word_rotl k (word_rotr k v) = v\<close>
 proof (rule bit_word_eqI)
   show "bit (word_rotl k (word_rotr k v)) n = bit v n" if "n < LENGTH('a)" for n
     using that
     by (auto simp: word_rot_lem word_rotl_eq_word_rotr word_rotr_word_rotr_eq bit_word_rotr_iff algebra_simps split: nat_diff_split)
 qed
 
 lemma word_rot_lr [simp]: \<open>word_rotr k (word_rotl k v) = v\<close>
 proof (rule bit_word_eqI)
   show "bit (word_rotr k (word_rotl k v)) n = bit v n" if "n < LENGTH('a)" for n
     using that
     by (auto simp add: word_rot_lem word_rotl_eq_word_rotr word_rotr_word_rotr_eq bit_word_rotr_iff algebra_simps split: nat_diff_split)
 qed
 
 lemma word_rot_gal:
   \<open>word_rotr n v = w \<longleftrightarrow> word_rotl n w = v\<close>
   by auto
 
 lemma word_rot_gal':
   \<open>w = word_rotr n v \<longleftrightarrow> v = word_rotl n w\<close>
   by auto
 
 lemma word_rotr_rev:
   \<open>word_rotr n w = word_reverse (word_rotl n (word_reverse w))\<close>
 proof (rule bit_word_eqI)
   fix m
   assume \<open>m < LENGTH('a)\<close>
   moreover have \<open>1 +
     ((int m + int n mod int LENGTH('a)) mod int LENGTH('a) +
      ((int LENGTH('a) * 2) mod int LENGTH('a) - (1 + (int m + int n mod int LENGTH('a)))) mod int LENGTH('a)) =
     int LENGTH('a)\<close>
     apply (cases \<open>(1 + (int m + int n mod int LENGTH('a))) mod
          int LENGTH('a) = 0\<close>)
     using zmod_zminus1_eq_if [of \<open>1 + (int m + int n mod int LENGTH('a))\<close> \<open>int LENGTH('a)\<close>]
     apply simp_all
      apply (auto simp add: algebra_simps)
     apply (metis (mono_tags, hide_lams) Abs_fnat_hom_add mod_Suc mod_mult_self2_is_0 of_nat_Suc of_nat_mod semiring_char_0_class.of_nat_neq_0)
     apply (metis (no_types, hide_lams) Abs_fnat_hom_add less_not_refl mod_Suc of_nat_Suc of_nat_gt_0 of_nat_mod)
     done
   then have \<open>int ((m + n) mod LENGTH('a)) =
     int (LENGTH('a) - Suc ((LENGTH('a) - Suc m + LENGTH('a) - n mod LENGTH('a)) mod LENGTH('a)))\<close>
     using \<open>m < LENGTH('a)\<close>
     by (simp only: of_nat_mod mod_simps)
       (simp add: of_nat_diff of_nat_mod Suc_le_eq add_less_mono algebra_simps mod_simps)
   then have \<open>(m + n) mod LENGTH('a) =
     LENGTH('a) - Suc ((LENGTH('a) - Suc m + LENGTH('a) - n mod LENGTH('a)) mod LENGTH('a))\<close>
     by simp
   ultimately show \<open>bit (word_rotr n w) m \<longleftrightarrow> bit (word_reverse (word_rotl n (word_reverse w))) m\<close>
     by (simp add: word_rotl_eq_word_rotr bit_word_rotr_iff bit_word_reverse_iff)
 qed
 
 lemma word_roti_0 [simp]: "word_roti 0 w = w"
   by transfer simp
 
 lemma word_roti_add: "word_roti (m + n) w = word_roti m (word_roti n w)"
   by (rule bit_word_eqI)
     (simp add: bit_word_roti_iff nat_less_iff mod_simps ac_simps)
 
 lemma word_roti_conv_mod':
   "word_roti n w = word_roti (n mod int (size w)) w"
   by transfer simp
 
 lemmas word_roti_conv_mod = word_roti_conv_mod' [unfolded word_size]
 
 
 subsubsection \<open>"Word rotation commutes with bit-wise operations\<close>
 
 \<comment> \<open>using locale to not pollute lemma namespace\<close>
 locale word_rotate
 begin
 
 lemma word_rot_logs:
   "word_rotl n (NOT v) = NOT (word_rotl n v)"
   "word_rotr n (NOT v) = NOT (word_rotr n v)"
   "word_rotl n (x AND y) = word_rotl n x AND word_rotl n y"
   "word_rotr n (x AND y) = word_rotr n x AND word_rotr n y"
   "word_rotl n (x OR y) = word_rotl n x OR word_rotl n y"
   "word_rotr n (x OR y) = word_rotr n x OR word_rotr n y"
   "word_rotl n (x XOR y) = word_rotl n x XOR word_rotl n y"
   "word_rotr n (x XOR y) = word_rotr n x XOR word_rotr n y"
   by (rule bit_word_eqI, auto simp add: bit_word_rotl_iff bit_word_rotr_iff bit_and_iff bit_or_iff bit_xor_iff bit_not_iff algebra_simps not_le)+
 
 end
 
 lemmas word_rot_logs = word_rotate.word_rot_logs
 
 lemma word_rotx_0 [simp] : "word_rotr i 0 = 0 \<and> word_rotl i 0 = 0"
   by transfer simp_all
 
 lemma word_roti_0' [simp] : "word_roti n 0 = 0"
   by transfer simp
 
 declare word_roti_eq_word_rotr_word_rotl [simp]
 
 
 subsection \<open>Maximum machine word\<close>
 
 lemma word_int_cases:
   fixes x :: "'a::len word"
   obtains n where "x = word_of_int n" and "0 \<le> n" and "n < 2^LENGTH('a)"
   by (rule that [of \<open>uint x\<close>]) simp_all
 
 lemma word_nat_cases [cases type: word]:
   fixes x :: "'a::len word"
   obtains n where "x = of_nat n" and "n < 2^LENGTH('a)"
   by (rule that [of \<open>unat x\<close>]) simp_all
 
 lemma max_word_max [intro!]: "n \<le> max_word"
   by (fact word_order.extremum)
 
 lemma word_of_int_2p_len: "word_of_int (2 ^ LENGTH('a)) = (0::'a::len word)"
   by simp
 
 lemma word_pow_0: "(2::'a::len word) ^ LENGTH('a) = 0"
   by (fact word_exp_length_eq_0)
 
 lemma max_word_wrap: "x + 1 = 0 \<Longrightarrow> x = max_word"
   by (simp add: eq_neg_iff_add_eq_0)
 
 lemma word_and_max: "x AND max_word = x"
   by (fact word_log_esimps)
 
 lemma word_or_max: "x OR max_word = max_word"
   by (fact word_log_esimps)
 
 lemma word_ao_dist2: "x AND (y OR z) = x AND y OR x AND z"
   for x y z :: "'a::len word"
   by (fact bit.conj_disj_distrib)
 
 lemma word_oa_dist2: "x OR y AND z = (x OR y) AND (x OR z)"
   for x y z :: "'a::len word"
   by (fact bit.disj_conj_distrib)
 
 lemma word_and_not [simp]: "x AND NOT x = 0"
   for x :: "'a::len word"
   by (fact bit.conj_cancel_right)
 
 lemma word_or_not [simp]: "x OR NOT x = max_word"
   by (fact bit.disj_cancel_right)
 
 lemma word_xor_and_or: "x XOR y = x AND NOT y OR NOT x AND y"
   for x y :: "'a::len word"
   by (fact bit.xor_def)
 
 lemma uint_lt_0 [simp]: "uint x < 0 = False"
   by (simp add: linorder_not_less)
 
 lemma shiftr1_1 [simp]: "shiftr1 (1::'a::len word) = 0"
   by transfer simp
 
 lemma word_less_1 [simp]: "x < 1 \<longleftrightarrow> x = 0"
   for x :: "'a::len word"
   by (simp add: word_less_nat_alt unat_0_iff)
 
 lemma uint_plus_if_size:
   "uint (x + y) =
     (if uint x + uint y < 2^size x
      then uint x + uint y
      else uint x + uint y - 2^size x)"
   by (simp add: take_bit_eq_mod word_size uint_word_of_int_eq uint_plus_if')
 
 lemma unat_plus_if_size:
   "unat (x + y) =
     (if unat x + unat y < 2^size x
      then unat x + unat y
      else unat x + unat y - 2^size x)"
   for x y :: "'a::len word"
   by (simp add: size_word.rep_eq unat_arith_simps)
 
 lemma word_neq_0_conv: "w \<noteq> 0 \<longleftrightarrow> 0 < w"
   for w :: "'a::len word"
   by (fact word_coorder.not_eq_extremum)
 
 lemma max_lt: "unat (max a b div c) = unat (max a b) div unat c"
   for c :: "'a::len word"
   by (fact unat_div)
 
 lemma uint_sub_if_size:
   "uint (x - y) =
     (if uint y \<le> uint x
      then uint x - uint y
      else uint x - uint y + 2^size x)"
   by (simp add: size_word.rep_eq uint_sub_if')
 
 lemma unat_sub:
   \<open>unat (a - b) = unat a - unat b\<close>
   if \<open>b \<le> a\<close>
   by (meson that unat_sub_if_size word_le_nat_alt)
 
 lemmas word_less_sub1_numberof [simp] = word_less_sub1 [of "numeral w"] for w
 lemmas word_le_sub1_numberof [simp] = word_le_sub1 [of "numeral w"] for w
 
 lemma word_of_int_minus: "word_of_int (2^LENGTH('a) - i) = (word_of_int (-i)::'a::len word)"
   by simp
 
 lemma word_of_int_inj:
   \<open>(word_of_int x :: 'a::len word) = word_of_int y \<longleftrightarrow> x = y\<close>
   if \<open>0 \<le> x \<and> x < 2 ^ LENGTH('a)\<close> \<open>0 \<le> y \<and> y < 2 ^ LENGTH('a)\<close>
   using that by (transfer fixing: x y) (simp add: take_bit_int_eq_self) 
 
 lemma word_le_less_eq: "x \<le> y \<longleftrightarrow> x = y \<or> x < y"
   for x y :: "'z::len word"
   by (auto simp add: order_class.le_less)
 
 lemma mod_plus_cong:
   fixes b b' :: int
   assumes 1: "b = b'"
     and 2: "x mod b' = x' mod b'"
     and 3: "y mod b' = y' mod b'"
     and 4: "x' + y' = z'"
   shows "(x + y) mod b = z' mod b'"
 proof -
   from 1 2[symmetric] 3[symmetric] have "(x + y) mod b = (x' mod b' + y' mod b') mod b'"
     by (simp add: mod_add_eq)
   also have "\<dots> = (x' + y') mod b'"
     by (simp add: mod_add_eq)
   finally show ?thesis
     by (simp add: 4)
 qed
 
 lemma mod_minus_cong:
   fixes b b' :: int
   assumes "b = b'"
     and "x mod b' = x' mod b'"
     and "y mod b' = y' mod b'"
     and "x' - y' = z'"
   shows "(x - y) mod b = z' mod b'"
   using assms [symmetric] by (auto intro: mod_diff_cong)
 
 lemma word_induct_less [case_names zero less]:
   \<open>P m\<close> if zero: \<open>P 0\<close> and less: \<open>\<And>n. n < m \<Longrightarrow> P n \<Longrightarrow> P (1 + n)\<close>
   for m :: \<open>'a::len word\<close>
 proof -
   define q where \<open>q = unat m\<close>
   with less have \<open>\<And>n. n < word_of_nat q \<Longrightarrow> P n \<Longrightarrow> P (1 + n)\<close>
     by simp
   then have \<open>P (word_of_nat q :: 'a word)\<close>
   proof (induction q)
     case 0
     show ?case
       by (simp add: zero)
   next
     case (Suc q)
     show ?case
     proof (cases \<open>1 + word_of_nat q = (0 :: 'a word)\<close>)
       case True
       then show ?thesis
         by (simp add: zero)
     next
       case False
       then have *: \<open>word_of_nat q < (word_of_nat (Suc q) :: 'a word)\<close>
         by (simp add: unatSuc word_less_nat_alt)
       then have **: \<open>n < (1 + word_of_nat q :: 'a word) \<longleftrightarrow> n \<le> (word_of_nat q :: 'a word)\<close> for n
         by (metis (no_types, lifting) add.commute inc_le le_less_trans not_less of_nat_Suc)
       have \<open>P (word_of_nat q)\<close>
         by (simp add: "**" Suc.IH Suc.prems)
       with * have \<open>P (1 + word_of_nat q)\<close>
         by (rule Suc.prems)
       then show ?thesis
         by simp
     qed
   qed
   with \<open>q = unat m\<close> show ?thesis
     by simp
 qed
 
 lemma word_induct: "P 0 \<Longrightarrow> (\<And>n. P n \<Longrightarrow> P (1 + n)) \<Longrightarrow> P m"
   for P :: "'a::len word \<Rightarrow> bool"
   by (rule word_induct_less)
 
 lemma word_induct2 [case_names zero suc, induct type]: "P 0 \<Longrightarrow> (\<And>n. 1 + n \<noteq> 0 \<Longrightarrow> P n \<Longrightarrow> P (1 + n)) \<Longrightarrow> P n"
   for P :: "'b::len word \<Rightarrow> bool"
 by (induction rule: word_induct_less; force)
 
 
 subsection \<open>Recursion combinator for words\<close>
 
 definition word_rec :: "'a \<Rightarrow> ('b::len word \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'b word \<Rightarrow> 'a"
   where "word_rec forZero forSuc n = rec_nat forZero (forSuc \<circ> of_nat) (unat n)"
 
 lemma word_rec_0 [simp]: "word_rec z s 0 = z"
   by (simp add: word_rec_def)
 
 lemma word_rec_Suc [simp]: "1 + n \<noteq> 0 \<Longrightarrow> word_rec z s (1 + n) = s n (word_rec z s n)"
   for n :: "'a::len word"
   by (simp add: unatSuc word_rec_def)
 
 lemma word_rec_Pred: "n \<noteq> 0 \<Longrightarrow> word_rec z s n = s (n - 1) (word_rec z s (n - 1))"
   by (metis add.commute diff_add_cancel word_rec_Suc)
 
 lemma word_rec_in: "f (word_rec z (\<lambda>_. f) n) = word_rec (f z) (\<lambda>_. f) n"
   by (induct n) (simp_all add: word_rec_Suc)
 
 lemma word_rec_in2: "f n (word_rec z f n) = word_rec (f 0 z) (f \<circ> (+) 1) n"
   by (induct n) (simp_all add: word_rec_Suc)
 
 
 
 lemma word_rec_twice:
   "m \<le> n \<Longrightarrow> word_rec z f n = word_rec (word_rec z f (n - m)) (f \<circ> (+) (n - m)) m"
 proof (induction n arbitrary: z f)
   case zero
   then show ?case
     by (metis diff_0_right word_le_0_iff word_rec_0)
 next
   case (suc n z f)
   show ?case
   proof (cases "1 + (n - m) = 0")
     case True
     then show ?thesis
       by (simp add: add_diff_eq)
   next
     case False
     then have eq: "1 + n - m = 1 + (n - m)"
       by simp
     with False have "m \<le> n"
       by (metis "suc.prems" add.commute dual_order.antisym eq_iff_diff_eq_0 inc_le leI)
     with False "suc.hyps" show ?thesis
       using suc.IH [of "f 0 z" "f \<circ> (+) 1"] 
       by (simp add: word_rec_in2 eq add.assoc o_def)
   qed
 qed
 
 lemma word_rec_id: "word_rec z (\<lambda>_. id) n = z"
   by (induct n) auto
 
 lemma word_rec_id_eq: "(\<And>m. m < n \<Longrightarrow> f m = id) \<Longrightarrow> word_rec z f n = z"
   by (induction n) (auto simp add: unatSuc unat_arith_simps(2))
 
 lemma word_rec_max:
   assumes "\<forall>m\<ge>n. m \<noteq> - 1 \<longrightarrow> f m = id"
   shows "word_rec z f (- 1) = word_rec z f n"
 proof -
   have \<section>: "\<And>m. \<lbrakk>m < - 1 - n\<rbrakk> \<Longrightarrow> (f \<circ> (+) n) m = id"
     using assms
     by (metis (mono_tags, lifting) add.commute add_diff_cancel_left' comp_apply less_le olen_add_eqv plus_minus_no_overflow word_n1_ge)
   have "word_rec z f (- 1) = word_rec (word_rec z f (- 1 - (- 1 - n))) (f \<circ> (+) (- 1 - (- 1 - n))) (- 1 - n)"
     by (meson word_n1_ge word_rec_twice)
   also have "... = word_rec z f n"
     by (metis (no_types, lifting) \<section> diff_add_cancel minus_diff_eq uminus_add_conv_diff word_rec_id_eq)
   finally show ?thesis .
 qed
 
 
 subsection \<open>More\<close>
 
 lemma mask_1: "mask 1 = 1"
   by simp
 
 lemma mask_Suc_0: "mask (Suc 0) = 1"
   by simp
 
 lemma bin_last_bintrunc: "odd (take_bit l n) \<longleftrightarrow> l > 0 \<and> odd n"
   by simp
 
 
 lemma push_bit_word_beyond [simp]:
   \<open>push_bit n w = 0\<close> if \<open>LENGTH('a) \<le> n\<close> for w :: \<open>'a::len word\<close>
   using that by (transfer fixing: n) (simp add: take_bit_push_bit)
 
 lemma drop_bit_word_beyond [simp]:
   \<open>drop_bit n w = 0\<close> if \<open>LENGTH('a) \<le> n\<close> for w :: \<open>'a::len word\<close>
   using that by (transfer fixing: n) (simp add: drop_bit_take_bit)
 
 lemma signed_drop_bit_beyond:
   \<open>signed_drop_bit n w = (if bit w (LENGTH('a) - Suc 0) then - 1 else 0)\<close>
   if \<open>LENGTH('a) \<le> n\<close> for w :: \<open>'a::len word\<close>
   by (rule bit_word_eqI) (simp add: bit_signed_drop_bit_iff that)
 
 
 subsection \<open>SMT support\<close>
 
 ML_file \<open>Tools/smt_word.ML\<close>
 
 end
diff --git a/src/HOL/Library/Z2.thy b/src/HOL/Library/Z2.thy
--- a/src/HOL/Library/Z2.thy
+++ b/src/HOL/Library/Z2.thy
@@ -1,237 +1,237 @@
 (*  Title:      HOL/Library/Z2.thy
     Author:     Brian Huffman
 *)
 
 section \<open>The Field of Integers mod 2\<close>
 
 theory Z2
 imports Main "HOL-Library.Bit_Operations"
 begin
 
 text \<open>
   Note that in most cases \<^typ>\<open>bool\<close> is appropriate hen a binary type is needed; the
   type provided here, for historical reasons named \<^text>\<open>bit\<close>, is only needed if proper
   field operations are required.
 \<close>
 
 typedef bit = \<open>UNIV :: bool set\<close> ..
 
 instantiation bit :: zero_neq_one
 begin
 
 definition zero_bit :: bit
   where \<open>0 = Abs_bit False\<close>
 
 definition one_bit :: bit
   where \<open>1 = Abs_bit True\<close>
 
 instance
   by standard (simp add: zero_bit_def one_bit_def Abs_bit_inject)
 
 end
 
 free_constructors case_bit for \<open>0::bit\<close> | \<open>1::bit\<close>
 proof -
   fix P :: bool
   fix a :: bit
   assume \<open>a = 0 \<Longrightarrow> P\<close> and \<open>a = 1 \<Longrightarrow> P\<close>
   then show P
     by (cases a) (auto simp add: zero_bit_def one_bit_def Abs_bit_inject)
 qed simp
 
 lemma bit_not_zero_iff [simp]:
   \<open>a \<noteq> 0 \<longleftrightarrow> a = 1\<close> for a :: bit
   by (cases a) simp_all
 
 lemma bit_not_one_imp [simp]:
   \<open>a \<noteq> 1 \<longleftrightarrow> a = 0\<close> for a :: bit
   by (cases a) simp_all
 
 instantiation bit :: semidom_modulo
 begin
 
 definition plus_bit :: \<open>bit \<Rightarrow> bit \<Rightarrow> bit\<close>
   where \<open>a + b = Abs_bit (Rep_bit a \<noteq> Rep_bit b)\<close>
 
 definition minus_bit :: \<open>bit \<Rightarrow> bit \<Rightarrow> bit\<close>
   where [simp]: \<open>minus_bit = plus\<close>
 
 definition times_bit :: \<open>bit \<Rightarrow> bit \<Rightarrow> bit\<close>
   where \<open>a * b = Abs_bit (Rep_bit a \<and> Rep_bit b)\<close>
 
 definition divide_bit :: \<open>bit \<Rightarrow> bit \<Rightarrow> bit\<close>
   where [simp]: \<open>divide_bit = times\<close>
 
 definition modulo_bit :: \<open>bit \<Rightarrow> bit \<Rightarrow> bit\<close>
   where \<open>a mod b = Abs_bit (Rep_bit a \<and> \<not> Rep_bit b)\<close>
 
 instance
   by standard
     (auto simp flip: Rep_bit_inject
     simp add: zero_bit_def one_bit_def plus_bit_def times_bit_def modulo_bit_def Abs_bit_inverse Rep_bit_inverse)
 
 end
 
 lemma bit_2_eq_0 [simp]:
   \<open>2 = (0::bit)\<close>
   by (simp flip: one_add_one add: zero_bit_def plus_bit_def)
 
 instance bit :: semiring_parity
   apply standard
     apply (auto simp flip: Rep_bit_inject simp add: modulo_bit_def Abs_bit_inverse Rep_bit_inverse)
          apply (auto simp add: zero_bit_def one_bit_def Abs_bit_inverse Rep_bit_inverse)
   done
 
 lemma Abs_bit_eq_of_bool [code_abbrev]:
   \<open>Abs_bit = of_bool\<close>
   by (simp add: fun_eq_iff zero_bit_def one_bit_def)
 
 lemma Rep_bit_eq_odd:
   \<open>Rep_bit = odd\<close>
 proof -
   have \<open>\<not> Rep_bit 0\<close>
     by (simp only: zero_bit_def) (subst Abs_bit_inverse, auto)
   then show ?thesis
     by (auto simp flip: Rep_bit_inject simp add: fun_eq_iff)
 qed
 
 lemma Rep_bit_iff_odd [code_abbrev]:
   \<open>Rep_bit b \<longleftrightarrow> odd b\<close>
   by (simp add: Rep_bit_eq_odd)
 
 lemma Not_Rep_bit_iff_even [code_abbrev]:
   \<open>\<not> Rep_bit b \<longleftrightarrow> even b\<close>
   by (simp add: Rep_bit_eq_odd)
 
 lemma Not_Not_Rep_bit [code_unfold]:
   \<open>\<not> \<not> Rep_bit b \<longleftrightarrow> Rep_bit b\<close>
   by simp
 
 code_datatype \<open>0::bit\<close> \<open>1::bit\<close>
 
 lemma Abs_bit_code [code]:
   \<open>Abs_bit False = 0\<close>
   \<open>Abs_bit True = 1\<close>
   by (simp_all add: Abs_bit_eq_of_bool)
 
 lemma Rep_bit_code [code]:
   \<open>Rep_bit 0 \<longleftrightarrow> False\<close>
   \<open>Rep_bit 1 \<longleftrightarrow> True\<close>
   by (simp_all add: Rep_bit_eq_odd)
 
 context zero_neq_one
 begin
 
 abbreviation of_bit :: \<open>bit \<Rightarrow> 'a\<close>
   where \<open>of_bit b \<equiv> of_bool (odd b)\<close>
 
 end
 
 context
 begin
 
 qualified lemma bit_eq_iff:
   \<open>a = b \<longleftrightarrow> (even a \<longleftrightarrow> even b)\<close> for a b :: bit
   by (cases a; cases b) simp_all
 
 end
 
 lemma modulo_bit_unfold [simp, code]:
   \<open>a mod b = of_bool (odd a \<and> even b)\<close> for a b :: bit
   by (simp add: modulo_bit_def Abs_bit_eq_of_bool Rep_bit_eq_odd)
 
 lemma power_bit_unfold [simp, code]:
   \<open>a ^ n = of_bool (odd a \<or> n = 0)\<close> for a :: bit
   by (cases a) simp_all
 
 instantiation bit :: semiring_bits
 begin
 
 definition bit_bit :: \<open>bit \<Rightarrow> nat \<Rightarrow> bool\<close>
   where [simp]: \<open>bit_bit b n \<longleftrightarrow> odd b \<and> n = 0\<close>
 
 instance
   apply standard
               apply auto
   apply (metis bit.exhaust of_bool_eq(2))
   done
 
 end
 
 instantiation bit :: semiring_bit_shifts
 begin
 
 definition push_bit_bit :: \<open>nat \<Rightarrow> bit \<Rightarrow> bit\<close>
   where [simp]: \<open>push_bit n b = of_bool (odd b \<and> n = 0)\<close> for b :: bit
 
 definition drop_bit_bit :: \<open>nat \<Rightarrow> bit \<Rightarrow> bit\<close>
   where [simp]: \<open>drop_bit_bit = push_bit\<close>
 
 definition take_bit_bit :: \<open>nat \<Rightarrow> bit \<Rightarrow> bit\<close>
   where [simp]: \<open>take_bit n b = of_bool (odd b \<and> n > 0)\<close> for b :: bit
 
 instance
   by standard simp_all
 
 end
 
 instantiation bit :: semiring_bit_operations
 begin
 
 definition and_bit :: \<open>bit \<Rightarrow> bit \<Rightarrow> bit\<close>
   where [simp]: \<open>b AND c = of_bool (odd b \<and> odd c)\<close> for b c :: bit
 
 definition or_bit :: \<open>bit \<Rightarrow> bit \<Rightarrow> bit\<close>
   where [simp]: \<open>b OR c = of_bool (odd b \<or> odd c)\<close> for b c :: bit
 
 definition xor_bit :: \<open>bit \<Rightarrow> bit \<Rightarrow> bit\<close>
   where [simp]: \<open>b XOR c = of_bool (odd b \<noteq> odd c)\<close> for b c :: bit
 
 definition mask_bit :: \<open>nat \<Rightarrow> bit\<close>
   where [simp]: \<open>mask_bit n = of_bool (n > 0)\<close>
 
 instance
   by standard auto
 
 end
 
 lemma add_bit_eq_xor [simp, code]:
   \<open>(+) = ((XOR) :: bit \<Rightarrow> _)\<close>
   by (auto simp add: fun_eq_iff)
 
 lemma mult_bit_eq_and [simp, code]:
   \<open>(*) = ((AND) :: bit \<Rightarrow> _)\<close>
   by (simp add: fun_eq_iff)
 
 instantiation bit :: field
 begin
 
 definition uminus_bit :: \<open>bit \<Rightarrow> bit\<close>
   where [simp]: \<open>uminus_bit = id\<close>
 
 definition inverse_bit :: \<open>bit \<Rightarrow> bit\<close>
   where [simp]: \<open>inverse_bit = id\<close>
 
 instance
   by standard simp_all
 
 end
 
 instantiation bit :: ring_bit_operations
 begin
 
 definition not_bit :: \<open>bit \<Rightarrow> bit\<close>
   where [simp]: \<open>NOT b = of_bool (even b)\<close> for b :: bit
 
 instance
-  by standard simp_all
+  by standard auto
 
 end
 
 lemma bit_numeral_even [simp]: "numeral (Num.Bit0 w) = (0 :: bit)"
   by (simp only: Z2.bit_eq_iff even_numeral) simp
 
 lemma bit_numeral_odd [simp]: "numeral (Num.Bit1 w) = (1 :: bit)"
   by (simp only: Z2.bit_eq_iff odd_numeral)  simp
 
 end
diff --git a/src/HOL/Parity.thy b/src/HOL/Parity.thy
--- a/src/HOL/Parity.thy
+++ b/src/HOL/Parity.thy
@@ -1,1996 +1,1996 @@
 (*  Title:      HOL/Parity.thy
     Author:     Jeremy Avigad
     Author:     Jacques D. Fleuriot
 *)
 
 section \<open>Parity in rings and semirings\<close>
 
 theory Parity
   imports Euclidean_Division
 begin
 
 subsection \<open>Ring structures with parity and \<open>even\<close>/\<open>odd\<close> predicates\<close>
 
 class semiring_parity = comm_semiring_1 + semiring_modulo +
   assumes even_iff_mod_2_eq_zero: "2 dvd a \<longleftrightarrow> a mod 2 = 0"
     and odd_iff_mod_2_eq_one: "\<not> 2 dvd a \<longleftrightarrow> a mod 2 = 1"
     and odd_one [simp]: "\<not> 2 dvd 1"
 begin
 
 abbreviation even :: "'a \<Rightarrow> bool"
   where "even a \<equiv> 2 dvd a"
 
 abbreviation odd :: "'a \<Rightarrow> bool"
   where "odd a \<equiv> \<not> 2 dvd a"
 
 lemma parity_cases [case_names even odd]:
   assumes "even a \<Longrightarrow> a mod 2 = 0 \<Longrightarrow> P"
   assumes "odd a \<Longrightarrow> a mod 2 = 1 \<Longrightarrow> P"
   shows P
   using assms by (cases "even a")
     (simp_all add: even_iff_mod_2_eq_zero [symmetric] odd_iff_mod_2_eq_one [symmetric])
 
 lemma odd_of_bool_self [simp]:
   \<open>odd (of_bool p) \<longleftrightarrow> p\<close>
   by (cases p) simp_all
 
 lemma not_mod_2_eq_0_eq_1 [simp]:
   "a mod 2 \<noteq> 0 \<longleftrightarrow> a mod 2 = 1"
   by (cases a rule: parity_cases) simp_all
 
 lemma not_mod_2_eq_1_eq_0 [simp]:
   "a mod 2 \<noteq> 1 \<longleftrightarrow> a mod 2 = 0"
   by (cases a rule: parity_cases) simp_all
 
 lemma evenE [elim?]:
   assumes "even a"
   obtains b where "a = 2 * b"
   using assms by (rule dvdE)
 
 lemma oddE [elim?]:
   assumes "odd a"
   obtains b where "a = 2 * b + 1"
 proof -
   have "a = 2 * (a div 2) + a mod 2"
     by (simp add: mult_div_mod_eq)
   with assms have "a = 2 * (a div 2) + 1"
     by (simp add: odd_iff_mod_2_eq_one)
   then show ?thesis ..
 qed
 
 lemma mod_2_eq_odd:
   "a mod 2 = of_bool (odd a)"
   by (auto elim: oddE simp add: even_iff_mod_2_eq_zero)
 
 lemma of_bool_odd_eq_mod_2:
   "of_bool (odd a) = a mod 2"
   by (simp add: mod_2_eq_odd)
 
 lemma even_mod_2_iff [simp]:
   \<open>even (a mod 2) \<longleftrightarrow> even a\<close>
   by (simp add: mod_2_eq_odd)
 
 lemma mod2_eq_if:
   "a mod 2 = (if even a then 0 else 1)"
   by (simp add: mod_2_eq_odd)
 
 lemma even_zero [simp]:
   "even 0"
   by (fact dvd_0_right)
 
 lemma odd_even_add:
   "even (a + b)" if "odd a" and "odd b"
 proof -
   from that obtain c d where "a = 2 * c + 1" and "b = 2 * d + 1"
     by (blast elim: oddE)
   then have "a + b = 2 * c + 2 * d + (1 + 1)"
     by (simp only: ac_simps)
   also have "\<dots> = 2 * (c + d + 1)"
     by (simp add: algebra_simps)
   finally show ?thesis ..
 qed
 
 lemma even_add [simp]:
   "even (a + b) \<longleftrightarrow> (even a \<longleftrightarrow> even b)"
   by (auto simp add: dvd_add_right_iff dvd_add_left_iff odd_even_add)
 
 lemma odd_add [simp]:
   "odd (a + b) \<longleftrightarrow> \<not> (odd a \<longleftrightarrow> odd b)"
   by simp
 
 lemma even_plus_one_iff [simp]:
   "even (a + 1) \<longleftrightarrow> odd a"
   by (auto simp add: dvd_add_right_iff intro: odd_even_add)
 
 lemma even_mult_iff [simp]:
   "even (a * b) \<longleftrightarrow> even a \<or> even b" (is "?P \<longleftrightarrow> ?Q")
 proof
   assume ?Q
   then show ?P
     by auto
 next
   assume ?P
   show ?Q
   proof (rule ccontr)
     assume "\<not> (even a \<or> even b)"
     then have "odd a" and "odd b"
       by auto
     then obtain r s where "a = 2 * r + 1" and "b = 2 * s + 1"
       by (blast elim: oddE)
     then have "a * b = (2 * r + 1) * (2 * s + 1)"
       by simp
     also have "\<dots> = 2 * (2 * r * s + r + s) + 1"
       by (simp add: algebra_simps)
     finally have "odd (a * b)"
       by simp
     with \<open>?P\<close> show False
       by auto
   qed
 qed
 
 lemma even_numeral [simp]: "even (numeral (Num.Bit0 n))"
 proof -
   have "even (2 * numeral n)"
     unfolding even_mult_iff by simp
   then have "even (numeral n + numeral n)"
     unfolding mult_2 .
   then show ?thesis
     unfolding numeral.simps .
 qed
 
 lemma odd_numeral [simp]: "odd (numeral (Num.Bit1 n))"
 proof
   assume "even (numeral (num.Bit1 n))"
   then have "even (numeral n + numeral n + 1)"
     unfolding numeral.simps .
   then have "even (2 * numeral n + 1)"
     unfolding mult_2 .
   then have "2 dvd numeral n * 2 + 1"
     by (simp add: ac_simps)
   then have "2 dvd 1"
     using dvd_add_times_triv_left_iff [of 2 "numeral n" 1] by simp
   then show False by simp
 qed
 
 lemma odd_numeral_BitM [simp]:
   \<open>odd (numeral (Num.BitM w))\<close>
   by (cases w) simp_all
 
 lemma even_power [simp]: "even (a ^ n) \<longleftrightarrow> even a \<and> n > 0"
   by (induct n) auto
 
 lemma mask_eq_sum_exp:
   \<open>2 ^ n - 1 = (\<Sum>m\<in>{q. q < n}. 2 ^ m)\<close>
 proof -
   have *: \<open>{q. q < Suc m} = insert m {q. q < m}\<close> for m
     by auto
   have \<open>2 ^ n = (\<Sum>m\<in>{q. q < n}. 2 ^ m) + 1\<close>
     by (induction n) (simp_all add: ac_simps mult_2 *)
   then have \<open>2 ^ n - 1 = (\<Sum>m\<in>{q. q < n}. 2 ^ m) + 1 - 1\<close>
     by simp
   then show ?thesis
     by simp
 qed
 
 end
 
 class ring_parity = ring + semiring_parity
 begin
 
 subclass comm_ring_1 ..
 
 lemma even_minus:
   "even (- a) \<longleftrightarrow> even a"
   by (fact dvd_minus_iff)
 
 lemma even_diff [simp]:
   "even (a - b) \<longleftrightarrow> even (a + b)"
   using even_add [of a "- b"] by simp
 
 end
 
 
 subsection \<open>Special case: euclidean rings containing the natural numbers\<close>
 
 context unique_euclidean_semiring_with_nat
 begin
 
 subclass semiring_parity
 proof
   show "2 dvd a \<longleftrightarrow> a mod 2 = 0" for a
     by (fact dvd_eq_mod_eq_0)
   show "\<not> 2 dvd a \<longleftrightarrow> a mod 2 = 1" for a
   proof
     assume "a mod 2 = 1"
     then show "\<not> 2 dvd a"
       by auto
   next
     assume "\<not> 2 dvd a"
     have eucl: "euclidean_size (a mod 2) = 1"
     proof (rule order_antisym)
       show "euclidean_size (a mod 2) \<le> 1"
         using mod_size_less [of 2 a] by simp
       show "1 \<le> euclidean_size (a mod 2)"
         using \<open>\<not> 2 dvd a\<close> by (simp add: Suc_le_eq dvd_eq_mod_eq_0)
     qed 
     from \<open>\<not> 2 dvd a\<close> have "\<not> of_nat 2 dvd division_segment a * of_nat (euclidean_size a)"
       by simp
     then have "\<not> of_nat 2 dvd of_nat (euclidean_size a)"
       by (auto simp only: dvd_mult_unit_iff' is_unit_division_segment)
     then have "\<not> 2 dvd euclidean_size a"
       using of_nat_dvd_iff [of 2] by simp
     then have "euclidean_size a mod 2 = 1"
       by (simp add: semidom_modulo_class.dvd_eq_mod_eq_0)
     then have "of_nat (euclidean_size a mod 2) = of_nat 1"
       by simp
     then have "of_nat (euclidean_size a) mod 2 = 1"
       by (simp add: of_nat_mod)
     from \<open>\<not> 2 dvd a\<close> eucl
     show "a mod 2 = 1"
       by (auto intro: division_segment_eq_iff simp add: division_segment_mod)
   qed
   show "\<not> is_unit 2"
   proof (rule notI)
     assume "is_unit 2"
     then have "of_nat 2 dvd of_nat 1"
       by simp
     then have "is_unit (2::nat)"
       by (simp only: of_nat_dvd_iff)
     then show False
       by simp
   qed
 qed
 
 lemma even_of_nat [simp]:
   "even (of_nat a) \<longleftrightarrow> even a"
 proof -
   have "even (of_nat a) \<longleftrightarrow> of_nat 2 dvd of_nat a"
     by simp
   also have "\<dots> \<longleftrightarrow> even a"
     by (simp only: of_nat_dvd_iff)
   finally show ?thesis .
 qed
 
 lemma even_succ_div_two [simp]:
   "even a \<Longrightarrow> (a + 1) div 2 = a div 2"
   by (cases "a = 0") (auto elim!: evenE dest: mult_not_zero)
 
 lemma odd_succ_div_two [simp]:
   "odd a \<Longrightarrow> (a + 1) div 2 = a div 2 + 1"
   by (auto elim!: oddE simp add: add.assoc)
 
 lemma even_two_times_div_two:
   "even a \<Longrightarrow> 2 * (a div 2) = a"
   by (fact dvd_mult_div_cancel)
 
 lemma odd_two_times_div_two_succ [simp]:
   "odd a \<Longrightarrow> 2 * (a div 2) + 1 = a"
   using mult_div_mod_eq [of 2 a]
   by (simp add: even_iff_mod_2_eq_zero)
 
 lemma coprime_left_2_iff_odd [simp]:
   "coprime 2 a \<longleftrightarrow> odd a"
 proof
   assume "odd a"
   show "coprime 2 a"
   proof (rule coprimeI)
     fix b
     assume "b dvd 2" "b dvd a"
     then have "b dvd a mod 2"
       by (auto intro: dvd_mod)
     with \<open>odd a\<close> show "is_unit b"
       by (simp add: mod_2_eq_odd)
   qed
 next
   assume "coprime 2 a"
   show "odd a"
   proof (rule notI)
     assume "even a"
     then obtain b where "a = 2 * b" ..
     with \<open>coprime 2 a\<close> have "coprime 2 (2 * b)"
       by simp
     moreover have "\<not> coprime 2 (2 * b)"
       by (rule not_coprimeI [of 2]) simp_all
     ultimately show False
       by blast
   qed
 qed
 
 lemma coprime_right_2_iff_odd [simp]:
   "coprime a 2 \<longleftrightarrow> odd a"
   using coprime_left_2_iff_odd [of a] by (simp add: ac_simps)
 
 end
 
 context unique_euclidean_ring_with_nat
 begin
 
 subclass ring_parity ..
 
 lemma minus_1_mod_2_eq [simp]:
   "- 1 mod 2 = 1"
   by (simp add: mod_2_eq_odd)
 
 lemma minus_1_div_2_eq [simp]:
   "- 1 div 2 = - 1"
 proof -
   from div_mult_mod_eq [of "- 1" 2]
   have "- 1 div 2 * 2 = - 1 * 2"
     using add_implies_diff by fastforce
   then show ?thesis
     using mult_right_cancel [of 2 "- 1 div 2" "- 1"] by simp
 qed
 
 end
 
 
 subsection \<open>Instance for \<^typ>\<open>nat\<close>\<close>
 
 instance nat :: unique_euclidean_semiring_with_nat
   by standard (simp_all add: dvd_eq_mod_eq_0)
 
 lemma even_Suc_Suc_iff [simp]:
   "even (Suc (Suc n)) \<longleftrightarrow> even n"
   using dvd_add_triv_right_iff [of 2 n] by simp
 
 lemma even_Suc [simp]: "even (Suc n) \<longleftrightarrow> odd n"
   using even_plus_one_iff [of n] by simp
 
 lemma even_diff_nat [simp]:
   "even (m - n) \<longleftrightarrow> m < n \<or> even (m + n)" for m n :: nat
 proof (cases "n \<le> m")
   case True
   then have "m - n + n * 2 = m + n" by (simp add: mult_2_right)
   moreover have "even (m - n) \<longleftrightarrow> even (m - n + n * 2)" by simp
   ultimately have "even (m - n) \<longleftrightarrow> even (m + n)" by (simp only:)
   then show ?thesis by auto
 next
   case False
   then show ?thesis by simp
 qed
 
 lemma odd_pos:
   "odd n \<Longrightarrow> 0 < n" for n :: nat
   by (auto elim: oddE)
 
 lemma Suc_double_not_eq_double:
   "Suc (2 * m) \<noteq> 2 * n"
 proof
   assume "Suc (2 * m) = 2 * n"
   moreover have "odd (Suc (2 * m))" and "even (2 * n)"
     by simp_all
   ultimately show False by simp
 qed
 
 lemma double_not_eq_Suc_double:
   "2 * m \<noteq> Suc (2 * n)"
   using Suc_double_not_eq_double [of n m] by simp
 
 lemma odd_Suc_minus_one [simp]: "odd n \<Longrightarrow> Suc (n - Suc 0) = n"
   by (auto elim: oddE)
 
 lemma even_Suc_div_two [simp]:
   "even n \<Longrightarrow> Suc n div 2 = n div 2"
   using even_succ_div_two [of n] by simp
 
 lemma odd_Suc_div_two [simp]:
   "odd n \<Longrightarrow> Suc n div 2 = Suc (n div 2)"
   using odd_succ_div_two [of n] by simp
 
 lemma odd_two_times_div_two_nat [simp]:
   assumes "odd n"
   shows "2 * (n div 2) = n - (1 :: nat)"
 proof -
   from assms have "2 * (n div 2) + 1 = n"
     by (rule odd_two_times_div_two_succ)
   then have "Suc (2 * (n div 2)) - 1 = n - 1"
     by simp
   then show ?thesis
     by simp
 qed
 
 lemma not_mod2_eq_Suc_0_eq_0 [simp]:
   "n mod 2 \<noteq> Suc 0 \<longleftrightarrow> n mod 2 = 0"
   using not_mod_2_eq_1_eq_0 [of n] by simp
 
 lemma odd_card_imp_not_empty:
   \<open>A \<noteq> {}\<close> if \<open>odd (card A)\<close>
   using that by auto
 
 lemma nat_induct2 [case_names 0 1 step]:
   assumes "P 0" "P 1" and step: "\<And>n::nat. P n \<Longrightarrow> P (n + 2)"
   shows "P n"
 proof (induct n rule: less_induct)
   case (less n)
   show ?case
   proof (cases "n < Suc (Suc 0)")
     case True
     then show ?thesis
       using assms by (auto simp: less_Suc_eq)
   next
     case False
     then obtain k where k: "n = Suc (Suc k)"
       by (force simp: not_less nat_le_iff_add)
     then have "k<n"
       by simp
     with less assms have "P (k+2)"
       by blast
     then show ?thesis
       by (simp add: k)
   qed
 qed
 
 lemma mask_eq_sum_exp_nat:
   \<open>2 ^ n - Suc 0 = (\<Sum>m\<in>{q. q < n}. 2 ^ m)\<close>
   using mask_eq_sum_exp [where ?'a = nat] by simp
 
 context semiring_parity
 begin
 
 lemma even_sum_iff:
   \<open>even (sum f A) \<longleftrightarrow> even (card {a\<in>A. odd (f a)})\<close> if \<open>finite A\<close>
 using that proof (induction A)
   case empty
   then show ?case
     by simp
 next
   case (insert a A)
   moreover have \<open>{b \<in> insert a A. odd (f b)} = (if odd (f a) then {a} else {}) \<union> {b \<in> A. odd (f b)}\<close>
     by auto
   ultimately show ?case
     by simp
 qed
 
 lemma even_prod_iff:
   \<open>even (prod f A) \<longleftrightarrow> (\<exists>a\<in>A. even (f a))\<close> if \<open>finite A\<close>
   using that by (induction A) simp_all
 
 lemma even_mask_iff [simp]:
   \<open>even (2 ^ n - 1) \<longleftrightarrow> n = 0\<close>
 proof (cases \<open>n = 0\<close>)
   case True
   then show ?thesis
     by simp
 next
   case False
   then have \<open>{a. a = 0 \<and> a < n} = {0}\<close>
     by auto
   then show ?thesis
     by (auto simp add: mask_eq_sum_exp even_sum_iff)
 qed
 
 end
 
 
 subsection \<open>Parity and powers\<close>
 
 context ring_1
 begin
 
 lemma power_minus_even [simp]: "even n \<Longrightarrow> (- a) ^ n = a ^ n"
   by (auto elim: evenE)
 
 lemma power_minus_odd [simp]: "odd n \<Longrightarrow> (- a) ^ n = - (a ^ n)"
   by (auto elim: oddE)
 
 lemma uminus_power_if:
   "(- a) ^ n = (if even n then a ^ n else - (a ^ n))"
   by auto
 
 lemma neg_one_even_power [simp]: "even n \<Longrightarrow> (- 1) ^ n = 1"
   by simp
 
 lemma neg_one_odd_power [simp]: "odd n \<Longrightarrow> (- 1) ^ n = - 1"
   by simp
 
 lemma neg_one_power_add_eq_neg_one_power_diff: "k \<le> n \<Longrightarrow> (- 1) ^ (n + k) = (- 1) ^ (n - k)"
   by (cases "even (n + k)") auto
 
 lemma minus_one_power_iff: "(- 1) ^ n = (if even n then 1 else - 1)"
   by (induct n) auto
 
 end
 
 context linordered_idom
 begin
 
 lemma zero_le_even_power: "even n \<Longrightarrow> 0 \<le> a ^ n"
   by (auto elim: evenE)
 
 lemma zero_le_odd_power: "odd n \<Longrightarrow> 0 \<le> a ^ n \<longleftrightarrow> 0 \<le> a"
   by (auto simp add: power_even_eq zero_le_mult_iff elim: oddE)
 
 lemma zero_le_power_eq: "0 \<le> a ^ n \<longleftrightarrow> even n \<or> odd n \<and> 0 \<le> a"
   by (auto simp add: zero_le_even_power zero_le_odd_power)
 
 lemma zero_less_power_eq: "0 < a ^ n \<longleftrightarrow> n = 0 \<or> even n \<and> a \<noteq> 0 \<or> odd n \<and> 0 < a"
 proof -
   have [simp]: "0 = a ^ n \<longleftrightarrow> a = 0 \<and> n > 0"
     unfolding power_eq_0_iff [of a n, symmetric] by blast
   show ?thesis
     unfolding less_le zero_le_power_eq by auto
 qed
 
 lemma power_less_zero_eq [simp]: "a ^ n < 0 \<longleftrightarrow> odd n \<and> a < 0"
   unfolding not_le [symmetric] zero_le_power_eq by auto
 
 lemma power_le_zero_eq: "a ^ n \<le> 0 \<longleftrightarrow> n > 0 \<and> (odd n \<and> a \<le> 0 \<or> even n \<and> a = 0)"
   unfolding not_less [symmetric] zero_less_power_eq by auto
 
 lemma power_even_abs: "even n \<Longrightarrow> \<bar>a\<bar> ^ n = a ^ n"
   using power_abs [of a n] by (simp add: zero_le_even_power)
 
 lemma power_mono_even:
   assumes "even n" and "\<bar>a\<bar> \<le> \<bar>b\<bar>"
   shows "a ^ n \<le> b ^ n"
 proof -
   have "0 \<le> \<bar>a\<bar>" by auto
   with \<open>\<bar>a\<bar> \<le> \<bar>b\<bar>\<close> have "\<bar>a\<bar> ^ n \<le> \<bar>b\<bar> ^ n"
     by (rule power_mono)
   with \<open>even n\<close> show ?thesis
     by (simp add: power_even_abs)
 qed
 
 lemma power_mono_odd:
   assumes "odd n" and "a \<le> b"
   shows "a ^ n \<le> b ^ n"
 proof (cases "b < 0")
   case True
   with \<open>a \<le> b\<close> have "- b \<le> - a" and "0 \<le> - b" by auto
   then have "(- b) ^ n \<le> (- a) ^ n" by (rule power_mono)
   with \<open>odd n\<close> show ?thesis by simp
 next
   case False
   then have "0 \<le> b" by auto
   show ?thesis
   proof (cases "a < 0")
     case True
     then have "n \<noteq> 0" and "a \<le> 0" using \<open>odd n\<close> [THEN odd_pos] by auto
     then have "a ^ n \<le> 0" unfolding power_le_zero_eq using \<open>odd n\<close> by auto
     moreover from \<open>0 \<le> b\<close> have "0 \<le> b ^ n" by auto
     ultimately show ?thesis by auto
   next
     case False
     then have "0 \<le> a" by auto
     with \<open>a \<le> b\<close> show ?thesis
       using power_mono by auto
   qed
 qed
 
 text \<open>Simplify, when the exponent is a numeral\<close>
 
 lemma zero_le_power_eq_numeral [simp]:
   "0 \<le> a ^ numeral w \<longleftrightarrow> even (numeral w :: nat) \<or> odd (numeral w :: nat) \<and> 0 \<le> a"
   by (fact zero_le_power_eq)
 
 lemma zero_less_power_eq_numeral [simp]:
   "0 < a ^ numeral w \<longleftrightarrow>
     numeral w = (0 :: nat) \<or>
     even (numeral w :: nat) \<and> a \<noteq> 0 \<or>
     odd (numeral w :: nat) \<and> 0 < a"
   by (fact zero_less_power_eq)
 
 lemma power_le_zero_eq_numeral [simp]:
   "a ^ numeral w \<le> 0 \<longleftrightarrow>
     (0 :: nat) < numeral w \<and>
     (odd (numeral w :: nat) \<and> a \<le> 0 \<or> even (numeral w :: nat) \<and> a = 0)"
   by (fact power_le_zero_eq)
 
 lemma power_less_zero_eq_numeral [simp]:
   "a ^ numeral w < 0 \<longleftrightarrow> odd (numeral w :: nat) \<and> a < 0"
   by (fact power_less_zero_eq)
 
 lemma power_even_abs_numeral [simp]:
   "even (numeral w :: nat) \<Longrightarrow> \<bar>a\<bar> ^ numeral w = a ^ numeral w"
   by (fact power_even_abs)
 
 end
 
 context unique_euclidean_semiring_with_nat
 begin
 
 lemma even_mask_div_iff':
   \<open>even ((2 ^ m - 1) div 2 ^ n) \<longleftrightarrow> m \<le> n\<close>
 proof -
   have \<open>even ((2 ^ m - 1) div 2 ^ n) \<longleftrightarrow> even (of_nat ((2 ^ m - Suc 0) div 2 ^ n))\<close>
     by (simp only: of_nat_div) (simp add: of_nat_diff)
   also have \<open>\<dots> \<longleftrightarrow> even ((2 ^ m - Suc 0) div 2 ^ n)\<close>
     by simp
   also have \<open>\<dots> \<longleftrightarrow> m \<le> n\<close>
   proof (cases \<open>m \<le> n\<close>)
     case True
     then show ?thesis
       by (simp add: Suc_le_lessD)
   next
     case False
     then obtain r where r: \<open>m = n + Suc r\<close>
       using less_imp_Suc_add by fastforce
     from r have \<open>{q. q < m} \<inter> {q. 2 ^ n dvd (2::nat) ^ q} = {q. n \<le> q \<and> q < m}\<close>
       by (auto simp add: dvd_power_iff_le)
     moreover from r have \<open>{q. q < m} \<inter> {q. \<not> 2 ^ n dvd (2::nat) ^ q} = {q. q < n}\<close>
       by (auto simp add: dvd_power_iff_le)
     moreover from False have \<open>{q. n \<le> q \<and> q < m \<and> q \<le> n} = {n}\<close>
       by auto
     then have \<open>odd ((\<Sum>a\<in>{q. n \<le> q \<and> q < m}. 2 ^ a div (2::nat) ^ n) + sum ((^) 2) {q. q < n} div 2 ^ n)\<close>
       by (simp_all add: euclidean_semiring_cancel_class.power_diff_power_eq semiring_parity_class.even_sum_iff not_less mask_eq_sum_exp_nat [symmetric])
     ultimately have \<open>odd (sum ((^) (2::nat)) {q. q < m} div 2 ^ n)\<close>
       by (subst euclidean_semiring_cancel_class.sum_div_partition) simp_all
     with False show ?thesis
       by (simp add: mask_eq_sum_exp_nat)
   qed
   finally show ?thesis .
 qed
 
 end
 
 
 subsection \<open>Instance for \<^typ>\<open>int\<close>\<close>
 
 lemma even_diff_iff:
   "even (k - l) \<longleftrightarrow> even (k + l)" for k l :: int
   by (fact even_diff)
 
 lemma even_abs_add_iff:
   "even (\<bar>k\<bar> + l) \<longleftrightarrow> even (k + l)" for k l :: int
   by simp
 
 lemma even_add_abs_iff:
   "even (k + \<bar>l\<bar>) \<longleftrightarrow> even (k + l)" for k l :: int
   by simp
 
 lemma even_nat_iff: "0 \<le> k \<Longrightarrow> even (nat k) \<longleftrightarrow> even k"
   by (simp add: even_of_nat [of "nat k", where ?'a = int, symmetric])
 
 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 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
 
 context
   assumes "SORT_CONSTRAINT('a::division_ring)"
 begin
 
 lemma power_int_minus_left:
   "power_int (-a :: 'a) n = (if even n then power_int a n else -power_int a n)"
   by (auto simp: power_int_def minus_one_power_iff even_nat_iff)
 
 lemma power_int_minus_left_even [simp]: "even n \<Longrightarrow> power_int (-a :: 'a) n = power_int a n"
   by (simp add: power_int_minus_left)
 
 lemma power_int_minus_left_odd [simp]: "odd n \<Longrightarrow> power_int (-a :: 'a) n = -power_int a n"
   by (simp add: power_int_minus_left)
 
 lemma power_int_minus_left_distrib:
   "NO_MATCH (-1) x \<Longrightarrow> power_int (-a :: 'a) n = power_int (-1) n * power_int a n"
   by (simp add: power_int_minus_left)
 
 lemma power_int_minus_one_minus: "power_int (-1 :: 'a) (-n) = power_int (-1) n"
   by (simp add: power_int_minus_left)
 
 lemma power_int_minus_one_diff_commute: "power_int (-1 :: 'a) (a - b) = power_int (-1) (b - a)"
   by (subst power_int_minus_one_minus [symmetric]) auto
 
 lemma power_int_minus_one_mult_self [simp]:
   "power_int (-1 :: 'a) m * power_int (-1) m = 1"
   by (simp add: power_int_minus_left)
 
 lemma power_int_minus_one_mult_self' [simp]:
   "power_int (-1 :: 'a) m * (power_int (-1) m * b) = b"
   by (simp add: power_int_minus_left)
 
 end
 
 
 subsection \<open>Abstract bit structures\<close>
 
 class semiring_bits = semiring_parity +
   assumes bits_induct [case_names stable rec]:
     \<open>(\<And>a. a div 2 = a \<Longrightarrow> P a)
      \<Longrightarrow> (\<And>a b. P a \<Longrightarrow> (of_bool b + 2 * a) div 2 = a \<Longrightarrow> P (of_bool b + 2 * a))
         \<Longrightarrow> P a\<close>
   assumes bits_div_0 [simp]: \<open>0 div a = 0\<close>
     and bits_div_by_1 [simp]: \<open>a div 1 = a\<close>
     and bits_mod_div_trivial [simp]: \<open>a mod b div b = 0\<close>
     and even_succ_div_2 [simp]: \<open>even a \<Longrightarrow> (1 + a) div 2 = a div 2\<close>
     and even_mask_div_iff: \<open>even ((2 ^ m - 1) div 2 ^ n) \<longleftrightarrow> 2 ^ n = 0 \<or> m \<le> n\<close>
     and exp_div_exp_eq: \<open>2 ^ m div 2 ^ n = of_bool (2 ^ m \<noteq> 0 \<and> m \<ge> n) * 2 ^ (m - n)\<close>
     and div_exp_eq: \<open>a div 2 ^ m div 2 ^ n = a div 2 ^ (m + n)\<close>
     and mod_exp_eq: \<open>a mod 2 ^ m mod 2 ^ n = a mod 2 ^ min m n\<close>
     and mult_exp_mod_exp_eq: \<open>m \<le> n \<Longrightarrow> (a * 2 ^ m) mod (2 ^ n) = (a mod 2 ^ (n - m)) * 2 ^ m\<close>
     and div_exp_mod_exp_eq: \<open>a div 2 ^ n mod 2 ^ m = a mod (2 ^ (n + m)) div 2 ^ n\<close>
     and even_mult_exp_div_exp_iff: \<open>even (a * 2 ^ m div 2 ^ n) \<longleftrightarrow> m > n \<or> 2 ^ n = 0 \<or> (m \<le> n \<and> even (a div 2 ^ (n - m)))\<close>
   fixes bit :: \<open>'a \<Rightarrow> nat \<Rightarrow> bool\<close>
   assumes bit_iff_odd: \<open>bit a n \<longleftrightarrow> odd (a div 2 ^ n)\<close>
 begin
 
 text \<open>
   Having \<^const>\<open>bit\<close> as definitional class operation
   takes into account that specific instances can be implemented
   differently wrt. code generation.
 \<close>
 
 lemma bits_div_by_0 [simp]:
   \<open>a div 0 = 0\<close>
   by (metis add_cancel_right_right bits_mod_div_trivial mod_mult_div_eq mult_not_zero)
 
 lemma bits_1_div_2 [simp]:
   \<open>1 div 2 = 0\<close>
   using even_succ_div_2 [of 0] by simp
 
 lemma bits_1_div_exp [simp]:
   \<open>1 div 2 ^ n = of_bool (n = 0)\<close>
   using div_exp_eq [of 1 1] by (cases n) simp_all
 
 lemma even_succ_div_exp [simp]:
   \<open>(1 + a) div 2 ^ n = a div 2 ^ n\<close> if \<open>even a\<close> and \<open>n > 0\<close>
 proof (cases n)
   case 0
   with that show ?thesis
     by simp
 next
   case (Suc n)
   with \<open>even a\<close> have \<open>(1 + a) div 2 ^ Suc n = a div 2 ^ Suc n\<close>
   proof (induction n)
     case 0
     then show ?case
       by simp
   next
     case (Suc n)
     then show ?case
       using div_exp_eq [of _ 1 \<open>Suc n\<close>, symmetric]
       by simp
   qed
   with Suc show ?thesis
     by simp
 qed
 
 lemma even_succ_mod_exp [simp]:
   \<open>(1 + a) mod 2 ^ n = 1 + (a mod 2 ^ n)\<close> if \<open>even a\<close> and \<open>n > 0\<close>
   using div_mult_mod_eq [of \<open>1 + a\<close> \<open>2 ^ n\<close>] that
   apply simp
   by (metis local.add.left_commute local.add_left_cancel local.div_mult_mod_eq)
 
 lemma bits_mod_by_1 [simp]:
   \<open>a mod 1 = 0\<close>
   using div_mult_mod_eq [of a 1] by simp
 
 lemma bits_mod_0 [simp]:
   \<open>0 mod a = 0\<close>
   using div_mult_mod_eq [of 0 a] by simp
 
 lemma bits_one_mod_two_eq_one [simp]:
   \<open>1 mod 2 = 1\<close>
   by (simp add: mod2_eq_if)
 
 lemma bit_0 [simp]:
   \<open>bit a 0 \<longleftrightarrow> odd a\<close>
   by (simp add: bit_iff_odd)
 
 lemma bit_Suc:
   \<open>bit a (Suc n) \<longleftrightarrow> bit (a div 2) n\<close>
   using div_exp_eq [of a 1 n] by (simp add: bit_iff_odd)
 
 lemma bit_rec:
   \<open>bit a n \<longleftrightarrow> (if n = 0 then odd a else bit (a div 2) (n - 1))\<close>
   by (cases n) (simp_all add: bit_Suc)
 
 lemma bit_0_eq [simp]:
   \<open>bit 0 = bot\<close>
   by (simp add: fun_eq_iff bit_iff_odd)
 
 context
   fixes a
   assumes stable: \<open>a div 2 = a\<close>
 begin
 
 lemma bits_stable_imp_add_self:
   \<open>a + a mod 2 = 0\<close>
 proof -
   have \<open>a div 2 * 2 + a mod 2 = a\<close>
     by (fact div_mult_mod_eq)
   then have \<open>a * 2 + a mod 2 = a\<close>
     by (simp add: stable)
   then show ?thesis
     by (simp add: mult_2_right ac_simps)
 qed
 
 lemma stable_imp_bit_iff_odd:
   \<open>bit a n \<longleftrightarrow> odd a\<close>
   by (induction n) (simp_all add: stable bit_Suc)
 
 end
 
 lemma bit_iff_idd_imp_stable:
   \<open>a div 2 = a\<close> if \<open>\<And>n. bit a n \<longleftrightarrow> odd a\<close>
 using that proof (induction a rule: bits_induct)
   case (stable a)
   then show ?case
     by simp
 next
   case (rec a b)
   from rec.prems [of 1] have [simp]: \<open>b = odd a\<close>
     by (simp add: rec.hyps bit_Suc)
   from rec.hyps have hyp: \<open>(of_bool (odd a) + 2 * a) div 2 = a\<close>
     by simp
   have \<open>bit a n \<longleftrightarrow> odd a\<close> for n
     using rec.prems [of \<open>Suc n\<close>] by (simp add: hyp bit_Suc)
   then have \<open>a div 2 = a\<close>
     by (rule rec.IH)
   then have \<open>of_bool (odd a) + 2 * a = 2 * (a div 2) + of_bool (odd a)\<close>
     by (simp add: ac_simps)
   also have \<open>\<dots> = a\<close>
     using mult_div_mod_eq [of 2 a]
     by (simp add: of_bool_odd_eq_mod_2)
   finally show ?case
     using \<open>a div 2 = a\<close> by (simp add: hyp)
 qed
 
 lemma exp_eq_0_imp_not_bit:
   \<open>\<not> bit a n\<close> if \<open>2 ^ n = 0\<close>
   using that by (simp add: bit_iff_odd)
 
 lemma bit_eqI:
   \<open>a = b\<close> if \<open>\<And>n. 2 ^ n \<noteq> 0 \<Longrightarrow> bit a n \<longleftrightarrow> bit b n\<close>
 proof -
   have \<open>bit a n \<longleftrightarrow> bit b n\<close> for n
   proof (cases \<open>2 ^ n = 0\<close>)
     case True
     then show ?thesis
       by (simp add: exp_eq_0_imp_not_bit)
   next
     case False
     then show ?thesis
       by (rule that)
   qed
   then show ?thesis proof (induction a arbitrary: b rule: bits_induct)
     case (stable a)
     from stable(2) [of 0] have **: \<open>even b \<longleftrightarrow> even a\<close>
       by simp
     have \<open>b div 2 = b\<close>
     proof (rule bit_iff_idd_imp_stable)
       fix n
       from stable have *: \<open>bit b n \<longleftrightarrow> bit a n\<close>
         by simp
       also have \<open>bit a n \<longleftrightarrow> odd a\<close>
         using stable by (simp add: stable_imp_bit_iff_odd)
       finally show \<open>bit b n \<longleftrightarrow> odd b\<close>
         by (simp add: **)
     qed
     from ** have \<open>a mod 2 = b mod 2\<close>
       by (simp add: mod2_eq_if)
     then have \<open>a mod 2 + (a + b) = b mod 2 + (a + b)\<close>
       by simp
     then have \<open>a + a mod 2 + b = b + b mod 2 + a\<close>
       by (simp add: ac_simps)
     with \<open>a div 2 = a\<close> \<open>b div 2 = b\<close> show ?case
       by (simp add: bits_stable_imp_add_self)
   next
     case (rec a p)
     from rec.prems [of 0] have [simp]: \<open>p = odd b\<close>
       by simp
     from rec.hyps have \<open>bit a n \<longleftrightarrow> bit (b div 2) n\<close> for n
       using rec.prems [of \<open>Suc n\<close>] by (simp add: bit_Suc)
     then have \<open>a = b div 2\<close>
       by (rule rec.IH)
     then have \<open>2 * a = 2 * (b div 2)\<close>
       by simp
     then have \<open>b mod 2 + 2 * a = b mod 2 + 2 * (b div 2)\<close>
       by simp
     also have \<open>\<dots> = b\<close>
       by (fact mod_mult_div_eq)
     finally show ?case
       by (auto simp add: mod2_eq_if)
   qed
 qed
 
 lemma bit_eq_iff:
   \<open>a = b \<longleftrightarrow> (\<forall>n. bit a n \<longleftrightarrow> bit b n)\<close>
   by (auto intro: bit_eqI)
 
 named_theorems bit_simps \<open>Simplification rules for \<^const>\<open>bit\<close>\<close>
 
 lemma bit_exp_iff [bit_simps]:
   \<open>bit (2 ^ m) n \<longleftrightarrow> 2 ^ m \<noteq> 0 \<and> m = n\<close>
   by (auto simp add: bit_iff_odd exp_div_exp_eq)
 
 lemma bit_1_iff [bit_simps]:
   \<open>bit 1 n \<longleftrightarrow> 1 \<noteq> 0 \<and> n = 0\<close>
   using bit_exp_iff [of 0 n] by simp
 
 lemma bit_2_iff [bit_simps]:
   \<open>bit 2 n \<longleftrightarrow> 2 \<noteq> 0 \<and> n = 1\<close>
   using bit_exp_iff [of 1 n] by auto
 
 lemma even_bit_succ_iff:
   \<open>bit (1 + a) n \<longleftrightarrow> bit a n \<or> n = 0\<close> if \<open>even a\<close>
   using that by (cases \<open>n = 0\<close>) (simp_all add: bit_iff_odd)
 
 lemma odd_bit_iff_bit_pred:
   \<open>bit a n \<longleftrightarrow> bit (a - 1) n \<or> n = 0\<close> if \<open>odd a\<close>
 proof -
   from \<open>odd a\<close> obtain b where \<open>a = 2 * b + 1\<close> ..
   moreover have \<open>bit (2 * b) n \<or> n = 0 \<longleftrightarrow> bit (1 + 2 * b) n\<close>
     using even_bit_succ_iff by simp
   ultimately show ?thesis by (simp add: ac_simps)
 qed
 
 lemma bit_double_iff [bit_simps]:
   \<open>bit (2 * a) n \<longleftrightarrow> bit a (n - 1) \<and> n \<noteq> 0 \<and> 2 ^ n \<noteq> 0\<close>
   using even_mult_exp_div_exp_iff [of a 1 n]
   by (cases n, auto simp add: bit_iff_odd ac_simps)
 
 lemma bit_eq_rec:
   \<open>a = b \<longleftrightarrow> (even a \<longleftrightarrow> even b) \<and> a div 2 = b div 2\<close> (is \<open>?P = ?Q\<close>)
 proof
   assume ?P
   then show ?Q
     by simp
 next
   assume ?Q
   then have \<open>even a \<longleftrightarrow> even b\<close> and \<open>a div 2 = b div 2\<close>
     by simp_all
   show ?P
   proof (rule bit_eqI)
     fix n
     show \<open>bit a n \<longleftrightarrow> bit b n\<close>
     proof (cases n)
       case 0
       with \<open>even a \<longleftrightarrow> even b\<close> show ?thesis
         by simp
     next
       case (Suc n)
       moreover from \<open>a div 2 = b div 2\<close> have \<open>bit (a div 2) n = bit (b div 2) n\<close>
         by simp
       ultimately show ?thesis
         by (simp add: bit_Suc)
     qed
   qed
 qed
 
 lemma bit_mod_2_iff [simp]:
   \<open>bit (a mod 2) n \<longleftrightarrow> n = 0 \<and> odd a\<close>
   by (cases a rule: parity_cases) (simp_all add: bit_iff_odd)
 
 lemma bit_mask_iff:
   \<open>bit (2 ^ m - 1) n \<longleftrightarrow> 2 ^ n \<noteq> 0 \<and> n < m\<close>
   by (simp add: bit_iff_odd even_mask_div_iff not_le)
 
 lemma bit_Numeral1_iff [simp]:
   \<open>bit (numeral Num.One) n \<longleftrightarrow> n = 0\<close>
   by (simp add: bit_rec)
 
 lemma exp_add_not_zero_imp:
   \<open>2 ^ m \<noteq> 0\<close> and \<open>2 ^ n \<noteq> 0\<close> if \<open>2 ^ (m + n) \<noteq> 0\<close>
 proof -
   have \<open>\<not> (2 ^ m = 0 \<or> 2 ^ n = 0)\<close>
   proof (rule notI)
     assume \<open>2 ^ m = 0 \<or> 2 ^ n = 0\<close>
     then have \<open>2 ^ (m + n) = 0\<close>
       by (rule disjE) (simp_all add: power_add)
     with that show False ..
   qed
   then show \<open>2 ^ m \<noteq> 0\<close> and \<open>2 ^ n \<noteq> 0\<close>
     by simp_all
 qed
 
 lemma bit_disjunctive_add_iff:
   \<open>bit (a + b) n \<longleftrightarrow> bit a n \<or> bit b n\<close>
   if \<open>\<And>n. \<not> bit a n \<or> \<not> bit b n\<close>
 proof (cases \<open>2 ^ n = 0\<close>)
   case True
   then show ?thesis
     by (simp add: exp_eq_0_imp_not_bit)
 next
   case False
   with that show ?thesis proof (induction n arbitrary: a b)
     case 0
     from "0.prems"(1) [of 0] show ?case
       by auto
   next
     case (Suc n)
     from Suc.prems(1) [of 0] have even: \<open>even a \<or> even b\<close>
       by auto
     have bit: \<open>\<not> bit (a div 2) n \<or> \<not> bit (b div 2) n\<close> for n
       using Suc.prems(1) [of \<open>Suc n\<close>] by (simp add: bit_Suc)
     from Suc.prems(2) have \<open>2 * 2 ^ n \<noteq> 0\<close> \<open>2 ^ n \<noteq> 0\<close>
       by (auto simp add: mult_2)
     have \<open>a + b = (a div 2 * 2 + a mod 2) + (b div 2 * 2 + b mod 2)\<close>
       using div_mult_mod_eq [of a 2] div_mult_mod_eq [of b 2] by simp
     also have \<open>\<dots> = of_bool (odd a \<or> odd b) + 2 * (a div 2 + b div 2)\<close>
       using even by (auto simp add: algebra_simps mod2_eq_if)
     finally have \<open>bit ((a + b) div 2) n \<longleftrightarrow> bit (a div 2 + b div 2) n\<close>
-      using \<open>2 * 2 ^ n \<noteq> 0\<close> by simp (simp flip: bit_Suc add: bit_double_iff)
+      using \<open>2 * 2 ^ n \<noteq> 0\<close> by simp (simp_all flip: bit_Suc add: bit_double_iff)
     also have \<open>\<dots> \<longleftrightarrow> bit (a div 2) n \<or> bit (b div 2) n\<close>
       using bit \<open>2 ^ n \<noteq> 0\<close> by (rule Suc.IH)
     finally show ?case
       by (simp add: bit_Suc)
   qed
 qed
 
 lemma
   exp_add_not_zero_imp_left: \<open>2 ^ m \<noteq> 0\<close>
   and exp_add_not_zero_imp_right: \<open>2 ^ n \<noteq> 0\<close>
   if \<open>2 ^ (m + n) \<noteq> 0\<close>
 proof -
   have \<open>\<not> (2 ^ m = 0 \<or> 2 ^ n = 0)\<close>
   proof (rule notI)
     assume \<open>2 ^ m = 0 \<or> 2 ^ n = 0\<close>
     then have \<open>2 ^ (m + n) = 0\<close>
       by (rule disjE) (simp_all add: power_add)
     with that show False ..
   qed
   then show \<open>2 ^ m \<noteq> 0\<close> and \<open>2 ^ n \<noteq> 0\<close>
     by simp_all
 qed
 
 lemma exp_not_zero_imp_exp_diff_not_zero:
   \<open>2 ^ (n - m) \<noteq> 0\<close> if \<open>2 ^ n \<noteq> 0\<close>
 proof (cases \<open>m \<le> n\<close>)
   case True
   moreover define q where \<open>q = n - m\<close>
   ultimately have \<open>n = m + q\<close>
     by simp
   with that show ?thesis
     by (simp add: exp_add_not_zero_imp_right)
 next
   case False
   with that show ?thesis
     by simp
 qed
 
 end
 
 lemma nat_bit_induct [case_names zero even odd]:
   "P n" if zero: "P 0"
     and even: "\<And>n. P n \<Longrightarrow> n > 0 \<Longrightarrow> P (2 * n)"
     and odd: "\<And>n. P n \<Longrightarrow> P (Suc (2 * n))"
 proof (induction n rule: less_induct)
   case (less n)
   show "P n"
   proof (cases "n = 0")
     case True with zero show ?thesis by simp
   next
     case False
     with less have hyp: "P (n div 2)" by simp
     show ?thesis
     proof (cases "even n")
       case True
       then have "n \<noteq> 1"
         by auto
       with \<open>n \<noteq> 0\<close> have "n div 2 > 0"
         by simp
       with \<open>even n\<close> hyp even [of "n div 2"] show ?thesis
         by simp
     next
       case False
       with hyp odd [of "n div 2"] show ?thesis
         by simp
     qed
   qed
 qed
 
 instantiation nat :: semiring_bits
 begin
 
 definition bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> bool\<close>
   where \<open>bit_nat m n \<longleftrightarrow> odd (m div 2 ^ n)\<close>
 
 instance
 proof
   show \<open>P n\<close> if stable: \<open>\<And>n. n div 2 = n \<Longrightarrow> P n\<close>
     and rec: \<open>\<And>n b. P n \<Longrightarrow> (of_bool b + 2 * n) div 2 = n \<Longrightarrow> P (of_bool b + 2 * n)\<close>
     for P and n :: nat
   proof (induction n rule: nat_bit_induct)
     case zero
     from stable [of 0] show ?case
       by simp
   next
     case (even n)
     with rec [of n False] show ?case
       by simp
   next
     case (odd n)
     with rec [of n True] show ?case
       by simp
   qed
   show \<open>q mod 2 ^ m mod 2 ^ n = q mod 2 ^ min m n\<close>
     for q m n :: nat
     apply (auto simp add: less_iff_Suc_add power_add mod_mod_cancel split: split_min_lin)
     apply (metis div_mult2_eq mod_div_trivial mod_eq_self_iff_div_eq_0 mod_mult_self2_is_0 power_commutes)
     done
   show \<open>(q * 2 ^ m) mod (2 ^ n) = (q mod 2 ^ (n - m)) * 2 ^ m\<close> if \<open>m \<le> n\<close>
     for q m n :: nat
     using that
     apply (auto simp add: mod_mod_cancel div_mult2_eq power_add mod_mult2_eq le_iff_add split: split_min_lin)
     apply (simp add: mult.commute)
     done
   show \<open>even ((2 ^ m - (1::nat)) div 2 ^ n) \<longleftrightarrow> 2 ^ n = (0::nat) \<or> m \<le> n\<close>
     for m n :: nat
     using even_mask_div_iff' [where ?'a = nat, of m n] by simp
   show \<open>even (q * 2 ^ m div 2 ^ n) \<longleftrightarrow> n < m \<or> (2::nat) ^ n = 0 \<or> m \<le> n \<and> even (q div 2 ^ (n - m))\<close>
     for m n q r :: nat
     apply (auto simp add: not_less power_add ac_simps dest!: le_Suc_ex)
     apply (metis (full_types) dvd_mult dvd_mult_imp_div dvd_power_iff_le not_less not_less_eq order_refl power_Suc)
     done
 qed (auto simp add: div_mult2_eq mod_mult2_eq power_add power_diff bit_nat_def)
 
 end
 
 lemma int_bit_induct [case_names zero minus even odd]:
   "P k" if zero_int: "P 0"
     and minus_int: "P (- 1)"
     and even_int: "\<And>k. P k \<Longrightarrow> k \<noteq> 0 \<Longrightarrow> P (k * 2)"
     and odd_int: "\<And>k. P k \<Longrightarrow> k \<noteq> - 1 \<Longrightarrow> P (1 + (k * 2))" for k :: int
 proof (cases "k \<ge> 0")
   case True
   define n where "n = nat k"
   with True have "k = int n"
     by simp
   then show "P k"
   proof (induction n arbitrary: k rule: nat_bit_induct)
     case zero
     then show ?case
       by (simp add: zero_int)
   next
     case (even n)
     have "P (int n * 2)"
       by (rule even_int) (use even in simp_all)
     with even show ?case
       by (simp add: ac_simps)
   next
     case (odd n)
     have "P (1 + (int n * 2))"
       by (rule odd_int) (use odd in simp_all)
     with odd show ?case
       by (simp add: ac_simps)
   qed
 next
   case False
   define n where "n = nat (- k - 1)"
   with False have "k = - int n - 1"
     by simp
   then show "P k"
   proof (induction n arbitrary: k rule: nat_bit_induct)
     case zero
     then show ?case
       by (simp add: minus_int)
   next
     case (even n)
     have "P (1 + (- int (Suc n) * 2))"
       by (rule odd_int) (use even in \<open>simp_all add: algebra_simps\<close>)
     also have "\<dots> = - int (2 * n) - 1"
       by (simp add: algebra_simps)
     finally show ?case
       using even.prems by simp
   next
     case (odd n)
     have "P (- int (Suc n) * 2)"
       by (rule even_int) (use odd in \<open>simp_all add: algebra_simps\<close>)
     also have "\<dots> = - int (Suc (2 * n)) - 1"
       by (simp add: algebra_simps)
     finally show ?case
       using odd.prems by simp
   qed
 qed
 
 context semiring_bits
 begin
 
 lemma bit_of_bool_iff [bit_simps]:
   \<open>bit (of_bool b) n \<longleftrightarrow> b \<and> n = 0\<close>
   by (simp add: bit_1_iff)
 
 lemma even_of_nat_iff:
   \<open>even (of_nat n) \<longleftrightarrow> even n\<close>
   by (induction n rule: nat_bit_induct) simp_all
 
 lemma bit_of_nat_iff [bit_simps]:
   \<open>bit (of_nat m) n \<longleftrightarrow> (2::'a) ^ n \<noteq> 0 \<and> bit m n\<close>
 proof (cases \<open>(2::'a) ^ n = 0\<close>)
   case True
   then show ?thesis
     by (simp add: exp_eq_0_imp_not_bit)
 next
   case False
   then have \<open>bit (of_nat m) n \<longleftrightarrow> bit m n\<close>
   proof (induction m arbitrary: n rule: nat_bit_induct)
     case zero
     then show ?case
       by simp
   next
     case (even m)
     then show ?case
       by (cases n)
         (auto simp add: bit_double_iff Parity.bit_double_iff dest: mult_not_zero)
   next
     case (odd m)
     then show ?case
       by (cases n)
          (auto simp add: bit_double_iff even_bit_succ_iff Parity.bit_Suc dest: mult_not_zero)
   qed
   with False show ?thesis
     by simp
 qed
 
 end
 
 instantiation int :: semiring_bits
 begin
 
 definition bit_int :: \<open>int \<Rightarrow> nat \<Rightarrow> bool\<close>
   where \<open>bit_int k n \<longleftrightarrow> odd (k div 2 ^ n)\<close>
 
 instance
 proof
   show \<open>P k\<close> if stable: \<open>\<And>k. k div 2 = k \<Longrightarrow> P k\<close>
     and rec: \<open>\<And>k b. P k \<Longrightarrow> (of_bool b + 2 * k) div 2 = k \<Longrightarrow> P (of_bool b + 2 * k)\<close>
     for P and k :: int
   proof (induction k rule: int_bit_induct)
     case zero
     from stable [of 0] show ?case
       by simp
   next
     case minus
     from stable [of \<open>- 1\<close>] show ?case
       by simp
   next
     case (even k)
     with rec [of k False] show ?case
       by (simp add: ac_simps)
   next
     case (odd k)
     with rec [of k True] show ?case
       by (simp add: ac_simps)
   qed
   show \<open>(2::int) ^ m div 2 ^ n = of_bool ((2::int) ^ m \<noteq> 0 \<and> n \<le> m) * 2 ^ (m - n)\<close>
     for m n :: nat
   proof (cases \<open>m < n\<close>)
     case True
     then have \<open>n = m + (n - m)\<close>
       by simp
     then have \<open>(2::int) ^ m div 2 ^ n = (2::int) ^ m div 2 ^ (m + (n - m))\<close>
       by simp
     also have \<open>\<dots> = (2::int) ^ m div (2 ^ m * 2 ^ (n - m))\<close>
       by (simp add: power_add)
     also have \<open>\<dots> = (2::int) ^ m div 2 ^ m div 2 ^ (n - m)\<close>
       by (simp add: zdiv_zmult2_eq)
     finally show ?thesis using \<open>m < n\<close> by simp
   next
     case False
     then show ?thesis
       by (simp add: power_diff)
   qed
   show \<open>k mod 2 ^ m mod 2 ^ n = k mod 2 ^ min m n\<close>
     for m n :: nat and k :: int
     using mod_exp_eq [of \<open>nat k\<close> m n]
     apply (auto simp add: mod_mod_cancel zdiv_zmult2_eq power_add zmod_zmult2_eq le_iff_add split: split_min_lin)
      apply (auto simp add: less_iff_Suc_add mod_mod_cancel power_add)
     apply (simp only: flip: mult.left_commute [of \<open>2 ^ m\<close>])
     apply (subst zmod_zmult2_eq) apply simp_all
     done
   show \<open>(k * 2 ^ m) mod (2 ^ n) = (k mod 2 ^ (n - m)) * 2 ^ m\<close>
     if \<open>m \<le> n\<close> for m n :: nat and k :: int
     using that
     apply (auto simp add: power_add zmod_zmult2_eq le_iff_add split: split_min_lin)
     apply (simp add: ac_simps)
     done
   show \<open>even ((2 ^ m - (1::int)) div 2 ^ n) \<longleftrightarrow> 2 ^ n = (0::int) \<or> m \<le> n\<close>
     for m n :: nat
     using even_mask_div_iff' [where ?'a = int, of m n] by simp
   show \<open>even (k * 2 ^ m div 2 ^ n) \<longleftrightarrow> n < m \<or> (2::int) ^ n = 0 \<or> m \<le> n \<and> even (k div 2 ^ (n - m))\<close>
     for m n :: nat and k l :: int
     apply (auto simp add: not_less power_add ac_simps dest!: le_Suc_ex)
     apply (metis Suc_leI dvd_mult dvd_mult_imp_div dvd_power_le dvd_refl power.simps(2))
     done
 qed (auto simp add: zdiv_zmult2_eq zmod_zmult2_eq power_add power_diff not_le bit_int_def)
 
 end
 
 class semiring_bit_shifts = semiring_bits +
   fixes push_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
   assumes push_bit_eq_mult: \<open>push_bit n a = a * 2 ^ n\<close>
   fixes drop_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
   assumes drop_bit_eq_div: \<open>drop_bit n a = a div 2 ^ n\<close>
   fixes take_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
   assumes take_bit_eq_mod: \<open>take_bit n a = a mod 2 ^ n\<close>
 begin
 
 text \<open>
   Logically, \<^const>\<open>push_bit\<close>,
   \<^const>\<open>drop_bit\<close> and \<^const>\<open>take_bit\<close> are just aliases; having them
   as separate operations makes proofs easier, otherwise proof automation
   would fiddle with concrete expressions \<^term>\<open>2 ^ n\<close> in a way obfuscating the basic
   algebraic relationships between those operations.
   Having
   them as definitional class operations
   takes into account that specific instances of these can be implemented
   differently wrt. code generation.
 \<close>
 
 lemma bit_iff_odd_drop_bit:
   \<open>bit a n \<longleftrightarrow> odd (drop_bit n a)\<close>
   by (simp add: bit_iff_odd drop_bit_eq_div)
 
 lemma even_drop_bit_iff_not_bit:
   \<open>even (drop_bit n a) \<longleftrightarrow> \<not> bit a n\<close>
   by (simp add: bit_iff_odd_drop_bit)
 
 lemma div_push_bit_of_1_eq_drop_bit:
   \<open>a div push_bit n 1 = drop_bit n a\<close>
   by (simp add: push_bit_eq_mult drop_bit_eq_div)
 
 lemma bits_ident:
   "push_bit n (drop_bit n a) + take_bit n a = a"
   using div_mult_mod_eq by (simp add: push_bit_eq_mult take_bit_eq_mod drop_bit_eq_div)
 
 lemma push_bit_push_bit [simp]:
   "push_bit m (push_bit n a) = push_bit (m + n) a"
   by (simp add: push_bit_eq_mult power_add ac_simps)
 
 lemma push_bit_0_id [simp]:
   "push_bit 0 = id"
   by (simp add: fun_eq_iff push_bit_eq_mult)
 
 lemma push_bit_of_0 [simp]:
   "push_bit n 0 = 0"
   by (simp add: push_bit_eq_mult)
 
 lemma push_bit_of_1:
   "push_bit n 1 = 2 ^ n"
   by (simp add: push_bit_eq_mult)
 
 lemma push_bit_Suc [simp]:
   "push_bit (Suc n) a = push_bit n (a * 2)"
   by (simp add: push_bit_eq_mult ac_simps)
 
 lemma push_bit_double:
   "push_bit n (a * 2) = push_bit n a * 2"
   by (simp add: push_bit_eq_mult ac_simps)
 
 lemma push_bit_add:
   "push_bit n (a + b) = push_bit n a + push_bit n b"
   by (simp add: push_bit_eq_mult algebra_simps)
 
 lemma push_bit_numeral [simp]:
   \<open>push_bit (numeral l) (numeral k) = push_bit (pred_numeral l) (numeral (Num.Bit0 k))\<close>
   by (simp add: numeral_eq_Suc mult_2_right) (simp add: numeral_Bit0)
 
 lemma take_bit_0 [simp]:
   "take_bit 0 a = 0"
   by (simp add: take_bit_eq_mod)
 
 lemma take_bit_Suc:
   \<open>take_bit (Suc n) a = take_bit n (a div 2) * 2 + a mod 2\<close>
 proof -
   have \<open>take_bit (Suc n) (a div 2 * 2 + of_bool (odd a)) = take_bit n (a div 2) * 2 + of_bool (odd a)\<close>
     using even_succ_mod_exp [of \<open>2 * (a div 2)\<close> \<open>Suc n\<close>]
       mult_exp_mod_exp_eq [of 1 \<open>Suc n\<close> \<open>a div 2\<close>]
     by (auto simp add: take_bit_eq_mod ac_simps)
   then show ?thesis
     using div_mult_mod_eq [of a 2] by (simp add: mod_2_eq_odd)
 qed
 
 lemma take_bit_rec:
   \<open>take_bit n a = (if n = 0 then 0 else take_bit (n - 1) (a div 2) * 2 + a mod 2)\<close>
   by (cases n) (simp_all add: take_bit_Suc)
 
 lemma take_bit_Suc_0 [simp]:
   \<open>take_bit (Suc 0) a = a mod 2\<close>
   by (simp add: take_bit_eq_mod)
 
 lemma take_bit_of_0 [simp]:
   "take_bit n 0 = 0"
   by (simp add: take_bit_eq_mod)
 
 lemma take_bit_of_1 [simp]:
   "take_bit n 1 = of_bool (n > 0)"
   by (cases n) (simp_all add: take_bit_Suc)
 
 lemma drop_bit_of_0 [simp]:
   "drop_bit n 0 = 0"
   by (simp add: drop_bit_eq_div)
 
 lemma drop_bit_of_1 [simp]:
   "drop_bit n 1 = of_bool (n = 0)"
   by (simp add: drop_bit_eq_div)
 
 lemma drop_bit_0 [simp]:
   "drop_bit 0 = id"
   by (simp add: fun_eq_iff drop_bit_eq_div)
 
 lemma drop_bit_Suc:
   "drop_bit (Suc n) a = drop_bit n (a div 2)"
   using div_exp_eq [of a 1] by (simp add: drop_bit_eq_div)
 
 lemma drop_bit_rec:
   "drop_bit n a = (if n = 0 then a else drop_bit (n - 1) (a div 2))"
   by (cases n) (simp_all add: drop_bit_Suc)
 
 lemma drop_bit_half:
   "drop_bit n (a div 2) = drop_bit n a div 2"
   by (induction n arbitrary: a) (simp_all add: drop_bit_Suc)
 
 lemma drop_bit_of_bool [simp]:
   "drop_bit n (of_bool b) = of_bool (n = 0 \<and> b)"
   by (cases n) simp_all
 
 lemma even_take_bit_eq [simp]:
   \<open>even (take_bit n a) \<longleftrightarrow> n = 0 \<or> even a\<close>
   by (simp add: take_bit_rec [of n a])
 
 lemma take_bit_take_bit [simp]:
   "take_bit m (take_bit n a) = take_bit (min m n) a"
   by (simp add: take_bit_eq_mod mod_exp_eq ac_simps)
 
 lemma drop_bit_drop_bit [simp]:
   "drop_bit m (drop_bit n a) = drop_bit (m + n) a"
   by (simp add: drop_bit_eq_div power_add div_exp_eq ac_simps)
 
 lemma push_bit_take_bit:
   "push_bit m (take_bit n a) = take_bit (m + n) (push_bit m a)"
   apply (simp add: push_bit_eq_mult take_bit_eq_mod power_add ac_simps)
   using mult_exp_mod_exp_eq [of m \<open>m + n\<close> a] apply (simp add: ac_simps power_add)
   done
 
 lemma take_bit_push_bit:
   "take_bit m (push_bit n a) = push_bit n (take_bit (m - n) a)"
 proof (cases "m \<le> n")
   case True
   then show ?thesis
     apply (simp add:)
     apply (simp_all add: push_bit_eq_mult take_bit_eq_mod)
     apply (auto dest!: le_Suc_ex simp add: power_add ac_simps)
     using mult_exp_mod_exp_eq [of m m \<open>a * 2 ^ n\<close> for n]
     apply (simp add: ac_simps)
     done
 next
   case False
   then show ?thesis
     using push_bit_take_bit [of n "m - n" a]
     by simp
 qed
 
 lemma take_bit_drop_bit:
   "take_bit m (drop_bit n a) = drop_bit n (take_bit (m + n) a)"
   by (simp add: drop_bit_eq_div take_bit_eq_mod ac_simps div_exp_mod_exp_eq)
 
 lemma drop_bit_take_bit:
   "drop_bit m (take_bit n a) = take_bit (n - m) (drop_bit m a)"
 proof (cases "m \<le> n")
   case True
   then show ?thesis
     using take_bit_drop_bit [of "n - m" m a] by simp
 next
   case False
   then obtain q where \<open>m = n + q\<close>
     by (auto simp add: not_le dest: less_imp_Suc_add)
   then have \<open>drop_bit m (take_bit n a) = 0\<close>
     using div_exp_eq [of \<open>a mod 2 ^ n\<close> n q]
     by (simp add: take_bit_eq_mod drop_bit_eq_div)
   with False show ?thesis
     by simp
 qed
 
 lemma even_push_bit_iff [simp]:
   \<open>even (push_bit n a) \<longleftrightarrow> n \<noteq> 0 \<or> even a\<close>
   by (simp add: push_bit_eq_mult) auto
 
 lemma bit_push_bit_iff [bit_simps]:
   \<open>bit (push_bit m a) n \<longleftrightarrow> m \<le> n \<and> 2 ^ n \<noteq> 0 \<and> bit a (n - m)\<close>
   by (auto simp add: bit_iff_odd push_bit_eq_mult even_mult_exp_div_exp_iff)
 
 lemma bit_drop_bit_eq [bit_simps]:
   \<open>bit (drop_bit n a) = bit a \<circ> (+) n\<close>
   by (simp add: bit_iff_odd fun_eq_iff ac_simps flip: drop_bit_eq_div)
 
 lemma bit_take_bit_iff [bit_simps]:
   \<open>bit (take_bit m a) n \<longleftrightarrow> n < m \<and> bit a n\<close>
   by (simp add: bit_iff_odd drop_bit_take_bit not_le flip: drop_bit_eq_div)
 
 lemma stable_imp_drop_bit_eq:
   \<open>drop_bit n a = a\<close>
   if \<open>a div 2 = a\<close>
   by (induction n) (simp_all add: that drop_bit_Suc)
 
 lemma stable_imp_take_bit_eq:
   \<open>take_bit n a = (if even a then 0 else 2 ^ n - 1)\<close>
     if \<open>a div 2 = a\<close>
 proof (rule bit_eqI)
   fix m
   assume \<open>2 ^ m \<noteq> 0\<close>
   with that show \<open>bit (take_bit n a) m \<longleftrightarrow> bit (if even a then 0 else 2 ^ n - 1) m\<close>
     by (simp add: bit_take_bit_iff bit_mask_iff stable_imp_bit_iff_odd)
 qed
 
 lemma exp_dvdE:
   assumes \<open>2 ^ n dvd a\<close>
   obtains b where \<open>a = push_bit n b\<close>
 proof -
   from assms obtain b where \<open>a = 2 ^ n * b\<close> ..
   then have \<open>a = push_bit n b\<close>
     by (simp add: push_bit_eq_mult ac_simps)
   with that show thesis .
 qed
 
 lemma take_bit_eq_0_iff:
   \<open>take_bit n a = 0 \<longleftrightarrow> 2 ^ n dvd a\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof
   assume ?P
   then show ?Q
     by (simp add: take_bit_eq_mod mod_0_imp_dvd)
 next
   assume ?Q
   then obtain b where \<open>a = push_bit n b\<close>
     by (rule exp_dvdE)
   then show ?P
     by (simp add: take_bit_push_bit)
 qed
 
 lemma take_bit_tightened:
   \<open>take_bit m a = take_bit m b\<close> if \<open>take_bit n a = take_bit n b\<close> and \<open>m \<le> n\<close> 
 proof -
   from that have \<open>take_bit m (take_bit n a) = take_bit m (take_bit n b)\<close>
     by simp
   then have \<open>take_bit (min m n) a = take_bit (min m n) b\<close>
     by simp
   with that show ?thesis
     by (simp add: min_def)
 qed
 
 end
 
 instantiation nat :: semiring_bit_shifts
 begin
 
 definition push_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
   where \<open>push_bit_nat n m = m * 2 ^ n\<close>
 
 definition drop_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
   where \<open>drop_bit_nat n m = m div 2 ^ n\<close>
 
 definition take_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
   where \<open>take_bit_nat n m = m mod 2 ^ n\<close>
 
 instance
   by standard (simp_all add: push_bit_nat_def drop_bit_nat_def take_bit_nat_def)
 
 end
 
 context semiring_bit_shifts
 begin
 
 lemma push_bit_of_nat:
   \<open>push_bit n (of_nat m) = of_nat (push_bit n m)\<close>
   by (simp add: push_bit_eq_mult semiring_bit_shifts_class.push_bit_eq_mult)
 
 lemma of_nat_push_bit:
   \<open>of_nat (push_bit m n) = push_bit m (of_nat n)\<close>
   by (simp add: push_bit_eq_mult semiring_bit_shifts_class.push_bit_eq_mult)
 
 lemma take_bit_of_nat:
   \<open>take_bit n (of_nat m) = of_nat (take_bit n m)\<close>
   by (rule bit_eqI) (simp add: bit_take_bit_iff Parity.bit_take_bit_iff bit_of_nat_iff)
 
 lemma of_nat_take_bit:
   \<open>of_nat (take_bit n m) = take_bit n (of_nat m)\<close>
   by (rule bit_eqI) (simp add: bit_take_bit_iff Parity.bit_take_bit_iff bit_of_nat_iff)
 
 end
 
 instantiation int :: semiring_bit_shifts
 begin
 
 definition push_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close>
   where \<open>push_bit_int n k = k * 2 ^ n\<close>
 
 definition drop_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close>
   where \<open>drop_bit_int n k = k div 2 ^ n\<close>
 
 definition take_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close>
   where \<open>take_bit_int n k = k mod 2 ^ n\<close>
 
 instance
   by standard (simp_all add: push_bit_int_def drop_bit_int_def take_bit_int_def)
 
 end
 
 lemma bit_push_bit_iff_nat:
   \<open>bit (push_bit m q) n \<longleftrightarrow> m \<le> n \<and> bit q (n - m)\<close> for q :: nat
   by (auto simp add: bit_push_bit_iff)
 
 lemma bit_push_bit_iff_int:
   \<open>bit (push_bit m k) n \<longleftrightarrow> m \<le> n \<and> bit k (n - m)\<close> for k :: int
   by (auto simp add: bit_push_bit_iff)
 
 lemma take_bit_nat_less_exp [simp]:
   \<open>take_bit n m < 2 ^ n\<close> for n m ::nat 
   by (simp add: take_bit_eq_mod)
 
 lemma take_bit_nonnegative [simp]:
   \<open>take_bit n k \<ge> 0\<close> for k :: int
   by (simp add: take_bit_eq_mod)
 
 lemma not_take_bit_negative [simp]:
   \<open>\<not> take_bit n k < 0\<close> for k :: int
   by (simp add: not_less)
 
 lemma take_bit_int_less_exp [simp]:
   \<open>take_bit n k < 2 ^ n\<close> for k :: int
   by (simp add: take_bit_eq_mod)
 
 lemma take_bit_nat_eq_self_iff:
   \<open>take_bit n m = m \<longleftrightarrow> m < 2 ^ n\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
   for n m :: nat
 proof
   assume ?P
   moreover note take_bit_nat_less_exp [of n m]
   ultimately show ?Q
     by simp
 next
   assume ?Q
   then show ?P
     by (simp add: take_bit_eq_mod)
 qed
 
 lemma take_bit_nat_eq_self:
   \<open>take_bit n m = m\<close> if \<open>m < 2 ^ n\<close> for m n :: nat
   using that by (simp add: take_bit_nat_eq_self_iff)
 
 lemma take_bit_int_eq_self_iff:
   \<open>take_bit n k = k \<longleftrightarrow> 0 \<le> k \<and> k < 2 ^ n\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
   for k :: int
 proof
   assume ?P
   moreover note take_bit_int_less_exp [of n k] take_bit_nonnegative [of n k]
   ultimately show ?Q
     by simp
 next
   assume ?Q
   then show ?P
     by (simp add: take_bit_eq_mod)
 qed
 
 lemma take_bit_int_eq_self:
   \<open>take_bit n k = k\<close> if \<open>0 \<le> k\<close> \<open>k < 2 ^ n\<close> for k :: int
   using that by (simp add: take_bit_int_eq_self_iff)
 
 lemma take_bit_nat_less_eq_self [simp]:
   \<open>take_bit n m \<le> m\<close> for n m :: nat
   by (simp add: take_bit_eq_mod)
 
 lemma take_bit_nat_less_self_iff:
   \<open>take_bit n m < m \<longleftrightarrow> 2 ^ n \<le> m\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
   for m n :: nat
 proof
   assume ?P
   then have \<open>take_bit n m \<noteq> m\<close>
     by simp
   then show \<open>?Q\<close>
     by (simp add: take_bit_nat_eq_self_iff)
 next
   have \<open>take_bit n m < 2 ^ n\<close>
     by (fact take_bit_nat_less_exp)
   also assume ?Q
   finally show ?P .
 qed
 
 class unique_euclidean_semiring_with_bit_shifts =
   unique_euclidean_semiring_with_nat + semiring_bit_shifts
 begin
 
 lemma take_bit_of_exp [simp]:
   \<open>take_bit m (2 ^ n) = of_bool (n < m) * 2 ^ n\<close>
   by (simp add: take_bit_eq_mod exp_mod_exp)
 
 lemma take_bit_of_2 [simp]:
   \<open>take_bit n 2 = of_bool (2 \<le> n) * 2\<close>
   using take_bit_of_exp [of n 1] by simp
 
 lemma take_bit_of_mask:
   \<open>take_bit m (2 ^ n - 1) = 2 ^ min m n - 1\<close>
   by (simp add: take_bit_eq_mod mask_mod_exp)
 
 lemma push_bit_eq_0_iff [simp]:
   "push_bit n a = 0 \<longleftrightarrow> a = 0"
   by (simp add: push_bit_eq_mult)
 
 lemma take_bit_add:
   "take_bit n (take_bit n a + take_bit n b) = take_bit n (a + b)"
   by (simp add: take_bit_eq_mod mod_simps)
 
 lemma take_bit_of_1_eq_0_iff [simp]:
   "take_bit n 1 = 0 \<longleftrightarrow> n = 0"
   by (simp add: take_bit_eq_mod)
 
 lemma take_bit_Suc_1 [simp]:
   \<open>take_bit (Suc n) 1 = 1\<close>
   by (simp add: take_bit_Suc)
 
 lemma take_bit_Suc_bit0 [simp]:
   \<open>take_bit (Suc n) (numeral (Num.Bit0 k)) = take_bit n (numeral k) * 2\<close>
   by (simp add: take_bit_Suc numeral_Bit0_div_2)
 
 lemma take_bit_Suc_bit1 [simp]:
   \<open>take_bit (Suc n) (numeral (Num.Bit1 k)) = take_bit n (numeral k) * 2 + 1\<close>
   by (simp add: take_bit_Suc numeral_Bit1_div_2 mod_2_eq_odd)
 
 lemma take_bit_numeral_1 [simp]:
   \<open>take_bit (numeral l) 1 = 1\<close>
   by (simp add: take_bit_rec [of \<open>numeral l\<close> 1])
 
 lemma take_bit_numeral_bit0 [simp]:
   \<open>take_bit (numeral l) (numeral (Num.Bit0 k)) = take_bit (pred_numeral l) (numeral k) * 2\<close>
   by (simp add: take_bit_rec numeral_Bit0_div_2)
 
 lemma take_bit_numeral_bit1 [simp]:
   \<open>take_bit (numeral l) (numeral (Num.Bit1 k)) = take_bit (pred_numeral l) (numeral k) * 2 + 1\<close>
   by (simp add: take_bit_rec numeral_Bit1_div_2 mod_2_eq_odd)
 
 lemma drop_bit_Suc_bit0 [simp]:
   \<open>drop_bit (Suc n) (numeral (Num.Bit0 k)) = drop_bit n (numeral k)\<close>
   by (simp add: drop_bit_Suc numeral_Bit0_div_2)
 
 lemma drop_bit_Suc_bit1 [simp]:
   \<open>drop_bit (Suc n) (numeral (Num.Bit1 k)) = drop_bit n (numeral k)\<close>
   by (simp add: drop_bit_Suc numeral_Bit1_div_2)
 
 lemma drop_bit_numeral_bit0 [simp]:
   \<open>drop_bit (numeral l) (numeral (Num.Bit0 k)) = drop_bit (pred_numeral l) (numeral k)\<close>
   by (simp add: drop_bit_rec numeral_Bit0_div_2)
 
 lemma drop_bit_numeral_bit1 [simp]:
   \<open>drop_bit (numeral l) (numeral (Num.Bit1 k)) = drop_bit (pred_numeral l) (numeral k)\<close>
   by (simp add: drop_bit_rec numeral_Bit1_div_2)
 
 lemma drop_bit_of_nat:
   "drop_bit n (of_nat m) = of_nat (drop_bit n m)"
   by (simp add: drop_bit_eq_div Parity.drop_bit_eq_div of_nat_div [of m "2 ^ n"])
 
 lemma bit_of_nat_iff_bit [bit_simps]:
   \<open>bit (of_nat m) n \<longleftrightarrow> bit m n\<close>
 proof -
   have \<open>even (m div 2 ^ n) \<longleftrightarrow> even (of_nat (m div 2 ^ n))\<close>
     by simp
   also have \<open>of_nat (m div 2 ^ n) = of_nat m div of_nat (2 ^ n)\<close>
     by (simp add: of_nat_div)
   finally show ?thesis
     by (simp add: bit_iff_odd semiring_bits_class.bit_iff_odd)
 qed
 
 lemma of_nat_drop_bit:
   \<open>of_nat (drop_bit m n) = drop_bit m (of_nat n)\<close>
   by (simp add: drop_bit_eq_div semiring_bit_shifts_class.drop_bit_eq_div of_nat_div)
 
 lemma bit_push_bit_iff_of_nat_iff [bit_simps]:
   \<open>bit (push_bit m (of_nat r)) n \<longleftrightarrow> m \<le> n \<and> bit (of_nat r) (n - m)\<close>
   by (auto simp add: bit_push_bit_iff)
 
 end
 
 instance nat :: unique_euclidean_semiring_with_bit_shifts ..
 
 instance int :: unique_euclidean_semiring_with_bit_shifts ..
 
 lemma bit_not_int_iff':
   \<open>bit (- k - 1) n \<longleftrightarrow> \<not> bit k n\<close>
   for k :: int
 proof (induction n arbitrary: k)
   case 0
   show ?case
     by simp
 next
   case (Suc n)
   have \<open>- k - 1 = - (k + 2) + 1\<close>
     by simp
   also have \<open>(- (k + 2) + 1) div 2 = - (k div 2) - 1\<close>
   proof (cases \<open>even k\<close>)
     case True
     then have \<open>- k div 2 = - (k div 2)\<close>
       by rule (simp flip: mult_minus_right)
     with True show ?thesis
       by simp
   next
     case False
     have \<open>4 = 2 * (2::int)\<close>
       by simp
     also have \<open>2 * 2 div 2 = (2::int)\<close>
       by (simp only: nonzero_mult_div_cancel_left)
     finally have *: \<open>4 div 2 = (2::int)\<close> .
     from False obtain l where k: \<open>k = 2 * l + 1\<close> ..
     then have \<open>- k - 2 = 2 * - (l + 2) + 1\<close>
       by simp
     then have \<open>(- k - 2) div 2 + 1 = - (k div 2) - 1\<close>
       by (simp flip: mult_minus_right add: *) (simp add: k)
     with False show ?thesis
       by simp
   qed
   finally have \<open>(- k - 1) div 2 = - (k div 2) - 1\<close> .
   with Suc show ?case
     by (simp add: bit_Suc)
 qed
 
 lemma bit_minus_int_iff [bit_simps]:
   \<open>bit (- k) n \<longleftrightarrow> \<not> bit (k - 1) n\<close>
   for k :: int
   using bit_not_int_iff' [of \<open>k - 1\<close>] by simp
 
 lemma bit_nat_iff [bit_simps]:
   \<open>bit (nat k) n \<longleftrightarrow> k \<ge> 0 \<and> bit k n\<close>
 proof (cases \<open>k \<ge> 0\<close>)
   case True
   moreover define m where \<open>m = nat k\<close>
   ultimately have \<open>k = int m\<close>
     by simp
   then show ?thesis
     by (simp add: bit_simps)
 next
   case False
   then show ?thesis
     by simp
 qed
 
 lemma push_bit_nat_eq:
   \<open>push_bit n (nat k) = nat (push_bit n k)\<close>
   by (cases \<open>k \<ge> 0\<close>) (simp_all add: push_bit_eq_mult nat_mult_distrib not_le mult_nonneg_nonpos2)
 
 lemma drop_bit_nat_eq:
   \<open>drop_bit n (nat k) = nat (drop_bit n k)\<close>
   apply (cases \<open>k \<ge> 0\<close>)
    apply (simp_all add: drop_bit_eq_div nat_div_distrib nat_power_eq not_le)
   apply (simp add: divide_int_def)
   done
 
 lemma take_bit_nat_eq:
   \<open>take_bit n (nat k) = nat (take_bit n k)\<close> if \<open>k \<ge> 0\<close>
   using that by (simp add: take_bit_eq_mod nat_mod_distrib nat_power_eq)
 
 lemma nat_take_bit_eq:
   \<open>nat (take_bit n k) = take_bit n (nat k)\<close>
   if \<open>k \<ge> 0\<close>
   using that by (simp add: take_bit_eq_mod nat_mod_distrib nat_power_eq)
 
 lemma not_exp_less_eq_0_int [simp]:
   \<open>\<not> 2 ^ n \<le> (0::int)\<close>
   by (simp add: power_le_zero_eq)
 
 lemma half_nonnegative_int_iff [simp]:
   \<open>k div 2 \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int
 proof (cases \<open>k \<ge> 0\<close>)
   case True
   then show ?thesis
     by (auto simp add: divide_int_def sgn_1_pos)
 next
   case False
   then show ?thesis
     apply (auto simp add: divide_int_def not_le elim!: evenE)
     apply (simp only: minus_mult_right)
-    apply (subst nat_mult_distrib)
+    apply (subst (asm) nat_mult_distrib)
      apply simp_all
     done
 qed
 
 lemma half_negative_int_iff [simp]:
   \<open>k div 2 < 0 \<longleftrightarrow> k < 0\<close> for k :: int
   by (subst Not_eq_iff [symmetric]) (simp add: not_less)
 
 lemma push_bit_of_Suc_0 [simp]:
   "push_bit n (Suc 0) = 2 ^ n"
   using push_bit_of_1 [where ?'a = nat] by simp
 
 lemma take_bit_of_Suc_0 [simp]:
   "take_bit n (Suc 0) = of_bool (0 < n)"
   using take_bit_of_1 [where ?'a = nat] by simp
 
 lemma drop_bit_of_Suc_0 [simp]:
   "drop_bit n (Suc 0) = of_bool (n = 0)"
   using drop_bit_of_1 [where ?'a = nat] by simp
 
 lemma push_bit_minus_one:
   "push_bit n (- 1 :: int) = - (2 ^ n)"
   by (simp add: push_bit_eq_mult)
 
 lemma minus_1_div_exp_eq_int:
   \<open>- 1 div (2 :: int) ^ n = - 1\<close>
   by (induction n) (use div_exp_eq [symmetric, of \<open>- 1 :: int\<close> 1] in \<open>simp_all add: ac_simps\<close>)
 
 lemma drop_bit_minus_one [simp]:
   \<open>drop_bit n (- 1 :: int) = - 1\<close>
   by (simp add: drop_bit_eq_div minus_1_div_exp_eq_int)
 
 lemma take_bit_Suc_from_most:
   \<open>take_bit (Suc n) k = 2 ^ n * of_bool (bit k n) + take_bit n k\<close> for k :: int
   by (simp only: take_bit_eq_mod power_Suc2) (simp_all add: bit_iff_odd odd_iff_mod_2_eq_one zmod_zmult2_eq)
 
 lemma take_bit_minus:
   \<open>take_bit n (- take_bit n k) = take_bit n (- k)\<close>
     for k :: int
   by (simp add: take_bit_eq_mod mod_minus_eq)
 
 lemma take_bit_diff:
   \<open>take_bit n (take_bit n k - take_bit n l) = take_bit n (k - l)\<close>
     for k l :: int
   by (simp add: take_bit_eq_mod mod_diff_eq)
 
 lemma bit_imp_take_bit_positive:
   \<open>0 < take_bit m k\<close> if \<open>n < m\<close> and \<open>bit k n\<close> for k :: int
 proof (rule ccontr)
   assume \<open>\<not> 0 < take_bit m k\<close>
   then have \<open>take_bit m k = 0\<close>
     by (auto simp add: not_less intro: order_antisym)
   then have \<open>bit (take_bit m k) n = bit 0 n\<close>
     by simp
   with that show False
     by (simp add: bit_take_bit_iff)
 qed
 
 lemma take_bit_mult:
   \<open>take_bit n (take_bit n k * take_bit n l) = take_bit n (k * l)\<close>
   for k l :: int
   by (simp add: take_bit_eq_mod mod_mult_eq)
 
 lemma (in ring_1) of_nat_nat_take_bit_eq [simp]:
   \<open>of_nat (nat (take_bit n k)) = of_int (take_bit n k)\<close>
   by simp
 
 lemma take_bit_minus_small_eq:
   \<open>take_bit n (- k) = 2 ^ n - k\<close> if \<open>0 < k\<close> \<open>k \<le> 2 ^ n\<close> for k :: int
 proof -
   define m where \<open>m = nat k\<close>
   with that have \<open>k = int m\<close> and \<open>0 < m\<close> and \<open>m \<le> 2 ^ n\<close>
     by simp_all
   have \<open>(2 ^ n - m) mod 2 ^ n = 2 ^ n - m\<close>
     using \<open>0 < m\<close> by simp
   then have \<open>int ((2 ^ n - m) mod 2 ^ n) = int (2 ^ n - m)\<close>
     by simp
   then have \<open>(2 ^ n - int m) mod 2 ^ n = 2 ^ n - int m\<close>
     using \<open>m \<le> 2 ^ n\<close> by (simp only: of_nat_mod of_nat_diff) simp
   with \<open>k = int m\<close> have \<open>(2 ^ n - k) mod 2 ^ n = 2 ^ n - k\<close>
     by simp
   then show ?thesis
     by (simp add: take_bit_eq_mod)
 qed
 
 lemma drop_bit_push_bit_int:
   \<open>drop_bit m (push_bit n k) = drop_bit (m - n) (push_bit (n - m) k)\<close> for k :: int
   by (cases \<open>m \<le> n\<close>) (auto simp add: mult.left_commute [of _ \<open>2 ^ n\<close>] mult.commute [of _ \<open>2 ^ n\<close>] mult.assoc
     mult.commute [of k] drop_bit_eq_div push_bit_eq_mult not_le power_add dest!: le_Suc_ex less_imp_Suc_add)
 
 lemma push_bit_nonnegative_int_iff [simp]:
   \<open>push_bit n k \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int
   by (simp add: push_bit_eq_mult zero_le_mult_iff)
 
 lemma push_bit_negative_int_iff [simp]:
   \<open>push_bit n k < 0 \<longleftrightarrow> k < 0\<close> for k :: int
   by (subst Not_eq_iff [symmetric]) (simp add: not_less)
 
 lemma drop_bit_nonnegative_int_iff [simp]:
   \<open>drop_bit n k \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int
   by (induction n) (simp_all add: drop_bit_Suc drop_bit_half)
 
 lemma drop_bit_negative_int_iff [simp]:
   \<open>drop_bit n k < 0 \<longleftrightarrow> k < 0\<close> for k :: int
   by (subst Not_eq_iff [symmetric]) (simp add: not_less)
 
 code_identifier
   code_module Parity \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith
 
 end
diff --git a/src/HOL/Rings.thy b/src/HOL/Rings.thy
--- a/src/HOL/Rings.thy
+++ b/src/HOL/Rings.thy
@@ -1,2692 +1,2736 @@
 (*  Title:      HOL/Rings.thy
     Author:     Gertrud Bauer
     Author:     Steven Obua
     Author:     Tobias Nipkow
     Author:     Lawrence C Paulson
     Author:     Markus Wenzel
     Author:     Jeremy Avigad
 *)
 
 section \<open>Rings\<close>
 
 theory Rings
   imports Groups Set Fun
 begin
 
 subsection \<open>Semirings and rings\<close>
 
 class semiring = ab_semigroup_add + semigroup_mult +
   assumes distrib_right [algebra_simps, algebra_split_simps]: "(a + b) * c = a * c + b * c"
   assumes distrib_left [algebra_simps, algebra_split_simps]: "a * (b + c) = a * b + a * c"
 begin
 
 text \<open>For the \<open>combine_numerals\<close> simproc\<close>
 lemma combine_common_factor: "a * e + (b * e + c) = (a + b) * e + c"
   by (simp add: distrib_right ac_simps)
 
 end
 
 class mult_zero = times + zero +
   assumes mult_zero_left [simp]: "0 * a = 0"
   assumes mult_zero_right [simp]: "a * 0 = 0"
 begin
 
 lemma mult_not_zero: "a * b \<noteq> 0 \<Longrightarrow> a \<noteq> 0 \<and> b \<noteq> 0"
   by auto
 
 end
 
 class semiring_0 = semiring + comm_monoid_add + mult_zero
 
 class semiring_0_cancel = semiring + cancel_comm_monoid_add
 begin
 
 subclass semiring_0
 proof
   fix a :: 'a
   have "0 * a + 0 * a = 0 * a + 0"
     by (simp add: distrib_right [symmetric])
   then show "0 * a = 0"
     by (simp only: add_left_cancel)
   have "a * 0 + a * 0 = a * 0 + 0"
     by (simp add: distrib_left [symmetric])
   then show "a * 0 = 0"
     by (simp only: add_left_cancel)
 qed
 
 end
 
 class comm_semiring = ab_semigroup_add + ab_semigroup_mult +
   assumes distrib: "(a + b) * c = a * c + b * c"
 begin
 
 subclass semiring
 proof
   fix a b c :: 'a
   show "(a + b) * c = a * c + b * c"
     by (simp add: distrib)
   have "a * (b + c) = (b + c) * a"
     by (simp add: ac_simps)
   also have "\<dots> = b * a + c * a"
     by (simp only: distrib)
   also have "\<dots> = a * b + a * c"
     by (simp add: ac_simps)
   finally show "a * (b + c) = a * b + a * c"
     by blast
 qed
 
 end
 
 class comm_semiring_0 = comm_semiring + comm_monoid_add + mult_zero
 begin
 
 subclass semiring_0 ..
 
 end
 
 class comm_semiring_0_cancel = comm_semiring + cancel_comm_monoid_add
 begin
 
 subclass semiring_0_cancel ..
 
 subclass comm_semiring_0 ..
 
 end
 
 class zero_neq_one = zero + one +
   assumes zero_neq_one [simp]: "0 \<noteq> 1"
 begin
 
 lemma one_neq_zero [simp]: "1 \<noteq> 0"
   by (rule not_sym) (rule zero_neq_one)
 
 definition of_bool :: "bool \<Rightarrow> 'a"
   where "of_bool p = (if p then 1 else 0)"
 
 lemma of_bool_eq [simp, code]:
   "of_bool False = 0"
   "of_bool True = 1"
   by (simp_all add: of_bool_def)
 
 lemma of_bool_eq_iff: "of_bool p = of_bool q \<longleftrightarrow> p = q"
   by (simp add: of_bool_def)
 
 lemma split_of_bool [split]: "P (of_bool p) \<longleftrightarrow> (p \<longrightarrow> P 1) \<and> (\<not> p \<longrightarrow> P 0)"
   by (cases p) simp_all
 
-lemma split_of_bool_asm: "P (of_bool p) \<longleftrightarrow> \<not> (p \<and> \<not> P 1 \<or> \<not> p \<and> \<not> P 0)"
+lemma split_of_bool_asm [split]: "P (of_bool p) \<longleftrightarrow> \<not> (p \<and> \<not> P 1 \<or> \<not> p \<and> \<not> P 0)"
   by (cases p) simp_all
 
+lemma of_bool_eq_0_iff [simp]:
+  \<open>of_bool P = 0 \<longleftrightarrow> \<not> P\<close>
+  by simp
+
+lemma of_bool_eq_1_iff [simp]:
+  \<open>of_bool P = 1 \<longleftrightarrow> P\<close>
+  by simp
+
 end
 
 class semiring_1 = zero_neq_one + semiring_0 + monoid_mult
 begin
 
 lemma of_bool_conj:
   "of_bool (P \<and> Q) = of_bool P * of_bool Q"
   by auto
 
 end
 
 lemma lambda_zero: "(\<lambda>h::'a::mult_zero. 0) = (*) 0"
   by auto
 
 lemma lambda_one: "(\<lambda>x::'a::monoid_mult. x) = (*) 1"
   by auto
 
 subsection \<open>Abstract divisibility\<close>
 
 class dvd = times
 begin
 
 definition dvd :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "dvd" 50)
   where "b dvd a \<longleftrightarrow> (\<exists>k. a = b * k)"
 
 lemma dvdI [intro?]: "a = b * k \<Longrightarrow> b dvd a"
   unfolding dvd_def ..
 
 lemma dvdE [elim]: "b dvd a \<Longrightarrow> (\<And>k. a = b * k \<Longrightarrow> P) \<Longrightarrow> P"
   unfolding dvd_def by blast
 
 end
 
 context comm_monoid_mult
 begin
 
 subclass dvd .
 
 lemma dvd_refl [simp]: "a dvd a"
 proof
   show "a = a * 1" by simp
 qed
 
 lemma dvd_trans [trans]:
   assumes "a dvd b" and "b dvd c"
   shows "a dvd c"
 proof -
   from assms obtain v where "b = a * v"
     by auto
   moreover from assms obtain w where "c = b * w"
     by auto
   ultimately have "c = a * (v * w)"
     by (simp add: mult.assoc)
   then show ?thesis ..
 qed
 
 lemma subset_divisors_dvd: "{c. c dvd a} \<subseteq> {c. c dvd b} \<longleftrightarrow> a dvd b"
   by (auto simp add: subset_iff intro: dvd_trans)
 
 lemma strict_subset_divisors_dvd: "{c. c dvd a} \<subset> {c. c dvd b} \<longleftrightarrow> a dvd b \<and> \<not> b dvd a"
   by (auto simp add: subset_iff intro: dvd_trans)
 
 lemma one_dvd [simp]: "1 dvd a"
   by (auto intro: dvdI)
 
 lemma dvd_mult [simp]: "a dvd (b * c)" if "a dvd c"
   using that by rule (auto intro: mult.left_commute dvdI)
 
 lemma dvd_mult2 [simp]: "a dvd (b * c)" if "a dvd b"
   using that dvd_mult [of a b c] by (simp add: ac_simps)
 
 lemma dvd_triv_right [simp]: "a dvd b * a"
   by (rule dvd_mult) (rule dvd_refl)
 
 lemma dvd_triv_left [simp]: "a dvd a * b"
   by (rule dvd_mult2) (rule dvd_refl)
 
 lemma mult_dvd_mono:
   assumes "a dvd b"
     and "c dvd d"
   shows "a * c dvd b * d"
 proof -
   from \<open>a dvd b\<close> obtain b' where "b = a * b'" ..
   moreover from \<open>c dvd d\<close> obtain d' where "d = c * d'" ..
   ultimately have "b * d = (a * c) * (b' * d')"
     by (simp add: ac_simps)
   then show ?thesis ..
 qed
 
 lemma dvd_mult_left: "a * b dvd c \<Longrightarrow> a dvd c"
   by (simp add: dvd_def mult.assoc) blast
 
 lemma dvd_mult_right: "a * b dvd c \<Longrightarrow> b dvd c"
   using dvd_mult_left [of b a c] by (simp add: ac_simps)
 
 end
 
 class comm_semiring_1 = zero_neq_one + comm_semiring_0 + comm_monoid_mult
 begin
 
 subclass semiring_1 ..
 
 lemma dvd_0_left_iff [simp]: "0 dvd a \<longleftrightarrow> a = 0"
   by auto
 
 lemma dvd_0_right [iff]: "a dvd 0"
 proof
   show "0 = a * 0" by simp
 qed
 
 lemma dvd_0_left: "0 dvd a \<Longrightarrow> a = 0"
   by simp
 
 lemma dvd_add [simp]:
   assumes "a dvd b" and "a dvd c"
   shows "a dvd (b + c)"
 proof -
   from \<open>a dvd b\<close> obtain b' where "b = a * b'" ..
   moreover from \<open>a dvd c\<close> obtain c' where "c = a * c'" ..
   ultimately have "b + c = a * (b' + c')"
     by (simp add: distrib_left)
   then show ?thesis ..
 qed
 
 end
 
 class semiring_1_cancel = semiring + cancel_comm_monoid_add
   + zero_neq_one + monoid_mult
 begin
 
 subclass semiring_0_cancel ..
 
 subclass semiring_1 ..
 
 end
 
 class comm_semiring_1_cancel =
   comm_semiring + cancel_comm_monoid_add + zero_neq_one + comm_monoid_mult +
   assumes right_diff_distrib' [algebra_simps, algebra_split_simps]:
     "a * (b - c) = a * b - a * c"
 begin
 
 subclass semiring_1_cancel ..
 subclass comm_semiring_0_cancel ..
 subclass comm_semiring_1 ..
 
 lemma left_diff_distrib' [algebra_simps, algebra_split_simps]:
   "(b - c) * a = b * a - c * a"
   by (simp add: algebra_simps)
 
 lemma dvd_add_times_triv_left_iff [simp]: "a dvd c * a + b \<longleftrightarrow> a dvd b"
 proof -
   have "a dvd a * c + b \<longleftrightarrow> a dvd b" (is "?P \<longleftrightarrow> ?Q")
   proof
     assume ?Q
     then show ?P by simp
   next
     assume ?P
     then obtain d where "a * c + b = a * d" ..
     then have "a * c + b - a * c = a * d - a * c" by simp
     then have "b = a * d - a * c" by simp
     then have "b = a * (d - c)" by (simp add: algebra_simps)
     then show ?Q ..
   qed
   then show "a dvd c * a + b \<longleftrightarrow> a dvd b" by (simp add: ac_simps)
 qed
 
 lemma dvd_add_times_triv_right_iff [simp]: "a dvd b + c * a \<longleftrightarrow> a dvd b"
   using dvd_add_times_triv_left_iff [of a c b] by (simp add: ac_simps)
 
 lemma dvd_add_triv_left_iff [simp]: "a dvd a + b \<longleftrightarrow> a dvd b"
   using dvd_add_times_triv_left_iff [of a 1 b] by simp
 
 lemma dvd_add_triv_right_iff [simp]: "a dvd b + a \<longleftrightarrow> a dvd b"
   using dvd_add_times_triv_right_iff [of a b 1] by simp
 
 lemma dvd_add_right_iff:
   assumes "a dvd b"
   shows "a dvd b + c \<longleftrightarrow> a dvd c" (is "?P \<longleftrightarrow> ?Q")
 proof
   assume ?P
   then obtain d where "b + c = a * d" ..
   moreover from \<open>a dvd b\<close> obtain e where "b = a * e" ..
   ultimately have "a * e + c = a * d" by simp
   then have "a * e + c - a * e = a * d - a * e" by simp
   then have "c = a * d - a * e" by simp
   then have "c = a * (d - e)" by (simp add: algebra_simps)
   then show ?Q ..
 next
   assume ?Q
   with assms show ?P by simp
 qed
 
 lemma dvd_add_left_iff: "a dvd c \<Longrightarrow> a dvd b + c \<longleftrightarrow> a dvd b"
   using dvd_add_right_iff [of a c b] by (simp add: ac_simps)
 
 end
 
 class ring = semiring + ab_group_add
 begin
 
 subclass semiring_0_cancel ..
 
 text \<open>Distribution rules\<close>
 
 lemma minus_mult_left: "- (a * b) = - a * b"
   by (rule minus_unique) (simp add: distrib_right [symmetric])
 
 lemma minus_mult_right: "- (a * b) = a * - b"
   by (rule minus_unique) (simp add: distrib_left [symmetric])
 
 text \<open>Extract signs from products\<close>
 lemmas mult_minus_left [simp] = minus_mult_left [symmetric]
 lemmas mult_minus_right [simp] = minus_mult_right [symmetric]
 
 lemma minus_mult_minus [simp]: "- a * - b = a * b"
   by simp
 
 lemma minus_mult_commute: "- a * b = a * - b"
   by simp
 
 lemma right_diff_distrib [algebra_simps, algebra_split_simps]:
   "a * (b - c) = a * b - a * c"
   using distrib_left [of a b "-c "] by simp
 
 lemma left_diff_distrib [algebra_simps, algebra_split_simps]:
   "(a - b) * c = a * c - b * c"
   using distrib_right [of a "- b" c] by simp
 
 lemmas ring_distribs = distrib_left distrib_right left_diff_distrib right_diff_distrib
 
 lemma eq_add_iff1: "a * e + c = b * e + d \<longleftrightarrow> (a - b) * e + c = d"
   by (simp add: algebra_simps)
 
 lemma eq_add_iff2: "a * e + c = b * e + d \<longleftrightarrow> c = (b - a) * e + d"
   by (simp add: algebra_simps)
 
 end
 
 lemmas ring_distribs = distrib_left distrib_right left_diff_distrib right_diff_distrib
 
 class comm_ring = comm_semiring + ab_group_add
 begin
 
 subclass ring ..
 subclass comm_semiring_0_cancel ..
 
 lemma square_diff_square_factored: "x * x - y * y = (x + y) * (x - y)"
   by (simp add: algebra_simps)
 
 end
 
 class ring_1 = ring + zero_neq_one + monoid_mult
 begin
 
 subclass semiring_1_cancel ..
 
+lemma of_bool_not_iff [simp]:
+  \<open>of_bool (\<not> P) = 1 - of_bool P\<close>
+  by simp
+
 lemma square_diff_one_factored: "x * x - 1 = (x + 1) * (x - 1)"
   by (simp add: algebra_simps)
 
 end
 
 class comm_ring_1 = comm_ring + zero_neq_one + comm_monoid_mult
 begin
 
 subclass ring_1 ..
 subclass comm_semiring_1_cancel
   by standard (simp add: algebra_simps)
 
 lemma dvd_minus_iff [simp]: "x dvd - y \<longleftrightarrow> x dvd y"
 proof
   assume "x dvd - y"
   then have "x dvd - 1 * - y" by (rule dvd_mult)
   then show "x dvd y" by simp
 next
   assume "x dvd y"
   then have "x dvd - 1 * y" by (rule dvd_mult)
   then show "x dvd - y" by simp
 qed
 
 lemma minus_dvd_iff [simp]: "- x dvd y \<longleftrightarrow> x dvd y"
 proof
   assume "- x dvd y"
   then obtain k where "y = - x * k" ..
   then have "y = x * - k" by simp
   then show "x dvd y" ..
 next
   assume "x dvd y"
   then obtain k where "y = x * k" ..
   then have "y = - x * - k" by simp
   then show "- x dvd y" ..
 qed
 
 lemma dvd_diff [simp]: "x dvd y \<Longrightarrow> x dvd z \<Longrightarrow> x dvd (y - z)"
   using dvd_add [of x y "- z"] by simp
 
 end
 
 
 subsection \<open>Towards integral domains\<close>
 
 class semiring_no_zero_divisors = semiring_0 +
   assumes no_zero_divisors: "a \<noteq> 0 \<Longrightarrow> b \<noteq> 0 \<Longrightarrow> a * b \<noteq> 0"
 begin
 
 lemma divisors_zero:
   assumes "a * b = 0"
   shows "a = 0 \<or> b = 0"
 proof (rule classical)
   assume "\<not> ?thesis"
   then have "a \<noteq> 0" and "b \<noteq> 0" by auto
   with no_zero_divisors have "a * b \<noteq> 0" by blast
   with assms show ?thesis by simp
 qed
 
 lemma mult_eq_0_iff [simp]: "a * b = 0 \<longleftrightarrow> a = 0 \<or> b = 0"
 proof (cases "a = 0 \<or> b = 0")
   case False
   then have "a \<noteq> 0" and "b \<noteq> 0" by auto
     then show ?thesis using no_zero_divisors by simp
 next
   case True
   then show ?thesis by auto
 qed
 
 end
 
 class semiring_1_no_zero_divisors = semiring_1 + semiring_no_zero_divisors
 
 class semiring_no_zero_divisors_cancel = semiring_no_zero_divisors +
   assumes mult_cancel_right [simp]: "a * c = b * c \<longleftrightarrow> c = 0 \<or> a = b"
     and mult_cancel_left [simp]: "c * a = c * b \<longleftrightarrow> c = 0 \<or> a = b"
 begin
 
 lemma mult_left_cancel: "c \<noteq> 0 \<Longrightarrow> c * a = c * b \<longleftrightarrow> a = b"
   by simp
 
 lemma mult_right_cancel: "c \<noteq> 0 \<Longrightarrow> a * c = b * c \<longleftrightarrow> a = b"
   by simp
 
 end
 
 class ring_no_zero_divisors = ring + semiring_no_zero_divisors
 begin
 
 subclass semiring_no_zero_divisors_cancel
 proof
   fix a b c
   have "a * c = b * c \<longleftrightarrow> (a - b) * c = 0"
     by (simp add: algebra_simps)
   also have "\<dots> \<longleftrightarrow> c = 0 \<or> a = b"
     by auto
   finally show "a * c = b * c \<longleftrightarrow> c = 0 \<or> a = b" .
   have "c * a = c * b \<longleftrightarrow> c * (a - b) = 0"
     by (simp add: algebra_simps)
   also have "\<dots> \<longleftrightarrow> c = 0 \<or> a = b"
     by auto
   finally show "c * a = c * b \<longleftrightarrow> c = 0 \<or> a = b" .
 qed
 
 end
 
 class ring_1_no_zero_divisors = ring_1 + ring_no_zero_divisors
 begin
 
 subclass semiring_1_no_zero_divisors ..
 
 lemma square_eq_1_iff: "x * x = 1 \<longleftrightarrow> x = 1 \<or> x = - 1"
 proof -
   have "(x - 1) * (x + 1) = x * x - 1"
     by (simp add: algebra_simps)
   then have "x * x = 1 \<longleftrightarrow> (x - 1) * (x + 1) = 0"
     by simp
   then show ?thesis
     by (simp add: eq_neg_iff_add_eq_0)
 qed
 
 lemma mult_cancel_right1 [simp]: "c = b * c \<longleftrightarrow> c = 0 \<or> b = 1"
   using mult_cancel_right [of 1 c b] by auto
 
 lemma mult_cancel_right2 [simp]: "a * c = c \<longleftrightarrow> c = 0 \<or> a = 1"
   using mult_cancel_right [of a c 1] by simp
 
 lemma mult_cancel_left1 [simp]: "c = c * b \<longleftrightarrow> c = 0 \<or> b = 1"
   using mult_cancel_left [of c 1 b] by force
 
 lemma mult_cancel_left2 [simp]: "c * a = c \<longleftrightarrow> c = 0 \<or> a = 1"
   using mult_cancel_left [of c a 1] by simp
 
 end
 
 class semidom = comm_semiring_1_cancel + semiring_no_zero_divisors
 begin
 
 subclass semiring_1_no_zero_divisors ..
 
 end
 
 class idom = comm_ring_1 + semiring_no_zero_divisors
 begin
 
 subclass semidom ..
 
 subclass ring_1_no_zero_divisors ..
 
 lemma dvd_mult_cancel_right [simp]:
   "a * c dvd b * c \<longleftrightarrow> c = 0 \<or> a dvd b"
 proof -
   have "a * c dvd b * c \<longleftrightarrow> (\<exists>k. b * c = (a * k) * c)"
     by (auto simp add: ac_simps)
   also have "(\<exists>k. b * c = (a * k) * c) \<longleftrightarrow> c = 0 \<or> a dvd b"
     by auto
   finally show ?thesis .
 qed
 
 lemma dvd_mult_cancel_left [simp]:
   "c * a dvd c * b \<longleftrightarrow> c = 0 \<or> a dvd b"
   using dvd_mult_cancel_right [of a c b] by (simp add: ac_simps)
 
 lemma square_eq_iff: "a * a = b * b \<longleftrightarrow> a = b \<or> a = - b"
 proof
   assume "a * a = b * b"
   then have "(a - b) * (a + b) = 0"
     by (simp add: algebra_simps)
   then show "a = b \<or> a = - b"
     by (simp add: eq_neg_iff_add_eq_0)
 next
   assume "a = b \<or> a = - b"
   then show "a * a = b * b" by auto
 qed
 
 end
 
 class idom_abs_sgn = idom + abs + sgn +
   assumes sgn_mult_abs: "sgn a * \<bar>a\<bar> = a"
     and sgn_sgn [simp]: "sgn (sgn a) = sgn a"
     and abs_abs [simp]: "\<bar>\<bar>a\<bar>\<bar> = \<bar>a\<bar>"
     and abs_0 [simp]: "\<bar>0\<bar> = 0"
     and sgn_0 [simp]: "sgn 0 = 0"
     and sgn_1 [simp]: "sgn 1 = 1"
     and sgn_minus_1: "sgn (- 1) = - 1"
     and sgn_mult: "sgn (a * b) = sgn a * sgn b"
 begin
 
 lemma sgn_eq_0_iff:
   "sgn a = 0 \<longleftrightarrow> a = 0"
 proof -
   { assume "sgn a = 0"
     then have "sgn a * \<bar>a\<bar> = 0"
       by simp
     then have "a = 0"
       by (simp add: sgn_mult_abs)
   } then show ?thesis
     by auto
 qed
 
 lemma abs_eq_0_iff:
   "\<bar>a\<bar> = 0 \<longleftrightarrow> a = 0"
 proof -
   { assume "\<bar>a\<bar> = 0"
     then have "sgn a * \<bar>a\<bar> = 0"
       by simp
     then have "a = 0"
       by (simp add: sgn_mult_abs)
   } then show ?thesis
     by auto
 qed
 
 lemma abs_mult_sgn:
   "\<bar>a\<bar> * sgn a = a"
   using sgn_mult_abs [of a] by (simp add: ac_simps)
 
 lemma abs_1 [simp]:
   "\<bar>1\<bar> = 1"
   using sgn_mult_abs [of 1] by simp
 
 lemma sgn_abs [simp]:
   "\<bar>sgn a\<bar> = of_bool (a \<noteq> 0)"
   using sgn_mult_abs [of "sgn a"] mult_cancel_left [of "sgn a" "\<bar>sgn a\<bar>" 1]
   by (auto simp add: sgn_eq_0_iff)
 
 lemma abs_sgn [simp]:
   "sgn \<bar>a\<bar> = of_bool (a \<noteq> 0)"
   using sgn_mult_abs [of "\<bar>a\<bar>"] mult_cancel_right [of "sgn \<bar>a\<bar>" "\<bar>a\<bar>" 1]
   by (auto simp add: abs_eq_0_iff)
 
 lemma abs_mult:
   "\<bar>a * b\<bar> = \<bar>a\<bar> * \<bar>b\<bar>"
 proof (cases "a = 0 \<or> b = 0")
   case True
   then show ?thesis
     by auto
 next
   case False
   then have *: "sgn (a * b) \<noteq> 0"
     by (simp add: sgn_eq_0_iff)
   from abs_mult_sgn [of "a * b"] abs_mult_sgn [of a] abs_mult_sgn [of b]
   have "\<bar>a * b\<bar> * sgn (a * b) = \<bar>a\<bar> * sgn a * \<bar>b\<bar> * sgn b"
     by (simp add: ac_simps)
   then have "\<bar>a * b\<bar> * sgn (a * b) = \<bar>a\<bar> * \<bar>b\<bar> * sgn (a * b)"
     by (simp add: sgn_mult ac_simps)
   with * show ?thesis
     by simp
 qed
 
 lemma sgn_minus [simp]:
   "sgn (- a) = - sgn a"
 proof -
   from sgn_minus_1 have "sgn (- 1 * a) = - 1 * sgn a"
     by (simp only: sgn_mult)
   then show ?thesis
     by simp
 qed
 
 lemma abs_minus [simp]:
   "\<bar>- a\<bar> = \<bar>a\<bar>"
 proof -
   have [simp]: "\<bar>- 1\<bar> = 1"
     using sgn_mult_abs [of "- 1"] by simp
   then have "\<bar>- 1 * a\<bar> = 1 * \<bar>a\<bar>"
     by (simp only: abs_mult)
   then show ?thesis
     by simp
 qed
 
 end
 
 
 subsection \<open>(Partial) Division\<close>
 
 class divide =
   fixes divide :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"  (infixl "div" 70)
 
 setup \<open>Sign.add_const_constraint (\<^const_name>\<open>divide\<close>, SOME \<^typ>\<open>'a \<Rightarrow> 'a \<Rightarrow> 'a\<close>)\<close>
 
 context semiring
 begin
 
 lemma [field_simps, field_split_simps]:
   shows distrib_left_NO_MATCH: "NO_MATCH (x div y) a \<Longrightarrow> a * (b + c) = a * b + a * c"
     and distrib_right_NO_MATCH: "NO_MATCH (x div y) c \<Longrightarrow> (a + b) * c = a * c + b * c"
   by (rule distrib_left distrib_right)+
 
 end
 
 context ring
 begin
 
 lemma [field_simps, field_split_simps]:
   shows left_diff_distrib_NO_MATCH: "NO_MATCH (x div y) c \<Longrightarrow> (a - b) * c = a * c - b * c"
     and right_diff_distrib_NO_MATCH: "NO_MATCH (x div y) a \<Longrightarrow> a * (b - c) = a * b - a * c"
   by (rule left_diff_distrib right_diff_distrib)+
 
 end
 
 setup \<open>Sign.add_const_constraint (\<^const_name>\<open>divide\<close>, SOME \<^typ>\<open>'a::divide \<Rightarrow> 'a \<Rightarrow> 'a\<close>)\<close>
 
 text \<open>Algebraic classes with division\<close>
   
 class semidom_divide = semidom + divide +
   assumes nonzero_mult_div_cancel_right [simp]: "b \<noteq> 0 \<Longrightarrow> (a * b) div b = a"
   assumes div_by_0 [simp]: "a div 0 = 0"
 begin
 
 lemma nonzero_mult_div_cancel_left [simp]: "a \<noteq> 0 \<Longrightarrow> (a * b) div a = b"
   using nonzero_mult_div_cancel_right [of a b] by (simp add: ac_simps)
 
 subclass semiring_no_zero_divisors_cancel
 proof
   show *: "a * c = b * c \<longleftrightarrow> c = 0 \<or> a = b" for a b c
   proof (cases "c = 0")
     case True
     then show ?thesis by simp
   next
     case False
     have "a = b" if "a * c = b * c"
     proof -
       from that have "a * c div c = b * c div c"
         by simp
       with False show ?thesis
         by simp
     qed
     then show ?thesis by auto
   qed
   show "c * a = c * b \<longleftrightarrow> c = 0 \<or> a = b" for a b c
     using * [of a c b] by (simp add: ac_simps)
 qed
 
 lemma div_self [simp]: "a \<noteq> 0 \<Longrightarrow> a div a = 1"
   using nonzero_mult_div_cancel_left [of a 1] by simp
 
 lemma div_0 [simp]: "0 div a = 0"
 proof (cases "a = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then have "a * 0 div a = 0"
     by (rule nonzero_mult_div_cancel_left)
   then show ?thesis by simp
 qed
 
 lemma div_by_1 [simp]: "a div 1 = a"
   using nonzero_mult_div_cancel_left [of 1 a] by simp
 
 lemma dvd_div_eq_0_iff:
   assumes "b dvd a"
   shows "a div b = 0 \<longleftrightarrow> a = 0"
   using assms by (elim dvdE, cases "b = 0") simp_all  
 
 lemma dvd_div_eq_cancel:
   "a div c = b div c \<Longrightarrow> c dvd a \<Longrightarrow> c dvd b \<Longrightarrow> a = b"
   by (elim dvdE, cases "c = 0") simp_all
 
 lemma dvd_div_eq_iff:
   "c dvd a \<Longrightarrow> c dvd b \<Longrightarrow> a div c = b div c \<longleftrightarrow> a = b"
   by (elim dvdE, cases "c = 0") simp_all
 
 lemma inj_on_mult:
   "inj_on ((*) a) A" if "a \<noteq> 0"
 proof (rule inj_onI)
   fix b c
   assume "a * b = a * c"
   then have "a * b div a = a * c div a"
     by (simp only:)
   with that show "b = c"
     by simp
 qed
 
 end
 
 class idom_divide = idom + semidom_divide
 begin
 
 lemma dvd_neg_div:
   assumes "b dvd a"
   shows "- a div b = - (a div b)"
 proof (cases "b = 0")
   case True
   then show ?thesis by simp
 next
   case False
   from assms obtain c where "a = b * c" ..
   then have "- a div b = (b * - c) div b"
     by simp
   from False also have "\<dots> = - c"
     by (rule nonzero_mult_div_cancel_left)  
   with False \<open>a = b * c\<close> show ?thesis
     by simp
 qed
 
 lemma dvd_div_neg:
   assumes "b dvd a"
   shows "a div - b = - (a div b)"
 proof (cases "b = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then have "- b \<noteq> 0"
     by simp
   from assms obtain c where "a = b * c" ..
   then have "a div - b = (- b * - c) div - b"
     by simp
   from \<open>- b \<noteq> 0\<close> also have "\<dots> = - c"
     by (rule nonzero_mult_div_cancel_left)  
   with False \<open>a = b * c\<close> show ?thesis
     by simp
 qed
 
 end
 
 class algebraic_semidom = semidom_divide
 begin
 
 text \<open>
   Class \<^class>\<open>algebraic_semidom\<close> enriches a integral domain
   by notions from algebra, like units in a ring.
   It is a separate class to avoid spoiling fields with notions
   which are degenerated there.
 \<close>
 
 lemma dvd_times_left_cancel_iff [simp]:
   assumes "a \<noteq> 0"
   shows "a * b dvd a * c \<longleftrightarrow> b dvd c"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   then obtain d where "a * c = a * b * d" ..
   with assms have "c = b * d" by (simp add: ac_simps)
   then show ?rhs ..
 next
   assume ?rhs
   then obtain d where "c = b * d" ..
   then have "a * c = a * b * d" by (simp add: ac_simps)
   then show ?lhs ..
 qed
 
 lemma dvd_times_right_cancel_iff [simp]:
   assumes "a \<noteq> 0"
   shows "b * a dvd c * a \<longleftrightarrow> b dvd c"
   using dvd_times_left_cancel_iff [of a b c] assms by (simp add: ac_simps)
 
 lemma div_dvd_iff_mult:
   assumes "b \<noteq> 0" and "b dvd a"
   shows "a div b dvd c \<longleftrightarrow> a dvd c * b"
 proof -
   from \<open>b dvd a\<close> obtain d where "a = b * d" ..
   with \<open>b \<noteq> 0\<close> show ?thesis by (simp add: ac_simps)
 qed
 
 lemma dvd_div_iff_mult:
   assumes "c \<noteq> 0" and "c dvd b"
   shows "a dvd b div c \<longleftrightarrow> a * c dvd b"
 proof -
   from \<open>c dvd b\<close> obtain d where "b = c * d" ..
   with \<open>c \<noteq> 0\<close> show ?thesis by (simp add: mult.commute [of a])
 qed
 
 lemma div_dvd_div [simp]:
   assumes "a dvd b" and "a dvd c"
   shows "b div a dvd c div a \<longleftrightarrow> b dvd c"
 proof (cases "a = 0")
   case True
   with assms show ?thesis by simp
 next
   case False
   moreover from assms obtain k l where "b = a * k" and "c = a * l"
     by blast
   ultimately show ?thesis by simp
 qed
 
 lemma div_add [simp]:
   assumes "c dvd a" and "c dvd b"
   shows "(a + b) div c = a div c + b div c"
 proof (cases "c = 0")
   case True
   then show ?thesis by simp
 next
   case False
   moreover from assms obtain k l where "a = c * k" and "b = c * l"
     by blast
   moreover have "c * k + c * l = c * (k + l)"
     by (simp add: algebra_simps)
   ultimately show ?thesis
     by simp
 qed
 
 lemma div_mult_div_if_dvd:
   assumes "b dvd a" and "d dvd c"
   shows "(a div b) * (c div d) = (a * c) div (b * d)"
 proof (cases "b = 0 \<or> c = 0")
   case True
   with assms show ?thesis by auto
 next
   case False
   moreover from assms obtain k l where "a = b * k" and "c = d * l"
     by blast
   moreover have "b * k * (d * l) div (b * d) = (b * d) * (k * l) div (b * d)"
     by (simp add: ac_simps)
   ultimately show ?thesis by simp
 qed
 
 lemma dvd_div_eq_mult:
   assumes "a \<noteq> 0" and "a dvd b"
   shows "b div a = c \<longleftrightarrow> b = c * a"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?rhs
   then show ?lhs by (simp add: assms)
 next
   assume ?lhs
   then have "b div a * a = c * a" by simp
   moreover from assms have "b div a * a = b"
     by (auto simp add: ac_simps)
   ultimately show ?rhs by simp
 qed
 
 lemma dvd_div_mult_self [simp]: "a dvd b \<Longrightarrow> b div a * a = b"
   by (cases "a = 0") (auto simp add: ac_simps)
 
 lemma dvd_mult_div_cancel [simp]: "a dvd b \<Longrightarrow> a * (b div a) = b"
   using dvd_div_mult_self [of a b] by (simp add: ac_simps)
 
 lemma div_mult_swap:
   assumes "c dvd b"
   shows "a * (b div c) = (a * b) div c"
 proof (cases "c = 0")
   case True
   then show ?thesis by simp
 next
   case False
   from assms obtain d where "b = c * d" ..
   moreover from False have "a * divide (d * c) c = ((a * d) * c) div c"
     by simp
   ultimately show ?thesis by (simp add: ac_simps)
 qed
 
 lemma dvd_div_mult: "c dvd b \<Longrightarrow> b div c * a = (b * a) div c"
   using div_mult_swap [of c b a] by (simp add: ac_simps)
 
 lemma dvd_div_mult2_eq:
   assumes "b * c dvd a"
   shows "a div (b * c) = a div b div c"
 proof -
   from assms obtain k where "a = b * c * k" ..
   then show ?thesis
     by (cases "b = 0 \<or> c = 0") (auto, simp add: ac_simps)
 qed
 
 lemma dvd_div_div_eq_mult:
   assumes "a \<noteq> 0" "c \<noteq> 0" and "a dvd b" "c dvd d"
   shows "b div a = d div c \<longleftrightarrow> b * c = a * d"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof -
   from assms have "a * c \<noteq> 0" by simp
   then have "?lhs \<longleftrightarrow> b div a * (a * c) = d div c * (a * c)"
     by simp
   also have "\<dots> \<longleftrightarrow> (a * (b div a)) * c = (c * (d div c)) * a"
     by (simp add: ac_simps)
   also have "\<dots> \<longleftrightarrow> (a * b div a) * c = (c * d div c) * a"
     using assms by (simp add: div_mult_swap)
   also have "\<dots> \<longleftrightarrow> ?rhs"
     using assms by (simp add: ac_simps)
   finally show ?thesis .
 qed
 
 lemma dvd_mult_imp_div:
   assumes "a * c dvd b"
   shows "a dvd b div c"
 proof (cases "c = 0")
   case True then show ?thesis by simp
 next
   case False
   from \<open>a * c dvd b\<close> obtain d where "b = a * c * d" ..
   with False show ?thesis
     by (simp add: mult.commute [of a] mult.assoc)
 qed
 
 lemma div_div_eq_right:
   assumes "c dvd b" "b dvd a"
   shows   "a div (b div c) = a div b * c"
 proof (cases "c = 0 \<or> b = 0")
   case True
   then show ?thesis
     by auto
 next
   case False
   from assms obtain r s where "b = c * r" and "a = c * r * s"
     by blast
   moreover with False have "r \<noteq> 0"
     by auto
   ultimately show ?thesis using False
     by simp (simp add: mult.commute [of _ r] mult.assoc mult.commute [of c])
 qed
 
 lemma div_div_div_same:
   assumes "d dvd b" "b dvd a"
   shows   "(a div d) div (b div d) = a div b"
 proof (cases "b = 0 \<or> d = 0")
   case True
   with assms show ?thesis
     by auto
 next
   case False
   from assms obtain r s
     where "a = d * r * s" and "b = d * r"
     by blast
   with False show ?thesis
     by simp (simp add: ac_simps)
 qed
 
 
 text \<open>Units: invertible elements in a ring\<close>
 
 abbreviation is_unit :: "'a \<Rightarrow> bool"
   where "is_unit a \<equiv> a dvd 1"
 
 lemma not_is_unit_0 [simp]: "\<not> is_unit 0"
   by simp
 
 lemma unit_imp_dvd [dest]: "is_unit b \<Longrightarrow> b dvd a"
   by (rule dvd_trans [of _ 1]) simp_all
 
 lemma unit_dvdE:
   assumes "is_unit a"
   obtains c where "a \<noteq> 0" and "b = a * c"
 proof -
   from assms have "a dvd b" by auto
   then obtain c where "b = a * c" ..
   moreover from assms have "a \<noteq> 0" by auto
   ultimately show thesis using that by blast
 qed
 
 lemma dvd_unit_imp_unit: "a dvd b \<Longrightarrow> is_unit b \<Longrightarrow> is_unit a"
   by (rule dvd_trans)
 
 lemma unit_div_1_unit [simp, intro]:
   assumes "is_unit a"
   shows "is_unit (1 div a)"
 proof -
   from assms have "1 = 1 div a * a" by simp
   then show "is_unit (1 div a)" by (rule dvdI)
 qed
 
 lemma is_unitE [elim?]:
   assumes "is_unit a"
   obtains b where "a \<noteq> 0" and "b \<noteq> 0"
     and "is_unit b" and "1 div a = b" and "1 div b = a"
     and "a * b = 1" and "c div a = c * b"
 proof (rule that)
   define b where "b = 1 div a"
   then show "1 div a = b" by simp
   from assms b_def show "is_unit b" by simp
   with assms show "a \<noteq> 0" and "b \<noteq> 0" by auto
   from assms b_def show "a * b = 1" by simp
   then have "1 = a * b" ..
   with b_def \<open>b \<noteq> 0\<close> show "1 div b = a" by simp
   from assms have "a dvd c" ..
   then obtain d where "c = a * d" ..
   with \<open>a \<noteq> 0\<close> \<open>a * b = 1\<close> show "c div a = c * b"
     by (simp add: mult.assoc mult.left_commute [of a])
 qed
 
 lemma unit_prod [intro]: "is_unit a \<Longrightarrow> is_unit b \<Longrightarrow> is_unit (a * b)"
   by (subst mult_1_left [of 1, symmetric]) (rule mult_dvd_mono)
 
 lemma is_unit_mult_iff: "is_unit (a * b) \<longleftrightarrow> is_unit a \<and> is_unit b"
   by (auto dest: dvd_mult_left dvd_mult_right)
 
 lemma unit_div [intro]: "is_unit a \<Longrightarrow> is_unit b \<Longrightarrow> is_unit (a div b)"
   by (erule is_unitE [of b a]) (simp add: ac_simps unit_prod)
 
 lemma mult_unit_dvd_iff:
   assumes "is_unit b"
   shows "a * b dvd c \<longleftrightarrow> a dvd c"
 proof
   assume "a * b dvd c"
   with assms show "a dvd c"
     by (simp add: dvd_mult_left)
 next
   assume "a dvd c"
   then obtain k where "c = a * k" ..
   with assms have "c = (a * b) * (1 div b * k)"
     by (simp add: mult_ac)
   then show "a * b dvd c" by (rule dvdI)
 qed
 
 lemma mult_unit_dvd_iff': "is_unit a \<Longrightarrow> (a * b) dvd c \<longleftrightarrow> b dvd c"
   using mult_unit_dvd_iff [of a b c] by (simp add: ac_simps)
 
 lemma dvd_mult_unit_iff:
   assumes "is_unit b"
   shows "a dvd c * b \<longleftrightarrow> a dvd c"
 proof
   assume "a dvd c * b"
   with assms have "c * b dvd c * (b * (1 div b))"
     by (subst mult_assoc [symmetric]) simp
   also from assms have "b * (1 div b) = 1"
     by (rule is_unitE) simp
   finally have "c * b dvd c" by simp
   with \<open>a dvd c * b\<close> show "a dvd c" by (rule dvd_trans)
 next
   assume "a dvd c"
   then show "a dvd c * b" by simp
 qed
 
 lemma dvd_mult_unit_iff': "is_unit b \<Longrightarrow> a dvd b * c \<longleftrightarrow> a dvd c"
   using dvd_mult_unit_iff [of b a c] by (simp add: ac_simps)
 
 lemma div_unit_dvd_iff: "is_unit b \<Longrightarrow> a div b dvd c \<longleftrightarrow> a dvd c"
   by (erule is_unitE [of _ a]) (auto simp add: mult_unit_dvd_iff)
 
 lemma dvd_div_unit_iff: "is_unit b \<Longrightarrow> a dvd c div b \<longleftrightarrow> a dvd c"
   by (erule is_unitE [of _ c]) (simp add: dvd_mult_unit_iff)
 
 lemmas unit_dvd_iff = mult_unit_dvd_iff mult_unit_dvd_iff'
   dvd_mult_unit_iff dvd_mult_unit_iff' 
   div_unit_dvd_iff dvd_div_unit_iff (* FIXME consider named_theorems *)
 
 lemma unit_mult_div_div [simp]: "is_unit a \<Longrightarrow> b * (1 div a) = b div a"
   by (erule is_unitE [of _ b]) simp
 
 lemma unit_div_mult_self [simp]: "is_unit a \<Longrightarrow> b div a * a = b"
   by (rule dvd_div_mult_self) auto
 
 lemma unit_div_1_div_1 [simp]: "is_unit a \<Longrightarrow> 1 div (1 div a) = a"
   by (erule is_unitE) simp
 
 lemma unit_div_mult_swap: "is_unit c \<Longrightarrow> a * (b div c) = (a * b) div c"
   by (erule unit_dvdE [of _ b]) (simp add: mult.left_commute [of _ c])
 
 lemma unit_div_commute: "is_unit b \<Longrightarrow> (a div b) * c = (a * c) div b"
   using unit_div_mult_swap [of b c a] by (simp add: ac_simps)
 
 lemma unit_eq_div1: "is_unit b \<Longrightarrow> a div b = c \<longleftrightarrow> a = c * b"
   by (auto elim: is_unitE)
 
 lemma unit_eq_div2: "is_unit b \<Longrightarrow> a = c div b \<longleftrightarrow> a * b = c"
   using unit_eq_div1 [of b c a] by auto
 
 lemma unit_mult_left_cancel: "is_unit a \<Longrightarrow> a * b = a * c \<longleftrightarrow> b = c"
   using mult_cancel_left [of a b c] by auto
 
 lemma unit_mult_right_cancel: "is_unit a \<Longrightarrow> b * a = c * a \<longleftrightarrow> b = c"
   using unit_mult_left_cancel [of a b c] by (auto simp add: ac_simps)
 
 lemma unit_div_cancel:
   assumes "is_unit a"
   shows "b div a = c div a \<longleftrightarrow> b = c"
 proof -
   from assms have "is_unit (1 div a)" by simp
   then have "b * (1 div a) = c * (1 div a) \<longleftrightarrow> b = c"
     by (rule unit_mult_right_cancel)
   with assms show ?thesis by simp
 qed
 
 lemma is_unit_div_mult2_eq:
   assumes "is_unit b" and "is_unit c"
   shows "a div (b * c) = a div b div c"
 proof -
   from assms have "is_unit (b * c)"
     by (simp add: unit_prod)
   then have "b * c dvd a"
     by (rule unit_imp_dvd)
   then show ?thesis
     by (rule dvd_div_mult2_eq)
 qed
 
 lemma is_unit_div_mult_cancel_left:
   assumes "a \<noteq> 0" and "is_unit b"
   shows "a div (a * b) = 1 div b"
 proof -
   from assms have "a div (a * b) = a div a div b"
     by (simp add: mult_unit_dvd_iff dvd_div_mult2_eq)
   with assms show ?thesis by simp
 qed
 
 lemma is_unit_div_mult_cancel_right:
   assumes "a \<noteq> 0" and "is_unit b"
   shows "a div (b * a) = 1 div b"
   using assms is_unit_div_mult_cancel_left [of a b] by (simp add: ac_simps)
 
 lemma unit_div_eq_0_iff:
   assumes "is_unit b"
   shows "a div b = 0 \<longleftrightarrow> a = 0"
   by (rule dvd_div_eq_0_iff) (insert assms, auto)  
 
 lemma div_mult_unit2:
   "is_unit c \<Longrightarrow> b dvd a \<Longrightarrow> a div (b * c) = a div b div c"
   by (rule dvd_div_mult2_eq) (simp_all add: mult_unit_dvd_iff)
 
 
 text \<open>Coprimality\<close>
 
 definition coprime :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
   where "coprime a b \<longleftrightarrow> (\<forall>c. c dvd a \<longrightarrow> c dvd b \<longrightarrow> is_unit c)"
 
 lemma coprimeI:
   assumes "\<And>c. c dvd a \<Longrightarrow> c dvd b \<Longrightarrow> is_unit c"
   shows "coprime a b"
   using assms by (auto simp: coprime_def)
 
 lemma not_coprimeI:
   assumes "c dvd a" and "c dvd b" and "\<not> is_unit c"
   shows "\<not> coprime a b"
   using assms by (auto simp: coprime_def)
 
 lemma coprime_common_divisor:
   "is_unit c" if "coprime a b" and "c dvd a" and "c dvd b"
   using that by (auto simp: coprime_def)
 
 lemma not_coprimeE:
   assumes "\<not> coprime a b"
   obtains c where "c dvd a" and "c dvd b" and "\<not> is_unit c"
   using assms by (auto simp: coprime_def)
 
 lemma coprime_imp_coprime:
   "coprime a b" if "coprime c d"
     and "\<And>e. \<not> is_unit e \<Longrightarrow> e dvd a \<Longrightarrow> e dvd b \<Longrightarrow> e dvd c"
     and "\<And>e. \<not> is_unit e \<Longrightarrow> e dvd a \<Longrightarrow> e dvd b \<Longrightarrow> e dvd d"
 proof (rule coprimeI)
   fix e
   assume "e dvd a" and "e dvd b"
   with that have "e dvd c" and "e dvd d"
     by (auto intro: dvd_trans)
   with \<open>coprime c d\<close> show "is_unit e"
     by (rule coprime_common_divisor)
 qed
 
 lemma coprime_divisors:
   "coprime a b" if "a dvd c" "b dvd d" and "coprime c d"
 using \<open>coprime c d\<close> proof (rule coprime_imp_coprime)
   fix e
   assume "e dvd a" then show "e dvd c"
     using \<open>a dvd c\<close> by (rule dvd_trans)
   assume "e dvd b" then show "e dvd d"
     using \<open>b dvd d\<close> by (rule dvd_trans)
 qed
 
 lemma coprime_self [simp]:
   "coprime a a \<longleftrightarrow> is_unit a" (is "?P \<longleftrightarrow> ?Q")
 proof
   assume ?P
   then show ?Q
     by (rule coprime_common_divisor) simp_all
 next
   assume ?Q
   show ?P
     by (rule coprimeI) (erule dvd_unit_imp_unit, rule \<open>?Q\<close>)
 qed
 
 lemma coprime_commute [ac_simps]:
   "coprime b a \<longleftrightarrow> coprime a b"
   unfolding coprime_def by auto
 
 lemma is_unit_left_imp_coprime:
   "coprime a b" if "is_unit a"
 proof (rule coprimeI)
   fix c
   assume "c dvd a"
   with that show "is_unit c"
     by (auto intro: dvd_unit_imp_unit)
 qed
 
 lemma is_unit_right_imp_coprime:
   "coprime a b" if "is_unit b"
   using that is_unit_left_imp_coprime [of b a] by (simp add: ac_simps)
 
 lemma coprime_1_left [simp]:
   "coprime 1 a"
   by (rule coprimeI)
 
 lemma coprime_1_right [simp]:
   "coprime a 1"
   by (rule coprimeI)
 
 lemma coprime_0_left_iff [simp]:
   "coprime 0 a \<longleftrightarrow> is_unit a"
   by (auto intro: coprimeI dvd_unit_imp_unit coprime_common_divisor [of 0 a a])
 
 lemma coprime_0_right_iff [simp]:
   "coprime a 0 \<longleftrightarrow> is_unit a"
   using coprime_0_left_iff [of a] by (simp add: ac_simps)
 
 lemma coprime_mult_self_left_iff [simp]:
   "coprime (c * a) (c * b) \<longleftrightarrow> is_unit c \<and> coprime a b"
   by (auto intro: coprime_common_divisor)
     (rule coprimeI, auto intro: coprime_common_divisor simp add: dvd_mult_unit_iff')+
 
 lemma coprime_mult_self_right_iff [simp]:
   "coprime (a * c) (b * c) \<longleftrightarrow> is_unit c \<and> coprime a b"
   using coprime_mult_self_left_iff [of c a b] by (simp add: ac_simps)
 
 lemma coprime_absorb_left:
   assumes "x dvd y"
   shows   "coprime x y \<longleftrightarrow> is_unit x"
   using assms coprime_common_divisor is_unit_left_imp_coprime by auto
 
 lemma coprime_absorb_right:
   assumes "y dvd x"
   shows   "coprime x y \<longleftrightarrow> is_unit y"
   using assms coprime_common_divisor is_unit_right_imp_coprime by auto
 
 end
 
 class unit_factor =
   fixes unit_factor :: "'a \<Rightarrow> 'a"
 
 class semidom_divide_unit_factor = semidom_divide + unit_factor +
   assumes unit_factor_0 [simp]: "unit_factor 0 = 0"
     and is_unit_unit_factor: "a dvd 1 \<Longrightarrow> unit_factor a = a"
     and unit_factor_is_unit: "a \<noteq> 0 \<Longrightarrow> unit_factor a dvd 1"
     and unit_factor_mult_unit_left: "a dvd 1 \<Longrightarrow> unit_factor (a * b) = a * unit_factor b"
   \<comment> \<open>This fine-grained hierarchy will later on allow lean normalization of polynomials\<close>
 begin
 
 lemma unit_factor_mult_unit_right: "a dvd 1 \<Longrightarrow> unit_factor (b * a) = unit_factor b * a"
   using unit_factor_mult_unit_left[of a b] by (simp add: mult_ac)
 
 lemmas [simp] = unit_factor_mult_unit_left unit_factor_mult_unit_right
 
 end
 
 class normalization_semidom = algebraic_semidom + semidom_divide_unit_factor +
   fixes normalize :: "'a \<Rightarrow> 'a"
   assumes unit_factor_mult_normalize [simp]: "unit_factor a * normalize a = a"
     and normalize_0 [simp]: "normalize 0 = 0"
 begin
 
 text \<open>
   Class \<^class>\<open>normalization_semidom\<close> cultivates the idea that each integral
   domain can be split into equivalence classes whose representants are
   associated, i.e. divide each other. \<^const>\<open>normalize\<close> specifies a canonical
   representant for each equivalence class. The rationale behind this is that
   it is easier to reason about equality than equivalences, hence we prefer to
   think about equality of normalized values rather than associated elements.
 \<close>
 
 declare unit_factor_is_unit [iff]
   
 lemma unit_factor_dvd [simp]: "a \<noteq> 0 \<Longrightarrow> unit_factor a dvd b"
   by (rule unit_imp_dvd) simp
 
 lemma unit_factor_self [simp]: "unit_factor a dvd a"
   by (cases "a = 0") simp_all
 
 lemma normalize_mult_unit_factor [simp]: "normalize a * unit_factor a = a"
   using unit_factor_mult_normalize [of a] by (simp add: ac_simps)
 
 lemma normalize_eq_0_iff [simp]: "normalize a = 0 \<longleftrightarrow> a = 0"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   moreover have "unit_factor a * normalize a = a" by simp
   ultimately show ?rhs by simp
 next
   assume ?rhs
   then show ?lhs by simp
 qed
 
 lemma unit_factor_eq_0_iff [simp]: "unit_factor a = 0 \<longleftrightarrow> a = 0"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   moreover have "unit_factor a * normalize a = a" by simp
   ultimately show ?rhs by simp
 next
   assume ?rhs
   then show ?lhs by simp
 qed
 
 lemma div_unit_factor [simp]: "a div unit_factor a = normalize a"
 proof (cases "a = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then have "unit_factor a \<noteq> 0"
     by simp
   with nonzero_mult_div_cancel_left
   have "unit_factor a * normalize a div unit_factor a = normalize a"
     by blast
   then show ?thesis by simp
 qed
 
 lemma normalize_div [simp]: "normalize a div a = 1 div unit_factor a"
 proof (cases "a = 0")
   case True
   then show ?thesis by simp
 next
   case False
   have "normalize a div a = normalize a div (unit_factor a * normalize a)"
     by simp
   also have "\<dots> = 1 div unit_factor a"
     using False by (subst is_unit_div_mult_cancel_right) simp_all
   finally show ?thesis .
 qed
 
 lemma is_unit_normalize:
   assumes "is_unit a"
   shows "normalize a = 1"
 proof -
   from assms have "unit_factor a = a"
     by (rule is_unit_unit_factor)
   moreover from assms have "a \<noteq> 0"
     by auto
   moreover have "normalize a = a div unit_factor a"
     by simp
   ultimately show ?thesis
     by simp
 qed
 
 lemma unit_factor_1 [simp]: "unit_factor 1 = 1"
   by (rule is_unit_unit_factor) simp
 
 lemma normalize_1 [simp]: "normalize 1 = 1"
   by (rule is_unit_normalize) simp
 
 lemma normalize_1_iff: "normalize a = 1 \<longleftrightarrow> is_unit a"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?rhs
   then show ?lhs by (rule is_unit_normalize)
 next
   assume ?lhs
   then have "unit_factor a * normalize a = unit_factor a * 1"
     by simp
   then have "unit_factor a = a"
     by simp
   moreover
   from \<open>?lhs\<close> have "a \<noteq> 0" by auto
   then have "is_unit (unit_factor a)" by simp
   ultimately show ?rhs by simp
 qed
 
 lemma div_normalize [simp]: "a div normalize a = unit_factor a"
 proof (cases "a = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then have "normalize a \<noteq> 0" by simp
   with nonzero_mult_div_cancel_right
   have "unit_factor a * normalize a div normalize a = unit_factor a" by blast
   then show ?thesis by simp
 qed
 
 lemma mult_one_div_unit_factor [simp]: "a * (1 div unit_factor b) = a div unit_factor b"
   by (cases "b = 0") simp_all
 
 lemma inv_unit_factor_eq_0_iff [simp]:
   "1 div unit_factor a = 0 \<longleftrightarrow> a = 0"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   then have "a * (1 div unit_factor a) = a * 0"
     by simp
   then show ?rhs
     by simp
 next
   assume ?rhs
   then show ?lhs by simp
 qed
 
 lemma unit_factor_idem [simp]: "unit_factor (unit_factor a) = unit_factor a"
   by (cases "a = 0") (auto intro: is_unit_unit_factor)
 
 lemma normalize_unit_factor [simp]: "a \<noteq> 0 \<Longrightarrow> normalize (unit_factor a) = 1"
   by (rule is_unit_normalize) simp
 
 lemma normalize_mult_unit_left [simp]:
   assumes "a dvd 1"
   shows   "normalize (a * b) = normalize b"
 proof (cases "b = 0")
   case False
   have "a * unit_factor b * normalize (a * b) = unit_factor (a * b) * normalize (a * b)"
     using assms by (subst unit_factor_mult_unit_left) auto
   also have "\<dots> = a * b" by simp
   also have "b = unit_factor b * normalize b" by simp
   hence "a * b = a * unit_factor b * normalize b"
     by (simp only: mult_ac)
   finally show ?thesis
     using assms False by auto
 qed auto
 
 lemma normalize_mult_unit_right [simp]:
   assumes "b dvd 1"
   shows   "normalize (a * b) = normalize a"
   using assms by (subst mult.commute) auto
 
 lemma normalize_idem [simp]: "normalize (normalize a) = normalize a"
 proof (cases "a = 0")
   case False
   have "normalize a = normalize (unit_factor a * normalize a)"
     by simp
   also from False have "\<dots> = normalize (normalize a)"
     by (subst normalize_mult_unit_left) auto
   finally show ?thesis ..
 qed auto
 
 lemma unit_factor_normalize [simp]:
   assumes "a \<noteq> 0"
   shows "unit_factor (normalize a) = 1"
 proof -
   from assms have *: "normalize a \<noteq> 0"
     by simp
   have "unit_factor (normalize a) * normalize (normalize a) = normalize a"
     by (simp only: unit_factor_mult_normalize)
   then have "unit_factor (normalize a) * normalize a = normalize a"
     by simp
   with * have "unit_factor (normalize a) * normalize a div normalize a = normalize a div normalize a"
     by simp
   with * show ?thesis
     by simp
 qed
 
 lemma normalize_dvd_iff [simp]: "normalize a dvd b \<longleftrightarrow> a dvd b"
 proof -
   have "normalize a dvd b \<longleftrightarrow> unit_factor a * normalize a dvd b"
     using mult_unit_dvd_iff [of "unit_factor a" "normalize a" b]
       by (cases "a = 0") simp_all
   then show ?thesis by simp
 qed
 
 lemma dvd_normalize_iff [simp]: "a dvd normalize b \<longleftrightarrow> a dvd b"
 proof -
   have "a dvd normalize  b \<longleftrightarrow> a dvd normalize b * unit_factor b"
     using dvd_mult_unit_iff [of "unit_factor b" a "normalize b"]
       by (cases "b = 0") simp_all
   then show ?thesis by simp
 qed
 
 lemma normalize_idem_imp_unit_factor_eq:
   assumes "normalize a = a"
   shows "unit_factor a = of_bool (a \<noteq> 0)"
 proof (cases "a = 0")
   case True
   then show ?thesis
     by simp
 next
   case False
   then show ?thesis
     using assms unit_factor_normalize [of a] by simp
 qed
 
 lemma normalize_idem_imp_is_unit_iff:
   assumes "normalize a = a"
   shows "is_unit a \<longleftrightarrow> a = 1"
   using assms by (cases "a = 0") (auto dest: is_unit_normalize)
 
 lemma coprime_normalize_left_iff [simp]:
   "coprime (normalize a) b \<longleftrightarrow> coprime a b"
   by (rule; rule coprimeI) (auto intro: coprime_common_divisor)
 
 lemma coprime_normalize_right_iff [simp]:
   "coprime a (normalize b) \<longleftrightarrow> coprime a b"
   using coprime_normalize_left_iff [of b a] by (simp add: ac_simps)
 
 text \<open>
   We avoid an explicit definition of associated elements but prefer explicit
   normalisation instead. In theory we could define an abbreviation like \<^prop>\<open>associated a b \<longleftrightarrow> normalize a = normalize b\<close> but this is counterproductive
   without suggestive infix syntax, which we do not want to sacrifice for this
   purpose here.
 \<close>
 
 lemma associatedI:
   assumes "a dvd b" and "b dvd a"
   shows "normalize a = normalize b"
 proof (cases "a = 0 \<or> b = 0")
   case True
   with assms show ?thesis by auto
 next
   case False
   from \<open>a dvd b\<close> obtain c where b: "b = a * c" ..
   moreover from \<open>b dvd a\<close> obtain d where a: "a = b * d" ..
   ultimately have "b * 1 = b * (c * d)"
     by (simp add: ac_simps)
   with False have "1 = c * d"
     unfolding mult_cancel_left by simp
   then have "is_unit c" and "is_unit d"
     by auto
   with a b show ?thesis
     by (simp add: is_unit_normalize)
 qed
 
 lemma associatedD1: "normalize a = normalize b \<Longrightarrow> a dvd b"
   using dvd_normalize_iff [of _ b, symmetric] normalize_dvd_iff [of a _, symmetric]
   by simp
 
 lemma associatedD2: "normalize a = normalize b \<Longrightarrow> b dvd a"
   using dvd_normalize_iff [of _ a, symmetric] normalize_dvd_iff [of b _, symmetric]
   by simp
 
 lemma associated_unit: "normalize a = normalize b \<Longrightarrow> is_unit a \<Longrightarrow> is_unit b"
   using dvd_unit_imp_unit by (auto dest!: associatedD1 associatedD2)
 
 lemma associated_iff_dvd: "normalize a = normalize b \<longleftrightarrow> a dvd b \<and> b dvd a"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?rhs
   then show ?lhs by (auto intro!: associatedI)
 next
   assume ?lhs
   then have "unit_factor a * normalize a = unit_factor a * normalize b"
     by simp
   then have *: "normalize b * unit_factor a = a"
     by (simp add: ac_simps)
   show ?rhs
   proof (cases "a = 0 \<or> b = 0")
     case True
     with \<open>?lhs\<close> show ?thesis by auto
   next
     case False
     then have "b dvd normalize b * unit_factor a" and "normalize b * unit_factor a dvd b"
       by (simp_all add: mult_unit_dvd_iff dvd_mult_unit_iff)
     with * show ?thesis by simp
   qed
 qed
 
 lemma associated_eqI:
   assumes "a dvd b" and "b dvd a"
   assumes "normalize a = a" and "normalize b = b"
   shows "a = b"
 proof -
   from assms have "normalize a = normalize b"
     unfolding associated_iff_dvd by simp
   with \<open>normalize a = a\<close> have "a = normalize b"
     by simp
   with \<open>normalize b = b\<close> show "a = b"
     by simp
 qed
 
 lemma normalize_unit_factor_eqI:
   assumes "normalize a = normalize b"
     and "unit_factor a = unit_factor b"
   shows "a = b"
 proof -
   from assms have "unit_factor a * normalize a = unit_factor b * normalize b"
     by simp
   then show ?thesis
     by simp
 qed
 
 lemma normalize_mult_normalize_left [simp]: "normalize (normalize a * b) = normalize (a * b)"
   by (rule associated_eqI) (auto intro!: mult_dvd_mono)
 
 lemma normalize_mult_normalize_right [simp]: "normalize (a * normalize b) = normalize (a * b)"
   by (rule associated_eqI) (auto intro!: mult_dvd_mono)
 
 end
 
 
 class normalization_semidom_multiplicative = normalization_semidom +
   assumes unit_factor_mult: "unit_factor (a * b) = unit_factor a * unit_factor b"
 begin
 
 lemma normalize_mult: "normalize (a * b) = normalize a * normalize b"
 proof (cases "a = 0 \<or> b = 0")
   case True
   then show ?thesis by auto
 next
   case False
   have "unit_factor (a * b) * normalize (a * b) = a * b"
     by (rule unit_factor_mult_normalize)
   then have "normalize (a * b) = a * b div unit_factor (a * b)"
     by simp
   also have "\<dots> = a * b div unit_factor (b * a)"
     by (simp add: ac_simps)
   also have "\<dots> = a * b div unit_factor b div unit_factor a"
     using False by (simp add: unit_factor_mult is_unit_div_mult2_eq [symmetric])
   also have "\<dots> = a * (b div unit_factor b) div unit_factor a"
     using False by (subst unit_div_mult_swap) simp_all
   also have "\<dots> = normalize a * normalize b"
     using False
     by (simp add: mult.commute [of a] mult.commute [of "normalize a"] unit_div_mult_swap [symmetric])
   finally show ?thesis .
 qed
 
 lemma dvd_unit_factor_div:
   assumes "b dvd a"
   shows "unit_factor (a div b) = unit_factor a div unit_factor b"
 proof -
   from assms have "a = a div b * b"
     by simp
   then have "unit_factor a = unit_factor (a div b * b)"
     by simp
   then show ?thesis
     by (cases "b = 0") (simp_all add: unit_factor_mult)
 qed
 
 lemma dvd_normalize_div:
   assumes "b dvd a"
   shows "normalize (a div b) = normalize a div normalize b"
 proof -
   from assms have "a = a div b * b"
     by simp
   then have "normalize a = normalize (a div b * b)"
     by simp
   then show ?thesis
     by (cases "b = 0") (simp_all add: normalize_mult)
 qed
 
 end
 
 
 
 
 text \<open>Syntactic division remainder operator\<close>
 
 class modulo = dvd + divide +
   fixes modulo :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"  (infixl "mod" 70)
 
 text \<open>Arbitrary quotient and remainder partitions\<close>
 
 class semiring_modulo = comm_semiring_1_cancel + divide + modulo +
   assumes div_mult_mod_eq: "a div b * b + a mod b = a"
 begin
 
 lemma mod_div_decomp:
   fixes a b
   obtains q r where "q = a div b" and "r = a mod b"
     and "a = q * b + r"
 proof -
   from div_mult_mod_eq have "a = a div b * b + a mod b" by simp
   moreover have "a div b = a div b" ..
   moreover have "a mod b = a mod b" ..
   note that ultimately show thesis by blast
 qed
 
 lemma mult_div_mod_eq: "b * (a div b) + a mod b = a"
   using div_mult_mod_eq [of a b] by (simp add: ac_simps)
 
 lemma mod_div_mult_eq: "a mod b + a div b * b = a"
   using div_mult_mod_eq [of a b] by (simp add: ac_simps)
 
 lemma mod_mult_div_eq: "a mod b + b * (a div b) = a"
   using div_mult_mod_eq [of a b] by (simp add: ac_simps)
 
 lemma minus_div_mult_eq_mod: "a - a div b * b = a mod b"
   by (rule add_implies_diff [symmetric]) (fact mod_div_mult_eq)
 
 lemma minus_mult_div_eq_mod: "a - b * (a div b) = a mod b"
   by (rule add_implies_diff [symmetric]) (fact mod_mult_div_eq)
 
 lemma minus_mod_eq_div_mult: "a - a mod b = a div b * b"
   by (rule add_implies_diff [symmetric]) (fact div_mult_mod_eq)
 
 lemma minus_mod_eq_mult_div: "a - a mod b = b * (a div b)"
   by (rule add_implies_diff [symmetric]) (fact mult_div_mod_eq)
 
 lemma mod_0_imp_dvd [dest!]:
   "b dvd a" if "a mod b = 0"
 proof -
   have "b dvd (a div b) * b" by simp
   also have "(a div b) * b = a"
     using div_mult_mod_eq [of a b] by (simp add: that)
   finally show ?thesis .
 qed
 
 lemma [nitpick_unfold]:
   "a mod b = a - a div b * b"
   by (fact minus_div_mult_eq_mod [symmetric])
 
 end
 
 
 subsection \<open>Quotient and remainder in integral domains\<close>
 
 class semidom_modulo = algebraic_semidom + semiring_modulo
 begin
 
 lemma mod_0 [simp]: "0 mod a = 0"
   using div_mult_mod_eq [of 0 a] by simp
 
 lemma mod_by_0 [simp]: "a mod 0 = a"
   using div_mult_mod_eq [of a 0] by simp
 
 lemma mod_by_1 [simp]:
   "a mod 1 = 0"
 proof -
   from div_mult_mod_eq [of a one] div_by_1 have "a + a mod 1 = a" by simp
   then have "a + a mod 1 = a + 0" by simp
   then show ?thesis by (rule add_left_imp_eq)
 qed
 
 lemma mod_self [simp]:
   "a mod a = 0"
   using div_mult_mod_eq [of a a] by simp
 
 lemma dvd_imp_mod_0 [simp]:
   "b mod a = 0" if "a dvd b"
   using that minus_div_mult_eq_mod [of b a] by simp
 
 lemma mod_eq_0_iff_dvd:
   "a mod b = 0 \<longleftrightarrow> b dvd a"
   by (auto intro: mod_0_imp_dvd)
 
 lemma dvd_eq_mod_eq_0 [nitpick_unfold, code]:
   "a dvd b \<longleftrightarrow> b mod a = 0"
   by (simp add: mod_eq_0_iff_dvd)
 
 lemma dvd_mod_iff: 
   assumes "c dvd b"
   shows "c dvd a mod b \<longleftrightarrow> c dvd a"
 proof -
   from assms have "(c dvd a mod b) \<longleftrightarrow> (c dvd ((a div b) * b + a mod b))" 
     by (simp add: dvd_add_right_iff)
   also have "(a div b) * b + a mod b = a"
     using div_mult_mod_eq [of a b] by simp
   finally show ?thesis .
 qed
 
 lemma dvd_mod_imp_dvd:
   assumes "c dvd a mod b" and "c dvd b"
   shows "c dvd a"
   using assms dvd_mod_iff [of c b a] by simp
 
 lemma dvd_minus_mod [simp]:
   "b dvd a - a mod b"
   by (simp add: minus_mod_eq_div_mult)
 
 lemma cancel_div_mod_rules:
   "((a div b) * b + a mod b) + c = a + c"
   "(b * (a div b) + a mod b) + c = a + c"
   by (simp_all add: div_mult_mod_eq mult_div_mod_eq)
 
 end
 
 class idom_modulo = idom + semidom_modulo
 begin
 
 subclass idom_divide ..
 
 lemma div_diff [simp]:
   "c dvd a \<Longrightarrow> c dvd b \<Longrightarrow> (a - b) div c = a div c - b div c"
   using div_add [of _  _ "- b"] by (simp add: dvd_neg_div)
 
 end
 
 
 subsection \<open>Interlude: basic tool support for algebraic and arithmetic calculations\<close>
 
 named_theorems arith "arith facts -- only ground formulas"
 ML_file \<open>Tools/arith_data.ML\<close>
 
 ML_file \<open>~~/src/Provers/Arith/cancel_div_mod.ML\<close>
 
 ML \<open>
 structure Cancel_Div_Mod_Ring = 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 mk_sum = Arith_Data.mk_sum;
   val dest_sum = Arith_Data.dest_sum;
 
   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 diff_conv_add_uminus add_0_left add_0_right ac_simps})
 )
 \<close>
 
 simproc_setup cancel_div_mod_int ("(a::'a::semidom_modulo) + b") =
   \<open>K Cancel_Div_Mod_Ring.proc\<close>
 
 
 subsection \<open>Ordered semirings and rings\<close>
 
 text \<open>
   The theory of partially ordered rings is taken from the books:
     \<^item> \<^emph>\<open>Lattice Theory\<close> by Garret Birkhoff, American Mathematical Society, 1979
     \<^item> \<^emph>\<open>Partially Ordered Algebraic Systems\<close>, Pergamon Press, 1963
 
   Most of the used notions can also be looked up in
     \<^item> \<^url>\<open>http://www.mathworld.com\<close> by Eric Weisstein et. al.
     \<^item> \<^emph>\<open>Algebra I\<close> by van der Waerden, Springer
 \<close>
 
 class ordered_semiring = semiring + ordered_comm_monoid_add +
   assumes mult_left_mono: "a \<le> b \<Longrightarrow> 0 \<le> c \<Longrightarrow> c * a \<le> c * b"
   assumes mult_right_mono: "a \<le> b \<Longrightarrow> 0 \<le> c \<Longrightarrow> a * c \<le> b * c"
 begin
 
 lemma mult_mono: "a \<le> b \<Longrightarrow> c \<le> d \<Longrightarrow> 0 \<le> b \<Longrightarrow> 0 \<le> c \<Longrightarrow> a * c \<le> b * d"
   apply (erule (1) mult_right_mono [THEN order_trans])
   apply (erule (1) mult_left_mono)
   done
 
 lemma mult_mono': "a \<le> b \<Longrightarrow> c \<le> d \<Longrightarrow> 0 \<le> a \<Longrightarrow> 0 \<le> c \<Longrightarrow> a * c \<le> b * d"
   by (rule mult_mono) (fast intro: order_trans)+
 
 end
 
 class ordered_semiring_0 = semiring_0 + ordered_semiring
 begin
 
 lemma mult_nonneg_nonneg [simp]: "0 \<le> a \<Longrightarrow> 0 \<le> b \<Longrightarrow> 0 \<le> a * b"
   using mult_left_mono [of 0 b a] by simp
 
 lemma mult_nonneg_nonpos: "0 \<le> a \<Longrightarrow> b \<le> 0 \<Longrightarrow> a * b \<le> 0"
   using mult_left_mono [of b 0 a] by simp
 
 lemma mult_nonpos_nonneg: "a \<le> 0 \<Longrightarrow> 0 \<le> b \<Longrightarrow> a * b \<le> 0"
   using mult_right_mono [of a 0 b] by simp
 
 text \<open>Legacy -- use @{thm [source] mult_nonpos_nonneg}.\<close>
 lemma mult_nonneg_nonpos2: "0 \<le> a \<Longrightarrow> b \<le> 0 \<Longrightarrow> b * a \<le> 0"
   by (drule mult_right_mono [of b 0]) auto
 
 lemma split_mult_neg_le: "(0 \<le> a \<and> b \<le> 0) \<or> (a \<le> 0 \<and> 0 \<le> b) \<Longrightarrow> a * b \<le> 0"
   by (auto simp add: mult_nonneg_nonpos mult_nonneg_nonpos2)
 
 end
 
 class ordered_cancel_semiring = ordered_semiring + cancel_comm_monoid_add
 begin
 
 subclass semiring_0_cancel ..
 
 subclass ordered_semiring_0 ..
 
 end
 
 class linordered_semiring = ordered_semiring + linordered_cancel_ab_semigroup_add
 begin
 
 subclass ordered_cancel_semiring ..
 
 subclass ordered_cancel_comm_monoid_add ..
 
 subclass ordered_ab_semigroup_monoid_add_imp_le ..
 
 lemma mult_left_less_imp_less: "c * a < c * b \<Longrightarrow> 0 \<le> c \<Longrightarrow> a < b"
   by (force simp add: mult_left_mono not_le [symmetric])
 
 lemma mult_right_less_imp_less: "a * c < b * c \<Longrightarrow> 0 \<le> c \<Longrightarrow> a < b"
   by (force simp add: mult_right_mono not_le [symmetric])
 
 end
 
 class zero_less_one = order + zero + one +
   assumes zero_less_one [simp]: "0 < 1"
 
 class linordered_semiring_1 = linordered_semiring + semiring_1 + zero_less_one
 begin
 
 lemma convex_bound_le:
   assumes "x \<le> a" "y \<le> a" "0 \<le> u" "0 \<le> v" "u + v = 1"
   shows "u * x + v * y \<le> a"
 proof-
   from assms have "u * x + v * y \<le> u * a + v * a"
     by (simp add: add_mono mult_left_mono)
   with assms show ?thesis
     unfolding distrib_right[symmetric] by simp
 qed
 
 end
 
 class linordered_semiring_strict = semiring + comm_monoid_add + linordered_cancel_ab_semigroup_add +
   assumes mult_strict_left_mono: "a < b \<Longrightarrow> 0 < c \<Longrightarrow> c * a < c * b"
   assumes mult_strict_right_mono: "a < b \<Longrightarrow> 0 < c \<Longrightarrow> a * c < b * c"
 begin
 
 subclass semiring_0_cancel ..
 
 subclass linordered_semiring
 proof
   fix a b c :: 'a
   assume *: "a \<le> b" "0 \<le> c"
   then show "c * a \<le> c * b"
     unfolding le_less
     using mult_strict_left_mono by (cases "c = 0") auto
   from * show "a * c \<le> b * c"
     unfolding le_less
     using mult_strict_right_mono by (cases "c = 0") auto
 qed
 
 lemma mult_left_le_imp_le: "c * a \<le> c * b \<Longrightarrow> 0 < c \<Longrightarrow> a \<le> b"
   by (auto simp add: mult_strict_left_mono _not_less [symmetric])
 
 lemma mult_right_le_imp_le: "a * c \<le> b * c \<Longrightarrow> 0 < c \<Longrightarrow> a \<le> b"
   by (auto simp add: mult_strict_right_mono not_less [symmetric])
 
 lemma mult_pos_pos[simp]: "0 < a \<Longrightarrow> 0 < b \<Longrightarrow> 0 < a * b"
   using mult_strict_left_mono [of 0 b a] by simp
 
 lemma mult_pos_neg: "0 < a \<Longrightarrow> b < 0 \<Longrightarrow> a * b < 0"
   using mult_strict_left_mono [of b 0 a] by simp
 
 lemma mult_neg_pos: "a < 0 \<Longrightarrow> 0 < b \<Longrightarrow> a * b < 0"
   using mult_strict_right_mono [of a 0 b] by simp
 
 text \<open>Legacy -- use @{thm [source] mult_neg_pos}.\<close>
 lemma mult_pos_neg2: "0 < a \<Longrightarrow> b < 0 \<Longrightarrow> b * a < 0"
   by (drule mult_strict_right_mono [of b 0]) auto
 
 lemma zero_less_mult_pos: 
   assumes "0 < a * b" "0 < a" shows "0 < b"
 proof (cases "b \<le> 0")
   case True
   then show ?thesis
     using assms by (auto simp: le_less dest: less_not_sym mult_pos_neg [of a b])
 qed (auto simp add: le_less not_less)
 
 
 lemma zero_less_mult_pos2: 
   assumes "0 < b * a" "0 < a" shows "0 < b"
 proof (cases "b \<le> 0")
   case True
   then show ?thesis
     using assms by (auto simp: le_less dest: less_not_sym mult_pos_neg2 [of a b])
 qed (auto simp add: le_less not_less)
 
 text \<open>Strict monotonicity in both arguments\<close>
 lemma mult_strict_mono:
   assumes "a < b" "c < d" "0 < b" "0 \<le> c"
   shows "a * c < b * d"
 proof (cases "c = 0")
   case True
   with assms show ?thesis
     by simp
 next
   case False
   with assms have "a*c < b*c"
     by (simp add: mult_strict_right_mono [OF \<open>a < b\<close>])
   also have "\<dots> < b*d"
     by (simp add: assms mult_strict_left_mono)
   finally show ?thesis .
 qed
 
 text \<open>This weaker variant has more natural premises\<close>
 lemma mult_strict_mono':
   assumes "a < b" and "c < d" and "0 \<le> a" and "0 \<le> c"
   shows "a * c < b * d"
   by (rule mult_strict_mono) (insert assms, auto)
 
 lemma mult_less_le_imp_less:
   assumes "a < b" and "c \<le> d" and "0 \<le> a" and "0 < c"
   shows "a * c < b * d"
 proof -
   have "a * c < b * c"
     by (simp add: assms mult_strict_right_mono)
   also have "... \<le> b * d"
     by (intro mult_left_mono) (use assms in auto)
   finally show ?thesis .
 qed
 
 lemma mult_le_less_imp_less:
   assumes "a \<le> b" and "c < d" and "0 < a" and "0 \<le> c"
   shows "a * c < b * d"
 proof -
   have "a * c \<le> b * c"
     by (simp add: assms mult_right_mono)
   also have "... < b * d"
     by (intro mult_strict_left_mono) (use assms in auto)
   finally show ?thesis .
 qed
 
 end
 
 class linordered_semiring_1_strict = linordered_semiring_strict + semiring_1 + zero_less_one
 begin
 
 subclass linordered_semiring_1 ..
 
 lemma convex_bound_lt:
   assumes "x < a" "y < a" "0 \<le> u" "0 \<le> v" "u + v = 1"
   shows "u * x + v * y < a"
 proof -
   from assms have "u * x + v * y < u * a + v * a"
     by (cases "u = 0") (auto intro!: add_less_le_mono mult_strict_left_mono mult_left_mono)
   with assms show ?thesis
     unfolding distrib_right[symmetric] by simp
 qed
 
 end
 
 class ordered_comm_semiring = comm_semiring_0 + ordered_ab_semigroup_add +
   assumes comm_mult_left_mono: "a \<le> b \<Longrightarrow> 0 \<le> c \<Longrightarrow> c * a \<le> c * b"
 begin
 
 subclass ordered_semiring
 proof
   fix a b c :: 'a
   assume "a \<le> b" "0 \<le> c"
   then show "c * a \<le> c * b" by (rule comm_mult_left_mono)
   then show "a * c \<le> b * c" by (simp only: mult.commute)
 qed
 
 end
 
 class ordered_cancel_comm_semiring = ordered_comm_semiring + cancel_comm_monoid_add
 begin
 
 subclass comm_semiring_0_cancel ..
 subclass ordered_comm_semiring ..
 subclass ordered_cancel_semiring ..
 
 end
 
 class linordered_comm_semiring_strict = comm_semiring_0 + linordered_cancel_ab_semigroup_add +
   assumes comm_mult_strict_left_mono: "a < b \<Longrightarrow> 0 < c \<Longrightarrow> c * a < c * b"
 begin
 
 subclass linordered_semiring_strict
 proof
   fix a b c :: 'a
   assume "a < b" "0 < c"
   then show "c * a < c * b"
     by (rule comm_mult_strict_left_mono)
   then show "a * c < b * c"
     by (simp only: mult.commute)
 qed
 
 subclass ordered_cancel_comm_semiring
 proof
   fix a b c :: 'a
   assume "a \<le> b" "0 \<le> c"
   then show "c * a \<le> c * b"
     unfolding le_less
     using mult_strict_left_mono by (cases "c = 0") auto
 qed
 
 end
 
 class ordered_ring = ring + ordered_cancel_semiring
 begin
 
 subclass ordered_ab_group_add ..
 
 lemma less_add_iff1: "a * e + c < b * e + d \<longleftrightarrow> (a - b) * e + c < d"
   by (simp add: algebra_simps)
 
 lemma less_add_iff2: "a * e + c < b * e + d \<longleftrightarrow> c < (b - a) * e + d"
   by (simp add: algebra_simps)
 
 lemma le_add_iff1: "a * e + c \<le> b * e + d \<longleftrightarrow> (a - b) * e + c \<le> d"
   by (simp add: algebra_simps)
 
 lemma le_add_iff2: "a * e + c \<le> b * e + d \<longleftrightarrow> c \<le> (b - a) * e + d"
   by (simp add: algebra_simps)
 
 lemma mult_left_mono_neg: "b \<le> a \<Longrightarrow> c \<le> 0 \<Longrightarrow> c * a \<le> c * b"
   by (auto dest: mult_left_mono [of _ _ "- c"])
 
 lemma mult_right_mono_neg: "b \<le> a \<Longrightarrow> c \<le> 0 \<Longrightarrow> a * c \<le> b * c"
   by (auto dest: mult_right_mono [of _ _ "- c"])
 
 lemma mult_nonpos_nonpos: "a \<le> 0 \<Longrightarrow> b \<le> 0 \<Longrightarrow> 0 \<le> a * b"
   using mult_right_mono_neg [of a 0 b] by simp
 
 lemma split_mult_pos_le: "(0 \<le> a \<and> 0 \<le> b) \<or> (a \<le> 0 \<and> b \<le> 0) \<Longrightarrow> 0 \<le> a * b"
   by (auto simp add: mult_nonpos_nonpos)
 
 end
 
 class abs_if = minus + uminus + ord + zero + abs +
   assumes abs_if: "\<bar>a\<bar> = (if a < 0 then - a else a)"
 
 class linordered_ring = ring + linordered_semiring + linordered_ab_group_add + abs_if
 begin
 
 subclass ordered_ring ..
 
 subclass ordered_ab_group_add_abs
 proof
   fix a b
   show "\<bar>a + b\<bar> \<le> \<bar>a\<bar> + \<bar>b\<bar>"
     by (auto simp add: abs_if not_le not_less algebra_simps
         simp del: add.commute dest: add_neg_neg add_nonneg_nonneg)
 qed (auto simp: abs_if)
 
 lemma zero_le_square [simp]: "0 \<le> a * a"
   using linear [of 0 a] by (auto simp add: mult_nonpos_nonpos)
 
 lemma not_square_less_zero [simp]: "\<not> (a * a < 0)"
   by (simp add: not_less)
 
 proposition abs_eq_iff: "\<bar>x\<bar> = \<bar>y\<bar> \<longleftrightarrow> x = y \<or> x = -y"
   by (auto simp add: abs_if split: if_split_asm)
 
 lemma abs_eq_iff':
   "\<bar>a\<bar> = b \<longleftrightarrow> b \<ge> 0 \<and> (a = b \<or> a = - b)"
   by (cases "a \<ge> 0") auto
 
 lemma eq_abs_iff':
   "a = \<bar>b\<bar> \<longleftrightarrow> a \<ge> 0 \<and> (b = a \<or> b = - a)"
   using abs_eq_iff' [of b a] by auto
 
 lemma sum_squares_ge_zero: "0 \<le> x * x + y * y"
   by (intro add_nonneg_nonneg zero_le_square)
 
 lemma not_sum_squares_lt_zero: "\<not> x * x + y * y < 0"
   by (simp add: not_less sum_squares_ge_zero)
 
 end
 
 class linordered_ring_strict = ring + linordered_semiring_strict
   + ordered_ab_group_add + abs_if
 begin
 
 subclass linordered_ring ..
 
 lemma mult_strict_left_mono_neg: "b < a \<Longrightarrow> c < 0 \<Longrightarrow> c * a < c * b"
   using mult_strict_left_mono [of b a "- c"] by simp
 
 lemma mult_strict_right_mono_neg: "b < a \<Longrightarrow> c < 0 \<Longrightarrow> a * c < b * c"
   using mult_strict_right_mono [of b a "- c"] by simp
 
 lemma mult_neg_neg: "a < 0 \<Longrightarrow> b < 0 \<Longrightarrow> 0 < a * b"
   using mult_strict_right_mono_neg [of a 0 b] by simp
 
 subclass ring_no_zero_divisors
 proof
   fix a b
   assume "a \<noteq> 0"
   then have a: "a < 0 \<or> 0 < a" by (simp add: neq_iff)
   assume "b \<noteq> 0"
   then have b: "b < 0 \<or> 0 < b" by (simp add: neq_iff)
   have "a * b < 0 \<or> 0 < a * b"
   proof (cases "a < 0")
     case True
     show ?thesis
     proof (cases "b < 0")
       case True
       with \<open>a < 0\<close> show ?thesis by (auto dest: mult_neg_neg)
     next
       case False
       with b have "0 < b" by auto
       with \<open>a < 0\<close> show ?thesis by (auto dest: mult_strict_right_mono)
     qed
   next
     case False
     with a have "0 < a" by auto
     show ?thesis
     proof (cases "b < 0")
       case True
       with \<open>0 < a\<close> show ?thesis
         by (auto dest: mult_strict_right_mono_neg)
     next
       case False
       with b have "0 < b" by auto
       with \<open>0 < a\<close> show ?thesis by auto
     qed
   qed
   then show "a * b \<noteq> 0"
     by (simp add: neq_iff)
 qed
 
 lemma zero_less_mult_iff [algebra_split_simps, field_split_simps]:
   "0 < a * b \<longleftrightarrow> 0 < a \<and> 0 < b \<or> a < 0 \<and> b < 0"
   by (cases a 0 b 0 rule: linorder_cases[case_product linorder_cases])
      (auto simp add: mult_neg_neg not_less le_less dest: zero_less_mult_pos zero_less_mult_pos2)
 
 lemma zero_le_mult_iff [algebra_split_simps, field_split_simps]:
   "0 \<le> a * b \<longleftrightarrow> 0 \<le> a \<and> 0 \<le> b \<or> a \<le> 0 \<and> b \<le> 0"
   by (auto simp add: eq_commute [of 0] le_less not_less zero_less_mult_iff)
 
 lemma mult_less_0_iff [algebra_split_simps, field_split_simps]:
   "a * b < 0 \<longleftrightarrow> 0 < a \<and> b < 0 \<or> a < 0 \<and> 0 < b"
   using zero_less_mult_iff [of "- a" b] by auto
 
 lemma mult_le_0_iff [algebra_split_simps, field_split_simps]:
   "a * b \<le> 0 \<longleftrightarrow> 0 \<le> a \<and> b \<le> 0 \<or> a \<le> 0 \<and> 0 \<le> b"
   using zero_le_mult_iff [of "- a" b] by auto
 
 text \<open>
   Cancellation laws for \<^term>\<open>c * a < c * b\<close> and \<^term>\<open>a * c < b * c\<close>,
   also with the relations \<open>\<le>\<close> and equality.
 \<close>
 
 text \<open>
   These ``disjunction'' versions produce two cases when the comparison is
   an assumption, but effectively four when the comparison is a goal.
 \<close>
 
 lemma mult_less_cancel_right_disj: "a * c < b * c \<longleftrightarrow> 0 < c \<and> a < b \<or> c < 0 \<and> b < a"
 proof (cases "c = 0")
   case False
   show ?thesis (is "?lhs \<longleftrightarrow> ?rhs")
   proof
     assume ?lhs
     then have "c < 0 \<Longrightarrow> b < a" "c > 0 \<Longrightarrow> b > a"
       by (auto simp flip: not_le intro: mult_right_mono mult_right_mono_neg)
     with False show ?rhs 
       by (auto simp add: neq_iff)
   next
     assume ?rhs
     with False show ?lhs 
       by (auto simp add: mult_strict_right_mono mult_strict_right_mono_neg)
   qed
 qed auto
 
 lemma mult_less_cancel_left_disj: "c * a < c * b \<longleftrightarrow> 0 < c \<and> a < b \<or> c < 0 \<and> b < a"
 proof (cases "c = 0")
   case False
   show ?thesis (is "?lhs \<longleftrightarrow> ?rhs")
   proof
     assume ?lhs
     then have "c < 0 \<Longrightarrow> b < a" "c > 0 \<Longrightarrow> b > a"
       by (auto simp flip: not_le intro: mult_left_mono mult_left_mono_neg)
     with False show ?rhs 
       by (auto simp add: neq_iff)
   next
     assume ?rhs
     with False show ?lhs 
       by (auto simp add: mult_strict_left_mono mult_strict_left_mono_neg)
   qed
 qed auto
 
 text \<open>
   The ``conjunction of implication'' lemmas produce two cases when the
   comparison is a goal, but give four when the comparison is an assumption.
 \<close>
 
 lemma mult_less_cancel_right: "a * c < b * c \<longleftrightarrow> (0 \<le> c \<longrightarrow> a < b) \<and> (c \<le> 0 \<longrightarrow> b < a)"
   using mult_less_cancel_right_disj [of a c b] by auto
 
 lemma mult_less_cancel_left: "c * a < c * b \<longleftrightarrow> (0 \<le> c \<longrightarrow> a < b) \<and> (c \<le> 0 \<longrightarrow> b < a)"
   using mult_less_cancel_left_disj [of c a b] by auto
 
 lemma mult_le_cancel_right: "a * c \<le> b * c \<longleftrightarrow> (0 < c \<longrightarrow> a \<le> b) \<and> (c < 0 \<longrightarrow> b \<le> a)"
   by (simp add: not_less [symmetric] mult_less_cancel_right_disj)
 
 lemma mult_le_cancel_left: "c * a \<le> c * b \<longleftrightarrow> (0 < c \<longrightarrow> a \<le> b) \<and> (c < 0 \<longrightarrow> b \<le> a)"
   by (simp add: not_less [symmetric] mult_less_cancel_left_disj)
 
 lemma mult_le_cancel_left_pos: "0 < c \<Longrightarrow> c * a \<le> c * b \<longleftrightarrow> a \<le> b"
   by (auto simp: mult_le_cancel_left)
 
 lemma mult_le_cancel_left_neg: "c < 0 \<Longrightarrow> c * a \<le> c * b \<longleftrightarrow> b \<le> a"
   by (auto simp: mult_le_cancel_left)
 
 lemma mult_less_cancel_left_pos: "0 < c \<Longrightarrow> c * a < c * b \<longleftrightarrow> a < b"
   by (auto simp: mult_less_cancel_left)
 
 lemma mult_less_cancel_left_neg: "c < 0 \<Longrightarrow> c * a < c * b \<longleftrightarrow> b < a"
   by (auto simp: mult_less_cancel_left)
 
 end
 
 lemmas mult_sign_intros =
   mult_nonneg_nonneg mult_nonneg_nonpos
   mult_nonpos_nonneg mult_nonpos_nonpos
   mult_pos_pos mult_pos_neg
   mult_neg_pos mult_neg_neg
 
 class ordered_comm_ring = comm_ring + ordered_comm_semiring
 begin
 
 subclass ordered_ring ..
 subclass ordered_cancel_comm_semiring ..
 
 end
 
 class linordered_nonzero_semiring = ordered_comm_semiring + monoid_mult + linorder + zero_less_one +
   assumes add_mono1: "a < b \<Longrightarrow> a + 1 < b + 1"
 begin
 
 subclass zero_neq_one
   by standard (insert zero_less_one, blast)
 
 subclass comm_semiring_1
   by standard (rule mult_1_left)
 
 lemma zero_le_one [simp]: "0 \<le> 1"
   by (rule zero_less_one [THEN less_imp_le])
 
 lemma not_one_le_zero [simp]: "\<not> 1 \<le> 0"
   by (simp add: not_le)
 
 lemma not_one_less_zero [simp]: "\<not> 1 < 0"
   by (simp add: not_less)
 
+lemma of_bool_less_eq_iff [simp]:
+  \<open>of_bool P \<le> of_bool Q \<longleftrightarrow> (P \<longrightarrow> Q)\<close>
+  by auto
+
+lemma of_bool_less_iff [simp]:
+  \<open>of_bool P < of_bool Q \<longleftrightarrow> \<not> P \<and> Q\<close>
+  by auto
+
 lemma mult_left_le: "c \<le> 1 \<Longrightarrow> 0 \<le> a \<Longrightarrow> a * c \<le> a"
   using mult_left_mono[of c 1 a] by simp
 
 lemma mult_le_one: "a \<le> 1 \<Longrightarrow> 0 \<le> b \<Longrightarrow> b \<le> 1 \<Longrightarrow> a * b \<le> 1"
   using mult_mono[of a 1 b 1] by simp
 
 lemma zero_less_two: "0 < 1 + 1"
   using add_pos_pos[OF zero_less_one zero_less_one] .
 
 end
 
 class linordered_semidom = semidom + linordered_comm_semiring_strict + zero_less_one +
   assumes le_add_diff_inverse2 [simp]: "b \<le> a \<Longrightarrow> a - b + b = a"
 begin
 
 subclass linordered_nonzero_semiring 
 proof
   show "a + 1 < b + 1" if "a < b" for a b
   proof (rule ccontr, simp add: not_less)
     assume "b \<le> a"
     with that show False
       by (simp add: )
   qed
 qed
 
+lemma zero_less_eq_of_bool [simp]:
+  \<open>0 \<le> of_bool P\<close>
+  by simp
+
+lemma zero_less_of_bool_iff [simp]:
+  \<open>0 < of_bool P \<longleftrightarrow> P\<close>
+  by simp
+
+lemma of_bool_less_eq_one [simp]:
+  \<open>of_bool P \<le> 1\<close>
+  by simp
+
+lemma of_bool_less_one_iff [simp]:
+  \<open>of_bool P < 1 \<longleftrightarrow> \<not> P\<close>
+  by simp
+
+lemma of_bool_or_iff [simp]:
+  \<open>of_bool (P \<or> Q) = max (of_bool P) (of_bool Q)\<close>
+  by (simp add: max_def)
+
 text \<open>Addition is the inverse of subtraction.\<close>
 
 lemma le_add_diff_inverse [simp]: "b \<le> a \<Longrightarrow> b + (a - b) = a"
   by (frule le_add_diff_inverse2) (simp add: add.commute)
 
 lemma add_diff_inverse: "\<not> a < b \<Longrightarrow> b + (a - b) = a"
   by simp
 
 lemma add_le_imp_le_diff: 
   assumes "i + k \<le> n" shows "i \<le> n - k"
 proof -
   have "n - (i + k) + i + k = n"
     by (simp add: assms add.assoc)
   with assms add_implies_diff have "i + k \<le> n - k + k"
     by fastforce
   then show ?thesis
     by simp
 qed
 
 lemma add_le_add_imp_diff_le:
   assumes 1: "i + k \<le> n"
     and 2: "n \<le> j + k"
   shows "i + k \<le> n \<Longrightarrow> n \<le> j + k \<Longrightarrow> n - k \<le> j"
 proof -
   have "n - (i + k) + i + k = n"
     using 1 by (simp add: add.assoc)
   moreover have "n - k = n - k - i + i"
     using 1 by (simp add: add_le_imp_le_diff)
   ultimately show ?thesis
     using 2 add_le_imp_le_diff [of "n-k" k "j + k"]
     by (simp add: add.commute diff_diff_add)
 qed
 
 lemma less_1_mult: "1 < m \<Longrightarrow> 1 < n \<Longrightarrow> 1 < m * n"
   using mult_strict_mono [of 1 m 1 n] by (simp add: less_trans [OF zero_less_one])
 
 end
 
 class linordered_idom = comm_ring_1 + linordered_comm_semiring_strict +
   ordered_ab_group_add + abs_if + sgn +
   assumes sgn_if: "sgn x = (if x = 0 then 0 else if 0 < x then 1 else - 1)"
 begin
 
 subclass linordered_ring_strict ..
 
 subclass linordered_semiring_1_strict
 proof
   have "0 \<le> 1 * 1"
     by (fact zero_le_square)
   then show "0 < 1" 
     by (simp add: le_less)
 qed
 
 subclass ordered_comm_ring ..
 subclass idom ..
 
 subclass linordered_semidom
   by standard simp
 
 subclass idom_abs_sgn
   by standard
     (auto simp add: sgn_if abs_if zero_less_mult_iff)
 
+lemma abs_bool_eq [simp]:
+  \<open>\<bar>of_bool P\<bar> = of_bool P\<close>
+  by simp
+
 lemma linorder_neqE_linordered_idom:
   assumes "x \<noteq> y"
   obtains "x < y" | "y < x"
   using assms by (rule neqE)
 
 text \<open>These cancellation simp rules also produce two cases when the comparison is a goal.\<close>
 
 lemma mult_le_cancel_right1: "c \<le> b * c \<longleftrightarrow> (0 < c \<longrightarrow> 1 \<le> b) \<and> (c < 0 \<longrightarrow> b \<le> 1)"
   using mult_le_cancel_right [of 1 c b] by simp
 
 lemma mult_le_cancel_right2: "a * c \<le> c \<longleftrightarrow> (0 < c \<longrightarrow> a \<le> 1) \<and> (c < 0 \<longrightarrow> 1 \<le> a)"
   using mult_le_cancel_right [of a c 1] by simp
 
 lemma mult_le_cancel_left1: "c \<le> c * b \<longleftrightarrow> (0 < c \<longrightarrow> 1 \<le> b) \<and> (c < 0 \<longrightarrow> b \<le> 1)"
   using mult_le_cancel_left [of c 1 b] by simp
 
 lemma mult_le_cancel_left2: "c * a \<le> c \<longleftrightarrow> (0 < c \<longrightarrow> a \<le> 1) \<and> (c < 0 \<longrightarrow> 1 \<le> a)"
   using mult_le_cancel_left [of c a 1] by simp
 
 lemma mult_less_cancel_right1: "c < b * c \<longleftrightarrow> (0 \<le> c \<longrightarrow> 1 < b) \<and> (c \<le> 0 \<longrightarrow> b < 1)"
   using mult_less_cancel_right [of 1 c b] by simp
 
 lemma mult_less_cancel_right2: "a * c < c \<longleftrightarrow> (0 \<le> c \<longrightarrow> a < 1) \<and> (c \<le> 0 \<longrightarrow> 1 < a)"
   using mult_less_cancel_right [of a c 1] by simp
 
 lemma mult_less_cancel_left1: "c < c * b \<longleftrightarrow> (0 \<le> c \<longrightarrow> 1 < b) \<and> (c \<le> 0 \<longrightarrow> b < 1)"
   using mult_less_cancel_left [of c 1 b] by simp
 
 lemma mult_less_cancel_left2: "c * a < c \<longleftrightarrow> (0 \<le> c \<longrightarrow> a < 1) \<and> (c \<le> 0 \<longrightarrow> 1 < a)"
   using mult_less_cancel_left [of c a 1] by simp
 
 lemma sgn_0_0: "sgn a = 0 \<longleftrightarrow> a = 0"
   by (fact sgn_eq_0_iff)
 
 lemma sgn_1_pos: "sgn a = 1 \<longleftrightarrow> a > 0"
   unfolding sgn_if by simp
 
 lemma sgn_1_neg: "sgn a = - 1 \<longleftrightarrow> a < 0"
   unfolding sgn_if by auto
 
 lemma sgn_pos [simp]: "0 < a \<Longrightarrow> sgn a = 1"
   by (simp only: sgn_1_pos)
 
 lemma sgn_neg [simp]: "a < 0 \<Longrightarrow> sgn a = - 1"
   by (simp only: sgn_1_neg)
 
 lemma abs_sgn: "\<bar>k\<bar> = k * sgn k"
   unfolding sgn_if abs_if by auto
 
 lemma sgn_greater [simp]: "0 < sgn a \<longleftrightarrow> 0 < a"
   unfolding sgn_if by auto
 
 lemma sgn_less [simp]: "sgn a < 0 \<longleftrightarrow> a < 0"
   unfolding sgn_if by auto
 
 lemma abs_sgn_eq_1 [simp]:
   "a \<noteq> 0 \<Longrightarrow> \<bar>sgn a\<bar> = 1"
   by simp
 
 lemma abs_sgn_eq: "\<bar>sgn a\<bar> = (if a = 0 then 0 else 1)"
   by (simp add: sgn_if)
 
 lemma sgn_mult_self_eq [simp]:
   "sgn a * sgn a = of_bool (a \<noteq> 0)"
   by (cases "a > 0") simp_all
 
 lemma abs_mult_self_eq [simp]:
   "\<bar>a\<bar> * \<bar>a\<bar> = a * a"
   by (cases "a > 0") simp_all
 
 lemma same_sgn_sgn_add:
   "sgn (a + b) = sgn a" if "sgn b = sgn a"
 proof (cases a 0 rule: linorder_cases)
   case equal
   with that show ?thesis
     by simp
 next
   case less
   with that have "b < 0"
     by (simp add: sgn_1_neg)
   with \<open>a < 0\<close> have "a + b < 0"
     by (rule add_neg_neg)
   with \<open>a < 0\<close> show ?thesis
     by simp
 next
   case greater
   with that have "b > 0"
     by (simp add: sgn_1_pos)
   with \<open>a > 0\<close> have "a + b > 0"
     by (rule add_pos_pos)
   with \<open>a > 0\<close> show ?thesis
     by simp
 qed
 
 lemma same_sgn_abs_add:
   "\<bar>a + b\<bar> = \<bar>a\<bar> + \<bar>b\<bar>" if "sgn b = sgn a"
 proof -
   have "a + b = sgn a * \<bar>a\<bar> + sgn b * \<bar>b\<bar>"
     by (simp add: sgn_mult_abs)
   also have "\<dots> = sgn a * (\<bar>a\<bar> + \<bar>b\<bar>)"
     using that by (simp add: algebra_simps)
   finally show ?thesis
     by (auto simp add: abs_mult)
 qed
 
 lemma sgn_not_eq_imp:
   "sgn a = - sgn b" if "sgn b \<noteq> sgn a" and "sgn a \<noteq> 0" and "sgn b \<noteq> 0"
   using that by (cases "a < 0") (auto simp add: sgn_0_0 sgn_1_pos sgn_1_neg)
 
 lemma abs_dvd_iff [simp]: "\<bar>m\<bar> dvd k \<longleftrightarrow> m dvd k"
   by (simp add: abs_if)
 
 lemma dvd_abs_iff [simp]: "m dvd \<bar>k\<bar> \<longleftrightarrow> m dvd k"
   by (simp add: abs_if)
 
 lemma dvd_if_abs_eq: "\<bar>l\<bar> = \<bar>k\<bar> \<Longrightarrow> l dvd k"
   by (subst abs_dvd_iff [symmetric]) simp
 
 text \<open>
   The following lemmas can be proven in more general structures, but
   are dangerous as simp rules in absence of @{thm neg_equal_zero},
   @{thm neg_less_pos}, @{thm neg_less_eq_nonneg}.
 \<close>
 
 lemma equation_minus_iff_1 [simp, no_atp]: "1 = - a \<longleftrightarrow> a = - 1"
   by (fact equation_minus_iff)
 
 lemma minus_equation_iff_1 [simp, no_atp]: "- a = 1 \<longleftrightarrow> a = - 1"
   by (subst minus_equation_iff, auto)
 
 lemma le_minus_iff_1 [simp, no_atp]: "1 \<le> - b \<longleftrightarrow> b \<le> - 1"
   by (fact le_minus_iff)
 
 lemma minus_le_iff_1 [simp, no_atp]: "- a \<le> 1 \<longleftrightarrow> - 1 \<le> a"
   by (fact minus_le_iff)
 
 lemma less_minus_iff_1 [simp, no_atp]: "1 < - b \<longleftrightarrow> b < - 1"
   by (fact less_minus_iff)
 
 lemma minus_less_iff_1 [simp, no_atp]: "- a < 1 \<longleftrightarrow> - 1 < a"
   by (fact minus_less_iff)
 
 lemma add_less_zeroD:
   shows "x+y < 0 \<Longrightarrow> x<0 \<or> y<0"
   by (auto simp: not_less intro: le_less_trans [of _ "x+y"])
 
 end
 
 text \<open>Reasoning about inequalities with division\<close>
 
 context linordered_semidom
 begin
 
 lemma less_add_one: "a < a + 1"
 proof -
   have "a + 0 < a + 1"
     by (blast intro: zero_less_one add_strict_left_mono)
   then show ?thesis by simp
 qed
 
 end
 
 context linordered_idom
 begin
 
 lemma mult_right_le_one_le: "0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> x * y \<le> x"
   by (rule mult_left_le)
 
 lemma mult_left_le_one_le: "0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> y * x \<le> x"
   by (auto simp add: mult_le_cancel_right2)
 
 end
 
 text \<open>Absolute Value\<close>
 
 context linordered_idom
 begin
 
 lemma mult_sgn_abs: "sgn x * \<bar>x\<bar> = x"
   by (fact sgn_mult_abs)
 
 lemma abs_one: "\<bar>1\<bar> = 1"
   by (fact abs_1)
 
 end
 
 class ordered_ring_abs = ordered_ring + ordered_ab_group_add_abs +
   assumes abs_eq_mult:
     "(0 \<le> a \<or> a \<le> 0) \<and> (0 \<le> b \<or> b \<le> 0) \<Longrightarrow> \<bar>a * b\<bar> = \<bar>a\<bar> * \<bar>b\<bar>"
 
 context linordered_idom
 begin
 
 subclass ordered_ring_abs
   by standard (auto simp: abs_if not_less mult_less_0_iff)
 
 lemma abs_mult_self: "\<bar>a\<bar> * \<bar>a\<bar> = a * a"
   by (fact abs_mult_self_eq)
 
 lemma abs_mult_less:
   assumes ac: "\<bar>a\<bar> < c"
     and bd: "\<bar>b\<bar> < d"
   shows "\<bar>a\<bar> * \<bar>b\<bar> < c * d"
 proof -
   from ac have "0 < c"
     by (blast intro: le_less_trans abs_ge_zero)
   with bd show ?thesis by (simp add: ac mult_strict_mono)
 qed
 
 lemma abs_less_iff: "\<bar>a\<bar> < b \<longleftrightarrow> a < b \<and> - a < b"
   by (simp add: less_le abs_le_iff) (auto simp add: abs_if)
 
 lemma abs_mult_pos: "0 \<le> x \<Longrightarrow> \<bar>y\<bar> * x = \<bar>y * x\<bar>"
   by (simp add: abs_mult)
 
 lemma abs_diff_less_iff: "\<bar>x - a\<bar> < r \<longleftrightarrow> a - r < x \<and> x < a + r"
   by (auto simp add: diff_less_eq ac_simps abs_less_iff)
 
 lemma abs_diff_le_iff: "\<bar>x - a\<bar> \<le> r \<longleftrightarrow> a - r \<le> x \<and> x \<le> a + r"
   by (auto simp add: diff_le_eq ac_simps abs_le_iff)
 
 lemma abs_add_one_gt_zero: "0 < 1 + \<bar>x\<bar>"
   by (auto simp: abs_if not_less intro: zero_less_one add_strict_increasing less_trans)
 
 end
 
 
 subsection \<open>Dioids\<close>
 
 text \<open>
   Dioids are the alternative extensions of semirings, a semiring can
   either be a ring or a dioid but never both.
 \<close>
 
 class dioid = semiring_1 + canonically_ordered_monoid_add
 begin
 
 subclass ordered_semiring
   by standard (auto simp: le_iff_add distrib_left distrib_right)
 
 end
 
 
 hide_fact (open) comm_mult_left_mono comm_mult_strict_left_mono distrib
 
 code_identifier
   code_module Rings \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith
 
 end