diff --git a/src/HOL/Complex.thy b/src/HOL/Complex.thy
--- a/src/HOL/Complex.thy
+++ b/src/HOL/Complex.thy
@@ -1,1307 +1,1313 @@
 (*  Title:       HOL/Complex.thy
     Author:      Jacques D. Fleuriot, 2001 University of Edinburgh
     Author:      Lawrence C Paulson, 2003/4
 *)
 
 section \<open>Complex Numbers: Rectangular and Polar Representations\<close>
 
 theory Complex
 imports Transcendental
 begin
 
 text \<open>
   We use the \<^theory_text>\<open>codatatype\<close> command to define the type of complex numbers. This
   allows us to use \<^theory_text>\<open>primcorec\<close> to define complex functions by defining their
   real and imaginary result separately.
 \<close>
 
 codatatype complex = Complex (Re: real) (Im: real)
 
 lemma complex_surj: "Complex (Re z) (Im z) = z"
   by (rule complex.collapse)
 
 lemma complex_eqI [intro?]: "Re x = Re y \<Longrightarrow> Im x = Im y \<Longrightarrow> x = y"
   by (rule complex.expand) simp
 
 lemma complex_eq_iff: "x = y \<longleftrightarrow> Re x = Re y \<and> Im x = Im y"
   by (auto intro: complex.expand)
 
 
 subsection \<open>Addition and Subtraction\<close>
 
 instantiation complex :: ab_group_add
 begin
 
 primcorec zero_complex
   where
     "Re 0 = 0"
   | "Im 0 = 0"
 
 primcorec plus_complex
   where
     "Re (x + y) = Re x + Re y"
   | "Im (x + y) = Im x + Im y"
 
 primcorec uminus_complex
   where
     "Re (- x) = - Re x"
   | "Im (- x) = - Im x"
 
 primcorec minus_complex
   where
     "Re (x - y) = Re x - Re y"
   | "Im (x - y) = Im x - Im y"
 
 instance
   by standard (simp_all add: complex_eq_iff)
 
 end
 
 
 subsection \<open>Multiplication and Division\<close>
 
 instantiation complex :: field
 begin
 
 primcorec one_complex
   where
     "Re 1 = 1"
   | "Im 1 = 0"
 
 primcorec times_complex
   where
     "Re (x * y) = Re x * Re y - Im x * Im y"
   | "Im (x * y) = Re x * Im y + Im x * Re y"
 
 primcorec inverse_complex
   where
     "Re (inverse x) = Re x / ((Re x)\<^sup>2 + (Im x)\<^sup>2)"
   | "Im (inverse x) = - Im x / ((Re x)\<^sup>2 + (Im x)\<^sup>2)"
 
 definition "x div y = x * inverse y" for x y :: complex
 
 instance
   by standard
      (simp_all add: complex_eq_iff divide_complex_def
       distrib_left distrib_right right_diff_distrib left_diff_distrib
       power2_eq_square add_divide_distrib [symmetric])
 
 end
 
 lemma Re_divide: "Re (x / y) = (Re x * Re y + Im x * Im y) / ((Re y)\<^sup>2 + (Im y)\<^sup>2)"
   by (simp add: divide_complex_def add_divide_distrib)
 
 lemma Im_divide: "Im (x / y) = (Im x * Re y - Re x * Im y) / ((Re y)\<^sup>2 + (Im y)\<^sup>2)"
   by (simp add: divide_complex_def diff_divide_distrib)
 
 lemma Complex_divide:
     "(x / y) = Complex ((Re x * Re y + Im x * Im y) / ((Re y)\<^sup>2 + (Im y)\<^sup>2))
                        ((Im x * Re y - Re x * Im y) / ((Re y)\<^sup>2 + (Im y)\<^sup>2))"
   by (metis Im_divide Re_divide complex_surj)
 
 lemma Re_power2: "Re (x ^ 2) = (Re x)^2 - (Im x)^2"
   by (simp add: power2_eq_square)
 
 lemma Im_power2: "Im (x ^ 2) = 2 * Re x * Im x"
   by (simp add: power2_eq_square)
 
 lemma Re_power_real [simp]: "Im x = 0 \<Longrightarrow> Re (x ^ n) = Re x ^ n "
   by (induct n) simp_all
 
 lemma Im_power_real [simp]: "Im x = 0 \<Longrightarrow> Im (x ^ n) = 0"
   by (induct n) simp_all
 
 
 subsection \<open>Scalar Multiplication\<close>
 
 instantiation complex :: real_field
 begin
 
 primcorec scaleR_complex
   where
     "Re (scaleR r x) = r * Re x"
   | "Im (scaleR r x) = r * Im x"
 
 instance
 proof
   fix a b :: real and x y :: complex
   show "scaleR a (x + y) = scaleR a x + scaleR a y"
     by (simp add: complex_eq_iff distrib_left)
   show "scaleR (a + b) x = scaleR a x + scaleR b x"
     by (simp add: complex_eq_iff distrib_right)
   show "scaleR a (scaleR b x) = scaleR (a * b) x"
     by (simp add: complex_eq_iff mult.assoc)
   show "scaleR 1 x = x"
     by (simp add: complex_eq_iff)
   show "scaleR a x * y = scaleR a (x * y)"
     by (simp add: complex_eq_iff algebra_simps)
   show "x * scaleR a y = scaleR a (x * y)"
     by (simp add: complex_eq_iff algebra_simps)
 qed
 
 end
 
 
 subsection \<open>Numerals, Arithmetic, and Embedding from R\<close>
 
 abbreviation complex_of_real :: "real \<Rightarrow> complex"
   where "complex_of_real \<equiv> of_real"
 
 declare [[coercion "of_real :: real \<Rightarrow> complex"]]
 declare [[coercion "of_rat :: rat \<Rightarrow> complex"]]
 declare [[coercion "of_int :: int \<Rightarrow> complex"]]
 declare [[coercion "of_nat :: nat \<Rightarrow> complex"]]
 
 lemma complex_Re_of_nat [simp]: "Re (of_nat n) = of_nat n"
   by (induct n) simp_all
 
 lemma complex_Im_of_nat [simp]: "Im (of_nat n) = 0"
   by (induct n) simp_all
 
 lemma complex_Re_of_int [simp]: "Re (of_int z) = of_int z"
   by (cases z rule: int_diff_cases) simp
 
 lemma complex_Im_of_int [simp]: "Im (of_int z) = 0"
   by (cases z rule: int_diff_cases) simp
 
 lemma complex_Re_numeral [simp]: "Re (numeral v) = numeral v"
   using complex_Re_of_int [of "numeral v"] by simp
 
 lemma complex_Im_numeral [simp]: "Im (numeral v) = 0"
   using complex_Im_of_int [of "numeral v"] by simp
 
 lemma Re_complex_of_real [simp]: "Re (complex_of_real z) = z"
   by (simp add: of_real_def)
 
 lemma Im_complex_of_real [simp]: "Im (complex_of_real z) = 0"
   by (simp add: of_real_def)
 
 lemma Re_divide_numeral [simp]: "Re (z / numeral w) = Re z / numeral w"
   by (simp add: Re_divide sqr_conv_mult)
 
 lemma Im_divide_numeral [simp]: "Im (z / numeral w) = Im z / numeral w"
   by (simp add: Im_divide sqr_conv_mult)
 
 lemma Re_divide_of_nat [simp]: "Re (z / of_nat n) = Re z / of_nat n"
   by (cases n) (simp_all add: Re_divide field_split_simps power2_eq_square del: of_nat_Suc)
 
 lemma Im_divide_of_nat [simp]: "Im (z / of_nat n) = Im z / of_nat n"
   by (cases n) (simp_all add: Im_divide field_split_simps power2_eq_square del: of_nat_Suc)
 
 lemma of_real_Re [simp]: "z \<in> \<real> \<Longrightarrow> of_real (Re z) = z"
   by (auto simp: Reals_def)
 
 lemma complex_Re_fact [simp]: "Re (fact n) = fact n"
 proof -
   have "(fact n :: complex) = of_real (fact n)"
     by simp
   also have "Re \<dots> = fact n"
     by (subst Re_complex_of_real) simp_all
   finally show ?thesis .
 qed
 
 lemma complex_Im_fact [simp]: "Im (fact n) = 0"
   by (subst of_nat_fact [symmetric]) (simp only: complex_Im_of_nat)
 
 lemma Re_prod_Reals: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> \<real>) \<Longrightarrow> Re (prod f A) = prod (\<lambda>x. Re (f x)) A"
 proof (induction A rule: infinite_finite_induct)
   case (insert x A)
   hence "Re (prod f (insert x A)) = Re (f x) * Re (prod f A) - Im (f x) * Im (prod f A)"
     by simp
   also from insert.prems have "f x \<in> \<real>" by simp
   hence "Im (f x) = 0" by (auto elim!: Reals_cases)
   also have "Re (prod f A) = (\<Prod>x\<in>A. Re (f x))"
     by (intro insert.IH insert.prems) auto
   finally show ?case using insert.hyps by simp
 qed auto
 
 
 subsection \<open>The Complex Number $i$\<close>
 
 primcorec imaginary_unit :: complex  ("\<i>")
   where
     "Re \<i> = 0"
   | "Im \<i> = 1"
 
 lemma Complex_eq: "Complex a b = a + \<i> * b"
   by (simp add: complex_eq_iff)
 
 lemma complex_eq: "a = Re a + \<i> * Im a"
   by (simp add: complex_eq_iff)
 
 lemma fun_complex_eq: "f = (\<lambda>x. Re (f x) + \<i> * Im (f x))"
   by (simp add: fun_eq_iff complex_eq)
 
 lemma i_squared [simp]: "\<i> * \<i> = -1"
   by (simp add: complex_eq_iff)
 
 lemma power2_i [simp]: "\<i>\<^sup>2 = -1"
   by (simp add: power2_eq_square)
 
 lemma inverse_i [simp]: "inverse \<i> = - \<i>"
   by (rule inverse_unique) simp
 
 lemma divide_i [simp]: "x / \<i> = - \<i> * x"
   by (simp add: divide_complex_def)
 
 lemma complex_i_mult_minus [simp]: "\<i> * (\<i> * x) = - x"
   by (simp add: mult.assoc [symmetric])
 
 lemma complex_i_not_zero [simp]: "\<i> \<noteq> 0"
   by (simp add: complex_eq_iff)
 
 lemma complex_i_not_one [simp]: "\<i> \<noteq> 1"
   by (simp add: complex_eq_iff)
 
 lemma complex_i_not_numeral [simp]: "\<i> \<noteq> numeral w"
   by (simp add: complex_eq_iff)
 
 lemma complex_i_not_neg_numeral [simp]: "\<i> \<noteq> - numeral w"
   by (simp add: complex_eq_iff)
 
 lemma complex_split_polar: "\<exists>r a. z = complex_of_real r * (cos a + \<i> * sin a)"
   by (simp add: complex_eq_iff polar_Ex)
 
 lemma i_even_power [simp]: "\<i> ^ (n * 2) = (-1) ^ n"
   by (metis mult.commute power2_i power_mult)
 
 lemma Re_i_times [simp]: "Re (\<i> * z) = - Im z"
   by simp
 
 lemma Im_i_times [simp]: "Im (\<i> * z) = Re z"
   by simp
 
 lemma i_times_eq_iff: "\<i> * w = z \<longleftrightarrow> w = - (\<i> * z)"
   by auto
 
 lemma divide_numeral_i [simp]: "z / (numeral n * \<i>) = - (\<i> * z) / numeral n"
   by (metis divide_divide_eq_left divide_i mult.commute mult_minus_right)
 
 lemma imaginary_eq_real_iff [simp]:
   assumes "y \<in> Reals" "x \<in> Reals"
   shows "\<i> * y = x \<longleftrightarrow> x=0 \<and> y=0"
     using assms
     unfolding Reals_def
     apply clarify
       apply (rule iffI)
     apply (metis Im_complex_of_real Im_i_times Re_complex_of_real mult_eq_0_iff of_real_0)
     by simp
 
 lemma real_eq_imaginary_iff [simp]:
   assumes "y \<in> Reals" "x \<in> Reals"
   shows "x = \<i> * y  \<longleftrightarrow> x=0 \<and> y=0"
     using assms imaginary_eq_real_iff by fastforce
 
 subsection \<open>Vector Norm\<close>
 
 instantiation complex :: real_normed_field
 begin
 
 definition "norm z = sqrt ((Re z)\<^sup>2 + (Im z)\<^sup>2)"
 
 abbreviation cmod :: "complex \<Rightarrow> real"
   where "cmod \<equiv> norm"
 
 definition complex_sgn_def: "sgn x = x /\<^sub>R cmod x"
 
 definition dist_complex_def: "dist x y = cmod (x - y)"
 
 definition uniformity_complex_def [code del]:
   "(uniformity :: (complex \<times> complex) filter) = (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})"
 
 definition open_complex_def [code del]:
   "open (U :: complex set) \<longleftrightarrow> (\<forall>x\<in>U. eventually (\<lambda>(x', y). x' = x \<longrightarrow> y \<in> U) uniformity)"
 
 instance
 proof
   fix r :: real and x y :: complex and S :: "complex set"
   show "(norm x = 0) = (x = 0)"
     by (simp add: norm_complex_def complex_eq_iff)
   show "norm (x + y) \<le> norm x + norm y"
     by (simp add: norm_complex_def complex_eq_iff real_sqrt_sum_squares_triangle_ineq)
   show "norm (scaleR r x) = \<bar>r\<bar> * norm x"
     by (simp add: norm_complex_def complex_eq_iff power_mult_distrib distrib_left [symmetric]
         real_sqrt_mult)
   show "norm (x * y) = norm x * norm y"
     by (simp add: norm_complex_def complex_eq_iff real_sqrt_mult [symmetric]
         power2_eq_square algebra_simps)
 qed (rule complex_sgn_def dist_complex_def open_complex_def uniformity_complex_def)+
 
 end
 
 declare uniformity_Abort[where 'a = complex, code]
 
 lemma norm_ii [simp]: "norm \<i> = 1"
   by (simp add: norm_complex_def)
 
 lemma cmod_unit_one: "cmod (cos a + \<i> * sin a) = 1"
   by (simp add: norm_complex_def)
 
 lemma cmod_complex_polar: "cmod (r * (cos a + \<i> * sin a)) = \<bar>r\<bar>"
   by (simp add: norm_mult cmod_unit_one)
 
 lemma complex_Re_le_cmod: "Re x \<le> cmod x"
   unfolding norm_complex_def by (rule real_sqrt_sum_squares_ge1)
 
 lemma complex_mod_minus_le_complex_mod: "- cmod x \<le> cmod x"
   by (rule order_trans [OF _ norm_ge_zero]) simp
 
 lemma complex_mod_triangle_ineq2: "cmod (b + a) - cmod b \<le> cmod a"
   by (rule ord_le_eq_trans [OF norm_triangle_ineq2]) simp
 
 lemma abs_Re_le_cmod: "\<bar>Re x\<bar> \<le> cmod x"
   by (simp add: norm_complex_def)
 
 lemma abs_Im_le_cmod: "\<bar>Im x\<bar> \<le> cmod x"
   by (simp add: norm_complex_def)
 
 lemma cmod_le: "cmod z \<le> \<bar>Re z\<bar> + \<bar>Im z\<bar>"
   apply (subst complex_eq)
   apply (rule order_trans)
    apply (rule norm_triangle_ineq)
   apply (simp add: norm_mult)
   done
 
 lemma cmod_eq_Re: "Im z = 0 \<Longrightarrow> cmod z = \<bar>Re z\<bar>"
   by (simp add: norm_complex_def)
 
 lemma cmod_eq_Im: "Re z = 0 \<Longrightarrow> cmod z = \<bar>Im z\<bar>"
   by (simp add: norm_complex_def)
 
 lemma cmod_power2: "(cmod z)\<^sup>2 = (Re z)\<^sup>2 + (Im z)\<^sup>2"
   by (simp add: norm_complex_def)
 
 lemma cmod_plus_Re_le_0_iff: "cmod z + Re z \<le> 0 \<longleftrightarrow> Re z = - cmod z"
   using abs_Re_le_cmod[of z] by auto
 
 lemma cmod_Re_le_iff: "Im x = Im y \<Longrightarrow> cmod x \<le> cmod y \<longleftrightarrow> \<bar>Re x\<bar> \<le> \<bar>Re y\<bar>"
   by (metis add.commute add_le_cancel_left norm_complex_def real_sqrt_abs real_sqrt_le_iff)
 
 lemma cmod_Im_le_iff: "Re x = Re y \<Longrightarrow> cmod x \<le> cmod y \<longleftrightarrow> \<bar>Im x\<bar> \<le> \<bar>Im y\<bar>"
   by (metis add_le_cancel_left norm_complex_def real_sqrt_abs real_sqrt_le_iff)
 
 lemma Im_eq_0: "\<bar>Re z\<bar> = cmod z \<Longrightarrow> Im z = 0"
   by (subst (asm) power_eq_iff_eq_base[symmetric, where n=2]) (auto simp add: norm_complex_def)
 
 lemma abs_sqrt_wlog: "(\<And>x. x \<ge> 0 \<Longrightarrow> P x (x\<^sup>2)) \<Longrightarrow> P \<bar>x\<bar> (x\<^sup>2)"
   for x::"'a::linordered_idom"
   by (metis abs_ge_zero power2_abs)
 
 lemma complex_abs_le_norm: "\<bar>Re z\<bar> + \<bar>Im z\<bar> \<le> sqrt 2 * norm z"
   unfolding norm_complex_def
   apply (rule abs_sqrt_wlog [where x="Re z"])
   apply (rule abs_sqrt_wlog [where x="Im z"])
   apply (rule power2_le_imp_le)
    apply (simp_all add: power2_sum add.commute sum_squares_bound real_sqrt_mult [symmetric])
   done
 
 lemma complex_unit_circle: "z \<noteq> 0 \<Longrightarrow> (Re z / cmod z)\<^sup>2 + (Im z / cmod z)\<^sup>2 = 1"
   by (simp add: norm_complex_def complex_eq_iff power2_eq_square add_divide_distrib [symmetric])
 
 
 text \<open>Properties of complex signum.\<close>
 
 lemma sgn_eq: "sgn z = z / complex_of_real (cmod z)"
   by (simp add: sgn_div_norm divide_inverse scaleR_conv_of_real mult.commute)
 
 lemma Re_sgn [simp]: "Re(sgn z) = Re(z)/cmod z"
   by (simp add: complex_sgn_def divide_inverse)
 
 lemma Im_sgn [simp]: "Im(sgn z) = Im(z)/cmod z"
   by (simp add: complex_sgn_def divide_inverse)
 
 
 subsection \<open>Absolute value\<close>
 
 instantiation complex :: field_abs_sgn
 begin
 
 definition abs_complex :: "complex \<Rightarrow> complex"
   where "abs_complex = of_real \<circ> norm"
 
 instance
   apply standard
          apply (auto simp add: abs_complex_def complex_sgn_def norm_mult)
   apply (auto simp add: scaleR_conv_of_real field_simps)
   done
 
 end
 
 
 subsection \<open>Completeness of the Complexes\<close>
 
 lemma bounded_linear_Re: "bounded_linear Re"
   by (rule bounded_linear_intro [where K=1]) (simp_all add: norm_complex_def)
 
 lemma bounded_linear_Im: "bounded_linear Im"
   by (rule bounded_linear_intro [where K=1]) (simp_all add: norm_complex_def)
 
 lemmas Cauchy_Re = bounded_linear.Cauchy [OF bounded_linear_Re]
 lemmas Cauchy_Im = bounded_linear.Cauchy [OF bounded_linear_Im]
 lemmas tendsto_Re [tendsto_intros] = bounded_linear.tendsto [OF bounded_linear_Re]
 lemmas tendsto_Im [tendsto_intros] = bounded_linear.tendsto [OF bounded_linear_Im]
 lemmas isCont_Re [simp] = bounded_linear.isCont [OF bounded_linear_Re]
 lemmas isCont_Im [simp] = bounded_linear.isCont [OF bounded_linear_Im]
 lemmas continuous_Re [simp] = bounded_linear.continuous [OF bounded_linear_Re]
 lemmas continuous_Im [simp] = bounded_linear.continuous [OF bounded_linear_Im]
 lemmas continuous_on_Re [continuous_intros] = bounded_linear.continuous_on[OF bounded_linear_Re]
 lemmas continuous_on_Im [continuous_intros] = bounded_linear.continuous_on[OF bounded_linear_Im]
 lemmas has_derivative_Re [derivative_intros] = bounded_linear.has_derivative[OF bounded_linear_Re]
 lemmas has_derivative_Im [derivative_intros] = bounded_linear.has_derivative[OF bounded_linear_Im]
 lemmas sums_Re = bounded_linear.sums [OF bounded_linear_Re]
 lemmas sums_Im = bounded_linear.sums [OF bounded_linear_Im]
 
 lemma tendsto_Complex [tendsto_intros]:
   "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> ((\<lambda>x. Complex (f x) (g x)) \<longlongrightarrow> Complex a b) F"
   unfolding Complex_eq by (auto intro!: tendsto_intros)
 
 lemma tendsto_complex_iff:
   "(f \<longlongrightarrow> x) F \<longleftrightarrow> (((\<lambda>x. Re (f x)) \<longlongrightarrow> Re x) F \<and> ((\<lambda>x. Im (f x)) \<longlongrightarrow> Im x) F)"
 proof safe
   assume "((\<lambda>x. Re (f x)) \<longlongrightarrow> Re x) F" "((\<lambda>x. Im (f x)) \<longlongrightarrow> Im x) F"
   from tendsto_Complex[OF this] show "(f \<longlongrightarrow> x) F"
     unfolding complex.collapse .
 qed (auto intro: tendsto_intros)
 
 lemma continuous_complex_iff:
   "continuous F f \<longleftrightarrow> continuous F (\<lambda>x. Re (f x)) \<and> continuous F (\<lambda>x. Im (f x))"
   by (simp only: continuous_def tendsto_complex_iff)
 
 lemma continuous_on_of_real_o_iff [simp]:
      "continuous_on S (\<lambda>x. complex_of_real (g x)) = continuous_on S g"
   using continuous_on_Re continuous_on_of_real  by fastforce
 
 lemma continuous_on_of_real_id [simp]:
      "continuous_on S (of_real :: real \<Rightarrow> 'a::real_normed_algebra_1)"
   by (rule continuous_on_of_real [OF continuous_on_id])
 
 lemma has_vector_derivative_complex_iff: "(f has_vector_derivative x) F \<longleftrightarrow>
     ((\<lambda>x. Re (f x)) has_field_derivative (Re x)) F \<and>
     ((\<lambda>x. Im (f x)) has_field_derivative (Im x)) F"
   by (simp add: has_vector_derivative_def has_field_derivative_def has_derivative_def
       tendsto_complex_iff algebra_simps bounded_linear_scaleR_left bounded_linear_mult_right)
 
 lemma has_field_derivative_Re[derivative_intros]:
   "(f has_vector_derivative D) F \<Longrightarrow> ((\<lambda>x. Re (f x)) has_field_derivative (Re D)) F"
   unfolding has_vector_derivative_complex_iff by safe
 
 lemma has_field_derivative_Im[derivative_intros]:
   "(f has_vector_derivative D) F \<Longrightarrow> ((\<lambda>x. Im (f x)) has_field_derivative (Im D)) F"
   unfolding has_vector_derivative_complex_iff by safe
 
 instance complex :: banach
 proof
   fix X :: "nat \<Rightarrow> complex"
   assume X: "Cauchy X"
   then have "(\<lambda>n. Complex (Re (X n)) (Im (X n))) \<longlonglongrightarrow>
     Complex (lim (\<lambda>n. Re (X n))) (lim (\<lambda>n. Im (X n)))"
     by (intro tendsto_Complex convergent_LIMSEQ_iff[THEN iffD1]
         Cauchy_convergent_iff[THEN iffD1] Cauchy_Re Cauchy_Im)
   then show "convergent X"
     unfolding complex.collapse by (rule convergentI)
 qed
 
 declare DERIV_power[where 'a=complex, unfolded of_nat_def[symmetric], derivative_intros]
 
 
 subsection \<open>Complex Conjugation\<close>
 
 primcorec cnj :: "complex \<Rightarrow> complex"
   where
     "Re (cnj z) = Re z"
   | "Im (cnj z) = - Im z"
 
 lemma complex_cnj_cancel_iff [simp]: "cnj x = cnj y \<longleftrightarrow> x = y"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_cnj [simp]: "cnj (cnj z) = z"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_zero [simp]: "cnj 0 = 0"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_zero_iff [iff]: "cnj z = 0 \<longleftrightarrow> z = 0"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_one_iff [simp]: "cnj z = 1 \<longleftrightarrow> z = 1"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_add [simp]: "cnj (x + y) = cnj x + cnj y"
   by (simp add: complex_eq_iff)
 
 lemma cnj_sum [simp]: "cnj (sum f s) = (\<Sum>x\<in>s. cnj (f x))"
   by (induct s rule: infinite_finite_induct) auto
 
 lemma complex_cnj_diff [simp]: "cnj (x - y) = cnj x - cnj y"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_minus [simp]: "cnj (- x) = - cnj x"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_one [simp]: "cnj 1 = 1"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_mult [simp]: "cnj (x * y) = cnj x * cnj y"
   by (simp add: complex_eq_iff)
 
 lemma cnj_prod [simp]: "cnj (prod f s) = (\<Prod>x\<in>s. cnj (f x))"
   by (induct s rule: infinite_finite_induct) auto
 
 lemma complex_cnj_inverse [simp]: "cnj (inverse x) = inverse (cnj x)"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_divide [simp]: "cnj (x / y) = cnj x / cnj y"
   by (simp add: divide_complex_def)
 
 lemma complex_cnj_power [simp]: "cnj (x ^ n) = cnj x ^ n"
   by (induct n) simp_all
 
 lemma complex_cnj_of_nat [simp]: "cnj (of_nat n) = of_nat n"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_of_int [simp]: "cnj (of_int z) = of_int z"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_numeral [simp]: "cnj (numeral w) = numeral w"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_neg_numeral [simp]: "cnj (- numeral w) = - numeral w"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_scaleR [simp]: "cnj (scaleR r x) = scaleR r (cnj x)"
   by (simp add: complex_eq_iff)
 
 lemma complex_mod_cnj [simp]: "cmod (cnj z) = cmod z"
   by (simp add: norm_complex_def)
 
 lemma complex_cnj_complex_of_real [simp]: "cnj (of_real x) = of_real x"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_i [simp]: "cnj \<i> = - \<i>"
   by (simp add: complex_eq_iff)
 
 lemma complex_add_cnj: "z + cnj z = complex_of_real (2 * Re z)"
   by (simp add: complex_eq_iff)
 
 lemma complex_diff_cnj: "z - cnj z = complex_of_real (2 * Im z) * \<i>"
   by (simp add: complex_eq_iff)
 
+lemma Ints_cnj [intro]: "x \<in> \<int> \<Longrightarrow> cnj x \<in> \<int>"
+  by (auto elim!: Ints_cases)
+
+lemma cnj_in_Ints_iff [simp]: "cnj x \<in> \<int> \<longleftrightarrow> x \<in> \<int>"
+  using Ints_cnj[of x] Ints_cnj[of "cnj x"] by auto
+
 lemma complex_mult_cnj: "z * cnj z = complex_of_real ((Re z)\<^sup>2 + (Im z)\<^sup>2)"
   by (simp add: complex_eq_iff power2_eq_square)
 
 lemma cnj_add_mult_eq_Re: "z * cnj w + cnj z * w = 2 * Re (z * cnj w)"
   by (rule complex_eqI) auto
 
 lemma complex_mod_mult_cnj: "cmod (z * cnj z) = (cmod z)\<^sup>2"
   by (simp add: norm_mult power2_eq_square)
 
 lemma complex_mod_sqrt_Re_mult_cnj: "cmod z = sqrt (Re (z * cnj z))"
   by (simp add: norm_complex_def power2_eq_square)
 
 lemma complex_In_mult_cnj_zero [simp]: "Im (z * cnj z) = 0"
   by simp
 
 lemma complex_cnj_fact [simp]: "cnj (fact n) = fact n"
   by (subst of_nat_fact [symmetric], subst complex_cnj_of_nat) simp
 
 lemma complex_cnj_pochhammer [simp]: "cnj (pochhammer z n) = pochhammer (cnj z) n"
   by (induct n arbitrary: z) (simp_all add: pochhammer_rec)
 
 lemma bounded_linear_cnj: "bounded_linear cnj"
   using complex_cnj_add complex_cnj_scaleR by (rule bounded_linear_intro [where K=1]) simp
 
 lemma linear_cnj: "linear cnj"
   using bounded_linear.linear[OF bounded_linear_cnj] .
 
 lemmas tendsto_cnj [tendsto_intros] = bounded_linear.tendsto [OF bounded_linear_cnj]
   and isCont_cnj [simp] = bounded_linear.isCont [OF bounded_linear_cnj]
   and continuous_cnj [simp, continuous_intros] = bounded_linear.continuous [OF bounded_linear_cnj]
   and continuous_on_cnj [simp, continuous_intros] = bounded_linear.continuous_on [OF bounded_linear_cnj]
   and has_derivative_cnj [simp, derivative_intros] = bounded_linear.has_derivative [OF bounded_linear_cnj]
 
 lemma lim_cnj: "((\<lambda>x. cnj(f x)) \<longlongrightarrow> cnj l) F \<longleftrightarrow> (f \<longlongrightarrow> l) F"
   by (simp add: tendsto_iff dist_complex_def complex_cnj_diff [symmetric] del: complex_cnj_diff)
 
 lemma sums_cnj: "((\<lambda>x. cnj(f x)) sums cnj l) \<longleftrightarrow> (f sums l)"
   by (simp add: sums_def lim_cnj cnj_sum [symmetric] del: cnj_sum)
 
 lemma differentiable_cnj_iff:
   "(\<lambda>z. cnj (f z)) differentiable at x within A \<longleftrightarrow> f differentiable at x within A"
 proof
   assume "(\<lambda>z. cnj (f z)) differentiable at x within A"
   then obtain D where "((\<lambda>z. cnj (f z)) has_derivative D) (at x within A)"
     by (auto simp: differentiable_def)
   from has_derivative_cnj[OF this] show "f differentiable at x within A"
     by (auto simp: differentiable_def)
 next
   assume "f differentiable at x within A"
   then obtain D where "(f has_derivative D) (at x within A)"
     by (auto simp: differentiable_def)
   from has_derivative_cnj[OF this] show "(\<lambda>z. cnj (f z)) differentiable at x within A"
     by (auto simp: differentiable_def)
 qed
 
 lemma has_vector_derivative_cnj [derivative_intros]:
   assumes "(f has_vector_derivative f') (at z within A)"
   shows   "((\<lambda>z. cnj (f z)) has_vector_derivative cnj f') (at z within A)"
   using assms by (auto simp: has_vector_derivative_complex_iff intro: derivative_intros)
 
 
 subsection \<open>Basic Lemmas\<close>
 
 lemma complex_eq_0: "z=0 \<longleftrightarrow> (Re z)\<^sup>2 + (Im z)\<^sup>2 = 0"
   by (metis zero_complex.sel complex_eqI sum_power2_eq_zero_iff)
 
 lemma complex_neq_0: "z\<noteq>0 \<longleftrightarrow> (Re z)\<^sup>2 + (Im z)\<^sup>2 > 0"
   by (metis complex_eq_0 less_numeral_extra(3) sum_power2_gt_zero_iff)
 
 lemma complex_norm_square: "of_real ((norm z)\<^sup>2) = z * cnj z"
   by (cases z)
     (auto simp: complex_eq_iff norm_complex_def power2_eq_square[symmetric] of_real_power[symmetric]
       simp del: of_real_power)
 
 lemma complex_div_cnj: "a / b = (a * cnj b) / (norm b)\<^sup>2"
   using complex_norm_square by auto
 
 lemma Re_complex_div_eq_0: "Re (a / b) = 0 \<longleftrightarrow> Re (a * cnj b) = 0"
   by (auto simp add: Re_divide)
 
 lemma Im_complex_div_eq_0: "Im (a / b) = 0 \<longleftrightarrow> Im (a * cnj b) = 0"
   by (auto simp add: Im_divide)
 
 lemma complex_div_gt_0: "(Re (a / b) > 0 \<longleftrightarrow> Re (a * cnj b) > 0) \<and> (Im (a / b) > 0 \<longleftrightarrow> Im (a * cnj b) > 0)"
 proof (cases "b = 0")
   case True
   then show ?thesis by auto
 next
   case False
   then have "0 < (Re b)\<^sup>2 + (Im b)\<^sup>2"
     by (simp add: complex_eq_iff sum_power2_gt_zero_iff)
   then show ?thesis
     by (simp add: Re_divide Im_divide zero_less_divide_iff)
 qed
 
 lemma Re_complex_div_gt_0: "Re (a / b) > 0 \<longleftrightarrow> Re (a * cnj b) > 0"
   and Im_complex_div_gt_0: "Im (a / b) > 0 \<longleftrightarrow> Im (a * cnj b) > 0"
   using complex_div_gt_0 by auto
 
 lemma Re_complex_div_ge_0: "Re (a / b) \<ge> 0 \<longleftrightarrow> Re (a * cnj b) \<ge> 0"
   by (metis le_less Re_complex_div_eq_0 Re_complex_div_gt_0)
 
 lemma Im_complex_div_ge_0: "Im (a / b) \<ge> 0 \<longleftrightarrow> Im (a * cnj b) \<ge> 0"
   by (metis Im_complex_div_eq_0 Im_complex_div_gt_0 le_less)
 
 lemma Re_complex_div_lt_0: "Re (a / b) < 0 \<longleftrightarrow> Re (a * cnj b) < 0"
   by (metis less_asym neq_iff Re_complex_div_eq_0 Re_complex_div_gt_0)
 
 lemma Im_complex_div_lt_0: "Im (a / b) < 0 \<longleftrightarrow> Im (a * cnj b) < 0"
   by (metis Im_complex_div_eq_0 Im_complex_div_gt_0 less_asym neq_iff)
 
 lemma Re_complex_div_le_0: "Re (a / b) \<le> 0 \<longleftrightarrow> Re (a * cnj b) \<le> 0"
   by (metis not_le Re_complex_div_gt_0)
 
 lemma Im_complex_div_le_0: "Im (a / b) \<le> 0 \<longleftrightarrow> Im (a * cnj b) \<le> 0"
   by (metis Im_complex_div_gt_0 not_le)
 
 lemma Re_divide_of_real [simp]: "Re (z / of_real r) = Re z / r"
   by (simp add: Re_divide power2_eq_square)
 
 lemma Im_divide_of_real [simp]: "Im (z / of_real r) = Im z / r"
   by (simp add: Im_divide power2_eq_square)
 
 lemma Re_divide_Reals [simp]: "r \<in> \<real> \<Longrightarrow> Re (z / r) = Re z / Re r"
   by (metis Re_divide_of_real of_real_Re)
 
 lemma Im_divide_Reals [simp]: "r \<in> \<real> \<Longrightarrow> Im (z / r) = Im z / Re r"
   by (metis Im_divide_of_real of_real_Re)
 
 lemma Re_sum[simp]: "Re (sum f s) = (\<Sum>x\<in>s. Re (f x))"
   by (induct s rule: infinite_finite_induct) auto
 
 lemma Im_sum[simp]: "Im (sum f s) = (\<Sum>x\<in>s. Im(f x))"
   by (induct s rule: infinite_finite_induct) auto
 
 lemma sums_complex_iff: "f sums x \<longleftrightarrow> ((\<lambda>x. Re (f x)) sums Re x) \<and> ((\<lambda>x. Im (f x)) sums Im x)"
   unfolding sums_def tendsto_complex_iff Im_sum Re_sum ..
 
 lemma summable_complex_iff: "summable f \<longleftrightarrow> summable (\<lambda>x. Re (f x)) \<and>  summable (\<lambda>x. Im (f x))"
   unfolding summable_def sums_complex_iff[abs_def] by (metis complex.sel)
 
 lemma summable_complex_of_real [simp]: "summable (\<lambda>n. complex_of_real (f n)) \<longleftrightarrow> summable f"
   unfolding summable_complex_iff by simp
 
 lemma summable_Re: "summable f \<Longrightarrow> summable (\<lambda>x. Re (f x))"
   unfolding summable_complex_iff by blast
 
 lemma summable_Im: "summable f \<Longrightarrow> summable (\<lambda>x. Im (f x))"
   unfolding summable_complex_iff by blast
 
 lemma complex_is_Nat_iff: "z \<in> \<nat> \<longleftrightarrow> Im z = 0 \<and> (\<exists>i. Re z = of_nat i)"
   by (auto simp: Nats_def complex_eq_iff)
 
 lemma complex_is_Int_iff: "z \<in> \<int> \<longleftrightarrow> Im z = 0 \<and> (\<exists>i. Re z = of_int i)"
   by (auto simp: Ints_def complex_eq_iff)
 
 lemma complex_is_Real_iff: "z \<in> \<real> \<longleftrightarrow> Im z = 0"
   by (auto simp: Reals_def complex_eq_iff)
 
 lemma Reals_cnj_iff: "z \<in> \<real> \<longleftrightarrow> cnj z = z"
   by (auto simp: complex_is_Real_iff complex_eq_iff)
 
 lemma in_Reals_norm: "z \<in> \<real> \<Longrightarrow> norm z = \<bar>Re z\<bar>"
   by (simp add: complex_is_Real_iff norm_complex_def)
 
 lemma Re_Reals_divide: "r \<in> \<real> \<Longrightarrow> Re (r / z) = Re r * Re z / (norm z)\<^sup>2"
   by (simp add: Re_divide complex_is_Real_iff cmod_power2)
 
 lemma Im_Reals_divide: "r \<in> \<real> \<Longrightarrow> Im (r / z) = -Re r * Im z / (norm z)\<^sup>2"
   by (simp add: Im_divide complex_is_Real_iff cmod_power2)
 
 lemma series_comparison_complex:
   fixes f:: "nat \<Rightarrow> 'a::banach"
   assumes sg: "summable g"
     and "\<And>n. g n \<in> \<real>" "\<And>n. Re (g n) \<ge> 0"
     and fg: "\<And>n. n \<ge> N \<Longrightarrow> norm(f n) \<le> norm(g n)"
   shows "summable f"
 proof -
   have g: "\<And>n. cmod (g n) = Re (g n)"
     using assms by (metis abs_of_nonneg in_Reals_norm)
   show ?thesis
     apply (rule summable_comparison_test' [where g = "\<lambda>n. norm (g n)" and N=N])
     using sg
      apply (auto simp: summable_def)
      apply (rule_tac x = "Re s" in exI)
      apply (auto simp: g sums_Re)
     apply (metis fg g)
     done
 qed
 
 
 subsection \<open>Polar Form for Complex Numbers\<close>
 
 lemma complex_unimodular_polar:
   assumes "norm z = 1"
   obtains t where "0 \<le> t" "t < 2 * pi" "z = Complex (cos t) (sin t)"
   by (metis cmod_power2 one_power2 complex_surj sincos_total_2pi [of "Re z" "Im z"] assms)
 
 
 subsubsection \<open>$\cos \theta + i \sin \theta$\<close>
 
 primcorec cis :: "real \<Rightarrow> complex"
   where
     "Re (cis a) = cos a"
   | "Im (cis a) = sin a"
 
 lemma cis_zero [simp]: "cis 0 = 1"
   by (simp add: complex_eq_iff)
 
 lemma norm_cis [simp]: "norm (cis a) = 1"
   by (simp add: norm_complex_def)
 
 lemma sgn_cis [simp]: "sgn (cis a) = cis a"
   by (simp add: sgn_div_norm)
 
 lemma cis_2pi [simp]: "cis (2 * pi) = 1"
   by (simp add: cis.ctr complex_eq_iff)
 
 lemma cis_neq_zero [simp]: "cis a \<noteq> 0"
   by (metis norm_cis norm_zero zero_neq_one)
 
 lemma cis_cnj: "cnj (cis t) = cis (-t)"
   by (simp add: complex_eq_iff)
 
 lemma cis_mult: "cis a * cis b = cis (a + b)"
   by (simp add: complex_eq_iff cos_add sin_add)
 
 lemma DeMoivre: "(cis a) ^ n = cis (real n * a)"
   by (induct n) (simp_all add: algebra_simps cis_mult)
 
 lemma cis_inverse [simp]: "inverse (cis a) = cis (- a)"
   by (simp add: complex_eq_iff)
 
 lemma cis_divide: "cis a / cis b = cis (a - b)"
   by (simp add: divide_complex_def cis_mult)
 
 lemma cos_n_Re_cis_pow_n: "cos (real n * a) = Re (cis a ^ n)"
   by (auto simp add: DeMoivre)
 
 lemma sin_n_Im_cis_pow_n: "sin (real n * a) = Im (cis a ^ n)"
   by (auto simp add: DeMoivre)
 
 lemma cis_pi [simp]: "cis pi = -1"
   by (simp add: complex_eq_iff)
 
 lemma cis_pi_half[simp]: "cis (pi / 2) = \<i>"
   by (simp add: cis.ctr complex_eq_iff)
 
 lemma cis_minus_pi_half[simp]: "cis (-(pi / 2)) = -\<i>"
   by (simp add: cis.ctr complex_eq_iff)
 
 lemma cis_multiple_2pi[simp]: "n \<in> \<int> \<Longrightarrow> cis (2 * pi * n) = 1"
   by (auto elim!: Ints_cases simp: cis.ctr one_complex.ctr)
 
 
 subsubsection \<open>$r(\cos \theta + i \sin \theta)$\<close>
 
 definition rcis :: "real \<Rightarrow> real \<Rightarrow> complex"
   where "rcis r a = complex_of_real r * cis a"
 
 lemma Re_rcis [simp]: "Re(rcis r a) = r * cos a"
   by (simp add: rcis_def)
 
 lemma Im_rcis [simp]: "Im(rcis r a) = r * sin a"
   by (simp add: rcis_def)
 
 lemma rcis_Ex: "\<exists>r a. z = rcis r a"
   by (simp add: complex_eq_iff polar_Ex)
 
 lemma complex_mod_rcis [simp]: "cmod (rcis r a) = \<bar>r\<bar>"
   by (simp add: rcis_def norm_mult)
 
 lemma cis_rcis_eq: "cis a = rcis 1 a"
   by (simp add: rcis_def)
 
 lemma rcis_mult: "rcis r1 a * rcis r2 b = rcis (r1 * r2) (a + b)"
   by (simp add: rcis_def cis_mult)
 
 lemma rcis_zero_mod [simp]: "rcis 0 a = 0"
   by (simp add: rcis_def)
 
 lemma rcis_zero_arg [simp]: "rcis r 0 = complex_of_real r"
   by (simp add: rcis_def)
 
 lemma rcis_eq_zero_iff [simp]: "rcis r a = 0 \<longleftrightarrow> r = 0"
   by (simp add: rcis_def)
 
 lemma DeMoivre2: "(rcis r a) ^ n = rcis (r ^ n) (real n * a)"
   by (simp add: rcis_def power_mult_distrib DeMoivre)
 
 lemma rcis_inverse: "inverse(rcis r a) = rcis (1 / r) (- a)"
   by (simp add: divide_inverse rcis_def)
 
 lemma rcis_divide: "rcis r1 a / rcis r2 b = rcis (r1 / r2) (a - b)"
   by (simp add: rcis_def cis_divide [symmetric])
 
 
 subsubsection \<open>Complex exponential\<close>
 
 lemma exp_Reals_eq:
   assumes "z \<in> \<real>"
   shows   "exp z = of_real (exp (Re z))"
   using assms by (auto elim!: Reals_cases simp: exp_of_real)
 
 lemma cis_conv_exp: "cis b = exp (\<i> * b)"
 proof -
   have "(\<i> * complex_of_real b) ^ n /\<^sub>R fact n =
       of_real (cos_coeff n * b^n) + \<i> * of_real (sin_coeff n * b^n)"
     for n :: nat
   proof -
     have "\<i> ^ n = fact n *\<^sub>R (cos_coeff n + \<i> * sin_coeff n)"
       by (induct n)
         (simp_all add: sin_coeff_Suc cos_coeff_Suc complex_eq_iff Re_divide Im_divide field_simps
           power2_eq_square add_nonneg_eq_0_iff)
     then show ?thesis
       by (simp add: field_simps)
   qed
   then show ?thesis
     using sin_converges [of b] cos_converges [of b]
     by (auto simp add: Complex_eq cis.ctr exp_def simp del: of_real_mult
         intro!: sums_unique sums_add sums_mult sums_of_real)
 qed
 
 lemma exp_eq_polar: "exp z = exp (Re z) * cis (Im z)"
   unfolding cis_conv_exp exp_of_real [symmetric] mult_exp_exp
   by (cases z) (simp add: Complex_eq)
 
 lemma Re_exp: "Re (exp z) = exp (Re z) * cos (Im z)"
   unfolding exp_eq_polar by simp
 
 lemma Im_exp: "Im (exp z) = exp (Re z) * sin (Im z)"
   unfolding exp_eq_polar by simp
 
 lemma norm_cos_sin [simp]: "norm (Complex (cos t) (sin t)) = 1"
   by (simp add: norm_complex_def)
 
 lemma norm_exp_eq_Re [simp]: "norm (exp z) = exp (Re z)"
   by (simp add: cis.code cmod_complex_polar exp_eq_polar Complex_eq)
 
 lemma complex_exp_exists: "\<exists>a r. z = complex_of_real r * exp a"
   apply (insert rcis_Ex [of z])
   apply (auto simp add: exp_eq_polar rcis_def mult.assoc [symmetric])
   apply (rule_tac x = "\<i> * complex_of_real a" in exI)
   apply auto
   done
 
 lemma exp_pi_i [simp]: "exp (of_real pi * \<i>) = -1"
   by (metis cis_conv_exp cis_pi mult.commute)
 
 lemma exp_pi_i' [simp]: "exp (\<i> * of_real pi) = -1"
   using cis_conv_exp cis_pi by auto
 
 lemma exp_two_pi_i [simp]: "exp (2 * of_real pi * \<i>) = 1"
   by (simp add: exp_eq_polar complex_eq_iff)
 
 lemma exp_two_pi_i' [simp]: "exp (\<i> * (of_real pi * 2)) = 1"
   by (metis exp_two_pi_i mult.commute)
 
 lemma continuous_on_cis [continuous_intros]:
   "continuous_on A f \<Longrightarrow> continuous_on A (\<lambda>x. cis (f x))"
   by (auto simp: cis_conv_exp intro!: continuous_intros)
 
 
 subsubsection \<open>Complex argument\<close>
 
 definition arg :: "complex \<Rightarrow> real"
   where "arg z = (if z = 0 then 0 else (SOME a. sgn z = cis a \<and> - pi < a \<and> a \<le> pi))"
 
 lemma arg_zero: "arg 0 = 0"
   by (simp add: arg_def)
 
 lemma arg_unique:
   assumes "sgn z = cis x" and "-pi < x" and "x \<le> pi"
   shows "arg z = x"
 proof -
   from assms have "z \<noteq> 0" by auto
   have "(SOME a. sgn z = cis a \<and> -pi < a \<and> a \<le> pi) = x"
   proof
     fix a
     define d where "d = a - x"
     assume a: "sgn z = cis a \<and> - pi < a \<and> a \<le> pi"
     from a assms have "- (2*pi) < d \<and> d < 2*pi"
       unfolding d_def by simp
     moreover
     from a assms have "cos a = cos x" and "sin a = sin x"
       by (simp_all add: complex_eq_iff)
     then have cos: "cos d = 1"
       by (simp add: d_def cos_diff)
     moreover from cos have "sin d = 0"
       by (rule cos_one_sin_zero)
     ultimately have "d = 0"
       by (auto simp: sin_zero_iff elim!: evenE dest!: less_2_cases)
     then show "a = x"
       by (simp add: d_def)
   qed (simp add: assms del: Re_sgn Im_sgn)
   with \<open>z \<noteq> 0\<close> show "arg z = x"
     by (simp add: arg_def)
 qed
 
 lemma arg_correct:
   assumes "z \<noteq> 0"
   shows "sgn z = cis (arg z) \<and> -pi < arg z \<and> arg z \<le> pi"
 proof (simp add: arg_def assms, rule someI_ex)
   obtain r a where z: "z = rcis r a"
     using rcis_Ex by fast
   with assms have "r \<noteq> 0" by auto
   define b where "b = (if 0 < r then a else a + pi)"
   have b: "sgn z = cis b"
     using \<open>r \<noteq> 0\<close> by (simp add: z b_def rcis_def of_real_def sgn_scaleR sgn_if complex_eq_iff)
   have cis_2pi_nat: "cis (2 * pi * real_of_nat n) = 1" for n
     by (induct n) (simp_all add: distrib_left cis_mult [symmetric] complex_eq_iff)
   have cis_2pi_int: "cis (2 * pi * real_of_int x) = 1" for x
     by (cases x rule: int_diff_cases)
       (simp add: right_diff_distrib cis_divide [symmetric] cis_2pi_nat)
   define c where "c = b - 2 * pi * of_int \<lceil>(b - pi) / (2 * pi)\<rceil>"
   have "sgn z = cis c"
     by (simp add: b c_def cis_divide [symmetric] cis_2pi_int)
   moreover have "- pi < c \<and> c \<le> pi"
     using ceiling_correct [of "(b - pi) / (2*pi)"]
     by (simp add: c_def less_divide_eq divide_le_eq algebra_simps del: le_of_int_ceiling)
   ultimately show "\<exists>a. sgn z = cis a \<and> -pi < a \<and> a \<le> pi"
     by fast
 qed
 
 lemma arg_bounded: "- pi < arg z \<and> arg z \<le> pi"
   by (cases "z = 0") (simp_all add: arg_zero arg_correct)
 
 lemma cis_arg: "z \<noteq> 0 \<Longrightarrow> cis (arg z) = sgn z"
   by (simp add: arg_correct)
 
 lemma rcis_cmod_arg: "rcis (cmod z) (arg z) = z"
   by (cases "z = 0") (simp_all add: rcis_def cis_arg sgn_div_norm of_real_def)
 
 lemma cos_arg_i_mult_zero [simp]: "y \<noteq> 0 \<Longrightarrow> Re y = 0 \<Longrightarrow> cos (arg y) = 0"
   using cis_arg [of y] by (simp add: complex_eq_iff)
 
 subsection \<open>Complex n-th roots\<close>
 
 lemma bij_betw_roots_unity:
   assumes "n > 0"
   shows   "bij_betw (\<lambda>k. cis (2 * pi * real k / real n)) {..<n} {z. z ^ n = 1}"
     (is "bij_betw ?f _ _")
   unfolding bij_betw_def
 proof (intro conjI)
   show inj: "inj_on ?f {..<n}" unfolding inj_on_def
   proof (safe, goal_cases)
     case (1 k l)
     hence kl: "k < n" "l < n" by simp_all
     from 1 have "1 = ?f k / ?f l" by simp
     also have "\<dots> = cis (2*pi*(real k - real l)/n)"
       using assms by (simp add: field_simps cis_divide)
     finally have "cos (2*pi*(real k - real l) / n) = 1"
       by (simp add: complex_eq_iff)
     then obtain m :: int where "2 * pi * (real k - real l) / real n = real_of_int m * 2 * pi"
       by (subst (asm) cos_one_2pi_int) blast
     hence "real_of_int (int k - int l) = real_of_int (m * int n)"
       unfolding of_int_diff of_int_mult using assms
       by (simp add: nonzero_divide_eq_eq)
     also note of_int_eq_iff
     finally have *: "abs m * n = abs (int k - int l)" by (simp add: abs_mult)
     also have "\<dots> < int n" using kl by linarith
     finally have "m = 0" using assms by simp
     with * show "k = l" by simp
   qed
 
   have subset: "?f ` {..<n} \<subseteq> {z. z ^ n = 1}"
   proof safe
     fix k :: nat
     have "cis (2 * pi * real k / real n) ^ n = cis (2 * pi) ^ k"
       using assms by (simp add: DeMoivre mult_ac)
     also have "cis (2 * pi) = 1" by (simp add: complex_eq_iff)
     finally show "?f k ^ n = 1" by simp
   qed
 
   have "n = card {..<n}" by simp
   also from assms and subset have "\<dots> \<le> card {z::complex. z ^ n = 1}"
     by (intro card_inj_on_le[OF inj]) (auto simp: finite_roots_unity)
   finally have card: "card {z::complex. z ^ n = 1} = n"
     using assms by (intro antisym card_roots_unity) auto
 
   have "card (?f ` {..<n}) = card {z::complex. z ^ n = 1}"
     using card inj by (subst card_image) auto
   with subset and assms show "?f ` {..<n} = {z::complex. z ^ n = 1}"
     by (intro card_subset_eq finite_roots_unity) auto
 qed
 
 lemma card_roots_unity_eq:
   assumes "n > 0"
   shows   "card {z::complex. z ^ n = 1} = n"
   using bij_betw_same_card [OF bij_betw_roots_unity [OF assms]] by simp
 
 lemma bij_betw_nth_root_unity:
   fixes c :: complex and n :: nat
   assumes c: "c \<noteq> 0" and n: "n > 0"
   defines "c' \<equiv> root n (norm c) * cis (arg c / n)"
   shows "bij_betw (\<lambda>z. c' * z) {z. z ^ n = 1} {z. z ^ n = c}"
 proof -
   have "c' ^ n = of_real (root n (norm c) ^ n) * cis (arg c)"
     unfolding of_real_power using n by (simp add: c'_def power_mult_distrib DeMoivre)
   also from n have "root n (norm c) ^ n = norm c" by simp
   also from c have "of_real \<dots> * cis (arg c) = c" by (simp add: cis_arg Complex.sgn_eq)
   finally have [simp]: "c' ^ n = c" .
 
   show ?thesis unfolding bij_betw_def inj_on_def
   proof safe
     fix z :: complex assume "z ^ n = 1"
     hence "(c' * z) ^ n = c' ^ n" by (simp add: power_mult_distrib)
     also have "c' ^ n = of_real (root n (norm c) ^ n) * cis (arg c)"
       unfolding of_real_power using n by (simp add: c'_def power_mult_distrib DeMoivre)
     also from n have "root n (norm c) ^ n = norm c" by simp
     also from c have "\<dots> * cis (arg c) = c" by (simp add: cis_arg Complex.sgn_eq)
     finally show "(c' * z) ^ n = c" .
   next
     fix z assume z: "c = z ^ n"
     define z' where "z' = z / c'"
     from c and n have "c' \<noteq> 0" by (auto simp: c'_def)
     with n c have "z = c' * z'" and "z' ^ n = 1"
       by (auto simp: z'_def power_divide z)
     thus "z \<in> (\<lambda>z. c' * z) ` {z. z ^ n = 1}" by blast
   qed (insert c n, auto simp: c'_def)
 qed
 
 lemma finite_nth_roots [intro]:
   assumes "n > 0"
   shows   "finite {z::complex. z ^ n = c}"
 proof (cases "c = 0")
   case True
   with assms have "{z::complex. z ^ n = c} = {0}" by auto
   thus ?thesis by simp
 next
   case False
   from assms have "finite {z::complex. z ^ n = 1}" by (intro finite_roots_unity) simp_all
   also have "?this \<longleftrightarrow> ?thesis"
     by (rule bij_betw_finite, rule bij_betw_nth_root_unity) fact+
   finally show ?thesis .
 qed
 
 lemma card_nth_roots:
   assumes "c \<noteq> 0" "n > 0"
   shows   "card {z::complex. z ^ n = c} = n"
 proof -
   have "card {z. z ^ n = c} = card {z::complex. z ^ n = 1}"
     by (rule sym, rule bij_betw_same_card, rule bij_betw_nth_root_unity) fact+
   also have "\<dots> = n" by (rule card_roots_unity_eq) fact+
   finally show ?thesis .
 qed
 
 lemma sum_roots_unity:
   assumes "n > 1"
   shows   "\<Sum>{z::complex. z ^ n = 1} = 0"
 proof -
   define \<omega> where "\<omega> = cis (2 * pi / real n)"
   have [simp]: "\<omega> \<noteq> 1"
   proof
     assume "\<omega> = 1"
     with assms obtain k :: int where "2 * pi / real n = 2 * pi * of_int k"
       by (auto simp: \<omega>_def complex_eq_iff cos_one_2pi_int)
     with assms have "real n * of_int k = 1" by (simp add: field_simps)
     also have "real n * of_int k = of_int (int n * k)" by simp
     also have "1 = (of_int 1 :: real)" by simp
     also note of_int_eq_iff
     finally show False using assms by (auto simp: zmult_eq_1_iff)
   qed
 
   have "(\<Sum>z | z ^ n = 1. z :: complex) = (\<Sum>k<n. cis (2 * pi * real k / real n))"
     using assms by (intro sum.reindex_bij_betw [symmetric] bij_betw_roots_unity) auto
   also have "\<dots> = (\<Sum>k<n. \<omega> ^ k)"
     by (intro sum.cong refl) (auto simp: \<omega>_def DeMoivre mult_ac)
   also have "\<dots> = (\<omega> ^ n - 1) / (\<omega> - 1)"
     by (subst geometric_sum) auto
   also have "\<omega> ^ n - 1 = cis (2 * pi) - 1" using assms by (auto simp: \<omega>_def DeMoivre)
   also have "\<dots> = 0" by (simp add: complex_eq_iff)
   finally show ?thesis by simp
 qed
 
 lemma sum_nth_roots:
   assumes "n > 1"
   shows   "\<Sum>{z::complex. z ^ n = c} = 0"
 proof (cases "c = 0")
   case True
   with assms have "{z::complex. z ^ n = c} = {0}" by auto
   also have "\<Sum>\<dots> = 0" by simp
   finally show ?thesis .
 next
   case False
   define c' where "c' = root n (norm c) * cis (arg c / n)"
   from False and assms have "(\<Sum>{z. z ^ n = c}) = (\<Sum>z | z ^ n = 1. c' * z)"
     by (subst sum.reindex_bij_betw [OF bij_betw_nth_root_unity, symmetric])
        (auto simp: sum_distrib_left finite_roots_unity c'_def)
   also from assms have "\<dots> = 0"
     by (simp add: sum_distrib_left [symmetric] sum_roots_unity)
   finally show ?thesis .
 qed
 
 subsection \<open>Square root of complex numbers\<close>
 
 primcorec csqrt :: "complex \<Rightarrow> complex"
   where
     "Re (csqrt z) = sqrt ((cmod z + Re z) / 2)"
   | "Im (csqrt z) = (if Im z = 0 then 1 else sgn (Im z)) * sqrt ((cmod z - Re z) / 2)"
 
 lemma csqrt_of_real_nonneg [simp]: "Im x = 0 \<Longrightarrow> Re x \<ge> 0 \<Longrightarrow> csqrt x = sqrt (Re x)"
   by (simp add: complex_eq_iff norm_complex_def)
 
 lemma csqrt_of_real_nonpos [simp]: "Im x = 0 \<Longrightarrow> Re x \<le> 0 \<Longrightarrow> csqrt x = \<i> * sqrt \<bar>Re x\<bar>"
   by (simp add: complex_eq_iff norm_complex_def)
 
 lemma of_real_sqrt: "x \<ge> 0 \<Longrightarrow> of_real (sqrt x) = csqrt (of_real x)"
   by (simp add: complex_eq_iff norm_complex_def)
 
 lemma csqrt_0 [simp]: "csqrt 0 = 0"
   by simp
 
 lemma csqrt_1 [simp]: "csqrt 1 = 1"
   by simp
 
 lemma csqrt_ii [simp]: "csqrt \<i> = (1 + \<i>) / sqrt 2"
   by (simp add: complex_eq_iff Re_divide Im_divide real_sqrt_divide real_div_sqrt)
 
 lemma power2_csqrt[simp,algebra]: "(csqrt z)\<^sup>2 = z"
 proof (cases "Im z = 0")
   case True
   then show ?thesis
     using real_sqrt_pow2[of "Re z"] real_sqrt_pow2[of "- Re z"]
     by (cases "0::real" "Re z" rule: linorder_cases)
       (simp_all add: complex_eq_iff Re_power2 Im_power2 power2_eq_square cmod_eq_Re)
 next
   case False
   moreover have "cmod z * cmod z - Re z * Re z = Im z * Im z"
     by (simp add: norm_complex_def power2_eq_square)
   moreover have "\<bar>Re z\<bar> \<le> cmod z"
     by (simp add: norm_complex_def)
   ultimately show ?thesis
     by (simp add: Re_power2 Im_power2 complex_eq_iff real_sgn_eq
         field_simps real_sqrt_mult[symmetric] real_sqrt_divide)
 qed
 
 lemma csqrt_eq_0 [simp]: "csqrt z = 0 \<longleftrightarrow> z = 0"
   by auto (metis power2_csqrt power_eq_0_iff)
 
 lemma csqrt_eq_1 [simp]: "csqrt z = 1 \<longleftrightarrow> z = 1"
   by auto (metis power2_csqrt power2_eq_1_iff)
 
 lemma csqrt_principal: "0 < Re (csqrt z) \<or> Re (csqrt z) = 0 \<and> 0 \<le> Im (csqrt z)"
   by (auto simp add: not_less cmod_plus_Re_le_0_iff Im_eq_0)
 
 lemma Re_csqrt: "0 \<le> Re (csqrt z)"
   by (metis csqrt_principal le_less)
 
 lemma csqrt_square:
   assumes "0 < Re b \<or> (Re b = 0 \<and> 0 \<le> Im b)"
   shows "csqrt (b^2) = b"
 proof -
   have "csqrt (b^2) = b \<or> csqrt (b^2) = - b"
     by (simp add: power2_eq_iff[symmetric])
   moreover have "csqrt (b^2) \<noteq> -b \<or> b = 0"
     using csqrt_principal[of "b ^ 2"] assms
     by (intro disjCI notI) (auto simp: complex_eq_iff)
   ultimately show ?thesis
     by auto
 qed
 
 lemma csqrt_unique: "w\<^sup>2 = z \<Longrightarrow> 0 < Re w \<or> Re w = 0 \<and> 0 \<le> Im w \<Longrightarrow> csqrt z = w"
   by (auto simp: csqrt_square)
 
 lemma csqrt_minus [simp]:
   assumes "Im x < 0 \<or> (Im x = 0 \<and> 0 \<le> Re x)"
   shows "csqrt (- x) = \<i> * csqrt x"
 proof -
   have "csqrt ((\<i> * csqrt x)^2) = \<i> * csqrt x"
   proof (rule csqrt_square)
     have "Im (csqrt x) \<le> 0"
       using assms by (auto simp add: cmod_eq_Re mult_le_0_iff field_simps complex_Re_le_cmod)
     then show "0 < Re (\<i> * csqrt x) \<or> Re (\<i> * csqrt x) = 0 \<and> 0 \<le> Im (\<i> * csqrt x)"
       by (auto simp add: Re_csqrt simp del: csqrt.simps)
   qed
   also have "(\<i> * csqrt x)^2 = - x"
     by (simp add: power_mult_distrib)
   finally show ?thesis .
 qed
 
 
 text \<open>Legacy theorem names\<close>
 
 lemmas cmod_def = norm_complex_def
 
 lemma legacy_Complex_simps:
   shows Complex_eq_0: "Complex a b = 0 \<longleftrightarrow> a = 0 \<and> b = 0"
     and complex_add: "Complex a b + Complex c d = Complex (a + c) (b + d)"
     and complex_minus: "- (Complex a b) = Complex (- a) (- b)"
     and complex_diff: "Complex a b - Complex c d = Complex (a - c) (b - d)"
     and Complex_eq_1: "Complex a b = 1 \<longleftrightarrow> a = 1 \<and> b = 0"
     and Complex_eq_neg_1: "Complex a b = - 1 \<longleftrightarrow> a = - 1 \<and> b = 0"
     and complex_mult: "Complex a b * Complex c d = Complex (a * c - b * d) (a * d + b * c)"
     and complex_inverse: "inverse (Complex a b) = Complex (a / (a\<^sup>2 + b\<^sup>2)) (- b / (a\<^sup>2 + b\<^sup>2))"
     and Complex_eq_numeral: "Complex a b = numeral w \<longleftrightarrow> a = numeral w \<and> b = 0"
     and Complex_eq_neg_numeral: "Complex a b = - numeral w \<longleftrightarrow> a = - numeral w \<and> b = 0"
     and complex_scaleR: "scaleR r (Complex a b) = Complex (r * a) (r * b)"
     and Complex_eq_i: "Complex x y = \<i> \<longleftrightarrow> x = 0 \<and> y = 1"
     and i_mult_Complex: "\<i> * Complex a b = Complex (- b) a"
     and Complex_mult_i: "Complex a b * \<i> = Complex (- b) a"
     and i_complex_of_real: "\<i> * complex_of_real r = Complex 0 r"
     and complex_of_real_i: "complex_of_real r * \<i> = Complex 0 r"
     and Complex_add_complex_of_real: "Complex x y + complex_of_real r = Complex (x+r) y"
     and complex_of_real_add_Complex: "complex_of_real r + Complex x y = Complex (r+x) y"
     and Complex_mult_complex_of_real: "Complex x y * complex_of_real r = Complex (x*r) (y*r)"
     and complex_of_real_mult_Complex: "complex_of_real r * Complex x y = Complex (r*x) (r*y)"
     and complex_eq_cancel_iff2: "(Complex x y = complex_of_real xa) = (x = xa \<and> y = 0)"
     and complex_cnj: "cnj (Complex a b) = Complex a (- b)"
     and Complex_sum': "sum (\<lambda>x. Complex (f x) 0) s = Complex (sum f s) 0"
     and Complex_sum: "Complex (sum f s) 0 = sum (\<lambda>x. Complex (f x) 0) s"
     and complex_of_real_def: "complex_of_real r = Complex r 0"
     and complex_norm: "cmod (Complex x y) = sqrt (x\<^sup>2 + y\<^sup>2)"
   by (simp_all add: norm_complex_def field_simps complex_eq_iff Re_divide Im_divide)
 
 lemma Complex_in_Reals: "Complex x 0 \<in> \<real>"
   by (metis Reals_of_real complex_of_real_def)
 
 end
diff --git a/src/HOL/Computational_Algebra/Polynomial.thy b/src/HOL/Computational_Algebra/Polynomial.thy
--- a/src/HOL/Computational_Algebra/Polynomial.thy
+++ b/src/HOL/Computational_Algebra/Polynomial.thy
@@ -1,4708 +1,5019 @@
 (*  Title:      HOL/Computational_Algebra/Polynomial.thy
     Author:     Brian Huffman
     Author:     Clemens Ballarin
     Author:     Amine Chaieb
     Author:     Florian Haftmann
 *)
 
 section \<open>Polynomials as type over a ring structure\<close>
 
 theory Polynomial
 imports
   Complex_Main
   "HOL-Library.More_List"
   "HOL-Library.Infinite_Set"
   Factorial_Ring
 begin
 
 subsection \<open>Auxiliary: operations for lists (later) representing coefficients\<close>
 
 definition cCons :: "'a::zero \<Rightarrow> 'a list \<Rightarrow> 'a list"  (infixr "##" 65)
   where "x ## xs = (if xs = [] \<and> x = 0 then [] else x # xs)"
 
 lemma cCons_0_Nil_eq [simp]: "0 ## [] = []"
   by (simp add: cCons_def)
 
 lemma cCons_Cons_eq [simp]: "x ## y # ys = x # y # ys"
   by (simp add: cCons_def)
 
 lemma cCons_append_Cons_eq [simp]: "x ## xs @ y # ys = x # xs @ y # ys"
   by (simp add: cCons_def)
 
 lemma cCons_not_0_eq [simp]: "x \<noteq> 0 \<Longrightarrow> x ## xs = x # xs"
   by (simp add: cCons_def)
 
 lemma strip_while_not_0_Cons_eq [simp]:
   "strip_while (\<lambda>x. x = 0) (x # xs) = x ## strip_while (\<lambda>x. x = 0) xs"
 proof (cases "x = 0")
   case False
   then show ?thesis by simp
 next
   case True
   show ?thesis
   proof (induct xs rule: rev_induct)
     case Nil
     with True show ?case by simp
   next
     case (snoc y ys)
     then show ?case
       by (cases "y = 0") (simp_all add: append_Cons [symmetric] del: append_Cons)
   qed
 qed
 
 lemma tl_cCons [simp]: "tl (x ## xs) = xs"
   by (simp add: cCons_def)
 
 
 subsection \<open>Definition of type \<open>poly\<close>\<close>
 
 typedef (overloaded) 'a poly = "{f :: nat \<Rightarrow> 'a::zero. \<forall>\<^sub>\<infinity> n. f n = 0}"
   morphisms coeff Abs_poly
   by (auto intro!: ALL_MOST)
 
 setup_lifting type_definition_poly
 
 lemma poly_eq_iff: "p = q \<longleftrightarrow> (\<forall>n. coeff p n = coeff q n)"
   by (simp add: coeff_inject [symmetric] fun_eq_iff)
 
 lemma poly_eqI: "(\<And>n. coeff p n = coeff q n) \<Longrightarrow> p = q"
   by (simp add: poly_eq_iff)
 
 lemma MOST_coeff_eq_0: "\<forall>\<^sub>\<infinity> n. coeff p n = 0"
   using coeff [of p] by simp
 
 
 subsection \<open>Degree of a polynomial\<close>
 
 definition degree :: "'a::zero poly \<Rightarrow> nat"
   where "degree p = (LEAST n. \<forall>i>n. coeff p i = 0)"
 
 lemma coeff_eq_0:
   assumes "degree p < n"
   shows "coeff p n = 0"
 proof -
   have "\<exists>n. \<forall>i>n. coeff p i = 0"
     using MOST_coeff_eq_0 by (simp add: MOST_nat)
   then have "\<forall>i>degree p. coeff p i = 0"
     unfolding degree_def by (rule LeastI_ex)
   with assms show ?thesis by simp
 qed
 
 lemma le_degree: "coeff p n \<noteq> 0 \<Longrightarrow> n \<le> degree p"
   by (erule contrapos_np, rule coeff_eq_0, simp)
 
 lemma degree_le: "\<forall>i>n. coeff p i = 0 \<Longrightarrow> degree p \<le> n"
   unfolding degree_def by (erule Least_le)
 
 lemma less_degree_imp: "n < degree p \<Longrightarrow> \<exists>i>n. coeff p i \<noteq> 0"
   unfolding degree_def by (drule not_less_Least, simp)
 
 
 subsection \<open>The zero polynomial\<close>
 
 instantiation poly :: (zero) zero
 begin
 
 lift_definition zero_poly :: "'a poly"
   is "\<lambda>_. 0"
   by (rule MOST_I) simp
 
 instance ..
 
 end
 
 lemma coeff_0 [simp]: "coeff 0 n = 0"
   by transfer rule
 
 lemma degree_0 [simp]: "degree 0 = 0"
   by (rule order_antisym [OF degree_le le0]) simp
 
 lemma leading_coeff_neq_0:
   assumes "p \<noteq> 0"
   shows "coeff p (degree p) \<noteq> 0"
 proof (cases "degree p")
   case 0
   from \<open>p \<noteq> 0\<close> obtain n where "coeff p n \<noteq> 0"
     by (auto simp add: poly_eq_iff)
   then have "n \<le> degree p"
     by (rule le_degree)
   with \<open>coeff p n \<noteq> 0\<close> and \<open>degree p = 0\<close> show "coeff p (degree p) \<noteq> 0"
     by simp
 next
   case (Suc n)
   from \<open>degree p = Suc n\<close> have "n < degree p"
     by simp
   then have "\<exists>i>n. coeff p i \<noteq> 0"
     by (rule less_degree_imp)
   then obtain i where "n < i" and "coeff p i \<noteq> 0"
     by blast
   from \<open>degree p = Suc n\<close> and \<open>n < i\<close> have "degree p \<le> i"
     by simp
   also from \<open>coeff p i \<noteq> 0\<close> have "i \<le> degree p"
     by (rule le_degree)
   finally have "degree p = i" .
   with \<open>coeff p i \<noteq> 0\<close> show "coeff p (degree p) \<noteq> 0" by simp
 qed
 
 lemma leading_coeff_0_iff [simp]: "coeff p (degree p) = 0 \<longleftrightarrow> p = 0"
   by (cases "p = 0") (simp_all add: leading_coeff_neq_0)
 
 lemma eq_zero_or_degree_less:
   assumes "degree p \<le> n" and "coeff p n = 0"
   shows "p = 0 \<or> degree p < n"
 proof (cases n)
   case 0
   with \<open>degree p \<le> n\<close> and \<open>coeff p n = 0\<close> have "coeff p (degree p) = 0"
     by simp
   then have "p = 0" by simp
   then show ?thesis ..
 next
   case (Suc m)
   from \<open>degree p \<le> n\<close> have "\<forall>i>n. coeff p i = 0"
     by (simp add: coeff_eq_0)
   with \<open>coeff p n = 0\<close> have "\<forall>i\<ge>n. coeff p i = 0"
     by (simp add: le_less)
   with \<open>n = Suc m\<close> have "\<forall>i>m. coeff p i = 0"
     by (simp add: less_eq_Suc_le)
   then have "degree p \<le> m"
     by (rule degree_le)
   with \<open>n = Suc m\<close> have "degree p < n"
     by (simp add: less_Suc_eq_le)
   then show ?thesis ..
 qed
 
 lemma coeff_0_degree_minus_1: "coeff rrr dr = 0 \<Longrightarrow> degree rrr \<le> dr \<Longrightarrow> degree rrr \<le> dr - 1"
   using eq_zero_or_degree_less by fastforce
 
 
 subsection \<open>List-style constructor for polynomials\<close>
 
 lift_definition pCons :: "'a::zero \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   is "\<lambda>a p. case_nat a (coeff p)"
   by (rule MOST_SucD) (simp add: MOST_coeff_eq_0)
 
 lemmas coeff_pCons = pCons.rep_eq
 
 lemma coeff_pCons_0 [simp]: "coeff (pCons a p) 0 = a"
   by transfer simp
 
 lemma coeff_pCons_Suc [simp]: "coeff (pCons a p) (Suc n) = coeff p n"
   by (simp add: coeff_pCons)
 
 lemma degree_pCons_le: "degree (pCons a p) \<le> Suc (degree p)"
   by (rule degree_le) (simp add: coeff_eq_0 coeff_pCons split: nat.split)
 
 lemma degree_pCons_eq: "p \<noteq> 0 \<Longrightarrow> degree (pCons a p) = Suc (degree p)"
   by (simp add: degree_pCons_le le_antisym le_degree)
 
 lemma degree_pCons_0: "degree (pCons a 0) = 0"
 proof -
   have "degree (pCons a 0) \<le> Suc 0"
     by (metis (no_types) degree_0 degree_pCons_le)
   then show ?thesis
     by (metis coeff_0 coeff_pCons_Suc degree_0 eq_zero_or_degree_less less_Suc0)
 qed
 
 lemma degree_pCons_eq_if [simp]: "degree (pCons a p) = (if p = 0 then 0 else Suc (degree p))"
   by (simp add: degree_pCons_0 degree_pCons_eq)
 
 lemma pCons_0_0 [simp]: "pCons 0 0 = 0"
   by (rule poly_eqI) (simp add: coeff_pCons split: nat.split)
 
 lemma pCons_eq_iff [simp]: "pCons a p = pCons b q \<longleftrightarrow> a = b \<and> p = q"
 proof safe
   assume "pCons a p = pCons b q"
   then have "coeff (pCons a p) 0 = coeff (pCons b q) 0"
     by simp
   then show "a = b"
     by simp
 next
   assume "pCons a p = pCons b q"
   then have "coeff (pCons a p) (Suc n) = coeff (pCons b q) (Suc n)" for n
     by simp
   then show "p = q"
     by (simp add: poly_eq_iff)
 qed
 
 lemma pCons_eq_0_iff [simp]: "pCons a p = 0 \<longleftrightarrow> a = 0 \<and> p = 0"
   using pCons_eq_iff [of a p 0 0] by simp
 
 lemma pCons_cases [cases type: poly]:
   obtains (pCons) a q where "p = pCons a q"
 proof
   show "p = pCons (coeff p 0) (Abs_poly (\<lambda>n. coeff p (Suc n)))"
     by transfer
       (simp_all add: MOST_inj[where f=Suc and P="\<lambda>n. p n = 0" for p] fun_eq_iff Abs_poly_inverse
         split: nat.split)
 qed
 
 lemma pCons_induct [case_names 0 pCons, induct type: poly]:
   assumes zero: "P 0"
   assumes pCons: "\<And>a p. a \<noteq> 0 \<or> p \<noteq> 0 \<Longrightarrow> P p \<Longrightarrow> P (pCons a p)"
   shows "P p"
 proof (induct p rule: measure_induct_rule [where f=degree])
   case (less p)
   obtain a q where "p = pCons a q" by (rule pCons_cases)
   have "P q"
   proof (cases "q = 0")
     case True
     then show "P q" by (simp add: zero)
   next
     case False
     then have "degree (pCons a q) = Suc (degree q)"
       by (rule degree_pCons_eq)
     with \<open>p = pCons a q\<close> have "degree q < degree p"
       by simp
     then show "P q"
       by (rule less.hyps)
   qed
   have "P (pCons a q)"
   proof (cases "a \<noteq> 0 \<or> q \<noteq> 0")
     case True
     with \<open>P q\<close> show ?thesis by (auto intro: pCons)
   next
     case False
     with zero show ?thesis by simp
   qed
   with \<open>p = pCons a q\<close> show ?case
     by simp
 qed
 
 lemma degree_eq_zeroE:
   fixes p :: "'a::zero poly"
   assumes "degree p = 0"
   obtains a where "p = pCons a 0"
 proof -
   obtain a q where p: "p = pCons a q"
     by (cases p)
   with assms have "q = 0"
     by (cases "q = 0") simp_all
   with p have "p = pCons a 0"
     by simp
   then show thesis ..
 qed
 
 
 subsection \<open>Quickcheck generator for polynomials\<close>
 
 quickcheck_generator poly constructors: "0 :: _ poly", pCons
 
 
 subsection \<open>List-style syntax for polynomials\<close>
 
 syntax "_poly" :: "args \<Rightarrow> 'a poly"  ("[:(_):]")
 translations
   "[:x, xs:]" \<rightleftharpoons> "CONST pCons x [:xs:]"
   "[:x:]" \<rightleftharpoons> "CONST pCons x 0"
   "[:x:]" \<leftharpoondown> "CONST pCons x (_constrain 0 t)"
 
 
 subsection \<open>Representation of polynomials by lists of coefficients\<close>
 
 primrec Poly :: "'a::zero list \<Rightarrow> 'a poly"
   where
     [code_post]: "Poly [] = 0"
   | [code_post]: "Poly (a # as) = pCons a (Poly as)"
 
 lemma Poly_replicate_0 [simp]: "Poly (replicate n 0) = 0"
   by (induct n) simp_all
 
 lemma Poly_eq_0: "Poly as = 0 \<longleftrightarrow> (\<exists>n. as = replicate n 0)"
   by (induct as) (auto simp add: Cons_replicate_eq)
 
 lemma Poly_append_replicate_zero [simp]: "Poly (as @ replicate n 0) = Poly as"
   by (induct as) simp_all
 
 lemma Poly_snoc_zero [simp]: "Poly (as @ [0]) = Poly as"
   using Poly_append_replicate_zero [of as 1] by simp
 
 lemma Poly_cCons_eq_pCons_Poly [simp]: "Poly (a ## p) = pCons a (Poly p)"
   by (simp add: cCons_def)
 
 lemma Poly_on_rev_starting_with_0 [simp]: "hd as = 0 \<Longrightarrow> Poly (rev (tl as)) = Poly (rev as)"
   by (cases as) simp_all
 
 lemma degree_Poly: "degree (Poly xs) \<le> length xs"
   by (induct xs) simp_all
 
 lemma coeff_Poly_eq [simp]: "coeff (Poly xs) = nth_default 0 xs"
   by (induct xs) (simp_all add: fun_eq_iff coeff_pCons split: nat.splits)
 
 definition coeffs :: "'a poly \<Rightarrow> 'a::zero list"
   where "coeffs p = (if p = 0 then [] else map (\<lambda>i. coeff p i) [0 ..< Suc (degree p)])"
 
 lemma coeffs_eq_Nil [simp]: "coeffs p = [] \<longleftrightarrow> p = 0"
   by (simp add: coeffs_def)
 
 lemma not_0_coeffs_not_Nil: "p \<noteq> 0 \<Longrightarrow> coeffs p \<noteq> []"
   by simp
 
 lemma coeffs_0_eq_Nil [simp]: "coeffs 0 = []"
   by simp
 
 lemma coeffs_pCons_eq_cCons [simp]: "coeffs (pCons a p) = a ## coeffs p"
 proof -
   have *: "\<forall>m\<in>set ms. m > 0 \<Longrightarrow> map (case_nat x f) ms = map f (map (\<lambda>n. n - 1) ms)"
     for ms :: "nat list" and f :: "nat \<Rightarrow> 'a" and x :: "'a"
     by (induct ms) (auto split: nat.split)
   show ?thesis
     by (simp add: * coeffs_def upt_conv_Cons coeff_pCons map_decr_upt del: upt_Suc)
 qed
 
 lemma length_coeffs: "p \<noteq> 0 \<Longrightarrow> length (coeffs p) = degree p + 1"
   by (simp add: coeffs_def)
 
 lemma coeffs_nth: "p \<noteq> 0 \<Longrightarrow> n \<le> degree p \<Longrightarrow> coeffs p ! n = coeff p n"
   by (auto simp: coeffs_def simp del: upt_Suc)
 
 lemma coeff_in_coeffs: "p \<noteq> 0 \<Longrightarrow> n \<le> degree p \<Longrightarrow> coeff p n \<in> set (coeffs p)"
   using coeffs_nth [of p n, symmetric] by (simp add: length_coeffs)
 
 lemma not_0_cCons_eq [simp]: "p \<noteq> 0 \<Longrightarrow> a ## coeffs p = a # coeffs p"
   by (simp add: cCons_def)
 
 lemma Poly_coeffs [simp, code abstype]: "Poly (coeffs p) = p"
   by (induct p) auto
 
 lemma coeffs_Poly [simp]: "coeffs (Poly as) = strip_while (HOL.eq 0) as"
 proof (induct as)
   case Nil
   then show ?case by simp
 next
   case (Cons a as)
   from replicate_length_same [of as 0] have "(\<forall>n. as \<noteq> replicate n 0) \<longleftrightarrow> (\<exists>a\<in>set as. a \<noteq> 0)"
     by (auto dest: sym [of _ as])
   with Cons show ?case by auto
 qed
 
 lemma no_trailing_coeffs [simp]:
   "no_trailing (HOL.eq 0) (coeffs p)"
   by (induct p)  auto
 
 lemma strip_while_coeffs [simp]:
   "strip_while (HOL.eq 0) (coeffs p) = coeffs p"
   by simp
 
 lemma coeffs_eq_iff: "p = q \<longleftrightarrow> coeffs p = coeffs q"
   (is "?P \<longleftrightarrow> ?Q")
 proof
   assume ?P
   then show ?Q by simp
 next
   assume ?Q
   then have "Poly (coeffs p) = Poly (coeffs q)" by simp
   then show ?P by simp
 qed
 
 lemma nth_default_coeffs_eq: "nth_default 0 (coeffs p) = coeff p"
   by (simp add: fun_eq_iff coeff_Poly_eq [symmetric])
 
 lemma [code]: "coeff p = nth_default 0 (coeffs p)"
   by (simp add: nth_default_coeffs_eq)
 
 lemma coeffs_eqI:
   assumes coeff: "\<And>n. coeff p n = nth_default 0 xs n"
   assumes zero: "no_trailing (HOL.eq 0) xs"
   shows "coeffs p = xs"
 proof -
   from coeff have "p = Poly xs"
     by (simp add: poly_eq_iff)
   with zero show ?thesis by simp
 qed
 
 lemma degree_eq_length_coeffs [code]: "degree p = length (coeffs p) - 1"
   by (simp add: coeffs_def)
 
 lemma length_coeffs_degree: "p \<noteq> 0 \<Longrightarrow> length (coeffs p) = Suc (degree p)"
   by (induct p) (auto simp: cCons_def)
 
 lemma [code abstract]: "coeffs 0 = []"
   by (fact coeffs_0_eq_Nil)
 
 lemma [code abstract]: "coeffs (pCons a p) = a ## coeffs p"
   by (fact coeffs_pCons_eq_cCons)
 
 lemma set_coeffs_subset_singleton_0_iff [simp]:
   "set (coeffs p) \<subseteq> {0} \<longleftrightarrow> p = 0"
   by (auto simp add: coeffs_def intro: classical)
 
 lemma set_coeffs_not_only_0 [simp]:
   "set (coeffs p) \<noteq> {0}"
   by (auto simp add: set_eq_subset)
 
 lemma forall_coeffs_conv:
   "(\<forall>n. P (coeff p n)) \<longleftrightarrow> (\<forall>c \<in> set (coeffs p). P c)" if "P 0"
   using that by (auto simp add: coeffs_def)
     (metis atLeastLessThan_iff coeff_eq_0 not_less_iff_gr_or_eq zero_le)
 
 instantiation poly :: ("{zero, equal}") equal
 begin
 
 definition [code]: "HOL.equal (p::'a poly) q \<longleftrightarrow> HOL.equal (coeffs p) (coeffs q)"
 
 instance
   by standard (simp add: equal equal_poly_def coeffs_eq_iff)
 
 end
 
 lemma [code nbe]: "HOL.equal (p :: _ poly) p \<longleftrightarrow> True"
   by (fact equal_refl)
 
 definition is_zero :: "'a::zero poly \<Rightarrow> bool"
   where [code]: "is_zero p \<longleftrightarrow> List.null (coeffs p)"
 
 lemma is_zero_null [code_abbrev]: "is_zero p \<longleftrightarrow> p = 0"
   by (simp add: is_zero_def null_def)
 
 
 subsubsection \<open>Reconstructing the polynomial from the list\<close>
   \<comment> \<open>contributed by Sebastiaan J.C. Joosten and René Thiemann\<close>
 
 definition poly_of_list :: "'a::comm_monoid_add list \<Rightarrow> 'a poly"
   where [simp]: "poly_of_list = Poly"
 
 lemma poly_of_list_impl [code abstract]: "coeffs (poly_of_list as) = strip_while (HOL.eq 0) as"
   by simp
 
 
 subsection \<open>Fold combinator for polynomials\<close>
 
 definition fold_coeffs :: "('a::zero \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a poly \<Rightarrow> 'b \<Rightarrow> 'b"
   where "fold_coeffs f p = foldr f (coeffs p)"
 
 lemma fold_coeffs_0_eq [simp]: "fold_coeffs f 0 = id"
   by (simp add: fold_coeffs_def)
 
 lemma fold_coeffs_pCons_eq [simp]: "f 0 = id \<Longrightarrow> fold_coeffs f (pCons a p) = f a \<circ> fold_coeffs f p"
   by (simp add: fold_coeffs_def cCons_def fun_eq_iff)
 
 lemma fold_coeffs_pCons_0_0_eq [simp]: "fold_coeffs f (pCons 0 0) = id"
   by (simp add: fold_coeffs_def)
 
 lemma fold_coeffs_pCons_coeff_not_0_eq [simp]:
   "a \<noteq> 0 \<Longrightarrow> fold_coeffs f (pCons a p) = f a \<circ> fold_coeffs f p"
   by (simp add: fold_coeffs_def)
 
 lemma fold_coeffs_pCons_not_0_0_eq [simp]:
   "p \<noteq> 0 \<Longrightarrow> fold_coeffs f (pCons a p) = f a \<circ> fold_coeffs f p"
   by (simp add: fold_coeffs_def)
 
 
 subsection \<open>Canonical morphism on polynomials -- evaluation\<close>
 
 definition poly :: \<open>'a::comm_semiring_0 poly \<Rightarrow> 'a \<Rightarrow> 'a\<close>
   where \<open>poly p a = horner_sum id a (coeffs p)\<close>
 
 lemma poly_eq_fold_coeffs:
   \<open>poly p = fold_coeffs (\<lambda>a f x. a + x * f x) p (\<lambda>x. 0)\<close>
   by (induction p) (auto simp add: fun_eq_iff poly_def)
 
 lemma poly_0 [simp]: "poly 0 x = 0"
   by (simp add: poly_def)
 
 lemma poly_pCons [simp]: "poly (pCons a p) x = a + x * poly p x"
   by (cases "p = 0 \<and> a = 0") (auto simp add: poly_def)
 
 lemma poly_altdef: "poly p x = (\<Sum>i\<le>degree p. coeff p i * x ^ i)"
   for x :: "'a::{comm_semiring_0,semiring_1}"
 proof (induction p rule: pCons_induct)
   case 0
   then show ?case
     by simp
 next
   case (pCons a p)
   show ?case
   proof (cases "p = 0")
     case True
     then show ?thesis by simp
   next
     case False
     let ?p' = "pCons a p"
     note poly_pCons[of a p x]
     also note pCons.IH
     also have "a + x * (\<Sum>i\<le>degree p. coeff p i * x ^ i) =
         coeff ?p' 0 * x^0 + (\<Sum>i\<le>degree p. coeff ?p' (Suc i) * x^Suc i)"
       by (simp add: field_simps sum_distrib_left coeff_pCons)
     also note sum.atMost_Suc_shift[symmetric]
     also note degree_pCons_eq[OF \<open>p \<noteq> 0\<close>, of a, symmetric]
     finally show ?thesis .
   qed
 qed
 
 lemma poly_0_coeff_0: "poly p 0 = coeff p 0"
   by (cases p) (auto simp: poly_altdef)
 
 
 subsection \<open>Monomials\<close>
 
 lift_definition monom :: "'a \<Rightarrow> nat \<Rightarrow> 'a::zero poly"
   is "\<lambda>a m n. if m = n then a else 0"
   by (simp add: MOST_iff_cofinite)
 
 lemma coeff_monom [simp]: "coeff (monom a m) n = (if m = n then a else 0)"
   by transfer rule
 
 lemma monom_0: "monom a 0 = pCons a 0"
   by (rule poly_eqI) (simp add: coeff_pCons split: nat.split)
 
 lemma monom_Suc: "monom a (Suc n) = pCons 0 (monom a n)"
   by (rule poly_eqI) (simp add: coeff_pCons split: nat.split)
 
 lemma monom_eq_0 [simp]: "monom 0 n = 0"
   by (rule poly_eqI) simp
 
 lemma monom_eq_0_iff [simp]: "monom a n = 0 \<longleftrightarrow> a = 0"
   by (simp add: poly_eq_iff)
 
 lemma monom_eq_iff [simp]: "monom a n = monom b n \<longleftrightarrow> a = b"
   by (simp add: poly_eq_iff)
 
 lemma degree_monom_le: "degree (monom a n) \<le> n"
   by (rule degree_le, simp)
 
 lemma degree_monom_eq: "a \<noteq> 0 \<Longrightarrow> degree (monom a n) = n"
   by (metis coeff_monom leading_coeff_0_iff)
 
 lemma coeffs_monom [code abstract]:
   "coeffs (monom a n) = (if a = 0 then [] else replicate n 0 @ [a])"
   by (induct n) (simp_all add: monom_0 monom_Suc)
 
 lemma fold_coeffs_monom [simp]: "a \<noteq> 0 \<Longrightarrow> fold_coeffs f (monom a n) = f 0 ^^ n \<circ> f a"
   by (simp add: fold_coeffs_def coeffs_monom fun_eq_iff)
 
 lemma poly_monom: "poly (monom a n) x = a * x ^ n"
   for a x :: "'a::comm_semiring_1"
   by (cases "a = 0", simp_all) (induct n, simp_all add: mult.left_commute poly_eq_fold_coeffs)
 
 lemma monom_eq_iff': "monom c n = monom d m \<longleftrightarrow>  c = d \<and> (c = 0 \<or> n = m)"
   by (auto simp: poly_eq_iff)
 
 lemma monom_eq_const_iff: "monom c n = [:d:] \<longleftrightarrow> c = d \<and> (c = 0 \<or> n = 0)"
   using monom_eq_iff'[of c n d 0] by (simp add: monom_0)
 
 
 subsection \<open>Leading coefficient\<close>
 
 abbreviation lead_coeff:: "'a::zero poly \<Rightarrow> 'a"
   where "lead_coeff p \<equiv> coeff p (degree p)"
 
 lemma lead_coeff_pCons[simp]:
   "p \<noteq> 0 \<Longrightarrow> lead_coeff (pCons a p) = lead_coeff p"
   "p = 0 \<Longrightarrow> lead_coeff (pCons a p) = a"
   by auto
 
 lemma lead_coeff_monom [simp]: "lead_coeff (monom c n) = c"
   by (cases "c = 0") (simp_all add: degree_monom_eq)
 
 lemma last_coeffs_eq_coeff_degree:
   "last (coeffs p) = lead_coeff p" if "p \<noteq> 0"
   using that by (simp add: coeffs_def)
   
 
 subsection \<open>Addition and subtraction\<close>
 
 instantiation poly :: (comm_monoid_add) comm_monoid_add
 begin
 
 lift_definition plus_poly :: "'a poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   is "\<lambda>p q n. coeff p n + coeff q n"
 proof -
   fix q p :: "'a poly"
   show "\<forall>\<^sub>\<infinity>n. coeff p n + coeff q n = 0"
     using MOST_coeff_eq_0[of p] MOST_coeff_eq_0[of q] by eventually_elim simp
 qed
 
 lemma coeff_add [simp]: "coeff (p + q) n = coeff p n + coeff q n"
   by (simp add: plus_poly.rep_eq)
 
 instance
 proof
   fix p q r :: "'a poly"
   show "(p + q) + r = p + (q + r)"
     by (simp add: poly_eq_iff add.assoc)
   show "p + q = q + p"
     by (simp add: poly_eq_iff add.commute)
   show "0 + p = p"
     by (simp add: poly_eq_iff)
 qed
 
 end
 
 instantiation poly :: (cancel_comm_monoid_add) cancel_comm_monoid_add
 begin
 
 lift_definition minus_poly :: "'a poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   is "\<lambda>p q n. coeff p n - coeff q n"
 proof -
   fix q p :: "'a poly"
   show "\<forall>\<^sub>\<infinity>n. coeff p n - coeff q n = 0"
     using MOST_coeff_eq_0[of p] MOST_coeff_eq_0[of q] by eventually_elim simp
 qed
 
 lemma coeff_diff [simp]: "coeff (p - q) n = coeff p n - coeff q n"
   by (simp add: minus_poly.rep_eq)
 
 instance
 proof
   fix p q r :: "'a poly"
   show "p + q - p = q"
     by (simp add: poly_eq_iff)
   show "p - q - r = p - (q + r)"
     by (simp add: poly_eq_iff diff_diff_eq)
 qed
 
 end
 
 instantiation poly :: (ab_group_add) ab_group_add
 begin
 
 lift_definition uminus_poly :: "'a poly \<Rightarrow> 'a poly"
   is "\<lambda>p n. - coeff p n"
 proof -
   fix p :: "'a poly"
   show "\<forall>\<^sub>\<infinity>n. - coeff p n = 0"
     using MOST_coeff_eq_0 by simp
 qed
 
 lemma coeff_minus [simp]: "coeff (- p) n = - coeff p n"
   by (simp add: uminus_poly.rep_eq)
 
 instance
 proof
   fix p q :: "'a poly"
   show "- p + p = 0"
     by (simp add: poly_eq_iff)
   show "p - q = p + - q"
     by (simp add: poly_eq_iff)
 qed
 
 end
 
 lemma add_pCons [simp]: "pCons a p + pCons b q = pCons (a + b) (p + q)"
   by (rule poly_eqI) (simp add: coeff_pCons split: nat.split)
 
 lemma minus_pCons [simp]: "- pCons a p = pCons (- a) (- p)"
   by (rule poly_eqI) (simp add: coeff_pCons split: nat.split)
 
 lemma diff_pCons [simp]: "pCons a p - pCons b q = pCons (a - b) (p - q)"
   by (rule poly_eqI) (simp add: coeff_pCons split: nat.split)
 
 lemma degree_add_le_max: "degree (p + q) \<le> max (degree p) (degree q)"
   by (rule degree_le) (auto simp add: coeff_eq_0)
 
 lemma degree_add_le: "degree p \<le> n \<Longrightarrow> degree q \<le> n \<Longrightarrow> degree (p + q) \<le> n"
   by (auto intro: order_trans degree_add_le_max)
 
 lemma degree_add_less: "degree p < n \<Longrightarrow> degree q < n \<Longrightarrow> degree (p + q) < n"
   by (auto intro: le_less_trans degree_add_le_max)
 
 lemma degree_add_eq_right: assumes "degree p < degree q" shows "degree (p + q) = degree q"
 proof (cases "q = 0")
   case False
   show ?thesis
   proof (rule order_antisym)
     show "degree (p + q) \<le> degree q"
       by (simp add: assms degree_add_le order.strict_implies_order)
     show "degree q \<le> degree (p + q)"
       by (simp add: False assms coeff_eq_0 le_degree)
   qed
 qed (use assms in auto)
 
 lemma degree_add_eq_left: "degree q < degree p \<Longrightarrow> degree (p + q) = degree p"
   using degree_add_eq_right [of q p] by (simp add: add.commute)
 
 lemma degree_minus [simp]: "degree (- p) = degree p"
   by (simp add: degree_def)
 
 lemma lead_coeff_add_le: "degree p < degree q \<Longrightarrow> lead_coeff (p + q) = lead_coeff q"
   by (metis coeff_add coeff_eq_0 monoid_add_class.add.left_neutral degree_add_eq_right)
 
 lemma lead_coeff_minus: "lead_coeff (- p) = - lead_coeff p"
   by (metis coeff_minus degree_minus)
 
 lemma degree_diff_le_max: "degree (p - q) \<le> max (degree p) (degree q)"
   for p q :: "'a::ab_group_add poly"
   using degree_add_le [where p=p and q="-q"] by simp
 
 lemma degree_diff_le: "degree p \<le> n \<Longrightarrow> degree q \<le> n \<Longrightarrow> degree (p - q) \<le> n"
   for p q :: "'a::ab_group_add poly"
   using degree_add_le [of p n "- q"] by simp
 
 lemma degree_diff_less: "degree p < n \<Longrightarrow> degree q < n \<Longrightarrow> degree (p - q) < n"
   for p q :: "'a::ab_group_add poly"
   using degree_add_less [of p n "- q"] by simp
 
 lemma add_monom: "monom a n + monom b n = monom (a + b) n"
   by (rule poly_eqI) simp
 
 lemma diff_monom: "monom a n - monom b n = monom (a - b) n"
   by (rule poly_eqI) simp
 
 lemma minus_monom: "- monom a n = monom (- a) n"
   by (rule poly_eqI) simp
 
 lemma coeff_sum: "coeff (\<Sum>x\<in>A. p x) i = (\<Sum>x\<in>A. coeff (p x) i)"
   by (induct A rule: infinite_finite_induct) simp_all
 
 lemma monom_sum: "monom (\<Sum>x\<in>A. a x) n = (\<Sum>x\<in>A. monom (a x) n)"
   by (rule poly_eqI) (simp add: coeff_sum)
 
 fun plus_coeffs :: "'a::comm_monoid_add list \<Rightarrow> 'a list \<Rightarrow> 'a list"
   where
     "plus_coeffs xs [] = xs"
   | "plus_coeffs [] ys = ys"
   | "plus_coeffs (x # xs) (y # ys) = (x + y) ## plus_coeffs xs ys"
 
 lemma coeffs_plus_eq_plus_coeffs [code abstract]:
   "coeffs (p + q) = plus_coeffs (coeffs p) (coeffs q)"
 proof -
   have *: "nth_default 0 (plus_coeffs xs ys) n = nth_default 0 xs n + nth_default 0 ys n"
     for xs ys :: "'a list" and n
   proof (induct xs ys arbitrary: n rule: plus_coeffs.induct)
     case (3 x xs y ys n)
     then show ?case
       by (cases n) (auto simp add: cCons_def)
   qed simp_all
   have **: "no_trailing (HOL.eq 0) (plus_coeffs xs ys)"
     if "no_trailing (HOL.eq 0) xs" and "no_trailing (HOL.eq 0) ys"
     for xs ys :: "'a list"
     using that by (induct xs ys rule: plus_coeffs.induct) (simp_all add: cCons_def)
   show ?thesis
     by (rule coeffs_eqI) (auto simp add: * nth_default_coeffs_eq intro: **)
 qed
 
 lemma coeffs_uminus [code abstract]:
   "coeffs (- p) = map uminus (coeffs p)"
 proof -
   have eq_0: "HOL.eq 0 \<circ> uminus = HOL.eq (0::'a)"
     by (simp add: fun_eq_iff)
   show ?thesis
     by (rule coeffs_eqI) (simp_all add: nth_default_map_eq nth_default_coeffs_eq no_trailing_map eq_0)
 qed
 
 lemma [code]: "p - q = p + - q"
   for p q :: "'a::ab_group_add poly"
   by (fact diff_conv_add_uminus)
 
 lemma poly_add [simp]: "poly (p + q) x = poly p x + poly q x"
 proof (induction p arbitrary: q)
   case (pCons a p)
   then show ?case
     by (cases q) (simp add: algebra_simps)
 qed auto
 
 lemma poly_minus [simp]: "poly (- p) x = - poly p x"
   for x :: "'a::comm_ring"
   by (induct p) simp_all
 
 lemma poly_diff [simp]: "poly (p - q) x = poly p x - poly q x"
   for x :: "'a::comm_ring"
   using poly_add [of p "- q" x] by simp
 
 lemma poly_sum: "poly (\<Sum>k\<in>A. p k) x = (\<Sum>k\<in>A. poly (p k) x)"
   by (induct A rule: infinite_finite_induct) simp_all
 
 lemma degree_sum_le: "finite S \<Longrightarrow> (\<And>p. p \<in> S \<Longrightarrow> degree (f p) \<le> n) \<Longrightarrow> degree (sum f S) \<le> n"
 proof (induct S rule: finite_induct)
   case empty
   then show ?case by simp
 next
   case (insert p S)
   then have "degree (sum f S) \<le> n" "degree (f p) \<le> n"
     by auto
   then show ?case
     unfolding sum.insert[OF insert(1-2)] by (metis degree_add_le)
 qed
 
 lemma poly_as_sum_of_monoms':
   assumes "degree p \<le> n"
   shows "(\<Sum>i\<le>n. monom (coeff p i) i) = p"
 proof -
   have eq: "\<And>i. {..n} \<inter> {i} = (if i \<le> n then {i} else {})"
     by auto
   from assms show ?thesis
     by (simp add: poly_eq_iff coeff_sum coeff_eq_0 sum.If_cases eq
         if_distrib[where f="\<lambda>x. x * a" for a])
 qed
 
 lemma poly_as_sum_of_monoms: "(\<Sum>i\<le>degree p. monom (coeff p i) i) = p"
   by (intro poly_as_sum_of_monoms' order_refl)
 
 lemma Poly_snoc: "Poly (xs @ [x]) = Poly xs + monom x (length xs)"
   by (induct xs) (simp_all add: monom_0 monom_Suc)
 
 
 subsection \<open>Multiplication by a constant, polynomial multiplication and the unit polynomial\<close>
 
 lift_definition smult :: "'a::comm_semiring_0 \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   is "\<lambda>a p n. a * coeff p n"
 proof -
   fix a :: 'a and p :: "'a poly"
   show "\<forall>\<^sub>\<infinity> i. a * coeff p i = 0"
     using MOST_coeff_eq_0[of p] by eventually_elim simp
 qed
 
 lemma coeff_smult [simp]: "coeff (smult a p) n = a * coeff p n"
   by (simp add: smult.rep_eq)
 
 lemma degree_smult_le: "degree (smult a p) \<le> degree p"
   by (rule degree_le) (simp add: coeff_eq_0)
 
 lemma smult_smult [simp]: "smult a (smult b p) = smult (a * b) p"
   by (rule poly_eqI) (simp add: mult.assoc)
 
 lemma smult_0_right [simp]: "smult a 0 = 0"
   by (rule poly_eqI) simp
 
 lemma smult_0_left [simp]: "smult 0 p = 0"
   by (rule poly_eqI) simp
 
 lemma smult_1_left [simp]: "smult (1::'a::comm_semiring_1) p = p"
   by (rule poly_eqI) simp
 
 lemma smult_add_right: "smult a (p + q) = smult a p + smult a q"
   by (rule poly_eqI) (simp add: algebra_simps)
 
 lemma smult_add_left: "smult (a + b) p = smult a p + smult b p"
   by (rule poly_eqI) (simp add: algebra_simps)
 
 lemma smult_minus_right [simp]: "smult a (- p) = - smult a p"
   for a :: "'a::comm_ring"
   by (rule poly_eqI) simp
 
 lemma smult_minus_left [simp]: "smult (- a) p = - smult a p"
   for a :: "'a::comm_ring"
   by (rule poly_eqI) simp
 
 lemma smult_diff_right: "smult a (p - q) = smult a p - smult a q"
   for a :: "'a::comm_ring"
   by (rule poly_eqI) (simp add: algebra_simps)
 
 lemma smult_diff_left: "smult (a - b) p = smult a p - smult b p"
   for a b :: "'a::comm_ring"
   by (rule poly_eqI) (simp add: algebra_simps)
 
 lemmas smult_distribs =
   smult_add_left smult_add_right
   smult_diff_left smult_diff_right
 
 lemma smult_pCons [simp]: "smult a (pCons b p) = pCons (a * b) (smult a p)"
   by (rule poly_eqI) (simp add: coeff_pCons split: nat.split)
 
 lemma smult_monom: "smult a (monom b n) = monom (a * b) n"
   by (induct n) (simp_all add: monom_0 monom_Suc)
 
 lemma smult_Poly: "smult c (Poly xs) = Poly (map ((*) c) xs)"
   by (auto simp: poly_eq_iff nth_default_def)
 
 lemma degree_smult_eq [simp]: "degree (smult a p) = (if a = 0 then 0 else degree p)"
   for a :: "'a::{comm_semiring_0,semiring_no_zero_divisors}"
   by (cases "a = 0") (simp_all add: degree_def)
 
 lemma smult_eq_0_iff [simp]: "smult a p = 0 \<longleftrightarrow> a = 0 \<or> p = 0"
   for a :: "'a::{comm_semiring_0,semiring_no_zero_divisors}"
   by (simp add: poly_eq_iff)
 
 lemma coeffs_smult [code abstract]:
   "coeffs (smult a p) = (if a = 0 then [] else map (Groups.times a) (coeffs p))"
   for p :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
 proof -
   have eq_0: "HOL.eq 0 \<circ> times a = HOL.eq (0::'a)" if "a \<noteq> 0"
     using that by (simp add: fun_eq_iff)
   show ?thesis
     by (rule coeffs_eqI) (auto simp add: no_trailing_map nth_default_map_eq nth_default_coeffs_eq eq_0)
 qed  
 
 lemma smult_eq_iff:
   fixes b :: "'a :: field"
   assumes "b \<noteq> 0"
   shows "smult a p = smult b q \<longleftrightarrow> smult (a / b) p = q"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   also from assms have "smult (inverse b) \<dots> = q"
     by simp
   finally show ?rhs
     by (simp add: field_simps)
 next
   assume ?rhs
   with assms show ?lhs by auto
 qed
 
 instantiation poly :: (comm_semiring_0) comm_semiring_0
 begin
 
 definition "p * q = fold_coeffs (\<lambda>a p. smult a q + pCons 0 p) p 0"
 
 lemma mult_poly_0_left: "(0::'a poly) * q = 0"
   by (simp add: times_poly_def)
 
 lemma mult_pCons_left [simp]: "pCons a p * q = smult a q + pCons 0 (p * q)"
   by (cases "p = 0 \<and> a = 0") (auto simp add: times_poly_def)
 
 lemma mult_poly_0_right: "p * (0::'a poly) = 0"
   by (induct p) (simp_all add: mult_poly_0_left)
 
 lemma mult_pCons_right [simp]: "p * pCons a q = smult a p + pCons 0 (p * q)"
   by (induct p) (simp_all add: mult_poly_0_left algebra_simps)
 
 lemmas mult_poly_0 = mult_poly_0_left mult_poly_0_right
 
 lemma mult_smult_left [simp]: "smult a p * q = smult a (p * q)"
   by (induct p) (simp_all add: mult_poly_0 smult_add_right)
 
 lemma mult_smult_right [simp]: "p * smult a q = smult a (p * q)"
   by (induct q) (simp_all add: mult_poly_0 smult_add_right)
 
 lemma mult_poly_add_left: "(p + q) * r = p * r + q * r"
   for p q r :: "'a poly"
   by (induct r) (simp_all add: mult_poly_0 smult_distribs algebra_simps)
 
 instance
 proof
   fix p q r :: "'a poly"
   show 0: "0 * p = 0"
     by (rule mult_poly_0_left)
   show "p * 0 = 0"
     by (rule mult_poly_0_right)
   show "(p + q) * r = p * r + q * r"
     by (rule mult_poly_add_left)
   show "(p * q) * r = p * (q * r)"
     by (induct p) (simp_all add: mult_poly_0 mult_poly_add_left)
   show "p * q = q * p"
     by (induct p) (simp_all add: mult_poly_0)
 qed
 
 end
 
 lemma coeff_mult_degree_sum:
   "coeff (p * q) (degree p + degree q) = coeff p (degree p) * coeff q (degree q)"
   by (induct p) (simp_all add: coeff_eq_0)
 
 instance poly :: ("{comm_semiring_0,semiring_no_zero_divisors}") semiring_no_zero_divisors
 proof
   fix p q :: "'a poly"
   assume "p \<noteq> 0" and "q \<noteq> 0"
   have "coeff (p * q) (degree p + degree q) = coeff p (degree p) * coeff q (degree q)"
     by (rule coeff_mult_degree_sum)
   also from \<open>p \<noteq> 0\<close> \<open>q \<noteq> 0\<close> have "coeff p (degree p) * coeff q (degree q) \<noteq> 0"
     by simp
   finally have "\<exists>n. coeff (p * q) n \<noteq> 0" ..
   then show "p * q \<noteq> 0"
     by (simp add: poly_eq_iff)
 qed
 
 instance poly :: (comm_semiring_0_cancel) comm_semiring_0_cancel ..
 
 lemma coeff_mult: "coeff (p * q) n = (\<Sum>i\<le>n. coeff p i * coeff q (n-i))"
 proof (induct p arbitrary: n)
   case 0
   show ?case by simp
 next
   case (pCons a p n)
   then show ?case
     by (cases n) (simp_all add: sum.atMost_Suc_shift del: sum.atMost_Suc)
 qed
 
 lemma degree_mult_le: "degree (p * q) \<le> degree p + degree q"
 proof (rule degree_le)
   show "\<forall>i>degree p + degree q. coeff (p * q) i = 0"
     by (induct p) (simp_all add: coeff_eq_0 coeff_pCons split: nat.split)
 qed
 
 lemma mult_monom: "monom a m * monom b n = monom (a * b) (m + n)"
   by (induct m) (simp add: monom_0 smult_monom, simp add: monom_Suc)
 
 instantiation poly :: (comm_semiring_1) comm_semiring_1
 begin
 
 lift_definition one_poly :: "'a poly"
   is "\<lambda>n. of_bool (n = 0)"
   by (rule MOST_SucD) simp
 
 lemma coeff_1 [simp]:
   "coeff 1 n = of_bool (n = 0)"
   by (simp add: one_poly.rep_eq)
 
 lemma one_pCons:
   "1 = [:1:]"
   by (simp add: poly_eq_iff coeff_pCons split: nat.splits)
 
 lemma pCons_one:
   "[:1:] = 1"
   by (simp add: one_pCons)
 
 instance
   by standard (simp_all add: one_pCons)
 
 end
 
 lemma poly_1 [simp]:
   "poly 1 x = 1"
   by (simp add: one_pCons)
 
 lemma one_poly_eq_simps [simp]:
   "1 = [:1:] \<longleftrightarrow> True"
   "[:1:] = 1 \<longleftrightarrow> True"
   by (simp_all add: one_pCons)
 
 lemma degree_1 [simp]:
   "degree 1 = 0"
   by (simp add: one_pCons)
 
 lemma coeffs_1_eq [simp, code abstract]:
   "coeffs 1 = [1]"
   by (simp add: one_pCons)
 
 lemma smult_one [simp]:
   "smult c 1 = [:c:]"
   by (simp add: one_pCons)
 
 lemma monom_eq_1 [simp]:
   "monom 1 0 = 1"
   by (simp add: monom_0 one_pCons)
 
 lemma monom_eq_1_iff:
   "monom c n = 1 \<longleftrightarrow> c = 1 \<and> n = 0"
   using monom_eq_const_iff [of c n 1] by auto
 
 lemma monom_altdef:
   "monom c n = smult c ([:0, 1:] ^ n)"
   by (induct n) (simp_all add: monom_0 monom_Suc)  
 
 instance poly :: ("{comm_semiring_1,semiring_1_no_zero_divisors}") semiring_1_no_zero_divisors ..
 instance poly :: (comm_ring) comm_ring ..
 instance poly :: (comm_ring_1) comm_ring_1 ..
 instance poly :: (comm_ring_1) comm_semiring_1_cancel ..
 
 lemma degree_power_le: "degree (p ^ n) \<le> degree p * n"
   by (induct n) (auto intro: order_trans degree_mult_le)
 
 lemma coeff_0_power: "coeff (p ^ n) 0 = coeff p 0 ^ n"
   by (induct n) (simp_all add: coeff_mult)
 
 lemma poly_smult [simp]: "poly (smult a p) x = a * poly p x"
   by (induct p) (simp_all add: algebra_simps)
 
 lemma poly_mult [simp]: "poly (p * q) x = poly p x * poly q x"
   by (induct p) (simp_all add: algebra_simps)
 
 lemma poly_power [simp]: "poly (p ^ n) x = poly p x ^ n"
   for p :: "'a::comm_semiring_1 poly"
   by (induct n) simp_all
 
 lemma poly_prod: "poly (\<Prod>k\<in>A. p k) x = (\<Prod>k\<in>A. poly (p k) x)"
   by (induct A rule: infinite_finite_induct) simp_all
 
 lemma degree_prod_sum_le: "finite S \<Longrightarrow> degree (prod f S) \<le> sum (degree \<circ> f) S"
 proof (induct S rule: finite_induct)
   case empty
   then show ?case by simp
 next
   case (insert a S)
   show ?case
     unfolding prod.insert[OF insert(1-2)] sum.insert[OF insert(1-2)]
     by (rule le_trans[OF degree_mult_le]) (use insert in auto)
 qed
 
 lemma coeff_0_prod_list: "coeff (prod_list xs) 0 = prod_list (map (\<lambda>p. coeff p 0) xs)"
   by (induct xs) (simp_all add: coeff_mult)
 
 lemma coeff_monom_mult: "coeff (monom c n * p) k = (if k < n then 0 else c * coeff p (k - n))"
 proof -
   have "coeff (monom c n * p) k = (\<Sum>i\<le>k. (if n = i then c else 0) * coeff p (k - i))"
     by (simp add: coeff_mult)
   also have "\<dots> = (\<Sum>i\<le>k. (if n = i then c * coeff p (k - i) else 0))"
     by (intro sum.cong) simp_all
   also have "\<dots> = (if k < n then 0 else c * coeff p (k - n))"
     by simp
   finally show ?thesis .
 qed
 
 lemma monom_1_dvd_iff': "monom 1 n dvd p \<longleftrightarrow> (\<forall>k<n. coeff p k = 0)"
 proof
   assume "monom 1 n dvd p"
   then obtain r where "p = monom 1 n * r"
     by (rule dvdE)
   then show "\<forall>k<n. coeff p k = 0"
     by (simp add: coeff_mult)
 next
   assume zero: "(\<forall>k<n. coeff p k = 0)"
   define r where "r = Abs_poly (\<lambda>k. coeff p (k + n))"
   have "\<forall>\<^sub>\<infinity>k. coeff p (k + n) = 0"
     by (subst cofinite_eq_sequentially, subst eventually_sequentially_seg,
         subst cofinite_eq_sequentially [symmetric]) transfer
   then have coeff_r [simp]: "coeff r k = coeff p (k + n)" for k
     unfolding r_def by (subst poly.Abs_poly_inverse) simp_all
   have "p = monom 1 n * r"
     by (rule poly_eqI, subst coeff_monom_mult) (simp_all add: zero)
   then show "monom 1 n dvd p" by simp
 qed
 
 
 subsection \<open>Mapping polynomials\<close>
 
 definition map_poly :: "('a :: zero \<Rightarrow> 'b :: zero) \<Rightarrow> 'a poly \<Rightarrow> 'b poly"
   where "map_poly f p = Poly (map f (coeffs p))"
 
 lemma map_poly_0 [simp]: "map_poly f 0 = 0"
   by (simp add: map_poly_def)
 
 lemma map_poly_1: "map_poly f 1 = [:f 1:]"
   by (simp add: map_poly_def)
 
 lemma map_poly_1' [simp]: "f 1 = 1 \<Longrightarrow> map_poly f 1 = 1"
   by (simp add: map_poly_def one_pCons)
 
 lemma coeff_map_poly:
   assumes "f 0 = 0"
   shows "coeff (map_poly f p) n = f (coeff p n)"
   by (auto simp: assms map_poly_def nth_default_def coeffs_def not_less Suc_le_eq coeff_eq_0
       simp del: upt_Suc)
 
 lemma coeffs_map_poly [code abstract]:
   "coeffs (map_poly f p) = strip_while ((=) 0) (map f (coeffs p))"
   by (simp add: map_poly_def)
 
 lemma coeffs_map_poly':
   assumes "\<And>x. x \<noteq> 0 \<Longrightarrow> f x \<noteq> 0"
   shows "coeffs (map_poly f p) = map f (coeffs p)"
   using assms
   by (auto simp add: coeffs_map_poly strip_while_idem_iff
     last_coeffs_eq_coeff_degree no_trailing_unfold last_map)
 
 lemma set_coeffs_map_poly:
   "(\<And>x. f x = 0 \<longleftrightarrow> x = 0) \<Longrightarrow> set (coeffs (map_poly f p)) = f ` set (coeffs p)"
   by (simp add: coeffs_map_poly')
 
 lemma degree_map_poly:
   assumes "\<And>x. x \<noteq> 0 \<Longrightarrow> f x \<noteq> 0"
   shows "degree (map_poly f p) = degree p"
   by (simp add: degree_eq_length_coeffs coeffs_map_poly' assms)
 
 lemma map_poly_eq_0_iff:
   assumes "f 0 = 0" "\<And>x. x \<in> set (coeffs p) \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> f x \<noteq> 0"
   shows "map_poly f p = 0 \<longleftrightarrow> p = 0"
 proof -
   have "(coeff (map_poly f p) n = 0) = (coeff p n = 0)" for n
   proof -
     have "coeff (map_poly f p) n = f (coeff p n)"
       by (simp add: coeff_map_poly assms)
     also have "\<dots> = 0 \<longleftrightarrow> coeff p n = 0"
     proof (cases "n < length (coeffs p)")
       case True
       then have "coeff p n \<in> set (coeffs p)"
         by (auto simp: coeffs_def simp del: upt_Suc)
       with assms show "f (coeff p n) = 0 \<longleftrightarrow> coeff p n = 0"
         by auto
     next
       case False
       then show ?thesis
         by (auto simp: assms length_coeffs nth_default_coeffs_eq [symmetric] nth_default_def)
     qed
     finally show ?thesis .
   qed
   then show ?thesis by (auto simp: poly_eq_iff)
 qed
 
 lemma map_poly_smult:
   assumes "f 0 = 0""\<And>c x. f (c * x) = f c * f x"
   shows "map_poly f (smult c p) = smult (f c) (map_poly f p)"
   by (intro poly_eqI) (simp_all add: assms coeff_map_poly)
 
 lemma map_poly_pCons:
   assumes "f 0 = 0"
   shows "map_poly f (pCons c p) = pCons (f c) (map_poly f p)"
   by (intro poly_eqI) (simp_all add: assms coeff_map_poly coeff_pCons split: nat.splits)
 
 lemma map_poly_map_poly:
   assumes "f 0 = 0" "g 0 = 0"
   shows "map_poly f (map_poly g p) = map_poly (f \<circ> g) p"
   by (intro poly_eqI) (simp add: coeff_map_poly assms)
 
 lemma map_poly_id [simp]: "map_poly id p = p"
   by (simp add: map_poly_def)
 
 lemma map_poly_id' [simp]: "map_poly (\<lambda>x. x) p = p"
   by (simp add: map_poly_def)
 
 lemma map_poly_cong:
   assumes "(\<And>x. x \<in> set (coeffs p) \<Longrightarrow> f x = g x)"
   shows "map_poly f p = map_poly g p"
 proof -
   from assms have "map f (coeffs p) = map g (coeffs p)"
     by (intro map_cong) simp_all
   then show ?thesis
     by (simp only: coeffs_eq_iff coeffs_map_poly)
 qed
 
 lemma map_poly_monom: "f 0 = 0 \<Longrightarrow> map_poly f (monom c n) = monom (f c) n"
   by (intro poly_eqI) (simp_all add: coeff_map_poly)
 
 lemma map_poly_idI:
   assumes "\<And>x. x \<in> set (coeffs p) \<Longrightarrow> f x = x"
   shows "map_poly f p = p"
   using map_poly_cong[OF assms, of _ id] by simp
 
 lemma map_poly_idI':
   assumes "\<And>x. x \<in> set (coeffs p) \<Longrightarrow> f x = x"
   shows "p = map_poly f p"
   using map_poly_cong[OF assms, of _ id] by simp
 
 lemma smult_conv_map_poly: "smult c p = map_poly (\<lambda>x. c * x) p"
   by (intro poly_eqI) (simp_all add: coeff_map_poly)
 
 
 subsection \<open>Conversions\<close>
 
 lemma of_nat_poly:
   "of_nat n = [:of_nat n:]"
   by (induct n) (simp_all add: one_pCons)
 
 lemma of_nat_monom:
   "of_nat n = monom (of_nat n) 0"
   by (simp add: of_nat_poly monom_0)
 
 lemma degree_of_nat [simp]:
   "degree (of_nat n) = 0"
   by (simp add: of_nat_poly)
 
 lemma lead_coeff_of_nat [simp]:
   "lead_coeff (of_nat n) = of_nat n"
   by (simp add: of_nat_poly)
 
 lemma of_int_poly:
   "of_int k = [:of_int k:]"
   by (simp only: of_int_of_nat of_nat_poly) simp
 
 lemma of_int_monom:
   "of_int k = monom (of_int k) 0"
   by (simp add: of_int_poly monom_0)
 
 lemma degree_of_int [simp]:
   "degree (of_int k) = 0"
   by (simp add: of_int_poly)
 
 lemma lead_coeff_of_int [simp]:
   "lead_coeff (of_int k) = of_int k"
   by (simp add: of_int_poly)
 
 lemma numeral_poly: "numeral n = [:numeral n:]"
 proof -
   have "numeral n = of_nat (numeral n)"
     by simp
   also have "\<dots> = [:of_nat (numeral n):]"
     by (simp add: of_nat_poly)
   finally show ?thesis
     by simp
 qed
 
 lemma numeral_monom:
   "numeral n = monom (numeral n) 0"
   by (simp add: numeral_poly monom_0)
 
 lemma degree_numeral [simp]:
   "degree (numeral n) = 0"
   by (simp add: numeral_poly)
 
 lemma lead_coeff_numeral [simp]:
   "lead_coeff (numeral n) = numeral n"
   by (simp add: numeral_poly)
 
 
 subsection \<open>Lemmas about divisibility\<close>
 
 lemma dvd_smult:
   assumes "p dvd q"
   shows "p dvd smult a q"
 proof -
   from assms obtain k where "q = p * k" ..
   then have "smult a q = p * smult a k" by simp
   then show "p dvd smult a q" ..
 qed
 
 lemma dvd_smult_cancel: "p dvd smult a q \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> p dvd q"
   for a :: "'a::field"
   by (drule dvd_smult [where a="inverse a"]) simp
 
 lemma dvd_smult_iff: "a \<noteq> 0 \<Longrightarrow> p dvd smult a q \<longleftrightarrow> p dvd q"
   for a :: "'a::field"
   by (safe elim!: dvd_smult dvd_smult_cancel)
 
 lemma smult_dvd_cancel:
   assumes "smult a p dvd q"
   shows "p dvd q"
 proof -
   from assms obtain k where "q = smult a p * k" ..
   then have "q = p * smult a k" by simp
   then show "p dvd q" ..
 qed
 
 lemma smult_dvd: "p dvd q \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> smult a p dvd q"
   for a :: "'a::field"
   by (rule smult_dvd_cancel [where a="inverse a"]) simp
 
 lemma smult_dvd_iff: "smult a p dvd q \<longleftrightarrow> (if a = 0 then q = 0 else p dvd q)"
   for a :: "'a::field"
   by (auto elim: smult_dvd smult_dvd_cancel)
 
 lemma is_unit_smult_iff: "smult c p dvd 1 \<longleftrightarrow> c dvd 1 \<and> p dvd 1"
 proof -
   have "smult c p = [:c:] * p" by simp
   also have "\<dots> dvd 1 \<longleftrightarrow> c dvd 1 \<and> p dvd 1"
   proof safe
     assume *: "[:c:] * p dvd 1"
     then show "p dvd 1"
       by (rule dvd_mult_right)
     from * obtain q where q: "1 = [:c:] * p * q"
       by (rule dvdE)
     have "c dvd c * (coeff p 0 * coeff q 0)"
       by simp
     also have "\<dots> = coeff ([:c:] * p * q) 0"
       by (simp add: mult.assoc coeff_mult)
     also note q [symmetric]
     finally have "c dvd coeff 1 0" .
     then show "c dvd 1" by simp
   next
     assume "c dvd 1" "p dvd 1"
     from this(1) obtain d where "1 = c * d"
       by (rule dvdE)
     then have "1 = [:c:] * [:d:]"
       by (simp add: one_pCons ac_simps)
     then have "[:c:] dvd 1"
       by (rule dvdI)
     from mult_dvd_mono[OF this \<open>p dvd 1\<close>] show "[:c:] * p dvd 1"
       by simp
   qed
   finally show ?thesis .
 qed
 
 
 subsection \<open>Polynomials form an integral domain\<close>
 
 instance poly :: (idom) idom ..
 
 instance poly :: ("{ring_char_0, comm_ring_1}") ring_char_0
   by standard (auto simp add: of_nat_poly intro: injI)
 
 lemma degree_mult_eq: "p \<noteq> 0 \<Longrightarrow> q \<noteq> 0 \<Longrightarrow> degree (p * q) = degree p + degree q"
   for p q :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
   by (rule order_antisym [OF degree_mult_le le_degree]) (simp add: coeff_mult_degree_sum)
 
+lemma degree_prod_eq_sum_degree:
+  fixes A :: "'a set"
+  and f :: "'a \<Rightarrow> 'b::idom poly"
+  assumes f0: "\<forall>i\<in>A. f i \<noteq> 0"
+  shows "degree (\<Prod>i\<in>A. (f i)) = (\<Sum>i\<in>A. degree (f i))"
+  using assms
+  by (induction A rule: infinite_finite_induct) (auto simp: degree_mult_eq)
+
 lemma degree_mult_eq_0:
   "degree (p * q) = 0 \<longleftrightarrow> p = 0 \<or> q = 0 \<or> (p \<noteq> 0 \<and> q \<noteq> 0 \<and> degree p = 0 \<and> degree q = 0)"
   for p q :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
   by (auto simp: degree_mult_eq)
 
 lemma degree_power_eq: "p \<noteq> 0 \<Longrightarrow> degree ((p :: 'a :: idom poly) ^ n) = n * degree p"
   by (induction n) (simp_all add: degree_mult_eq)
 
 lemma degree_mult_right_le:
   fixes p q :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
   assumes "q \<noteq> 0"
   shows "degree p \<le> degree (p * q)"
   using assms by (cases "p = 0") (simp_all add: degree_mult_eq)
 
 lemma coeff_degree_mult: "coeff (p * q) (degree (p * q)) = coeff q (degree q) * coeff p (degree p)"
   for p q :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
   by (cases "p = 0 \<or> q = 0") (auto simp: degree_mult_eq coeff_mult_degree_sum mult_ac)
 
 lemma dvd_imp_degree_le: "p dvd q \<Longrightarrow> q \<noteq> 0 \<Longrightarrow> degree p \<le> degree q"
   for p q :: "'a::{comm_semiring_1,semiring_no_zero_divisors} poly"
   by (erule dvdE, hypsubst, subst degree_mult_eq) auto
 
 lemma divides_degree:
   fixes p q :: "'a ::{comm_semiring_1,semiring_no_zero_divisors} poly"
   assumes "p dvd q"
   shows "degree p \<le> degree q \<or> q = 0"
   by (metis dvd_imp_degree_le assms)
 
 lemma const_poly_dvd_iff:
   fixes c :: "'a::{comm_semiring_1,semiring_no_zero_divisors}"
   shows "[:c:] dvd p \<longleftrightarrow> (\<forall>n. c dvd coeff p n)"
 proof (cases "c = 0 \<or> p = 0")
   case True
   then show ?thesis
     by (auto intro!: poly_eqI)
 next
   case False
   show ?thesis
   proof
     assume "[:c:] dvd p"
     then show "\<forall>n. c dvd coeff p n"
       by (auto elim!: dvdE simp: coeffs_def)
   next
     assume *: "\<forall>n. c dvd coeff p n"
     define mydiv where "mydiv x y = (SOME z. x = y * z)" for x y :: 'a
     have mydiv: "x = y * mydiv x y" if "y dvd x" for x y
       using that unfolding mydiv_def dvd_def by (rule someI_ex)
     define q where "q = Poly (map (\<lambda>a. mydiv a c) (coeffs p))"
     from False * have "p = q * [:c:]"
       by (intro poly_eqI)
         (auto simp: q_def nth_default_def not_less length_coeffs_degree coeffs_nth
           intro!: coeff_eq_0 mydiv)
     then show "[:c:] dvd p"
       by (simp only: dvd_triv_right)
   qed
 qed
 
 lemma const_poly_dvd_const_poly_iff [simp]: "[:a:] dvd [:b:] \<longleftrightarrow> a dvd b"
   for a b :: "'a::{comm_semiring_1,semiring_no_zero_divisors}"
   by (subst const_poly_dvd_iff) (auto simp: coeff_pCons split: nat.splits)
 
 lemma lead_coeff_mult: "lead_coeff (p * q) = lead_coeff p * lead_coeff q"
   for p q :: "'a::{comm_semiring_0, semiring_no_zero_divisors} poly"
   by (cases "p = 0 \<or> q = 0") (auto simp: coeff_mult_degree_sum degree_mult_eq)
 
+lemma lead_coeff_prod: "lead_coeff (prod f A) = (\<Prod>x\<in>A. lead_coeff (f x))"
+  for f :: "'a \<Rightarrow> 'b::{comm_semiring_1, semiring_no_zero_divisors} poly"
+  by (induction A rule: infinite_finite_induct) (auto simp: lead_coeff_mult)
+
 lemma lead_coeff_smult: "lead_coeff (smult c p) = c * lead_coeff p"
   for p :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
 proof -
   have "smult c p = [:c:] * p" by simp
   also have "lead_coeff \<dots> = c * lead_coeff p"
     by (subst lead_coeff_mult) simp_all
   finally show ?thesis .
 qed
 
 lemma lead_coeff_1 [simp]: "lead_coeff 1 = 1"
   by simp
 
 lemma lead_coeff_power: "lead_coeff (p ^ n) = lead_coeff p ^ n"
   for p :: "'a::{comm_semiring_1,semiring_no_zero_divisors} poly"
   by (induct n) (simp_all add: lead_coeff_mult)
 
 
 subsection \<open>Polynomials form an ordered integral domain\<close>
 
 definition pos_poly :: "'a::linordered_semidom poly \<Rightarrow> bool"
   where "pos_poly p \<longleftrightarrow> 0 < coeff p (degree p)"
 
 lemma pos_poly_pCons: "pos_poly (pCons a p) \<longleftrightarrow> pos_poly p \<or> (p = 0 \<and> 0 < a)"
   by (simp add: pos_poly_def)
 
 lemma not_pos_poly_0 [simp]: "\<not> pos_poly 0"
   by (simp add: pos_poly_def)
 
 lemma pos_poly_add: "pos_poly p \<Longrightarrow> pos_poly q \<Longrightarrow> pos_poly (p + q)"
 proof (induction p arbitrary: q)
   case (pCons a p)
   then show ?case 
     by (cases q; force simp add: pos_poly_pCons add_pos_pos)
 qed auto
 
 lemma pos_poly_mult: "pos_poly p \<Longrightarrow> pos_poly q \<Longrightarrow> pos_poly (p * q)"
   by (simp add: pos_poly_def coeff_degree_mult)
 
 lemma pos_poly_total: "p = 0 \<or> pos_poly p \<or> pos_poly (- p)"
   for p :: "'a::linordered_idom poly"
   by (induct p) (auto simp: pos_poly_pCons)
 
 lemma pos_poly_coeffs [code]: "pos_poly p \<longleftrightarrow> (let as = coeffs p in as \<noteq> [] \<and> last as > 0)"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?rhs
   then show ?lhs
     by (auto simp add: pos_poly_def last_coeffs_eq_coeff_degree)
 next
   assume ?lhs
   then have *: "0 < coeff p (degree p)"
     by (simp add: pos_poly_def)
   then have "p \<noteq> 0"
     by auto
   with * show ?rhs
     by (simp add: last_coeffs_eq_coeff_degree)
 qed
 
 instantiation poly :: (linordered_idom) linordered_idom
 begin
 
 definition "x < y \<longleftrightarrow> pos_poly (y - x)"
 
 definition "x \<le> y \<longleftrightarrow> x = y \<or> pos_poly (y - x)"
 
 definition "\<bar>x::'a poly\<bar> = (if x < 0 then - x else x)"
 
 definition "sgn (x::'a poly) = (if x = 0 then 0 else if 0 < x then 1 else - 1)"
 
 instance
 proof
   fix x y z :: "'a poly"
   show "x < y \<longleftrightarrow> x \<le> y \<and> \<not> y \<le> x"
     unfolding less_eq_poly_def less_poly_def
     using pos_poly_add by force
   then show "x \<le> y \<Longrightarrow> y \<le> x \<Longrightarrow> x = y"
     using less_eq_poly_def less_poly_def by force
   show "x \<le> x"
     by (simp add: less_eq_poly_def)
   show "x \<le> y \<Longrightarrow> y \<le> z \<Longrightarrow> x \<le> z"
     using less_eq_poly_def pos_poly_add by fastforce
   show "x \<le> y \<Longrightarrow> z + x \<le> z + y"
     by (simp add: less_eq_poly_def)
   show "x \<le> y \<or> y \<le> x"
     unfolding less_eq_poly_def
     using pos_poly_total [of "x - y"]
     by auto
   show "x < y \<Longrightarrow> 0 < z \<Longrightarrow> z * x < z * y"
     by (simp add: less_poly_def right_diff_distrib [symmetric] pos_poly_mult)
   show "\<bar>x\<bar> = (if x < 0 then - x else x)"
     by (rule abs_poly_def)
   show "sgn x = (if x = 0 then 0 else if 0 < x then 1 else - 1)"
     by (rule sgn_poly_def)
 qed
 
 end
 
 text \<open>TODO: Simplification rules for comparisons\<close>
 
 
 subsection \<open>Synthetic division and polynomial roots\<close>
 
 subsubsection \<open>Synthetic division\<close>
 
 text \<open>Synthetic division is simply division by the linear polynomial \<^term>\<open>x - c\<close>.\<close>
 
 definition synthetic_divmod :: "'a::comm_semiring_0 poly \<Rightarrow> 'a \<Rightarrow> 'a poly \<times> 'a"
   where "synthetic_divmod p c = fold_coeffs (\<lambda>a (q, r). (pCons r q, a + c * r)) p (0, 0)"
 
 definition synthetic_div :: "'a::comm_semiring_0 poly \<Rightarrow> 'a \<Rightarrow> 'a poly"
   where "synthetic_div p c = fst (synthetic_divmod p c)"
 
 lemma synthetic_divmod_0 [simp]: "synthetic_divmod 0 c = (0, 0)"
   by (simp add: synthetic_divmod_def)
 
 lemma synthetic_divmod_pCons [simp]:
   "synthetic_divmod (pCons a p) c = (\<lambda>(q, r). (pCons r q, a + c * r)) (synthetic_divmod p c)"
   by (cases "p = 0 \<and> a = 0") (auto simp add: synthetic_divmod_def)
 
 lemma synthetic_div_0 [simp]: "synthetic_div 0 c = 0"
   by (simp add: synthetic_div_def)
 
 lemma synthetic_div_unique_lemma: "smult c p = pCons a p \<Longrightarrow> p = 0"
   by (induct p arbitrary: a) simp_all
 
 lemma snd_synthetic_divmod: "snd (synthetic_divmod p c) = poly p c"
   by (induct p) (simp_all add: split_def)
 
 lemma synthetic_div_pCons [simp]:
   "synthetic_div (pCons a p) c = pCons (poly p c) (synthetic_div p c)"
   by (simp add: synthetic_div_def split_def snd_synthetic_divmod)
 
 lemma synthetic_div_eq_0_iff: "synthetic_div p c = 0 \<longleftrightarrow> degree p = 0"
 proof (induct p)
   case 0
   then show ?case by simp
 next
   case (pCons a p)
   then show ?case by (cases p) simp
 qed
 
 lemma degree_synthetic_div: "degree (synthetic_div p c) = degree p - 1"
   by (induct p) (simp_all add: synthetic_div_eq_0_iff)
 
 lemma synthetic_div_correct:
   "p + smult c (synthetic_div p c) = pCons (poly p c) (synthetic_div p c)"
   by (induct p) simp_all
 
 lemma synthetic_div_unique: "p + smult c q = pCons r q \<Longrightarrow> r = poly p c \<and> q = synthetic_div p c"
 proof (induction p arbitrary: q r)
   case 0
   then show ?case
     using synthetic_div_unique_lemma by fastforce
 next
   case (pCons a p)
   then show ?case
     by (cases q; force)
 qed
 
 lemma synthetic_div_correct': "[:-c, 1:] * synthetic_div p c + [:poly p c:] = p"
   for c :: "'a::comm_ring_1"
   using synthetic_div_correct [of p c] by (simp add: algebra_simps)
 
 
 subsubsection \<open>Polynomial roots\<close>
 
 lemma poly_eq_0_iff_dvd: "poly p c = 0 \<longleftrightarrow> [:- c, 1:] dvd p"
   (is "?lhs \<longleftrightarrow> ?rhs")
   for c :: "'a::comm_ring_1"
 proof
   assume ?lhs
   with synthetic_div_correct' [of c p] have "p = [:-c, 1:] * synthetic_div p c" by simp
   then show ?rhs ..
 next
   assume ?rhs
   then obtain k where "p = [:-c, 1:] * k" by (rule dvdE)
   then show ?lhs by simp
 qed
 
 lemma dvd_iff_poly_eq_0: "[:c, 1:] dvd p \<longleftrightarrow> poly p (- c) = 0"
   for c :: "'a::comm_ring_1"
   by (simp add: poly_eq_0_iff_dvd)
 
 lemma poly_roots_finite: "p \<noteq> 0 \<Longrightarrow> finite {x. poly p x = 0}"
   for p :: "'a::{comm_ring_1,ring_no_zero_divisors} poly"
 proof (induct n \<equiv> "degree p" arbitrary: p)
   case 0
   then obtain a where "a \<noteq> 0" and "p = [:a:]"
     by (cases p) (simp split: if_splits)
   then show "finite {x. poly p x = 0}"
     by simp
 next
   case (Suc n)
   show "finite {x. poly p x = 0}"
   proof (cases "\<exists>x. poly p x = 0")
     case False
     then show "finite {x. poly p x = 0}" by simp
   next
     case True
     then obtain a where "poly p a = 0" ..
     then have "[:-a, 1:] dvd p"
       by (simp only: poly_eq_0_iff_dvd)
     then obtain k where k: "p = [:-a, 1:] * k" ..
     with \<open>p \<noteq> 0\<close> have "k \<noteq> 0"
       by auto
     with k have "degree p = Suc (degree k)"
       by (simp add: degree_mult_eq del: mult_pCons_left)
     with \<open>Suc n = degree p\<close> have "n = degree k"
       by simp
     from this \<open>k \<noteq> 0\<close> have "finite {x. poly k x = 0}"
       by (rule Suc.hyps)
     then have "finite (insert a {x. poly k x = 0})"
       by simp
     then show "finite {x. poly p x = 0}"
       by (simp add: k Collect_disj_eq del: mult_pCons_left)
   qed
 qed
 
 lemma poly_eq_poly_eq_iff: "poly p = poly q \<longleftrightarrow> p = q"
   (is "?lhs \<longleftrightarrow> ?rhs")
   for p q :: "'a::{comm_ring_1,ring_no_zero_divisors,ring_char_0} poly"
 proof
   assume ?rhs
   then show ?lhs by simp
 next
   assume ?lhs
   have "poly p = poly 0 \<longleftrightarrow> p = 0" for p :: "'a poly"
   proof (cases "p = 0")
     case False
     then show ?thesis
       by (auto simp add: infinite_UNIV_char_0 dest: poly_roots_finite)
   qed auto
   from \<open>?lhs\<close> and this [of "p - q"] show ?rhs
     by auto
 qed
 
 lemma poly_all_0_iff_0: "(\<forall>x. poly p x = 0) \<longleftrightarrow> p = 0"
   for p :: "'a::{ring_char_0,comm_ring_1,ring_no_zero_divisors} poly"
   by (auto simp add: poly_eq_poly_eq_iff [symmetric])
 
 
 subsubsection \<open>Order of polynomial roots\<close>
 
 definition order :: "'a::idom \<Rightarrow> 'a poly \<Rightarrow> nat"
   where "order a p = (LEAST n. \<not> [:-a, 1:] ^ Suc n dvd p)"
 
 lemma coeff_linear_power: "coeff ([:a, 1:] ^ n) n = 1"
   for a :: "'a::comm_semiring_1"
 proof (induct n)
   case (Suc n)
   have "degree ([:a, 1:] ^ n) \<le> 1 * n"
     by (metis One_nat_def degree_pCons_eq_if degree_power_le one_neq_zero one_pCons)
   then have "coeff ([:a, 1:] ^ n) (Suc n) = 0"
     by (simp add: coeff_eq_0)
   then show ?case
     using Suc.hyps by fastforce
 qed auto
 
 lemma degree_linear_power: "degree ([:a, 1:] ^ n) = n"
   for a :: "'a::comm_semiring_1"
 proof (rule order_antisym)
   show "degree ([:a, 1:] ^ n) \<le> n"
     by (metis One_nat_def degree_pCons_eq_if degree_power_le mult.left_neutral one_neq_zero one_pCons)
 qed (simp add: coeff_linear_power le_degree)
 
 lemma order_1: "[:-a, 1:] ^ order a p dvd p"
 proof (cases "p = 0")
   case False
   show ?thesis 
   proof (cases "order a p")
     case (Suc n)
     then show ?thesis
       by (metis lessI not_less_Least order_def)
   qed auto
 qed auto
 
 lemma order_2: 
   assumes "p \<noteq> 0" 
   shows "\<not> [:-a, 1:] ^ Suc (order a p) dvd p"
 proof -
   have False if "[:- a, 1:] ^ Suc (degree p) dvd p"
     using dvd_imp_degree_le [OF that]
     by (metis Suc_n_not_le_n assms degree_linear_power)
   then show ?thesis
     unfolding order_def
     by (metis (no_types, lifting) LeastI)
 qed
 
 lemma order: "p \<noteq> 0 \<Longrightarrow> [:-a, 1:] ^ order a p dvd p \<and> \<not> [:-a, 1:] ^ Suc (order a p) dvd p"
   by (rule conjI [OF order_1 order_2])
 
 lemma order_degree:
   assumes p: "p \<noteq> 0"
   shows "order a p \<le> degree p"
 proof -
   have "order a p = degree ([:-a, 1:] ^ order a p)"
     by (simp only: degree_linear_power)
   also from order_1 p have "\<dots> \<le> degree p"
     by (rule dvd_imp_degree_le)
   finally show ?thesis .
 qed
 
 lemma order_root: "poly p a = 0 \<longleftrightarrow> p = 0 \<or> order a p \<noteq> 0" (is "?lhs = ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     by (metis One_nat_def order_2 poly_eq_0_iff_dvd power_one_right)
   show "?rhs \<Longrightarrow> ?lhs"
     by (meson dvd_power dvd_trans neq0_conv order_1 poly_0 poly_eq_0_iff_dvd)
 qed
 
 lemma order_0I: "poly p a \<noteq> 0 \<Longrightarrow> order a p = 0"
   by (subst (asm) order_root) auto
 
 lemma order_unique_lemma:
   fixes p :: "'a::idom poly"
   assumes "[:-a, 1:] ^ n dvd p" "\<not> [:-a, 1:] ^ Suc n dvd p"
   shows "order a p = n"
   unfolding Polynomial.order_def
   by (metis (mono_tags, lifting) Least_equality assms not_less_eq_eq power_le_dvd)
 
 lemma order_mult: 
   assumes "p * q \<noteq> 0" shows "order a (p * q) = order a p + order a q"
 proof -
   define i where "i \<equiv> order a p"
   define j where "j \<equiv> order a q"
   define t where "t \<equiv> [:-a, 1:]"
   have t_dvd_iff: "\<And>u. t dvd u \<longleftrightarrow> poly u a = 0"
     by (simp add: t_def dvd_iff_poly_eq_0)
   have dvd: "t ^ i dvd p" "t ^ j dvd q" and "\<not> t ^ Suc i dvd p" "\<not> t ^ Suc j dvd q"
     using assms i_def j_def order_1 order_2 t_def by auto
   then have "\<not> t ^ Suc(i + j) dvd p * q"
     by (elim dvdE) (simp add: power_add t_dvd_iff)
   moreover have "t ^ (i + j) dvd p * q"
     using dvd by (simp add: mult_dvd_mono power_add)
   ultimately show "order a (p * q) = i + j"
     using order_unique_lemma t_def by blast
 qed
 
 
 lemma order_smult:
   assumes "c \<noteq> 0"
   shows "order x (smult c p) = order x p"
 proof (cases "p = 0")
   case True
   then show ?thesis
     by simp
 next
   case False
   have "smult c p = [:c:] * p" by simp
   also from assms False have "order x \<dots> = order x [:c:] + order x p"
     by (subst order_mult) simp_all
   also have "order x [:c:] = 0"
     by (rule order_0I) (use assms in auto)
   finally show ?thesis
     by simp
 qed
 
 text \<open>Next three lemmas contributed by Wenda Li\<close>
 lemma order_1_eq_0 [simp]:"order x 1 = 0"
   by (metis order_root poly_1 zero_neq_one)
 
 lemma order_uminus[simp]: "order x (-p) = order x p"
   by (metis neg_equal_0_iff_equal order_smult smult_1_left smult_minus_left) 
 
 lemma order_power_n_n: "order a ([:-a,1:]^n)=n"
 proof (induct n) (*might be proved more concisely using nat_less_induct*)
   case 0
   then show ?case
     by (metis order_root poly_1 power_0 zero_neq_one)
 next
   case (Suc n)
   have "order a ([:- a, 1:] ^ Suc n) = order a ([:- a, 1:] ^ n) + order a [:-a,1:]"
     by (metis (no_types, hide_lams) One_nat_def add_Suc_right monoid_add_class.add.right_neutral
       one_neq_zero order_mult pCons_eq_0_iff power_add power_eq_0_iff power_one_right)
   moreover have "order a [:-a,1:] = 1"
     unfolding order_def
   proof (rule Least_equality, rule notI)
     assume "[:- a, 1:] ^ Suc 1 dvd [:- a, 1:]"
     then have "degree ([:- a, 1:] ^ Suc 1) \<le> degree ([:- a, 1:])"
       by (rule dvd_imp_degree_le) auto
     then show False
       by auto
   next
     fix y
     assume *: "\<not> [:- a, 1:] ^ Suc y dvd [:- a, 1:]"
     show "1 \<le> y"
     proof (rule ccontr)
       assume "\<not> 1 \<le> y"
       then have "y = 0" by auto
       then have "[:- a, 1:] ^ Suc y dvd [:- a, 1:]" by auto
       with * show False by auto
     qed
   qed
   ultimately show ?case
     using Suc by auto
 qed
 
 lemma order_0_monom [simp]: "c \<noteq> 0 \<Longrightarrow> order 0 (monom c n) = n"
   using order_power_n_n[of 0 n] by (simp add: monom_altdef order_smult)
 
 lemma dvd_imp_order_le: "q \<noteq> 0 \<Longrightarrow> p dvd q \<Longrightarrow> Polynomial.order a p \<le> Polynomial.order a q"
   by (auto simp: order_mult elim: dvdE)
 
 text \<open>Now justify the standard squarefree decomposition, i.e. \<open>f / gcd f f'\<close>.\<close>
 
 lemma order_divides: "[:-a, 1:] ^ n dvd p \<longleftrightarrow> p = 0 \<or> n \<le> order a p"
   by (meson dvd_0_right not_less_eq_eq order_1 order_2 power_le_dvd)
 
 lemma order_decomp:
   assumes "p \<noteq> 0"
   shows "\<exists>q. p = [:- a, 1:] ^ order a p * q \<and> \<not> [:- a, 1:] dvd q"
 proof -
   from assms have *: "[:- a, 1:] ^ order a p dvd p"
     and **: "\<not> [:- a, 1:] ^ Suc (order a p) dvd p"
     by (auto dest: order)
   from * obtain q where q: "p = [:- a, 1:] ^ order a p * q" ..
   with ** have "\<not> [:- a, 1:] ^ Suc (order a p) dvd [:- a, 1:] ^ order a p * q"
     by simp
   then have "\<not> [:- a, 1:] ^ order a p * [:- a, 1:] dvd [:- a, 1:] ^ order a p * q"
     by simp
   with idom_class.dvd_mult_cancel_left [of "[:- a, 1:] ^ order a p" "[:- a, 1:]" q]
   have "\<not> [:- a, 1:] dvd q" by auto
   with q show ?thesis by blast
 qed
 
 lemma monom_1_dvd_iff: "p \<noteq> 0 \<Longrightarrow> monom 1 n dvd p \<longleftrightarrow> n \<le> order 0 p"
   using order_divides[of 0 n p] by (simp add: monom_altdef)
 
 
 subsection \<open>Additional induction rules on polynomials\<close>
 
 text \<open>
   An induction rule for induction over the roots of a polynomial with a certain property.
   (e.g. all positive roots)
 \<close>
 lemma poly_root_induct [case_names 0 no_roots root]:
   fixes p :: "'a :: idom poly"
   assumes "Q 0"
     and "\<And>p. (\<And>a. P a \<Longrightarrow> poly p a \<noteq> 0) \<Longrightarrow> Q p"
     and "\<And>a p. P a \<Longrightarrow> Q p \<Longrightarrow> Q ([:a, -1:] * p)"
   shows "Q p"
 proof (induction "degree p" arbitrary: p rule: less_induct)
   case (less p)
   show ?case
   proof (cases "p = 0")
     case True
     with assms(1) show ?thesis by simp
   next
     case False
     show ?thesis
     proof (cases "\<exists>a. P a \<and> poly p a = 0")
       case False
       then show ?thesis by (intro assms(2)) blast
     next
       case True
       then obtain a where a: "P a" "poly p a = 0"
         by blast
       then have "-[:-a, 1:] dvd p"
         by (subst minus_dvd_iff) (simp add: poly_eq_0_iff_dvd)
       then obtain q where q: "p = [:a, -1:] * q" by (elim dvdE) simp
       with False have "q \<noteq> 0" by auto
       have "degree p = Suc (degree q)"
         by (subst q, subst degree_mult_eq) (simp_all add: \<open>q \<noteq> 0\<close>)
       then have "Q q" by (intro less) simp
       with a(1) have "Q ([:a, -1:] * q)"
         by (rule assms(3))
       with q show ?thesis by simp
     qed
   qed
 qed
 
 lemma dropWhile_replicate_append:
   "dropWhile ((=) a) (replicate n a @ ys) = dropWhile ((=) a) ys"
   by (induct n) simp_all
 
 lemma Poly_append_replicate_0: "Poly (xs @ replicate n 0) = Poly xs"
   by (subst coeffs_eq_iff) (simp_all add: strip_while_def dropWhile_replicate_append)
 
 text \<open>
   An induction rule for simultaneous induction over two polynomials,
   prepending one coefficient in each step.
 \<close>
 lemma poly_induct2 [case_names 0 pCons]:
   assumes "P 0 0" "\<And>a p b q. P p q \<Longrightarrow> P (pCons a p) (pCons b q)"
   shows "P p q"
 proof -
   define n where "n = max (length (coeffs p)) (length (coeffs q))"
   define xs where "xs = coeffs p @ (replicate (n - length (coeffs p)) 0)"
   define ys where "ys = coeffs q @ (replicate (n - length (coeffs q)) 0)"
   have "length xs = length ys"
     by (simp add: xs_def ys_def n_def)
   then have "P (Poly xs) (Poly ys)"
     by (induct rule: list_induct2) (simp_all add: assms)
   also have "Poly xs = p"
     by (simp add: xs_def Poly_append_replicate_0)
   also have "Poly ys = q"
     by (simp add: ys_def Poly_append_replicate_0)
   finally show ?thesis .
 qed
 
 
 subsection \<open>Composition of polynomials\<close>
 
 (* Several lemmas contributed by René Thiemann and Akihisa Yamada *)
 
 definition pcompose :: "'a::comm_semiring_0 poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   where "pcompose p q = fold_coeffs (\<lambda>a c. [:a:] + q * c) p 0"
 
 notation pcompose (infixl "\<circ>\<^sub>p" 71)
 
 lemma pcompose_0 [simp]: "pcompose 0 q = 0"
   by (simp add: pcompose_def)
 
 lemma pcompose_pCons: "pcompose (pCons a p) q = [:a:] + q * pcompose p q"
   by (cases "p = 0 \<and> a = 0") (auto simp add: pcompose_def)
 
 lemma pcompose_1: "pcompose 1 p = 1"
   for p :: "'a::comm_semiring_1 poly"
   by (auto simp: one_pCons pcompose_pCons)
 
 lemma poly_pcompose: "poly (pcompose p q) x = poly p (poly q x)"
   by (induct p) (simp_all add: pcompose_pCons)
 
 lemma degree_pcompose_le: "degree (pcompose p q) \<le> degree p * degree q"
 proof (induction p)
   case (pCons a p)
   then show ?case
   proof (clarsimp simp add: pcompose_pCons)
     assume "degree (p \<circ>\<^sub>p q) \<le> degree p * degree q" "p \<noteq> 0"
     then have "degree (q * p \<circ>\<^sub>p q) \<le> degree q + degree p * degree q"
       by (meson add_le_cancel_left degree_mult_le dual_order.trans pCons.IH)
     then show "degree ([:a:] + q * p \<circ>\<^sub>p q) \<le> degree q + degree p * degree q"
       by (simp add: degree_add_le)
   qed
 qed auto
 
 lemma pcompose_add: "pcompose (p + q) r = pcompose p r + pcompose q r"
   for p q r :: "'a::{comm_semiring_0, ab_semigroup_add} poly"
 proof (induction p q rule: poly_induct2)
   case 0
   then show ?case by simp
 next
   case (pCons a p b q)
   have "pcompose (pCons a p + pCons b q) r = [:a + b:] + r * pcompose p r + r * pcompose q r"
     by (simp_all add: pcompose_pCons pCons.IH algebra_simps)
   also have "[:a + b:] = [:a:] + [:b:]" by simp
   also have "\<dots> + r * pcompose p r + r * pcompose q r = pcompose (pCons a p) r + pcompose (pCons b q) r"
     by (simp only: pcompose_pCons add_ac)
   finally show ?case .
 qed
 
 lemma pcompose_uminus: "pcompose (-p) r = -pcompose p r"
   for p r :: "'a::comm_ring poly"
   by (induct p) (simp_all add: pcompose_pCons)
 
 lemma pcompose_diff: "pcompose (p - q) r = pcompose p r - pcompose q r"
   for p q r :: "'a::comm_ring poly"
   using pcompose_add[of p "-q"] by (simp add: pcompose_uminus)
 
 lemma pcompose_smult: "pcompose (smult a p) r = smult a (pcompose p r)"
   for p r :: "'a::comm_semiring_0 poly"
   by (induct p) (simp_all add: pcompose_pCons pcompose_add smult_add_right)
 
 lemma pcompose_mult: "pcompose (p * q) r = pcompose p r * pcompose q r"
   for p q r :: "'a::comm_semiring_0 poly"
   by (induct p arbitrary: q) (simp_all add: pcompose_add pcompose_smult pcompose_pCons algebra_simps)
 
 lemma pcompose_assoc: "pcompose p (pcompose q r) = pcompose (pcompose p q) r"
   for p q r :: "'a::comm_semiring_0 poly"
   by (induct p arbitrary: q) (simp_all add: pcompose_pCons pcompose_add pcompose_mult)
 
 lemma pcompose_idR[simp]: "pcompose p [: 0, 1 :] = p"
   for p :: "'a::comm_semiring_1 poly"
   by (induct p) (simp_all add: pcompose_pCons)
 
 lemma pcompose_sum: "pcompose (sum f A) p = sum (\<lambda>i. pcompose (f i) p) A"
   by (induct A rule: infinite_finite_induct) (simp_all add: pcompose_1 pcompose_add)
 
 lemma pcompose_prod: "pcompose (prod f A) p = prod (\<lambda>i. pcompose (f i) p) A"
   by (induct A rule: infinite_finite_induct) (simp_all add: pcompose_1 pcompose_mult)
 
 lemma pcompose_const [simp]: "pcompose [:a:] q = [:a:]"
   by (subst pcompose_pCons) simp
 
 lemma pcompose_0': "pcompose p 0 = [:coeff p 0:]"
   by (induct p) (auto simp add: pcompose_pCons)
 
 lemma degree_pcompose: "degree (pcompose p q) = degree p * degree q"
   for p q :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
 proof (induct p)
   case 0
   then show ?case by auto
 next
   case (pCons a p)
   consider "degree (q * pcompose p q) = 0" | "degree (q * pcompose p q) > 0"
     by blast
   then show ?case
   proof cases
     case prems: 1
     show ?thesis
     proof (cases "p = 0")
       case True
       then show ?thesis by auto
     next
       case False
       from prems have "degree q = 0 \<or> pcompose p q = 0"
         by (auto simp add: degree_mult_eq_0)
       moreover have False if "pcompose p q = 0" "degree q \<noteq> 0"
       proof -
         from pCons.hyps(2) that have "degree p = 0"
           by auto
         then obtain a1 where "p = [:a1:]"
           by (metis degree_pCons_eq_if old.nat.distinct(2) pCons_cases)
         with \<open>pcompose p q = 0\<close> \<open>p \<noteq> 0\<close> show False
           by auto
       qed
       ultimately have "degree (pCons a p) * degree q = 0"
         by auto
       moreover have "degree (pcompose (pCons a p) q) = 0"
       proof -
         from prems have "0 = max (degree [:a:]) (degree (q * pcompose p q))"
           by simp
         also have "\<dots> \<ge> degree ([:a:] + q * pcompose p q)"
           by (rule degree_add_le_max)
         finally show ?thesis
           by (auto simp add: pcompose_pCons)
       qed
       ultimately show ?thesis by simp
     qed
   next
     case prems: 2
     then have "p \<noteq> 0" "q \<noteq> 0" "pcompose p q \<noteq> 0"
       by auto
     from prems degree_add_eq_right [of "[:a:]"]
     have "degree (pcompose (pCons a p) q) = degree (q * pcompose p q)"
       by (auto simp: pcompose_pCons)
     with pCons.hyps(2) degree_mult_eq[OF \<open>q\<noteq>0\<close> \<open>pcompose p q\<noteq>0\<close>] show ?thesis
       by auto
   qed
 qed
 
 lemma pcompose_eq_0:
   fixes p q :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
   assumes "pcompose p q = 0" "degree q > 0"
   shows "p = 0"
 proof -
   from assms degree_pcompose [of p q] have "degree p = 0"
     by auto
   then obtain a where "p = [:a:]"
     by (metis degree_pCons_eq_if gr0_conv_Suc neq0_conv pCons_cases)
   with assms(1) have "a = 0"
     by auto
   with \<open>p = [:a:]\<close> show ?thesis
     by simp
 qed
 
 lemma lead_coeff_comp:
   fixes p q :: "'a::{comm_semiring_1,semiring_no_zero_divisors} poly"
   assumes "degree q > 0"
   shows "lead_coeff (pcompose p q) = lead_coeff p * lead_coeff q ^ (degree p)"
 proof (induct p)
   case 0
   then show ?case by auto
 next
   case (pCons a p)
   consider "degree (q * pcompose p q) = 0" | "degree (q * pcompose p q) > 0"
     by blast
   then show ?case
   proof cases
     case prems: 1
     then have "pcompose p q = 0"
       by (metis assms degree_0 degree_mult_eq_0 neq0_conv)
     with pcompose_eq_0[OF _ \<open>degree q > 0\<close>] have "p = 0"
       by simp
     then show ?thesis
       by auto
   next
     case prems: 2
     then have "degree [:a:] < degree (q * pcompose p q)"
       by simp
     then have "lead_coeff ([:a:] + q * p \<circ>\<^sub>p q) = lead_coeff (q * p \<circ>\<^sub>p q)"
       by (rule lead_coeff_add_le)
     then have "lead_coeff (pcompose (pCons a p) q) = lead_coeff (q * pcompose p q)"
       by (simp add: pcompose_pCons)
     also have "\<dots> = lead_coeff q * (lead_coeff p * lead_coeff q ^ degree p)"
       using pCons.hyps(2) lead_coeff_mult[of q "pcompose p q"] by simp
     also have "\<dots> = lead_coeff p * lead_coeff q ^ (degree p + 1)"
       by (auto simp: mult_ac)
     finally show ?thesis by auto
   qed
 qed
 
 
+subsection \<open>Closure properties of coefficients\<close>
+
+
+context
+  fixes R :: "'a :: comm_semiring_1 set"
+  assumes R_0: "0 \<in> R"
+  assumes R_plus: "\<And>x y. x \<in> R \<Longrightarrow> y \<in> R \<Longrightarrow> x + y \<in> R"
+  assumes R_mult: "\<And>x y. x \<in> R \<Longrightarrow> y \<in> R \<Longrightarrow> x * y \<in> R"
+begin
+
+lemma coeff_mult_semiring_closed:
+  assumes "\<And>i. coeff p i \<in> R" "\<And>i. coeff q i \<in> R"
+  shows   "coeff (p * q) i \<in> R"
+proof -
+  have R_sum: "sum f A \<in> R" if "\<And>x. x \<in> A \<Longrightarrow> f x \<in> R" for A and f :: "nat \<Rightarrow> 'a"
+    using that by (induction A rule: infinite_finite_induct) (auto intro: R_0 R_plus)
+  show ?thesis
+    unfolding coeff_mult by (auto intro!: R_sum R_mult assms)
+qed
+
+lemma coeff_pcompose_semiring_closed:
+  assumes "\<And>i. coeff p i \<in> R" "\<And>i. coeff q i \<in> R"
+  shows   "coeff (pcompose p q) i \<in> R"
+  using assms(1)
+proof (induction p arbitrary: i)
+  case (pCons a p i)
+  have [simp]: "a \<in> R"
+    using pCons.prems[of 0] by auto
+  have "coeff p i \<in> R" for i
+    using pCons.prems[of "Suc i"] by auto
+  hence "coeff (p \<circ>\<^sub>p q) i \<in> R" for i
+    using pCons.prems by (intro pCons.IH)
+  thus ?case
+    by (auto simp: pcompose_pCons coeff_pCons split: nat.splits
+             intro!: assms R_plus coeff_mult_semiring_closed)
+qed auto
+
+end
+
+
 subsection \<open>Shifting polynomials\<close>
 
 definition poly_shift :: "nat \<Rightarrow> 'a::zero poly \<Rightarrow> 'a poly"
   where "poly_shift n p = Abs_poly (\<lambda>i. coeff p (i + n))"
 
 lemma nth_default_drop: "nth_default x (drop n xs) m = nth_default x xs (m + n)"
   by (auto simp add: nth_default_def add_ac)
 
 lemma nth_default_take: "nth_default x (take n xs) m = (if m < n then nth_default x xs m else x)"
   by (auto simp add: nth_default_def add_ac)
 
 lemma coeff_poly_shift: "coeff (poly_shift n p) i = coeff p (i + n)"
 proof -
   from MOST_coeff_eq_0[of p] obtain m where "\<forall>k>m. coeff p k = 0"
     by (auto simp: MOST_nat)
   then have "\<forall>k>m. coeff p (k + n) = 0"
     by auto
   then have "\<forall>\<^sub>\<infinity>k. coeff p (k + n) = 0"
     by (auto simp: MOST_nat)
   then show ?thesis
     by (simp add: poly_shift_def poly.Abs_poly_inverse)
 qed
 
 lemma poly_shift_id [simp]: "poly_shift 0 = (\<lambda>x. x)"
   by (simp add: poly_eq_iff fun_eq_iff coeff_poly_shift)
 
 lemma poly_shift_0 [simp]: "poly_shift n 0 = 0"
   by (simp add: poly_eq_iff coeff_poly_shift)
 
 lemma poly_shift_1: "poly_shift n 1 = (if n = 0 then 1 else 0)"
   by (simp add: poly_eq_iff coeff_poly_shift)
 
 lemma poly_shift_monom: "poly_shift n (monom c m) = (if m \<ge> n then monom c (m - n) else 0)"
   by (auto simp add: poly_eq_iff coeff_poly_shift)
 
 lemma coeffs_shift_poly [code abstract]:
   "coeffs (poly_shift n p) = drop n (coeffs p)"
 proof (cases "p = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then show ?thesis
     by (intro coeffs_eqI)
       (simp_all add: coeff_poly_shift nth_default_drop nth_default_coeffs_eq)
 qed
 
 
 subsection \<open>Truncating polynomials\<close>
 
 definition poly_cutoff
   where "poly_cutoff n p = Abs_poly (\<lambda>k. if k < n then coeff p k else 0)"
 
 lemma coeff_poly_cutoff: "coeff (poly_cutoff n p) k = (if k < n then coeff p k else 0)"
   unfolding poly_cutoff_def
   by (subst poly.Abs_poly_inverse) (auto simp: MOST_nat intro: exI[of _ n])
 
 lemma poly_cutoff_0 [simp]: "poly_cutoff n 0 = 0"
   by (simp add: poly_eq_iff coeff_poly_cutoff)
 
 lemma poly_cutoff_1 [simp]: "poly_cutoff n 1 = (if n = 0 then 0 else 1)"
   by (simp add: poly_eq_iff coeff_poly_cutoff)
 
 lemma coeffs_poly_cutoff [code abstract]:
   "coeffs (poly_cutoff n p) = strip_while ((=) 0) (take n (coeffs p))"
 proof (cases "strip_while ((=) 0) (take n (coeffs p)) = []")
   case True
   then have "coeff (poly_cutoff n p) k = 0" for k
     unfolding coeff_poly_cutoff
     by (auto simp: nth_default_coeffs_eq [symmetric] nth_default_def set_conv_nth)
   then have "poly_cutoff n p = 0"
     by (simp add: poly_eq_iff)
   then show ?thesis
     by (subst True) simp_all
 next
   case False
   have "no_trailing ((=) 0) (strip_while ((=) 0) (take n (coeffs p)))"
     by simp
   with False have "last (strip_while ((=) 0) (take n (coeffs p))) \<noteq> 0"
     unfolding no_trailing_unfold by auto
   then show ?thesis
     by (intro coeffs_eqI)
       (simp_all add: coeff_poly_cutoff nth_default_take nth_default_coeffs_eq)
 qed
 
 
 subsection \<open>Reflecting polynomials\<close>
 
 definition reflect_poly :: "'a::zero poly \<Rightarrow> 'a poly"
   where "reflect_poly p = Poly (rev (coeffs p))"
 
 lemma coeffs_reflect_poly [code abstract]:
   "coeffs (reflect_poly p) = rev (dropWhile ((=) 0) (coeffs p))"
   by (simp add: reflect_poly_def)
 
 lemma reflect_poly_0 [simp]: "reflect_poly 0 = 0"
   by (simp add: reflect_poly_def)
 
 lemma reflect_poly_1 [simp]: "reflect_poly 1 = 1"
   by (simp add: reflect_poly_def one_pCons)
 
 lemma coeff_reflect_poly:
   "coeff (reflect_poly p) n = (if n > degree p then 0 else coeff p (degree p - n))"
   by (cases "p = 0")
     (auto simp add: reflect_poly_def nth_default_def
       rev_nth degree_eq_length_coeffs coeffs_nth not_less
       dest: le_imp_less_Suc)
 
 lemma coeff_0_reflect_poly_0_iff [simp]: "coeff (reflect_poly p) 0 = 0 \<longleftrightarrow> p = 0"
   by (simp add: coeff_reflect_poly)
 
 lemma reflect_poly_at_0_eq_0_iff [simp]: "poly (reflect_poly p) 0 = 0 \<longleftrightarrow> p = 0"
   by (simp add: coeff_reflect_poly poly_0_coeff_0)
 
 lemma reflect_poly_pCons':
   "p \<noteq> 0 \<Longrightarrow> reflect_poly (pCons c p) = reflect_poly p + monom c (Suc (degree p))"
   by (intro poly_eqI)
     (auto simp: coeff_reflect_poly coeff_pCons not_less Suc_diff_le split: nat.split)
 
 lemma reflect_poly_const [simp]: "reflect_poly [:a:] = [:a:]"
   by (cases "a = 0") (simp_all add: reflect_poly_def)
 
 lemma poly_reflect_poly_nz:
   "x \<noteq> 0 \<Longrightarrow> poly (reflect_poly p) x = x ^ degree p * poly p (inverse x)"
   for x :: "'a::field"
   by (induct rule: pCons_induct) (simp_all add: field_simps reflect_poly_pCons' poly_monom)
 
 lemma coeff_0_reflect_poly [simp]: "coeff (reflect_poly p) 0 = lead_coeff p"
   by (simp add: coeff_reflect_poly)
 
 lemma poly_reflect_poly_0 [simp]: "poly (reflect_poly p) 0 = lead_coeff p"
   by (simp add: poly_0_coeff_0)
 
 lemma reflect_poly_reflect_poly [simp]: "coeff p 0 \<noteq> 0 \<Longrightarrow> reflect_poly (reflect_poly p) = p"
   by (cases p rule: pCons_cases) (simp add: reflect_poly_def )
 
 lemma degree_reflect_poly_le: "degree (reflect_poly p) \<le> degree p"
   by (simp add: degree_eq_length_coeffs coeffs_reflect_poly length_dropWhile_le diff_le_mono)
 
 lemma reflect_poly_pCons: "a \<noteq> 0 \<Longrightarrow> reflect_poly (pCons a p) = Poly (rev (a # coeffs p))"
   by (subst coeffs_eq_iff) (simp add: coeffs_reflect_poly)
 
 lemma degree_reflect_poly_eq [simp]: "coeff p 0 \<noteq> 0 \<Longrightarrow> degree (reflect_poly p) = degree p"
   by (cases p rule: pCons_cases) (simp add: reflect_poly_pCons degree_eq_length_coeffs)
 
 (* TODO: does this work with zero divisors as well? Probably not. *)
 lemma reflect_poly_mult: "reflect_poly (p * q) = reflect_poly p * reflect_poly q"
   for p q :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
 proof (cases "p = 0 \<or> q = 0")
   case False
   then have [simp]: "p \<noteq> 0" "q \<noteq> 0" by auto
   show ?thesis
   proof (rule poly_eqI)
     show "coeff (reflect_poly (p * q)) i = coeff (reflect_poly p * reflect_poly q) i" for i
     proof (cases "i \<le> degree (p * q)")
       case True
       define A where "A = {..i} \<inter> {i - degree q..degree p}"
       define B where "B = {..degree p} \<inter> {degree p - i..degree (p*q) - i}"
       let ?f = "\<lambda>j. degree p - j"
 
       from True have "coeff (reflect_poly (p * q)) i = coeff (p * q) (degree (p * q) - i)"
         by (simp add: coeff_reflect_poly)
       also have "\<dots> = (\<Sum>j\<le>degree (p * q) - i. coeff p j * coeff q (degree (p * q) - i - j))"
         by (simp add: coeff_mult)
       also have "\<dots> = (\<Sum>j\<in>B. coeff p j * coeff q (degree (p * q) - i - j))"
         by (intro sum.mono_neutral_right) (auto simp: B_def degree_mult_eq not_le coeff_eq_0)
       also from True have "\<dots> = (\<Sum>j\<in>A. coeff p (degree p - j) * coeff q (degree q - (i - j)))"
         by (intro sum.reindex_bij_witness[of _ ?f ?f])
           (auto simp: A_def B_def degree_mult_eq add_ac)
       also have "\<dots> =
         (\<Sum>j\<le>i.
           if j \<in> {i - degree q..degree p}
           then coeff p (degree p - j) * coeff q (degree q - (i - j))
           else 0)"
         by (subst sum.inter_restrict [symmetric]) (simp_all add: A_def)
       also have "\<dots> = coeff (reflect_poly p * reflect_poly q) i"
         by (fastforce simp: coeff_mult coeff_reflect_poly intro!: sum.cong)
       finally show ?thesis .
     qed (auto simp: coeff_mult coeff_reflect_poly coeff_eq_0 degree_mult_eq intro!: sum.neutral)
   qed
 qed auto
 
 lemma reflect_poly_smult: "reflect_poly (smult c p) = smult c (reflect_poly p)"
   for p :: "'a::{comm_semiring_0,semiring_no_zero_divisors} poly"
   using reflect_poly_mult[of "[:c:]" p] by simp
 
 lemma reflect_poly_power: "reflect_poly (p ^ n) = reflect_poly p ^ n"
   for p :: "'a::{comm_semiring_1,semiring_no_zero_divisors} poly"
   by (induct n) (simp_all add: reflect_poly_mult)
 
 lemma reflect_poly_prod: "reflect_poly (prod f A) = prod (\<lambda>x. reflect_poly (f x)) A"
   for f :: "_ \<Rightarrow> _::{comm_semiring_0,semiring_no_zero_divisors} poly"
   by (induct A rule: infinite_finite_induct) (simp_all add: reflect_poly_mult)
 
 lemma reflect_poly_prod_list: "reflect_poly (prod_list xs) = prod_list (map reflect_poly xs)"
   for xs :: "_::{comm_semiring_0,semiring_no_zero_divisors} poly list"
   by (induct xs) (simp_all add: reflect_poly_mult)
 
 lemma reflect_poly_Poly_nz:
   "no_trailing (HOL.eq 0) xs \<Longrightarrow> reflect_poly (Poly xs) = Poly (rev xs)"
   by (simp add: reflect_poly_def)
 
 lemmas reflect_poly_simps =
   reflect_poly_0 reflect_poly_1 reflect_poly_const reflect_poly_smult reflect_poly_mult
   reflect_poly_power reflect_poly_prod reflect_poly_prod_list
 
 
 subsection \<open>Derivatives\<close>
 
 function pderiv :: "('a :: {comm_semiring_1,semiring_no_zero_divisors}) poly \<Rightarrow> 'a poly"
   where "pderiv (pCons a p) = (if p = 0 then 0 else p + pCons 0 (pderiv p))"
   by (auto intro: pCons_cases)
 
 termination pderiv
   by (relation "measure degree") simp_all
 
 declare pderiv.simps[simp del]
 
 lemma pderiv_0 [simp]: "pderiv 0 = 0"
   using pderiv.simps [of 0 0] by simp
 
 lemma pderiv_pCons: "pderiv (pCons a p) = p + pCons 0 (pderiv p)"
   by (simp add: pderiv.simps)
 
 lemma pderiv_1 [simp]: "pderiv 1 = 0"
   by (simp add: one_pCons pderiv_pCons)
 
 lemma pderiv_of_nat [simp]: "pderiv (of_nat n) = 0"
   and pderiv_numeral [simp]: "pderiv (numeral m) = 0"
   by (simp_all add: of_nat_poly numeral_poly pderiv_pCons)
 
 lemma coeff_pderiv: "coeff (pderiv p) n = of_nat (Suc n) * coeff p (Suc n)"
   by (induct p arbitrary: n)
     (auto simp add: pderiv_pCons coeff_pCons algebra_simps split: nat.split)
 
 fun pderiv_coeffs_code :: "'a::{comm_semiring_1,semiring_no_zero_divisors} \<Rightarrow> 'a list \<Rightarrow> 'a list"
   where
     "pderiv_coeffs_code f (x # xs) = cCons (f * x) (pderiv_coeffs_code (f+1) xs)"
   | "pderiv_coeffs_code f [] = []"
 
 definition pderiv_coeffs :: "'a::{comm_semiring_1,semiring_no_zero_divisors} list \<Rightarrow> 'a list"
   where "pderiv_coeffs xs = pderiv_coeffs_code 1 (tl xs)"
 
 (* Efficient code for pderiv contributed by René Thiemann and Akihisa Yamada *)
 lemma pderiv_coeffs_code:
   "nth_default 0 (pderiv_coeffs_code f xs) n = (f + of_nat n) * nth_default 0 xs n"
 proof (induct xs arbitrary: f n)
   case Nil
   then show ?case by simp
 next
   case (Cons x xs)
   show ?case
   proof (cases n)
     case 0
     then show ?thesis
       by (cases "pderiv_coeffs_code (f + 1) xs = [] \<and> f * x = 0") (auto simp: cCons_def)
   next
     case n: (Suc m)
     show ?thesis
     proof (cases "pderiv_coeffs_code (f + 1) xs = [] \<and> f * x = 0")
       case False
       then have "nth_default 0 (pderiv_coeffs_code f (x # xs)) n =
           nth_default 0 (pderiv_coeffs_code (f + 1) xs) m"
         by (auto simp: cCons_def n)
       also have "\<dots> = (f + of_nat n) * nth_default 0 xs m"
         by (simp add: Cons n add_ac)
       finally show ?thesis
         by (simp add: n)
     next
       case True
       have empty: "pderiv_coeffs_code g xs = [] \<Longrightarrow> g + of_nat m = 0 \<or> nth_default 0 xs m = 0" for g
       proof (induct xs arbitrary: g m)
         case Nil
         then show ?case by simp
       next
         case (Cons x xs)
         from Cons(2) have empty: "pderiv_coeffs_code (g + 1) xs = []" and g: "g = 0 \<or> x = 0"
           by (auto simp: cCons_def split: if_splits)
         note IH = Cons(1)[OF empty]
         from IH[of m] IH[of "m - 1"] g show ?case
           by (cases m) (auto simp: field_simps)
       qed
       from True have "nth_default 0 (pderiv_coeffs_code f (x # xs)) n = 0"
         by (auto simp: cCons_def n)
       moreover from True have "(f + of_nat n) * nth_default 0 (x # xs) n = 0"
         by (simp add: n) (use empty[of "f+1"] in \<open>auto simp: field_simps\<close>)
       ultimately show ?thesis by simp
     qed
   qed
 qed
 
 lemma coeffs_pderiv_code [code abstract]: "coeffs (pderiv p) = pderiv_coeffs (coeffs p)"
   unfolding pderiv_coeffs_def
 proof (rule coeffs_eqI, unfold pderiv_coeffs_code coeff_pderiv, goal_cases)
   case (1 n)
   have id: "coeff p (Suc n) = nth_default 0 (map (\<lambda>i. coeff p (Suc i)) [0..<degree p]) n"
     by (cases "n < degree p") (auto simp: nth_default_def coeff_eq_0)
   show ?case
     unfolding coeffs_def map_upt_Suc by (auto simp: id)
 next
   case 2
   obtain n :: 'a and xs where defs: "tl (coeffs p) = xs" "1 = n"
     by simp
   from 2 show ?case
     unfolding defs by (induct xs arbitrary: n) (auto simp: cCons_def)
 qed
 
 lemma pderiv_eq_0_iff: "pderiv p = 0 \<longleftrightarrow> degree p = 0"
   for p :: "'a::{comm_semiring_1,semiring_no_zero_divisors,semiring_char_0} poly"
 proof (cases "degree p")
   case 0
   then show ?thesis 
     by (metis degree_eq_zeroE pderiv.simps)
 next
   case (Suc n)
   then show ?thesis
-    by (metis coeff_0 coeff_pderiv degree_0 leading_coeff_0_iff mult_eq_0_iff nat.distinct(1) of_nat_eq_0_iff)    
+    using coeff_0 coeff_pderiv degree_0 leading_coeff_0_iff mult_eq_0_iff nat.distinct(1) of_nat_eq_0_iff
+    by (metis coeff_0 coeff_pderiv degree_0 leading_coeff_0_iff mult_eq_0_iff nat.distinct(1) of_nat_eq_0_iff)
 qed
 
 lemma degree_pderiv: "degree (pderiv p) = degree p - 1"
   for p :: "'a::{comm_semiring_1,semiring_no_zero_divisors,semiring_char_0} poly"
 proof -
   have "degree p - 1 \<le> degree (pderiv p)"
   proof (cases "degree p")
     case (Suc n)
     then show ?thesis
       by (metis coeff_pderiv degree_0 diff_Suc_1 le_degree leading_coeff_0_iff mult_eq_0_iff nat.distinct(1) of_nat_eq_0_iff)      
   qed auto
   moreover have "\<forall>i>degree p - 1. coeff (pderiv p) i = 0"
     by (simp add: coeff_eq_0 coeff_pderiv)
   ultimately show ?thesis
     using order_antisym [OF degree_le] by blast
 qed
 
 lemma not_dvd_pderiv:
   fixes p :: "'a::{comm_semiring_1,semiring_no_zero_divisors,semiring_char_0} poly"
   assumes "degree p \<noteq> 0"
   shows "\<not> p dvd pderiv p"
 proof
   assume dvd: "p dvd pderiv p"
   then obtain q where p: "pderiv p = p * q"
     unfolding dvd_def by auto
   from dvd have le: "degree p \<le> degree (pderiv p)"
     by (simp add: assms dvd_imp_degree_le pderiv_eq_0_iff)
   from assms and this [unfolded degree_pderiv]
     show False by auto
 qed
 
 lemma dvd_pderiv_iff [simp]: "p dvd pderiv p \<longleftrightarrow> degree p = 0"
   for p :: "'a::{comm_semiring_1,semiring_no_zero_divisors,semiring_char_0} poly"
   using not_dvd_pderiv[of p] by (auto simp: pderiv_eq_0_iff [symmetric])
 
 lemma pderiv_singleton [simp]: "pderiv [:a:] = 0"
   by (simp add: pderiv_pCons)
 
 lemma pderiv_add: "pderiv (p + q) = pderiv p + pderiv q"
   by (rule poly_eqI) (simp add: coeff_pderiv algebra_simps)
 
 lemma pderiv_minus: "pderiv (- p :: 'a :: idom poly) = - pderiv p"
   by (rule poly_eqI) (simp add: coeff_pderiv algebra_simps)
 
 lemma pderiv_diff: "pderiv ((p :: _ :: idom poly) - q) = pderiv p - pderiv q"
   by (rule poly_eqI) (simp add: coeff_pderiv algebra_simps)
 
 lemma pderiv_smult: "pderiv (smult a p) = smult a (pderiv p)"
   by (rule poly_eqI) (simp add: coeff_pderiv algebra_simps)
 
 lemma pderiv_mult: "pderiv (p * q) = p * pderiv q + q * pderiv p"
   by (induct p) (auto simp: pderiv_add pderiv_smult pderiv_pCons algebra_simps)
 
 lemma pderiv_power_Suc: "pderiv (p ^ Suc n) = smult (of_nat (Suc n)) (p ^ n) * pderiv p"
 proof (induction n)
   case (Suc n)
   then show ?case
     by (simp add: pderiv_mult smult_add_left algebra_simps)
 qed auto 
 
 lemma pderiv_pcompose: "pderiv (pcompose p q) = pcompose (pderiv p) q * pderiv q"
   by (induction p rule: pCons_induct)
      (auto simp: pcompose_pCons pderiv_add pderiv_mult pderiv_pCons pcompose_add algebra_simps)
 
 lemma pderiv_prod: "pderiv (prod f (as)) = (\<Sum>a\<in>as. prod f (as - {a}) * pderiv (f a))"
 proof (induct as rule: infinite_finite_induct)
   case (insert a as)
   then have id: "prod f (insert a as) = f a * prod f as"
     "\<And>g. sum g (insert a as) = g a + sum g as"
     "insert a as - {a} = as"
     by auto
   have "prod f (insert a as - {b}) = f a * prod f (as - {b})" if "b \<in> as" for b
   proof -
     from \<open>a \<notin> as\<close> that have *: "insert a as - {b} = insert a (as - {b})"
       by auto
     show ?thesis
       unfolding * by (subst prod.insert) (use insert in auto)
   qed
   then show ?case
     unfolding id pderiv_mult insert(3) sum_distrib_left
     by (auto simp add: ac_simps intro!: sum.cong)
 qed auto
 
 lemma DERIV_pow2: "DERIV (\<lambda>x. x ^ Suc n) x :> real (Suc n) * (x ^ n)"
   by (rule DERIV_cong, rule DERIV_pow) simp
 declare DERIV_pow2 [simp] DERIV_pow [simp]
 
 lemma DERIV_add_const: "DERIV f x :> D \<Longrightarrow> DERIV (\<lambda>x. a + f x :: 'a::real_normed_field) x :> D"
   by (rule DERIV_cong, rule DERIV_add) auto
 
 lemma poly_DERIV [simp]: "DERIV (\<lambda>x. poly p x) x :> poly (pderiv p) x"
   by (induct p) (auto intro!: derivative_eq_intros simp add: pderiv_pCons)
 
 lemma poly_isCont[simp]: 
   fixes x::"'a::real_normed_field"
   shows "isCont (\<lambda>x. poly p x) x"
 by (rule poly_DERIV [THEN DERIV_isCont])
 
 lemma tendsto_poly [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. poly p (f x)) \<longlongrightarrow> poly p a) F"
   for f :: "_ \<Rightarrow> 'a::real_normed_field"  
   by (rule isCont_tendsto_compose [OF poly_isCont])
 
 lemma continuous_within_poly: "continuous (at z within s) (poly p)"
   for z :: "'a::{real_normed_field}"
   by (simp add: continuous_within tendsto_poly)  
     
 lemma continuous_poly [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. poly p (f x))"
   for f :: "_ \<Rightarrow> 'a::real_normed_field"
   unfolding continuous_def by (rule tendsto_poly)
       
 lemma continuous_on_poly [continuous_intros]:
   fixes p :: "'a :: {real_normed_field} poly"
   assumes "continuous_on A f"
   shows "continuous_on A (\<lambda>x. poly p (f x))"
   by (metis DERIV_continuous_on assms continuous_on_compose2 poly_DERIV subset_UNIV)
 
 text \<open>Consequences of the derivative theorem above.\<close>
 
 lemma poly_differentiable[simp]: "(\<lambda>x. poly p x) differentiable (at x)"
   for x :: real
   by (simp add: real_differentiable_def) (blast intro: poly_DERIV)
 
 lemma poly_IVT_pos: "a < b \<Longrightarrow> poly p a < 0 \<Longrightarrow> 0 < poly p b \<Longrightarrow> \<exists>x. a < x \<and> x < b \<and> poly p x = 0"
   for a b :: real
   using IVT [of "poly p" a 0 b] by (auto simp add: order_le_less)
 
 lemma poly_IVT_neg: "a < b \<Longrightarrow> 0 < poly p a \<Longrightarrow> poly p b < 0 \<Longrightarrow> \<exists>x. a < x \<and> x < b \<and> poly p x = 0"
   for a b :: real
   using poly_IVT_pos [where p = "- p"] by simp
 
 lemma poly_IVT: "a < b \<Longrightarrow> poly p a * poly p b < 0 \<Longrightarrow> \<exists>x>a. x < b \<and> poly p x = 0"
   for p :: "real poly"
   by (metis less_not_sym mult_less_0_iff poly_IVT_neg poly_IVT_pos)
 
 lemma poly_MVT: "a < b \<Longrightarrow> \<exists>x. a < x \<and> x < b \<and> poly p b - poly p a = (b - a) * poly (pderiv p) x"
   for a b :: real
   by (simp add: MVT2)
 
 lemma poly_MVT':
   fixes a b :: real
   assumes "{min a b..max a b} \<subseteq> A"
   shows "\<exists>x\<in>A. poly p b - poly p a = (b - a) * poly (pderiv p) x"
 proof (cases a b rule: linorder_cases)
   case less
   from poly_MVT[OF less, of p] guess x by (elim exE conjE)
   then show ?thesis by (intro bexI[of _ x]) (auto intro!: subsetD[OF assms])
 next
   case greater
   from poly_MVT[OF greater, of p] guess x by (elim exE conjE)
   then show ?thesis by (intro bexI[of _ x]) (auto simp: algebra_simps intro!: subsetD[OF assms])
 qed (use assms in auto)
 
 lemma poly_pinfty_gt_lc:
   fixes p :: "real poly"
   assumes "lead_coeff p > 0"
   shows "\<exists>n. \<forall> x \<ge> n. poly p x \<ge> lead_coeff p"
   using assms
 proof (induct p)
   case 0
   then show ?case by auto
 next
   case (pCons a p)
   from this(1) consider "a \<noteq> 0" "p = 0" | "p \<noteq> 0" by auto
   then show ?case
   proof cases
     case 1
     then show ?thesis by auto
   next
     case 2
     with pCons obtain n1 where gte_lcoeff: "\<forall>x\<ge>n1. lead_coeff p \<le> poly p x"
       by auto
     from pCons(3) \<open>p \<noteq> 0\<close> have gt_0: "lead_coeff p > 0" by auto
     define n where "n = max n1 (1 + \<bar>a\<bar> / lead_coeff p)"
     have "lead_coeff (pCons a p) \<le> poly (pCons a p) x" if "n \<le> x" for x
     proof -
       from gte_lcoeff that have "lead_coeff p \<le> poly p x"
         by (auto simp: n_def)
       with gt_0 have "\<bar>a\<bar> / lead_coeff p \<ge> \<bar>a\<bar> / poly p x" and "poly p x > 0"
         by (auto intro: frac_le)
       with \<open>n \<le> x\<close>[unfolded n_def] have "x \<ge> 1 + \<bar>a\<bar> / poly p x"
         by auto
       with \<open>lead_coeff p \<le> poly p x\<close> \<open>poly p x > 0\<close> \<open>p \<noteq> 0\<close>
       show "lead_coeff (pCons a p) \<le> poly (pCons a p) x"
         by (auto simp: field_simps)
     qed
     then show ?thesis by blast
   qed
 qed
 
 lemma lemma_order_pderiv1:
   "pderiv ([:- a, 1:] ^ Suc n * q) = [:- a, 1:] ^ Suc n * pderiv q +
     smult (of_nat (Suc n)) (q * [:- a, 1:] ^ n)"
   by (simp only: pderiv_mult pderiv_power_Suc) (simp del: power_Suc of_nat_Suc add: pderiv_pCons)
 
 lemma lemma_order_pderiv:
   fixes p :: "'a :: field_char_0 poly"
   assumes n: "0 < n"
     and pd: "pderiv p \<noteq> 0"
     and pe: "p = [:- a, 1:] ^ n * q"
     and nd: "\<not> [:- a, 1:] dvd q"
   shows "n = Suc (order a (pderiv p))"
 proof -
   from assms have "pderiv ([:- a, 1:] ^ n * q) \<noteq> 0"
     by auto
   from assms obtain n' where "n = Suc n'" "0 < Suc n'" "pderiv ([:- a, 1:] ^ Suc n' * q) \<noteq> 0"
     by (cases n) auto
   have "order a (pderiv ([:- a, 1:] ^ Suc n' * q)) = n'"
   proof (rule order_unique_lemma)
     show "[:- a, 1:] ^ n' dvd pderiv ([:- a, 1:] ^ Suc n' * q)"
       unfolding lemma_order_pderiv1
     proof (rule dvd_add)
       show "[:- a, 1:] ^ n' dvd [:- a, 1:] ^ Suc n' * pderiv q"
         by (metis dvdI dvd_mult2 power_Suc2)
       show "[:- a, 1:] ^ n' dvd smult (of_nat (Suc n')) (q * [:- a, 1:] ^ n')"
         by (metis dvd_smult dvd_triv_right)
     qed
     have "k dvd k * pderiv q + smult (of_nat (Suc n')) l \<Longrightarrow> k dvd l" for k l
       by (auto simp del: of_nat_Suc simp: dvd_add_right_iff dvd_smult_iff)
     then show "\<not> [:- a, 1:] ^ Suc n' dvd pderiv ([:- a, 1:] ^ Suc n' * q)"
       unfolding lemma_order_pderiv1
       by (metis nd dvd_mult_cancel_right power_not_zero pCons_eq_0_iff power_Suc zero_neq_one)
   qed
   then show ?thesis
     by (metis \<open>n = Suc n'\<close> pe)
 qed
 
 lemma order_pderiv: "order a p = Suc (order a (pderiv p))"
   if "pderiv p \<noteq> 0" "order a p \<noteq> 0"
   for p :: "'a::field_char_0 poly"
 proof (cases "p = 0")
   case False
   obtain q where "p = [:- a, 1:] ^ order a p * q \<and> \<not> [:- a, 1:] dvd q"
     using False order_decomp by blast
   then show ?thesis
     using lemma_order_pderiv that by blast
 qed (use that in auto)
 
 lemma poly_squarefree_decomp_order:
   fixes p :: "'a::field_char_0 poly"
   assumes "pderiv p \<noteq> 0"
     and p: "p = q * d"
     and p': "pderiv p = e * d"
     and d: "d = r * p + s * pderiv p"
   shows "order a q = (if order a p = 0 then 0 else 1)"
 proof (rule classical)
   assume 1: "\<not> ?thesis"
   from \<open>pderiv p \<noteq> 0\<close> have "p \<noteq> 0" by auto
   with p have "order a p = order a q + order a d"
     by (simp add: order_mult)
   with 1 have "order a p \<noteq> 0"
     by (auto split: if_splits)
   from \<open>pderiv p \<noteq> 0\<close> \<open>pderiv p = e * d\<close> have oapp: "order a (pderiv p) = order a e + order a d"
     by (simp add: order_mult)
   from \<open>pderiv p \<noteq> 0\<close> \<open>order a p \<noteq> 0\<close> have oap: "order a p = Suc (order a (pderiv p))"
     by (rule order_pderiv)
   from \<open>p \<noteq> 0\<close> \<open>p = q * d\<close> have "d \<noteq> 0"
     by simp
   have "[:- a, 1:] ^ order a (pderiv p) dvd r * p"
     by (metis dvd_trans dvd_triv_right oap order_1 power_Suc)
   then have "([:-a, 1:] ^ (order a (pderiv p))) dvd d"
     by (simp add: d order_1)
   with \<open>d \<noteq> 0\<close> have "order a (pderiv p) \<le> order a d"
     by (simp add: order_divides)
   show ?thesis
     using \<open>order a p = order a q + order a d\<close>
       and oapp oap
       and \<open>order a (pderiv p) \<le> order a d\<close>
     by auto
 qed
 
 lemma poly_squarefree_decomp_order2:
   "pderiv p \<noteq> 0 \<Longrightarrow> p = q * d \<Longrightarrow> pderiv p = e * d \<Longrightarrow>
     d = r * p + s * pderiv p \<Longrightarrow> \<forall>a. order a q = (if order a p = 0 then 0 else 1)"
   for p :: "'a::field_char_0 poly"
   by (blast intro: poly_squarefree_decomp_order)
 
 lemma order_pderiv2:
   "pderiv p \<noteq> 0 \<Longrightarrow> order a p \<noteq> 0 \<Longrightarrow> order a (pderiv p) = n \<longleftrightarrow> order a p = Suc n"
   for p :: "'a::field_char_0 poly"
   by (auto dest: order_pderiv)
 
 definition rsquarefree :: "'a::idom poly \<Rightarrow> bool"
   where "rsquarefree p \<longleftrightarrow> p \<noteq> 0 \<and> (\<forall>a. order a p = 0 \<or> order a p = 1)"
 
 lemma pderiv_iszero: "pderiv p = 0 \<Longrightarrow> \<exists>h. p = [:h:]"
   for p :: "'a::{semidom,semiring_char_0} poly"
   by (cases p) (auto simp: pderiv_eq_0_iff split: if_splits)
 
 lemma rsquarefree_roots: "rsquarefree p \<longleftrightarrow> (\<forall>a. \<not> (poly p a = 0 \<and> poly (pderiv p) a = 0))"
   for p :: "'a::field_char_0 poly"
 proof (cases "p = 0")
   case False
   show ?thesis
   proof (cases "pderiv p = 0")
     case True
     with \<open>p \<noteq> 0\<close> pderiv_iszero show ?thesis
       by (force simp add: order_0I rsquarefree_def)
   next
     case False
     with \<open>p \<noteq> 0\<close> order_pderiv2 show ?thesis
       by (force simp add: rsquarefree_def order_root)
   qed
 qed (simp add: rsquarefree_def)
 
 lemma poly_squarefree_decomp:
   fixes p :: "'a::field_char_0 poly"
   assumes "pderiv p \<noteq> 0"
     and "p = q * d"
     and "pderiv p = e * d"
     and "d = r * p + s * pderiv p"
   shows "rsquarefree q \<and> (\<forall>a. poly q a = 0 \<longleftrightarrow> poly p a = 0)"
 proof -
   from \<open>pderiv p \<noteq> 0\<close> have "p \<noteq> 0" by auto
   with \<open>p = q * d\<close> have "q \<noteq> 0" by simp
   from assms have "\<forall>a. order a q = (if order a p = 0 then 0 else 1)"
     by (rule poly_squarefree_decomp_order2)
   with \<open>p \<noteq> 0\<close> \<open>q \<noteq> 0\<close> show ?thesis
     by (simp add: rsquarefree_def order_root)
 qed
 
 
 subsection \<open>Algebraic numbers\<close>
 
 text \<open>
   Algebraic numbers can be defined in two equivalent ways: all real numbers that are
   roots of rational polynomials or of integer polynomials. The Algebraic-Numbers AFP entry
   uses the rational definition, but we need the integer definition.
 
   The equivalence is obvious since any rational polynomial can be multiplied with the
   LCM of its coefficients, yielding an integer polynomial with the same roots.
 \<close>
 
 definition algebraic :: "'a :: field_char_0 \<Rightarrow> bool"
   where "algebraic x \<longleftrightarrow> (\<exists>p. (\<forall>i. coeff p i \<in> \<int>) \<and> p \<noteq> 0 \<and> poly p x = 0)"
 
 lemma algebraicI: "(\<And>i. coeff p i \<in> \<int>) \<Longrightarrow> p \<noteq> 0 \<Longrightarrow> poly p x = 0 \<Longrightarrow> algebraic x"
   unfolding algebraic_def by blast
 
 lemma algebraicE:
   assumes "algebraic x"
   obtains p where "\<And>i. coeff p i \<in> \<int>" "p \<noteq> 0" "poly p x = 0"
   using assms unfolding algebraic_def by blast
 
 lemma algebraic_altdef: "algebraic x \<longleftrightarrow> (\<exists>p. (\<forall>i. coeff p i \<in> \<rat>) \<and> p \<noteq> 0 \<and> poly p x = 0)"
   for p :: "'a::field_char_0 poly"
 proof safe
   fix p
   assume rat: "\<forall>i. coeff p i \<in> \<rat>" and root: "poly p x = 0" and nz: "p \<noteq> 0"
   define cs where "cs = coeffs p"
   from rat have "\<forall>c\<in>range (coeff p). \<exists>c'. c = of_rat c'"
     unfolding Rats_def by blast
   then obtain f where f: "coeff p i = of_rat (f (coeff p i))" for i
     by (subst (asm) bchoice_iff) blast
   define cs' where "cs' = map (quotient_of \<circ> f) (coeffs p)"
   define d where "d = Lcm (set (map snd cs'))"
   define p' where "p' = smult (of_int d) p"
 
   have "coeff p' n \<in> \<int>" for n
   proof (cases "n \<le> degree p")
     case True
     define c where "c = coeff p n"
     define a where "a = fst (quotient_of (f (coeff p n)))"
     define b where "b = snd (quotient_of (f (coeff p n)))"
     have b_pos: "b > 0"
       unfolding b_def using quotient_of_denom_pos' by simp
     have "coeff p' n = of_int d * coeff p n"
       by (simp add: p'_def)
     also have "coeff p n = of_rat (of_int a / of_int b)"
       unfolding a_def b_def
       by (subst quotient_of_div [of "f (coeff p n)", symmetric]) (simp_all add: f [symmetric])
     also have "of_int d * \<dots> = of_rat (of_int (a*d) / of_int b)"
       by (simp add: of_rat_mult of_rat_divide)
     also from nz True have "b \<in> snd ` set cs'"
       by (force simp: cs'_def o_def b_def coeffs_def simp del: upt_Suc)
     then have "b dvd (a * d)"
       by (simp add: d_def)
     then have "of_int (a * d) / of_int b \<in> (\<int> :: rat set)"
       by (rule of_int_divide_in_Ints)
     then have "of_rat (of_int (a * d) / of_int b) \<in> \<int>" by (elim Ints_cases) auto
     finally show ?thesis .
   next
     case False
     then show ?thesis
       by (auto simp: p'_def not_le coeff_eq_0)
   qed
   moreover have "set (map snd cs') \<subseteq> {0<..}"
     unfolding cs'_def using quotient_of_denom_pos' by (auto simp: coeffs_def simp del: upt_Suc)
   then have "d \<noteq> 0"
     unfolding d_def by (induct cs') simp_all
   with nz have "p' \<noteq> 0" by (simp add: p'_def)
   moreover from root have "poly p' x = 0"
     by (simp add: p'_def)
   ultimately show "algebraic x"
     unfolding algebraic_def by blast
 next
   assume "algebraic x"
   then obtain p where p: "coeff p i \<in> \<int>" "poly p x = 0" "p \<noteq> 0" for i
     by (force simp: algebraic_def)
   moreover have "coeff p i \<in> \<int> \<Longrightarrow> coeff p i \<in> \<rat>" for i
     by (elim Ints_cases) simp
   ultimately show "\<exists>p. (\<forall>i. coeff p i \<in> \<rat>) \<and> p \<noteq> 0 \<and> poly p x = 0" by auto
 qed
 
 
+subsection \<open>Algebraic integers\<close>
+
+inductive algebraic_int :: "'a :: field \<Rightarrow> bool" where
+  "\<lbrakk>lead_coeff p = 1; \<forall>i. coeff p i \<in> \<int>; poly p x = 0\<rbrakk> \<Longrightarrow> algebraic_int x"
+
+lemma algebraic_int_altdef_ipoly:
+  fixes x :: "'a :: field_char_0"
+  shows "algebraic_int x \<longleftrightarrow> (\<exists>p. poly (map_poly of_int p) x = 0 \<and> lead_coeff p = 1)"
+proof
+  assume "algebraic_int x"
+  then obtain p where p: "lead_coeff p = 1" "\<forall>i. coeff p i \<in> \<int>" "poly p x = 0"
+    by (auto elim: algebraic_int.cases)
+  define the_int where "the_int = (\<lambda>x::'a. THE r. x = of_int r)"
+  define p' where "p' = map_poly the_int p"
+  have of_int_the_int: "of_int (the_int x) = x" if "x \<in> \<int>" for x
+    unfolding the_int_def by (rule sym, rule theI') (insert that, auto simp: Ints_def)
+  have the_int_0_iff: "the_int x = 0 \<longleftrightarrow> x = 0" if "x \<in> \<int>" for x
+    using of_int_the_int[OF that] by auto
+  have [simp]: "the_int 0 = 0"
+    by (subst the_int_0_iff) auto
+  have "map_poly of_int p' = map_poly (of_int \<circ> the_int) p"
+    by (simp add: p'_def map_poly_map_poly)
+  also from p of_int_the_int have "\<dots> = p"
+    by (subst poly_eq_iff) (auto simp: coeff_map_poly)
+  finally have p_p': "map_poly of_int p' = p" .
+
+  show "(\<exists>p. poly (map_poly of_int p) x = 0 \<and> lead_coeff p = 1)"
+  proof (intro exI conjI notI)
+    from p show "poly (map_poly of_int p') x = 0" by (simp add: p_p')
+  next
+    show "lead_coeff p' = 1"
+      using p by (simp flip: p_p' add: degree_map_poly coeff_map_poly)
+  qed
+next
+  assume "\<exists>p. poly (map_poly of_int p) x = 0 \<and> lead_coeff p = 1"
+  then obtain p where p: "poly (map_poly of_int p) x = 0" "lead_coeff p = 1"
+    by auto
+  define p' where "p' = (map_poly of_int p :: 'a poly)"
+  from p have "lead_coeff p' = 1" "poly p' x = 0" "\<forall>i. coeff p' i \<in> \<int>"
+    by (auto simp: p'_def coeff_map_poly degree_map_poly)
+  thus "algebraic_int x"
+    by (intro algebraic_int.intros)
+qed
+
+theorem rational_algebraic_int_is_int:
+  assumes "algebraic_int x" and "x \<in> \<rat>"
+  shows   "x \<in> \<int>"
+proof -
+  from assms(2) obtain a b where ab: "b > 0" "Rings.coprime a b" and x_eq: "x = of_int a / of_int b"
+    by (auto elim: Rats_cases')
+  from \<open>b > 0\<close> have [simp]: "b \<noteq> 0"
+    by auto
+  from assms(1) obtain p
+    where p: "lead_coeff p = 1" "\<forall>i. coeff p i \<in> \<int>" "poly p x = 0"
+    by (auto simp: algebraic_int.simps)
+
+  define q :: "'a poly" where "q = [:-of_int a, of_int b:]"
+  have "poly q x = 0" "q \<noteq> 0" "\<forall>i. coeff q i \<in> \<int>"
+    by (auto simp: x_eq q_def coeff_pCons split: nat.splits)
+  define n where "n = degree p"
+  have "n > 0"
+    using p by (intro Nat.gr0I) (auto simp: n_def elim!: degree_eq_zeroE)
+  have "(\<Sum>i<n. coeff p i * of_int (a ^ i * b ^ (n - i - 1))) \<in> \<int>"
+    using p by auto
+  then obtain R where R: "of_int R = (\<Sum>i<n. coeff p i * of_int (a ^ i * b ^ (n - i - 1)))"
+    by (auto simp: Ints_def)
+  have [simp]: "coeff p n = 1"
+    using p by (auto simp: n_def)
+
+  have "0 = poly p x * of_int b ^ n"
+    using p by simp
+  also have "\<dots> = (\<Sum>i\<le>n. coeff p i * x ^ i * of_int b ^ n)"
+    by (simp add: poly_altdef n_def sum_distrib_right)
+  also have "\<dots> = (\<Sum>i\<le>n. coeff p i * of_int (a ^ i * b ^ (n - i)))"
+    by (intro sum.cong) (auto simp: x_eq field_simps simp flip: power_add)
+  also have "{..n} = insert n {..<n}"
+    using \<open>n > 0\<close> by auto
+  also have "(\<Sum>i\<in>\<dots>. coeff p i * of_int (a ^ i * b ^ (n - i))) =
+               coeff p n * of_int (a ^ n) + (\<Sum>i<n. coeff p i * of_int (a ^ i * b ^ (n - i)))"
+    by (subst sum.insert) auto
+  also have "(\<Sum>i<n. coeff p i * of_int (a ^ i * b ^ (n - i))) =
+             (\<Sum>i<n. coeff p i * of_int (a ^ i * b * b ^ (n - i - 1)))"
+    by (intro sum.cong) (auto simp flip: power_add power_Suc simp: Suc_diff_Suc)
+  also have "\<dots> = of_int (b * R)"
+    by (simp add: R sum_distrib_left sum_distrib_right mult_ac)
+  finally have "of_int (a ^ n) = (-of_int (b * R) :: 'a)"
+    by (auto simp: add_eq_0_iff)
+  hence "a ^ n = -b * R"
+    by (simp flip: of_int_mult of_int_power of_int_minus)
+  hence "b dvd a ^ n"
+    by simp
+  with \<open>Rings.coprime a b\<close> have "b dvd 1"
+    by (meson coprime_power_left_iff dvd_refl not_coprimeI)
+  with x_eq and \<open>b > 0\<close> show ?thesis
+    by auto
+qed
+
+lemma algebraic_int_imp_algebraic [dest]: "algebraic_int x \<Longrightarrow> algebraic x"
+  by (auto simp: algebraic_int.simps algebraic_def)
+
+lemma int_imp_algebraic_int:
+  assumes "x \<in> \<int>"
+  shows   "algebraic_int x"
+proof
+  show "\<forall>i. coeff [:-x, 1:] i \<in> \<int>"
+    using assms by (auto simp: coeff_pCons split: nat.splits)
+qed auto
+
+lemma algebraic_int_0 [simp, intro]: "algebraic_int 0"
+  and algebraic_int_1 [simp, intro]: "algebraic_int 1"
+  and algebraic_int_numeral [simp, intro]: "algebraic_int (numeral n)"
+  and algebraic_int_of_nat [simp, intro]: "algebraic_int (of_nat k)"
+  and algebraic_int_of_int [simp, intro]: "algebraic_int (of_int k)"
+  by (simp_all add: int_imp_algebraic_int)
+
+lemma algebraic_int_ii [simp, intro]: "algebraic_int \<i>"
+proof
+  show "poly [:1, 0, 1:] \<i> = 0"
+    by simp
+qed (auto simp: coeff_pCons split: nat.splits)
+
+lemma algebraic_int_minus [intro]:
+  assumes "algebraic_int x"
+  shows   "algebraic_int (-x)"
+proof -
+  from assms obtain p where p: "lead_coeff p = 1" "\<forall>i. coeff p i \<in> \<int>" "poly p x = 0"
+    by (auto simp: algebraic_int.simps)
+  define s where "s = (if even (degree p) then 1 else -1 :: 'a)"
+
+  define q where "q = Polynomial.smult s (pcompose p [:0, -1:])"
+  have "lead_coeff q = s * lead_coeff (pcompose p [:0, -1:])"
+    by (simp add: q_def)
+  also have "lead_coeff (pcompose p [:0, -1:]) = lead_coeff p * (- 1) ^ degree p"
+    by (subst lead_coeff_comp) auto
+  finally have "poly q (-x) = 0" and "lead_coeff q = 1"
+    using p by (auto simp: q_def poly_pcompose s_def)
+  moreover have "coeff q i \<in> \<int>" for i
+  proof -
+    have "coeff (pcompose p [:0, -1:]) i \<in> \<int>"
+      using p by (intro coeff_pcompose_semiring_closed) (auto simp: coeff_pCons split: nat.splits)
+    thus ?thesis by (simp add: q_def s_def)
+  qed
+  ultimately show ?thesis
+    by (auto simp: algebraic_int.simps)
+qed
+
+lemma algebraic_int_minus_iff [simp]:
+  "algebraic_int (-x) \<longleftrightarrow> algebraic_int (x :: 'a :: field_char_0)"
+  using algebraic_int_minus[of x] algebraic_int_minus[of "-x"] by auto
+
+lemma algebraic_int_inverse [intro]:
+  assumes "poly p x = 0" and "\<forall>i. coeff p i \<in> \<int>" and "coeff p 0 = 1"
+  shows   "algebraic_int (inverse x)"
+proof
+  from assms have [simp]: "x \<noteq> 0"
+    by (auto simp: poly_0_coeff_0)
+  show "poly (reflect_poly p) (inverse x) = 0"
+    using assms by (simp add: poly_reflect_poly_nz)
+qed (use assms in \<open>auto simp: coeff_reflect_poly\<close>)
+
+lemma algebraic_int_root:
+  assumes "algebraic_int y" 
+      and "poly p x = y" and "\<forall>i. coeff p i \<in> \<int>" and "lead_coeff p = 1" and "degree p > 0"
+  shows   "algebraic_int x"
+proof -
+  from assms obtain q where q: "poly q y = 0" "\<forall>i. coeff q i \<in> \<int>" "lead_coeff q = 1"
+    by (auto simp: algebraic_int.simps)
+  show ?thesis
+  proof
+    from assms q show "lead_coeff (pcompose q p) = 1"
+      by (subst lead_coeff_comp) auto
+    from assms q show "\<forall>i. coeff (pcompose q p) i \<in> \<int>"
+      by (intro allI coeff_pcompose_semiring_closed) auto
+    show "poly (pcompose q p) x = 0"
+      using assms q by (simp add: poly_pcompose)
+  qed
+qed
+
+lemma algebraic_int_abs_real [simp]:
+  "algebraic_int \<bar>x :: real\<bar> \<longleftrightarrow> algebraic_int x"
+  by (auto simp: abs_if)
+
+lemma algebraic_int_nth_root_real [intro]:
+  assumes "algebraic_int x"
+  shows   "algebraic_int (root n x)"
+proof (cases "n = 0")
+  case False
+  show ?thesis
+  proof (rule algebraic_int_root)
+    show "poly (monom 1 n) (root n x) = (if even n then \<bar>x\<bar> else x)"
+      using sgn_power_root[of n x] False
+      by (auto simp add: poly_monom sgn_if split: if_splits)
+  qed (use False assms in \<open>auto simp: degree_monom_eq\<close>)
+qed auto
+
+lemma algebraic_int_sqrt [intro]: "algebraic_int x \<Longrightarrow> algebraic_int (sqrt x)"
+  by (auto simp: sqrt_def)
+
+lemma algebraic_int_csqrt [intro]: "algebraic_int x \<Longrightarrow> algebraic_int (csqrt x)"
+  by (rule algebraic_int_root[where p = "monom 1 2"])
+     (auto simp: poly_monom degree_monom_eq)
+
+lemma poly_map_poly_cnj [simp]: "poly (map_poly cnj p) x = cnj (poly p (cnj x))"
+  by (induction p) (auto simp: map_poly_pCons)
+
+lemma algebraic_int_cnj [intro]:
+  assumes "algebraic_int x"
+  shows   "algebraic_int (cnj x)"
+proof -
+  from assms obtain p where p: "lead_coeff p = 1" "\<forall>i. coeff p i \<in> \<int>" "poly p x = 0"
+    by (auto simp: algebraic_int.simps)
+  show ?thesis
+  proof
+    show "poly (map_poly cnj p) (cnj x) = 0"
+      using p by simp
+    show "lead_coeff (map_poly cnj p) = 1"
+      using p by (simp add: coeff_map_poly degree_map_poly)
+    show "\<forall>i. coeff (map_poly cnj p) i \<in> \<int>"
+      using p by (auto simp: coeff_map_poly)
+  qed
+qed
+
+lemma algebraic_int_cnj_iff [simp]: "algebraic_int (cnj x) \<longleftrightarrow> algebraic_int x"
+  using algebraic_int_cnj[of x] algebraic_int_cnj[of "cnj x"] by auto
+
+lemma algebraic_int_of_real [intro]:
+  assumes "algebraic_int x"
+  shows   "algebraic_int (of_real x)"
+proof -
+  from assms obtain p where p: "poly p x = 0" "\<forall>i. coeff p i \<in> \<int>" "lead_coeff p = 1"
+    by (auto simp: algebraic_int.simps)
+  show "algebraic_int (of_real x :: 'a)"
+  proof
+    have "poly (map_poly of_real p) (of_real x) = (of_real (poly p x) :: 'a)"
+      by (induction p) (auto simp: map_poly_pCons)
+    thus "poly (map_poly of_real p) (of_real x) = (0 :: 'a)"
+      using p by simp
+  qed (use p in \<open>auto simp: coeff_map_poly degree_map_poly\<close>)
+qed
+
+lemma algebraic_int_of_real_iff [simp]:
+  "algebraic_int (of_real x :: 'a :: {field_char_0, real_algebra_1}) \<longleftrightarrow> algebraic_int x"
+proof
+  assume "algebraic_int (of_real x :: 'a)"
+  then obtain p
+    where p: "poly (map_poly of_int p) (of_real x :: 'a) = 0" "lead_coeff p = 1"
+    by (auto simp: algebraic_int_altdef_ipoly)
+  show "algebraic_int x"
+    unfolding algebraic_int_altdef_ipoly
+  proof (intro exI[of _ p] conjI)
+    have "of_real (poly (map_poly real_of_int p) x) = poly (map_poly of_int p) (of_real x :: 'a)"
+      by (induction p) (auto simp: map_poly_pCons)
+    also note p(1)
+    finally show "poly (map_poly real_of_int p) x = 0" by simp
+  qed (use p in auto)
+qed auto
+
+
 subsection \<open>Division of polynomials\<close>
 
 subsubsection \<open>Division in general\<close>
 
 instantiation poly :: (idom_divide) idom_divide
 begin
 
 fun divide_poly_main :: "'a \<Rightarrow> 'a poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a poly"
   where
     "divide_poly_main lc q r d dr (Suc n) =
       (let cr = coeff r dr; a = cr div lc; mon = monom a n in
         if False \<or> a * lc = cr then \<comment> \<open>\<open>False \<or>\<close> is only because of problem in function-package\<close>
           divide_poly_main
             lc
             (q + mon)
             (r - mon * d)
             d (dr - 1) n else 0)"
   | "divide_poly_main lc q r d dr 0 = q"
 
 definition divide_poly :: "'a poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   where "divide_poly f g =
     (if g = 0 then 0
      else
       divide_poly_main (coeff g (degree g)) 0 f g (degree f)
         (1 + length (coeffs f) - length (coeffs g)))"
 
 lemma divide_poly_main:
   assumes d: "d \<noteq> 0" "lc = coeff d (degree d)"
     and "degree (d * r) \<le> dr" "divide_poly_main lc q (d * r) d dr n = q'"
     and "n = 1 + dr - degree d \<or> dr = 0 \<and> n = 0 \<and> d * r = 0"
   shows "q' = q + r"
   using assms(3-)
 proof (induct n arbitrary: q r dr)
   case (Suc n)
   let ?rr = "d * r"
   let ?a = "coeff ?rr dr"
   let ?qq = "?a div lc"
   define b where [simp]: "b = monom ?qq n"
   let ?rrr =  "d * (r - b)"
   let ?qqq = "q + b"
   note res = Suc(3)
   from Suc(4) have dr: "dr = n + degree d" by auto
   from d have lc: "lc \<noteq> 0" by auto
   have "coeff (b * d) dr = coeff b n * coeff d (degree d)"
   proof (cases "?qq = 0")
     case True
     then show ?thesis by simp
   next
     case False
     then have n: "n = degree b"
       by (simp add: degree_monom_eq)
     show ?thesis
       unfolding n dr by (simp add: coeff_mult_degree_sum)
   qed
   also have "\<dots> = lc * coeff b n"
     by (simp add: d)
   finally have c2: "coeff (b * d) dr = lc * coeff b n" .
   have rrr: "?rrr = ?rr - b * d"
     by (simp add: field_simps)
   have c1: "coeff (d * r) dr = lc * coeff r n"
   proof (cases "degree r = n")
     case True
     with Suc(2) show ?thesis
       unfolding dr using coeff_mult_degree_sum[of d r] d by (auto simp: ac_simps)
   next
     case False
     from dr Suc(2) have "degree r \<le> n"
       by auto
         (metis add.commute add_le_cancel_left d(1) degree_0 degree_mult_eq
           diff_is_0_eq diff_zero le_cases)
     with False have r_n: "degree r < n"
       by auto
     then have right: "lc * coeff r n = 0"
       by (simp add: coeff_eq_0)
     have "coeff (d * r) dr = coeff (d * r) (degree d + n)"
       by (simp add: dr ac_simps)
     also from r_n have "\<dots> = 0"
       by (metis False Suc.prems(1) add.commute add_left_imp_eq coeff_degree_mult coeff_eq_0
         coeff_mult_degree_sum degree_mult_le dr le_eq_less_or_eq)
     finally show ?thesis
       by (simp only: right)
   qed
   have c0: "coeff ?rrr dr = 0"
     and id: "lc * (coeff (d * r) dr div lc) = coeff (d * r) dr"
     unfolding rrr coeff_diff c2
     unfolding b_def coeff_monom coeff_smult c1 using lc by auto
   from res[unfolded divide_poly_main.simps[of lc q] Let_def] id
   have res: "divide_poly_main lc ?qqq ?rrr d (dr - 1) n = q'"
     by (simp del: divide_poly_main.simps add: field_simps)
   note IH = Suc(1)[OF _ res]
   from Suc(4) have dr: "dr = n + degree d" by auto
   from Suc(2) have deg_rr: "degree ?rr \<le> dr" by auto
   have deg_bd: "degree (b * d) \<le> dr"
     unfolding dr b_def by (rule order.trans[OF degree_mult_le]) (auto simp: degree_monom_le)
   have "degree ?rrr \<le> dr"
     unfolding rrr by (rule degree_diff_le[OF deg_rr deg_bd])
   with c0 have deg_rrr: "degree ?rrr \<le> (dr - 1)"
     by (rule coeff_0_degree_minus_1)
   have "n = 1 + (dr - 1) - degree d \<or> dr - 1 = 0 \<and> n = 0 \<and> ?rrr = 0"
   proof (cases dr)
     case 0
     with Suc(4) have 0: "dr = 0" "n = 0" "degree d = 0"
       by auto
     with deg_rrr have "degree ?rrr = 0"
       by simp
     from degree_eq_zeroE[OF this] obtain a where rrr: "?rrr = [:a:]"
       by metis
     show ?thesis
       unfolding 0 using c0 unfolding rrr 0 by simp
   next
     case _: Suc
     with Suc(4) show ?thesis by auto
   qed
   from IH[OF deg_rrr this] show ?case
     by simp
 next
   case 0
   show ?case
   proof (cases "r = 0")
     case True
     with 0 show ?thesis by auto
   next
     case False
     from d False have "degree (d * r) = degree d + degree r"
       by (subst degree_mult_eq) auto
     with 0 d show ?thesis by auto
   qed
 qed
 
 lemma divide_poly_main_0: "divide_poly_main 0 0 r d dr n = 0"
 proof (induct n arbitrary: r d dr)
   case 0
   then show ?case by simp
 next
   case Suc
   show ?case
     unfolding divide_poly_main.simps[of _ _ r] Let_def
     by (simp add: Suc del: divide_poly_main.simps)
 qed
 
 lemma divide_poly:
   assumes g: "g \<noteq> 0"
   shows "(f * g) div g = (f :: 'a poly)"
 proof -
   have len: "length (coeffs f) = Suc (degree f)" if "f \<noteq> 0" for f :: "'a poly"
     using that unfolding degree_eq_length_coeffs by auto
   have "divide_poly_main (coeff g (degree g)) 0 (g * f) g (degree (g * f))
     (1 + length (coeffs (g * f)) - length (coeffs  g)) = (f * g) div g"
     by (simp add: divide_poly_def Let_def ac_simps)
   note main = divide_poly_main[OF g refl le_refl this]
   have "(f * g) div g = 0 + f"
   proof (rule main, goal_cases)
     case 1
     show ?case
     proof (cases "f = 0")
       case True
       with g show ?thesis
         by (auto simp: degree_eq_length_coeffs)
     next
       case False
       with g have fg: "g * f \<noteq> 0" by auto
       show ?thesis
         unfolding len[OF fg] len[OF g] by auto
     qed
   qed
   then show ?thesis by simp
 qed
 
 lemma divide_poly_0: "f div 0 = 0"
   for f :: "'a poly"
   by (simp add: divide_poly_def Let_def divide_poly_main_0)
 
 instance
   by standard (auto simp: divide_poly divide_poly_0)
 
 end
 
 instance poly :: (idom_divide) algebraic_semidom ..
 
 lemma div_const_poly_conv_map_poly:
   assumes "[:c:] dvd p"
   shows "p div [:c:] = map_poly (\<lambda>x. x div c) p"
 proof (cases "c = 0")
   case True
   then show ?thesis
     by (auto intro!: poly_eqI simp: coeff_map_poly)
 next
   case False
   from assms obtain q where p: "p = [:c:] * q" by (rule dvdE)
   moreover {
     have "smult c q = [:c:] * q"
       by simp
     also have "\<dots> div [:c:] = q"
       by (rule nonzero_mult_div_cancel_left) (use False in auto)
     finally have "smult c q div [:c:] = q" .
   }
   ultimately show ?thesis by (intro poly_eqI) (auto simp: coeff_map_poly False)
 qed
 
 lemma is_unit_monom_0:
   fixes a :: "'a::field"
   assumes "a \<noteq> 0"
   shows "is_unit (monom a 0)"
 proof
   from assms show "1 = monom a 0 * monom (inverse a) 0"
     by (simp add: mult_monom)
 qed
 
 lemma is_unit_triv: "a \<noteq> 0 \<Longrightarrow> is_unit [:a:]"
   for a :: "'a::field"
   by (simp add: is_unit_monom_0 monom_0 [symmetric])
 
 lemma is_unit_iff_degree:
   fixes p :: "'a::field poly"
   assumes "p \<noteq> 0"
   shows "is_unit p \<longleftrightarrow> degree p = 0"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?rhs
   then obtain a where "p = [:a:]"
     by (rule degree_eq_zeroE)
   with assms show ?lhs
     by (simp add: is_unit_triv)
 next
   assume ?lhs
   then obtain q where "q \<noteq> 0" "p * q = 1" ..
   then have "degree (p * q) = degree 1"
     by simp
   with \<open>p \<noteq> 0\<close> \<open>q \<noteq> 0\<close> have "degree p + degree q = 0"
     by (simp add: degree_mult_eq)
   then show ?rhs by simp
 qed
 
 lemma is_unit_pCons_iff: "is_unit (pCons a p) \<longleftrightarrow> p = 0 \<and> a \<noteq> 0"
   for p :: "'a::field poly"
   by (cases "p = 0") (auto simp: is_unit_triv is_unit_iff_degree)
 
 lemma is_unit_monom_trivial: "is_unit p \<Longrightarrow> monom (coeff p (degree p)) 0 = p"
   for p :: "'a::field poly"
   by (cases p) (simp_all add: monom_0 is_unit_pCons_iff)
 
 lemma is_unit_const_poly_iff: "[:c:] dvd 1 \<longleftrightarrow> c dvd 1"
   for c :: "'a::{comm_semiring_1,semiring_no_zero_divisors}"
   by (auto simp: one_pCons)
 
 lemma is_unit_polyE:
   fixes p :: "'a :: {comm_semiring_1,semiring_no_zero_divisors} poly"
   assumes "p dvd 1"
   obtains c where "p = [:c:]" "c dvd 1"
 proof -
   from assms obtain q where "1 = p * q"
     by (rule dvdE)
   then have "p \<noteq> 0" and "q \<noteq> 0"
     by auto
   from \<open>1 = p * q\<close> have "degree 1 = degree (p * q)"
     by simp
   also from \<open>p \<noteq> 0\<close> and \<open>q \<noteq> 0\<close> have "\<dots> = degree p + degree q"
     by (simp add: degree_mult_eq)
   finally have "degree p = 0" by simp
   with degree_eq_zeroE obtain c where c: "p = [:c:]" .
   with \<open>p dvd 1\<close> have "c dvd 1"
     by (simp add: is_unit_const_poly_iff)
   with c show thesis ..
 qed
 
 lemma is_unit_polyE':
   fixes p :: "'a::field poly"
   assumes "is_unit p"
   obtains a where "p = monom a 0" and "a \<noteq> 0"
 proof -
   obtain a q where "p = pCons a q"
     by (cases p)
   with assms have "p = [:a:]" and "a \<noteq> 0"
     by (simp_all add: is_unit_pCons_iff)
   with that show thesis by (simp add: monom_0)
 qed
 
 lemma is_unit_poly_iff: "p dvd 1 \<longleftrightarrow> (\<exists>c. p = [:c:] \<and> c dvd 1)"
   for p :: "'a::{comm_semiring_1,semiring_no_zero_divisors} poly"
   by (auto elim: is_unit_polyE simp add: is_unit_const_poly_iff)
 
 
 subsubsection \<open>Pseudo-Division\<close>
 
 text \<open>This part is by René Thiemann and Akihisa Yamada.\<close>
 
 fun pseudo_divmod_main ::
   "'a :: comm_ring_1  \<Rightarrow> 'a poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a poly \<times> 'a poly"
   where
     "pseudo_divmod_main lc q r d dr (Suc n) =
       (let
         rr = smult lc r;
         qq = coeff r dr;
         rrr = rr - monom qq n * d;
         qqq = smult lc q + monom qq n
        in pseudo_divmod_main lc qqq rrr d (dr - 1) n)"
   | "pseudo_divmod_main lc q r d dr 0 = (q,r)"
 
 definition pseudo_divmod :: "'a :: comm_ring_1 poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly \<times> 'a poly"
   where "pseudo_divmod p q \<equiv>
     if q = 0 then (0, p)
     else
       pseudo_divmod_main (coeff q (degree q)) 0 p q (degree p)
         (1 + length (coeffs p) - length (coeffs q))"
 
 lemma pseudo_divmod_main:
   assumes d: "d \<noteq> 0" "lc = coeff d (degree d)"
     and "degree r \<le> dr" "pseudo_divmod_main lc q r d dr n = (q',r')"
     and "n = 1 + dr - degree d \<or> dr = 0 \<and> n = 0 \<and> r = 0"
   shows "(r' = 0 \<or> degree r' < degree d) \<and> smult (lc^n) (d * q + r) = d * q' + r'"
   using assms(3-)
 proof (induct n arbitrary: q r dr)
   case 0
   then show ?case by auto
 next
   case (Suc n)
   let ?rr = "smult lc r"
   let ?qq = "coeff r dr"
   define b where [simp]: "b = monom ?qq n"
   let ?rrr = "?rr - b * d"
   let ?qqq = "smult lc q + b"
   note res = Suc(3)
   from res[unfolded pseudo_divmod_main.simps[of lc q] Let_def]
   have res: "pseudo_divmod_main lc ?qqq ?rrr d (dr - 1) n = (q',r')"
     by (simp del: pseudo_divmod_main.simps)
   from Suc(4) have dr: "dr = n + degree d" by auto
   have "coeff (b * d) dr = coeff b n * coeff d (degree d)"
   proof (cases "?qq = 0")
     case True
     then show ?thesis by auto
   next
     case False
     then have n: "n = degree b"
       by (simp add: degree_monom_eq)
     show ?thesis
       unfolding n dr by (simp add: coeff_mult_degree_sum)
   qed
   also have "\<dots> = lc * coeff b n" by (simp add: d)
   finally have "coeff (b * d) dr = lc * coeff b n" .
   moreover have "coeff ?rr dr = lc * coeff r dr"
     by simp
   ultimately have c0: "coeff ?rrr dr = 0"
     by auto
   from Suc(4) have dr: "dr = n + degree d" by auto
   have deg_rr: "degree ?rr \<le> dr"
     using Suc(2) degree_smult_le dual_order.trans by blast
   have deg_bd: "degree (b * d) \<le> dr"
     unfolding dr by (rule order.trans[OF degree_mult_le]) (auto simp: degree_monom_le)
   have "degree ?rrr \<le> dr"
     using degree_diff_le[OF deg_rr deg_bd] by auto
   with c0 have deg_rrr: "degree ?rrr \<le> (dr - 1)"
     by (rule coeff_0_degree_minus_1)
   have "n = 1 + (dr - 1) - degree d \<or> dr - 1 = 0 \<and> n = 0 \<and> ?rrr = 0"
   proof (cases dr)
     case 0
     with Suc(4) have 0: "dr = 0" "n = 0" "degree d = 0" by auto
     with deg_rrr have "degree ?rrr = 0" by simp
     then have "\<exists>a. ?rrr = [:a:]"
       by (metis degree_pCons_eq_if old.nat.distinct(2) pCons_cases)
     from this obtain a where rrr: "?rrr = [:a:]"
       by auto
     show ?thesis
       unfolding 0 using c0 unfolding rrr 0 by simp
   next
     case _: Suc
     with Suc(4) show ?thesis by auto
   qed
   note IH = Suc(1)[OF deg_rrr res this]
   show ?case
   proof (intro conjI)
     from IH show "r' = 0 \<or> degree r' < degree d"
       by blast
     show "smult (lc ^ Suc n) (d * q + r) = d * q' + r'"
       unfolding IH[THEN conjunct2,symmetric]
       by (simp add: field_simps smult_add_right)
   qed
 qed
 
 lemma pseudo_divmod:
   assumes g: "g \<noteq> 0"
     and *: "pseudo_divmod f g = (q,r)"
   shows "smult (coeff g (degree g) ^ (Suc (degree f) - degree g)) f = g * q + r"  (is ?A)
     and "r = 0 \<or> degree r < degree g"  (is ?B)
 proof -
   from *[unfolded pseudo_divmod_def Let_def]
   have "pseudo_divmod_main (coeff g (degree g)) 0 f g (degree f)
       (1 + length (coeffs f) - length (coeffs g)) = (q, r)"
     by (auto simp: g)
   note main = pseudo_divmod_main[OF _ _ _ this, OF g refl le_refl]
   from g have "1 + length (coeffs f) - length (coeffs g) = 1 + degree f - degree g \<or>
     degree f = 0 \<and> 1 + length (coeffs f) - length (coeffs g) = 0 \<and> f = 0"
     by (cases "f = 0"; cases "coeffs g") (auto simp: degree_eq_length_coeffs)
   note main' = main[OF this]
   then show "r = 0 \<or> degree r < degree g" by auto
   show "smult (coeff g (degree g) ^ (Suc (degree f) - degree g)) f = g * q + r"
     by (subst main'[THEN conjunct2, symmetric], simp add: degree_eq_length_coeffs,
         cases "f = 0"; cases "coeffs g", use g in auto)
 qed
 
 definition "pseudo_mod_main lc r d dr n = snd (pseudo_divmod_main lc 0 r d dr n)"
 
 lemma snd_pseudo_divmod_main:
   "snd (pseudo_divmod_main lc q r d dr n) = snd (pseudo_divmod_main lc q' r d dr n)"
   by (induct n arbitrary: q q' lc r d dr) (simp_all add: Let_def)
 
 definition pseudo_mod :: "'a::{comm_ring_1,semiring_1_no_zero_divisors} poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   where "pseudo_mod f g = snd (pseudo_divmod f g)"
 
 lemma pseudo_mod:
   fixes f g :: "'a::{comm_ring_1,semiring_1_no_zero_divisors} poly"
   defines "r \<equiv> pseudo_mod f g"
   assumes g: "g \<noteq> 0"
   shows "\<exists>a q. a \<noteq> 0 \<and> smult a f = g * q + r" "r = 0 \<or> degree r < degree g"
 proof -
   let ?cg = "coeff g (degree g)"
   let ?cge = "?cg ^ (Suc (degree f) - degree g)"
   define a where "a = ?cge"
   from r_def[unfolded pseudo_mod_def] obtain q where pdm: "pseudo_divmod f g = (q, r)"
     by (cases "pseudo_divmod f g") auto
   from pseudo_divmod[OF g pdm] have id: "smult a f = g * q + r" and "r = 0 \<or> degree r < degree g"
     by (auto simp: a_def)
   show "r = 0 \<or> degree r < degree g" by fact
   from g have "a \<noteq> 0"
     by (auto simp: a_def)
   with id show "\<exists>a q. a \<noteq> 0 \<and> smult a f = g * q + r"
     by auto
 qed
 
 lemma fst_pseudo_divmod_main_as_divide_poly_main:
   assumes d: "d \<noteq> 0"
   defines lc: "lc \<equiv> coeff d (degree d)"
   shows "fst (pseudo_divmod_main lc q r d dr n) =
     divide_poly_main lc (smult (lc^n) q) (smult (lc^n) r) d dr n"
 proof (induct n arbitrary: q r dr)
   case 0
   then show ?case by simp
 next
   case (Suc n)
   note lc0 = leading_coeff_neq_0[OF d, folded lc]
   then have "pseudo_divmod_main lc q r d dr (Suc n) =
     pseudo_divmod_main lc (smult lc q + monom (coeff r dr) n)
       (smult lc r - monom (coeff r dr) n * d) d (dr - 1) n"
     by (simp add: Let_def ac_simps)
   also have "fst \<dots> = divide_poly_main lc
      (smult (lc^n) (smult lc q + monom (coeff r dr) n))
      (smult (lc^n) (smult lc r - monom (coeff r dr) n * d))
      d (dr - 1) n"
     by (simp only: Suc[unfolded divide_poly_main.simps Let_def])
   also have "\<dots> = divide_poly_main lc (smult (lc ^ Suc n) q) (smult (lc ^ Suc n) r) d dr (Suc n)"
     unfolding smult_monom smult_distribs mult_smult_left[symmetric]
     using lc0 by (simp add: Let_def ac_simps)
   finally show ?case .
 qed
 
 
 subsubsection \<open>Division in polynomials over fields\<close>
 
 lemma pseudo_divmod_field:
   fixes g :: "'a::field poly"
   assumes g: "g \<noteq> 0"
     and *: "pseudo_divmod f g = (q,r)"
   defines "c \<equiv> coeff g (degree g) ^ (Suc (degree f) - degree g)"
   shows "f = g * smult (1/c) q + smult (1/c) r"
 proof -
   from leading_coeff_neq_0[OF g] have c0: "c \<noteq> 0"
     by (auto simp: c_def)
   from pseudo_divmod(1)[OF g *, folded c_def] have "smult c f = g * q + r"
     by auto
   also have "smult (1 / c) \<dots> = g * smult (1 / c) q + smult (1 / c) r"
     by (simp add: smult_add_right)
   finally show ?thesis
     using c0 by auto
 qed
 
 lemma divide_poly_main_field:
   fixes d :: "'a::field poly"
   assumes d: "d \<noteq> 0"
   defines lc: "lc \<equiv> coeff d (degree d)"
   shows "divide_poly_main lc q r d dr n =
     fst (pseudo_divmod_main lc (smult ((1 / lc)^n) q) (smult ((1 / lc)^n) r) d dr n)"
   unfolding lc by (subst fst_pseudo_divmod_main_as_divide_poly_main) (auto simp: d power_one_over)
 
 lemma divide_poly_field:
   fixes f g :: "'a::field poly"
   defines "f' \<equiv> smult ((1 / coeff g (degree g)) ^ (Suc (degree f) - degree g)) f"
   shows "f div g = fst (pseudo_divmod f' g)"
 proof (cases "g = 0")
   case True
   show ?thesis
     unfolding divide_poly_def pseudo_divmod_def Let_def f'_def True
     by (simp add: divide_poly_main_0)
 next
   case False
   from leading_coeff_neq_0[OF False] have "degree f' = degree f"
     by (auto simp: f'_def)
   then show ?thesis
     using length_coeffs_degree[of f'] length_coeffs_degree[of f]
     unfolding divide_poly_def pseudo_divmod_def Let_def
       divide_poly_main_field[OF False]
       length_coeffs_degree[OF False]
       f'_def
     by force
 qed
 
 instantiation poly :: ("{semidom_divide_unit_factor,idom_divide}") normalization_semidom
 begin
 
 definition unit_factor_poly :: "'a poly \<Rightarrow> 'a poly"
   where "unit_factor_poly p = [:unit_factor (lead_coeff p):]"
 
 definition normalize_poly :: "'a poly \<Rightarrow> 'a poly"
   where "normalize p = p div [:unit_factor (lead_coeff p):]"
 
 instance
 proof
   fix p :: "'a poly"
   show "unit_factor p * normalize p = p"
   proof (cases "p = 0")
     case True
     then show ?thesis
       by (simp add: unit_factor_poly_def normalize_poly_def)
   next
     case False
     then have "lead_coeff p \<noteq> 0"
       by simp
     then have *: "unit_factor (lead_coeff p) \<noteq> 0"
       using unit_factor_is_unit [of "lead_coeff p"] by auto
     then have "unit_factor (lead_coeff p) dvd 1"
       by (auto intro: unit_factor_is_unit)
     then have **: "unit_factor (lead_coeff p) dvd c" for c
       by (rule dvd_trans) simp
     have ***: "unit_factor (lead_coeff p) * (c div unit_factor (lead_coeff p)) = c" for c
     proof -
       from ** obtain b where "c = unit_factor (lead_coeff p) * b" ..
       with False * show ?thesis by simp
     qed
     have "p div [:unit_factor (lead_coeff p):] =
       map_poly (\<lambda>c. c div unit_factor (lead_coeff p)) p"
       by (simp add: const_poly_dvd_iff div_const_poly_conv_map_poly **)
     then show ?thesis
       by (simp add: normalize_poly_def unit_factor_poly_def
         smult_conv_map_poly map_poly_map_poly o_def ***)
   qed
 next
   fix p :: "'a poly"
   assume "is_unit p"
   then obtain c where p: "p = [:c:]" "c dvd 1"
     by (auto simp: is_unit_poly_iff)
   then show "unit_factor p = p"
     by (simp add: unit_factor_poly_def monom_0 is_unit_unit_factor)
 next
   fix p :: "'a poly"
   assume "p \<noteq> 0"
   then show "is_unit (unit_factor p)"
     by (simp add: unit_factor_poly_def monom_0 is_unit_poly_iff unit_factor_is_unit)
 next
   fix a b :: "'a poly" assume "is_unit a" 
   thus "unit_factor (a * b) = a * unit_factor b"
     by (auto simp: unit_factor_poly_def lead_coeff_mult unit_factor_mult elim!: is_unit_polyE)
 qed (simp_all add: normalize_poly_def unit_factor_poly_def monom_0 lead_coeff_mult unit_factor_mult)
 
 end
 
 instance poly :: ("{semidom_divide_unit_factor,idom_divide,normalization_semidom_multiplicative}") 
   normalization_semidom_multiplicative
   by intro_classes (auto simp: unit_factor_poly_def lead_coeff_mult unit_factor_mult)
 
 lemma normalize_poly_eq_map_poly: "normalize p = map_poly (\<lambda>x. x div unit_factor (lead_coeff p)) p"
 proof -
   have "[:unit_factor (lead_coeff p):] dvd p"
     by (metis unit_factor_poly_def unit_factor_self)
   then show ?thesis
     by (simp add: normalize_poly_def div_const_poly_conv_map_poly)
 qed
 
 lemma coeff_normalize [simp]:
   "coeff (normalize p) n = coeff p n div unit_factor (lead_coeff p)"
   by (simp add: normalize_poly_eq_map_poly coeff_map_poly)
 
 class field_unit_factor = field + unit_factor +
   assumes unit_factor_field [simp]: "unit_factor = id"
 begin
 
 subclass semidom_divide_unit_factor
 proof
   fix a
   assume "a \<noteq> 0"
   then have "1 = a * inverse a" by simp
   then have "a dvd 1" ..
   then show "unit_factor a dvd 1" by simp
 qed simp_all
 
 end
 
 lemma unit_factor_pCons:
   "unit_factor (pCons a p) = (if p = 0 then [:unit_factor a:] else unit_factor p)"
   by (simp add: unit_factor_poly_def)
 
 lemma normalize_monom [simp]: "normalize (monom a n) = monom (normalize a) n"
   by (cases "a = 0") (simp_all add: map_poly_monom normalize_poly_eq_map_poly degree_monom_eq)
 
 lemma unit_factor_monom [simp]: "unit_factor (monom a n) = [:unit_factor a:]"
   by (cases "a = 0") (simp_all add: unit_factor_poly_def degree_monom_eq)
 
 lemma normalize_const_poly: "normalize [:c:] = [:normalize c:]"
   by (simp add: normalize_poly_eq_map_poly map_poly_pCons)
 
 lemma normalize_smult:
   fixes c :: "'a :: {normalization_semidom_multiplicative, idom_divide}"
   shows "normalize (smult c p) = smult (normalize c) (normalize p)"
 proof -
   have "smult c p = [:c:] * p" by simp
   also have "normalize \<dots> = smult (normalize c) (normalize p)"
     by (subst normalize_mult) (simp add: normalize_const_poly)
   finally show ?thesis .
 qed
 
 inductive eucl_rel_poly :: "'a::field poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly \<times> 'a poly \<Rightarrow> bool"
   where
     eucl_rel_poly_by0: "eucl_rel_poly x 0 (0, x)"
   | eucl_rel_poly_dividesI: "y \<noteq> 0 \<Longrightarrow> x = q * y \<Longrightarrow> eucl_rel_poly x y (q, 0)"
   | eucl_rel_poly_remainderI:
       "y \<noteq> 0 \<Longrightarrow> degree r < degree y \<Longrightarrow> x = q * y + r \<Longrightarrow> eucl_rel_poly x y (q, r)"
 
 lemma eucl_rel_poly_iff:
   "eucl_rel_poly x y (q, r) \<longleftrightarrow>
     x = q * y + r \<and> (if y = 0 then q = 0 else r = 0 \<or> degree r < degree y)"
   by (auto elim: eucl_rel_poly.cases
       intro: eucl_rel_poly_by0 eucl_rel_poly_dividesI eucl_rel_poly_remainderI)
 
 lemma eucl_rel_poly_0: "eucl_rel_poly 0 y (0, 0)"
   by (simp add: eucl_rel_poly_iff)
 
 lemma eucl_rel_poly_by_0: "eucl_rel_poly x 0 (0, x)"
   by (simp add: eucl_rel_poly_iff)
 
 lemma eucl_rel_poly_pCons:
   assumes rel: "eucl_rel_poly x y (q, r)"
   assumes y: "y \<noteq> 0"
   assumes b: "b = coeff (pCons a r) (degree y) / coeff y (degree y)"
   shows "eucl_rel_poly (pCons a x) y (pCons b q, pCons a r - smult b y)"
     (is "eucl_rel_poly ?x y (?q, ?r)")
 proof -
   from assms have x: "x = q * y + r" and r: "r = 0 \<or> degree r < degree y"
     by (simp_all add: eucl_rel_poly_iff)
   from b x have "?x = ?q * y + ?r" by simp
   moreover
   have "?r = 0 \<or> degree ?r < degree y"
   proof (rule eq_zero_or_degree_less)
     show "degree ?r \<le> degree y"
     proof (rule degree_diff_le)
       from r show "degree (pCons a r) \<le> degree y"
         by auto
       show "degree (smult b y) \<le> degree y"
         by (rule degree_smult_le)
     qed
     from \<open>y \<noteq> 0\<close> show "coeff ?r (degree y) = 0"
       by (simp add: b)
   qed
   ultimately show ?thesis
     unfolding eucl_rel_poly_iff using \<open>y \<noteq> 0\<close> by simp
 qed
 
 lemma eucl_rel_poly_exists: "\<exists>q r. eucl_rel_poly x y (q, r)"
 proof (cases "y = 0")
   case False
   show ?thesis
   proof (induction x)
     case 0
     then show ?case
       using eucl_rel_poly_0 by blast 
   next
     case (pCons a x)
     then show ?case
       using False eucl_rel_poly_pCons by blast
   qed
 qed (use eucl_rel_poly_by0 in blast)
 
 lemma eucl_rel_poly_unique:
   assumes 1: "eucl_rel_poly x y (q1, r1)"
   assumes 2: "eucl_rel_poly x y (q2, r2)"
   shows "q1 = q2 \<and> r1 = r2"
 proof (cases "y = 0")
   assume "y = 0"
   with assms show ?thesis
     by (simp add: eucl_rel_poly_iff)
 next
   assume [simp]: "y \<noteq> 0"
   from 1 have q1: "x = q1 * y + r1" and r1: "r1 = 0 \<or> degree r1 < degree y"
     unfolding eucl_rel_poly_iff by simp_all
   from 2 have q2: "x = q2 * y + r2" and r2: "r2 = 0 \<or> degree r2 < degree y"
     unfolding eucl_rel_poly_iff by simp_all
   from q1 q2 have q3: "(q1 - q2) * y = r2 - r1"
     by (simp add: algebra_simps)
   from r1 r2 have r3: "(r2 - r1) = 0 \<or> degree (r2 - r1) < degree y"
     by (auto intro: degree_diff_less)
   show "q1 = q2 \<and> r1 = r2"
   proof (rule classical)
     assume "\<not> ?thesis"
     with q3 have "q1 \<noteq> q2" and "r1 \<noteq> r2" by auto
     with r3 have "degree (r2 - r1) < degree y" by simp
     also have "degree y \<le> degree (q1 - q2) + degree y" by simp
     also from \<open>q1 \<noteq> q2\<close> have "\<dots> = degree ((q1 - q2) * y)"
       by (simp add: degree_mult_eq)
     also from q3 have "\<dots> = degree (r2 - r1)"
       by simp
     finally have "degree (r2 - r1) < degree (r2 - r1)" .
     then show ?thesis by simp
   qed
 qed
 
 lemma eucl_rel_poly_0_iff: "eucl_rel_poly 0 y (q, r) \<longleftrightarrow> q = 0 \<and> r = 0"
   by (auto dest: eucl_rel_poly_unique intro: eucl_rel_poly_0)
 
 lemma eucl_rel_poly_by_0_iff: "eucl_rel_poly x 0 (q, r) \<longleftrightarrow> q = 0 \<and> r = x"
   by (auto dest: eucl_rel_poly_unique intro: eucl_rel_poly_by_0)
 
 lemmas eucl_rel_poly_unique_div = eucl_rel_poly_unique [THEN conjunct1]
 
 lemmas eucl_rel_poly_unique_mod = eucl_rel_poly_unique [THEN conjunct2]
 
 instantiation poly :: (field) semidom_modulo
 begin
 
 definition modulo_poly :: "'a poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   where mod_poly_def: "f mod g =
     (if g = 0 then f else pseudo_mod (smult ((1 / lead_coeff g) ^ (Suc (degree f) - degree g)) f) g)"
 
 instance
 proof
   fix x y :: "'a poly"
   show "x div y * y + x mod y = x"
   proof (cases "y = 0")
     case True
     then show ?thesis
       by (simp add: divide_poly_0 mod_poly_def)
   next
     case False
     then have "pseudo_divmod (smult ((1 / lead_coeff y) ^ (Suc (degree x) - degree y)) x) y =
         (x div y, x mod y)"
       by (simp add: divide_poly_field mod_poly_def pseudo_mod_def)
     with False pseudo_divmod [OF False this] show ?thesis
       by (simp add: power_mult_distrib [symmetric] ac_simps)
   qed
 qed
 
 end
 
 lemma eucl_rel_poly: "eucl_rel_poly x y (x div y, x mod y)"
   unfolding eucl_rel_poly_iff
 proof
   show "x = x div y * y + x mod y"
     by (simp add: div_mult_mod_eq)
   show "if y = 0 then x div y = 0 else x mod y = 0 \<or> degree (x mod y) < degree y"
   proof (cases "y = 0")
     case True
     then show ?thesis by auto
   next
     case False
     with pseudo_mod[OF this] show ?thesis
       by (simp add: mod_poly_def)
   qed
 qed
 
 lemma div_poly_eq: "eucl_rel_poly x y (q, r) \<Longrightarrow> x div y = q"
   for x :: "'a::field poly"
   by (rule eucl_rel_poly_unique_div [OF eucl_rel_poly])
 
 lemma mod_poly_eq: "eucl_rel_poly x y (q, r) \<Longrightarrow> x mod y = r"
   for x :: "'a::field poly"
   by (rule eucl_rel_poly_unique_mod [OF eucl_rel_poly])
 
 instance poly :: (field) idom_modulo ..
 
 lemma div_pCons_eq:
   "pCons a p div q =
     (if q = 0 then 0
      else pCons (coeff (pCons a (p mod q)) (degree q) / lead_coeff q) (p div q))"
   using eucl_rel_poly_pCons [OF eucl_rel_poly _ refl, of q a p]
   by (auto intro: div_poly_eq)
 
 lemma mod_pCons_eq:
   "pCons a p mod q =
     (if q = 0 then pCons a p
      else pCons a (p mod q) - smult (coeff (pCons a (p mod q)) (degree q) / lead_coeff q) q)"
   using eucl_rel_poly_pCons [OF eucl_rel_poly _ refl, of q a p]
   by (auto intro: mod_poly_eq)
 
 lemma div_mod_fold_coeffs:
   "(p div q, p mod q) =
     (if q = 0 then (0, p)
      else
       fold_coeffs
         (\<lambda>a (s, r).
           let b = coeff (pCons a r) (degree q) / coeff q (degree q)
           in (pCons b s, pCons a r - smult b q)) p (0, 0))"
   by (rule sym, induct p) (auto simp: div_pCons_eq mod_pCons_eq Let_def)
 
 lemma degree_mod_less: "y \<noteq> 0 \<Longrightarrow> x mod y = 0 \<or> degree (x mod y) < degree y"
   using eucl_rel_poly [of x y] unfolding eucl_rel_poly_iff by simp
 
 lemma degree_mod_less': "b \<noteq> 0 \<Longrightarrow> a mod b \<noteq> 0 \<Longrightarrow> degree (a mod b) < degree b"
   using degree_mod_less[of b a] by auto
 
 lemma div_poly_less:
   fixes x :: "'a::field poly"
   assumes "degree x < degree y"
   shows "x div y = 0"
 proof -
   from assms have "eucl_rel_poly x y (0, x)"
     by (simp add: eucl_rel_poly_iff)
   then show "x div y = 0"
     by (rule div_poly_eq)
 qed
 
 lemma mod_poly_less:
   assumes "degree x < degree y"
   shows "x mod y = x"
 proof -
   from assms have "eucl_rel_poly x y (0, x)"
     by (simp add: eucl_rel_poly_iff)
   then show "x mod y = x"
     by (rule mod_poly_eq)
 qed
 
 lemma eucl_rel_poly_smult_left:
   "eucl_rel_poly x y (q, r) \<Longrightarrow> eucl_rel_poly (smult a x) y (smult a q, smult a r)"
   by (simp add: eucl_rel_poly_iff smult_add_right)
 
 lemma div_smult_left: "(smult a x) div y = smult a (x div y)"
   for x y :: "'a::field poly"
   by (rule div_poly_eq, rule eucl_rel_poly_smult_left, rule eucl_rel_poly)
 
 lemma mod_smult_left: "(smult a x) mod y = smult a (x mod y)"
   by (rule mod_poly_eq, rule eucl_rel_poly_smult_left, rule eucl_rel_poly)
 
 lemma poly_div_minus_left [simp]: "(- x) div y = - (x div y)"
   for x y :: "'a::field poly"
   using div_smult_left [of "- 1::'a"] by simp
 
 lemma poly_mod_minus_left [simp]: "(- x) mod y = - (x mod y)"
   for x y :: "'a::field poly"
   using mod_smult_left [of "- 1::'a"] by simp
 
 lemma eucl_rel_poly_add_left:
   assumes "eucl_rel_poly x y (q, r)"
   assumes "eucl_rel_poly x' y (q', r')"
   shows "eucl_rel_poly (x + x') y (q + q', r + r')"
   using assms unfolding eucl_rel_poly_iff
   by (auto simp: algebra_simps degree_add_less)
 
 lemma poly_div_add_left: "(x + y) div z = x div z + y div z"
   for x y z :: "'a::field poly"
   using eucl_rel_poly_add_left [OF eucl_rel_poly eucl_rel_poly]
   by (rule div_poly_eq)
 
 lemma poly_mod_add_left: "(x + y) mod z = x mod z + y mod z"
   for x y z :: "'a::field poly"
   using eucl_rel_poly_add_left [OF eucl_rel_poly eucl_rel_poly]
   by (rule mod_poly_eq)
 
 lemma poly_div_diff_left: "(x - y) div z = x div z - y div z"
   for x y z :: "'a::field poly"
   by (simp only: diff_conv_add_uminus poly_div_add_left poly_div_minus_left)
 
 lemma poly_mod_diff_left: "(x - y) mod z = x mod z - y mod z"
   for x y z :: "'a::field poly"
   by (simp only: diff_conv_add_uminus poly_mod_add_left poly_mod_minus_left)
 
 lemma eucl_rel_poly_smult_right:
   "a \<noteq> 0 \<Longrightarrow> eucl_rel_poly x y (q, r) \<Longrightarrow> eucl_rel_poly x (smult a y) (smult (inverse a) q, r)"
   by (simp add: eucl_rel_poly_iff)
 
 lemma div_smult_right: "a \<noteq> 0 \<Longrightarrow> x div (smult a y) = smult (inverse a) (x div y)"
   for x y :: "'a::field poly"
   by (rule div_poly_eq, erule eucl_rel_poly_smult_right, rule eucl_rel_poly)
 
 lemma mod_smult_right: "a \<noteq> 0 \<Longrightarrow> x mod (smult a y) = x mod y"
   by (rule mod_poly_eq, erule eucl_rel_poly_smult_right, rule eucl_rel_poly)
 
 lemma poly_div_minus_right [simp]: "x div (- y) = - (x div y)"
   for x y :: "'a::field poly"
   using div_smult_right [of "- 1::'a"] by (simp add: nonzero_inverse_minus_eq)
 
 lemma poly_mod_minus_right [simp]: "x mod (- y) = x mod y"
   for x y :: "'a::field poly"
   using mod_smult_right [of "- 1::'a"] by simp
 
 lemma eucl_rel_poly_mult:
   assumes "eucl_rel_poly x y (q, r)" "eucl_rel_poly q z (q', r')"
   shows "eucl_rel_poly x (y * z) (q', y * r' + r)"
 proof (cases "y = 0")
   case True
   with assms eucl_rel_poly_0_iff show ?thesis
     by (force simp add: eucl_rel_poly_iff)
 next
   case False
   show ?thesis
   proof (cases "r' = 0")
     case True
     with assms show ?thesis
       by (auto simp add: eucl_rel_poly_iff degree_mult_eq)
   next
     case False
     with assms \<open>y \<noteq> 0\<close> show ?thesis
       by (auto simp add: eucl_rel_poly_iff degree_add_less degree_mult_eq field_simps)
   qed
 qed
 
 lemma poly_div_mult_right: "x div (y * z) = (x div y) div z"
   for x y z :: "'a::field poly"
   by (rule div_poly_eq, rule eucl_rel_poly_mult, (rule eucl_rel_poly)+)
 
 lemma poly_mod_mult_right: "x mod (y * z) = y * (x div y mod z) + x mod y"
   for x y z :: "'a::field poly"
   by (rule mod_poly_eq, rule eucl_rel_poly_mult, (rule eucl_rel_poly)+)
 
 lemma mod_pCons:
   fixes a :: "'a::field"
     and x y :: "'a::field poly"
   assumes y: "y \<noteq> 0"
   defines "b \<equiv> coeff (pCons a (x mod y)) (degree y) / coeff y (degree y)"
   shows "(pCons a x) mod y = pCons a (x mod y) - smult b y"
   unfolding b_def
   by (rule mod_poly_eq, rule eucl_rel_poly_pCons [OF eucl_rel_poly y refl])
 
 
 subsubsection \<open>List-based versions for fast implementation\<close>
 (* Subsection by:
       Sebastiaan Joosten
       René Thiemann
       Akihisa Yamada
     *)
 fun minus_poly_rev_list :: "'a :: group_add list \<Rightarrow> 'a list \<Rightarrow> 'a list"
   where
     "minus_poly_rev_list (x # xs) (y # ys) = (x - y) # (minus_poly_rev_list xs ys)"
   | "minus_poly_rev_list xs [] = xs"
   | "minus_poly_rev_list [] (y # ys) = []"
 
 fun pseudo_divmod_main_list ::
   "'a::comm_ring_1 \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> 'a list \<times> 'a list"
   where
     "pseudo_divmod_main_list lc q r d (Suc n) =
       (let
         rr = map ((*) lc) r;
         a = hd r;
         qqq = cCons a (map ((*) lc) q);
         rrr = tl (if a = 0 then rr else minus_poly_rev_list rr (map ((*) a) d))
        in pseudo_divmod_main_list lc qqq rrr d n)"
   | "pseudo_divmod_main_list lc q r d 0 = (q, r)"
 
 fun pseudo_mod_main_list :: "'a::comm_ring_1 \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> 'a list"
   where
     "pseudo_mod_main_list lc r d (Suc n) =
       (let
         rr = map ((*) lc) r;
         a = hd r;
         rrr = tl (if a = 0 then rr else minus_poly_rev_list rr (map ((*) a) d))
        in pseudo_mod_main_list lc rrr d n)"
   | "pseudo_mod_main_list lc r d 0 = r"
 
 
 fun divmod_poly_one_main_list ::
     "'a::comm_ring_1 list \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> 'a list \<times> 'a list"
   where
     "divmod_poly_one_main_list q r d (Suc n) =
       (let
         a = hd r;
         qqq = cCons a q;
         rr = tl (if a = 0 then r else minus_poly_rev_list r (map ((*) a) d))
        in divmod_poly_one_main_list qqq rr d n)"
   | "divmod_poly_one_main_list q r d 0 = (q, r)"
 
 fun mod_poly_one_main_list :: "'a::comm_ring_1 list \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> 'a list"
   where
     "mod_poly_one_main_list r d (Suc n) =
       (let
         a = hd r;
         rr = tl (if a = 0 then r else minus_poly_rev_list r (map ((*) a) d))
        in mod_poly_one_main_list rr d n)"
   | "mod_poly_one_main_list r d 0 = r"
 
 definition pseudo_divmod_list :: "'a::comm_ring_1 list \<Rightarrow> 'a list \<Rightarrow> 'a list \<times> 'a list"
   where "pseudo_divmod_list p q =
     (if q = [] then ([], p)
      else
       (let rq = rev q;
         (qu,re) = pseudo_divmod_main_list (hd rq) [] (rev p) rq (1 + length p - length q)
        in (qu, rev re)))"
 
 definition pseudo_mod_list :: "'a::comm_ring_1 list \<Rightarrow> 'a list \<Rightarrow> 'a list"
   where "pseudo_mod_list p q =
     (if q = [] then p
      else
       (let
         rq = rev q;
         re = pseudo_mod_main_list (hd rq) (rev p) rq (1 + length p - length q)
        in rev re))"
 
 lemma minus_zero_does_nothing: "minus_poly_rev_list x (map ((*) 0) y) = x"
   for x :: "'a::ring list"
   by (induct x y rule: minus_poly_rev_list.induct) auto
 
 lemma length_minus_poly_rev_list [simp]: "length (minus_poly_rev_list xs ys) = length xs"
   by (induct xs ys rule: minus_poly_rev_list.induct) auto
 
 lemma if_0_minus_poly_rev_list:
   "(if a = 0 then x else minus_poly_rev_list x (map ((*) a) y)) =
     minus_poly_rev_list x (map ((*) a) y)"
   for a :: "'a::ring"
   by(cases "a = 0") (simp_all add: minus_zero_does_nothing)
 
 lemma Poly_append: "Poly (a @ b) = Poly a + monom 1 (length a) * Poly b"
   for a :: "'a::comm_semiring_1 list"
   by (induct a) (auto simp: monom_0 monom_Suc)
 
 lemma minus_poly_rev_list: "length p \<ge> length q \<Longrightarrow>
   Poly (rev (minus_poly_rev_list (rev p) (rev q))) =
     Poly p - monom 1 (length p - length q) * Poly q"
   for p q :: "'a :: comm_ring_1 list"
 proof (induct "rev p" "rev q" arbitrary: p q rule: minus_poly_rev_list.induct)
   case (1 x xs y ys)
   then have "length (rev q) \<le> length (rev p)"
     by simp
   from this[folded 1(2,3)] have ys_xs: "length ys \<le> length xs"
     by simp
   then have *: "Poly (rev (minus_poly_rev_list xs ys)) =
       Poly (rev xs) - monom 1 (length xs - length ys) * Poly (rev ys)"
     by (subst "1.hyps"(1)[of "rev xs" "rev ys", unfolded rev_rev_ident length_rev]) auto
   have "Poly p - monom 1 (length p - length q) * Poly q =
     Poly (rev (rev p)) - monom 1 (length (rev (rev p)) - length (rev (rev q))) * Poly (rev (rev q))"
     by simp
   also have "\<dots> =
       Poly (rev (x # xs)) - monom 1 (length (x # xs) - length (y # ys)) * Poly (rev (y # ys))"
     unfolding 1(2,3) by simp
   also from ys_xs have "\<dots> =
     Poly (rev xs) + monom x (length xs) -
       (monom 1 (length xs - length ys) * Poly (rev ys) + monom y (length xs))"
     by (simp add: Poly_append distrib_left mult_monom smult_monom)
   also have "\<dots> = Poly (rev (minus_poly_rev_list xs ys)) + monom (x - y) (length xs)"
     unfolding * diff_monom[symmetric] by simp
   finally show ?case
     by (simp add: 1(2,3)[symmetric] smult_monom Poly_append)
 qed auto
 
 lemma smult_monom_mult: "smult a (monom b n * f) = monom (a * b) n * f"
   using smult_monom [of a _ n] by (metis mult_smult_left)
 
 lemma head_minus_poly_rev_list:
   "length d \<le> length r \<Longrightarrow> d \<noteq> [] \<Longrightarrow>
     hd (minus_poly_rev_list (map ((*) (last d)) r) (map ((*) (hd r)) (rev d))) = 0"
   for d r :: "'a::comm_ring list"
 proof (induct r)
   case Nil
   then show ?case by simp
 next
   case (Cons a rs)
   then show ?case by (cases "rev d") (simp_all add: ac_simps)
 qed
 
 lemma Poly_map: "Poly (map ((*) a) p) = smult a (Poly p)"
 proof (induct p)
   case Nil
   then show ?case by simp
 next
   case (Cons x xs)
   then show ?case by (cases "Poly xs = 0") auto
 qed
 
 lemma last_coeff_is_hd: "xs \<noteq> [] \<Longrightarrow> coeff (Poly xs) (length xs - 1) = hd (rev xs)"
   by (simp_all add: hd_conv_nth rev_nth nth_default_nth nth_append)
 
 lemma pseudo_divmod_main_list_invar:
   assumes leading_nonzero: "last d \<noteq> 0"
     and lc: "last d = lc"
     and "d \<noteq> []"
     and "pseudo_divmod_main_list lc q (rev r) (rev d) n = (q', rev r')"
     and "n = 1 + length r - length d"
   shows "pseudo_divmod_main lc (monom 1 n * Poly q) (Poly r) (Poly d) (length r - 1) n =
     (Poly q', Poly r')"
   using assms(4-)
 proof (induct n arbitrary: r q)
   case (Suc n)
   from Suc.prems have *: "\<not> Suc (length r) \<le> length d"
     by simp
   with \<open>d \<noteq> []\<close> have "r \<noteq> []"
     using Suc_leI length_greater_0_conv list.size(3) by fastforce
   let ?a = "(hd (rev r))"
   let ?rr = "map ((*) lc) (rev r)"
   let ?rrr = "rev (tl (minus_poly_rev_list ?rr (map ((*) ?a) (rev d))))"
   let ?qq = "cCons ?a (map ((*) lc) q)"
   from * Suc(3) have n: "n = (1 + length r - length d - 1)"
     by simp
   from * have rr_val:"(length ?rrr) = (length r - 1)"
     by auto
   with \<open>r \<noteq> []\<close> * have rr_smaller: "(1 + length r - length d - 1) = (1 + length ?rrr - length d)"
     by auto
   from * have id: "Suc (length r) - length d = Suc (length r - length d)"
     by auto
   from Suc.prems *
   have "pseudo_divmod_main_list lc ?qq (rev ?rrr) (rev d) (1 + length r - length d - 1) = (q', rev r')"
     by (simp add: Let_def if_0_minus_poly_rev_list id)
   with n have v: "pseudo_divmod_main_list lc ?qq (rev ?rrr) (rev d) n = (q', rev r')"
     by auto
   from * have sucrr:"Suc (length r) - length d = Suc (length r - length d)"
     using Suc_diff_le not_less_eq_eq by blast
   from Suc(3) \<open>r \<noteq> []\<close> have n_ok : "n = 1 + (length ?rrr) - length d"
     by simp
   have cong: "\<And>x1 x2 x3 x4 y1 y2 y3 y4. x1 = y1 \<Longrightarrow> x2 = y2 \<Longrightarrow> x3 = y3 \<Longrightarrow> x4 = y4 \<Longrightarrow>
       pseudo_divmod_main lc x1 x2 x3 x4 n = pseudo_divmod_main lc y1 y2 y3 y4 n"
     by simp
   have hd_rev: "coeff (Poly r) (length r - Suc 0) = hd (rev r)"
     using last_coeff_is_hd[OF \<open>r \<noteq> []\<close>] by simp
   show ?case
     unfolding Suc.hyps(1)[OF v n_ok, symmetric] pseudo_divmod_main.simps Let_def
   proof (rule cong[OF _ _ refl], goal_cases)
     case 1
     show ?case
       by (simp add: monom_Suc hd_rev[symmetric] smult_monom Poly_map)
   next
     case 2
     show ?case
     proof (subst Poly_on_rev_starting_with_0, goal_cases)
       show "hd (minus_poly_rev_list (map ((*) lc) (rev r)) (map ((*) (hd (rev r))) (rev d))) = 0"
         by (fold lc, subst head_minus_poly_rev_list, insert * \<open>d \<noteq> []\<close>, auto)
       from * have "length d \<le> length r"
         by simp
       then show "smult lc (Poly r) - monom (coeff (Poly r) (length r - 1)) n * Poly d =
           Poly (rev (minus_poly_rev_list (map ((*) lc) (rev r)) (map ((*) (hd (rev r))) (rev d))))"
         by (fold rev_map) (auto simp add: n smult_monom_mult Poly_map hd_rev [symmetric]
             minus_poly_rev_list)
     qed
   qed simp
 qed simp
 
 lemma pseudo_divmod_impl [code]:
   "pseudo_divmod f g = map_prod poly_of_list poly_of_list (pseudo_divmod_list (coeffs f) (coeffs g))"
     for f g :: "'a::comm_ring_1 poly"
 proof (cases "g = 0")
   case False
   then have "last (coeffs g) \<noteq> 0"
     and "last (coeffs g) = lead_coeff g"
     and "coeffs g \<noteq> []"
     by (simp_all add: last_coeffs_eq_coeff_degree)
   moreover obtain q r where qr: "pseudo_divmod_main_list
     (last (coeffs g)) (rev [])
     (rev (coeffs f)) (rev (coeffs g))
     (1 + length (coeffs f) -
     length (coeffs g)) = (q, rev (rev r))"
     by force
   ultimately have "(Poly q, Poly (rev r)) = pseudo_divmod_main (lead_coeff g) 0 f g
     (length (coeffs f) - Suc 0) (Suc (length (coeffs f)) - length (coeffs g))"
     by (subst pseudo_divmod_main_list_invar [symmetric]) auto
   moreover have "pseudo_divmod_main_list
     (hd (rev (coeffs g))) []
     (rev (coeffs f)) (rev (coeffs g))
     (1 + length (coeffs f) -
     length (coeffs g)) = (q, r)"
     using qr hd_rev [OF \<open>coeffs g \<noteq> []\<close>] by simp
   ultimately show ?thesis
     by (auto simp: degree_eq_length_coeffs pseudo_divmod_def pseudo_divmod_list_def Let_def)
 next
   case True
   then show ?thesis
     by (auto simp add: pseudo_divmod_def pseudo_divmod_list_def)
 qed
 
 lemma pseudo_mod_main_list:
   "snd (pseudo_divmod_main_list l q xs ys n) = pseudo_mod_main_list l xs ys n"
   by (induct n arbitrary: l q xs ys) (auto simp: Let_def)
 
 lemma pseudo_mod_impl[code]: "pseudo_mod f g = poly_of_list (pseudo_mod_list (coeffs f) (coeffs g))"
 proof -
   have snd_case: "\<And>f g p. snd ((\<lambda>(x,y). (f x, g y)) p) = g (snd p)"
     by auto
   show ?thesis
     unfolding pseudo_mod_def pseudo_divmod_impl pseudo_divmod_list_def
       pseudo_mod_list_def Let_def
     by (simp add: snd_case pseudo_mod_main_list)
 qed
 
 
 subsubsection \<open>Improved Code-Equations for Polynomial (Pseudo) Division\<close>
 
 lemma pdivmod_pdivmodrel: "eucl_rel_poly p q (r, s) \<longleftrightarrow> (p div q, p mod q) = (r, s)"
   by (metis eucl_rel_poly eucl_rel_poly_unique)
 
 lemma pdivmod_via_pseudo_divmod:
   "(f div g, f mod g) =
     (if g = 0 then (0, f)
      else
       let
         ilc = inverse (coeff g (degree g));
         h = smult ilc g;
         (q,r) = pseudo_divmod f h
       in (smult ilc q, r))"
   (is "?l = ?r")
 proof (cases "g = 0")
   case True
   then show ?thesis by simp
 next
   case False
   define lc where "lc = inverse (coeff g (degree g))"
   define h where "h = smult lc g"
   from False have h1: "coeff h (degree h) = 1" and lc: "lc \<noteq> 0"
     by (auto simp: h_def lc_def)
   then have h0: "h \<noteq> 0"
     by auto
   obtain q r where p: "pseudo_divmod f h = (q, r)"
     by force
   from False have id: "?r = (smult lc q, r)"
     by (auto simp: Let_def h_def[symmetric] lc_def[symmetric] p)
   from pseudo_divmod[OF h0 p, unfolded h1]
   have f: "f = h * q + r" and r: "r = 0 \<or> degree r < degree h"
     by auto
   from f r h0 have "eucl_rel_poly f h (q, r)"
     by (auto simp: eucl_rel_poly_iff)
   then have "(f div h, f mod h) = (q, r)"
     by (simp add: pdivmod_pdivmodrel)
   with lc have "(f div g, f mod g) = (smult lc q, r)"
     by (auto simp: h_def div_smult_right[OF lc] mod_smult_right[OF lc])
   with id show ?thesis
     by auto
 qed
 
 lemma pdivmod_via_pseudo_divmod_list:
   "(f div g, f mod g) =
     (let cg = coeffs g in
       if cg = [] then (0, f)
       else
         let
           cf = coeffs f;
           ilc = inverse (last cg);
           ch = map ((*) ilc) cg;
           (q, r) = pseudo_divmod_main_list 1 [] (rev cf) (rev ch) (1 + length cf - length cg)
         in (poly_of_list (map ((*) ilc) q), poly_of_list (rev r)))"
 proof -
   note d = pdivmod_via_pseudo_divmod pseudo_divmod_impl pseudo_divmod_list_def
   show ?thesis
   proof (cases "g = 0")
     case True
     with d show ?thesis by auto
   next
     case False
     define ilc where "ilc = inverse (coeff g (degree g))"
     from False have ilc: "ilc \<noteq> 0"
       by (auto simp: ilc_def)
     with False have id: "g = 0 \<longleftrightarrow> False" "coeffs g = [] \<longleftrightarrow> False"
       "last (coeffs g) = coeff g (degree g)"
       "coeffs (smult ilc g) = [] \<longleftrightarrow> False"
       by (auto simp: last_coeffs_eq_coeff_degree)
     have id2: "hd (rev (coeffs (smult ilc g))) = 1"
       by (subst hd_rev, insert id ilc, auto simp: coeffs_smult, subst last_map, auto simp: id ilc_def)
     have id3: "length (coeffs (smult ilc g)) = length (coeffs g)"
       "rev (coeffs (smult ilc g)) = rev (map ((*) ilc) (coeffs g))"
       unfolding coeffs_smult using ilc by auto
     obtain q r where pair:
       "pseudo_divmod_main_list 1 [] (rev (coeffs f)) (rev (map ((*) ilc) (coeffs g)))
         (1 + length (coeffs f) - length (coeffs g)) = (q, r)"
       by force
     show ?thesis
       unfolding d Let_def id if_False ilc_def[symmetric] map_prod_def[symmetric] id2
       unfolding id3 pair map_prod_def split
       by (auto simp: Poly_map)
   qed
 qed
 
 lemma pseudo_divmod_main_list_1: "pseudo_divmod_main_list 1 = divmod_poly_one_main_list"
 proof (intro ext, goal_cases)
   case (1 q r d n)
   have *: "map ((*) 1) xs = xs" for xs :: "'a list"
     by (induct xs) auto
   show ?case
     by (induct n arbitrary: q r d) (auto simp: * Let_def)
 qed
 
 fun divide_poly_main_list :: "'a::idom_divide \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> 'a list"
   where
     "divide_poly_main_list lc q r d (Suc n) =
       (let
         cr = hd r
         in if cr = 0 then divide_poly_main_list lc (cCons cr q) (tl r) d n else let
         a = cr div lc;
         qq = cCons a q;
         rr = minus_poly_rev_list r (map ((*) a) d)
        in if hd rr = 0 then divide_poly_main_list lc qq (tl rr) d n else [])"
   | "divide_poly_main_list lc q r d 0 = q"
 
 lemma divide_poly_main_list_simp [simp]:
   "divide_poly_main_list lc q r d (Suc n) =
     (let
       cr = hd r;
       a = cr div lc;
       qq = cCons a q;
       rr = minus_poly_rev_list r (map ((*) a) d)
      in if hd rr = 0 then divide_poly_main_list lc qq (tl rr) d n else [])"
   by (simp add: Let_def minus_zero_does_nothing)
 
 declare divide_poly_main_list.simps(1)[simp del]
 
 definition divide_poly_list :: "'a::idom_divide poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   where "divide_poly_list f g =
     (let cg = coeffs g in
       if cg = [] then g
       else
         let
           cf = coeffs f;
           cgr = rev cg
         in poly_of_list (divide_poly_main_list (hd cgr) [] (rev cf) cgr (1 + length cf - length cg)))"
 
 lemmas pdivmod_via_divmod_list = pdivmod_via_pseudo_divmod_list[unfolded pseudo_divmod_main_list_1]
 
 lemma mod_poly_one_main_list: "snd (divmod_poly_one_main_list q r d n) = mod_poly_one_main_list r d n"
   by (induct n arbitrary: q r d) (auto simp: Let_def)
 
 lemma mod_poly_code [code]:
   "f mod g =
     (let cg = coeffs g in
       if cg = [] then f
       else
         let
           cf = coeffs f;
           ilc = inverse (last cg);
           ch = map ((*) ilc) cg;
           r = mod_poly_one_main_list (rev cf) (rev ch) (1 + length cf - length cg)
         in poly_of_list (rev r))"
   (is "_ = ?rhs")
 proof -
   have "snd (f div g, f mod g) = ?rhs"
     unfolding pdivmod_via_divmod_list Let_def mod_poly_one_main_list [symmetric, of _ _ _ Nil]
     by (auto split: prod.splits)
   then show ?thesis by simp
 qed
 
 definition div_field_poly_impl :: "'a :: field poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly"
   where "div_field_poly_impl f g =
     (let cg = coeffs g in
       if cg = [] then 0
       else
         let
           cf = coeffs f;
           ilc = inverse (last cg);
           ch = map ((*) ilc) cg;
           q = fst (divmod_poly_one_main_list [] (rev cf) (rev ch) (1 + length cf - length cg))
         in poly_of_list ((map ((*) ilc) q)))"
 
 text \<open>We do not declare the following lemma as code equation, since then polynomial division
   on non-fields will no longer be executable. However, a code-unfold is possible, since
   \<open>div_field_poly_impl\<close> is a bit more efficient than the generic polynomial division.\<close>
 lemma div_field_poly_impl[code_unfold]: "(div) = div_field_poly_impl"
 proof (intro ext)
   fix f g :: "'a poly"
   have "fst (f div g, f mod g) = div_field_poly_impl f g"
     unfolding div_field_poly_impl_def pdivmod_via_divmod_list Let_def
     by (auto split: prod.splits)
   then show "f div g =  div_field_poly_impl f g"
     by simp
 qed
 
 lemma divide_poly_main_list:
   assumes lc0: "lc \<noteq> 0"
     and lc: "last d = lc"
     and d: "d \<noteq> []"
     and "n = (1 + length r - length d)"
   shows "Poly (divide_poly_main_list lc q (rev r) (rev d) n) =
     divide_poly_main lc (monom 1 n * Poly q) (Poly r) (Poly d) (length r - 1) n"
   using assms(4-)
 proof (induct "n" arbitrary: r q)
   case (Suc n)
   from Suc.prems have ifCond: "\<not> Suc (length r) \<le> length d"
     by simp
   with d have r: "r \<noteq> []"
     using Suc_leI length_greater_0_conv list.size(3) by fastforce
   then obtain rr lcr where r: "r = rr @ [lcr]"
     by (cases r rule: rev_cases) auto
   from d lc obtain dd where d: "d = dd @ [lc]"
     by (cases d rule: rev_cases) auto
   from Suc(2) ifCond have n: "n = 1 + length rr - length d"
     by (auto simp: r)
   from ifCond have len: "length dd \<le> length rr"
     by (simp add: r d)
   show ?case
   proof (cases "lcr div lc * lc = lcr")
     case False
     with r d show ?thesis
       unfolding Suc(2)[symmetric]
       by (auto simp add: Let_def nth_default_append)
   next
     case True
     with r d have id:
       "?thesis \<longleftrightarrow>
         Poly (divide_poly_main_list lc (cCons (lcr div lc) q)
           (rev (rev (minus_poly_rev_list (rev rr) (rev (map ((*) (lcr div lc)) dd))))) (rev d) n) =
           divide_poly_main lc
             (monom 1 (Suc n) * Poly q + monom (lcr div lc) n)
             (Poly r - monom (lcr div lc) n * Poly d)
             (Poly d) (length rr - 1) n"
       by (cases r rule: rev_cases; cases "d" rule: rev_cases)
         (auto simp add: Let_def rev_map nth_default_append)
     have cong: "\<And>x1 x2 x3 x4 y1 y2 y3 y4. x1 = y1 \<Longrightarrow> x2 = y2 \<Longrightarrow> x3 = y3 \<Longrightarrow> x4 = y4 \<Longrightarrow>
         divide_poly_main lc x1 x2 x3 x4 n = divide_poly_main lc y1 y2 y3 y4 n"
       by simp
     show ?thesis
       unfolding id
     proof (subst Suc(1), simp add: n,
         subst minus_poly_rev_list, force simp: len, rule cong[OF _ _ refl], goal_cases)
       case 2
       have "monom lcr (length rr) = monom (lcr div lc) (length rr - length dd) * monom lc (length dd)"
         by (simp add: mult_monom len True)
       then show ?case unfolding r d Poly_append n ring_distribs
         by (auto simp: Poly_map smult_monom smult_monom_mult)
     qed (auto simp: len monom_Suc smult_monom)
   qed
 qed simp
 
 lemma divide_poly_list[code]: "f div g = divide_poly_list f g"
 proof -
   note d = divide_poly_def divide_poly_list_def
   show ?thesis
   proof (cases "g = 0")
     case True
     show ?thesis by (auto simp: d True)
   next
     case False
     then obtain cg lcg where cg: "coeffs g = cg @ [lcg]"
       by (cases "coeffs g" rule: rev_cases) auto
     with False have id: "(g = 0) = False" "(cg @ [lcg] = []) = False"
       by auto
     from cg False have lcg: "coeff g (degree g) = lcg"
       using last_coeffs_eq_coeff_degree last_snoc by force
     with False have "lcg \<noteq> 0" by auto
     from cg Poly_coeffs [of g] have ltp: "Poly (cg @ [lcg]) = g"
       by auto
     show ?thesis
       unfolding d cg Let_def id if_False poly_of_list_def
       by (subst divide_poly_main_list, insert False cg \<open>lcg \<noteq> 0\<close>)
         (auto simp: lcg ltp, simp add: degree_eq_length_coeffs)
   qed
 qed
 
 
 subsection \<open>Primality and irreducibility in polynomial rings\<close>
 
 lemma prod_mset_const_poly: "(\<Prod>x\<in>#A. [:f x:]) = [:prod_mset (image_mset f A):]"
   by (induct A) (simp_all add: ac_simps)
 
 lemma irreducible_const_poly_iff:
   fixes c :: "'a :: {comm_semiring_1,semiring_no_zero_divisors}"
   shows "irreducible [:c:] \<longleftrightarrow> irreducible c"
 proof
   assume A: "irreducible c"
   show "irreducible [:c:]"
   proof (rule irreducibleI)
     fix a b assume ab: "[:c:] = a * b"
     hence "degree [:c:] = degree (a * b)" by (simp only: )
     also from A ab have "a \<noteq> 0" "b \<noteq> 0" by auto
     hence "degree (a * b) = degree a + degree b" by (simp add: degree_mult_eq)
     finally have "degree a = 0" "degree b = 0" by auto
     then obtain a' b' where ab': "a = [:a':]" "b = [:b':]" by (auto elim!: degree_eq_zeroE)
     from ab have "coeff [:c:] 0 = coeff (a * b) 0" by (simp only: )
     hence "c = a' * b'" by (simp add: ab' mult_ac)
     from A and this have "a' dvd 1 \<or> b' dvd 1" by (rule irreducibleD)
     with ab' show "a dvd 1 \<or> b dvd 1"
       by (auto simp add: is_unit_const_poly_iff)
   qed (insert A, auto simp: irreducible_def is_unit_poly_iff)
 next
   assume A: "irreducible [:c:]"
   then have "c \<noteq> 0" and "\<not> c dvd 1"
     by (auto simp add: irreducible_def is_unit_const_poly_iff)
   then show "irreducible c"
   proof (rule irreducibleI)
     fix a b assume ab: "c = a * b"
     hence "[:c:] = [:a:] * [:b:]" by (simp add: mult_ac)
     from A and this have "[:a:] dvd 1 \<or> [:b:] dvd 1" by (rule irreducibleD)
     then show "a dvd 1 \<or> b dvd 1"
       by (auto simp add: is_unit_const_poly_iff)
   qed
 qed
 
 lemma lift_prime_elem_poly:
   assumes "prime_elem (c :: 'a :: semidom)"
   shows   "prime_elem [:c:]"
 proof (rule prime_elemI)
   fix a b assume *: "[:c:] dvd a * b"
   from * have dvd: "c dvd coeff (a * b) n" for n
     by (subst (asm) const_poly_dvd_iff) blast
   {
     define m where "m = (GREATEST m. \<not>c dvd coeff b m)"
     assume "\<not>[:c:] dvd b"
     hence A: "\<exists>i. \<not>c dvd coeff b i" by (subst (asm) const_poly_dvd_iff) blast
     have B: "\<And>i. \<not>c dvd coeff b i \<Longrightarrow> i \<le> degree b"
       by (auto intro: le_degree)
     have coeff_m: "\<not>c dvd coeff b m" unfolding m_def by (rule GreatestI_ex_nat[OF A B])
     have "i \<le> m" if "\<not>c dvd coeff b i" for i
       unfolding m_def by (metis (mono_tags, lifting) B Greatest_le_nat that)
     hence dvd_b: "c dvd coeff b i" if "i > m" for i using that by force
 
     have "c dvd coeff a i" for i
     proof (induction i rule: nat_descend_induct[of "degree a"])
       case (base i)
       thus ?case by (simp add: coeff_eq_0)
     next
       case (descend i)
       let ?A = "{..i+m} - {i}"
       have "c dvd coeff (a * b) (i + m)" by (rule dvd)
       also have "coeff (a * b) (i + m) = (\<Sum>k\<le>i + m. coeff a k * coeff b (i + m - k))"
         by (simp add: coeff_mult)
       also have "{..i+m} = insert i ?A" by auto
       also have "(\<Sum>k\<in>\<dots>. coeff a k * coeff b (i + m - k)) =
                    coeff a i * coeff b m + (\<Sum>k\<in>?A. coeff a k * coeff b (i + m - k))"
         (is "_ = _ + ?S")
         by (subst sum.insert) simp_all
       finally have eq: "c dvd coeff a i * coeff b m + ?S" .
       moreover have "c dvd ?S"
       proof (rule dvd_sum)
         fix k assume k: "k \<in> {..i+m} - {i}"
         show "c dvd coeff a k * coeff b (i + m - k)"
         proof (cases "k < i")
           case False
           with k have "c dvd coeff a k" by (intro descend.IH) simp
           thus ?thesis by simp
         next
           case True
           hence "c dvd coeff b (i + m - k)" by (intro dvd_b) simp
           thus ?thesis by simp
         qed
       qed
       ultimately have "c dvd coeff a i * coeff b m"
         by (simp add: dvd_add_left_iff)
       with assms coeff_m show "c dvd coeff a i"
         by (simp add: prime_elem_dvd_mult_iff)
     qed
     hence "[:c:] dvd a" by (subst const_poly_dvd_iff) blast
   }
   then show "[:c:] dvd a \<or> [:c:] dvd b" by blast
 next
   from assms show "[:c:] \<noteq> 0" and "\<not> [:c:] dvd 1"
     by (simp_all add: prime_elem_def is_unit_const_poly_iff)
 qed
 
 lemma prime_elem_const_poly_iff:
   fixes c :: "'a :: semidom"
   shows   "prime_elem [:c:] \<longleftrightarrow> prime_elem c"
 proof
   assume A: "prime_elem [:c:]"
   show "prime_elem c"
   proof (rule prime_elemI)
     fix a b assume "c dvd a * b"
     hence "[:c:] dvd [:a:] * [:b:]" by (simp add: mult_ac)
     from A and this have "[:c:] dvd [:a:] \<or> [:c:] dvd [:b:]" by (rule prime_elem_dvd_multD)
     thus "c dvd a \<or> c dvd b" by simp
   qed (insert A, auto simp: prime_elem_def is_unit_poly_iff)
 qed (auto intro: lift_prime_elem_poly)
 
 
 subsection \<open>Content and primitive part of a polynomial\<close>
 
 definition content :: "'a::semiring_gcd poly \<Rightarrow> 'a"
   where "content p = gcd_list (coeffs p)"
 
 lemma content_eq_fold_coeffs [code]: "content p = fold_coeffs gcd p 0"
   by (simp add: content_def Gcd_fin.set_eq_fold fold_coeffs_def foldr_fold fun_eq_iff ac_simps)
 
 lemma content_0 [simp]: "content 0 = 0"
   by (simp add: content_def)
 
 lemma content_1 [simp]: "content 1 = 1"
   by (simp add: content_def)
 
 lemma content_const [simp]: "content [:c:] = normalize c"
   by (simp add: content_def cCons_def)
 
 lemma const_poly_dvd_iff_dvd_content: "[:c:] dvd p \<longleftrightarrow> c dvd content p"
   for c :: "'a::semiring_gcd"
 proof (cases "p = 0")
   case True
   then show ?thesis by simp
 next
   case False
   have "[:c:] dvd p \<longleftrightarrow> (\<forall>n. c dvd coeff p n)"
     by (rule const_poly_dvd_iff)
   also have "\<dots> \<longleftrightarrow> (\<forall>a\<in>set (coeffs p). c dvd a)"
   proof safe
     fix n :: nat
     assume "\<forall>a\<in>set (coeffs p). c dvd a"
     then show "c dvd coeff p n"
       by (cases "n \<le> degree p") (auto simp: coeff_eq_0 coeffs_def split: if_splits)
   qed (auto simp: coeffs_def simp del: upt_Suc split: if_splits)
   also have "\<dots> \<longleftrightarrow> c dvd content p"
     by (simp add: content_def dvd_Gcd_fin_iff dvd_mult_unit_iff)
   finally show ?thesis .
 qed
 
 lemma content_dvd [simp]: "[:content p:] dvd p"
   by (subst const_poly_dvd_iff_dvd_content) simp_all
 
 lemma content_dvd_coeff [simp]: "content p dvd coeff p n"
 proof (cases "p = 0")
   case True
   then show ?thesis
     by simp
 next
   case False
   then show ?thesis
     by (cases "n \<le> degree p")
       (auto simp add: content_def not_le coeff_eq_0 coeff_in_coeffs intro: Gcd_fin_dvd)
 qed
 
 lemma content_dvd_coeffs: "c \<in> set (coeffs p) \<Longrightarrow> content p dvd c"
   by (simp add: content_def Gcd_fin_dvd)
 
 lemma normalize_content [simp]: "normalize (content p) = content p"
   by (simp add: content_def)
 
 lemma is_unit_content_iff [simp]: "is_unit (content p) \<longleftrightarrow> content p = 1"
 proof
   assume "is_unit (content p)"
   then have "normalize (content p) = 1" by (simp add: is_unit_normalize del: normalize_content)
   then show "content p = 1" by simp
 qed auto
 
 lemma content_smult [simp]:
   fixes c :: "'a :: {normalization_semidom_multiplicative, semiring_gcd}"
   shows "content (smult c p) = normalize c * content p"
   by (simp add: content_def coeffs_smult Gcd_fin_mult normalize_mult)
 
 lemma content_eq_zero_iff [simp]: "content p = 0 \<longleftrightarrow> p = 0"
   by (auto simp: content_def simp: poly_eq_iff coeffs_def)
 
 definition primitive_part :: "'a :: semiring_gcd poly \<Rightarrow> 'a poly"
   where "primitive_part p = map_poly (\<lambda>x. x div content p) p"
 
 lemma primitive_part_0 [simp]: "primitive_part 0 = 0"
   by (simp add: primitive_part_def)
 
 lemma content_times_primitive_part [simp]: "smult (content p) (primitive_part p) = p"
   for p :: "'a :: semiring_gcd poly"
 proof (cases "p = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then show ?thesis
   unfolding primitive_part_def
   by (auto simp: smult_conv_map_poly map_poly_map_poly o_def content_dvd_coeffs
       intro: map_poly_idI)
 qed
 
 lemma primitive_part_eq_0_iff [simp]: "primitive_part p = 0 \<longleftrightarrow> p = 0"
 proof (cases "p = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then have "primitive_part p = map_poly (\<lambda>x. x div content p) p"
     by (simp add:  primitive_part_def)
   also from False have "\<dots> = 0 \<longleftrightarrow> p = 0"
     by (intro map_poly_eq_0_iff) (auto simp: dvd_div_eq_0_iff content_dvd_coeffs)
   finally show ?thesis
     using False by simp
 qed
 
 lemma content_primitive_part [simp]:
   fixes p :: "'a :: {normalization_semidom_multiplicative, semiring_gcd} poly"
   assumes "p \<noteq> 0"
   shows "content (primitive_part p) = 1"
 proof -
   have "p = smult (content p) (primitive_part p)"
     by simp
   also have "content \<dots> = content (primitive_part p) * content p"
     by (simp del: content_times_primitive_part add: ac_simps)
   finally have "1 * content p = content (primitive_part p) * content p"
     by simp
   then have "1 * content p div content p = content (primitive_part p) * content p div content p"
     by simp
   with assms show ?thesis
     by simp
 qed
 
 lemma content_decompose:
   obtains p' :: "'a :: {normalization_semidom_multiplicative, semiring_gcd} poly"
   where "p = smult (content p) p'" "content p' = 1"
 proof (cases "p = 0")
   case True
   then have "p = smult (content p) 1" "content 1 = 1"
     by simp_all
   then show ?thesis ..
 next
   case False
   then have "p = smult (content p) (primitive_part p)" "content (primitive_part p) = 1"
     by simp_all
   then show ?thesis ..
 qed
   
 lemma content_dvd_contentI [intro]: "p dvd q \<Longrightarrow> content p dvd content q"
   using const_poly_dvd_iff_dvd_content content_dvd dvd_trans by blast
 
 lemma primitive_part_const_poly [simp]: "primitive_part [:x:] = [:unit_factor x:]"
   by (simp add: primitive_part_def map_poly_pCons)
 
 lemma primitive_part_prim: "content p = 1 \<Longrightarrow> primitive_part p = p"
   by (auto simp: primitive_part_def)
 
 lemma degree_primitive_part [simp]: "degree (primitive_part p) = degree p"
 proof (cases "p = 0")
   case True
   then show ?thesis by simp
 next
   case False
   have "p = smult (content p) (primitive_part p)"
     by simp
   also from False have "degree \<dots> = degree (primitive_part p)"
     by (subst degree_smult_eq) simp_all
   finally show ?thesis ..
 qed
 
 lemma smult_content_normalize_primitive_part [simp]:
   fixes p :: "'a :: {normalization_semidom_multiplicative, semiring_gcd, idom_divide} poly"
   shows "smult (content p) (normalize (primitive_part p)) = normalize p"
 proof -
   have "smult (content p) (normalize (primitive_part p)) =
       normalize ([:content p:] * primitive_part p)"
     by (subst normalize_mult) (simp_all add: normalize_const_poly)
   also have "[:content p:] * primitive_part p = p" by simp
   finally show ?thesis .
 qed
 
 context
 begin
 
 private
 
 lemma content_1_mult:
   fixes f g :: "'a :: {semiring_gcd, factorial_semiring} poly"
   assumes "content f = 1" "content g = 1"
   shows   "content (f * g) = 1"
 proof (cases "f * g = 0")
   case False
   from assms have "f \<noteq> 0" "g \<noteq> 0" by auto
 
   hence "f * g \<noteq> 0" by auto
   {
     assume "\<not>is_unit (content (f * g))"
     with False have "\<exists>p. p dvd content (f * g) \<and> prime p"
       by (intro prime_divisor_exists) simp_all
     then obtain p where "p dvd content (f * g)" "prime p" by blast
     from \<open>p dvd content (f * g)\<close> have "[:p:] dvd f * g"
       by (simp add: const_poly_dvd_iff_dvd_content)
     moreover from \<open>prime p\<close> have "prime_elem [:p:]" by (simp add: lift_prime_elem_poly)
     ultimately have "[:p:] dvd f \<or> [:p:] dvd g"
       by (simp add: prime_elem_dvd_mult_iff)
     with assms have "is_unit p" by (simp add: const_poly_dvd_iff_dvd_content)
     with \<open>prime p\<close> have False by simp
   }
   hence "is_unit (content (f * g))" by blast
   hence "normalize (content (f * g)) = 1" by (simp add: is_unit_normalize del: normalize_content)
   thus ?thesis by simp
 qed (insert assms, auto)
 
 lemma content_mult:
   fixes p q :: "'a :: {factorial_semiring, semiring_gcd, normalization_semidom_multiplicative} poly"
   shows "content (p * q) = content p * content q"
 proof (cases "p * q = 0")
   case False
   then have "p \<noteq> 0" and "q \<noteq> 0"
     by simp_all
   then have *: "content (primitive_part p * primitive_part q) = 1"
     by (auto intro: content_1_mult)
   have "p * q = smult (content p) (primitive_part p) * smult (content q) (primitive_part q)"
     by simp
   also have "\<dots> = smult (content p * content q) (primitive_part p * primitive_part q)"
     by (metis mult.commute mult_smult_right smult_smult)
   with * show ?thesis
   by (simp add: normalize_mult)
 next
   case True
   then show ?thesis
     by auto
 qed
 
 end
 
 lemma primitive_part_mult:
   fixes p q :: "'a :: {factorial_semiring, semiring_Gcd, ring_gcd, idom_divide,
                        normalization_semidom_multiplicative} poly"
   shows "primitive_part (p * q) = primitive_part p * primitive_part q"
 proof -
   have "primitive_part (p * q) = p * q div [:content (p * q):]"
     by (simp add: primitive_part_def div_const_poly_conv_map_poly)
   also have "\<dots> = (p div [:content p:]) * (q div [:content q:])"
     by (subst div_mult_div_if_dvd) (simp_all add: content_mult mult_ac)
   also have "\<dots> = primitive_part p * primitive_part q"
     by (simp add: primitive_part_def div_const_poly_conv_map_poly)
   finally show ?thesis .
 qed
 
 lemma primitive_part_smult:
   fixes p :: "'a :: {factorial_semiring, semiring_Gcd, ring_gcd, idom_divide,
                      normalization_semidom_multiplicative} poly"
   shows "primitive_part (smult a p) = smult (unit_factor a) (primitive_part p)"
 proof -
   have "smult a p = [:a:] * p" by simp
   also have "primitive_part \<dots> = smult (unit_factor a) (primitive_part p)"
     by (subst primitive_part_mult) simp_all
   finally show ?thesis .
 qed  
 
 lemma primitive_part_dvd_primitive_partI [intro]:
   fixes p q :: "'a :: {factorial_semiring, semiring_Gcd, ring_gcd, idom_divide,
                        normalization_semidom_multiplicative} poly"
   shows "p dvd q \<Longrightarrow> primitive_part p dvd primitive_part q"
   by (auto elim!: dvdE simp: primitive_part_mult)
 
 lemma content_prod_mset: 
   fixes A :: "'a :: {factorial_semiring, semiring_Gcd, normalization_semidom_multiplicative}
       poly multiset"
   shows "content (prod_mset A) = prod_mset (image_mset content A)"
   by (induction A) (simp_all add: content_mult mult_ac)
 
 lemma content_prod_eq_1_iff: 
   fixes p q :: "'a :: {factorial_semiring, semiring_Gcd, normalization_semidom_multiplicative} poly"
   shows "content (p * q) = 1 \<longleftrightarrow> content p = 1 \<and> content q = 1"
 proof safe
   assume A: "content (p * q) = 1"
   {
     fix p q :: "'a poly" assume "content p * content q = 1"
     hence "1 = content p * content q" by simp
     hence "content p dvd 1" by (rule dvdI)
     hence "content p = 1" by simp
   } note B = this
   from A B[of p q] B [of q p] show "content p = 1" "content q = 1" 
     by (simp_all add: content_mult mult_ac)
 qed (auto simp: content_mult)
 
 
 no_notation cCons (infixr "##" 65)
 
 end
diff --git a/src/HOL/GCD.thy b/src/HOL/GCD.thy
--- a/src/HOL/GCD.thy
+++ b/src/HOL/GCD.thy
@@ -1,2787 +1,2925 @@
 (*  Title:      HOL/GCD.thy
     Author:     Christophe Tabacznyj
     Author:     Lawrence C. Paulson
     Author:     Amine Chaieb
     Author:     Thomas M. Rasmussen
     Author:     Jeremy Avigad
     Author:     Tobias Nipkow
 
 This file deals with the functions gcd and lcm.  Definitions and
 lemmas are proved uniformly for the natural numbers and integers.
 
 This file combines and revises a number of prior developments.
 
 The original theories "GCD" and "Primes" were by Christophe Tabacznyj
 and Lawrence C. Paulson, based on @{cite davenport92}. They introduced
 gcd, lcm, and prime for the natural numbers.
 
 The original theory "IntPrimes" was by Thomas M. Rasmussen, and
 extended gcd, lcm, primes to the integers. Amine Chaieb provided
 another extension of the notions to the integers, and added a number
 of results to "Primes" and "GCD". IntPrimes also defined and developed
 the congruence relations on the integers. The notion was extended to
 the natural numbers by Chaieb.
 
 Jeremy Avigad combined all of these, made everything uniform for the
 natural numbers and the integers, and added a number of new theorems.
 
 Tobias Nipkow cleaned up a lot.
 *)
 
 section \<open>Greatest common divisor and least common multiple\<close>
 
 theory GCD
   imports Groups_List 
 begin
 
 subsection \<open>Abstract bounded quasi semilattices as common foundation\<close>
 
 locale bounded_quasi_semilattice = abel_semigroup +
   fixes top :: 'a  ("\<^bold>\<top>") and bot :: 'a  ("\<^bold>\<bottom>")
     and normalize :: "'a \<Rightarrow> 'a"
   assumes idem_normalize [simp]: "a \<^bold>* a = normalize a"
     and normalize_left_idem [simp]: "normalize a \<^bold>* b = a \<^bold>* b"
     and normalize_idem [simp]: "normalize (a \<^bold>* b) = a \<^bold>* b"
     and normalize_top [simp]: "normalize \<^bold>\<top> = \<^bold>\<top>"
     and normalize_bottom [simp]: "normalize \<^bold>\<bottom> = \<^bold>\<bottom>"
     and top_left_normalize [simp]: "\<^bold>\<top> \<^bold>* a = normalize a"
     and bottom_left_bottom [simp]: "\<^bold>\<bottom> \<^bold>* a = \<^bold>\<bottom>"
 begin
 
 lemma left_idem [simp]:
   "a \<^bold>* (a \<^bold>* b) = a \<^bold>* b"
   using assoc [of a a b, symmetric] by simp
 
 lemma right_idem [simp]:
   "(a \<^bold>* b) \<^bold>* b = a \<^bold>* b"
   using left_idem [of b a] by (simp add: ac_simps)
 
 lemma comp_fun_idem: "comp_fun_idem f"
   by standard (simp_all add: fun_eq_iff ac_simps)
 
 interpretation comp_fun_idem f
   by (fact comp_fun_idem)
 
 lemma top_right_normalize [simp]:
   "a \<^bold>* \<^bold>\<top> = normalize a"
   using top_left_normalize [of a] by (simp add: ac_simps)
 
 lemma bottom_right_bottom [simp]:
   "a \<^bold>* \<^bold>\<bottom> = \<^bold>\<bottom>"
   using bottom_left_bottom [of a] by (simp add: ac_simps)
 
 lemma normalize_right_idem [simp]:
   "a \<^bold>* normalize b = a \<^bold>* b"
   using normalize_left_idem [of b a] by (simp add: ac_simps)
 
 end
 
 locale bounded_quasi_semilattice_set = bounded_quasi_semilattice
 begin
 
 interpretation comp_fun_idem f
   by (fact comp_fun_idem)
 
 definition F :: "'a set \<Rightarrow> 'a"
 where
   eq_fold: "F A = (if finite A then Finite_Set.fold f \<^bold>\<top> A else \<^bold>\<bottom>)"
 
 lemma infinite [simp]:
   "infinite A \<Longrightarrow> F A = \<^bold>\<bottom>"
   by (simp add: eq_fold)
 
 lemma set_eq_fold [code]:
   "F (set xs) = fold f xs \<^bold>\<top>"
   by (simp add: eq_fold fold_set_fold)
 
 lemma empty [simp]:
   "F {} = \<^bold>\<top>"
   by (simp add: eq_fold)
 
 lemma insert [simp]:
   "F (insert a A) = a \<^bold>* F A"
   by (cases "finite A") (simp_all add: eq_fold)
 
 lemma normalize [simp]:
   "normalize (F A) = F A"
   by (induct A rule: infinite_finite_induct) simp_all
 
 lemma in_idem:
   assumes "a \<in> A"
   shows "a \<^bold>* F A = F A"
   using assms by (induct A rule: infinite_finite_induct)
     (auto simp: left_commute [of a])
 
 lemma union:
   "F (A \<union> B) = F A \<^bold>* F B"
   by (induct A rule: infinite_finite_induct)
     (simp_all add: ac_simps)
 
 lemma remove:
   assumes "a \<in> A"
   shows "F A = a \<^bold>* F (A - {a})"
 proof -
   from assms obtain B where "A = insert a B" and "a \<notin> B"
     by (blast dest: mk_disjoint_insert)
   with assms show ?thesis by simp
 qed
 
 lemma insert_remove:
   "F (insert a A) = a \<^bold>* F (A - {a})"
   by (cases "a \<in> A") (simp_all add: insert_absorb remove)
 
 lemma subset:
   assumes "B \<subseteq> A"
   shows "F B \<^bold>* F A = F A"
   using assms by (simp add: union [symmetric] Un_absorb1)
 
 end
 
 subsection \<open>Abstract GCD and LCM\<close>
 
 class gcd = zero + one + dvd +
   fixes gcd :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
     and lcm :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
 
 class Gcd = gcd +
   fixes Gcd :: "'a set \<Rightarrow> 'a"
     and Lcm :: "'a set \<Rightarrow> 'a"
 
 syntax
   "_GCD1"     :: "pttrns \<Rightarrow> 'b \<Rightarrow> 'b"           ("(3GCD _./ _)" [0, 10] 10)
   "_GCD"      :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3GCD _\<in>_./ _)" [0, 0, 10] 10)
   "_LCM1"     :: "pttrns \<Rightarrow> 'b \<Rightarrow> 'b"           ("(3LCM _./ _)" [0, 10] 10)
   "_LCM"      :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3LCM _\<in>_./ _)" [0, 0, 10] 10)
 
 translations
   "GCD x y. f"   \<rightleftharpoons> "GCD x. GCD y. f"
   "GCD x. f"     \<rightleftharpoons> "CONST Gcd (CONST range (\<lambda>x. f))"
   "GCD x\<in>A. f"   \<rightleftharpoons> "CONST Gcd ((\<lambda>x. f) ` A)"
   "LCM x y. f"   \<rightleftharpoons> "LCM x. LCM y. f"
   "LCM x. f"     \<rightleftharpoons> "CONST Lcm (CONST range (\<lambda>x. f))"
   "LCM x\<in>A. f"   \<rightleftharpoons> "CONST Lcm ((\<lambda>x. f) ` A)"
 
 class semiring_gcd = normalization_semidom + gcd +
   assumes gcd_dvd1 [iff]: "gcd a b dvd a"
     and gcd_dvd2 [iff]: "gcd a b dvd b"
     and gcd_greatest: "c dvd a \<Longrightarrow> c dvd b \<Longrightarrow> c dvd gcd a b"
     and normalize_gcd [simp]: "normalize (gcd a b) = gcd a b"
     and lcm_gcd: "lcm a b = normalize (a * b div gcd a b)"
 begin
 
 lemma gcd_greatest_iff [simp]: "a dvd gcd b c \<longleftrightarrow> a dvd b \<and> a dvd c"
   by (blast intro!: gcd_greatest intro: dvd_trans)
 
 lemma gcd_dvdI1: "a dvd c \<Longrightarrow> gcd a b dvd c"
   by (rule dvd_trans) (rule gcd_dvd1)
 
 lemma gcd_dvdI2: "b dvd c \<Longrightarrow> gcd a b dvd c"
   by (rule dvd_trans) (rule gcd_dvd2)
 
 lemma dvd_gcdD1: "a dvd gcd b c \<Longrightarrow> a dvd b"
   using gcd_dvd1 [of b c] by (blast intro: dvd_trans)
 
 lemma dvd_gcdD2: "a dvd gcd b c \<Longrightarrow> a dvd c"
   using gcd_dvd2 [of b c] by (blast intro: dvd_trans)
 
 lemma gcd_0_left [simp]: "gcd 0 a = normalize a"
   by (rule associated_eqI) simp_all
 
 lemma gcd_0_right [simp]: "gcd a 0 = normalize a"
   by (rule associated_eqI) simp_all
 
 lemma gcd_eq_0_iff [simp]: "gcd a b = 0 \<longleftrightarrow> a = 0 \<and> b = 0"
   (is "?P \<longleftrightarrow> ?Q")
 proof
   assume ?P
   then have "0 dvd gcd a b"
     by simp
   then have "0 dvd a" and "0 dvd b"
     by (blast intro: dvd_trans)+
   then show ?Q
     by simp
 next
   assume ?Q
   then show ?P
     by simp
 qed
 
 lemma unit_factor_gcd: "unit_factor (gcd a b) = (if a = 0 \<and> b = 0 then 0 else 1)"
 proof (cases "gcd a b = 0")
   case True
   then show ?thesis by simp
 next
   case False
   have "unit_factor (gcd a b) * normalize (gcd a b) = gcd a b"
     by (rule unit_factor_mult_normalize)
   then have "unit_factor (gcd a b) * gcd a b = gcd a b"
     by simp
   then have "unit_factor (gcd a b) * gcd a b div gcd a b = gcd a b div gcd a b"
     by simp
   with False show ?thesis
     by simp
 qed
 
 lemma is_unit_gcd_iff [simp]:
   "is_unit (gcd a b) \<longleftrightarrow> gcd a b = 1"
   by (cases "a = 0 \<and> b = 0") (auto simp: unit_factor_gcd dest: is_unit_unit_factor)
 
 sublocale gcd: abel_semigroup gcd
 proof
   fix a b c
   show "gcd a b = gcd b a"
     by (rule associated_eqI) simp_all
   from gcd_dvd1 have "gcd (gcd a b) c dvd a"
     by (rule dvd_trans) simp
   moreover from gcd_dvd1 have "gcd (gcd a b) c dvd b"
     by (rule dvd_trans) simp
   ultimately have P1: "gcd (gcd a b) c dvd gcd a (gcd b c)"
     by (auto intro!: gcd_greatest)
   from gcd_dvd2 have "gcd a (gcd b c) dvd b"
     by (rule dvd_trans) simp
   moreover from gcd_dvd2 have "gcd a (gcd b c) dvd c"
     by (rule dvd_trans) simp
   ultimately have P2: "gcd a (gcd b c) dvd gcd (gcd a b) c"
     by (auto intro!: gcd_greatest)
   from P1 P2 show "gcd (gcd a b) c = gcd a (gcd b c)"
     by (rule associated_eqI) simp_all
 qed
 
 sublocale gcd: bounded_quasi_semilattice gcd 0 1 normalize
 proof
   show "gcd a a = normalize a" for a
   proof -
     have "a dvd gcd a a"
       by (rule gcd_greatest) simp_all
     then show ?thesis
       by (auto intro: associated_eqI)
   qed
   show "gcd (normalize a) b = gcd a b" for a b
     using gcd_dvd1 [of "normalize a" b]
     by (auto intro: associated_eqI)
   show "gcd 1 a = 1" for a
     by (rule associated_eqI) simp_all
 qed simp_all
 
 lemma gcd_self: "gcd a a = normalize a"
   by (fact gcd.idem_normalize)
 
 lemma gcd_left_idem: "gcd a (gcd a b) = gcd a b"
   by (fact gcd.left_idem)
 
 lemma gcd_right_idem: "gcd (gcd a b) b = gcd a b"
   by (fact gcd.right_idem)
 
 lemma gcdI:
   assumes "c dvd a" and "c dvd b"
     and greatest: "\<And>d. d dvd a \<Longrightarrow> d dvd b \<Longrightarrow> d dvd c"
     and "normalize c = c"
   shows "c = gcd a b"
   by (rule associated_eqI) (auto simp: assms intro: gcd_greatest)
 
 lemma gcd_unique:
   "d dvd a \<and> d dvd b \<and> normalize d = d \<and> (\<forall>e. e dvd a \<and> e dvd b \<longrightarrow> e dvd d) \<longleftrightarrow> d = gcd a b"
   by rule (auto intro: gcdI simp: gcd_greatest)
 
 lemma gcd_dvd_prod: "gcd a b dvd k * b"
   using mult_dvd_mono [of 1] by auto
 
 lemma gcd_proj2_if_dvd: "b dvd a \<Longrightarrow> gcd a b = normalize b"
   by (rule gcdI [symmetric]) simp_all
 
 lemma gcd_proj1_if_dvd: "a dvd b \<Longrightarrow> gcd a b = normalize a"
   by (rule gcdI [symmetric]) simp_all
 
 lemma gcd_proj1_iff: "gcd m n = normalize m \<longleftrightarrow> m dvd n"
 proof
   assume *: "gcd m n = normalize m"
   show "m dvd n"
   proof (cases "m = 0")
     case True
     with * show ?thesis by simp
   next
     case [simp]: False
     from * have **: "m = gcd m n * unit_factor m"
       by (simp add: unit_eq_div2)
     show ?thesis
       by (subst **) (simp add: mult_unit_dvd_iff)
   qed
 next
   assume "m dvd n"
   then show "gcd m n = normalize m"
     by (rule gcd_proj1_if_dvd)
 qed
 
 lemma gcd_proj2_iff: "gcd m n = normalize n \<longleftrightarrow> n dvd m"
   using gcd_proj1_iff [of n m] by (simp add: ac_simps)
 
 lemma gcd_mult_left: "gcd (c * a) (c * b) = normalize (c * gcd a b)"
 proof (cases "c = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then have *: "c * gcd a b dvd gcd (c * a) (c * b)"
     by (auto intro: gcd_greatest)
   moreover from False * have "gcd (c * a) (c * b) dvd c * gcd a b"
     by (metis div_dvd_iff_mult dvd_mult_left gcd_dvd1 gcd_dvd2 gcd_greatest mult_commute)
   ultimately have "normalize (gcd (c * a) (c * b)) = normalize (c * gcd a b)"
     by (auto intro: associated_eqI)
   then show ?thesis
     by (simp add: normalize_mult)
 qed
 
 lemma gcd_mult_right: "gcd (a * c) (b * c) = normalize (gcd b a * c)"
   using gcd_mult_left [of c a b] by (simp add: ac_simps)
 
 lemma dvd_lcm1 [iff]: "a dvd lcm a b"
   by (metis div_mult_swap dvd_mult2 dvd_normalize_iff dvd_refl gcd_dvd2 lcm_gcd)
 
 lemma dvd_lcm2 [iff]: "b dvd lcm a b"
   by (metis dvd_div_mult dvd_mult dvd_normalize_iff dvd_refl gcd_dvd1 lcm_gcd)
 
 lemma dvd_lcmI1: "a dvd b \<Longrightarrow> a dvd lcm b c"
   by (rule dvd_trans) (assumption, blast)
 
 lemma dvd_lcmI2: "a dvd c \<Longrightarrow> a dvd lcm b c"
   by (rule dvd_trans) (assumption, blast)
 
 lemma lcm_dvdD1: "lcm a b dvd c \<Longrightarrow> a dvd c"
   using dvd_lcm1 [of a b] by (blast intro: dvd_trans)
 
 lemma lcm_dvdD2: "lcm a b dvd c \<Longrightarrow> b dvd c"
   using dvd_lcm2 [of a b] by (blast intro: dvd_trans)
 
 lemma lcm_least:
   assumes "a dvd c" and "b dvd c"
   shows "lcm a b dvd c"
 proof (cases "c = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then have *: "is_unit (unit_factor c)"
     by simp
   show ?thesis
   proof (cases "gcd a b = 0")
     case True
     with assms show ?thesis by simp
   next
     case False
     have "a * b dvd normalize (c * gcd a b)"
       using assms by (subst gcd_mult_left [symmetric]) (auto intro!: gcd_greatest simp: mult_ac)
     with False have "(a * b div gcd a b) dvd c"
       by (subst div_dvd_iff_mult) auto
     thus ?thesis by (simp add: lcm_gcd)
   qed
 qed
 
 lemma lcm_least_iff [simp]: "lcm a b dvd c \<longleftrightarrow> a dvd c \<and> b dvd c"
   by (blast intro!: lcm_least intro: dvd_trans)
 
 lemma normalize_lcm [simp]: "normalize (lcm a b) = lcm a b"
   by (simp add: lcm_gcd dvd_normalize_div)
 
 lemma lcm_0_left [simp]: "lcm 0 a = 0"
   by (simp add: lcm_gcd)
 
 lemma lcm_0_right [simp]: "lcm a 0 = 0"
   by (simp add: lcm_gcd)
 
 lemma lcm_eq_0_iff: "lcm a b = 0 \<longleftrightarrow> a = 0 \<or> b = 0"
   (is "?P \<longleftrightarrow> ?Q")
 proof
   assume ?P
   then have "0 dvd lcm a b"
     by simp
   also have "lcm a b dvd (a * b)"
     by simp
   finally show ?Q
     by auto
 next
   assume ?Q
   then show ?P
     by auto
 qed
 
 lemma zero_eq_lcm_iff: "0 = lcm a b \<longleftrightarrow> a = 0 \<or> b = 0"
   using lcm_eq_0_iff[of a b] by auto
 
 lemma lcm_eq_1_iff [simp]: "lcm a b = 1 \<longleftrightarrow> is_unit a \<and> is_unit b"
   by (auto intro: associated_eqI)
 
 lemma unit_factor_lcm: "unit_factor (lcm a b) = (if a = 0 \<or> b = 0 then 0 else 1)"
   using lcm_eq_0_iff[of a b] by (cases "lcm a b = 0") (auto simp: lcm_gcd)
 
 sublocale lcm: abel_semigroup lcm
 proof
   fix a b c
   show "lcm a b = lcm b a"
     by (simp add: lcm_gcd ac_simps normalize_mult dvd_normalize_div)
   have "lcm (lcm a b) c dvd lcm a (lcm b c)"
     and "lcm a (lcm b c) dvd lcm (lcm a b) c"
     by (auto intro: lcm_least
       dvd_trans [of b "lcm b c" "lcm a (lcm b c)"]
       dvd_trans [of c "lcm b c" "lcm a (lcm b c)"]
       dvd_trans [of a "lcm a b" "lcm (lcm a b) c"]
       dvd_trans [of b "lcm a b" "lcm (lcm a b) c"])
   then show "lcm (lcm a b) c = lcm a (lcm b c)"
     by (rule associated_eqI) simp_all
 qed
 
 sublocale lcm: bounded_quasi_semilattice lcm 1 0 normalize
 proof
   show "lcm a a = normalize a" for a
   proof -
     have "lcm a a dvd a"
       by (rule lcm_least) simp_all
     then show ?thesis
       by (auto intro: associated_eqI)
   qed
   show "lcm (normalize a) b = lcm a b" for a b
     using dvd_lcm1 [of "normalize a" b] unfolding normalize_dvd_iff
     by (auto intro: associated_eqI)
   show "lcm 1 a = normalize a" for a
     by (rule associated_eqI) simp_all
 qed simp_all
 
 lemma lcm_self: "lcm a a = normalize a"
   by (fact lcm.idem_normalize)
 
 lemma lcm_left_idem: "lcm a (lcm a b) = lcm a b"
   by (fact lcm.left_idem)
 
 lemma lcm_right_idem: "lcm (lcm a b) b = lcm a b"
   by (fact lcm.right_idem)
 
 lemma gcd_lcm:
   assumes "a \<noteq> 0" and "b \<noteq> 0"
   shows "gcd a b = normalize (a * b div lcm a b)"
 proof -
   from assms have [simp]: "a * b div gcd a b \<noteq> 0"
     by (subst dvd_div_eq_0_iff) auto
   let ?u = "unit_factor (a * b div gcd a b)"
   have "gcd a b * normalize (a * b div gcd a b) =
           gcd a b * ((a * b div gcd a b) * (1 div ?u))"
     by simp
   also have "\<dots> = a * b div ?u"
     by (subst mult.assoc [symmetric]) auto
   also have "\<dots> dvd a * b"
     by (subst div_unit_dvd_iff) auto
   finally have "gcd a b dvd ((a * b) div lcm a b)"
     by (intro dvd_mult_imp_div) (auto simp: lcm_gcd)
   moreover have "a * b div lcm a b dvd a" and "a * b div lcm a b dvd b"
     using assms by (subst div_dvd_iff_mult; simp add: lcm_eq_0_iff mult.commute[of b "lcm a b"])+
   ultimately have "normalize (gcd a b) = normalize (a * b div lcm a b)"
     apply -
     apply (rule associated_eqI)
     using assms
     apply (auto simp: div_dvd_iff_mult zero_eq_lcm_iff)
     done
   thus ?thesis by simp
 qed
 
 lemma lcm_1_left: "lcm 1 a = normalize a"
   by (fact lcm.top_left_normalize)
 
 lemma lcm_1_right: "lcm a 1 = normalize a"
   by (fact lcm.top_right_normalize)
 
 lemma lcm_mult_left: "lcm (c * a) (c * b) = normalize (c * lcm a b)"
 proof (cases "c = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then have *: "lcm (c * a) (c * b) dvd c * lcm a b"
     by (auto intro: lcm_least)
   moreover have "lcm a b dvd lcm (c * a) (c * b) div c"
     by (intro lcm_least) (auto intro!: dvd_mult_imp_div simp: mult_ac)
   hence "c * lcm a b dvd lcm (c * a) (c * b)"
     using False by (subst (asm) dvd_div_iff_mult) (auto simp: mult_ac intro: dvd_lcmI1)
   ultimately have "normalize (lcm (c * a) (c * b)) = normalize (c * lcm a b)"
     by (auto intro: associated_eqI)
   then show ?thesis
     by (simp add: normalize_mult)
 qed
 
 lemma lcm_mult_right: "lcm (a * c) (b * c) = normalize (lcm b a * c)"
   using lcm_mult_left [of c a b] by (simp add: ac_simps)
 
 lemma lcm_mult_unit1: "is_unit a \<Longrightarrow> lcm (b * a) c = lcm b c"
   by (rule associated_eqI) (simp_all add: mult_unit_dvd_iff dvd_lcmI1)
 
 lemma lcm_mult_unit2: "is_unit a \<Longrightarrow> lcm b (c * a) = lcm b c"
   using lcm_mult_unit1 [of a c b] by (simp add: ac_simps)
 
 lemma lcm_div_unit1:
   "is_unit a \<Longrightarrow> lcm (b div a) c = lcm b c"
   by (erule is_unitE [of _ b]) (simp add: lcm_mult_unit1)
 
 lemma lcm_div_unit2: "is_unit a \<Longrightarrow> lcm b (c div a) = lcm b c"
   by (erule is_unitE [of _ c]) (simp add: lcm_mult_unit2)
 
 lemma normalize_lcm_left: "lcm (normalize a) b = lcm a b"
   by (fact lcm.normalize_left_idem)
 
 lemma normalize_lcm_right: "lcm a (normalize b) = lcm a b"
   by (fact lcm.normalize_right_idem)
 
 lemma comp_fun_idem_gcd: "comp_fun_idem gcd"
   by standard (simp_all add: fun_eq_iff ac_simps)
 
 lemma comp_fun_idem_lcm: "comp_fun_idem lcm"
   by standard (simp_all add: fun_eq_iff ac_simps)
 
 lemma gcd_dvd_antisym: "gcd a b dvd gcd c d \<Longrightarrow> gcd c d dvd gcd a b \<Longrightarrow> gcd a b = gcd c d"
 proof (rule gcdI)
   assume *: "gcd a b dvd gcd c d"
     and **: "gcd c d dvd gcd a b"
   have "gcd c d dvd c"
     by simp
   with * show "gcd a b dvd c"
     by (rule dvd_trans)
   have "gcd c d dvd d"
     by simp
   with * show "gcd a b dvd d"
     by (rule dvd_trans)
   show "normalize (gcd a b) = gcd a b"
     by simp
   fix l assume "l dvd c" and "l dvd d"
   then have "l dvd gcd c d"
     by (rule gcd_greatest)
   from this and ** show "l dvd gcd a b"
     by (rule dvd_trans)
 qed
 
 declare unit_factor_lcm [simp]
 
 lemma lcmI:
   assumes "a dvd c" and "b dvd c" and "\<And>d. a dvd d \<Longrightarrow> b dvd d \<Longrightarrow> c dvd d"
     and "normalize c = c"
   shows "c = lcm a b"
   by (rule associated_eqI) (auto simp: assms intro: lcm_least)
 
 lemma gcd_dvd_lcm [simp]: "gcd a b dvd lcm a b"
   using gcd_dvd2 by (rule dvd_lcmI2)
 
 lemmas lcm_0 = lcm_0_right
 
 lemma lcm_unique:
   "a dvd d \<and> b dvd d \<and> normalize d = d \<and> (\<forall>e. a dvd e \<and> b dvd e \<longrightarrow> d dvd e) \<longleftrightarrow> d = lcm a b"
   by rule (auto intro: lcmI simp: lcm_least lcm_eq_0_iff)
 
 lemma lcm_proj1_if_dvd:
   assumes "b dvd a" shows "lcm a b = normalize a"
 proof -
   have "normalize (lcm a b) = normalize a"
     by (rule associatedI) (use assms in auto)
   thus ?thesis by simp
 qed
 
 lemma lcm_proj2_if_dvd: "a dvd b \<Longrightarrow> lcm a b = normalize b"
   using lcm_proj1_if_dvd [of a b] by (simp add: ac_simps)
 
 lemma lcm_proj1_iff: "lcm m n = normalize m \<longleftrightarrow> n dvd m"
 proof
   assume *: "lcm m n = normalize m"
   show "n dvd m"
   proof (cases "m = 0")
     case True
     then show ?thesis by simp
   next
     case [simp]: False
     from * have **: "m = lcm m n * unit_factor m"
       by (simp add: unit_eq_div2)
     show ?thesis by (subst **) simp
   qed
 next
   assume "n dvd m"
   then show "lcm m n = normalize m"
     by (rule lcm_proj1_if_dvd)
 qed
 
 lemma lcm_proj2_iff: "lcm m n = normalize n \<longleftrightarrow> m dvd n"
   using lcm_proj1_iff [of n m] by (simp add: ac_simps)
 
 lemma gcd_mono: "a dvd c \<Longrightarrow> b dvd d \<Longrightarrow> gcd a b dvd gcd c d"
   by (simp add: gcd_dvdI1 gcd_dvdI2)
 
 lemma lcm_mono: "a dvd c \<Longrightarrow> b dvd d \<Longrightarrow> lcm a b dvd lcm c d"
   by (simp add: dvd_lcmI1 dvd_lcmI2)
 
 lemma dvd_productE:
   assumes "p dvd a * b"
   obtains x y where "p = x * y" "x dvd a" "y dvd b"
 proof (cases "a = 0")
   case True
   thus ?thesis by (intro that[of p 1]) simp_all
 next
   case False
   define x y where "x = gcd a p" and "y = p div x"
   have "p = x * y" by (simp add: x_def y_def)
   moreover have "x dvd a" by (simp add: x_def)
   moreover from assms have "p dvd gcd (b * a) (b * p)"
     by (intro gcd_greatest) (simp_all add: mult.commute)
   hence "p dvd b * gcd a p" by (subst (asm) gcd_mult_left) auto
   with False have "y dvd b"
     by (simp add: x_def y_def div_dvd_iff_mult assms)
   ultimately show ?thesis by (rule that)
 qed
 
 lemma gcd_mult_unit1: 
   assumes "is_unit a" shows "gcd (b * a) c = gcd b c"
 proof -
   have "gcd (b * a) c dvd b"
     using assms dvd_mult_unit_iff by blast
   then show ?thesis
     by (rule gcdI) simp_all
 qed
 
 lemma gcd_mult_unit2: "is_unit a \<Longrightarrow> gcd b (c * a) = gcd b c"
   using gcd.commute gcd_mult_unit1 by auto
 
 lemma gcd_div_unit1: "is_unit a \<Longrightarrow> gcd (b div a) c = gcd b c"
   by (erule is_unitE [of _ b]) (simp add: gcd_mult_unit1)
 
 lemma gcd_div_unit2: "is_unit a \<Longrightarrow> gcd b (c div a) = gcd b c"
   by (erule is_unitE [of _ c]) (simp add: gcd_mult_unit2)
 
 lemma normalize_gcd_left: "gcd (normalize a) b = gcd a b"
   by (fact gcd.normalize_left_idem)
 
 lemma normalize_gcd_right: "gcd a (normalize b) = gcd a b"
   by (fact gcd.normalize_right_idem)
 
 lemma gcd_add1 [simp]: "gcd (m + n) n = gcd m n"
   by (rule gcdI [symmetric]) (simp_all add: dvd_add_left_iff)
 
 lemma gcd_add2 [simp]: "gcd m (m + n) = gcd m n"
   using gcd_add1 [of n m] by (simp add: ac_simps)
 
 lemma gcd_add_mult: "gcd m (k * m + n) = gcd m n"
   by (rule gcdI [symmetric]) (simp_all add: dvd_add_right_iff)
 
 end
 
 class ring_gcd = comm_ring_1 + semiring_gcd
 begin
 
 lemma gcd_neg1 [simp]: "gcd (-a) b = gcd a b"
   by (rule sym, rule gcdI) (simp_all add: gcd_greatest)
 
 lemma gcd_neg2 [simp]: "gcd a (-b) = gcd a b"
   by (rule sym, rule gcdI) (simp_all add: gcd_greatest)
 
 lemma gcd_neg_numeral_1 [simp]: "gcd (- numeral n) a = gcd (numeral n) a"
   by (fact gcd_neg1)
 
 lemma gcd_neg_numeral_2 [simp]: "gcd a (- numeral n) = gcd a (numeral n)"
   by (fact gcd_neg2)
 
 lemma gcd_diff1: "gcd (m - n) n = gcd m n"
   by (subst diff_conv_add_uminus, subst gcd_neg2[symmetric], subst gcd_add1, simp)
 
 lemma gcd_diff2: "gcd (n - m) n = gcd m n"
   by (subst gcd_neg1[symmetric]) (simp only: minus_diff_eq gcd_diff1)
 
 lemma lcm_neg1 [simp]: "lcm (-a) b = lcm a b"
   by (rule sym, rule lcmI) (simp_all add: lcm_least lcm_eq_0_iff)
 
 lemma lcm_neg2 [simp]: "lcm a (-b) = lcm a b"
   by (rule sym, rule lcmI) (simp_all add: lcm_least lcm_eq_0_iff)
 
 lemma lcm_neg_numeral_1 [simp]: "lcm (- numeral n) a = lcm (numeral n) a"
   by (fact lcm_neg1)
 
 lemma lcm_neg_numeral_2 [simp]: "lcm a (- numeral n) = lcm a (numeral n)"
   by (fact lcm_neg2)
 
 end
 
 class semiring_Gcd = semiring_gcd + Gcd +
   assumes Gcd_dvd: "a \<in> A \<Longrightarrow> Gcd A dvd a"
     and Gcd_greatest: "(\<And>b. b \<in> A \<Longrightarrow> a dvd b) \<Longrightarrow> a dvd Gcd A"
     and normalize_Gcd [simp]: "normalize (Gcd A) = Gcd A"
   assumes dvd_Lcm: "a \<in> A \<Longrightarrow> a dvd Lcm A"
     and Lcm_least: "(\<And>b. b \<in> A \<Longrightarrow> b dvd a) \<Longrightarrow> Lcm A dvd a"
     and normalize_Lcm [simp]: "normalize (Lcm A) = Lcm A"
 begin
 
 lemma Lcm_Gcd: "Lcm A = Gcd {b. \<forall>a\<in>A. a dvd b}"
   by (rule associated_eqI) (auto intro: Gcd_dvd dvd_Lcm Gcd_greatest Lcm_least)
 
 lemma Gcd_Lcm: "Gcd A = Lcm {b. \<forall>a\<in>A. b dvd a}"
   by (rule associated_eqI) (auto intro: Gcd_dvd dvd_Lcm Gcd_greatest Lcm_least)
 
 lemma Gcd_empty [simp]: "Gcd {} = 0"
   by (rule dvd_0_left, rule Gcd_greatest) simp
 
 lemma Lcm_empty [simp]: "Lcm {} = 1"
   by (auto intro: associated_eqI Lcm_least)
 
 lemma Gcd_insert [simp]: "Gcd (insert a A) = gcd a (Gcd A)"
 proof -
   have "Gcd (insert a A) dvd gcd a (Gcd A)"
     by (auto intro: Gcd_dvd Gcd_greatest)
   moreover have "gcd a (Gcd A) dvd Gcd (insert a A)"
   proof (rule Gcd_greatest)
     fix b
     assume "b \<in> insert a A"
     then show "gcd a (Gcd A) dvd b"
     proof
       assume "b = a"
       then show ?thesis
         by simp
     next
       assume "b \<in> A"
       then have "Gcd A dvd b"
         by (rule Gcd_dvd)
       moreover have "gcd a (Gcd A) dvd Gcd A"
         by simp
       ultimately show ?thesis
         by (blast intro: dvd_trans)
     qed
   qed
   ultimately show ?thesis
     by (auto intro: associated_eqI)
 qed
 
 lemma Lcm_insert [simp]: "Lcm (insert a A) = lcm a (Lcm A)"
 proof (rule sym)
   have "lcm a (Lcm A) dvd Lcm (insert a A)"
     by (auto intro: dvd_Lcm Lcm_least)
   moreover have "Lcm (insert a A) dvd lcm a (Lcm A)"
   proof (rule Lcm_least)
     fix b
     assume "b \<in> insert a A"
     then show "b dvd lcm a (Lcm A)"
     proof
       assume "b = a"
       then show ?thesis by simp
     next
       assume "b \<in> A"
       then have "b dvd Lcm A"
         by (rule dvd_Lcm)
       moreover have "Lcm A dvd lcm a (Lcm A)"
         by simp
       ultimately show ?thesis
         by (blast intro: dvd_trans)
     qed
   qed
   ultimately show "lcm a (Lcm A) = Lcm (insert a A)"
     by (rule associated_eqI) (simp_all add: lcm_eq_0_iff)
 qed
 
 lemma LcmI:
   assumes "\<And>a. a \<in> A \<Longrightarrow> a dvd b"
     and "\<And>c. (\<And>a. a \<in> A \<Longrightarrow> a dvd c) \<Longrightarrow> b dvd c"
     and "normalize b = b"
   shows "b = Lcm A"
   by (rule associated_eqI) (auto simp: assms dvd_Lcm intro: Lcm_least)
 
 lemma Lcm_subset: "A \<subseteq> B \<Longrightarrow> Lcm A dvd Lcm B"
   by (blast intro: Lcm_least dvd_Lcm)
 
 lemma Lcm_Un: "Lcm (A \<union> B) = lcm (Lcm A) (Lcm B)"
 proof -
   have "\<And>d. \<lbrakk>Lcm A dvd d; Lcm B dvd d\<rbrakk> \<Longrightarrow> Lcm (A \<union> B) dvd d"
     by (meson UnE Lcm_least dvd_Lcm dvd_trans)
   then show ?thesis
     by (meson Lcm_subset lcm_unique normalize_Lcm sup.cobounded1 sup.cobounded2)
 qed
 
 lemma Gcd_0_iff [simp]: "Gcd A = 0 \<longleftrightarrow> A \<subseteq> {0}"
   (is "?P \<longleftrightarrow> ?Q")
 proof
   assume ?P
   show ?Q
   proof
     fix a
     assume "a \<in> A"
     then have "Gcd A dvd a"
       by (rule Gcd_dvd)
     with \<open>?P\<close> have "a = 0"
       by simp
     then show "a \<in> {0}"
       by simp
   qed
 next
   assume ?Q
   have "0 dvd Gcd A"
   proof (rule Gcd_greatest)
     fix a
     assume "a \<in> A"
     with \<open>?Q\<close> have "a = 0"
       by auto
     then show "0 dvd a"
       by simp
   qed
   then show ?P
     by simp
 qed
 
 lemma Lcm_1_iff [simp]: "Lcm A = 1 \<longleftrightarrow> (\<forall>a\<in>A. is_unit a)"
   (is "?P \<longleftrightarrow> ?Q")
 proof
   assume ?P
   show ?Q
   proof
     fix a
     assume "a \<in> A"
     then have "a dvd Lcm A"
       by (rule dvd_Lcm)
     with \<open>?P\<close> show "is_unit a"
       by simp
   qed
 next
   assume ?Q
   then have "is_unit (Lcm A)"
     by (blast intro: Lcm_least)
   then have "normalize (Lcm A) = 1"
     by (rule is_unit_normalize)
   then show ?P
     by simp
 qed
 
 lemma unit_factor_Lcm: "unit_factor (Lcm A) = (if Lcm A = 0 then 0 else 1)"
 proof (cases "Lcm A = 0")
   case True
   then show ?thesis
     by simp
 next
   case False
   with unit_factor_normalize have "unit_factor (normalize (Lcm A)) = 1"
     by blast
   with False show ?thesis
     by simp
 qed
 
 lemma unit_factor_Gcd: "unit_factor (Gcd A) = (if Gcd A = 0 then 0 else 1)"
   by (simp add: Gcd_Lcm unit_factor_Lcm)
 
 lemma GcdI:
   assumes "\<And>a. a \<in> A \<Longrightarrow> b dvd a"
     and "\<And>c. (\<And>a. a \<in> A \<Longrightarrow> c dvd a) \<Longrightarrow> c dvd b"
     and "normalize b = b"
   shows "b = Gcd A"
   by (rule associated_eqI) (auto simp: assms Gcd_dvd intro: Gcd_greatest)
 
 lemma Gcd_eq_1_I:
   assumes "is_unit a" and "a \<in> A"
   shows "Gcd A = 1"
 proof -
   from assms have "is_unit (Gcd A)"
     by (blast intro: Gcd_dvd dvd_unit_imp_unit)
   then have "normalize (Gcd A) = 1"
     by (rule is_unit_normalize)
   then show ?thesis
     by simp
 qed
 
 lemma Lcm_eq_0_I:
   assumes "0 \<in> A"
   shows "Lcm A = 0"
 proof -
   from assms have "0 dvd Lcm A"
     by (rule dvd_Lcm)
   then show ?thesis
     by simp
 qed
 
 lemma Gcd_UNIV [simp]: "Gcd UNIV = 1"
   using dvd_refl by (rule Gcd_eq_1_I) simp
 
 lemma Lcm_UNIV [simp]: "Lcm UNIV = 0"
   by (rule Lcm_eq_0_I) simp
 
 lemma Lcm_0_iff:
   assumes "finite A"
   shows "Lcm A = 0 \<longleftrightarrow> 0 \<in> A"
 proof (cases "A = {}")
   case True
   then show ?thesis by simp
 next
   case False
   with assms show ?thesis
     by (induct A rule: finite_ne_induct) (auto simp: lcm_eq_0_iff)
 qed
 
 lemma Gcd_image_normalize [simp]: "Gcd (normalize ` A) = Gcd A"
 proof -
   have "Gcd (normalize ` A) dvd a" if "a \<in> A" for a
   proof -
     from that obtain B where "A = insert a B"
       by blast
     moreover have "gcd (normalize a) (Gcd (normalize ` B)) dvd normalize a"
       by (rule gcd_dvd1)
     ultimately show "Gcd (normalize ` A) dvd a"
       by simp
   qed
   then have "Gcd (normalize ` A) dvd Gcd A" and "Gcd A dvd Gcd (normalize ` A)"
     by (auto intro!: Gcd_greatest intro: Gcd_dvd)
   then show ?thesis
     by (auto intro: associated_eqI)
 qed
 
 lemma Gcd_eqI:
   assumes "normalize a = a"
   assumes "\<And>b. b \<in> A \<Longrightarrow> a dvd b"
     and "\<And>c. (\<And>b. b \<in> A \<Longrightarrow> c dvd b) \<Longrightarrow> c dvd a"
   shows "Gcd A = a"
   using assms by (blast intro: associated_eqI Gcd_greatest Gcd_dvd normalize_Gcd)
 
 lemma dvd_GcdD: "x dvd Gcd A \<Longrightarrow> y \<in> A \<Longrightarrow> x dvd y"
   using Gcd_dvd dvd_trans by blast
 
 lemma dvd_Gcd_iff: "x dvd Gcd A \<longleftrightarrow> (\<forall>y\<in>A. x dvd y)"
   by (blast dest: dvd_GcdD intro: Gcd_greatest)
 
 lemma Gcd_mult: "Gcd ((*) c ` A) = normalize (c * Gcd A)"
 proof (cases "c = 0")
   case True
   then show ?thesis by auto
 next
   case [simp]: False
   have "Gcd ((*) c ` A) div c dvd Gcd A"
     by (intro Gcd_greatest, subst div_dvd_iff_mult)
        (auto intro!: Gcd_greatest Gcd_dvd simp: mult.commute[of _ c])
   then have "Gcd ((*) c ` A) dvd c * Gcd A"
     by (subst (asm) div_dvd_iff_mult) (auto intro: Gcd_greatest simp: mult_ac)
   moreover have "c * Gcd A dvd Gcd ((*) c ` A)"
     by (intro Gcd_greatest) (auto intro: mult_dvd_mono Gcd_dvd)
   ultimately have "normalize (Gcd ((*) c ` A)) = normalize (c * Gcd A)"
     by (rule associatedI)
   then show ?thesis by simp    
 qed
 
 lemma Lcm_eqI:
   assumes "normalize a = a"
     and "\<And>b. b \<in> A \<Longrightarrow> b dvd a"
     and "\<And>c. (\<And>b. b \<in> A \<Longrightarrow> b dvd c) \<Longrightarrow> a dvd c"
   shows "Lcm A = a"
   using assms by (blast intro: associated_eqI Lcm_least dvd_Lcm normalize_Lcm)
 
 lemma Lcm_dvdD: "Lcm A dvd x \<Longrightarrow> y \<in> A \<Longrightarrow> y dvd x"
   using dvd_Lcm dvd_trans by blast
 
 lemma Lcm_dvd_iff: "Lcm A dvd x \<longleftrightarrow> (\<forall>y\<in>A. y dvd x)"
   by (blast dest: Lcm_dvdD intro: Lcm_least)
 
 lemma Lcm_mult:
   assumes "A \<noteq> {}"
   shows "Lcm ((*) c ` A) = normalize (c * Lcm A)"
 proof (cases "c = 0")
   case True
   with assms have "(*) c ` A = {0}"
     by auto
   with True show ?thesis by auto
 next
   case [simp]: False
   from assms obtain x where x: "x \<in> A"
     by blast
   have "c dvd c * x"
     by simp
   also from x have "c * x dvd Lcm ((*) c ` A)"
     by (intro dvd_Lcm) auto
   finally have dvd: "c dvd Lcm ((*) c ` A)" .
   moreover have "Lcm A dvd Lcm ((*) c ` A) div c"
     by (intro Lcm_least dvd_mult_imp_div)
       (auto intro!: Lcm_least dvd_Lcm simp: mult.commute[of _ c])
   ultimately have "c * Lcm A dvd Lcm ((*) c ` A)"
     by auto
   moreover have "Lcm ((*) c ` A) dvd c * Lcm A"
     by (intro Lcm_least) (auto intro: mult_dvd_mono dvd_Lcm)
   ultimately have "normalize (c * Lcm A) = normalize (Lcm ((*) c ` A))"
     by (rule associatedI)
   then show ?thesis by simp
 qed
 
 lemma Lcm_no_units: "Lcm A = Lcm (A - {a. is_unit a})"
 proof -
   have "(A - {a. is_unit a}) \<union> {a\<in>A. is_unit a} = A"
     by blast
   then have "Lcm A = lcm (Lcm (A - {a. is_unit a})) (Lcm {a\<in>A. is_unit a})"
     by (simp add: Lcm_Un [symmetric])
   also have "Lcm {a\<in>A. is_unit a} = 1"
     by simp
   finally show ?thesis
     by simp
 qed
 
 lemma Lcm_0_iff': "Lcm A = 0 \<longleftrightarrow> (\<nexists>l. l \<noteq> 0 \<and> (\<forall>a\<in>A. a dvd l))"
   by (metis Lcm_least dvd_0_left dvd_Lcm)
 
 lemma Lcm_no_multiple: "(\<forall>m. m \<noteq> 0 \<longrightarrow> (\<exists>a\<in>A. \<not> a dvd m)) \<Longrightarrow> Lcm A = 0"
   by (auto simp: Lcm_0_iff')
 
 lemma Lcm_singleton [simp]: "Lcm {a} = normalize a"
   by simp
 
 lemma Lcm_2 [simp]: "Lcm {a, b} = lcm a b"
   by simp
 
 lemma Gcd_1: "1 \<in> A \<Longrightarrow> Gcd A = 1"
   by (auto intro!: Gcd_eq_1_I)
 
 lemma Gcd_singleton [simp]: "Gcd {a} = normalize a"
   by simp
 
 lemma Gcd_2 [simp]: "Gcd {a, b} = gcd a b"
   by simp
 
 lemma Gcd_mono:
   assumes "\<And>x. x \<in> A \<Longrightarrow> f x dvd g x"
   shows   "(GCD x\<in>A. f x) dvd (GCD x\<in>A. g x)"
 proof (intro Gcd_greatest, safe)
   fix x assume "x \<in> A"
   hence "(GCD x\<in>A. f x) dvd f x"
     by (intro Gcd_dvd) auto
   also have "f x dvd g x"
     using \<open>x \<in> A\<close> assms by blast
   finally show "(GCD x\<in>A. f x) dvd \<dots>" .
 qed
 
 lemma Lcm_mono:
   assumes "\<And>x. x \<in> A \<Longrightarrow> f x dvd g x"
   shows   "(LCM x\<in>A. f x) dvd (LCM x\<in>A. g x)"
 proof (intro Lcm_least, safe)
   fix x assume "x \<in> A"
   hence "f x dvd g x" by (rule assms)
   also have "g x dvd (LCM x\<in>A. g x)"
     using \<open>x \<in> A\<close> by (intro dvd_Lcm) auto
   finally show "f x dvd \<dots>" .
 qed
 
 end
 
 
 subsection \<open>An aside: GCD and LCM on finite sets for incomplete gcd rings\<close>
 
 context semiring_gcd
 begin
 
 sublocale Gcd_fin: bounded_quasi_semilattice_set gcd 0 1 normalize
 defines
   Gcd_fin ("Gcd\<^sub>f\<^sub>i\<^sub>n") = "Gcd_fin.F :: 'a set \<Rightarrow> 'a" ..
 
 abbreviation gcd_list :: "'a list \<Rightarrow> 'a"
   where "gcd_list xs \<equiv> Gcd\<^sub>f\<^sub>i\<^sub>n (set xs)"
 
 sublocale Lcm_fin: bounded_quasi_semilattice_set lcm 1 0 normalize
 defines
   Lcm_fin ("Lcm\<^sub>f\<^sub>i\<^sub>n") = Lcm_fin.F ..
 
 abbreviation lcm_list :: "'a list \<Rightarrow> 'a"
   where "lcm_list xs \<equiv> Lcm\<^sub>f\<^sub>i\<^sub>n (set xs)"
 
 lemma Gcd_fin_dvd:
   "a \<in> A \<Longrightarrow> Gcd\<^sub>f\<^sub>i\<^sub>n A dvd a"
   by (induct A rule: infinite_finite_induct)
     (auto intro: dvd_trans)
 
 lemma dvd_Lcm_fin:
   "a \<in> A \<Longrightarrow> a dvd Lcm\<^sub>f\<^sub>i\<^sub>n A"
   by (induct A rule: infinite_finite_induct)
     (auto intro: dvd_trans)
 
 lemma Gcd_fin_greatest:
   "a dvd Gcd\<^sub>f\<^sub>i\<^sub>n A" if "finite A" and "\<And>b. b \<in> A \<Longrightarrow> a dvd b"
   using that by (induct A) simp_all
 
 lemma Lcm_fin_least:
   "Lcm\<^sub>f\<^sub>i\<^sub>n A dvd a" if "finite A" and "\<And>b. b \<in> A \<Longrightarrow> b dvd a"
   using that by (induct A) simp_all
 
 lemma gcd_list_greatest:
   "a dvd gcd_list bs" if "\<And>b. b \<in> set bs \<Longrightarrow> a dvd b"
   by (rule Gcd_fin_greatest) (simp_all add: that)
 
 lemma lcm_list_least:
   "lcm_list bs dvd a" if "\<And>b. b \<in> set bs \<Longrightarrow> b dvd a"
   by (rule Lcm_fin_least) (simp_all add: that)
 
 lemma dvd_Gcd_fin_iff:
   "b dvd Gcd\<^sub>f\<^sub>i\<^sub>n A \<longleftrightarrow> (\<forall>a\<in>A. b dvd a)" if "finite A"
   using that by (auto intro: Gcd_fin_greatest Gcd_fin_dvd dvd_trans [of b "Gcd\<^sub>f\<^sub>i\<^sub>n A"])
 
 lemma dvd_gcd_list_iff:
   "b dvd gcd_list xs \<longleftrightarrow> (\<forall>a\<in>set xs. b dvd a)"
   by (simp add: dvd_Gcd_fin_iff)
 
 lemma Lcm_fin_dvd_iff:
   "Lcm\<^sub>f\<^sub>i\<^sub>n A dvd b  \<longleftrightarrow> (\<forall>a\<in>A. a dvd b)" if "finite A"
   using that by (auto intro: Lcm_fin_least dvd_Lcm_fin dvd_trans [of _ "Lcm\<^sub>f\<^sub>i\<^sub>n A" b])
 
 lemma lcm_list_dvd_iff:
   "lcm_list xs dvd b  \<longleftrightarrow> (\<forall>a\<in>set xs. a dvd b)"
   by (simp add: Lcm_fin_dvd_iff)
 
 lemma Gcd_fin_mult:
   "Gcd\<^sub>f\<^sub>i\<^sub>n (image (times b) A) = normalize (b * Gcd\<^sub>f\<^sub>i\<^sub>n A)" if "finite A"
   using that by induction (auto simp: gcd_mult_left)
 
 lemma Lcm_fin_mult:
   "Lcm\<^sub>f\<^sub>i\<^sub>n (image (times b) A) = normalize (b * Lcm\<^sub>f\<^sub>i\<^sub>n A)" if "A \<noteq> {}"
 proof (cases "b = 0")
   case True
   moreover from that have "times 0 ` A = {0}"
     by auto
   ultimately show ?thesis
     by simp
 next
   case False
   show ?thesis proof (cases "finite A")
     case False
     moreover have "inj_on (times b) A"
       using \<open>b \<noteq> 0\<close> by (rule inj_on_mult)
     ultimately have "infinite (times b ` A)"
       by (simp add: finite_image_iff)
     with False show ?thesis
       by simp
   next
     case True
     then show ?thesis using that
       by (induct A rule: finite_ne_induct) (auto simp: lcm_mult_left)
   qed
 qed
 
 lemma unit_factor_Gcd_fin:
   "unit_factor (Gcd\<^sub>f\<^sub>i\<^sub>n A) = of_bool (Gcd\<^sub>f\<^sub>i\<^sub>n A \<noteq> 0)"
   by (rule normalize_idem_imp_unit_factor_eq) simp
 
 lemma unit_factor_Lcm_fin:
   "unit_factor (Lcm\<^sub>f\<^sub>i\<^sub>n A) = of_bool (Lcm\<^sub>f\<^sub>i\<^sub>n A \<noteq> 0)"
   by (rule normalize_idem_imp_unit_factor_eq) simp
 
 lemma is_unit_Gcd_fin_iff [simp]:
   "is_unit (Gcd\<^sub>f\<^sub>i\<^sub>n A) \<longleftrightarrow> Gcd\<^sub>f\<^sub>i\<^sub>n A = 1"
   by (rule normalize_idem_imp_is_unit_iff) simp
 
 lemma is_unit_Lcm_fin_iff [simp]:
   "is_unit (Lcm\<^sub>f\<^sub>i\<^sub>n A) \<longleftrightarrow> Lcm\<^sub>f\<^sub>i\<^sub>n A = 1"
   by (rule normalize_idem_imp_is_unit_iff) simp
  
 lemma Gcd_fin_0_iff:
   "Gcd\<^sub>f\<^sub>i\<^sub>n A = 0 \<longleftrightarrow> A \<subseteq> {0} \<and> finite A"
   by (induct A rule: infinite_finite_induct) simp_all
 
 lemma Lcm_fin_0_iff:
   "Lcm\<^sub>f\<^sub>i\<^sub>n A = 0 \<longleftrightarrow> 0 \<in> A" if "finite A"
   using that by (induct A) (auto simp: lcm_eq_0_iff)
 
 lemma Lcm_fin_1_iff:
   "Lcm\<^sub>f\<^sub>i\<^sub>n A = 1 \<longleftrightarrow> (\<forall>a\<in>A. is_unit a) \<and> finite A"
   by (induct A rule: infinite_finite_induct) simp_all
 
 end
 
 context semiring_Gcd
 begin
 
 lemma Gcd_fin_eq_Gcd [simp]:
   "Gcd\<^sub>f\<^sub>i\<^sub>n A = Gcd A" if "finite A" for A :: "'a set"
   using that by induct simp_all
 
 lemma Gcd_set_eq_fold [code_unfold]:
   "Gcd (set xs) = fold gcd xs 0"
   by (simp add: Gcd_fin.set_eq_fold [symmetric])
 
 lemma Lcm_fin_eq_Lcm [simp]:
   "Lcm\<^sub>f\<^sub>i\<^sub>n A = Lcm A" if "finite A" for A :: "'a set"
   using that by induct simp_all
 
 lemma Lcm_set_eq_fold [code_unfold]:
   "Lcm (set xs) = fold lcm xs 1"
   by (simp add: Lcm_fin.set_eq_fold [symmetric])
 
 end
 
 
 subsection \<open>Coprimality\<close>
 
 context semiring_gcd
 begin
 
 lemma coprime_imp_gcd_eq_1 [simp]:
   "gcd a b = 1" if "coprime a b"
 proof -
   define t r s where "t = gcd a b" and "r = a div t" and "s = b div t"
   then have "a = t * r" and "b = t * s"
     by simp_all
   with that have "coprime (t * r) (t * s)"
     by simp
   then show ?thesis
     by (simp add: t_def)
 qed
 
 lemma gcd_eq_1_imp_coprime [dest!]:
   "coprime a b" if "gcd a b = 1"
 proof (rule coprimeI)
   fix c
   assume "c dvd a" and "c dvd b"
   then have "c dvd gcd a b"
     by (rule gcd_greatest)
   with that show "is_unit c"
     by simp
 qed
 
 lemma coprime_iff_gcd_eq_1 [presburger, code]:
   "coprime a b \<longleftrightarrow> gcd a b = 1"
   by rule (simp_all add: gcd_eq_1_imp_coprime)
 
 lemma is_unit_gcd [simp]:
   "is_unit (gcd a b) \<longleftrightarrow> coprime a b"
   by (simp add: coprime_iff_gcd_eq_1)
 
 lemma coprime_add_one_left [simp]: "coprime (a + 1) a"
   by (simp add: gcd_eq_1_imp_coprime ac_simps)
 
 lemma coprime_add_one_right [simp]: "coprime a (a + 1)"
   using coprime_add_one_left [of a] by (simp add: ac_simps)
 
 lemma coprime_mult_left_iff [simp]:
   "coprime (a * b) c \<longleftrightarrow> coprime a c \<and> coprime b c"
 proof
   assume "coprime (a * b) c"
   with coprime_common_divisor [of "a * b" c]
   have *: "is_unit d" if "d dvd a * b" and "d dvd c" for d
     using that by blast
   have "coprime a c"
     by (rule coprimeI, rule *) simp_all
   moreover have "coprime b c"
     by (rule coprimeI, rule *) simp_all
   ultimately show "coprime a c \<and> coprime b c" ..
 next
   assume "coprime a c \<and> coprime b c"
   then have "coprime a c" "coprime b c"
     by simp_all
   show "coprime (a * b) c"
   proof (rule coprimeI)
     fix d
     assume "d dvd a * b"
     then obtain r s where d: "d = r * s" "r dvd a" "s dvd b"
       by (rule dvd_productE)
     assume "d dvd c"
     with d have "r * s dvd c"
       by simp
     then have "r dvd c" "s dvd c"
       by (auto intro: dvd_mult_left dvd_mult_right)
     from \<open>coprime a c\<close> \<open>r dvd a\<close> \<open>r dvd c\<close>
     have "is_unit r"
       by (rule coprime_common_divisor)
     moreover from \<open>coprime b c\<close> \<open>s dvd b\<close> \<open>s dvd c\<close>
     have "is_unit s"
       by (rule coprime_common_divisor)
     ultimately show "is_unit d"
       by (simp add: d is_unit_mult_iff)
   qed
 qed
 
 lemma coprime_mult_right_iff [simp]:
   "coprime c (a * b) \<longleftrightarrow> coprime c a \<and> coprime c b"
   using coprime_mult_left_iff [of a b c] by (simp add: ac_simps)
 
 lemma coprime_power_left_iff [simp]:
   "coprime (a ^ n) b \<longleftrightarrow> coprime a b \<or> n = 0"
 proof (cases "n = 0")
   case True
   then show ?thesis
     by simp
 next
   case False
   then have "n > 0"
     by simp
   then show ?thesis
     by (induction n rule: nat_induct_non_zero) simp_all
 qed
 
 lemma coprime_power_right_iff [simp]:
   "coprime a (b ^ n) \<longleftrightarrow> coprime a b \<or> n = 0"
   using coprime_power_left_iff [of b n a] by (simp add: ac_simps)
 
 lemma prod_coprime_left:
   "coprime (\<Prod>i\<in>A. f i) a" if "\<And>i. i \<in> A \<Longrightarrow> coprime (f i) a"
   using that by (induct A rule: infinite_finite_induct) simp_all
 
 lemma prod_coprime_right:
   "coprime a (\<Prod>i\<in>A. f i)" if "\<And>i. i \<in> A \<Longrightarrow> coprime a (f i)"
   using that prod_coprime_left [of A f a] by (simp add: ac_simps)
 
 lemma prod_list_coprime_left:
   "coprime (prod_list xs) a" if "\<And>x. x \<in> set xs \<Longrightarrow> coprime x a"
   using that by (induct xs) simp_all
 
 lemma prod_list_coprime_right:
   "coprime a (prod_list xs)" if "\<And>x. x \<in> set xs \<Longrightarrow> coprime a x"
   using that prod_list_coprime_left [of xs a] by (simp add: ac_simps)
 
 lemma coprime_dvd_mult_left_iff:
   "a dvd b * c \<longleftrightarrow> a dvd b" if "coprime a c"
 proof
   assume "a dvd b"
   then show "a dvd b * c"
     by simp
 next
   assume "a dvd b * c"
   show "a dvd b"
   proof (cases "b = 0")
     case True
     then show ?thesis
       by simp
   next
     case False
     then have unit: "is_unit (unit_factor b)"
       by simp
     from \<open>coprime a c\<close>
     have "gcd (b * a) (b * c) * unit_factor b = b"
       by (subst gcd_mult_left) (simp add: ac_simps)
     moreover from \<open>a dvd b * c\<close>
     have "a dvd gcd (b * a) (b * c) * unit_factor b"
       by (simp add: dvd_mult_unit_iff unit)
     ultimately show ?thesis
       by simp
   qed
 qed
 
 lemma coprime_dvd_mult_right_iff:
   "a dvd c * b \<longleftrightarrow> a dvd b" if "coprime a c"
   using that coprime_dvd_mult_left_iff [of a c b] by (simp add: ac_simps)
 
 lemma divides_mult:
   "a * b dvd c" if "a dvd c" and "b dvd c" and "coprime a b"
 proof -
   from \<open>b dvd c\<close> obtain b' where "c = b * b'" ..
   with \<open>a dvd c\<close> have "a dvd b' * b"
     by (simp add: ac_simps)
   with \<open>coprime a b\<close> have "a dvd b'"
     by (simp add: coprime_dvd_mult_left_iff)
   then obtain a' where "b' = a * a'" ..
   with \<open>c = b * b'\<close> have "c = (a * b) * a'"
     by (simp add: ac_simps)
   then show ?thesis ..
 qed
 
 lemma div_gcd_coprime:
   assumes "a \<noteq> 0 \<or> b \<noteq> 0"
   shows "coprime (a div gcd a b) (b div gcd a b)"
 proof -
   let ?g = "gcd a b"
   let ?a' = "a div ?g"
   let ?b' = "b div ?g"
   let ?g' = "gcd ?a' ?b'"
   have dvdg: "?g dvd a" "?g dvd b"
     by simp_all
   have dvdg': "?g' dvd ?a'" "?g' dvd ?b'"
     by simp_all
   from dvdg dvdg' obtain ka kb ka' kb' where
     kab: "a = ?g * ka" "b = ?g * kb" "?a' = ?g' * ka'" "?b' = ?g' * kb'"
     unfolding dvd_def by blast
   from this [symmetric] have "?g * ?a' = (?g * ?g') * ka'" "?g * ?b' = (?g * ?g') * kb'"
     by (simp_all add: mult.assoc mult.left_commute [of "gcd a b"])
   then have dvdgg':"?g * ?g' dvd a" "?g* ?g' dvd b"
     by (auto simp: dvd_mult_div_cancel [OF dvdg(1)] dvd_mult_div_cancel [OF dvdg(2)] dvd_def)
   have "?g \<noteq> 0"
     using assms by simp
   moreover from gcd_greatest [OF dvdgg'] have "?g * ?g' dvd ?g" .
   ultimately show ?thesis
     using dvd_times_left_cancel_iff [of "gcd a b" _ 1]
     by simp (simp only: coprime_iff_gcd_eq_1)
 qed
 
 lemma gcd_coprime:
   assumes c: "gcd a b \<noteq> 0"
     and a: "a = a' * gcd a b"
     and b: "b = b' * gcd a b"
   shows "coprime a' b'"
 proof -
   from c have "a \<noteq> 0 \<or> b \<noteq> 0"
     by simp
   with div_gcd_coprime have "coprime (a div gcd a b) (b div gcd a b)" .
   also from assms have "a div gcd a b = a'"
     using dvd_div_eq_mult gcd_dvd1 by blast
   also from assms have "b div gcd a b = b'"
     using dvd_div_eq_mult gcd_dvd1 by blast
   finally show ?thesis .
 qed
 
 lemma gcd_coprime_exists:
   assumes "gcd a b \<noteq> 0"
   shows "\<exists>a' b'. a = a' * gcd a b \<and> b = b' * gcd a b \<and> coprime a' b'"
 proof -
   have "coprime (a div gcd a b) (b div gcd a b)"
     using assms div_gcd_coprime by auto
   then show ?thesis
     by force
 qed
 
 lemma pow_divides_pow_iff [simp]:
   "a ^ n dvd b ^ n \<longleftrightarrow> a dvd b" if "n > 0"
 proof (cases "gcd a b = 0")
   case True
   then show ?thesis
     by simp
 next
   case False
   show ?thesis
   proof
     let ?d = "gcd a b"
     from \<open>n > 0\<close> obtain m where m: "n = Suc m"
       by (cases n) simp_all
     from False have zn: "?d ^ n \<noteq> 0"
       by (rule power_not_zero)
     from gcd_coprime_exists [OF False]
     obtain a' b' where ab': "a = a' * ?d" "b = b' * ?d" "coprime a' b'"
       by blast
     assume "a ^ n dvd b ^ n"
     then have "(a' * ?d) ^ n dvd (b' * ?d) ^ n"
       by (simp add: ab'(1,2)[symmetric])
     then have "?d^n * a'^n dvd ?d^n * b'^n"
       by (simp only: power_mult_distrib ac_simps)
     with zn have "a' ^ n dvd b' ^ n"
       by simp
     then have "a' dvd b' ^ n"
       using dvd_trans[of a' "a'^n" "b'^n"] by (simp add: m)
     then have "a' dvd b' ^ m * b'"
       by (simp add: m ac_simps)
     moreover have "coprime a' (b' ^ n)"
       using \<open>coprime a' b'\<close> by simp
     then have "a' dvd b'"
       using \<open>a' dvd b' ^ n\<close> coprime_dvd_mult_left_iff dvd_mult by blast
     then have "a' * ?d dvd b' * ?d"
       by (rule mult_dvd_mono) simp
     with ab'(1,2) show "a dvd b"
       by simp
   next
     assume "a dvd b"
     with \<open>n > 0\<close> show "a ^ n dvd b ^ n"
       by (induction rule: nat_induct_non_zero)
         (simp_all add: mult_dvd_mono)
   qed
 qed
 
 lemma coprime_crossproduct:
   fixes a b c d :: 'a
   assumes "coprime a d" and "coprime b c"
   shows "normalize a * normalize c = normalize b * normalize d \<longleftrightarrow>
     normalize a = normalize b \<and> normalize c = normalize d"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?rhs
   then show ?lhs by simp
 next
   assume ?lhs
   from \<open>?lhs\<close> have "normalize a dvd normalize b * normalize d"
     by (auto intro: dvdI dest: sym)
   with \<open>coprime a d\<close> have "a dvd b"
     by (simp add: coprime_dvd_mult_left_iff normalize_mult [symmetric])
   from \<open>?lhs\<close> have "normalize b dvd normalize a * normalize c"
     by (auto intro: dvdI dest: sym)
   with \<open>coprime b c\<close> have "b dvd a"
     by (simp add: coprime_dvd_mult_left_iff normalize_mult [symmetric])
   from \<open>?lhs\<close> have "normalize c dvd normalize d * normalize b"
     by (auto intro: dvdI dest: sym simp add: mult.commute)
   with \<open>coprime b c\<close> have "c dvd d"
     by (simp add: coprime_dvd_mult_left_iff coprime_commute normalize_mult [symmetric])
   from \<open>?lhs\<close> have "normalize d dvd normalize c * normalize a"
     by (auto intro: dvdI dest: sym simp add: mult.commute)
   with \<open>coprime a d\<close> have "d dvd c"
     by (simp add: coprime_dvd_mult_left_iff coprime_commute normalize_mult [symmetric])
   from \<open>a dvd b\<close> \<open>b dvd a\<close> have "normalize a = normalize b"
     by (rule associatedI)
   moreover from \<open>c dvd d\<close> \<open>d dvd c\<close> have "normalize c = normalize d"
     by (rule associatedI)
   ultimately show ?rhs ..
 qed
 
 lemma gcd_mult_left_left_cancel:
   "gcd (c * a) b = gcd a b" if "coprime b c"
 proof -
   have "coprime (gcd b (a * c)) c"
     by (rule coprimeI) (auto intro: that coprime_common_divisor)
   then have "gcd b (a * c) dvd a"
     using coprime_dvd_mult_left_iff [of "gcd b (a * c)" c a]
     by simp
   then show ?thesis
     by (auto intro: associated_eqI simp add: ac_simps)
 qed
 
 lemma gcd_mult_left_right_cancel:
   "gcd (a * c) b = gcd a b" if "coprime b c"
   using that gcd_mult_left_left_cancel [of b c a]
   by (simp add: ac_simps)
 
 lemma gcd_mult_right_left_cancel:
   "gcd a (c * b) = gcd a b" if "coprime a c"
   using that gcd_mult_left_left_cancel [of a c b]
   by (simp add: ac_simps)
 
 lemma gcd_mult_right_right_cancel:
   "gcd a (b * c) = gcd a b" if "coprime a c"
   using that gcd_mult_right_left_cancel [of a c b]
   by (simp add: ac_simps)
 
 lemma gcd_exp_weak:
   "gcd (a ^ n) (b ^ n) = normalize (gcd a b ^ n)"
 proof (cases "a = 0 \<and> b = 0 \<or> n = 0")
   case True
   then show ?thesis
     by (cases n) simp_all
 next
   case False
   then have "coprime (a div gcd a b) (b div gcd a b)" and "n > 0"
     by (auto intro: div_gcd_coprime)
   then have "coprime ((a div gcd a b) ^ n) ((b div gcd a b) ^ n)"
     by simp
   then have "1 = gcd ((a div gcd a b) ^ n) ((b div gcd a b) ^ n)"
     by simp
   then have "normalize (gcd a b ^ n) = normalize (gcd a b ^ n * \<dots>)"
     by simp
   also have "\<dots> = gcd (gcd a b ^ n * (a div gcd a b) ^ n) (gcd a b ^ n * (b div gcd a b) ^ n)"
     by (rule gcd_mult_left [symmetric])
   also have "(gcd a b) ^ n * (a div gcd a b) ^ n = a ^ n"
     by (simp add: ac_simps div_power dvd_power_same)
   also have "(gcd a b) ^ n * (b div gcd a b) ^ n = b ^ n"
     by (simp add: ac_simps div_power dvd_power_same)
   finally show ?thesis by simp
 qed
 
 lemma division_decomp:
   assumes "a dvd b * c"
   shows "\<exists>b' c'. a = b' * c' \<and> b' dvd b \<and> c' dvd c"
 proof (cases "gcd a b = 0")
   case True
   then have "a = 0 \<and> b = 0"
     by simp
   then have "a = 0 * c \<and> 0 dvd b \<and> c dvd c"
     by simp
   then show ?thesis by blast
 next
   case False
   let ?d = "gcd a b"
   from gcd_coprime_exists [OF False]
     obtain a' b' where ab': "a = a' * ?d" "b = b' * ?d" "coprime a' b'"
     by blast
   from ab'(1) have "a' dvd a" ..
   with assms have "a' dvd b * c"
     using dvd_trans [of a' a "b * c"] by simp
   from assms ab'(1,2) have "a' * ?d dvd (b' * ?d) * c"
     by simp
   then have "?d * a' dvd ?d * (b' * c)"
     by (simp add: mult_ac)
   with \<open>?d \<noteq> 0\<close> have "a' dvd b' * c"
     by simp
   then have "a' dvd c"
     using \<open>coprime a' b'\<close> by (simp add: coprime_dvd_mult_right_iff)
   with ab'(1) have "a = ?d * a' \<and> ?d dvd b \<and> a' dvd c"
     by (simp add: ac_simps)
   then show ?thesis by blast
 qed
 
 lemma lcm_coprime: "coprime a b \<Longrightarrow> lcm a b = normalize (a * b)"
   by (subst lcm_gcd) simp
 
 end
 
 context ring_gcd
 begin
 
 lemma coprime_minus_left_iff [simp]:
   "coprime (- a) b \<longleftrightarrow> coprime a b"
   by (rule; rule coprimeI) (auto intro: coprime_common_divisor)
 
 lemma coprime_minus_right_iff [simp]:
   "coprime a (- b) \<longleftrightarrow> coprime a b"
   using coprime_minus_left_iff [of b a] by (simp add: ac_simps)
 
 lemma coprime_diff_one_left [simp]: "coprime (a - 1) a"
   using coprime_add_one_right [of "a - 1"] by simp
 
 lemma coprime_doff_one_right [simp]: "coprime a (a - 1)"
   using coprime_diff_one_left [of a] by (simp add: ac_simps)
 
 end
 
 context semiring_Gcd
 begin
 
 lemma Lcm_coprime:
   assumes "finite A"
     and "A \<noteq> {}"
     and "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> a \<noteq> b \<Longrightarrow> coprime a b"
   shows "Lcm A = normalize (\<Prod>A)"
   using assms
 proof (induct rule: finite_ne_induct)
   case singleton
   then show ?case by simp
 next
   case (insert a A)
   have "Lcm (insert a A) = lcm a (Lcm A)"
     by simp
   also from insert have "Lcm A = normalize (\<Prod>A)"
     by blast
   also have "lcm a \<dots> = lcm a (\<Prod>A)"
     by (cases "\<Prod>A = 0") (simp_all add: lcm_div_unit2)
   also from insert have "coprime a (\<Prod>A)"
     by (subst coprime_commute, intro prod_coprime_left) auto
   with insert have "lcm a (\<Prod>A) = normalize (\<Prod>(insert a A))"
     by (simp add: lcm_coprime)
   finally show ?case .
 qed
 
 lemma Lcm_coprime':
   "card A \<noteq> 0 \<Longrightarrow>
     (\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> a \<noteq> b \<Longrightarrow> coprime a b) \<Longrightarrow>
     Lcm A = normalize (\<Prod>A)"
   by (rule Lcm_coprime) (simp_all add: card_eq_0_iff)
 
 end
 
 
 subsection \<open>GCD and LCM for multiplicative normalisation functions\<close>
 
 class semiring_gcd_mult_normalize = semiring_gcd + normalization_semidom_multiplicative
 begin
 
 lemma mult_gcd_left: "c * gcd a b = unit_factor c * gcd (c * a) (c * b)"
   by (simp add: gcd_mult_left normalize_mult mult.assoc [symmetric])
 
 lemma mult_gcd_right: "gcd a b * c = gcd (a * c) (b * c) * unit_factor c"
   using mult_gcd_left [of c a b] by (simp add: ac_simps)
 
 lemma gcd_mult_distrib': "normalize c * gcd a b = gcd (c * a) (c * b)"
   by (subst gcd_mult_left) (simp_all add: normalize_mult)
 
 lemma gcd_mult_distrib: "k * gcd a b = gcd (k * a) (k * b) * unit_factor k"
 proof-
   have "normalize k * gcd a b = gcd (k * a) (k * b)"
     by (simp add: gcd_mult_distrib')
   then have "normalize k * gcd a b * unit_factor k = gcd (k * a) (k * b) * unit_factor k"
     by simp
   then have "normalize k * unit_factor k * gcd a b  = gcd (k * a) (k * b) * unit_factor k"
     by (simp only: ac_simps)
   then show ?thesis
     by simp
 qed
 
 lemma gcd_mult_lcm [simp]: "gcd a b * lcm a b = normalize a * normalize b"
   by (simp add: lcm_gcd normalize_mult dvd_normalize_div)
 
 lemma lcm_mult_gcd [simp]: "lcm a b * gcd a b = normalize a * normalize b"
   using gcd_mult_lcm [of a b] by (simp add: ac_simps)
 
 lemma mult_lcm_left: "c * lcm a b = unit_factor c * lcm (c * a) (c * b)"
   by (simp add: lcm_mult_left mult.assoc [symmetric] normalize_mult)
 
 lemma mult_lcm_right: "lcm a b * c = lcm (a * c) (b * c) * unit_factor c"
   using mult_lcm_left [of c a b] by (simp add: ac_simps)
 
 lemma lcm_gcd_prod: "lcm a b * gcd a b = normalize (a * b)"
   by (simp add: lcm_gcd dvd_normalize_div normalize_mult)
 
 lemma lcm_mult_distrib': "normalize c * lcm a b = lcm (c * a) (c * b)"
   by (subst lcm_mult_left) (simp add: normalize_mult)
 
 lemma lcm_mult_distrib: "k * lcm a b = lcm (k * a) (k * b) * unit_factor k"
 proof-
   have "normalize k * lcm a b = lcm (k * a) (k * b)"
     by (simp add: lcm_mult_distrib')
   then have "normalize k * lcm a b * unit_factor k = lcm (k * a) (k * b) * unit_factor k"
     by simp
   then have "normalize k * unit_factor k * lcm a b  = lcm (k * a) (k * b) * unit_factor k"
     by (simp only: ac_simps)
   then show ?thesis
     by simp
 qed
 
 lemma coprime_crossproduct':
   fixes a b c d
   assumes "b \<noteq> 0"
   assumes unit_factors: "unit_factor b = unit_factor d"
   assumes coprime: "coprime a b" "coprime c d"
   shows "a * d = b * c \<longleftrightarrow> a = c \<and> b = d"
 proof safe
   assume eq: "a * d = b * c"
   hence "normalize a * normalize d = normalize c * normalize b"
     by (simp only: normalize_mult [symmetric] mult_ac)
   with coprime have "normalize b = normalize d"
     by (subst (asm) coprime_crossproduct) simp_all
   from this and unit_factors show "b = d"
     by (rule normalize_unit_factor_eqI)
   from eq have "a * d = c * d" by (simp only: \<open>b = d\<close> mult_ac)
   with \<open>b \<noteq> 0\<close> \<open>b = d\<close> show "a = c" by simp
 qed (simp_all add: mult_ac)
 
 lemma gcd_exp [simp]:
   "gcd (a ^ n) (b ^ n) = gcd a b ^ n"
   using gcd_exp_weak[of a n b] by (simp add: normalize_power)
 
 end
 
 
 subsection \<open>GCD and LCM on \<^typ>\<open>nat\<close> and \<^typ>\<open>int\<close>\<close>
 
 instantiation nat :: gcd
 begin
 
 fun gcd_nat  :: "nat \<Rightarrow> nat \<Rightarrow> nat"
   where "gcd_nat x y = (if y = 0 then x else gcd y (x mod y))"
 
 definition lcm_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat"
   where "lcm_nat x y = x * y div (gcd x y)"
 
 instance ..
 
 end
 
 instantiation int :: gcd
 begin
 
 definition gcd_int  :: "int \<Rightarrow> int \<Rightarrow> int"
   where "gcd_int x y = int (gcd (nat \<bar>x\<bar>) (nat \<bar>y\<bar>))"
 
 definition lcm_int :: "int \<Rightarrow> int \<Rightarrow> int"
   where "lcm_int x y = int (lcm (nat \<bar>x\<bar>) (nat \<bar>y\<bar>))"
 
 instance ..
 
 end
 
 lemma gcd_int_int_eq [simp]:
   "gcd (int m) (int n) = int (gcd m n)"
   by (simp add: gcd_int_def)
 
 lemma gcd_nat_abs_left_eq [simp]:
   "gcd (nat \<bar>k\<bar>) n = nat (gcd k (int n))"
   by (simp add: gcd_int_def)
 
 lemma gcd_nat_abs_right_eq [simp]:
   "gcd n (nat \<bar>k\<bar>) = nat (gcd (int n) k)"
   by (simp add: gcd_int_def)
 
 lemma abs_gcd_int [simp]:
   "\<bar>gcd x y\<bar> = gcd x y"
   for x y :: int
   by (simp only: gcd_int_def)
 
 lemma gcd_abs1_int [simp]:
   "gcd \<bar>x\<bar> y = gcd x y"
   for x y :: int
   by (simp only: gcd_int_def) simp
 
 lemma gcd_abs2_int [simp]:
   "gcd x \<bar>y\<bar> = gcd x y"
   for x y :: int
   by (simp only: gcd_int_def) simp
 
 lemma lcm_int_int_eq [simp]:
   "lcm (int m) (int n) = int (lcm m n)"
   by (simp add: lcm_int_def)
 
 lemma lcm_nat_abs_left_eq [simp]:
   "lcm (nat \<bar>k\<bar>) n = nat (lcm k (int n))"
   by (simp add: lcm_int_def)
 
 lemma lcm_nat_abs_right_eq [simp]:
   "lcm n (nat \<bar>k\<bar>) = nat (lcm (int n) k)"
   by (simp add: lcm_int_def)
 
 lemma lcm_abs1_int [simp]:
   "lcm \<bar>x\<bar> y = lcm x y"
   for x y :: int
   by (simp only: lcm_int_def) simp
 
 lemma lcm_abs2_int [simp]:
   "lcm x \<bar>y\<bar> = lcm x y"
   for x y :: int
   by (simp only: lcm_int_def) simp
 
 lemma abs_lcm_int [simp]: "\<bar>lcm i j\<bar> = lcm i j"
   for i j :: int
   by (simp only: lcm_int_def)
 
 lemma gcd_nat_induct [case_names base step]:
   fixes m n :: nat
   assumes "\<And>m. P m 0"
     and "\<And>m n. 0 < n \<Longrightarrow> P n (m mod n) \<Longrightarrow> P m n"
   shows "P m n"
 proof (induction m n rule: gcd_nat.induct)
   case (1 x y)
   then show ?case
     using assms neq0_conv by blast
 qed
 
 lemma gcd_neg1_int [simp]: "gcd (- x) y = gcd x y"
   for x y :: int
   by (simp only: gcd_int_def) simp
 
 lemma gcd_neg2_int [simp]: "gcd x (- y) = gcd x y"
   for x y :: int
   by (simp only: gcd_int_def) simp
 
 lemma gcd_cases_int:
   fixes x y :: int
   assumes "x \<ge> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> P (gcd x y)"
     and "x \<ge> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> P (gcd x (- y))"
     and "x \<le> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> P (gcd (- x) y)"
     and "x \<le> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> P (gcd (- x) (- y))"
   shows "P (gcd x y)"
   using assms by auto arith
 
 lemma gcd_ge_0_int [simp]: "gcd (x::int) y >= 0"
   for x y :: int
   by (simp add: gcd_int_def)
 
 lemma lcm_neg1_int: "lcm (- x) y = lcm x y"
   for x y :: int
   by (simp only: lcm_int_def) simp
 
 lemma lcm_neg2_int: "lcm x (- y) = lcm x y"
   for x y :: int
   by (simp only: lcm_int_def) simp
 
 lemma lcm_cases_int:
   fixes x y :: int
   assumes "x \<ge> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> P (lcm x y)"
     and "x \<ge> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> P (lcm x (- y))"
     and "x \<le> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> P (lcm (- x) y)"
     and "x \<le> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> P (lcm (- x) (- y))"
   shows "P (lcm x y)"
   using assms by (auto simp: lcm_neg1_int lcm_neg2_int) arith
 
 lemma lcm_ge_0_int [simp]: "lcm x y \<ge> 0"
   for x y :: int
   by (simp only: lcm_int_def)
 
 lemma gcd_0_nat: "gcd x 0 = x"
   for x :: nat
   by simp
 
 lemma gcd_0_int [simp]: "gcd x 0 = \<bar>x\<bar>"
   for x :: int
   by (auto simp: gcd_int_def)
 
 lemma gcd_0_left_nat: "gcd 0 x = x"
   for x :: nat
   by simp
 
 lemma gcd_0_left_int [simp]: "gcd 0 x = \<bar>x\<bar>"
   for x :: int
   by (auto simp: gcd_int_def)
 
 lemma gcd_red_nat: "gcd x y = gcd y (x mod y)"
   for x y :: nat
   by (cases "y = 0") auto
 
 
 text \<open>Weaker, but useful for the simplifier.\<close>
 
 lemma gcd_non_0_nat: "y \<noteq> 0 \<Longrightarrow> gcd x y = gcd y (x mod y)"
   for x y :: nat
   by simp
 
 lemma gcd_1_nat [simp]: "gcd m 1 = 1"
   for m :: nat
   by simp
 
 lemma gcd_Suc_0 [simp]: "gcd m (Suc 0) = Suc 0"
   for m :: nat
   by simp
 
 lemma gcd_1_int [simp]: "gcd m 1 = 1"
   for m :: int
   by (simp add: gcd_int_def)
 
 lemma gcd_idem_nat: "gcd x x = x"
   for x :: nat
   by simp
 
 lemma gcd_idem_int: "gcd x x = \<bar>x\<bar>"
   for x :: int
   by (auto simp: gcd_int_def)
 
 declare gcd_nat.simps [simp del]
 
 text \<open>
   \<^medskip> \<^term>\<open>gcd m n\<close> divides \<open>m\<close> and \<open>n\<close>.
   The conjunctions don't seem provable separately.
 \<close>
 
 instance nat :: semiring_gcd
 proof
   fix m n :: nat
   show "gcd m n dvd m" and "gcd m n dvd n"
   proof (induct m n rule: gcd_nat_induct)
     case (step m n)
     then have "gcd n (m mod n) dvd m"
       by (metis dvd_mod_imp_dvd)
     with step show "gcd m n dvd m"
       by (simp add: gcd_non_0_nat)
   qed (simp_all add: gcd_0_nat gcd_non_0_nat)
 next
   fix m n k :: nat
   assume "k dvd m" and "k dvd n"
   then show "k dvd gcd m n"
     by (induct m n rule: gcd_nat_induct) (simp_all add: gcd_non_0_nat dvd_mod gcd_0_nat)
 qed (simp_all add: lcm_nat_def)
 
 instance int :: ring_gcd
 proof
   fix k l r :: int
   show [simp]: "gcd k l dvd k" "gcd k l dvd l"
     using gcd_dvd1 [of "nat \<bar>k\<bar>" "nat \<bar>l\<bar>"]
       gcd_dvd2 [of "nat \<bar>k\<bar>" "nat \<bar>l\<bar>"]
     by simp_all
   show "lcm k l = normalize (k * l div gcd k l)"
     using lcm_gcd [of "nat \<bar>k\<bar>" "nat \<bar>l\<bar>"]
     by (simp add: nat_eq_iff of_nat_div abs_mult abs_div)
   assume "r dvd k" "r dvd l"
   then show "r dvd gcd k l"
     using gcd_greatest [of "nat \<bar>r\<bar>" "nat \<bar>k\<bar>" "nat \<bar>l\<bar>"]
     by simp
 qed simp
 
 lemma gcd_le1_nat [simp]: "a \<noteq> 0 \<Longrightarrow> gcd a b \<le> a"
   for a b :: nat
   by (rule dvd_imp_le) auto
 
 lemma gcd_le2_nat [simp]: "b \<noteq> 0 \<Longrightarrow> gcd a b \<le> b"
   for a b :: nat
   by (rule dvd_imp_le) auto
 
 lemma gcd_le1_int [simp]: "a > 0 \<Longrightarrow> gcd a b \<le> a"
   for a b :: int
   by (rule zdvd_imp_le) auto
 
 lemma gcd_le2_int [simp]: "b > 0 \<Longrightarrow> gcd a b \<le> b"
   for a b :: int
   by (rule zdvd_imp_le) auto
 
 lemma gcd_pos_nat [simp]: "gcd m n > 0 \<longleftrightarrow> m \<noteq> 0 \<or> n \<noteq> 0"
   for m n :: nat
   using gcd_eq_0_iff [of m n] by arith
 
 lemma gcd_pos_int [simp]: "gcd m n > 0 \<longleftrightarrow> m \<noteq> 0 \<or> n \<noteq> 0"
   for m n :: int
   using gcd_eq_0_iff [of m n] gcd_ge_0_int [of m n] by arith
 
 lemma gcd_unique_nat: "d dvd a \<and> d dvd b \<and> (\<forall>e. e dvd a \<and> e dvd b \<longrightarrow> e dvd d) \<longleftrightarrow> d = gcd a b"
   for d a :: nat
   using gcd_unique by fastforce
 
 lemma gcd_unique_int:
   "d \<ge> 0 \<and> d dvd a \<and> d dvd b \<and> (\<forall>e. e dvd a \<and> e dvd b \<longrightarrow> e dvd d) \<longleftrightarrow> d = gcd a b"
   for d a :: int
   using zdvd_antisym_nonneg by auto
 
 interpretation gcd_nat:
   semilattice_neutr_order gcd "0::nat" Rings.dvd "\<lambda>m n. m dvd n \<and> m \<noteq> n"
   by standard (auto simp: gcd_unique_nat [symmetric] intro: dvd_antisym dvd_trans)
 
 lemma gcd_proj1_if_dvd_int [simp]: "x dvd y \<Longrightarrow> gcd x y = \<bar>x\<bar>"
   for x y :: int
   by (metis abs_dvd_iff gcd_0_left_int gcd_unique_int)
 
 lemma gcd_proj2_if_dvd_int [simp]: "y dvd x \<Longrightarrow> gcd x y = \<bar>y\<bar>"
   for x y :: int
   by (metis gcd_proj1_if_dvd_int gcd.commute)
 
 
 text \<open>\<^medskip> Multiplication laws.\<close>
 
 lemma gcd_mult_distrib_nat: "k * gcd m n = gcd (k * m) (k * n)"
   for k m n :: nat
   \<comment> \<open>@{cite \<open>page 27\<close> davenport92}\<close>
   by (simp add: gcd_mult_left)
 
 lemma gcd_mult_distrib_int: "\<bar>k\<bar> * gcd m n = gcd (k * m) (k * n)"
   for k m n :: int
   by (simp add: gcd_mult_left abs_mult)
 
 text \<open>\medskip Addition laws.\<close>
 
 (* TODO: add the other variations? *)
 
 lemma gcd_diff1_nat: "m \<ge> n \<Longrightarrow> gcd (m - n) n = gcd m n"
   for m n :: nat
   by (subst gcd_add1 [symmetric]) auto
 
 lemma gcd_diff2_nat: "n \<ge> m \<Longrightarrow> gcd (n - m) n = gcd m n"
   for m n :: nat
   by (metis gcd.commute gcd_add2 gcd_diff1_nat le_add_diff_inverse2)
 
 lemma gcd_non_0_int: 
   fixes x y :: int
   assumes "y > 0" shows "gcd x y = gcd y (x mod y)"
 proof (cases "x mod y = 0")
   case False
   then have neg: "x mod y = y - (- x) mod y"
     by (simp add: zmod_zminus1_eq_if)
   have xy: "0 \<le> x mod y" 
     by (simp add: assms)
   show ?thesis
   proof (cases "x < 0")
     case True
     have "nat (- x mod y) \<le> nat y"
       by (simp add: assms dual_order.order_iff_strict)
     moreover have "gcd (nat (- x)) (nat y) = gcd (nat (- x mod y)) (nat y)"
       using True assms gcd_non_0_nat nat_mod_distrib by auto
     ultimately have "gcd (nat (- x)) (nat y) = gcd (nat y) (nat (x mod y))"
       using assms 
       by (simp add: neg nat_diff_distrib') (metis gcd.commute gcd_diff2_nat)
     with assms \<open>0 \<le> x mod y\<close> show ?thesis
       by (simp add: True dual_order.order_iff_strict gcd_int_def)
   next
     case False
     with assms xy have "gcd (nat x) (nat y) = gcd (nat y) (nat x mod nat y)"
       using gcd_red_nat by blast
     with False assms show ?thesis
       by (simp add: gcd_int_def nat_mod_distrib)
   qed
 qed (use assms in auto)
 
 lemma gcd_red_int: "gcd x y = gcd y (x mod y)"
   for x y :: int
 proof (cases y "0::int" rule: linorder_cases)
   case less
   with gcd_non_0_int [of "- y" "- x"] show ?thesis
     by auto
 next
   case greater
   with gcd_non_0_int [of y x] show ?thesis
     by auto
 qed auto
 
 (* TODO: differences, and all variations of addition rules
     as simplification rules for nat and int *)
 
 (* TODO: add the three variations of these, and for ints? *)
 
 lemma finite_divisors_nat [simp]: (* FIXME move *)
   fixes m :: nat
   assumes "m > 0"
   shows "finite {d. d dvd m}"
 proof-
   from assms have "{d. d dvd m} \<subseteq> {d. d \<le> m}"
     by (auto dest: dvd_imp_le)
   then show ?thesis
     using finite_Collect_le_nat by (rule finite_subset)
 qed
 
 lemma finite_divisors_int [simp]:
   fixes i :: int
   assumes "i \<noteq> 0"
   shows "finite {d. d dvd i}"
 proof -
   have "{d. \<bar>d\<bar> \<le> \<bar>i\<bar>} = {- \<bar>i\<bar>..\<bar>i\<bar>}"
     by (auto simp: abs_if)
   then have "finite {d. \<bar>d\<bar> \<le> \<bar>i\<bar>}"
     by simp
   from finite_subset [OF _ this] show ?thesis
     using assms by (simp add: dvd_imp_le_int subset_iff)
 qed
 
 lemma Max_divisors_self_nat [simp]: "n \<noteq> 0 \<Longrightarrow> Max {d::nat. d dvd n} = n"
   by (fastforce intro: antisym Max_le_iff[THEN iffD2] simp: dvd_imp_le)
 
 lemma Max_divisors_self_int [simp]: 
   assumes "n \<noteq> 0" shows "Max {d::int. d dvd n} = \<bar>n\<bar>"
 proof (rule antisym)
   show "Max {d. d dvd n} \<le> \<bar>n\<bar>"
     using assms by (auto intro: abs_le_D1 dvd_imp_le_int intro!: Max_le_iff [THEN iffD2])
 qed (simp add: assms)
 
 lemma gcd_is_Max_divisors_nat:
   fixes m n :: nat
   assumes "n > 0" shows "gcd m n = Max {d. d dvd m \<and> d dvd n}"
 proof (rule Max_eqI[THEN sym], simp_all)
   show "finite {d. d dvd m \<and> d dvd n}"
     by (simp add: \<open>n > 0\<close>)
   show "\<And>y. y dvd m \<and> y dvd n \<Longrightarrow> y \<le> gcd m n"
     by (simp add: \<open>n > 0\<close> dvd_imp_le)
 qed
 
 lemma gcd_is_Max_divisors_int:
   fixes m n :: int
   assumes "n \<noteq> 0" shows "gcd m n = Max {d. d dvd m \<and> d dvd n}"
 proof (rule Max_eqI[THEN sym], simp_all)
   show "finite {d. d dvd m \<and> d dvd n}"
     by (simp add: \<open>n \<noteq> 0\<close>)
   show "\<And>y. y dvd m \<and> y dvd n \<Longrightarrow> y \<le> gcd m n"
     by (simp add: \<open>n \<noteq> 0\<close> zdvd_imp_le)
 qed
 
 lemma gcd_code_int [code]: "gcd k l = \<bar>if l = 0 then k else gcd l (\<bar>k\<bar> mod \<bar>l\<bar>)\<bar>"
   for k l :: int
   using gcd_red_int [of "\<bar>k\<bar>" "\<bar>l\<bar>"] by simp
 
 lemma coprime_Suc_left_nat [simp]:
   "coprime (Suc n) n"
   using coprime_add_one_left [of n] by simp
 
 lemma coprime_Suc_right_nat [simp]:
   "coprime n (Suc n)"
   using coprime_Suc_left_nat [of n] by (simp add: ac_simps)
 
 lemma coprime_diff_one_left_nat [simp]:
   "coprime (n - 1) n" if "n > 0" for n :: nat
   using that coprime_Suc_right_nat [of "n - 1"] by simp
 
 lemma coprime_diff_one_right_nat [simp]:
   "coprime n (n - 1)" if "n > 0" for n :: nat
   using that coprime_diff_one_left_nat [of n] by (simp add: ac_simps)
 
 lemma coprime_crossproduct_nat:
   fixes a b c d :: nat
   assumes "coprime a d" and "coprime b c"
   shows "a * c = b * d \<longleftrightarrow> a = b \<and> c = d"
   using assms coprime_crossproduct [of a d b c] by simp
 
 lemma coprime_crossproduct_int:
   fixes a b c d :: int
   assumes "coprime a d" and "coprime b c"
   shows "\<bar>a\<bar> * \<bar>c\<bar> = \<bar>b\<bar> * \<bar>d\<bar> \<longleftrightarrow> \<bar>a\<bar> = \<bar>b\<bar> \<and> \<bar>c\<bar> = \<bar>d\<bar>"
   using assms coprime_crossproduct [of a d b c] by simp
 
 
 subsection \<open>Bezout's theorem\<close>
 
 text \<open>
   Function \<open>bezw\<close> returns a pair of witnesses to Bezout's theorem --
   see the theorems that follow the definition.
 \<close>
 
 fun bezw :: "nat \<Rightarrow> nat \<Rightarrow> int * int"
   where "bezw x y =
     (if y = 0 then (1, 0)
      else
       (snd (bezw y (x mod y)),
        fst (bezw y (x mod y)) - snd (bezw y (x mod y)) * int(x div y)))"
 
 lemma bezw_0 [simp]: "bezw x 0 = (1, 0)"
   by simp
 
 lemma bezw_non_0:
   "y > 0 \<Longrightarrow> bezw x y =
     (snd (bezw y (x mod y)), fst (bezw y (x mod y)) - snd (bezw y (x mod y)) * int(x div y))"
   by simp
 
 declare bezw.simps [simp del]
 
 
 lemma bezw_aux: "int (gcd x y) = fst (bezw x y) * int x + snd (bezw x y) * int y"
 proof (induct x y rule: gcd_nat_induct)
   case (step m n)
   then have "fst (bezw m n) * int m + snd (bezw m n) * int n - int (gcd m n) 
              = int m * snd (bezw n (m mod n)) -
                (int (m mod n) * snd (bezw n (m mod n)) + int n * (int (m div n) * snd (bezw n (m mod n))))"
     by (simp add: bezw_non_0 gcd_non_0_nat field_simps)
   also have "\<dots> = int m * snd (bezw n (m mod n)) - (int (m mod n) + int (n * (m div n))) * snd (bezw n (m mod n))"
     by (simp add: distrib_right)
   also have "\<dots> = 0"
     by (metis cancel_comm_monoid_add_class.diff_cancel mod_mult_div_eq of_nat_add)
   finally show ?case
     by simp
 qed auto
 
 
 lemma bezout_int: "\<exists>u v. u * x + v * y = gcd x y"
   for x y :: int
 proof -
   have aux: "x \<ge> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> \<exists>u v. u * x + v * y = gcd x y" for x y :: int
     apply (rule_tac x = "fst (bezw (nat x) (nat y))" in exI)
     apply (rule_tac x = "snd (bezw (nat x) (nat y))" in exI)
     by (simp add: bezw_aux gcd_int_def)
   consider "x \<ge> 0" "y \<ge> 0" | "x \<ge> 0" "y \<le> 0" | "x \<le> 0" "y \<ge> 0" | "x \<le> 0" "y \<le> 0"
     using linear by blast
   then show ?thesis
   proof cases
     case 1
     then show ?thesis by (rule aux)
   next
     case 2
     then show ?thesis
       using aux [of x "-y"]
       by (metis gcd_neg2_int mult.commute mult_minus_right neg_0_le_iff_le)
   next
     case 3
     then show ?thesis
       using aux [of "-x" y]
       by (metis gcd.commute gcd_neg2_int mult.commute mult_minus_right neg_0_le_iff_le)
   next
     case 4
     then show ?thesis
       using aux [of "-x" "-y"]
       by (metis diff_0 diff_ge_0_iff_ge gcd_neg1_int gcd_neg2_int mult.commute mult_minus_right)
   qed
 qed
 
 
 text \<open>Versions of Bezout for \<open>nat\<close>, by Amine Chaieb.\<close>
 
 lemma Euclid_induct [case_names swap zero add]:
   fixes P :: "nat \<Rightarrow> nat \<Rightarrow> bool"
   assumes c: "\<And>a b. P a b \<longleftrightarrow> P b a"
     and z: "\<And>a. P a 0"
     and add: "\<And>a b. P a b \<longrightarrow> P a (a + b)"
   shows "P a b"
 proof (induct "a + b" arbitrary: a b rule: less_induct)
   case less
   consider (eq) "a = b" | (lt) "a < b" "a + b - a < a + b" | "b = 0" | "b + a - b < a + b"
     by arith
   show ?case
   proof (cases a b rule: linorder_cases)
     case equal
     with add [rule_format, OF z [rule_format, of a]] show ?thesis by simp
   next
     case lt: less
     then consider "a = 0" | "a + b - a < a + b" by arith
     then show ?thesis
     proof cases
       case 1
       with z c show ?thesis by blast
     next
       case 2
       also have *: "a + b - a = a + (b - a)" using lt by arith
       finally have "a + (b - a) < a + b" .
       then have "P a (a + (b - a))" by (rule add [rule_format, OF less])
       then show ?thesis by (simp add: *[symmetric])
     qed
   next
     case gt: greater
     then consider "b = 0" | "b + a - b < a + b" by arith
     then show ?thesis
     proof cases
       case 1
       with z c show ?thesis by blast
     next
       case 2
       also have *: "b + a - b = b + (a - b)" using gt by arith
       finally have "b + (a - b) < a + b" .
       then have "P b (b + (a - b))" by (rule add [rule_format, OF less])
       then have "P b a" by (simp add: *[symmetric])
       with c show ?thesis by blast
     qed
   qed
 qed
 
 lemma bezout_lemma_nat:
   fixes d::nat
   shows "\<lbrakk>d dvd a; d dvd b; a * x = b * y + d \<or> b * x = a * y + d\<rbrakk>
     \<Longrightarrow> \<exists>x y. d dvd a \<and> d dvd a + b \<and> (a * x = (a + b) * y + d \<or> (a + b) * x = a * y + d)"
   apply auto
   apply (metis add_mult_distrib2 left_add_mult_distrib)
   apply (rule_tac x=x in exI)
   by (metis add_mult_distrib2 mult.commute add.assoc)
 
 lemma bezout_add_nat: 
   "\<exists>(d::nat) x y. d dvd a \<and> d dvd b \<and> (a * x = b * y + d \<or> b * x = a * y + d)"
 proof (induct a b rule: Euclid_induct)
   case (swap a b)
   then show ?case
     by blast
 next
   case (zero a)
   then show ?case
     by fastforce    
 next
   case (add a b)
   then show ?case
     by (meson bezout_lemma_nat)
 qed
 
 lemma bezout1_nat: "\<exists>(d::nat) x y. d dvd a \<and> d dvd b \<and> (a * x - b * y = d \<or> b * x - a * y = d)"
   using bezout_add_nat[of a b]  by (metis add_diff_cancel_left')
 
 lemma bezout_add_strong_nat:
   fixes a b :: nat
   assumes a: "a \<noteq> 0"
   shows "\<exists>d x y. d dvd a \<and> d dvd b \<and> a * x = b * y + d"
 proof -
   consider d x y where "d dvd a" "d dvd b" "a * x = b * y + d"
          | d x y where "d dvd a" "d dvd b" "b * x = a * y + d"
     using bezout_add_nat [of a b] by blast
   then show ?thesis
   proof cases
     case 1
     then show ?thesis by blast
   next
     case H: 2
     show ?thesis
     proof (cases "b = 0")
       case True
       with H show ?thesis by simp
     next
       case False
       then have bp: "b > 0" by simp
       with dvd_imp_le [OF H(2)] consider "d = b" | "d < b"
         by atomize_elim auto
       then show ?thesis
       proof cases
         case 1
         with a H show ?thesis
           by (metis Suc_pred add.commute mult.commute mult_Suc_right neq0_conv)
       next
         case 2
         show ?thesis
         proof (cases "x = 0")
           case True
           with a H show ?thesis by simp
         next
           case x0: False
           then have xp: "x > 0" by simp
           from \<open>d < b\<close> have "d \<le> b - 1" by simp
           then have "d * b \<le> b * (b - 1)" by simp
           with xp mult_mono[of "1" "x" "d * b" "b * (b - 1)"]
           have dble: "d * b \<le> x * b * (b - 1)" using bp by simp
           from H(3) have "d + (b - 1) * (b * x) = d + (b - 1) * (a * y + d)"
             by simp
           then have "d + (b - 1) * a * y + (b - 1) * d = d + (b - 1) * b * x"
             by (simp only: mult.assoc distrib_left)
           then have "a * ((b - 1) * y) + d * (b - 1 + 1) = d + x * b * (b - 1)"
             by algebra
           then have "a * ((b - 1) * y) = d + x * b * (b - 1) - d * b"
             using bp by simp
           then have "a * ((b - 1) * y) = d + (x * b * (b - 1) - d * b)"
             by (simp only: diff_add_assoc[OF dble, of d, symmetric])
           then have "a * ((b - 1) * y) = b * (x * (b - 1) - d) + d"
             by (simp only: diff_mult_distrib2 ac_simps)
           with H(1,2) show ?thesis
             by blast
         qed
       qed
     qed
   qed
 qed
 
 lemma bezout_nat:
   fixes a :: nat
   assumes a: "a \<noteq> 0"
   shows "\<exists>x y. a * x = b * y + gcd a b"
 proof -
   obtain d x y where d: "d dvd a" "d dvd b" and eq: "a * x = b * y + d"
     using bezout_add_strong_nat [OF a, of b] by blast
   from d have "d dvd gcd a b"
     by simp
   then obtain k where k: "gcd a b = d * k"
     unfolding dvd_def by blast
   from eq have "a * x * k = (b * y + d) * k"
     by auto
   then have "a * (x * k) = b * (y * k) + gcd a b"
     by (algebra add: k)
   then show ?thesis
     by blast
 qed
 
 
 subsection \<open>LCM properties on \<^typ>\<open>nat\<close> and \<^typ>\<open>int\<close>\<close>
 
 lemma lcm_altdef_int [code]: "lcm a b = \<bar>a\<bar> * \<bar>b\<bar> div gcd a b"
   for a b :: int
   by (simp add: abs_mult lcm_gcd abs_div)
   
 lemma prod_gcd_lcm_nat: "m * n = gcd m n * lcm m n"
   for m n :: nat
   by (simp add: lcm_gcd)
 
 lemma prod_gcd_lcm_int: "\<bar>m\<bar> * \<bar>n\<bar> = gcd m n * lcm m n"
   for m n :: int
   by (simp add: lcm_gcd abs_div abs_mult)
 
 lemma lcm_pos_nat: "m > 0 \<Longrightarrow> n > 0 \<Longrightarrow> lcm m n > 0"
   for m n :: nat
   using lcm_eq_0_iff [of m n] by auto
 
 lemma lcm_pos_int: "m \<noteq> 0 \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> lcm m n > 0"
   for m n :: int
   by (simp add: less_le lcm_eq_0_iff)
 
 lemma dvd_pos_nat: "n > 0 \<Longrightarrow> m dvd n \<Longrightarrow> m > 0"  (* FIXME move *)
   for m n :: nat
   by auto
 
 lemma lcm_unique_nat:
   "a dvd d \<and> b dvd d \<and> (\<forall>e. a dvd e \<and> b dvd e \<longrightarrow> d dvd e) \<longleftrightarrow> d = lcm a b"
   for a b d :: nat
   by (auto intro: dvd_antisym lcm_least)
 
 lemma lcm_unique_int:
   "d \<ge> 0 \<and> a dvd d \<and> b dvd d \<and> (\<forall>e. a dvd e \<and> b dvd e \<longrightarrow> d dvd e) \<longleftrightarrow> d = lcm a b"
   for a b d :: int
   using lcm_least zdvd_antisym_nonneg by auto
 
 lemma lcm_proj2_if_dvd_nat [simp]: "x dvd y \<Longrightarrow> lcm x y = y"
   for x y :: nat
   by (simp add: lcm_proj2_if_dvd)
 
 lemma lcm_proj2_if_dvd_int [simp]: "x dvd y \<Longrightarrow> lcm x y = \<bar>y\<bar>"
   for x y :: int
   by (simp add: lcm_proj2_if_dvd)
 
 lemma lcm_proj1_if_dvd_nat [simp]: "x dvd y \<Longrightarrow> lcm y x = y"
   for x y :: nat
   by (subst lcm.commute) (erule lcm_proj2_if_dvd_nat)
 
 lemma lcm_proj1_if_dvd_int [simp]: "x dvd y \<Longrightarrow> lcm y x = \<bar>y\<bar>"
   for x y :: int
   by (subst lcm.commute) (erule lcm_proj2_if_dvd_int)
 
 lemma lcm_proj1_iff_nat [simp]: "lcm m n = m \<longleftrightarrow> n dvd m"
   for m n :: nat
   by (metis lcm_proj1_if_dvd_nat lcm_unique_nat)
 
 lemma lcm_proj2_iff_nat [simp]: "lcm m n = n \<longleftrightarrow> m dvd n"
   for m n :: nat
   by (metis lcm_proj2_if_dvd_nat lcm_unique_nat)
 
 lemma lcm_proj1_iff_int [simp]: "lcm m n = \<bar>m\<bar> \<longleftrightarrow> n dvd m"
   for m n :: int
   by (metis dvd_abs_iff lcm_proj1_if_dvd_int lcm_unique_int)
 
 lemma lcm_proj2_iff_int [simp]: "lcm m n = \<bar>n\<bar> \<longleftrightarrow> m dvd n"
   for m n :: int
   by (metis dvd_abs_iff lcm_proj2_if_dvd_int lcm_unique_int)
 
 lemma lcm_1_iff_nat [simp]: "lcm m n = Suc 0 \<longleftrightarrow> m = Suc 0 \<and> n = Suc 0"
   for m n :: nat
   using lcm_eq_1_iff [of m n] by simp
 
 lemma lcm_1_iff_int [simp]: "lcm m n = 1 \<longleftrightarrow> (m = 1 \<or> m = -1) \<and> (n = 1 \<or> n = -1)"
   for m n :: int
   by auto
 
 
 subsection \<open>The complete divisibility lattice on \<^typ>\<open>nat\<close> and \<^typ>\<open>int\<close>\<close>
 
 text \<open>
   Lifting \<open>gcd\<close> and \<open>lcm\<close> to sets (\<open>Gcd\<close> / \<open>Lcm\<close>).
   \<open>Gcd\<close> is defined via \<open>Lcm\<close> to facilitate the proof that we have a complete lattice.
 \<close>
 
 instantiation nat :: semiring_Gcd
 begin
 
 interpretation semilattice_neutr_set lcm "1::nat"
   by standard simp_all
 
 definition "Lcm M = (if finite M then F M else 0)" for M :: "nat set"
 
 lemma Lcm_nat_empty: "Lcm {} = (1::nat)"
   by (simp add: Lcm_nat_def del: One_nat_def)
 
 lemma Lcm_nat_insert: "Lcm (insert n M) = lcm n (Lcm M)" for n :: nat
   by (cases "finite M") (auto simp: Lcm_nat_def simp del: One_nat_def)
 
 lemma Lcm_nat_infinite: "infinite M \<Longrightarrow> Lcm M = 0" for M :: "nat set"
   by (simp add: Lcm_nat_def)
 
 lemma dvd_Lcm_nat [simp]:
   fixes M :: "nat set"
   assumes "m \<in> M"
   shows "m dvd Lcm M"
 proof -
   from assms have "insert m M = M"
     by auto
   moreover have "m dvd Lcm (insert m M)"
     by (simp add: Lcm_nat_insert)
   ultimately show ?thesis
     by simp
 qed
 
 lemma Lcm_dvd_nat [simp]:
   fixes M :: "nat set"
   assumes "\<forall>m\<in>M. m dvd n"
   shows "Lcm M dvd n"
 proof (cases "n > 0")
   case False
   then show ?thesis by simp
 next
   case True
   then have "finite {d. d dvd n}"
     by (rule finite_divisors_nat)
   moreover have "M \<subseteq> {d. d dvd n}"
     using assms by fast
   ultimately have "finite M"
     by (rule rev_finite_subset)
   then show ?thesis
     using assms by (induct M) (simp_all add: Lcm_nat_empty Lcm_nat_insert)
 qed
 
 definition "Gcd M = Lcm {d. \<forall>m\<in>M. d dvd m}" for M :: "nat set"
 
 instance
 proof
   fix N :: "nat set"
   fix n :: nat
   show "Gcd N dvd n" if "n \<in> N"
     using that by (induct N rule: infinite_finite_induct) (auto simp: Gcd_nat_def)
   show "n dvd Gcd N" if "\<And>m. m \<in> N \<Longrightarrow> n dvd m"
     using that by (induct N rule: infinite_finite_induct) (auto simp: Gcd_nat_def)
   show "n dvd Lcm N" if "n \<in> N"
     using that by (induct N rule: infinite_finite_induct) auto
   show "Lcm N dvd n" if "\<And>m. m \<in> N \<Longrightarrow> m dvd n"
     using that by (induct N rule: infinite_finite_induct) auto
   show "normalize (Gcd N) = Gcd N" and "normalize (Lcm N) = Lcm N"
     by simp_all
 qed
 
 end
 
 lemma Gcd_nat_eq_one: "1 \<in> N \<Longrightarrow> Gcd N = 1"
   for N :: "nat set"
   by (rule Gcd_eq_1_I) auto
 
 instance nat :: semiring_gcd_mult_normalize
   by intro_classes (auto simp: unit_factor_nat_def)
 
 
 text \<open>Alternative characterizations of Gcd:\<close>
 
 lemma Gcd_eq_Max:
   fixes M :: "nat set"
   assumes "finite (M::nat set)" and "M \<noteq> {}" and "0 \<notin> M"
   shows "Gcd M = Max (\<Inter>m\<in>M. {d. d dvd m})"
 proof (rule antisym)
   from assms obtain m where "m \<in> M" and "m > 0"
     by auto
   from \<open>m > 0\<close> have "finite {d. d dvd m}"
     by (blast intro: finite_divisors_nat)
   with \<open>m \<in> M\<close> have fin: "finite (\<Inter>m\<in>M. {d. d dvd m})"
     by blast
   from fin show "Gcd M \<le> Max (\<Inter>m\<in>M. {d. d dvd m})"
     by (auto intro: Max_ge Gcd_dvd)
   from fin show "Max (\<Inter>m\<in>M. {d. d dvd m}) \<le> Gcd M"
   proof (rule Max.boundedI, simp_all)
     show "(\<Inter>m\<in>M. {d. d dvd m}) \<noteq> {}"
       by auto
     show "\<And>a. \<forall>x\<in>M. a dvd x \<Longrightarrow> a \<le> Gcd M"
       by (meson Gcd_dvd Gcd_greatest \<open>0 < m\<close> \<open>m \<in> M\<close> dvd_imp_le dvd_pos_nat)
   qed
 qed
 
 lemma Gcd_remove0_nat: "finite M \<Longrightarrow> Gcd M = Gcd (M - {0})"
   for M :: "nat set"
 proof (induct pred: finite)
   case (insert x M)
   then show ?case
     by (simp add: insert_Diff_if)
 qed auto
 
 lemma Lcm_in_lcm_closed_set_nat:
   fixes M :: "nat set" 
   assumes "finite M" "M \<noteq> {}" "\<And>m n. \<lbrakk>m \<in> M; n \<in> M\<rbrakk> \<Longrightarrow> lcm m n \<in> M"
   shows "Lcm M \<in> M"
   using assms
 proof (induction M rule: finite_linorder_min_induct)
   case (insert x M)
   then have "\<And>m n. m \<in> M \<Longrightarrow> n \<in> M \<Longrightarrow> lcm m n \<in> M"
     by (metis dvd_lcm1 gr0I insert_iff lcm_pos_nat nat_dvd_not_less)
   with insert show ?case
     by simp (metis Lcm_nat_empty One_nat_def dvd_1_left dvd_lcm2)
 qed auto
 
 lemma Lcm_eq_Max_nat:
   fixes M :: "nat set" 
   assumes M: "finite M" "M \<noteq> {}" "0 \<notin> M" and lcm: "\<And>m n. \<lbrakk>m \<in> M; n \<in> M\<rbrakk> \<Longrightarrow> lcm m n \<in> M"
   shows "Lcm M = Max M"
 proof (rule antisym)
   show "Lcm M \<le> Max M"
     by (simp add: Lcm_in_lcm_closed_set_nat \<open>finite M\<close> \<open>M \<noteq> {}\<close> lcm)
   show "Max M \<le> Lcm M"
     by (meson Lcm_0_iff Max_in M dvd_Lcm dvd_imp_le le_0_eq not_le)
 qed
 
 lemma mult_inj_if_coprime_nat:
   "inj_on f A \<Longrightarrow> inj_on g B \<Longrightarrow> (\<And>a b. \<lbrakk>a\<in>A; b\<in>B\<rbrakk> \<Longrightarrow> coprime (f a) (g b)) \<Longrightarrow>
     inj_on (\<lambda>(a, b). f a * g b) (A \<times> B)"
   for f :: "'a \<Rightarrow> nat" and g :: "'b \<Rightarrow> nat"
   by (auto simp: inj_on_def coprime_crossproduct_nat simp del: One_nat_def)
 
 
 subsubsection \<open>Setwise GCD and LCM for integers\<close>
 
 instantiation int :: Gcd
 begin
 
 definition Gcd_int :: "int set \<Rightarrow> int"
   where "Gcd K = int (GCD k\<in>K. (nat \<circ> abs) k)"
 
 definition Lcm_int :: "int set \<Rightarrow> int"
   where "Lcm K = int (LCM k\<in>K. (nat \<circ> abs) k)"
 
 instance ..
 
 end
 
 lemma Gcd_int_eq [simp]:
   "(GCD n\<in>N. int n) = int (Gcd N)"
   by (simp add: Gcd_int_def image_image)
 
 lemma Gcd_nat_abs_eq [simp]:
   "(GCD k\<in>K. nat \<bar>k\<bar>) = nat (Gcd K)"
   by (simp add: Gcd_int_def)
 
 lemma abs_Gcd_eq [simp]:
   "\<bar>Gcd K\<bar> = Gcd K" for K :: "int set"
   by (simp only: Gcd_int_def)
 
 lemma Gcd_int_greater_eq_0 [simp]:
   "Gcd K \<ge> 0"
   for K :: "int set"
   using abs_ge_zero [of "Gcd K"] by simp
 
 lemma Gcd_abs_eq [simp]:
   "(GCD k\<in>K. \<bar>k\<bar>) = Gcd K"
   for K :: "int set"
   by (simp only: Gcd_int_def image_image) simp
 
 lemma Lcm_int_eq [simp]:
   "(LCM n\<in>N. int n) = int (Lcm N)"
   by (simp add: Lcm_int_def image_image)
 
 lemma Lcm_nat_abs_eq [simp]:
   "(LCM k\<in>K. nat \<bar>k\<bar>) = nat (Lcm K)"
   by (simp add: Lcm_int_def)
 
 lemma abs_Lcm_eq [simp]:
   "\<bar>Lcm K\<bar> = Lcm K" for K :: "int set"
   by (simp only: Lcm_int_def)
 
 lemma Lcm_int_greater_eq_0 [simp]:
   "Lcm K \<ge> 0"
   for K :: "int set"
   using abs_ge_zero [of "Lcm K"] by simp
 
 lemma Lcm_abs_eq [simp]:
   "(LCM k\<in>K. \<bar>k\<bar>) = Lcm K"
   for K :: "int set"
   by (simp only: Lcm_int_def image_image) simp
 
 instance int :: semiring_Gcd
 proof
   fix K :: "int set" and k :: int
   show "Gcd K dvd k" and "k dvd Lcm K" if "k \<in> K"
     using that Gcd_dvd [of "nat \<bar>k\<bar>" "(nat \<circ> abs) ` K"]
       dvd_Lcm [of "nat \<bar>k\<bar>" "(nat \<circ> abs) ` K"]
     by (simp_all add: comp_def)
   show "k dvd Gcd K" if "\<And>l. l \<in> K \<Longrightarrow> k dvd l"
   proof -
     have "nat \<bar>k\<bar> dvd (GCD k\<in>K. nat \<bar>k\<bar>)"
       by (rule Gcd_greatest) (use that in auto)
     then show ?thesis by simp
   qed
   show "Lcm K dvd k" if "\<And>l. l \<in> K \<Longrightarrow> l dvd k"
   proof -
     have "(LCM k\<in>K. nat \<bar>k\<bar>) dvd nat \<bar>k\<bar>"
       by (rule Lcm_least) (use that in auto)
     then show ?thesis by simp
   qed
 qed (simp_all add: sgn_mult)
 
 instance int :: semiring_gcd_mult_normalize
   by intro_classes (auto simp: sgn_mult)
 
 
 subsection \<open>GCD and LCM on \<^typ>\<open>integer\<close>\<close>
 
 instantiation integer :: gcd
 begin
 
 context
   includes integer.lifting
 begin
 
 lift_definition gcd_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer" is gcd .
 
 lift_definition lcm_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer" is lcm .
 
 end
 
 instance ..
 
 end
 
 lifting_update integer.lifting
 lifting_forget integer.lifting
 
 context
   includes integer.lifting
 begin
 
 lemma gcd_code_integer [code]: "gcd k l = \<bar>if l = (0::integer) then k else gcd l (\<bar>k\<bar> mod \<bar>l\<bar>)\<bar>"
   by transfer (fact gcd_code_int)
 
 lemma lcm_code_integer [code]: "lcm a b = \<bar>a\<bar> * \<bar>b\<bar> div gcd a b"
   for a b :: integer
   by transfer (fact lcm_altdef_int)
 
 end
 
 code_printing
   constant "gcd :: integer \<Rightarrow> _" \<rightharpoonup>
     (OCaml) "!(fun k l -> if Z.equal k Z.zero then/ Z.abs l else if Z.equal/ l Z.zero then Z.abs k else Z.gcd k l)"
   and (Haskell) "Prelude.gcd"
   and (Scala) "_.gcd'((_)')"
   \<comment> \<open>There is no gcd operation in the SML standard library, so no code setup for SML\<close>
 
 text \<open>Some code equations\<close>
 
 lemmas Gcd_nat_set_eq_fold [code] = Gcd_set_eq_fold [where ?'a = nat]
 lemmas Lcm_nat_set_eq_fold [code] = Lcm_set_eq_fold [where ?'a = nat]
 lemmas Gcd_int_set_eq_fold [code] = Gcd_set_eq_fold [where ?'a = int]
 lemmas Lcm_int_set_eq_fold [code] = Lcm_set_eq_fold [where ?'a = int]
 
 text \<open>Fact aliases.\<close>
 
 lemma lcm_0_iff_nat [simp]: "lcm m n = 0 \<longleftrightarrow> m = 0 \<or> n = 0"
   for m n :: nat
   by (fact lcm_eq_0_iff)
 
 lemma lcm_0_iff_int [simp]: "lcm m n = 0 \<longleftrightarrow> m = 0 \<or> n = 0"
   for m n :: int
   by (fact lcm_eq_0_iff)
 
 lemma dvd_lcm_I1_nat [simp]: "k dvd m \<Longrightarrow> k dvd lcm m n"
   for k m n :: nat
   by (fact dvd_lcmI1)
 
 lemma dvd_lcm_I2_nat [simp]: "k dvd n \<Longrightarrow> k dvd lcm m n"
   for k m n :: nat
   by (fact dvd_lcmI2)
 
 lemma dvd_lcm_I1_int [simp]: "i dvd m \<Longrightarrow> i dvd lcm m n"
   for i m n :: int
   by (fact dvd_lcmI1)
 
 lemma dvd_lcm_I2_int [simp]: "i dvd n \<Longrightarrow> i dvd lcm m n"
   for i m n :: int
   by (fact dvd_lcmI2)
 
 lemmas Gcd_dvd_nat [simp] = Gcd_dvd [where ?'a = nat]
 lemmas Gcd_dvd_int [simp] = Gcd_dvd [where ?'a = int]
 lemmas Gcd_greatest_nat [simp] = Gcd_greatest [where ?'a = nat]
 lemmas Gcd_greatest_int [simp] = Gcd_greatest [where ?'a = int]
 
 lemma dvd_Lcm_int [simp]: "m \<in> M \<Longrightarrow> m dvd Lcm M"
   for M :: "int set"
   by (fact dvd_Lcm)
 
 lemma gcd_neg_numeral_1_int [simp]: "gcd (- numeral n :: int) x = gcd (numeral n) x"
   by (fact gcd_neg1_int)
 
 lemma gcd_neg_numeral_2_int [simp]: "gcd x (- numeral n :: int) = gcd x (numeral n)"
   by (fact gcd_neg2_int)
 
 lemma gcd_proj1_if_dvd_nat [simp]: "x dvd y \<Longrightarrow> gcd x y = x"
   for x y :: nat
   by (fact gcd_nat.absorb1)
 
 lemma gcd_proj2_if_dvd_nat [simp]: "y dvd x \<Longrightarrow> gcd x y = y"
   for x y :: nat
   by (fact gcd_nat.absorb2)
 
+lemma Gcd_in:
+  fixes A :: "nat set"
+  assumes "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> gcd a b \<in> A"
+  assumes "A \<noteq> {}"
+  shows   "Gcd A \<in> A"
+proof (cases "A = {0}")
+  case False
+  with assms obtain x where "x \<in> A" "x > 0"
+    by auto
+  thus "Gcd A \<in> A"
+  proof (induction x rule: less_induct)
+    case (less x)
+    show ?case
+    proof (cases "x = Gcd A")
+      case False
+      have "\<exists>y\<in>A. \<not>x dvd y"
+        using False less.prems by (metis Gcd_dvd Gcd_greatest_nat gcd_nat.asym)
+      then obtain y where y: "y \<in> A" "\<not>x dvd y"
+        by blast
+      have "gcd x y \<in> A"
+        by (rule assms(1)) (use \<open>x \<in> A\<close> y in auto)
+      moreover have "gcd x y < x"
+        using \<open>x > 0\<close> y by (metis gcd_dvd1 gcd_dvd2 nat_dvd_not_less nat_neq_iff)
+      moreover have "gcd x y > 0"
+        using \<open>x > 0\<close> by auto
+      ultimately show ?thesis using less.IH by blast
+    qed (use less in auto)
+  qed
+qed auto
+
+lemma bezout_gcd_nat':
+  fixes a b :: nat
+  shows "\<exists>x y. b * y \<le> a * x \<and> a * x - b * y = gcd a b \<or> a * y \<le> b * x \<and> b * x - a * y = gcd a b"
+  using bezout_nat[of a b]
+  by (metis add_diff_cancel_left' diff_zero gcd.commute gcd_0_nat
+            le_add_same_cancel1 mult.right_neutral zero_le)
+
 lemmas Lcm_eq_0_I_nat [simp] = Lcm_eq_0_I [where ?'a = nat]
 lemmas Lcm_0_iff_nat [simp] = Lcm_0_iff [where ?'a = nat]
 lemmas Lcm_least_int [simp] = Lcm_least [where ?'a = int]
 
+
+subsection \<open>Characteristic of a semiring\<close>
+
+definition (in semiring_1) semiring_char :: "'a itself \<Rightarrow> nat" 
+  where "semiring_char _ = Gcd {n. of_nat n = (0 :: 'a)}"
+
+context semiring_1
+begin
+
+context
+  fixes CHAR :: nat
+  defines "CHAR \<equiv> semiring_char (Pure.type :: 'a itself)"
+begin
+
+lemma of_nat_CHAR [simp]: "of_nat CHAR = (0 :: 'a)"
+proof -
+  have "CHAR \<in> {n. of_nat n = (0::'a)}"
+    unfolding CHAR_def semiring_char_def
+  proof (rule Gcd_in, clarify)
+    fix a b :: nat
+    assume *: "of_nat a = (0 :: 'a)" "of_nat b = (0 :: 'a)"
+    show "of_nat (gcd a b) = (0 :: 'a)"
+    proof (cases "a = 0")
+      case False
+      with bezout_nat obtain x y where "a * x = b * y + gcd a b"
+        by blast
+      hence "of_nat (a * x) = (of_nat (b * y + gcd a b) :: 'a)"
+        by (rule arg_cong)
+      thus "of_nat (gcd a b) = (0 :: 'a)"
+        using * by simp
+    qed (use * in auto)
+  next
+    have "of_nat 0 = (0 :: 'a)"
+      by simp
+    thus "{n. of_nat n = (0 :: 'a)} \<noteq> {}"
+      by blast
+  qed
+  thus ?thesis
+    by simp
+qed
+
+lemma of_nat_eq_0_iff_char_dvd: "of_nat n = (0 :: 'a) \<longleftrightarrow> CHAR dvd n"
+proof
+  assume "of_nat n = (0 :: 'a)"
+  thus "CHAR dvd n"
+    unfolding CHAR_def semiring_char_def by (intro Gcd_dvd) auto
+next
+  assume "CHAR dvd n"
+  then obtain m where "n = CHAR * m"
+    by auto
+  thus "of_nat n = (0 :: 'a)"
+    by simp
+qed
+
+lemma CHAR_eqI:
+  assumes "of_nat c = (0 :: 'a)"
+  assumes "\<And>x. of_nat x = (0 :: 'a) \<Longrightarrow> c dvd x"
+  shows   "CHAR = c"
+  using assms by (intro dvd_antisym) (auto simp: of_nat_eq_0_iff_char_dvd)
+
+lemma CHAR_eq0_iff: "CHAR = 0 \<longleftrightarrow> (\<forall>n>0. of_nat n \<noteq> (0::'a))"
+  by (auto simp: of_nat_eq_0_iff_char_dvd)
+
+lemma CHAR_pos_iff: "CHAR > 0 \<longleftrightarrow> (\<exists>n>0. of_nat n = (0::'a))"
+  using CHAR_eq0_iff neq0_conv by blast
+
+lemma CHAR_eq_posI:
+  assumes "c > 0" "of_nat c = (0 :: 'a)" "\<And>x. x > 0 \<Longrightarrow> x < c \<Longrightarrow> of_nat x \<noteq> (0 :: 'a)"
+  shows   "CHAR = c"
+proof (rule antisym)
+  from assms have "CHAR > 0"
+    by (auto simp: CHAR_pos_iff)
+  from assms(3)[OF this] show "CHAR \<ge> c"
+    by force
+next
+  have "CHAR dvd c"
+    using assms by (auto simp: of_nat_eq_0_iff_char_dvd)
+  thus "CHAR \<le> c"
+    using \<open>c > 0\<close> by (intro dvd_imp_le) auto
+qed
+
 end
+end
+
+lemma (in semiring_char_0) CHAR_eq_0 [simp]: "semiring_char (Pure.type :: 'a itself) = 0"
+  by (simp add: CHAR_eq0_iff)
+
+
+(* nicer notation *)
+
+syntax "_type_char" :: "type => nat" ("(1CHAR/(1'(_')))")
+
+translations "CHAR('t)" => "CONST semiring_char (CONST Pure.type :: 't itself)"
+
+print_translation \<open>
+  let
+    fun char_type_tr' ctxt [Const (\<^const_syntax>\<open>Pure.type\<close>, Type (_, [T]))] =
+      Syntax.const \<^syntax_const>\<open>_type_char\<close> $ Syntax_Phases.term_of_typ ctxt T
+  in [(\<^const_syntax>\<open>semiring_char\<close>, char_type_tr')] end
+\<close>
+
+end
diff --git a/src/HOL/Int.thy b/src/HOL/Int.thy
--- a/src/HOL/Int.thy
+++ b/src/HOL/Int.thy
@@ -1,2246 +1,2252 @@
 (*  Title:      HOL/Int.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Author:     Tobias Nipkow, Florian Haftmann, TU Muenchen
 *)
 
 section \<open>The Integers as Equivalence Classes over Pairs of Natural Numbers\<close>
 
 theory Int
   imports Equiv_Relations Power Quotient Fun_Def
 begin
 
 subsection \<open>Definition of integers as a quotient type\<close>
 
 definition intrel :: "(nat \<times> nat) \<Rightarrow> (nat \<times> nat) \<Rightarrow> bool"
   where "intrel = (\<lambda>(x, y) (u, v). x + v = u + y)"
 
 lemma intrel_iff [simp]: "intrel (x, y) (u, v) \<longleftrightarrow> x + v = u + y"
   by (simp add: intrel_def)
 
 quotient_type int = "nat \<times> nat" / "intrel"
   morphisms Rep_Integ Abs_Integ
 proof (rule equivpI)
   show "reflp intrel" by (auto simp: reflp_def)
   show "symp intrel" by (auto simp: symp_def)
   show "transp intrel" by (auto simp: transp_def)
 qed
 
 lemma eq_Abs_Integ [case_names Abs_Integ, cases type: int]:
   "(\<And>x y. z = Abs_Integ (x, y) \<Longrightarrow> P) \<Longrightarrow> P"
   by (induct z) auto
 
 
 subsection \<open>Integers form a commutative ring\<close>
 
 instantiation int :: comm_ring_1
 begin
 
 lift_definition zero_int :: "int" is "(0, 0)" .
 
 lift_definition one_int :: "int" is "(1, 0)" .
 
 lift_definition plus_int :: "int \<Rightarrow> int \<Rightarrow> int"
   is "\<lambda>(x, y) (u, v). (x + u, y + v)"
   by clarsimp
 
 lift_definition uminus_int :: "int \<Rightarrow> int"
   is "\<lambda>(x, y). (y, x)"
   by clarsimp
 
 lift_definition minus_int :: "int \<Rightarrow> int \<Rightarrow> int"
   is "\<lambda>(x, y) (u, v). (x + v, y + u)"
   by clarsimp
 
 lift_definition times_int :: "int \<Rightarrow> int \<Rightarrow> int"
   is "\<lambda>(x, y) (u, v). (x*u + y*v, x*v + y*u)"
 proof (clarsimp)
   fix s t u v w x y z :: nat
   assume "s + v = u + t" and "w + z = y + x"
   then have "(s + v) * w + (u + t) * x + u * (w + z) + v * (y + x) =
     (u + t) * w + (s + v) * x + u * (y + x) + v * (w + z)"
     by simp
   then show "(s * w + t * x) + (u * z + v * y) = (u * y + v * z) + (s * x + t * w)"
     by (simp add: algebra_simps)
 qed
 
 instance
   by standard (transfer; clarsimp simp: algebra_simps)+
 
 end
 
 abbreviation int :: "nat \<Rightarrow> int"
   where "int \<equiv> of_nat"
 
 lemma int_def: "int n = Abs_Integ (n, 0)"
   by (induct n) (simp add: zero_int.abs_eq, simp add: one_int.abs_eq plus_int.abs_eq)
 
 lemma int_transfer [transfer_rule]:
   includes lifting_syntax
   shows "rel_fun (=) pcr_int (\<lambda>n. (n, 0)) int"
   by (simp add: rel_fun_def int.pcr_cr_eq cr_int_def int_def)
 
 lemma int_diff_cases: obtains (diff) m n where "z = int m - int n"
   by transfer clarsimp
 
 
 subsection \<open>Integers are totally ordered\<close>
 
 instantiation int :: linorder
 begin
 
 lift_definition less_eq_int :: "int \<Rightarrow> int \<Rightarrow> bool"
   is "\<lambda>(x, y) (u, v). x + v \<le> u + y"
   by auto
 
 lift_definition less_int :: "int \<Rightarrow> int \<Rightarrow> bool"
   is "\<lambda>(x, y) (u, v). x + v < u + y"
   by auto
 
 instance
   by standard (transfer, force)+
 
 end
 
 instantiation int :: distrib_lattice
 begin
 
 definition "(inf :: int \<Rightarrow> int \<Rightarrow> int) = min"
 
 definition "(sup :: int \<Rightarrow> int \<Rightarrow> int) = max"
 
 instance
   by standard (auto simp add: inf_int_def sup_int_def max_min_distrib2)
 
 end
 
 subsection \<open>Ordering properties of arithmetic operations\<close>
 
 instance int :: ordered_cancel_ab_semigroup_add
 proof
   fix i j k :: int
   show "i \<le> j \<Longrightarrow> k + i \<le> k + j"
     by transfer clarsimp
 qed
 
 text \<open>Strict Monotonicity of Multiplication.\<close>
 
 text \<open>Strict, in 1st argument; proof is by induction on \<open>k > 0\<close>.\<close>
 lemma zmult_zless_mono2_lemma: "i < j \<Longrightarrow> 0 < k \<Longrightarrow> int k * i < int k * j"
   for i j :: int
 proof (induct k)
   case 0
   then show ?case by simp
 next
   case (Suc k)
   then show ?case
     by (cases "k = 0") (simp_all add: distrib_right add_strict_mono)
 qed
 
 lemma zero_le_imp_eq_int:
   assumes "k \<ge> (0::int)" shows "\<exists>n. k = int n"
 proof -
   have "b \<le> a \<Longrightarrow> \<exists>n::nat. a = n + b" for a b
     by (rule_tac x="a - b" in exI) simp
   with assms show ?thesis
     by transfer auto
 qed
 
 lemma zero_less_imp_eq_int:
   assumes "k > (0::int)" shows "\<exists>n>0. k = int n"
 proof -
   have "b < a \<Longrightarrow> \<exists>n::nat. n>0 \<and> a = n + b" for a b
     by (rule_tac x="a - b" in exI) simp
   with assms show ?thesis
     by transfer auto
 qed
 
 lemma zmult_zless_mono2: "i < j \<Longrightarrow> 0 < k \<Longrightarrow> k * i < k * j"
   for i j k :: int
   by (drule zero_less_imp_eq_int) (auto simp add: zmult_zless_mono2_lemma)
 
 
 text \<open>The integers form an ordered integral domain.\<close>
 
 instantiation int :: linordered_idom
 begin
 
 definition zabs_def: "\<bar>i::int\<bar> = (if i < 0 then - i else i)"
 
 definition zsgn_def: "sgn (i::int) = (if i = 0 then 0 else if 0 < i then 1 else - 1)"
 
 instance
 proof
   fix i j k :: int
   show "i < j \<Longrightarrow> 0 < k \<Longrightarrow> k * i < k * j"
     by (rule zmult_zless_mono2)
   show "\<bar>i\<bar> = (if i < 0 then -i else i)"
     by (simp only: zabs_def)
   show "sgn (i::int) = (if i=0 then 0 else if 0<i then 1 else - 1)"
     by (simp only: zsgn_def)
 qed
 
 end
 
 lemma zless_imp_add1_zle: "w < z \<Longrightarrow> w + 1 \<le> z"
   for w z :: int
   by transfer clarsimp
 
 lemma zless_iff_Suc_zadd: "w < z \<longleftrightarrow> (\<exists>n. z = w + int (Suc n))"
   for w z :: int
 proof -
   have "\<And>a b c d. a + d < c + b \<Longrightarrow> \<exists>n. c + b = Suc (a + n + d)"
     by (rule_tac x="c+b - Suc(a+d)" in exI) arith
   then show ?thesis
     by transfer auto
 qed
 
 lemma zabs_less_one_iff [simp]: "\<bar>z\<bar> < 1 \<longleftrightarrow> z = 0" (is "?lhs \<longleftrightarrow> ?rhs")
   for z :: int
 proof
   assume ?rhs
   then show ?lhs by simp
 next
   assume ?lhs
   with zless_imp_add1_zle [of "\<bar>z\<bar>" 1] have "\<bar>z\<bar> + 1 \<le> 1" by simp
   then have "\<bar>z\<bar> \<le> 0" by simp
   then show ?rhs by simp
 qed
 
 
 subsection \<open>Embedding of the Integers into any \<open>ring_1\<close>: \<open>of_int\<close>\<close>
 
 context ring_1
 begin
 
 lift_definition of_int :: "int \<Rightarrow> 'a"
   is "\<lambda>(i, j). of_nat i - of_nat j"
   by (clarsimp simp add: diff_eq_eq eq_diff_eq diff_add_eq
       of_nat_add [symmetric] simp del: of_nat_add)
 
 lemma of_int_0 [simp]: "of_int 0 = 0"
   by transfer simp
 
 lemma of_int_1 [simp]: "of_int 1 = 1"
   by transfer simp
 
 lemma of_int_add [simp]: "of_int (w + z) = of_int w + of_int z"
   by transfer (clarsimp simp add: algebra_simps)
 
 lemma of_int_minus [simp]: "of_int (- z) = - (of_int z)"
   by (transfer fixing: uminus) clarsimp
 
 lemma of_int_diff [simp]: "of_int (w - z) = of_int w - of_int z"
   using of_int_add [of w "- z"] by simp
 
 lemma of_int_mult [simp]: "of_int (w*z) = of_int w * of_int z"
   by (transfer fixing: times) (clarsimp simp add: algebra_simps)
 
 lemma mult_of_int_commute: "of_int x * y = y * of_int x"
   by (transfer fixing: times) (auto simp: algebra_simps mult_of_nat_commute)
 
 text \<open>Collapse nested embeddings.\<close>
 lemma of_int_of_nat_eq [simp]: "of_int (int n) = of_nat n"
   by (induct n) auto
 
 lemma of_int_numeral [simp, code_post]: "of_int (numeral k) = numeral k"
   by (simp add: of_nat_numeral [symmetric] of_int_of_nat_eq [symmetric])
 
 lemma of_int_neg_numeral [code_post]: "of_int (- numeral k) = - numeral k"
   by simp
 
 lemma of_int_power [simp]: "of_int (z ^ n) = of_int z ^ n"
   by (induct n) simp_all
 
 lemma of_int_of_bool [simp]:
   "of_int (of_bool P) = of_bool P"
   by auto
 
 end
 
 context ring_char_0
 begin
 
 lemma of_int_eq_iff [simp]: "of_int w = of_int z \<longleftrightarrow> w = z"
   by transfer (clarsimp simp add: algebra_simps of_nat_add [symmetric] simp del: of_nat_add)
 
 text \<open>Special cases where either operand is zero.\<close>
 lemma of_int_eq_0_iff [simp]: "of_int z = 0 \<longleftrightarrow> z = 0"
   using of_int_eq_iff [of z 0] by simp
 
 lemma of_int_0_eq_iff [simp]: "0 = of_int z \<longleftrightarrow> z = 0"
   using of_int_eq_iff [of 0 z] by simp
 
 lemma of_int_eq_1_iff [iff]: "of_int z = 1 \<longleftrightarrow> z = 1"
   using of_int_eq_iff [of z 1] by simp
 
 lemma numeral_power_eq_of_int_cancel_iff [simp]:
   "numeral x ^ n = of_int y \<longleftrightarrow> numeral x ^ n = y"
   using of_int_eq_iff[of "numeral x ^ n" y, unfolded of_int_numeral of_int_power] .
 
 lemma of_int_eq_numeral_power_cancel_iff [simp]:
   "of_int y = numeral x ^ n \<longleftrightarrow> y = numeral x ^ n"
   using numeral_power_eq_of_int_cancel_iff [of x n y] by (metis (mono_tags))
 
 lemma neg_numeral_power_eq_of_int_cancel_iff [simp]:
   "(- numeral x) ^ n = of_int y \<longleftrightarrow> (- numeral x) ^ n = y"
   using of_int_eq_iff[of "(- numeral x) ^ n" y]
   by simp
 
 lemma of_int_eq_neg_numeral_power_cancel_iff [simp]:
   "of_int y = (- numeral x) ^ n \<longleftrightarrow> y = (- numeral x) ^ n"
   using neg_numeral_power_eq_of_int_cancel_iff[of x n y] by (metis (mono_tags))
 
 lemma of_int_eq_of_int_power_cancel_iff[simp]: "(of_int b) ^ w = of_int x \<longleftrightarrow> b ^ w = x"
   by (metis of_int_power of_int_eq_iff)
 
 lemma of_int_power_eq_of_int_cancel_iff[simp]: "of_int x = (of_int b) ^ w \<longleftrightarrow> x = b ^ w"
   by (metis of_int_eq_of_int_power_cancel_iff)
 
 end
 
 context linordered_idom
 begin
 
 text \<open>Every \<open>linordered_idom\<close> has characteristic zero.\<close>
 subclass ring_char_0 ..
 
 lemma of_int_le_iff [simp]: "of_int w \<le> of_int z \<longleftrightarrow> w \<le> z"
   by (transfer fixing: less_eq)
     (clarsimp simp add: algebra_simps of_nat_add [symmetric] simp del: of_nat_add)
 
 lemma of_int_less_iff [simp]: "of_int w < of_int z \<longleftrightarrow> w < z"
   by (simp add: less_le order_less_le)
 
 lemma of_int_0_le_iff [simp]: "0 \<le> of_int z \<longleftrightarrow> 0 \<le> z"
   using of_int_le_iff [of 0 z] by simp
 
 lemma of_int_le_0_iff [simp]: "of_int z \<le> 0 \<longleftrightarrow> z \<le> 0"
   using of_int_le_iff [of z 0] by simp
 
 lemma of_int_0_less_iff [simp]: "0 < of_int z \<longleftrightarrow> 0 < z"
   using of_int_less_iff [of 0 z] by simp
 
 lemma of_int_less_0_iff [simp]: "of_int z < 0 \<longleftrightarrow> z < 0"
   using of_int_less_iff [of z 0] by simp
 
 lemma of_int_1_le_iff [simp]: "1 \<le> of_int z \<longleftrightarrow> 1 \<le> z"
   using of_int_le_iff [of 1 z] by simp
 
 lemma of_int_le_1_iff [simp]: "of_int z \<le> 1 \<longleftrightarrow> z \<le> 1"
   using of_int_le_iff [of z 1] by simp
 
 lemma of_int_1_less_iff [simp]: "1 < of_int z \<longleftrightarrow> 1 < z"
   using of_int_less_iff [of 1 z] by simp
 
 lemma of_int_less_1_iff [simp]: "of_int z < 1 \<longleftrightarrow> z < 1"
   using of_int_less_iff [of z 1] by simp
 
 lemma of_int_pos: "z > 0 \<Longrightarrow> of_int z > 0"
   by simp
 
 lemma of_int_nonneg: "z \<ge> 0 \<Longrightarrow> of_int z \<ge> 0"
   by simp
 
 lemma of_int_abs [simp]: "of_int \<bar>x\<bar> = \<bar>of_int x\<bar>"
   by (auto simp add: abs_if)
 
 lemma of_int_lessD:
   assumes "\<bar>of_int n\<bar> < x"
   shows "n = 0 \<or> x > 1"
 proof (cases "n = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then have "\<bar>n\<bar> \<noteq> 0" by simp
   then have "\<bar>n\<bar> > 0" by simp
   then have "\<bar>n\<bar> \<ge> 1"
     using zless_imp_add1_zle [of 0 "\<bar>n\<bar>"] by simp
   then have "\<bar>of_int n\<bar> \<ge> 1"
     unfolding of_int_1_le_iff [of "\<bar>n\<bar>", symmetric] by simp
   then have "1 < x" using assms by (rule le_less_trans)
   then show ?thesis ..
 qed
 
 lemma of_int_leD:
   assumes "\<bar>of_int n\<bar> \<le> x"
   shows "n = 0 \<or> 1 \<le> x"
 proof (cases "n = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then have "\<bar>n\<bar> \<noteq> 0" by simp
   then have "\<bar>n\<bar> > 0" by simp
   then have "\<bar>n\<bar> \<ge> 1"
     using zless_imp_add1_zle [of 0 "\<bar>n\<bar>"] by simp
   then have "\<bar>of_int n\<bar> \<ge> 1"
     unfolding of_int_1_le_iff [of "\<bar>n\<bar>", symmetric] by simp
   then have "1 \<le> x" using assms by (rule order_trans)
   then show ?thesis ..
 qed
 
 lemma numeral_power_le_of_int_cancel_iff [simp]:
   "numeral x ^ n \<le> of_int a \<longleftrightarrow> numeral x ^ n \<le> a"
   by (metis (mono_tags) local.of_int_eq_numeral_power_cancel_iff of_int_le_iff)
 
 lemma of_int_le_numeral_power_cancel_iff [simp]:
   "of_int a \<le> numeral x ^ n \<longleftrightarrow> a \<le> numeral x ^ n"
   by (metis (mono_tags) local.numeral_power_eq_of_int_cancel_iff of_int_le_iff)
 
 lemma numeral_power_less_of_int_cancel_iff [simp]:
   "numeral x ^ n < of_int a \<longleftrightarrow> numeral x ^ n < a"
   by (metis (mono_tags) local.of_int_eq_numeral_power_cancel_iff of_int_less_iff)
 
 lemma of_int_less_numeral_power_cancel_iff [simp]:
   "of_int a < numeral x ^ n \<longleftrightarrow> a < numeral x ^ n"
   by (metis (mono_tags) local.of_int_eq_numeral_power_cancel_iff of_int_less_iff)
 
 lemma neg_numeral_power_le_of_int_cancel_iff [simp]:
   "(- numeral x) ^ n \<le> of_int a \<longleftrightarrow> (- numeral x) ^ n \<le> a"
   by (metis (mono_tags) of_int_le_iff of_int_neg_numeral of_int_power)
 
 lemma of_int_le_neg_numeral_power_cancel_iff [simp]:
   "of_int a \<le> (- numeral x) ^ n \<longleftrightarrow> a \<le> (- numeral x) ^ n"
   by (metis (mono_tags) of_int_le_iff of_int_neg_numeral of_int_power)
 
 lemma neg_numeral_power_less_of_int_cancel_iff [simp]:
   "(- numeral x) ^ n < of_int a \<longleftrightarrow> (- numeral x) ^ n < a"
   using of_int_less_iff[of "(- numeral x) ^ n" a]
   by simp
 
 lemma of_int_less_neg_numeral_power_cancel_iff [simp]:
   "of_int a < (- numeral x) ^ n \<longleftrightarrow> a < (- numeral x::int) ^ n"
   using of_int_less_iff[of a "(- numeral x) ^ n"]
   by simp
 
 lemma of_int_le_of_int_power_cancel_iff[simp]: "(of_int b) ^ w \<le> of_int x \<longleftrightarrow> b ^ w \<le> x"
   by (metis (mono_tags) of_int_le_iff of_int_power)
 
 lemma of_int_power_le_of_int_cancel_iff[simp]: "of_int x \<le> (of_int b) ^ w\<longleftrightarrow> x \<le> b ^ w"
   by (metis (mono_tags) of_int_le_iff of_int_power)
 
 lemma of_int_less_of_int_power_cancel_iff[simp]: "(of_int b) ^ w < of_int x \<longleftrightarrow> b ^ w < x"
   by (metis (mono_tags) of_int_less_iff of_int_power)
 
 lemma of_int_power_less_of_int_cancel_iff[simp]: "of_int x < (of_int b) ^ w\<longleftrightarrow> x < b ^ w"
   by (metis (mono_tags) of_int_less_iff of_int_power)
 
 lemma of_int_max: "of_int (max x y) = max (of_int x) (of_int y)"
   by (auto simp: max_def)
 
 lemma of_int_min: "of_int (min x y) = min (of_int x) (of_int y)"
   by (auto simp: min_def)
 
 end
 
 context division_ring
 begin
 
 lemmas mult_inverse_of_int_commute =
   mult_commute_imp_mult_inverse_commute[OF mult_of_int_commute]
 
 end
 
 text \<open>Comparisons involving \<^term>\<open>of_int\<close>.\<close>
 
 lemma of_int_eq_numeral_iff [iff]: "of_int z = (numeral n :: 'a::ring_char_0) \<longleftrightarrow> z = numeral n"
   using of_int_eq_iff by fastforce
 
 lemma of_int_le_numeral_iff [simp]:
   "of_int z \<le> (numeral n :: 'a::linordered_idom) \<longleftrightarrow> z \<le> numeral n"
   using of_int_le_iff [of z "numeral n"] by simp
 
 lemma of_int_numeral_le_iff [simp]:
   "(numeral n :: 'a::linordered_idom) \<le> of_int z \<longleftrightarrow> numeral n \<le> z"
   using of_int_le_iff [of "numeral n"] by simp
 
 lemma of_int_less_numeral_iff [simp]:
   "of_int z < (numeral n :: 'a::linordered_idom) \<longleftrightarrow> z < numeral n"
   using of_int_less_iff [of z "numeral n"] by simp
 
 lemma of_int_numeral_less_iff [simp]:
   "(numeral n :: 'a::linordered_idom) < of_int z \<longleftrightarrow> numeral n < z"
   using of_int_less_iff [of "numeral n" z] by simp
 
 lemma of_nat_less_of_int_iff: "(of_nat n::'a::linordered_idom) < of_int x \<longleftrightarrow> int n < x"
   by (metis of_int_of_nat_eq of_int_less_iff)
 
 lemma of_int_eq_id [simp]: "of_int = id"
 proof
   show "of_int z = id z" for z
     by (cases z rule: int_diff_cases) simp
 qed
 
 instance int :: no_top
 proof
   show "\<And>x::int. \<exists>y. x < y"
     by (rule_tac x="x + 1" in exI) simp
 qed
 
 instance int :: no_bot
 proof
   show "\<And>x::int. \<exists>y. y < x"
     by (rule_tac x="x - 1" in exI) simp
 qed
 
 
 subsection \<open>Magnitude of an Integer, as a Natural Number: \<open>nat\<close>\<close>
 
 lift_definition nat :: "int \<Rightarrow> nat" is "\<lambda>(x, y). x - y"
   by auto
 
 lemma nat_int [simp]: "nat (int n) = n"
   by transfer simp
 
 lemma int_nat_eq [simp]: "int (nat z) = (if 0 \<le> z then z else 0)"
   by transfer clarsimp
 
 lemma nat_0_le: "0 \<le> z \<Longrightarrow> int (nat z) = z"
   by simp
 
 lemma nat_le_0 [simp]: "z \<le> 0 \<Longrightarrow> nat z = 0"
   by transfer clarsimp
 
 lemma nat_le_eq_zle: "0 < w \<or> 0 \<le> z \<Longrightarrow> nat w \<le> nat z \<longleftrightarrow> w \<le> z"
   by transfer (clarsimp, arith)
 
 text \<open>An alternative condition is \<^term>\<open>0 \<le> w\<close>.\<close>
 lemma nat_mono_iff: "0 < z \<Longrightarrow> nat w < nat z \<longleftrightarrow> w < z"
   by (simp add: nat_le_eq_zle linorder_not_le [symmetric])
 
 lemma nat_less_eq_zless: "0 \<le> w \<Longrightarrow> nat w < nat z \<longleftrightarrow> w < z"
   by (simp add: nat_le_eq_zle linorder_not_le [symmetric])
 
 lemma zless_nat_conj [simp]: "nat w < nat z \<longleftrightarrow> 0 < z \<and> w < z"
   by transfer (clarsimp, arith)
 
 lemma nonneg_int_cases:
   assumes "0 \<le> k"
   obtains n where "k = int n"
 proof -
   from assms have "k = int (nat k)"
     by simp
   then show thesis
     by (rule that)
 qed
 
 lemma pos_int_cases:
   assumes "0 < k"
   obtains n where "k = int n" and "n > 0"
 proof -
   from assms have "0 \<le> k"
     by simp
   then obtain n where "k = int n"
     by (rule nonneg_int_cases)
   moreover have "n > 0"
     using \<open>k = int n\<close> assms by simp
   ultimately show thesis
     by (rule that)
 qed
 
 lemma nonpos_int_cases:
   assumes "k \<le> 0"
   obtains n where "k = - int n"
 proof -
   from assms have "- k \<ge> 0"
     by simp
   then obtain n where "- k = int n"
     by (rule nonneg_int_cases)
   then have "k = - int n"
     by simp
   then show thesis
     by (rule that)
 qed
 
 lemma neg_int_cases:
   assumes "k < 0"
   obtains n where "k = - int n" and "n > 0"
 proof -
   from assms have "- k > 0"
     by simp
   then obtain n where "- k = int n" and "- k > 0"
     by (blast elim: pos_int_cases)
   then have "k = - int n" and "n > 0"
     by simp_all
   then show thesis
     by (rule that)
 qed
 
 lemma nat_eq_iff: "nat w = m \<longleftrightarrow> (if 0 \<le> w then w = int m else m = 0)"
   by transfer (clarsimp simp add: le_imp_diff_is_add)
 
 lemma nat_eq_iff2: "m = nat w \<longleftrightarrow> (if 0 \<le> w then w = int m else m = 0)"
   using nat_eq_iff [of w m] by auto
 
 lemma nat_0 [simp]: "nat 0 = 0"
   by (simp add: nat_eq_iff)
 
 lemma nat_1 [simp]: "nat 1 = Suc 0"
   by (simp add: nat_eq_iff)
 
 lemma nat_numeral [simp]: "nat (numeral k) = numeral k"
   by (simp add: nat_eq_iff)
 
 lemma nat_neg_numeral [simp]: "nat (- numeral k) = 0"
   by simp
 
 lemma nat_2: "nat 2 = Suc (Suc 0)"
   by simp
 
 lemma nat_less_iff: "0 \<le> w \<Longrightarrow> nat w < m \<longleftrightarrow> w < of_nat m"
   by transfer (clarsimp, arith)
 
 lemma nat_le_iff: "nat x \<le> n \<longleftrightarrow> x \<le> int n"
   by transfer (clarsimp simp add: le_diff_conv)
 
 lemma nat_mono: "x \<le> y \<Longrightarrow> nat x \<le> nat y"
   by transfer auto
 
 lemma nat_0_iff[simp]: "nat i = 0 \<longleftrightarrow> i \<le> 0"
   for i :: int
   by transfer clarsimp
 
 lemma int_eq_iff: "of_nat m = z \<longleftrightarrow> m = nat z \<and> 0 \<le> z"
   by (auto simp add: nat_eq_iff2)
 
 lemma zero_less_nat_eq [simp]: "0 < nat z \<longleftrightarrow> 0 < z"
   using zless_nat_conj [of 0] by auto
 
 lemma nat_add_distrib: "0 \<le> z \<Longrightarrow> 0 \<le> z' \<Longrightarrow> nat (z + z') = nat z + nat z'"
   by transfer clarsimp
 
 lemma nat_diff_distrib': "0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> nat (x - y) = nat x - nat y"
   by transfer clarsimp
 
 lemma nat_diff_distrib: "0 \<le> z' \<Longrightarrow> z' \<le> z \<Longrightarrow> nat (z - z') = nat z - nat z'"
   by (rule nat_diff_distrib') auto
 
 lemma nat_zminus_int [simp]: "nat (- int n) = 0"
   by transfer simp
 
 lemma le_nat_iff: "k \<ge> 0 \<Longrightarrow> n \<le> nat k \<longleftrightarrow> int n \<le> k"
   by transfer auto
 
 lemma zless_nat_eq_int_zless: "m < nat z \<longleftrightarrow> int m < z"
   by transfer (clarsimp simp add: less_diff_conv)
 
 lemma (in ring_1) of_nat_nat [simp]: "0 \<le> z \<Longrightarrow> of_nat (nat z) = of_int z"
   by transfer (clarsimp simp add: of_nat_diff)
 
 lemma diff_nat_numeral [simp]: "(numeral v :: nat) - numeral v' = nat (numeral v - numeral v')"
   by (simp only: nat_diff_distrib' zero_le_numeral nat_numeral)
 
 lemma nat_abs_triangle_ineq:
   "nat \<bar>k + l\<bar> \<le> nat \<bar>k\<bar> + nat \<bar>l\<bar>"
   by (simp add: nat_add_distrib [symmetric] nat_le_eq_zle abs_triangle_ineq)
 
 lemma nat_of_bool [simp]:
   "nat (of_bool P) = of_bool P"
   by auto
 
 lemma split_nat [arith_split]: "P (nat i) \<longleftrightarrow> ((\<forall>n. i = int n \<longrightarrow> P n) \<and> (i < 0 \<longrightarrow> P 0))"
   (is "?P = (?L \<and> ?R)")
   for i :: int
 proof (cases "i < 0")
   case True
   then show ?thesis
     by auto
 next
   case False
   have "?P = ?L"
   proof
     assume ?P
     then show ?L using False by auto
   next
     assume ?L
     moreover from False have "int (nat i) = i"
       by (simp add: not_less)
     ultimately show ?P
       by simp
   qed
   with False show ?thesis by simp
 qed
 
 lemma all_nat: "(\<forall>x. P x) \<longleftrightarrow> (\<forall>x\<ge>0. P (nat x))"
   by (auto split: split_nat)
 
 lemma ex_nat: "(\<exists>x. P x) \<longleftrightarrow> (\<exists>x. 0 \<le> x \<and> P (nat x))"
 proof
   assume "\<exists>x. P x"
   then obtain x where "P x" ..
   then have "int x \<ge> 0 \<and> P (nat (int x))" by simp
   then show "\<exists>x\<ge>0. P (nat x)" ..
 next
   assume "\<exists>x\<ge>0. P (nat x)"
   then show "\<exists>x. P x" by auto
 qed
 
 
 text \<open>For termination proofs:\<close>
 lemma measure_function_int[measure_function]: "is_measure (nat \<circ> abs)" ..
 
 
 subsection \<open>Lemmas about the Function \<^term>\<open>of_nat\<close> and Orderings\<close>
 
 lemma negative_zless_0: "- (int (Suc n)) < (0 :: int)"
   by (simp add: order_less_le del: of_nat_Suc)
 
 lemma negative_zless [iff]: "- (int (Suc n)) < int m"
   by (rule negative_zless_0 [THEN order_less_le_trans], simp)
 
 lemma negative_zle_0: "- int n \<le> 0"
   by (simp add: minus_le_iff)
 
 lemma negative_zle [iff]: "- int n \<le> int m"
   by (rule order_trans [OF negative_zle_0 of_nat_0_le_iff])
 
 lemma not_zle_0_negative [simp]: "\<not> 0 \<le> - int (Suc n)"
   by (subst le_minus_iff) (simp del: of_nat_Suc)
 
 lemma int_zle_neg: "int n \<le> - int m \<longleftrightarrow> n = 0 \<and> m = 0"
   by transfer simp
 
 lemma not_int_zless_negative [simp]: "\<not> int n < - int m"
   by (simp add: linorder_not_less)
 
 lemma negative_eq_positive [simp]: "- int n = of_nat m \<longleftrightarrow> n = 0 \<and> m = 0"
   by (force simp add: order_eq_iff [of "- of_nat n"] int_zle_neg)
 
 lemma zle_iff_zadd: "w \<le> z \<longleftrightarrow> (\<exists>n. z = w + int n)"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?rhs
   then show ?lhs by auto
 next
   assume ?lhs
   then have "0 \<le> z - w" by simp
   then obtain n where "z - w = int n"
     using zero_le_imp_eq_int [of "z - w"] by blast
   then have "z = w + int n" by simp
   then show ?rhs ..
 qed
 
 lemma zadd_int_left: "int m + (int n + z) = int (m + n) + z"
   by simp
 
 text \<open>
   This version is proved for all ordered rings, not just integers!
   It is proved here because attribute \<open>arith_split\<close> is not available
   in theory \<open>Rings\<close>.
   But is it really better than just rewriting with \<open>abs_if\<close>?
 \<close>
 lemma abs_split [arith_split, no_atp]: "P \<bar>a\<bar> \<longleftrightarrow> (0 \<le> a \<longrightarrow> P a) \<and> (a < 0 \<longrightarrow> P (- a))"
   for a :: "'a::linordered_idom"
   by (force dest: order_less_le_trans simp add: abs_if linorder_not_less)
 
 lemma negD:
   assumes "x < 0" shows "\<exists>n. x = - (int (Suc n))"
 proof -
   have "\<And>a b. a < b \<Longrightarrow> \<exists>n. Suc (a + n) = b"
     by (rule_tac x="b - Suc a" in exI) arith
   with assms show ?thesis
     by transfer auto
 qed
 
 
 subsection \<open>Cases and induction\<close>
 
 text \<open>
   Now we replace the case analysis rule by a more conventional one:
   whether an integer is negative or not.
 \<close>
 
 text \<open>This version is symmetric in the two subgoals.\<close>
 lemma int_cases2 [case_names nonneg nonpos, cases type: int]:
   "(\<And>n. z = int n \<Longrightarrow> P) \<Longrightarrow> (\<And>n. z = - (int n) \<Longrightarrow> P) \<Longrightarrow> P"
   by (cases "z < 0") (auto simp add: linorder_not_less dest!: negD nat_0_le [THEN sym])
 
 text \<open>This is the default, with a negative case.\<close>
 lemma int_cases [case_names nonneg neg, cases type: int]:
   assumes pos: "\<And>n. z = int n \<Longrightarrow> P" and neg: "\<And>n. z = - (int (Suc n)) \<Longrightarrow> P"
   shows P
 proof (cases "z < 0")
   case True
   with neg show ?thesis
     by (blast dest!: negD)
 next
   case False
   with pos show ?thesis
     by (force simp add: linorder_not_less dest: nat_0_le [THEN sym])
 qed
 
 lemma int_cases3 [case_names zero pos neg]:
   fixes k :: int
   assumes "k = 0 \<Longrightarrow> P" and "\<And>n. k = int n \<Longrightarrow> n > 0 \<Longrightarrow> P"
     and "\<And>n. k = - int n \<Longrightarrow> n > 0 \<Longrightarrow> P"
   shows "P"
 proof (cases k "0::int" rule: linorder_cases)
   case equal
   with assms(1) show P by simp
 next
   case greater
   then have *: "nat k > 0" by simp
   moreover from * have "k = int (nat k)" by auto
   ultimately show P using assms(2) by blast
 next
   case less
   then have *: "nat (- k) > 0" by simp
   moreover from * have "k = - int (nat (- k))" by auto
   ultimately show P using assms(3) by blast
 qed
 
 lemma int_of_nat_induct [case_names nonneg neg, induct type: int]:
   "(\<And>n. P (int n)) \<Longrightarrow> (\<And>n. P (- (int (Suc n)))) \<Longrightarrow> P z"
   by (cases z) auto
 
 lemma sgn_mult_dvd_iff [simp]:
   "sgn r * l dvd k \<longleftrightarrow> l dvd k \<and> (r = 0 \<longrightarrow> k = 0)" for k l r :: int
   by (cases r rule: int_cases3) auto
 
 lemma mult_sgn_dvd_iff [simp]:
   "l * sgn r dvd k \<longleftrightarrow> l dvd k \<and> (r = 0 \<longrightarrow> k = 0)" for k l r :: int
   using sgn_mult_dvd_iff [of r l k] by (simp add: ac_simps)
 
 lemma dvd_sgn_mult_iff [simp]:
   "l dvd sgn r * k \<longleftrightarrow> l dvd k \<or> r = 0" for k l r :: int
   by (cases r rule: int_cases3) simp_all
 
 lemma dvd_mult_sgn_iff [simp]:
   "l dvd k * sgn r \<longleftrightarrow> l dvd k \<or> r = 0" for k l r :: int
   using dvd_sgn_mult_iff [of l r k] by (simp add: ac_simps)
 
 lemma int_sgnE:
   fixes k :: int
   obtains n and l where "k = sgn l * int n"
 proof -
   have "k = sgn k * int (nat \<bar>k\<bar>)"
     by (simp add: sgn_mult_abs)
   then show ?thesis ..
 qed
 
 
 subsubsection \<open>Binary comparisons\<close>
 
 text \<open>Preliminaries\<close>
 
 lemma le_imp_0_less:
   fixes z :: int
   assumes le: "0 \<le> z"
   shows "0 < 1 + z"
 proof -
   have "0 \<le> z" by fact
   also have "\<dots> < z + 1" by (rule less_add_one)
   also have "\<dots> = 1 + z" by (simp add: ac_simps)
   finally show "0 < 1 + z" .
 qed
 
 lemma odd_less_0_iff: "1 + z + z < 0 \<longleftrightarrow> z < 0"
   for z :: int
 proof (cases z)
   case (nonneg n)
   then show ?thesis
     by (simp add: linorder_not_less add.assoc add_increasing le_imp_0_less [THEN order_less_imp_le])
 next
   case (neg n)
   then show ?thesis
     by (simp del: of_nat_Suc of_nat_add of_nat_1
         add: algebra_simps of_nat_1 [where 'a=int, symmetric] of_nat_add [symmetric])
 qed
 
 
 subsubsection \<open>Comparisons, for Ordered Rings\<close>
 
 lemma odd_nonzero: "1 + z + z \<noteq> 0"
   for z :: int
 proof (cases z)
   case (nonneg n)
   have le: "0 \<le> z + z"
     by (simp add: nonneg add_increasing)
   then show ?thesis
     using le_imp_0_less [OF le] by (auto simp: ac_simps)
 next
   case (neg n)
   show ?thesis
   proof
     assume eq: "1 + z + z = 0"
     have "0 < 1 + (int n + int n)"
       by (simp add: le_imp_0_less add_increasing)
     also have "\<dots> = - (1 + z + z)"
       by (simp add: neg add.assoc [symmetric])
     also have "\<dots> = 0" by (simp add: eq)
     finally have "0<0" ..
     then show False by blast
   qed
 qed
 
 
 subsection \<open>The Set of Integers\<close>
 
 context ring_1
 begin
 
 definition Ints :: "'a set"  ("\<int>")
   where "\<int> = range of_int"
 
 lemma Ints_of_int [simp]: "of_int z \<in> \<int>"
   by (simp add: Ints_def)
 
 lemma Ints_of_nat [simp]: "of_nat n \<in> \<int>"
   using Ints_of_int [of "of_nat n"] by simp
 
 lemma Ints_0 [simp]: "0 \<in> \<int>"
   using Ints_of_int [of "0"] by simp
 
 lemma Ints_1 [simp]: "1 \<in> \<int>"
   using Ints_of_int [of "1"] by simp
 
 lemma Ints_numeral [simp]: "numeral n \<in> \<int>"
   by (subst of_nat_numeral [symmetric], rule Ints_of_nat)
 
 lemma Ints_add [simp]: "a \<in> \<int> \<Longrightarrow> b \<in> \<int> \<Longrightarrow> a + b \<in> \<int>"
   by (force simp add: Ints_def simp flip: of_int_add intro: range_eqI)
 
 lemma Ints_minus [simp]: "a \<in> \<int> \<Longrightarrow> -a \<in> \<int>"
   by (force simp add: Ints_def simp flip: of_int_minus intro: range_eqI)
 
 lemma minus_in_Ints_iff: "-x \<in> \<int> \<longleftrightarrow> x \<in> \<int>"
   using Ints_minus[of x] Ints_minus[of "-x"] by auto
 
 lemma Ints_diff [simp]: "a \<in> \<int> \<Longrightarrow> b \<in> \<int> \<Longrightarrow> a - b \<in> \<int>"
   by (force simp add: Ints_def simp flip: of_int_diff intro: range_eqI)
 
 lemma Ints_mult [simp]: "a \<in> \<int> \<Longrightarrow> b \<in> \<int> \<Longrightarrow> a * b \<in> \<int>"
   by (force simp add: Ints_def simp flip: of_int_mult intro: range_eqI)
 
 lemma Ints_power [simp]: "a \<in> \<int> \<Longrightarrow> a ^ n \<in> \<int>"
   by (induct n) simp_all
 
 lemma Ints_cases [cases set: Ints]:
   assumes "q \<in> \<int>"
   obtains (of_int) z where "q = of_int z"
   unfolding Ints_def
 proof -
   from \<open>q \<in> \<int>\<close> have "q \<in> range of_int" unfolding Ints_def .
   then obtain z where "q = of_int z" ..
   then show thesis ..
 qed
 
 lemma Ints_induct [case_names of_int, induct set: Ints]:
   "q \<in> \<int> \<Longrightarrow> (\<And>z. P (of_int z)) \<Longrightarrow> P q"
   by (rule Ints_cases) auto
 
 lemma Nats_subset_Ints: "\<nat> \<subseteq> \<int>"
   unfolding Nats_def Ints_def
   by (rule subsetI, elim imageE, hypsubst, subst of_int_of_nat_eq[symmetric], rule imageI) simp_all
 
 lemma Nats_altdef1: "\<nat> = {of_int n |n. n \<ge> 0}"
 proof (intro subsetI equalityI)
   fix x :: 'a
   assume "x \<in> {of_int n |n. n \<ge> 0}"
   then obtain n where "x = of_int n" "n \<ge> 0"
     by (auto elim!: Ints_cases)
   then have "x = of_nat (nat n)"
     by (subst of_nat_nat) simp_all
   then show "x \<in> \<nat>"
     by simp
 next
   fix x :: 'a
   assume "x \<in> \<nat>"
   then obtain n where "x = of_nat n"
     by (auto elim!: Nats_cases)
   then have "x = of_int (int n)" by simp
   also have "int n \<ge> 0" by simp
   then have "of_int (int n) \<in> {of_int n |n. n \<ge> 0}" by blast
   finally show "x \<in> {of_int n |n. n \<ge> 0}" .
 qed
 
 end
 
+lemma Ints_sum [intro]: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> \<int>) \<Longrightarrow> sum f A \<in> \<int>"
+  by (induction A rule: infinite_finite_induct) auto
+
+lemma Ints_prod [intro]: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> \<int>) \<Longrightarrow> prod f A \<in> \<int>"
+  by (induction A rule: infinite_finite_induct) auto
+
 lemma (in linordered_idom) Ints_abs [simp]:
   shows "a \<in> \<int> \<Longrightarrow> abs a \<in> \<int>"
   by (auto simp: abs_if)
 
 lemma (in linordered_idom) Nats_altdef2: "\<nat> = {n \<in> \<int>. n \<ge> 0}"
 proof (intro subsetI equalityI)
   fix x :: 'a
   assume "x \<in> {n \<in> \<int>. n \<ge> 0}"
   then obtain n where "x = of_int n" "n \<ge> 0"
     by (auto elim!: Ints_cases)
   then have "x = of_nat (nat n)"
     by (subst of_nat_nat) simp_all
   then show "x \<in> \<nat>"
     by simp
 qed (auto elim!: Nats_cases)
 
 lemma (in idom_divide) of_int_divide_in_Ints: 
   "of_int a div of_int b \<in> \<int>" if "b dvd a"
 proof -
   from that obtain c where "a = b * c" ..
   then show ?thesis
     by (cases "of_int b = 0") simp_all
 qed
 
 text \<open>The premise involving \<^term>\<open>Ints\<close> prevents \<^term>\<open>a = 1/2\<close>.\<close>
 
 lemma Ints_double_eq_0_iff:
   fixes a :: "'a::ring_char_0"
   assumes in_Ints: "a \<in> \<int>"
   shows "a + a = 0 \<longleftrightarrow> a = 0"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof -
   from in_Ints have "a \<in> range of_int"
     unfolding Ints_def [symmetric] .
   then obtain z where a: "a = of_int z" ..
   show ?thesis
   proof
     assume ?rhs
     then show ?lhs by simp
   next
     assume ?lhs
     with a have "of_int (z + z) = (of_int 0 :: 'a)" by simp
     then have "z + z = 0" by (simp only: of_int_eq_iff)
     then have "z = 0" by (simp only: double_zero)
     with a show ?rhs by simp
   qed
 qed
 
 lemma Ints_odd_nonzero:
   fixes a :: "'a::ring_char_0"
   assumes in_Ints: "a \<in> \<int>"
   shows "1 + a + a \<noteq> 0"
 proof -
   from in_Ints have "a \<in> range of_int"
     unfolding Ints_def [symmetric] .
   then obtain z where a: "a = of_int z" ..
   show ?thesis
   proof
     assume "1 + a + a = 0"
     with a have "of_int (1 + z + z) = (of_int 0 :: 'a)" by simp
     then have "1 + z + z = 0" by (simp only: of_int_eq_iff)
     with odd_nonzero show False by blast
   qed
 qed
 
 lemma Nats_numeral [simp]: "numeral w \<in> \<nat>"
   using of_nat_in_Nats [of "numeral w"] by simp
 
 lemma Ints_odd_less_0:
   fixes a :: "'a::linordered_idom"
   assumes in_Ints: "a \<in> \<int>"
   shows "1 + a + a < 0 \<longleftrightarrow> a < 0"
 proof -
   from in_Ints have "a \<in> range of_int"
     unfolding Ints_def [symmetric] .
   then obtain z where a: "a = of_int z" ..
   with a have "1 + a + a < 0 \<longleftrightarrow> of_int (1 + z + z) < (of_int 0 :: 'a)"
     by simp
   also have "\<dots> \<longleftrightarrow> z < 0"
     by (simp only: of_int_less_iff odd_less_0_iff)
   also have "\<dots> \<longleftrightarrow> a < 0"
     by (simp add: a)
   finally show ?thesis .
 qed
 
 
 subsection \<open>\<^term>\<open>sum\<close> and \<^term>\<open>prod\<close>\<close>
 
 context semiring_1
 begin
 
 lemma of_nat_sum [simp]:
   "of_nat (sum f A) = (\<Sum>x\<in>A. of_nat (f x))"
   by (induction A rule: infinite_finite_induct) auto
 
 end
 
 context ring_1
 begin
 
 lemma of_int_sum [simp]:
   "of_int (sum f A) = (\<Sum>x\<in>A. of_int (f x))"
   by (induction A rule: infinite_finite_induct) auto
 
 end
 
 context comm_semiring_1
 begin
 
 lemma of_nat_prod [simp]:
   "of_nat (prod f A) = (\<Prod>x\<in>A. of_nat (f x))"
   by (induction A rule: infinite_finite_induct) auto
 
 end
 
 context comm_ring_1
 begin
 
 lemma of_int_prod [simp]:
   "of_int (prod f A) = (\<Prod>x\<in>A. of_int (f x))"
   by (induction A rule: infinite_finite_induct) auto
 
 end
 
 
 subsection \<open>Setting up simplification procedures\<close>
 
 ML_file \<open>Tools/int_arith.ML\<close>
 
 declaration \<open>K (
   Lin_Arith.add_discrete_type \<^type_name>\<open>Int.int\<close>
   #> Lin_Arith.add_lessD @{thm zless_imp_add1_zle}
   #> Lin_Arith.add_inj_thms @{thms of_nat_le_iff [THEN iffD2] of_nat_eq_iff [THEN iffD2]}
   #> Lin_Arith.add_inj_const (\<^const_name>\<open>of_nat\<close>, \<^typ>\<open>nat \<Rightarrow> int\<close>)
   #> Lin_Arith.add_simps
       @{thms of_int_0 of_int_1 of_int_add of_int_mult of_int_numeral of_int_neg_numeral nat_0 nat_1 diff_nat_numeral nat_numeral
       neg_less_iff_less
       True_implies_equals
       distrib_left [where a = "numeral v" for v]
       distrib_left [where a = "- numeral v" for v]
       div_by_1 div_0
       times_divide_eq_right times_divide_eq_left
       minus_divide_left [THEN sym] minus_divide_right [THEN sym]
       add_divide_distrib diff_divide_distrib
       of_int_minus of_int_diff
       of_int_of_nat_eq}
   #> Lin_Arith.add_simprocs [Int_Arith.zero_one_idom_simproc]
 )\<close>
 
 simproc_setup fast_arith
   ("(m::'a::linordered_idom) < n" |
     "(m::'a::linordered_idom) \<le> n" |
     "(m::'a::linordered_idom) = n") =
   \<open>K Lin_Arith.simproc\<close>
 
 
 subsection\<open>More Inequality Reasoning\<close>
 
 lemma zless_add1_eq: "w < z + 1 \<longleftrightarrow> w < z \<or> w = z"
   for w z :: int
   by arith
 
 lemma add1_zle_eq: "w + 1 \<le> z \<longleftrightarrow> w < z"
   for w z :: int
   by arith
 
 lemma zle_diff1_eq [simp]: "w \<le> z - 1 \<longleftrightarrow> w < z"
   for w z :: int
   by arith
 
 lemma zle_add1_eq_le [simp]: "w < z + 1 \<longleftrightarrow> w \<le> z"
   for w z :: int
   by arith
 
 lemma int_one_le_iff_zero_less: "1 \<le> z \<longleftrightarrow> 0 < z"
   for z :: int
   by arith
 
 lemma Ints_nonzero_abs_ge1:
   fixes x:: "'a :: linordered_idom"
     assumes "x \<in> Ints" "x \<noteq> 0"
     shows "1 \<le> abs x"
 proof (rule Ints_cases [OF \<open>x \<in> Ints\<close>])
   fix z::int
   assume "x = of_int z"
     with \<open>x \<noteq> 0\<close> 
   show "1 \<le> \<bar>x\<bar>"
     apply (auto simp add: abs_if)
     by (metis diff_0 of_int_1 of_int_le_iff of_int_minus zle_diff1_eq)
 qed
   
 lemma Ints_nonzero_abs_less1:
   fixes x:: "'a :: linordered_idom"
   shows "\<lbrakk>x \<in> Ints; abs x < 1\<rbrakk> \<Longrightarrow> x = 0"
     using Ints_nonzero_abs_ge1 [of x] by auto
 
 lemma Ints_eq_abs_less1:
   fixes x:: "'a :: linordered_idom"
   shows "\<lbrakk>x \<in> Ints; y \<in> Ints\<rbrakk> \<Longrightarrow> x = y \<longleftrightarrow> abs (x-y) < 1"
   using eq_iff_diff_eq_0 by (fastforce intro: Ints_nonzero_abs_less1)
  
 
 subsection \<open>The functions \<^term>\<open>nat\<close> and \<^term>\<open>int\<close>\<close>
 
 text \<open>Simplify the term \<^term>\<open>w + - z\<close>.\<close>
 
 lemma one_less_nat_eq [simp]: "Suc 0 < nat z \<longleftrightarrow> 1 < z"
   using zless_nat_conj [of 1 z] by auto
 
 lemma int_eq_iff_numeral [simp]:
   "int m = numeral v \<longleftrightarrow> m = numeral v"
   by (simp add: int_eq_iff)
 
 lemma nat_abs_int_diff:
   "nat \<bar>int a - int b\<bar> = (if a \<le> b then b - a else a - b)"
   by auto
 
 lemma nat_int_add: "nat (int a + int b) = a + b"
   by auto
 
 context ring_1
 begin
 
 lemma of_int_of_nat [nitpick_simp]:
   "of_int k = (if k < 0 then - of_nat (nat (- k)) else of_nat (nat k))"
 proof (cases "k < 0")
   case True
   then have "0 \<le> - k" by simp
   then have "of_nat (nat (- k)) = of_int (- k)" by (rule of_nat_nat)
   with True show ?thesis by simp
 next
   case False
   then show ?thesis by (simp add: not_less)
 qed
 
 end
 
 lemma transfer_rule_of_int:
   includes lifting_syntax
   fixes R :: "'a::ring_1 \<Rightarrow> 'b::ring_1 \<Rightarrow> bool"
   assumes [transfer_rule]: "R 0 0" "R 1 1"
     "(R ===> R ===> R) (+) (+)"
     "(R ===> R) uminus uminus"
   shows "((=) ===> R) of_int of_int"
 proof -
   note assms
   note transfer_rule_of_nat [transfer_rule]
   have [transfer_rule]: "((=) ===> R) of_nat of_nat"
     by transfer_prover
   show ?thesis
     by (unfold of_int_of_nat [abs_def]) transfer_prover
 qed
 
 lemma nat_mult_distrib:
   fixes z z' :: int
   assumes "0 \<le> z"
   shows "nat (z * z') = nat z * nat z'"
 proof (cases "0 \<le> z'")
   case False
   with assms have "z * z' \<le> 0"
     by (simp add: not_le mult_le_0_iff)
   then have "nat (z * z') = 0" by simp
   moreover from False have "nat z' = 0" by simp
   ultimately show ?thesis by simp
 next
   case True
   with assms have ge_0: "z * z' \<ge> 0" by (simp add: zero_le_mult_iff)
   show ?thesis
     by (rule injD [of "of_nat :: nat \<Rightarrow> int", OF inj_of_nat])
       (simp only: of_nat_mult of_nat_nat [OF True]
          of_nat_nat [OF assms] of_nat_nat [OF ge_0], simp)
 qed
 
 lemma nat_mult_distrib_neg:
   assumes "z \<le> (0::int)" shows "nat (z * z') = nat (- z) * nat (- z')" (is "?L = ?R")
 proof -
   have "?L = nat (- z * - z')"
     using assms by auto
   also have "... = ?R"
     by (rule nat_mult_distrib) (use assms in auto)
   finally show ?thesis .
 qed
 
 lemma nat_abs_mult_distrib: "nat \<bar>w * z\<bar> = nat \<bar>w\<bar> * nat \<bar>z\<bar>"
   by (cases "z = 0 \<or> w = 0")
     (auto simp add: abs_if nat_mult_distrib [symmetric]
       nat_mult_distrib_neg [symmetric] mult_less_0_iff)
 
 lemma int_in_range_abs [simp]: "int n \<in> range abs"
 proof (rule range_eqI)
   show "int n = \<bar>int n\<bar>" by simp
 qed
 
 lemma range_abs_Nats [simp]: "range abs = (\<nat> :: int set)"
 proof -
   have "\<bar>k\<bar> \<in> \<nat>" for k :: int
     by (cases k) simp_all
   moreover have "k \<in> range abs" if "k \<in> \<nat>" for k :: int
     using that by induct simp
   ultimately show ?thesis by blast
 qed
 
 lemma Suc_nat_eq_nat_zadd1: "0 \<le> z \<Longrightarrow> Suc (nat z) = nat (1 + z)"
   for z :: int
   by (rule sym) (simp add: nat_eq_iff)
 
 lemma diff_nat_eq_if:
   "nat z - nat z' =
     (if z' < 0 then nat z
      else
       let d = z - z'
       in if d < 0 then 0 else nat d)"
   by (simp add: Let_def nat_diff_distrib [symmetric])
 
 lemma nat_numeral_diff_1 [simp]: "numeral v - (1::nat) = nat (numeral v - 1)"
   using diff_nat_numeral [of v Num.One] by simp
 
 
 subsection \<open>Induction principles for int\<close>
 
 text \<open>Well-founded segments of the integers.\<close>
 
 definition int_ge_less_than :: "int \<Rightarrow> (int \<times> int) set"
   where "int_ge_less_than d = {(z', z). d \<le> z' \<and> z' < z}"
 
 lemma wf_int_ge_less_than: "wf (int_ge_less_than d)"
 proof -
   have "int_ge_less_than d \<subseteq> measure (\<lambda>z. nat (z - d))"
     by (auto simp add: int_ge_less_than_def)
   then show ?thesis
     by (rule wf_subset [OF wf_measure])
 qed
 
 text \<open>
   This variant looks odd, but is typical of the relations suggested
   by RankFinder.\<close>
 
 definition int_ge_less_than2 :: "int \<Rightarrow> (int \<times> int) set"
   where "int_ge_less_than2 d = {(z',z). d \<le> z \<and> z' < z}"
 
 lemma wf_int_ge_less_than2: "wf (int_ge_less_than2 d)"
 proof -
   have "int_ge_less_than2 d \<subseteq> measure (\<lambda>z. nat (1 + z - d))"
     by (auto simp add: int_ge_less_than2_def)
   then show ?thesis
     by (rule wf_subset [OF wf_measure])
 qed
 
 (* `set:int': dummy construction *)
 theorem int_ge_induct [case_names base step, induct set: int]:
   fixes i :: int
   assumes ge: "k \<le> i"
     and base: "P k"
     and step: "\<And>i. k \<le> i \<Longrightarrow> P i \<Longrightarrow> P (i + 1)"
   shows "P i"
 proof -
   have "\<And>i::int. n = nat (i - k) \<Longrightarrow> k \<le> i \<Longrightarrow> P i" for n
   proof (induct n)
     case 0
     then have "i = k" by arith
     with base show "P i" by simp
   next
     case (Suc n)
     then have "n = nat ((i - 1) - k)" by arith
     moreover have k: "k \<le> i - 1" using Suc.prems by arith
     ultimately have "P (i - 1)" by (rule Suc.hyps)
     from step [OF k this] show ?case by simp
   qed
   with ge show ?thesis by fast
 qed
 
 (* `set:int': dummy construction *)
 theorem int_gr_induct [case_names base step, induct set: int]:
   fixes i k :: int
   assumes "k < i" "P (k + 1)" "\<And>i. k < i \<Longrightarrow> P i \<Longrightarrow> P (i + 1)"
   shows "P i"
 proof -
   have "k+1 \<le> i"
     using assms by auto
   then show ?thesis
     by (induction i rule: int_ge_induct) (auto simp: assms)
 qed
 
 theorem int_le_induct [consumes 1, case_names base step]:
   fixes i k :: int
   assumes le: "i \<le> k"
     and base: "P k"
     and step: "\<And>i. i \<le> k \<Longrightarrow> P i \<Longrightarrow> P (i - 1)"
   shows "P i"
 proof -
   have "\<And>i::int. n = nat(k-i) \<Longrightarrow> i \<le> k \<Longrightarrow> P i" for n
   proof (induct n)
     case 0
     then have "i = k" by arith
     with base show "P i" by simp
   next
     case (Suc n)
     then have "n = nat (k - (i + 1))" by arith
     moreover have k: "i + 1 \<le> k" using Suc.prems by arith
     ultimately have "P (i + 1)" by (rule Suc.hyps)
     from step[OF k this] show ?case by simp
   qed
   with le show ?thesis by fast
 qed
 
 theorem int_less_induct [consumes 1, case_names base step]:
   fixes i k :: int
   assumes "i < k" "P (k - 1)" "\<And>i. i < k \<Longrightarrow> P i \<Longrightarrow> P (i - 1)"
   shows "P i"
 proof -
   have "i \<le> k-1"
     using assms by auto
   then show ?thesis
     by (induction i rule: int_le_induct) (auto simp: assms)
 qed
 
 theorem int_induct [case_names base step1 step2]:
   fixes k :: int
   assumes base: "P k"
     and step1: "\<And>i. k \<le> i \<Longrightarrow> P i \<Longrightarrow> P (i + 1)"
     and step2: "\<And>i. k \<ge> i \<Longrightarrow> P i \<Longrightarrow> P (i - 1)"
   shows "P i"
 proof -
   have "i \<le> k \<or> i \<ge> k" by arith
   then show ?thesis
   proof
     assume "i \<ge> k"
     then show ?thesis
       using base by (rule int_ge_induct) (fact step1)
   next
     assume "i \<le> k"
     then show ?thesis
       using base by (rule int_le_induct) (fact step2)
   qed
 qed
 
 
 subsection \<open>Intermediate value theorems\<close>
 
 lemma nat_ivt_aux: 
   "\<lbrakk>\<forall>i<n. \<bar>f (Suc i) - f i\<bar> \<le> 1; f 0 \<le> k; k \<le> f n\<rbrakk> \<Longrightarrow> \<exists>i \<le> n. f i = k"
   for m n :: nat and k :: int
 proof (induct n)
   case (Suc n)
   show ?case
   proof (cases "k = f (Suc n)")
     case False
     with Suc have "k \<le> f n"
       by auto
     with Suc show ?thesis
       by (auto simp add: abs_if split: if_split_asm intro: le_SucI)
   qed (use Suc in auto)
 qed auto
 
 lemma nat_intermed_int_val:
   fixes m n :: nat and k :: int
   assumes "\<forall>i. m \<le> i \<and> i < n \<longrightarrow> \<bar>f (Suc i) - f i\<bar> \<le> 1" "m \<le> n" "f m \<le> k" "k \<le> f n"
   shows "\<exists>i. m \<le> i \<and> i \<le> n \<and> f i = k"
 proof -
   obtain i where "i \<le> n - m" "k = f (m + i)"
     using nat_ivt_aux [of "n - m" "f \<circ> plus m" k] assms by auto
   with assms show ?thesis
     by (rule_tac x = "m + i" in exI) auto
 qed
 
 lemma nat0_intermed_int_val:
   "\<exists>i\<le>n. f i = k"
   if "\<forall>i<n. \<bar>f (i + 1) - f i\<bar> \<le> 1" "f 0 \<le> k" "k \<le> f n"
   for n :: nat and k :: int
   using nat_intermed_int_val [of 0 n f k] that by auto
 
 
 subsection \<open>Products and 1, by T. M. Rasmussen\<close>
 
 lemma abs_zmult_eq_1:
   fixes m n :: int
   assumes mn: "\<bar>m * n\<bar> = 1"
   shows "\<bar>m\<bar> = 1"
 proof -
   from mn have 0: "m \<noteq> 0" "n \<noteq> 0" by auto
   have "\<not> 2 \<le> \<bar>m\<bar>"
   proof
     assume "2 \<le> \<bar>m\<bar>"
     then have "2 * \<bar>n\<bar> \<le> \<bar>m\<bar> * \<bar>n\<bar>" by (simp add: mult_mono 0)
     also have "\<dots> = \<bar>m * n\<bar>" by (simp add: abs_mult)
     also from mn have "\<dots> = 1" by simp
     finally have "2 * \<bar>n\<bar> \<le> 1" .
     with 0 show "False" by arith
   qed
   with 0 show ?thesis by auto
 qed
 
 lemma pos_zmult_eq_1_iff_lemma: "m * n = 1 \<Longrightarrow> m = 1 \<or> m = - 1"
   for m n :: int
   using abs_zmult_eq_1 [of m n] by arith
 
 lemma pos_zmult_eq_1_iff:
   fixes m n :: int
   assumes "0 < m"
   shows "m * n = 1 \<longleftrightarrow> m = 1 \<and> n = 1"
 proof -
   from assms have "m * n = 1 \<Longrightarrow> m = 1"
     by (auto dest: pos_zmult_eq_1_iff_lemma)
   then show ?thesis
     by (auto dest: pos_zmult_eq_1_iff_lemma)
 qed
 
 lemma zmult_eq_1_iff: "m * n = 1 \<longleftrightarrow> (m = 1 \<and> n = 1) \<or> (m = - 1 \<and> n = - 1)" (is "?L = ?R")
   for m n :: int
 proof
   assume L: ?L show ?R
     using pos_zmult_eq_1_iff_lemma [OF L] L by force
 qed auto
 
 lemma infinite_UNIV_int [simp]: "\<not> finite (UNIV::int set)"
 proof
   assume "finite (UNIV::int set)"
   moreover have "inj (\<lambda>i::int. 2 * i)"
     by (rule injI) simp
   ultimately have "surj (\<lambda>i::int. 2 * i)"
     by (rule finite_UNIV_inj_surj)
   then obtain i :: int where "1 = 2 * i" by (rule surjE)
   then show False by (simp add: pos_zmult_eq_1_iff)
 qed
 
 
 subsection \<open>The divides relation\<close>
 
 lemma zdvd_antisym_nonneg: "0 \<le> m \<Longrightarrow> 0 \<le> n \<Longrightarrow> m dvd n \<Longrightarrow> n dvd m \<Longrightarrow> m = n"
   for m n :: int
   by (auto simp add: dvd_def mult.assoc zero_le_mult_iff zmult_eq_1_iff)
 
 lemma zdvd_antisym_abs:
   fixes a b :: int
   assumes "a dvd b" and "b dvd a"
   shows "\<bar>a\<bar> = \<bar>b\<bar>"
 proof (cases "a = 0")
   case True
   with assms show ?thesis by simp
 next
   case False
   from \<open>a dvd b\<close> obtain k where k: "b = a * k"
     unfolding dvd_def by blast
   from \<open>b dvd a\<close> obtain k' where k': "a = b * k'"
     unfolding dvd_def by blast
   from k k' have "a = a * k * k'" by simp
   with mult_cancel_left1[where c="a" and b="k*k'"] have kk': "k * k' = 1"
     using \<open>a \<noteq> 0\<close> by (simp add: mult.assoc)
   then have "k = 1 \<and> k' = 1 \<or> k = -1 \<and> k' = -1"
     by (simp add: zmult_eq_1_iff)
   with k k' show ?thesis by auto
 qed
 
 lemma zdvd_zdiffD: "k dvd m - n \<Longrightarrow> k dvd n \<Longrightarrow> k dvd m"
   for k m n :: int
   using dvd_add_right_iff [of k "- n" m] by simp
 
 lemma zdvd_reduce: "k dvd n + k * m \<longleftrightarrow> k dvd n"
   for k m n :: int
   using dvd_add_times_triv_right_iff [of k n m] by (simp add: ac_simps)
 
 lemma dvd_imp_le_int:
   fixes d i :: int
   assumes "i \<noteq> 0" and "d dvd i"
   shows "\<bar>d\<bar> \<le> \<bar>i\<bar>"
 proof -
   from \<open>d dvd i\<close> obtain k where "i = d * k" ..
   with \<open>i \<noteq> 0\<close> have "k \<noteq> 0" by auto
   then have "1 \<le> \<bar>k\<bar>" and "0 \<le> \<bar>d\<bar>" by auto
   then have "\<bar>d\<bar> * 1 \<le> \<bar>d\<bar> * \<bar>k\<bar>" by (rule mult_left_mono)
   with \<open>i = d * k\<close> show ?thesis by (simp add: abs_mult)
 qed
 
 lemma zdvd_not_zless:
   fixes m n :: int
   assumes "0 < m" and "m < n"
   shows "\<not> n dvd m"
 proof
   from assms have "0 < n" by auto
   assume "n dvd m" then obtain k where k: "m = n * k" ..
   with \<open>0 < m\<close> have "0 < n * k" by auto
   with \<open>0 < n\<close> have "0 < k" by (simp add: zero_less_mult_iff)
   with k \<open>0 < n\<close> \<open>m < n\<close> have "n * k < n * 1" by simp
   with \<open>0 < n\<close> \<open>0 < k\<close> show False unfolding mult_less_cancel_left by auto
 qed
 
 lemma zdvd_mult_cancel:
   fixes k m n :: int
   assumes d: "k * m dvd k * n"
     and "k \<noteq> 0"
   shows "m dvd n"
 proof -
   from d obtain h where h: "k * n = k * m * h"
     unfolding dvd_def by blast
   have "n = m * h"
   proof (rule ccontr)
     assume "\<not> ?thesis"
     with \<open>k \<noteq> 0\<close> have "k * n \<noteq> k * (m * h)" by simp
     with h show False
       by (simp add: mult.assoc)
   qed
   then show ?thesis by simp
 qed
 
 lemma int_dvd_int_iff [simp]:
   "int m dvd int n \<longleftrightarrow> m dvd n"
 proof -
   have "m dvd n" if "int n = int m * k" for k
   proof (cases k)
     case (nonneg q)
     with that have "n = m * q"
       by (simp del: of_nat_mult add: of_nat_mult [symmetric])
     then show ?thesis ..
   next
     case (neg q)
     with that have "int n = int m * (- int (Suc q))"
       by simp
     also have "\<dots> = - (int m * int (Suc q))"
       by (simp only: mult_minus_right)
     also have "\<dots> = - int (m * Suc q)"
       by (simp only: of_nat_mult [symmetric])
     finally have "- int (m * Suc q) = int n" ..
     then show ?thesis
       by (simp only: negative_eq_positive) auto
   qed
   then show ?thesis by (auto simp add: dvd_def)
 qed
 
 lemma dvd_nat_abs_iff [simp]:
   "n dvd nat \<bar>k\<bar> \<longleftrightarrow> int n dvd k"
 proof -
   have "n dvd nat \<bar>k\<bar> \<longleftrightarrow> int n dvd int (nat \<bar>k\<bar>)"
     by (simp only: int_dvd_int_iff)
   then show ?thesis
     by simp
 qed
 
 lemma nat_abs_dvd_iff [simp]:
   "nat \<bar>k\<bar> dvd n \<longleftrightarrow> k dvd int n"
 proof -
   have "nat \<bar>k\<bar> dvd n \<longleftrightarrow> int (nat \<bar>k\<bar>) dvd int n"
     by (simp only: int_dvd_int_iff)
   then show ?thesis
     by simp
 qed
 
 lemma zdvd1_eq [simp]: "x dvd 1 \<longleftrightarrow> \<bar>x\<bar> = 1" (is "?lhs \<longleftrightarrow> ?rhs")
   for x :: int
 proof
   assume ?lhs
   then have "nat \<bar>x\<bar> dvd nat \<bar>1\<bar>"
     by (simp only: nat_abs_dvd_iff) simp
   then have "nat \<bar>x\<bar> = 1"
     by simp
   then show ?rhs
     by (cases "x < 0") simp_all
 next
   assume ?rhs
   then have "x = 1 \<or> x = - 1"
     by auto
   then show ?lhs
     by (auto intro: dvdI)
 qed
 
 lemma zdvd_mult_cancel1:
   fixes m :: int
   assumes mp: "m \<noteq> 0"
   shows "m * n dvd m \<longleftrightarrow> \<bar>n\<bar> = 1"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?rhs
   then show ?lhs
     by (cases "n > 0") (auto simp add: minus_equation_iff)
 next
   assume ?lhs
   then have "m * n dvd m * 1" by simp
   from zdvd_mult_cancel[OF this mp] show ?rhs
     by (simp only: zdvd1_eq)
 qed
 
 lemma nat_dvd_iff: "nat z dvd m \<longleftrightarrow> (if 0 \<le> z then z dvd int m else m = 0)"
   using nat_abs_dvd_iff [of z m] by (cases "z \<ge> 0") auto
 
 lemma eq_nat_nat_iff: "0 \<le> z \<Longrightarrow> 0 \<le> z' \<Longrightarrow> nat z = nat z' \<longleftrightarrow> z = z'"
   by (auto elim: nonneg_int_cases)
 
 lemma nat_power_eq: "0 \<le> z \<Longrightarrow> nat (z ^ n) = nat z ^ n"
   by (induct n) (simp_all add: nat_mult_distrib)
 
 lemma numeral_power_eq_nat_cancel_iff [simp]:
   "numeral x ^ n = nat y \<longleftrightarrow> numeral x ^ n = y"
   using nat_eq_iff2 by auto
 
 lemma nat_eq_numeral_power_cancel_iff [simp]:
   "nat y = numeral x ^ n \<longleftrightarrow> y = numeral x ^ n"
   using numeral_power_eq_nat_cancel_iff[of x n y]
   by (metis (mono_tags))
 
 lemma numeral_power_le_nat_cancel_iff [simp]:
   "numeral x ^ n \<le> nat a \<longleftrightarrow> numeral x ^ n \<le> a"
   using nat_le_eq_zle[of "numeral x ^ n" a]
   by (auto simp: nat_power_eq)
 
 lemma nat_le_numeral_power_cancel_iff [simp]:
   "nat a \<le> numeral x ^ n \<longleftrightarrow> a \<le> numeral x ^ n"
   by (simp add: nat_le_iff)
 
 lemma numeral_power_less_nat_cancel_iff [simp]:
   "numeral x ^ n < nat a \<longleftrightarrow> numeral x ^ n < a"
   using nat_less_eq_zless[of "numeral x ^ n" a]
   by (auto simp: nat_power_eq)
 
 lemma nat_less_numeral_power_cancel_iff [simp]:
   "nat a < numeral x ^ n \<longleftrightarrow> a < numeral x ^ n"
   using nat_less_eq_zless[of a "numeral x ^ n"]
   by (cases "a < 0") (auto simp: nat_power_eq less_le_trans[where y=0])
 
 lemma zdvd_imp_le: "z \<le> n" if "z dvd n" "0 < n" for n z :: int
 proof (cases n)
   case (nonneg n)
   show ?thesis
     by (cases z) (use nonneg dvd_imp_le that in auto)
 qed (use that in auto)
 
 lemma zdvd_period:
   fixes a d :: int
   assumes "a dvd d"
   shows "a dvd (x + t) \<longleftrightarrow> a dvd ((x + c * d) + t)"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof -
   from assms have "a dvd (x + t) \<longleftrightarrow> a dvd ((x + t) + c * d)"
     by (simp add: dvd_add_left_iff)
   then show ?thesis
     by (simp add: ac_simps)
 qed
 
 
 subsection \<open>Powers with integer exponents\<close>
 
 text \<open>
   The following allows writing powers with an integer exponent. While the type signature
   is very generic, most theorems will assume that the underlying type is a division ring or
   a field.
 
   The notation `powi' is inspired by the `powr' notation for real/complex exponentiation.
 \<close>
 definition power_int :: "'a :: {inverse, power} \<Rightarrow> int \<Rightarrow> 'a" (infixr "powi" 80) where
   "power_int x n = (if n \<ge> 0 then x ^ nat n else inverse x ^ (nat (-n)))"
 
 lemma power_int_0_right [simp]: "power_int x 0 = 1"
   and power_int_1_right [simp]:
         "power_int (y :: 'a :: {power, inverse, monoid_mult}) 1 = y"
   and power_int_minus1_right [simp]:
         "power_int (y :: 'a :: {power, inverse, monoid_mult}) (-1) = inverse y"
   by (simp_all add: power_int_def)
 
 lemma power_int_of_nat [simp]: "power_int x (int n) = x ^ n"
   by (simp add: power_int_def)
 
 lemma power_int_numeral [simp]: "power_int x (numeral n) = x ^ numeral n"
   by (simp add: power_int_def)
 
 lemma int_cases4 [case_names nonneg neg]:
   fixes m :: int
   obtains n where "m = int n" | n where "n > 0" "m = -int n"
 proof (cases "m \<ge> 0")
   case True
   thus ?thesis using that(1)[of "nat m"] by auto
 next
   case False
   thus ?thesis using that(2)[of "nat (-m)"] by auto
 qed
 
 
 context
   assumes "SORT_CONSTRAINT('a::division_ring)"
 begin
 
 lemma power_int_minus: "power_int (x::'a) (-n) = inverse (power_int x n)"
   by (auto simp: power_int_def power_inverse)
 
 lemma power_int_eq_0_iff [simp]: "power_int (x::'a) n = 0 \<longleftrightarrow> x = 0 \<and> n \<noteq> 0"
   by (auto simp: power_int_def)
 
 lemma power_int_0_left_If: "power_int (0 :: 'a) m = (if m = 0 then 1 else 0)"
   by (auto simp: power_int_def)
 
 lemma power_int_0_left [simp]: "m \<noteq> 0 \<Longrightarrow> power_int (0 :: 'a) m = 0"
   by (simp add: power_int_0_left_If)
 
 lemma power_int_1_left [simp]: "power_int 1 n = (1 :: 'a :: division_ring)"
   by (auto simp: power_int_def) 
 
 lemma power_diff_conv_inverse: "x \<noteq> 0 \<Longrightarrow> m \<le> n \<Longrightarrow> (x :: 'a) ^ (n - m) = x ^ n * inverse x ^ m"
   by (simp add: field_simps flip: power_add)
 
 lemma power_mult_inverse_distrib: "x ^ m * inverse (x :: 'a) = inverse x * x ^ m"
 proof (cases "x = 0")
   case [simp]: False
   show ?thesis
   proof (cases m)
     case (Suc m')
     have "x ^ Suc m' * inverse x = x ^ m'"
       by (subst power_Suc2) (auto simp: mult.assoc)
     also have "\<dots> = inverse x * x ^ Suc m'"
       by (subst power_Suc) (auto simp: mult.assoc [symmetric])
     finally show ?thesis using Suc by simp
   qed auto
 qed auto
 
 lemma power_mult_power_inverse_commute:
   "x ^ m * inverse (x :: 'a) ^ n = inverse x ^ n * x ^ m"
 proof (induction n)
   case (Suc n)
   have "x ^ m * inverse x ^ Suc n = (x ^ m * inverse x ^ n) * inverse x"
     by (simp only: power_Suc2 mult.assoc)
   also have "x ^ m * inverse x ^ n = inverse x ^ n * x ^ m"
     by (rule Suc)
   also have "\<dots> * inverse x = (inverse x ^ n * inverse x) * x ^ m"
     by (simp add: mult.assoc power_mult_inverse_distrib)
   also have "\<dots> = inverse x ^ (Suc n) * x ^ m"
     by (simp only: power_Suc2)
   finally show ?case .
 qed auto
 
 lemma power_int_add:
   assumes "x \<noteq> 0 \<or> m + n \<noteq> 0"
   shows   "power_int (x::'a) (m + n) = power_int x m * power_int x n"
 proof (cases "x = 0")
   case True
   thus ?thesis using assms by (auto simp: power_int_0_left_If)
 next
   case [simp]: False
   show ?thesis
   proof (cases m n rule: int_cases4[case_product int_cases4])
     case (nonneg_nonneg a b)
     thus ?thesis
       by (auto simp: power_int_def nat_add_distrib power_add)
   next
     case (nonneg_neg a b)
     thus ?thesis
       by (auto simp: power_int_def nat_diff_distrib not_le power_diff_conv_inverse
                      power_mult_power_inverse_commute)
   next
     case (neg_nonneg a b)
     thus ?thesis
       by (auto simp: power_int_def nat_diff_distrib not_le power_diff_conv_inverse
                      power_mult_power_inverse_commute)    
   next
     case (neg_neg a b)
     thus ?thesis
       by (auto simp: power_int_def nat_add_distrib add.commute simp flip: power_add)
   qed
 qed
 
 lemma power_int_add_1:
   assumes "x \<noteq> 0 \<or> m \<noteq> -1"
   shows   "power_int (x::'a) (m + 1) = power_int x m * x"
   using assms by (subst power_int_add) auto
 
 lemma power_int_add_1':
   assumes "x \<noteq> 0 \<or> m \<noteq> -1"
   shows   "power_int (x::'a) (m + 1) = x * power_int x m"
   using assms by (subst add.commute, subst power_int_add) auto
 
 lemma power_int_commutes: "power_int (x :: 'a) n * x = x * power_int x n"
   by (cases "x = 0") (auto simp flip: power_int_add_1 power_int_add_1')
 
 lemma power_int_inverse [field_simps, field_split_simps, divide_simps]:
   "power_int (inverse (x :: 'a)) n = inverse (power_int x n)"
   by (auto simp: power_int_def power_inverse)
 
 lemma power_int_mult: "power_int (x :: 'a) (m * n) = power_int (power_int x m) n"
   by (auto simp: power_int_def zero_le_mult_iff simp flip: power_mult power_inverse nat_mult_distrib)
 
 end
 
 context
   assumes "SORT_CONSTRAINT('a::field)"
 begin
 
 lemma power_int_diff:
   assumes "x \<noteq> 0 \<or> m \<noteq> n"
   shows   "power_int (x::'a) (m - n) = power_int x m / power_int x n"
   using power_int_add[of x m "-n"] assms by (auto simp: field_simps power_int_minus)
 
 lemma power_int_minus_mult: "x \<noteq> 0 \<or> n \<noteq> 0 \<Longrightarrow> power_int (x :: 'a) (n - 1) * x = power_int x n"
   by (auto simp flip: power_int_add_1)  
 
 lemma power_int_mult_distrib: "power_int (x * y :: 'a) m = power_int x m * power_int y m"
   by (auto simp: power_int_def power_mult_distrib)
 
 lemmas power_int_mult_distrib_numeral1 = power_int_mult_distrib [where x = "numeral w" for w, simp]
 lemmas power_int_mult_distrib_numeral2 = power_int_mult_distrib [where y = "numeral w" for w, simp]
 
 lemma power_int_divide_distrib: "power_int (x / y :: 'a) m = power_int x m / power_int y m"
   using power_int_mult_distrib[of x "inverse y" m] unfolding power_int_inverse
   by (simp add: field_simps)
 
 end
 
 
 lemma power_int_add_numeral [simp]:
   "power_int x (numeral m) * power_int x (numeral n) = power_int x (numeral (m + n))"
   for x :: "'a :: division_ring"
   by (simp add: power_int_add [symmetric])
 
 lemma power_int_add_numeral2 [simp]:
   "power_int x (numeral m) * (power_int x (numeral n) * b) = power_int x (numeral (m + n)) * b"
   for x :: "'a :: division_ring"
   by (simp add: mult.assoc [symmetric])
 
 lemma power_int_mult_numeral [simp]:
   "power_int (power_int x (numeral m)) (numeral n) = power_int x (numeral (m * n))"
   for x :: "'a :: division_ring"
   by (simp only: numeral_mult power_int_mult)
   
 lemma power_int_not_zero: "(x :: 'a :: division_ring) \<noteq> 0 \<or> n = 0 \<Longrightarrow> power_int x n \<noteq> 0"
   by (subst power_int_eq_0_iff) auto
 
 lemma power_int_one_over [field_simps, field_split_simps, divide_simps]:
   "power_int (1 / x :: 'a :: division_ring) n = 1 / power_int x n"
   using power_int_inverse[of x] by (simp add: divide_inverse)
 
 
 context
   assumes "SORT_CONSTRAINT('a :: linordered_field)"
 begin
 
 lemma power_int_numeral_neg_numeral [simp]:
   "power_int (numeral m) (-numeral n) = (inverse (numeral (Num.pow m n)) :: 'a)"
   by (simp add: power_int_minus)
 
 lemma zero_less_power_int [simp]: "0 < (x :: 'a) \<Longrightarrow> 0 < power_int x n"
   by (auto simp: power_int_def)
 
 lemma zero_le_power_int [simp]: "0 \<le> (x :: 'a) \<Longrightarrow> 0 \<le> power_int x n"
   by (auto simp: power_int_def)
 
 lemma power_int_mono: "(x :: 'a) \<le> y \<Longrightarrow> n \<ge> 0 \<Longrightarrow> 0 \<le> x \<Longrightarrow> power_int x n \<le> power_int y n"
   by (cases n rule: int_cases4) (auto intro: power_mono)
 
 lemma one_le_power_int [simp]: "1 \<le> (x :: 'a) \<Longrightarrow> n \<ge> 0 \<Longrightarrow> 1 \<le> power_int x n"
   using power_int_mono [of 1 x n] by simp
 
 lemma power_int_le_one: "0 \<le> (x :: 'a) \<Longrightarrow> n \<ge> 0 \<Longrightarrow> x \<le> 1 \<Longrightarrow> power_int x n \<le> 1"
   using power_int_mono [of x 1 n] by simp
 
 lemma power_int_le_imp_le_exp:
   assumes gt1: "1 < (x :: 'a :: linordered_field)"
   assumes "power_int x m \<le> power_int x n" "n \<ge> 0"
   shows   "m \<le> n"
 proof (cases "m < 0")
   case True
   with \<open>n \<ge> 0\<close> show ?thesis by simp
 next
   case False
   with assms have "x ^ nat m \<le> x ^ nat n"
     by (simp add: power_int_def)
   from gt1 and this show ?thesis
     using False \<open>n \<ge> 0\<close> by auto
 qed
 
 lemma power_int_le_imp_less_exp:
   assumes gt1: "1 < (x :: 'a :: linordered_field)"
   assumes "power_int x m < power_int x n" "n \<ge> 0"
   shows   "m < n"
 proof (cases "m < 0")
   case True
   with \<open>n \<ge> 0\<close> show ?thesis by simp
 next
   case False
   with assms have "x ^ nat m < x ^ nat n"
     by (simp add: power_int_def)
   from gt1 and this show ?thesis
     using False \<open>n \<ge> 0\<close> by auto
 qed
 
 lemma power_int_strict_mono:
   "(a :: 'a :: linordered_field) < b \<Longrightarrow> 0 \<le> a \<Longrightarrow> 0 < n \<Longrightarrow> power_int a n < power_int b n"
   by (auto simp: power_int_def intro!: power_strict_mono)
 
 lemma power_int_mono_iff [simp]:
   fixes a b :: "'a :: linordered_field"
   shows "\<lbrakk>a \<ge> 0; b \<ge> 0; n > 0\<rbrakk> \<Longrightarrow> power_int a n \<le> power_int b n \<longleftrightarrow> a \<le> b"
   by (auto simp: power_int_def intro!: power_strict_mono)
 
 lemma power_int_strict_increasing:
   fixes a :: "'a :: linordered_field"
   assumes "n < N" "1 < a"
   shows   "power_int a N > power_int a n"
 proof -
   have *: "a ^ nat (N - n) > a ^ 0"
     using assms by (intro power_strict_increasing) auto
   have "power_int a N = power_int a n * power_int a (N - n)"
     using assms by (simp flip: power_int_add)
   also have "\<dots> > power_int a n * 1"
     using assms *
     by (intro mult_strict_left_mono zero_less_power_int) (auto simp: power_int_def)
   finally show ?thesis by simp
 qed
 
 lemma power_int_increasing:
   fixes a :: "'a :: linordered_field"
   assumes "n \<le> N" "a \<ge> 1"
   shows   "power_int a N \<ge> power_int a n"
 proof -
   have *: "a ^ nat (N - n) \<ge> a ^ 0"
     using assms by (intro power_increasing) auto
   have "power_int a N = power_int a n * power_int a (N - n)"
     using assms by (simp flip: power_int_add)
   also have "\<dots> \<ge> power_int a n * 1"
     using assms * by (intro mult_left_mono) (auto simp: power_int_def)
   finally show ?thesis by simp
 qed
 
 lemma power_int_strict_decreasing:
   fixes a :: "'a :: linordered_field"
   assumes "n < N" "0 < a" "a < 1"
   shows   "power_int a N < power_int a n"
 proof -
   have *: "a ^ nat (N - n) < a ^ 0"
     using assms by (intro power_strict_decreasing) auto
   have "power_int a N = power_int a n * power_int a (N - n)"
     using assms by (simp flip: power_int_add)
   also have "\<dots> < power_int a n * 1"
     using assms *
     by (intro mult_strict_left_mono zero_less_power_int) (auto simp: power_int_def)
   finally show ?thesis by simp
 qed
 
 lemma power_int_decreasing:
   fixes a :: "'a :: linordered_field"
   assumes "n \<le> N" "0 \<le> a" "a \<le> 1" "a \<noteq> 0 \<or> N \<noteq> 0 \<or> n = 0"
   shows   "power_int a N \<le> power_int a n"
 proof (cases "a = 0")
   case False
   have *: "a ^ nat (N - n) \<le> a ^ 0"
     using assms by (intro power_decreasing) auto
   have "power_int a N = power_int a n * power_int a (N - n)"
     using assms False by (simp flip: power_int_add)
   also have "\<dots> \<le> power_int a n * 1"
     using assms * by (intro mult_left_mono) (auto simp: power_int_def)
   finally show ?thesis by simp
 qed (use assms in \<open>auto simp: power_int_0_left_If\<close>)
 
 lemma one_less_power_int: "1 < (a :: 'a) \<Longrightarrow> 0 < n \<Longrightarrow> 1 < power_int a n"
   using power_int_strict_increasing[of 0 n a] by simp
 
 lemma power_int_abs: "\<bar>power_int a n :: 'a\<bar> = power_int \<bar>a\<bar> n"
   by (auto simp: power_int_def power_abs)
 
 lemma power_int_sgn [simp]: "sgn (power_int a n :: 'a) = power_int (sgn a) n"
   by (auto simp: power_int_def)
 
 lemma abs_power_int_minus [simp]: "\<bar>power_int (- a) n :: 'a\<bar> = \<bar>power_int a n\<bar>"
   by (simp add: power_int_abs)
 
 lemma power_int_strict_antimono:
   assumes "(a :: 'a :: linordered_field) < b" "0 < a" "n < 0"
   shows   "power_int a n > power_int b n"
 proof -
   have "inverse (power_int a (-n)) > inverse (power_int b (-n))"
     using assms by (intro less_imp_inverse_less power_int_strict_mono zero_less_power_int) auto
   thus ?thesis by (simp add: power_int_minus)
 qed
 
 lemma power_int_antimono:
   assumes "(a :: 'a :: linordered_field) \<le> b" "0 < a" "n < 0"
   shows   "power_int a n \<ge> power_int b n"
   using power_int_strict_antimono[of a b n] assms by (cases "a = b") auto
 
 end
 
 
 subsection \<open>Finiteness of intervals\<close>
 
 lemma finite_interval_int1 [iff]: "finite {i :: int. a \<le> i \<and> i \<le> b}"
 proof (cases "a \<le> b")
   case True
   then show ?thesis
   proof (induct b rule: int_ge_induct)
     case base
     have "{i. a \<le> i \<and> i \<le> a} = {a}" by auto
     then show ?case by simp
   next
     case (step b)
     then have "{i. a \<le> i \<and> i \<le> b + 1} = {i. a \<le> i \<and> i \<le> b} \<union> {b + 1}" by auto
     with step show ?case by simp
   qed
 next
   case False
   then show ?thesis
     by (metis (lifting, no_types) Collect_empty_eq finite.emptyI order_trans)
 qed
 
 lemma finite_interval_int2 [iff]: "finite {i :: int. a \<le> i \<and> i < b}"
   by (rule rev_finite_subset[OF finite_interval_int1[of "a" "b"]]) auto
 
 lemma finite_interval_int3 [iff]: "finite {i :: int. a < i \<and> i \<le> b}"
   by (rule rev_finite_subset[OF finite_interval_int1[of "a" "b"]]) auto
 
 lemma finite_interval_int4 [iff]: "finite {i :: int. a < i \<and> i < b}"
   by (rule rev_finite_subset[OF finite_interval_int1[of "a" "b"]]) auto
 
 
 subsection \<open>Configuration of the code generator\<close>
 
 text \<open>Constructors\<close>
 
 definition Pos :: "num \<Rightarrow> int"
   where [simp, code_abbrev]: "Pos = numeral"
 
 definition Neg :: "num \<Rightarrow> int"
   where [simp, code_abbrev]: "Neg n = - (Pos n)"
 
 code_datatype "0::int" Pos Neg
 
 
 text \<open>Auxiliary operations.\<close>
 
 definition dup :: "int \<Rightarrow> int"
   where [simp]: "dup k = k + k"
 
 lemma dup_code [code]:
   "dup 0 = 0"
   "dup (Pos n) = Pos (Num.Bit0 n)"
   "dup (Neg n) = Neg (Num.Bit0 n)"
   by (simp_all add: numeral_Bit0)
 
 definition sub :: "num \<Rightarrow> num \<Rightarrow> int"
   where [simp]: "sub m n = numeral m - numeral n"
 
 lemma sub_code [code]:
   "sub Num.One Num.One = 0"
   "sub (Num.Bit0 m) Num.One = Pos (Num.BitM m)"
   "sub (Num.Bit1 m) Num.One = Pos (Num.Bit0 m)"
   "sub Num.One (Num.Bit0 n) = Neg (Num.BitM n)"
   "sub Num.One (Num.Bit1 n) = Neg (Num.Bit0 n)"
   "sub (Num.Bit0 m) (Num.Bit0 n) = dup (sub m n)"
   "sub (Num.Bit1 m) (Num.Bit1 n) = dup (sub m n)"
   "sub (Num.Bit1 m) (Num.Bit0 n) = dup (sub m n) + 1"
   "sub (Num.Bit0 m) (Num.Bit1 n) = dup (sub m n) - 1"
   by (simp_all only: sub_def dup_def numeral.simps Pos_def Neg_def numeral_BitM)
 
 lemma sub_BitM_One_eq:
   \<open>(Num.sub (Num.BitM n) num.One) = 2 * (Num.sub n Num.One :: int)\<close>
   by (cases n) simp_all
 
 text \<open>Implementations.\<close>
 
 lemma one_int_code [code]: "1 = Pos Num.One"
   by simp
 
 lemma plus_int_code [code]:
   "k + 0 = k"
   "0 + l = l"
   "Pos m + Pos n = Pos (m + n)"
   "Pos m + Neg n = sub m n"
   "Neg m + Pos n = sub n m"
   "Neg m + Neg n = Neg (m + n)"
   for k l :: int
   by simp_all
 
 lemma uminus_int_code [code]:
   "uminus 0 = (0::int)"
   "uminus (Pos m) = Neg m"
   "uminus (Neg m) = Pos m"
   by simp_all
 
 lemma minus_int_code [code]:
   "k - 0 = k"
   "0 - l = uminus l"
   "Pos m - Pos n = sub m n"
   "Pos m - Neg n = Pos (m + n)"
   "Neg m - Pos n = Neg (m + n)"
   "Neg m - Neg n = sub n m"
   for k l :: int
   by simp_all
 
 lemma times_int_code [code]:
   "k * 0 = 0"
   "0 * l = 0"
   "Pos m * Pos n = Pos (m * n)"
   "Pos m * Neg n = Neg (m * n)"
   "Neg m * Pos n = Neg (m * n)"
   "Neg m * Neg n = Pos (m * n)"
   for k l :: int
   by simp_all
 
 instantiation int :: equal
 begin
 
 definition "HOL.equal k l \<longleftrightarrow> k = (l::int)"
 
 instance
   by standard (rule equal_int_def)
 
 end
 
 lemma equal_int_code [code]:
   "HOL.equal 0 (0::int) \<longleftrightarrow> True"
   "HOL.equal 0 (Pos l) \<longleftrightarrow> False"
   "HOL.equal 0 (Neg l) \<longleftrightarrow> False"
   "HOL.equal (Pos k) 0 \<longleftrightarrow> False"
   "HOL.equal (Pos k) (Pos l) \<longleftrightarrow> HOL.equal k l"
   "HOL.equal (Pos k) (Neg l) \<longleftrightarrow> False"
   "HOL.equal (Neg k) 0 \<longleftrightarrow> False"
   "HOL.equal (Neg k) (Pos l) \<longleftrightarrow> False"
   "HOL.equal (Neg k) (Neg l) \<longleftrightarrow> HOL.equal k l"
   by (auto simp add: equal)
 
 lemma equal_int_refl [code nbe]: "HOL.equal k k \<longleftrightarrow> True"
   for k :: int
   by (fact equal_refl)
 
 lemma less_eq_int_code [code]:
   "0 \<le> (0::int) \<longleftrightarrow> True"
   "0 \<le> Pos l \<longleftrightarrow> True"
   "0 \<le> Neg l \<longleftrightarrow> False"
   "Pos k \<le> 0 \<longleftrightarrow> False"
   "Pos k \<le> Pos l \<longleftrightarrow> k \<le> l"
   "Pos k \<le> Neg l \<longleftrightarrow> False"
   "Neg k \<le> 0 \<longleftrightarrow> True"
   "Neg k \<le> Pos l \<longleftrightarrow> True"
   "Neg k \<le> Neg l \<longleftrightarrow> l \<le> k"
   by simp_all
 
 lemma less_int_code [code]:
   "0 < (0::int) \<longleftrightarrow> False"
   "0 < Pos l \<longleftrightarrow> True"
   "0 < Neg l \<longleftrightarrow> False"
   "Pos k < 0 \<longleftrightarrow> False"
   "Pos k < Pos l \<longleftrightarrow> k < l"
   "Pos k < Neg l \<longleftrightarrow> False"
   "Neg k < 0 \<longleftrightarrow> True"
   "Neg k < Pos l \<longleftrightarrow> True"
   "Neg k < Neg l \<longleftrightarrow> l < k"
   by simp_all
 
 lemma nat_code [code]:
   "nat (Int.Neg k) = 0"
   "nat 0 = 0"
   "nat (Int.Pos k) = nat_of_num k"
   by (simp_all add: nat_of_num_numeral)
 
 lemma (in ring_1) of_int_code [code]:
   "of_int (Int.Neg k) = - numeral k"
   "of_int 0 = 0"
   "of_int (Int.Pos k) = numeral k"
   by simp_all
 
 
 text \<open>Serializer setup.\<close>
 
 code_identifier
   code_module Int \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith
 
 quickcheck_params [default_type = int]
 
 hide_const (open) Pos Neg sub dup
 
 
 text \<open>De-register \<open>int\<close> as a quotient type:\<close>
 
 lifting_update int.lifting
 lifting_forget int.lifting
 
 
 subsection \<open>Duplicates\<close>
 
 lemmas int_sum = of_nat_sum [where 'a=int]
 lemmas int_prod = of_nat_prod [where 'a=int]
 lemmas zle_int = of_nat_le_iff [where 'a=int]
 lemmas int_int_eq = of_nat_eq_iff [where 'a=int]
 lemmas nonneg_eq_int = nonneg_int_cases
 lemmas double_eq_0_iff = double_zero
 
 lemmas int_distrib =
   distrib_right [of z1 z2 w]
   distrib_left [of w z1 z2]
   left_diff_distrib [of z1 z2 w]
   right_diff_distrib [of w z1 z2]
   for z1 z2 w :: int
 
 end
 
diff --git a/src/HOL/Library/Numeral_Type.thy b/src/HOL/Library/Numeral_Type.thy
--- a/src/HOL/Library/Numeral_Type.thy
+++ b/src/HOL/Library/Numeral_Type.thy
@@ -1,579 +1,604 @@
 (*  Title:      HOL/Library/Numeral_Type.thy
     Author:     Brian Huffman
 *)
 
 section \<open>Numeral Syntax for Types\<close>
 
 theory Numeral_Type
 imports Cardinality
 begin
 
 subsection \<open>Numeral Types\<close>
 
 typedef num0 = "UNIV :: nat set" ..
 typedef num1 = "UNIV :: unit set" ..
 
 typedef 'a bit0 = "{0 ..< 2 * int CARD('a::finite)}"
 proof
   show "0 \<in> {0 ..< 2 * int CARD('a)}"
     by simp
 qed
 
 typedef 'a bit1 = "{0 ..< 1 + 2 * int CARD('a::finite)}"
 proof
   show "0 \<in> {0 ..< 1 + 2 * int CARD('a)}"
     by simp
 qed
 
 lemma card_num0 [simp]: "CARD (num0) = 0"
   unfolding type_definition.card [OF type_definition_num0]
   by simp
 
 lemma infinite_num0: "\<not> finite (UNIV :: num0 set)"
   using card_num0[unfolded card_eq_0_iff]
   by simp
 
 lemma card_num1 [simp]: "CARD(num1) = 1"
   unfolding type_definition.card [OF type_definition_num1]
   by (simp only: card_UNIV_unit)
 
 lemma card_bit0 [simp]: "CARD('a bit0) = 2 * CARD('a::finite)"
   unfolding type_definition.card [OF type_definition_bit0]
   by simp
 
 lemma card_bit1 [simp]: "CARD('a bit1) = Suc (2 * CARD('a::finite))"
   unfolding type_definition.card [OF type_definition_bit1]
   by simp
 
 subsection \<open>@{typ num1}\<close>
 
 instance num1 :: finite
 proof
   show "finite (UNIV::num1 set)"
     unfolding type_definition.univ [OF type_definition_num1]
     using finite by (rule finite_imageI)
 qed
 
 instantiation num1 :: CARD_1
 begin
 
 instance
 proof
   show "CARD(num1) = 1" by auto
 qed
 
 end
 
 lemma num1_eq_iff: "(x::num1) = (y::num1) \<longleftrightarrow> True"
   by (induct x, induct y) simp
 
 instantiation num1 :: "{comm_ring,comm_monoid_mult,numeral}"
 begin
 
 instance
   by standard (simp_all add: num1_eq_iff)
 
 end
 
 lemma num1_eqI:
   fixes a::num1 shows "a = b"
 by(simp add: num1_eq_iff)
 
 lemma num1_eq1 [simp]:
   fixes a::num1 shows "a = 1"
   by (rule num1_eqI)
 
 lemma forall_1[simp]: "(\<forall>i::num1. P i) \<longleftrightarrow> P 1"
   by (metis (full_types) num1_eq_iff)
 
 lemma ex_1[simp]: "(\<exists>x::num1. P x) \<longleftrightarrow> P 1"
   by auto (metis (full_types) num1_eq_iff)
 
 instantiation num1 :: linorder begin
 definition "a < b \<longleftrightarrow> Rep_num1 a < Rep_num1 b"
 definition "a \<le> b \<longleftrightarrow> Rep_num1 a \<le> Rep_num1 b"
 instance
   by intro_classes (auto simp: less_eq_num1_def less_num1_def intro: num1_eqI)
 end
 
 instance num1 :: wellorder
   by intro_classes (auto simp: less_eq_num1_def less_num1_def)
 
 
 instance bit0 :: (finite) card2
 proof
   show "finite (UNIV::'a bit0 set)"
     unfolding type_definition.univ [OF type_definition_bit0]
     by simp
   show "2 \<le> CARD('a bit0)"
     by simp
 qed
 
 instance bit1 :: (finite) card2
 proof
   show "finite (UNIV::'a bit1 set)"
     unfolding type_definition.univ [OF type_definition_bit1]
     by simp
   show "2 \<le> CARD('a bit1)"
     by simp
 qed
 
 subsection \<open>Locales for for modular arithmetic subtypes\<close>
 
 locale mod_type =
   fixes n :: int
   and Rep :: "'a::{zero,one,plus,times,uminus,minus} \<Rightarrow> int"
   and Abs :: "int \<Rightarrow> 'a::{zero,one,plus,times,uminus,minus}"
   assumes type: "type_definition Rep Abs {0..<n}"
   and size1: "1 < n"
   and zero_def: "0 = Abs 0"
   and one_def:  "1 = Abs 1"
   and add_def:  "x + y = Abs ((Rep x + Rep y) mod n)"
   and mult_def: "x * y = Abs ((Rep x * Rep y) mod n)"
   and diff_def: "x - y = Abs ((Rep x - Rep y) mod n)"
   and minus_def: "- x = Abs ((- Rep x) mod n)"
 begin
 
 lemma size0: "0 < n"
 using size1 by simp
 
 lemmas definitions =
   zero_def one_def add_def mult_def minus_def diff_def
 
 lemma Rep_less_n: "Rep x < n"
 by (rule type_definition.Rep [OF type, simplified, THEN conjunct2])
 
 lemma Rep_le_n: "Rep x \<le> n"
 by (rule Rep_less_n [THEN order_less_imp_le])
 
 lemma Rep_inject_sym: "x = y \<longleftrightarrow> Rep x = Rep y"
 by (rule type_definition.Rep_inject [OF type, symmetric])
 
 lemma Rep_inverse: "Abs (Rep x) = x"
 by (rule type_definition.Rep_inverse [OF type])
 
 lemma Abs_inverse: "m \<in> {0..<n} \<Longrightarrow> Rep (Abs m) = m"
 by (rule type_definition.Abs_inverse [OF type])
 
 lemma Rep_Abs_mod: "Rep (Abs (m mod n)) = m mod n"
 by (simp add: Abs_inverse pos_mod_conj [OF size0])
 
 lemma Rep_Abs_0: "Rep (Abs 0) = 0"
 by (simp add: Abs_inverse size0)
 
 lemma Rep_0: "Rep 0 = 0"
 by (simp add: zero_def Rep_Abs_0)
 
 lemma Rep_Abs_1: "Rep (Abs 1) = 1"
 by (simp add: Abs_inverse size1)
 
 lemma Rep_1: "Rep 1 = 1"
 by (simp add: one_def Rep_Abs_1)
 
 lemma Rep_mod: "Rep x mod n = Rep x"
 apply (rule_tac x=x in type_definition.Abs_cases [OF type])
 apply (simp add: type_definition.Abs_inverse [OF type])
 done
 
 lemmas Rep_simps =
   Rep_inject_sym Rep_inverse Rep_Abs_mod Rep_mod Rep_Abs_0 Rep_Abs_1
 
 lemma comm_ring_1: "OFCLASS('a, comm_ring_1_class)"
 apply (intro_classes, unfold definitions)
 apply (simp_all add: Rep_simps mod_simps field_simps)
 done
 
 end
 
 locale mod_ring = mod_type n Rep Abs
   for n :: int
   and Rep :: "'a::{comm_ring_1} \<Rightarrow> int"
   and Abs :: "int \<Rightarrow> 'a::{comm_ring_1}"
 begin
 
 lemma of_nat_eq: "of_nat k = Abs (int k mod n)"
 apply (induct k)
 apply (simp add: zero_def)
 apply (simp add: Rep_simps add_def one_def mod_simps ac_simps)
 done
 
 lemma of_int_eq: "of_int z = Abs (z mod n)"
 apply (cases z rule: int_diff_cases)
 apply (simp add: Rep_simps of_nat_eq diff_def mod_simps)
 done
 
 lemma Rep_numeral:
   "Rep (numeral w) = numeral w mod n"
 using of_int_eq [of "numeral w"]
 by (simp add: Rep_inject_sym Rep_Abs_mod)
 
 lemma iszero_numeral:
   "iszero (numeral w::'a) \<longleftrightarrow> numeral w mod n = 0"
 by (simp add: Rep_inject_sym Rep_numeral Rep_0 iszero_def)
 
 lemma cases:
   assumes 1: "\<And>z. \<lbrakk>(x::'a) = of_int z; 0 \<le> z; z < n\<rbrakk> \<Longrightarrow> P"
   shows "P"
 apply (cases x rule: type_definition.Abs_cases [OF type])
 apply (rule_tac z="y" in 1)
 apply (simp_all add: of_int_eq)
 done
 
 lemma induct:
   "(\<And>z. \<lbrakk>0 \<le> z; z < n\<rbrakk> \<Longrightarrow> P (of_int z)) \<Longrightarrow> P (x::'a)"
 by (cases x rule: cases) simp
 
+lemma UNIV_eq: "(UNIV :: 'a set) = Abs ` {0..<n}"
+  using type type_definition.univ by blast
+
+lemma CARD_eq: "CARD('a) = nat n"
+proof -
+  have "CARD('a) = card (Abs ` {0..<n})"
+    by (simp add: UNIV_eq)
+  also have "inj_on Abs {0..<n}"
+    by (metis Abs_inverse inj_onI)
+  hence "card (Abs ` {0..<n}) = nat n"
+    using size1 by (subst card_image) auto
+  finally show ?thesis .
+qed
+
+lemma CHAR_eq [simp]: "CHAR('a) = CARD('a)"
+proof (rule CHAR_eqI)
+  show "of_nat (CARD('a)) = (0 :: 'a)"
+    by (simp add: CARD_eq of_nat_eq zero_def)
+next
+  fix n assume "of_nat n = (0 :: 'a)"
+  thus "CARD('a) dvd n"
+    by (metis CARD_eq Rep_0 Rep_Abs_mod Rep_le_n mod_0_imp_dvd nat_dvd_iff of_nat_eq)
+qed
+
 end
 
 
 subsection \<open>Ring class instances\<close>
 
 text \<open>
   Unfortunately \<open>ring_1\<close> instance is not possible for
   \<^typ>\<open>num1\<close>, since 0 and 1 are not distinct.
 \<close>
 
 instantiation
   bit0 and bit1 :: (finite) "{zero,one,plus,times,uminus,minus}"
 begin
 
 definition Abs_bit0' :: "int \<Rightarrow> 'a bit0" where
   "Abs_bit0' x = Abs_bit0 (x mod int CARD('a bit0))"
 
 definition Abs_bit1' :: "int \<Rightarrow> 'a bit1" where
   "Abs_bit1' x = Abs_bit1 (x mod int CARD('a bit1))"
 
 definition "0 = Abs_bit0 0"
 definition "1 = Abs_bit0 1"
 definition "x + y = Abs_bit0' (Rep_bit0 x + Rep_bit0 y)"
 definition "x * y = Abs_bit0' (Rep_bit0 x * Rep_bit0 y)"
 definition "x - y = Abs_bit0' (Rep_bit0 x - Rep_bit0 y)"
 definition "- x = Abs_bit0' (- Rep_bit0 x)"
 
 definition "0 = Abs_bit1 0"
 definition "1 = Abs_bit1 1"
 definition "x + y = Abs_bit1' (Rep_bit1 x + Rep_bit1 y)"
 definition "x * y = Abs_bit1' (Rep_bit1 x * Rep_bit1 y)"
 definition "x - y = Abs_bit1' (Rep_bit1 x - Rep_bit1 y)"
 definition "- x = Abs_bit1' (- Rep_bit1 x)"
 
 instance ..
 
 end
 
 interpretation bit0:
   mod_type "int CARD('a::finite bit0)"
            "Rep_bit0 :: 'a::finite bit0 \<Rightarrow> int"
            "Abs_bit0 :: int \<Rightarrow> 'a::finite bit0"
 apply (rule mod_type.intro)
 apply (simp add: type_definition_bit0)
 apply (rule one_less_int_card)
 apply (rule zero_bit0_def)
 apply (rule one_bit0_def)
 apply (rule plus_bit0_def [unfolded Abs_bit0'_def])
 apply (rule times_bit0_def [unfolded Abs_bit0'_def])
 apply (rule minus_bit0_def [unfolded Abs_bit0'_def])
 apply (rule uminus_bit0_def [unfolded Abs_bit0'_def])
 done
 
 interpretation bit1:
   mod_type "int CARD('a::finite bit1)"
            "Rep_bit1 :: 'a::finite bit1 \<Rightarrow> int"
            "Abs_bit1 :: int \<Rightarrow> 'a::finite bit1"
 apply (rule mod_type.intro)
 apply (simp add: type_definition_bit1)
 apply (rule one_less_int_card)
 apply (rule zero_bit1_def)
 apply (rule one_bit1_def)
 apply (rule plus_bit1_def [unfolded Abs_bit1'_def])
 apply (rule times_bit1_def [unfolded Abs_bit1'_def])
 apply (rule minus_bit1_def [unfolded Abs_bit1'_def])
 apply (rule uminus_bit1_def [unfolded Abs_bit1'_def])
 done
 
 instance bit0 :: (finite) comm_ring_1
   by (rule bit0.comm_ring_1)
 
 instance bit1 :: (finite) comm_ring_1
   by (rule bit1.comm_ring_1)
 
 interpretation bit0:
   mod_ring "int CARD('a::finite bit0)"
            "Rep_bit0 :: 'a::finite bit0 \<Rightarrow> int"
            "Abs_bit0 :: int \<Rightarrow> 'a::finite bit0"
   ..
 
 interpretation bit1:
   mod_ring "int CARD('a::finite bit1)"
            "Rep_bit1 :: 'a::finite bit1 \<Rightarrow> int"
            "Abs_bit1 :: int \<Rightarrow> 'a::finite bit1"
   ..
 
 text \<open>Set up cases, induction, and arithmetic\<close>
 
 lemmas bit0_cases [case_names of_int, cases type: bit0] = bit0.cases
 lemmas bit1_cases [case_names of_int, cases type: bit1] = bit1.cases
 
 lemmas bit0_induct [case_names of_int, induct type: bit0] = bit0.induct
 lemmas bit1_induct [case_names of_int, induct type: bit1] = bit1.induct
 
 lemmas bit0_iszero_numeral [simp] = bit0.iszero_numeral
 lemmas bit1_iszero_numeral [simp] = bit1.iszero_numeral
 
 lemmas [simp] = eq_numeral_iff_iszero [where 'a="'a bit0"] for dummy :: "'a::finite"
 lemmas [simp] = eq_numeral_iff_iszero [where 'a="'a bit1"] for dummy :: "'a::finite"
 
 subsection \<open>Order instances\<close>
 
 instantiation bit0 and bit1 :: (finite) linorder begin
 definition "a < b \<longleftrightarrow> Rep_bit0 a < Rep_bit0 b"
 definition "a \<le> b \<longleftrightarrow> Rep_bit0 a \<le> Rep_bit0 b"
 definition "a < b \<longleftrightarrow> Rep_bit1 a < Rep_bit1 b"
 definition "a \<le> b \<longleftrightarrow> Rep_bit1 a \<le> Rep_bit1 b"
 
 instance
   by(intro_classes)
     (auto simp add: less_eq_bit0_def less_bit0_def less_eq_bit1_def less_bit1_def Rep_bit0_inject Rep_bit1_inject)
 end
 
 lemma (in preorder) tranclp_less: "(<) \<^sup>+\<^sup>+ = (<)"
 by(auto simp add: fun_eq_iff intro: less_trans elim: tranclp.induct)
 
 instance bit0 and bit1 :: (finite) wellorder
 proof -
   have "wf {(x :: 'a bit0, y). x < y}"
     by(auto simp add: trancl_def tranclp_less intro!: finite_acyclic_wf acyclicI)
   thus "OFCLASS('a bit0, wellorder_class)"
     by(rule wf_wellorderI) intro_classes
 next
   have "wf {(x :: 'a bit1, y). x < y}"
     by(auto simp add: trancl_def tranclp_less intro!: finite_acyclic_wf acyclicI)
   thus "OFCLASS('a bit1, wellorder_class)"
     by(rule wf_wellorderI) intro_classes
 qed
 
 subsection \<open>Code setup and type classes for code generation\<close>
 
 text \<open>Code setup for \<^typ>\<open>num0\<close> and \<^typ>\<open>num1\<close>\<close>
 
 definition Num0 :: num0 where "Num0 = Abs_num0 0"
 code_datatype Num0
 
 instantiation num0 :: equal begin
 definition equal_num0 :: "num0 \<Rightarrow> num0 \<Rightarrow> bool"
   where "equal_num0 = (=)"
 instance by intro_classes (simp add: equal_num0_def)
 end
 
 lemma equal_num0_code [code]:
   "equal_class.equal Num0 Num0 = True"
 by(rule equal_refl)
 
 code_datatype "1 :: num1"
 
 instantiation num1 :: equal begin
 definition equal_num1 :: "num1 \<Rightarrow> num1 \<Rightarrow> bool"
   where "equal_num1 = (=)"
 instance by intro_classes (simp add: equal_num1_def)
 end
 
 lemma equal_num1_code [code]:
   "equal_class.equal (1 :: num1) 1 = True"
 by(rule equal_refl)
 
 instantiation num1 :: enum begin
 definition "enum_class.enum = [1 :: num1]"
 definition "enum_class.enum_all P = P (1 :: num1)"
 definition "enum_class.enum_ex P = P (1 :: num1)"
 instance
   by intro_classes
      (auto simp add: enum_num1_def enum_all_num1_def enum_ex_num1_def num1_eq_iff Ball_def)
 end
 
 instantiation num0 and num1 :: card_UNIV begin
 definition "finite_UNIV = Phantom(num0) False"
 definition "card_UNIV = Phantom(num0) 0"
 definition "finite_UNIV = Phantom(num1) True"
 definition "card_UNIV = Phantom(num1) 1"
 instance
   by intro_classes
      (simp_all add: finite_UNIV_num0_def card_UNIV_num0_def infinite_num0 finite_UNIV_num1_def card_UNIV_num1_def)
 end
 
 
 text \<open>Code setup for \<^typ>\<open>'a bit0\<close> and \<^typ>\<open>'a bit1\<close>\<close>
 
 declare
   bit0.Rep_inverse[code abstype]
   bit0.Rep_0[code abstract]
   bit0.Rep_1[code abstract]
 
 lemma Abs_bit0'_code [code abstract]:
   "Rep_bit0 (Abs_bit0' x :: 'a :: finite bit0) = x mod int (CARD('a bit0))"
 by(auto simp add: Abs_bit0'_def intro!: Abs_bit0_inverse)
 
 lemma inj_on_Abs_bit0:
   "inj_on (Abs_bit0 :: int \<Rightarrow> 'a bit0) {0..<2 * int CARD('a :: finite)}"
 by(auto intro: inj_onI simp add: Abs_bit0_inject)
 
 declare
   bit1.Rep_inverse[code abstype]
   bit1.Rep_0[code abstract]
   bit1.Rep_1[code abstract]
 
 lemma Abs_bit1'_code [code abstract]:
   "Rep_bit1 (Abs_bit1' x :: 'a :: finite bit1) = x mod int (CARD('a bit1))"
   by(auto simp add: Abs_bit1'_def intro!: Abs_bit1_inverse)
 
 lemma inj_on_Abs_bit1:
   "inj_on (Abs_bit1 :: int \<Rightarrow> 'a bit1) {0..<1 + 2 * int CARD('a :: finite)}"
 by(auto intro: inj_onI simp add: Abs_bit1_inject)
 
 instantiation bit0 and bit1 :: (finite) equal begin
 
 definition "equal_class.equal x y \<longleftrightarrow> Rep_bit0 x = Rep_bit0 y"
 definition "equal_class.equal x y \<longleftrightarrow> Rep_bit1 x = Rep_bit1 y"
 
 instance
   by intro_classes (simp_all add: equal_bit0_def equal_bit1_def Rep_bit0_inject Rep_bit1_inject)
 
 end
 
 instantiation bit0 :: (finite) enum begin
 definition "(enum_class.enum :: 'a bit0 list) = map (Abs_bit0' \<circ> int) (upt 0 (CARD('a bit0)))"
 definition "enum_class.enum_all P = (\<forall>b :: 'a bit0 \<in> set enum_class.enum. P b)"
 definition "enum_class.enum_ex P = (\<exists>b :: 'a bit0 \<in> set enum_class.enum. P b)"
 
 instance proof
   show "distinct (enum_class.enum :: 'a bit0 list)"
     by (simp add: enum_bit0_def distinct_map inj_on_def Abs_bit0'_def Abs_bit0_inject)
 
   let ?Abs = "Abs_bit0 :: _ \<Rightarrow> 'a bit0"
   interpret type_definition Rep_bit0 ?Abs "{0..<2 * int CARD('a)}"
     by (fact type_definition_bit0)
   have "UNIV = ?Abs ` {0..<2 * int CARD('a)}"
     by (simp add: Abs_image)
   also have "\<dots> = ?Abs ` (int ` {0..<2 * CARD('a)})"
     by (simp add: image_int_atLeastLessThan)
   also have "\<dots> = (?Abs \<circ> int) ` {0..<2 * CARD('a)}"
     by (simp add: image_image cong: image_cong)
   also have "\<dots> = set enum_class.enum"
     by (simp add: enum_bit0_def Abs_bit0'_def cong: image_cong_simp)
   finally show univ_eq: "(UNIV :: 'a bit0 set) = set enum_class.enum" .
 
   fix P :: "'a bit0 \<Rightarrow> bool"
   show "enum_class.enum_all P = Ball UNIV P"
     and "enum_class.enum_ex P = Bex UNIV P"
     by(simp_all add: enum_all_bit0_def enum_ex_bit0_def univ_eq)
 qed
 
 end
 
 instantiation bit1 :: (finite) enum begin
 definition "(enum_class.enum :: 'a bit1 list) = map (Abs_bit1' \<circ> int) (upt 0 (CARD('a bit1)))"
 definition "enum_class.enum_all P = (\<forall>b :: 'a bit1 \<in> set enum_class.enum. P b)"
 definition "enum_class.enum_ex P = (\<exists>b :: 'a bit1 \<in> set enum_class.enum. P b)"
 
 instance
 proof(intro_classes)
   show "distinct (enum_class.enum :: 'a bit1 list)"
     by(simp only: Abs_bit1'_def zmod_int[symmetric] enum_bit1_def distinct_map Suc_eq_plus1 card_bit1 o_apply inj_on_def)
       (clarsimp simp add: Abs_bit1_inject)
 
   let ?Abs = "Abs_bit1 :: _ \<Rightarrow> 'a bit1"
   interpret type_definition Rep_bit1 ?Abs "{0..<1 + 2 * int CARD('a)}"
     by (fact type_definition_bit1)
   have "UNIV = ?Abs ` {0..<1 + 2 * int CARD('a)}"
     by (simp add: Abs_image)
   also have "\<dots> = ?Abs ` (int ` {0..<1 + 2 * CARD('a)})"
     by (simp add: image_int_atLeastLessThan)
   also have "\<dots> = (?Abs \<circ> int) ` {0..<1 + 2 * CARD('a)}"
     by (simp add: image_image cong: image_cong)
   finally show univ_eq: "(UNIV :: 'a bit1 set) = set enum_class.enum"
     by (simp only: enum_bit1_def set_map set_upt) (simp add: Abs_bit1'_def cong: image_cong_simp)
 
   fix P :: "'a bit1 \<Rightarrow> bool"
   show "enum_class.enum_all P = Ball UNIV P"
     and "enum_class.enum_ex P = Bex UNIV P"
     by(simp_all add: enum_all_bit1_def enum_ex_bit1_def univ_eq)
 qed
 
 end
 
 instantiation bit0 and bit1 :: (finite) finite_UNIV begin
 definition "finite_UNIV = Phantom('a bit0) True"
 definition "finite_UNIV = Phantom('a bit1) True"
 instance by intro_classes (simp_all add: finite_UNIV_bit0_def finite_UNIV_bit1_def)
 end
 
 instantiation bit0 and bit1 :: ("{finite,card_UNIV}") card_UNIV begin
 definition "card_UNIV = Phantom('a bit0) (2 * of_phantom (card_UNIV :: 'a card_UNIV))"
 definition "card_UNIV = Phantom('a bit1) (1 + 2 * of_phantom (card_UNIV :: 'a card_UNIV))"
 instance by intro_classes (simp_all add: card_UNIV_bit0_def card_UNIV_bit1_def card_UNIV)
 end
 
 subsection \<open>Syntax\<close>
 
 syntax
   "_NumeralType" :: "num_token => type"  ("_")
   "_NumeralType0" :: type ("0")
   "_NumeralType1" :: type ("1")
 
 translations
   (type) "1" == (type) "num1"
   (type) "0" == (type) "num0"
 
 parse_translation \<open>
   let
     fun mk_bintype n =
       let
         fun mk_bit 0 = Syntax.const \<^type_syntax>\<open>bit0\<close>
           | mk_bit 1 = Syntax.const \<^type_syntax>\<open>bit1\<close>;
         fun bin_of n =
           if n = 1 then Syntax.const \<^type_syntax>\<open>num1\<close>
           else if n = 0 then Syntax.const \<^type_syntax>\<open>num0\<close>
           else if n = ~1 then raise TERM ("negative type numeral", [])
           else
             let val (q, r) = Integer.div_mod n 2;
             in mk_bit r $ bin_of q end;
       in bin_of n end;
 
     fun numeral_tr [Free (str, _)] = mk_bintype (the (Int.fromString str))
       | numeral_tr ts = raise TERM ("numeral_tr", ts);
 
   in [(\<^syntax_const>\<open>_NumeralType\<close>, K numeral_tr)] end
 \<close>
 
 print_translation \<open>
   let
     fun int_of [] = 0
       | int_of (b :: bs) = b + 2 * int_of bs;
 
     fun bin_of (Const (\<^type_syntax>\<open>num0\<close>, _)) = []
       | bin_of (Const (\<^type_syntax>\<open>num1\<close>, _)) = [1]
       | bin_of (Const (\<^type_syntax>\<open>bit0\<close>, _) $ bs) = 0 :: bin_of bs
       | bin_of (Const (\<^type_syntax>\<open>bit1\<close>, _) $ bs) = 1 :: bin_of bs
       | bin_of t = raise TERM ("bin_of", [t]);
 
     fun bit_tr' b [t] =
           let
             val rev_digs = b :: bin_of t handle TERM _ => raise Match
             val i = int_of rev_digs;
             val num = string_of_int (abs i);
           in
             Syntax.const \<^syntax_const>\<open>_NumeralType\<close> $ Syntax.free num
           end
       | bit_tr' b _ = raise Match;
   in
    [(\<^type_syntax>\<open>bit0\<close>, K (bit_tr' 0)),
     (\<^type_syntax>\<open>bit1\<close>, K (bit_tr' 1))]
   end
 \<close>
 
 subsection \<open>Examples\<close>
 
 lemma "CARD(0) = 0" by simp
 lemma "CARD(17) = 17" by simp
+lemma "CHAR(23) = 23" by simp
 lemma "8 * 11 ^ 3 - 6 = (2::5)" by simp
 
 end
diff --git a/src/HOL/Rat.thy b/src/HOL/Rat.thy
--- a/src/HOL/Rat.thy
+++ b/src/HOL/Rat.thy
@@ -1,1153 +1,1167 @@
 (*  Title:      HOL/Rat.thy
     Author:     Markus Wenzel, TU Muenchen
 *)
 
 section \<open>Rational numbers\<close>
 
 theory Rat
   imports Archimedean_Field
 begin
 
 subsection \<open>Rational numbers as quotient\<close>
 
 subsubsection \<open>Construction of the type of rational numbers\<close>
 
 definition ratrel :: "(int \<times> int) \<Rightarrow> (int \<times> int) \<Rightarrow> bool"
   where "ratrel = (\<lambda>x y. snd x \<noteq> 0 \<and> snd y \<noteq> 0 \<and> fst x * snd y = fst y * snd x)"
 
 lemma ratrel_iff [simp]: "ratrel x y \<longleftrightarrow> snd x \<noteq> 0 \<and> snd y \<noteq> 0 \<and> fst x * snd y = fst y * snd x"
   by (simp add: ratrel_def)
 
 lemma exists_ratrel_refl: "\<exists>x. ratrel x x"
   by (auto intro!: one_neq_zero)
 
 lemma symp_ratrel: "symp ratrel"
   by (simp add: ratrel_def symp_def)
 
 lemma transp_ratrel: "transp ratrel"
 proof (rule transpI, unfold split_paired_all)
   fix a b a' b' a'' b'' :: int
   assume *: "ratrel (a, b) (a', b')"
   assume **: "ratrel (a', b') (a'', b'')"
   have "b' * (a * b'') = b'' * (a * b')" by simp
   also from * have "a * b' = a' * b" by auto
   also have "b'' * (a' * b) = b * (a' * b'')" by simp
   also from ** have "a' * b'' = a'' * b'" by auto
   also have "b * (a'' * b') = b' * (a'' * b)" by simp
   finally have "b' * (a * b'') = b' * (a'' * b)" .
   moreover from ** have "b' \<noteq> 0" by auto
   ultimately have "a * b'' = a'' * b" by simp
   with * ** show "ratrel (a, b) (a'', b'')" by auto
 qed
 
 lemma part_equivp_ratrel: "part_equivp ratrel"
   by (rule part_equivpI [OF exists_ratrel_refl symp_ratrel transp_ratrel])
 
 quotient_type rat = "int \<times> int" / partial: "ratrel"
   morphisms Rep_Rat Abs_Rat
   by (rule part_equivp_ratrel)
 
 lemma Domainp_cr_rat [transfer_domain_rule]: "Domainp pcr_rat = (\<lambda>x. snd x \<noteq> 0)"
   by (simp add: rat.domain_eq)
 
 
 subsubsection \<open>Representation and basic operations\<close>
 
 lift_definition Fract :: "int \<Rightarrow> int \<Rightarrow> rat"
   is "\<lambda>a b. if b = 0 then (0, 1) else (a, b)"
   by simp
 
 lemma eq_rat:
   "\<And>a b c d. b \<noteq> 0 \<Longrightarrow> d \<noteq> 0 \<Longrightarrow> Fract a b = Fract c d \<longleftrightarrow> a * d = c * b"
   "\<And>a. Fract a 0 = Fract 0 1"
   "\<And>a c. Fract 0 a = Fract 0 c"
   by (transfer, simp)+
 
 lemma Rat_cases [case_names Fract, cases type: rat]:
   assumes that: "\<And>a b. q = Fract a b \<Longrightarrow> b > 0 \<Longrightarrow> coprime a b \<Longrightarrow> C"
   shows C
 proof -
   obtain a b :: int where q: "q = Fract a b" and b: "b \<noteq> 0"
     by transfer simp
   let ?a = "a div gcd a b"
   let ?b = "b div gcd a b"
   from b have "?b * gcd a b = b"
     by simp
   with b have "?b \<noteq> 0"
     by fastforce
   with q b have q2: "q = Fract ?a ?b"
     by (simp add: eq_rat dvd_div_mult mult.commute [of a])
   from b have coprime: "coprime ?a ?b"
     by (auto intro: div_gcd_coprime)
   show C
   proof (cases "b > 0")
     case True
     then have "?b > 0"
       by (simp add: nonneg1_imp_zdiv_pos_iff)
     from q2 this coprime show C by (rule that)
   next
     case False
     have "q = Fract (- ?a) (- ?b)"
       unfolding q2 by transfer simp
     moreover from False b have "- ?b > 0"
       by (simp add: pos_imp_zdiv_neg_iff)
     moreover from coprime have "coprime (- ?a) (- ?b)"
       by simp
     ultimately show C
       by (rule that)
   qed
 qed
 
 lemma Rat_induct [case_names Fract, induct type: rat]:
   assumes "\<And>a b. b > 0 \<Longrightarrow> coprime a b \<Longrightarrow> P (Fract a b)"
   shows "P q"
   using assms by (cases q) simp
 
 instantiation rat :: field
 begin
 
 lift_definition zero_rat :: "rat" is "(0, 1)"
   by simp
 
 lift_definition one_rat :: "rat" is "(1, 1)"
   by simp
 
 lemma Zero_rat_def: "0 = Fract 0 1"
   by transfer simp
 
 lemma One_rat_def: "1 = Fract 1 1"
   by transfer simp
 
 lift_definition plus_rat :: "rat \<Rightarrow> rat \<Rightarrow> rat"
   is "\<lambda>x y. (fst x * snd y + fst y * snd x, snd x * snd y)"
   by (auto simp: distrib_right) (simp add: ac_simps)
 
 lemma add_rat [simp]:
   assumes "b \<noteq> 0" and "d \<noteq> 0"
   shows "Fract a b + Fract c d = Fract (a * d + c * b) (b * d)"
   using assms by transfer simp
 
 lift_definition uminus_rat :: "rat \<Rightarrow> rat" is "\<lambda>x. (- fst x, snd x)"
   by simp
 
 lemma minus_rat [simp]: "- Fract a b = Fract (- a) b"
   by transfer simp
 
 lemma minus_rat_cancel [simp]: "Fract (- a) (- b) = Fract a b"
   by (cases "b = 0") (simp_all add: eq_rat)
 
 definition diff_rat_def: "q - r = q + - r" for q r :: rat
 
 lemma diff_rat [simp]:
   "b \<noteq> 0 \<Longrightarrow> d \<noteq> 0 \<Longrightarrow> Fract a b - Fract c d = Fract (a * d - c * b) (b * d)"
   by (simp add: diff_rat_def)
 
 lift_definition times_rat :: "rat \<Rightarrow> rat \<Rightarrow> rat"
   is "\<lambda>x y. (fst x * fst y, snd x * snd y)"
   by (simp add: ac_simps)
 
 lemma mult_rat [simp]: "Fract a b * Fract c d = Fract (a * c) (b * d)"
   by transfer simp
 
 lemma mult_rat_cancel: "c \<noteq> 0 \<Longrightarrow> Fract (c * a) (c * b) = Fract a b"
   by transfer simp
 
 lift_definition inverse_rat :: "rat \<Rightarrow> rat"
   is "\<lambda>x. if fst x = 0 then (0, 1) else (snd x, fst x)"
   by (auto simp add: mult.commute)
 
 lemma inverse_rat [simp]: "inverse (Fract a b) = Fract b a"
   by transfer simp
 
 definition divide_rat_def: "q div r = q * inverse r" for q r :: rat
 
 lemma divide_rat [simp]: "Fract a b div Fract c d = Fract (a * d) (b * c)"
   by (simp add: divide_rat_def)
 
 instance
 proof
   fix q r s :: rat
   show "(q * r) * s = q * (r * s)"
     by transfer simp
   show "q * r = r * q"
     by transfer simp
   show "1 * q = q"
     by transfer simp
   show "(q + r) + s = q + (r + s)"
     by transfer (simp add: algebra_simps)
   show "q + r = r + q"
     by transfer simp
   show "0 + q = q"
     by transfer simp
   show "- q + q = 0"
     by transfer simp
   show "q - r = q + - r"
     by (fact diff_rat_def)
   show "(q + r) * s = q * s + r * s"
     by transfer (simp add: algebra_simps)
   show "(0::rat) \<noteq> 1"
     by transfer simp
   show "inverse q * q = 1" if "q \<noteq> 0"
     using that by transfer simp
   show "q div r = q * inverse r"
     by (fact divide_rat_def)
   show "inverse 0 = (0::rat)"
     by transfer simp
 qed
 
 end
 
 (* We cannot state these two rules earlier because of pending sort hypotheses *)
 lemma div_add_self1_no_field [simp]:
   assumes "NO_MATCH (x :: 'b :: field) b" "(b :: 'a :: euclidean_semiring_cancel) \<noteq> 0"
   shows "(b + a) div b = a div b + 1"
   using assms(2) by (fact div_add_self1)
 
 lemma div_add_self2_no_field [simp]:
   assumes "NO_MATCH (x :: 'b :: field) b" "(b :: 'a :: euclidean_semiring_cancel) \<noteq> 0"
   shows "(a + b) div b = a div b + 1"
   using assms(2) by (fact div_add_self2)
 
 lemma of_nat_rat: "of_nat k = Fract (of_nat k) 1"
   by (induct k) (simp_all add: Zero_rat_def One_rat_def)
 
 lemma of_int_rat: "of_int k = Fract k 1"
   by (cases k rule: int_diff_cases) (simp add: of_nat_rat)
 
 lemma Fract_of_nat_eq: "Fract (of_nat k) 1 = of_nat k"
   by (rule of_nat_rat [symmetric])
 
 lemma Fract_of_int_eq: "Fract k 1 = of_int k"
   by (rule of_int_rat [symmetric])
 
 lemma rat_number_collapse:
   "Fract 0 k = 0"
   "Fract 1 1 = 1"
   "Fract (numeral w) 1 = numeral w"
   "Fract (- numeral w) 1 = - numeral w"
   "Fract (- 1) 1 = - 1"
   "Fract k 0 = 0"
   using Fract_of_int_eq [of "numeral w"]
     and Fract_of_int_eq [of "- numeral w"]
   by (simp_all add: Zero_rat_def One_rat_def eq_rat)
 
 lemma rat_number_expand:
   "0 = Fract 0 1"
   "1 = Fract 1 1"
   "numeral k = Fract (numeral k) 1"
   "- 1 = Fract (- 1) 1"
   "- numeral k = Fract (- numeral k) 1"
   by (simp_all add: rat_number_collapse)
 
 lemma Rat_cases_nonzero [case_names Fract 0]:
   assumes Fract: "\<And>a b. q = Fract a b \<Longrightarrow> b > 0 \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> coprime a b \<Longrightarrow> C"
     and 0: "q = 0 \<Longrightarrow> C"
   shows C
 proof (cases "q = 0")
   case True
   then show C using 0 by auto
 next
   case False
   then obtain a b where *: "q = Fract a b" "b > 0" "coprime a b"
     by (cases q) auto
   with False have "0 \<noteq> Fract a b"
     by simp
   with \<open>b > 0\<close> have "a \<noteq> 0"
     by (simp add: Zero_rat_def eq_rat)
   with Fract * show C by blast
 qed
 
 
 subsubsection \<open>Function \<open>normalize\<close>\<close>
 
 lemma Fract_coprime: "Fract (a div gcd a b) (b div gcd a b) = Fract a b"
 proof (cases "b = 0")
   case True
   then show ?thesis
     by (simp add: eq_rat)
 next
   case False
   moreover have "b div gcd a b * gcd a b = b"
     by (rule dvd_div_mult_self) simp
   ultimately have "b div gcd a b * gcd a b \<noteq> 0"
     by simp
   then have "b div gcd a b \<noteq> 0"
     by fastforce
   with False show ?thesis
     by (simp add: eq_rat dvd_div_mult mult.commute [of a])
 qed
 
 definition normalize :: "int \<times> int \<Rightarrow> int \<times> int"
   where "normalize p =
    (if snd p > 0 then (let a = gcd (fst p) (snd p) in (fst p div a, snd p div a))
     else if snd p = 0 then (0, 1)
     else (let a = - gcd (fst p) (snd p) in (fst p div a, snd p div a)))"
 
 lemma normalize_crossproduct:
   assumes "q \<noteq> 0" "s \<noteq> 0"
   assumes "normalize (p, q) = normalize (r, s)"
   shows "p * s = r * q"
 proof -
   have *: "p * s = q * r"
     if "p * gcd r s = sgn (q * s) * r * gcd p q" and "q * gcd r s = sgn (q * s) * s * gcd p q"
   proof -
     from that have "(p * gcd r s) * (sgn (q * s) * s * gcd p q) =
         (q * gcd r s) * (sgn (q * s) * r * gcd p q)"
       by simp
     with assms show ?thesis
       by (auto simp add: ac_simps sgn_mult sgn_0_0)
   qed
   from assms show ?thesis
     by (auto simp: normalize_def Let_def dvd_div_div_eq_mult mult.commute sgn_mult
         split: if_splits intro: *)
 qed
 
 lemma normalize_eq: "normalize (a, b) = (p, q) \<Longrightarrow> Fract p q = Fract a b"
   by (auto simp: normalize_def Let_def Fract_coprime dvd_div_neg rat_number_collapse
       split: if_split_asm)
 
 lemma normalize_denom_pos: "normalize r = (p, q) \<Longrightarrow> q > 0"
   by (auto simp: normalize_def Let_def dvd_div_neg pos_imp_zdiv_neg_iff nonneg1_imp_zdiv_pos_iff
       split: if_split_asm)
 
 lemma normalize_coprime: "normalize r = (p, q) \<Longrightarrow> coprime p q"
   by (auto simp: normalize_def Let_def dvd_div_neg div_gcd_coprime split: if_split_asm)
 
 lemma normalize_stable [simp]: "q > 0 \<Longrightarrow> coprime p q \<Longrightarrow> normalize (p, q) = (p, q)"
   by (simp add: normalize_def)
 
 lemma normalize_denom_zero [simp]: "normalize (p, 0) = (0, 1)"
   by (simp add: normalize_def)
 
 lemma normalize_negative [simp]: "q < 0 \<Longrightarrow> normalize (p, q) = normalize (- p, - q)"
   by (simp add: normalize_def Let_def dvd_div_neg dvd_neg_div)
 
 text\<open>
   Decompose a fraction into normalized, i.e. coprime numerator and denominator:
 \<close>
 
 definition quotient_of :: "rat \<Rightarrow> int \<times> int"
   where "quotient_of x =
     (THE pair. x = Fract (fst pair) (snd pair) \<and> snd pair > 0 \<and> coprime (fst pair) (snd pair))"
 
 lemma quotient_of_unique: "\<exists>!p. r = Fract (fst p) (snd p) \<and> snd p > 0 \<and> coprime (fst p) (snd p)"
 proof (cases r)
   case (Fract a b)
   then have "r = Fract (fst (a, b)) (snd (a, b)) \<and>
       snd (a, b) > 0 \<and> coprime (fst (a, b)) (snd (a, b))"
     by auto
   then show ?thesis
   proof (rule ex1I)
     fix p
     assume r: "r = Fract (fst p) (snd p) \<and> snd p > 0 \<and> coprime (fst p) (snd p)"
     obtain c d where p: "p = (c, d)" by (cases p)
     with r have Fract': "r = Fract c d" "d > 0" "coprime c d"
       by simp_all
     have "(c, d) = (a, b)"
     proof (cases "a = 0")
       case True
       with Fract Fract' show ?thesis
         by (simp add: eq_rat)
     next
       case False
       with Fract Fract' have *: "c * b = a * d" and "c \<noteq> 0"
         by (auto simp add: eq_rat)
       then have "c * b > 0 \<longleftrightarrow> a * d > 0"
         by auto
       with \<open>b > 0\<close> \<open>d > 0\<close> have "a > 0 \<longleftrightarrow> c > 0"
         by (simp add: zero_less_mult_iff)
       with \<open>a \<noteq> 0\<close> \<open>c \<noteq> 0\<close> have sgn: "sgn a = sgn c"
         by (auto simp add: not_less)
       from \<open>coprime a b\<close> \<open>coprime c d\<close> have "\<bar>a\<bar> * \<bar>d\<bar> = \<bar>c\<bar> * \<bar>b\<bar> \<longleftrightarrow> \<bar>a\<bar> = \<bar>c\<bar> \<and> \<bar>d\<bar> = \<bar>b\<bar>"
         by (simp add: coprime_crossproduct_int)
       with \<open>b > 0\<close> \<open>d > 0\<close> have "\<bar>a\<bar> * d = \<bar>c\<bar> * b \<longleftrightarrow> \<bar>a\<bar> = \<bar>c\<bar> \<and> d = b"
         by simp
       then have "a * sgn a * d = c * sgn c * b \<longleftrightarrow> a * sgn a = c * sgn c \<and> d = b"
         by (simp add: abs_sgn)
       with sgn * show ?thesis
         by (auto simp add: sgn_0_0)
     qed
     with p show "p = (a, b)"
       by simp
   qed
 qed
 
 lemma quotient_of_Fract [code]: "quotient_of (Fract a b) = normalize (a, b)"
 proof -
   have "Fract a b = Fract (fst (normalize (a, b))) (snd (normalize (a, b)))" (is ?Fract)
     by (rule sym) (auto intro: normalize_eq)
   moreover have "0 < snd (normalize (a, b))" (is ?denom_pos)
     by (cases "normalize (a, b)") (rule normalize_denom_pos, simp)
   moreover have "coprime (fst (normalize (a, b))) (snd (normalize (a, b)))" (is ?coprime)
     by (rule normalize_coprime) simp
   ultimately have "?Fract \<and> ?denom_pos \<and> ?coprime" by blast
   then have "(THE p. Fract a b = Fract (fst p) (snd p) \<and> 0 < snd p \<and>
     coprime (fst p) (snd p)) = normalize (a, b)"
     by (rule the1_equality [OF quotient_of_unique])
   then show ?thesis by (simp add: quotient_of_def)
 qed
 
 lemma quotient_of_number [simp]:
   "quotient_of 0 = (0, 1)"
   "quotient_of 1 = (1, 1)"
   "quotient_of (numeral k) = (numeral k, 1)"
   "quotient_of (- 1) = (- 1, 1)"
   "quotient_of (- numeral k) = (- numeral k, 1)"
   by (simp_all add: rat_number_expand quotient_of_Fract)
 
 lemma quotient_of_eq: "quotient_of (Fract a b) = (p, q) \<Longrightarrow> Fract p q = Fract a b"
   by (simp add: quotient_of_Fract normalize_eq)
 
 lemma quotient_of_denom_pos: "quotient_of r = (p, q) \<Longrightarrow> q > 0"
   by (cases r) (simp add: quotient_of_Fract normalize_denom_pos)
 
 lemma quotient_of_denom_pos': "snd (quotient_of r) > 0"
   using quotient_of_denom_pos [of r] by (simp add: prod_eq_iff)
 
 lemma quotient_of_coprime: "quotient_of r = (p, q) \<Longrightarrow> coprime p q"
   by (cases r) (simp add: quotient_of_Fract normalize_coprime)
 
 lemma quotient_of_inject:
   assumes "quotient_of a = quotient_of b"
   shows "a = b"
 proof -
   obtain p q r s where a: "a = Fract p q" and b: "b = Fract r s" and "q > 0" and "s > 0"
     by (cases a, cases b)
   with assms show ?thesis
     by (simp add: eq_rat quotient_of_Fract normalize_crossproduct)
 qed
 
 lemma quotient_of_inject_eq: "quotient_of a = quotient_of b \<longleftrightarrow> a = b"
   by (auto simp add: quotient_of_inject)
 
 
 subsubsection \<open>Various\<close>
 
 lemma Fract_of_int_quotient: "Fract k l = of_int k / of_int l"
   by (simp add: Fract_of_int_eq [symmetric])
 
 lemma Fract_add_one: "n \<noteq> 0 \<Longrightarrow> Fract (m + n) n = Fract m n + 1"
   by (simp add: rat_number_expand)
 
 lemma quotient_of_div:
   assumes r: "quotient_of r = (n,d)"
   shows "r = of_int n / of_int d"
 proof -
   from theI'[OF quotient_of_unique[of r], unfolded r[unfolded quotient_of_def]]
   have "r = Fract n d" by simp
   then show ?thesis using Fract_of_int_quotient
     by simp
 qed
 
 
 subsubsection \<open>The ordered field of rational numbers\<close>
 
 lift_definition positive :: "rat \<Rightarrow> bool"
   is "\<lambda>x. 0 < fst x * snd x"
 proof clarsimp
   fix a b c d :: int
   assume "b \<noteq> 0" and "d \<noteq> 0" and "a * d = c * b"
   then have "a * d * b * d = c * b * b * d"
     by simp
   then have "a * b * d\<^sup>2 = c * d * b\<^sup>2"
     unfolding power2_eq_square by (simp add: ac_simps)
   then have "0 < a * b * d\<^sup>2 \<longleftrightarrow> 0 < c * d * b\<^sup>2"
     by simp
   then show "0 < a * b \<longleftrightarrow> 0 < c * d"
     using \<open>b \<noteq> 0\<close> and \<open>d \<noteq> 0\<close>
     by (simp add: zero_less_mult_iff)
 qed
 
 lemma positive_zero: "\<not> positive 0"
   by transfer simp
 
 lemma positive_add: "positive x \<Longrightarrow> positive y \<Longrightarrow> positive (x + y)"
   apply transfer
      apply (auto simp add: zero_less_mult_iff add_pos_pos add_neg_neg mult_pos_neg mult_neg_pos mult_neg_neg)
   done
 
 lemma positive_mult: "positive x \<Longrightarrow> positive y \<Longrightarrow> positive (x * y)"
   apply transfer
   by (metis fst_conv mult.commute mult_pos_neg2 snd_conv zero_less_mult_iff)
 
 lemma positive_minus: "\<not> positive x \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> positive (- x)"
   by transfer (auto simp: neq_iff zero_less_mult_iff mult_less_0_iff)
 
 instantiation rat :: linordered_field
 begin
 
 definition "x < y \<longleftrightarrow> positive (y - x)"
 
 definition "x \<le> y \<longleftrightarrow> x < y \<or> x = y" for x y :: rat
 
 definition "\<bar>a\<bar> = (if a < 0 then - a else a)" for a :: rat
 
 definition "sgn a = (if a = 0 then 0 else if 0 < a then 1 else - 1)" for a :: rat
 
 instance
 proof
   fix a b c :: rat
   show "\<bar>a\<bar> = (if a < 0 then - a else a)"
     by (rule abs_rat_def)
   show "a < b \<longleftrightarrow> a \<le> b \<and> \<not> b \<le> a"
     unfolding less_eq_rat_def less_rat_def
     using positive_add positive_zero by force
   show "a \<le> a"
     unfolding less_eq_rat_def by simp
   show "a \<le> b \<Longrightarrow> b \<le> c \<Longrightarrow> a \<le> c"
     unfolding less_eq_rat_def less_rat_def
     using positive_add by fastforce
   show "a \<le> b \<Longrightarrow> b \<le> a \<Longrightarrow> a = b"
     unfolding less_eq_rat_def less_rat_def
     using positive_add positive_zero by fastforce
   show "a \<le> b \<Longrightarrow> c + a \<le> c + b"
     unfolding less_eq_rat_def less_rat_def by auto
   show "sgn a = (if a = 0 then 0 else if 0 < a then 1 else - 1)"
     by (rule sgn_rat_def)
   show "a \<le> b \<or> b \<le> a"
     unfolding less_eq_rat_def less_rat_def
     by (auto dest!: positive_minus)
   show "a < b \<Longrightarrow> 0 < c \<Longrightarrow> c * a < c * b"
     unfolding less_rat_def
     by (metis diff_zero positive_mult right_diff_distrib')
 qed
 
 end
 
 instantiation rat :: distrib_lattice
 begin
 
 definition "(inf :: rat \<Rightarrow> rat \<Rightarrow> rat) = min"
 
 definition "(sup :: rat \<Rightarrow> rat \<Rightarrow> rat) = max"
 
 instance
   by standard (auto simp add: inf_rat_def sup_rat_def max_min_distrib2)
 
 end
 
 lemma positive_rat: "positive (Fract a b) \<longleftrightarrow> 0 < a * b"
   by transfer simp
 
 lemma less_rat [simp]:
   "b \<noteq> 0 \<Longrightarrow> d \<noteq> 0 \<Longrightarrow> Fract a b < Fract c d \<longleftrightarrow> (a * d) * (b * d) < (c * b) * (b * d)"
   by (simp add: less_rat_def positive_rat algebra_simps)
 
 lemma le_rat [simp]:
   "b \<noteq> 0 \<Longrightarrow> d \<noteq> 0 \<Longrightarrow> Fract a b \<le> Fract c d \<longleftrightarrow> (a * d) * (b * d) \<le> (c * b) * (b * d)"
   by (simp add: le_less eq_rat)
 
 lemma abs_rat [simp, code]: "\<bar>Fract a b\<bar> = Fract \<bar>a\<bar> \<bar>b\<bar>"
   by (auto simp add: abs_rat_def zabs_def Zero_rat_def not_less le_less eq_rat zero_less_mult_iff)
 
 lemma sgn_rat [simp, code]: "sgn (Fract a b) = of_int (sgn a * sgn b)"
   unfolding Fract_of_int_eq
   by (auto simp: zsgn_def sgn_rat_def Zero_rat_def eq_rat)
     (auto simp: rat_number_collapse not_less le_less zero_less_mult_iff)
 
 lemma Rat_induct_pos [case_names Fract, induct type: rat]:
   assumes step: "\<And>a b. 0 < b \<Longrightarrow> P (Fract a b)"
   shows "P q"
 proof (cases q)
   case (Fract a b)
   have step': "P (Fract a b)" if b: "b < 0" for a b :: int
   proof -
     from b have "0 < - b"
       by simp
     then have "P (Fract (- a) (- b))"
       by (rule step)
     then show "P (Fract a b)"
       by (simp add: order_less_imp_not_eq [OF b])
   qed
   from Fract show "P q"
     by (auto simp add: linorder_neq_iff step step')
 qed
 
 lemma zero_less_Fract_iff: "0 < b \<Longrightarrow> 0 < Fract a b \<longleftrightarrow> 0 < a"
   by (simp add: Zero_rat_def zero_less_mult_iff)
 
 lemma Fract_less_zero_iff: "0 < b \<Longrightarrow> Fract a b < 0 \<longleftrightarrow> a < 0"
   by (simp add: Zero_rat_def mult_less_0_iff)
 
 lemma zero_le_Fract_iff: "0 < b \<Longrightarrow> 0 \<le> Fract a b \<longleftrightarrow> 0 \<le> a"
   by (simp add: Zero_rat_def zero_le_mult_iff)
 
 lemma Fract_le_zero_iff: "0 < b \<Longrightarrow> Fract a b \<le> 0 \<longleftrightarrow> a \<le> 0"
   by (simp add: Zero_rat_def mult_le_0_iff)
 
 lemma one_less_Fract_iff: "0 < b \<Longrightarrow> 1 < Fract a b \<longleftrightarrow> b < a"
   by (simp add: One_rat_def mult_less_cancel_right_disj)
 
 lemma Fract_less_one_iff: "0 < b \<Longrightarrow> Fract a b < 1 \<longleftrightarrow> a < b"
   by (simp add: One_rat_def mult_less_cancel_right_disj)
 
 lemma one_le_Fract_iff: "0 < b \<Longrightarrow> 1 \<le> Fract a b \<longleftrightarrow> b \<le> a"
   by (simp add: One_rat_def mult_le_cancel_right)
 
 lemma Fract_le_one_iff: "0 < b \<Longrightarrow> Fract a b \<le> 1 \<longleftrightarrow> a \<le> b"
   by (simp add: One_rat_def mult_le_cancel_right)
 
 
 subsubsection \<open>Rationals are an Archimedean field\<close>
 
 lemma rat_floor_lemma: "of_int (a div b) \<le> Fract a b \<and> Fract a b < of_int (a div b + 1)"
 proof -
   have "Fract a b = of_int (a div b) + Fract (a mod b) b"
     by (cases "b = 0") (simp, simp add: of_int_rat)
   moreover have "0 \<le> Fract (a mod b) b \<and> Fract (a mod b) b < 1"
     unfolding Fract_of_int_quotient
     by (rule linorder_cases [of b 0]) (simp_all add: divide_nonpos_neg)
   ultimately show ?thesis by simp
 qed
 
 instance rat :: archimedean_field
 proof
   show "\<exists>z. r \<le> of_int z" for r :: rat
   proof (induct r)
     case (Fract a b)
     have "Fract a b \<le> of_int (a div b + 1)"
       using rat_floor_lemma [of a b] by simp
     then show "\<exists>z. Fract a b \<le> of_int z" ..
   qed
 qed
 
 instantiation rat :: floor_ceiling
 begin
 
 definition floor_rat :: "rat \<Rightarrow> int"
   where"\<lfloor>x\<rfloor> = (THE z. of_int z \<le> x \<and> x < of_int (z + 1))" for x :: rat
 
 instance
 proof
   show "of_int \<lfloor>x\<rfloor> \<le> x \<and> x < of_int (\<lfloor>x\<rfloor> + 1)" for x :: rat
     unfolding floor_rat_def using floor_exists1 by (rule theI')
 qed
 
 end
 
 lemma floor_Fract [simp]: "\<lfloor>Fract a b\<rfloor> = a div b"
   by (simp add: Fract_of_int_quotient floor_divide_of_int_eq)
 
 
 subsection \<open>Linear arithmetic setup\<close>
 
 declaration \<open>
   K (Lin_Arith.add_inj_thms @{thms of_int_le_iff [THEN iffD2] of_int_eq_iff [THEN iffD2]}
     (* not needed because x < (y::int) can be rewritten as x + 1 <= y: of_int_less_iff RS iffD2 *)
   #> Lin_Arith.add_inj_const (\<^const_name>\<open>of_nat\<close>, \<^typ>\<open>nat \<Rightarrow> rat\<close>)
   #> Lin_Arith.add_inj_const (\<^const_name>\<open>of_int\<close>, \<^typ>\<open>int \<Rightarrow> rat\<close>))
 \<close>
 
 
 subsection \<open>Embedding from Rationals to other Fields\<close>
 
 context field_char_0
 begin
 
 lift_definition of_rat :: "rat \<Rightarrow> 'a"
   is "\<lambda>x. of_int (fst x) / of_int (snd x)"
   by (auto simp: nonzero_divide_eq_eq nonzero_eq_divide_eq) (simp only: of_int_mult [symmetric])
 
 end
 
 lemma of_rat_rat: "b \<noteq> 0 \<Longrightarrow> of_rat (Fract a b) = of_int a / of_int b"
   by transfer simp
 
 lemma of_rat_0 [simp]: "of_rat 0 = 0"
   by transfer simp
 
 lemma of_rat_1 [simp]: "of_rat 1 = 1"
   by transfer simp
 
 lemma of_rat_add: "of_rat (a + b) = of_rat a + of_rat b"
   by transfer (simp add: add_frac_eq)
 
 lemma of_rat_minus: "of_rat (- a) = - of_rat a"
   by transfer simp
 
 lemma of_rat_neg_one [simp]: "of_rat (- 1) = - 1"
   by (simp add: of_rat_minus)
 
 lemma of_rat_diff: "of_rat (a - b) = of_rat a - of_rat b"
   using of_rat_add [of a "- b"] by (simp add: of_rat_minus)
 
 lemma of_rat_mult: "of_rat (a * b) = of_rat a * of_rat b"
   by transfer (simp add: divide_inverse nonzero_inverse_mult_distrib ac_simps)
 
 lemma of_rat_sum: "of_rat (\<Sum>a\<in>A. f a) = (\<Sum>a\<in>A. of_rat (f a))"
   by (induct rule: infinite_finite_induct) (auto simp: of_rat_add)
 
 lemma of_rat_prod: "of_rat (\<Prod>a\<in>A. f a) = (\<Prod>a\<in>A. of_rat (f a))"
   by (induct rule: infinite_finite_induct) (auto simp: of_rat_mult)
 
 lemma nonzero_of_rat_inverse: "a \<noteq> 0 \<Longrightarrow> of_rat (inverse a) = inverse (of_rat a)"
   by (rule inverse_unique [symmetric]) (simp add: of_rat_mult [symmetric])
 
 lemma of_rat_inverse: "(of_rat (inverse a) :: 'a::field_char_0) = inverse (of_rat a)"
   by (cases "a = 0") (simp_all add: nonzero_of_rat_inverse)
 
 lemma nonzero_of_rat_divide: "b \<noteq> 0 \<Longrightarrow> of_rat (a / b) = of_rat a / of_rat b"
   by (simp add: divide_inverse of_rat_mult nonzero_of_rat_inverse)
 
 lemma of_rat_divide: "(of_rat (a / b) :: 'a::field_char_0) = of_rat a / of_rat b"
   by (cases "b = 0") (simp_all add: nonzero_of_rat_divide)
 
 lemma of_rat_power: "(of_rat (a ^ n) :: 'a::field_char_0) = of_rat a ^ n"
   by (induct n) (simp_all add: of_rat_mult)
 
 lemma of_rat_eq_iff [simp]: "of_rat a = of_rat b \<longleftrightarrow> a = b"
   apply transfer
   apply (simp add: nonzero_divide_eq_eq nonzero_eq_divide_eq flip: of_int_mult)
   done
 
 lemma of_rat_eq_0_iff [simp]: "of_rat a = 0 \<longleftrightarrow> a = 0"
   using of_rat_eq_iff [of _ 0] by simp
 
 lemma zero_eq_of_rat_iff [simp]: "0 = of_rat a \<longleftrightarrow> 0 = a"
   by simp
 
 lemma of_rat_eq_1_iff [simp]: "of_rat a = 1 \<longleftrightarrow> a = 1"
   using of_rat_eq_iff [of _ 1] by simp
 
 lemma one_eq_of_rat_iff [simp]: "1 = of_rat a \<longleftrightarrow> 1 = a"
   by simp
 
 lemma of_rat_less: "(of_rat r :: 'a::linordered_field) < of_rat s \<longleftrightarrow> r < s"
 proof (induct r, induct s)
   fix a b c d :: int
   assume not_zero: "b > 0" "d > 0"
   then have "b * d > 0" by simp
   have of_int_divide_less_eq:
     "(of_int a :: 'a) / of_int b < of_int c / of_int d \<longleftrightarrow>
       (of_int a :: 'a) * of_int d < of_int c * of_int b"
     using not_zero by (simp add: pos_less_divide_eq pos_divide_less_eq)
   show "(of_rat (Fract a b) :: 'a::linordered_field) < of_rat (Fract c d) \<longleftrightarrow>
       Fract a b < Fract c d"
     using not_zero \<open>b * d > 0\<close>
     by (simp add: of_rat_rat of_int_divide_less_eq of_int_mult [symmetric] del: of_int_mult)
 qed
 
 lemma of_rat_less_eq: "(of_rat r :: 'a::linordered_field) \<le> of_rat s \<longleftrightarrow> r \<le> s"
   unfolding le_less by (auto simp add: of_rat_less)
 
 lemma of_rat_le_0_iff [simp]: "(of_rat r :: 'a::linordered_field) \<le> 0 \<longleftrightarrow> r \<le> 0"
   using of_rat_less_eq [of r 0, where 'a = 'a] by simp
 
 lemma zero_le_of_rat_iff [simp]: "0 \<le> (of_rat r :: 'a::linordered_field) \<longleftrightarrow> 0 \<le> r"
   using of_rat_less_eq [of 0 r, where 'a = 'a] by simp
 
 lemma of_rat_le_1_iff [simp]: "(of_rat r :: 'a::linordered_field) \<le> 1 \<longleftrightarrow> r \<le> 1"
   using of_rat_less_eq [of r 1] by simp
 
 lemma one_le_of_rat_iff [simp]: "1 \<le> (of_rat r :: 'a::linordered_field) \<longleftrightarrow> 1 \<le> r"
   using of_rat_less_eq [of 1 r] by simp
 
 lemma of_rat_less_0_iff [simp]: "(of_rat r :: 'a::linordered_field) < 0 \<longleftrightarrow> r < 0"
   using of_rat_less [of r 0, where 'a = 'a] by simp
 
 lemma zero_less_of_rat_iff [simp]: "0 < (of_rat r :: 'a::linordered_field) \<longleftrightarrow> 0 < r"
   using of_rat_less [of 0 r, where 'a = 'a] by simp
 
 lemma of_rat_less_1_iff [simp]: "(of_rat r :: 'a::linordered_field) < 1 \<longleftrightarrow> r < 1"
   using of_rat_less [of r 1] by simp
 
 lemma one_less_of_rat_iff [simp]: "1 < (of_rat r :: 'a::linordered_field) \<longleftrightarrow> 1 < r"
   using of_rat_less [of 1 r] by simp
 
 lemma of_rat_eq_id [simp]: "of_rat = id"
 proof
   show "of_rat a = id a" for a
     by (induct a) (simp add: of_rat_rat Fract_of_int_eq [symmetric])
 qed
 
 lemma abs_of_rat [simp]:
   "\<bar>of_rat r\<bar> = (of_rat \<bar>r\<bar> :: 'a :: linordered_field)"
   by (cases "r \<ge> 0") (simp_all add: not_le of_rat_minus)
 
 text \<open>Collapse nested embeddings.\<close>
 lemma of_rat_of_nat_eq [simp]: "of_rat (of_nat n) = of_nat n"
   by (induct n) (simp_all add: of_rat_add)
 
 lemma of_rat_of_int_eq [simp]: "of_rat (of_int z) = of_int z"
   by (cases z rule: int_diff_cases) (simp add: of_rat_diff)
 
 lemma of_rat_numeral_eq [simp]: "of_rat (numeral w) = numeral w"
   using of_rat_of_int_eq [of "numeral w"] by simp
 
 lemma of_rat_neg_numeral_eq [simp]: "of_rat (- numeral w) = - numeral w"
   using of_rat_of_int_eq [of "- numeral w"] by simp
 
 lemma of_rat_floor [simp]:
   "\<lfloor>of_rat r\<rfloor> = \<lfloor>r\<rfloor>"
   by (cases r) (simp add: Fract_of_int_quotient of_rat_divide floor_divide_of_int_eq)
 
 lemma of_rat_ceiling [simp]:
   "\<lceil>of_rat r\<rceil> = \<lceil>r\<rceil>"
   using of_rat_floor [of "- r"] by (simp add: of_rat_minus ceiling_def)
 
 lemmas zero_rat = Zero_rat_def
 lemmas one_rat = One_rat_def
 
 abbreviation rat_of_nat :: "nat \<Rightarrow> rat"
   where "rat_of_nat \<equiv> of_nat"
 
 abbreviation rat_of_int :: "int \<Rightarrow> rat"
   where "rat_of_int \<equiv> of_int"
 
 
 subsection \<open>The Set of Rational Numbers\<close>
 
 context field_char_0
 begin
 
 definition Rats :: "'a set" ("\<rat>")
   where "\<rat> = range of_rat"
 
 end
 
 lemma Rats_cases [cases set: Rats]:
   assumes "q \<in> \<rat>"
   obtains (of_rat) r where "q = of_rat r"
 proof -
   from \<open>q \<in> \<rat>\<close> have "q \<in> range of_rat"
     by (simp only: Rats_def)
   then obtain r where "q = of_rat r" ..
   then show thesis ..
 qed
 
+lemma Rats_cases':
+  assumes "(x :: 'a :: field_char_0) \<in> \<rat>"
+  obtains a b where "b > 0" "coprime a b" "x = of_int a / of_int b"
+proof -
+  from assms obtain r where "x = of_rat r"
+    by (auto simp: Rats_def)
+  obtain a b where quot: "quotient_of r = (a,b)" by force
+  have "b > 0" using quotient_of_denom_pos[OF quot] .
+  moreover have "coprime a b" using quotient_of_coprime[OF quot] .
+  moreover have "x = of_int a / of_int b" unfolding \<open>x = of_rat r\<close>
+      quotient_of_div[OF quot] by (simp add: of_rat_divide)
+  ultimately show ?thesis using that by blast
+qed
+
 lemma Rats_of_rat [simp]: "of_rat r \<in> \<rat>"
   by (simp add: Rats_def)
 
 lemma Rats_of_int [simp]: "of_int z \<in> \<rat>"
   by (subst of_rat_of_int_eq [symmetric]) (rule Rats_of_rat)
 
 lemma Ints_subset_Rats: "\<int> \<subseteq> \<rat>"
   using Ints_cases Rats_of_int by blast
 
 lemma Rats_of_nat [simp]: "of_nat n \<in> \<rat>"
   by (subst of_rat_of_nat_eq [symmetric]) (rule Rats_of_rat)
 
 lemma Nats_subset_Rats: "\<nat> \<subseteq> \<rat>"
   using Ints_subset_Rats Nats_subset_Ints by blast
 
 lemma Rats_number_of [simp]: "numeral w \<in> \<rat>"
   by (subst of_rat_numeral_eq [symmetric]) (rule Rats_of_rat)
 
 lemma Rats_0 [simp]: "0 \<in> \<rat>"
   unfolding Rats_def by (rule range_eqI) (rule of_rat_0 [symmetric])
 
 lemma Rats_1 [simp]: "1 \<in> \<rat>"
   unfolding Rats_def by (rule range_eqI) (rule of_rat_1 [symmetric])
 
 lemma Rats_add [simp]: "a \<in> \<rat> \<Longrightarrow> b \<in> \<rat> \<Longrightarrow> a + b \<in> \<rat>"
   by (metis Rats_cases Rats_of_rat of_rat_add)
 
 lemma Rats_minus_iff [simp]: "- a \<in> \<rat> \<longleftrightarrow> a \<in> \<rat>"
   by (metis Rats_cases Rats_of_rat add.inverse_inverse of_rat_minus)
 
 lemma Rats_diff [simp]: "a \<in> \<rat> \<Longrightarrow> b \<in> \<rat> \<Longrightarrow> a - b \<in> \<rat>"
   by (metis Rats_add Rats_minus_iff diff_conv_add_uminus)
 
 lemma Rats_mult [simp]: "a \<in> \<rat> \<Longrightarrow> b \<in> \<rat> \<Longrightarrow> a * b \<in> \<rat>"
   by (metis Rats_cases Rats_of_rat of_rat_mult)
 
 lemma Rats_inverse [simp]: "a \<in> \<rat> \<Longrightarrow> inverse a \<in> \<rat>"
   for a :: "'a::field_char_0"
   by (metis Rats_cases Rats_of_rat of_rat_inverse)
 
 lemma Rats_divide [simp]: "a \<in> \<rat> \<Longrightarrow> b \<in> \<rat> \<Longrightarrow> a / b \<in> \<rat>"
   for a b :: "'a::field_char_0"
   by (simp add: divide_inverse)
 
 lemma Rats_power [simp]: "a \<in> \<rat> \<Longrightarrow> a ^ n \<in> \<rat>"
   for a :: "'a::field_char_0"
   by (metis Rats_cases Rats_of_rat of_rat_power)
 
 lemma Rats_induct [case_names of_rat, induct set: Rats]: "q \<in> \<rat> \<Longrightarrow> (\<And>r. P (of_rat r)) \<Longrightarrow> P q"
   by (rule Rats_cases) auto
 
 lemma Rats_infinite: "\<not> finite \<rat>"
   by (auto dest!: finite_imageD simp: inj_on_def infinite_UNIV_char_0 Rats_def)
 
 
 subsection \<open>Implementation of rational numbers as pairs of integers\<close>
 
 text \<open>Formal constructor\<close>
 
 definition Frct :: "int \<times> int \<Rightarrow> rat"
   where [simp]: "Frct p = Fract (fst p) (snd p)"
 
 lemma [code abstype]: "Frct (quotient_of q) = q"
   by (cases q) (auto intro: quotient_of_eq)
 
 
 text \<open>Numerals\<close>
 
 declare quotient_of_Fract [code abstract]
 
 definition of_int :: "int \<Rightarrow> rat"
   where [code_abbrev]: "of_int = Int.of_int"
 
 hide_const (open) of_int
 
 lemma quotient_of_int [code abstract]: "quotient_of (Rat.of_int a) = (a, 1)"
   by (simp add: of_int_def of_int_rat quotient_of_Fract)
 
 lemma [code_unfold]: "numeral k = Rat.of_int (numeral k)"
   by (simp add: Rat.of_int_def)
 
 lemma [code_unfold]: "- numeral k = Rat.of_int (- numeral k)"
   by (simp add: Rat.of_int_def)
 
 lemma Frct_code_post [code_post]:
   "Frct (0, a) = 0"
   "Frct (a, 0) = 0"
   "Frct (1, 1) = 1"
   "Frct (numeral k, 1) = numeral k"
   "Frct (1, numeral k) = 1 / numeral k"
   "Frct (numeral k, numeral l) = numeral k / numeral l"
   "Frct (- a, b) = - Frct (a, b)"
   "Frct (a, - b) = - Frct (a, b)"
   "- (- Frct q) = Frct q"
   by (simp_all add: Fract_of_int_quotient)
 
 
 text \<open>Operations\<close>
 
 lemma rat_zero_code [code abstract]: "quotient_of 0 = (0, 1)"
   by (simp add: Zero_rat_def quotient_of_Fract normalize_def)
 
 lemma rat_one_code [code abstract]: "quotient_of 1 = (1, 1)"
   by (simp add: One_rat_def quotient_of_Fract normalize_def)
 
 lemma rat_plus_code [code abstract]:
   "quotient_of (p + q) = (let (a, c) = quotient_of p; (b, d) = quotient_of q
      in normalize (a * d + b * c, c * d))"
   by (cases p, cases q) (simp add: quotient_of_Fract)
 
 lemma rat_uminus_code [code abstract]:
   "quotient_of (- p) = (let (a, b) = quotient_of p in (- a, b))"
   by (cases p) (simp add: quotient_of_Fract)
 
 lemma rat_minus_code [code abstract]:
   "quotient_of (p - q) =
     (let (a, c) = quotient_of p; (b, d) = quotient_of q
      in normalize (a * d - b * c, c * d))"
   by (cases p, cases q) (simp add: quotient_of_Fract)
 
 lemma rat_times_code [code abstract]:
   "quotient_of (p * q) =
     (let (a, c) = quotient_of p; (b, d) = quotient_of q
      in normalize (a * b, c * d))"
   by (cases p, cases q) (simp add: quotient_of_Fract)
 
 lemma rat_inverse_code [code abstract]:
   "quotient_of (inverse p) =
     (let (a, b) = quotient_of p
      in if a = 0 then (0, 1) else (sgn a * b, \<bar>a\<bar>))"
 proof (cases p)
   case (Fract a b)
   then show ?thesis
     by (cases "0::int" a rule: linorder_cases) (simp_all add: quotient_of_Fract ac_simps)
 qed
 
 lemma rat_divide_code [code abstract]:
   "quotient_of (p / q) =
     (let (a, c) = quotient_of p; (b, d) = quotient_of q
      in normalize (a * d, c * b))"
   by (cases p, cases q) (simp add: quotient_of_Fract)
 
 lemma rat_abs_code [code abstract]:
   "quotient_of \<bar>p\<bar> = (let (a, b) = quotient_of p in (\<bar>a\<bar>, b))"
   by (cases p) (simp add: quotient_of_Fract)
   
 lemma rat_sgn_code [code abstract]: "quotient_of (sgn p) = (sgn (fst (quotient_of p)), 1)"
 proof (cases p)
   case (Fract a b)
   then show ?thesis
     by (cases "0::int" a rule: linorder_cases) (simp_all add: quotient_of_Fract)
 qed
 
 lemma rat_floor_code [code]: "\<lfloor>p\<rfloor> = (let (a, b) = quotient_of p in a div b)"
   by (cases p) (simp add: quotient_of_Fract floor_Fract)
 
 instantiation rat :: equal
 begin
 
 definition [code]: "HOL.equal a b \<longleftrightarrow> quotient_of a = quotient_of b"
 
 instance
   by standard (simp add: equal_rat_def quotient_of_inject_eq)
 
 lemma rat_eq_refl [code nbe]: "HOL.equal (r::rat) r \<longleftrightarrow> True"
   by (rule equal_refl)
 
 end
 
 lemma rat_less_eq_code [code]:
   "p \<le> q \<longleftrightarrow> (let (a, c) = quotient_of p; (b, d) = quotient_of q in a * d \<le> c * b)"
   by (cases p, cases q) (simp add: quotient_of_Fract mult.commute)
 
 lemma rat_less_code [code]:
   "p < q \<longleftrightarrow> (let (a, c) = quotient_of p; (b, d) = quotient_of q in a * d < c * b)"
   by (cases p, cases q) (simp add: quotient_of_Fract mult.commute)
 
 lemma [code]: "of_rat p = (let (a, b) = quotient_of p in of_int a / of_int b)"
   by (cases p) (simp add: quotient_of_Fract of_rat_rat)
 
 
 text \<open>Quickcheck\<close>
 
 context
   includes term_syntax
 begin
 
 definition
   valterm_fract :: "int \<times> (unit \<Rightarrow> Code_Evaluation.term) \<Rightarrow>
     int \<times> (unit \<Rightarrow> Code_Evaluation.term) \<Rightarrow>
     rat \<times> (unit \<Rightarrow> Code_Evaluation.term)"
   where [code_unfold]: "valterm_fract k l = Code_Evaluation.valtermify Fract {\<cdot>} k {\<cdot>} l"
 
 end
 
 instantiation rat :: random
 begin
 
 context
   includes state_combinator_syntax
 begin
 
 definition
   "Quickcheck_Random.random i =
     Quickcheck_Random.random i \<circ>\<rightarrow> (\<lambda>num. Random.range i \<circ>\<rightarrow> (\<lambda>denom. Pair
       (let j = int_of_integer (integer_of_natural (denom + 1))
        in valterm_fract num (j, \<lambda>u. Code_Evaluation.term_of j))))"
 
 instance ..
 
 end
 
 end
 
 instantiation rat :: exhaustive
 begin
 
 definition
   "exhaustive_rat f d =
     Quickcheck_Exhaustive.exhaustive
       (\<lambda>l. Quickcheck_Exhaustive.exhaustive
         (\<lambda>k. f (Fract k (int_of_integer (integer_of_natural l) + 1))) d) d"
 
 instance ..
 
 end
 
 instantiation rat :: full_exhaustive
 begin
 
 definition
   "full_exhaustive_rat f d =
     Quickcheck_Exhaustive.full_exhaustive
       (\<lambda>(l, _). Quickcheck_Exhaustive.full_exhaustive
         (\<lambda>k. f
           (let j = int_of_integer (integer_of_natural l) + 1
            in valterm_fract k (j, \<lambda>_. Code_Evaluation.term_of j))) d) d"
 
 instance ..
 
 end
 
 instance rat :: partial_term_of ..
 
 lemma [code]:
   "partial_term_of (ty :: rat itself) (Quickcheck_Narrowing.Narrowing_variable p tt) \<equiv>
     Code_Evaluation.Free (STR ''_'') (Typerep.Typerep (STR ''Rat.rat'') [])"
   "partial_term_of (ty :: rat itself) (Quickcheck_Narrowing.Narrowing_constructor 0 [l, k]) \<equiv>
     Code_Evaluation.App
       (Code_Evaluation.Const (STR ''Rat.Frct'')
         (Typerep.Typerep (STR ''fun'')
           [Typerep.Typerep (STR ''Product_Type.prod'')
            [Typerep.Typerep (STR ''Int.int'') [], Typerep.Typerep (STR ''Int.int'') []],
            Typerep.Typerep (STR ''Rat.rat'') []]))
       (Code_Evaluation.App
         (Code_Evaluation.App
           (Code_Evaluation.Const (STR ''Product_Type.Pair'')
             (Typerep.Typerep (STR ''fun'')
               [Typerep.Typerep (STR ''Int.int'') [],
                Typerep.Typerep (STR ''fun'')
                 [Typerep.Typerep (STR ''Int.int'') [],
                  Typerep.Typerep (STR ''Product_Type.prod'')
                  [Typerep.Typerep (STR ''Int.int'') [], Typerep.Typerep (STR ''Int.int'') []]]]))
           (partial_term_of (TYPE(int)) l)) (partial_term_of (TYPE(int)) k))"
   by (rule partial_term_of_anything)+
 
 instantiation rat :: narrowing
 begin
 
 definition
   "narrowing =
     Quickcheck_Narrowing.apply
       (Quickcheck_Narrowing.apply
         (Quickcheck_Narrowing.cons (\<lambda>nom denom. Fract nom denom)) narrowing) narrowing"
 
 instance ..
 
 end
 
 
 subsection \<open>Setup for Nitpick\<close>
 
 declaration \<open>
   Nitpick_HOL.register_frac_type \<^type_name>\<open>rat\<close>
     [(\<^const_name>\<open>Abs_Rat\<close>, \<^const_name>\<open>Nitpick.Abs_Frac\<close>),
      (\<^const_name>\<open>zero_rat_inst.zero_rat\<close>, \<^const_name>\<open>Nitpick.zero_frac\<close>),
      (\<^const_name>\<open>one_rat_inst.one_rat\<close>, \<^const_name>\<open>Nitpick.one_frac\<close>),
      (\<^const_name>\<open>plus_rat_inst.plus_rat\<close>, \<^const_name>\<open>Nitpick.plus_frac\<close>),
      (\<^const_name>\<open>times_rat_inst.times_rat\<close>, \<^const_name>\<open>Nitpick.times_frac\<close>),
      (\<^const_name>\<open>uminus_rat_inst.uminus_rat\<close>, \<^const_name>\<open>Nitpick.uminus_frac\<close>),
      (\<^const_name>\<open>inverse_rat_inst.inverse_rat\<close>, \<^const_name>\<open>Nitpick.inverse_frac\<close>),
      (\<^const_name>\<open>ord_rat_inst.less_rat\<close>, \<^const_name>\<open>Nitpick.less_frac\<close>),
      (\<^const_name>\<open>ord_rat_inst.less_eq_rat\<close>, \<^const_name>\<open>Nitpick.less_eq_frac\<close>),
      (\<^const_name>\<open>field_char_0_class.of_rat\<close>, \<^const_name>\<open>Nitpick.of_frac\<close>)]
 \<close>
 
 lemmas [nitpick_unfold] =
   inverse_rat_inst.inverse_rat
   one_rat_inst.one_rat ord_rat_inst.less_rat
   ord_rat_inst.less_eq_rat plus_rat_inst.plus_rat times_rat_inst.times_rat
   uminus_rat_inst.uminus_rat zero_rat_inst.zero_rat
 
 
 subsection \<open>Float syntax\<close>
 
 syntax "_Float" :: "float_const \<Rightarrow> 'a"    ("_")
 
 parse_translation \<open>
   let
     fun mk_frac str =
       let
         val {mant = i, exp = n} = Lexicon.read_float str;
         val exp = Syntax.const \<^const_syntax>\<open>Power.power\<close>;
         val ten = Numeral.mk_number_syntax 10;
         val exp10 = if n = 1 then ten else exp $ ten $ Numeral.mk_number_syntax n;
       in Syntax.const \<^const_syntax>\<open>Fields.inverse_divide\<close> $ Numeral.mk_number_syntax i $ exp10 end;
 
     fun float_tr [(c as Const (\<^syntax_const>\<open>_constrain\<close>, _)) $ t $ u] = c $ float_tr [t] $ u
       | float_tr [t as Const (str, _)] = mk_frac str
       | float_tr ts = raise TERM ("float_tr", ts);
   in [(\<^syntax_const>\<open>_Float\<close>, K float_tr)] end
 \<close>
 
 text\<open>Test:\<close>
 lemma "123.456 = -111.111 + 200 + 30 + 4 + 5/10 + 6/100 + (7/1000::rat)"
   by simp
 
 
 subsection \<open>Hiding implementation details\<close>
 
 hide_const (open) normalize positive
 
 lifting_update rat.lifting
 lifting_forget rat.lifting
 
 end
diff --git a/src/HOL/Real_Vector_Spaces.thy b/src/HOL/Real_Vector_Spaces.thy
--- a/src/HOL/Real_Vector_Spaces.thy
+++ b/src/HOL/Real_Vector_Spaces.thy
@@ -1,2382 +1,2399 @@
 (*  Title:      HOL/Real_Vector_Spaces.thy
     Author:     Brian Huffman
     Author:     Johannes Hölzl
 *)
 
 section \<open>Vector Spaces and Algebras over the Reals\<close>
 
 theory Real_Vector_Spaces              
 imports Real Topological_Spaces Vector_Spaces
 begin                                   
 
 subsection \<open>Real vector spaces\<close>
 
 class scaleR =
   fixes scaleR :: "real \<Rightarrow> 'a \<Rightarrow> 'a" (infixr "*\<^sub>R" 75)
 begin
 
 abbreviation divideR :: "'a \<Rightarrow> real \<Rightarrow> 'a"  (infixl "'/\<^sub>R" 70)
   where "x /\<^sub>R r \<equiv> inverse r *\<^sub>R x"
 
 end
 
 class real_vector = scaleR + ab_group_add +
   assumes scaleR_add_right: "a *\<^sub>R (x + y) = a *\<^sub>R x + a *\<^sub>R y"
   and scaleR_add_left: "(a + b) *\<^sub>R x = a *\<^sub>R x + b *\<^sub>R x"
   and scaleR_scaleR: "a *\<^sub>R b *\<^sub>R x = (a * b) *\<^sub>R x"
   and scaleR_one: "1 *\<^sub>R x = x"
 
 class real_algebra = real_vector + ring +
   assumes mult_scaleR_left [simp]: "a *\<^sub>R x * y = a *\<^sub>R (x * y)"
     and mult_scaleR_right [simp]: "x * a *\<^sub>R y = a *\<^sub>R (x * y)"
 
 class real_algebra_1 = real_algebra + ring_1
 
 class real_div_algebra = real_algebra_1 + division_ring
 
 class real_field = real_div_algebra + field
 
 instantiation real :: real_field
 begin
 
 definition real_scaleR_def [simp]: "scaleR a x = a * x"
 
 instance
   by standard (simp_all add: algebra_simps)
 
 end
 
 locale linear = Vector_Spaces.linear "scaleR::_\<Rightarrow>_\<Rightarrow>'a::real_vector" "scaleR::_\<Rightarrow>_\<Rightarrow>'b::real_vector"
 begin
 
 lemmas scaleR = scale
 
 end
 
 global_interpretation real_vector?: vector_space "scaleR :: real \<Rightarrow> 'a \<Rightarrow> 'a :: real_vector"
   rewrites "Vector_Spaces.linear (*\<^sub>R) (*\<^sub>R) = linear"
     and "Vector_Spaces.linear (*) (*\<^sub>R) = linear"
   defines dependent_raw_def: dependent = real_vector.dependent
     and representation_raw_def: representation = real_vector.representation
     and subspace_raw_def: subspace = real_vector.subspace
     and span_raw_def: span = real_vector.span
     and extend_basis_raw_def: extend_basis = real_vector.extend_basis
     and dim_raw_def: dim = real_vector.dim
 proof unfold_locales
   show "Vector_Spaces.linear (*\<^sub>R) (*\<^sub>R) = linear" "Vector_Spaces.linear (*) (*\<^sub>R) = linear"
     by (force simp: linear_def real_scaleR_def[abs_def])+
 qed (use scaleR_add_right scaleR_add_left scaleR_scaleR scaleR_one in auto)
 
 hide_const (open)\<comment> \<open>locale constants\<close>
   real_vector.dependent
   real_vector.independent
   real_vector.representation
   real_vector.subspace
   real_vector.span
   real_vector.extend_basis
   real_vector.dim
 
 abbreviation "independent x \<equiv> \<not> dependent x"
 
 global_interpretation real_vector?: vector_space_pair "scaleR::_\<Rightarrow>_\<Rightarrow>'a::real_vector" "scaleR::_\<Rightarrow>_\<Rightarrow>'b::real_vector"
   rewrites  "Vector_Spaces.linear (*\<^sub>R) (*\<^sub>R) = linear"
     and "Vector_Spaces.linear (*) (*\<^sub>R) = linear"
   defines construct_raw_def: construct = real_vector.construct
 proof unfold_locales
   show "Vector_Spaces.linear (*) (*\<^sub>R) = linear"
   unfolding linear_def real_scaleR_def by auto
 qed (auto simp: linear_def)
 
 hide_const (open)\<comment> \<open>locale constants\<close>
   real_vector.construct
 
 lemma linear_compose: "linear f \<Longrightarrow> linear g \<Longrightarrow> linear (g \<circ> f)"
   unfolding linear_def by (rule Vector_Spaces.linear_compose)
 
 text \<open>Recover original theorem names\<close>
 
 lemmas scaleR_left_commute = real_vector.scale_left_commute
 lemmas scaleR_zero_left = real_vector.scale_zero_left
 lemmas scaleR_minus_left = real_vector.scale_minus_left
 lemmas scaleR_diff_left = real_vector.scale_left_diff_distrib
 lemmas scaleR_sum_left = real_vector.scale_sum_left
 lemmas scaleR_zero_right = real_vector.scale_zero_right
 lemmas scaleR_minus_right = real_vector.scale_minus_right
 lemmas scaleR_diff_right = real_vector.scale_right_diff_distrib
 lemmas scaleR_sum_right = real_vector.scale_sum_right
 lemmas scaleR_eq_0_iff = real_vector.scale_eq_0_iff
 lemmas scaleR_left_imp_eq = real_vector.scale_left_imp_eq
 lemmas scaleR_right_imp_eq = real_vector.scale_right_imp_eq
 lemmas scaleR_cancel_left = real_vector.scale_cancel_left
 lemmas scaleR_cancel_right = real_vector.scale_cancel_right
 
 lemma [field_simps]:
   "c \<noteq> 0 \<Longrightarrow> a = b /\<^sub>R c \<longleftrightarrow> c *\<^sub>R a = b"
   "c \<noteq> 0 \<Longrightarrow> b /\<^sub>R c = a \<longleftrightarrow> b = c *\<^sub>R a"
   "c \<noteq> 0 \<Longrightarrow> a + b /\<^sub>R c = (c *\<^sub>R a + b) /\<^sub>R c"
   "c \<noteq> 0 \<Longrightarrow> a /\<^sub>R c + b = (a + c *\<^sub>R b) /\<^sub>R c"
   "c \<noteq> 0 \<Longrightarrow> a - b /\<^sub>R c = (c *\<^sub>R a - b) /\<^sub>R c"
   "c \<noteq> 0 \<Longrightarrow> a /\<^sub>R c - b = (a - c *\<^sub>R b) /\<^sub>R c"
   "c \<noteq> 0 \<Longrightarrow> - (a /\<^sub>R c) + b = (- a + c *\<^sub>R b) /\<^sub>R c"
   "c \<noteq> 0 \<Longrightarrow> - (a /\<^sub>R c) - b = (- a - c *\<^sub>R b) /\<^sub>R c"
   for a b :: "'a :: real_vector"
   by (auto simp add: scaleR_add_right scaleR_add_left scaleR_diff_right scaleR_diff_left)
 
 
 text \<open>Legacy names\<close>
 
 lemmas scaleR_left_distrib = scaleR_add_left
 lemmas scaleR_right_distrib = scaleR_add_right
 lemmas scaleR_left_diff_distrib = scaleR_diff_left
 lemmas scaleR_right_diff_distrib = scaleR_diff_right
 
 lemmas linear_injective_0 = linear_inj_iff_eq_0
   and linear_injective_on_subspace_0 = linear_inj_on_iff_eq_0
   and linear_cmul = linear_scale
   and linear_scaleR = linear_scale_self
   and subspace_mul = subspace_scale
   and span_linear_image = linear_span_image
   and span_0 = span_zero
   and span_mul = span_scale
   and injective_scaleR = injective_scale
 
 lemma scaleR_minus1_left [simp]: "scaleR (-1) x = - x"
   for x :: "'a::real_vector"
   using scaleR_minus_left [of 1 x] by simp
 
 lemma scaleR_2:
   fixes x :: "'a::real_vector"
   shows "scaleR 2 x = x + x"
   unfolding one_add_one [symmetric] scaleR_left_distrib by simp
 
 lemma scaleR_half_double [simp]:
   fixes a :: "'a::real_vector"
   shows "(1 / 2) *\<^sub>R (a + a) = a"
 proof -
   have "\<And>r. r *\<^sub>R (a + a) = (r * 2) *\<^sub>R a"
     by (metis scaleR_2 scaleR_scaleR)
   then show ?thesis
     by simp
 qed
 
 lemma linear_scale_real:
   fixes r::real shows "linear f \<Longrightarrow> f (r * b) = r * f b"
   using linear_scale by fastforce
 
 interpretation scaleR_left: additive "(\<lambda>a. scaleR a x :: 'a::real_vector)"
   by standard (rule scaleR_left_distrib)
 
 interpretation scaleR_right: additive "(\<lambda>x. scaleR a x :: 'a::real_vector)"
   by standard (rule scaleR_right_distrib)
 
 lemma nonzero_inverse_scaleR_distrib:
   "a \<noteq> 0 \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> inverse (scaleR a x) = scaleR (inverse a) (inverse x)"
   for x :: "'a::real_div_algebra"
   by (rule inverse_unique) simp
 
 lemma inverse_scaleR_distrib: "inverse (scaleR a x) = scaleR (inverse a) (inverse x)"
   for x :: "'a::{real_div_algebra,division_ring}"
   by (metis inverse_zero nonzero_inverse_scaleR_distrib scale_eq_0_iff)
 
 lemmas sum_constant_scaleR = real_vector.sum_constant_scale\<comment> \<open>legacy name\<close>
 
 named_theorems vector_add_divide_simps "to simplify sums of scaled vectors"
 
 lemma [vector_add_divide_simps]:
   "v + (b / z) *\<^sub>R w = (if z = 0 then v else (z *\<^sub>R v + b *\<^sub>R w) /\<^sub>R z)"
   "a *\<^sub>R v + (b / z) *\<^sub>R w = (if z = 0 then a *\<^sub>R v else ((a * z) *\<^sub>R v + b *\<^sub>R w) /\<^sub>R z)"
   "(a / z) *\<^sub>R v + w = (if z = 0 then w else (a *\<^sub>R v + z *\<^sub>R w) /\<^sub>R z)"
   "(a / z) *\<^sub>R v + b *\<^sub>R w = (if z = 0 then b *\<^sub>R w else (a *\<^sub>R v + (b * z) *\<^sub>R w) /\<^sub>R z)"
   "v - (b / z) *\<^sub>R w = (if z = 0 then v else (z *\<^sub>R v - b *\<^sub>R w) /\<^sub>R z)"
   "a *\<^sub>R v - (b / z) *\<^sub>R w = (if z = 0 then a *\<^sub>R v else ((a * z) *\<^sub>R v - b *\<^sub>R w) /\<^sub>R z)"
   "(a / z) *\<^sub>R v - w = (if z = 0 then -w else (a *\<^sub>R v - z *\<^sub>R w) /\<^sub>R z)"
   "(a / z) *\<^sub>R v - b *\<^sub>R w = (if z = 0 then -b *\<^sub>R w else (a *\<^sub>R v - (b * z) *\<^sub>R w) /\<^sub>R z)"
   for v :: "'a :: real_vector"
   by (simp_all add: divide_inverse_commute scaleR_add_right scaleR_diff_right)
 
 
 lemma eq_vector_fraction_iff [vector_add_divide_simps]:
   fixes x :: "'a :: real_vector"
   shows "(x = (u / v) *\<^sub>R a) \<longleftrightarrow> (if v=0 then x = 0 else v *\<^sub>R x = u *\<^sub>R a)"
 by auto (metis (no_types) divide_eq_1_iff divide_inverse_commute scaleR_one scaleR_scaleR)
 
 lemma vector_fraction_eq_iff [vector_add_divide_simps]:
   fixes x :: "'a :: real_vector"
   shows "((u / v) *\<^sub>R a = x) \<longleftrightarrow> (if v=0 then x = 0 else u *\<^sub>R a = v *\<^sub>R x)"
 by (metis eq_vector_fraction_iff)
 
 lemma real_vector_affinity_eq:
   fixes x :: "'a :: real_vector"
   assumes m0: "m \<noteq> 0"
   shows "m *\<^sub>R x + c = y \<longleftrightarrow> x = inverse m *\<^sub>R y - (inverse m *\<^sub>R c)"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   then have "m *\<^sub>R x = y - c" by (simp add: field_simps)
   then have "inverse m *\<^sub>R (m *\<^sub>R x) = inverse m *\<^sub>R (y - c)" by simp
   then show "x = inverse m *\<^sub>R y - (inverse m *\<^sub>R c)"
     using m0
   by (simp add: scaleR_diff_right)
 next
   assume ?rhs
   with m0 show "m *\<^sub>R x + c = y"
     by (simp add: scaleR_diff_right)
 qed
 
 lemma real_vector_eq_affinity: "m \<noteq> 0 \<Longrightarrow> y = m *\<^sub>R x + c \<longleftrightarrow> inverse m *\<^sub>R y - (inverse m *\<^sub>R c) = x"
   for x :: "'a::real_vector"
   using real_vector_affinity_eq[where m=m and x=x and y=y and c=c]
   by metis
 
 lemma scaleR_eq_iff [simp]: "b + u *\<^sub>R a = a + u *\<^sub>R b \<longleftrightarrow> a = b \<or> u = 1"
   for a :: "'a::real_vector"
 proof (cases "u = 1")
   case True
   then show ?thesis by auto
 next
   case False
   have "a = b" if "b + u *\<^sub>R a = a + u *\<^sub>R b"
   proof -
     from that have "(u - 1) *\<^sub>R a = (u - 1) *\<^sub>R b"
       by (simp add: algebra_simps)
     with False show ?thesis
       by auto
   qed
   then show ?thesis by auto
 qed
 
 lemma scaleR_collapse [simp]: "(1 - u) *\<^sub>R a + u *\<^sub>R a = a"
   for a :: "'a::real_vector"
   by (simp add: algebra_simps)
 
 
 subsection \<open>Embedding of the Reals into any \<open>real_algebra_1\<close>: \<open>of_real\<close>\<close>
 
 definition of_real :: "real \<Rightarrow> 'a::real_algebra_1"
   where "of_real r = scaleR r 1"
 
 lemma scaleR_conv_of_real: "scaleR r x = of_real r * x"
   by (simp add: of_real_def)
 
 lemma of_real_0 [simp]: "of_real 0 = 0"
   by (simp add: of_real_def)
 
 lemma of_real_1 [simp]: "of_real 1 = 1"
   by (simp add: of_real_def)
 
 lemma of_real_add [simp]: "of_real (x + y) = of_real x + of_real y"
   by (simp add: of_real_def scaleR_left_distrib)
 
 lemma of_real_minus [simp]: "of_real (- x) = - of_real x"
   by (simp add: of_real_def)
 
 lemma of_real_diff [simp]: "of_real (x - y) = of_real x - of_real y"
   by (simp add: of_real_def scaleR_left_diff_distrib)
 
 lemma of_real_mult [simp]: "of_real (x * y) = of_real x * of_real y"
   by (simp add: of_real_def)
 
 lemma of_real_sum[simp]: "of_real (sum f s) = (\<Sum>x\<in>s. of_real (f x))"
   by (induct s rule: infinite_finite_induct) auto
 
 lemma of_real_prod[simp]: "of_real (prod f s) = (\<Prod>x\<in>s. of_real (f x))"
   by (induct s rule: infinite_finite_induct) auto
 
 lemma nonzero_of_real_inverse:
   "x \<noteq> 0 \<Longrightarrow> of_real (inverse x) = inverse (of_real x :: 'a::real_div_algebra)"
   by (simp add: of_real_def nonzero_inverse_scaleR_distrib)
 
 lemma of_real_inverse [simp]:
   "of_real (inverse x) = inverse (of_real x :: 'a::{real_div_algebra,division_ring})"
   by (simp add: of_real_def inverse_scaleR_distrib)
 
 lemma nonzero_of_real_divide:
   "y \<noteq> 0 \<Longrightarrow> of_real (x / y) = (of_real x / of_real y :: 'a::real_field)"
   by (simp add: divide_inverse nonzero_of_real_inverse)
 
 lemma of_real_divide [simp]:
   "of_real (x / y) = (of_real x / of_real y :: 'a::real_div_algebra)"
   by (simp add: divide_inverse)
 
 lemma of_real_power [simp]:
   "of_real (x ^ n) = (of_real x :: 'a::{real_algebra_1}) ^ n"
   by (induct n) simp_all
 
 lemma of_real_power_int [simp]:
   "of_real (power_int x n) = power_int (of_real x :: 'a :: {real_div_algebra,division_ring}) n"
   by (auto simp: power_int_def)
 
 lemma of_real_eq_iff [simp]: "of_real x = of_real y \<longleftrightarrow> x = y"
   by (simp add: of_real_def)
 
 lemma inj_of_real: "inj of_real"
   by (auto intro: injI)
 
 lemmas of_real_eq_0_iff [simp] = of_real_eq_iff [of _ 0, simplified]
 lemmas of_real_eq_1_iff [simp] = of_real_eq_iff [of _ 1, simplified]
 
 lemma minus_of_real_eq_of_real_iff [simp]: "-of_real x = of_real y \<longleftrightarrow> -x = y"
   using of_real_eq_iff[of "-x" y] by (simp only: of_real_minus)
 
 lemma of_real_eq_minus_of_real_iff [simp]: "of_real x = -of_real y \<longleftrightarrow> x = -y"
   using of_real_eq_iff[of x "-y"] by (simp only: of_real_minus)
 
 lemma of_real_eq_id [simp]: "of_real = (id :: real \<Rightarrow> real)"
   by (rule ext) (simp add: of_real_def)
 
 text \<open>Collapse nested embeddings.\<close>
 lemma of_real_of_nat_eq [simp]: "of_real (of_nat n) = of_nat n"
   by (induct n) auto
 
 lemma of_real_of_int_eq [simp]: "of_real (of_int z) = of_int z"
   by (cases z rule: int_diff_cases) simp
 
 lemma of_real_numeral [simp]: "of_real (numeral w) = numeral w"
   using of_real_of_int_eq [of "numeral w"] by simp
 
 lemma of_real_neg_numeral [simp]: "of_real (- numeral w) = - numeral w"
   using of_real_of_int_eq [of "- numeral w"] by simp
 
 lemma numeral_power_int_eq_of_real_cancel_iff [simp]:
   "power_int (numeral x) n = (of_real y :: 'a :: {real_div_algebra, division_ring}) \<longleftrightarrow>
      power_int (numeral x) n = y"
 proof -
   have "power_int (numeral x) n = (of_real (power_int (numeral x) n) :: 'a)"
     by simp
   also have "\<dots> = of_real y \<longleftrightarrow> power_int (numeral x) n = y"
     by (subst of_real_eq_iff) auto
   finally show ?thesis .
 qed
 
 lemma of_real_eq_numeral_power_int_cancel_iff [simp]:
   "(of_real y :: 'a :: {real_div_algebra, division_ring}) = power_int (numeral x) n \<longleftrightarrow>
      y = power_int (numeral x) n"
   by (subst (1 2) eq_commute) simp
 
 lemma of_real_eq_of_real_power_int_cancel_iff [simp]:
   "power_int (of_real b :: 'a :: {real_div_algebra, division_ring}) w = of_real x \<longleftrightarrow>
      power_int b w = x"
   by (metis of_real_power_int of_real_eq_iff)
 
+lemma of_real_in_Ints_iff [simp]: "of_real x \<in> \<int> \<longleftrightarrow> x \<in> \<int>"
+proof safe
+  fix x assume "(of_real x :: 'a) \<in> \<int>"
+  then obtain n where "(of_real x :: 'a) = of_int n"
+    by (auto simp: Ints_def)
+  also have "of_int n = of_real (real_of_int n)"
+    by simp
+  finally have "x = real_of_int n"
+    by (subst (asm) of_real_eq_iff)
+  thus "x \<in> \<int>"
+    by auto
+qed (auto simp: Ints_def)
+
+lemma Ints_of_real [intro]: "x \<in> \<int> \<Longrightarrow> of_real x \<in> \<int>"
+  by simp
+
+
 text \<open>Every real algebra has characteristic zero.\<close>
 instance real_algebra_1 < ring_char_0
 proof
   from inj_of_real inj_of_nat have "inj (of_real \<circ> of_nat)"
     by (rule inj_compose)
   then show "inj (of_nat :: nat \<Rightarrow> 'a)"
     by (simp add: comp_def)
 qed
 
 lemma fraction_scaleR_times [simp]:
   fixes a :: "'a::real_algebra_1"
   shows "(numeral u / numeral v) *\<^sub>R (numeral w * a) = (numeral u * numeral w / numeral v) *\<^sub>R a"
 by (metis (no_types, lifting) of_real_numeral scaleR_conv_of_real scaleR_scaleR times_divide_eq_left)
 
 lemma inverse_scaleR_times [simp]:
   fixes a :: "'a::real_algebra_1"
   shows "(1 / numeral v) *\<^sub>R (numeral w * a) = (numeral w / numeral v) *\<^sub>R a"
 by (metis divide_inverse_commute inverse_eq_divide of_real_numeral scaleR_conv_of_real scaleR_scaleR)
 
 lemma scaleR_times [simp]:
   fixes a :: "'a::real_algebra_1"
   shows "(numeral u) *\<^sub>R (numeral w * a) = (numeral u * numeral w) *\<^sub>R a"
 by (simp add: scaleR_conv_of_real)
 
 instance real_field < field_char_0 ..
 
 
 subsection \<open>The Set of Real Numbers\<close>
 
 definition Reals :: "'a::real_algebra_1 set"  ("\<real>")
   where "\<real> = range of_real"
 
 lemma Reals_of_real [simp]: "of_real r \<in> \<real>"
   by (simp add: Reals_def)
 
 lemma Reals_of_int [simp]: "of_int z \<in> \<real>"
   by (subst of_real_of_int_eq [symmetric], rule Reals_of_real)
 
 lemma Reals_of_nat [simp]: "of_nat n \<in> \<real>"
   by (subst of_real_of_nat_eq [symmetric], rule Reals_of_real)
 
 lemma Reals_numeral [simp]: "numeral w \<in> \<real>"
   by (subst of_real_numeral [symmetric], rule Reals_of_real)
 
 lemma Reals_0 [simp]: "0 \<in> \<real>" and Reals_1 [simp]: "1 \<in> \<real>"
   by (simp_all add: Reals_def)
 
 lemma Reals_add [simp]: "a \<in> \<real> \<Longrightarrow> b \<in> \<real> \<Longrightarrow> a + b \<in> \<real>"
   by (metis (no_types, hide_lams) Reals_def Reals_of_real imageE of_real_add)
 
 lemma Reals_minus [simp]: "a \<in> \<real> \<Longrightarrow> - a \<in> \<real>"
   by (auto simp: Reals_def)
 
 lemma Reals_minus_iff [simp]: "- a \<in> \<real> \<longleftrightarrow> a \<in> \<real>"
   using Reals_minus by fastforce
 
 lemma Reals_diff [simp]: "a \<in> \<real> \<Longrightarrow> b \<in> \<real> \<Longrightarrow> a - b \<in> \<real>"
   by (metis Reals_add Reals_minus_iff add_uminus_conv_diff)
 
 lemma Reals_mult [simp]: "a \<in> \<real> \<Longrightarrow> b \<in> \<real> \<Longrightarrow> a * b \<in> \<real>"
   by (metis (no_types, lifting) Reals_def Reals_of_real imageE of_real_mult)
 
 lemma nonzero_Reals_inverse: "a \<in> \<real> \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> inverse a \<in> \<real>"
   for a :: "'a::real_div_algebra"
   by (metis Reals_def Reals_of_real imageE of_real_inverse)
 
 lemma Reals_inverse: "a \<in> \<real> \<Longrightarrow> inverse a \<in> \<real>"
   for a :: "'a::{real_div_algebra,division_ring}"
   using nonzero_Reals_inverse by fastforce
 
 lemma Reals_inverse_iff [simp]: "inverse x \<in> \<real> \<longleftrightarrow> x \<in> \<real>"
   for x :: "'a::{real_div_algebra,division_ring}"
   by (metis Reals_inverse inverse_inverse_eq)
 
 lemma nonzero_Reals_divide: "a \<in> \<real> \<Longrightarrow> b \<in> \<real> \<Longrightarrow> b \<noteq> 0 \<Longrightarrow> a / b \<in> \<real>"
   for a b :: "'a::real_field"
   by (simp add: divide_inverse)
 
 lemma Reals_divide [simp]: "a \<in> \<real> \<Longrightarrow> b \<in> \<real> \<Longrightarrow> a / b \<in> \<real>"
   for a b :: "'a::{real_field,field}"
   using nonzero_Reals_divide by fastforce
 
 lemma Reals_power [simp]: "a \<in> \<real> \<Longrightarrow> a ^ n \<in> \<real>"
   for a :: "'a::real_algebra_1"
   by (metis Reals_def Reals_of_real imageE of_real_power)
 
 lemma Reals_cases [cases set: Reals]:
   assumes "q \<in> \<real>"
   obtains (of_real) r where "q = of_real r"
   unfolding Reals_def
 proof -
   from \<open>q \<in> \<real>\<close> have "q \<in> range of_real" unfolding Reals_def .
   then obtain r where "q = of_real r" ..
   then show thesis ..
 qed
 
 lemma sum_in_Reals [intro,simp]: "(\<And>i. i \<in> s \<Longrightarrow> f i \<in> \<real>) \<Longrightarrow> sum f s \<in> \<real>"
 proof (induct s rule: infinite_finite_induct)
   case infinite
   then show ?case by (metis Reals_0 sum.infinite)
 qed simp_all
 
 lemma prod_in_Reals [intro,simp]: "(\<And>i. i \<in> s \<Longrightarrow> f i \<in> \<real>) \<Longrightarrow> prod f s \<in> \<real>"
 proof (induct s rule: infinite_finite_induct)
   case infinite
   then show ?case by (metis Reals_1 prod.infinite)
 qed simp_all
 
 lemma Reals_induct [case_names of_real, induct set: Reals]:
   "q \<in> \<real> \<Longrightarrow> (\<And>r. P (of_real r)) \<Longrightarrow> P q"
   by (rule Reals_cases) auto
 
 
 subsection \<open>Ordered real vector spaces\<close>
 
 class ordered_real_vector = real_vector + ordered_ab_group_add +
   assumes scaleR_left_mono: "x \<le> y \<Longrightarrow> 0 \<le> a \<Longrightarrow> a *\<^sub>R x \<le> a *\<^sub>R y"
     and scaleR_right_mono: "a \<le> b \<Longrightarrow> 0 \<le> x \<Longrightarrow> a *\<^sub>R x \<le> b *\<^sub>R x"
 begin
 
 lemma scaleR_mono:
   "a \<le> b \<Longrightarrow> x \<le> y \<Longrightarrow> 0 \<le> b \<Longrightarrow> 0 \<le> x \<Longrightarrow> a *\<^sub>R x \<le> b *\<^sub>R y"
   by (meson order_trans scaleR_left_mono scaleR_right_mono)
   
 lemma scaleR_mono':
   "a \<le> b \<Longrightarrow> c \<le> d \<Longrightarrow> 0 \<le> a \<Longrightarrow> 0 \<le> c \<Longrightarrow> a *\<^sub>R c \<le> b *\<^sub>R d"
   by (rule scaleR_mono) (auto intro: order.trans)
 
 lemma pos_le_divideR_eq [field_simps]:
   "a \<le> b /\<^sub>R c \<longleftrightarrow> c *\<^sub>R a \<le> b" (is "?P \<longleftrightarrow> ?Q") if "0 < c"
 proof
   assume ?P
   with scaleR_left_mono that have "c *\<^sub>R a \<le> c *\<^sub>R (b /\<^sub>R c)"
     by simp
   with that show ?Q
     by (simp add: scaleR_one scaleR_scaleR inverse_eq_divide)
 next
   assume ?Q
   with scaleR_left_mono that have "c *\<^sub>R a /\<^sub>R c \<le> b /\<^sub>R c"
     by simp
   with that show ?P
     by (simp add: scaleR_one scaleR_scaleR inverse_eq_divide)
 qed
 
 lemma pos_less_divideR_eq [field_simps]:
   "a < b /\<^sub>R c \<longleftrightarrow> c *\<^sub>R a < b" if "c > 0"
   using that pos_le_divideR_eq [of c a b]
   by (auto simp add: le_less scaleR_scaleR scaleR_one)
 
 lemma pos_divideR_le_eq [field_simps]:
   "b /\<^sub>R c \<le> a \<longleftrightarrow> b \<le> c *\<^sub>R a" if "c > 0"
   using that pos_le_divideR_eq [of "inverse c" b a] by simp
 
 lemma pos_divideR_less_eq [field_simps]:
   "b /\<^sub>R c < a \<longleftrightarrow> b < c *\<^sub>R a" if "c > 0"
   using that pos_less_divideR_eq [of "inverse c" b a] by simp
 
 lemma pos_le_minus_divideR_eq [field_simps]:
   "a \<le> - (b /\<^sub>R c) \<longleftrightarrow> c *\<^sub>R a \<le> - b" if "c > 0"
   using that by (metis add_minus_cancel diff_0 left_minus minus_minus neg_le_iff_le
     scaleR_add_right uminus_add_conv_diff pos_le_divideR_eq)
   
 lemma pos_less_minus_divideR_eq [field_simps]:
   "a < - (b /\<^sub>R c) \<longleftrightarrow> c *\<^sub>R a < - b" if "c > 0"
   using that by (metis le_less less_le_not_le pos_divideR_le_eq
     pos_divideR_less_eq pos_le_minus_divideR_eq)
 
 lemma pos_minus_divideR_le_eq [field_simps]:
   "- (b /\<^sub>R c) \<le> a \<longleftrightarrow> - b \<le> c *\<^sub>R a" if "c > 0"
   using that by (metis pos_divideR_le_eq pos_le_minus_divideR_eq that
     inverse_positive_iff_positive le_imp_neg_le minus_minus)
 
 lemma pos_minus_divideR_less_eq [field_simps]:
   "- (b /\<^sub>R c) < a \<longleftrightarrow> - b < c *\<^sub>R a" if "c > 0"
   using that by (simp add: less_le_not_le pos_le_minus_divideR_eq pos_minus_divideR_le_eq) 
 
 lemma scaleR_image_atLeastAtMost: "c > 0 \<Longrightarrow> scaleR c ` {x..y} = {c *\<^sub>R x..c *\<^sub>R y}"
   apply (auto intro!: scaleR_left_mono simp: image_iff Bex_def)
   by (meson local.eq_iff pos_divideR_le_eq pos_le_divideR_eq)
 
 end
 
 lemma neg_le_divideR_eq [field_simps]:
   "a \<le> b /\<^sub>R c \<longleftrightarrow> b \<le> c *\<^sub>R a" (is "?P \<longleftrightarrow> ?Q") if "c < 0"
     for a b :: "'a :: ordered_real_vector"
   using that pos_le_divideR_eq [of "- c" a "- b"] by simp
 
 lemma neg_less_divideR_eq [field_simps]:
   "a < b /\<^sub>R c \<longleftrightarrow> b < c *\<^sub>R a" if "c < 0"
     for a b :: "'a :: ordered_real_vector"
   using that neg_le_divideR_eq [of c a b] by (auto simp add: le_less)
 
 lemma neg_divideR_le_eq [field_simps]:
   "b /\<^sub>R c \<le> a \<longleftrightarrow> c *\<^sub>R a \<le> b" if "c < 0"
     for a b :: "'a :: ordered_real_vector"
   using that pos_divideR_le_eq [of "- c" "- b" a] by simp
 
 lemma neg_divideR_less_eq [field_simps]:
   "b /\<^sub>R c < a \<longleftrightarrow> c *\<^sub>R a < b" if "c < 0"
     for a b :: "'a :: ordered_real_vector"
   using that neg_divideR_le_eq [of c b a] by (auto simp add: le_less)
 
 lemma neg_le_minus_divideR_eq [field_simps]:
   "a \<le> - (b /\<^sub>R c) \<longleftrightarrow> - b \<le> c *\<^sub>R a" if "c < 0"
     for a b :: "'a :: ordered_real_vector"
   using that pos_le_minus_divideR_eq [of "- c" a "- b"] by (simp add: minus_le_iff)
   
 lemma neg_less_minus_divideR_eq [field_simps]:
   "a < - (b /\<^sub>R c) \<longleftrightarrow> - b < c *\<^sub>R a" if "c < 0"
    for a b :: "'a :: ordered_real_vector"
 proof -
   have *: "- b = c *\<^sub>R a \<longleftrightarrow> b = - (c *\<^sub>R a)"
     by (metis add.inverse_inverse)
   from that neg_le_minus_divideR_eq [of c a b]
   show ?thesis by (auto simp add: le_less *)
 qed
 
 lemma neg_minus_divideR_le_eq [field_simps]:
   "- (b /\<^sub>R c) \<le> a \<longleftrightarrow> c *\<^sub>R a \<le> - b" if "c < 0"
     for a b :: "'a :: ordered_real_vector"
   using that pos_minus_divideR_le_eq [of "- c" "- b" a] by (simp add: le_minus_iff) 
 
 lemma neg_minus_divideR_less_eq [field_simps]:
   "- (b /\<^sub>R c) < a \<longleftrightarrow> c *\<^sub>R a < - b" if "c < 0"
     for a b :: "'a :: ordered_real_vector"
   using that by (simp add: less_le_not_le neg_le_minus_divideR_eq neg_minus_divideR_le_eq)
 
 lemma [field_split_simps]:
   "a = b /\<^sub>R c \<longleftrightarrow> (if c = 0 then a = 0 else c *\<^sub>R a = b)"
   "b /\<^sub>R c = a \<longleftrightarrow> (if c = 0 then a = 0 else b = c *\<^sub>R a)"
   "a + b /\<^sub>R c = (if c = 0 then a else (c *\<^sub>R a + b) /\<^sub>R c)"
   "a /\<^sub>R c + b = (if c = 0 then b else (a + c *\<^sub>R b) /\<^sub>R c)"
   "a - b /\<^sub>R c = (if c = 0 then a else (c *\<^sub>R a - b) /\<^sub>R c)"
   "a /\<^sub>R c - b = (if c = 0 then - b else (a - c *\<^sub>R b) /\<^sub>R c)"
   "- (a /\<^sub>R c) + b = (if c = 0 then b else (- a + c *\<^sub>R b) /\<^sub>R c)"
   "- (a /\<^sub>R c) - b = (if c = 0 then - b else (- a - c *\<^sub>R b) /\<^sub>R c)"
     for a b :: "'a :: real_vector"
   by (auto simp add: field_simps)
 
 lemma [field_split_simps]:
   "0 < c \<Longrightarrow> a \<le> b /\<^sub>R c \<longleftrightarrow> (if c > 0 then c *\<^sub>R a \<le> b else if c < 0 then b \<le> c *\<^sub>R a else a \<le> 0)"
   "0 < c \<Longrightarrow> a < b /\<^sub>R c \<longleftrightarrow> (if c > 0 then c *\<^sub>R a < b else if c < 0 then b < c *\<^sub>R a else a < 0)"
   "0 < c \<Longrightarrow> b /\<^sub>R c \<le> a \<longleftrightarrow> (if c > 0 then b \<le> c *\<^sub>R a else if c < 0 then c *\<^sub>R a \<le> b else a \<ge> 0)"
   "0 < c \<Longrightarrow> b /\<^sub>R c < a \<longleftrightarrow> (if c > 0 then b < c *\<^sub>R a else if c < 0 then c *\<^sub>R a < b else a > 0)"
   "0 < c \<Longrightarrow> a \<le> - (b /\<^sub>R c) \<longleftrightarrow> (if c > 0 then c *\<^sub>R a \<le> - b else if c < 0 then - b \<le> c *\<^sub>R a else a \<le> 0)"
   "0 < c \<Longrightarrow> a < - (b /\<^sub>R c) \<longleftrightarrow> (if c > 0 then c *\<^sub>R a < - b else if c < 0 then - b < c *\<^sub>R a else a < 0)"
   "0 < c \<Longrightarrow> - (b /\<^sub>R c) \<le> a \<longleftrightarrow> (if c > 0 then - b \<le> c *\<^sub>R a else if c < 0 then c *\<^sub>R a \<le> - b else a \<ge> 0)"
   "0 < c \<Longrightarrow> - (b /\<^sub>R c) < a \<longleftrightarrow> (if c > 0 then - b < c *\<^sub>R a else if c < 0 then c *\<^sub>R a < - b else a > 0)"
   for a b :: "'a :: ordered_real_vector"
   by (clarsimp intro!: field_simps)+
 
 lemma scaleR_nonneg_nonneg: "0 \<le> a \<Longrightarrow> 0 \<le> x \<Longrightarrow> 0 \<le> a *\<^sub>R x"
   for x :: "'a::ordered_real_vector"
   using scaleR_left_mono [of 0 x a] by simp
 
 lemma scaleR_nonneg_nonpos: "0 \<le> a \<Longrightarrow> x \<le> 0 \<Longrightarrow> a *\<^sub>R x \<le> 0"
   for x :: "'a::ordered_real_vector"
   using scaleR_left_mono [of x 0 a] by simp
 
 lemma scaleR_nonpos_nonneg: "a \<le> 0 \<Longrightarrow> 0 \<le> x \<Longrightarrow> a *\<^sub>R x \<le> 0"
   for x :: "'a::ordered_real_vector"
   using scaleR_right_mono [of a 0 x] by simp
 
 lemma split_scaleR_neg_le: "(0 \<le> a \<and> x \<le> 0) \<or> (a \<le> 0 \<and> 0 \<le> x) \<Longrightarrow> a *\<^sub>R x \<le> 0"
   for x :: "'a::ordered_real_vector"
   by (auto simp: scaleR_nonneg_nonpos scaleR_nonpos_nonneg)
 
 lemma le_add_iff1: "a *\<^sub>R e + c \<le> b *\<^sub>R e + d \<longleftrightarrow> (a - b) *\<^sub>R e + c \<le> d"
   for c d e :: "'a::ordered_real_vector"
   by (simp add: algebra_simps)
 
 lemma le_add_iff2: "a *\<^sub>R e + c \<le> b *\<^sub>R e + d \<longleftrightarrow> c \<le> (b - a) *\<^sub>R e + d"
   for c d e :: "'a::ordered_real_vector"
   by (simp add: algebra_simps)
 
 lemma scaleR_left_mono_neg: "b \<le> a \<Longrightarrow> c \<le> 0 \<Longrightarrow> c *\<^sub>R a \<le> c *\<^sub>R b"
   for a b :: "'a::ordered_real_vector"
   by (drule scaleR_left_mono [of _ _ "- c"], simp_all)
 
 lemma scaleR_right_mono_neg: "b \<le> a \<Longrightarrow> c \<le> 0 \<Longrightarrow> a *\<^sub>R c \<le> b *\<^sub>R c"
   for c :: "'a::ordered_real_vector"
   by (drule scaleR_right_mono [of _ _ "- c"], simp_all)
 
 lemma scaleR_nonpos_nonpos: "a \<le> 0 \<Longrightarrow> b \<le> 0 \<Longrightarrow> 0 \<le> a *\<^sub>R b"
   for b :: "'a::ordered_real_vector"
   using scaleR_right_mono_neg [of a 0 b] by simp
 
 lemma split_scaleR_pos_le: "(0 \<le> a \<and> 0 \<le> b) \<or> (a \<le> 0 \<and> b \<le> 0) \<Longrightarrow> 0 \<le> a *\<^sub>R b"
   for b :: "'a::ordered_real_vector"
   by (auto simp: scaleR_nonneg_nonneg scaleR_nonpos_nonpos)
 
 lemma zero_le_scaleR_iff:
   fixes b :: "'a::ordered_real_vector"
   shows "0 \<le> a *\<^sub>R b \<longleftrightarrow> 0 < a \<and> 0 \<le> b \<or> a < 0 \<and> b \<le> 0 \<or> a = 0"
     (is "?lhs = ?rhs")
 proof (cases "a = 0")
   case True
   then show ?thesis by simp
 next
   case False
   show ?thesis
   proof
     assume ?lhs
     from \<open>a \<noteq> 0\<close> consider "a > 0" | "a < 0" by arith
     then show ?rhs
     proof cases
       case 1
       with \<open>?lhs\<close> have "inverse a *\<^sub>R 0 \<le> inverse a *\<^sub>R (a *\<^sub>R b)"
         by (intro scaleR_mono) auto
       with 1 show ?thesis
         by simp
     next
       case 2
       with \<open>?lhs\<close> have "- inverse a *\<^sub>R 0 \<le> - inverse a *\<^sub>R (a *\<^sub>R b)"
         by (intro scaleR_mono) auto
       with 2 show ?thesis
         by simp
     qed
   next
     assume ?rhs
     then show ?lhs
       by (auto simp: not_le \<open>a \<noteq> 0\<close> intro!: split_scaleR_pos_le)
   qed
 qed
 
 lemma scaleR_le_0_iff: "a *\<^sub>R b \<le> 0 \<longleftrightarrow> 0 < a \<and> b \<le> 0 \<or> a < 0 \<and> 0 \<le> b \<or> a = 0"
   for b::"'a::ordered_real_vector"
   by (insert zero_le_scaleR_iff [of "-a" b]) force
 
 lemma scaleR_le_cancel_left: "c *\<^sub>R a \<le> c *\<^sub>R b \<longleftrightarrow> (0 < c \<longrightarrow> a \<le> b) \<and> (c < 0 \<longrightarrow> b \<le> a)"
   for b :: "'a::ordered_real_vector"
   by (auto simp: neq_iff scaleR_left_mono scaleR_left_mono_neg
       dest: scaleR_left_mono[where a="inverse c"] scaleR_left_mono_neg[where c="inverse c"])
 
 lemma scaleR_le_cancel_left_pos: "0 < c \<Longrightarrow> c *\<^sub>R a \<le> c *\<^sub>R b \<longleftrightarrow> a \<le> b"
   for b :: "'a::ordered_real_vector"
   by (auto simp: scaleR_le_cancel_left)
 
 lemma scaleR_le_cancel_left_neg: "c < 0 \<Longrightarrow> c *\<^sub>R a \<le> c *\<^sub>R b \<longleftrightarrow> b \<le> a"
   for b :: "'a::ordered_real_vector"
   by (auto simp: scaleR_le_cancel_left)
 
 lemma scaleR_left_le_one_le: "0 \<le> x \<Longrightarrow> a \<le> 1 \<Longrightarrow> a *\<^sub>R x \<le> x"
   for x :: "'a::ordered_real_vector" and a :: real
   using scaleR_right_mono[of a 1 x] by simp
 
 
 subsection \<open>Real normed vector spaces\<close>
 
 class dist =
   fixes dist :: "'a \<Rightarrow> 'a \<Rightarrow> real"
 
 class norm =
   fixes norm :: "'a \<Rightarrow> real"
 
 class sgn_div_norm = scaleR + norm + sgn +
   assumes sgn_div_norm: "sgn x = x /\<^sub>R norm x"
 
 class dist_norm = dist + norm + minus +
   assumes dist_norm: "dist x y = norm (x - y)"
 
 class uniformity_dist = dist + uniformity +
   assumes uniformity_dist: "uniformity = (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})"
 begin
 
 lemma eventually_uniformity_metric:
   "eventually P uniformity \<longleftrightarrow> (\<exists>e>0. \<forall>x y. dist x y < e \<longrightarrow> P (x, y))"
   unfolding uniformity_dist
   by (subst eventually_INF_base)
      (auto simp: eventually_principal subset_eq intro: bexI[of _ "min _ _"])
 
 end
 
 class real_normed_vector = real_vector + sgn_div_norm + dist_norm + uniformity_dist + open_uniformity +
   assumes norm_eq_zero [simp]: "norm x = 0 \<longleftrightarrow> x = 0"
     and norm_triangle_ineq: "norm (x + y) \<le> norm x + norm y"
     and norm_scaleR [simp]: "norm (scaleR a x) = \<bar>a\<bar> * norm x"
 begin
 
 lemma norm_ge_zero [simp]: "0 \<le> norm x"
 proof -
   have "0 = norm (x + -1 *\<^sub>R x)"
     using scaleR_add_left[of 1 "-1" x] norm_scaleR[of 0 x] by (simp add: scaleR_one)
   also have "\<dots> \<le> norm x + norm (-1 *\<^sub>R x)" by (rule norm_triangle_ineq)
   finally show ?thesis by simp
 qed
 
 end
 
 class real_normed_algebra = real_algebra + real_normed_vector +
   assumes norm_mult_ineq: "norm (x * y) \<le> norm x * norm y"
 
 class real_normed_algebra_1 = real_algebra_1 + real_normed_algebra +
   assumes norm_one [simp]: "norm 1 = 1"
 
 lemma (in real_normed_algebra_1) scaleR_power [simp]: "(scaleR x y) ^ n = scaleR (x^n) (y^n)"
   by (induct n) (simp_all add: scaleR_one scaleR_scaleR mult_ac)
 
 class real_normed_div_algebra = real_div_algebra + real_normed_vector +
   assumes norm_mult: "norm (x * y) = norm x * norm y"
 
 class real_normed_field = real_field + real_normed_div_algebra
 
 instance real_normed_div_algebra < real_normed_algebra_1
 proof
   show "norm (x * y) \<le> norm x * norm y" for x y :: 'a
     by (simp add: norm_mult)
 next
   have "norm (1 * 1::'a) = norm (1::'a) * norm (1::'a)"
     by (rule norm_mult)
   then show "norm (1::'a) = 1" by simp
 qed
 
 context real_normed_vector begin
 
 lemma norm_zero [simp]: "norm (0::'a) = 0"
   by simp
 
 lemma zero_less_norm_iff [simp]: "norm x > 0 \<longleftrightarrow> x \<noteq> 0"
   by (simp add: order_less_le)
 
 lemma norm_not_less_zero [simp]: "\<not> norm x < 0"
   by (simp add: linorder_not_less)
 
 lemma norm_le_zero_iff [simp]: "norm x \<le> 0 \<longleftrightarrow> x = 0"
   by (simp add: order_le_less)
 
 lemma norm_minus_cancel [simp]: "norm (- x) = norm x"
 proof -
   have "- 1 *\<^sub>R x = - (1 *\<^sub>R x)"
     unfolding add_eq_0_iff2[symmetric] scaleR_add_left[symmetric]
     using norm_eq_zero
     by fastforce
   then have "norm (- x) = norm (scaleR (- 1) x)"
     by (simp only: scaleR_one)
   also have "\<dots> = \<bar>- 1\<bar> * norm x"
     by (rule norm_scaleR)
   finally show ?thesis by simp
 qed
 
 lemma norm_minus_commute: "norm (a - b) = norm (b - a)"
 proof -
   have "norm (- (b - a)) = norm (b - a)"
     by (rule norm_minus_cancel)
   then show ?thesis by simp
 qed
 
 lemma dist_add_cancel [simp]: "dist (a + b) (a + c) = dist b c"
   by (simp add: dist_norm)
 
 lemma dist_add_cancel2 [simp]: "dist (b + a) (c + a) = dist b c"
   by (simp add: dist_norm)
 
 lemma norm_uminus_minus: "norm (- x - y) = norm (x + y)"
   by (subst (2) norm_minus_cancel[symmetric], subst minus_add_distrib) simp
 
 lemma norm_triangle_ineq2: "norm a - norm b \<le> norm (a - b)"
 proof -
   have "norm (a - b + b) \<le> norm (a - b) + norm b"
     by (rule norm_triangle_ineq)
   then show ?thesis by simp
 qed
 
 lemma norm_triangle_ineq3: "\<bar>norm a - norm b\<bar> \<le> norm (a - b)"
 proof -
   have "norm a - norm b \<le> norm (a - b)"
     by (simp add: norm_triangle_ineq2)
   moreover have "norm b - norm a \<le> norm (a - b)"
     by (metis norm_minus_commute norm_triangle_ineq2)
   ultimately show ?thesis
     by (simp add: abs_le_iff)
 qed
 
 lemma norm_triangle_ineq4: "norm (a - b) \<le> norm a + norm b"
 proof -
   have "norm (a + - b) \<le> norm a + norm (- b)"
     by (rule norm_triangle_ineq)
   then show ?thesis by simp
 qed
 
 lemma norm_triangle_le_diff: "norm x + norm y \<le> e \<Longrightarrow> norm (x - y) \<le> e"
     by (meson norm_triangle_ineq4 order_trans)
 
 lemma norm_diff_ineq: "norm a - norm b \<le> norm (a + b)"
 proof -
   have "norm a - norm (- b) \<le> norm (a - - b)"
     by (rule norm_triangle_ineq2)
   then show ?thesis by simp
 qed
 
 lemma norm_triangle_sub: "norm x \<le> norm y + norm (x - y)"
   using norm_triangle_ineq[of "y" "x - y"] by (simp add: field_simps)
 
 lemma norm_triangle_le: "norm x + norm y \<le> e \<Longrightarrow> norm (x + y) \<le> e"
   by (rule norm_triangle_ineq [THEN order_trans])
 
 lemma norm_triangle_lt: "norm x + norm y < e \<Longrightarrow> norm (x + y) < e"
   by (rule norm_triangle_ineq [THEN le_less_trans])
 
 lemma norm_add_leD: "norm (a + b) \<le> c \<Longrightarrow> norm b \<le> norm a + c"
   by (metis ab_semigroup_add_class.add.commute add_commute diff_le_eq norm_diff_ineq order_trans)
 
 lemma norm_diff_triangle_ineq: "norm ((a + b) - (c + d)) \<le> norm (a - c) + norm (b - d)"
 proof -
   have "norm ((a + b) - (c + d)) = norm ((a - c) + (b - d))"
     by (simp add: algebra_simps)
   also have "\<dots> \<le> norm (a - c) + norm (b - d)"
     by (rule norm_triangle_ineq)
   finally show ?thesis .
 qed
 
 lemma norm_diff_triangle_le: "norm (x - z) \<le> e1 + e2"
   if "norm (x - y) \<le> e1"  "norm (y - z) \<le> e2"
 proof -
   have "norm (x - (y + z - y)) \<le> norm (x - y) + norm (y - z)"
     using norm_diff_triangle_ineq that diff_diff_eq2 by presburger
   with that show ?thesis by simp
 qed
 
 lemma norm_diff_triangle_less: "norm (x - z) < e1 + e2"
   if "norm (x - y) < e1"  "norm (y - z) < e2"
 proof -
   have "norm (x - z) \<le> norm (x - y) + norm (y - z)"
     by (metis norm_diff_triangle_ineq add_diff_cancel_left' diff_diff_eq2)
   with that show ?thesis by auto
 qed
 
 lemma norm_triangle_mono:
   "norm a \<le> r \<Longrightarrow> norm b \<le> s \<Longrightarrow> norm (a + b) \<le> r + s"
   by (metis (mono_tags) add_mono_thms_linordered_semiring(1) norm_triangle_ineq order.trans)
 
 lemma norm_sum: "norm (sum f A) \<le> (\<Sum>i\<in>A. norm (f i))"
   for f::"'b \<Rightarrow> 'a"
   by (induct A rule: infinite_finite_induct) (auto intro: norm_triangle_mono)
 
 lemma sum_norm_le: "norm (sum f S) \<le> sum g S"
   if "\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> g x"
   for f::"'b \<Rightarrow> 'a"
   by (rule order_trans [OF norm_sum sum_mono]) (simp add: that)
 
 lemma abs_norm_cancel [simp]: "\<bar>norm a\<bar> = norm a"
   by (rule abs_of_nonneg [OF norm_ge_zero])
 
 lemma sum_norm_bound:
   "norm (sum f S) \<le> of_nat (card S)*K"
   if "\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> K"
   for f :: "'b \<Rightarrow> 'a"
   using sum_norm_le[OF that] sum_constant[symmetric]
   by simp
 
 lemma norm_add_less: "norm x < r \<Longrightarrow> norm y < s \<Longrightarrow> norm (x + y) < r + s"
   by (rule order_le_less_trans [OF norm_triangle_ineq add_strict_mono])
 
 end
 
 lemma dist_scaleR [simp]: "dist (x *\<^sub>R a) (y *\<^sub>R a) = \<bar>x - y\<bar> * norm a"
   for a :: "'a::real_normed_vector"
   by (metis dist_norm norm_scaleR scaleR_left.diff)
 
 lemma norm_mult_less: "norm x < r \<Longrightarrow> norm y < s \<Longrightarrow> norm (x * y) < r * s"
   for x y :: "'a::real_normed_algebra"
   by (rule order_le_less_trans [OF norm_mult_ineq]) (simp add: mult_strict_mono')
 
 lemma norm_of_real [simp]: "norm (of_real r :: 'a::real_normed_algebra_1) = \<bar>r\<bar>"
   by (simp add: of_real_def)
 
 lemma norm_numeral [simp]: "norm (numeral w::'a::real_normed_algebra_1) = numeral w"
   by (subst of_real_numeral [symmetric], subst norm_of_real, simp)
 
 lemma norm_neg_numeral [simp]: "norm (- numeral w::'a::real_normed_algebra_1) = numeral w"
   by (subst of_real_neg_numeral [symmetric], subst norm_of_real, simp)
 
 lemma norm_of_real_add1 [simp]: "norm (of_real x + 1 :: 'a :: real_normed_div_algebra) = \<bar>x + 1\<bar>"
   by (metis norm_of_real of_real_1 of_real_add)
 
 lemma norm_of_real_addn [simp]:
   "norm (of_real x + numeral b :: 'a :: real_normed_div_algebra) = \<bar>x + numeral b\<bar>"
   by (metis norm_of_real of_real_add of_real_numeral)
 
 lemma norm_of_int [simp]: "norm (of_int z::'a::real_normed_algebra_1) = \<bar>of_int z\<bar>"
   by (subst of_real_of_int_eq [symmetric], rule norm_of_real)
 
 lemma norm_of_nat [simp]: "norm (of_nat n::'a::real_normed_algebra_1) = of_nat n"
   by (metis abs_of_nat norm_of_real of_real_of_nat_eq)
 
 lemma nonzero_norm_inverse: "a \<noteq> 0 \<Longrightarrow> norm (inverse a) = inverse (norm a)"
   for a :: "'a::real_normed_div_algebra"
   by (metis inverse_unique norm_mult norm_one right_inverse)
 
 lemma norm_inverse: "norm (inverse a) = inverse (norm a)"
   for a :: "'a::{real_normed_div_algebra,division_ring}"
   by (metis inverse_zero nonzero_norm_inverse norm_zero)
 
 lemma nonzero_norm_divide: "b \<noteq> 0 \<Longrightarrow> norm (a / b) = norm a / norm b"
   for a b :: "'a::real_normed_field"
   by (simp add: divide_inverse norm_mult nonzero_norm_inverse)
 
 lemma norm_divide: "norm (a / b) = norm a / norm b"
   for a b :: "'a::{real_normed_field,field}"
   by (simp add: divide_inverse norm_mult norm_inverse)
 
 lemma norm_inverse_le_norm:
   fixes x :: "'a::real_normed_div_algebra"
   shows "r \<le> norm x \<Longrightarrow> 0 < r \<Longrightarrow> norm (inverse x) \<le> inverse r"
   by (simp add: le_imp_inverse_le norm_inverse)
 
 lemma norm_power_ineq: "norm (x ^ n) \<le> norm x ^ n"
   for x :: "'a::real_normed_algebra_1"
 proof (induct n)
   case 0
   show "norm (x ^ 0) \<le> norm x ^ 0" by simp
 next
   case (Suc n)
   have "norm (x * x ^ n) \<le> norm x * norm (x ^ n)"
     by (rule norm_mult_ineq)
   also from Suc have "\<dots> \<le> norm x * norm x ^ n"
     using norm_ge_zero by (rule mult_left_mono)
   finally show "norm (x ^ Suc n) \<le> norm x ^ Suc n"
     by simp
 qed
 
 lemma norm_power: "norm (x ^ n) = norm x ^ n"
   for x :: "'a::real_normed_div_algebra"
   by (induct n) (simp_all add: norm_mult)
 
 lemma norm_power_int: "norm (power_int x n) = power_int (norm x) n"
   for x :: "'a::real_normed_div_algebra"
   by (cases n rule: int_cases4) (auto simp: norm_power power_int_minus norm_inverse)
 
 lemma power_eq_imp_eq_norm:
   fixes w :: "'a::real_normed_div_algebra"
   assumes eq: "w ^ n = z ^ n" and "n > 0"
     shows "norm w = norm z"
 proof -
   have "norm w ^ n = norm z ^ n"
     by (metis (no_types) eq norm_power)
   then show ?thesis
     using assms by (force intro: power_eq_imp_eq_base)
 qed
 
 lemma power_eq_1_iff:
   fixes w :: "'a::real_normed_div_algebra"
   shows "w ^ n = 1 \<Longrightarrow> norm w = 1 \<or> n = 0"
   by (metis norm_one power_0_left power_eq_0_iff power_eq_imp_eq_norm power_one)
 
 lemma norm_mult_numeral1 [simp]: "norm (numeral w * a) = numeral w * norm a"
   for a b :: "'a::{real_normed_field,field}"
   by (simp add: norm_mult)
 
 lemma norm_mult_numeral2 [simp]: "norm (a * numeral w) = norm a * numeral w"
   for a b :: "'a::{real_normed_field,field}"
   by (simp add: norm_mult)
 
 lemma norm_divide_numeral [simp]: "norm (a / numeral w) = norm a / numeral w"
   for a b :: "'a::{real_normed_field,field}"
   by (simp add: norm_divide)
 
 lemma norm_of_real_diff [simp]:
   "norm (of_real b - of_real a :: 'a::real_normed_algebra_1) \<le> \<bar>b - a\<bar>"
   by (metis norm_of_real of_real_diff order_refl)
 
 text \<open>Despite a superficial resemblance, \<open>norm_eq_1\<close> is not relevant.\<close>
 lemma square_norm_one:
   fixes x :: "'a::real_normed_div_algebra"
   assumes "x\<^sup>2 = 1"
   shows "norm x = 1"
   by (metis assms norm_minus_cancel norm_one power2_eq_1_iff)
 
 lemma norm_less_p1: "norm x < norm (of_real (norm x) + 1 :: 'a)"
   for x :: "'a::real_normed_algebra_1"
 proof -
   have "norm x < norm (of_real (norm x + 1) :: 'a)"
     by (simp add: of_real_def)
   then show ?thesis
     by simp
 qed
 
 lemma prod_norm: "prod (\<lambda>x. norm (f x)) A = norm (prod f A)"
   for f :: "'a \<Rightarrow> 'b::{comm_semiring_1,real_normed_div_algebra}"
   by (induct A rule: infinite_finite_induct) (auto simp: norm_mult)
 
 lemma norm_prod_le:
   "norm (prod f A) \<le> (\<Prod>a\<in>A. norm (f a :: 'a :: {real_normed_algebra_1,comm_monoid_mult}))"
 proof (induct A rule: infinite_finite_induct)
   case empty
   then show ?case by simp
 next
   case (insert a A)
   then have "norm (prod f (insert a A)) \<le> norm (f a) * norm (prod f A)"
     by (simp add: norm_mult_ineq)
   also have "norm (prod f A) \<le> (\<Prod>a\<in>A. norm (f a))"
     by (rule insert)
   finally show ?case
     by (simp add: insert mult_left_mono)
 next
   case infinite
   then show ?case by simp
 qed
 
 lemma norm_prod_diff:
   fixes z w :: "'i \<Rightarrow> 'a::{real_normed_algebra_1, comm_monoid_mult}"
   shows "(\<And>i. i \<in> I \<Longrightarrow> norm (z i) \<le> 1) \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> norm (w i) \<le> 1) \<Longrightarrow>
     norm ((\<Prod>i\<in>I. z i) - (\<Prod>i\<in>I. w i)) \<le> (\<Sum>i\<in>I. norm (z i - w i))"
 proof (induction I rule: infinite_finite_induct)
   case empty
   then show ?case by simp
 next
   case (insert i I)
   note insert.hyps[simp]
 
   have "norm ((\<Prod>i\<in>insert i I. z i) - (\<Prod>i\<in>insert i I. w i)) =
     norm ((\<Prod>i\<in>I. z i) * (z i - w i) + ((\<Prod>i\<in>I. z i) - (\<Prod>i\<in>I. w i)) * w i)"
     (is "_ = norm (?t1 + ?t2)")
     by (auto simp: field_simps)
   also have "\<dots> \<le> norm ?t1 + norm ?t2"
     by (rule norm_triangle_ineq)
   also have "norm ?t1 \<le> norm (\<Prod>i\<in>I. z i) * norm (z i - w i)"
     by (rule norm_mult_ineq)
   also have "\<dots> \<le> (\<Prod>i\<in>I. norm (z i)) * norm(z i - w i)"
     by (rule mult_right_mono) (auto intro: norm_prod_le)
   also have "(\<Prod>i\<in>I. norm (z i)) \<le> (\<Prod>i\<in>I. 1)"
     by (intro prod_mono) (auto intro!: insert)
   also have "norm ?t2 \<le> norm ((\<Prod>i\<in>I. z i) - (\<Prod>i\<in>I. w i)) * norm (w i)"
     by (rule norm_mult_ineq)
   also have "norm (w i) \<le> 1"
     by (auto intro: insert)
   also have "norm ((\<Prod>i\<in>I. z i) - (\<Prod>i\<in>I. w i)) \<le> (\<Sum>i\<in>I. norm (z i - w i))"
     using insert by auto
   finally show ?case
     by (auto simp: ac_simps mult_right_mono mult_left_mono)
 next
   case infinite
   then show ?case by simp
 qed
 
 lemma norm_power_diff:
   fixes z w :: "'a::{real_normed_algebra_1, comm_monoid_mult}"
   assumes "norm z \<le> 1" "norm w \<le> 1"
   shows "norm (z^m - w^m) \<le> m * norm (z - w)"
 proof -
   have "norm (z^m - w^m) = norm ((\<Prod> i < m. z) - (\<Prod> i < m. w))"
     by simp
   also have "\<dots> \<le> (\<Sum>i<m. norm (z - w))"
     by (intro norm_prod_diff) (auto simp: assms)
   also have "\<dots> = m * norm (z - w)"
     by simp
   finally show ?thesis .
 qed
 
 
 subsection \<open>Metric spaces\<close>
 
 class metric_space = uniformity_dist + open_uniformity +
   assumes dist_eq_0_iff [simp]: "dist x y = 0 \<longleftrightarrow> x = y"
     and dist_triangle2: "dist x y \<le> dist x z + dist y z"
 begin
 
 lemma dist_self [simp]: "dist x x = 0"
   by simp
 
 lemma zero_le_dist [simp]: "0 \<le> dist x y"
   using dist_triangle2 [of x x y] by simp
 
 lemma zero_less_dist_iff: "0 < dist x y \<longleftrightarrow> x \<noteq> y"
   by (simp add: less_le)
 
 lemma dist_not_less_zero [simp]: "\<not> dist x y < 0"
   by (simp add: not_less)
 
 lemma dist_le_zero_iff [simp]: "dist x y \<le> 0 \<longleftrightarrow> x = y"
   by (simp add: le_less)
 
 lemma dist_commute: "dist x y = dist y x"
 proof (rule order_antisym)
   show "dist x y \<le> dist y x"
     using dist_triangle2 [of x y x] by simp
   show "dist y x \<le> dist x y"
     using dist_triangle2 [of y x y] by simp
 qed
 
 lemma dist_commute_lessI: "dist y x < e \<Longrightarrow> dist x y < e"
   by (simp add: dist_commute)
 
 lemma dist_triangle: "dist x z \<le> dist x y + dist y z"
   using dist_triangle2 [of x z y] by (simp add: dist_commute)
 
 lemma dist_triangle3: "dist x y \<le> dist a x + dist a y"
   using dist_triangle2 [of x y a] by (simp add: dist_commute)
 
 lemma abs_dist_diff_le: "\<bar>dist a b - dist b c\<bar> \<le> dist a c"
   using dist_triangle3[of b c a] dist_triangle2[of a b c] by simp
 
 lemma dist_pos_lt: "x \<noteq> y \<Longrightarrow> 0 < dist x y"
   by (simp add: zero_less_dist_iff)
 
 lemma dist_nz: "x \<noteq> y \<longleftrightarrow> 0 < dist x y"
   by (simp add: zero_less_dist_iff)
 
 declare dist_nz [symmetric, simp]
 
 lemma dist_triangle_le: "dist x z + dist y z \<le> e \<Longrightarrow> dist x y \<le> e"
   by (rule order_trans [OF dist_triangle2])
 
 lemma dist_triangle_lt: "dist x z + dist y z < e \<Longrightarrow> dist x y < e"
   by (rule le_less_trans [OF dist_triangle2])
 
 lemma dist_triangle_less_add: "dist x1 y < e1 \<Longrightarrow> dist x2 y < e2 \<Longrightarrow> dist x1 x2 < e1 + e2"
   by (rule dist_triangle_lt [where z=y]) simp
 
 lemma dist_triangle_half_l: "dist x1 y < e / 2 \<Longrightarrow> dist x2 y < e / 2 \<Longrightarrow> dist x1 x2 < e"
   by (rule dist_triangle_lt [where z=y]) simp
 
 lemma dist_triangle_half_r: "dist y x1 < e / 2 \<Longrightarrow> dist y x2 < e / 2 \<Longrightarrow> dist x1 x2 < e"
   by (rule dist_triangle_half_l) (simp_all add: dist_commute)
 
 lemma dist_triangle_third:
   assumes "dist x1 x2 < e/3" "dist x2 x3 < e/3" "dist x3 x4 < e/3"
   shows "dist x1 x4 < e"
 proof -
   have "dist x1 x3 < e/3 + e/3"
     by (metis assms(1) assms(2) dist_commute dist_triangle_less_add)
   then have "dist x1 x4 < (e/3 + e/3) + e/3"
     by (metis assms(3) dist_commute dist_triangle_less_add)
   then show ?thesis
     by simp
 qed
   
 subclass uniform_space
 proof
   fix E x
   assume "eventually E uniformity"
   then obtain e where E: "0 < e" "\<And>x y. dist x y < e \<Longrightarrow> E (x, y)"
     by (auto simp: eventually_uniformity_metric)
   then show "E (x, x)" "\<forall>\<^sub>F (x, y) in uniformity. E (y, x)"
     by (auto simp: eventually_uniformity_metric dist_commute)
   show "\<exists>D. eventually D uniformity \<and> (\<forall>x y z. D (x, y) \<longrightarrow> D (y, z) \<longrightarrow> E (x, z))"
     using E dist_triangle_half_l[where e=e]
     unfolding eventually_uniformity_metric
     by (intro exI[of _ "\<lambda>(x, y). dist x y < e / 2"] exI[of _ "e/2"] conjI)
       (auto simp: dist_commute)
 qed
 
 lemma open_dist: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> S)"
   by (simp add: dist_commute open_uniformity eventually_uniformity_metric)
 
 lemma open_ball: "open {y. dist x y < d}"
   unfolding open_dist
 proof (intro ballI)
   fix y
   assume *: "y \<in> {y. dist x y < d}"
   then show "\<exists>e>0. \<forall>z. dist z y < e \<longrightarrow> z \<in> {y. dist x y < d}"
     by (auto intro!: exI[of _ "d - dist x y"] simp: field_simps dist_triangle_lt)
 qed
 
 subclass first_countable_topology
 proof
   fix x
   show "\<exists>A::nat \<Rightarrow> 'a set. (\<forall>i. x \<in> A i \<and> open (A i)) \<and> (\<forall>S. open S \<and> x \<in> S \<longrightarrow> (\<exists>i. A i \<subseteq> S))"
   proof (safe intro!: exI[of _ "\<lambda>n. {y. dist x y < inverse (Suc n)}"])
     fix S
     assume "open S" "x \<in> S"
     then obtain e where e: "0 < e" and "{y. dist x y < e} \<subseteq> S"
       by (auto simp: open_dist subset_eq dist_commute)
     moreover
     from e obtain i where "inverse (Suc i) < e"
       by (auto dest!: reals_Archimedean)
     then have "{y. dist x y < inverse (Suc i)} \<subseteq> {y. dist x y < e}"
       by auto
     ultimately show "\<exists>i. {y. dist x y < inverse (Suc i)} \<subseteq> S"
       by blast
   qed (auto intro: open_ball)
 qed
 
 end
 
 instance metric_space \<subseteq> t2_space
 proof
   fix x y :: "'a::metric_space"
   assume xy: "x \<noteq> y"
   let ?U = "{y'. dist x y' < dist x y / 2}"
   let ?V = "{x'. dist y x' < dist x y / 2}"
   have *: "d x z \<le> d x y + d y z \<Longrightarrow> d y z = d z y \<Longrightarrow> \<not> (d x y * 2 < d x z \<and> d z y * 2 < d x z)"
     for d :: "'a \<Rightarrow> 'a \<Rightarrow> real" and x y z :: 'a
     by arith
   have "open ?U \<and> open ?V \<and> x \<in> ?U \<and> y \<in> ?V \<and> ?U \<inter> ?V = {}"
     using dist_pos_lt[OF xy] *[of dist, OF dist_triangle dist_commute]
     using open_ball[of _ "dist x y / 2"] by auto
   then show "\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
     by blast
 qed
 
 text \<open>Every normed vector space is a metric space.\<close>
 instance real_normed_vector < metric_space
 proof
   fix x y z :: 'a
   show "dist x y = 0 \<longleftrightarrow> x = y"
     by (simp add: dist_norm)
   show "dist x y \<le> dist x z + dist y z"
     using norm_triangle_ineq4 [of "x - z" "y - z"] by (simp add: dist_norm)
 qed
 
 
 subsection \<open>Class instances for real numbers\<close>
 
 instantiation real :: real_normed_field
 begin
 
 definition dist_real_def: "dist x y = \<bar>x - y\<bar>"
 
 definition uniformity_real_def [code del]:
   "(uniformity :: (real \<times> real) filter) = (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})"
 
 definition open_real_def [code del]:
   "open (U :: real set) \<longleftrightarrow> (\<forall>x\<in>U. eventually (\<lambda>(x', y). x' = x \<longrightarrow> y \<in> U) uniformity)"
 
 definition real_norm_def [simp]: "norm r = \<bar>r\<bar>"
 
 instance
   by intro_classes (auto simp: abs_mult open_real_def dist_real_def sgn_real_def uniformity_real_def)
 
 end
 
 declare uniformity_Abort[where 'a=real, code]
 
 lemma dist_of_real [simp]: "dist (of_real x :: 'a) (of_real y) = dist x y"
   for a :: "'a::real_normed_div_algebra"
   by (metis dist_norm norm_of_real of_real_diff real_norm_def)
 
 declare [[code abort: "open :: real set \<Rightarrow> bool"]]
 
 instance real :: linorder_topology
 proof
   show "(open :: real set \<Rightarrow> bool) = generate_topology (range lessThan \<union> range greaterThan)"
   proof (rule ext, safe)
     fix S :: "real set"
     assume "open S"
     then obtain f where "\<forall>x\<in>S. 0 < f x \<and> (\<forall>y. dist y x < f x \<longrightarrow> y \<in> S)"
       unfolding open_dist bchoice_iff ..
     then have *: "(\<Union>x\<in>S. {x - f x <..} \<inter> {..< x + f x}) = S" (is "?S = S")
       by (fastforce simp: dist_real_def)
     moreover have "generate_topology (range lessThan \<union> range greaterThan) ?S"
       by (force intro: generate_topology.Basis generate_topology_Union generate_topology.Int)
     ultimately show "generate_topology (range lessThan \<union> range greaterThan) S"
       by simp
   next
     fix S :: "real set"
     assume "generate_topology (range lessThan \<union> range greaterThan) S"
     moreover have "\<And>a::real. open {..<a}"
       unfolding open_dist dist_real_def
     proof clarify
       fix x a :: real
       assume "x < a"
       then have "0 < a - x \<and> (\<forall>y. \<bar>y - x\<bar> < a - x \<longrightarrow> y \<in> {..<a})" by auto
       then show "\<exists>e>0. \<forall>y. \<bar>y - x\<bar> < e \<longrightarrow> y \<in> {..<a}" ..
     qed
     moreover have "\<And>a::real. open {a <..}"
       unfolding open_dist dist_real_def
     proof clarify
       fix x a :: real
       assume "a < x"
       then have "0 < x - a \<and> (\<forall>y. \<bar>y - x\<bar> < x - a \<longrightarrow> y \<in> {a<..})" by auto
       then show "\<exists>e>0. \<forall>y. \<bar>y - x\<bar> < e \<longrightarrow> y \<in> {a<..}" ..
     qed
     ultimately show "open S"
       by induct auto
   qed
 qed
 
 instance real :: linear_continuum_topology ..
 
 lemmas open_real_greaterThan = open_greaterThan[where 'a=real]
 lemmas open_real_lessThan = open_lessThan[where 'a=real]
 lemmas open_real_greaterThanLessThan = open_greaterThanLessThan[where 'a=real]
 lemmas closed_real_atMost = closed_atMost[where 'a=real]
 lemmas closed_real_atLeast = closed_atLeast[where 'a=real]
 lemmas closed_real_atLeastAtMost = closed_atLeastAtMost[where 'a=real]
 
 instance real :: ordered_real_vector
   by standard (auto intro: mult_left_mono mult_right_mono)
 
 
 subsection \<open>Extra type constraints\<close>
 
 text \<open>Only allow \<^term>\<open>open\<close> in class \<open>topological_space\<close>.\<close>
 setup \<open>Sign.add_const_constraint
   (\<^const_name>\<open>open\<close>, SOME \<^typ>\<open>'a::topological_space set \<Rightarrow> bool\<close>)\<close>
 
 text \<open>Only allow \<^term>\<open>uniformity\<close> in class \<open>uniform_space\<close>.\<close>
 setup \<open>Sign.add_const_constraint
   (\<^const_name>\<open>uniformity\<close>, SOME \<^typ>\<open>('a::uniformity \<times> 'a) filter\<close>)\<close>
 
 text \<open>Only allow \<^term>\<open>dist\<close> in class \<open>metric_space\<close>.\<close>
 setup \<open>Sign.add_const_constraint
   (\<^const_name>\<open>dist\<close>, SOME \<^typ>\<open>'a::metric_space \<Rightarrow> 'a \<Rightarrow> real\<close>)\<close>
 
 text \<open>Only allow \<^term>\<open>norm\<close> in class \<open>real_normed_vector\<close>.\<close>
 setup \<open>Sign.add_const_constraint
   (\<^const_name>\<open>norm\<close>, SOME \<^typ>\<open>'a::real_normed_vector \<Rightarrow> real\<close>)\<close>
 
 
 subsection \<open>Sign function\<close>
 
 lemma norm_sgn: "norm (sgn x) = (if x = 0 then 0 else 1)"
   for x :: "'a::real_normed_vector"
   by (simp add: sgn_div_norm)
 
 lemma sgn_zero [simp]: "sgn (0::'a::real_normed_vector) = 0"
   by (simp add: sgn_div_norm)
 
 lemma sgn_zero_iff: "sgn x = 0 \<longleftrightarrow> x = 0"
   for x :: "'a::real_normed_vector"
   by (simp add: sgn_div_norm)
 
 lemma sgn_minus: "sgn (- x) = - sgn x"
   for x :: "'a::real_normed_vector"
   by (simp add: sgn_div_norm)
 
 lemma sgn_scaleR: "sgn (scaleR r x) = scaleR (sgn r) (sgn x)"
   for x :: "'a::real_normed_vector"
   by (simp add: sgn_div_norm ac_simps)
 
 lemma sgn_one [simp]: "sgn (1::'a::real_normed_algebra_1) = 1"
   by (simp add: sgn_div_norm)
 
 lemma sgn_of_real: "sgn (of_real r :: 'a::real_normed_algebra_1) = of_real (sgn r)"
   unfolding of_real_def by (simp only: sgn_scaleR sgn_one)
 
 lemma sgn_mult: "sgn (x * y) = sgn x * sgn y"
   for x y :: "'a::real_normed_div_algebra"
   by (simp add: sgn_div_norm norm_mult)
 
 hide_fact (open) sgn_mult
 
 lemma real_sgn_eq: "sgn x = x / \<bar>x\<bar>"
   for x :: real
   by (simp add: sgn_div_norm divide_inverse)
 
 lemma zero_le_sgn_iff [simp]: "0 \<le> sgn x \<longleftrightarrow> 0 \<le> x"
   for x :: real
   by (cases "0::real" x rule: linorder_cases) simp_all
 
 lemma sgn_le_0_iff [simp]: "sgn x \<le> 0 \<longleftrightarrow> x \<le> 0"
   for x :: real
   by (cases "0::real" x rule: linorder_cases) simp_all
 
 lemma norm_conv_dist: "norm x = dist x 0"
   unfolding dist_norm by simp
 
 declare norm_conv_dist [symmetric, simp]
 
 lemma dist_0_norm [simp]: "dist 0 x = norm x"
   for x :: "'a::real_normed_vector"
   by (simp add: dist_norm)
 
 lemma dist_diff [simp]: "dist a (a - b) = norm b"  "dist (a - b) a = norm b"
   by (simp_all add: dist_norm)
 
 lemma dist_of_int: "dist (of_int m) (of_int n :: 'a :: real_normed_algebra_1) = of_int \<bar>m - n\<bar>"
 proof -
   have "dist (of_int m) (of_int n :: 'a) = dist (of_int m :: 'a) (of_int m - (of_int (m - n)))"
     by simp
   also have "\<dots> = of_int \<bar>m - n\<bar>" by (subst dist_diff, subst norm_of_int) simp
   finally show ?thesis .
 qed
 
 lemma dist_of_nat:
   "dist (of_nat m) (of_nat n :: 'a :: real_normed_algebra_1) = of_int \<bar>int m - int n\<bar>"
   by (subst (1 2) of_int_of_nat_eq [symmetric]) (rule dist_of_int)
 
 
 subsection \<open>Bounded Linear and Bilinear Operators\<close>
 
 lemma linearI: "linear f"
   if "\<And>b1 b2. f (b1 + b2) = f b1 + f b2"
     "\<And>r b. f (r *\<^sub>R b) = r *\<^sub>R f b"
   using that
   by unfold_locales (auto simp: algebra_simps)
 
 lemma linear_iff:
   "linear f \<longleftrightarrow> (\<forall>x y. f (x + y) = f x + f y) \<and> (\<forall>c x. f (c *\<^sub>R x) = c *\<^sub>R f x)"
   (is "linear f \<longleftrightarrow> ?rhs")
 proof
   assume "linear f"
   then interpret f: linear f .
   show "?rhs" by (simp add: f.add f.scale)
 next
   assume "?rhs"
   then show "linear f" by (intro linearI) auto
 qed
 
 lemmas linear_scaleR_left = linear_scale_left
 lemmas linear_imp_scaleR = linear_imp_scale
 
 corollary real_linearD:
   fixes f :: "real \<Rightarrow> real"
   assumes "linear f" obtains c where "f = (*) c"
   by (rule linear_imp_scaleR [OF assms]) (force simp: scaleR_conv_of_real)
 
 lemma linear_times_of_real: "linear (\<lambda>x. a * of_real x)"
   by (auto intro!: linearI simp: distrib_left)
     (metis mult_scaleR_right scaleR_conv_of_real)
 
 locale bounded_linear = linear f for f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" +
   assumes bounded: "\<exists>K. \<forall>x. norm (f x) \<le> norm x * K"
 begin
 
 lemma pos_bounded: "\<exists>K>0. \<forall>x. norm (f x) \<le> norm x * K"
 proof -
   obtain K where K: "\<And>x. norm (f x) \<le> norm x * K"
     using bounded by blast
   show ?thesis
   proof (intro exI impI conjI allI)
     show "0 < max 1 K"
       by (rule order_less_le_trans [OF zero_less_one max.cobounded1])
   next
     fix x
     have "norm (f x) \<le> norm x * K" using K .
     also have "\<dots> \<le> norm x * max 1 K"
       by (rule mult_left_mono [OF max.cobounded2 norm_ge_zero])
     finally show "norm (f x) \<le> norm x * max 1 K" .
   qed
 qed
 
 lemma nonneg_bounded: "\<exists>K\<ge>0. \<forall>x. norm (f x) \<le> norm x * K"
   using pos_bounded by (auto intro: order_less_imp_le)
 
 lemma linear: "linear f"
   by (fact local.linear_axioms)
 
 end
 
 lemma bounded_linear_intro:
   assumes "\<And>x y. f (x + y) = f x + f y"
     and "\<And>r x. f (scaleR r x) = scaleR r (f x)"
     and "\<And>x. norm (f x) \<le> norm x * K"
   shows "bounded_linear f"
   by standard (blast intro: assms)+
 
 locale bounded_bilinear =
   fixes prod :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector \<Rightarrow> 'c::real_normed_vector"
     (infixl "**" 70)
   assumes add_left: "prod (a + a') b = prod a b + prod a' b"
     and add_right: "prod a (b + b') = prod a b + prod a b'"
     and scaleR_left: "prod (scaleR r a) b = scaleR r (prod a b)"
     and scaleR_right: "prod a (scaleR r b) = scaleR r (prod a b)"
     and bounded: "\<exists>K. \<forall>a b. norm (prod a b) \<le> norm a * norm b * K"
 begin
 
 lemma pos_bounded: "\<exists>K>0. \<forall>a b. norm (a ** b) \<le> norm a * norm b * K"
 proof -
   obtain K where "\<And>a b. norm (a ** b) \<le> norm a * norm b * K"
     using bounded by blast
   then have "norm (a ** b) \<le> norm a * norm b * (max 1 K)" for a b
     by (rule order.trans) (simp add: mult_left_mono)
   then show ?thesis
     by force
 qed
 
 lemma nonneg_bounded: "\<exists>K\<ge>0. \<forall>a b. norm (a ** b) \<le> norm a * norm b * K"
   using pos_bounded by (auto intro: order_less_imp_le)
 
 lemma additive_right: "additive (\<lambda>b. prod a b)"
   by (rule additive.intro, rule add_right)
 
 lemma additive_left: "additive (\<lambda>a. prod a b)"
   by (rule additive.intro, rule add_left)
 
 lemma zero_left: "prod 0 b = 0"
   by (rule additive.zero [OF additive_left])
 
 lemma zero_right: "prod a 0 = 0"
   by (rule additive.zero [OF additive_right])
 
 lemma minus_left: "prod (- a) b = - prod a b"
   by (rule additive.minus [OF additive_left])
 
 lemma minus_right: "prod a (- b) = - prod a b"
   by (rule additive.minus [OF additive_right])
 
 lemma diff_left: "prod (a - a') b = prod a b - prod a' b"
   by (rule additive.diff [OF additive_left])
 
 lemma diff_right: "prod a (b - b') = prod a b - prod a b'"
   by (rule additive.diff [OF additive_right])
 
 lemma sum_left: "prod (sum g S) x = sum ((\<lambda>i. prod (g i) x)) S"
   by (rule additive.sum [OF additive_left])
 
 lemma sum_right: "prod x (sum g S) = sum ((\<lambda>i. (prod x (g i)))) S"
   by (rule additive.sum [OF additive_right])
 
 
 lemma bounded_linear_left: "bounded_linear (\<lambda>a. a ** b)"
 proof -
   obtain K where "\<And>a b. norm (a ** b) \<le> norm a * norm b * K"
     using pos_bounded by blast
   then show ?thesis
     by (rule_tac K="norm b * K" in bounded_linear_intro) (auto simp: algebra_simps scaleR_left add_left)
 qed
 
 lemma bounded_linear_right: "bounded_linear (\<lambda>b. a ** b)"
 proof -
   obtain K where "\<And>a b. norm (a ** b) \<le> norm a * norm b * K"
     using pos_bounded by blast
   then show ?thesis
     by (rule_tac K="norm a * K" in bounded_linear_intro) (auto simp: algebra_simps scaleR_right add_right)
 qed
 
 lemma prod_diff_prod: "(x ** y - a ** b) = (x - a) ** (y - b) + (x - a) ** b + a ** (y - b)"
   by (simp add: diff_left diff_right)
 
 lemma flip: "bounded_bilinear (\<lambda>x y. y ** x)"
 proof
   show "\<exists>K. \<forall>a b. norm (b ** a) \<le> norm a * norm b * K"
     by (metis bounded mult.commute)
 qed (simp_all add: add_right add_left scaleR_right scaleR_left)
 
 lemma comp1:
   assumes "bounded_linear g"
   shows "bounded_bilinear (\<lambda>x. (**) (g x))"
 proof unfold_locales
   interpret g: bounded_linear g by fact
   show "\<And>a a' b. g (a + a') ** b = g a ** b + g a' ** b"
     "\<And>a b b'. g a ** (b + b') = g a ** b + g a ** b'"
     "\<And>r a b. g (r *\<^sub>R a) ** b = r *\<^sub>R (g a ** b)"
     "\<And>a r b. g a ** (r *\<^sub>R b) = r *\<^sub>R (g a ** b)"
     by (auto simp: g.add add_left add_right g.scaleR scaleR_left scaleR_right)
   from g.nonneg_bounded nonneg_bounded obtain K L
     where nn: "0 \<le> K" "0 \<le> L"
       and K: "\<And>x. norm (g x) \<le> norm x * K"
       and L: "\<And>a b. norm (a ** b) \<le> norm a * norm b * L"
     by auto
   have "norm (g a ** b) \<le> norm a * K * norm b * L" for a b
     by (auto intro!:  order_trans[OF K] order_trans[OF L] mult_mono simp: nn)
   then show "\<exists>K. \<forall>a b. norm (g a ** b) \<le> norm a * norm b * K"
     by (auto intro!: exI[where x="K * L"] simp: ac_simps)
 qed
 
 lemma comp: "bounded_linear f \<Longrightarrow> bounded_linear g \<Longrightarrow> bounded_bilinear (\<lambda>x y. f x ** g y)"
   by (rule bounded_bilinear.flip[OF bounded_bilinear.comp1[OF bounded_bilinear.flip[OF comp1]]])
 
 end
 
 lemma bounded_linear_ident[simp]: "bounded_linear (\<lambda>x. x)"
   by standard (auto intro!: exI[of _ 1])
 
 lemma bounded_linear_zero[simp]: "bounded_linear (\<lambda>x. 0)"
   by standard (auto intro!: exI[of _ 1])
 
 lemma bounded_linear_add:
   assumes "bounded_linear f"
     and "bounded_linear g"
   shows "bounded_linear (\<lambda>x. f x + g x)"
 proof -
   interpret f: bounded_linear f by fact
   interpret g: bounded_linear g by fact
   show ?thesis
   proof
     from f.bounded obtain Kf where Kf: "norm (f x) \<le> norm x * Kf" for x
       by blast
     from g.bounded obtain Kg where Kg: "norm (g x) \<le> norm x * Kg" for x
       by blast
     show "\<exists>K. \<forall>x. norm (f x + g x) \<le> norm x * K"
       using add_mono[OF Kf Kg]
       by (intro exI[of _ "Kf + Kg"]) (auto simp: field_simps intro: norm_triangle_ineq order_trans)
   qed (simp_all add: f.add g.add f.scaleR g.scaleR scaleR_right_distrib)
 qed
 
 lemma bounded_linear_minus:
   assumes "bounded_linear f"
   shows "bounded_linear (\<lambda>x. - f x)"
 proof -
   interpret f: bounded_linear f by fact
   show ?thesis
     by unfold_locales (simp_all add: f.add f.scaleR f.bounded)
 qed
 
 lemma bounded_linear_sub: "bounded_linear f \<Longrightarrow> bounded_linear g \<Longrightarrow> bounded_linear (\<lambda>x. f x - g x)"
   using bounded_linear_add[of f "\<lambda>x. - g x"] bounded_linear_minus[of g]
   by (auto simp: algebra_simps)
 
 lemma bounded_linear_sum:
   fixes f :: "'i \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   shows "(\<And>i. i \<in> I \<Longrightarrow> bounded_linear (f i)) \<Longrightarrow> bounded_linear (\<lambda>x. \<Sum>i\<in>I. f i x)"
   by (induct I rule: infinite_finite_induct) (auto intro!: bounded_linear_add)
 
 lemma bounded_linear_compose:
   assumes "bounded_linear f"
     and "bounded_linear g"
   shows "bounded_linear (\<lambda>x. f (g x))"
 proof -
   interpret f: bounded_linear f by fact
   interpret g: bounded_linear g by fact
   show ?thesis
   proof unfold_locales
     show "f (g (x + y)) = f (g x) + f (g y)" for x y
       by (simp only: f.add g.add)
     show "f (g (scaleR r x)) = scaleR r (f (g x))" for r x
       by (simp only: f.scaleR g.scaleR)
     from f.pos_bounded obtain Kf where f: "\<And>x. norm (f x) \<le> norm x * Kf" and Kf: "0 < Kf"
       by blast
     from g.pos_bounded obtain Kg where g: "\<And>x. norm (g x) \<le> norm x * Kg"
       by blast
     show "\<exists>K. \<forall>x. norm (f (g x)) \<le> norm x * K"
     proof (intro exI allI)
       fix x
       have "norm (f (g x)) \<le> norm (g x) * Kf"
         using f .
       also have "\<dots> \<le> (norm x * Kg) * Kf"
         using g Kf [THEN order_less_imp_le] by (rule mult_right_mono)
       also have "(norm x * Kg) * Kf = norm x * (Kg * Kf)"
         by (rule mult.assoc)
       finally show "norm (f (g x)) \<le> norm x * (Kg * Kf)" .
     qed
   qed
 qed
 
 lemma bounded_bilinear_mult: "bounded_bilinear ((*) :: 'a \<Rightarrow> 'a \<Rightarrow> 'a::real_normed_algebra)"
 proof (rule bounded_bilinear.intro)
   show "\<exists>K. \<forall>a b::'a. norm (a * b) \<le> norm a * norm b * K"
     by (rule_tac x=1 in exI) (simp add: norm_mult_ineq)
 qed (auto simp: algebra_simps)
 
 lemma bounded_linear_mult_left: "bounded_linear (\<lambda>x::'a::real_normed_algebra. x * y)"
   using bounded_bilinear_mult
   by (rule bounded_bilinear.bounded_linear_left)
 
 lemma bounded_linear_mult_right: "bounded_linear (\<lambda>y::'a::real_normed_algebra. x * y)"
   using bounded_bilinear_mult
   by (rule bounded_bilinear.bounded_linear_right)
 
 lemmas bounded_linear_mult_const =
   bounded_linear_mult_left [THEN bounded_linear_compose]
 
 lemmas bounded_linear_const_mult =
   bounded_linear_mult_right [THEN bounded_linear_compose]
 
 lemma bounded_linear_divide: "bounded_linear (\<lambda>x. x / y)"
   for y :: "'a::real_normed_field"
   unfolding divide_inverse by (rule bounded_linear_mult_left)
 
 lemma bounded_bilinear_scaleR: "bounded_bilinear scaleR"
 proof (rule bounded_bilinear.intro)
   show "\<exists>K. \<forall>a b. norm (a *\<^sub>R b) \<le> norm a * norm b * K"
     using less_eq_real_def by auto
 qed (auto simp: algebra_simps)
 
 lemma bounded_linear_scaleR_left: "bounded_linear (\<lambda>r. scaleR r x)"
   using bounded_bilinear_scaleR
   by (rule bounded_bilinear.bounded_linear_left)
 
 lemma bounded_linear_scaleR_right: "bounded_linear (\<lambda>x. scaleR r x)"
   using bounded_bilinear_scaleR
   by (rule bounded_bilinear.bounded_linear_right)
 
 lemmas bounded_linear_scaleR_const =
   bounded_linear_scaleR_left[THEN bounded_linear_compose]
 
 lemmas bounded_linear_const_scaleR =
   bounded_linear_scaleR_right[THEN bounded_linear_compose]
 
 lemma bounded_linear_of_real: "bounded_linear (\<lambda>r. of_real r)"
   unfolding of_real_def by (rule bounded_linear_scaleR_left)
 
 lemma real_bounded_linear: "bounded_linear f \<longleftrightarrow> (\<exists>c::real. f = (\<lambda>x. x * c))"
   for f :: "real \<Rightarrow> real"
 proof -
   {
     fix x
     assume "bounded_linear f"
     then interpret bounded_linear f .
     from scaleR[of x 1] have "f x = x * f 1"
       by simp
   }
   then show ?thesis
     by (auto intro: exI[of _ "f 1"] bounded_linear_mult_left)
 qed
 
 instance real_normed_algebra_1 \<subseteq> perfect_space
 proof
   fix x::'a
   have "\<And>e. 0 < e \<Longrightarrow> \<exists>y. norm (y - x) < e \<and> y \<noteq> x"
     by (rule_tac x = "x + of_real (e/2)" in exI) auto
   then show "\<not> open {x}" 
     by (clarsimp simp: open_dist dist_norm)
 qed
 
 
 subsection \<open>Filters and Limits on Metric Space\<close>
 
 lemma (in metric_space) nhds_metric: "nhds x = (INF e\<in>{0 <..}. principal {y. dist y x < e})"
   unfolding nhds_def
 proof (safe intro!: INF_eq)
   fix S
   assume "open S" "x \<in> S"
   then obtain e where "{y. dist y x < e} \<subseteq> S" "0 < e"
     by (auto simp: open_dist subset_eq)
   then show "\<exists>e\<in>{0<..}. principal {y. dist y x < e} \<le> principal S"
     by auto
 qed (auto intro!: exI[of _ "{y. dist x y < e}" for e] open_ball simp: dist_commute)
 
 lemma (in metric_space) tendsto_iff: "(f \<longlongrightarrow> l) F \<longleftrightarrow> (\<forall>e>0. eventually (\<lambda>x. dist (f x) l < e) F)"
   unfolding nhds_metric filterlim_INF filterlim_principal by auto
 
 lemma tendsto_dist_iff:
   "((f \<longlongrightarrow> l) F) \<longleftrightarrow> (((\<lambda>x. dist (f x) l) \<longlongrightarrow> 0) F)"
   unfolding tendsto_iff by simp
 
 lemma (in metric_space) tendstoI [intro?]:
   "(\<And>e. 0 < e \<Longrightarrow> eventually (\<lambda>x. dist (f x) l < e) F) \<Longrightarrow> (f \<longlongrightarrow> l) F"
   by (auto simp: tendsto_iff)
 
 lemma (in metric_space) tendstoD: "(f \<longlongrightarrow> l) F \<Longrightarrow> 0 < e \<Longrightarrow> eventually (\<lambda>x. dist (f x) l < e) F"
   by (auto simp: tendsto_iff)
 
 lemma (in metric_space) eventually_nhds_metric:
   "eventually P (nhds a) \<longleftrightarrow> (\<exists>d>0. \<forall>x. dist x a < d \<longrightarrow> P x)"
   unfolding nhds_metric
   by (subst eventually_INF_base)
      (auto simp: eventually_principal Bex_def subset_eq intro: exI[of _ "min a b" for a b])
 
 lemma eventually_at: "eventually P (at a within S) \<longleftrightarrow> (\<exists>d>0. \<forall>x\<in>S. x \<noteq> a \<and> dist x a < d \<longrightarrow> P x)"
   for a :: "'a :: metric_space"
   by (auto simp: eventually_at_filter eventually_nhds_metric)
 
 lemma frequently_at: "frequently P (at a within S) \<longleftrightarrow> (\<forall>d>0. \<exists>x\<in>S. x \<noteq> a \<and> dist x a < d \<and> P x)"
   for a :: "'a :: metric_space"
   unfolding frequently_def eventually_at by auto
 
 lemma eventually_at_le: "eventually P (at a within S) \<longleftrightarrow> (\<exists>d>0. \<forall>x\<in>S. x \<noteq> a \<and> dist x a \<le> d \<longrightarrow> P x)"
   for a :: "'a::metric_space"
   unfolding eventually_at_filter eventually_nhds_metric
   apply safe
   apply (rule_tac x="d / 2" in exI, auto)
   done
 
 lemma eventually_at_left_real: "a > (b :: real) \<Longrightarrow> eventually (\<lambda>x. x \<in> {b<..<a}) (at_left a)"
   by (subst eventually_at, rule exI[of _ "a - b"]) (force simp: dist_real_def)
 
 lemma eventually_at_right_real: "a < (b :: real) \<Longrightarrow> eventually (\<lambda>x. x \<in> {a<..<b}) (at_right a)"
   by (subst eventually_at, rule exI[of _ "b - a"]) (force simp: dist_real_def)
 
 lemma metric_tendsto_imp_tendsto:
   fixes a :: "'a :: metric_space"
     and b :: "'b :: metric_space"
   assumes f: "(f \<longlongrightarrow> a) F"
     and le: "eventually (\<lambda>x. dist (g x) b \<le> dist (f x) a) F"
   shows "(g \<longlongrightarrow> b) F"
 proof (rule tendstoI)
   fix e :: real
   assume "0 < e"
   with f have "eventually (\<lambda>x. dist (f x) a < e) F" by (rule tendstoD)
   with le show "eventually (\<lambda>x. dist (g x) b < e) F"
     using le_less_trans by (rule eventually_elim2)
 qed
 
 lemma filterlim_real_sequentially: "LIM x sequentially. real x :> at_top"
 proof (clarsimp simp: filterlim_at_top)
   fix Z
   show "\<forall>\<^sub>F x in sequentially. Z \<le> real x"
     by (meson eventually_sequentiallyI nat_ceiling_le_eq)
 qed
 
 lemma filterlim_nat_sequentially: "filterlim nat sequentially at_top"
 proof -
   have "\<forall>\<^sub>F x in at_top. Z \<le> nat x" for Z
     by (auto intro!: eventually_at_top_linorderI[where c="int Z"])
   then show ?thesis
     unfolding filterlim_at_top ..
 qed
 
 lemma filterlim_floor_sequentially: "filterlim floor at_top at_top"
 proof -
   have "\<forall>\<^sub>F x in at_top. Z \<le> \<lfloor>x\<rfloor>" for Z
     by (auto simp: le_floor_iff intro!: eventually_at_top_linorderI[where c="of_int Z"])
   then show ?thesis
     unfolding filterlim_at_top ..
 qed
 
 lemma filterlim_sequentially_iff_filterlim_real:
   "filterlim f sequentially F \<longleftrightarrow> filterlim (\<lambda>x. real (f x)) at_top F" (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
     using filterlim_compose filterlim_real_sequentially by blast
 next
   assume R: ?rhs
   show ?lhs
   proof -
     have "filterlim (\<lambda>x. nat (floor (real (f x)))) sequentially F"
       by (intro filterlim_compose[OF filterlim_nat_sequentially]
           filterlim_compose[OF filterlim_floor_sequentially] R)
     then show ?thesis by simp
   qed
 qed
 
 
 subsubsection \<open>Limits of Sequences\<close>
 
 lemma lim_sequentially: "X \<longlonglongrightarrow> L \<longleftrightarrow> (\<forall>r>0. \<exists>no. \<forall>n\<ge>no. dist (X n) L < r)"
   for L :: "'a::metric_space"
   unfolding tendsto_iff eventually_sequentially ..
 
 lemmas LIMSEQ_def = lim_sequentially  (*legacy binding*)
 
 lemma LIMSEQ_iff_nz: "X \<longlonglongrightarrow> L \<longleftrightarrow> (\<forall>r>0. \<exists>no>0. \<forall>n\<ge>no. dist (X n) L < r)"
   for L :: "'a::metric_space"
   unfolding lim_sequentially by (metis Suc_leD zero_less_Suc)
 
 lemma metric_LIMSEQ_I: "(\<And>r. 0 < r \<Longrightarrow> \<exists>no. \<forall>n\<ge>no. dist (X n) L < r) \<Longrightarrow> X \<longlonglongrightarrow> L"
   for L :: "'a::metric_space"
   by (simp add: lim_sequentially)
 
 lemma metric_LIMSEQ_D: "X \<longlonglongrightarrow> L \<Longrightarrow> 0 < r \<Longrightarrow> \<exists>no. \<forall>n\<ge>no. dist (X n) L < r"
   for L :: "'a::metric_space"
   by (simp add: lim_sequentially)
 
 lemma LIMSEQ_norm_0:
   assumes  "\<And>n::nat. norm (f n) < 1 / real (Suc n)"
   shows "f \<longlonglongrightarrow> 0"
 proof (rule metric_LIMSEQ_I)
   fix \<epsilon> :: "real"
   assume "\<epsilon> > 0"
   then obtain N::nat where "\<epsilon> > inverse N" "N > 0"
     by (metis neq0_conv real_arch_inverse)
   then have "norm (f n) < \<epsilon>" if "n \<ge> N" for n
   proof -
     have "1 / (Suc n) \<le> 1 / N"
       using \<open>0 < N\<close> inverse_of_nat_le le_SucI that by blast
     also have "\<dots> < \<epsilon>"
       by (metis (no_types) \<open>inverse (real N) < \<epsilon>\<close> inverse_eq_divide)
     finally show ?thesis
       by (meson assms less_eq_real_def not_le order_trans)
   qed
   then show "\<exists>no. \<forall>n\<ge>no. dist (f n) 0 < \<epsilon>"
     by auto
 qed
 
 
 subsubsection \<open>Limits of Functions\<close>
 
 lemma LIM_def: "f \<midarrow>a\<rightarrow> L \<longleftrightarrow> (\<forall>r > 0. \<exists>s > 0. \<forall>x. x \<noteq> a \<and> dist x a < s \<longrightarrow> dist (f x) L < r)"
   for a :: "'a::metric_space" and L :: "'b::metric_space"
   unfolding tendsto_iff eventually_at by simp
 
 lemma metric_LIM_I:
   "(\<And>r. 0 < r \<Longrightarrow> \<exists>s>0. \<forall>x. x \<noteq> a \<and> dist x a < s \<longrightarrow> dist (f x) L < r) \<Longrightarrow> f \<midarrow>a\<rightarrow> L"
   for a :: "'a::metric_space" and L :: "'b::metric_space"
   by (simp add: LIM_def)
 
 lemma metric_LIM_D: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> 0 < r \<Longrightarrow> \<exists>s>0. \<forall>x. x \<noteq> a \<and> dist x a < s \<longrightarrow> dist (f x) L < r"
   for a :: "'a::metric_space" and L :: "'b::metric_space"
   by (simp add: LIM_def)
 
 lemma metric_LIM_imp_LIM:
   fixes l :: "'a::metric_space"
     and m :: "'b::metric_space"
   assumes f: "f \<midarrow>a\<rightarrow> l"
     and le: "\<And>x. x \<noteq> a \<Longrightarrow> dist (g x) m \<le> dist (f x) l"
   shows "g \<midarrow>a\<rightarrow> m"
   by (rule metric_tendsto_imp_tendsto [OF f]) (auto simp: eventually_at_topological le)
 
 lemma metric_LIM_equal2:
   fixes a :: "'a::metric_space"
   assumes "g \<midarrow>a\<rightarrow> l" "0 < R"
     and "\<And>x. x \<noteq> a \<Longrightarrow> dist x a < R \<Longrightarrow> f x = g x"
   shows "f \<midarrow>a\<rightarrow> l"
 proof -
   have "\<And>S. \<lbrakk>open S; l \<in> S; \<forall>\<^sub>F x in at a. g x \<in> S\<rbrakk> \<Longrightarrow> \<forall>\<^sub>F x in at a. f x \<in> S"
     apply (simp add: eventually_at)
     by (metis assms(2) assms(3) dual_order.strict_trans linorder_neqE_linordered_idom)
   then show ?thesis
     using assms by (simp add: tendsto_def)
 qed
 
 lemma metric_LIM_compose2:
   fixes a :: "'a::metric_space"
   assumes f: "f \<midarrow>a\<rightarrow> b"
     and g: "g \<midarrow>b\<rightarrow> c"
     and inj: "\<exists>d>0. \<forall>x. x \<noteq> a \<and> dist x a < d \<longrightarrow> f x \<noteq> b"
   shows "(\<lambda>x. g (f x)) \<midarrow>a\<rightarrow> c"
   using inj by (intro tendsto_compose_eventually[OF g f]) (auto simp: eventually_at)
 
 lemma metric_isCont_LIM_compose2:
   fixes f :: "'a :: metric_space \<Rightarrow> _"
   assumes f [unfolded isCont_def]: "isCont f a"
     and g: "g \<midarrow>f a\<rightarrow> l"
     and inj: "\<exists>d>0. \<forall>x. x \<noteq> a \<and> dist x a < d \<longrightarrow> f x \<noteq> f a"
   shows "(\<lambda>x. g (f x)) \<midarrow>a\<rightarrow> l"
   by (rule metric_LIM_compose2 [OF f g inj])
 
 
 subsection \<open>Complete metric spaces\<close>
 
 subsection \<open>Cauchy sequences\<close>
 
 lemma (in metric_space) Cauchy_def: "Cauchy X = (\<forall>e>0. \<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < e)"
 proof -
   have *: "eventually P (INF M. principal {(X m, X n) | n m. m \<ge> M \<and> n \<ge> M}) \<longleftrightarrow>
     (\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. P (X m, X n))" for P
     apply (subst eventually_INF_base)
     subgoal by simp
     subgoal for a b
       by (intro bexI[of _ "max a b"]) (auto simp: eventually_principal subset_eq)
     subgoal by (auto simp: eventually_principal, blast)
     done
   have "Cauchy X \<longleftrightarrow> (INF M. principal {(X m, X n) | n m. m \<ge> M \<and> n \<ge> M}) \<le> uniformity"
     unfolding Cauchy_uniform_iff le_filter_def * ..
   also have "\<dots> = (\<forall>e>0. \<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < e)"
     unfolding uniformity_dist le_INF_iff by (auto simp: * le_principal)
   finally show ?thesis .
 qed
 
 lemma (in metric_space) Cauchy_altdef: "Cauchy f \<longleftrightarrow> (\<forall>e>0. \<exists>M. \<forall>m\<ge>M. \<forall>n>m. dist (f m) (f n) < e)"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?rhs
   show ?lhs
     unfolding Cauchy_def
   proof (intro allI impI)
     fix e :: real assume e: "e > 0"
     with \<open>?rhs\<close> obtain M where M: "m \<ge> M \<Longrightarrow> n > m \<Longrightarrow> dist (f m) (f n) < e" for m n
       by blast
     have "dist (f m) (f n) < e" if "m \<ge> M" "n \<ge> M" for m n
       using M[of m n] M[of n m] e that by (cases m n rule: linorder_cases) (auto simp: dist_commute)
     then show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (f m) (f n) < e"
       by blast
   qed
 next
   assume ?lhs
   show ?rhs
   proof (intro allI impI)
     fix e :: real
     assume e: "e > 0"
     with \<open>Cauchy f\<close> obtain M where "\<And>m n. m \<ge> M \<Longrightarrow> n \<ge> M \<Longrightarrow> dist (f m) (f n) < e"
       unfolding Cauchy_def by blast
     then show "\<exists>M. \<forall>m\<ge>M. \<forall>n>m. dist (f m) (f n) < e"
       by (intro exI[of _ M]) force
   qed
 qed
 
 lemma (in metric_space) Cauchy_altdef2: "Cauchy s \<longleftrightarrow> (\<forall>e>0. \<exists>N::nat. \<forall>n\<ge>N. dist(s n)(s N) < e)" (is "?lhs = ?rhs")
 proof 
   assume "Cauchy s"
   then show ?rhs by (force simp: Cauchy_def)
 next
     assume ?rhs
     {
       fix e::real
       assume "e>0"
       with \<open>?rhs\<close> obtain N where N: "\<forall>n\<ge>N. dist (s n) (s N) < e/2"
         by (erule_tac x="e/2" in allE) auto
       {
         fix n m
         assume nm: "N \<le> m \<and> N \<le> n"
         then have "dist (s m) (s n) < e" using N
           using dist_triangle_half_l[of "s m" "s N" "e" "s n"]
           by blast
       }
       then have "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (s m) (s n) < e"
         by blast
     }
     then have ?lhs
       unfolding Cauchy_def by blast
   then show ?lhs
     by blast
 qed
 
 lemma (in metric_space) metric_CauchyI:
   "(\<And>e. 0 < e \<Longrightarrow> \<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < e) \<Longrightarrow> Cauchy X"
   by (simp add: Cauchy_def)
 
 lemma (in metric_space) CauchyI':
   "(\<And>e. 0 < e \<Longrightarrow> \<exists>M. \<forall>m\<ge>M. \<forall>n>m. dist (X m) (X n) < e) \<Longrightarrow> Cauchy X"
   unfolding Cauchy_altdef by blast
 
 lemma (in metric_space) metric_CauchyD:
   "Cauchy X \<Longrightarrow> 0 < e \<Longrightarrow> \<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < e"
   by (simp add: Cauchy_def)
 
 lemma (in metric_space) metric_Cauchy_iff2:
   "Cauchy X = (\<forall>j. (\<exists>M. \<forall>m \<ge> M. \<forall>n \<ge> M. dist (X m) (X n) < inverse(real (Suc j))))"
   apply (auto simp add: Cauchy_def)
   by (metis less_trans of_nat_Suc reals_Archimedean)
 
 lemma Cauchy_iff2: "Cauchy X \<longleftrightarrow> (\<forall>j. (\<exists>M. \<forall>m \<ge> M. \<forall>n \<ge> M. \<bar>X m - X n\<bar> < inverse (real (Suc j))))"
   by (simp only: metric_Cauchy_iff2 dist_real_def)
 
 lemma lim_1_over_n [tendsto_intros]: "((\<lambda>n. 1 / of_nat n) \<longlongrightarrow> (0::'a::real_normed_field)) sequentially"
 proof (subst lim_sequentially, intro allI impI exI)
   fix e::real and n
   assume e: "e > 0" 
   have "inverse e < of_nat (nat \<lceil>inverse e + 1\<rceil>)" by linarith
   also assume "n \<ge> nat \<lceil>inverse e + 1\<rceil>"
   finally show "dist (1 / of_nat n :: 'a) 0 < e"
     using e by (simp add: field_split_simps norm_divide)
 qed
 
 lemma (in metric_space) complete_def:
   shows "complete S = (\<forall>f. (\<forall>n. f n \<in> S) \<and> Cauchy f \<longrightarrow> (\<exists>l\<in>S. f \<longlonglongrightarrow> l))"
   unfolding complete_uniform
 proof safe
   fix f :: "nat \<Rightarrow> 'a"
   assume f: "\<forall>n. f n \<in> S" "Cauchy f"
     and *: "\<forall>F\<le>principal S. F \<noteq> bot \<longrightarrow> cauchy_filter F \<longrightarrow> (\<exists>x\<in>S. F \<le> nhds x)"
   then show "\<exists>l\<in>S. f \<longlonglongrightarrow> l"
     unfolding filterlim_def using f
     by (intro *[rule_format])
        (auto simp: filtermap_sequentually_ne_bot le_principal eventually_filtermap Cauchy_uniform)
 next
   fix F :: "'a filter"
   assume "F \<le> principal S" "F \<noteq> bot" "cauchy_filter F"
   assume seq: "\<forall>f. (\<forall>n. f n \<in> S) \<and> Cauchy f \<longrightarrow> (\<exists>l\<in>S. f \<longlonglongrightarrow> l)"
 
   from \<open>F \<le> principal S\<close> \<open>cauchy_filter F\<close>
   have FF_le: "F \<times>\<^sub>F F \<le> uniformity_on S"
     by (simp add: cauchy_filter_def principal_prod_principal[symmetric] prod_filter_mono)
 
   let ?P = "\<lambda>P e. eventually P F \<and> (\<forall>x. P x \<longrightarrow> x \<in> S) \<and> (\<forall>x y. P x \<longrightarrow> P y \<longrightarrow> dist x y < e)"
   have P: "\<exists>P. ?P P \<epsilon>" if "0 < \<epsilon>" for \<epsilon> :: real
   proof -
     from that have "eventually (\<lambda>(x, y). x \<in> S \<and> y \<in> S \<and> dist x y < \<epsilon>) (uniformity_on S)"
       by (auto simp: eventually_inf_principal eventually_uniformity_metric)
     from filter_leD[OF FF_le this] show ?thesis
       by (auto simp: eventually_prod_same)
   qed
 
   have "\<exists>P. \<forall>n. ?P (P n) (1 / Suc n) \<and> P (Suc n) \<le> P n"
   proof (rule dependent_nat_choice)
     show "\<exists>P. ?P P (1 / Suc 0)"
       using P[of 1] by auto
   next
     fix P n assume "?P P (1/Suc n)"
     moreover obtain Q where "?P Q (1 / Suc (Suc n))"
       using P[of "1/Suc (Suc n)"] by auto
     ultimately show "\<exists>Q. ?P Q (1 / Suc (Suc n)) \<and> Q \<le> P"
       by (intro exI[of _ "\<lambda>x. P x \<and> Q x"]) (auto simp: eventually_conj_iff)
   qed
   then obtain P where P: "eventually (P n) F" "P n x \<Longrightarrow> x \<in> S"
     "P n x \<Longrightarrow> P n y \<Longrightarrow> dist x y < 1 / Suc n" "P (Suc n) \<le> P n"
     for n x y
     by metis
   have "antimono P"
     using P(4) unfolding decseq_Suc_iff le_fun_def by blast
 
   obtain X where X: "P n (X n)" for n
     using P(1)[THEN eventually_happens'[OF \<open>F \<noteq> bot\<close>]] by metis
   have "Cauchy X"
     unfolding metric_Cauchy_iff2 inverse_eq_divide
   proof (intro exI allI impI)
     fix j m n :: nat
     assume "j \<le> m" "j \<le> n"
     with \<open>antimono P\<close> X have "P j (X m)" "P j (X n)"
       by (auto simp: antimono_def)
     then show "dist (X m) (X n) < 1 / Suc j"
       by (rule P)
   qed
   moreover have "\<forall>n. X n \<in> S"
     using P(2) X by auto
   ultimately obtain x where "X \<longlonglongrightarrow> x" "x \<in> S"
     using seq by blast
 
   show "\<exists>x\<in>S. F \<le> nhds x"
   proof (rule bexI)
     have "eventually (\<lambda>y. dist y x < e) F" if "0 < e" for e :: real
     proof -
       from that have "(\<lambda>n. 1 / Suc n :: real) \<longlonglongrightarrow> 0 \<and> 0 < e / 2"
         by (subst filterlim_sequentially_Suc) (auto intro!: lim_1_over_n)
       then have "\<forall>\<^sub>F n in sequentially. dist (X n) x < e / 2 \<and> 1 / Suc n < e / 2"
         using \<open>X \<longlonglongrightarrow> x\<close>
         unfolding tendsto_iff order_tendsto_iff[where 'a=real] eventually_conj_iff
         by blast
       then obtain n where "dist x (X n) < e / 2" "1 / Suc n < e / 2"
         by (auto simp: eventually_sequentially dist_commute)
       show ?thesis
         using \<open>eventually (P n) F\<close>
       proof eventually_elim
         case (elim y)
         then have "dist y (X n) < 1 / Suc n"
           by (intro X P)
         also have "\<dots> < e / 2" by fact
         finally show "dist y x < e"
           by (rule dist_triangle_half_l) fact
       qed
     qed
     then show "F \<le> nhds x"
       unfolding nhds_metric le_INF_iff le_principal by auto
   qed fact
 qed
 
 text\<open>apparently unused\<close>
 lemma (in metric_space) totally_bounded_metric:
   "totally_bounded S \<longleftrightarrow> (\<forall>e>0. \<exists>k. finite k \<and> S \<subseteq> (\<Union>x\<in>k. {y. dist x y < e}))"
   unfolding totally_bounded_def eventually_uniformity_metric imp_ex
   apply (subst all_comm)
   apply (intro arg_cong[where f=All] ext, safe)
   subgoal for e
     apply (erule allE[of _ "\<lambda>(x, y). dist x y < e"])
     apply auto
     done
   subgoal for e P k
     apply (intro exI[of _ k])
     apply (force simp: subset_eq)
     done
   done
 
 
 subsubsection \<open>Cauchy Sequences are Convergent\<close>
 
 (* TODO: update to uniform_space *)
 class complete_space = metric_space +
   assumes Cauchy_convergent: "Cauchy X \<Longrightarrow> convergent X"
 
 lemma Cauchy_convergent_iff: "Cauchy X \<longleftrightarrow> convergent X"
   for X :: "nat \<Rightarrow> 'a::complete_space"
   by (blast intro: Cauchy_convergent convergent_Cauchy)
 
 text \<open>To prove that a Cauchy sequence converges, it suffices to show that a subsequence converges.\<close>
 
 lemma Cauchy_converges_subseq:
   fixes u::"nat \<Rightarrow> 'a::metric_space"
   assumes "Cauchy u"
     "strict_mono r"
     "(u \<circ> r) \<longlonglongrightarrow> l"
   shows "u \<longlonglongrightarrow> l"
 proof -
   have *: "eventually (\<lambda>n. dist (u n) l < e) sequentially" if "e > 0" for e
   proof -
     have "e/2 > 0" using that by auto
     then obtain N1 where N1: "\<And>m n. m \<ge> N1 \<Longrightarrow> n \<ge> N1 \<Longrightarrow> dist (u m) (u n) < e/2"
       using \<open>Cauchy u\<close> unfolding Cauchy_def by blast
     obtain N2 where N2: "\<And>n. n \<ge> N2 \<Longrightarrow> dist ((u \<circ> r) n) l < e / 2"
       using order_tendstoD(2)[OF iffD1[OF tendsto_dist_iff \<open>(u \<circ> r) \<longlonglongrightarrow> l\<close>] \<open>e/2 > 0\<close>]
       unfolding eventually_sequentially by auto
     have "dist (u n) l < e" if "n \<ge> max N1 N2" for n
     proof -
       have "dist (u n) l \<le> dist (u n) ((u \<circ> r) n) + dist ((u \<circ> r) n) l"
         by (rule dist_triangle)
       also have "\<dots> < e/2 + e/2"
       proof (intro add_strict_mono)
         show "dist (u n) ((u \<circ> r) n) < e / 2"
           using N1[of n "r n"] N2[of n] that unfolding comp_def
           by (meson assms(2) le_trans max.bounded_iff strict_mono_imp_increasing)
         show "dist ((u \<circ> r) n) l < e / 2"
           using N2 that by auto
       qed
       finally show ?thesis by simp
     qed 
     then show ?thesis unfolding eventually_sequentially by blast
   qed
   have "(\<lambda>n. dist (u n) l) \<longlonglongrightarrow> 0"
     by (simp add: less_le_trans * order_tendstoI)
   then show ?thesis using tendsto_dist_iff by auto
 qed
 
 subsection \<open>The set of real numbers is a complete metric space\<close>
 
 text \<open>
   Proof that Cauchy sequences converge based on the one from
   \<^url>\<open>http://pirate.shu.edu/~wachsmut/ira/numseq/proofs/cauconv.html\<close>
 \<close>
 
 text \<open>
   If sequence \<^term>\<open>X\<close> is Cauchy, then its limit is the lub of
   \<^term>\<open>{r::real. \<exists>N. \<forall>n\<ge>N. r < X n}\<close>
 \<close>
 lemma increasing_LIMSEQ:
   fixes f :: "nat \<Rightarrow> real"
   assumes inc: "\<And>n. f n \<le> f (Suc n)"
     and bdd: "\<And>n. f n \<le> l"
     and en: "\<And>e. 0 < e \<Longrightarrow> \<exists>n. l \<le> f n + e"
   shows "f \<longlonglongrightarrow> l"
 proof (rule increasing_tendsto)
   fix x
   assume "x < l"
   with dense[of 0 "l - x"] obtain e where "0 < e" "e < l - x"
     by auto
   from en[OF \<open>0 < e\<close>] obtain n where "l - e \<le> f n"
     by (auto simp: field_simps)
   with \<open>e < l - x\<close> \<open>0 < e\<close> have "x < f n"
     by simp
   with incseq_SucI[of f, OF inc] show "eventually (\<lambda>n. x < f n) sequentially"
     by (auto simp: eventually_sequentially incseq_def intro: less_le_trans)
 qed (use bdd in auto)
 
 lemma real_Cauchy_convergent:
   fixes X :: "nat \<Rightarrow> real"
   assumes X: "Cauchy X"
   shows "convergent X"
 proof -
   define S :: "real set" where "S = {x. \<exists>N. \<forall>n\<ge>N. x < X n}"
   then have mem_S: "\<And>N x. \<forall>n\<ge>N. x < X n \<Longrightarrow> x \<in> S"
     by auto
 
   have bound_isUb: "y \<le> x" if N: "\<forall>n\<ge>N. X n < x" and "y \<in> S" for N and x y :: real
   proof -
     from that have "\<exists>M. \<forall>n\<ge>M. y < X n"
       by (simp add: S_def)
     then obtain M where "\<forall>n\<ge>M. y < X n" ..
     then have "y < X (max M N)" by simp
     also have "\<dots> < x" using N by simp
     finally show ?thesis by (rule order_less_imp_le)
   qed
 
   obtain N where "\<forall>m\<ge>N. \<forall>n\<ge>N. dist (X m) (X n) < 1"
     using X[THEN metric_CauchyD, OF zero_less_one] by auto
   then have N: "\<forall>n\<ge>N. dist (X n) (X N) < 1" by simp
   have [simp]: "S \<noteq> {}"
   proof (intro exI ex_in_conv[THEN iffD1])
     from N have "\<forall>n\<ge>N. X N - 1 < X n"
       by (simp add: abs_diff_less_iff dist_real_def)
     then show "X N - 1 \<in> S" by (rule mem_S)
   qed
   have [simp]: "bdd_above S"
   proof
     from N have "\<forall>n\<ge>N. X n < X N + 1"
       by (simp add: abs_diff_less_iff dist_real_def)
     then show "\<And>s. s \<in> S \<Longrightarrow>  s \<le> X N + 1"
       by (rule bound_isUb)
   qed
   have "X \<longlonglongrightarrow> Sup S"
   proof (rule metric_LIMSEQ_I)
     fix r :: real
     assume "0 < r"
     then have r: "0 < r/2" by simp
     obtain N where "\<forall>n\<ge>N. \<forall>m\<ge>N. dist (X n) (X m) < r/2"
       using metric_CauchyD [OF X r] by auto
     then have "\<forall>n\<ge>N. dist (X n) (X N) < r/2" by simp
     then have N: "\<forall>n\<ge>N. X N - r/2 < X n \<and> X n < X N + r/2"
       by (simp only: dist_real_def abs_diff_less_iff)
 
     from N have "\<forall>n\<ge>N. X N - r/2 < X n" by blast
     then have "X N - r/2 \<in> S" by (rule mem_S)
     then have 1: "X N - r/2 \<le> Sup S" by (simp add: cSup_upper)
 
     from N have "\<forall>n\<ge>N. X n < X N + r/2" by blast
     from bound_isUb[OF this]
     have 2: "Sup S \<le> X N + r/2"
       by (intro cSup_least) simp_all
 
     show "\<exists>N. \<forall>n\<ge>N. dist (X n) (Sup S) < r"
     proof (intro exI allI impI)
       fix n
       assume n: "N \<le> n"
       from N n have "X n < X N + r/2" and "X N - r/2 < X n"
         by simp_all
       then show "dist (X n) (Sup S) < r" using 1 2
         by (simp add: abs_diff_less_iff dist_real_def)
     qed
   qed
   then show ?thesis by (auto simp: convergent_def)
 qed
 
 instance real :: complete_space
   by intro_classes (rule real_Cauchy_convergent)
 
 class banach = real_normed_vector + complete_space
 
 instance real :: banach ..
 
 lemma tendsto_at_topI_sequentially:
   fixes f :: "real \<Rightarrow> 'b::first_countable_topology"
   assumes *: "\<And>X. filterlim X at_top sequentially \<Longrightarrow> (\<lambda>n. f (X n)) \<longlonglongrightarrow> y"
   shows "(f \<longlongrightarrow> y) at_top"
 proof -
   obtain A where A: "decseq A" "open (A n)" "y \<in> A n" "nhds y = (INF n. principal (A n))" for n
     by (rule nhds_countable[of y]) (rule that)
 
   have "\<forall>m. \<exists>k. \<forall>x\<ge>k. f x \<in> A m"
   proof (rule ccontr)
     assume "\<not> (\<forall>m. \<exists>k. \<forall>x\<ge>k. f x \<in> A m)"
     then obtain m where "\<And>k. \<exists>x\<ge>k. f x \<notin> A m"
       by auto
     then have "\<exists>X. \<forall>n. (f (X n) \<notin> A m) \<and> max n (X n) + 1 \<le> X (Suc n)"
       by (intro dependent_nat_choice) (auto simp del: max.bounded_iff)
     then obtain X where X: "\<And>n. f (X n) \<notin> A m" "\<And>n. max n (X n) + 1 \<le> X (Suc n)"
       by auto
     have "1 \<le> n \<Longrightarrow> real n \<le> X n" for n
       using X[of "n - 1"] by auto
     then have "filterlim X at_top sequentially"
       by (force intro!: filterlim_at_top_mono[OF filterlim_real_sequentially]
           simp: eventually_sequentially)
     from topological_tendstoD[OF *[OF this] A(2, 3), of m] X(1) show False
       by auto
   qed
   then obtain k where "k m \<le> x \<Longrightarrow> f x \<in> A m" for m x
     by metis
   then show ?thesis
     unfolding at_top_def A by (intro filterlim_base[where i=k]) auto
 qed
 
 lemma tendsto_at_topI_sequentially_real:
   fixes f :: "real \<Rightarrow> real"
   assumes mono: "mono f"
     and limseq: "(\<lambda>n. f (real n)) \<longlonglongrightarrow> y"
   shows "(f \<longlongrightarrow> y) at_top"
 proof (rule tendstoI)
   fix e :: real
   assume "0 < e"
   with limseq obtain N :: nat where N: "N \<le> n \<Longrightarrow> \<bar>f (real n) - y\<bar> < e" for n
     by (auto simp: lim_sequentially dist_real_def)
   have le: "f x \<le> y" for x :: real
   proof -
     obtain n where "x \<le> real_of_nat n"
       using real_arch_simple[of x] ..
     note monoD[OF mono this]
     also have "f (real_of_nat n) \<le> y"
       by (rule LIMSEQ_le_const[OF limseq]) (auto intro!: exI[of _ n] monoD[OF mono])
     finally show ?thesis .
   qed
   have "eventually (\<lambda>x. real N \<le> x) at_top"
     by (rule eventually_ge_at_top)
   then show "eventually (\<lambda>x. dist (f x) y < e) at_top"
   proof eventually_elim
     case (elim x)
     with N[of N] le have "y - f (real N) < e" by auto
     moreover note monoD[OF mono elim]
     ultimately show "dist (f x) y < e"
       using le[of x] by (auto simp: dist_real_def field_simps)
   qed
 qed
 
 end