diff --git a/src/HOL/Bit_Operations.thy b/src/HOL/Bit_Operations.thy
--- a/src/HOL/Bit_Operations.thy
+++ b/src/HOL/Bit_Operations.thy
@@ -1,3880 +1,3861 @@
 (*  Author:  Florian Haftmann, TUM
 *)
 
 section \<open>Bit operations in suitable algebraic structures\<close>
 
 theory Bit_Operations
   imports Presburger Groups_List
 begin
 
 subsection \<open>Abstract bit structures\<close>
 
-class semiring_bits = semiring_parity +
+class semiring_bits = semiring_parity + semiring_modulo_trivial +
   assumes bit_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_by_0 [simp]: \<open>a div 0 = 0\<close>
-    and bits_div_by_1 [simp]: \<open>a div 1 = a\<close>
-    and bits_0_div [simp]: \<open>0 div a = 0\<close>
-    and even_half_succ_eq [simp]: \<open>even a \<Longrightarrow> (1 + a) div 2 = a div 2\<close>
+  assumes even_half_succ_eq [simp]: \<open>even a \<Longrightarrow> (1 + a) div 2 = a div 2\<close>
     and half_div_exp_eq: \<open>a div 2 div 2 ^ n = a div 2 ^ Suc n\<close>
     and even_double_div_exp_iff: \<open>2 ^ Suc n \<noteq> 0 \<Longrightarrow> even (2 * a div 2 ^ Suc n) \<longleftrightarrow> even (a div 2 ^ n)\<close>
     and even_decr_exp_div_exp_iff: \<open>2 ^ n \<noteq> 0 \<Longrightarrow> even ((2 ^ m - 1) div 2 ^ n) \<longleftrightarrow> m \<le> n\<close>
     and even_mod_exp_diff_exp_iff: \<open>even (a mod 2 ^ m div 2 ^ n) \<longleftrightarrow> m \<le> n \<or> even (a div 2 ^ n)\<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 half_1 [simp]:
   \<open>1 div 2 = 0\<close>
   using even_half_succ_eq [of 0] by simp
 
-lemma bits_mod_by_0 [simp]:
-  \<open>a mod 0 = a\<close>
-  using div_mult_mod_eq [of a 0] by simp
-
-lemma bits_mod_by_1 [simp]:
-  \<open>a mod 1 = 0\<close>
-  using div_mult_mod_eq [of a 1] by simp
-
-lemma bits_0_mod [simp]:
-  \<open>0 mod a = 0\<close>
-  using div_mult_mod_eq [of 0 a] by simp
-
 lemma div_exp_eq_funpow_half:
   \<open>a div 2 ^ n = ((\<lambda>a. a div 2) ^^ n) a\<close>
 proof -
   have \<open>((\<lambda>a. a div 2) ^^ n) = (\<lambda>a. a div 2 ^ n)\<close>
     by (induction n)
       (simp_all del: funpow.simps power.simps add: power_0 funpow_Suc_right half_div_exp_eq)
   then show ?thesis
     by simp
 qed
 
 lemma div_exp_eq:
   \<open>a div 2 ^ m div 2 ^ n = a div 2 ^ (m + n)\<close>
   by (simp add: div_exp_eq_funpow_half Groups.add.commute [of m] funpow_add)
 
 lemma bit_0:
   \<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 bit_0)
 
 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 bit_0)
 
 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: bit_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 bit_0)
   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 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>] div_mult_mod_eq [of a \<open>2 ^ n\<close>] that
   by simp (metis (full_types) add.left_commute add_left_imp_eq)
 
 named_theorems bit_simps \<open>Simplification rules for \<^const>\<open>bit\<close>\<close>
 
 definition possible_bit :: \<open>'a itself \<Rightarrow> nat \<Rightarrow> bool\<close>
   where \<open>possible_bit TYPE('a) n \<longleftrightarrow> 2 ^ n \<noteq> 0\<close>
   \<comment> \<open>This auxiliary avoids non-termination with extensionality.\<close>
 
 lemma possible_bit_0 [simp]:
   \<open>possible_bit TYPE('a) 0\<close>
   by (simp add: possible_bit_def)
 
 lemma fold_possible_bit:
   \<open>2 ^ n = 0 \<longleftrightarrow> \<not> possible_bit TYPE('a) n\<close>
   by (simp add: possible_bit_def)
 
 lemma bit_imp_possible_bit:
   \<open>possible_bit TYPE('a) n\<close> if \<open>bit a n\<close>
   by (rule ccontr) (use that in \<open>auto simp add: bit_iff_odd possible_bit_def\<close>)
 
 lemma impossible_bit:
   \<open>\<not> bit a n\<close> if \<open>\<not> possible_bit TYPE('a) n\<close>
   using that by (blast dest: bit_imp_possible_bit)
 
 lemma possible_bit_less_imp:
   \<open>possible_bit TYPE('a) j\<close> if \<open>possible_bit TYPE('a) i\<close> \<open>j \<le> i\<close>
   using power_add [of 2 j \<open>i - j\<close>] that mult_not_zero [of \<open>2 ^ j\<close> \<open>2 ^ (i - j)\<close>]
   by (simp add: possible_bit_def)
 
 lemma possible_bit_min [simp]:
   \<open>possible_bit TYPE('a) (min i j) \<longleftrightarrow> possible_bit TYPE('a) i \<or> possible_bit TYPE('a) j\<close>
   by (auto simp add: min_def elim: possible_bit_less_imp)
 
 lemma bit_eqI:
   \<open>a = b\<close> if \<open>\<And>n. possible_bit TYPE('a) n \<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>possible_bit TYPE('a) n\<close>)
     case False
     then show ?thesis
       by (simp add: impossible_bit)
   next
     case True
     then show ?thesis
       by (rule that)
   qed
   then show ?thesis proof (induction a arbitrary: b rule: bit_induct)
     case (stable a)
     from stable(2) [of 0] have **: \<open>even b \<longleftrightarrow> even a\<close>
       by (simp add: bit_0)
     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 add: bit_0)
     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_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 add: bit_0)
     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_eq_iff:
   \<open>a = b \<longleftrightarrow> (\<forall>n. possible_bit TYPE('a) n \<longrightarrow> bit a n \<longleftrightarrow> bit b n)\<close>
   by (auto intro: bit_eqI simp add: possible_bit_def)
 
 lemma bit_0_eq [simp]:
   \<open>bit 0 = \<bottom>\<close>
 proof -
   have \<open>0 div 2 ^ n = 0\<close> for n
     unfolding div_exp_eq_funpow_half by (induction n) simp_all
   then show ?thesis
     by (simp add: fun_eq_iff bit_iff_odd)
 qed
 
 lemma bit_double_Suc_iff:
   \<open>bit (2 * a) (Suc n) \<longleftrightarrow> possible_bit TYPE('a) (Suc n) \<and> bit a n\<close>
   using even_double_div_exp_iff [of n a]
   by (cases \<open>possible_bit TYPE('a) (Suc n)\<close>)
     (auto simp add: bit_iff_odd possible_bit_def)
 
 lemma bit_double_iff [bit_simps]:
   \<open>bit (2 * a) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> n \<noteq> 0 \<and> bit a (n - 1)\<close>
   by (cases n) (simp_all add: bit_0 bit_double_Suc_iff)
 
 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_exp_iff [bit_simps]:
   \<open>bit (2 ^ m) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> n = m\<close>
 proof (cases \<open>possible_bit TYPE('a) n\<close>)
   case False
   then show ?thesis
     by (simp add: impossible_bit)
 next
   case True
   then show ?thesis
   proof (induction n arbitrary: m)
     case 0
     show ?case
       by (simp add: bit_0)
   next
     case (Suc n)
     then have \<open>possible_bit TYPE('a) n\<close>
       by (simp add: possible_bit_less_imp)
     show ?case
     proof (cases m)
       case 0
       then show ?thesis
         by (simp add: bit_Suc)
     next
       case (Suc m)
       with Suc.IH [of m] \<open>possible_bit TYPE('a) n\<close> show ?thesis
         by (simp add: bit_double_Suc_iff)
     qed
   qed
 qed
 
 lemma bit_1_iff [bit_simps]:
   \<open>bit 1 n \<longleftrightarrow> n = 0\<close>
   using bit_exp_iff [of 0 n] by auto
 
 lemma bit_2_iff [bit_simps]:
   \<open>bit 2 n \<longleftrightarrow> possible_bit TYPE('a) 1 \<and> n = 1\<close>
   using bit_exp_iff [of 1 n] by auto
 
 lemma bit_of_bool_iff [bit_simps]:
   \<open>bit (of_bool b) n \<longleftrightarrow> n = 0 \<and> b\<close>
   by (simp add: bit_1_iff)
 
 lemma bit_mod_2_iff [simp]:
   \<open>bit (a mod 2) n \<longleftrightarrow> n = 0 \<and> odd a\<close>
   by (simp add: mod_2_eq_odd bit_simps)
 
 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>possible_bit TYPE('a) n\<close>)
   case False
   then show ?thesis
     by (auto dest: impossible_bit)
 next
   case True
   with that show ?thesis proof (induction n arbitrary: a b)
     case 0
     from "0.prems"(1) [of 0] show ?case
       by (auto simp add: bit_0)
   next
     case (Suc n)
     from Suc.prems(1) [of 0] have even: \<open>even a \<or> even b\<close>
       by (auto simp add: bit_0)
     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>possible_bit TYPE('a) (Suc n)\<close> \<open>possible_bit TYPE('a) n\<close>
       by (simp_all add: possible_bit_less_imp)
     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>possible_bit TYPE('a) (Suc n)\<close> by simp (simp_all flip: bit_Suc add: bit_double_iff possible_bit_def)
     also have \<open>\<dots> \<longleftrightarrow> bit (a div 2) n \<or> bit (b div 2) n\<close>
       using bit \<open>possible_bit TYPE('a) n\<close> by (rule Suc.IH)
     finally show ?case
       by (simp add: bit_Suc)
   qed
 qed
 
 end
 
 lemma nat_bit_induct [case_names zero even odd]:
   \<open>P n\<close> if zero: \<open>P 0\<close>
     and even: \<open>\<And>n. P n \<Longrightarrow> n > 0 \<Longrightarrow> P (2 * n)\<close>
     and odd: \<open>\<And>n. P n \<Longrightarrow> P (Suc (2 * n))\<close>
 proof (induction n rule: less_induct)
   case (less n)
   show \<open>P n\<close>
   proof (cases \<open>n = 0\<close>)
     case True with zero show ?thesis by simp
   next
     case False
     with less have hyp: \<open>P (n div 2)\<close> by simp
     show ?thesis
     proof (cases \<open>even n\<close>)
       case True
       then have \<open>n \<noteq> 1\<close>
         by auto
       with \<open>n \<noteq> 0\<close> have \<open>n div 2 > 0\<close>
         by simp
       with \<open>even n\<close> hyp even [of \<open>n div 2\<close>] show ?thesis
         by simp
     next
       case False
       with hyp odd [of \<open>n div 2\<close>] 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>even (((2 :: nat) ^ m - 1) div 2 ^ n) \<longleftrightarrow> m \<le> n\<close> for m n :: nat
     using even_decr_exp_div_exp_iff' [of m n] .
   show \<open>even (q mod 2 ^ m div 2 ^ n) \<longleftrightarrow> m \<le> n \<or> even (q div 2 ^ n)\<close> for q m n :: nat
   proof (cases \<open>m \<le> n\<close>)
     case True
     moreover define r where \<open>r = n - m\<close>
     ultimately have \<open>n = m + r\<close>
       by simp
     with True show ?thesis
       by (simp add: power_add div_mult2_eq)
   next
     case False
     moreover define r where \<open>r = m - Suc n\<close>
     ultimately have \<open>m = n + Suc r\<close>
       by simp
     moreover have \<open>even (q mod 2 ^ (n + Suc r) div 2 ^ n) \<longleftrightarrow> even (q div 2 ^ n)\<close>
       by (simp only: power_add) (simp add: mod_mult2_eq dvd_mod_iff)
     ultimately show ?thesis
       by simp
   qed
 qed (auto simp add: div_mult2_eq bit_nat_def)
 
 end
 
 lemma possible_bit_nat [simp]:
   \<open>possible_bit TYPE(nat) n\<close>
   by (simp add: possible_bit_def)
 
 lemma bit_Suc_0_iff [bit_simps]:
   \<open>bit (Suc 0) n \<longleftrightarrow> n = 0\<close>
   using bit_1_iff [of n, where ?'a = nat] by simp
 
 lemma not_bit_Suc_0_Suc [simp]:
   \<open>\<not> bit (Suc 0) (Suc n)\<close>
   by (simp add: bit_Suc)
 
 lemma not_bit_Suc_0_numeral [simp]:
   \<open>\<not> bit (Suc 0) (numeral n)\<close>
   by (simp add: numeral_eq_Suc)
 
 context semiring_bits
 begin
 
 lemma bit_of_nat_iff [bit_simps]:
   \<open>bit (of_nat m) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> bit m n\<close>
 proof (cases \<open>possible_bit TYPE('a) n\<close>)
   case False
   then show ?thesis
     by (simp add: impossible_bit)
 next
   case True
   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 Bit_Operations.bit_double_iff possible_bit_def bit_0 dest: mult_not_zero)
   next
     case (odd m)
     then show ?case
       by (cases n)
         (auto simp add: bit_double_iff even_bit_succ_iff possible_bit_def
           Bit_Operations.bit_Suc Bit_Operations.bit_0 dest: mult_not_zero)
   qed
   with True show ?thesis
     by simp
 qed
 
 end
 
 lemma int_bit_induct [case_names zero minus even odd]:
   \<open>P k\<close> if zero_int: \<open>P 0\<close>
     and minus_int: \<open>P (- 1)\<close>
     and even_int: \<open>\<And>k. P k \<Longrightarrow> k \<noteq> 0 \<Longrightarrow> P (k * 2)\<close>
     and odd_int: \<open>\<And>k. P k \<Longrightarrow> k \<noteq> - 1 \<Longrightarrow> P (1 + (k * 2))\<close> for k :: int
 proof (cases \<open>k \<ge> 0\<close>)
   case True
   define n where \<open>n = nat k\<close>
   with True have \<open>k = int n\<close>
     by simp
   then show \<open>P k\<close>
   proof (induction n arbitrary: k rule: nat_bit_induct)
     case zero
     then show ?case
       by (simp add: zero_int)
   next
     case (even n)
     have \<open>P (int n * 2)\<close>
       by (rule even_int) (use even in simp_all)
     with even show ?case
       by (simp add: ac_simps)
   next
     case (odd n)
     have \<open>P (1 + (int n * 2))\<close>
       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 \<open>n = nat (- k - 1)\<close>
   with False have \<open>k = - int n - 1\<close>
     by simp
   then show \<open>P k\<close>
   proof (induction n arbitrary: k rule: nat_bit_induct)
     case zero
     then show ?case
       by (simp add: minus_int)
   next
     case (even n)
     have \<open>P (1 + (- int (Suc n) * 2))\<close>
       by (rule odd_int) (use even in \<open>simp_all add: algebra_simps\<close>)
     also have \<open>\<dots> = - int (2 * n) - 1\<close>
       by (simp add: algebra_simps)
     finally show ?case
       using even.prems by simp
   next
     case (odd n)
     have \<open>P (- int (Suc n) * 2)\<close>
       by (rule even_int) (use odd in \<open>simp_all add: algebra_simps\<close>)
     also have \<open>\<dots> = - int (Suc (2 * n)) - 1\<close>
       by (simp add: algebra_simps)
     finally show ?case
       using odd.prems by simp
   qed
 qed
 
 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>even (((2 :: int) ^ m - 1) div 2 ^ n) \<longleftrightarrow> m \<le> n\<close> for m n :: nat
     using even_decr_exp_div_exp_iff' [of m n] .
   show \<open>even (k mod 2 ^ m div 2 ^ n) \<longleftrightarrow> m \<le> n \<or> even (k div 2 ^ n)\<close> for k :: int and m n :: nat
   proof (cases \<open>m \<le> n\<close>)
     case True
     moreover define r where \<open>r = n - m\<close>
     ultimately have \<open>n = m + r\<close>
       by simp
     with True show ?thesis
       by (simp add: power_add zdiv_zmult2_eq)
   next
     case False
     moreover define r where \<open>r = m - Suc n\<close>
     ultimately have \<open>m = n + Suc r\<close>
       by simp
     moreover have \<open>even (k mod 2 ^ (n + Suc r) div 2 ^ n) \<longleftrightarrow> even (k div 2 ^ n)\<close>
       by (simp only: power_add) (simp add: zmod_zmult2_eq dvd_mod_iff)
     ultimately show ?thesis
       by simp
   qed
 qed (auto simp add: zdiv_zmult2_eq bit_int_def)
 
 end
 
 lemma possible_bit_int [simp]:
   \<open>possible_bit TYPE(int) n\<close>
   by (simp add: possible_bit_def)
 
 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
 
 
 subsection \<open>Bit operations\<close>
 
 class semiring_bit_operations = semiring_bits +
   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>
     and set_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
     and unset_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
     and flip_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
     and push_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
     and drop_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
     and take_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>
   assumes and_rec: \<open>a AND b = of_bool (odd a \<and> odd b) + 2 * ((a div 2) AND (b div 2))\<close>
     and or_rec: \<open>a OR b = of_bool (odd a \<or> odd b) + 2 * ((a div 2) OR (b div 2))\<close>
     and xor_rec: \<open>a XOR b = of_bool (odd a \<noteq> odd b) + 2 * ((a div 2) XOR (b div 2))\<close>
     and mask_eq_exp_minus_1: \<open>mask n = 2 ^ n - 1\<close>
     and set_bit_eq_or: \<open>set_bit n a = a OR push_bit n 1\<close>
     and unset_bit_eq_or_xor: \<open>unset_bit n a = (a OR push_bit n 1) XOR push_bit n 1\<close>
     and flip_bit_eq_xor: \<open>flip_bit n a = a XOR push_bit n 1\<close>
     and push_bit_eq_mult: \<open>push_bit n a = a * 2 ^ n\<close>
     and drop_bit_eq_div: \<open>drop_bit n a = a div 2 ^ n\<close>
     and take_bit_eq_mod: \<open>take_bit n a = a mod 2 ^ n\<close>
 begin
 
 text \<open>
   We want the bitwise operations to bind slightly weaker
   than \<open>+\<close> and \<open>-\<close>.
 
   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.
 
   For the sake of code generation operations
   are specified as definitional class operations,
   taking 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 bit_and_iff [bit_simps]:
   \<open>bit (a AND b) n \<longleftrightarrow> bit a n \<and> bit b n\<close>
 proof (induction n arbitrary: a b)
   case 0
   show ?case
     by (simp add: bit_0 and_rec [of a b] even_bit_succ_iff)
 next
   case (Suc n)
   from Suc [of \<open>a div 2\<close> \<open>b div 2\<close>]
   show ?case
     by (simp add: and_rec [of a b] bit_Suc)
       (auto simp flip: bit_Suc simp add: bit_double_iff dest: bit_imp_possible_bit)
 qed
 
 lemma bit_or_iff [bit_simps]:
   \<open>bit (a OR b) n \<longleftrightarrow> bit a n \<or> bit b n\<close>
 proof (induction n arbitrary: a b)
   case 0
   show ?case
     by (simp add: bit_0 or_rec [of a b] even_bit_succ_iff)
 next
   case (Suc n)
   from Suc [of \<open>a div 2\<close> \<open>b div 2\<close>]
   show ?case
     by (simp add: or_rec [of a b] bit_Suc)
       (auto simp flip: bit_Suc simp add: bit_double_iff dest: bit_imp_possible_bit)
 qed
 
 lemma bit_xor_iff [bit_simps]:
   \<open>bit (a XOR b) n \<longleftrightarrow> bit a n \<noteq> bit b n\<close>
 proof (induction n arbitrary: a b)
   case 0
   show ?case
     by (simp add: bit_0 xor_rec [of a b] even_bit_succ_iff)
 next
   case (Suc n)
   from Suc [of \<open>a div 2\<close> \<open>b div 2\<close>]
   show ?case
     by (simp add: xor_rec [of a b] bit_Suc)
       (auto simp flip: bit_Suc simp add: bit_double_iff dest: bit_imp_possible_bit)
 qed
 
 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 simp add: bit_0)
 
 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 simp add: bit_0)
 
 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 simp add: bit_0)
 
 lemma zero_and_eq [simp]:
   \<open>0 AND a = 0\<close>
   by (simp add: bit_eq_iff bit_and_iff)
 
 lemma and_zero_eq [simp]:
   \<open>a AND 0 = 0\<close>
   by (simp add: bit_eq_iff bit_and_iff)
 
 lemma one_and_eq:
   \<open>1 AND a = a mod 2\<close>
   by (simp add: bit_eq_iff bit_and_iff) (auto simp add: bit_1_iff bit_0)
 
 lemma and_one_eq:
   \<open>a AND 1 = a mod 2\<close>
   using one_and_eq [of a] by (simp add: ac_simps)
 
 lemma one_or_eq:
   \<open>1 OR a = a + of_bool (even a)\<close>
   by (simp add: bit_eq_iff bit_or_iff add.commute [of _ 1] even_bit_succ_iff)
     (auto simp add: bit_1_iff bit_0)
 
 lemma or_one_eq:
   \<open>a OR 1 = a + of_bool (even a)\<close>
   using one_or_eq [of a] by (simp add: ac_simps)
 
 lemma one_xor_eq:
   \<open>1 XOR a = a + of_bool (even a) - of_bool (odd a)\<close>
   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 bit_0 elim: oddE)
 
 lemma xor_one_eq:
   \<open>a XOR 1 = a + of_bool (even a) - of_bool (odd a)\<close>
   using one_xor_eq [of a] by (simp add: ac_simps)
 
 lemma xor_self_eq [simp]:
   \<open>a XOR a = 0\<close>
   by (rule bit_eqI) (simp add: bit_simps)
 
 lemma bit_mask_iff [bit_simps]:
   \<open>bit (mask m) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> n < m\<close>
   apply (cases \<open>possible_bit TYPE('a) n\<close>)
    apply (simp add: bit_iff_odd mask_eq_exp_minus_1 possible_bit_def even_decr_exp_div_exp_iff not_le)
   apply (simp add: impossible_bit)
   done
 
 lemma even_mask_iff:
   \<open>even (mask n) \<longleftrightarrow> n = 0\<close>
   using bit_mask_iff [of n 0] by (auto simp add: bit_0)
 
 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 (auto simp add: bit_eq_iff bit_simps)
 
 lemma mask_Suc_double:
   \<open>mask (Suc n) = 1 OR 2 * mask n\<close>
   by (auto simp add: bit_eq_iff bit_simps elim: possible_bit_less_imp)
 
 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 push_bit_0_id [simp]:
   \<open>push_bit 0 = id\<close>
   by (simp add: fun_eq_iff push_bit_eq_mult)
 
 lemma push_bit_Suc [simp]:
   \<open>push_bit (Suc n) a = push_bit n (a * 2)\<close>
   by (simp add: push_bit_eq_mult ac_simps)
 
 lemma push_bit_double:
   \<open>push_bit n (a * 2) = push_bit n a * 2\<close>
   by (simp add: push_bit_eq_mult ac_simps)
 
 lemma bit_push_bit_iff [bit_simps]:
   \<open>bit (push_bit m a) n \<longleftrightarrow> m \<le> n \<and> possible_bit TYPE('a) n \<and> bit a (n - m)\<close>
 proof (induction n arbitrary: m)
   case 0
   then show ?case
     by (auto simp add: bit_0 push_bit_eq_mult)
 next
   case (Suc n)
   show ?case
   proof (cases m)
     case 0
     then show ?thesis
       by (auto simp add: bit_imp_possible_bit)
   next
     case (Suc m)
     with Suc.prems Suc.IH [of m] show ?thesis
       apply (simp add: push_bit_double)
       apply (simp add: bit_simps mult.commute [of _ 2])
       apply (auto simp add: possible_bit_less_imp)
       done
   qed
 qed
 
 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:
   \<open>push_bit n (drop_bit n a) + take_bit n a = a\<close>
   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]:
   \<open>push_bit m (push_bit n a) = push_bit (m + n) a\<close>
   by (simp add: push_bit_eq_mult power_add ac_simps)
 
 lemma push_bit_of_0 [simp]:
   \<open>push_bit n 0 = 0\<close>
   by (simp add: push_bit_eq_mult)
 
 lemma push_bit_of_1 [simp]:
   \<open>push_bit n 1 = 2 ^ n\<close>
   by (simp add: push_bit_eq_mult)
 
 lemma push_bit_add:
   \<open>push_bit n (a + b) = push_bit n a + push_bit n b\<close>
   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 bit_take_bit_iff [bit_simps]:
   \<open>bit (take_bit m a) n \<longleftrightarrow> n < m \<and> bit a n\<close>
   by (simp add: take_bit_eq_mod bit_iff_odd even_mod_exp_diff_exp_iff not_le)
 
 lemma take_bit_Suc:
   \<open>take_bit (Suc n) a = take_bit n (a div 2) * 2 + a mod 2\<close> (is \<open>?lhs = ?rhs\<close>)
 proof (rule bit_eqI)
   fix m
   assume \<open>possible_bit TYPE('a) m\<close>
   then show \<open>bit ?lhs m \<longleftrightarrow> bit ?rhs m\<close>
     apply (cases a rule: parity_cases; cases m)
        apply (simp_all add: bit_simps even_bit_succ_iff mult.commute [of _ 2] add.commute [of _ 1] flip: bit_Suc)
      apply (simp_all add: bit_0)
     done
 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]:
   \<open>take_bit n 0 = 0\<close>
   by (rule bit_eqI) (simp add: bit_simps)
 
 lemma take_bit_of_1 [simp]:
   \<open>take_bit n 1 = of_bool (n > 0)\<close>
   by (cases n) (simp_all add: take_bit_Suc)
 
 lemma bit_drop_bit_eq [bit_simps]:
   \<open>bit (drop_bit n a) = bit a \<circ> (+) n\<close>
   by rule (simp add: drop_bit_eq_div bit_iff_odd div_exp_eq)
 
 lemma drop_bit_of_0 [simp]:
   \<open>drop_bit n 0 = 0\<close>
   by (rule bit_eqI) (simp add: bit_simps)
 
 lemma drop_bit_of_1 [simp]:
   \<open>drop_bit n 1 = of_bool (n = 0)\<close>
   by (rule bit_eqI) (simp add: bit_simps ac_simps)
 
 lemma drop_bit_0 [simp]:
   \<open>drop_bit 0 = id\<close>
   by (simp add: fun_eq_iff drop_bit_eq_div)
 
 lemma drop_bit_Suc:
   \<open>drop_bit (Suc n) a = drop_bit n (a div 2)\<close>
   using div_exp_eq [of a 1] by (simp add: drop_bit_eq_div)
 
 lemma drop_bit_rec:
   \<open>drop_bit n a = (if n = 0 then a else drop_bit (n - 1) (a div 2))\<close>
   by (cases n) (simp_all add: drop_bit_Suc)
 
 lemma drop_bit_half:
   \<open>drop_bit n (a div 2) = drop_bit n a div 2\<close>
   by (induction n arbitrary: a) (simp_all add: drop_bit_Suc)
 
 lemma drop_bit_of_bool [simp]:
   \<open>drop_bit n (of_bool b) = of_bool (n = 0 \<and> b)\<close>
   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]:
   \<open>take_bit m (take_bit n a) = take_bit (min m n) a\<close>
   by (rule bit_eqI) (simp add: bit_simps)
 
 lemma drop_bit_drop_bit [simp]:
   \<open>drop_bit m (drop_bit n a) = drop_bit (m + n) a\<close>
   by (simp add: drop_bit_eq_div power_add div_exp_eq ac_simps)
 
 lemma push_bit_take_bit:
   \<open>push_bit m (take_bit n a) = take_bit (m + n) (push_bit m a)\<close>
   by (rule bit_eqI) (auto simp add: bit_simps)
 
 lemma take_bit_push_bit:
   \<open>take_bit m (push_bit n a) = push_bit n (take_bit (m - n) a)\<close>
   by (rule bit_eqI) (auto simp add: bit_simps)
 
 lemma take_bit_drop_bit:
   \<open>take_bit m (drop_bit n a) = drop_bit n (take_bit (m + n) a)\<close>
   by (rule bit_eqI) (auto simp add: bit_simps)
 
 lemma drop_bit_take_bit:
   \<open>drop_bit m (take_bit n a) = take_bit (n - m) (drop_bit m a)\<close>
   by (rule bit_eqI) (auto simp add: bit_simps)
 
 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 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 mask n)\<close>
     if \<open>a div 2 = a\<close>
   by (rule bit_eqI) (use that in \<open>simp add: bit_simps stable_imp_bit_iff_odd\<close>)
 
 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
 
 lemma take_bit_eq_self_iff_drop_bit_eq_0:
   \<open>take_bit n a = a \<longleftrightarrow> drop_bit n a = 0\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof
   assume ?P
   show ?Q
   proof (rule bit_eqI)
     fix m
     from \<open>?P\<close> have \<open>a = take_bit n a\<close> ..
     also have \<open>\<not> bit (take_bit n a) (n + m)\<close>
       unfolding bit_simps
       by (simp add: bit_simps)
     finally show \<open>bit (drop_bit n a) m \<longleftrightarrow> bit 0 m\<close>
       by (simp add: bit_simps)
   qed
 next
   assume ?Q
   show ?P
   proof (rule bit_eqI)
     fix m
     from \<open>?Q\<close> have \<open>\<not> bit (drop_bit n a) (m - n)\<close>
       by simp
     then have \<open> \<not> bit a (n + (m - n))\<close>
       by (simp add: bit_simps)
     then show \<open>bit (take_bit n a) m \<longleftrightarrow> bit a m\<close>
       by (cases \<open>m < n\<close>) (auto simp add: bit_simps)
   qed
 qed
 
 lemma drop_bit_exp_eq:
   \<open>drop_bit m (2 ^ n) = of_bool (m \<le> n \<and> possible_bit TYPE('a) n) * 2 ^ (n - m)\<close>
   by (auto simp add: bit_eq_iff bit_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_simps)
 
 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_simps)
 
 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_simps)
 
 lemma push_bit_and [simp]:
   \<open>push_bit n (a AND b) = push_bit n a AND push_bit n b\<close>
   by (auto simp add: bit_eq_iff bit_simps)
 
 lemma push_bit_or [simp]:
   \<open>push_bit n (a OR b) = push_bit n a OR push_bit n b\<close>
   by (auto simp add: bit_eq_iff bit_simps)
 
 lemma push_bit_xor [simp]:
   \<open>push_bit n (a XOR b) = push_bit n a XOR push_bit n b\<close>
   by (auto simp add: bit_eq_iff bit_simps)
 
 lemma drop_bit_and [simp]:
   \<open>drop_bit n (a AND b) = drop_bit n a AND drop_bit n b\<close>
   by (auto simp add: bit_eq_iff bit_simps)
 
 lemma drop_bit_or [simp]:
   \<open>drop_bit n (a OR b) = drop_bit n a OR drop_bit n b\<close>
   by (auto simp add: bit_eq_iff bit_simps)
 
 lemma drop_bit_xor [simp]:
   \<open>drop_bit n (a XOR b) = drop_bit n a XOR drop_bit n b\<close>
   by (auto simp add: bit_eq_iff bit_simps)
 
 lemma take_bit_of_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 (auto simp add: bit_eq_iff bit_simps)
 
 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>
   by (cases \<open>possible_bit TYPE('a) n\<close>) (simp_all add: bit_eq_iff bit_simps impossible_bit)
 
 lemma bit_set_bit_iff [bit_simps]:
   \<open>bit (set_bit m a) n \<longleftrightarrow> bit a n \<or> (m = n \<and> possible_bit TYPE('a) n)\<close>
   by (auto simp add: set_bit_eq_or 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 simp add: bit_0)
 
 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_eq_or_xor bit_simps dest: bit_imp_possible_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 simp add: bit_0)
 
 lemma bit_flip_bit_iff [bit_simps]:
   \<open>bit (flip_bit m a) n \<longleftrightarrow> (m = n \<longleftrightarrow> \<not> bit a n) \<and> possible_bit TYPE('a) n\<close>
   by (auto simp add: bit_eq_iff bit_simps flip_bit_eq_xor bit_imp_possible_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 simp: possible_bit_def  bit_0)
 
 lemma and_exp_eq_0_iff_not_bit:
   \<open>a AND 2 ^ n = 0 \<longleftrightarrow> \<not> bit a n\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
   using bit_imp_possible_bit[of a n]
   by (auto simp add: bit_eq_iff bit_simps)
 
 lemma bit_sum_mult_2_cases:
   assumes a: \<open>\<forall>j. \<not> bit a (Suc j)\<close>
   shows \<open>bit (a + 2 * b) n = (if n = 0 then odd a else bit (2 * b) n)\<close>
 proof -
   from a have \<open>n = 0\<close> if \<open>bit a n\<close> for n using that
     by (cases n) simp_all
   then have \<open>a = 0 \<or> a = 1\<close>
     by (auto simp add: bit_eq_iff bit_1_iff)
   then show ?thesis
     by (cases n) (auto simp add: bit_0 bit_double_iff even_bit_succ_iff)
 qed
 
 lemma set_bit_0 [simp]:
   \<open>set_bit 0 a = 1 + 2 * (a div 2)\<close>
   by (auto simp add: bit_eq_iff bit_simps even_bit_succ_iff simp flip: bit_Suc)
 
 lemma set_bit_Suc:
   \<open>set_bit (Suc n) a = a mod 2 + 2 * set_bit n (a div 2)\<close>
   by (auto simp add: bit_eq_iff bit_sum_mult_2_cases bit_simps bit_0 simp flip: bit_Suc
     elim: possible_bit_less_imp)
 
 lemma unset_bit_0 [simp]:
   \<open>unset_bit 0 a = 2 * (a div 2)\<close>
   by (auto simp add: bit_eq_iff bit_simps simp flip: bit_Suc)
 
 lemma unset_bit_Suc:
   \<open>unset_bit (Suc n) a = a mod 2 + 2 * unset_bit n (a div 2)\<close>
   by (auto simp add: bit_eq_iff bit_sum_mult_2_cases bit_simps bit_0 simp flip: bit_Suc)
 
 lemma flip_bit_0 [simp]:
   \<open>flip_bit 0 a = of_bool (even a) + 2 * (a div 2)\<close>
   by (auto simp add: bit_eq_iff bit_simps even_bit_succ_iff bit_0 simp flip: bit_Suc)
 
 lemma flip_bit_Suc:
   \<open>flip_bit (Suc n) a = a mod 2 + 2 * flip_bit n (a div 2)\<close>
   by (auto simp add: bit_eq_iff bit_sum_mult_2_cases bit_simps bit_0 simp flip: bit_Suc
     elim: possible_bit_less_imp)
 
 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)
 
 lemma bit_1_0 [simp]:
   \<open>bit 1 0\<close>
   by (simp add: bit_0)
 
 lemma not_bit_1_Suc [simp]:
   \<open>\<not> bit 1 (Suc n)\<close>
   by (simp add: bit_Suc)
 
 lemma push_bit_Suc_numeral [simp]:
   \<open>push_bit (Suc n) (numeral k) = push_bit n (numeral (Num.Bit0 k))\<close>
   by (simp add: numeral_eq_Suc mult_2_right) (simp add: numeral_Bit0)
 
 lemma mask_eq_0_iff [simp]:
   \<open>mask n = 0 \<longleftrightarrow> n = 0\<close>
   by (cases n) (simp_all add: mask_Suc_double or_eq_0_iff)
 
 lemma bit_horner_sum_bit_iff [bit_simps]:
   \<open>bit (horner_sum of_bool 2 bs) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> 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 add: bit_0)
   next
     case (Suc m)
     with bit_rec [of _ n] Cons.prems Cons.IH [of m]
     show ?thesis
       by (simp add: bit_simps)
         (auto simp add: possible_bit_less_imp bit_simps simp flip: bit_Suc)
   qed
 qed
 
 lemma horner_sum_bit_eq_take_bit:
   \<open>horner_sum of_bool 2 (map (bit a) [0..<n]) = take_bit n a\<close>
   by (rule bit_eqI) (auto simp add: bit_simps)
 
 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)
 
 lemma take_bit_sum:
   \<open>take_bit n a = (\<Sum>k = 0..<n. push_bit k (of_bool (bit a k)))\<close>
   by (simp flip: horner_sum_bit_eq_take_bit add: horner_sum_eq_sum push_bit_eq_mult)
 
 lemma set_bit_eq:
   \<open>set_bit n a = a + of_bool (\<not> bit a n) * 2 ^ n\<close>
 proof -
   have \<open>set_bit n a = a OR of_bool (\<not> bit a n) * 2 ^ n\<close>
     by (rule bit_eqI) (auto simp add: bit_simps)
   then show ?thesis
     by (subst disjunctive_add) (auto simp add: bit_simps)
 qed
 
 end
 
 class ring_bit_operations = semiring_bit_operations + ring_parity +
   fixes not :: \<open>'a \<Rightarrow> 'a\<close>  (\<open>NOT\<close>)
   assumes not_eq_complement: \<open>NOT a = - 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 minus_eq_not_plus_1:
   \<open>- a = NOT a + 1\<close>
   using not_eq_complement [of a] by simp
 
 lemma minus_eq_not_minus_1:
   \<open>- a = NOT (a - 1)\<close>
   using not_eq_complement [of \<open>a - 1\<close>] by simp (simp add: algebra_simps)
 
 lemma not_rec:
   \<open>NOT a = of_bool (even a) + 2 * NOT (a div 2)\<close>
   by (simp add: not_eq_complement algebra_simps mod_2_eq_odd flip: minus_mod_eq_mult_div)
 
 lemma even_not_iff [simp]:
   \<open>even (NOT a) \<longleftrightarrow> odd a\<close>
   by (simp add: not_eq_complement)
 
 lemma bit_not_iff [bit_simps]:
   \<open>bit (NOT a) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> \<not> bit a n\<close>
 proof (cases \<open>possible_bit TYPE('a) n\<close>)
   case False
   then show ?thesis
     by (auto dest: bit_imp_possible_bit)
 next
   case True
   moreover have \<open>bit (NOT a) n \<longleftrightarrow> \<not> bit a n\<close>
   using \<open>possible_bit TYPE('a) n\<close> proof (induction n arbitrary: a)
     case 0
     then show ?case
       by (simp add: bit_0)
   next
     case (Suc n)
     from Suc.prems Suc.IH [of \<open>a div 2\<close>]
     show ?case
       by (simp add: impossible_bit possible_bit_less_imp not_rec [of a] even_bit_succ_iff bit_double_iff flip: bit_Suc)
   qed
   ultimately show ?thesis
     by simp
 qed
 
 lemma bit_not_exp_iff [bit_simps]:
   \<open>bit (NOT (2 ^ m)) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> n \<noteq> m\<close>
   by (auto simp add: bit_not_iff bit_exp_iff)
 
 lemma bit_minus_iff [bit_simps]:
   \<open>bit (- a) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> \<not> bit (a - 1) n\<close>
   by (simp add: minus_eq_not_minus_1 bit_not_iff)
 
 lemma bit_minus_1_iff [simp]:
   \<open>bit (- 1) n \<longleftrightarrow> possible_bit TYPE('a) n\<close>
   by (simp add: bit_minus_iff)
 
 lemma bit_minus_exp_iff [bit_simps]:
   \<open>bit (- (2 ^ m)) n \<longleftrightarrow> possible_bit TYPE('a) n \<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> possible_bit TYPE('a) n \<and> n > 0\<close>
   by (simp add: bit_minus_iff bit_1_iff)
 
 lemma bit_not_iff_eq:
   \<open>bit (NOT a) n \<longleftrightarrow> 2 ^ n \<noteq> 0 \<and> \<not> bit a n\<close>
   by (simp add: bit_simps possible_bit_def)
 
 lemma not_one_eq [simp]:
   \<open>NOT 1 = - 2\<close>
   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: abstract_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)
 
 sublocale bit: abstract_boolean_algebra_sym_diff \<open>(AND)\<close> \<open>(OR)\<close> NOT 0 \<open>- 1\<close> \<open>(XOR)\<close>
   apply standard
   apply (rule bit_eqI)
   apply (auto simp add: bit_simps)
   done
 
 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 and_eq_minus_1_iff:
   \<open>a AND b = - 1 \<longleftrightarrow> a = - 1 \<and> b = - 1\<close>
   by (auto simp: bit_eq_iff bit_simps)
 
 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:
   \<open>take_bit n (NOT a) = take_bit n (NOT b) \<longleftrightarrow> take_bit n a = take_bit n b\<close>
   by (auto simp add: bit_eq_iff bit_simps)
 
 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 bit_imp_possible_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 [simp]:
   \<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 [simp]:
   \<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 unset_bit_eq_and_not:
   \<open>unset_bit n a = a AND NOT (push_bit n 1)\<close>
   by (rule bit_eqI) (auto simp add: bit_simps)
 
 lemma push_bit_Suc_minus_numeral [simp]:
   \<open>push_bit (Suc n) (- numeral k) = push_bit n (- numeral (Num.Bit0 k))\<close>
   apply (simp only: numeral_Bit0)
   apply simp
   apply (simp only: numeral_mult mult_2_right numeral_add)
   done
 
 lemma push_bit_minus_numeral [simp]:
   \<open>push_bit (numeral l) (- numeral k) = push_bit (pred_numeral l) (- numeral (Num.Bit0 k))\<close>
   by (simp only: numeral_eq_Suc push_bit_Suc_minus_numeral)
 
 lemma take_bit_Suc_minus_1_eq:
   \<open>take_bit (Suc n) (- 1) = 2 ^ Suc n - 1\<close>
   by (simp add: mask_eq_exp_minus_1)
 
 lemma take_bit_numeral_minus_1_eq:
   \<open>take_bit (numeral k) (- 1) = 2 ^ numeral k - 1\<close>
   by (simp add: mask_eq_exp_minus_1)
 
 lemma push_bit_mask_eq:
   \<open>push_bit m (mask n) = mask (n + m) AND NOT (mask m)\<close>
   by (rule bit_eqI) (auto simp add: bit_simps not_less possible_bit_less_imp)
 
 lemma slice_eq_mask:
   \<open>push_bit n (take_bit m (drop_bit n a)) = a AND mask (m + n) AND NOT (mask n)\<close>
   by (rule bit_eqI) (auto simp add: bit_simps)
 
 lemma push_bit_numeral_minus_1 [simp]:
   \<open>push_bit (numeral n) (- 1) = - (2 ^ numeral n)\<close>
   by (simp add: push_bit_eq_mult)
 
 lemma unset_bit_eq:
   \<open>unset_bit n a = a - of_bool (bit a n) * 2 ^ n\<close>
 proof -
   have \<open>unset_bit n a = a AND NOT (of_bool (bit a n) * 2 ^ n)\<close>
     by (rule bit_eqI) (auto simp add: bit_simps)
   then show ?thesis
     by (subst disjunctive_diff) (auto simp add: bit_simps simp flip: push_bit_eq_mult)
 qed
 
 end
 
 
 subsection \<open>Common algebraic structure\<close>
 
 class linordered_euclidean_semiring_bit_operations =
   linordered_euclidean_semiring + semiring_bit_operations
 begin
 
 lemma possible_bit [simp]:
   \<open>possible_bit TYPE('a) n\<close>
   by (simp add: possible_bit_def)
 
 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 push_bit_eq_0_iff [simp]:
   \<open>push_bit n a = 0 \<longleftrightarrow> a = 0\<close>
   by (simp add: push_bit_eq_mult)
 
 lemma take_bit_add:
   \<open>take_bit n (take_bit n a + take_bit n b) = take_bit n (a + b)\<close>
   by (simp add: take_bit_eq_mod mod_simps)
 
 lemma take_bit_of_1_eq_0_iff [simp]:
   \<open>take_bit n 1 = 0 \<longleftrightarrow> n = 0\<close>
   by (simp add: take_bit_eq_mod)
 
 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 take_bit_Suc_1 [simp]:
   \<open>take_bit (Suc n) 1 = 1\<close>
   by (simp add: take_bit_Suc)
 
 lemma take_bit_Suc_bit0:
   \<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:
   \<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:
   \<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:
   \<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 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 drop_bit_mask_eq:
   \<open>drop_bit m (mask n) = mask (n - m)\<close>
   by (rule bit_eqI) (auto simp add: bit_simps possible_bit_def)
 
 lemma bit_push_bit_iff':
   \<open>bit (push_bit m a) n \<longleftrightarrow> m \<le> n \<and> bit a (n - m)\<close>
   by (simp add: bit_simps)
 
 lemma mask_half:
   \<open>mask n div 2 = mask (n - 1)\<close>
   by (cases n) (simp_all add: mask_Suc_double one_or_eq)
 
 lemma take_bit_Suc_from_most:
   \<open>take_bit (Suc n) a = 2 ^ n * of_bool (bit a n) + take_bit n a\<close>
   using mod_mult2_eq' [of a \<open>2 ^ n\<close> 2]
   by (simp only: take_bit_eq_mod power_Suc2)
     (simp_all add: bit_iff_odd odd_iff_mod_2_eq_one)
 
 lemma take_bit_nonnegative [simp]:
   \<open>0 \<le> take_bit n a\<close>
   using horner_sum_nonnegative by (simp flip: horner_sum_bit_eq_take_bit)
 
 lemma not_take_bit_negative [simp]:
   \<open>\<not> take_bit n a < 0\<close>
   by (simp add: not_less)
 
 lemma bit_imp_take_bit_positive:
   \<open>0 < take_bit m a\<close> if \<open>n < m\<close> and \<open>bit a n\<close>
 proof (rule ccontr)
   assume \<open>\<not> 0 < take_bit m a\<close>
   then have \<open>take_bit m a = 0\<close>
     by (auto simp add: not_less intro: order_antisym)
   then have \<open>bit (take_bit m a) 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 a * take_bit n b) = take_bit n (a * b)\<close>
   by (simp add: take_bit_eq_mod mod_mult_eq)
 
 lemma drop_bit_push_bit:
   \<open>drop_bit m (push_bit n a) = drop_bit (m - n) (push_bit (n - m) a)\<close>
   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 a] drop_bit_eq_div push_bit_eq_mult not_le power_add Orderings.not_le dest!: le_Suc_ex less_imp_Suc_add)
 
 end
 
 
 subsection \<open>Instance \<^typ>\<open>int\<close>\<close>
 
 locale fold2_bit_int =
   fixes f :: \<open>bool \<Rightarrow> bool \<Rightarrow> bool\<close>
 begin
 
 context
 begin
 
 function F :: \<open>int \<Rightarrow> int \<Rightarrow> int\<close>
   where \<open>F k l = (if k \<in> {0, - 1} \<and> l \<in> {0, - 1}
     then - of_bool (f (odd k) (odd l))
     else of_bool (f (odd k) (odd l)) + 2 * (F (k div 2) (l div 2)))\<close>
   by auto
 
 private termination proof (relation \<open>measure (\<lambda>(k, l). nat (\<bar>k\<bar> + \<bar>l\<bar>))\<close>)
   have less_eq: \<open>\<bar>k div 2\<bar> \<le> \<bar>k\<bar>\<close> for k :: int
     by (cases k) (simp_all add: divide_int_def nat_add_distrib)
   then have less: \<open>\<bar>k div 2\<bar> < \<bar>k\<bar>\<close> if \<open>k \<notin> {0, - 1}\<close> for k :: int
     using that by (auto simp add: less_le [of k])
   show \<open>wf (measure (\<lambda>(k, l). nat (\<bar>k\<bar> + \<bar>l\<bar>)))\<close>
     by simp
   show \<open>((k div 2, l div 2), k, l) \<in> measure (\<lambda>(k, l). nat (\<bar>k\<bar> + \<bar>l\<bar>))\<close>
     if \<open>\<not> (k \<in> {0, - 1} \<and> l \<in> {0, - 1})\<close> for k l
   proof -
     from that have *: \<open>k \<notin> {0, - 1} \<or> l \<notin> {0, - 1}\<close>
       by simp
     then have \<open>0 < \<bar>k\<bar> + \<bar>l\<bar>\<close>
       by auto
     moreover from * have \<open>\<bar>k div 2\<bar> + \<bar>l div 2\<bar> < \<bar>k\<bar> + \<bar>l\<bar>\<close>
     proof
       assume \<open>k \<notin> {0, - 1}\<close>
       then have \<open>\<bar>k div 2\<bar> < \<bar>k\<bar>\<close>
         by (rule less)
       with less_eq [of l] show ?thesis
         by auto
     next
       assume \<open>l \<notin> {0, - 1}\<close>
       then have \<open>\<bar>l div 2\<bar> < \<bar>l\<bar>\<close>
         by (rule less)
       with less_eq [of k] show ?thesis
         by auto
     qed
     ultimately show ?thesis
       by (simp only: in_measure split_def fst_conv snd_conv nat_mono_iff)
   qed
 qed
 
 declare F.simps [simp del]
 
 lemma rec:
   \<open>F k l = of_bool (f (odd k) (odd l)) + 2 * (F (k div 2) (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 add: F.simps [of 0] F.simps [of \<open>- 1\<close>])
 next
   case False
   then show ?thesis
     by (auto simp add: ac_simps F.simps [of k l])
 qed
 
 lemma bit_iff:
   \<open>bit (F k l) n \<longleftrightarrow> f (bit k n) (bit l n)\<close> for k l :: int
 proof (induction n arbitrary: k l)
   case 0
   then show ?case
     by (simp add: rec [of k l] bit_0)
 next
   case (Suc n)
   then show ?case
     by (simp add: rec [of k l] bit_Suc)
 qed
 
 end
 
 end
 
 instantiation int :: ring_bit_operations
 begin
 
 definition not_int :: \<open>int \<Rightarrow> int\<close>
   where \<open>not_int k = - k - 1\<close>
 
 global_interpretation and_int: fold2_bit_int \<open>(\<and>)\<close>
   defines and_int = and_int.F .
 
 global_interpretation or_int: fold2_bit_int \<open>(\<or>)\<close>
   defines or_int = or_int.F .
 
 global_interpretation xor_int: fold2_bit_int \<open>(\<noteq>)\<close>
   defines xor_int = xor_int.F .
 
 definition mask_int :: \<open>nat \<Rightarrow> int\<close>
   where \<open>mask n = (2 :: int) ^ n - 1\<close>
 
 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>
 
 definition set_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close>
   where \<open>set_bit n k = k OR push_bit n 1\<close> for k :: int
 
 definition unset_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close>
   where \<open>unset_bit n k = k AND NOT (push_bit n 1)\<close> for k :: int
 
 definition flip_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close>
   where \<open>flip_bit n k = k XOR push_bit n 1\<close> for k :: int
 
 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:
   \<open>bit (NOT k) n \<longleftrightarrow> \<not> bit k n\<close> for k :: int
 proof (rule sym, induction n arbitrary: k)
   case 0
   then show ?case
     by (simp add: bit_0 not_int_def)
 next
   case (Suc n)
   then show ?case
     by (simp add: bit_Suc not_int_div_2)
 qed
 
 instance proof
   fix k l :: int and m n :: nat
   show \<open>unset_bit n k = (k OR push_bit n 1) XOR push_bit n 1\<close>
     by (rule bit_eqI)
       (auto simp add: unset_bit_int_def
         and_int.bit_iff or_int.bit_iff xor_int.bit_iff bit_not_int_iff push_bit_int_def bit_simps)
 qed (fact and_int.rec or_int.rec xor_int.rec mask_int_def set_bit_int_def flip_bit_int_def
   push_bit_int_def drop_bit_int_def take_bit_int_def not_int_def)+
 
 end
 
 instance int :: linordered_euclidean_semiring_bit_operations ..
 
 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> possible_bit TYPE('a) n \<and> bit k n\<close>
 proof (cases \<open>possible_bit TYPE('a) n\<close>)
   case False
   then show ?thesis
     by (simp add: impossible_bit)
 next
   case True
   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] Bit_Operations.bit_double_iff [of k n]
       by (cases n) (auto simp add: ac_simps possible_bit_def 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 Bit_Operations.bit_0 Bit_Operations.bit_Suc
           possible_bit_def dest: mult_not_zero)
   qed
   with True 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 Bit_Operations.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 Bit_Operations.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 Bit_Operations.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 Bit_Operations.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_not_numeral:
   \<open>of_int (NOT (numeral k)) = NOT (numeral k)\<close>
   by (simp add: local.of_int_not_eq)
 
 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
 
 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_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 mask_nonnegative_int [simp]:
   \<open>mask n \<ge> (0::int)\<close>
   by (simp add: mask_eq_exp_minus_1 add_le_imp_le_diff)
 
 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 zero_le_mult_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 simp add: zero_le_mult_iff not_le)
 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>
   \<open>x OR y < 2 ^ n\<close> if \<open>0 \<le> x\<close> \<open>x < 2 ^ n\<close> \<open>y < 2 ^ n\<close> for x y :: int
 using that 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>
   \<open>x XOR y < 2 ^ n\<close> if \<open>0 \<le> x\<close> \<open>x < 2 ^ n\<close> \<open>y < 2 ^ n\<close> for x y :: int
 using that 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>
   \<open>0 \<le> x AND y\<close> if \<open>0 \<le> x\<close> for x y :: int
   using that by simp
 
 lemma OR_lower [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
   \<open>0 \<le> x OR y\<close> if \<open>0 \<le> x\<close> \<open>0 \<le> y\<close> for x y :: int
   using that by simp
 
 lemma XOR_lower [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
   \<open>0 \<le> x XOR y\<close> if \<open>0 \<le> x\<close> \<open>0 \<le> y\<close> for x y :: int
   using that by simp
 
 lemma AND_upper1 [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
   \<open>x AND y \<le> x\<close> if \<open>0 \<le> x\<close> for x y :: int
 using that 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>])
 
 lemma AND_upper1' [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
   \<open>y AND x \<le> z\<close> if \<open>0 \<le> y\<close> \<open>y \<le> z\<close> for x y z :: int
   using _ \<open>y \<le> z\<close> by (rule order_trans) (use \<open>0 \<le> y\<close> in simp)
 
 lemma AND_upper1'' [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
   \<open>y AND x < z\<close> if \<open>0 \<le> y\<close> \<open>y < z\<close> for x y z :: int
   using _ \<open>y < z\<close> by (rule order_le_less_trans) (use \<open>0 \<le> y\<close> in simp)
 
 lemma AND_upper2 [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
   \<open>x AND y \<le> y\<close> if \<open>0 \<le> y\<close> for x y :: int
   using that AND_upper1 [of y x] by (simp add: ac_simps)
 
 lemma AND_upper2' [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
   \<open>x AND y \<le> z\<close> if \<open>0 \<le> y\<close> \<open>y \<le> z\<close> for x y :: int
   using that AND_upper1' [of y z x] by (simp add: ac_simps)
 
 lemma AND_upper2'' [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>
   \<open>x AND y < z\<close> if \<open>0 \<le> y\<close> \<open>y < z\<close> for x y :: int
   using that AND_upper1'' [of y z x] by (simp add: ac_simps)
 
 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 push_bit_minus_one:
   \<open>push_bit n (- 1 :: int) = - (2 ^ n)\<close>
   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_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 (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 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 power_le_zero_eq)
 
 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) (auto simp 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)
 
 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_eq_or)
 
 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_eq_or)
 
 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_eq_and_not)
 
 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_eq_and_not)
 
 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_eq_xor)
 
 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_eq_xor)
 
 lemma set_bit_greater_eq:
   \<open>set_bit n k \<ge> k\<close> for k :: int
   by (simp add: set_bit_eq_or or_greater_eq)
 
 lemma unset_bit_less_eq:
   \<open>unset_bit n k \<le> k\<close> for k :: int
   by (simp add: unset_bit_eq_and_not and_less_eq)
 
 lemma and_int_unfold:
   \<open>k AND l = (if k = 0 \<or> l = 0 then 0 else if k = - 1 then l else if l = - 1 then k
     else (k mod 2) * (l mod 2) + 2 * ((k div 2) AND (l div 2)))\<close> for k l :: int
   by (auto simp add: and_int.rec [of k l] zmult_eq_1_iff elim: oddE)
 
 lemma or_int_unfold:
   \<open>k OR l = (if k = - 1 \<or> l = - 1 then - 1 else if k = 0 then l else if l = 0 then k
     else max (k mod 2) (l mod 2) + 2 * ((k div 2) OR (l div 2)))\<close> for k l :: int
   by (auto simp add: or_int.rec [of k l] elim: oddE)
 
 lemma xor_int_unfold:
   \<open>k XOR l = (if k = - 1 then NOT l else if l = - 1 then NOT k else if k = 0 then l else if l = 0 then k
     else \<bar>k mod 2 - l mod 2\<bar> + 2 * ((k div 2) XOR (l div 2)))\<close> for k l :: int
   by (auto simp add: xor_int.rec [of k l] not_int_def elim!: oddE)
 
 lemma bit_minus_int_iff:
   \<open>bit (- k) n \<longleftrightarrow> bit (NOT (k - 1)) n\<close> for k :: int
   by (simp add: bit_simps)
 
 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>])
 
 lemma take_bit_tightened_less_eq_int:
   \<open>take_bit m k \<le> take_bit n k\<close> if \<open>m \<le> n\<close> for k :: int
 proof -
   have \<open>take_bit m (take_bit n k) \<le> take_bit n k\<close>
     by (simp only: take_bit_int_less_eq_self_iff take_bit_nonnegative)
   with that show ?thesis
     by simp
 qed
 
 lemma not_exp_less_eq_0_int [simp]:
   \<open>\<not> 2 ^ n \<le> (0::int)\<close>
   by (simp add: power_le_zero_eq)
 
 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>nat k < 2 ^ nat k\<close>
       by simp
     then have \<open>int (nat k) < int (2 ^ nat k)\<close>
       by (simp only: of_nat_less_iff)
     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>nat (- k) < 2 ^ nat (- k)\<close>
       by simp
     then have \<open>int (nat (- k)) < int (2 ^ nat (- k))\<close>
       by (simp only: of_nat_less_iff)
     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
 
 
 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>
 
 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>
 
 definition set_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
   where \<open>set_bit m n = n OR push_bit m 1\<close> for m n :: nat
 
 definition unset_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
   where \<open>unset_bit m n = (n OR push_bit m 1) XOR push_bit m 1\<close> for m n :: nat
 
 definition flip_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>
   where \<open>flip_bit m n = n XOR push_bit m 1\<close> for m n :: nat
 
 instance proof
   fix m n :: nat
   show \<open>m AND n = of_bool (odd m \<and> odd n) + 2 * (m div 2 AND n div 2)\<close>
     by (simp add: and_nat_def and_rec [of \<open>int m\<close> \<open>int n\<close>] nat_add_distrib of_nat_div)
   show \<open>m OR n = of_bool (odd m \<or> odd n) + 2 * (m div 2 OR n div 2)\<close>
     by (simp add: or_nat_def or_rec [of \<open>int m\<close> \<open>int n\<close>] nat_add_distrib of_nat_div)
   show \<open>m XOR n = of_bool (odd m \<noteq> odd n) + 2 * (m div 2 XOR n div 2)\<close>
     by (simp add: xor_nat_def xor_rec [of \<open>int m\<close> \<open>int n\<close>] nat_add_distrib of_nat_div)
 qed (simp_all add: mask_nat_def set_bit_nat_def unset_bit_nat_def flip_bit_nat_def
   push_bit_nat_def drop_bit_nat_def take_bit_nat_def)
 
 end
 
 instance nat :: linordered_euclidean_semiring_bit_operations ..
 
 context semiring_bit_operations
 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 Bit_Operations.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 Bit_Operations.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 Bit_Operations.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 Bit_Operations.bit_take_bit_iff bit_of_nat_iff)
 
 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)
 
 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
 
 context linordered_euclidean_semiring_bit_operations
 begin
 
 lemma drop_bit_of_nat:
   "drop_bit n (of_nat m) = of_nat (drop_bit n m)"
   by (simp add: drop_bit_eq_div Bit_Operations.drop_bit_eq_div of_nat_div [of m "2 ^ n"])
 
 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 Bit_Operations.drop_bit_eq_div of_nat_div)
 
 end
 
 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_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_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
 
 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
 
 lemma and_nat_unfold [code]:
   \<open>m AND n = (if m = 0 \<or> n = 0 then 0 else (m mod 2) * (n mod 2) + 2 * ((m div 2) AND (n div 2)))\<close>
     for m n :: nat
   by (auto simp add: and_rec [of m n] elim: oddE)
 
 lemma or_nat_unfold [code]:
   \<open>m OR n = (if m = 0 then n else if n = 0 then m
     else max (m mod 2) (n mod 2) + 2 * ((m div 2) OR (n div 2)))\<close> for m n :: nat
   by (auto simp add: or_rec [of m n] elim: oddE)
 
 lemma xor_nat_unfold [code]:
   \<open>m XOR n = (if m = 0 then n else if n = 0 then m
     else (m mod 2 + n mod 2) mod 2 + 2 * ((m div 2) XOR (n div 2)))\<close> for m n :: nat
   by (auto simp add: xor_rec [of m n] elim!: oddE)
 
 lemma [code]:
   \<open>unset_bit 0 m = 2 * (m div 2)\<close>
   \<open>unset_bit (Suc n) m = m mod 2 + 2 * unset_bit n (m div 2)\<close> for m n :: nat
   by (simp_all add: unset_bit_Suc)
 
 lemma push_bit_of_Suc_0 [simp]:
   \<open>push_bit n (Suc 0) = 2 ^ n\<close>
   using push_bit_of_1 [where ?'a = nat] by simp
 
 lemma take_bit_of_Suc_0 [simp]:
   \<open>take_bit n (Suc 0) = of_bool (0 < n)\<close>
   using take_bit_of_1 [where ?'a = nat] by simp
 
 lemma drop_bit_of_Suc_0 [simp]:
   \<open>drop_bit n (Suc 0) = of_bool (n = 0)\<close>
   using drop_bit_of_1 [where ?'a = nat] by simp
 
 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
 
 lemma mask_nat_less_exp [simp]:
   \<open>(mask n :: nat) < 2 ^ n\<close>
   by (simp add: mask_eq_exp_minus_1)
 
 lemma mask_nat_positive_iff [simp]:
   \<open>(0::nat) < mask n \<longleftrightarrow> 0 < n\<close>
 proof (cases \<open>n = 0\<close>)
   case True
   then show ?thesis
     by simp
 next
   case False
   then have \<open>0 < n\<close>
     by simp
   then have \<open>(0::nat) < mask n\<close>
     using less_eq_mask [of n] by (rule order_less_le_trans)
   with \<open>0 < n\<close> show ?thesis
     by simp
 qed
 
 lemma take_bit_tightened_less_eq_nat:
   \<open>take_bit m q \<le> take_bit n q\<close> if \<open>m \<le> n\<close> for q :: nat
 proof -
   have \<open>take_bit m (take_bit n q) \<le> take_bit n q\<close>
     by (rule take_bit_nat_less_eq_self)
   with that 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 nat_mask_eq:
   \<open>nat (mask n) = mask n\<close>
   by (simp add: nat_eq_iff of_nat_mask_eq)
 
 
 subsection \<open>Symbolic computations on numeral expressions\<close>
 
 context semiring_bits
 begin
 
 lemma not_bit_numeral_Bit0_0 [simp]:
   \<open>\<not> bit (numeral (Num.Bit0 m)) 0\<close>
   by (simp add: bit_0)
 
 lemma bit_numeral_Bit1_0 [simp]:
   \<open>bit (numeral (Num.Bit1 m)) 0\<close>
   by (simp add: bit_0)
 
 end
 
 context ring_bit_operations
 begin
 
 lemma not_bit_minus_numeral_Bit0_0 [simp]:
   \<open>\<not> bit (- numeral (Num.Bit0 m)) 0\<close>
   by (simp add: bit_0)
 
 lemma bit_minus_numeral_Bit1_0 [simp]:
   \<open>bit (- numeral (Num.Bit1 m)) 0\<close>
   by (simp add: bit_0)
 
 end
 
 context linordered_euclidean_semiring_bit_operations
 begin
 
 lemma bit_numeral_iff:
   \<open>bit (numeral m) n \<longleftrightarrow> bit (numeral m :: nat) n\<close>
   using bit_of_nat_iff_bit [of \<open>numeral m\<close> n] by simp
 
 lemma bit_numeral_Bit0_Suc_iff [simp]:
   \<open>bit (numeral (Num.Bit0 m)) (Suc n) \<longleftrightarrow> bit (numeral m) n\<close>
   by (simp add: bit_Suc numeral_Bit0_div_2)
 
 lemma bit_numeral_Bit1_Suc_iff [simp]:
   \<open>bit (numeral (Num.Bit1 m)) (Suc n) \<longleftrightarrow> bit (numeral m) n\<close>
   by (simp add: bit_Suc numeral_Bit1_div_2)
 
 lemma bit_numeral_rec:
   \<open>bit (numeral (Num.Bit0 w)) n \<longleftrightarrow> (case n of 0 \<Rightarrow> False | Suc m \<Rightarrow> bit (numeral w) m)\<close>
   \<open>bit (numeral (Num.Bit1 w)) n \<longleftrightarrow> (case n of 0 \<Rightarrow> True | Suc m \<Rightarrow> bit (numeral w) m)\<close>
   by (cases n; simp add: bit_0)+
 
 lemma bit_numeral_simps [simp]:
   \<open>\<not> bit 1 (numeral n)\<close>
   \<open>bit (numeral (Num.Bit0 w)) (numeral n) \<longleftrightarrow> bit (numeral w) (pred_numeral n)\<close>
   \<open>bit (numeral (Num.Bit1 w)) (numeral n) \<longleftrightarrow> bit (numeral w) (pred_numeral n)\<close>
   by (simp_all add: bit_1_iff numeral_eq_Suc)
 
 lemma and_numerals [simp]:
   \<open>1 AND numeral (Num.Bit0 y) = 0\<close>
   \<open>1 AND numeral (Num.Bit1 y) = 1\<close>
   \<open>numeral (Num.Bit0 x) AND numeral (Num.Bit0 y) = 2 * (numeral x AND numeral y)\<close>
   \<open>numeral (Num.Bit0 x) AND numeral (Num.Bit1 y) = 2 * (numeral x AND numeral y)\<close>
   \<open>numeral (Num.Bit0 x) AND 1 = 0\<close>
   \<open>numeral (Num.Bit1 x) AND numeral (Num.Bit0 y) = 2 * (numeral x AND numeral y)\<close>
   \<open>numeral (Num.Bit1 x) AND numeral (Num.Bit1 y) = 1 + 2 * (numeral x AND numeral y)\<close>
   \<open>numeral (Num.Bit1 x) AND 1 = 1\<close>
   by (simp_all add: bit_eq_iff) (simp_all add: bit_0 bit_simps bit_Suc bit_numeral_rec split: nat.splits)
 
 lemma or_numerals [simp]:
   \<open>1 OR numeral (Num.Bit0 y) = numeral (Num.Bit1 y)\<close>
   \<open>1 OR numeral (Num.Bit1 y) = numeral (Num.Bit1 y)\<close>
   \<open>numeral (Num.Bit0 x) OR numeral (Num.Bit0 y) = 2 * (numeral x OR numeral y)\<close>
   \<open>numeral (Num.Bit0 x) OR numeral (Num.Bit1 y) = 1 + 2 * (numeral x OR numeral y)\<close>
   \<open>numeral (Num.Bit0 x) OR 1 = numeral (Num.Bit1 x)\<close>
   \<open>numeral (Num.Bit1 x) OR numeral (Num.Bit0 y) = 1 + 2 * (numeral x OR numeral y)\<close>
   \<open>numeral (Num.Bit1 x) OR numeral (Num.Bit1 y) = 1 + 2 * (numeral x OR numeral y)\<close>
   \<open>numeral (Num.Bit1 x) OR 1 = numeral (Num.Bit1 x)\<close>
   by (simp_all add: bit_eq_iff) (simp_all add: bit_0 bit_simps bit_Suc bit_numeral_rec split: nat.splits)
 
 lemma xor_numerals [simp]:
   \<open>1 XOR numeral (Num.Bit0 y) = numeral (Num.Bit1 y)\<close>
   \<open>1 XOR numeral (Num.Bit1 y) = numeral (Num.Bit0 y)\<close>
   \<open>numeral (Num.Bit0 x) XOR numeral (Num.Bit0 y) = 2 * (numeral x XOR numeral y)\<close>
   \<open>numeral (Num.Bit0 x) XOR numeral (Num.Bit1 y) = 1 + 2 * (numeral x XOR numeral y)\<close>
   \<open>numeral (Num.Bit0 x) XOR 1 = numeral (Num.Bit1 x)\<close>
   \<open>numeral (Num.Bit1 x) XOR numeral (Num.Bit0 y) = 1 + 2 * (numeral x XOR numeral y)\<close>
   \<open>numeral (Num.Bit1 x) XOR numeral (Num.Bit1 y) = 2 * (numeral x XOR numeral y)\<close>
   \<open>numeral (Num.Bit1 x) XOR 1 = numeral (Num.Bit0 x)\<close>
   by (simp_all add: bit_eq_iff) (simp_all add: bit_0 bit_simps bit_Suc bit_numeral_rec split: nat.splits)
 
 end
 
 lemma drop_bit_Suc_minus_bit0 [simp]:
   \<open>drop_bit (Suc n) (- numeral (Num.Bit0 k)) = drop_bit n (- numeral k :: int)\<close>
   by (simp add: drop_bit_Suc numeral_Bit0_div_2)
 
 lemma drop_bit_Suc_minus_bit1 [simp]:
   \<open>drop_bit (Suc n) (- numeral (Num.Bit1 k)) = drop_bit n (- numeral (Num.inc k) :: int)\<close>
   by (simp add: drop_bit_Suc numeral_Bit1_div_2 add_One)
 
 lemma drop_bit_numeral_minus_bit0 [simp]:
   \<open>drop_bit (numeral l) (- numeral (Num.Bit0 k)) = drop_bit (pred_numeral l) (- numeral k :: int)\<close>
   by (simp add: numeral_eq_Suc numeral_Bit0_div_2)
 
 lemma drop_bit_numeral_minus_bit1 [simp]:
   \<open>drop_bit (numeral l) (- numeral (Num.Bit1 k)) = drop_bit (pred_numeral l) (- numeral (Num.inc k) :: int)\<close>
   by (simp add: numeral_eq_Suc numeral_Bit1_div_2)
 
 lemma take_bit_Suc_minus_bit0:
   \<open>take_bit (Suc n) (- numeral (Num.Bit0 k)) = take_bit n (- numeral k) * (2 :: int)\<close>
   by (simp add: take_bit_Suc numeral_Bit0_div_2)
 
 lemma take_bit_Suc_minus_bit1:
   \<open>take_bit (Suc n) (- numeral (Num.Bit1 k)) = take_bit n (- numeral (Num.inc k)) * 2 + (1 :: int)\<close>
   by (simp add: take_bit_Suc numeral_Bit1_div_2 add_One)
 
 lemma take_bit_numeral_minus_bit0:
   \<open>take_bit (numeral l) (- numeral (Num.Bit0 k)) = take_bit (pred_numeral l) (- numeral k) * (2 :: int)\<close>
   by (simp add: numeral_eq_Suc numeral_Bit0_div_2 take_bit_Suc_minus_bit0)
 
 lemma take_bit_numeral_minus_bit1:
   \<open>take_bit (numeral l) (- numeral (Num.Bit1 k)) = take_bit (pred_numeral l) (- numeral (Num.inc k)) * 2 + (1 :: int)\<close>
   by (simp add: numeral_eq_Suc numeral_Bit1_div_2 take_bit_Suc_minus_bit1)
 
 lemma and_nat_numerals [simp]:
   \<open>Suc 0 AND numeral (Num.Bit0 y) = 0\<close>
   \<open>Suc 0 AND numeral (Num.Bit1 y) = 1\<close>
   \<open>numeral (Num.Bit0 x) AND Suc 0 = 0\<close>
   \<open>numeral (Num.Bit1 x) AND Suc 0 = 1\<close>
   by (simp_all only: and_numerals flip: One_nat_def)
 
 lemma or_nat_numerals [simp]:
   \<open>Suc 0 OR numeral (Num.Bit0 y) = numeral (Num.Bit1 y)\<close>
   \<open>Suc 0 OR numeral (Num.Bit1 y) = numeral (Num.Bit1 y)\<close>
   \<open>numeral (Num.Bit0 x) OR Suc 0 = numeral (Num.Bit1 x)\<close>
   \<open>numeral (Num.Bit1 x) OR Suc 0 = numeral (Num.Bit1 x)\<close>
   by (simp_all only: or_numerals flip: One_nat_def)
 
 lemma xor_nat_numerals [simp]:
   \<open>Suc 0 XOR numeral (Num.Bit0 y) = numeral (Num.Bit1 y)\<close>
   \<open>Suc 0 XOR numeral (Num.Bit1 y) = numeral (Num.Bit0 y)\<close>
   \<open>numeral (Num.Bit0 x) XOR Suc 0 = numeral (Num.Bit1 x)\<close>
   \<open>numeral (Num.Bit1 x) XOR Suc 0 = numeral (Num.Bit0 x)\<close>
   by (simp_all only: xor_numerals flip: One_nat_def)
 
 context ring_bit_operations
 begin
 
 lemma minus_numeral_inc_eq:
   \<open>- numeral (Num.inc n) = NOT (numeral n)\<close>
   by (simp add: not_eq_complement sub_inc_One_eq add_One)
 
 lemma sub_one_eq_not_neg:
   \<open>Num.sub n num.One = NOT (- numeral n)\<close>
   by (simp add: not_eq_complement)
 
 lemma minus_numeral_eq_not_sub_one:
   \<open>- numeral n = NOT (Num.sub n num.One)\<close>
   by (simp add: not_eq_complement)
 
 lemma not_numeral_eq [simp]:
   \<open>NOT (numeral n) = - numeral (Num.inc n)\<close>
   by (simp add: minus_numeral_inc_eq)
 
 lemma not_minus_numeral_eq [simp]:
   \<open>NOT (- numeral n) = Num.sub n num.One\<close>
   by (simp add: sub_one_eq_not_neg)
 
 lemma minus_not_numeral_eq [simp]:
   \<open>- (NOT (numeral n)) = numeral (Num.inc n)\<close>
   by simp
 
 lemma not_numeral_BitM_eq:
   \<open>NOT (numeral (Num.BitM n)) =  - numeral (num.Bit0 n)\<close>
   by (simp add: inc_BitM_eq)
 
 lemma not_numeral_Bit0_eq:
   \<open>NOT (numeral (Num.Bit0 n)) =  - numeral (num.Bit1 n)\<close>
   by simp
 
 end
 
 lemma bit_minus_numeral_int [simp]:
   \<open>bit (- numeral (num.Bit0 w) :: int) (numeral n) \<longleftrightarrow> bit (- numeral w :: int) (pred_numeral n)\<close>
   \<open>bit (- numeral (num.Bit1 w) :: int) (numeral n) \<longleftrightarrow> \<not> bit (numeral w :: int) (pred_numeral n)\<close>
   by (simp_all add: bit_minus_iff bit_not_iff numeral_eq_Suc bit_Suc add_One sub_inc_One_eq)
 
 lemma bit_minus_numeral_Bit0_Suc_iff [simp]:
   \<open>bit (- numeral (num.Bit0 w) :: int) (Suc n) \<longleftrightarrow> bit (- numeral w :: int) n\<close>
   by (simp add: bit_Suc)
 
 lemma bit_minus_numeral_Bit1_Suc_iff [simp]:
   \<open>bit (- numeral (num.Bit1 w) :: int) (Suc n) \<longleftrightarrow> \<not> bit (numeral w :: int) n\<close>
   by (simp add: bit_Suc add_One flip: bit_not_int_iff)
 
 lemma and_not_numerals:
   \<open>1 AND NOT 1 = (0 :: int)\<close>
   \<open>1 AND NOT (numeral (Num.Bit0 n)) = (1 :: int)\<close>
   \<open>1 AND NOT (numeral (Num.Bit1 n)) = (0 :: int)\<close>
   \<open>numeral (Num.Bit0 m) AND NOT (1 :: int) = numeral (Num.Bit0 m)\<close>
   \<open>numeral (Num.Bit0 m) AND NOT (numeral (Num.Bit0 n)) = (2 :: int) * (numeral m AND NOT (numeral n))\<close>
   \<open>numeral (Num.Bit0 m) AND NOT (numeral (Num.Bit1 n)) = (2 :: int) * (numeral m AND NOT (numeral n))\<close>
   \<open>numeral (Num.Bit1 m) AND NOT (1 :: int) = numeral (Num.Bit0 m)\<close>
   \<open>numeral (Num.Bit1 m) AND NOT (numeral (Num.Bit0 n)) = 1 + (2 :: int) * (numeral m AND NOT (numeral n))\<close>
   \<open>numeral (Num.Bit1 m) AND NOT (numeral (Num.Bit1 n)) = (2 :: int) * (numeral m AND NOT (numeral n))\<close>
   by (simp_all add: bit_eq_iff) (auto simp add: bit_0 bit_simps bit_Suc bit_numeral_rec BitM_inc_eq sub_inc_One_eq split: nat.split)
 
 fun and_not_num :: \<open>num \<Rightarrow> num \<Rightarrow> num option\<close> \<^marker>\<open>contributor \<open>Andreas Lochbihler\<close>\<close>
 where
   \<open>and_not_num num.One num.One = None\<close>
 | \<open>and_not_num num.One (num.Bit0 n) = Some num.One\<close>
 | \<open>and_not_num num.One (num.Bit1 n) = None\<close>
 | \<open>and_not_num (num.Bit0 m) num.One = Some (num.Bit0 m)\<close>
 | \<open>and_not_num (num.Bit0 m) (num.Bit0 n) = map_option num.Bit0 (and_not_num m n)\<close>
 | \<open>and_not_num (num.Bit0 m) (num.Bit1 n) = map_option num.Bit0 (and_not_num m n)\<close>
 | \<open>and_not_num (num.Bit1 m) num.One = Some (num.Bit0 m)\<close>
 | \<open>and_not_num (num.Bit1 m) (num.Bit0 n) = (case and_not_num m n of None \<Rightarrow> Some num.One | Some n' \<Rightarrow> Some (num.Bit1 n'))\<close>
 | \<open>and_not_num (num.Bit1 m) (num.Bit1 n) = map_option num.Bit0 (and_not_num m n)\<close>
 
 lemma int_numeral_and_not_num:
   \<open>numeral m AND NOT (numeral n) = (case and_not_num m n of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')\<close>
   by (induction m n rule: and_not_num.induct) (simp_all del: not_numeral_eq not_one_eq add: and_not_numerals split: option.splits)
 
 lemma int_numeral_not_and_num:
   \<open>NOT (numeral m) AND numeral n = (case and_not_num n m of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')\<close>
   using int_numeral_and_not_num [of n m] by (simp add: ac_simps)
 
 lemma and_not_num_eq_None_iff:
   \<open>and_not_num m n = None \<longleftrightarrow> numeral m AND NOT (numeral n) = (0 :: int)\<close>
   by (simp del: not_numeral_eq add: int_numeral_and_not_num split: option.split)
 
 lemma and_not_num_eq_Some_iff:
   \<open>and_not_num m n = Some q \<longleftrightarrow> numeral m AND NOT (numeral n) = (numeral q :: int)\<close>
   by (simp del: not_numeral_eq add: int_numeral_and_not_num split: option.split)
 
 lemma and_minus_numerals [simp]:
   \<open>1 AND - (numeral (num.Bit0 n)) = (0::int)\<close>
   \<open>1 AND - (numeral (num.Bit1 n)) = (1::int)\<close>
   \<open>numeral m AND - (numeral (num.Bit0 n)) = (case and_not_num m (Num.BitM n) of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')\<close>
   \<open>numeral m AND - (numeral (num.Bit1 n)) = (case and_not_num m (Num.Bit0 n) of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')\<close>
   \<open>- (numeral (num.Bit0 n)) AND 1 = (0::int)\<close>
   \<open>- (numeral (num.Bit1 n)) AND 1 = (1::int)\<close>
   \<open>- (numeral (num.Bit0 n)) AND numeral m = (case and_not_num m (Num.BitM n) of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')\<close>
   \<open>- (numeral (num.Bit1 n)) AND numeral m = (case and_not_num m (Num.Bit0 n) of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')\<close>
   by (simp_all del: not_numeral_eq add: ac_simps
     and_not_numerals one_and_eq not_numeral_BitM_eq not_numeral_Bit0_eq and_not_num_eq_None_iff and_not_num_eq_Some_iff split: option.split)
 
 lemma and_minus_minus_numerals [simp]:
   \<open>- (numeral m :: int) AND - (numeral n :: int) = NOT ((numeral m - 1) OR (numeral n - 1))\<close>
   by (simp add: minus_numeral_eq_not_sub_one)
 
 lemma or_not_numerals:
   \<open>1 OR NOT 1 = NOT (0 :: int)\<close>
   \<open>1 OR NOT (numeral (Num.Bit0 n)) = NOT (numeral (Num.Bit0 n) :: int)\<close>
   \<open>1 OR NOT (numeral (Num.Bit1 n)) = NOT (numeral (Num.Bit0 n) :: int)\<close>
   \<open>numeral (Num.Bit0 m) OR NOT (1 :: int) = NOT (1 :: int)\<close>
   \<open>numeral (Num.Bit0 m) OR NOT (numeral (Num.Bit0 n)) = 1 + (2 :: int) * (numeral m OR NOT (numeral n))\<close>
   \<open>numeral (Num.Bit0 m) OR NOT (numeral (Num.Bit1 n)) = (2 :: int) * (numeral m OR NOT (numeral n))\<close>
   \<open>numeral (Num.Bit1 m) OR NOT (1 :: int) = NOT (0 :: int)\<close>
   \<open>numeral (Num.Bit1 m) OR NOT (numeral (Num.Bit0 n)) = 1 + (2 :: int) * (numeral m OR NOT (numeral n))\<close>
   \<open>numeral (Num.Bit1 m) OR NOT (numeral (Num.Bit1 n)) = 1 + (2 :: int) * (numeral m OR NOT (numeral n))\<close>
   by (simp_all add: bit_eq_iff)
     (auto simp add: bit_0 bit_simps bit_Suc bit_numeral_rec sub_inc_One_eq split: nat.split)
 
 fun or_not_num_neg :: \<open>num \<Rightarrow> num \<Rightarrow> num\<close> \<^marker>\<open>contributor \<open>Andreas Lochbihler\<close>\<close>
 where
   \<open>or_not_num_neg num.One num.One = num.One\<close>
 | \<open>or_not_num_neg num.One (num.Bit0 m) = num.Bit1 m\<close>
 | \<open>or_not_num_neg num.One (num.Bit1 m) = num.Bit1 m\<close>
 | \<open>or_not_num_neg (num.Bit0 n) num.One = num.Bit0 num.One\<close>
 | \<open>or_not_num_neg (num.Bit0 n) (num.Bit0 m) = Num.BitM (or_not_num_neg n m)\<close>
 | \<open>or_not_num_neg (num.Bit0 n) (num.Bit1 m) = num.Bit0 (or_not_num_neg n m)\<close>
 | \<open>or_not_num_neg (num.Bit1 n) num.One = num.One\<close>
 | \<open>or_not_num_neg (num.Bit1 n) (num.Bit0 m) = Num.BitM (or_not_num_neg n m)\<close>
 | \<open>or_not_num_neg (num.Bit1 n) (num.Bit1 m) = Num.BitM (or_not_num_neg n m)\<close>
 
 lemma int_numeral_or_not_num_neg:
   \<open>numeral m OR NOT (numeral n :: int) = - numeral (or_not_num_neg m n)\<close>
   by (induction m n rule: or_not_num_neg.induct) (simp_all del: not_numeral_eq not_one_eq add: or_not_numerals, simp_all)
 
 lemma int_numeral_not_or_num_neg:
   \<open>NOT (numeral m) OR (numeral n :: int) = - numeral (or_not_num_neg n m)\<close>
   using int_numeral_or_not_num_neg [of n m] by (simp add: ac_simps)
 
 lemma numeral_or_not_num_eq:
   \<open>numeral (or_not_num_neg m n) = - (numeral m OR NOT (numeral n :: int))\<close>
   using int_numeral_or_not_num_neg [of m n] by simp
 
 lemma or_minus_numerals [simp]:
   \<open>1 OR - (numeral (num.Bit0 n)) = - (numeral (or_not_num_neg num.One (Num.BitM n)) :: int)\<close>
   \<open>1 OR - (numeral (num.Bit1 n)) = - (numeral (num.Bit1 n) :: int)\<close>
   \<open>numeral m OR - (numeral (num.Bit0 n)) = - (numeral (or_not_num_neg m (Num.BitM n)) :: int)\<close>
   \<open>numeral m OR - (numeral (num.Bit1 n)) = - (numeral (or_not_num_neg m (Num.Bit0 n)) :: int)\<close>
   \<open>- (numeral (num.Bit0 n)) OR 1 = - (numeral (or_not_num_neg num.One (Num.BitM n)) :: int)\<close>
   \<open>- (numeral (num.Bit1 n)) OR 1 = - (numeral (num.Bit1 n) :: int)\<close>
   \<open>- (numeral (num.Bit0 n)) OR numeral m = - (numeral (or_not_num_neg m (Num.BitM n)) :: int)\<close>
   \<open>- (numeral (num.Bit1 n)) OR numeral m = - (numeral (or_not_num_neg m (Num.Bit0 n)) :: int)\<close>
   by (simp_all only: or.commute [of _ 1] or.commute [of _ \<open>numeral m\<close>]
     minus_numeral_eq_not_sub_one or_not_numerals
     numeral_or_not_num_eq arith_simps minus_minus numeral_One)
 
 lemma or_minus_minus_numerals [simp]:
   \<open>- (numeral m :: int) OR - (numeral n :: int) = NOT ((numeral m - 1) AND (numeral n - 1))\<close>
   by (simp add: minus_numeral_eq_not_sub_one)
 
 lemma xor_minus_numerals [simp]:
   \<open>- numeral n XOR k = NOT (neg_numeral_class.sub n num.One XOR k)\<close>
   \<open>k XOR - numeral n = NOT (k XOR (neg_numeral_class.sub n num.One))\<close> for k :: int
   by (simp_all add: minus_numeral_eq_not_sub_one)
 
 definition take_bit_num :: \<open>nat \<Rightarrow> num \<Rightarrow> num option\<close>
   where \<open>take_bit_num n m =
     (if take_bit n (numeral m :: nat) = 0 then None else Some (num_of_nat (take_bit n (numeral m :: nat))))\<close>
 
 lemma take_bit_num_simps:
   \<open>take_bit_num 0 m = None\<close>
   \<open>take_bit_num (Suc n) Num.One =
     Some Num.One\<close>
   \<open>take_bit_num (Suc n) (Num.Bit0 m) =
     (case take_bit_num n m of None \<Rightarrow> None | Some q \<Rightarrow> Some (Num.Bit0 q))\<close>
   \<open>take_bit_num (Suc n) (Num.Bit1 m) =
     Some (case take_bit_num n m of None \<Rightarrow> Num.One | Some q \<Rightarrow> Num.Bit1 q)\<close>
   \<open>take_bit_num (numeral r) Num.One =
     Some Num.One\<close>
   \<open>take_bit_num (numeral r) (Num.Bit0 m) =
     (case take_bit_num (pred_numeral r) m of None \<Rightarrow> None | Some q \<Rightarrow> Some (Num.Bit0 q))\<close>
   \<open>take_bit_num (numeral r) (Num.Bit1 m) =
     Some (case take_bit_num (pred_numeral r) m of None \<Rightarrow> Num.One | Some q \<Rightarrow> Num.Bit1 q)\<close>
   by (auto simp add: take_bit_num_def ac_simps mult_2 num_of_nat_double
     take_bit_Suc_bit0 take_bit_Suc_bit1 take_bit_numeral_bit0 take_bit_numeral_bit1)
 
 lemma take_bit_num_code [code]:
   \<comment> \<open>Ocaml-style pattern matching is more robust wrt. different representations of \<^typ>\<open>nat\<close>\<close>
   \<open>take_bit_num n m = (case (n, m)
    of (0, _) \<Rightarrow> None
     | (Suc n, Num.One) \<Rightarrow> Some Num.One
     | (Suc n, Num.Bit0 m) \<Rightarrow> (case take_bit_num n m of None \<Rightarrow> None | Some q \<Rightarrow> Some (Num.Bit0 q))
     | (Suc n, Num.Bit1 m) \<Rightarrow> Some (case take_bit_num n m of None \<Rightarrow> Num.One | Some q \<Rightarrow> Num.Bit1 q))\<close>
   by (cases n; cases m) (simp_all add: take_bit_num_simps)
 
 context semiring_bit_operations
 begin
 
 lemma take_bit_num_eq_None_imp:
   \<open>take_bit m (numeral n) = 0\<close> if \<open>take_bit_num m n = None\<close>
 proof -
   from that have \<open>take_bit m (numeral n :: nat) = 0\<close>
     by (simp add: take_bit_num_def split: if_splits)
   then have \<open>of_nat (take_bit m (numeral n)) = of_nat 0\<close>
     by simp
   then show ?thesis
     by (simp add: of_nat_take_bit)
 qed
 
 lemma take_bit_num_eq_Some_imp:
   \<open>take_bit m (numeral n) = numeral q\<close> if \<open>take_bit_num m n = Some q\<close>
 proof -
   from that have \<open>take_bit m (numeral n :: nat) = numeral q\<close>
     by (auto simp add: take_bit_num_def Num.numeral_num_of_nat_unfold split: if_splits)
   then have \<open>of_nat (take_bit m (numeral n)) = of_nat (numeral q)\<close>
     by simp
   then show ?thesis
     by (simp add: of_nat_take_bit)
 qed
 
 lemma take_bit_numeral_numeral:
   \<open>take_bit (numeral m) (numeral n) =
     (case take_bit_num (numeral m) n of None \<Rightarrow> 0 | Some q \<Rightarrow> numeral q)\<close>
   by (auto split: option.split dest: take_bit_num_eq_None_imp take_bit_num_eq_Some_imp)
 
 end
 
 lemma take_bit_numeral_minus_numeral_int:
   \<open>take_bit (numeral m) (- numeral n :: int) =
     (case take_bit_num (numeral m) n of None \<Rightarrow> 0 | Some q \<Rightarrow> take_bit (numeral m) (2 ^ numeral m - numeral q))\<close> (is \<open>?lhs = ?rhs\<close>)
 proof (cases \<open>take_bit_num (numeral m) n\<close>)
   case None
   then show ?thesis
     by (auto dest: take_bit_num_eq_None_imp [where ?'a = int] simp add: take_bit_eq_0_iff)
 next
   case (Some q)
   then have q: \<open>take_bit (numeral m) (numeral n :: int) = numeral q\<close>
     by (auto dest: take_bit_num_eq_Some_imp)
   let ?T = \<open>take_bit (numeral m) :: int \<Rightarrow> int\<close>
   have *: \<open>?T (2 ^ numeral m) = ?T (?T 0)\<close>
     by (simp add: take_bit_eq_0_iff)
   have \<open>?lhs = ?T (0 - numeral n)\<close>
     by simp
   also have \<open>\<dots> = ?T (?T (?T 0) - ?T (?T (numeral n)))\<close>
     by (simp only: take_bit_diff)
   also have \<open>\<dots> = ?T (2 ^ numeral m - ?T (numeral n))\<close>
     by (simp only: take_bit_diff flip: *)
   also have \<open>\<dots> = ?rhs\<close>
     by (simp add: q Some)
   finally show ?thesis .
 qed
 
 declare take_bit_num_simps [simp]
   take_bit_numeral_numeral [simp]
   take_bit_numeral_minus_numeral_int [simp]
 
 
 subsection \<open>Symbolic computations for code generation\<close>
 
 lemma bit_int_code [code]:
   \<open>bit (0::int)               n      \<longleftrightarrow> False\<close>
   \<open>bit (Int.Neg num.One)      n      \<longleftrightarrow> True\<close>
   \<open>bit (Int.Pos num.One)      0      \<longleftrightarrow> True\<close>
   \<open>bit (Int.Pos (num.Bit0 m)) 0      \<longleftrightarrow> False\<close>
   \<open>bit (Int.Pos (num.Bit1 m)) 0      \<longleftrightarrow> True\<close>
   \<open>bit (Int.Neg (num.Bit0 m)) 0      \<longleftrightarrow> False\<close>
   \<open>bit (Int.Neg (num.Bit1 m)) 0      \<longleftrightarrow> True\<close>
   \<open>bit (Int.Pos num.One)      (Suc n) \<longleftrightarrow> False\<close>
   \<open>bit (Int.Pos (num.Bit0 m)) (Suc n) \<longleftrightarrow> bit (Int.Pos m) n\<close>
   \<open>bit (Int.Pos (num.Bit1 m)) (Suc n) \<longleftrightarrow> bit (Int.Pos m) n\<close>
   \<open>bit (Int.Neg (num.Bit0 m)) (Suc n) \<longleftrightarrow> bit (Int.Neg m) n\<close>
   \<open>bit (Int.Neg (num.Bit1 m)) (Suc n) \<longleftrightarrow> bit (Int.Neg (Num.inc m)) n\<close>
   by (simp_all add: Num.add_One bit_0 bit_Suc)
 
 lemma not_int_code [code]:
   \<open>NOT (0 :: int) = - 1\<close>
   \<open>NOT (Int.Pos n) = Int.Neg (Num.inc n)\<close>
   \<open>NOT (Int.Neg n) = Num.sub n num.One\<close>
   by (simp_all add: Num.add_One not_int_def)
 
 fun and_num :: \<open>num \<Rightarrow> num \<Rightarrow> num option\<close> \<^marker>\<open>contributor \<open>Andreas Lochbihler\<close>\<close>
 where
   \<open>and_num num.One num.One = Some num.One\<close>
 | \<open>and_num num.One (num.Bit0 n) = None\<close>
 | \<open>and_num num.One (num.Bit1 n) = Some num.One\<close>
 | \<open>and_num (num.Bit0 m) num.One = None\<close>
 | \<open>and_num (num.Bit0 m) (num.Bit0 n) = map_option num.Bit0 (and_num m n)\<close>
 | \<open>and_num (num.Bit0 m) (num.Bit1 n) = map_option num.Bit0 (and_num m n)\<close>
 | \<open>and_num (num.Bit1 m) num.One = Some num.One\<close>
 | \<open>and_num (num.Bit1 m) (num.Bit0 n) = map_option num.Bit0 (and_num m n)\<close>
 | \<open>and_num (num.Bit1 m) (num.Bit1 n) = (case and_num m n of None \<Rightarrow> Some num.One | Some n' \<Rightarrow> Some (num.Bit1 n'))\<close>
 
 context linordered_euclidean_semiring_bit_operations
 begin
 
 lemma numeral_and_num:
   \<open>numeral m AND numeral n = (case and_num m n of None \<Rightarrow> 0 | Some n' \<Rightarrow> numeral n')\<close>
   by (induction m n rule: and_num.induct) (simp_all add: split: option.split)
 
 lemma and_num_eq_None_iff:
   \<open>and_num m n = None \<longleftrightarrow> numeral m AND numeral n = 0\<close>
   by (simp add: numeral_and_num split: option.split)
 
 lemma and_num_eq_Some_iff:
   \<open>and_num m n = Some q \<longleftrightarrow> numeral m AND numeral n = numeral q\<close>
   by (simp add: numeral_and_num split: option.split)
 
 end
 
 lemma and_int_code [code]:
   fixes i j :: int shows
   \<open>0 AND j = 0\<close>
   \<open>i AND 0 = 0\<close>
   \<open>Int.Pos n AND Int.Pos m = (case and_num n m of None \<Rightarrow> 0 | Some n' \<Rightarrow> Int.Pos n')\<close>
   \<open>Int.Neg n AND Int.Neg m = NOT (Num.sub n num.One OR Num.sub m num.One)\<close>
   \<open>Int.Pos n AND Int.Neg num.One = Int.Pos n\<close>
   \<open>Int.Pos n AND Int.Neg (num.Bit0 m) = Num.sub (or_not_num_neg (Num.BitM m) n) num.One\<close>
   \<open>Int.Pos n AND Int.Neg (num.Bit1 m) = Num.sub (or_not_num_neg (num.Bit0 m) n) num.One\<close>
   \<open>Int.Neg num.One AND Int.Pos m = Int.Pos m\<close>
   \<open>Int.Neg (num.Bit0 n) AND Int.Pos m = Num.sub (or_not_num_neg (Num.BitM n) m) num.One\<close>
   \<open>Int.Neg (num.Bit1 n) AND Int.Pos m = Num.sub (or_not_num_neg (num.Bit0 n) m) num.One\<close>
   apply (auto simp add: and_num_eq_None_iff [where ?'a = int] and_num_eq_Some_iff [where ?'a = int]
     split: option.split)
      apply (simp_all only: sub_one_eq_not_neg numeral_or_not_num_eq minus_minus and_not_numerals
        bit.de_Morgan_disj bit.double_compl and_not_num_eq_None_iff and_not_num_eq_Some_iff ac_simps)
   done
 
 context linordered_euclidean_semiring_bit_operations
 begin
 
 fun or_num :: \<open>num \<Rightarrow> num \<Rightarrow> num\<close> \<^marker>\<open>contributor \<open>Andreas Lochbihler\<close>\<close>
 where
   \<open>or_num num.One num.One = num.One\<close>
 | \<open>or_num num.One (num.Bit0 n) = num.Bit1 n\<close>
 | \<open>or_num num.One (num.Bit1 n) = num.Bit1 n\<close>
 | \<open>or_num (num.Bit0 m) num.One = num.Bit1 m\<close>
 | \<open>or_num (num.Bit0 m) (num.Bit0 n) = num.Bit0 (or_num m n)\<close>
 | \<open>or_num (num.Bit0 m) (num.Bit1 n) = num.Bit1 (or_num m n)\<close>
 | \<open>or_num (num.Bit1 m) num.One = num.Bit1 m\<close>
 | \<open>or_num (num.Bit1 m) (num.Bit0 n) = num.Bit1 (or_num m n)\<close>
 | \<open>or_num (num.Bit1 m) (num.Bit1 n) = num.Bit1 (or_num m n)\<close>
 
 lemma numeral_or_num:
   \<open>numeral m OR numeral n = numeral (or_num m n)\<close>
   by (induction m n rule: or_num.induct) simp_all
 
 lemma numeral_or_num_eq:
   \<open>numeral (or_num m n) = numeral m OR numeral n\<close>
   by (simp add: numeral_or_num)
 
 end
 
 lemma or_int_code [code]:
   fixes i j :: int shows
   \<open>0 OR j = j\<close>
   \<open>i OR 0 = i\<close>
   \<open>Int.Pos n OR Int.Pos m = Int.Pos (or_num n m)\<close>
   \<open>Int.Neg n OR Int.Neg m = NOT (Num.sub n num.One AND Num.sub m num.One)\<close>
   \<open>Int.Pos n OR Int.Neg num.One = Int.Neg num.One\<close>
   \<open>Int.Pos n OR Int.Neg (num.Bit0 m) = (case and_not_num (Num.BitM m) n of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))\<close>
   \<open>Int.Pos n OR Int.Neg (num.Bit1 m) = (case and_not_num (num.Bit0 m) n of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))\<close>
   \<open>Int.Neg num.One OR Int.Pos m = Int.Neg num.One\<close>
   \<open>Int.Neg (num.Bit0 n) OR Int.Pos m = (case and_not_num (Num.BitM n) m of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))\<close>
   \<open>Int.Neg (num.Bit1 n) OR Int.Pos m = (case and_not_num (num.Bit0 n) m of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))\<close>
   apply (auto simp add: numeral_or_num_eq split: option.splits)
          apply (simp_all only: and_not_num_eq_None_iff and_not_num_eq_Some_iff and_not_numerals
            numeral_or_not_num_eq or_eq_not_not_and bit.double_compl ac_simps flip: numeral_eq_iff [where ?'a = int])
          apply simp_all
   done
 
 fun xor_num :: \<open>num \<Rightarrow> num \<Rightarrow> num option\<close> \<^marker>\<open>contributor \<open>Andreas Lochbihler\<close>\<close>
 where
   \<open>xor_num num.One num.One = None\<close>
 | \<open>xor_num num.One (num.Bit0 n) = Some (num.Bit1 n)\<close>
 | \<open>xor_num num.One (num.Bit1 n) = Some (num.Bit0 n)\<close>
 | \<open>xor_num (num.Bit0 m) num.One = Some (num.Bit1 m)\<close>
 | \<open>xor_num (num.Bit0 m) (num.Bit0 n) = map_option num.Bit0 (xor_num m n)\<close>
 | \<open>xor_num (num.Bit0 m) (num.Bit1 n) = Some (case xor_num m n of None \<Rightarrow> num.One | Some n' \<Rightarrow> num.Bit1 n')\<close>
 | \<open>xor_num (num.Bit1 m) num.One = Some (num.Bit0 m)\<close>
 | \<open>xor_num (num.Bit1 m) (num.Bit0 n) = Some (case xor_num m n of None \<Rightarrow> num.One | Some n' \<Rightarrow> num.Bit1 n')\<close>
 | \<open>xor_num (num.Bit1 m) (num.Bit1 n) = map_option num.Bit0 (xor_num m n)\<close>
 
 context linordered_euclidean_semiring_bit_operations
 begin
 
 lemma numeral_xor_num:
   \<open>numeral m XOR numeral n = (case xor_num m n of None \<Rightarrow> 0 | Some n' \<Rightarrow> numeral n')\<close>
   by (induction m n rule: xor_num.induct) (simp_all split: option.split)
 
 lemma xor_num_eq_None_iff:
   \<open>xor_num m n = None \<longleftrightarrow> numeral m XOR numeral n = 0\<close>
   by (simp add: numeral_xor_num split: option.split)
 
 lemma xor_num_eq_Some_iff:
   \<open>xor_num m n = Some q \<longleftrightarrow> numeral m XOR numeral n = numeral q\<close>
   by (simp add: numeral_xor_num split: option.split)
 
 end
 
 lemma xor_int_code [code]:
   fixes i j :: int shows
   \<open>0 XOR j = j\<close>
   \<open>i XOR 0 = i\<close>
   \<open>Int.Pos n XOR Int.Pos m = (case xor_num n m of None \<Rightarrow> 0 | Some n' \<Rightarrow> Int.Pos n')\<close>
   \<open>Int.Neg n XOR Int.Neg m = Num.sub n num.One XOR Num.sub m num.One\<close>
   \<open>Int.Neg n XOR Int.Pos m = NOT (Num.sub n num.One XOR Int.Pos m)\<close>
   \<open>Int.Pos n XOR Int.Neg m = NOT (Int.Pos n XOR Num.sub m num.One)\<close>
   by (simp_all add: xor_num_eq_None_iff [where ?'a = int] xor_num_eq_Some_iff [where ?'a = int] split: option.split)
 
 lemma push_bit_int_code [code]:
   \<open>push_bit 0 i = i\<close>
   \<open>push_bit (Suc n) i = push_bit n (Int.dup i)\<close>
   by (simp_all add: ac_simps)
 
 lemma drop_bit_int_code [code]:
   fixes i :: int shows
   \<open>drop_bit 0 i = i\<close>
   \<open>drop_bit (Suc n) 0 = (0 :: int)\<close>
   \<open>drop_bit (Suc n) (Int.Pos num.One) = 0\<close>
   \<open>drop_bit (Suc n) (Int.Pos (num.Bit0 m)) = drop_bit n (Int.Pos m)\<close>
   \<open>drop_bit (Suc n) (Int.Pos (num.Bit1 m)) = drop_bit n (Int.Pos m)\<close>
   \<open>drop_bit (Suc n) (Int.Neg num.One) = - 1\<close>
   \<open>drop_bit (Suc n) (Int.Neg (num.Bit0 m)) = drop_bit n (Int.Neg m)\<close>
   \<open>drop_bit (Suc n) (Int.Neg (num.Bit1 m)) = drop_bit n (Int.Neg (Num.inc m))\<close>
   by (simp_all add: drop_bit_Suc add_One)
 
 
 subsection \<open>More properties\<close>
 
 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 take_bit_eq_0_iff)
   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
 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)
 
 
 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: bit_0 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> possible_bit TYPE('a) n \<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)
     (blast dest: bit_imp_possible_bit)
 
 lemma signed_take_bit_0 [simp]:
   \<open>signed_take_bit 0 a = - (a mod 2)\<close>
   by (simp add: bit_0 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>
   by (simp add: bit_eq_iff bit_sum_mult_2_cases bit_simps bit_0 possible_bit_less_imp flip: bit_Suc min_Suc_Suc)
 
 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 mask_eq_exp_minus_1 possible_bit_def)
 
 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_numeral_of_1 [simp]:
   \<open>signed_take_bit (numeral k) 1 = 1\<close>
   by (simp add: bit_1_iff signed_take_bit_eq_if_positive)
 
 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 bit_imp_possible_bit in fastforce)
   then show ?thesis
     by (auto simp add: fun_eq_iff intro: bit_eqI)
 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>
   by (auto simp add: bit_eq_iff bit_simps ac_simps)
 
 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)
 
 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_greater_eq_minus_exp [simp]:
   \<open>- (2 ^ n) \<le> signed_take_bit n k\<close>
   for k :: int
   by (simp add: signed_take_bit_eq_take_bit_shift)
 
 lemma signed_take_bit_int_less_exp [simp]:
   \<open>signed_take_bit n k < 2 ^ n\<close>
   for k :: int
   using take_bit_int_less_exp [of \<open>Suc n\<close>]
   by (simp add: signed_take_bit_eq_take_bit_shift)
 
 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 simp del: push_bit_minus_one_eq_not_mask)
 qed
 
 
 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 bit_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_eq_or [where ?'a = int, no_vars]}
 
       \<^item> Unset a single bit: @{thm unset_bit_eq_and_not [where ?'a = int, no_vars]}
 
       \<^item> Flip a single bit: @{thm flip_bit_eq_xor [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>
 
 
 subsection \<open>Lemma duplicates and other\<close>
 
 context semiring_bits
 begin
 
 lemma even_mask_div_iff [no_atp]:
   \<open>even ((2 ^ m - 1) div 2 ^ n) \<longleftrightarrow> 2 ^ n = 0 \<or> m \<le> n\<close>
   by (cases \<open>2 ^ n = 0\<close>) (simp_all add: even_decr_exp_div_exp_iff)
 
 lemma exp_div_exp_eq [no_atp]:
   \<open>2 ^ m div 2 ^ n = of_bool (2 ^ m \<noteq> 0 \<and> m \<ge> n) * 2 ^ (m - n)\<close>
   apply (rule bit_eqI)
   using bit_exp_iff div_exp_eq apply (auto simp add: bit_iff_odd possible_bit_def)
   done
 
 lemma bits_1_div_2 [no_atp]:
   \<open>1 div 2 = 0\<close>
   by (fact half_1)
 
 lemma bits_1_div_exp [no_atp]:
   \<open>1 div 2 ^ n = of_bool (n = 0)\<close>
   using div_exp_eq [of 1 1] by (cases n) simp_all
 
-lemmas bits_div_0 = bits_0_div
-
-lemmas bits_mod_0 = bits_0_mod
-
 lemma exp_add_not_zero_imp [no_atp]:
   \<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
   exp_add_not_zero_imp_left [no_atp]: \<open>2 ^ m \<noteq> 0\<close>
   and exp_add_not_zero_imp_right [no_atp]: \<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 [no_atp]:
   \<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
 
 lemma exp_eq_0_imp_not_bit [no_atp]:
   \<open>\<not> bit a n\<close> if \<open>2 ^ n = 0\<close>
   using that by (simp add: bit_iff_odd)
 
 end
 
 context semiring_bit_operations
 begin
 
 lemma mod_exp_eq [no_atp]:
   \<open>a mod 2 ^ m mod 2 ^ n = a mod 2 ^ min m n\<close>
   by (simp flip: take_bit_eq_mod add: ac_simps)
 
 lemma mult_exp_mod_exp_eq [no_atp]:
   \<open>m \<le> n \<Longrightarrow> (a * 2 ^ m) mod (2 ^ n) = (a mod 2 ^ (n - m)) * 2 ^ m\<close>
   by (simp flip: push_bit_eq_mult take_bit_eq_mod add: push_bit_take_bit)
 
 lemma div_exp_mod_exp_eq [no_atp]:
   \<open>a div 2 ^ n mod 2 ^ m = a mod (2 ^ (n + m)) div 2 ^ n\<close>
   by (simp flip: drop_bit_eq_div take_bit_eq_mod add: drop_bit_take_bit)
 
 lemma even_mult_exp_div_exp_iff [no_atp]:
   \<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>
   by (simp flip: push_bit_eq_mult drop_bit_eq_div add: even_drop_bit_iff_not_bit bit_simps possible_bit_def) auto
 
 lemma mod_exp_div_exp_eq_0 [no_atp]:
   \<open>a mod 2 ^ n div 2 ^ n = 0\<close>
   by (simp flip: take_bit_eq_mod drop_bit_eq_div add: drop_bit_take_bit)
 
 lemmas bits_one_mod_two_eq_one [no_atp] = one_mod_two_eq_one
 
 lemmas set_bit_def [no_atp] = set_bit_eq_or
 
 lemmas unset_bit_def [no_atp] = unset_bit_eq_and_not
 
 lemmas flip_bit_def [no_atp] = flip_bit_eq_xor
 
 end
 
 lemma and_nat_rec [no_atp]:
   \<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 (fact and_rec)
 
 lemma or_nat_rec [no_atp]:
   \<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 (fact or_rec)
 
 lemma xor_nat_rec [no_atp]:
   \<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 (fact xor_rec)
 
 lemma bit_push_bit_iff_nat [no_atp]:
   \<open>bit (push_bit m q) n \<longleftrightarrow> m \<le> n \<and> bit q (n - m)\<close> for q :: nat
   by (fact bit_push_bit_iff')
 
 lemma mask_half_int [no_atp]:
   \<open>mask n div 2 = (mask (n - 1) :: int)\<close>
   by (fact mask_half)
 
 lemma not_int_rec [no_atp]:
   \<open>NOT k = of_bool (even k) + 2 * NOT (k div 2)\<close> for k :: int
   by (fact not_rec)
 
 lemma even_not_iff_int [no_atp]:
   \<open>even (NOT k) \<longleftrightarrow> odd k\<close> for k :: int
   by (fact even_not_iff)
 
 lemma bit_not_int_iff':
   \<open>bit (- k - 1) n \<longleftrightarrow> \<not> bit k n\<close> for k :: int
   by (simp flip: not_eq_complement add: bit_simps)
 
 lemmas and_int_rec [no_atp] = and_int.rec
 
 lemma even_and_iff_int [no_atp]:
   \<open>even (k AND l) \<longleftrightarrow> even k \<or> even l\<close> for k l :: int
   by (fact even_and_iff)
 
 lemmas bit_and_int_iff [no_atp] = and_int.bit_iff
 
 lemmas or_int_rec [no_atp] = or_int.rec
 
 lemmas bit_or_int_iff [no_atp] = or_int.bit_iff
 
 lemmas xor_int_rec [no_atp] = xor_int.rec
 
 lemmas bit_xor_int_iff [no_atp] = xor_int.bit_iff
 
 lemma drop_bit_push_bit_int [no_atp]:
   \<open>drop_bit m (push_bit n k) = drop_bit (m - n) (push_bit (n - m) k)\<close> for k :: int
   by (fact drop_bit_push_bit)
 
 lemma bit_push_bit_iff_int [no_atp] :
   \<open>bit (push_bit m k) n \<longleftrightarrow> m \<le> n \<and> bit k (n - m)\<close> for k :: int
   by (fact bit_push_bit_iff')
 
 no_notation
   not  (\<open>NOT\<close>)
     and "and"  (infixr \<open>AND\<close> 64)
     and or  (infixr \<open>OR\<close>  59)
     and xor  (infixr \<open>XOR\<close> 59)
 
 bundle bit_operations_syntax
 begin
 
 notation
   not  (\<open>NOT\<close>)
     and "and"  (infixr \<open>AND\<close> 64)
     and or  (infixr \<open>OR\<close>  59)
     and xor  (infixr \<open>XOR\<close> 59)
 
 end
 
 end
diff --git a/src/HOL/Code_Numeral.thy b/src/HOL/Code_Numeral.thy
--- a/src/HOL/Code_Numeral.thy
+++ b/src/HOL/Code_Numeral.thy
@@ -1,1329 +1,1329 @@
 (*  Title:      HOL/Code_Numeral.thy
     Author:     Florian Haftmann, TU Muenchen
 *)
 
 section \<open>Numeric types for code generation onto target language numerals only\<close>
 
 theory Code_Numeral
 imports Lifting Bit_Operations
 begin
 
 subsection \<open>Type of target language integers\<close>
 
 typedef integer = "UNIV :: int set"
   morphisms int_of_integer integer_of_int ..
 
 setup_lifting type_definition_integer
 
 lemma integer_eq_iff:
   "k = l \<longleftrightarrow> int_of_integer k = int_of_integer l"
   by transfer rule
 
 lemma integer_eqI:
   "int_of_integer k = int_of_integer l \<Longrightarrow> k = l"
   using integer_eq_iff [of k l] by simp
 
 lemma int_of_integer_integer_of_int [simp]:
   "int_of_integer (integer_of_int k) = k"
   by transfer rule
 
 lemma integer_of_int_int_of_integer [simp]:
   "integer_of_int (int_of_integer k) = k"
   by transfer rule
 
 instantiation integer :: ring_1
 begin
 
 lift_definition zero_integer :: integer
   is "0 :: int"
   .
 
 declare zero_integer.rep_eq [simp]
 
 lift_definition one_integer :: integer
   is "1 :: int"
   .
 
 declare one_integer.rep_eq [simp]
 
 lift_definition plus_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"
   is "plus :: int \<Rightarrow> int \<Rightarrow> int"
   .
 
 declare plus_integer.rep_eq [simp]
 
 lift_definition uminus_integer :: "integer \<Rightarrow> integer"
   is "uminus :: int \<Rightarrow> int"
   .
 
 declare uminus_integer.rep_eq [simp]
 
 lift_definition minus_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"
   is "minus :: int \<Rightarrow> int \<Rightarrow> int"
   .
 
 declare minus_integer.rep_eq [simp]
 
 lift_definition times_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"
   is "times :: int \<Rightarrow> int \<Rightarrow> int"
   .
 
 declare times_integer.rep_eq [simp]
 
 instance proof
 qed (transfer, simp add: algebra_simps)+
 
 end
 
 instance integer :: Rings.dvd ..
 
 context
   includes lifting_syntax
   notes transfer_rule_numeral [transfer_rule]
 begin
 
 lemma [transfer_rule]:
   "(pcr_integer ===> pcr_integer ===> (\<longleftrightarrow>)) (dvd) (dvd)"
   by (unfold dvd_def) transfer_prover
 
 lemma [transfer_rule]:
   "((\<longleftrightarrow>) ===> pcr_integer) of_bool of_bool"
   by (unfold of_bool_def) transfer_prover
 
 lemma [transfer_rule]:
   "((=) ===> pcr_integer) int of_nat"
   by (rule transfer_rule_of_nat) transfer_prover+
 
 lemma [transfer_rule]:
   "((=) ===> pcr_integer) (\<lambda>k. k) of_int"
 proof -
   have "((=) ===> pcr_integer) of_int of_int"
     by (rule transfer_rule_of_int) transfer_prover+
   then show ?thesis by (simp add: id_def)
 qed
 
 lemma [transfer_rule]:
   "((=) ===> pcr_integer) numeral numeral"
   by transfer_prover
 
 lemma [transfer_rule]:
   "((=) ===> (=) ===> pcr_integer) Num.sub Num.sub"
   by (unfold Num.sub_def) transfer_prover
 
 lemma [transfer_rule]:
   "(pcr_integer ===> (=) ===> pcr_integer) (^) (^)"
   by (unfold power_def) transfer_prover
 
 end
 
 lemma int_of_integer_of_nat [simp]:
   "int_of_integer (of_nat n) = of_nat n"
   by transfer rule
 
 lift_definition integer_of_nat :: "nat \<Rightarrow> integer"
   is "of_nat :: nat \<Rightarrow> int"
   .
 
 lemma integer_of_nat_eq_of_nat [code]:
   "integer_of_nat = of_nat"
   by transfer rule
 
 lemma int_of_integer_integer_of_nat [simp]:
   "int_of_integer (integer_of_nat n) = of_nat n"
   by transfer rule
 
 lift_definition nat_of_integer :: "integer \<Rightarrow> nat"
   is Int.nat
   .
 
 lemma nat_of_integer_of_nat [simp]:
   "nat_of_integer (of_nat n) = n"
   by transfer simp
 
 lemma int_of_integer_of_int [simp]:
   "int_of_integer (of_int k) = k"
   by transfer simp
 
 lemma nat_of_integer_integer_of_nat [simp]:
   "nat_of_integer (integer_of_nat n) = n"
   by transfer simp
 
 lemma integer_of_int_eq_of_int [simp, code_abbrev]:
   "integer_of_int = of_int"
   by transfer (simp add: fun_eq_iff)
 
 lemma of_int_integer_of [simp]:
   "of_int (int_of_integer k) = (k :: integer)"
   by transfer rule
 
 lemma int_of_integer_numeral [simp]:
   "int_of_integer (numeral k) = numeral k"
   by transfer rule
 
 lemma int_of_integer_sub [simp]:
   "int_of_integer (Num.sub k l) = Num.sub k l"
   by transfer rule
 
 definition integer_of_num :: "num \<Rightarrow> integer"
   where [simp]: "integer_of_num = numeral"
 
 lemma integer_of_num [code]:
   "integer_of_num Num.One = 1"
   "integer_of_num (Num.Bit0 n) = (let k = integer_of_num n in k + k)"
   "integer_of_num (Num.Bit1 n) = (let k = integer_of_num n in k + k + 1)"
   by (simp_all only: integer_of_num_def numeral.simps Let_def)
 
 lemma integer_of_num_triv:
   "integer_of_num Num.One = 1"
   "integer_of_num (Num.Bit0 Num.One) = 2"
   by simp_all
 
 instantiation integer :: equal
 begin
 
 lift_definition equal_integer :: \<open>integer \<Rightarrow> integer \<Rightarrow> bool\<close>
   is \<open>HOL.equal :: int \<Rightarrow> int \<Rightarrow> bool\<close>
   .
 
 instance
   by (standard; transfer) (fact equal_eq)
 
 end
 
 instantiation integer :: linordered_idom
 begin
 
 lift_definition abs_integer :: \<open>integer \<Rightarrow> integer\<close>
   is \<open>abs :: int \<Rightarrow> int\<close>
   .
 
 declare abs_integer.rep_eq [simp]
 
 lift_definition sgn_integer :: \<open>integer \<Rightarrow> integer\<close>
   is \<open>sgn :: int \<Rightarrow> int\<close>
   .
 
 declare sgn_integer.rep_eq [simp]
 
 lift_definition less_eq_integer :: \<open>integer \<Rightarrow> integer \<Rightarrow> bool\<close>
   is \<open>less_eq :: int \<Rightarrow> int \<Rightarrow> bool\<close>
   .
 
 lemma integer_less_eq_iff:
   \<open>k \<le> l \<longleftrightarrow> int_of_integer k \<le> int_of_integer l\<close>
   by (fact less_eq_integer.rep_eq)
 
 lift_definition less_integer :: \<open>integer \<Rightarrow> integer \<Rightarrow> bool\<close>
   is \<open>less :: int \<Rightarrow> int \<Rightarrow> bool\<close>
   .
 
 lemma integer_less_iff:
   \<open>k < l \<longleftrightarrow> int_of_integer k < int_of_integer l\<close>
   by (fact less_integer.rep_eq)
 
 instance
   by (standard; transfer)
     (simp_all add: algebra_simps less_le_not_le [symmetric] mult_strict_right_mono linear)
 
 end
 
 instance integer :: discrete_linordered_semidom
   by (standard; transfer)
     (fact less_iff_succ_less_eq)
 
 context
   includes lifting_syntax
 begin
 
 lemma [transfer_rule]:
   \<open>(pcr_integer ===> pcr_integer ===> pcr_integer) min min\<close>
   by (unfold min_def) transfer_prover
 
 lemma [transfer_rule]:
   \<open>(pcr_integer ===> pcr_integer ===> pcr_integer) max max\<close>
   by (unfold max_def) transfer_prover
 
 end
 
 lemma int_of_integer_min [simp]:
   "int_of_integer (min k l) = min (int_of_integer k) (int_of_integer l)"
   by transfer rule
 
 lemma int_of_integer_max [simp]:
   "int_of_integer (max k l) = max (int_of_integer k) (int_of_integer l)"
   by transfer rule
 
 lemma nat_of_integer_non_positive [simp]:
   "k \<le> 0 \<Longrightarrow> nat_of_integer k = 0"
   by transfer simp
 
 lemma of_nat_of_integer [simp]:
   "of_nat (nat_of_integer k) = max 0 k"
   by transfer auto
 
 instantiation integer :: unique_euclidean_ring
 begin
 
 lift_definition divide_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"
   is "divide :: int \<Rightarrow> int \<Rightarrow> int"
   .
 
 declare divide_integer.rep_eq [simp]
 
 lift_definition modulo_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"
   is "modulo :: int \<Rightarrow> int \<Rightarrow> int"
   .
 
 declare modulo_integer.rep_eq [simp]
 
 lift_definition euclidean_size_integer :: "integer \<Rightarrow> nat"
   is "euclidean_size :: int \<Rightarrow> nat"
   .
 
 declare euclidean_size_integer.rep_eq [simp]
 
 lift_definition division_segment_integer :: "integer \<Rightarrow> integer"
   is "division_segment :: int \<Rightarrow> int"
   .
 
 declare division_segment_integer.rep_eq [simp]
 
 instance
   apply (standard; transfer)
   apply (use mult_le_mono2 [of 1] in \<open>auto simp add: sgn_mult_abs abs_mult sgn_mult abs_mod_less sgn_mod nat_mult_distrib
      division_segment_mult division_segment_mod\<close>)
   apply (simp add: division_segment_int_def split: if_splits)
   done
 
 end
 
 lemma [code]:
   "euclidean_size = nat_of_integer \<circ> abs"
   by (simp add: fun_eq_iff nat_of_integer.rep_eq)
 
 lemma [code]:
   "division_segment (k :: integer) = (if k \<ge> 0 then 1 else - 1)"
   by transfer (simp add: division_segment_int_def)
 
 instance integer :: linordered_euclidean_semiring
   by (standard; transfer) (simp_all add: of_nat_div division_segment_int_def)
 
 instantiation integer :: ring_bit_operations
 begin
 
 lift_definition bit_integer :: \<open>integer \<Rightarrow> nat \<Rightarrow> bool\<close>
   is bit .
 
 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 .
 
 lift_definition set_bit_integer :: \<open>nat \<Rightarrow> integer \<Rightarrow> integer\<close>
   is set_bit .
 
 lift_definition unset_bit_integer :: \<open>nat \<Rightarrow> integer \<Rightarrow> integer\<close>
   is unset_bit .
 
 lift_definition flip_bit_integer :: \<open>nat \<Rightarrow> integer \<Rightarrow> integer\<close>
   is flip_bit .
 
 lift_definition push_bit_integer :: \<open>nat \<Rightarrow> integer \<Rightarrow> integer\<close>
   is push_bit .
 
 lift_definition drop_bit_integer :: \<open>nat \<Rightarrow> integer \<Rightarrow> integer\<close>
   is drop_bit .
 
 lift_definition take_bit_integer :: \<open>nat \<Rightarrow> integer \<Rightarrow> integer\<close>
   is take_bit .
 
 instance by (standard; transfer)
-  (fact bit_induct bits_div_by_0 bits_div_by_1 bits_0_div even_half_succ_eq
+  (fact bit_induct div_by_0 div_by_1 div_0 even_half_succ_eq
     half_div_exp_eq even_double_div_exp_iff even_decr_exp_div_exp_iff even_mod_exp_diff_exp_iff
     bit_iff_odd push_bit_eq_mult drop_bit_eq_div take_bit_eq_mod
     and_rec or_rec xor_rec mask_eq_exp_minus_1
     set_bit_eq_or unset_bit_eq_or_xor flip_bit_eq_xor not_eq_complement)+
 
 end
 
 
 
 instance integer :: linordered_euclidean_semiring_bit_operations ..
 
 context
   includes bit_operations_syntax
 begin
 
 lemma [code]:
   \<open>bit k n \<longleftrightarrow> odd (drop_bit n k)\<close>
   \<open>NOT k = - k - 1\<close>
   \<open>mask n = 2 ^ n - (1 :: integer)\<close>
   \<open>set_bit n k = k OR push_bit n 1\<close>
   \<open>unset_bit n k = k AND NOT (push_bit n 1)\<close>
   \<open>flip_bit n k = k XOR push_bit n 1\<close>
   \<open>push_bit n k = k * 2 ^ n\<close>
   \<open>drop_bit n k = k div 2 ^ n\<close>
   \<open>take_bit n k = k mod 2 ^ n\<close> for k :: integer
   by (fact bit_iff_odd_drop_bit not_eq_complement mask_eq_exp_minus_1
     set_bit_eq_or unset_bit_eq_and_not flip_bit_eq_xor push_bit_eq_mult drop_bit_eq_div take_bit_eq_mod)+
 
 lemma [code]:
   \<open>k AND l = (if k = 0 \<or> l = 0 then 0 else if k = - 1 then l else if l = - 1 then k
     else (k mod 2) * (l mod 2) + 2 * ((k div 2) AND (l div 2)))\<close> for k l :: integer
   by transfer (fact and_int_unfold) 
 
 lemma [code]:
   \<open>k OR l = (if k = - 1 \<or> l = - 1 then - 1 else if k = 0 then l else if l = 0 then k
     else max (k mod 2) (l mod 2) + 2 * ((k div 2) OR (l div 2)))\<close> for k l :: integer
   by transfer (fact or_int_unfold)
 
 lemma [code]:
   \<open>k XOR l = (if k = - 1 then NOT l else if l = - 1 then NOT k else if k = 0 then l else if l = 0 then k
     else \<bar>k mod 2 - l mod 2\<bar> + 2 * ((k div 2) XOR (l div 2)))\<close> for k l :: integer
   by transfer (fact xor_int_unfold)
 
 end
 
 instantiation integer :: linordered_euclidean_semiring_division
 begin
 
 definition divmod_integer :: "num \<Rightarrow> num \<Rightarrow> integer \<times> integer"
 where
   divmod_integer'_def: "divmod_integer m n = (numeral m div numeral n, numeral m mod numeral n)"
 
 definition divmod_step_integer :: "integer \<Rightarrow> integer \<times> integer \<Rightarrow> integer \<times> integer"
 where
   "divmod_step_integer l qr = (let (q, r) = qr
     in if \<bar>l\<bar> \<le> \<bar>r\<bar> then (2 * q + 1, r - l)
     else (2 * q, r))"
 
 instance by standard
   (auto simp add: divmod_integer'_def divmod_step_integer_def integer_less_eq_iff)
 
 end
 
 declare divmod_algorithm_code [where ?'a = integer,
   folded integer_of_num_def, unfolded integer_of_num_triv,
   code]
 
 lemma integer_of_nat_0: "integer_of_nat 0 = 0"
 by transfer simp
 
 lemma integer_of_nat_1: "integer_of_nat 1 = 1"
 by transfer simp
 
 lemma integer_of_nat_numeral:
   "integer_of_nat (numeral n) = numeral n"
 by transfer simp
 
 
 subsection \<open>Code theorems for target language integers\<close>
 
 text \<open>Constructors\<close>
 
 definition Pos :: "num \<Rightarrow> integer"
 where
   [simp, code_post]: "Pos = numeral"
 
 context
   includes lifting_syntax
 begin
 
 lemma [transfer_rule]:
   \<open>((=) ===> pcr_integer) numeral Pos\<close>
   by simp transfer_prover
 
 end
 
 lemma Pos_fold [code_unfold]:
   "numeral Num.One = Pos Num.One"
   "numeral (Num.Bit0 k) = Pos (Num.Bit0 k)"
   "numeral (Num.Bit1 k) = Pos (Num.Bit1 k)"
   by simp_all
 
 definition Neg :: "num \<Rightarrow> integer"
 where
   [simp, code_abbrev]: "Neg n = - Pos n"
 
 context
   includes lifting_syntax
 begin
 
 lemma [transfer_rule]:
   \<open>((=) ===> pcr_integer) (\<lambda>n. - numeral n) Neg\<close>
   by (unfold Neg_def) transfer_prover
 
 end
 
 code_datatype "0::integer" Pos Neg
 
   
 text \<open>A further pair of constructors for generated computations\<close>
 
 context
 begin  
 
 qualified definition positive :: "num \<Rightarrow> integer"
   where [simp]: "positive = numeral"
 
 qualified definition negative :: "num \<Rightarrow> integer"
   where [simp]: "negative = uminus \<circ> numeral"
 
 lemma [code_computation_unfold]:
   "numeral = positive"
   "Pos = positive"
   "Neg = negative"
   by (simp_all add: fun_eq_iff)
 
 end
 
 
 text \<open>Auxiliary operations\<close>
 
 lift_definition dup :: "integer \<Rightarrow> integer"
   is "\<lambda>k::int. k + k"
   .
 
 lemma dup_code [code]:
   "dup 0 = 0"
   "dup (Pos n) = Pos (Num.Bit0 n)"
   "dup (Neg n) = Neg (Num.Bit0 n)"
   by (transfer, simp only: numeral_Bit0 minus_add_distrib)+
 
 lift_definition sub :: "num \<Rightarrow> num \<Rightarrow> integer"
   is "\<lambda>m n. numeral m - numeral n :: int"
   .
 
 lemma sub_code [code]:
   "sub Num.One Num.One = 0"
   "sub (Num.Bit0 m) Num.One = Pos (Num.BitM m)"
   "sub (Num.Bit1 m) Num.One = Pos (Num.Bit0 m)"
   "sub Num.One (Num.Bit0 n) = Neg (Num.BitM n)"
   "sub Num.One (Num.Bit1 n) = Neg (Num.Bit0 n)"
   "sub (Num.Bit0 m) (Num.Bit0 n) = dup (sub m n)"
   "sub (Num.Bit1 m) (Num.Bit1 n) = dup (sub m n)"
   "sub (Num.Bit1 m) (Num.Bit0 n) = dup (sub m n) + 1"
   "sub (Num.Bit0 m) (Num.Bit1 n) = dup (sub m n) - 1"
   by (transfer, simp add: dbl_def dbl_inc_def dbl_dec_def)+
 
 
 text \<open>Implementations\<close>
 
 lemma one_integer_code [code, code_unfold]:
   "1 = Pos Num.One"
   by simp
 
 lemma plus_integer_code [code]:
   "k + 0 = (k::integer)"
   "0 + l = (l::integer)"
   "Pos m + Pos n = Pos (m + n)"
   "Pos m + Neg n = sub m n"
   "Neg m + Pos n = sub n m"
   "Neg m + Neg n = Neg (m + n)"
   by (transfer, simp)+
 
 lemma uminus_integer_code [code]:
   "uminus 0 = (0::integer)"
   "uminus (Pos m) = Neg m"
   "uminus (Neg m) = Pos m"
   by simp_all
 
 lemma minus_integer_code [code]:
   "k - 0 = (k::integer)"
   "0 - l = uminus (l::integer)"
   "Pos m - Pos n = sub m n"
   "Pos m - Neg n = Pos (m + n)"
   "Neg m - Pos n = Neg (m + n)"
   "Neg m - Neg n = sub n m"
   by (transfer, simp)+
 
 lemma abs_integer_code [code]:
   "\<bar>k\<bar> = (if (k::integer) < 0 then - k else k)"
   by simp
 
 lemma sgn_integer_code [code]:
   "sgn k = (if k = 0 then 0 else if (k::integer) < 0 then - 1 else 1)"
   by simp
 
 lemma times_integer_code [code]:
   "k * 0 = (0::integer)"
   "0 * l = (0::integer)"
   "Pos m * Pos n = Pos (m * n)"
   "Pos m * Neg n = Neg (m * n)"
   "Neg m * Pos n = Neg (m * n)"
   "Neg m * Neg n = Pos (m * n)"
   by simp_all
 
 definition divmod_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer \<times> integer"
 where
   "divmod_integer k l = (k div l, k mod l)"
 
 lemma fst_divmod_integer [simp]:
   "fst (divmod_integer k l) = k div l"
   by (simp add: divmod_integer_def)
 
 lemma snd_divmod_integer [simp]:
   "snd (divmod_integer k l) = k mod l"
   by (simp add: divmod_integer_def)
 
 definition divmod_abs :: "integer \<Rightarrow> integer \<Rightarrow> integer \<times> integer"
 where
   "divmod_abs k l = (\<bar>k\<bar> div \<bar>l\<bar>, \<bar>k\<bar> mod \<bar>l\<bar>)"
 
 lemma fst_divmod_abs [simp]:
   "fst (divmod_abs k l) = \<bar>k\<bar> div \<bar>l\<bar>"
   by (simp add: divmod_abs_def)
 
 lemma snd_divmod_abs [simp]:
   "snd (divmod_abs k l) = \<bar>k\<bar> mod \<bar>l\<bar>"
   by (simp add: divmod_abs_def)
 
 lemma divmod_abs_code [code]:
   "divmod_abs (Pos k) (Pos l) = divmod k l"
   "divmod_abs (Neg k) (Neg l) = divmod k l"
   "divmod_abs (Neg k) (Pos l) = divmod k l"
   "divmod_abs (Pos k) (Neg l) = divmod k l"
   "divmod_abs j 0 = (0, \<bar>j\<bar>)"
   "divmod_abs 0 j = (0, 0)"
   by (simp_all add: prod_eq_iff)
 
 lemma divmod_integer_eq_cases:
   "divmod_integer k l =
     (if k = 0 then (0, 0) else if l = 0 then (0, k) else
     (apsnd \<circ> times \<circ> sgn) l (if sgn k = sgn l
       then divmod_abs k l
       else (let (r, s) = divmod_abs k l in
         if s = 0 then (- r, 0) else (- r - 1, \<bar>l\<bar> - s))))"
 proof -
   have *: "sgn k = sgn l \<longleftrightarrow> k = 0 \<and> l = 0 \<or> 0 < l \<and> 0 < k \<or> l < 0 \<and> k < 0" for k l :: int
     by (auto simp add: sgn_if)
   have **: "- k = l * q \<longleftrightarrow> k = - (l * q)" for k l q :: int
     by auto
   show ?thesis
     by (simp add: divmod_integer_def divmod_abs_def)
       (transfer, auto simp add: * ** not_less zdiv_zminus1_eq_if zmod_zminus1_eq_if div_minus_right mod_minus_right)
 qed
 
 lemma divmod_integer_code [code]: \<^marker>\<open>contributor \<open>René Thiemann\<close>\<close> \<^marker>\<open>contributor \<open>Akihisa Yamada\<close>\<close>
   "divmod_integer k l =
    (if k = 0 then (0, 0)
     else if l > 0 then
             (if k > 0 then Code_Numeral.divmod_abs k l
              else case Code_Numeral.divmod_abs k l of (r, s) \<Rightarrow>
                   if s = 0 then (- r, 0) else (- r - 1, l - s))
     else if l = 0 then (0, k)
     else apsnd uminus
             (if k < 0 then Code_Numeral.divmod_abs k l
              else case Code_Numeral.divmod_abs k l of (r, s) \<Rightarrow>
                   if s = 0 then (- r, 0) else (- r - 1, - l - s)))"
   by (cases l "0 :: integer" rule: linorder_cases)
     (auto split: prod.splits simp add: divmod_integer_eq_cases)
 
 lemma div_integer_code [code]:
   "k div l = fst (divmod_integer k l)"
   by simp
 
 lemma mod_integer_code [code]:
   "k mod l = snd (divmod_integer k l)"
   by simp
 
 definition bit_cut_integer :: "integer \<Rightarrow> integer \<times> bool"
   where "bit_cut_integer k = (k div 2, odd k)"
 
 lemma bit_cut_integer_code [code]:
   "bit_cut_integer k = (if k = 0 then (0, False)
      else let (r, s) = Code_Numeral.divmod_abs k 2
        in (if k > 0 then r else - r - s, s = 1))"
 proof -
   have "bit_cut_integer k = (let (r, s) = divmod_integer k 2 in (r, s = 1))"
     by (simp add: divmod_integer_def bit_cut_integer_def odd_iff_mod_2_eq_one)
   then show ?thesis
     by (simp add: divmod_integer_code) (auto simp add: split_def)
 qed
 
 lemma equal_integer_code [code]:
   "HOL.equal 0 (0::integer) \<longleftrightarrow> True"
   "HOL.equal 0 (Pos l) \<longleftrightarrow> False"
   "HOL.equal 0 (Neg l) \<longleftrightarrow> False"
   "HOL.equal (Pos k) 0 \<longleftrightarrow> False"
   "HOL.equal (Pos k) (Pos l) \<longleftrightarrow> HOL.equal k l"
   "HOL.equal (Pos k) (Neg l) \<longleftrightarrow> False"
   "HOL.equal (Neg k) 0 \<longleftrightarrow> False"
   "HOL.equal (Neg k) (Pos l) \<longleftrightarrow> False"
   "HOL.equal (Neg k) (Neg l) \<longleftrightarrow> HOL.equal k l"
   by (simp_all add: equal)
 
 lemma equal_integer_refl [code nbe]:
   "HOL.equal (k::integer) k \<longleftrightarrow> True"
   by (fact equal_refl)
 
 lemma less_eq_integer_code [code]:
   "0 \<le> (0::integer) \<longleftrightarrow> True"
   "0 \<le> Pos l \<longleftrightarrow> True"
   "0 \<le> Neg l \<longleftrightarrow> False"
   "Pos k \<le> 0 \<longleftrightarrow> False"
   "Pos k \<le> Pos l \<longleftrightarrow> k \<le> l"
   "Pos k \<le> Neg l \<longleftrightarrow> False"
   "Neg k \<le> 0 \<longleftrightarrow> True"
   "Neg k \<le> Pos l \<longleftrightarrow> True"
   "Neg k \<le> Neg l \<longleftrightarrow> l \<le> k"
   by simp_all
 
 lemma less_integer_code [code]:
   "0 < (0::integer) \<longleftrightarrow> False"
   "0 < Pos l \<longleftrightarrow> True"
   "0 < Neg l \<longleftrightarrow> False"
   "Pos k < 0 \<longleftrightarrow> False"
   "Pos k < Pos l \<longleftrightarrow> k < l"
   "Pos k < Neg l \<longleftrightarrow> False"
   "Neg k < 0 \<longleftrightarrow> True"
   "Neg k < Pos l \<longleftrightarrow> True"
   "Neg k < Neg l \<longleftrightarrow> l < k"
   by simp_all
 
 lift_definition num_of_integer :: "integer \<Rightarrow> num"
   is "num_of_nat \<circ> nat"
   .
 
 lemma num_of_integer_code [code]:
   "num_of_integer k = (if k \<le> 1 then Num.One
      else let
        (l, j) = divmod_integer k 2;
        l' = num_of_integer l;
        l'' = l' + l'
      in if j = 0 then l'' else l'' + Num.One)"
 proof -
   {
     assume "int_of_integer k mod 2 = 1"
     then have "nat (int_of_integer k mod 2) = nat 1" by simp
     moreover assume *: "1 < int_of_integer k"
     ultimately have **: "nat (int_of_integer k) mod 2 = 1" by (simp add: nat_mod_distrib)
     have "num_of_nat (nat (int_of_integer k)) =
       num_of_nat (2 * (nat (int_of_integer k) div 2) + nat (int_of_integer k) mod 2)"
       by simp
     then have "num_of_nat (nat (int_of_integer k)) =
       num_of_nat (nat (int_of_integer k) div 2 + nat (int_of_integer k) div 2 + nat (int_of_integer k) mod 2)"
       by (simp add: mult_2)
     with ** have "num_of_nat (nat (int_of_integer k)) =
       num_of_nat (nat (int_of_integer k) div 2 + nat (int_of_integer k) div 2 + 1)"
       by simp
   }
   note aux = this
   show ?thesis
     by (auto simp add: num_of_integer_def nat_of_integer_def Let_def case_prod_beta
       not_le integer_eq_iff less_eq_integer_def
       nat_mult_distrib nat_div_distrib num_of_nat_One num_of_nat_plus_distrib
        mult_2 [where 'a=nat] aux add_One)
 qed
 
 lemma nat_of_integer_code [code]:
   "nat_of_integer k = (if k \<le> 0 then 0
      else let
        (l, j) = divmod_integer k 2;
        l' = nat_of_integer l;
        l'' = l' + l'
      in if j = 0 then l'' else l'' + 1)"
 proof -
   obtain j where k: "k = integer_of_int j"
   proof
     show "k = integer_of_int (int_of_integer k)" by simp
   qed
   have *: "nat j mod 2 = nat_of_integer (of_int j mod 2)" if "j \<ge> 0"
     using that by transfer (simp add: nat_mod_distrib)
   from k show ?thesis
     by (auto simp add: split_def Let_def nat_of_integer_def nat_div_distrib mult_2 [symmetric]
       minus_mod_eq_mult_div [symmetric] *)
 qed
 
 lemma int_of_integer_code [code]:
   "int_of_integer k = (if k < 0 then - (int_of_integer (- k))
      else if k = 0 then 0
      else let
        (l, j) = divmod_integer k 2;
        l' = 2 * int_of_integer l
      in if j = 0 then l' else l' + 1)"
   by (auto simp add: split_def Let_def integer_eq_iff minus_mod_eq_mult_div [symmetric])
 
 lemma integer_of_int_code [code]:
   "integer_of_int k = (if k < 0 then - (integer_of_int (- k))
      else if k = 0 then 0
      else let
        l = 2 * integer_of_int (k div 2);
        j = k mod 2
      in if j = 0 then l else l + 1)"
   by (auto simp add: split_def Let_def integer_eq_iff minus_mod_eq_mult_div [symmetric])
 
 hide_const (open) Pos Neg sub dup divmod_abs
 
 
 subsection \<open>Serializer setup for target language integers\<close>
 
 code_reserved Eval int Integer abs
 
 code_printing
   type_constructor integer \<rightharpoonup>
     (SML) "IntInf.int"
     and (OCaml) "Z.t"
     and (Haskell) "Integer"
     and (Scala) "BigInt"
     and (Eval) "int"
 | class_instance integer :: equal \<rightharpoonup>
     (Haskell) -
 
 code_printing
   constant "0::integer" \<rightharpoonup>
     (SML) "!(0/ :/ IntInf.int)"
     and (OCaml) "Z.zero"
     and (Haskell) "!(0/ ::/ Integer)"
     and (Scala) "BigInt(0)"
 
 setup \<open>
   fold (fn target =>
     Numeral.add_code \<^const_name>\<open>Code_Numeral.Pos\<close> I Code_Printer.literal_numeral target
     #> Numeral.add_code \<^const_name>\<open>Code_Numeral.Neg\<close> (~) Code_Printer.literal_numeral target)
     ["SML", "OCaml", "Haskell", "Scala"]
 \<close>
 
 code_printing
   constant "plus :: integer \<Rightarrow> _ \<Rightarrow> _" \<rightharpoonup>
     (SML) "IntInf.+ ((_), (_))"
     and (OCaml) "Z.add"
     and (Haskell) infixl 6 "+"
     and (Scala) infixl 7 "+"
     and (Eval) infixl 8 "+"
 | constant "uminus :: integer \<Rightarrow> _" \<rightharpoonup>
     (SML) "IntInf.~"
     and (OCaml) "Z.neg"
     and (Haskell) "negate"
     and (Scala) "!(- _)"
     and (Eval) "~/ _"
 | constant "minus :: integer \<Rightarrow> _" \<rightharpoonup>
     (SML) "IntInf.- ((_), (_))"
     and (OCaml) "Z.sub"
     and (Haskell) infixl 6 "-"
     and (Scala) infixl 7 "-"
     and (Eval) infixl 8 "-"
 | constant Code_Numeral.dup \<rightharpoonup>
     (SML) "IntInf.*/ (2,/ (_))"
     and (OCaml) "Z.shift'_left/ _/ 1"
     and (Haskell) "!(2 * _)"
     and (Scala) "!(2 * _)"
     and (Eval) "!(2 * _)"
 | constant Code_Numeral.sub \<rightharpoonup>
     (SML) "!(raise/ Fail/ \"sub\")"
     and (OCaml) "failwith/ \"sub\""
     and (Haskell) "error/ \"sub\""
     and (Scala) "!sys.error(\"sub\")"
 | constant "times :: integer \<Rightarrow> _ \<Rightarrow> _" \<rightharpoonup>
     (SML) "IntInf.* ((_), (_))"
     and (OCaml) "Z.mul"
     and (Haskell) infixl 7 "*"
     and (Scala) infixl 8 "*"
     and (Eval) infixl 9 "*"
 | constant Code_Numeral.divmod_abs \<rightharpoonup>
     (SML) "IntInf.divMod/ (IntInf.abs _,/ IntInf.abs _)"
     and (OCaml) "!(fun k l ->/ if Z.equal Z.zero l then/ (Z.zero, l) else/ Z.div'_rem/ (Z.abs k)/ (Z.abs l))"
     and (Haskell) "divMod/ (abs _)/ (abs _)"
     and (Scala) "!((k: BigInt) => (l: BigInt) =>/ if (l == 0)/ (BigInt(0), k) else/ (k.abs '/% l.abs))"
     and (Eval) "Integer.div'_mod/ (abs _)/ (abs _)"
 | constant "HOL.equal :: integer \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
     (SML) "!((_ : IntInf.int) = _)"
     and (OCaml) "Z.equal"
     and (Haskell) infix 4 "=="
     and (Scala) infixl 5 "=="
     and (Eval) infixl 6 "="
 | constant "less_eq :: integer \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
     (SML) "IntInf.<= ((_), (_))"
     and (OCaml) "Z.leq"
     and (Haskell) infix 4 "<="
     and (Scala) infixl 4 "<="
     and (Eval) infixl 6 "<="
 | constant "less :: integer \<Rightarrow> _ \<Rightarrow> bool" \<rightharpoonup>
     (SML) "IntInf.< ((_), (_))"
     and (OCaml) "Z.lt"
     and (Haskell) infix 4 "<"
     and (Scala) infixl 4 "<"
     and (Eval) infixl 6 "<"
 | constant "abs :: integer \<Rightarrow> _" \<rightharpoonup>
     (SML) "IntInf.abs"
     and (OCaml) "Z.abs"
     and (Haskell) "Prelude.abs"
     and (Scala) "_.abs"
     and (Eval) "abs"
 
 code_identifier
   code_module Code_Numeral \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith
 
 
 subsection \<open>Type of target language naturals\<close>
 
 typedef natural = "UNIV :: nat set"
   morphisms nat_of_natural natural_of_nat ..
 
 setup_lifting type_definition_natural
 
 lemma natural_eq_iff [termination_simp]:
   "m = n \<longleftrightarrow> nat_of_natural m = nat_of_natural n"
   by transfer rule
 
 lemma natural_eqI:
   "nat_of_natural m = nat_of_natural n \<Longrightarrow> m = n"
   using natural_eq_iff [of m n] by simp
 
 lemma nat_of_natural_of_nat_inverse [simp]:
   "nat_of_natural (natural_of_nat n) = n"
   by transfer rule
 
 lemma natural_of_nat_of_natural_inverse [simp]:
   "natural_of_nat (nat_of_natural n) = n"
   by transfer rule
 
 instantiation natural :: "{comm_monoid_diff, semiring_1}"
 begin
 
 lift_definition zero_natural :: natural
   is "0 :: nat"
   .
 
 declare zero_natural.rep_eq [simp]
 
 lift_definition one_natural :: natural
   is "1 :: nat"
   .
 
 declare one_natural.rep_eq [simp]
 
 lift_definition plus_natural :: "natural \<Rightarrow> natural \<Rightarrow> natural"
   is "plus :: nat \<Rightarrow> nat \<Rightarrow> nat"
   .
 
 declare plus_natural.rep_eq [simp]
 
 lift_definition minus_natural :: "natural \<Rightarrow> natural \<Rightarrow> natural"
   is "minus :: nat \<Rightarrow> nat \<Rightarrow> nat"
   .
 
 declare minus_natural.rep_eq [simp]
 
 lift_definition times_natural :: "natural \<Rightarrow> natural \<Rightarrow> natural"
   is "times :: nat \<Rightarrow> nat \<Rightarrow> nat"
   .
 
 declare times_natural.rep_eq [simp]
 
 instance proof
 qed (transfer, simp add: algebra_simps)+
 
 end
 
 instance natural :: Rings.dvd ..
 
 context
   includes lifting_syntax
 begin
 
 lemma [transfer_rule]:
   \<open>(pcr_natural ===> pcr_natural ===> (\<longleftrightarrow>)) (dvd) (dvd)\<close>
   by (unfold dvd_def) transfer_prover
 
 lemma [transfer_rule]:
   \<open>((\<longleftrightarrow>) ===> pcr_natural) of_bool of_bool\<close>
   by (unfold of_bool_def) transfer_prover
 
 lemma [transfer_rule]:
   \<open>((=) ===> pcr_natural) (\<lambda>n. n) of_nat\<close>
 proof -
   have "rel_fun HOL.eq pcr_natural (of_nat :: nat \<Rightarrow> nat) (of_nat :: nat \<Rightarrow> natural)"
     by (unfold of_nat_def) transfer_prover
   then show ?thesis by (simp add: id_def)
 qed
 
 lemma [transfer_rule]:
   \<open>((=) ===> pcr_natural) numeral numeral\<close>
 proof -
   have \<open>((=) ===> pcr_natural) numeral (\<lambda>n. of_nat (numeral n))\<close>
     by transfer_prover
   then show ?thesis by simp
 qed
 
 lemma [transfer_rule]:
   \<open>(pcr_natural ===> (=) ===> pcr_natural) (^) (^)\<close>
   by (unfold power_def) transfer_prover
 
 end
 
 lemma nat_of_natural_of_nat [simp]:
   "nat_of_natural (of_nat n) = n"
   by transfer rule
 
 lemma natural_of_nat_of_nat [simp, code_abbrev]:
   "natural_of_nat = of_nat"
   by transfer rule
 
 lemma of_nat_of_natural [simp]:
   "of_nat (nat_of_natural n) = n"
   by transfer rule
 
 lemma nat_of_natural_numeral [simp]:
   "nat_of_natural (numeral k) = numeral k"
   by transfer rule
 
 instantiation natural :: "{linordered_semiring, equal}"
 begin
 
 lift_definition less_eq_natural :: "natural \<Rightarrow> natural \<Rightarrow> bool"
   is "less_eq :: nat \<Rightarrow> nat \<Rightarrow> bool"
   .
 
 declare less_eq_natural.rep_eq [termination_simp]
 
 lift_definition less_natural :: "natural \<Rightarrow> natural \<Rightarrow> bool"
   is "less :: nat \<Rightarrow> nat \<Rightarrow> bool"
   .
 
 declare less_natural.rep_eq [termination_simp]
 
 lift_definition equal_natural :: "natural \<Rightarrow> natural \<Rightarrow> bool"
   is "HOL.equal :: nat \<Rightarrow> nat \<Rightarrow> bool"
   .
 
 instance proof
 qed (transfer, simp add: algebra_simps equal less_le_not_le [symmetric] linear)+
 
 end
 
 context
   includes lifting_syntax
 begin
 
 lemma [transfer_rule]:
   \<open>(pcr_natural ===> pcr_natural ===> pcr_natural) min min\<close>
   by (unfold min_def) transfer_prover
 
 lemma [transfer_rule]:
   \<open>(pcr_natural ===> pcr_natural ===> pcr_natural) max max\<close>
   by (unfold max_def) transfer_prover
 
 end
 
 lemma nat_of_natural_min [simp]:
   "nat_of_natural (min k l) = min (nat_of_natural k) (nat_of_natural l)"
   by transfer rule
 
 lemma nat_of_natural_max [simp]:
   "nat_of_natural (max k l) = max (nat_of_natural k) (nat_of_natural l)"
   by transfer rule
 
 instantiation natural :: unique_euclidean_semiring
 begin
 
 lift_definition divide_natural :: "natural \<Rightarrow> natural \<Rightarrow> natural"
   is "divide :: nat \<Rightarrow> nat \<Rightarrow> nat"
   .
 
 declare divide_natural.rep_eq [simp]
 
 lift_definition modulo_natural :: "natural \<Rightarrow> natural \<Rightarrow> natural"
   is "modulo :: nat \<Rightarrow> nat \<Rightarrow> nat"
   .
 
 declare modulo_natural.rep_eq [simp]
 
 lift_definition euclidean_size_natural :: "natural \<Rightarrow> nat"
   is "euclidean_size :: nat \<Rightarrow> nat"
   .
 
 declare euclidean_size_natural.rep_eq [simp]
 
 lift_definition division_segment_natural :: "natural \<Rightarrow> natural"
   is "division_segment :: nat \<Rightarrow> nat"
   .
 
 declare division_segment_natural.rep_eq [simp]
 
 instance
   by (standard; transfer)
     (auto simp add: algebra_simps unit_factor_nat_def gr0_conv_Suc)
 
 end
 
 lemma [code]:
   "euclidean_size = nat_of_natural"
   by (simp add: fun_eq_iff)
 
 lemma [code]:
   "division_segment (n::natural) = 1"
   by (simp add: natural_eq_iff)
 
 instance natural :: discrete_linordered_semidom
   by (standard; transfer) (simp_all add: Suc_le_eq)
 
 instance natural :: linordered_euclidean_semiring
   by (standard; transfer) simp_all
 
 instantiation natural :: semiring_bit_operations
 begin
 
 lift_definition bit_natural :: \<open>natural \<Rightarrow> nat \<Rightarrow> bool\<close>
   is bit .
 
 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 .
 
 lift_definition set_bit_natural :: \<open>nat \<Rightarrow> natural \<Rightarrow> natural\<close>
   is set_bit .
 
 lift_definition unset_bit_natural :: \<open>nat \<Rightarrow> natural \<Rightarrow> natural\<close>
   is unset_bit .
 
 lift_definition flip_bit_natural :: \<open>nat \<Rightarrow> natural \<Rightarrow> natural\<close>
   is flip_bit .
 
 lift_definition push_bit_natural :: \<open>nat \<Rightarrow> natural \<Rightarrow> natural\<close>
   is push_bit .
 
 lift_definition drop_bit_natural :: \<open>nat \<Rightarrow> natural \<Rightarrow> natural\<close>
   is drop_bit .
 
 lift_definition take_bit_natural :: \<open>nat \<Rightarrow> natural \<Rightarrow> natural\<close>
   is take_bit .
 
 instance by (standard; transfer)
-  (fact bit_induct bits_div_by_0 bits_div_by_1 bits_0_div even_half_succ_eq
+  (fact bit_induct div_by_0 div_by_1 div_0 even_half_succ_eq
     half_div_exp_eq even_double_div_exp_iff even_decr_exp_div_exp_iff even_mod_exp_diff_exp_iff
     bit_iff_odd push_bit_eq_mult drop_bit_eq_div take_bit_eq_mod
     and_rec or_rec xor_rec mask_eq_exp_minus_1
     set_bit_eq_or unset_bit_eq_or_xor flip_bit_eq_xor not_eq_complement)+
 
 end
 
 instance natural :: linordered_euclidean_semiring_bit_operations ..
 
 context
   includes bit_operations_syntax
 begin
 
 lemma [code]:
   \<open>bit m n \<longleftrightarrow> odd (drop_bit n m)\<close>
   \<open>mask n = 2 ^ n - (1 :: natural)\<close>
   \<open>set_bit n m = m OR push_bit n 1\<close>
   \<open>flip_bit n m = m XOR push_bit n 1\<close>
   \<open>push_bit n m = m * 2 ^ n\<close>
   \<open>drop_bit n m = m div 2 ^ n\<close>
   \<open>take_bit n m = m mod 2 ^ n\<close> for m :: natural
   by (fact bit_iff_odd_drop_bit mask_eq_exp_minus_1
     set_bit_eq_or flip_bit_eq_xor push_bit_eq_mult drop_bit_eq_div take_bit_eq_mod)+
 
 lemma [code]:
   \<open>m AND n = (if m = 0 \<or> n = 0 then 0
     else (m mod 2) * (n mod 2) + 2 * ((m div 2) AND (n div 2)))\<close> for m n :: natural
   by transfer (fact and_nat_unfold)
 
 lemma [code]:
   \<open>m OR n = (if m = 0 then n else if n = 0 then m
     else max (m mod 2) (n mod 2) + 2 * ((m div 2) OR (n div 2)))\<close> for m n :: natural
   by transfer (fact or_nat_unfold)
 
 lemma [code]:
   \<open>m XOR n = (if m = 0 then n else if n = 0 then m
     else (m mod 2 + n mod 2) mod 2 + 2 * ((m div 2) XOR (n div 2)))\<close> for m n :: natural
   by transfer (fact xor_nat_unfold)
 
 lemma [code]:
   \<open>unset_bit 0 m = 2 * (m div 2)\<close>
   \<open>unset_bit (Suc n) m = m mod 2 + 2 * unset_bit n (m div 2)\<close> for m :: natural
   by (transfer; simp add: unset_bit_Suc)+
 
 end
 
 lift_definition natural_of_integer :: "integer \<Rightarrow> natural"
   is "nat :: int \<Rightarrow> nat"
   .
 
 lift_definition integer_of_natural :: "natural \<Rightarrow> integer"
   is "of_nat :: nat \<Rightarrow> int"
   .
 
 lemma natural_of_integer_of_natural [simp]:
   "natural_of_integer (integer_of_natural n) = n"
   by transfer simp
 
 lemma integer_of_natural_of_integer [simp]:
   "integer_of_natural (natural_of_integer k) = max 0 k"
   by transfer auto
 
 lemma int_of_integer_of_natural [simp]:
   "int_of_integer (integer_of_natural n) = of_nat (nat_of_natural n)"
   by transfer rule
 
 lemma integer_of_natural_of_nat [simp]:
   "integer_of_natural (of_nat n) = of_nat n"
   by transfer rule
 
 lemma [measure_function]:
   "is_measure nat_of_natural"
   by (rule is_measure_trivial)
 
 
 subsection \<open>Inductive representation of target language naturals\<close>
 
 lift_definition Suc :: "natural \<Rightarrow> natural"
   is Nat.Suc
   .
 
 declare Suc.rep_eq [simp]
 
 old_rep_datatype "0::natural" Suc
   by (transfer, fact nat.induct nat.inject nat.distinct)+
 
 lemma natural_cases [case_names nat, cases type: natural]:
   fixes m :: natural
   assumes "\<And>n. m = of_nat n \<Longrightarrow> P"
   shows P
   using assms by transfer blast
 
 instantiation natural :: size
 begin
 
 definition size_nat where [simp, code]: "size_nat = nat_of_natural"
 
 instance ..
 
 end
 
 lemma natural_decr [termination_simp]:
   "n \<noteq> 0 \<Longrightarrow> nat_of_natural n - Nat.Suc 0 < nat_of_natural n"
   by transfer simp
 
 lemma natural_zero_minus_one: "(0::natural) - 1 = 0"
   by (rule zero_diff)
 
 lemma Suc_natural_minus_one: "Suc n - 1 = n"
   by transfer simp
 
 hide_const (open) Suc
 
 
 subsection \<open>Code refinement for target language naturals\<close>
 
 lift_definition Nat :: "integer \<Rightarrow> natural"
   is nat
   .
 
 lemma [code_post]:
   "Nat 0 = 0"
   "Nat 1 = 1"
   "Nat (numeral k) = numeral k"
   by (transfer, simp)+
 
 lemma [code abstype]:
   "Nat (integer_of_natural n) = n"
   by transfer simp
 
 lemma [code]:
   "natural_of_nat n = natural_of_integer (integer_of_nat n)"
   by transfer simp
 
 lemma [code abstract]:
   "integer_of_natural (natural_of_integer k) = max 0 k"
   by simp
 
 lemma [code]:
   \<open>integer_of_natural (mask n) = mask n\<close>
   by transfer (simp add: mask_eq_exp_minus_1 of_nat_diff)
 
 lemma [code_abbrev]:
   "natural_of_integer (Code_Numeral.Pos k) = numeral k"
   by transfer simp
 
 lemma [code abstract]:
   "integer_of_natural 0 = 0"
   by transfer simp
 
 lemma [code abstract]:
   "integer_of_natural 1 = 1"
   by transfer simp
 
 lemma [code abstract]:
   "integer_of_natural (Code_Numeral.Suc n) = integer_of_natural n + 1"
   by transfer simp
 
 lemma [code]:
   "nat_of_natural = nat_of_integer \<circ> integer_of_natural"
   by transfer (simp add: fun_eq_iff)
 
 lemma [code, code_unfold]:
   "case_natural f g n = (if n = 0 then f else g (n - 1))"
   by (cases n rule: natural.exhaust) (simp_all, simp add: Suc_def)
 
 declare natural.rec [code del]
 
 lemma [code abstract]:
   "integer_of_natural (m + n) = integer_of_natural m + integer_of_natural n"
   by transfer simp
 
 lemma [code abstract]:
   "integer_of_natural (m - n) = max 0 (integer_of_natural m - integer_of_natural n)"
   by transfer simp
 
 lemma [code abstract]:
   "integer_of_natural (m * n) = integer_of_natural m * integer_of_natural n"
   by transfer simp
 
 lemma [code abstract]:
   "integer_of_natural (m div n) = integer_of_natural m div integer_of_natural n"
   by transfer (simp add: zdiv_int)
 
 lemma [code abstract]:
   "integer_of_natural (m mod n) = integer_of_natural m mod integer_of_natural n"
   by transfer (simp add: zmod_int)
 
 lemma [code]:
   "HOL.equal m n \<longleftrightarrow> HOL.equal (integer_of_natural m) (integer_of_natural n)"
   by transfer (simp add: equal)
 
 lemma [code nbe]: "HOL.equal n (n::natural) \<longleftrightarrow> True"
   by (rule equal_class.equal_refl)
 
 lemma [code]: "m \<le> n \<longleftrightarrow> integer_of_natural m \<le> integer_of_natural n"
   by transfer simp
 
 lemma [code]: "m < n \<longleftrightarrow> integer_of_natural m < integer_of_natural n"
   by transfer simp
 
 hide_const (open) Nat
 
 code_reflect Code_Numeral
   datatypes natural
   functions "Code_Numeral.Suc" "0 :: natural" "1 :: natural"
     "plus :: natural \<Rightarrow> _" "minus :: natural \<Rightarrow> _"
     "times :: natural \<Rightarrow> _" "divide :: natural \<Rightarrow> _"
     "modulo :: natural \<Rightarrow> _"
     integer_of_natural natural_of_integer
 
 lifting_update integer.lifting
 lifting_forget integer.lifting
 
 lifting_update natural.lifting
 lifting_forget natural.lifting
 
 end
diff --git a/src/HOL/Fields.thy b/src/HOL/Fields.thy
--- a/src/HOL/Fields.thy
+++ b/src/HOL/Fields.thy
@@ -1,1322 +1,1325 @@
 (*  Title:      HOL/Fields.thy
     Author:     Gertrud Bauer
     Author:     Steven Obua
     Author:     Tobias Nipkow
     Author:     Lawrence C Paulson
     Author:     Markus Wenzel
     Author:     Jeremy Avigad
 *)
 
 section \<open>Fields\<close>
 
 theory Fields
 imports Nat
 begin
 
 subsection \<open>Division rings\<close>
 
 text \<open>
   A division ring is like a field, but without the commutativity requirement.
 \<close>
 
 class inverse = divide +
   fixes inverse :: "'a \<Rightarrow> 'a"
 begin
   
 abbreviation inverse_divide :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"  (infixl "'/" 70)
 where
   "inverse_divide \<equiv> divide"
 
 end
 
 text \<open>Setup for linear arithmetic prover\<close>
 
 ML_file \<open>~~/src/Provers/Arith/fast_lin_arith.ML\<close>
 ML_file \<open>Tools/lin_arith.ML\<close>
 setup \<open>Lin_Arith.global_setup\<close>
 declaration \<open>K (                 
   Lin_Arith.init_arith_data
   #> Lin_Arith.add_discrete_type \<^type_name>\<open>nat\<close>
   #> Lin_Arith.add_lessD @{thm Suc_leI}
   #> Lin_Arith.add_simps @{thms simp_thms ring_distribs if_True if_False
       minus_diff_eq
       add_0_left add_0_right order_less_irrefl
       zero_neq_one zero_less_one zero_le_one
       zero_neq_one [THEN not_sym] not_one_le_zero not_one_less_zero
       add_Suc add_Suc_right nat.inject
       Suc_le_mono Suc_less_eq Zero_not_Suc
       Suc_not_Zero le_0_eq One_nat_def}
   #> Lin_Arith.add_simprocs [\<^simproc>\<open>group_cancel_add\<close>, \<^simproc>\<open>group_cancel_diff\<close>,
       \<^simproc>\<open>group_cancel_eq\<close>, \<^simproc>\<open>group_cancel_le\<close>,
       \<^simproc>\<open>group_cancel_less\<close>,
       \<^simproc>\<open>nateq_cancel_sums\<close>,\<^simproc>\<open>natless_cancel_sums\<close>,
       \<^simproc>\<open>natle_cancel_sums\<close>])\<close>
 
 simproc_setup fast_arith_nat ("(m::nat) < n" | "(m::nat) \<le> n" | "(m::nat) = n") =
   \<open>K Lin_Arith.simproc\<close> \<comment> \<open>Because of this simproc, the arithmetic solver is
    really only useful to detect inconsistencies among the premises for subgoals which are
    \<^emph>\<open>not\<close> themselves (in)equalities, because the latter activate
    \<^text>\<open>fast_nat_arith_simproc\<close> anyway. However, it seems cheaper to activate the
    solver all the time rather than add the additional check.\<close>
 
 lemmas [linarith_split] = nat_diff_split split_min split_max abs_split
 
 text\<open>Lemmas \<open>divide_simps\<close> move division to the outside and eliminates them on (in)equalities.\<close>
 
 named_theorems divide_simps "rewrite rules to eliminate divisions"
 
 class division_ring = ring_1 + inverse +
   assumes left_inverse [simp]:  "a \<noteq> 0 \<Longrightarrow> inverse a * a = 1"
   assumes right_inverse [simp]: "a \<noteq> 0 \<Longrightarrow> a * inverse a = 1"
   assumes divide_inverse: "a / b = a * inverse b"
   assumes inverse_zero [simp]: "inverse 0 = 0"
 begin
 
 subclass ring_1_no_zero_divisors
 proof
   fix a b :: 'a
   assume a: "a \<noteq> 0" and b: "b \<noteq> 0"
   show "a * b \<noteq> 0"
   proof
     assume ab: "a * b = 0"
     hence "0 = inverse a * (a * b) * inverse b" by simp
     also have "\<dots> = (inverse a * a) * (b * inverse b)"
       by (simp only: mult.assoc)
     also have "\<dots> = 1" using a b by simp
     finally show False by simp
   qed
 qed
 
 lemma nonzero_imp_inverse_nonzero:
   "a \<noteq> 0 \<Longrightarrow> inverse a \<noteq> 0"
 proof
   assume ianz: "inverse a = 0"
   assume "a \<noteq> 0"
   hence "1 = a * inverse a" by simp
   also have "... = 0" by (simp add: ianz)
   finally have "1 = 0" .
   thus False by (simp add: eq_commute)
 qed
 
 lemma inverse_zero_imp_zero:
   assumes "inverse a = 0" shows "a = 0"
 proof (rule ccontr)
   assume "a \<noteq> 0"
   then have "inverse a \<noteq> 0"
     by (simp add: nonzero_imp_inverse_nonzero)
   with assms show False
     by auto
 qed
 
 lemma inverse_unique:
   assumes ab: "a * b = 1"
   shows "inverse a = b"
 proof -
   have "a \<noteq> 0" using ab by (cases "a = 0") simp_all
   moreover have "inverse a * (a * b) = inverse a" by (simp add: ab)
   ultimately show ?thesis by (simp add: mult.assoc [symmetric])
 qed
 
 lemma nonzero_inverse_minus_eq:
   "a \<noteq> 0 \<Longrightarrow> inverse (- a) = - inverse a"
 by (rule inverse_unique) simp
 
 lemma nonzero_inverse_inverse_eq:
   "a \<noteq> 0 \<Longrightarrow> inverse (inverse a) = a"
 by (rule inverse_unique) simp
 
 lemma nonzero_inverse_eq_imp_eq:
   assumes "inverse a = inverse b" and "a \<noteq> 0" and "b \<noteq> 0"
   shows "a = b"
 proof -
   from \<open>inverse a = inverse b\<close>
   have "inverse (inverse a) = inverse (inverse b)" by (rule arg_cong)
   with \<open>a \<noteq> 0\<close> and \<open>b \<noteq> 0\<close> show "a = b"
     by (simp add: nonzero_inverse_inverse_eq)
 qed
 
 lemma inverse_1 [simp]: "inverse 1 = 1"
-by (rule inverse_unique) simp
+  by (rule inverse_unique) simp
+
+subclass divide_trivial
+  by standard (simp_all add: divide_inverse)
 
 lemma nonzero_inverse_mult_distrib:
   assumes "a \<noteq> 0" and "b \<noteq> 0"
   shows "inverse (a * b) = inverse b * inverse a"
 proof -
   have "a * (b * inverse b) * inverse a = 1" using assms by simp
   hence "a * b * (inverse b * inverse a) = 1" by (simp only: mult.assoc)
   thus ?thesis by (rule inverse_unique)
 qed
 
 lemma division_ring_inverse_add:
   "a \<noteq> 0 \<Longrightarrow> b \<noteq> 0 \<Longrightarrow> inverse a + inverse b = inverse a * (a + b) * inverse b"
 by (simp add: algebra_simps)
 
 lemma division_ring_inverse_diff:
   "a \<noteq> 0 \<Longrightarrow> b \<noteq> 0 \<Longrightarrow> inverse a - inverse b = inverse a * (b - a) * inverse b"
 by (simp add: algebra_simps)
 
 lemma right_inverse_eq: "b \<noteq> 0 \<Longrightarrow> a / b = 1 \<longleftrightarrow> a = b"
 proof
   assume neq: "b \<noteq> 0"
   {
     hence "a = (a / b) * b" by (simp add: divide_inverse mult.assoc)
     also assume "a / b = 1"
     finally show "a = b" by simp
   next
     assume "a = b"
     with neq show "a / b = 1" by (simp add: divide_inverse)
   }
 qed
 
 lemma nonzero_inverse_eq_divide: "a \<noteq> 0 \<Longrightarrow> inverse a = 1 / a"
 by (simp add: divide_inverse)
 
 lemma divide_self [simp]: "a \<noteq> 0 \<Longrightarrow> a / a = 1"
 by (simp add: divide_inverse)
 
 lemma inverse_eq_divide [field_simps, field_split_simps, divide_simps]: "inverse a = 1 / a"
 by (simp add: divide_inverse)
 
 lemma add_divide_distrib: "(a+b) / c = a/c + b/c"
 by (simp add: divide_inverse algebra_simps)
 
 lemma times_divide_eq_right [simp]: "a * (b / c) = (a * b) / c"
   by (simp add: divide_inverse mult.assoc)
 
 lemma minus_divide_left: "- (a / b) = (-a) / b"
   by (simp add: divide_inverse)
 
 lemma nonzero_minus_divide_right: "b \<noteq> 0 \<Longrightarrow> - (a / b) = a / (- b)"
   by (simp add: divide_inverse nonzero_inverse_minus_eq)
 
 lemma nonzero_minus_divide_divide: "b \<noteq> 0 \<Longrightarrow> (-a) / (-b) = a / b"
   by (simp add: divide_inverse nonzero_inverse_minus_eq)
 
 lemma divide_minus_left [simp]: "(-a) / b = - (a / b)"
   by (simp add: divide_inverse)
 
 lemma diff_divide_distrib: "(a - b) / c = a / c - b / c"
   using add_divide_distrib [of a "- b" c] by simp
 
 lemma nonzero_eq_divide_eq [field_simps]: "c \<noteq> 0 \<Longrightarrow> a = b / c \<longleftrightarrow> a * c = b"
 proof -
   assume [simp]: "c \<noteq> 0"
   have "a = b / c \<longleftrightarrow> a * c = (b / c) * c" by simp
   also have "... \<longleftrightarrow> a * c = b" by (simp add: divide_inverse mult.assoc)
   finally show ?thesis .
 qed
 
 lemma nonzero_divide_eq_eq [field_simps]: "c \<noteq> 0 \<Longrightarrow> b / c = a \<longleftrightarrow> b = a * c"
 proof -
   assume [simp]: "c \<noteq> 0"
   have "b / c = a \<longleftrightarrow> (b / c) * c = a * c" by simp
   also have "... \<longleftrightarrow> b = a * c" by (simp add: divide_inverse mult.assoc)
   finally show ?thesis .
 qed
 
 lemma nonzero_neg_divide_eq_eq [field_simps]: "b \<noteq> 0 \<Longrightarrow> - (a / b) = c \<longleftrightarrow> - a = c * b"
   using nonzero_divide_eq_eq[of b "-a" c] by simp
 
 lemma nonzero_neg_divide_eq_eq2 [field_simps]: "b \<noteq> 0 \<Longrightarrow> c = - (a / b) \<longleftrightarrow> c * b = - a"
   using nonzero_neg_divide_eq_eq[of b a c] by auto
 
 lemma divide_eq_imp: "c \<noteq> 0 \<Longrightarrow> b = a * c \<Longrightarrow> b / c = a"
   by (simp add: divide_inverse mult.assoc)
 
 lemma eq_divide_imp: "c \<noteq> 0 \<Longrightarrow> a * c = b \<Longrightarrow> a = b / c"
   by (drule sym) (simp add: divide_inverse mult.assoc)
 
 lemma add_divide_eq_iff [field_simps]:
   "z \<noteq> 0 \<Longrightarrow> x + y / z = (x * z + y) / z"
   by (simp add: add_divide_distrib nonzero_eq_divide_eq)
 
 lemma divide_add_eq_iff [field_simps]:
   "z \<noteq> 0 \<Longrightarrow> x / z + y = (x + y * z) / z"
   by (simp add: add_divide_distrib nonzero_eq_divide_eq)
 
 lemma diff_divide_eq_iff [field_simps]:
   "z \<noteq> 0 \<Longrightarrow> x - y / z = (x * z - y) / z"
   by (simp add: diff_divide_distrib nonzero_eq_divide_eq eq_diff_eq)
 
 lemma minus_divide_add_eq_iff [field_simps]:
   "z \<noteq> 0 \<Longrightarrow> - (x / z) + y = (- x + y * z) / z"
   by (simp add: add_divide_distrib diff_divide_eq_iff)
 
 lemma divide_diff_eq_iff [field_simps]:
   "z \<noteq> 0 \<Longrightarrow> x / z - y = (x - y * z) / z"
   by (simp add: field_simps)
 
 lemma minus_divide_diff_eq_iff [field_simps]:
   "z \<noteq> 0 \<Longrightarrow> - (x / z) - y = (- x - y * z) / z"
   by (simp add: divide_diff_eq_iff[symmetric])
 
-lemma division_ring_divide_zero [simp]:
+lemma division_ring_divide_zero:
   "a / 0 = 0"
-  by (simp add: divide_inverse)
+  by (fact div_by_0)
 
 lemma divide_self_if [simp]:
   "a / a = (if a = 0 then 0 else 1)"
   by simp
 
 lemma inverse_nonzero_iff_nonzero [simp]:
   "inverse a = 0 \<longleftrightarrow> a = 0"
   by (rule iffI) (fact inverse_zero_imp_zero, simp)
 
 lemma inverse_minus_eq [simp]:
   "inverse (- a) = - inverse a"
 proof cases
   assume "a=0" thus ?thesis by simp
 next
   assume "a\<noteq>0"
   thus ?thesis by (simp add: nonzero_inverse_minus_eq)
 qed
 
 lemma inverse_inverse_eq [simp]:
   "inverse (inverse a) = a"
 proof cases
   assume "a=0" thus ?thesis by simp
 next
   assume "a\<noteq>0"
   thus ?thesis by (simp add: nonzero_inverse_inverse_eq)
 qed
 
 lemma inverse_eq_imp_eq:
   "inverse a = inverse b \<Longrightarrow> a = b"
   by (drule arg_cong [where f="inverse"], simp)
 
 lemma inverse_eq_iff_eq [simp]:
   "inverse a = inverse b \<longleftrightarrow> a = b"
   by (force dest!: inverse_eq_imp_eq)
 
 lemma mult_commute_imp_mult_inverse_commute:
   assumes "y * x = x * y"
   shows   "inverse y * x = x * inverse y"
 proof (cases "y=0")
   case False
   hence "x * inverse y = inverse y * y * x * inverse y"
     by simp
   also have "\<dots> = inverse y * (x * y * inverse y)"
     by (simp add: mult.assoc assms)
   finally show ?thesis by (simp add: mult.assoc False)
 qed simp
 
 lemmas mult_inverse_of_nat_commute =
   mult_commute_imp_mult_inverse_commute[OF mult_of_nat_commute]
 
 lemma divide_divide_eq_left':
   "(a / b) / c = a / (c * b)"
   by (cases "b = 0 \<or> c = 0")
      (auto simp: divide_inverse mult.assoc nonzero_inverse_mult_distrib)
 
 lemma add_divide_eq_if_simps [field_split_simps, divide_simps]:
     "a + b / z = (if z = 0 then a else (a * z + b) / z)"
     "a / z + b = (if z = 0 then b else (a + b * z) / z)"
     "- (a / z) + b = (if z = 0 then b else (-a + b * z) / z)"
     "a - b / z = (if z = 0 then a else (a * z - b) / z)"
     "a / z - b = (if z = 0 then -b else (a - b * z) / z)"
     "- (a / z) - b = (if z = 0 then -b else (- a - b * z) / z)"
   by (simp_all add: add_divide_eq_iff divide_add_eq_iff diff_divide_eq_iff divide_diff_eq_iff
       minus_divide_diff_eq_iff)
 
 lemma [field_split_simps, divide_simps]:
   shows divide_eq_eq: "b / c = a \<longleftrightarrow> (if c \<noteq> 0 then b = a * c else a = 0)"
     and eq_divide_eq: "a = b / c \<longleftrightarrow> (if c \<noteq> 0 then a * c = b else a = 0)"
     and minus_divide_eq_eq: "- (b / c) = a \<longleftrightarrow> (if c \<noteq> 0 then - b = a * c else a = 0)"
     and eq_minus_divide_eq: "a = - (b / c) \<longleftrightarrow> (if c \<noteq> 0 then a * c = - b else a = 0)"
   by (auto simp add:  field_simps)
 
 end
 
 subsection \<open>Fields\<close>
 
 class field = comm_ring_1 + inverse +
   assumes field_inverse: "a \<noteq> 0 \<Longrightarrow> inverse a * a = 1"
   assumes field_divide_inverse: "a / b = a * inverse b"
   assumes field_inverse_zero: "inverse 0 = 0"
 begin
 
 subclass division_ring
 proof
   fix a :: 'a
   assume "a \<noteq> 0"
   thus "inverse a * a = 1" by (rule field_inverse)
   thus "a * inverse a = 1" by (simp only: mult.commute)
 next
   fix a b :: 'a
   show "a / b = a * inverse b" by (rule field_divide_inverse)
 next
   show "inverse 0 = 0"
     by (fact field_inverse_zero) 
 qed
 
 subclass idom_divide
 proof
   fix b a
   assume "b \<noteq> 0"
   then show "a * b / b = a"
     by (simp add: divide_inverse ac_simps)
 next
   fix a
   show "a / 0 = 0"
     by (simp add: divide_inverse)
 qed
 
 text\<open>There is no slick version using division by zero.\<close>
 lemma inverse_add:
   "a \<noteq> 0 \<Longrightarrow> b \<noteq> 0 \<Longrightarrow> inverse a + inverse b = (a + b) * inverse a * inverse b"
   by (simp add: division_ring_inverse_add ac_simps)
 
 lemma nonzero_mult_divide_mult_cancel_left [simp]:
   assumes [simp]: "c \<noteq> 0"
   shows "(c * a) / (c * b) = a / b"
 proof (cases "b = 0")
   case True then show ?thesis by simp
 next
   case False
   then have "(c*a)/(c*b) = c * a * (inverse b * inverse c)"
     by (simp add: divide_inverse nonzero_inverse_mult_distrib)
   also have "... =  a * inverse b * (inverse c * c)"
     by (simp only: ac_simps)
   also have "... =  a * inverse b" by simp
     finally show ?thesis by (simp add: divide_inverse)
 qed
 
 lemma nonzero_mult_divide_mult_cancel_right [simp]:
   "c \<noteq> 0 \<Longrightarrow> (a * c) / (b * c) = a / b"
   using nonzero_mult_divide_mult_cancel_left [of c a b] by (simp add: ac_simps)
 
 lemma times_divide_eq_left [simp]: "(b / c) * a = (b * a) / c"
   by (simp add: divide_inverse ac_simps)
 
 lemma divide_inverse_commute: "a / b = inverse b * a"
   by (simp add: divide_inverse mult.commute)
 
 lemma add_frac_eq:
   assumes "y \<noteq> 0" and "z \<noteq> 0"
   shows "x / y + w / z = (x * z + w * y) / (y * z)"
 proof -
   have "x / y + w / z = (x * z) / (y * z) + (y * w) / (y * z)"
     using assms by simp
   also have "\<dots> = (x * z + y * w) / (y * z)"
     by (simp only: add_divide_distrib)
   finally show ?thesis
     by (simp only: mult.commute)
 qed
 
 text\<open>Special Cancellation Simprules for Division\<close>
 
 lemma nonzero_divide_mult_cancel_right [simp]:
   "b \<noteq> 0 \<Longrightarrow> b / (a * b) = 1 / a"
   using nonzero_mult_divide_mult_cancel_right [of b 1 a] by simp
 
 lemma nonzero_divide_mult_cancel_left [simp]:
   "a \<noteq> 0 \<Longrightarrow> a / (a * b) = 1 / b"
   using nonzero_mult_divide_mult_cancel_left [of a 1 b] by simp
 
 lemma nonzero_mult_divide_mult_cancel_left2 [simp]:
   "c \<noteq> 0 \<Longrightarrow> (c * a) / (b * c) = a / b"
   using nonzero_mult_divide_mult_cancel_left [of c a b] by (simp add: ac_simps)
 
 lemma nonzero_mult_divide_mult_cancel_right2 [simp]:
   "c \<noteq> 0 \<Longrightarrow> (a * c) / (c * b) = a / b"
   using nonzero_mult_divide_mult_cancel_right [of b c a] by (simp add: ac_simps)
 
 lemma diff_frac_eq:
   "y \<noteq> 0 \<Longrightarrow> z \<noteq> 0 \<Longrightarrow> x / y - w / z = (x * z - w * y) / (y * z)"
   by (simp add: field_simps)
 
 lemma frac_eq_eq:
   "y \<noteq> 0 \<Longrightarrow> z \<noteq> 0 \<Longrightarrow> (x / y = w / z) = (x * z = w * y)"
   by (simp add: field_simps)
 
 lemma divide_minus1 [simp]: "x / - 1 = - x"
   using nonzero_minus_divide_right [of "1" x] by simp
 
 text\<open>This version builds in division by zero while also re-orienting
       the right-hand side.\<close>
 lemma inverse_mult_distrib [simp]:
   "inverse (a * b) = inverse a * inverse b"
 proof cases
   assume "a \<noteq> 0 \<and> b \<noteq> 0"
   thus ?thesis by (simp add: nonzero_inverse_mult_distrib ac_simps)
 next
   assume "\<not> (a \<noteq> 0 \<and> b \<noteq> 0)"
   thus ?thesis by force
 qed
 
 lemma inverse_divide [simp]:
   "inverse (a / b) = b / a"
   by (simp add: divide_inverse mult.commute)
 
 
 text \<open>Calculations with fractions\<close>
 
 text\<open>There is a whole bunch of simp-rules just for class \<open>field\<close> but none for class \<open>field\<close> and \<open>nonzero_divides\<close>
 because the latter are covered by a simproc.\<close>
 
 lemmas mult_divide_mult_cancel_left = nonzero_mult_divide_mult_cancel_left
 
 lemmas mult_divide_mult_cancel_right = nonzero_mult_divide_mult_cancel_right
 
 lemma divide_divide_eq_right [simp]:
   "a / (b / c) = (a * c) / b"
   by (simp add: divide_inverse ac_simps)
 
 lemma divide_divide_eq_left [simp]:
   "(a / b) / c = a / (b * c)"
   by (simp add: divide_inverse mult.assoc)
 
 lemma divide_divide_times_eq:
   "(x / y) / (z / w) = (x * w) / (y * z)"
   by simp
 
 text \<open>Special Cancellation Simprules for Division\<close>
 
 lemma mult_divide_mult_cancel_left_if [simp]:
   shows "(c * a) / (c * b) = (if c = 0 then 0 else a / b)"
   by simp
 
 
 text \<open>Division and Unary Minus\<close>
 
 lemma minus_divide_right:
   "- (a / b) = a / - b"
   by (simp add: divide_inverse)
 
 lemma divide_minus_right [simp]:
   "a / - b = - (a / b)"
   by (simp add: divide_inverse)
 
 lemma minus_divide_divide:
   "(- a) / (- b) = a / b"
   by (cases "b=0") (simp_all add: nonzero_minus_divide_divide)
 
 lemma inverse_eq_1_iff [simp]:
   "inverse x = 1 \<longleftrightarrow> x = 1"
   using inverse_eq_iff_eq [of x 1] by simp
 
 lemma divide_eq_0_iff [simp]:
   "a / b = 0 \<longleftrightarrow> a = 0 \<or> b = 0"
   by (simp add: divide_inverse)
 
 lemma divide_cancel_right [simp]:
   "a / c = b / c \<longleftrightarrow> c = 0 \<or> a = b"
   by (cases "c=0") (simp_all add: divide_inverse)
 
 lemma divide_cancel_left [simp]:
   "c / a = c / b \<longleftrightarrow> c = 0 \<or> a = b"
   by (cases "c=0") (simp_all add: divide_inverse)
 
 lemma divide_eq_1_iff [simp]:
   "a / b = 1 \<longleftrightarrow> b \<noteq> 0 \<and> a = b"
   by (cases "b=0") (simp_all add: right_inverse_eq)
 
 lemma one_eq_divide_iff [simp]:
   "1 = a / b \<longleftrightarrow> b \<noteq> 0 \<and> a = b"
   by (simp add: eq_commute [of 1])
 
 lemma divide_eq_minus_1_iff:
    "(a / b = - 1) \<longleftrightarrow> b \<noteq> 0 \<and> a = - b"
 using divide_eq_1_iff by fastforce
 
 lemma times_divide_times_eq:
   "(x / y) * (z / w) = (x * z) / (y * w)"
   by simp
 
 lemma add_frac_num:
   "y \<noteq> 0 \<Longrightarrow> x / y + z = (x + z * y) / y"
   by (simp add: add_divide_distrib)
 
 lemma add_num_frac:
   "y \<noteq> 0 \<Longrightarrow> z + x / y = (x + z * y) / y"
   by (simp add: add_divide_distrib add.commute)
 
 lemma dvd_field_iff:
   "a dvd b \<longleftrightarrow> (a = 0 \<longrightarrow> b = 0)"
 proof (cases "a = 0")
   case False
   then have "b = a * (b / a)"
     by (simp add: field_simps)
   then have "a dvd b" ..
   with False show ?thesis
     by simp
 qed simp
 
 lemma inj_divide_right [simp]:
   "inj (\<lambda>b. b / a) \<longleftrightarrow> a \<noteq> 0"
 proof -
   have "(\<lambda>b. b / a) = (*) (inverse a)"
     by (simp add: field_simps fun_eq_iff)
   then have "inj (\<lambda>y. y / a) \<longleftrightarrow> inj ((*) (inverse a))"
     by simp
   also have "\<dots> \<longleftrightarrow> inverse a \<noteq> 0"
     by simp
   also have "\<dots> \<longleftrightarrow> a \<noteq> 0"
     by simp
   finally show ?thesis
     by simp
 qed
 
 end
 
 class field_char_0 = field + ring_char_0
 
 
 subsection \<open>Ordered fields\<close>
 
 class field_abs_sgn = field + idom_abs_sgn
 begin
 
 lemma sgn_inverse [simp]:
   "sgn (inverse a) = inverse (sgn a)"
 proof (cases "a = 0")
   case True then show ?thesis by simp
 next
   case False
   then have "a * inverse a = 1"
     by simp
   then have "sgn (a * inverse a) = sgn 1"
     by simp
   then have "sgn a * sgn (inverse a) = 1"
     by (simp add: sgn_mult)
   then have "inverse (sgn a) * (sgn a * sgn (inverse a)) = inverse (sgn a) * 1"
     by simp
   then have "(inverse (sgn a) * sgn a) * sgn (inverse a) = inverse (sgn a)"
     by (simp add: ac_simps)
   with False show ?thesis
     by (simp add: sgn_eq_0_iff)
 qed
 
 lemma abs_inverse [simp]:
   "\<bar>inverse a\<bar> = inverse \<bar>a\<bar>"
 proof -
   from sgn_mult_abs [of "inverse a"] sgn_mult_abs [of a]
   have "inverse (sgn a) * \<bar>inverse a\<bar> = inverse (sgn a * \<bar>a\<bar>)"
     by simp
   then show ?thesis by (auto simp add: sgn_eq_0_iff)
 qed
     
 lemma sgn_divide [simp]:
   "sgn (a / b) = sgn a / sgn b"
   unfolding divide_inverse sgn_mult by simp
 
 lemma abs_divide [simp]:
   "\<bar>a / b\<bar> = \<bar>a\<bar> / \<bar>b\<bar>"
   unfolding divide_inverse abs_mult by simp
   
 end
 
 class linordered_field = field + linordered_idom
 begin
 
 lemma positive_imp_inverse_positive:
   assumes a_gt_0: "0 < a"
   shows "0 < inverse a"
 proof -
   have "0 < a * inverse a"
     by (simp add: a_gt_0 [THEN less_imp_not_eq2])
   thus "0 < inverse a"
     by (simp add: a_gt_0 [THEN less_not_sym] zero_less_mult_iff)
 qed
 
 lemma negative_imp_inverse_negative:
   "a < 0 \<Longrightarrow> inverse a < 0"
   using positive_imp_inverse_positive [of "-a"]
   by (simp add: nonzero_inverse_minus_eq less_imp_not_eq)
 
 lemma inverse_le_imp_le:
   assumes invle: "inverse a \<le> inverse b" and apos: "0 < a"
   shows "b \<le> a"
 proof (rule classical)
   assume "\<not> b \<le> a"
   hence "a < b"  by (simp add: linorder_not_le)
   hence bpos: "0 < b"  by (blast intro: apos less_trans)
   hence "a * inverse a \<le> a * inverse b"
     by (simp add: apos invle less_imp_le mult_left_mono)
   hence "(a * inverse a) * b \<le> (a * inverse b) * b"
     by (simp add: bpos less_imp_le mult_right_mono)
   thus "b \<le> a"  by (simp add: mult.assoc apos bpos less_imp_not_eq2)
 qed
 
 lemma inverse_positive_imp_positive:
   assumes inv_gt_0: "0 < inverse a" and nz: "a \<noteq> 0"
   shows "0 < a"
 proof -
   have "0 < inverse (inverse a)"
     using inv_gt_0 by (rule positive_imp_inverse_positive)
   thus "0 < a"
     using nz by (simp add: nonzero_inverse_inverse_eq)
 qed
 
 lemma inverse_negative_imp_negative:
   assumes inv_less_0: "inverse a < 0" and nz: "a \<noteq> 0"
   shows "a < 0"
 proof -
   have "inverse (inverse a) < 0"
     using inv_less_0 by (rule negative_imp_inverse_negative)
   thus "a < 0" using nz by (simp add: nonzero_inverse_inverse_eq)
 qed
 
 lemma linordered_field_no_lb:
   "\<forall>x. \<exists>y. y < x"
 proof
   fix x::'a
   have m1: "- (1::'a) < 0" by simp
   from add_strict_right_mono[OF m1, where c=x]
   have "(- 1) + x < x" by simp
   thus "\<exists>y. y < x" by blast
 qed
 
 lemma linordered_field_no_ub:
   "\<forall> x. \<exists>y. y > x"
 proof
   fix x::'a
   have m1: " (1::'a) > 0" by simp
   from add_strict_right_mono[OF m1, where c=x]
   have "1 + x > x" by simp
   thus "\<exists>y. y > x" by blast
 qed
 
 lemma less_imp_inverse_less:
   assumes less: "a < b" and apos:  "0 < a"
   shows "inverse b < inverse a"
 proof (rule ccontr)
   assume "\<not> inverse b < inverse a"
   hence "inverse a \<le> inverse b" by simp
   hence "\<not> (a < b)"
     by (simp add: not_less inverse_le_imp_le [OF _ apos])
   thus False by (rule notE [OF _ less])
 qed
 
 lemma inverse_less_imp_less:
   assumes "inverse a < inverse b" "0 < a"
   shows "b < a"
 proof -
   have "a \<noteq> b"
     using assms by (simp add: less_le)
   moreover have "b \<le> a"
     using assms by (force simp: less_le dest: inverse_le_imp_le)
   ultimately show ?thesis
     by (simp add: less_le)
 qed
 
 text\<open>Both premises are essential. Consider -1 and 1.\<close>
 lemma inverse_less_iff_less [simp]:
   "0 < a \<Longrightarrow> 0 < b \<Longrightarrow> inverse a < inverse b \<longleftrightarrow> b < a"
   by (blast intro: less_imp_inverse_less dest: inverse_less_imp_less)
 
 lemma le_imp_inverse_le:
   "a \<le> b \<Longrightarrow> 0 < a \<Longrightarrow> inverse b \<le> inverse a"
   by (force simp add: le_less less_imp_inverse_less)
 
 lemma inverse_le_iff_le [simp]:
   "0 < a \<Longrightarrow> 0 < b \<Longrightarrow> inverse a \<le> inverse b \<longleftrightarrow> b \<le> a"
   by (blast intro: le_imp_inverse_le dest: inverse_le_imp_le)
 
 
 text\<open>These results refer to both operands being negative.  The opposite-sign
 case is trivial, since inverse preserves signs.\<close>
 lemma inverse_le_imp_le_neg:
   assumes "inverse a \<le> inverse b" "b < 0"
   shows "b \<le> a"
 proof (rule classical)
   assume "\<not> b \<le> a"
   with \<open>b < 0\<close> have "a < 0"
     by force
   with assms show "b \<le> a"
     using inverse_le_imp_le [of "-b" "-a"] by (simp add: nonzero_inverse_minus_eq)
 qed
 
 lemma less_imp_inverse_less_neg:
   assumes "a < b" "b < 0"
   shows "inverse b < inverse a"
 proof -
   have "a < 0"
     using assms by (blast intro: less_trans)
   with less_imp_inverse_less [of "-b" "-a"] show ?thesis
     by (simp add: nonzero_inverse_minus_eq assms)
 qed
 
 lemma inverse_less_imp_less_neg:
   assumes "inverse a < inverse b" "b < 0"
   shows "b < a"
 proof (rule classical)
   assume "\<not> b < a"
   with \<open>b < 0\<close> have "a < 0"
     by force
   with inverse_less_imp_less [of "-b" "-a"] show ?thesis
     by (simp add: nonzero_inverse_minus_eq assms)
 qed
 
 lemma inverse_less_iff_less_neg [simp]:
   "a < 0 \<Longrightarrow> b < 0 \<Longrightarrow> inverse a < inverse b \<longleftrightarrow> b < a"
   using inverse_less_iff_less [of "-b" "-a"]
   by (simp del: inverse_less_iff_less add: nonzero_inverse_minus_eq)
 
 lemma le_imp_inverse_le_neg:
   "a \<le> b \<Longrightarrow> b < 0 \<Longrightarrow> inverse b \<le> inverse a"
   by (force simp add: le_less less_imp_inverse_less_neg)
 
 lemma inverse_le_iff_le_neg [simp]:
   "a < 0 \<Longrightarrow> b < 0 \<Longrightarrow> inverse a \<le> inverse b \<longleftrightarrow> b \<le> a"
   by (blast intro: le_imp_inverse_le_neg dest: inverse_le_imp_le_neg)
 
 lemma one_less_inverse:
   "0 < a \<Longrightarrow> a < 1 \<Longrightarrow> 1 < inverse a"
   using less_imp_inverse_less [of a 1, unfolded inverse_1] .
 
 lemma one_le_inverse:
   "0 < a \<Longrightarrow> a \<le> 1 \<Longrightarrow> 1 \<le> inverse a"
   using le_imp_inverse_le [of a 1, unfolded inverse_1] .
 
 lemma pos_le_divide_eq [field_simps]:
   assumes "0 < c"
   shows "a \<le> b / c \<longleftrightarrow> a * c \<le> b"
 proof -
   from assms have "a \<le> b / c \<longleftrightarrow> a * c \<le> (b / c) * c"
     using mult_le_cancel_right [of a c "b * inverse c"] by (auto simp add: field_simps)
   also have "... \<longleftrightarrow> a * c \<le> b"
     by (simp add: less_imp_not_eq2 [OF assms] divide_inverse mult.assoc)
   finally show ?thesis .
 qed
 
 lemma pos_less_divide_eq [field_simps]:
   assumes "0 < c"
   shows "a < b / c \<longleftrightarrow> a * c < b"
 proof -
   from assms have "a < b / c \<longleftrightarrow> a * c < (b / c) * c"
     using mult_less_cancel_right [of a c "b / c"] by auto
   also have "... = (a*c < b)"
     by (simp add: less_imp_not_eq2 [OF assms] divide_inverse mult.assoc)
   finally show ?thesis .
 qed
 
 lemma neg_less_divide_eq [field_simps]:
   assumes "c < 0"
   shows "a < b / c \<longleftrightarrow> b < a * c"
 proof -
   from assms have "a < b / c \<longleftrightarrow> (b / c) * c < a * c"
     using mult_less_cancel_right [of "b / c" c a] by auto
   also have "... \<longleftrightarrow> b < a * c"
     by (simp add: less_imp_not_eq [OF assms] divide_inverse mult.assoc)
   finally show ?thesis .
 qed
 
 lemma neg_le_divide_eq [field_simps]:
   assumes "c < 0"
   shows "a \<le> b / c \<longleftrightarrow> b \<le> a * c"
 proof -
   from assms have "a \<le> b / c \<longleftrightarrow> (b / c) * c \<le> a * c"
     using mult_le_cancel_right [of "b * inverse c" c a] by (auto simp add: field_simps)
   also have "... \<longleftrightarrow> b \<le> a * c"
     by (simp add: less_imp_not_eq [OF assms] divide_inverse mult.assoc)
   finally show ?thesis .
 qed
 
 lemma pos_divide_le_eq [field_simps]:
   assumes "0 < c"
   shows "b / c \<le> a \<longleftrightarrow> b \<le> a * c"
 proof -
   from assms have "b / c \<le> a \<longleftrightarrow> (b / c) * c \<le> a * c"
     using mult_le_cancel_right [of "b / c" c a] by auto
   also have "... \<longleftrightarrow> b \<le> a * c"
     by (simp add: less_imp_not_eq2 [OF assms] divide_inverse mult.assoc)
   finally show ?thesis .
 qed
 
 lemma pos_divide_less_eq [field_simps]:
   assumes "0 < c"
   shows "b / c < a \<longleftrightarrow> b < a * c"
 proof -
   from assms have "b / c < a \<longleftrightarrow> (b / c) * c < a * c"
     using mult_less_cancel_right [of "b / c" c a] by auto
   also have "... \<longleftrightarrow> b < a * c"
     by (simp add: less_imp_not_eq2 [OF assms] divide_inverse mult.assoc)
   finally show ?thesis .
 qed
 
 lemma neg_divide_le_eq [field_simps]:
   assumes "c < 0"
   shows "b / c \<le> a \<longleftrightarrow> a * c \<le> b"
 proof -
   from assms have "b / c \<le> a \<longleftrightarrow> a * c \<le> (b / c) * c"
     using mult_le_cancel_right [of a c "b / c"] by auto
   also have "... \<longleftrightarrow> a * c \<le> b"
     by (simp add: less_imp_not_eq [OF assms] divide_inverse mult.assoc)
   finally show ?thesis .
 qed
 
 lemma neg_divide_less_eq [field_simps]:
   assumes "c < 0"
   shows "b / c < a \<longleftrightarrow> a * c < b"
 proof -
   from assms have "b / c < a \<longleftrightarrow> a * c < b / c * c"
     using mult_less_cancel_right [of a c "b / c"] by auto
   also have "... \<longleftrightarrow> a * c < b"
     by (simp add: less_imp_not_eq [OF assms] divide_inverse mult.assoc)
   finally show ?thesis .
 qed
 
 text\<open>The following \<open>field_simps\<close> rules are necessary, as minus is always moved atop of
 division but we want to get rid of division.\<close>
 
 lemma pos_le_minus_divide_eq [field_simps]: "0 < c \<Longrightarrow> a \<le> - (b / c) \<longleftrightarrow> a * c \<le> - b"
   unfolding minus_divide_left by (rule pos_le_divide_eq)
 
 lemma neg_le_minus_divide_eq [field_simps]: "c < 0 \<Longrightarrow> a \<le> - (b / c) \<longleftrightarrow> - b \<le> a * c"
   unfolding minus_divide_left by (rule neg_le_divide_eq)
 
 lemma pos_less_minus_divide_eq [field_simps]: "0 < c \<Longrightarrow> a < - (b / c) \<longleftrightarrow> a * c < - b"
   unfolding minus_divide_left by (rule pos_less_divide_eq)
 
 lemma neg_less_minus_divide_eq [field_simps]: "c < 0 \<Longrightarrow> a < - (b / c) \<longleftrightarrow> - b < a * c"
   unfolding minus_divide_left by (rule neg_less_divide_eq)
 
 lemma pos_minus_divide_less_eq [field_simps]: "0 < c \<Longrightarrow> - (b / c) < a \<longleftrightarrow> - b < a * c"
   unfolding minus_divide_left by (rule pos_divide_less_eq)
 
 lemma neg_minus_divide_less_eq [field_simps]: "c < 0 \<Longrightarrow> - (b / c) < a \<longleftrightarrow> a * c < - b"
   unfolding minus_divide_left by (rule neg_divide_less_eq)
 
 lemma pos_minus_divide_le_eq [field_simps]: "0 < c \<Longrightarrow> - (b / c) \<le> a \<longleftrightarrow> - b \<le> a * c"
   unfolding minus_divide_left by (rule pos_divide_le_eq)
 
 lemma neg_minus_divide_le_eq [field_simps]: "c < 0 \<Longrightarrow> - (b / c) \<le> a \<longleftrightarrow> a * c \<le> - b"
   unfolding minus_divide_left by (rule neg_divide_le_eq)
 
 lemma frac_less_eq:
   "y \<noteq> 0 \<Longrightarrow> z \<noteq> 0 \<Longrightarrow> x / y < w / z \<longleftrightarrow> (x * z - w * y) / (y * z) < 0"
   by (subst less_iff_diff_less_0) (simp add: diff_frac_eq )
 
 lemma frac_le_eq:
   "y \<noteq> 0 \<Longrightarrow> z \<noteq> 0 \<Longrightarrow> x / y \<le> w / z \<longleftrightarrow> (x * z - w * y) / (y * z) \<le> 0"
   by (subst le_iff_diff_le_0) (simp add: diff_frac_eq )
 
 lemma divide_pos_pos[simp]:
   "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> 0 < x / y"
 by(simp add:field_simps)
 
 lemma divide_nonneg_pos:
   "0 \<le> x \<Longrightarrow> 0 < y \<Longrightarrow> 0 \<le> x / y"
 by(simp add:field_simps)
 
 lemma divide_neg_pos:
   "x < 0 \<Longrightarrow> 0 < y \<Longrightarrow> x / y < 0"
   by(simp add:field_simps)
 
 lemma divide_nonpos_pos:
   "x \<le> 0 \<Longrightarrow> 0 < y \<Longrightarrow> x / y \<le> 0"
   by(simp add:field_simps)
 
 lemma divide_pos_neg:
   "0 < x \<Longrightarrow> y < 0 \<Longrightarrow> x / y < 0"
   by(simp add:field_simps)
 
 lemma divide_nonneg_neg:
   "0 \<le> x \<Longrightarrow> y < 0 \<Longrightarrow> x / y \<le> 0"
   by(simp add:field_simps)
 
 lemma divide_neg_neg:
   "x < 0 \<Longrightarrow> y < 0 \<Longrightarrow> 0 < x / y"
   by(simp add:field_simps)
 
 lemma divide_nonpos_neg:
   "x \<le> 0 \<Longrightarrow> y < 0 \<Longrightarrow> 0 \<le> x / y"
   by(simp add:field_simps)
 
 lemma divide_strict_right_mono:
   "\<lbrakk>a < b; 0 < c\<rbrakk> \<Longrightarrow> a / c < b / c"
   by (simp add: less_imp_not_eq2 divide_inverse mult_strict_right_mono
       positive_imp_inverse_positive)
 
 
 lemma divide_strict_right_mono_neg:
   assumes "b < a" "c < 0" shows "a / c < b / c"
 proof -
   have "b / - c < a / - c"
     by (rule divide_strict_right_mono) (use assms in auto)
   then show ?thesis
     by (simp add: less_imp_not_eq)
 qed
 
 text\<open>The last premise ensures that \<^term>\<open>a\<close> and \<^term>\<open>b\<close>
       have the same sign\<close>
 lemma divide_strict_left_mono:
   "\<lbrakk>b < a; 0 < c; 0 < a*b\<rbrakk> \<Longrightarrow> c / a < c / b"
   by (auto simp: field_simps zero_less_mult_iff mult_strict_right_mono)
 
 lemma divide_left_mono:
   "\<lbrakk>b \<le> a; 0 \<le> c; 0 < a*b\<rbrakk> \<Longrightarrow> c / a \<le> c / b"
   by (auto simp: field_simps zero_less_mult_iff mult_right_mono)
 
 lemma divide_strict_left_mono_neg:
   "\<lbrakk>a < b; c < 0; 0 < a*b\<rbrakk> \<Longrightarrow> c / a < c / b"
   by (auto simp: field_simps zero_less_mult_iff mult_strict_right_mono_neg)
 
 lemma mult_imp_div_pos_le: "0 < y \<Longrightarrow> x \<le> z * y \<Longrightarrow> x / y \<le> z"
 by (subst pos_divide_le_eq, assumption+)
 
 lemma mult_imp_le_div_pos: "0 < y \<Longrightarrow> z * y \<le> x \<Longrightarrow> z \<le> x / y"
 by(simp add:field_simps)
 
 lemma mult_imp_div_pos_less: "0 < y \<Longrightarrow> x < z * y \<Longrightarrow> x / y < z"
 by(simp add:field_simps)
 
 lemma mult_imp_less_div_pos: "0 < y \<Longrightarrow> z * y < x \<Longrightarrow> z < x / y"
 by(simp add:field_simps)
 
 lemma frac_le:
   assumes "0 \<le> y" "x \<le> y" "0 < w" "w \<le> z"
   shows "x / z \<le> y / w"
 proof (rule mult_imp_div_pos_le)
   show "z > 0"
     using assms by simp
   have "x \<le> y * z / w"
   proof (rule mult_imp_le_div_pos [OF \<open>0 < w\<close>])
     show "x * w \<le> y * z"
       using assms by (auto intro: mult_mono)
   qed
   also have "... = y / w * z"
     by simp
   finally show "x \<le> y / w * z" .
 qed
 
 lemma frac_less:
   assumes "0 \<le> x" "x < y" "0 < w" "w \<le> z"
   shows "x / z < y / w"
 proof (rule mult_imp_div_pos_less)
   show "z > 0"
     using assms by simp
   have "x < y * z / w"
   proof (rule mult_imp_less_div_pos [OF \<open>0 < w\<close>])
     show "x * w < y * z"
       using assms by (auto intro: mult_less_le_imp_less)
   qed
   also have "... = y / w * z"
     by simp
   finally show "x < y / w * z" .
 qed
 
 lemma frac_less2:
   assumes "0 < x" "x \<le> y" "0 < w" "w < z"
   shows "x / z < y / w"
 proof (rule mult_imp_div_pos_less)
   show "z > 0"
     using assms by simp
   show "x < y / w * z"
     using assms by (force intro: mult_imp_less_div_pos mult_le_less_imp_less)
 qed
 
 lemma less_half_sum: "a < b \<Longrightarrow> a < (a+b) / (1+1)"
   by (simp add: field_simps zero_less_two)
 
 lemma gt_half_sum: "a < b \<Longrightarrow> (a+b)/(1+1) < b"
   by (simp add: field_simps zero_less_two)
 
 subclass unbounded_dense_linorder
 proof
   fix x y :: 'a
   from less_add_one show "\<exists>y. x < y" ..
   from less_add_one have "x + (- 1) < (x + 1) + (- 1)" by (rule add_strict_right_mono)
   then have "x - 1 < x + 1 - 1" by simp
   then have "x - 1 < x" by (simp add: algebra_simps)
   then show "\<exists>y. y < x" ..
   show "x < y \<Longrightarrow> \<exists>z>x. z < y" by (blast intro!: less_half_sum gt_half_sum)
 qed
 
 subclass field_abs_sgn ..
 
 lemma inverse_sgn [simp]:
   "inverse (sgn a) = sgn a"
   by (cases a 0 rule: linorder_cases) simp_all
 
 lemma divide_sgn [simp]:
   "a / sgn b = a * sgn b"
   by (cases b 0 rule: linorder_cases) simp_all
 
 lemma nonzero_abs_inverse:
   "a \<noteq> 0 \<Longrightarrow> \<bar>inverse a\<bar> = inverse \<bar>a\<bar>"
   by (rule abs_inverse)
 
 lemma nonzero_abs_divide:
   "b \<noteq> 0 \<Longrightarrow> \<bar>a / b\<bar> = \<bar>a\<bar> / \<bar>b\<bar>"
   by (rule abs_divide)
 
 lemma field_le_epsilon:
   assumes e: "\<And>e. 0 < e \<Longrightarrow> x \<le> y + e"
   shows "x \<le> y"
 proof (rule dense_le)
   fix t assume "t < x"
   hence "0 < x - t" by (simp add: less_diff_eq)
   from e [OF this] have "x + 0 \<le> x + (y - t)" by (simp add: algebra_simps)
   then have "0 \<le> y - t" by (simp only: add_le_cancel_left)
   then show "t \<le> y" by (simp add: algebra_simps)
 qed
 
 lemma inverse_positive_iff_positive [simp]: "(0 < inverse a) = (0 < a)"
 proof (cases "a = 0")
   case False
   then show ?thesis
     by (blast intro: inverse_positive_imp_positive positive_imp_inverse_positive)
 qed auto
 
 lemma inverse_negative_iff_negative [simp]: "(inverse a < 0) = (a < 0)"
 proof (cases "a = 0")
   case False
   then show ?thesis
     by (blast intro: inverse_negative_imp_negative negative_imp_inverse_negative)
 qed auto
 
 lemma inverse_nonnegative_iff_nonnegative [simp]: "0 \<le> inverse a \<longleftrightarrow> 0 \<le> a"
   by (simp add: not_less [symmetric])
 
 lemma inverse_nonpositive_iff_nonpositive [simp]: "inverse a \<le> 0 \<longleftrightarrow> a \<le> 0"
   by (simp add: not_less [symmetric])
 
 lemma one_less_inverse_iff: "1 < inverse x \<longleftrightarrow> 0 < x \<and> x < 1"
   using less_trans[of 1 x 0 for x]
   by (cases x 0 rule: linorder_cases) (auto simp add: field_simps)
 
 lemma one_le_inverse_iff: "1 \<le> inverse x \<longleftrightarrow> 0 < x \<and> x \<le> 1"
 proof (cases "x = 1")
   case True then show ?thesis by simp
 next
   case False then have "inverse x \<noteq> 1" by simp
   then have "1 \<noteq> inverse x" by blast
   then have "1 \<le> inverse x \<longleftrightarrow> 1 < inverse x" by (simp add: le_less)
   with False show ?thesis by (auto simp add: one_less_inverse_iff)
 qed
 
 lemma inverse_less_1_iff: "inverse x < 1 \<longleftrightarrow> x \<le> 0 \<or> 1 < x"
   by (simp add: not_le [symmetric] one_le_inverse_iff)
 
 lemma inverse_le_1_iff: "inverse x \<le> 1 \<longleftrightarrow> x \<le> 0 \<or> 1 \<le> x"
   by (simp add: not_less [symmetric] one_less_inverse_iff)
 
 lemma [field_split_simps, divide_simps]:
   shows le_divide_eq: "a \<le> b / c \<longleftrightarrow> (if 0 < c then a * c \<le> b else if c < 0 then b \<le> a * c else a \<le> 0)"
     and divide_le_eq: "b / c \<le> a \<longleftrightarrow> (if 0 < c then b \<le> a * c else if c < 0 then a * c \<le> b else 0 \<le> a)"
     and less_divide_eq: "a < b / c \<longleftrightarrow> (if 0 < c then a * c < b else if c < 0 then b < a * c else a < 0)"
     and divide_less_eq: "b / c < a \<longleftrightarrow> (if 0 < c then b < a * c else if c < 0 then a * c < b else 0 < a)"
     and le_minus_divide_eq: "a \<le> - (b / c) \<longleftrightarrow> (if 0 < c then a * c \<le> - b else if c < 0 then - b \<le> a * c else a \<le> 0)"
     and minus_divide_le_eq: "- (b / c) \<le> a \<longleftrightarrow> (if 0 < c then - b \<le> a * c else if c < 0 then a * c \<le> - b else 0 \<le> a)"
     and less_minus_divide_eq: "a < - (b / c) \<longleftrightarrow> (if 0 < c then a * c < - b else if c < 0 then - b < a * c else  a < 0)"
     and minus_divide_less_eq: "- (b / c) < a \<longleftrightarrow> (if 0 < c then - b < a * c else if c < 0 then a * c < - b else 0 < a)"
   by (auto simp: field_simps not_less dest: order.antisym)
 
 text \<open>Division and Signs\<close>
 
 lemma
   shows zero_less_divide_iff: "0 < a / b \<longleftrightarrow> 0 < a \<and> 0 < b \<or> a < 0 \<and> b < 0"
     and divide_less_0_iff: "a / b < 0 \<longleftrightarrow> 0 < a \<and> b < 0 \<or> a < 0 \<and> 0 < b"
     and zero_le_divide_iff: "0 \<le> a / b \<longleftrightarrow> 0 \<le> a \<and> 0 \<le> b \<or> a \<le> 0 \<and> b \<le> 0"
     and divide_le_0_iff: "a / b \<le> 0 \<longleftrightarrow> 0 \<le> a \<and> b \<le> 0 \<or> a \<le> 0 \<and> 0 \<le> b"
   by (auto simp add: field_split_simps)
 
 text \<open>Division and the Number One\<close>
 
 text\<open>Simplify expressions equated with 1\<close>
 
 lemma zero_eq_1_divide_iff [simp]: "0 = 1 / a \<longleftrightarrow> a = 0"
   by (cases "a = 0") (auto simp: field_simps)
 
 lemma one_divide_eq_0_iff [simp]: "1 / a = 0 \<longleftrightarrow> a = 0"
   using zero_eq_1_divide_iff[of a] by simp
 
 text\<open>Simplify expressions such as \<open>0 < 1/x\<close> to \<open>0 < x\<close>\<close>
 
 lemma zero_le_divide_1_iff [simp]:
   "0 \<le> 1 / a \<longleftrightarrow> 0 \<le> a"
   by (simp add: zero_le_divide_iff)
 
 lemma zero_less_divide_1_iff [simp]:
   "0 < 1 / a \<longleftrightarrow> 0 < a"
   by (simp add: zero_less_divide_iff)
 
 lemma divide_le_0_1_iff [simp]:
   "1 / a \<le> 0 \<longleftrightarrow> a \<le> 0"
   by (simp add: divide_le_0_iff)
 
 lemma divide_less_0_1_iff [simp]:
   "1 / a < 0 \<longleftrightarrow> a < 0"
   by (simp add: divide_less_0_iff)
 
 lemma divide_right_mono:
   "\<lbrakk>a \<le> b; 0 \<le> c\<rbrakk> \<Longrightarrow> a/c \<le> b/c"
   by (force simp add: divide_strict_right_mono le_less)
 
 lemma divide_right_mono_neg: "a \<le> b \<Longrightarrow> c \<le> 0 \<Longrightarrow> b / c \<le> a / c"
   by (auto dest: divide_right_mono [of _ _ "- c"])
 
 lemma divide_left_mono_neg: "a \<le> b \<Longrightarrow> c \<le> 0 \<Longrightarrow> 0 < a * b \<Longrightarrow> c / a \<le> c / b"
   by (auto simp add: mult.commute dest: divide_left_mono [of _ _ "- c"])
 
 lemma inverse_le_iff: "inverse a \<le> inverse b \<longleftrightarrow> (0 < a * b \<longrightarrow> b \<le> a) \<and> (a * b \<le> 0 \<longrightarrow> a \<le> b)"
   by (cases a 0 b 0 rule: linorder_cases[case_product linorder_cases])
      (auto simp add: field_simps zero_less_mult_iff mult_le_0_iff)
 
 lemma inverse_less_iff: "inverse a < inverse b \<longleftrightarrow> (0 < a * b \<longrightarrow> b < a) \<and> (a * b \<le> 0 \<longrightarrow> a < b)"
   by (subst less_le) (auto simp: inverse_le_iff)
 
 lemma divide_le_cancel: "a / c \<le> b / c \<longleftrightarrow> (0 < c \<longrightarrow> a \<le> b) \<and> (c < 0 \<longrightarrow> b \<le> a)"
   by (simp add: divide_inverse mult_le_cancel_right)
 
 lemma divide_less_cancel: "a / c < b / c \<longleftrightarrow> (0 < c \<longrightarrow> a < b) \<and> (c < 0 \<longrightarrow> b < a) \<and> c \<noteq> 0"
   by (auto simp add: divide_inverse mult_less_cancel_right)
 
 text\<open>Simplify quotients that are compared with the value 1.\<close>
 
 lemma le_divide_eq_1:
   "(1 \<le> b / a) = ((0 < a \<and> a \<le> b) \<or> (a < 0 \<and> b \<le> a))"
   by (auto simp add: le_divide_eq)
 
 lemma divide_le_eq_1:
   "(b / a \<le> 1) = ((0 < a \<and> b \<le> a) \<or> (a < 0 \<and> a \<le> b) \<or> a=0)"
   by (auto simp add: divide_le_eq)
 
 lemma less_divide_eq_1:
   "(1 < b / a) = ((0 < a \<and> a < b) \<or> (a < 0 \<and> b < a))"
   by (auto simp add: less_divide_eq)
 
 lemma divide_less_eq_1:
   "(b / a < 1) = ((0 < a \<and> b < a) \<or> (a < 0 \<and> a < b) \<or> a=0)"
   by (auto simp add: divide_less_eq)
 
 lemma divide_nonneg_nonneg [simp]:
   "0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> 0 \<le> x / y"
   by (auto simp add: field_split_simps)
 
 lemma divide_nonpos_nonpos:
   "x \<le> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> 0 \<le> x / y"
   by (auto simp add: field_split_simps)
 
 lemma divide_nonneg_nonpos:
   "0 \<le> x \<Longrightarrow> y \<le> 0 \<Longrightarrow> x / y \<le> 0"
   by (auto simp add: field_split_simps)
 
 lemma divide_nonpos_nonneg:
   "x \<le> 0 \<Longrightarrow> 0 \<le> y \<Longrightarrow> x / y \<le> 0"
   by (auto simp add: field_split_simps)
 
 text \<open>Conditional Simplification Rules: No Case Splits\<close>
 
 lemma le_divide_eq_1_pos [simp]:
   "0 < a \<Longrightarrow> (1 \<le> b/a) = (a \<le> b)"
   by (auto simp add: le_divide_eq)
 
 lemma le_divide_eq_1_neg [simp]:
   "a < 0 \<Longrightarrow> (1 \<le> b/a) = (b \<le> a)"
   by (auto simp add: le_divide_eq)
 
 lemma divide_le_eq_1_pos [simp]:
   "0 < a \<Longrightarrow> (b/a \<le> 1) = (b \<le> a)"
   by (auto simp add: divide_le_eq)
 
 lemma divide_le_eq_1_neg [simp]:
   "a < 0 \<Longrightarrow> (b/a \<le> 1) = (a \<le> b)"
   by (auto simp add: divide_le_eq)
 
 lemma less_divide_eq_1_pos [simp]:
   "0 < a \<Longrightarrow> (1 < b/a) = (a < b)"
   by (auto simp add: less_divide_eq)
 
 lemma less_divide_eq_1_neg [simp]:
   "a < 0 \<Longrightarrow> (1 < b/a) = (b < a)"
   by (auto simp add: less_divide_eq)
 
 lemma divide_less_eq_1_pos [simp]:
   "0 < a \<Longrightarrow> (b/a < 1) = (b < a)"
   by (auto simp add: divide_less_eq)
 
 lemma divide_less_eq_1_neg [simp]:
   "a < 0 \<Longrightarrow> b/a < 1 \<longleftrightarrow> a < b"
   by (auto simp add: divide_less_eq)
 
 lemma eq_divide_eq_1 [simp]:
   "(1 = b/a) = ((a \<noteq> 0 \<and> a = b))"
   by (auto simp add: eq_divide_eq)
 
 lemma divide_eq_eq_1 [simp]:
   "(b/a = 1) = ((a \<noteq> 0 \<and> a = b))"
   by (auto simp add: divide_eq_eq)
 
 lemma abs_div_pos: "0 < y \<Longrightarrow> \<bar>x\<bar> / y = \<bar>x / y\<bar>"
   by (simp add: order_less_imp_le)
 
 lemma zero_le_divide_abs_iff [simp]: "(0 \<le> a / \<bar>b\<bar>) = (0 \<le> a \<or> b = 0)"
   by (auto simp: zero_le_divide_iff)
 
 lemma divide_le_0_abs_iff [simp]: "(a / \<bar>b\<bar> \<le> 0) = (a \<le> 0 \<or> b = 0)"
   by (auto simp: divide_le_0_iff)
 
 lemma field_le_mult_one_interval:
   assumes *: "\<And>z. \<lbrakk> 0 < z ; z < 1 \<rbrakk> \<Longrightarrow> z * x \<le> y"
   shows "x \<le> y"
 proof (cases "0 < x")
   assume "0 < x"
   thus ?thesis
     using dense_le_bounded[of 0 1 "y/x"] *
     unfolding le_divide_eq if_P[OF \<open>0 < x\<close>] by simp
 next
   assume "\<not>0 < x" hence "x \<le> 0" by simp
   obtain s::'a where s: "0 < s" "s < 1" using dense[of 0 "1::'a"] by auto
   hence "x \<le> s * x" using mult_le_cancel_right[of 1 x s] \<open>x \<le> 0\<close> by auto
   also note *[OF s]
   finally show ?thesis .
 qed
 
 text\<open>For creating values between \<^term>\<open>u\<close> and \<^term>\<open>v\<close>.\<close>
 lemma scaling_mono:
   assumes "u \<le> v" "0 \<le> r" "r \<le> s"
   shows "u + r * (v - u) / s \<le> v"
 proof -
   have "r/s \<le> 1" using assms
     using divide_le_eq_1 by fastforce
   moreover have "0 \<le> v - u"
     using assms by simp
   ultimately have "(r/s) * (v - u) \<le> 1 * (v - u)"
     by (rule mult_right_mono)
   then show ?thesis
     by (simp add: field_simps)
 qed
 
 end
 
 text \<open>Min/max Simplification Rules\<close>
 
 lemma min_mult_distrib_left:
   fixes x::"'a::linordered_idom" 
   shows "p * min x y = (if 0 \<le> p then min (p*x) (p*y) else max (p*x) (p*y))"
 by (auto simp add: min_def max_def mult_le_cancel_left)
 
 lemma min_mult_distrib_right:
   fixes x::"'a::linordered_idom" 
   shows "min x y * p = (if 0 \<le> p then min (x*p) (y*p) else max (x*p) (y*p))"
 by (auto simp add: min_def max_def mult_le_cancel_right)
 
 lemma min_divide_distrib_right:
   fixes x::"'a::linordered_field" 
   shows "min x y / p = (if 0 \<le> p then min (x/p) (y/p) else max (x/p) (y/p))"
 by (simp add: min_mult_distrib_right divide_inverse)
 
 lemma max_mult_distrib_left:
   fixes x::"'a::linordered_idom" 
   shows "p * max x y = (if 0 \<le> p then max (p*x) (p*y) else min (p*x) (p*y))"
 by (auto simp add: min_def max_def mult_le_cancel_left)
 
 lemma max_mult_distrib_right:
   fixes x::"'a::linordered_idom" 
   shows "max x y * p = (if 0 \<le> p then max (x*p) (y*p) else min (x*p) (y*p))"
 by (auto simp add: min_def max_def mult_le_cancel_right)
 
 lemma max_divide_distrib_right:
   fixes x::"'a::linordered_field" 
   shows "max x y / p = (if 0 \<le> p then max (x/p) (y/p) else min (x/p) (y/p))"
 by (simp add: max_mult_distrib_right divide_inverse)
 
 hide_fact (open) field_inverse field_divide_inverse field_inverse_zero
 
 code_identifier
   code_module Fields \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith
 
 end
diff --git a/src/HOL/Nonstandard_Analysis/StarDef.thy b/src/HOL/Nonstandard_Analysis/StarDef.thy
--- a/src/HOL/Nonstandard_Analysis/StarDef.thy
+++ b/src/HOL/Nonstandard_Analysis/StarDef.thy
@@ -1,927 +1,930 @@
 (*  Title:      HOL/Nonstandard_Analysis/StarDef.thy
     Author:     Jacques D. Fleuriot and Brian Huffman
 *)
 
 section \<open>Construction of Star Types Using Ultrafilters\<close>
 
 theory StarDef
   imports Free_Ultrafilter
 begin
 
 subsection \<open>A Free Ultrafilter over the Naturals\<close>
 
 definition FreeUltrafilterNat :: "nat filter"  (\<open>\<U>\<close>)
   where "\<U> = (SOME U. freeultrafilter U)"
 
 lemma freeultrafilter_FreeUltrafilterNat: "freeultrafilter \<U>"
   unfolding FreeUltrafilterNat_def
   by (simp add: freeultrafilter_Ex someI_ex)
 
 interpretation FreeUltrafilterNat: freeultrafilter \<U>
   by (rule freeultrafilter_FreeUltrafilterNat)
 
 
 subsection \<open>Definition of \<open>star\<close> type constructor\<close>
 
 definition starrel :: "((nat \<Rightarrow> 'a) \<times> (nat \<Rightarrow> 'a)) set"
   where "starrel = {(X, Y). eventually (\<lambda>n. X n = Y n) \<U>}"
 
 definition "star = (UNIV :: (nat \<Rightarrow> 'a) set) // starrel"
 
 typedef 'a star = "star :: (nat \<Rightarrow> 'a) set set"
   by (auto simp: star_def intro: quotientI)
 
 definition star_n :: "(nat \<Rightarrow> 'a) \<Rightarrow> 'a star"
   where "star_n X = Abs_star (starrel `` {X})"
 
 theorem star_cases [case_names star_n, cases type: star]:
   obtains X where "x = star_n X"
   by (cases x) (auto simp: star_n_def star_def elim: quotientE)
 
 lemma all_star_eq: "(\<forall>x. P x) \<longleftrightarrow> (\<forall>X. P (star_n X))"
   by (metis star_cases)
 
 lemma ex_star_eq: "(\<exists>x. P x) \<longleftrightarrow> (\<exists>X. P (star_n X))"
   by (metis star_cases)
 
 text \<open>Proving that \<^term>\<open>starrel\<close> is an equivalence relation.\<close>
 
 lemma starrel_iff [iff]: "(X, Y) \<in> starrel \<longleftrightarrow> eventually (\<lambda>n. X n = Y n) \<U>"
   by (simp add: starrel_def)
 
 lemma equiv_starrel: "equiv UNIV starrel"
 proof (rule equivI)
   show "refl starrel" by (simp add: refl_on_def)
   show "sym starrel" by (simp add: sym_def eq_commute)
   show "trans starrel" by (intro transI) (auto elim: eventually_elim2)
 qed
 
 lemmas equiv_starrel_iff = eq_equiv_class_iff [OF equiv_starrel UNIV_I UNIV_I]
 
 lemma starrel_in_star: "starrel``{x} \<in> star"
   by (simp add: star_def quotientI)
 
 lemma star_n_eq_iff: "star_n X = star_n Y \<longleftrightarrow> eventually (\<lambda>n. X n = Y n) \<U>"
   by (simp add: star_n_def Abs_star_inject starrel_in_star equiv_starrel_iff)
 
 
 subsection \<open>Transfer principle\<close>
 
 text \<open>This introduction rule starts each transfer proof.\<close>
 lemma transfer_start: "P \<equiv> eventually (\<lambda>n. Q) \<U> \<Longrightarrow> Trueprop P \<equiv> Trueprop Q"
   by (simp add: FreeUltrafilterNat.proper)
 
 text \<open>Standard principles that play a central role in the transfer tactic.\<close>
 definition Ifun :: "('a \<Rightarrow> 'b) star \<Rightarrow> 'a star \<Rightarrow> 'b star" (\<open>(_ \<star>/ _)\<close> [300, 301] 300)
   where "Ifun f \<equiv>
     \<lambda>x. Abs_star (\<Union>F\<in>Rep_star f. \<Union>X\<in>Rep_star x. starrel``{\<lambda>n. F n (X n)})"
 
 lemma Ifun_congruent2: "congruent2 starrel starrel (\<lambda>F X. starrel``{\<lambda>n. F n (X n)})"
   by (auto simp add: congruent2_def equiv_starrel_iff elim!: eventually_rev_mp)
 
 lemma Ifun_star_n: "star_n F \<star> star_n X = star_n (\<lambda>n. F n (X n))"
   by (simp add: Ifun_def star_n_def Abs_star_inverse starrel_in_star
       UN_equiv_class2 [OF equiv_starrel equiv_starrel Ifun_congruent2])
 
 lemma transfer_Ifun: "f \<equiv> star_n F \<Longrightarrow> x \<equiv> star_n X \<Longrightarrow> f \<star> x \<equiv> star_n (\<lambda>n. F n (X n))"
   by (simp only: Ifun_star_n)
 
 definition star_of :: "'a \<Rightarrow> 'a star"
   where "star_of x \<equiv> star_n (\<lambda>n. x)"
 
 text \<open>Initialize transfer tactic.\<close>
 ML_file \<open>transfer_principle.ML\<close>
 
 method_setup transfer =
   \<open>Attrib.thms >> (fn ths => fn ctxt => SIMPLE_METHOD' (Transfer_Principle.transfer_tac ctxt ths))\<close>
   "transfer principle"
 
 
 text \<open>Transfer introduction rules.\<close>
 
 lemma transfer_ex [transfer_intro]:
   "(\<And>X. p (star_n X) \<equiv> eventually (\<lambda>n. P n (X n)) \<U>) \<Longrightarrow>
     \<exists>x::'a star. p x \<equiv> eventually (\<lambda>n. \<exists>x. P n x) \<U>"
   by (simp only: ex_star_eq eventually_ex)
 
 lemma transfer_all [transfer_intro]:
   "(\<And>X. p (star_n X) \<equiv> eventually (\<lambda>n. P n (X n)) \<U>) \<Longrightarrow>
     \<forall>x::'a star. p x \<equiv> eventually (\<lambda>n. \<forall>x. P n x) \<U>"
   by (simp only: all_star_eq FreeUltrafilterNat.eventually_all_iff)
 
 lemma transfer_not [transfer_intro]: "p \<equiv> eventually P \<U> \<Longrightarrow> \<not> p \<equiv> eventually (\<lambda>n. \<not> P n) \<U>"
   by (simp only: FreeUltrafilterNat.eventually_not_iff)
 
 lemma transfer_conj [transfer_intro]:
   "p \<equiv> eventually P \<U> \<Longrightarrow> q \<equiv> eventually Q \<U> \<Longrightarrow> p \<and> q \<equiv> eventually (\<lambda>n. P n \<and> Q n) \<U>"
   by (simp only: eventually_conj_iff)
 
 lemma transfer_disj [transfer_intro]:
   "p \<equiv> eventually P \<U> \<Longrightarrow> q \<equiv> eventually Q \<U> \<Longrightarrow> p \<or> q \<equiv> eventually (\<lambda>n. P n \<or> Q n) \<U>"
   by (simp only: FreeUltrafilterNat.eventually_disj_iff)
 
 lemma transfer_imp [transfer_intro]:
   "p \<equiv> eventually P \<U> \<Longrightarrow> q \<equiv> eventually Q \<U> \<Longrightarrow> p \<longrightarrow> q \<equiv> eventually (\<lambda>n. P n \<longrightarrow> Q n) \<U>"
   by (simp only: FreeUltrafilterNat.eventually_imp_iff)
 
 lemma transfer_iff [transfer_intro]:
   "p \<equiv> eventually P \<U> \<Longrightarrow> q \<equiv> eventually Q \<U> \<Longrightarrow> p = q \<equiv> eventually (\<lambda>n. P n = Q n) \<U>"
   by (simp only: FreeUltrafilterNat.eventually_iff_iff)
 
 lemma transfer_if_bool [transfer_intro]:
   "p \<equiv> eventually P \<U> \<Longrightarrow> x \<equiv> eventually X \<U> \<Longrightarrow> y \<equiv> eventually Y \<U> \<Longrightarrow>
     (if p then x else y) \<equiv> eventually (\<lambda>n. if P n then X n else Y n) \<U>"
   by (simp only: if_bool_eq_conj transfer_conj transfer_imp transfer_not)
 
 lemma transfer_eq [transfer_intro]:
   "x \<equiv> star_n X \<Longrightarrow> y \<equiv> star_n Y \<Longrightarrow> x = y \<equiv> eventually (\<lambda>n. X n = Y n) \<U>"
   by (simp only: star_n_eq_iff)
 
 lemma transfer_if [transfer_intro]:
   "p \<equiv> eventually (\<lambda>n. P n) \<U> \<Longrightarrow> x \<equiv> star_n X \<Longrightarrow> y \<equiv> star_n Y \<Longrightarrow>
     (if p then x else y) \<equiv> star_n (\<lambda>n. if P n then X n else Y n)"
   by (rule eq_reflection) (auto simp: star_n_eq_iff transfer_not elim!: eventually_mono)
 
 lemma transfer_fun_eq [transfer_intro]:
   "(\<And>X. f (star_n X) = g (star_n X) \<equiv> eventually (\<lambda>n. F n (X n) = G n (X n)) \<U>) \<Longrightarrow>
     f = g \<equiv> eventually (\<lambda>n. F n = G n) \<U>"
   by (simp only: fun_eq_iff transfer_all)
 
 lemma transfer_star_n [transfer_intro]: "star_n X \<equiv> star_n (\<lambda>n. X n)"
   by (rule reflexive)
 
 lemma transfer_bool [transfer_intro]: "p \<equiv> eventually (\<lambda>n. p) \<U>"
   by (simp add: FreeUltrafilterNat.proper)
 
 
 subsection \<open>Standard elements\<close>
 
 definition Standard :: "'a star set"
   where "Standard = range star_of"
 
 text \<open>Transfer tactic should remove occurrences of \<^term>\<open>star_of\<close>.\<close>
 setup \<open>Transfer_Principle.add_const \<^const_name>\<open>star_of\<close>\<close>
 
 lemma star_of_inject: "star_of x = star_of y \<longleftrightarrow> x = y"
   by transfer (rule refl)
 
 lemma Standard_star_of [simp]: "star_of x \<in> Standard"
   by (simp add: Standard_def)
 
 
 subsection \<open>Internal functions\<close>
 
 text \<open>Transfer tactic should remove occurrences of \<^term>\<open>Ifun\<close>.\<close>
 setup \<open>Transfer_Principle.add_const \<^const_name>\<open>Ifun\<close>\<close>
 
 lemma Ifun_star_of [simp]: "star_of f \<star> star_of x = star_of (f x)"
   by transfer (rule refl)
 
 lemma Standard_Ifun [simp]: "f \<in> Standard \<Longrightarrow> x \<in> Standard \<Longrightarrow> f \<star> x \<in> Standard"
   by (auto simp add: Standard_def)
 
 
 text \<open>Nonstandard extensions of functions.\<close>
 
 definition starfun :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a star \<Rightarrow> 'b star"  (\<open>*f* _\<close> [80] 80)
   where "starfun f \<equiv> \<lambda>x. star_of f \<star> x"
 
 definition starfun2 :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a star \<Rightarrow> 'b star \<Rightarrow> 'c star"  (\<open>*f2* _\<close> [80] 80)
   where "starfun2 f \<equiv> \<lambda>x y. star_of f \<star> x \<star> y"
 
 declare starfun_def [transfer_unfold]
 declare starfun2_def [transfer_unfold]
 
 lemma starfun_star_n: "( *f* f) (star_n X) = star_n (\<lambda>n. f (X n))"
   by (simp only: starfun_def star_of_def Ifun_star_n)
 
 lemma starfun2_star_n: "( *f2* f) (star_n X) (star_n Y) = star_n (\<lambda>n. f (X n) (Y n))"
   by (simp only: starfun2_def star_of_def Ifun_star_n)
 
 lemma starfun_star_of [simp]: "( *f* f) (star_of x) = star_of (f x)"
   by transfer (rule refl)
 
 lemma starfun2_star_of [simp]: "( *f2* f) (star_of x) = *f* f x"
   by transfer (rule refl)
 
 lemma Standard_starfun [simp]: "x \<in> Standard \<Longrightarrow> starfun f x \<in> Standard"
   by (simp add: starfun_def)
 
 lemma Standard_starfun2 [simp]: "x \<in> Standard \<Longrightarrow> y \<in> Standard \<Longrightarrow> starfun2 f x y \<in> Standard"
   by (simp add: starfun2_def)
 
 lemma Standard_starfun_iff:
   assumes inj: "\<And>x y. f x = f y \<Longrightarrow> x = y"
   shows "starfun f x \<in> Standard \<longleftrightarrow> x \<in> Standard"
 proof
   assume "x \<in> Standard"
   then show "starfun f x \<in> Standard" by simp
 next
   from inj have inj': "\<And>x y. starfun f x = starfun f y \<Longrightarrow> x = y"
     by transfer
   assume "starfun f x \<in> Standard"
   then obtain b where b: "starfun f x = star_of b"
     unfolding Standard_def ..
   then have "\<exists>x. starfun f x = star_of b" ..
   then have "\<exists>a. f a = b" by transfer
   then obtain a where "f a = b" ..
   then have "starfun f (star_of a) = star_of b" by transfer
   with b have "starfun f x = starfun f (star_of a)" by simp
   then have "x = star_of a" by (rule inj')
   then show "x \<in> Standard" by (simp add: Standard_def)
 qed
 
 lemma Standard_starfun2_iff:
   assumes inj: "\<And>a b a' b'. f a b = f a' b' \<Longrightarrow> a = a' \<and> b = b'"
   shows "starfun2 f x y \<in> Standard \<longleftrightarrow> x \<in> Standard \<and> y \<in> Standard"
 proof
   assume "x \<in> Standard \<and> y \<in> Standard"
   then show "starfun2 f x y \<in> Standard" by simp
 next
   have inj': "\<And>x y z w. starfun2 f x y = starfun2 f z w \<Longrightarrow> x = z \<and> y = w"
     using inj by transfer
   assume "starfun2 f x y \<in> Standard"
   then obtain c where c: "starfun2 f x y = star_of c"
     unfolding Standard_def ..
   then have "\<exists>x y. starfun2 f x y = star_of c" by auto
   then have "\<exists>a b. f a b = c" by transfer
   then obtain a b where "f a b = c" by auto
   then have "starfun2 f (star_of a) (star_of b) = star_of c" by transfer
   with c have "starfun2 f x y = starfun2 f (star_of a) (star_of b)" by simp
   then have "x = star_of a \<and> y = star_of b" by (rule inj')
   then show "x \<in> Standard \<and> y \<in> Standard" by (simp add: Standard_def)
 qed
 
 
 subsection \<open>Internal predicates\<close>
 
 definition unstar :: "bool star \<Rightarrow> bool"
   where "unstar b \<longleftrightarrow> b = star_of True"
 
 lemma unstar_star_n: "unstar (star_n P) \<longleftrightarrow> eventually P \<U>"
   by (simp add: unstar_def star_of_def star_n_eq_iff)
 
 lemma unstar_star_of [simp]: "unstar (star_of p) = p"
   by (simp add: unstar_def star_of_inject)
 
 text \<open>Transfer tactic should remove occurrences of \<^term>\<open>unstar\<close>.\<close>
 setup \<open>Transfer_Principle.add_const \<^const_name>\<open>unstar\<close>\<close>
 
 lemma transfer_unstar [transfer_intro]: "p \<equiv> star_n P \<Longrightarrow> unstar p \<equiv> eventually P \<U>"
   by (simp only: unstar_star_n)
 
 definition starP :: "('a \<Rightarrow> bool) \<Rightarrow> 'a star \<Rightarrow> bool"  (\<open>*p* _\<close> [80] 80)
   where "*p* P = (\<lambda>x. unstar (star_of P \<star> x))"
 
 definition starP2 :: "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'a star \<Rightarrow> 'b star \<Rightarrow> bool"  (\<open>*p2* _\<close> [80] 80)
   where "*p2* P = (\<lambda>x y. unstar (star_of P \<star> x \<star> y))"
 
 declare starP_def [transfer_unfold]
 declare starP2_def [transfer_unfold]
 
 lemma starP_star_n: "( *p* P) (star_n X) = eventually (\<lambda>n. P (X n)) \<U>"
   by (simp only: starP_def star_of_def Ifun_star_n unstar_star_n)
 
 lemma starP2_star_n: "( *p2* P) (star_n X) (star_n Y) = (eventually (\<lambda>n. P (X n) (Y n)) \<U>)"
   by (simp only: starP2_def star_of_def Ifun_star_n unstar_star_n)
 
 lemma starP_star_of [simp]: "( *p* P) (star_of x) = P x"
   by transfer (rule refl)
 
 lemma starP2_star_of [simp]: "( *p2* P) (star_of x) = *p* P x"
   by transfer (rule refl)
 
 
 subsection \<open>Internal sets\<close>
 
 definition Iset :: "'a set star \<Rightarrow> 'a star set"
   where "Iset A = {x. ( *p2* (\<in>)) x A}"
 
 lemma Iset_star_n: "(star_n X \<in> Iset (star_n A)) = (eventually (\<lambda>n. X n \<in> A n) \<U>)"
   by (simp add: Iset_def starP2_star_n)
 
 text \<open>Transfer tactic should remove occurrences of \<^term>\<open>Iset\<close>.\<close>
 setup \<open>Transfer_Principle.add_const \<^const_name>\<open>Iset\<close>\<close>
 
 lemma transfer_mem [transfer_intro]:
   "x \<equiv> star_n X \<Longrightarrow> a \<equiv> Iset (star_n A) \<Longrightarrow> x \<in> a \<equiv> eventually (\<lambda>n. X n \<in> A n) \<U>"
   by (simp only: Iset_star_n)
 
 lemma transfer_Collect [transfer_intro]:
   "(\<And>X. p (star_n X) \<equiv> eventually (\<lambda>n. P n (X n)) \<U>) \<Longrightarrow>
     Collect p \<equiv> Iset (star_n (\<lambda>n. Collect (P n)))"
   by (simp add: atomize_eq set_eq_iff all_star_eq Iset_star_n)
 
 lemma transfer_set_eq [transfer_intro]:
   "a \<equiv> Iset (star_n A) \<Longrightarrow> b \<equiv> Iset (star_n B) \<Longrightarrow> a = b \<equiv> eventually (\<lambda>n. A n = B n) \<U>"
   by (simp only: set_eq_iff transfer_all transfer_iff transfer_mem)
 
 lemma transfer_ball [transfer_intro]:
   "a \<equiv> Iset (star_n A) \<Longrightarrow> (\<And>X. p (star_n X) \<equiv> eventually (\<lambda>n. P n (X n)) \<U>) \<Longrightarrow>
     \<forall>x\<in>a. p x \<equiv> eventually (\<lambda>n. \<forall>x\<in>A n. P n x) \<U>"
   by (simp only: Ball_def transfer_all transfer_imp transfer_mem)
 
 lemma transfer_bex [transfer_intro]:
   "a \<equiv> Iset (star_n A) \<Longrightarrow> (\<And>X. p (star_n X) \<equiv> eventually (\<lambda>n. P n (X n)) \<U>) \<Longrightarrow>
     \<exists>x\<in>a. p x \<equiv> eventually (\<lambda>n. \<exists>x\<in>A n. P n x) \<U>"
   by (simp only: Bex_def transfer_ex transfer_conj transfer_mem)
 
 lemma transfer_Iset [transfer_intro]: "a \<equiv> star_n A \<Longrightarrow> Iset a \<equiv> Iset (star_n (\<lambda>n. A n))"
   by simp
 
 
 text \<open>Nonstandard extensions of sets.\<close>
 
 definition starset :: "'a set \<Rightarrow> 'a star set" (\<open>*s* _\<close> [80] 80)
   where "starset A = Iset (star_of A)"
 
 declare starset_def [transfer_unfold]
 
 lemma starset_mem: "star_of x \<in> *s* A \<longleftrightarrow> x \<in> A"
   by transfer (rule refl)
 
 lemma starset_UNIV: "*s* (UNIV::'a set) = (UNIV::'a star set)"
   by (transfer UNIV_def) (rule refl)
 
 lemma starset_empty: "*s* {} = {}"
   by (transfer empty_def) (rule refl)
 
 lemma starset_insert: "*s* (insert x A) = insert (star_of x) ( *s* A)"
   by (transfer insert_def Un_def) (rule refl)
 
 lemma starset_Un: "*s* (A \<union> B) = *s* A \<union> *s* B"
   by (transfer Un_def) (rule refl)
 
 lemma starset_Int: "*s* (A \<inter> B) = *s* A \<inter> *s* B"
   by (transfer Int_def) (rule refl)
 
 lemma starset_Compl: "*s* -A = -( *s* A)"
   by (transfer Compl_eq) (rule refl)
 
 lemma starset_diff: "*s* (A - B) = *s* A - *s* B"
   by (transfer set_diff_eq) (rule refl)
 
 lemma starset_image: "*s* (f ` A) = ( *f* f) ` ( *s* A)"
   by (transfer image_def) (rule refl)
 
 lemma starset_vimage: "*s* (f -` A) = ( *f* f) -` ( *s* A)"
   by (transfer vimage_def) (rule refl)
 
 lemma starset_subset: "( *s* A \<subseteq> *s* B) \<longleftrightarrow> A \<subseteq> B"
   by (transfer subset_eq) (rule refl)
 
 lemma starset_eq: "( *s* A = *s* B) \<longleftrightarrow> A = B"
   by transfer (rule refl)
 
 lemmas starset_simps [simp] =
   starset_mem     starset_UNIV
   starset_empty   starset_insert
   starset_Un      starset_Int
   starset_Compl   starset_diff
   starset_image   starset_vimage
   starset_subset  starset_eq
 
 
 subsection \<open>Syntactic classes\<close>
 
 instantiation star :: (zero) zero
 begin
   definition star_zero_def: "0 \<equiv> star_of 0"
   instance ..
 end
 
 instantiation star :: (one) one
 begin
   definition star_one_def: "1 \<equiv> star_of 1"
   instance ..
 end
 
 instantiation star :: (plus) plus
 begin
   definition star_add_def: "(+) \<equiv> *f2* (+)"
   instance ..
 end
 
 instantiation star :: (times) times
 begin
   definition star_mult_def: "((*)) \<equiv> *f2* ((*))"
   instance ..
 end
 
 instantiation star :: (uminus) uminus
 begin
   definition star_minus_def: "uminus \<equiv> *f* uminus"
   instance ..
 end
 
 instantiation star :: (minus) minus
 begin
   definition star_diff_def: "(-) \<equiv> *f2* (-)"
   instance ..
 end
 
 instantiation star :: (abs) abs
 begin
   definition star_abs_def: "abs \<equiv> *f* abs"
   instance ..
 end
 
 instantiation star :: (sgn) sgn
 begin
   definition star_sgn_def: "sgn \<equiv> *f* sgn"
   instance ..
 end
 
 instantiation star :: (divide) divide
 begin
   definition star_divide_def:  "divide \<equiv> *f2* divide"
   instance ..
 end
 
 instantiation star :: (inverse) inverse
 begin
   definition star_inverse_def: "inverse \<equiv> *f* inverse"
   instance ..
 end
 
 instance star :: (Rings.dvd) Rings.dvd ..
 
 instantiation star :: (modulo) modulo
 begin
   definition star_mod_def: "(mod) \<equiv> *f2* (mod)"
   instance ..
 end
 
 instantiation star :: (ord) ord
 begin
   definition star_le_def: "(\<le>) \<equiv> *p2* (\<le>)"
   definition star_less_def: "(<) \<equiv> *p2* (<)"
   instance ..
 end
 
 lemmas star_class_defs [transfer_unfold] =
   star_zero_def     star_one_def
   star_add_def      star_diff_def     star_minus_def
   star_mult_def     star_divide_def   star_inverse_def
   star_le_def       star_less_def     star_abs_def       star_sgn_def
   star_mod_def
 
 
 text \<open>Class operations preserve standard elements.\<close>
 
 lemma Standard_zero: "0 \<in> Standard"
   by (simp add: star_zero_def)
 
 lemma Standard_one: "1 \<in> Standard"
   by (simp add: star_one_def)
 
 lemma Standard_add: "x \<in> Standard \<Longrightarrow> y \<in> Standard \<Longrightarrow> x + y \<in> Standard"
   by (simp add: star_add_def)
 
 lemma Standard_diff: "x \<in> Standard \<Longrightarrow> y \<in> Standard \<Longrightarrow> x - y \<in> Standard"
   by (simp add: star_diff_def)
 
 lemma Standard_minus: "x \<in> Standard \<Longrightarrow> - x \<in> Standard"
   by (simp add: star_minus_def)
 
 lemma Standard_mult: "x \<in> Standard \<Longrightarrow> y \<in> Standard \<Longrightarrow> x * y \<in> Standard"
   by (simp add: star_mult_def)
 
 lemma Standard_divide: "x \<in> Standard \<Longrightarrow> y \<in> Standard \<Longrightarrow> x / y \<in> Standard"
   by (simp add: star_divide_def)
 
 lemma Standard_inverse: "x \<in> Standard \<Longrightarrow> inverse x \<in> Standard"
   by (simp add: star_inverse_def)
 
 lemma Standard_abs: "x \<in> Standard \<Longrightarrow> \<bar>x\<bar> \<in> Standard"
   by (simp add: star_abs_def)
 
 lemma Standard_mod: "x \<in> Standard \<Longrightarrow> y \<in> Standard \<Longrightarrow> x mod y \<in> Standard"
   by (simp add: star_mod_def)
 
 lemmas Standard_simps [simp] =
   Standard_zero  Standard_one
   Standard_add   Standard_diff    Standard_minus
   Standard_mult  Standard_divide  Standard_inverse
   Standard_abs   Standard_mod
 
 
 text \<open>\<^term>\<open>star_of\<close> preserves class operations.\<close>
 
 lemma star_of_add: "star_of (x + y) = star_of x + star_of y"
   by transfer (rule refl)
 
 lemma star_of_diff: "star_of (x - y) = star_of x - star_of y"
   by transfer (rule refl)
 
 lemma star_of_minus: "star_of (-x) = - star_of x"
   by transfer (rule refl)
 
 lemma star_of_mult: "star_of (x * y) = star_of x * star_of y"
   by transfer (rule refl)
 
 lemma star_of_divide: "star_of (x / y) = star_of x / star_of y"
   by transfer (rule refl)
 
 lemma star_of_inverse: "star_of (inverse x) = inverse (star_of x)"
   by transfer (rule refl)
 
 lemma star_of_mod: "star_of (x mod y) = star_of x mod star_of y"
   by transfer (rule refl)
 
 lemma star_of_abs: "star_of \<bar>x\<bar> = \<bar>star_of x\<bar>"
   by transfer (rule refl)
 
 
 text \<open>\<^term>\<open>star_of\<close> preserves numerals.\<close>
 
 lemma star_of_zero: "star_of 0 = 0"
   by transfer (rule refl)
 
 lemma star_of_one: "star_of 1 = 1"
   by transfer (rule refl)
 
 
 text \<open>\<^term>\<open>star_of\<close> preserves orderings.\<close>
 
 lemma star_of_less: "(star_of x < star_of y) = (x < y)"
 by transfer (rule refl)
 
 lemma star_of_le: "(star_of x \<le> star_of y) = (x \<le> y)"
 by transfer (rule refl)
 
 lemma star_of_eq: "(star_of x = star_of y) = (x = y)"
 by transfer (rule refl)
 
 
 text \<open>As above, for \<open>0\<close>.\<close>
 
 lemmas star_of_0_less = star_of_less [of 0, simplified star_of_zero]
 lemmas star_of_0_le   = star_of_le   [of 0, simplified star_of_zero]
 lemmas star_of_0_eq   = star_of_eq   [of 0, simplified star_of_zero]
 
 lemmas star_of_less_0 = star_of_less [of _ 0, simplified star_of_zero]
 lemmas star_of_le_0   = star_of_le   [of _ 0, simplified star_of_zero]
 lemmas star_of_eq_0   = star_of_eq   [of _ 0, simplified star_of_zero]
 
 
 text \<open>As above, for \<open>1\<close>.\<close>
 
 lemmas star_of_1_less = star_of_less [of 1, simplified star_of_one]
 lemmas star_of_1_le   = star_of_le   [of 1, simplified star_of_one]
 lemmas star_of_1_eq   = star_of_eq   [of 1, simplified star_of_one]
 
 lemmas star_of_less_1 = star_of_less [of _ 1, simplified star_of_one]
 lemmas star_of_le_1   = star_of_le   [of _ 1, simplified star_of_one]
 lemmas star_of_eq_1   = star_of_eq   [of _ 1, simplified star_of_one]
 
 lemmas star_of_simps [simp] =
   star_of_add     star_of_diff    star_of_minus
   star_of_mult    star_of_divide  star_of_inverse
   star_of_mod     star_of_abs
   star_of_zero    star_of_one
   star_of_less    star_of_le      star_of_eq
   star_of_0_less  star_of_0_le    star_of_0_eq
   star_of_less_0  star_of_le_0    star_of_eq_0
   star_of_1_less  star_of_1_le    star_of_1_eq
   star_of_less_1  star_of_le_1    star_of_eq_1
 
 
 subsection \<open>Ordering and lattice classes\<close>
 
 instance star :: (order) order
 proof 
   show "\<And>x y::'a star. (x < y) = (x \<le> y \<and> \<not> y \<le> x)"
     by transfer (rule less_le_not_le)
   show "\<And>x::'a star. x \<le> x"
     by transfer (rule order_refl)
   show "\<And>x y z::'a star. \<lbrakk>x \<le> y; y \<le> z\<rbrakk> \<Longrightarrow> x \<le> z"
     by transfer (rule order_trans)
   show "\<And>x y::'a star. \<lbrakk>x \<le> y; y \<le> x\<rbrakk> \<Longrightarrow> x = y"
     by transfer (rule order_antisym)
 qed
 
 instantiation star :: (semilattice_inf) semilattice_inf
 begin
   definition star_inf_def [transfer_unfold]: "inf \<equiv> *f2* inf"
   instance by (standard; transfer) auto
 end
 
 instantiation star :: (semilattice_sup) semilattice_sup
 begin
   definition star_sup_def [transfer_unfold]: "sup \<equiv> *f2* sup"
   instance by (standard; transfer) auto
 end
 
 instance star :: (lattice) lattice ..
 
 instance star :: (distrib_lattice) distrib_lattice
   by (standard; transfer) (auto simp add: sup_inf_distrib1)
 
 lemma Standard_inf [simp]: "x \<in> Standard \<Longrightarrow> y \<in> Standard \<Longrightarrow> inf x y \<in> Standard"
   by (simp add: star_inf_def)
 
 lemma Standard_sup [simp]: "x \<in> Standard \<Longrightarrow> y \<in> Standard \<Longrightarrow> sup x y \<in> Standard"
   by (simp add: star_sup_def)
 
 lemma star_of_inf [simp]: "star_of (inf x y) = inf (star_of x) (star_of y)"
   by transfer (rule refl)
 
 lemma star_of_sup [simp]: "star_of (sup x y) = sup (star_of x) (star_of y)"
   by transfer (rule refl)
 
 instance star :: (linorder) linorder
   by (intro_classes, transfer, rule linorder_linear)
 
 lemma star_max_def [transfer_unfold]: "max = *f2* max"
   unfolding max_def
   by (intro ext, transfer, simp)
 
 lemma star_min_def [transfer_unfold]: "min = *f2* min"
   unfolding min_def
   by (intro ext, transfer, simp)
 
 lemma Standard_max [simp]: "x \<in> Standard \<Longrightarrow> y \<in> Standard \<Longrightarrow> max x y \<in> Standard"
   by (simp add: star_max_def)
 
 lemma Standard_min [simp]: "x \<in> Standard \<Longrightarrow> y \<in> Standard \<Longrightarrow> min x y \<in> Standard"
   by (simp add: star_min_def)
 
 lemma star_of_max [simp]: "star_of (max x y) = max (star_of x) (star_of y)"
   by transfer (rule refl)
 
 lemma star_of_min [simp]: "star_of (min x y) = min (star_of x) (star_of y)"
   by transfer (rule refl)
 
 
 subsection \<open>Ordered group classes\<close>
 
 instance star :: (semigroup_add) semigroup_add
   by (intro_classes, transfer, rule add.assoc)
 
 instance star :: (ab_semigroup_add) ab_semigroup_add
   by (intro_classes, transfer, rule add.commute)
 
 instance star :: (semigroup_mult) semigroup_mult
   by (intro_classes, transfer, rule mult.assoc)
 
 instance star :: (ab_semigroup_mult) ab_semigroup_mult
   by (intro_classes, transfer, rule mult.commute)
 
 instance star :: (comm_monoid_add) comm_monoid_add
   by (intro_classes, transfer, rule comm_monoid_add_class.add_0)
 
 instance star :: (monoid_mult) monoid_mult
   apply intro_classes
    apply (transfer, rule mult_1_left)
   apply (transfer, rule mult_1_right)
   done
 
 instance star :: (power) power ..
 
 instance star :: (comm_monoid_mult) comm_monoid_mult
   by (intro_classes, transfer, rule mult_1)
 
 instance star :: (cancel_semigroup_add) cancel_semigroup_add
   apply intro_classes
    apply (transfer, erule add_left_imp_eq)
   apply (transfer, erule add_right_imp_eq)
   done
 
 instance star :: (cancel_ab_semigroup_add) cancel_ab_semigroup_add
   by intro_classes (transfer, simp add: diff_diff_eq)+
 
 instance star :: (cancel_comm_monoid_add) cancel_comm_monoid_add ..
 
 instance star :: (ab_group_add) ab_group_add
   apply intro_classes
    apply (transfer, rule left_minus)
   apply (transfer, rule diff_conv_add_uminus)
   done
 
 instance star :: (ordered_ab_semigroup_add) ordered_ab_semigroup_add
   by (intro_classes, transfer, rule add_left_mono)
 
 instance star :: (ordered_cancel_ab_semigroup_add) ordered_cancel_ab_semigroup_add ..
 
 instance star :: (ordered_ab_semigroup_add_imp_le) ordered_ab_semigroup_add_imp_le
   by (intro_classes, transfer, rule add_le_imp_le_left)
 
 instance star :: (ordered_comm_monoid_add) ordered_comm_monoid_add ..
 instance star :: (ordered_ab_semigroup_monoid_add_imp_le) ordered_ab_semigroup_monoid_add_imp_le ..
 instance star :: (ordered_cancel_comm_monoid_add) ordered_cancel_comm_monoid_add ..
 instance star :: (ordered_ab_group_add) ordered_ab_group_add ..
 
 instance star :: (ordered_ab_group_add_abs) ordered_ab_group_add_abs
   by intro_classes (transfer, simp add: abs_ge_self abs_leI abs_triangle_ineq)+
 
 instance star :: (linordered_cancel_ab_semigroup_add) linordered_cancel_ab_semigroup_add ..
 
 
 subsection \<open>Ring and field classes\<close>
 
 instance star :: (semiring) semiring
   by (intro_classes; transfer) (fact distrib_right distrib_left)+
 
 instance star :: (semiring_0) semiring_0
   by (intro_classes; transfer) simp_all
 
 instance star :: (semiring_0_cancel) semiring_0_cancel ..
 
 instance star :: (comm_semiring) comm_semiring
   by (intro_classes; transfer) (fact distrib_right)
 
 instance star :: (comm_semiring_0) comm_semiring_0 ..
 instance star :: (comm_semiring_0_cancel) comm_semiring_0_cancel ..
 
 instance star :: (zero_neq_one) zero_neq_one
   by (intro_classes; transfer) (fact zero_neq_one)
 
 instance star :: (semiring_1) semiring_1 ..
 instance star :: (comm_semiring_1) comm_semiring_1 ..
 
 declare dvd_def [transfer_refold]
 
 instance star :: (comm_semiring_1_cancel) comm_semiring_1_cancel
   by (intro_classes; transfer) (fact right_diff_distrib')
 
 instance star :: (semiring_no_zero_divisors) semiring_no_zero_divisors
   by (intro_classes; transfer) (fact no_zero_divisors)
 
 instance star :: (semiring_1_no_zero_divisors) semiring_1_no_zero_divisors ..
 
 instance star :: (semiring_no_zero_divisors_cancel) semiring_no_zero_divisors_cancel
   by (intro_classes; transfer) simp_all
 
 instance star :: (semiring_1_cancel) semiring_1_cancel ..
 instance star :: (ring) ring ..
 instance star :: (comm_ring) comm_ring ..
 instance star :: (ring_1) ring_1 ..
 instance star :: (comm_ring_1) comm_ring_1 ..
 instance star :: (semidom) semidom ..
 
 instance star :: (semidom_divide) semidom_divide
   by (intro_classes; transfer) simp_all
 
 instance star :: (ring_no_zero_divisors) ring_no_zero_divisors ..
 instance star :: (ring_1_no_zero_divisors) ring_1_no_zero_divisors ..
 instance star :: (idom) idom ..
 instance star :: (idom_divide) idom_divide ..
 
+instance star :: (divide_trivial) divide_trivial
+  by (intro_classes; transfer) simp_all
+
 instance star :: (division_ring) division_ring
   by (intro_classes; transfer) (simp_all add: divide_inverse)
 
 instance star :: (field) field
   by (intro_classes; transfer) (simp_all add: divide_inverse)
 
 instance star :: (ordered_semiring) ordered_semiring
   by (intro_classes; transfer) (fact mult_left_mono mult_right_mono)+
 
 instance star :: (ordered_cancel_semiring) ordered_cancel_semiring ..
 
 instance star :: (linordered_semiring_strict) linordered_semiring_strict
   by (intro_classes; transfer) (fact mult_strict_left_mono mult_strict_right_mono)+
 
 instance star :: (ordered_comm_semiring) ordered_comm_semiring
   by (intro_classes; transfer) (fact mult_left_mono)
 
 instance star :: (ordered_cancel_comm_semiring) ordered_cancel_comm_semiring ..
 
 instance star :: (linordered_comm_semiring_strict) linordered_comm_semiring_strict
   by (intro_classes; transfer) (fact mult_strict_left_mono)
 
 instance star :: (ordered_ring) ordered_ring ..
 
 instance star :: (ordered_ring_abs) ordered_ring_abs
   by (intro_classes; transfer) (fact abs_eq_mult)
 
 instance star :: (abs_if) abs_if
   by (intro_classes; transfer) (fact abs_if)
 
 instance star :: (linordered_ring_strict) linordered_ring_strict ..
 instance star :: (ordered_comm_ring) ordered_comm_ring ..
 
 instance star :: (linordered_semidom) linordered_semidom
   by (intro_classes; transfer) (fact zero_less_one le_add_diff_inverse2)+
 
 instance star :: (linordered_idom) linordered_idom
   by (intro_classes; transfer) (fact sgn_if)
 
 instance star :: (linordered_field) linordered_field ..
 
 instance star :: (algebraic_semidom) algebraic_semidom ..
 
 instantiation star :: (normalization_semidom) normalization_semidom
 begin
 
 definition unit_factor_star :: "'a star \<Rightarrow> 'a star"
   where [transfer_unfold]: "unit_factor_star = *f* unit_factor"
 
 definition normalize_star :: "'a star \<Rightarrow> 'a star"
   where [transfer_unfold]: "normalize_star = *f* normalize"
 
 instance
   by standard (transfer; simp add: is_unit_unit_factor unit_factor_mult)+
 
 end
 
 instance star :: (semidom_modulo) semidom_modulo
   by standard (transfer; simp)
 
 
 
 subsection \<open>Power\<close>
 
 lemma star_power_def [transfer_unfold]: "(^) \<equiv> \<lambda>x n. ( *f* (\<lambda>x. x ^ n)) x"
 proof (rule eq_reflection, rule ext, rule ext)
   show "x ^ n = ( *f* (\<lambda>x. x ^ n)) x" for n :: nat and x :: "'a star"
   proof (induct n arbitrary: x)
     case 0
     have "\<And>x::'a star. ( *f* (\<lambda>x. 1)) x = 1"
       by transfer simp
     then show ?case by simp
   next
     case (Suc n)
     have "\<And>x::'a star. x * ( *f* (\<lambda>x::'a. x ^ n)) x = ( *f* (\<lambda>x::'a. x * x ^ n)) x"
       by transfer simp
     with Suc show ?case by simp
   qed
 qed
 
 lemma Standard_power [simp]: "x \<in> Standard \<Longrightarrow> x ^ n \<in> Standard"
   by (simp add: star_power_def)
 
 lemma star_of_power [simp]: "star_of (x ^ n) = star_of x ^ n"
   by transfer (rule refl)
 
 
 subsection \<open>Number classes\<close>
 
 instance star :: (numeral) numeral ..
 
 lemma star_numeral_def [transfer_unfold]: "numeral k = star_of (numeral k)"
   by (induct k) (simp_all only: numeral.simps star_of_one star_of_add)
 
 lemma Standard_numeral [simp]: "numeral k \<in> Standard"
   by (simp add: star_numeral_def)
 
 lemma star_of_numeral [simp]: "star_of (numeral k) = numeral k"
   by transfer (rule refl)
 
 lemma star_of_nat_def [transfer_unfold]: "of_nat n = star_of (of_nat n)"
   by (induct n) simp_all
 
 lemmas star_of_compare_numeral [simp] =
   star_of_less [of "numeral k", simplified star_of_numeral]
   star_of_le   [of "numeral k", simplified star_of_numeral]
   star_of_eq   [of "numeral k", simplified star_of_numeral]
   star_of_less [of _ "numeral k", simplified star_of_numeral]
   star_of_le   [of _ "numeral k", simplified star_of_numeral]
   star_of_eq   [of _ "numeral k", simplified star_of_numeral]
   star_of_less [of "- numeral k", simplified star_of_numeral]
   star_of_le   [of "- numeral k", simplified star_of_numeral]
   star_of_eq   [of "- numeral k", simplified star_of_numeral]
   star_of_less [of _ "- numeral k", simplified star_of_numeral]
   star_of_le   [of _ "- numeral k", simplified star_of_numeral]
   star_of_eq   [of _ "- numeral k", simplified star_of_numeral] for k
 
 lemma Standard_of_nat [simp]: "of_nat n \<in> Standard"
   by (simp add: star_of_nat_def)
 
 lemma star_of_of_nat [simp]: "star_of (of_nat n) = of_nat n"
   by transfer (rule refl)
 
 lemma star_of_int_def [transfer_unfold]: "of_int z = star_of (of_int z)"
   by (rule int_diff_cases [of z]) simp
 
 lemma Standard_of_int [simp]: "of_int z \<in> Standard"
   by (simp add: star_of_int_def)
 
 lemma star_of_of_int [simp]: "star_of (of_int z) = of_int z"
   by transfer (rule refl)
 
 instance star :: (semiring_char_0) semiring_char_0
 proof
   have "inj (star_of :: 'a \<Rightarrow> 'a star)"
     by (rule injI) simp
   then have "inj (star_of \<circ> of_nat :: nat \<Rightarrow> 'a star)"
     using inj_of_nat by (rule inj_compose)
   then show "inj (of_nat :: nat \<Rightarrow> 'a star)"
     by (simp add: comp_def)
 qed
 
 instance star :: (ring_char_0) ring_char_0 ..
 
 
 subsection \<open>Finite class\<close>
 
 lemma starset_finite: "finite A \<Longrightarrow> *s* A = star_of ` A"
   by (erule finite_induct) simp_all
 
 instance star :: (finite) finite
 proof intro_classes
   show "finite (UNIV::'a star set)"
     by (metis starset_UNIV finite finite_imageI starset_finite)
 qed
 
 end
diff --git a/src/HOL/Rings.thy b/src/HOL/Rings.thy
--- a/src/HOL/Rings.thy
+++ b/src/HOL/Rings.thy
@@ -1,2795 +1,2809 @@
 (*  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)"
   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 (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:
   \<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
 
 lemma inj_mult_left [simp]: \<open>inj ((*) a) \<longleftrightarrow> a \<noteq> 0\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof
   assume ?P
   show ?Q
   proof
     assume \<open>a = 0\<close>
     with \<open>?P\<close> have "inj ((*) 0)"
       by simp
     moreover have "0 * 0 = 0 * 1"
       by simp
     ultimately have "0 = 1"
       by (rule injD)
     then show False
       by simp
   qed
 next
   assume ?Q then show ?P
     by (auto intro: injI)
 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>
 
+class divide_trivial = zero + one + divide +
+  assumes div_by_0 [simp]: \<open>a div 0 = 0\<close>
+    and div_by_1 [simp]: \<open>a div 1 = a\<close>
+    and div_0 [simp]: \<open>0 div a = 0\<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"
+  assumes nonzero_mult_div_cancel_right [simp]: \<open>b \<noteq> 0 \<Longrightarrow> (a * b) div b = a\<close>
+  assumes semidom_div_by_0: \<open>a div 0 = 0\<close>
 begin
 
-lemma nonzero_mult_div_cancel_left [simp]: "a \<noteq> 0 \<Longrightarrow> (a * b) div a = b"
+lemma nonzero_mult_div_cancel_left [simp]: \<open>a \<noteq> 0 \<Longrightarrow> (a * b) div a = b\<close>
   using nonzero_mult_div_cancel_right [of a b] by (simp add: ac_simps)
 
+subclass divide_trivial
+proof
+  show [simp]: \<open>a div 0 = 0\<close> for a
+    by (fact semidom_div_by_0)
+  show \<open>a div 1 = a\<close> for a
+    using nonzero_mult_div_cancel_right [of 1 a] by simp
+  show \<open>0 div a = 0\<close> for a
+    using nonzero_mult_div_cancel_right [of a 0] by (cases \<open>a = 0\<close>) simp_all
+qed
+
 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"
   using assms by (simp add: dvd_div_eq_0_iff unit_imp_dvd)
 
 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 iffI; 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"
+  assumes div_mult_mod_eq: \<open>a div b * b + a mod b = a\<close>
 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
 
+class semiring_modulo_trivial = semiring_modulo + divide_trivial
+begin
+
+lemma mod_0 [simp]:
+  \<open>0 mod a = 0\<close>
+  using div_mult_mod_eq [of 0 a] by simp
+
+lemma mod_by_0 [simp]:
+  \<open>a mod 0 = a\<close>
+  using div_mult_mod_eq [of a 0] by simp
+
+lemma mod_by_1 [simp]:
+  \<open>a mod 1 = 0\<close>
+proof -
+  have \<open>a + a mod 1 = a\<close>
+    using div_mult_mod_eq [of a 1] by simp
+  then have \<open>a + a mod 1 = a + 0\<close>
+    by simp
+  then show ?thesis
+    by (rule add_left_imp_eq)
+qed
+
+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
+subclass semiring_modulo_trivial ..
 
 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
 
 lemma mono_mult:
   fixes a :: "'a::ordered_semiring" 
   shows "a \<ge> 0 \<Longrightarrow> mono ((*) a)"
   by (simp add: mono_def mult_left_mono)
 
 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"
 begin
 
 subclass zero_neq_one
   by standard (simp add: less_imp_neq)
 
 lemma zero_le_one [simp]:
   \<open>0 \<le> 1\<close> by (rule less_imp_le) simp
 
 end
 
 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"
   using assms by (auto simp add: mult_strict_mono)
 
 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
 
 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)
     assume "\<not> a + 1 < b + 1"
     moreover with that have "a + 1 < b + 1"
       by simp
     ultimately show False
       by contradiction
   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 left_sgn_mult_self_eq [simp]:
   \<open>sgn a * (sgn a * b) = of_bool (a \<noteq> 0) * b\<close>
   by (simp flip: mult.assoc)
 
 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"])
 
 text \<open>
   Is this really better than just rewriting with \<open>abs_if\<close>?
 \<close>
 lemma abs_split [no_atp]: \<open>P \<bar>a\<bar> \<longleftrightarrow> (0 \<le> a \<longrightarrow> P a) \<and> (a < 0 \<longrightarrow> P (- a))\<close>
   by (force dest: order_less_le_trans simp add: abs_if linorder_not_less)
 
 end
 
 class discrete_linordered_semidom = linordered_semidom +
   assumes less_iff_succ_less_eq: \<open>a < b \<longleftrightarrow> a + 1 \<le> b\<close>
 begin
 
 lemma less_eq_iff_succ_less:
   \<open>a \<le> b \<longleftrightarrow> a < b + 1\<close>
   using less_iff_succ_less_eq [of a \<open>b + 1\<close>] by simp
 
 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_mult_pos': "0 \<le> x \<Longrightarrow> x * \<bar>y\<bar> = \<bar>x * y\<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