diff --git a/metadata/entries/Perfect_Fields.toml b/metadata/entries/Perfect_Fields.toml
--- a/metadata/entries/Perfect_Fields.toml
+++ b/metadata/entries/Perfect_Fields.toml
@@ -1,45 +1,45 @@
 title = "Perfect Fields"
 date = 2023-11-06
 topics = [
   "Mathematics/Algebra",
 ]
 abstract = """
 This entry provides a type class for <em>perfect fields</em>. 
 A perfect field <i>K</i> can be characterized by one of the following equivalent conditions:
 <ul>
 <li> Any irreducible polynomial <i>p</i> is separable, i.e. <i>gcd(p,p') = 1</i>, or, equivalently, <i>p'</i> non-zero.</li>
 <li> Either the characteristic of <i>K</i> is 0 or <i>p > 0</i> and the Frobenius endomorphism is surjective (i.e. every element of <i>K</i> has a <i>p</i>-th root).</li>
 </ul>
 We define perfect fields using the second characterization and show the equivalence to the first characterization.
 The implication ``2 => 1'' is relatively straightforward using the injectivity of the Frobenius homomorphism.
 
 Examples for perfect fields are:
 <ul>
 <li> any field of characteristic 0 (e.g. the reals or complex numbers)</li>
 <li> any finite field (i.e. <i>F<sub>q</sub></i> for <i>q=p<sup>n</sup></i>, <i>n > 0</i> and <i>p</i> prime)</li>
-<li> any algebraically closed field (for example the formal Puiseux series over finite fields)</li>
+<li> any algebraically closed field</li>
 </ul>"""
 license = "bsd"
 note = ""
 
 [authors]
 
 [authors.eberl]
 email = "eberl_email"
 
 [authors.kreuzer]
 email = "kreuzer_email"
 
 [contributors]
 
 [notify]
 eberl = "eberl_email"
 kreuzer = "kreuzer_email"
 
 [history]
 
 [extra]
 
 [related]
 dois = []
 pubs = []
diff --git a/thys/Berlekamp_Zassenhaus/Finite_Field.thy b/thys/Berlekamp_Zassenhaus/Finite_Field.thy
--- a/thys/Berlekamp_Zassenhaus/Finite_Field.thy
+++ b/thys/Berlekamp_Zassenhaus/Finite_Field.thy
@@ -1,353 +1,429 @@
 (*
     Authors:      Jose Divasón
                   Sebastiaan Joosten
                   René Thiemann
                   Akihisa Yamada
 *)
 section \<open>Finite Rings and Fields\<close>
 
 text \<open>We start by establishing some preliminary results about finite rings and finite fields\<close>
 
 subsection \<open>Finite Rings\<close>
 
 theory Finite_Field
 imports 
   "HOL-Computational_Algebra.Primes"
   "HOL-Number_Theory.Residues"
   "HOL-Library.Cardinality"
   Subresultants.Binary_Exponentiation
   Polynomial_Interpolation.Ring_Hom_Poly
 begin
 
 typedef ('a::finite) mod_ring = "{0..<int CARD('a)}" by auto
 
 setup_lifting type_definition_mod_ring
 
 lemma CARD_mod_ring[simp]: "CARD('a mod_ring) = CARD('a::finite)" 
 proof -
   have "card {y. \<exists>x\<in>{0..<int CARD('a)}. (y::'a mod_ring) = Abs_mod_ring x} = card {0..<int CARD('a)}"
   proof (rule bij_betw_same_card)
     have "inj_on Rep_mod_ring {y. \<exists>x\<in>{0..<int CARD('a)}. y = Abs_mod_ring x}"
       by (meson Rep_mod_ring_inject inj_onI)      
     moreover have "Rep_mod_ring ` {y. \<exists>x\<in>{0..<int CARD('a)}. (y::'a mod_ring) = Abs_mod_ring x} = {0..<int CARD('a)}"
     proof (auto simp add: image_def Rep_mod_ring_inject)
       fix xb show "0 \<le> Rep_mod_ring (Abs_mod_ring xb)" 
         using Rep_mod_ring atLeastLessThan_iff by blast 
       assume xb1: "0 \<le> xb" and xb2: "xb < int CARD('a)"
       thus " Rep_mod_ring (Abs_mod_ring xb) < int CARD('a)"
         by (metis Abs_mod_ring_inverse Rep_mod_ring atLeastLessThan_iff le_less_trans linear)
       have xb: "xb \<in> {0..<int CARD('a)}" using xb1 xb2 by simp
       show "\<exists>xa::'a mod_ring. (\<exists>x\<in>{0..<int CARD('a)}. xa = Abs_mod_ring x) \<and> xb = Rep_mod_ring xa"
       by (rule exI[of _ "Abs_mod_ring xb"], auto simp add: xb1 xb2, rule Abs_mod_ring_inverse[OF xb, symmetric])
     qed    
     ultimately show "bij_betw Rep_mod_ring
       {y. \<exists>x\<in>{0..<int CARD('a)}. (y::'a mod_ring) = Abs_mod_ring x} 
       {0..<int CARD('a)}"
       by (simp add: bij_betw_def)
   qed
   thus ?thesis
     unfolding type_definition.univ[OF type_definition_mod_ring]
     unfolding image_def by auto
 qed
 
 instance mod_ring :: (finite) finite 
 proof (intro_classes)
   show "finite (UNIV::'a mod_ring set)" 
     unfolding type_definition.univ[OF type_definition_mod_ring]
     using finite by simp
 qed
 
 
 instantiation mod_ring :: (finite) equal
 begin
 lift_definition equal_mod_ring :: "'a mod_ring \<Rightarrow> 'a mod_ring \<Rightarrow> bool" is "(=)" .
 instance by (intro_classes, transfer, auto)
 end
 
 instantiation mod_ring :: (finite) comm_ring
 begin
 
 lift_definition plus_mod_ring :: "'a mod_ring \<Rightarrow> 'a mod_ring \<Rightarrow> 'a mod_ring" is
   "\<lambda> x y. (x + y) mod int (CARD('a))" by simp
 
 lift_definition uminus_mod_ring :: "'a mod_ring \<Rightarrow> 'a mod_ring" is
   "\<lambda> x. if x = 0 then 0 else int (CARD('a)) - x" by simp
 
 lift_definition minus_mod_ring :: "'a mod_ring \<Rightarrow> 'a mod_ring \<Rightarrow> 'a mod_ring" is
   "\<lambda> x y. (x - y) mod int (CARD('a))" by simp
 
 lift_definition times_mod_ring :: "'a mod_ring \<Rightarrow> 'a mod_ring \<Rightarrow> 'a mod_ring" is
   "\<lambda> x y. (x * y) mod int (CARD('a))" by simp
 
 lift_definition zero_mod_ring :: "'a mod_ring" is 0 by simp
 
 instance
   by standard
     (transfer; auto simp add: mod_simps algebra_simps intro: mod_diff_cong)+
 
 end
 
 lift_definition to_int_mod_ring :: "'a::finite mod_ring \<Rightarrow> int" is "\<lambda> x. x" .
 
 lift_definition of_int_mod_ring :: "int \<Rightarrow> 'a::finite mod_ring" is
   "\<lambda> x. x mod int (CARD('a))" by simp
 
 interpretation to_int_mod_ring_hom: inj_zero_hom to_int_mod_ring
   by (unfold_locales; transfer, auto)
 
 lemma int_nat_card[simp]: "int (nat CARD('a::finite)) = CARD('a)" by auto
 
 interpretation of_int_mod_ring_hom: zero_hom of_int_mod_ring
   by (unfold_locales, transfer, auto)
 
 lemma of_int_mod_ring_to_int_mod_ring[simp]:
   "of_int_mod_ring (to_int_mod_ring x) = x" by (transfer, auto)
 
 lemma to_int_mod_ring_of_int_mod_ring[simp]: "0 \<le> x \<Longrightarrow> x < int CARD('a :: finite) \<Longrightarrow>
   to_int_mod_ring (of_int_mod_ring x :: 'a mod_ring) = x"
   by (transfer, auto)
 
 lemma range_to_int_mod_ring:
   "range (to_int_mod_ring :: ('a :: finite mod_ring \<Rightarrow> int)) = {0 ..< CARD('a)}"
   apply (intro equalityI subsetI)
   apply (elim rangeE, transfer, force)
   by (auto intro!: range_eqI to_int_mod_ring_of_int_mod_ring[symmetric])
 
 subsection \<open>Nontrivial Finite Rings\<close>
 
 class nontriv = assumes nontriv: "CARD('a) > 1"
 
 subclass(in nontriv) finite by(intro_classes,insert nontriv,auto intro:card_ge_0_finite)
 
 instantiation mod_ring :: (nontriv) comm_ring_1
 begin
 
 lift_definition one_mod_ring :: "'a mod_ring" is 1 using nontriv[where ?'a='a] by auto
 
 instance by (intro_classes; transfer, simp)
 
 end
 
 interpretation to_int_mod_ring_hom: inj_one_hom to_int_mod_ring
   by (unfold_locales, transfer, simp)
 
 lemma of_nat_of_int_mod_ring [code_unfold]:
   "of_nat = of_int_mod_ring o int"
 proof (rule ext, unfold o_def)
   show "of_nat n = of_int_mod_ring (int n)" for n
   proof (induct n)
     case (Suc n)
     show ?case
       by (simp only: of_nat_Suc Suc, transfer) (simp add: mod_simps)
   qed simp
 qed
 
 lemma of_nat_card_eq_0[simp]: "(of_nat (CARD('a::nontriv)) :: 'a mod_ring) = 0"
   by (unfold of_nat_of_int_mod_ring, transfer, auto)
 
 lemma of_int_of_int_mod_ring[code_unfold]: "of_int = of_int_mod_ring"
 proof (rule ext)
   fix x :: int
   obtain n1 n2 where x: "x = int n1 - int n2" by (rule int_diff_cases)
   show "of_int x = of_int_mod_ring x"
     unfolding x of_int_diff of_int_of_nat_eq of_nat_of_int_mod_ring o_def
     by (transfer, simp add: mod_diff_right_eq mod_diff_left_eq)
 qed
 
 unbundle lifting_syntax
 
 lemma pcr_mod_ring_to_int_mod_ring: "pcr_mod_ring = (\<lambda>x y. x = to_int_mod_ring y)"
  unfolding mod_ring.pcr_cr_eq unfolding cr_mod_ring_def to_int_mod_ring.rep_eq ..
 
 lemma [transfer_rule]:
   "((=) ===> pcr_mod_ring) (\<lambda> x. int x mod int (CARD('a :: nontriv))) (of_nat :: nat \<Rightarrow> 'a mod_ring)"
   by (intro rel_funI, unfold pcr_mod_ring_to_int_mod_ring of_nat_of_int_mod_ring, transfer, auto)
 
 lemma [transfer_rule]:
   "((=) ===> pcr_mod_ring) (\<lambda> x. x mod int (CARD('a :: nontriv))) (of_int :: int \<Rightarrow> 'a mod_ring)"
   by (intro rel_funI, unfold pcr_mod_ring_to_int_mod_ring of_int_of_int_mod_ring, transfer, auto)
 
 lemma one_mod_card [simp]: "1 mod CARD('a::nontriv) = 1"
   using mod_less nontriv by blast 
 
 lemma Suc_0_mod_card [simp]: "Suc 0 mod CARD('a::nontriv) = 1"
   using one_mod_card by simp
 
 lemma one_mod_card_int [simp]: "1 mod int CARD('a::nontriv) = 1"
 proof -
   from nontriv [where ?'a = 'a] have "int (1 mod CARD('a::nontriv)) = 1"
     by simp
   then show ?thesis
     using of_nat_mod [of 1 "CARD('a)", where ?'a = int] by simp
 qed
 
 lemma pow_mod_ring_transfer[transfer_rule]:
   "(pcr_mod_ring ===> (=) ===> pcr_mod_ring) 
    (\<lambda>a::int. \<lambda>n. a^n mod CARD('a::nontriv)) ((^)::'a mod_ring \<Rightarrow> nat \<Rightarrow> 'a mod_ring)"
 unfolding pcr_mod_ring_to_int_mod_ring
 proof (intro rel_funI,simp)
   fix x::"'a mod_ring" and n
   show "to_int_mod_ring x ^ n mod int CARD('a) = to_int_mod_ring (x ^ n)"
   proof (induct n)
     case 0
     thus ?case by auto
   next
     case (Suc n)
     have "to_int_mod_ring (x ^ Suc n) = to_int_mod_ring (x * x ^ n)" by auto
     also have "... = to_int_mod_ring x * to_int_mod_ring (x ^ n) mod CARD('a)"
       unfolding to_int_mod_ring_def using times_mod_ring.rep_eq by auto
     also have "... = to_int_mod_ring x * (to_int_mod_ring x ^ n mod CARD('a)) mod CARD('a)"
       using Suc.hyps by auto
     also have "... = to_int_mod_ring x ^ Suc n mod int CARD('a)"
       by (simp add: mod_simps)
     finally show ?case ..
   qed
 qed
 
 lemma dvd_mod_ring_transfer[transfer_rule]:
 "((pcr_mod_ring :: int \<Rightarrow> 'a :: nontriv mod_ring \<Rightarrow> bool) ===>
   (pcr_mod_ring :: int \<Rightarrow> 'a mod_ring \<Rightarrow> bool) ===> (=))
   (\<lambda> i j. \<exists>k \<in> {0..<int CARD('a)}. j = i * k mod int CARD('a)) (dvd)"
 proof (unfold pcr_mod_ring_to_int_mod_ring, intro rel_funI iffI)
   fix x y :: "'a mod_ring" and i j
   assume i: "i = to_int_mod_ring x" and j: "j = to_int_mod_ring y"
   { assume "x dvd y"
     then obtain z where "y = x * z" by (elim dvdE, auto)
     then have "j = i * to_int_mod_ring z mod CARD('a)" by (unfold i j, transfer)
     with range_to_int_mod_ring
     show "\<exists>k \<in> {0..<int CARD('a)}. j = i * k mod CARD('a)" by auto
   }
   assume "\<exists>k \<in> {0..<int CARD('a)}. j = i * k mod CARD('a)"
   then obtain k where k: "k \<in> {0..<int CARD('a)}" and dvd: "j = i * k mod CARD('a)" by auto
   from k have "to_int_mod_ring (of_int k :: 'a mod_ring) = k" by (transfer, auto)
   also from dvd have "j = i * ... mod CARD('a)" by auto
   finally have "y = x * (of_int k :: 'a mod_ring)" unfolding i j using k by (transfer, auto)
   then show "x dvd y" by auto
 qed
 
 lemma Rep_mod_ring_mod[simp]: "Rep_mod_ring (a :: 'a :: nontriv mod_ring) mod CARD('a) = Rep_mod_ring a"
   using Rep_mod_ring[where 'a = 'a] by auto
 
 subsection \<open>Finite Fields\<close>
 
 text \<open>When the domain is prime, the ring becomes a field\<close>
 
 class prime_card = assumes prime_card: "prime (CARD('a))"
 begin
 lemma prime_card_int: "prime (int (CARD('a)))" using prime_card by auto
 
 subclass nontriv using prime_card prime_gt_1_nat by (intro_classes,auto)
 end
 
 instance bool :: prime_card
   by standard auto
 
 instantiation mod_ring :: (prime_card) field
 begin
  
 definition inverse_mod_ring :: "'a mod_ring \<Rightarrow> 'a mod_ring" where
   "inverse_mod_ring x = (if x = 0 then 0 else x ^ (nat (CARD('a) - 2)))"
 
 definition divide_mod_ring :: "'a mod_ring \<Rightarrow> 'a mod_ring \<Rightarrow> 'a mod_ring"  where
   "divide_mod_ring x y = x * ((\<lambda>c. if c = 0 then 0 else c ^ (nat (CARD('a) - 2))) y)" 
 
 instance
 proof
   fix a b c::"'a mod_ring"
   show "inverse 0 = (0::'a mod_ring)" by (simp add: inverse_mod_ring_def)
   show "a div b = a * inverse b" 
     unfolding inverse_mod_ring_def by (transfer', simp add: divide_mod_ring_def)
   show "a \<noteq> 0 \<Longrightarrow> inverse a * a = 1"
   proof (unfold inverse_mod_ring_def, transfer)
     let ?p="CARD('a)"
     fix x
     assume x: "x \<in> {0..<int CARD('a)}" and x0: "x \<noteq> 0"
     have p0': "0\<le>?p" by auto
     have "\<not> ?p dvd x"
       using x x0 zdvd_imp_le by fastforce
     then have "\<not> CARD('a) dvd nat \<bar>x\<bar>"
       by simp
     with x have "\<not> CARD('a) dvd nat x"
       by simp
     have rw: "x ^ nat (int (?p - 2)) * x = x ^ nat (?p - 1)"
     proof -
       have p2: "0 \<le> int (?p-2)" using x by simp
       have card_rw: "(CARD('a) - Suc 0) = nat (1 + int (CARD('a) - 2))" 
         using nat_eq_iff x x0 by auto
       have "x ^ nat (?p - 2)*x = x ^ (Suc (nat (?p - 2)))" by simp
       also have "... = x ^ (nat (?p - 1))"
         using Suc_nat_eq_nat_zadd1[OF p2] card_rw by auto
       finally show ?thesis .
     qed
     have "[int (nat x ^ (CARD('a) - 1)) = int 1] (mod CARD('a))"
       using fermat_theorem [OF prime_card \<open>\<not> CARD('a) dvd nat x\<close>]
       by (simp only: cong_def cong_def of_nat_mod [symmetric])
     then have *: "[x ^ (CARD('a) - 1) = 1] (mod CARD('a))"
       using x by auto
     have "x ^ (CARD('a) - 2) mod CARD('a) * x mod CARD('a) 
       = (x ^ nat (CARD('a) - 2) * x) mod CARD('a)" by (simp add: mod_simps)
     also have "... =  (x ^ nat (?p - 1) mod ?p)" unfolding rw by simp
     also have "... = (x ^ (nat ?p - 1) mod ?p)" using p0' by (simp add: nat_diff_distrib')
     also have "... = 1"
       using * by (simp add: cong_def)
     finally show "(if x = 0 then 0 else x ^ nat (int (CARD('a) - 2)) mod CARD('a)) * x mod CARD('a) = 1"
       using x0 by auto
   qed
 qed
 end
 
 instantiation mod_ring :: (prime_card) "{normalization_euclidean_semiring, euclidean_ring}"
 begin
 
 definition modulo_mod_ring :: "'a mod_ring \<Rightarrow> 'a mod_ring \<Rightarrow> 'a mod_ring" where "modulo_mod_ring x y = (if y = 0 then x else 0)"
 definition normalize_mod_ring :: "'a mod_ring \<Rightarrow> 'a mod_ring" where "normalize_mod_ring x = (if x = 0 then 0 else 1)" 
 definition unit_factor_mod_ring :: "'a mod_ring \<Rightarrow> 'a mod_ring" where "unit_factor_mod_ring x = x" 
 definition euclidean_size_mod_ring :: "'a mod_ring \<Rightarrow> nat" where "euclidean_size_mod_ring x = (if x = 0 then 0 else 1)" 
 
 instance
 proof (intro_classes)
   fix a :: "'a mod_ring" show "a \<noteq> 0 \<Longrightarrow> unit_factor a dvd 1"
     unfolding dvd_def unit_factor_mod_ring_def by (intro exI[of _ "inverse a"], auto)
 qed (auto simp: normalize_mod_ring_def unit_factor_mod_ring_def modulo_mod_ring_def
      euclidean_size_mod_ring_def field_simps)
 end
 
 instantiation mod_ring :: (prime_card) euclidean_ring_gcd
 begin
 
 definition gcd_mod_ring :: "'a mod_ring \<Rightarrow> 'a mod_ring \<Rightarrow> 'a mod_ring" where "gcd_mod_ring = Euclidean_Algorithm.gcd"
 definition lcm_mod_ring :: "'a mod_ring \<Rightarrow> 'a mod_ring \<Rightarrow> 'a mod_ring" where "lcm_mod_ring = Euclidean_Algorithm.lcm"
 definition Gcd_mod_ring :: "'a mod_ring set \<Rightarrow> 'a mod_ring" where "Gcd_mod_ring = Euclidean_Algorithm.Gcd"
 definition Lcm_mod_ring :: "'a mod_ring set \<Rightarrow> 'a mod_ring" where "Lcm_mod_ring = Euclidean_Algorithm.Lcm"
 
 instance by (intro_classes, auto simp: gcd_mod_ring_def lcm_mod_ring_def Gcd_mod_ring_def Lcm_mod_ring_def)
 end
 
 instantiation mod_ring :: (prime_card) unique_euclidean_ring
 begin
 
 definition [simp]: "division_segment_mod_ring (x :: 'a mod_ring) = (1 :: 'a mod_ring)"
 
 instance by intro_classes (auto simp: euclidean_size_mod_ring_def split: if_splits)
 
 end
 
 instance mod_ring :: (prime_card) field_gcd
   by intro_classes auto
 
 
 lemma surj_of_nat_mod_ring: "\<exists> i. i < CARD('a :: prime_card) \<and> (x :: 'a mod_ring) = of_nat i" 
   by (rule exI[of _ "nat (to_int_mod_ring x)"], unfold of_nat_of_int_mod_ring o_def,
   subst nat_0_le, transfer, simp, simp, transfer, auto) 
 
 lemma of_nat_0_mod_ring_dvd: assumes x: "of_nat x = (0 :: 'a ::prime_card mod_ring)"
   shows "CARD('a) dvd x" 
 proof -
   let ?x = "of_nat x :: int" 
   from x have "of_int_mod_ring ?x = (0 :: 'a mod_ring)" by (fold of_int_of_int_mod_ring, simp)
   hence "?x mod CARD('a) = 0" by (transfer, auto)
   hence "x mod CARD('a) = 0" by presburger
   thus ?thesis unfolding mod_eq_0_iff_dvd .
 qed
 
+lemma semiring_char_mod_ring [simp]:
+  "CHAR('n :: nontriv mod_ring) = CARD('n)"
+proof (rule CHAR_eq_posI)
+  fix x assume "x > 0" "x < CARD('n)"
+  thus "of_nat x \<noteq> (0 :: 'n mod_ring)"
+    by transfer auto
+qed auto
+
+
+text \<open>
+  The following Material was contributed by Manuel Eberl
+\<close>
+instance mod_ring :: (prime_card) finite_field
+  by standard simp_all
+
+instantiation mod_ring :: (prime_card) enum_finite_field
+begin
+
+definition enum_finite_field_mod_ring :: "nat \<Rightarrow> 'a mod_ring" where
+  "enum_finite_field_mod_ring n = of_int_mod_ring (int n)"
+
+instance proof
+  interpret type_definition "Rep_mod_ring :: 'a mod_ring \<Rightarrow> int" Abs_mod_ring "{0..<CARD('a)}"
+    by (rule type_definition_mod_ring)
+  have "enum_finite_field ` {..<CARD('a mod_ring)} = of_int_mod_ring ` int ` {..<CARD('a mod_ring)}"
+    unfolding enum_finite_field_mod_ring_def by (simp add: image_image o_def)
+  also have "int ` {..<CARD('a mod_ring)} = {0..<int CARD('a mod_ring)}"
+    by (simp add: image_atLeastZeroLessThan_int)
+  also have "of_int_mod_ring ` \<dots> = (Abs_mod_ring ` \<dots> :: 'a mod_ring set)"
+    by (intro image_cong refl) (auto simp: of_int_mod_ring_def)
+  also have "\<dots> = (UNIV :: 'a mod_ring set)"
+    using Abs_image by simp
+  finally show "enum_finite_field ` {..<CARD('a mod_ring)} = (UNIV :: 'a mod_ring set)" .
+qed
+
 end
+
+typedef (overloaded) 'a :: semiring_1 ring_char = "if CHAR('a) = 0 then UNIV else {0..<CHAR('a)}"
+  by auto
+
+lemma CARD_ring_char [simp]: "CARD ('a :: semiring_1 ring_char) = CHAR('a)"
+proof -
+  let ?A = "if CHAR('a) = 0 then UNIV else {0..<CHAR('a)}"
+  interpret type_definition "Rep_ring_char :: 'a ring_char \<Rightarrow> nat" Abs_ring_char ?A
+    by (rule type_definition_ring_char)
+  from card show ?thesis
+    by auto
+qed
+
+instance ring_char :: (semiring_prime_char) nontriv
+proof
+  show "CARD('a ring_char) > 1"
+    using prime_nat_iff by auto
+qed
+
+instance ring_char :: (semiring_prime_char) prime_card
+proof
+  from CARD_ring_char show "prime CARD('a ring_char)"
+    by auto
+qed
+
+lemma to_int_mod_ring_add:
+  "to_int_mod_ring (x + y :: 'a :: finite mod_ring) = (to_int_mod_ring x + to_int_mod_ring y) mod CARD('a)"
+  by transfer auto
+
+lemma to_int_mod_ring_mult:
+  "to_int_mod_ring (x * y :: 'a :: finite mod_ring) = (to_int_mod_ring x * to_int_mod_ring y) mod CARD('a)"
+  by transfer auto
+
+lemma of_nat_mod_CHAR [simp]: "of_nat (x mod CHAR('a :: semiring_1)) = (of_nat x :: 'a)"
+  by (metis (no_types, opaque_lifting) comm_monoid_add_class.add_0 div_mod_decomp
+         mult_zero_right of_nat_CHAR of_nat_add of_nat_mult)
+
+lemma of_int_mod_CHAR [simp]: "of_int (x mod int CHAR('a :: ring_1)) = (of_int x :: 'a)"
+  by (simp add: of_int_eq_iff_cong_CHAR)
+
+end
diff --git a/thys/Formal_Puiseux_Series/Formal_Puiseux_Series.thy b/thys/Formal_Puiseux_Series/Formal_Puiseux_Series.thy
--- a/thys/Formal_Puiseux_Series/Formal_Puiseux_Series.thy
+++ b/thys/Formal_Puiseux_Series/Formal_Puiseux_Series.thy
@@ -1,1824 +1,1841 @@
 (*
   File:    Formal_Puiseux_Series.thy
   Author:  Manuel Eberl, TU München
 *)
 section \<open>Formal Puiseux Series\<close>
 theory Formal_Puiseux_Series
   imports FPS_Hensel
 begin
 
 subsection \<open>Auxiliary facts and definitions\<close>
 
 lemma div_dvd_self:
   fixes a b :: "'a :: {semidom_divide}"
   shows "b dvd a \<Longrightarrow> a div b dvd a"
   by (elim dvdE; cases "b = 0") simp_all
 
 lemma quotient_of_int [simp]: "quotient_of (of_int n) = (n, 1)"
   using Rat.of_int_def quotient_of_int by auto
 
 lemma of_int_div_of_int_in_Ints_iff:
   "(of_int n / of_int m :: 'a :: field_char_0) \<in> \<int> \<longleftrightarrow> m = 0 \<or> m dvd n"
 proof
   assume *: "(of_int n / of_int m :: 'a) \<in> \<int>"
   {
     assume "m \<noteq> 0"
     from * obtain k where k: "(of_int n / of_int m :: 'a) = of_int k"
       by (auto elim!: Ints_cases)
     hence "of_int n = (of_int k * of_int m :: 'a)"
       using \<open>m \<noteq> 0\<close> by (simp add: field_simps)
     also have "\<dots> = of_int (k * m)"
       by simp
     finally have "n = k * m"
       by (subst (asm) of_int_eq_iff)
     hence "m dvd n" by auto
   }
   thus "m = 0 \<or> m dvd n" by blast
 qed auto
 
 lemma rat_eq_quotientD:
   assumes "r = rat_of_int a / rat_of_int b" "b \<noteq> 0"
   shows   "fst (quotient_of r) dvd a" "snd (quotient_of r) dvd b"
 proof -
   define a' b' where "a' = fst (quotient_of r)" and "b' = snd (quotient_of r)"
   define d where "d = gcd a b"
   have "b' > 0"
     by (auto simp: b'_def quotient_of_denom_pos')
 
   have "coprime a' b'"
     by (rule quotient_of_coprime[of r]) (simp add: a'_def b'_def)
   have r: "r = rat_of_int a' / rat_of_int b'"
     by (simp add: a'_def b'_def quotient_of_div)
   from assms \<open>b' > 0\<close> have "rat_of_int (a' * b) = rat_of_int (a * b')"
     unfolding of_int_mult by (simp add: field_simps r)
   hence eq: "a' * b = a * b'"
     by (subst (asm) of_int_eq_iff)
 
   have "a' dvd a * b'"
     by (simp flip: eq)
   hence "a' dvd a"
     by (subst (asm) coprime_dvd_mult_left_iff) fact
   moreover have "b' dvd a' * b"
     by (simp add: eq)
   hence "b' dvd b"
     by (subst (asm) coprime_dvd_mult_right_iff) (use \<open>coprime a' b'\<close> in \<open>simp add: coprime_commute\<close>)
   ultimately show "fst (quotient_of r) dvd a" "snd (quotient_of r) dvd b"
     unfolding a'_def b'_def by blast+
 qed
 
 lemma quotient_of_denom_add_dvd:
   "snd (quotient_of (x + y)) dvd snd (quotient_of x) * snd (quotient_of y)"
 proof -
   define a b where "a = fst (quotient_of x)" and "b = snd (quotient_of x)"
   define c d where "c = fst (quotient_of y)" and "d = snd (quotient_of y)"
   have "b > 0" "d > 0"
     by (auto simp: b_def d_def quotient_of_denom_pos')
   have xy: "x = rat_of_int a / rat_of_int b" "y = rat_of_int c / rat_of_int d"
     unfolding a_def b_def c_def d_def by (simp_all add: quotient_of_div)
 
   show "snd (quotient_of (x + y)) dvd b * d"
   proof (rule rat_eq_quotientD)
     show "x + y = rat_of_int (a * d + c * b) / rat_of_int (b * d)"
       using \<open>b > 0\<close> \<open>d > 0\<close> by (simp add: field_simps xy)
   qed (use \<open>b > 0\<close> \<open>d > 0\<close> in auto)
 qed
 
 lemma quotient_of_denom_diff_dvd:
   "snd (quotient_of (x - y)) dvd snd (quotient_of x) * snd (quotient_of y)"
   using quotient_of_denom_add_dvd[of x "-y"]
   by (simp add: rat_uminus_code Let_def case_prod_unfold)
 
 
 definition supp :: "('a \<Rightarrow> ('b :: zero)) \<Rightarrow> 'a set" where
   "supp f = f -` (-{0})"
 
 lemma supp_0 [simp]: "supp (\<lambda>_. 0) = {}"
   and supp_const: "supp (\<lambda>_. c) = (if c = 0 then {} else UNIV)"
   and supp_singleton [simp]: "c \<noteq> 0 \<Longrightarrow> supp (\<lambda>x. if x = d then c else 0) = {d}"
   by (auto simp: supp_def)
 
 lemma supp_uminus [simp]: "supp (\<lambda>x. -f x :: 'a :: group_add) = supp f"
   by (auto simp: supp_def)
 
 
 subsection \<open>Definition\<close>
 
 text \<open>
   Similarly to formal power series $R[[X]]$ and formal Laurent series $R((X))$, we define the ring
   of formal Puiseux series $R\{\{X\}\}$ as functions from the rationals into a ring such that
 
     \<^enum> the support is bounded from below, and 
 
     \<^enum> the denominators of the numbers in the support have a common multiple other than 0
 
   One can also think of a formal Puiseux series in the paramter $X$ as a formal Laurent series
   in the parameter $X^{1/d}$ for some positive integer $d$. This is often written in the
   following suggestive notation:
   \[ R\{\{X\}\} = \bigcup_{d\geq 1} R((X^{1/d})) \]
 
   Many operations will be defined in terms of this correspondence between Puiseux and Laurent
   series, and many of the simple properties proven that way.
 \<close>
 
 definition is_fpxs :: "(rat \<Rightarrow> 'a :: zero) \<Rightarrow> bool" where
   "is_fpxs f \<longleftrightarrow> bdd_below (supp f) \<and> (LCM r\<in>supp f. snd (quotient_of r)) \<noteq> 0"
 
 typedef (overloaded) 'a fpxs = "{f::rat \<Rightarrow> 'a :: zero. is_fpxs f}"
   morphisms fpxs_nth Abs_fpxs
   by (rule exI[of _ "\<lambda>_. 0"]) (auto simp: is_fpxs_def supp_def)
 
 setup_lifting type_definition_fpxs
 
 lemma fpxs_ext: "(\<And>r. fpxs_nth f r = fpxs_nth g r) \<Longrightarrow> f = g"
   by transfer auto
 
 lemma fpxs_eq_iff: "f = g \<longleftrightarrow> (\<forall>r. fpxs_nth f r = fpxs_nth g r)"
   by transfer auto
 
 lift_definition fpxs_supp :: "'a :: zero fpxs \<Rightarrow> rat set" is supp .
 
 lemma fpxs_supp_altdef: "fpxs_supp f = {x. fpxs_nth f x \<noteq> 0}"
   by transfer (auto simp: supp_def)
 
 
 text \<open>
   The following gives us the ``root order'' of \<open>f\<close>i, i.e. the smallest positive integer \<open>d\<close>
   such that \<open>f\<close> is in $R((X^{1/p}))$.
 \<close>
 lift_definition fpxs_root_order :: "'a :: zero fpxs \<Rightarrow> nat" is
   "\<lambda>f. nat (LCM r\<in>supp f. snd (quotient_of r))" .
 
 lemma fpxs_root_order_pos [simp]: "fpxs_root_order f > 0"
 proof transfer
   fix f :: "rat \<Rightarrow> 'a" assume f: "is_fpxs f"
   hence "(LCM r\<in>supp f. snd (quotient_of r)) \<noteq> 0"
     by (auto simp: is_fpxs_def)
   moreover have "(LCM r\<in>supp f. snd (quotient_of r)) \<ge> 0"
     by simp
   ultimately show "nat (LCM r\<in>supp f. snd (quotient_of r)) > 0"
     by linarith
 qed
 
 lemma fpxs_root_order_nonzero [simp]: "fpxs_root_order f \<noteq> 0"
   using fpxs_root_order_pos[of f] by linarith
 
 
 text \<open>
   Let \<open>d\<close> denote the root order of a Puiseux series \<open>f\<close>, i.e. the smallest number \<open>d\<close> such that
   all monomials with non-zero coefficients can be written in the form $X^{n/d}$ for some \<open>n\<close>.
   Then \<open>f\<close> can be written as a Laurent series in \<open>X^{1/d}\<close>. The following operation gives us
   this Laurent series.
 \<close>
 lift_definition fls_of_fpxs :: "'a :: zero fpxs \<Rightarrow> 'a fls" is
   "\<lambda>f n. f (of_int n / of_int (LCM r\<in>supp f. snd (quotient_of r)))"
 proof -
   fix f :: "rat \<Rightarrow> 'a"
   assume f: "is_fpxs f"
   hence "bdd_below (supp f)"
     by (auto simp: is_fpxs_def)
   then obtain r0 where "\<forall>x\<in>supp f. r0 \<le> x"
     by (auto simp: bdd_below_def)
   hence r0: "f x = 0" if "x < r0" for x
     using that by (auto simp: supp_def vimage_def)
   define d :: int where "d = (LCM r\<in>supp f. snd (quotient_of r))"
   have "d \<ge> 0" by (simp add: d_def)
   moreover have "d \<noteq> 0"
     using f by (auto simp: d_def is_fpxs_def)
   ultimately have "d > 0" by linarith
 
   have *: "f (of_int n / of_int d) = 0" if "n < \<lfloor>r0 * of_int d\<rfloor>" for n
   proof -
     have "rat_of_int n < r0 * rat_of_int d"
       using that by linarith
     thus ?thesis
       using \<open>d > 0\<close> by (intro r0) (auto simp: field_simps)
   qed
   have "eventually (\<lambda>n. n > -\<lfloor>r0 * of_int d\<rfloor>) at_top"
     by (rule eventually_gt_at_top)
   hence "eventually (\<lambda>n. f (of_int (-n) / of_int d) = 0) at_top"
     by (eventually_elim) (rule *, auto)
   hence "eventually (\<lambda>n. f (of_int (-int n) / of_int d) = 0) at_top"
     by (rule eventually_compose_filterlim) (rule filterlim_int_sequentially)
   thus "eventually (\<lambda>n. f (of_int (-int n) / of_int d) = 0) cofinite"
     by (simp add: cofinite_eq_sequentially)
 qed
 
 lemma fls_nth_of_fpxs:
   "fls_nth (fls_of_fpxs f) n = fpxs_nth f (of_int n / of_nat (fpxs_root_order f))"
   by transfer simp
 
 
 subsection \<open>Basic algebraic typeclass instances\<close>
 
 instantiation fpxs :: (zero) zero
 begin
 
 lift_definition zero_fpxs :: "'a fpxs" is "\<lambda>r::rat. 0 :: 'a"
   by (auto simp: is_fpxs_def supp_def)
 
 instance ..
 
 end
 
 instantiation fpxs :: ("{one, zero}") one
 begin
 
 lift_definition one_fpxs :: "'a fpxs" is "\<lambda>r::rat. if r = 0 then 1 else 0 :: 'a"
   by (cases "(1 :: 'a) = 0") (auto simp: is_fpxs_def cong: if_cong)
 
 instance ..
 
 end
 
 lemma fls_of_fpxs_0 [simp]: "fls_of_fpxs 0 = 0"
   by transfer auto
 
 lemma fpxs_nth_0 [simp]: "fpxs_nth 0 r = 0"
   by transfer auto
 
 lemma fpxs_nth_1: "fpxs_nth 1 r = (if r = 0 then 1 else 0)"
   by transfer auto
 
 lemma fpxs_nth_1': "fpxs_nth 1 0 = 1" "r \<noteq> 0 \<Longrightarrow> fpxs_nth 1 r = 0"
   by (auto simp: fpxs_nth_1)
 
 instantiation fpxs :: (monoid_add) monoid_add
 begin
 
 lift_definition plus_fpxs :: "'a fpxs \<Rightarrow> 'a fpxs \<Rightarrow> 'a fpxs" is
   "\<lambda>f g x. f x + g x"
 proof -
   fix f g :: "rat \<Rightarrow> 'a"
   assume fg: "is_fpxs f" "is_fpxs g"
   show "is_fpxs (\<lambda>x. f x + g x)"
     unfolding is_fpxs_def
   proof
     have supp: "supp (\<lambda>x. f x + g x) \<subseteq> supp f \<union> supp g"
       by (auto simp: supp_def)
     show "bdd_below (supp (\<lambda>x. f x + g x))"
       by (rule bdd_below_mono[OF _ supp]) (use fg in \<open>auto simp: is_fpxs_def\<close>)
     have "(LCM r\<in>supp (\<lambda>x. f x + g x). snd (quotient_of r)) dvd
             (LCM r\<in>supp f \<union> supp g. snd (quotient_of r))"
       by (intro Lcm_subset image_mono supp)
     also have "\<dots> = lcm (LCM r\<in>supp f. snd (quotient_of r)) (LCM r\<in>supp g. snd (quotient_of r))"
       unfolding image_Un Lcm_Un ..
     finally have "(LCM r\<in>supp (\<lambda>x. f x + g x). snd (quotient_of r)) dvd
                     lcm (LCM r\<in>supp f. snd (quotient_of r)) (LCM r\<in>supp g. snd (quotient_of r))" .
     moreover have "lcm (LCM r\<in>supp f. snd (quotient_of r)) (LCM r\<in>supp g. snd (quotient_of r)) \<noteq> 0"
       using fg by (auto simp: is_fpxs_def)
     ultimately show "(LCM r\<in>supp (\<lambda>x. f x + g x). snd (quotient_of r)) \<noteq> 0"
       by auto
   qed
 qed
 
 instance 
   by standard (transfer; simp add: algebra_simps fun_eq_iff)+
 
 end
 
 instance fpxs :: (comm_monoid_add) comm_monoid_add
 proof
   fix f g :: "'a fpxs"
   show "f + g = g + f"
     by transfer (auto simp: add_ac)
 qed simp_all
 
 lemma fpxs_nth_add [simp]: "fpxs_nth (f + g) r = fpxs_nth f r + fpxs_nth g r"
   by transfer auto
 
 lift_definition fpxs_of_fls :: "'a :: zero fls \<Rightarrow> 'a fpxs" is
   "\<lambda>f r. if r \<in> \<int> then f \<lfloor>r\<rfloor> else 0"
 proof -
   fix f :: "int \<Rightarrow> 'a"
   assume "eventually (\<lambda>n. f (-int n) = 0) cofinite"
   hence "eventually (\<lambda>n. f (-int n) = 0) at_top"
     by (simp add: cofinite_eq_sequentially)
   then obtain N where N: "f (-int n) = 0" if "n \<ge> N" for n
     by (auto simp: eventually_at_top_linorder)
   
   show "is_fpxs (\<lambda>r. if r \<in> \<int> then f \<lfloor>r\<rfloor> else 0)"
     unfolding is_fpxs_def
   proof
     have "bdd_below {-(of_nat N::rat)..}"
       by simp
     moreover have "supp (\<lambda>r::rat. if r \<in> \<int> then f \<lfloor>r\<rfloor> else 0) \<subseteq> {-of_nat N..}"
     proof
       fix r :: rat assume "r \<in> supp (\<lambda>r. if r \<in> \<int> then f \<lfloor>r\<rfloor> else 0)"
       then obtain m where [simp]: "r = of_int m" "f m \<noteq> 0"
         by (auto simp: supp_def elim!: Ints_cases split: if_splits)
       have "m \<ge> -int N"
         using N[of "nat (-m)"] by (cases "m \<ge> 0"; cases "-int N \<le> m") (auto simp: le_nat_iff)
       thus "r \<in> {-of_nat N..}" by simp
     qed
     ultimately show "bdd_below (supp (\<lambda>r::rat. if r \<in> \<int> then f \<lfloor>r\<rfloor> else 0))"
       by (rule bdd_below_mono)
   next
     have "(LCM r\<in>supp (\<lambda>r. if r \<in> \<int> then f \<lfloor>r\<rfloor> else 0). snd (quotient_of r)) dvd 1"
       by (intro Lcm_least) (auto simp: supp_def elim!: Ints_cases split: if_splits)
     thus "(LCM r\<in>supp (\<lambda>r. if r \<in> \<int> then f \<lfloor>r\<rfloor> else 0). snd (quotient_of r)) \<noteq> 0"
       by (intro notI) simp
   qed
 qed
 
 instantiation fpxs :: (group_add) group_add
 begin
 
 lift_definition uminus_fpxs :: "'a fpxs \<Rightarrow> 'a fpxs" is "\<lambda>f x. -f x"
   by (auto simp: is_fpxs_def)
 
 definition minus_fpxs :: "'a fpxs \<Rightarrow> 'a fpxs \<Rightarrow> 'a fpxs" where
   "minus_fpxs f g = f + (-g)"
 
 instance proof
   fix f :: "'a fpxs"
   show "-f + f = 0"
     by transfer auto
 qed (auto simp: minus_fpxs_def)
 
 end
 
 lemma fpxs_nth_uminus [simp]: "fpxs_nth (-f) r = -fpxs_nth f r"
   by transfer auto
 
 lemma fpxs_nth_minus [simp]: "fpxs_nth (f - g) r = fpxs_nth f r - fpxs_nth g r"
   unfolding minus_fpxs_def fpxs_nth_add fpxs_nth_uminus by simp
 
 lemma fpxs_of_fls_eq_iff [simp]: "fpxs_of_fls f = fpxs_of_fls g \<longleftrightarrow> f = g"
   by transfer (force simp: fun_eq_iff Ints_def)
 
 lemma fpxs_of_fls_0 [simp]: "fpxs_of_fls 0 = 0"
   by transfer auto
 
 lemma fpxs_of_fls_1 [simp]: "fpxs_of_fls 1 = 1"
   by transfer (auto simp: fun_eq_iff elim!: Ints_cases)
 
 lemma fpxs_of_fls_add [simp]: "fpxs_of_fls (f + g) = fpxs_of_fls f + fpxs_of_fls g"
   by transfer (auto simp: fun_eq_iff elim!: Ints_cases)
 
 lemma fps_to_fls_sum [simp]: "fps_to_fls (sum f A) = (\<Sum>x\<in>A. fps_to_fls (f x))"
   by (induction A rule: infinite_finite_induct) auto
 
 lemma fpxs_of_fls_sum [simp]: "fpxs_of_fls (sum f A) = (\<Sum>x\<in>A. fpxs_of_fls (f x))"
   by (induction A rule: infinite_finite_induct) auto
 
 lemma fpxs_nth_of_fls:
   "fpxs_nth (fpxs_of_fls f) r = (if r \<in> \<int> then fls_nth f \<lfloor>r\<rfloor> else 0)"
   by transfer auto
 
 lemma fpxs_of_fls_eq_0_iff [simp]: "fpxs_of_fls f = 0 \<longleftrightarrow> f = 0"
   using fpxs_of_fls_eq_iff[of f 0] by (simp del: fpxs_of_fls_eq_iff)
 
 lemma fpxs_of_fls_eq_1_iff [simp]: "fpxs_of_fls f = 1 \<longleftrightarrow> f = 1"
   using fpxs_of_fls_eq_iff[of f 1] by (simp del: fpxs_of_fls_eq_iff)
 
 lemma fpxs_root_order_of_fls [simp]: "fpxs_root_order (fpxs_of_fls f) = 1"
 proof (transfer, goal_cases)
   case (1 f)
   have "supp (\<lambda>r. if r \<in> \<int> then f \<lfloor>r\<rfloor> else 0) = rat_of_int ` {n. f n \<noteq> 0}"
     by (force simp: supp_def Ints_def)
   also have "(LCM r\<in>\<dots>. snd (quotient_of r)) = nat (LCM x\<in>{n. f n \<noteq> 0}. 1)"
     by (simp add: image_image)
   also have "\<dots> = 1"
     by simp
   also have "nat 1 = 1"
     by simp
   finally show ?case  .
 qed
 
 
 
 subsection \<open>The substitution $X \mapsto X^r$\<close>
 
 text \<open>
   This operation turns a formal Puiseux series $f(X)$ into $f(X^r)$, where
   $r$ can be any positive rational number:
 \<close>
 lift_definition fpxs_compose_power :: "'a :: zero fpxs \<Rightarrow> rat \<Rightarrow> 'a fpxs" is
   "\<lambda>f r x. if r > 0 then f (x / r) else 0"
 proof -
   fix f :: "rat \<Rightarrow> 'a" and r :: rat
   assume f: "is_fpxs f"
   have "is_fpxs (\<lambda>x. f (x / r))" if "r > 0"
     unfolding is_fpxs_def
   proof
     define r' where "r' = inverse r"
     have "r' > 0"
       using \<open>r > 0\<close> by (auto simp: r'_def)
     have "(\<lambda>x. x / r') ` supp f = supp (\<lambda>x. f (x * r'))"
       using \<open>r' > 0\<close> by (auto simp: supp_def image_iff vimage_def field_simps)
     hence eq: "(\<lambda>x. x * r) ` supp f = supp (\<lambda>x. f (x / r))"
       using \<open>r > 0\<close> by (simp add: r'_def field_simps)
 
     from f have "bdd_below (supp f)"
       by (auto simp: is_fpxs_def)
     hence "bdd_below ((\<lambda>x. x * r) ` supp f)"
       using \<open>r > 0\<close> by (intro bdd_below_image_mono) (auto simp: mono_def divide_right_mono)
     also note eq
     finally show "bdd_below (supp (\<lambda>x. f (x / r)))" .
 
     define a b where "a = fst (quotient_of r)" and "b = snd (quotient_of r)"
     have "b > 0" by (simp add: b_def quotient_of_denom_pos')
     have [simp]: "quotient_of r = (a, b)"
       by (simp add: a_def b_def)
     have "r = of_int a / of_int b"
       by (simp add: quotient_of_div)
     with \<open>r > 0\<close> and \<open>b > 0\<close> have \<open>a > 0\<close>
       by (simp add: field_simps)
 
     have "(LCM r\<in>supp (\<lambda>x. f (x / r)). snd (quotient_of r)) =
             (LCM x\<in>supp f. snd (quotient_of (x * r)))"
       by (simp add: eq [symmetric] image_image)
     also have "\<dots> dvd (LCM x\<in>supp f. snd (quotient_of x) * b)"
       using \<open>a > 0\<close> \<open>b > 0\<close>
       by (intro Lcm_mono)
          (simp add: rat_times_code case_prod_unfold Let_def Rat.normalize_def
                     quotient_of_denom_pos' div_dvd_self)
     also have "\<dots> dvd normalize (b * (LCM x\<in>supp f. snd (quotient_of x)))"
     proof (cases "supp f = {}")
       case False
       thus ?thesis using Lcm_mult[of "(\<lambda>x. snd (quotient_of x)) ` supp f" b]
         by (simp add: mult_ac image_image)
     qed auto
     hence "(LCM x\<in>supp f. snd (quotient_of x) * b) dvd
              b * (LCM x\<in>supp f. snd (quotient_of x))" by simp
     finally show "(LCM r\<in>supp (\<lambda>x. f (x / r)). snd (quotient_of r)) \<noteq> 0"
       using \<open>b > 0\<close> f by (auto simp: is_fpxs_def)
   qed
   thus "is_fpxs (\<lambda>x. if r > 0 then f (x / r) else 0)"
     by (cases "r > 0") (auto simp: is_fpxs_def supp_def)
 qed
 
 lemma fpxs_as_fls:
   "fpxs_compose_power (fpxs_of_fls (fls_of_fpxs f)) (1 / of_nat (fpxs_root_order f)) = f"
 proof (transfer, goal_cases)
   case (1 f)
   define d where "d = (LCM r\<in>supp f. snd (quotient_of r))"
   have "d \<ge> 0" by (simp add: d_def)
   moreover have "d \<noteq> 0" using 1 by (simp add: is_fpxs_def d_def)
   ultimately have "d > 0" by linarith
 
   have "(if rat_of_int d * x \<in> \<int> then f (rat_of_int \<lfloor>rat_of_int d * x\<rfloor> / rat_of_int d) else 0) = f x" for x
   proof (cases "rat_of_int d * x \<in> \<int>")
     case True
     then obtain n where n: "rat_of_int d * x = of_int n"
       by (auto elim!: Ints_cases)
     have "f (rat_of_int \<lfloor>rat_of_int d * x\<rfloor> / rat_of_int d) = f (rat_of_int n / rat_of_int d)"
       by (simp add: n)
     also have "rat_of_int n / rat_of_int d = x"
       using n \<open>d > 0\<close> by (simp add: field_simps)
     finally show ?thesis
       using True by simp
   next
     case False
     have "x \<notin> supp f"
     proof
       assume "x \<in> supp f"
       hence "snd (quotient_of x) dvd d"
         by (simp add: d_def)
       hence "rat_of_int (fst (quotient_of x) * d) / rat_of_int (snd (quotient_of x)) \<in> \<int>"
         by (intro of_int_divide_in_Ints) auto
       also have "rat_of_int (fst (quotient_of x) * d) / rat_of_int (snd (quotient_of x)) =
                  rat_of_int d * (rat_of_int (fst (quotient_of x)) / rat_of_int (snd (quotient_of x)))"
         by (simp only: of_int_mult mult_ac times_divide_eq_right)
       also have "\<dots> = rat_of_int d * x"
         by (metis Fract_of_int_quotient Rat_cases normalize_stable prod.sel(1) prod.sel(2) quotient_of_Fract)
       finally have "rat_of_int d * x \<in> \<int>" .
       with False show False by contradiction
     qed
     thus ?thesis using False by (simp add: supp_def)
   qed
   thus ?case
     using \<open>d > 0\<close> by (simp add: is_fpxs_def d_def mult_ac fun_eq_iff cong: if_cong)
 qed
 
 lemma fpxs_compose_power_0 [simp]: "fpxs_compose_power 0 r = 0"
   by transfer simp
 
 lemma fpxs_compose_power_1 [simp]: "r > 0 \<Longrightarrow> fpxs_compose_power 1 r = 1"
   by transfer (auto simp: fun_eq_iff)
 
 lemma fls_of_fpxs_eq_0_iff [simp]: "fls_of_fpxs x = 0 \<longleftrightarrow> x = 0"
   by (metis fls_of_fpxs_0 fpxs_as_fls fpxs_compose_power_0 fpxs_of_fls_0)
 
 lemma fpxs_of_fls_compose_power [simp]:
   "fpxs_of_fls (fls_compose_power f d) = fpxs_compose_power (fpxs_of_fls f) (of_nat d)"
 proof (transfer, goal_cases)
   case (1 f d)
   show ?case
   proof (cases "d = 0")
     case False
     show ?thesis
     proof (intro ext, goal_cases)
       case (1 r)
       show ?case
       proof (cases "r \<in> \<int>")
         case True
         then obtain n where [simp]: "r = of_int n"
           by (cases r rule: Ints_cases)
         show ?thesis
         proof (cases "d dvd n")
           case True
           thus ?thesis by (auto elim!: Ints_cases)
         next
           case False
           hence "rat_of_int n / rat_of_int (int d) \<notin> \<int>"
             using \<open>d \<noteq> 0\<close> by (subst of_int_div_of_int_in_Ints_iff) auto
           thus ?thesis using False by auto
         qed
       next
         case False
         hence "r / rat_of_nat d \<notin> \<int>"
           using \<open>d \<noteq> 0\<close> by (auto elim!: Ints_cases simp: field_simps)
         thus ?thesis using False by auto
       qed
     qed
   qed auto
 qed
 
 lemma fpxs_compose_power_add [simp]:
   "fpxs_compose_power (f + g) r = fpxs_compose_power f r + fpxs_compose_power g r"
   by transfer (auto simp: fun_eq_iff)
 
 lemma fpxs_compose_power_distrib:
   "r1 > 0 \<or> r2 > 0 \<Longrightarrow> 
      fpxs_compose_power (fpxs_compose_power f r1) r2 = fpxs_compose_power f (r1 * r2)"
   by transfer (auto simp: fun_eq_iff algebra_simps zero_less_mult_iff)
 
 lemma fpxs_compose_power_divide_right:
   "r1 > 0 \<Longrightarrow> r2 > 0 \<Longrightarrow> 
      fpxs_compose_power f (r1 / r2) = fpxs_compose_power (fpxs_compose_power f r1) (inverse r2)"
   by (simp add: fpxs_compose_power_distrib field_simps)
 
 lemma fpxs_compose_power_1_right [simp]: "fpxs_compose_power f 1 = f"
   by transfer auto
 
 lemma fpxs_compose_power_eq_iff [simp]:
   assumes "r > 0"
   shows   "fpxs_compose_power f r = fpxs_compose_power g r \<longleftrightarrow> f = g"
   using assms
 proof (transfer, goal_cases)
   case (1 r f g)
   have "f x = g x" if "\<And>x. f (x / r) = g (x / r)" for x
     using that[of "x * r"] \<open>r > 0\<close> by auto
   thus ?case using \<open>r > 0\<close> by (auto simp: fun_eq_iff)
 qed
 
 lemma fpxs_compose_power_eq_1_iff [simp]:
   assumes "l > 0"
   shows   "fpxs_compose_power p l = 1 \<longleftrightarrow> p = 1"
 proof -
   have "fpxs_compose_power p l = 1 \<longleftrightarrow> fpxs_compose_power p l = fpxs_compose_power 1 l"
     by (subst fpxs_compose_power_1) (use assms in auto)
   also have "\<dots> \<longleftrightarrow> p = 1"
     using assms by (subst fpxs_compose_power_eq_iff) auto
   finally show ?thesis .
 qed
 
 lemma fpxs_compose_power_eq_0_iff [simp]:
   assumes "r > 0"
   shows   "fpxs_compose_power f r = 0 \<longleftrightarrow> f = 0"
   using fpxs_compose_power_eq_iff[of r f 0] assms by (simp del: fpxs_compose_power_eq_iff)
 
 lemma fls_of_fpxs_of_fls [simp]: "fls_of_fpxs (fpxs_of_fls f) = f"
   using fpxs_as_fls[of "fpxs_of_fls f"] by simp
 
 lemma fpxs_as_fls':
   assumes "fpxs_root_order f dvd d" "d > 0"
   obtains f' where "f = fpxs_compose_power (fpxs_of_fls f') (1 / of_nat d)"
 proof -
   define D where "D = fpxs_root_order f"
   have "D > 0"
     by (auto simp: D_def)
   define f' where "f' = fls_of_fpxs f"
   from assms obtain d' where d': "d = D * d'"
     by (auto simp: D_def)
   have "d' > 0"
     using assms by (auto intro!: Nat.gr0I simp: d')
   define f'' where "f'' = fls_compose_power f' d'"
   have "fpxs_compose_power (fpxs_of_fls f'') (1 / of_nat d) = f"
     using \<open>D > 0\<close> \<open>d' > 0\<close>
     by (simp add: d' D_def f''_def f'_def fpxs_as_fls fpxs_compose_power_distrib)
   thus ?thesis using that[of f''] by blast
 qed
 
 
 subsection \<open>Mutiplication and ring properties\<close>
 
 instantiation fpxs :: (comm_semiring_1) comm_semiring_1
 begin
 
 lift_definition times_fpxs :: "'a fpxs \<Rightarrow> 'a fpxs \<Rightarrow> 'a fpxs" is
   "\<lambda>f g x. (\<Sum>(y,z) | y \<in> supp f \<and> z \<in> supp g \<and> x = y + z. f y * g z)"
 proof -
   fix f g :: "rat \<Rightarrow> 'a"
   assume fg: "is_fpxs f" "is_fpxs g"
   show "is_fpxs (\<lambda>x. \<Sum>(y,z) | y \<in> supp f \<and> z \<in> supp g \<and> x = y + z. f y * g z)"
     (is "is_fpxs ?h") unfolding is_fpxs_def
   proof
     from fg obtain bnd1 bnd2 where bnds: "\<forall>x\<in>supp f. x \<ge> bnd1" "\<forall>x\<in>supp g. x \<ge> bnd2"
       by (auto simp: is_fpxs_def bdd_below_def)
     have "supp ?h \<subseteq> (\<lambda>(x,y). x + y) ` (supp f \<times> supp g)"
     proof
       fix x :: rat
       assume "x \<in> supp ?h"
       have "{(y,z). y \<in> supp f \<and> z \<in> supp g \<and> x = y + z} \<noteq> {}"
       proof
         assume eq: "{(y,z). y \<in> supp f \<and> z \<in> supp g \<and> x = y + z} = {}"
         hence "?h x = 0"
           by (simp only:) auto
         with \<open>x \<in> supp ?h\<close> show False by (auto simp: supp_def)
       qed
       thus "x \<in> (\<lambda>(x,y). x + y) ` (supp f \<times> supp g)"
         by auto
     qed
     also have "\<dots> \<subseteq> {bnd1 + bnd2..}"
       using bnds by (auto intro: add_mono)
     finally show "bdd_below (supp ?h)"
       by auto
   next
     define d1 where "d1 = (LCM r\<in>supp f. snd (quotient_of r))"
     define d2 where "d2 = (LCM r\<in>supp g. snd (quotient_of r))"
     have "(LCM r\<in>supp ?h. snd (quotient_of r)) dvd (d1 * d2)"
     proof (intro Lcm_least, safe)
       fix r :: rat
       assume "r \<in> supp ?h"
       hence "(\<Sum>(y, z) | y \<in> supp f \<and> z \<in> supp g \<and> r = y + z. f y * g z) \<noteq> 0"
         by (auto simp: supp_def)
       hence "{(y, z). y \<in> supp f \<and> z \<in> supp g \<and> r = y + z} \<noteq> {}"
         by (intro notI) simp_all
       then obtain y z where yz: "y \<in> supp f" "z \<in> supp g" "r = y + z"
         by auto
       have "snd (quotient_of r) = snd (quotient_of y) * snd (quotient_of z) div
               gcd (fst (quotient_of y) * snd (quotient_of z) +
                    fst (quotient_of z) * snd (quotient_of y))
                   (snd (quotient_of y) * snd (quotient_of z))"
         by (simp add: \<open>r = _\<close> rat_plus_code case_prod_unfold Let_def
                       Rat.normalize_def quotient_of_denom_pos')
       also have "\<dots> dvd snd (quotient_of y) * snd (quotient_of z)"
         by (metis dvd_def dvd_div_mult_self gcd_dvd2)
       also have "\<dots> dvd d1 * d2"
         using yz by (auto simp: d1_def d2_def intro!: mult_dvd_mono)
       finally show "snd (quotient_of r) dvd d1 * d2"
         by (simp add: d1_def d2_def)
     qed
     moreover have "d1 * d2 \<noteq> 0"
       using fg by (auto simp: d1_def d2_def is_fpxs_def)
     ultimately show "(LCM r\<in>supp ?h. snd (quotient_of r)) \<noteq> 0"
       by auto
   qed
 qed
 
 lemma fpxs_nth_mult:
   "fpxs_nth (f * g) r =
      (\<Sum>(y,z) | y \<in> fpxs_supp f \<and> z \<in> fpxs_supp g \<and> r = y + z. fpxs_nth f y * fpxs_nth g z)"
   by transfer simp
 
 lemma fpxs_compose_power_mult [simp]:
   "fpxs_compose_power (f * g) r = fpxs_compose_power f r * fpxs_compose_power g r"
 proof (transfer, rule ext, goal_cases)
   case (1 f g r x)
   show ?case
   proof (cases "r > 0")
     case True
     have "(\<Sum>x\<in>{(y, z). y \<in> supp f \<and> z \<in> supp g \<and> x / r = y + z}.
             case x of (y, z) \<Rightarrow> f y * g z) =
           (\<Sum>x\<in>{(y, z). y \<in> supp (\<lambda>x. f (x / r)) \<and> z \<in> supp (\<lambda>x. g (x / r)) \<and> x = y + z}.
             case x of (y, z) \<Rightarrow> f (y / r) * g (z / r))"
       by (rule sum.reindex_bij_witness[of _ "\<lambda>(x,y). (x/r,y/r)" "\<lambda>(x,y). (x*r,y*r)"])
          (use \<open>r > 0\<close> in \<open>auto simp: supp_def field_simps\<close>)
     thus ?thesis
       by (auto simp: fun_eq_iff)
   qed auto
 qed
 
 lemma fpxs_supp_of_fls: "fpxs_supp (fpxs_of_fls f) = of_int ` supp (fls_nth f)"
   by (force simp: fpxs_supp_def fpxs_nth_of_fls supp_def elim!: Ints_cases)
 
 lemma fpxs_of_fls_mult [simp]: "fpxs_of_fls (f * g) = fpxs_of_fls f * fpxs_of_fls g"
 proof (rule fpxs_ext)
   fix r :: rat
   show "fpxs_nth (fpxs_of_fls (f * g)) r = fpxs_nth (fpxs_of_fls f * fpxs_of_fls g) r"
   proof (cases "r \<in> \<int>")
     case True
     define h1 where "h1 = (\<lambda>(x, y). (\<lfloor>x::rat\<rfloor>, \<lfloor>y::rat\<rfloor>))"
     define h2 where "h2 = (\<lambda>(x, y). (of_int x :: rat, of_int y :: rat))"
     define df dg where [simp]: "df = fls_subdegree f" "dg = fls_subdegree g"
     from True obtain n where [simp]: "r = of_int n"
       by (cases rule: Ints_cases)
     have "fpxs_nth (fpxs_of_fls f * fpxs_of_fls g) r =
             (\<Sum>(y,z) | y \<in> fpxs_supp (fpxs_of_fls f) \<and> z \<in> fpxs_supp (fpxs_of_fls g) \<and> rat_of_int n = y + z.
               (if y \<in> \<int> then fls_nth f \<lfloor>y\<rfloor> else 0) * (if z \<in> \<int> then fls_nth g \<lfloor>z\<rfloor> else 0))"
       by (auto simp: fpxs_nth_mult fpxs_nth_of_fls)
     also have "\<dots> = (\<Sum>(y,z) | y \<in> supp (fls_nth f) \<and> z \<in> supp (fls_nth g) \<and> n = y + z.
                       fls_nth f y * fls_nth g z)"
       by (rule sum.reindex_bij_witness[of _ h2 h1]) (auto simp: h1_def h2_def fpxs_supp_of_fls)
     also have "\<dots> = (\<Sum>y | y - fls_subdegree g \<in> supp (fls_nth f) \<and> fls_subdegree g + n - y \<in> supp (fls_nth g).
                       fls_nth f (y - fls_subdegree g) * fls_nth g (fls_subdegree g + n - y))"
       by (rule sum.reindex_bij_witness[of _ "\<lambda>y. (y - fls_subdegree g, fls_subdegree g + n - y)" "\<lambda>z. fst z + fls_subdegree g"])
          auto
     also have "\<dots> = (\<Sum>i = fls_subdegree f + fls_subdegree g..n.
               fls_nth f (i - fls_subdegree g) * fls_nth g (fls_subdegree g + n - i))"
       using fls_subdegree_leI[of f] fls_subdegree_leI [of g]
       by (intro sum.mono_neutral_left; force simp: supp_def)
     also have "\<dots> = fpxs_nth (fpxs_of_fls (f * g)) r"
       by (auto simp: fls_times_nth fpxs_nth_of_fls)
     finally show ?thesis ..
   next
     case False
     have "fpxs_nth (fpxs_of_fls f * fpxs_of_fls g) r =
             (\<Sum>(y,z) | y \<in> fpxs_supp (fpxs_of_fls f) \<and> z \<in> fpxs_supp (fpxs_of_fls g) \<and> r = y + z.
               (if y \<in> \<int> then fls_nth f \<lfloor>y\<rfloor> else 0) * (if z \<in> \<int> then fls_nth g \<lfloor>z\<rfloor> else 0))"
       by (simp add: fpxs_nth_mult fpxs_nth_of_fls)
     also have "\<dots> = 0"
       using False by (intro sum.neutral ballI) auto
     also have "0 = fpxs_nth (fpxs_of_fls (f * g)) r"
       using False by (simp add: fpxs_nth_of_fls)
     finally show ?thesis ..
   qed
 qed
 
 instance proof
   show "0 \<noteq> (1 :: 'a fpxs)"
     by transfer (auto simp: fun_eq_iff)
 next
   fix f :: "'a fpxs"
   show "1 * f = f"
   proof (transfer, goal_cases)
     case (1 f)
     have "{(y, z). y \<in> supp (\<lambda>r. if r = 0 then (1::'a) else 0) \<and> z \<in> supp f \<and> x = y + z} =
             (if x \<in> supp f then {(0, x)} else {})" for x
       by (auto simp: supp_def split: if_splits)
     thus ?case
       by (auto simp: fun_eq_iff supp_def)
   qed
 next
   fix f :: "'a fpxs"
   show "0 * f = 0"
     by transfer (auto simp: fun_eq_iff supp_def)
   show "f * 0 = 0"
     by transfer (auto simp: fun_eq_iff supp_def)
 next
   fix f g :: "'a fpxs"
   show "f * g = g * f"
   proof (transfer, rule ext, goal_cases)
     case (1 f g x)
     show "(\<Sum>(y, z)\<in>{(y, z). y \<in> supp f \<and> z \<in> supp g \<and> x = y + z}. f y * g z) =
           (\<Sum>(y, z)\<in>{(y, z). y \<in> supp g \<and> z \<in> supp f \<and> x = y + z}. g y * f z)"
       by (rule sum.reindex_bij_witness[of _ "\<lambda>(x,y). (y,x)" "\<lambda>(x,y). (y,x)"])
          (auto simp: mult_ac)
   qed    
 next
   fix f g h :: "'a fpxs"
   define d where "d = (LCM F\<in>{f,g,h}. fpxs_root_order F)"
   have "d > 0"
     by (auto simp: d_def intro!: Nat.gr0I)
   obtain f' where f: "f = fpxs_compose_power (fpxs_of_fls f') (1 / of_nat d)"
     using fpxs_as_fls'[of f d] \<open>d > 0\<close> by (auto simp: d_def)
   obtain g' where g: "g = fpxs_compose_power (fpxs_of_fls g') (1 / of_nat d)"
     using fpxs_as_fls'[of g d] \<open>d > 0\<close> by (auto simp: d_def)
   obtain h' where h: "h = fpxs_compose_power (fpxs_of_fls h') (1 / of_nat d)"
     using fpxs_as_fls'[of h d] \<open>d > 0\<close> by (auto simp: d_def)
   show "(f * g) * h = f * (g * h)"
     by (simp add: f g h mult_ac
              flip: fpxs_compose_power_mult fpxs_compose_power_add fpxs_of_fls_mult)
   show "(f + g) * h = f * h + g * h"
     by (simp add: f g h ring_distribs
              flip: fpxs_compose_power_mult fpxs_compose_power_add fpxs_of_fls_mult fpxs_of_fls_add)
 qed
 
 end
 
 instance fpxs :: (comm_ring_1) comm_ring_1
   by intro_classes auto
 
 instance fpxs :: ("{comm_semiring_1,semiring_no_zero_divisors}") semiring_no_zero_divisors
 proof
   fix f g :: "'a fpxs"
   assume fg: "f \<noteq> 0" "g \<noteq> 0"
   define d where "d = lcm (fpxs_root_order f) (fpxs_root_order g)"
   have "d > 0"
     by (auto simp: d_def intro!: lcm_pos_nat)
   obtain f' where f: "f = fpxs_compose_power (fpxs_of_fls f') (1 / of_nat d)"
     using fpxs_as_fls'[of f d] \<open>d > 0\<close> by (auto simp: d_def)
   obtain g' where g: "g = fpxs_compose_power (fpxs_of_fls g') (1 / of_nat d)"
     using fpxs_as_fls'[of g d] \<open>d > 0\<close> by (auto simp: d_def)
   show "f * g \<noteq> 0"
     using \<open>d > 0\<close> fg
     by (simp add: f g flip: fpxs_compose_power_mult fpxs_of_fls_mult)
 qed
 
 lemma fpxs_of_fls_power [simp]: "fpxs_of_fls (f ^ n) = fpxs_of_fls f ^ n"
   by (induction n) auto
 
 lemma fpxs_compose_power_power [simp]:
   "r > 0 \<Longrightarrow> fpxs_compose_power (f ^ n) r = fpxs_compose_power f r ^ n"
   by (induction n) simp_all
 
 
 subsection \<open>Constant Puiseux series and the series \<open>X\<close>\<close>
 
 lift_definition fpxs_const :: "'a :: zero \<Rightarrow> 'a fpxs" is
   "\<lambda>c n. if n = 0 then c else 0"
 proof -
   fix c :: 'a
   have "supp (\<lambda>n::rat. if n = 0 then c else 0) = (if c = 0 then {} else {0})"
     by auto
   thus "is_fpxs (\<lambda>n::rat. if n = 0 then c else 0)"
     unfolding is_fpxs_def by auto
 qed
 
 lemma fpxs_const_0 [simp]: "fpxs_const 0 = 0"
   by transfer auto
 
 lemma fpxs_const_1 [simp]: "fpxs_const 1 = 1"
   by transfer auto
 
 lemma fpxs_of_fls_const [simp]: "fpxs_of_fls (fls_const c) = fpxs_const c"
   by transfer (auto simp: fun_eq_iff Ints_def)
 
 lemma fls_of_fpxs_const [simp]: "fls_of_fpxs (fpxs_const c) = fls_const c"
   by (metis fls_of_fpxs_of_fls fpxs_of_fls_const)
 
 lemma fls_of_fpxs_1 [simp]: "fls_of_fpxs 1 = 1"
   using fls_of_fpxs_const[of 1] by (simp del: fls_of_fpxs_const)
   
 lift_definition fpxs_X :: "'a :: {one, zero} fpxs" is
   "\<lambda>x. if x = 1 then (1::'a) else 0"
   by (cases "1 = (0 :: 'a)") (auto simp: is_fpxs_def cong: if_cong)
 
 lemma fpxs_const_altdef: "fpxs_const x = fpxs_of_fls (fls_const x)"
   by transfer auto
 
 lemma fpxs_const_add [simp]: "fpxs_const (x + y) = fpxs_const x + fpxs_const y"
   by transfer auto
 
 lemma fpxs_const_mult [simp]:
   fixes x y :: "'a::{comm_semiring_1}"
   shows "fpxs_const (x * y) = fpxs_const x * fpxs_const y"
   unfolding fpxs_const_altdef fls_const_mult_const[symmetric] fpxs_of_fls_mult ..
 
 lemma fpxs_const_eq_iff [simp]:
   "fpxs_const x = fpxs_const y \<longleftrightarrow> x = y"
   by transfer (auto simp: fun_eq_iff)
 
 lemma of_nat_fpxs_eq: "of_nat n = fpxs_const (of_nat n)"
   by (induction n) auto
 
 lemma fpxs_const_uminus [simp]: "fpxs_const (-x) = -fpxs_const x"
   by transfer auto
 
 lemma fpxs_const_diff [simp]: "fpxs_const (x - y) = fpxs_const x - fpxs_const y"
   unfolding minus_fpxs_def by transfer auto
 
 lemma of_int_fpxs_eq: "of_int n = fpxs_const (of_int n)"
   by (induction n) (auto simp: of_nat_fpxs_eq)
 
 
 subsection \<open>More algebraic typeclass instances\<close>
 
 instance fpxs :: ("{comm_semiring_1,semiring_char_0}") semiring_char_0
 proof
   show "inj (of_nat :: nat \<Rightarrow> 'a fpxs)"
     by (intro injI) (auto simp: of_nat_fpxs_eq)
 qed
 
 instance fpxs :: ("{comm_ring_1,ring_char_0}") ring_char_0 ..
 
 instance fpxs :: (idom) idom ..
 
 instantiation fpxs :: (field) field
 begin
 
 definition inverse_fpxs :: "'a fpxs \<Rightarrow> 'a fpxs" where
   "inverse_fpxs f =
      fpxs_compose_power (fpxs_of_fls (inverse (fls_of_fpxs f))) (1 / of_nat (fpxs_root_order f))"
 
 definition divide_fpxs :: "'a fpxs \<Rightarrow> 'a fpxs \<Rightarrow> 'a fpxs" where
   "divide_fpxs f g = f * inverse g"
 
 instance proof
   fix f :: "'a fpxs"
   assume "f \<noteq> 0"
   define f' where "f' = fls_of_fpxs f"
   define d where "d = fpxs_root_order f"
   have "d > 0" by (auto simp: d_def)
   have f: "f = fpxs_compose_power (fpxs_of_fls f') (1 / of_nat d)"
     by (simp add: f'_def d_def fpxs_as_fls)
 
   have "inverse f * f = fpxs_compose_power (fpxs_of_fls (inverse f')) (1 / of_nat d) * f"
     by (simp add: inverse_fpxs_def f'_def d_def)
   also have "fpxs_compose_power (fpxs_of_fls (inverse f')) (1 / of_nat d) * f =
              fpxs_compose_power (fpxs_of_fls (inverse f' * f')) (1 / of_nat d)"
     by (simp add: f)
   also have "inverse f' * f' = 1"
     using \<open>f \<noteq> 0\<close> \<open>d > 0\<close> by (simp add: f field_simps)
   finally show "inverse f * f = 1"
     using \<open>d > 0\<close> by simp
 qed (auto simp: divide_fpxs_def inverse_fpxs_def)
 
 end
 
 instance fpxs :: (field_char_0) field_char_0 ..
 
 
 subsection \<open>Valuation\<close>
 
 definition fpxs_val :: "'a :: zero fpxs \<Rightarrow> rat" where
   "fpxs_val f =
      of_int (fls_subdegree (fls_of_fpxs f)) / rat_of_nat (fpxs_root_order f)"
 
 lemma fpxs_val_of_fls [simp]: "fpxs_val (fpxs_of_fls f) = of_int (fls_subdegree f)"
   by (simp add: fpxs_val_def)
 
 lemma fpxs_nth_compose_power [simp]:
   assumes "r > 0"
   shows   "fpxs_nth (fpxs_compose_power f r) n = fpxs_nth f (n / r)"
   using assms by transfer auto
 
 lemma fls_of_fpxs_uminus [simp]: "fls_of_fpxs (-f) = -fls_of_fpxs f"
   by transfer auto
 
 lemma fpxs_root_order_uminus [simp]: "fpxs_root_order (-f) = fpxs_root_order f"
   by transfer auto
 
 lemma fpxs_val_uminus [simp]: "fpxs_val (-f) = fpxs_val f"
   unfolding fpxs_val_def by simp
 
 lemma fpxs_val_minus_commute: "fpxs_val (f - g) = fpxs_val (g - f)"
   by (subst fpxs_val_uminus [symmetric]) (simp del: fpxs_val_uminus)
 
 lemma fpxs_val_const [simp]: "fpxs_val (fpxs_const c) = 0"
   by (simp add: fpxs_val_def)
 
 lemma fpxs_val_1 [simp]: "fpxs_val 1 = 0"
   by (simp add: fpxs_val_def)
 
 lemma of_int_fls_subdegree_of_fpxs:
   "rat_of_int (fls_subdegree (fls_of_fpxs f)) = fpxs_val f * of_nat (fpxs_root_order f)"
   by (simp add: fpxs_val_def)
 
 lemma fpxs_nth_val_nonzero: 
   assumes "f \<noteq> 0"
   shows   "fpxs_nth f (fpxs_val f) \<noteq> 0"
 proof -
   define N where "N = fpxs_root_order f"
   define f' where "f' = fls_of_fpxs f"
   define M where "M = fls_subdegree f'"
   have val: "fpxs_val f = of_int M / of_nat N"
     by (simp add: M_def fpxs_val_def N_def f'_def)
   have *: "f = fpxs_compose_power (fpxs_of_fls f') (1 / rat_of_nat N)"
     by (simp add: fpxs_as_fls N_def f'_def)
   also have "fpxs_nth \<dots> (fpxs_val f) =
              fpxs_nth (fpxs_of_fls f') (fpxs_val f * rat_of_nat (fpxs_root_order f))"
     by (subst fpxs_nth_compose_power) (auto simp: N_def)
   also have "\<dots> = fls_nth f' M"
     by (subst fpxs_nth_of_fls) (auto simp: val N_def)
   also have "f' \<noteq> 0"
     using * assms by auto
   hence "fls_nth f' M \<noteq> 0"
     unfolding M_def by simp
   finally show "fpxs_nth f (fpxs_val f) \<noteq> 0" .
 qed
 
 lemma fpxs_nth_below_val:
   assumes n: "n < fpxs_val f"
   shows   "fpxs_nth f n = 0"
 proof (cases "f = 0")
   case False
   define N where "N = fpxs_root_order f"
   define f' where "f' = fls_of_fpxs f"
   define M where "M = fls_subdegree f'"
   have val: "fpxs_val f = of_int M / of_nat N"
     by (simp add: M_def fpxs_val_def N_def f'_def)
   have *: "f = fpxs_compose_power (fpxs_of_fls f') (1 / rat_of_nat N)"
     by (simp add: fpxs_as_fls N_def f'_def)
   have "fpxs_nth f n = fpxs_nth (fpxs_of_fls f') (n * rat_of_nat N)"
     by (subst *, subst fpxs_nth_compose_power) (auto simp: N_def)
   also have "\<dots> = 0"
   proof (cases "rat_of_nat N * n \<in> \<int>")
     case True
     then obtain n' where n': "of_int n' = rat_of_nat N * n"
       by (elim Ints_cases) auto
     have "of_int n' < rat_of_nat N * fpxs_val f"
       unfolding n' using n by (intro mult_strict_left_mono) (auto simp: N_def)
     also have "\<dots> = of_int M"
       by (simp add: val N_def)
     finally have "n' < M" by linarith
     
     have "fpxs_nth (fpxs_of_fls f') (rat_of_nat N * n) = fls_nth f' n'"
       unfolding n'[symmetric] by (subst fpxs_nth_of_fls) (auto simp: N_def)
     also from \<open>n' < M\<close> have "\<dots> = 0"
       unfolding M_def by simp
     finally show ?thesis by (simp add: mult_ac)
   qed (auto simp: fpxs_nth_of_fls mult_ac)
   finally show "fpxs_nth f n = 0" .
 qed auto
 
 lemma fpxs_val_leI: "fpxs_nth f r \<noteq> 0 \<Longrightarrow> fpxs_val f \<le> r"
   using fpxs_nth_below_val[of r f]
   by (cases "f = 0"; cases "fpxs_val f" r rule: linorder_cases) auto
 
 lemma fpxs_val_0 [simp]: "fpxs_val 0 = 0"
   by (simp add: fpxs_val_def)
 
 lemma fpxs_val_geI: 
   assumes "f \<noteq> 0" "\<And>r. r < r' \<Longrightarrow> fpxs_nth f r = 0"
   shows   "fpxs_val f \<ge> r'"
   using fpxs_nth_val_nonzero[of f] assms by force  
 
 lemma fpxs_val_compose_power [simp]:
   assumes "r > 0"
   shows   "fpxs_val (fpxs_compose_power f r) = fpxs_val f * r"
 proof (cases "f = 0")
   case [simp]: False
   show ?thesis
   proof (intro antisym)
     show "fpxs_val (fpxs_compose_power f r) \<le> fpxs_val f * r"
       using assms by (intro fpxs_val_leI) (simp add: fpxs_nth_val_nonzero)
   next
     show "fpxs_val f * r \<le> fpxs_val (fpxs_compose_power f r)"
     proof (intro fpxs_val_geI)
       show "fpxs_nth (fpxs_compose_power f r) r' = 0" if "r' < fpxs_val f * r" for r'
         unfolding fpxs_nth_compose_power[OF assms]
         by (rule fpxs_nth_below_val) (use that assms in \<open>auto simp: field_simps\<close>)
     qed (use assms in auto)
   qed
 qed auto
 
 lemma fpxs_val_add_ge:
   assumes "f + g \<noteq> 0"
   shows   "fpxs_val (f + g) \<ge> min (fpxs_val f) (fpxs_val g)"
 proof (rule ccontr)
   assume "\<not>(fpxs_val (f + g) \<ge> min (fpxs_val f) (fpxs_val g))" (is "\<not>(?n \<ge> _)")
   hence "?n < fpxs_val f" "?n < fpxs_val g"
     by auto
   hence "fpxs_nth f ?n = 0" "fpxs_nth g ?n = 0"
     by (intro fpxs_nth_below_val; simp; fail)+
   hence "fpxs_nth (f + g) ?n = 0"
     by simp
   moreover have "fpxs_nth (f + g) ?n \<noteq> 0"
     by (intro fpxs_nth_val_nonzero assms)
   ultimately show False by contradiction
 qed
 
 lemma fpxs_val_diff_ge:
   assumes "f \<noteq> g"
   shows   "fpxs_val (f - g) \<ge> min (fpxs_val f) (fpxs_val g)"
   using fpxs_val_add_ge[of f "-g"] assms by simp  
 
 lemma fpxs_nth_mult_val:
   "fpxs_nth (f * g) (fpxs_val f + fpxs_val g) = fpxs_nth f (fpxs_val f) * fpxs_nth g (fpxs_val g)"
 proof (cases "f = 0 \<or> g = 0")
   case False
   have "{(y, z). y \<in> fpxs_supp f \<and> z \<in> fpxs_supp g \<and> fpxs_val f + fpxs_val g = y + z} \<subseteq>
         {(fpxs_val f, fpxs_val g)}"
     using False fpxs_val_leI[of f] fpxs_val_leI[of g] by (force simp: fpxs_supp_def supp_def)
   hence "fpxs_nth (f * g) (fpxs_val f + fpxs_val g) = 
         (\<Sum>(y, z)\<in>{(fpxs_val f, fpxs_val g)}. fpxs_nth f y * fpxs_nth g z)"
     unfolding fpxs_nth_mult
     by (intro sum.mono_neutral_left) (auto simp: fpxs_supp_def supp_def)
   thus ?thesis by simp
 qed auto
 
 lemma fpxs_val_mult [simp]:
   fixes f g :: "'a :: {comm_semiring_1, semiring_no_zero_divisors} fpxs"
   assumes "f \<noteq> 0" "g \<noteq> 0"
   shows "fpxs_val (f * g) = fpxs_val f + fpxs_val g"
 proof (intro antisym fpxs_val_leI fpxs_val_geI)
   fix r :: rat
   assume r: "r < fpxs_val f + fpxs_val g"
   show "fpxs_nth (f * g) r = 0"
     unfolding fpxs_nth_mult using assms fpxs_val_leI[of f] fpxs_val_leI[of g] r
     by (intro sum.neutral; force)
 qed (use assms in \<open>auto simp: fpxs_nth_mult_val fpxs_nth_val_nonzero\<close>)
 
 lemma fpxs_val_power [simp]:
   fixes f :: "'a :: {comm_semiring_1, semiring_no_zero_divisors} fpxs"
   assumes "f \<noteq> 0 \<or> n > 0"
   shows "fpxs_val (f ^ n) = of_nat n * fpxs_val f"
 proof (cases "f = 0")
   case False
   have [simp]: "f ^ n \<noteq> 0" for n
     using False by (induction n) auto
   thus ?thesis using False
     by (induction n) (auto simp: algebra_simps)
 qed (use assms in \<open>auto simp: power_0_left\<close>)
 
 lemma fpxs_nth_power_val [simp]:
   fixes f :: "'a :: {comm_semiring_1, semiring_no_zero_divisors} fpxs"
   shows "fpxs_nth (f ^ r) (rat_of_nat r * fpxs_val f) = fpxs_nth f (fpxs_val f) ^ r"
 proof (cases "f \<noteq> 0")
   case True
   show ?thesis
   proof (induction r)
     case (Suc r)
     have "fpxs_nth (f ^ Suc r) (rat_of_nat (Suc r) * fpxs_val f) =
           fpxs_nth (f * f ^ r) (fpxs_val f + fpxs_val (f ^ r))"
       using True by (simp add: fpxs_nth_mult_val ring_distribs)
     also have "\<dots> = fpxs_nth f (fpxs_val f) ^ Suc r"
       using Suc True by (subst fpxs_nth_mult_val) auto
     finally show ?case .
   qed (auto simp: fpxs_nth_1')
 next
   case False
   thus ?thesis
     by (cases r) (auto simp: fpxs_nth_1')
 qed
 
 
 subsection \<open>Powers of \<open>X\<close> and shifting\<close>
 
 lift_definition fpxs_X_power :: "rat \<Rightarrow> 'a :: {zero, one} fpxs" is
   "\<lambda>r n :: rat. if n = r then 1 else (0 :: 'a)"
 proof -
   fix r :: rat
   have "supp (\<lambda>n. if n = r then 1 else (0 :: 'a)) = (if (1 :: 'a) = 0 then {} else {r})"
     by (auto simp: supp_def)
   thus "is_fpxs (\<lambda>n. if n = r then 1 else (0 :: 'a))"
     using quotient_of_denom_pos'[of r] by (auto simp: is_fpxs_def)
 qed
 
 lemma fpxs_X_power_0 [simp]: "fpxs_X_power 0 = 1"
   by transfer auto
 
 lemma fpxs_X_power_add: "fpxs_X_power (a + b) = fpxs_X_power a * fpxs_X_power b"
 proof (transfer, goal_cases)
   case (1 a b)
   have *: "{(y,z). y \<in> supp (\<lambda>n. if n=a then (1::'a) else 0) \<and>
                z \<in> supp (\<lambda>n. if n=b then (1::'a) else 0) \<and> x=y+z} =
            (if x = a + b then {(a, b)} else {})" for x
     by (auto simp: supp_def fun_eq_iff)
   show ?case
     unfolding * by (auto simp: fun_eq_iff case_prod_unfold)
 qed
 
 lemma fpxs_X_power_mult: "fpxs_X_power (rat_of_nat n * m) = fpxs_X_power m ^ n"
   by (induction n) (auto simp: ring_distribs fpxs_X_power_add)
 
 lemma fpxs_of_fls_X_power [simp]: "fpxs_of_fls (fls_shift n 1) = fpxs_X_power (-rat_of_int n)"
   by transfer (auto simp: fun_eq_iff Ints_def simp flip: of_int_minus)
 
 lemma fpxs_X_power_neq_0 [simp]: "fpxs_X_power r \<noteq> (0 :: 'a :: zero_neq_one fpxs)"
   by transfer (auto simp: fun_eq_iff)
 
 lemma fpxs_X_power_eq_1_iff [simp]: "fpxs_X_power r = (1 :: 'a :: zero_neq_one fpxs) \<longleftrightarrow> r = 0"
   by transfer (auto simp: fun_eq_iff)
 
 
 lift_definition fpxs_shift :: "rat \<Rightarrow> 'a :: zero fpxs \<Rightarrow> 'a fpxs" is
   "\<lambda>r f n. f (n + r)"
 proof -
   fix r :: rat and f :: "rat \<Rightarrow> 'a"
   assume f: "is_fpxs f"
   have subset: "supp (\<lambda>n. f (n + r)) \<subseteq> (\<lambda>n. n + r) -` supp f"
     by (auto simp: supp_def)
   have eq: "(\<lambda>n. n + r) -` supp f = (\<lambda>n. n - r) ` supp f"
     by (auto simp: image_iff algebra_simps)
 
   show "is_fpxs (\<lambda>n. f (n + r))"
     unfolding is_fpxs_def
   proof
     have "bdd_below ((\<lambda>n. n + r) -` supp f)"
       unfolding eq by (rule bdd_below_image_mono) (use f in \<open>auto simp: is_fpxs_def mono_def\<close>)
     thus "bdd_below (supp (\<lambda>n. f (n + r)))"
       by (rule bdd_below_mono[OF _ subset])
   next
     have "(LCM r\<in>supp (\<lambda>n. f (n + r)). snd (quotient_of r)) dvd
           (LCM r\<in>(\<lambda>n. n + r) -` supp f. snd (quotient_of r))"
       by (intro Lcm_subset image_mono subset)
     also have "\<dots> = (LCM x\<in>supp f. snd (quotient_of (x - r)))"
       by (simp only: eq image_image o_def)
     also have "\<dots> dvd (LCM x\<in>supp f. snd (quotient_of r) * snd (quotient_of x))"
       by (subst mult.commute, intro Lcm_mono quotient_of_denom_diff_dvd)
     also have "\<dots> = Lcm ((\<lambda>x. snd (quotient_of r) * x) ` (\<lambda>x. snd (quotient_of x)) ` supp f)"
       by (simp add: image_image o_def)
     also have "\<dots> dvd normalize (snd (quotient_of r) * (LCM x\<in>supp f. snd (quotient_of x)))"
     proof (cases "supp f = {}")
       case False
       thus ?thesis by (subst Lcm_mult) auto
     qed auto
     finally show "(LCM r\<in>supp (\<lambda>n. f (n + r)). snd (quotient_of r)) \<noteq> 0"
       using quotient_of_denom_pos'[of r] f by (auto simp: is_fpxs_def)
   qed
 qed
 
 lemma fpxs_nth_shift [simp]: "fpxs_nth (fpxs_shift r f) n = fpxs_nth f (n + r)"
   by transfer simp_all
 
 lemma fpxs_shift_0_left [simp]: "fpxs_shift 0 f = f"
   by transfer auto
 
 lemma fpxs_shift_add_left: "fpxs_shift (m + n) f = fpxs_shift m (fpxs_shift n f)"
   by transfer (simp_all add: add_ac)
 
 lemma fpxs_shift_diff_left: "fpxs_shift (m - n) f = fpxs_shift m (fpxs_shift (-n) f)"
   by (subst fpxs_shift_add_left [symmetric]) auto
 
 lemma fpxs_shift_0 [simp]: "fpxs_shift r 0 = 0"
   by transfer simp_all
 
 lemma fpxs_shift_add [simp]: "fpxs_shift r (f + g) = fpxs_shift r f + fpxs_shift r g"
   by transfer auto
 
 lemma fpxs_shift_uminus [simp]: "fpxs_shift r (-f) = -fpxs_shift r f"
   by transfer auto
 
 lemma fpxs_shift_shift_uminus [simp]: "fpxs_shift r (fpxs_shift (-r) f) = f"
   by (simp flip: fpxs_shift_add_left)
 
 lemma fpxs_shift_shift_uminus' [simp]: "fpxs_shift (-r) (fpxs_shift r f) = f"
   by (simp flip: fpxs_shift_add_left)
 
 lemma fpxs_shift_diff [simp]: "fpxs_shift r (f - g) = fpxs_shift r f - fpxs_shift r g"
   unfolding minus_fpxs_def by (subst fpxs_shift_add) auto
 
 lemma fpxs_shift_compose_power [simp]:
   "fpxs_shift r (fpxs_compose_power f s) = fpxs_compose_power (fpxs_shift (r / s) f) s"
   by transfer (simp_all add: add_divide_distrib add_ac cong: if_cong)
 
 lemma rat_of_int_div_dvd: "d dvd n \<Longrightarrow> rat_of_int (n div d) = rat_of_int n / rat_of_int d"
   by auto
 
 lemma fpxs_of_fls_shift [simp]:
   "fpxs_of_fls (fls_shift n f) = fpxs_shift (of_int n) (fpxs_of_fls f)"
 proof (transfer, goal_cases)
   case (1 n f)
   show ?case
   proof
     fix r :: rat
     have eq: "r + rat_of_int n \<in> \<int> \<longleftrightarrow> r \<in> \<int>"
       by (metis Ints_add Ints_diff Ints_of_int add_diff_cancel_right')
     show "(if r \<in> \<int> then f (\<lfloor>r\<rfloor> + n) else 0) =
           (if r + rat_of_int n \<in> \<int> then f \<lfloor>r + rat_of_int n\<rfloor> else 0)"
       unfolding eq by auto
   qed
 qed
 
 lemma fpxs_shift_mult: "f * fpxs_shift r g = fpxs_shift r (f * g)"
                        "fpxs_shift r f * g = fpxs_shift r (f * g)"
 proof -
   obtain a b where ab: "r = of_int a / of_nat b" and "b > 0"
     by (metis Fract_of_int_quotient of_int_of_nat_eq quotient_of_unique zero_less_imp_eq_int)
 
   define s where "s = lcm b (lcm (fpxs_root_order f) (fpxs_root_order g))"
   have "s > 0" using \<open>b > 0\<close>
     by (auto simp: s_def intro!: Nat.gr0I)
   obtain f' where f: "f = fpxs_compose_power (fpxs_of_fls f') (1 / rat_of_nat s)"
     using fpxs_as_fls'[of f s] \<open>s > 0\<close> by (auto simp: s_def)
   obtain g' where g: "g = fpxs_compose_power (fpxs_of_fls g') (1 / rat_of_nat s)"
     using fpxs_as_fls'[of g s] \<open>s > 0\<close> by (auto simp: s_def)
 
   define n where "n = (a * s) div b"
   have "b dvd s"
     by (auto simp: s_def)
   have sr_eq: "r * rat_of_nat s = rat_of_int n"
     using \<open>b > 0\<close> \<open>b dvd s\<close>
     by (simp add: ab field_simps of_rat_divide of_rat_mult n_def rat_of_int_div_dvd)
 
   show "f * fpxs_shift r g = fpxs_shift r (f * g)" "fpxs_shift r f * g = fpxs_shift r (f * g)"
     unfolding f g using \<open>s > 0\<close>
     by (simp_all flip: fpxs_compose_power_mult fpxs_of_fls_mult fpxs_of_fls_shift
                  add: sr_eq fls_shifted_times_simps mult_ac)
 qed
 
 lemma fpxs_shift_1: "fpxs_shift r 1 = fpxs_X_power (-r)"
   by transfer (auto simp: fun_eq_iff)
 
 lemma fpxs_X_power_conv_shift: "fpxs_X_power r = fpxs_shift (-r) 1"
   by (simp add: fpxs_shift_1)
 
 lemma fpxs_shift_power [simp]: "fpxs_shift n x ^ m = fpxs_shift (of_nat m * n) (x ^ m)"
   by (induction m) (simp_all add: algebra_simps fpxs_shift_mult flip: fpxs_shift_add_left)
 
 lemma fpxs_compose_power_X_power [simp]:
   "s > 0 \<Longrightarrow> fpxs_compose_power (fpxs_X_power r) s = fpxs_X_power (r * s)"
   by transfer (simp add: field_simps)
 
 
 subsection \<open>The \<open>n\<close>-th root of a Puiseux series\<close>
 
 text \<open>
   In this section, we define the formal root of a Puiseux series. This is done using the
   same concept for formal power series. There is still one interesting theorems that is missing
   here, e.g.\ the uniqueness (which could probably be lifted over from FPSs) somehow.
 \<close>
 
 definition fpxs_radical :: "(nat \<Rightarrow> 'a :: field_char_0 \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> 'a fpxs \<Rightarrow> 'a fpxs" where
   "fpxs_radical rt r f = (if f = 0 then 0 else
      (let f' = fls_base_factor_to_fps (fls_of_fpxs f);
           f'' = fpxs_of_fls (fps_to_fls (fps_radical rt r f'))
       in  fpxs_shift (-fpxs_val f / rat_of_nat r)
             (fpxs_compose_power f'' (1 / rat_of_nat (fpxs_root_order f)))))"
 
 lemma fpxs_radical_0 [simp]: "fpxs_radical rt r 0 = 0"
   by (simp add: fpxs_radical_def)
 
 lemma 
   fixes r :: nat
   assumes r: "r > 0"
   shows fpxs_power_radical:
         "rt r (fpxs_nth f (fpxs_val f)) ^ r = fpxs_nth f (fpxs_val f) \<Longrightarrow> fpxs_radical rt r f ^ r = f"
     and fpxs_radical_lead_coeff:
           "f \<noteq> 0 \<Longrightarrow> fpxs_nth (fpxs_radical rt r f) (fpxs_val f / rat_of_nat r) =
                        rt r (fpxs_nth f (fpxs_val f))"
 proof -
   define q where "q = fpxs_root_order f"
   define f' where "f' = fls_base_factor_to_fps (fls_of_fpxs f)"
   have [simp]: "fps_nth f' 0 = fpxs_nth f (fpxs_val f)"
     by (simp add: f'_def fls_nth_of_fpxs of_int_fls_subdegree_of_fpxs)
   define f'' where "f'' = fpxs_of_fls (fps_to_fls (fps_radical rt r f'))"
   have eq1: "fls_of_fpxs f = fls_shift (-fls_subdegree (fls_of_fpxs f)) (fps_to_fls f')"
     by (subst fls_conv_base_factor_to_fps_shift_subdegree) (simp add: f'_def)
   have eq2: "fpxs_compose_power (fpxs_of_fls (fls_of_fpxs f)) (1 / of_nat q) = f"
     unfolding q_def by (rule fpxs_as_fls)
   also note eq1
   also have "fpxs_of_fls (fls_shift (- fls_subdegree (fls_of_fpxs f)) (fps_to_fls f')) =
              fpxs_shift (- (fpxs_val f * rat_of_nat q)) (fpxs_of_fls (fps_to_fls f'))"
     by (simp add: of_int_fls_subdegree_of_fpxs q_def)
   finally have eq3: "fpxs_compose_power (fpxs_shift (- (fpxs_val f * rat_of_nat q))
                        (fpxs_of_fls (fps_to_fls f'))) (1 / rat_of_nat q) = f" .
 
   {
     assume rt: "rt r (fpxs_nth f (fpxs_val f)) ^ r = fpxs_nth f (fpxs_val f)"
     show "fpxs_radical rt r f ^ r = f"
     proof (cases "f = 0")
       case [simp]: False
       have "f'' ^ r = fpxs_of_fls (fps_to_fls (fps_radical rt r f' ^ r))"
         by (simp add: fps_to_fls_power f''_def)
       also have "fps_radical rt r f' ^ r = f'"
         using power_radical[of f' rt "r - 1"] r rt by (simp add: fpxs_nth_val_nonzero)
       finally have "f'' ^ r = fpxs_of_fls (fps_to_fls f')" .
   
       have "fpxs_shift (-fpxs_val f / rat_of_nat r) (fpxs_compose_power f'' (1 / of_nat q)) ^ r =
               fpxs_shift (-fpxs_val f) (fpxs_compose_power (f'' ^ r) (1 / of_nat q))"
         unfolding q_def using r
         by (subst fpxs_shift_power, subst fpxs_compose_power_power [symmetric]) simp_all
       also have "f'' ^ r = fpxs_of_fls (fps_to_fls f')"
         by fact
       also have "fpxs_shift (-fpxs_val f) (fpxs_compose_power
                    (fpxs_of_fls (fps_to_fls f')) (1 / of_nat q)) = f"
         using r eq3 by simp
       finally show "fpxs_radical rt r f ^ r = f"
         by (simp add: fpxs_radical_def f'_def f''_def q_def)
     qed (use r in auto)
   }
 
   assume [simp]: "f \<noteq> 0"
   have "fpxs_nth (fpxs_shift (-fpxs_val f / of_nat r) (fpxs_compose_power f'' (1 / of_nat q)))
           (fpxs_val f / of_nat r) = fpxs_nth f'' 0"
     using r by (simp add: q_def)
   also have "fpxs_shift (-fpxs_val f / of_nat r) (fpxs_compose_power f'' (1 / of_nat q)) =
                fpxs_radical rt r f"
     by (simp add: fpxs_radical_def q_def f'_def f''_def)
   also have "fpxs_nth f'' 0 = rt r (fpxs_nth f (fpxs_val f))"
     using r by (simp add: f''_def fpxs_nth_of_fls)
   finally show "fpxs_nth (fpxs_radical rt r f) (fpxs_val f / rat_of_nat r) =
                   rt r (fpxs_nth f (fpxs_val f))" .
 qed
 
 lemma fls_base_factor_power:
   fixes f :: "'a::{semiring_1, semiring_no_zero_divisors} fls"
   shows "fls_base_factor (f ^ n) = fls_base_factor f ^ n"
 proof (cases "f = 0")
   case False
   have [simp]: "f ^ n \<noteq> 0" for n
     by (induction n) (use False in auto)
   show ?thesis using False
     by (induction n) (auto simp: fls_base_factor_mult simp flip: fls_times_both_shifted_simp)
 qed (cases n; simp)
 
 (* TODO: Uniqueness of radical. Also: composition and composition inverse *)
 
 hide_const (open) supp
 
 
 subsection \<open>Algebraic closedness\<close>
 
 text \<open>
   We will now show that the field of formal Puiseux series over an algebraically closed field of
   characteristic 0 is again algebraically closed.
 
   The typeclass constraint \<^class>\<open>field_gcd\<close> is a technical constraint that mandates that
   the field has a (trivial) GCD operation defined on it. It comes from some peculiarities of
   Isabelle's typeclass system and can be considered unimportant, since any concrete type of
   class \<^class>\<open>field\<close> can easily be made an instance of \<^class>\<open>field_gcd\<close>.
 
   It would be possible to get rid of this constraint entirely here, but it is not worth
   the effort.
 
   The proof is a fairly standard one that uses Hensel's lemma. Some preliminary tricks are
   required to be able to use it, however, namely a number of non-obvious changes of variables
   to turn the polynomial with Puiseux coefficients into one with formal power series coefficients.
   The overall approach was taken from an article by Nowak~\<^cite>\<open>"nowak2000"\<close>.
 
   Basically, what we need to show is this: Let 
   \[p(X,Z) = a_n(Z) X^n + a_{n-1}(Z) X^{n-1} + \ldots + a_0(Z)\]
   be a polynomial in \<open>X\<close> of degree at least 2
   with coefficients that are formal Puiseux series in \<open>Z\<close>. Then \<open>p\<close> is reducible, i.e. it splits
   into two non-constant factors.
 
   Due to work we have already done elsewhere, we may assume here that $a_n = 1$, $a_{n-1} = 0$, and
   $a_0 \neq 0$, all of which will come in very useful.
 \<close>
 
 instance fpxs :: ("{alg_closed_field, field_char_0, field_gcd}") alg_closed_field
 proof (rule alg_closedI_reducible_coeff_deg_minus_one_eq_0)
   fix p :: "'a fpxs poly"
   assume deg_p: "degree p > 1"  and lc_p: "lead_coeff p = 1"
   assume coeff_deg_minus_1: "coeff p (degree p - 1) = 0"
   assume "coeff p 0 \<noteq> 0"
   define N where "N = degree p"
 
   text \<open>
     Let $a_0, \ldots, a_n$ be the coefficients of \<open>p\<close> with $a_n = 1$. Now let \<open>r\<close> be the maximum of
     $-\frac{\text{val}(a_i)}{n-i}$ ranging over all $i < n$ such that $a_i \neq 0$.
   \<close>
   define r :: rat
     where "r = (MAX i\<in>{i\<in>{..<N}. coeff p i \<noteq> 0}.
                   -fpxs_val (poly.coeff p i) / (rat_of_nat N - rat_of_nat i))"
 
   text \<open>
     We write $r = a / b$ such that all the $a_i$ can be written as Laurent series in
     $X^{1/b}$, i.e. the root orders of all the $a_i$ divide $b$:
   \<close>
   obtain a b where ab: "b > 0" "r = of_int a / of_nat b" "\<forall>i\<le>N. fpxs_root_order (coeff p i) dvd b"
   proof -
     define b where "b = lcm (nat (snd (quotient_of r))) (LCM i\<in>{..N}. fpxs_root_order (coeff p i))"
     define x where "x = b div nat (snd (quotient_of r))"
     define a where "a = fst (quotient_of r) * int x"
 
     show ?thesis
     proof (rule that)
       show "b > 0"
         using quotient_of_denom_pos'[of r] by (auto simp: b_def intro!: Nat.gr0I)
       have b_eq: "b = nat (snd (quotient_of r)) * x"
         by (simp add: x_def b_def)
       have "x > 0"
         using b_eq \<open>b > 0\<close> by (auto intro!: Nat.gr0I)
       have "r = rat_of_int (fst (quotient_of r)) / rat_of_int (int (nat (snd (quotient_of r))))"
         using quotient_of_denom_pos'[of r] quotient_of_div[of r] by simp
       also have "\<dots> = rat_of_int a / rat_of_nat b"
         using \<open>x > 0\<close> by (simp add: a_def b_eq)
       finally show "r = rat_of_int a / rat_of_nat b" .
       show "\<forall>i\<le>N. fpxs_root_order (poly.coeff p i) dvd b"
         by (auto simp: b_def)
     qed
   qed
 
   text \<open>
     We write all the coefficients of \<open>p\<close> as Laurent series in $X^{1/b}$:
   \<close>
   have "\<exists>c. coeff p i = fpxs_compose_power (fpxs_of_fls c) (1 / rat_of_nat b)" if i: "i \<le> N" for i
   proof -
     have "fpxs_root_order (coeff p i) dvd b"
       using ab(3) i by auto
     from fpxs_as_fls'[OF this \<open>b > 0\<close>] show ?thesis by metis
   qed
   then obtain c_aux where c_aux:
     "coeff p i = fpxs_compose_power (fpxs_of_fls (c_aux i)) (1 / rat_of_nat b)" if "i \<le> N" for i
     by metis
   define c where "c = (\<lambda>i. if i \<le> N then c_aux i else 0)"
   have c: "coeff p i = fpxs_compose_power (fpxs_of_fls (c i)) (1 / rat_of_nat b)" for i
     using c_aux[of i] by (auto simp: c_def N_def coeff_eq_0)
   have c_eq_0 [simp]: "c i = 0" if "i > N" for i
     using that by (auto simp: c_def)
   have c_eq: "fpxs_of_fls (c i) = fpxs_compose_power (coeff p i) (rat_of_nat b)" for i
     using c[of i] \<open>b > 0\<close> by (simp add: fpxs_compose_power_distrib)
 
   text \<open>
     We perform another change of variables and multiply with a suitable power of \<open>X\<close> to turn our
     Laurent coefficients into FPS coefficients:
   \<close>
   define c' where "c' = (\<lambda>i. fls_X_intpow ((int N - int i) * a) * c i)"
   have "c' N = 1"
     using c[of N] \<open>lead_coeff p = 1\<close> \<open>b > 0\<close> by (simp add: c'_def N_def)
 
   have subdegree_c: "of_int (fls_subdegree (c i)) = fpxs_val (coeff p i) * rat_of_nat b"
     if i: "i \<le> N" for i
   proof -
     have "rat_of_int (fls_subdegree (c i)) = fpxs_val (fpxs_of_fls (c i))"
       by simp
     also have "fpxs_of_fls (c i) = fpxs_compose_power (poly.coeff p i) (rat_of_nat b)"
       by (subst c_eq) auto
     also have "fpxs_val \<dots> = fpxs_val (coeff p i) * rat_of_nat b"
       using \<open>b > 0\<close> by simp
     finally show ?thesis .
   qed
 
   text \<open>
     We now write all the coefficients as FPSs:
   \<close>
   have "\<exists>c''. c' i = fps_to_fls c''" if "i \<le> N" for i
   proof (cases "i = N")
     case True
     hence "c' i = fps_to_fls 1"
       using \<open>c' N = 1\<close> by simp
     thus ?thesis by metis
   next
     case i: False
     show ?thesis
     proof (cases "c i = 0")
       case True
       hence "c' i = 0" by (auto simp: c'_def)
       thus ?thesis
         by (metis fps_zero_to_fls)
     next
       case False
       hence "coeff p i \<noteq> 0"
         using c_eq[of i] by auto
       hence r_ge: "r \<ge> -fpxs_val (poly.coeff p i) / (rat_of_nat N - rat_of_nat i)"
         unfolding r_def using i that False by (intro Max.coboundedI) auto
 
       have "fls_subdegree (c' i) = fls_subdegree (c i) + (int N - int i) * a"
         using i that False by (simp add: c'_def fls_X_intpow_times_conv_shift subdegree_c)
       also have "rat_of_int \<dots> =
                    fpxs_val (poly.coeff p i) * of_nat b + (of_nat N - of_nat i) * of_int a"
         using i that False by (simp add: subdegree_c)
       also have "\<dots> = of_nat b * (of_nat N - of_nat i) *
                         (fpxs_val (poly.coeff p i) / (of_nat N - of_nat i) + r)"
         using \<open>b > 0\<close> i by (auto simp: field_simps ab(2))
       also have "\<dots> \<ge> 0"
         using r_ge that by (intro mult_nonneg_nonneg) auto
       finally have "fls_subdegree (c' i) \<ge> 0" by simp
       hence "\<exists>c''. c' i = fls_shift 0 (fps_to_fls c'')"
         by (intro fls_as_fps') (auto simp: algebra_simps)
       thus ?thesis by simp
     qed
   qed
   then obtain c''_aux where c''_aux: "c' i = fps_to_fls (c''_aux i)" if "i \<le> N" for i
     by metis
   define c'' where "c'' = (\<lambda>i. if i \<le> N then c''_aux i else 0)"
   have c': "c' i = fps_to_fls (c'' i)" for i
   proof (cases "i \<le> N")
     case False
     thus ?thesis by (auto simp: c'_def c''_def)
   qed (auto simp: c''_def c''_aux)
   have c''_eq: "fps_to_fls (c'' i) = c' i" for i
     using c'[of i] by simp
 
   define p' where "p' = Abs_poly c''"
   have coeff_p': "coeff p' = c''"
     unfolding p'_def
   proof (rule coeff_Abs_poly)
     fix i assume "i > N"
     hence "coeff p i = 0"
       by (simp add: N_def coeff_eq_0)
     thus "c'' i = 0" using c'[of i] c[of i] \<open>b > 0\<close> \<open>N < i\<close> c''_def by auto
   qed
 
   text \<open>
     We set up some homomorphisms to convert between the two polynomials:
   \<close>
   interpret comppow: map_poly_inj_idom_hom "(\<lambda>x::'a fpxs. fpxs_compose_power x (1/rat_of_nat b))"
     by unfold_locales (use \<open>b > 0\<close> in simp_all)
   define lift_poly :: "'a fps poly \<Rightarrow> 'a fpxs poly" where
     "lift_poly = (\<lambda>p. pcompose p [:0, fpxs_X_power r:]) \<circ>
                   (map_poly ((\<lambda>x. fpxs_compose_power x (1/rat_of_nat b)) \<circ> fpxs_of_fls \<circ> fps_to_fls))"
   have [simp]: "degree (lift_poly q) = degree q" for q
     unfolding lift_poly_def by (simp add: degree_map_poly)
   
   interpret fps_to_fls: map_poly_inj_idom_hom fps_to_fls
     by unfold_locales (simp_all add: fls_times_fps_to_fls)
   interpret fpxs_of_fls: map_poly_inj_idom_hom fpxs_of_fls
     by unfold_locales simp_all
   interpret lift_poly: inj_idom_hom lift_poly
     unfolding lift_poly_def
     by (intro inj_idom_hom_compose inj_idom_hom_pcompose inj_idom_hom.inj_idom_hom_map_poly
               fps_to_fls.base.inj_idom_hom_axioms fpxs_of_fls.base.inj_idom_hom_axioms
               comppow.base.inj_idom_hom_axioms) simp_all
   interpret lift_poly: map_poly_inj_idom_hom lift_poly
     by unfold_locales
 
   define C :: "'a fpxs" where "C = fpxs_X_power (- (rat_of_nat N * r))"
   have [simp]: "C \<noteq> 0"
     by (auto simp: C_def)
 
   text \<open>
     Now, finally: the original polynomial and the new polynomial are related through the
     \<^term>\<open>lift_poly\<close> homomorphism:
   \<close>
   have p_eq: "p = smult C (lift_poly p')"
     using \<open>b > 0\<close>
     by (intro poly_eqI)
        (simp_all add: coeff_map_poly coeff_pcompose_linear coeff_p' c c''_eq c'_def C_def
                       ring_distribs fpxs_X_power_conv_shift fpxs_shift_mult lift_poly_def ab(2)
                  flip: fpxs_X_power_add fpxs_X_power_mult fpxs_shift_add_left)
   have [simp]: "degree p' = N"
     unfolding N_def using \<open>b > 0\<close> by (simp add: p_eq)
   have lc_p': "lead_coeff p' = 1"
     using c''_eq[of N] by (simp add: coeff_p' \<open>c' N = 1\<close>)
   have "coeff p' (N - 1) = 0"
     using coeff_deg_minus_1 \<open>b > 0\<close> unfolding N_def [symmetric]
     by (simp add: p_eq lift_poly_def coeff_map_poly coeff_pcompose_linear)
 
   text \<open>
     We reduce $p'(X,Z)$ to $p'(X,0)$:
   \<close>
   define p'_proj where "p'_proj = reduce_fps_poly p'"
   have [simp]: "degree p'_proj = N"
     unfolding p'_proj_def using lc_p' by (subst degree_reduce_fps_poly_monic) simp_all
   have lc_p'_proj: "lead_coeff p'_proj = 1"
     unfolding p'_proj_def using lc_p' by (subst reduce_fps_poly_monic) simp_all
   hence [simp]: "p'_proj \<noteq> 0"
     by auto
   have "coeff p'_proj (N - 1) = 0"
     using \<open>coeff p' (N - 1) = 0\<close> by (simp add: p'_proj_def reduce_fps_poly_def)
 
   text \<open>
     We now show that \<^term>\<open>p'_proj\<close> splits into non-trivial coprime factors. To do this, we
     have to show that it has two distinct roots, i.e. that it is not of the form $(X - c)^n$.
   \<close>
   obtain g h where gh: "degree g > 0" "degree h > 0" "coprime g h" "p'_proj = g * h"
   proof -
     have "degree p'_proj > 1"
       using deg_p by (auto simp: N_def)
     text \<open>Let \<open>x\<close> be an arbitrary root of \<^term>\<open>p'_proj\<close>:\<close>
     then obtain x where x: "poly p'_proj x = 0"
       using alg_closed_imp_poly_has_root[of p'_proj] by force
 
     text \<open>Assume for the sake of contradiction that \<^term>\<open>p'_proj\<close> were equal to $(1-x)^n$:\<close>
     have not_only_one_root: "p'_proj \<noteq> [:-x, 1:] ^ N"
     proof safe
       assume *: "p'_proj = [:-x, 1:] ^ N"
 
       text \<open>
         If \<open>x\<close> were non-zero, all the coefficients of \<open>p'_proj\<close> would also be non-zero by the
         Binomial Theorem. Since we know that the coefficient of \<open>n - 1\<close> \<^emph>\<open>is\<close> zero, this means
         that \<open>x\<close> must be zero:
       \<close>
       have "coeff p'_proj (N - 1) = 0" by fact
       hence "x = 0"
         by (subst (asm) *, subst (asm) coeff_linear_poly_power) auto
 
       text \<open>
         However, by our choice of \<open>r\<close>, we know that there is an index \<open>i\<close> such that \<open>c' i\<close> has
         is non-zero and has valuation (i.e. subdegree) 0, which means that the \<open>i\<close>-th coefficient
         of \<^term>\<open>p'_proj\<close> must also be non-zero.
       \<close>
       have "0 < N \<and> coeff p 0 \<noteq> 0"
         using deg_p \<open>coeff p 0 \<noteq> 0\<close> by (auto simp: N_def)
       hence "{i\<in>{..<N}. coeff p i \<noteq> 0} \<noteq> {}"
         by blast
       hence "r \<in> (\<lambda>i. -fpxs_val (poly.coeff p i) / (rat_of_nat N - rat_of_nat i)) `
               {i\<in>{..<N}. coeff p i \<noteq> 0}"
         unfolding r_def using deg_p by (intro Max_in) (auto simp: N_def)
       then obtain i where i: "i < N" "coeff p i \<noteq> 0"
                              "-fpxs_val (coeff p i) / (rat_of_nat N - rat_of_nat i) = r"
         by blast
       hence [simp]: "c' i \<noteq> 0"
         using i c[of i] by (auto simp: c'_def)
       have "fpxs_val (poly.coeff p i) = rat_of_int (fls_subdegree (c i)) / rat_of_nat b"
         using subdegree_c[of i] i \<open>b > 0\<close> by (simp add: field_simps)
       also have "fpxs_val (coeff p i) = -r * (rat_of_nat N - rat_of_nat i)"
         using i by (simp add: field_simps)
       finally have "rat_of_int (fls_subdegree (c i)) = - r * (of_nat N - of_nat i) * of_nat b"
         using \<open>b > 0\<close> by (simp add: field_simps)
       also have "c i = fls_shift ((int N - int i) * a) (c' i)"
         using i by (simp add: c'_def ring_distribs fls_X_intpow_times_conv_shift
                          flip: fls_shifted_times_simps(2))
       also have "fls_subdegree \<dots> = fls_subdegree (c' i) - (int N - int i) * a"
         by (subst fls_shift_subdegree) auto
       finally have "fls_subdegree (c' i) = 0"
         using \<open>b > 0\<close> by (simp add: ab(2))
       hence "subdegree (coeff p' i) = 0"
         by (simp flip: c''_eq add: fls_subdegree_fls_to_fps coeff_p')
       moreover have "coeff p' i \<noteq> 0"
         using \<open>c' i \<noteq> 0\<close> c' coeff_p' by auto
       ultimately have "coeff p' i $ 0 \<noteq> 0"
         using subdegree_eq_0_iff by blast
 
       also have "coeff p' i $ 0 = coeff p'_proj i"
         by (simp add: p'_proj_def reduce_fps_poly_def)
       also have "\<dots> = 0"
         by (subst *, subst coeff_linear_poly_power) (use i \<open>x = 0\<close> in auto)
       finally show False by simp
     qed
 
     text \<open>
       We can thus obtain our second root \<open>y\<close> from the factorisation:
     \<close>
     have "\<exists>y. x \<noteq> y \<and> poly p'_proj y = 0"
     proof (rule ccontr)
       assume *: "\<not>(\<exists>y. x \<noteq> y \<and> poly p'_proj y = 0)"
       have "p'_proj \<noteq> 0" by simp
       then obtain A where A: "size A = degree p'_proj"
                              "p'_proj = smult (lead_coeff p'_proj) (\<Prod>x\<in>#A. [:-x, 1:])"
         using alg_closed_imp_factorization[of p'_proj] by blast
       have "set_mset A = {x. poly p'_proj x = 0}"
         using lc_p'_proj by (subst A) (auto simp: poly_prod_mset)
       also have "\<dots> = {x}"
         using x * by auto
       finally have "A = replicate_mset N x"
         using set_mset_subset_singletonD[of A x] A(1) by simp
       with A(2) have "p'_proj = [:- x, 1:] ^ N"
         using lc_p'_proj by simp
       with not_only_one_root show False 
         by contradiction
     qed
     then obtain y where "x \<noteq> y" "poly p'_proj y = 0"
       by blast
 
     text \<open>
       It now follows easily that \<^term>\<open>p'_proj\<close> splits into non-trivial and coprime factors:
     \<close>
     show ?thesis
     proof (rule alg_closed_imp_poly_splits_coprime)
       show "degree p'_proj > 1"
         using deg_p by (simp add: N_def)
       show "x \<noteq> y" "poly p'_proj x = 0" "poly p'_proj y = 0"
         by fact+
     qed (use that in metis)
   qed
 
   text \<open>
     By Hensel's lemma, these factors give rise to corresponding factors of \<open>p'\<close>:
   \<close>
   interpret hensel: fps_hensel p' p'_proj g h
   proof unfold_locales
     show "lead_coeff p' = 1"
       using lc_p' by simp
   qed (use gh \<open>coprime g h\<close> in \<open>simp_all add: p'_proj_def\<close>) 
 
   text \<open>All that remains now is to undo the variable substitutions we did above:\<close>
   have "p = [:C:] * lift_poly hensel.G * lift_poly hensel.H"
     unfolding p_eq by (subst hensel.F_splits) (simp add: hom_distribs)
   thus "\<not>irreducible p"
     by (rule reducible_polyI) (use hensel.deg_G hensel.deg_H gh in simp_all)
 qed
 
 text \<open>
   We do not actually show that this is the algebraic closure since this cannot be stated
   idiomatically in the typeclass setting and is probably not very useful either, but it can
   be motivated like this:
 
   Suppose we have an algebraically closed extension $L$ of the field of Laurent series. Clearly,
   $X^{a/b}\in L$ for any integer \<open>a\<close> and any positive integer \<open>b\<close> since
   $(X^{a/b})^b - X^a = 0$. But any Puiseux series $F(X)$ with root order \<open>b\<close> can
   be written as
   \[F(X) = \sum_{k=0}^{b-1} X^{k/b} F_k(X)\]
   where the Laurent series $F_k(X)$ are defined as follows:
   \[F_k(X) := \sum_{n = n_{0,k}}^\infty [X^{n + k/b}] F(X) X^n\]
   Thus, $F(X)$ can be written as a finite sum of products of elements in $L$ and must therefore
   also be in $L$. Thus, the Puiseux series are all contained in $L$.
 \<close>
 
 
 subsection \<open>Metric and topology\<close>
 
 text \<open>
   Formal Puiseux series form a metric space with the usual metric for formal series:
   Two series are ``close'' to one another if they have many initial coefficients in common.
 \<close>
 
 instantiation fpxs :: (zero) norm
 begin
 
 definition norm_fpxs :: "'a fpxs \<Rightarrow> real" where
   "norm f = (if f = 0 then 0 else 2 powr (-of_rat (fpxs_val f)))"
 
 instance ..
 
 end
 
 
 instantiation fpxs :: (group_add) dist
 begin
 
 definition dist_fpxs :: "'a fpxs \<Rightarrow> 'a fpxs \<Rightarrow> real" where
   "dist f g = (if f = g then 0 else 2 powr (-of_rat (fpxs_val (f - g))))"
 
 instance ..
 
 end
 
 
 instantiation fpxs :: (group_add) metric_space
 begin
 
 definition uniformity_fpxs_def [code del]:
   "(uniformity :: ('a fpxs \<times> 'a fpxs) filter) = (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})"
 
 definition open_fpxs_def [code del]:
   "open (U :: 'a fpxs set) \<longleftrightarrow> (\<forall>x\<in>U. eventually (\<lambda>(x', y). x' = x \<longrightarrow> y \<in> U) uniformity)"
 
 instance proof
   fix f g h :: "'a fpxs"
   show "dist f g \<le> dist f h + dist g h"
   proof (cases "f \<noteq> g \<and> f \<noteq> h \<and> g \<noteq> h")
     case True
     have "dist f g \<le> 2 powr -real_of_rat (min (fpxs_val (f - h)) (fpxs_val (g - h)))"
       using fpxs_val_add_ge[of "f - h" "h - g"] True
       by (auto simp: algebra_simps fpxs_val_minus_commute dist_fpxs_def of_rat_less_eq)
     also have "\<dots> \<le> dist f h + dist g h"
       using True by (simp add: dist_fpxs_def min_def)
     finally show ?thesis .
   qed (auto simp: dist_fpxs_def fpxs_val_minus_commute)
 qed (simp_all add: uniformity_fpxs_def open_fpxs_def dist_fpxs_def)
 
 end
 
 
 instance fpxs :: (group_add) dist_norm
   by standard (auto simp: dist_fpxs_def norm_fpxs_def)
 
+lemma fpxs_const_eq_0_iff [simp]: "fpxs_const x = 0 \<longleftrightarrow> x = 0"
+  by (metis fpxs_const_0 fpxs_const_eq_iff)
+
+lemma semiring_char_fpxs [simp]: "CHAR('a :: comm_semiring_1 fpxs) = CHAR('a)"
+  by (rule CHAR_eqI; unfold of_nat_fpxs_eq) (auto simp: of_nat_eq_0_iff_char_dvd)
+
+instance fpxs :: ("{semiring_prime_char,comm_semiring_1}") semiring_prime_char
+  by (rule semiring_prime_charI) auto
+instance fpxs :: ("{comm_semiring_prime_char,comm_semiring_1}") comm_semiring_prime_char
+  by standard
+instance fpxs :: ("{comm_ring_prime_char,comm_semiring_1}") comm_ring_prime_char
+  by standard
+instance fpxs :: ("{idom_prime_char,comm_semiring_1}") idom_prime_char
+  by standard
+instance fpxs :: ("field_prime_char") field_prime_char
+  by standard auto
+
 end
\ No newline at end of file
diff --git a/thys/Gromov_Hyperbolicity/Gromov_Boundary.thy b/thys/Gromov_Hyperbolicity/Gromov_Boundary.thy
--- a/thys/Gromov_Hyperbolicity/Gromov_Boundary.thy
+++ b/thys/Gromov_Hyperbolicity/Gromov_Boundary.thy
@@ -1,2834 +1,2834 @@
 (*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
     License: BSD
 *)
 
 theory Gromov_Boundary
   imports Gromov_Hyperbolicity Eexp_Eln
 begin
 
 section \<open>Constructing a distance from a quasi-distance\<close>
 
 text \<open>Below, we will construct a distance on the Gromov completion of a hyperbolic space. The
 geometrical object that arises naturally is almost a distance, but it does not satisfy the triangular
 inequality. There is a general process to turn such a quasi-distance into a genuine distance, as
 follows: define the new distance $\tilde d(x,y)$ to be the infimum of $d(x, u_1) + d(u_1,u_2) +
 \dotsb + d(u_{n-1},x)$ over all sequences of points (of any length) connecting $x$ to $y$.
 It is clear that it satisfies the triangular inequality, is symmetric, and $\tilde d(x,y) \leq
 d(x,y)$. What is not clear, however, is if $\tilde d(x,y)$ can be zero if $x \neq y$, or more
 generally how one can bound $\tilde d$ from below. The main point of this contruction is that,
 if $d$ satisfies the inequality $d(x,z) \leq \sqrt{2} \max(d(x,y), d(y,z))$, then one
 has $\tilde d(x,y) \geq d(x,y)/2$ (and in particular $\tilde d$ defines the same topology, the
 same set of Lipschitz functions, and so on, as $d$).
 
 This statement can be found in [Bourbaki, topologie generale, chapitre 10] or in
 [Ghys-de la Harpe] for instance. We follow their proof.
 \<close>
 
 definition turn_into_distance::"('a \<Rightarrow> 'a \<Rightarrow> real) \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> real)"
   where "turn_into_distance f x y = Inf {(\<Sum> i \<in> {0..<n}. f (u i) (u (Suc i)))| u (n::nat). u 0 = x \<and> u n = y}"
 
 locale Turn_into_distance =
   fixes f::"'a \<Rightarrow> 'a \<Rightarrow> real"
   assumes nonneg: "f x y \<ge> 0"
       and sym: "f x y = f y x"
       and self_zero: "f x x = 0"
       and weak_triangle: "f x z \<le> sqrt 2 * max (f x y) (f y z)"
 begin
 
 text \<open>The two lemmas below are useful when dealing with Inf results, as they always require
 the set under consideration to be non-empty and bounded from below.\<close>
 
 lemma bdd_below [simp]:
   "bdd_below {(\<Sum> i = 0..<n. f (u i) (u (Suc i)))| u (n::nat). u 0 = x \<and> u n = y}"
   apply (rule bdd_belowI[of _ 0]) using nonneg by (auto simp add: sum_nonneg)
 
 lemma nonempty:
   "{\<Sum>i = 0..<n. f (u i) (u (Suc i)) |u n. u 0 = x \<and> u n = y} \<noteq> {}"
 proof -
   define u::"nat \<Rightarrow> 'a" where "u = (\<lambda>n. if n = 0 then x else y)"
   define n::nat where "n = 1"
   have "u 0 = x \<and> u n = y" unfolding u_def n_def by auto
   then have "(\<Sum>i = 0..<n. f (u i) (u (Suc i))) \<in> {\<Sum>i = 0..<n. f (u i) (u (Suc i)) |u n. u 0 = x \<and> u n = y}"
     by auto
   then show ?thesis by auto
 qed
 
 text \<open>We can now prove that \verb+turn_into_distance f+ satisfies all the properties of a distance.
 First, it is nonnegative.\<close>
 
 lemma TID_nonneg:
   "turn_into_distance f x y \<ge> 0"
 unfolding turn_into_distance_def apply (rule cInf_greatest[OF nonempty])
 using nonneg by (auto simp add: sum_nonneg)
 
 text \<open>For the symmetry, we use the symmetry of $f$, and go backwards along a chain of points,
 replacing a sequence from $x$ to $y$ with a sequence from $y$ to $x$.\<close>
 
 lemma TID_sym:
   "turn_into_distance f x y = turn_into_distance f y x"
 proof -
   have "turn_into_distance f x y \<le> Inf {(\<Sum> i \<in> {0..<n}. f (u i) (u (Suc i)))| u (n::nat). u 0 = y \<and> u n = x}" for x y
   proof (rule cInf_greatest[OF nonempty], auto)
     fix u::"nat \<Rightarrow> 'a" and n assume U: "y = u 0" "x = u n"
     define v::"nat \<Rightarrow>'a" where "v = (\<lambda>i. u (n-i))"
     have V: "v 0 = x" "v n = y" unfolding v_def using U by auto
 
     have "(\<Sum>i = 0..<n. f (u i) (u (Suc i))) = (\<Sum>i = 0..<n. (\<lambda>i. f (u i) (u (Suc i))) (n-1-i))"
       apply (rule sum.reindex_bij_betw[symmetric])
       by (rule bij_betw_byWitness[of _ "\<lambda>i. n-1-i"], auto)
     also have "... = (\<Sum> i = 0..<n. f (v (Suc i)) (v i))"
       apply (rule sum.cong) unfolding v_def by (auto simp add: Suc_diff_Suc)
     also have "... = (\<Sum> i = 0..<n. f (v i) (v (Suc i)))"
       using sym by auto
     finally have "(\<Sum>i = 0..<n. f (u i) (u (Suc i))) = (\<Sum> i = 0..<n. f (v i) (v (Suc i)))"
       by simp
 
     moreover have "turn_into_distance f x y \<le> (\<Sum> i = 0..<n. f (v i) (v (Suc i)))"
       unfolding turn_into_distance_def apply (rule cInf_lower)
       using V by auto
     finally show "turn_into_distance f (u n) (u 0) \<le> (\<Sum>i = 0..<n. f (u i) (u (Suc i)))"
       using U by auto
   qed
   then have *: "turn_into_distance f x y \<le> turn_into_distance f y x" for x y
     unfolding turn_into_distance_def by auto
   show ?thesis using *[of x y] *[of y x] by simp
 qed
 
 text \<open>There is a trivial upper bound by $f$, using the single chain $x, y$.\<close>
 
 lemma upper:
   "turn_into_distance f x y \<le> f x y"
 unfolding turn_into_distance_def proof (rule cInf_lower, auto)
   define u::"nat \<Rightarrow> 'a" where "u = (\<lambda>n. if n = 0 then x else y)"
   define n::nat where "n = 1"
   have "u 0 = x \<and> u n = y \<and> f x y = (\<Sum>i = 0..<n. f (u i) (u (Suc i)))" unfolding u_def n_def by auto
   then show "\<exists>u n. f x y = (\<Sum>i = 0..<n. f (u i) (u (Suc i))) \<and> u 0 = x \<and> u n = y"
     by auto
 qed
 
 text \<open>The new distance vanishes on a pair of equal points, as this is already the case for $f$.\<close>
 
 lemma TID_self_zero:
   "turn_into_distance f x x = 0"
 using upper[of x x] TID_nonneg[of x x] self_zero[of x] by auto
 
 text \<open>For the triangular inequality, we concatenate a sequence from $x$ to $y$ almost realizing the
 infimum, and a sequence from $y$ to $z$ almost realizing the infimum, to obtain a sequence from
 $x$ to $z$ along which the sums of $f$ is almost bounded by
 \verb|turn_into_distance f x y + turn_into_distance f y z|.
 \<close>
 
 lemma triangle:
   "turn_into_distance f x z \<le> turn_into_distance f x y + turn_into_distance f y z"
 proof -
   have "turn_into_distance f x z \<le> turn_into_distance f x y + turn_into_distance f y z + e" if "e > 0" for e
   proof -
     have "Inf {(\<Sum> i \<in> {0..<n}. f (u i) (u (Suc i)))| u (n::nat). u 0 = x \<and> u n = y} < turn_into_distance f x y + e/2"
       unfolding turn_into_distance_def using \<open>e > 0\<close> by auto
     then have "\<exists>a \<in> {(\<Sum> i \<in> {0..<n}. f (u i) (u (Suc i)))| u (n::nat). u 0 = x \<and> u n = y}. a < turn_into_distance f x y + e/2"
       by (rule cInf_lessD[OF nonempty])
     then obtain u n where U: "u 0 = x" "u n = y" "(\<Sum> i \<in> {0..<n}. f (u i) (u (Suc i))) < turn_into_distance f x y + e/2"
       by auto
 
     have "Inf {(\<Sum> i \<in> {0..<m}. f (v i) (v (Suc i)))| v (m::nat). v 0 = y \<and> v m = z} < turn_into_distance f y z + e/2"
       unfolding turn_into_distance_def using \<open>e > 0\<close> by auto
     then have "\<exists>a \<in> {(\<Sum> i \<in> {0..<m}. f (v i) (v (Suc i)))| v (m::nat). v 0 = y \<and> v m = z}. a < turn_into_distance f y z + e/2"
       by (rule cInf_lessD[OF nonempty])
     then obtain v m where V: "v 0 = y" "v m = z" "(\<Sum> i \<in> {0..<m}. f (v i) (v (Suc i))) < turn_into_distance f y z + e/2"
       by auto
 
     define w where "w = (\<lambda>i. if i < n then u i else v (i-n))"
     have *: "w 0 = x" "w (n+m) = z"
       unfolding w_def using U V by auto
     have "turn_into_distance f x z \<le> (\<Sum>i = 0..<n+m. f (w i) (w (Suc i)))"
       unfolding turn_into_distance_def apply (rule cInf_lower) using * by auto
     also have "... = (\<Sum>i = 0..<n. f (w i) (w (Suc i))) + (\<Sum>i = n..<n+m. f (w i) (w (Suc i)))"
       by (simp add: sum.atLeastLessThan_concat)
     also have "... = (\<Sum>i = 0..<n. f (w i) (w (Suc i))) + (\<Sum>i = 0..<m. f (w (i+n)) (w (Suc (i+n))))"
       by (auto intro!: sum.reindex_bij_betw[symmetric] bij_betw_byWitness[of _ "\<lambda>i. i-n"])
     also have "... = (\<Sum>i = 0..<n. f (u i) (u (Suc i))) + (\<Sum>i = 0..<m. f (v i) (v (Suc i)))"
       unfolding w_def apply (auto intro!: sum.cong)
       using U(2) V(1) Suc_lessI by fastforce
     also have "... < turn_into_distance f x y + e/2 + turn_into_distance f y z + e/2"
       using U(3) V(3) by auto
     finally show ?thesis by auto
   qed
   then show ?thesis
     using field_le_epsilon by blast
 qed
 
 text \<open>Now comes the only nontrivial statement of the construction, the fact that the new
 distance is bounded from below by $f/2$.
 
 Here is the mathematical proof. We show by induction that all chains from $x$ to
 $y$ satisfy this bound. Assume this is done for all chains of length $ < n$, we do it for a
 chain of length $n$. Write $S = \sum f(u_i, u_{i+1})$ for the sum along the chain. Introduce $p$
 the last index where the sum is $\leq S/2$. Then the sum from $0$ to $p$ is $\leq S/2$, and the sum
 from $p+1$ to $n$ is also $\leq S/2$ (by maximality of $p$). The induction assumption
 gives that $f (x, u_p)$ is bounded by twice the sum from $0$ to $p$, which is at most $S$. Same
 thing for $f(u_{p+1}, y)$. With the weird triangle inequality applied two times, we get
 $f (x, y) \leq 2 \max(f(x,u_p), f(u_p, u_{p+1}), f(u_{p+1}, y)) \leq 2S$, as claimed.
 
 The formalization presents no difficulty.
 \<close>
 
 lemma lower:
   "f x y \<le> 2 * turn_into_distance f x y"
 proof -
   have I: "f (u 0) (u n) \<le> (\<Sum> i \<in> {0..<n}. f (u i) (u (Suc i))) * 2" for n u
   proof (induction n arbitrary: u rule: less_induct)
     case (less n)
     show "f (u 0) (u n) \<le> (\<Sum>i = 0..<n. f (u i) (u (Suc i))) * 2"
     proof (cases "n = 0")
       case True
       then have "f (u 0) (u n) = 0" using self_zero by auto
       then show ?thesis using True by auto
     next
       case False
       then have "n > 0" by auto
       define S where "S = (\<Sum>i = 0..<n. f (u i) (u (Suc i)))"
       have "S \<ge> 0" unfolding S_def using nonneg by (auto simp add: sum_nonneg)
       have "\<exists>p. p < n \<and> (\<Sum>i = 0..<p. f (u i) (u (Suc i))) \<le> S/2 \<and> (\<Sum>i = Suc p..<n. f (u i) (u (Suc i))) \<le> S/2"
       proof (cases "S = 0")
         case True
         have "(\<Sum>i = Suc 0..<n. f (u i) (u (Suc i))) = (\<Sum>i = 0..<n. f (u i) (u (Suc i))) - f(u 0) (u (Suc 0))"
           using sum.atLeast_Suc_lessThan[OF \<open>n > 0\<close>, of "\<lambda>i. f (u i) (u (Suc i))"] by simp
         also have "... \<le> S/2" using True S_def nonneg by auto
         finally have "0 < n \<and> (\<Sum>i = 0..<0. f (u i) (u (Suc i))) \<le> S/2 \<and> (\<Sum>i = Suc 0..<n. f (u i) (u (Suc i))) \<le> S/2"
           using \<open>n > 0\<close> \<open>S = 0\<close> by auto
         then show ?thesis by auto
       next
         case False
         then have "S > 0" using \<open>S \<ge> 0\<close> by simp
         define A where "A = {q. q \<le> n \<and> (\<Sum>i = 0..<q. f (u i) (u (Suc i))) \<le> S/2}"
         have "0 \<in> A" unfolding A_def using \<open>S > 0\<close> \<open>n > 0\<close> by auto
         have "n \<notin> A" unfolding A_def using \<open>S > 0\<close> unfolding S_def by auto
         define p where "p = Max A"
         have "p \<in> A" unfolding p_def apply (rule Max_in) using \<open>0 \<in> A\<close> unfolding A_def by auto
         then have L: "p \<le> n" "(\<Sum>i = 0..<p. f (u i) (u (Suc i))) \<le> S/2" unfolding A_def by auto
         then have "p < n" using \<open>n \<notin> A\<close> \<open>p \<in> A\<close> le_neq_trans by blast
         have "Suc p \<notin> A" unfolding p_def
           by (metis (no_types, lifting) A_def Max_ge Suc_n_not_le_n infinite_nat_iff_unbounded mem_Collect_eq not_le p_def)
         then have *: "(\<Sum>i = 0..<Suc p. f (u i) (u (Suc i))) > S/2"
           unfolding A_def using \<open>p < n\<close> by auto
         have "(\<Sum> i = Suc p..<n. f (u i) (u (Suc i))) = S - (\<Sum>i = 0..<Suc p. f (u i) (u (Suc i)))"
           unfolding S_def using \<open>p < n\<close> by (metis (full_types) Suc_le_eq sum_diff_nat_ivl zero_le)
         also have "... \<le> S/2" using * by auto
         finally have "p < n \<and> (\<Sum>i = 0..<p. f (u i) (u (Suc i))) \<le> S/2 \<and> (\<Sum>i = Suc p..<n. f (u i) (u (Suc i))) \<le> S/2"
           using \<open>p < n\<close> L(2) by auto
         then show ?thesis by auto
       qed
       then obtain p where P: "p < n" "(\<Sum>i = 0..<p. f (u i) (u (Suc i))) \<le> S/2" "(\<Sum>i = Suc p..<n. f (u i) (u (Suc i))) \<le> S/2"
         by auto
       have "f (u 0) (u p) \<le> (\<Sum>i = 0..<p. f (u i) (u (Suc i))) * 2"
         apply (rule less.IH) using \<open>p < n\<close> by auto
       then have A: "f (u 0) (u p) \<le> S" using P(2) by auto
       have B: "f (u p) (u (Suc p)) \<le> S"
         apply (rule sum_nonneg_leq_bound[of "{0..<n}" "\<lambda>i. f (u i) (u (Suc i))"])
         using nonneg S_def \<open>p < n\<close> by auto
       have "f (u (0 + Suc p)) (u ((n-Suc p) + Suc p)) \<le> (\<Sum>i = 0..<n-Suc p. f (u (i + Suc p)) (u (Suc i + Suc p))) * 2"
         apply (rule less.IH) using \<open>n > 0\<close> by auto
       also have "... = 2 * (\<Sum>i = Suc p..<n. f (u i) (u (Suc i)))"
         by (auto intro!: sum.reindex_bij_betw bij_betw_byWitness[of _ "\<lambda>i. i - Suc p"])
       also have "... \<le> S" using P(3) by simp
       finally have C: "f (u (Suc p)) (u n) \<le> S"
         using \<open>p < n\<close> by auto
 
       have "f (u 0) (u n) \<le> sqrt 2 * max (f (u 0) (u p)) (f (u p) (u n))"
         using weak_triangle by simp
       also have "... \<le> sqrt 2* max (f (u 0) (u p)) (sqrt 2 * max (f (u p) (u (Suc p))) (f (u (Suc p)) (u n)))"
         using weak_triangle by simp (meson max.cobounded2 order_trans)
       also have "... \<le> sqrt 2 * max S (sqrt 2 * max S S)"
         using A B C by auto (simp add: le_max_iff_disj)
       also have "... \<le> sqrt 2 * max (sqrt 2 * S) (sqrt 2 * max S S)"
         apply (intro mult_left_mono max.mono) using \<open>S \<ge> 0\<close> less_eq_real_def by auto
       also have "... = 2 * S"
         by auto
       finally show ?thesis
         unfolding S_def by simp
     qed
   qed
   have "f x y/2 \<le> turn_into_distance f x y"
     unfolding turn_into_distance_def by (rule cInf_greatest[OF nonempty], auto simp add: I)
   then show ?thesis by simp
 qed
 
 end (*of locale Turn_into_distance*)
 
 
 section \<open>The Gromov completion of a hyperbolic space\<close>
 
 subsection \<open>The Gromov boundary as a set\<close>
 
 text \<open>A sequence in a Gromov hyperbolic space converges to a point in the boundary if
 the Gromov product $(u_n, u_m)_e$ tends to infinity when $m,n \to _infty$. The point at infinity
 is defined as the equivalence class of such sequences, for the relation $u \sim v$ iff
 $(u_n, v_n)_e \to \infty$ (or, equivalently, $(u_n, v_m)_e \to \infty$ when $m, n\to \infty$, or
 one could also change basepoints). Hence, the Gromov boundary is naturally defined as a quotient
 type. There is a difficulty: it can be empty in general, hence defining it as a type is not always
 possible. One could introduce a new typeclass of Gromov hyperbolic spaces for which the boundary
 is not empty (unboundedness is not enough, think of infinitely many segments $[0,n]$ all joined at
 $0$), and then only define the boundary of such spaces. However, this is tedious. Rather, we
 work with the Gromov completion (containing the space and its boundary), this is always not empty.
 The price to pay is that, in the definition of the completion, we have to distinguish between
 sequences converging to the boundary and sequences converging inside the space. This is more natural
 to proceed in this way as the interesting features of the boundary come from the fact that its sits
 at infinity of the initial space, so their relations (and the topology of $X \cup \partial X$) are
 central.\<close>
 
 definition Gromov_converging_at_boundary::"(nat \<Rightarrow> ('a::Gromov_hyperbolic_space)) \<Rightarrow> bool"
   where "Gromov_converging_at_boundary u = (\<forall>a. \<forall>(M::real). \<exists>N. \<forall>n \<ge> N. \<forall> m \<ge> N. Gromov_product_at a (u m) (u n) \<ge> M)"
 
 lemma Gromov_converging_at_boundaryI:
   assumes "\<And>M. \<exists>N. \<forall>n \<ge> N. \<forall>m \<ge> N. Gromov_product_at a (u m) (u n) \<ge> M"
   shows "Gromov_converging_at_boundary u"
 unfolding Gromov_converging_at_boundary_def proof (auto)
   fix b::'a and M::real
   obtain N where *: "\<And>m n. n \<ge> N \<Longrightarrow> m \<ge> N \<Longrightarrow> Gromov_product_at a (u m) (u n) \<ge> M + dist a b"
     using assms[of "M + dist a b"] by auto
   have "Gromov_product_at b (u m) (u n) \<ge> M" if "m \<ge> N" "n \<ge> N" for m n
     using *[OF that] Gromov_product_at_diff1[of a "u m" "u n" b] by (smt Gromov_product_commute)
   then show "\<exists>N. \<forall>n \<ge> N. \<forall>m \<ge> N. M \<le> Gromov_product_at b (u m) (u n)" by auto
 qed
 
 lemma Gromov_converging_at_boundary_imp_unbounded:
   assumes "Gromov_converging_at_boundary u"
   shows "(\<lambda>n. dist a (u n)) \<longlonglongrightarrow> \<infinity>"
 proof -
   have "\<exists>N. \<forall>n \<ge> N. dist a (u n) \<ge> M" for M::real
     using assms unfolding Gromov_converging_at_boundary_def Gromov_product_e_x_x[symmetric] by meson
   then show ?thesis
     unfolding tendsto_PInfty eventually_sequentially by (meson dual_order.strict_trans1 gt_ex less_ereal.simps(1))
 qed
 
 lemma Gromov_converging_at_boundary_imp_not_constant:
   "\<not>(Gromov_converging_at_boundary (\<lambda>n. x))"
   using Gromov_converging_at_boundary_imp_unbounded[of "(\<lambda>n. x)" "x"] Lim_bounded_PInfty by auto
 
 lemma Gromov_converging_at_boundary_imp_not_constant':
   assumes "Gromov_converging_at_boundary u"
   shows "\<not>(\<forall>m n. u m = u n)"
   using Gromov_converging_at_boundary_imp_not_constant
   by (metis (no_types) Gromov_converging_at_boundary_def assms order_refl)
 
 text \<open>We introduce a partial equivalence relation, defined over the sequences that converge to
 infinity, and the constant sequences. Quotienting the space of admissible sequences by this
 equivalence relation will give rise to the Gromov completion.\<close>
 
 definition Gromov_completion_rel::"(nat \<Rightarrow> 'a::Gromov_hyperbolic_space) \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> bool"
   where "Gromov_completion_rel u v =
             (((Gromov_converging_at_boundary u \<and> Gromov_converging_at_boundary v \<and> (\<forall>a. (\<lambda>n. Gromov_product_at a (u n) (v n)) \<longlonglongrightarrow> \<infinity>)))
             \<or> (\<forall>n m. u n = v m \<and> u n = u m \<and> v n = v m))"
 
 text \<open>We need some basic lemmas to work separately with sequences tending to the boundary
 and with constant sequences, as follows.\<close>
 
 lemma Gromov_completion_rel_const [simp]:
   "Gromov_completion_rel (\<lambda>n. x) (\<lambda>n. x)"
 unfolding Gromov_completion_rel_def by auto
 
 lemma Gromov_completion_rel_to_const:
   assumes "Gromov_completion_rel u (\<lambda>n. x)"
   shows "u n = x"
 using assms unfolding Gromov_completion_rel_def using Gromov_converging_at_boundary_imp_not_constant[of x] by auto
 
 lemma Gromov_completion_rel_to_const':
   assumes "Gromov_completion_rel (\<lambda>n. x) u"
   shows "u n = x"
 using assms unfolding Gromov_completion_rel_def using Gromov_converging_at_boundary_imp_not_constant[of x] by auto
 
 lemma Gromov_product_tendsto_PInf_a_b:
   assumes "(\<lambda>n. Gromov_product_at a (u n) (v n)) \<longlonglongrightarrow> \<infinity>"
   shows "(\<lambda>n. Gromov_product_at b (u n) (v n)) \<longlonglongrightarrow> \<infinity>"
 proof (rule tendsto_sandwich[of "\<lambda>n. ereal(Gromov_product_at a (u n) (v n)) + (- dist a b)" _ _ "\<lambda>n. \<infinity>"])
   have "ereal(Gromov_product_at b (u n) (v n)) \<ge> ereal(Gromov_product_at a (u n) (v n)) + (- dist a b)" for n
     using Gromov_product_at_diff1[of a "u n" "v n" b] by auto
   then show "\<forall>\<^sub>F n in sequentially. ereal (Gromov_product_at a (u n) (v n)) + ereal (- dist a b) \<le> ereal (Gromov_product_at b (u n) (v n))"
     by auto
   have "(\<lambda>n. ereal(Gromov_product_at a (u n) (v n)) + (- dist a b)) \<longlonglongrightarrow> \<infinity> + (- dist a b)"
     apply (intro tendsto_intros) using assms by auto
   then show "(\<lambda>n. ereal (Gromov_product_at a (u n) (v n)) + ereal (- dist a b)) \<longlonglongrightarrow> \<infinity>" by simp
 qed (auto)
 
 lemma Gromov_converging_at_boundary_rel:
   assumes "Gromov_converging_at_boundary u"
   shows "Gromov_completion_rel u u"
 unfolding Gromov_completion_rel_def using Gromov_converging_at_boundary_imp_unbounded[OF assms] assms by auto
 
 text \<open>We can now prove that we indeed have an equivalence relation.\<close>
 
 lemma part_equivp_Gromov_completion_rel:
   "part_equivp Gromov_completion_rel"
 proof (rule part_equivpI)
   show "\<exists>x::(nat \<Rightarrow> 'a). Gromov_completion_rel x x"
     apply (rule exI[of _ "\<lambda>n. (SOME a::'a. True)"]) unfolding Gromov_completion_rel_def by (auto simp add: convergent_const)
 
   show "symp Gromov_completion_rel"
     unfolding symp_def Gromov_completion_rel_def by (auto simp add: Gromov_product_commute) metis+
 
   show "transp (Gromov_completion_rel::(nat \<Rightarrow> 'a) \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> bool)"
   unfolding transp_def proof (intro allI impI)
     fix u v w::"nat\<Rightarrow>'a"
     assume UV: "Gromov_completion_rel u v"
        and VW: "Gromov_completion_rel v w"
     show "Gromov_completion_rel u w"
     proof (cases "\<forall>n m. v n = v m")
       case True
       define a where "a = v 0"
       have *: "v = (\<lambda>n. a)" unfolding a_def using True by auto
       then have "u n = v 0" "w n = v 0" for n
         using Gromov_completion_rel_to_const' Gromov_completion_rel_to_const UV VW unfolding * by auto force
       then show ?thesis
         using UV VW unfolding Gromov_completion_rel_def by auto
     next
       case False
       have "(\<lambda>n. Gromov_product_at a (u n) (w n)) \<longlonglongrightarrow> \<infinity>" for a
       proof (rule tendsto_sandwich[of "\<lambda>n. min (ereal (Gromov_product_at a (u n) (v n))) (ereal (Gromov_product_at a (v n) (w n))) + (- deltaG(TYPE('a)))" _ _ "\<lambda>n. \<infinity>"])
         have "min (Gromov_product_at a (u n) (v n)) (Gromov_product_at a (v n) (w n)) - deltaG(TYPE('a)) \<le> Gromov_product_at a (u n) (w n)" for n
           by (rule hyperb_ineq)
         then have "min (ereal (Gromov_product_at a (u n) (v n))) (ereal (Gromov_product_at a (v n) (w n))) + ereal (- deltaG TYPE('a)) \<le> ereal (Gromov_product_at a (u n) (w n))" for n
           by (auto simp del: ereal_min simp add: ereal_min[symmetric])
         then show "\<forall>\<^sub>F n in sequentially. min (ereal (Gromov_product_at a (u n) (v n))) (ereal (Gromov_product_at a (v n) (w n)))
                     + ereal (- deltaG TYPE('a)) \<le> ereal (Gromov_product_at a (u n) (w n))"
           unfolding eventually_sequentially by auto
 
         have "(\<lambda>n. min (ereal (Gromov_product_at a (u n) (v n))) (ereal (Gromov_product_at a (v n) (w n))) + (- deltaG(TYPE('a)))) \<longlonglongrightarrow> min \<infinity> \<infinity> + (- deltaG(TYPE('a)))"
           apply (intro tendsto_intros) using UV VW False unfolding Gromov_completion_rel_def by auto
         then show "(\<lambda>n. min (ereal (Gromov_product_at a (u n) (v n))) (ereal (Gromov_product_at a (v n) (w n))) + (- deltaG(TYPE('a)))) \<longlonglongrightarrow> \<infinity>" by auto
       qed (auto)
       then show ?thesis
         using False UV VW unfolding Gromov_completion_rel_def by auto
     qed
   qed
 qed
 
 text \<open>We can now define the Gromov completion of a Gromov hyperbolic space, considering either
 sequences converging to a point on the boundary, or sequences converging inside the space, and
 quotienting by the natural equivalence relation.\<close>
 
 quotient_type (overloaded) 'a Gromov_completion =
   "nat \<Rightarrow> ('a::Gromov_hyperbolic_space)"
   / partial: "Gromov_completion_rel"
 by (rule part_equivp_Gromov_completion_rel)
 
 text \<open>The Gromov completion contains is made of a copy of the original space, and new points
 forming the Gromov boundary.\<close>
 
 definition to_Gromov_completion::"('a::Gromov_hyperbolic_space) \<Rightarrow> 'a Gromov_completion"
   where "to_Gromov_completion x = abs_Gromov_completion (\<lambda>n. x)"
 
 definition from_Gromov_completion::"('a::Gromov_hyperbolic_space) Gromov_completion \<Rightarrow> 'a"
   where "from_Gromov_completion = inv to_Gromov_completion"
 
 definition Gromov_boundary::"('a::Gromov_hyperbolic_space) Gromov_completion set"
   where "Gromov_boundary = UNIV - range to_Gromov_completion"
 
 lemma to_Gromov_completion_inj:
   "inj to_Gromov_completion"
 proof (rule injI)
   fix x y::'a assume H: "to_Gromov_completion x = to_Gromov_completion y"
   have "Gromov_completion_rel (\<lambda>n. x) (\<lambda>n. y)"
     apply (subst Quotient3_rel[OF Quotient3_Gromov_completion, symmetric])
     using H unfolding to_Gromov_completion_def by auto
   then show "x = y"
     using Gromov_completion_rel_to_const by auto
 qed
 
 lemma from_to_Gromov_completion [simp]:
   "from_Gromov_completion (to_Gromov_completion x) = x"
 unfolding from_Gromov_completion_def by (simp add: to_Gromov_completion_inj)
 
 lemma to_from_Gromov_completion:
   assumes "x \<notin> Gromov_boundary"
   shows "to_Gromov_completion (from_Gromov_completion x) = x"
 using assms to_Gromov_completion_inj unfolding Gromov_boundary_def from_Gromov_completion_def
 by (simp add: f_inv_into_f)
 
 lemma not_in_Gromov_boundary:
   assumes "x \<notin> Gromov_boundary"
   shows "\<exists>a. x = to_Gromov_completion a"
 using assms unfolding Gromov_boundary_def by auto
 
 lemma not_in_Gromov_boundary' [simp]:
   "to_Gromov_completion x \<notin> Gromov_boundary"
 unfolding Gromov_boundary_def by auto
 
 lemma abs_Gromov_completion_in_Gromov_boundary [simp]:
   assumes "Gromov_converging_at_boundary u"
   shows "abs_Gromov_completion u \<in> Gromov_boundary"
 using Gromov_completion_rel_to_const Gromov_converging_at_boundary_imp_not_constant'
   Gromov_converging_at_boundary_rel[OF assms]
   Quotient3_rel[OF Quotient3_Gromov_completion] assms not_in_Gromov_boundary to_Gromov_completion_def
   by fastforce
 
 lemma rep_Gromov_completion_to_Gromov_completion [simp]:
   "rep_Gromov_completion (to_Gromov_completion y) = (\<lambda>n. y)"
 proof -
   have "Gromov_completion_rel (\<lambda>n. y) (rep_Gromov_completion (abs_Gromov_completion (\<lambda>n. y)))"
     by (metis Gromov_completion_rel_const Quotient3_Gromov_completion rep_abs_rsp)
   then show ?thesis
     unfolding to_Gromov_completion_def using Gromov_completion_rel_to_const' by blast
 qed
 
 text \<open>To distinguish the case of points inside the space or in the boundary, we introduce the
 following case distinction.\<close>
 
 lemma Gromov_completion_cases [case_names to_Gromov_completion boundary, cases type: Gromov_completion]:
   "(\<And>x. z = to_Gromov_completion x \<Longrightarrow> P) \<Longrightarrow> (z \<in> Gromov_boundary \<Longrightarrow> P) \<Longrightarrow> P"
 apply (cases "z \<in> Gromov_boundary") using not_in_Gromov_boundary by auto
 
 
 subsection \<open>Extending the original distance and the original Gromov product to the completion\<close>
 
 text \<open>In this subsection, we extend the Gromov product to the boundary, by taking limits along
 sequences tending to the point in the boundary. This does not converge, but it does up to $\delta$,
 so for definiteness we use a $\liminf$ over all sequences tending to the boundary point -- one
 interest of this definition is that the extended Gromov product still satisfies the hyperbolicity
 inequality. One difficulty is that this extended Gromov product can take infinite values (it does
 so exactly on the pair $(x,x)$ where $x$ is in the boundary), so we should define this product
 in extended nonnegative reals.
 
 We also extend the original distance, by $+\infty$ on the boundary. This is not a really interesting
 function, but it will be instrumental below. Again, this extended Gromov distance (not to be mistaken
 for the genuine distance we will construct later on on the completion) takes values in extended
 nonnegative reals.
 
 Since the extended Gromov product and the extension of the original distance both take values in
 $[0,+\infty]$, it may seem natural to define them in ennreal. This is the choice that was made in
 a previous implementation, but it turns out that one keeps computing with these numbers, writing
 down inequalities and subtractions. ennreal is ill suited for this kind of computations, as it only
 works well with additions. Hence, the implementation was switched to ereal, where proofs are indeed
 much smoother.
 
 To define the extended Gromov product, one takes a limit of the Gromov product along any
 sequence, as it does not depend up to $\delta$ on the chosen sequence. However, if one wants to
 keep the exact inequality that defines hyperbolicity, but at all points, then using an infimum
 is the best choice.\<close>
 
 definition extended_Gromov_product_at::"('a::Gromov_hyperbolic_space) \<Rightarrow> 'a Gromov_completion \<Rightarrow> 'a Gromov_completion \<Rightarrow> ereal"
   where "extended_Gromov_product_at e x y = Inf {liminf (\<lambda>n. ereal(Gromov_product_at e (u n) (v n))) |u v. abs_Gromov_completion u = x \<and> abs_Gromov_completion v = y \<and> Gromov_completion_rel u u \<and> Gromov_completion_rel v v}"
 
 definition extended_Gromov_distance::"('a::Gromov_hyperbolic_space) Gromov_completion \<Rightarrow> 'a Gromov_completion \<Rightarrow> ereal"
   where "extended_Gromov_distance x y =
               (if x \<in> Gromov_boundary \<or> y \<in> Gromov_boundary then \<infinity>
               else ereal (dist (inv to_Gromov_completion x) (inv to_Gromov_completion y)))"
 
 text \<open>The extended distance and the extended Gromov product are invariant under exchange
 of the points, readily from the definition.\<close>
 
 lemma extended_Gromov_distance_commute:
   "extended_Gromov_distance x y = extended_Gromov_distance y x"
 unfolding extended_Gromov_distance_def by (simp add: dist_commute)
 
 lemma extended_Gromov_product_nonneg [mono_intros, simp]:
   "0 \<le> extended_Gromov_product_at e x y"
 unfolding extended_Gromov_product_at_def by (rule Inf_greatest, auto intro: Liminf_bounded always_eventually)
 
 lemma extended_Gromov_distance_nonneg [mono_intros, simp]:
   "0 \<le> extended_Gromov_distance x y"
 unfolding extended_Gromov_distance_def by auto
 
 lemma extended_Gromov_product_at_commute:
   "extended_Gromov_product_at e x y = extended_Gromov_product_at e y x"
 unfolding extended_Gromov_product_at_def
 proof (rule arg_cong[of _ _ Inf])
   have "{liminf (\<lambda>n. ereal (Gromov_product_at e (u n) (v n))) |u v.
           abs_Gromov_completion u = x \<and> abs_Gromov_completion v = y \<and> Gromov_completion_rel u u \<and> Gromov_completion_rel v v} =
         {liminf (\<lambda>n. ereal (Gromov_product_at e (v n) (u n))) |u v.
           abs_Gromov_completion v = y \<and> abs_Gromov_completion u = x \<and> Gromov_completion_rel v v \<and> Gromov_completion_rel u u}"
     by (auto simp add: Gromov_product_commute)
   then show "{liminf (\<lambda>n. ereal (Gromov_product_at e (u n) (v n))) |u v.
       abs_Gromov_completion u = x \<and> abs_Gromov_completion v = y \<and> Gromov_completion_rel u u \<and> Gromov_completion_rel v v} =
       {liminf (\<lambda>n. ereal (Gromov_product_at e (u n) (v n))) |u v.
       abs_Gromov_completion u = y \<and> abs_Gromov_completion v = x \<and> Gromov_completion_rel u u \<and> Gromov_completion_rel v v}"
     by auto
 qed
 
 text \<open>Inside the space, the extended distance and the extended Gromov product coincide with the
 original ones.\<close>
 
 lemma extended_Gromov_distance_inside [simp]:
   "extended_Gromov_distance (to_Gromov_completion x) (to_Gromov_completion y) = dist x y"
 unfolding extended_Gromov_distance_def Gromov_boundary_def by (auto simp add: to_Gromov_completion_inj)
 
 lemma extended_Gromov_product_inside [simp] :
   "extended_Gromov_product_at e (to_Gromov_completion x) (to_Gromov_completion y) = Gromov_product_at e x y"
 proof -
   have A: "u = (\<lambda>n. z)" if H: "abs_Gromov_completion u = abs_Gromov_completion (\<lambda>n. z)" "Gromov_completion_rel u u" for u and z::'a
   proof -
     have "Gromov_completion_rel u (\<lambda>n. z)"
       apply (subst Quotient3_rel[OF Quotient3_Gromov_completion, symmetric])
       using H uniformity_dist_class_def by auto
     then show ?thesis using Gromov_completion_rel_to_const by auto
   qed
   then have *: "{u. abs_Gromov_completion u = to_Gromov_completion z \<and> Gromov_completion_rel u u} = {(\<lambda>n. z)}" for z::'a
     unfolding to_Gromov_completion_def by auto
   have **: "{F u v |u v. abs_Gromov_completion u = to_Gromov_completion x \<and> abs_Gromov_completion v = to_Gromov_completion y \<and> Gromov_completion_rel u u \<and> Gromov_completion_rel v v}
       = {F (\<lambda>n. x) (\<lambda>n. y)}" for F::"(nat \<Rightarrow> 'a) \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> ereal"
     using *[of x] *[of y] unfolding extended_Gromov_product_at_def by (auto, smt mem_Collect_eq singletonD)
 
   have "extended_Gromov_product_at e (to_Gromov_completion x) (to_Gromov_completion y) = Inf {liminf (\<lambda>n. ereal(Gromov_product_at e ((\<lambda>n. x) n) ((\<lambda>n. y) n)))}"
     unfolding extended_Gromov_product_at_def ** by simp
   also have "... = ereal(Gromov_product_at e x y)"
     by (auto simp add: Liminf_const)
   finally show "extended_Gromov_product_at e (to_Gromov_completion x) (to_Gromov_completion y) = Gromov_product_at e x y"
     by simp
 qed
 
 text \<open>A point in the boundary is at infinite extended distance of everyone, including itself:
 the extended distance is obtained by taking the supremum along all sequences tending to this point,
 so even for one single point one can take two sequences tending to it at different speeds, which
 results in an infinite extended distance.\<close>
 
 lemma extended_Gromov_distance_PInf_boundary [simp]:
   assumes "x \<in> Gromov_boundary"
   shows "extended_Gromov_distance x y = \<infinity>" "extended_Gromov_distance y x = \<infinity>"
 unfolding extended_Gromov_distance_def using assms by auto
 
 text \<open>By construction, the extended distance still satisfies the triangle inequality.\<close>
 
 lemma extended_Gromov_distance_triangle [mono_intros]:
   "extended_Gromov_distance x z \<le> extended_Gromov_distance x y + extended_Gromov_distance y z"
 proof (cases "x \<in> Gromov_boundary \<or> y \<in> Gromov_boundary \<or> z \<in> Gromov_boundary")
   case True
   then have *: "extended_Gromov_distance x y + extended_Gromov_distance y z = \<infinity>" by auto
   show ?thesis by (simp add: *)
 next
   case False
   then obtain a b c where abc: "x = to_Gromov_completion a" "y = to_Gromov_completion b" "z = to_Gromov_completion c"
     unfolding Gromov_boundary_def by auto
   show ?thesis
     unfolding abc using dist_triangle[of a c b] ennreal_leI by fastforce
 qed
 
 text \<open>The extended Gromov product can be bounded by the extended distance, just like inside
 the space.\<close>
 
 lemma extended_Gromov_product_le_dist [mono_intros]:
   "extended_Gromov_product_at e x y \<le> extended_Gromov_distance (to_Gromov_completion e) x"
 proof (cases x)
   case boundary
   then show ?thesis by simp
 next
   case (to_Gromov_completion a)
   define v where "v = rep_Gromov_completion y"
   have *: "abs_Gromov_completion (\<lambda>n. a) = x \<and> abs_Gromov_completion v = y \<and> Gromov_completion_rel (\<lambda>n. a) (\<lambda>n. a) \<and> Gromov_completion_rel v v"
     unfolding v_def to_Gromov_completion to_Gromov_completion_def
     by (auto simp add: Quotient3_rep_reflp[OF Quotient3_Gromov_completion] Quotient3_abs_rep[OF Quotient3_Gromov_completion])
   have "extended_Gromov_product_at e x y \<le> liminf (\<lambda>n. ereal(Gromov_product_at e a (v n)))"
     unfolding extended_Gromov_product_at_def apply (rule Inf_lower) using * by force
   also have "... \<le> liminf (\<lambda>n. ereal(dist e a))"
     using Gromov_product_le_dist(1)[of e a] by (auto intro!: Liminf_mono)
   also have "... = ereal(dist e a)"
     by (simp add: Liminf_const)
   also have "... = extended_Gromov_distance (to_Gromov_completion e) x"
     unfolding to_Gromov_completion by auto
   finally show ?thesis by auto
 qed
 
 lemma extended_Gromov_product_le_dist' [mono_intros]:
   "extended_Gromov_product_at e x y \<le> extended_Gromov_distance (to_Gromov_completion e) y"
 using extended_Gromov_product_le_dist[of e y x] by (simp add: extended_Gromov_product_at_commute)
 
 text \<open>The Gromov product inside the space varies by at most the distance when one varies one of
 the points. We will need the same statement for the extended Gromov product. The proof is done
 using this inequality inside the space, and passing to the limit.\<close>
 
 lemma extended_Gromov_product_at_diff3 [mono_intros]:
   "extended_Gromov_product_at e x y \<le> extended_Gromov_product_at e x z + extended_Gromov_distance y z"
 proof (cases "(extended_Gromov_distance y z = \<infinity>) \<or> (extended_Gromov_product_at e x z = \<infinity>)")
   case False
   then have "y \<notin> Gromov_boundary" "z \<notin> Gromov_boundary"
     using extended_Gromov_distance_PInf_boundary by auto
   then obtain b c where b: "y = to_Gromov_completion b" and c: "z = to_Gromov_completion c"
     unfolding Gromov_boundary_def by auto
   have "extended_Gromov_distance y z = ereal(dist b c)"
     unfolding b c by auto
   have "extended_Gromov_product_at e x y \<le> (extended_Gromov_product_at e x z + extended_Gromov_distance y z) + h" if "h>0" for h
   proof -
     have "\<exists>t\<in>{liminf (\<lambda>n. ereal(Gromov_product_at e (u n) (w n))) |u w. abs_Gromov_completion u = x
                   \<and> abs_Gromov_completion w = z \<and> Gromov_completion_rel u u \<and> Gromov_completion_rel w w}.
           t < extended_Gromov_product_at e x z + h"
       apply (subst Inf_less_iff[symmetric]) using False \<open>h > 0\<close> extended_Gromov_product_nonneg[of e x z] unfolding extended_Gromov_product_at_def[symmetric]
       by (metis add.right_neutral ereal_add_left_cancel_less order_refl)
     then obtain u w where H: "abs_Gromov_completion u = x" "abs_Gromov_completion w = z"
                           "Gromov_completion_rel u u" "Gromov_completion_rel w w"
                           "liminf (\<lambda>n. ereal(Gromov_product_at e (u n) (w n))) < extended_Gromov_product_at e x z + h"
       by auto
     then have w: "w n = c" for n
       using c Gromov_completion_rel_to_const Quotient3_Gromov_completion Quotient3_rel to_Gromov_completion_def by fastforce
     define v where v: "v = (\<lambda>n::nat. b)"
     have "abs_Gromov_completion v = y" "Gromov_completion_rel v v"
       unfolding v by (auto simp add: b to_Gromov_completion_def)
 
     have "Gromov_product_at e (u n) (v n) \<le> Gromov_product_at e (u n) (w n) + dist b c" for n
       unfolding v w using Gromov_product_at_diff3[of e "u n" b c] by auto
     then have *: "ereal(Gromov_product_at e (u n) (v n)) \<le> ereal(Gromov_product_at e (u n) (w n)) + extended_Gromov_distance y z" for n
       unfolding \<open>extended_Gromov_distance y z = ereal(dist b c)\<close> by fastforce
     have "extended_Gromov_product_at e x y \<le> liminf(\<lambda>n. ereal(Gromov_product_at e (u n) (v n)))"
       unfolding extended_Gromov_product_at_def by (rule Inf_lower, auto, rule exI[of _ u], rule exI[of _ v], auto, fact+)
     also have "... \<le> liminf(\<lambda>n. ereal(Gromov_product_at e (u n) (w n)) + extended_Gromov_distance y z)"
       apply (rule Liminf_mono) using * unfolding eventually_sequentially by auto
     also have "... = liminf(\<lambda>n. ereal(Gromov_product_at e (u n) (w n))) + extended_Gromov_distance y z"
       apply (rule Liminf_add_ereal_right) using False by auto
     also have "... \<le> extended_Gromov_product_at e x z + h + extended_Gromov_distance y z"
       using less_imp_le[OF H(5)] by (auto intro: mono_intros)
     finally show ?thesis
       by (simp add: algebra_simps)
   qed
   then show ?thesis
     using ereal_le_epsilon by blast
 next
   case True
   then show ?thesis by auto
 qed
 
 lemma extended_Gromov_product_at_diff2 [mono_intros]:
   "extended_Gromov_product_at e x y \<le> extended_Gromov_product_at e z y + extended_Gromov_distance x z"
 using extended_Gromov_product_at_diff3[of e y x z] by (simp add: extended_Gromov_product_at_commute)
 
 lemma extended_Gromov_product_at_diff1 [mono_intros]:
   "extended_Gromov_product_at e x y \<le> extended_Gromov_product_at f x y + dist e f"
 proof (cases "extended_Gromov_product_at f x y = \<infinity>")
   case False
   have "extended_Gromov_product_at e x y \<le> (extended_Gromov_product_at f x y + dist e f) + h" if "h > 0" for h
   proof -
     have "\<exists>t\<in>{liminf (\<lambda>n. ereal(Gromov_product_at f (u n) (v n))) |u v. abs_Gromov_completion u = x
                 \<and> abs_Gromov_completion v = y \<and> Gromov_completion_rel u u \<and> Gromov_completion_rel v v}.
           t < extended_Gromov_product_at f x y + h"
       apply (subst Inf_less_iff[symmetric]) using False \<open>h > 0\<close> extended_Gromov_product_nonneg[of f x y] unfolding extended_Gromov_product_at_def[symmetric]
       by (metis add.right_neutral ereal_add_left_cancel_less order_refl)
     then obtain u v where H: "abs_Gromov_completion u = x" "abs_Gromov_completion v = y"
                           "Gromov_completion_rel u u" "Gromov_completion_rel v v"
                           "liminf (\<lambda>n. ereal(Gromov_product_at f (u n) (v n))) < extended_Gromov_product_at f x y + h"
       by auto
 
     have "Gromov_product_at e (u n) (v n) \<le> Gromov_product_at f (u n) (v n) + dist e f" for n
       using Gromov_product_at_diff1[of e "u n" "v n" f] by auto
     then have *: "ereal(Gromov_product_at e (u n) (v n)) \<le> ereal(Gromov_product_at f (u n) (v n)) + dist e f" for n
       by fastforce
     have "extended_Gromov_product_at e x y \<le> liminf(\<lambda>n. ereal(Gromov_product_at e (u n) (v n)))"
       unfolding extended_Gromov_product_at_def by (rule Inf_lower, auto, rule exI[of _ u], rule exI[of _ v], auto, fact+)
     also have "... \<le> liminf(\<lambda>n. ereal(Gromov_product_at f (u n) (v n)) + dist e f)"
       apply (rule Liminf_mono) using * unfolding eventually_sequentially by auto
     also have "... = liminf(\<lambda>n. ereal(Gromov_product_at f (u n) (v n))) + dist e f"
       apply (rule Liminf_add_ereal_right) using False by auto
     also have "... \<le> extended_Gromov_product_at f x y + h + dist e f"
       using less_imp_le[OF H(5)] by (auto intro: mono_intros)
     finally show ?thesis
       by (simp add: algebra_simps)
   qed
   then show ?thesis
     using ereal_le_epsilon by blast
 next
   case True
   then show ?thesis by auto
 qed
 
 text \<open>A point in the Gromov boundary is represented by a sequence tending to infinity and
 converging in the Gromov boundary, essentially by definition.\<close>
 
 lemma Gromov_boundary_abs_converging:
   assumes "x \<in> Gromov_boundary" "abs_Gromov_completion u = x" "Gromov_completion_rel u u"
   shows "Gromov_converging_at_boundary u"
 proof -
   have "Gromov_converging_at_boundary u \<or> (\<forall>m n. u n = u m)"
     using assms unfolding Gromov_completion_rel_def by auto
   moreover have "\<not>(\<forall>m n. u n = u m)"
   proof (rule ccontr, simp)
     assume *: "\<forall>m n. u n = u m"
     define z where "z = u 0"
     then have z: "u = (\<lambda>n. z)"
       using * by auto
     then have "x = to_Gromov_completion z"
       using assms unfolding z to_Gromov_completion_def by auto
     then show False using \<open>x \<in> Gromov_boundary\<close> unfolding Gromov_boundary_def by auto
   qed
   ultimately show ?thesis by auto
 qed
 
 lemma Gromov_boundary_rep_converging:
   assumes "x \<in> Gromov_boundary"
   shows "Gromov_converging_at_boundary (rep_Gromov_completion x)"
 apply (rule Gromov_boundary_abs_converging[OF assms])
 using Quotient3_Gromov_completion Quotient3_abs_rep Quotient3_rep_reflp by fastforce+
 
 text \<open>We can characterize the points for which the Gromov product is infinite: they have to be
 the same point, at infinity. This is essentially equivalent to the definition of the Gromov
 completion, but there is some boilerplate to get the proof working.\<close>
 
 lemma Gromov_boundary_extended_product_PInf [simp]:
   "extended_Gromov_product_at e x y = \<infinity> \<longleftrightarrow> (x \<in> Gromov_boundary \<and> y = x)"
 proof
   fix x y::"'a Gromov_completion" assume "x \<in> Gromov_boundary \<and> y = x"
   then have H: "y = x" "x \<in> Gromov_boundary" by auto
   have *: "liminf (\<lambda>n. ereal (Gromov_product_at e (u n) (v n))) = \<infinity>" if
                   "abs_Gromov_completion u = x" "abs_Gromov_completion v = y"
                   "Gromov_completion_rel u u" "Gromov_completion_rel v v" for u v
   proof -
     have "Gromov_converging_at_boundary u" "Gromov_converging_at_boundary v"
       using Gromov_boundary_abs_converging that H by auto
     have "Gromov_completion_rel u v" using that \<open>y = x\<close>
       using Quotient3_rel[OF Quotient3_Gromov_completion] by fastforce
     then have "(\<lambda>n. Gromov_product_at e (u n) (v n)) \<longlonglongrightarrow> \<infinity>"
       unfolding Gromov_completion_rel_def using Gromov_converging_at_boundary_imp_not_constant'[OF \<open>Gromov_converging_at_boundary u\<close>] by auto
     then show ?thesis
       by (simp add: tendsto_iff_Liminf_eq_Limsup)
   qed
   then show "extended_Gromov_product_at e x y = \<infinity>"
     unfolding extended_Gromov_product_at_def by (auto intro: Inf_eqI)
 next
   fix x y::"'a Gromov_completion" assume H: "extended_Gromov_product_at e x y = \<infinity>"
   then have "extended_Gromov_distance (to_Gromov_completion e) x = \<infinity>"
     using extended_Gromov_product_le_dist[of e x y] neq_top_trans by auto
   then have "x \<in> Gromov_boundary"
     by (metis ereal.distinct(1) extended_Gromov_distance_def infinity_ereal_def not_in_Gromov_boundary')
   have "extended_Gromov_distance (to_Gromov_completion e) y = \<infinity>"
     using extended_Gromov_product_le_dist[of e y x] neq_top_trans H by (auto simp add: extended_Gromov_product_at_commute)
   then have "y \<in> Gromov_boundary"
     by (metis ereal.distinct(1) extended_Gromov_distance_def infinity_ereal_def not_in_Gromov_boundary')
   define u where "u = rep_Gromov_completion x"
   define v where "v = rep_Gromov_completion y"
   have A: "Gromov_converging_at_boundary u" "Gromov_converging_at_boundary v"
     unfolding u_def v_def using \<open>x \<in> Gromov_boundary\<close> \<open>y \<in> Gromov_boundary\<close>
     by (auto simp add: Gromov_boundary_rep_converging)
 
   have "abs_Gromov_completion u = x \<and> abs_Gromov_completion v = y \<and> Gromov_completion_rel u u \<and> Gromov_completion_rel v v"
     unfolding u_def v_def
     using Quotient3_abs_rep[OF Quotient3_Gromov_completion] Quotient3_rep_reflp[OF Quotient3_Gromov_completion] by auto
   then have "extended_Gromov_product_at e x y \<le> liminf (\<lambda>n. ereal(Gromov_product_at e (u n) (v n)))"
     unfolding extended_Gromov_product_at_def by (auto intro!: Inf_lower)
   then have "(\<lambda>n. ereal(Gromov_product_at e (u n) (v n))) \<longlonglongrightarrow> \<infinity>"
     unfolding H by (simp add: liminf_PInfty)
   then have "(\<lambda>n. ereal(Gromov_product_at a (u n) (v n))) \<longlonglongrightarrow> \<infinity>" for a
     using Gromov_product_tendsto_PInf_a_b by auto
 
   then have "Gromov_completion_rel u v"
     unfolding Gromov_completion_rel_def using A by auto
   then have "abs_Gromov_completion u = abs_Gromov_completion v"
     using Quotient3_rel_abs[OF Quotient3_Gromov_completion] by auto
   then have "x = y"
     unfolding u_def v_def Quotient3_abs_rep[OF Quotient3_Gromov_completion] by auto
   then show "x \<in> Gromov_boundary \<and> y = x"
     using \<open>x \<in> Gromov_boundary\<close> by auto
 qed
 
 text \<open>As for points inside the space, we deduce that the extended Gromov product between $x$ and $x$
 is just the extended distance to the basepoint.\<close>
 
 lemma extended_Gromov_product_e_x_x [simp]:
   "extended_Gromov_product_at e x x = extended_Gromov_distance (to_Gromov_completion e) x"
 proof (cases x)
   case boundary
   then show ?thesis using Gromov_boundary_extended_product_PInf by auto
 next
   case (to_Gromov_completion a)
   then show ?thesis by auto
 qed
 
 text \<open>The inequality in terms of Gromov products characterizing hyperbolicity extends in the
 same form to the Gromov completion, by taking limits of this inequality in the space.\<close>
 
 lemma extended_hyperb_ineq [mono_intros]:
   "extended_Gromov_product_at (e::'a::Gromov_hyperbolic_space) x z \<ge>
       min (extended_Gromov_product_at e x y) (extended_Gromov_product_at e y z) - deltaG(TYPE('a))"
 proof -
   have "min (extended_Gromov_product_at e x y) (extended_Gromov_product_at e y z) - deltaG(TYPE('a)) \<le>
     Inf {liminf (\<lambda>n. ereal (Gromov_product_at e (u n) (v n))) |u v.
             abs_Gromov_completion u = x \<and> abs_Gromov_completion v = z \<and> Gromov_completion_rel u u \<and> Gromov_completion_rel v v}"
   proof (rule cInf_greatest, auto)
     define u where "u = rep_Gromov_completion x"
     define w where "w = rep_Gromov_completion z"
     have "abs_Gromov_completion u = x \<and> abs_Gromov_completion w = z \<and> Gromov_completion_rel u u \<and> Gromov_completion_rel w w"
       unfolding u_def w_def
       using Quotient3_abs_rep[OF Quotient3_Gromov_completion] Quotient3_rep_reflp[OF Quotient3_Gromov_completion] by auto
     then show "\<exists>t u. Gromov_completion_rel u u \<and>
             (\<exists>v. abs_Gromov_completion v = z \<and> abs_Gromov_completion u = x \<and> t = liminf (\<lambda>n. ereal (Gromov_product_at e (u n) (v n))) \<and> Gromov_completion_rel v v)"
       by auto
   next
     fix u w assume H: "x = abs_Gromov_completion u" "z = abs_Gromov_completion w"
                       "Gromov_completion_rel u u" "Gromov_completion_rel w w"
     define v where "v = rep_Gromov_completion y"
     have Y: "y = abs_Gromov_completion v" "Gromov_completion_rel v v"
       unfolding v_def
       by (auto simp add: Quotient3_abs_rep[OF Quotient3_Gromov_completion] Quotient3_rep_reflp[OF Quotient3_Gromov_completion])
 
     have *: "min (ereal(Gromov_product_at e (u n) (v n))) (ereal(Gromov_product_at e (v n) (w n))) \<le> ereal(Gromov_product_at e (u n) (w n)) + deltaG(TYPE('a))" for n
       by (subst ereal_min[symmetric], subst plus_ereal.simps(1), intro mono_intros)
 
     have "extended_Gromov_product_at e (abs_Gromov_completion u) y \<le> liminf (\<lambda>n. ereal(Gromov_product_at e (u n) (v n)))"
       unfolding extended_Gromov_product_at_def using Y H by (auto intro!: Inf_lower)
     moreover have "extended_Gromov_product_at e y (abs_Gromov_completion w) \<le> liminf (\<lambda>n. ereal(Gromov_product_at e (v n) (w n)))"
       unfolding extended_Gromov_product_at_def using Y H by (auto intro!: Inf_lower)
     ultimately have "min (extended_Gromov_product_at e (abs_Gromov_completion u) y) (extended_Gromov_product_at e y (abs_Gromov_completion w))
       \<le> min (liminf (\<lambda>n. ereal(Gromov_product_at e (u n) (v n)))) (liminf (\<lambda>n. ereal(Gromov_product_at e (v n) (w n))))"
       by (intro mono_intros, auto)
     also have "... = liminf (\<lambda>n. min (ereal(Gromov_product_at e (u n) (v n))) (ereal(Gromov_product_at e (v n) (w n))))"
       by (rule Liminf_min_eq_min_Liminf[symmetric])
     also have "... \<le> liminf (\<lambda>n. ereal(Gromov_product_at e (u n) (w n)) + deltaG(TYPE('a)))"
       using * by (auto intro!: Liminf_mono)
     also have "... = liminf (\<lambda>n. ereal(Gromov_product_at e (u n) (w n))) + deltaG(TYPE('a))"
       by (intro Liminf_add_ereal_right, auto)
     finally show "min (extended_Gromov_product_at e (abs_Gromov_completion u) y) (extended_Gromov_product_at e y (abs_Gromov_completion w))
                   \<le> liminf (\<lambda>n. ereal (Gromov_product_at e (u n) (w n))) + ereal (deltaG TYPE('a))"
       by simp
   qed
   then show ?thesis unfolding extended_Gromov_product_at_def by auto
 qed
 
 lemma extended_hyperb_ineq' [mono_intros]:
   "extended_Gromov_product_at (e::'a::Gromov_hyperbolic_space) x z + deltaG(TYPE('a)) \<ge>
       min (extended_Gromov_product_at e x y) (extended_Gromov_product_at e y z)"
 using extended_hyperb_ineq[of e x y z] unfolding ereal_minus_le_iff by (simp add: add.commute)
 
 lemma zero_le_ereal [mono_intros]:
   assumes "0 \<le> z"
   shows "0 \<le> ereal z"
 using assms by auto
 
 lemma extended_hyperb_ineq_4_points' [mono_intros]:
   "Min {extended_Gromov_product_at (e::'a::Gromov_hyperbolic_space) x y, extended_Gromov_product_at e y z, extended_Gromov_product_at e z t} \<le> extended_Gromov_product_at e x t + 2 * deltaG(TYPE('a))"
 proof -
   have "min (extended_Gromov_product_at e x y + 0) (min (extended_Gromov_product_at e y z) (extended_Gromov_product_at e z t))
         \<le> min (extended_Gromov_product_at e x y + deltaG(TYPE('a))) (extended_Gromov_product_at e y t + deltaG(TYPE('a))) "
     by (intro mono_intros)
   also have "... = min (extended_Gromov_product_at e x y) (extended_Gromov_product_at e y t) + deltaG(TYPE('a))"
     by (simp add: add_mono_thms_linordered_semiring(3) dual_order.antisym min_def)
   also have "... \<le> (extended_Gromov_product_at e x t + deltaG(TYPE('a))) + deltaG(TYPE('a))"
     by (intro mono_intros)
   finally show ?thesis apply (auto simp add: algebra_simps)
     by (metis (no_types, opaque_lifting) add.commute add.left_commute mult_2_right plus_ereal.simps(1))
 qed
 
 lemma extended_hyperb_ineq_4_points [mono_intros]:
   "Min {extended_Gromov_product_at (e::'a::Gromov_hyperbolic_space) x y, extended_Gromov_product_at e y z, extended_Gromov_product_at e z t} - 2 * deltaG(TYPE('a)) \<le> extended_Gromov_product_at e x t"
 using extended_hyperb_ineq_4_points'[of e x y z] unfolding ereal_minus_le_iff by (simp add: add.commute)
 
 
 subsection \<open>Construction of the distance on the Gromov completion\<close>
 
 text \<open>We want now to define the natural topology of the Gromov completion. Most textbooks
 first define a topology on $\partial X$, or sometimes on
 $X \cup \partial X$, and then much later a distance on $\partial X$ (but they never do the tedious
 verification that the distance defines the same topology as the topology defined before). I have
 not seen one textbook defining a distance on $X \cup \partial X$. It turns out that one can in fact
 define a distance on $X \cup \partial X$, whose restriction to $\partial X$ is the usual distance
 on the Gromov boundary, and define the topology of $X \cup \partial X$ using it. For formalization
 purposes, this is very convenient as topologies defined with distances are automatically nice and
 tractable (no need to check separation axioms, for instance). The price to pay is that, once
 we have defined the distance, we have to check that it defines the right notion of convergence
 one expects.
 
 What we would like to take for the distance is
 $d(x,y) = e^{-(x,y)_o}$, where $o$ is some fixed basepoint in the space. However, this
 does not behave like a distance at small scales (but it is essentially the right thing at large
 scales), and it does not really satisfy the triangle inequality. However, $e^{-\epsilon (x,y)_o}$
 almost satisfies the triangle inequality if $\epsilon$ is small enough, i.e., it is equivalent
 to a function satisfying the triangle inequality. This gives a genuine distance on the boundary,
 but not inside the space as it does not vanish on pairs $(x,x)$.
 
 A third try would be to take $d(x,y) = \min(\tilde d(x,y), e^{-\epsilon (x,y)_o})$ where
 $\tilde d$ is the natural extension of $d$ to the Gromov completion (it is infinite if $x$ or $y$
 belongs to the boundary). However, we can not prove that it is equivalent to a distance.
 
 Finally, it works with $d(x,y) \asymp \min(\tilde d(x,y)^{1/2}, e^{-\epsilon (x,y)_o}$. This is
 what we will prove below. To construct the distance, we use the results proved in
 the locale \verb+Turn_into_distance+. For this, we need to check that our quasi-distance
 satisfies a weird version of the triangular inequality.
 
 All this construction depends on a basepoint, that we fix arbitrarily once and for all.
 \<close>
 
 definition epsilonG::"('a::Gromov_hyperbolic_space) itself \<Rightarrow> real"
   where "epsilonG _ = ln 2 / (2+2*deltaG(TYPE('a)))"
 
 definition basepoint::"'a"
   where "basepoint = (SOME a. True)"
 
 lemma constant_in_extended_predist_pos [simp, mono_intros]:
   "epsilonG(TYPE('a::Gromov_hyperbolic_space)) > 0"
   "epsilonG(TYPE('a::Gromov_hyperbolic_space)) \<ge> 0"
   "ennreal (epsilonG(TYPE('a))) * top = top"
 proof -
   have *: "2+2*deltaG(TYPE('a)) \<ge> 2 + 2 * 0"
     by (intro mono_intros, auto)
   show **: "epsilonG(TYPE('a)) > 0"
     unfolding epsilonG_def apply (auto simp add: divide_simps) using * by auto
   then show "ennreal (epsilonG(TYPE('a))) * top = top"
     using ennreal_mult_top by auto
   show "epsilonG(TYPE('a::Gromov_hyperbolic_space)) \<ge> 0"
     using ** by simp
 qed
 
 definition extended_predist::"('a::Gromov_hyperbolic_space) Gromov_completion \<Rightarrow> 'a Gromov_completion \<Rightarrow> real"
   where "extended_predist x y = real_of_ereal (min (esqrt (extended_Gromov_distance x y))
           (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)))"
 
 lemma extended_predist_ereal:
   "ereal (extended_predist x (y::('a::Gromov_hyperbolic_space) Gromov_completion)) = min (esqrt (extended_Gromov_distance x y))
           (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y))"
 proof -
   have "eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y) \<le> eexp (0)"
     by (intro mono_intros, simp add: ereal_mult_le_0_iff)
   then have A: "min (esqrt (extended_Gromov_distance x y)) (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)) \<le> 1"
     unfolding min_def using order_trans by fastforce
   show ?thesis
     unfolding extended_predist_def apply (rule ereal_real') using A by auto
 qed
 
 lemma extended_predist_nonneg [simp, mono_intros]:
   "extended_predist x y \<ge> 0"
 unfolding extended_predist_def min_def by (auto intro: real_of_ereal_pos)
 
 lemma extended_predist_commute:
   "extended_predist x y = extended_predist y x"
 unfolding extended_predist_def by (simp add: extended_Gromov_distance_commute extended_Gromov_product_at_commute)
 
 lemma extended_predist_self0 [simp]:
   "extended_predist x y = 0 \<longleftrightarrow> x = y"
 proof (auto)
   show "extended_predist y y = 0"
   proof (cases y)
     case boundary
     then have *: "extended_Gromov_product_at basepoint y y = \<infinity>"
       using Gromov_boundary_extended_product_PInf by auto
     show ?thesis unfolding extended_predist_def * apply (auto simp add: min_def)
       using constant_in_extended_predist_pos(1)[where ?'a = 'a] boundary by auto
   next
     case (to_Gromov_completion a)
     then show ?thesis unfolding extended_predist_def by (auto simp add: min_def)
   qed
   assume "extended_predist x y = 0"
   then have "esqrt (extended_Gromov_distance x y) = 0 \<or> eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y) = 0"
     by (metis extended_predist_ereal min_def zero_ereal_def)
     then show "x = y"
   proof
     assume "esqrt (extended_Gromov_distance x y) = 0"
     then have *: "extended_Gromov_distance x y = 0"
       using extended_Gromov_distance_nonneg by (metis ereal_zero_mult esqrt_square)
     then have "\<not>(x \<in> Gromov_boundary)" "\<not>(y \<in> Gromov_boundary)" by auto
     then obtain a b where ab: "x = to_Gromov_completion a" "y = to_Gromov_completion b"
       unfolding Gromov_boundary_def by auto
     have "a = b" using * unfolding ab by auto
     then show "x = y" using ab by auto
   next
     assume "eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y) = 0"
     then have "extended_Gromov_product_at basepoint x y = \<infinity>"
       by auto
     then show "x = y"
       using Gromov_boundary_extended_product_PInf[of basepoint x y] by auto
   qed
 qed
 
 lemma extended_predist_le1 [simp, mono_intros]:
   "extended_predist x y \<le> 1"
 proof -
   have "eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y) \<le> eexp (0)"
     by (intro mono_intros, simp add: ereal_mult_le_0_iff)
   then have "min (esqrt (extended_Gromov_distance x y)) (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)) \<le> 1"
     unfolding min_def using order_trans by fastforce
   then show ?thesis
     unfolding extended_predist_def by (simp add: real_of_ereal_le_1)
 qed
 
 lemma extended_predist_weak_triangle:
   "extended_predist x z \<le> sqrt 2 * max (extended_predist x y) (extended_predist y z)"
 proof -
   have Z: "esqrt 2 = eexp (ereal(ln 2/2))"
     by (subst esqrt_eq_iff_square, auto simp add: exp_add[symmetric])
 
   have A: "eexp(ereal(epsilonG TYPE('a)) * 1) \<le> esqrt 2"
     unfolding Z epsilonG_def apply auto
     apply (auto simp add: algebra_simps divide_simps intro!: mono_intros)
     using delta_nonneg[where ?'a = 'a] by auto
 
   text \<open>We have to show an inequality $d(x, z) \leq \sqrt{2} \max(d(x,y), d(y,z))$. Each of $d(x,y)$
   and $d(y,z)$ is either the extended distance, or the exponential of minus the Gromov product,
   depending on which is smaller. We split according to the four cases.\<close>
 
   have "(esqrt (extended_Gromov_distance x y) \<le> eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)
         \<or> esqrt (extended_Gromov_distance x y) \<ge> eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y))
         \<and>
       ((esqrt (extended_Gromov_distance y z) \<le> eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint y z)
         \<or> esqrt (extended_Gromov_distance y z) \<ge> eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint y z)))"
     by auto
   then have "ereal(extended_predist x z) \<le> ereal (sqrt 2) * max (ereal(extended_predist x y)) (ereal (extended_predist y z))"
   proof (auto)
 
     text \<open>First, consider the case where the minimum is the extended distance for both cases.
     Then $ed(x,z) \leq ed(x,y) + ed(y,z) \leq 2 \max(ed(x,y), ed(y,z))$. Therefore, $ed(x,z)^{1/2}
     \leq \sqrt{2} \max(ed(x,y)^{1/2}, ed(y,z)^{1/2})$. As predist is defined using
     the square root of $ed$, this readily gives the result.\<close>
     assume H: "esqrt (extended_Gromov_distance x y) \<le> eexp (ereal (- epsilonG TYPE('a)) * extended_Gromov_product_at basepoint x y)"
               "esqrt (extended_Gromov_distance y z) \<le> eexp (ereal (- epsilonG TYPE('a)) * extended_Gromov_product_at basepoint y z)"
     have "extended_Gromov_distance x z \<le> extended_Gromov_distance x y + extended_Gromov_distance y z"
       by (rule extended_Gromov_distance_triangle)
     also have "... \<le> 2 * max (extended_Gromov_distance x y) (extended_Gromov_distance y z)"
       by (simp add: add_mono add_mono_thms_linordered_semiring(1) mult_2_ereal)
     finally have "esqrt (extended_Gromov_distance x z) \<le> esqrt (2 * max (extended_Gromov_distance x y) (extended_Gromov_distance y z))"
       by (intro mono_intros)
     also have "... = esqrt 2 * max (esqrt (extended_Gromov_distance x y)) (esqrt (extended_Gromov_distance y z))"
       by (auto simp add: esqrt_mult max_of_mono[OF esqrt_mono])
     finally show ?thesis unfolding extended_predist_ereal min_def using H by auto
 
   next
     text \<open>Next, consider the case where the minimum comes from the Gromov product for both cases.
     Then, the conclusion will come for the hyperbolicity inequality (which is valid in the Gromov
     completion as well). There is an additive loss of $\delta$ in this inequality, which is converted
     to a multiplicative loss after taking the exponential to get the distance. Since, in the formula
     for the distance, the Gromov product is multiplied by a constant $\epsilon$ by design, the loss
     we get in the end is $\exp(\delta \epsilon)$. The precise value of $\epsilon$ we have taken is
     designed so that this is at most $\sqrt{2}$, giving the desired conclusion.\<close>
     assume H: "eexp (ereal (- epsilonG TYPE('a)) * extended_Gromov_product_at basepoint x y) \<le> esqrt (extended_Gromov_distance x y)"
               "eexp (ereal (- epsilonG TYPE('a)) * extended_Gromov_product_at basepoint y z) \<le> esqrt (extended_Gromov_distance y z)"
 
     text \<open>First, check that $\epsilon$ and $\delta$ satisfy the required inequality
     $\exp(\epsilon \delta) \leq \sqrt{2}$ (but in the extended reals as this is what we will use.\<close>
     have B: "eexp (epsilonG(TYPE('a)) * deltaG(TYPE('a))) \<le> esqrt 2"
       unfolding epsilonG_def \<open>esqrt 2 = eexp (ereal(ln 2/2))\<close>
       apply (auto simp add: algebra_simps divide_simps intro!: mono_intros)
       using delta_nonneg[where ?'a = 'a] by auto
 
     text \<open>We start the computation. First, use the hyperbolicity inequality.\<close>
     have "eexp (- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x z)
       \<le> eexp (- epsilonG TYPE('a) * ((min (extended_Gromov_product_at basepoint x y) (extended_Gromov_product_at basepoint y z) - deltaG(TYPE('a)))))"
       apply (subst uminus_ereal.simps(1)[symmetric], subst ereal_mult_minus_left)+ by (intro mono_intros)
     text \<open>Use distributivity to isolate the term $\epsilon \delta$. This requires some care
     as multiplication is not distributive in general in ereal.\<close>
     also have "... = eexp (- epsilonG TYPE('a) * min (extended_Gromov_product_at basepoint x y) (extended_Gromov_product_at basepoint y z)
             + epsilonG TYPE('a) * deltaG TYPE('a))"
       apply (rule cong[of eexp], auto)
       apply (subst times_ereal.simps(1)[symmetric])
       apply (subst ereal_distrib_minus_left, auto)
       apply (subst uminus_ereal.simps(1)[symmetric])+
       apply (subst ereal_minus(6))
       by simp
 
     text \<open>Use multiplicativity of exponential to extract the multiplicative error factor.\<close>
     also have "... = eexp(- epsilonG TYPE('a) * (min (extended_Gromov_product_at basepoint x y) (extended_Gromov_product_at basepoint y z)))
                     * eexp(epsilonG(TYPE('a))* deltaG(TYPE('a)))"
       by (rule eexp_add_mult, auto)
     text \<open>Extract the min outside of the exponential, using that all functions are monotonic.\<close>
     also have "... = eexp(epsilonG(TYPE('a))* deltaG(TYPE('a)))
                     * (max (eexp(- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y))
                             (eexp(- epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z)))"
       apply (subst max_of_antimono[of "\<lambda> (t::ereal). -epsilonG TYPE('a) * t", symmetric])
       apply (metis antimonoI constant_in_extended_predist_pos(2) enn2ereal_ennreal enn2ereal_nonneg ereal_minus_le_minus ereal_mult_left_mono ereal_mult_minus_left uminus_ereal.simps(1))
       apply (subst max_of_mono[OF eexp_mono])
       apply (simp add: mult.commute)
       done
     text \<open>We recognize the distance of $x$ to $y$ and the distance from $y$ to $z$ on the right.\<close>
     also have "... = eexp(epsilonG(TYPE('a)) * deltaG(TYPE('a))) * (max (ereal (extended_predist x y)) (extended_predist y z))"
       unfolding extended_predist_ereal min_def using H by auto
     also have "... \<le> esqrt 2 * max (ereal(extended_predist x y)) (ereal(extended_predist y z))"
       apply (intro mono_intros B) using extended_predist_nonneg[of x y] by (simp add: max_def)
     finally show ?thesis unfolding extended_predist_ereal min_def by auto
 
   next
     text \<open>Next consider the case where $d(x,y)$ comes from the exponential of minus the Gromov product,
     but $d(y,z)$ comes from their extended distance. Then $d(y,z) \leq 1$ (as $d(y,z)$ is smaller
     then the exponential of minus the Gromov distance, which is at most $1$), and this is all we use:
     the Gromov product between $x$ and $y$ or $x$ and $z$ differ by at most the distance from $y$ to $z$,
     i.e., $1$. Then the result follows directly as $\exp(\epsilon) \leq \sqrt{2}$, by the choice of
     $\epsilon$.\<close>
     assume H: "eexp (- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y) \<le> esqrt (extended_Gromov_distance x y)"
               "esqrt (extended_Gromov_distance y z) \<le> eexp (- epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z)"
     then have "esqrt(extended_Gromov_distance y z) \<le> 1"
       by (auto intro!: order_trans[OF H(2)] simp add: ereal_mult_le_0_iff)
     then have "extended_Gromov_distance y z \<le> 1"
       by (metis eq_iff esqrt_mono2 esqrt_simps(2) esqrt_square extended_Gromov_distance_nonneg le_cases zero_less_one_ereal)
 
     have "ereal(extended_predist x z) \<le> eexp(- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x z)"
       unfolding extended_predist_ereal min_def by auto
     also have "... \<le> eexp(- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y
                           + epsilonG TYPE('a) * extended_Gromov_distance y z)"
       apply (intro mono_intros) apply (subst uminus_ereal.simps(1)[symmetric])+ apply (subst ereal_mult_minus_left)+
       apply (intro mono_intros)
       using extended_Gromov_product_at_diff3[of basepoint x y z]
       by (meson constant_in_extended_predist_pos(2) ereal_le_distrib ereal_mult_left_mono order_trans zero_le_ereal)
     also have "... \<le> eexp(-epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y + ereal(epsilonG TYPE('a)) * 1)"
       by (intro mono_intros, fact)
     also have "... = eexp(-epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y) * eexp(ereal(epsilonG TYPE('a)) * 1)"
       by (rule eexp_add_mult, auto)
     also have "... \<le> eexp(-epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y) * esqrt 2"
       by (intro mono_intros A)
     also have "... = esqrt 2 * ereal(extended_predist x y)"
       unfolding extended_predist_ereal min_def using H by (auto simp add: mult.commute)
     also have "... \<le> esqrt 2 * max (ereal(extended_predist x y)) (ereal(extended_predist y z))"
       unfolding max_def by (auto intro!: mono_intros)
     finally show ?thesis by auto
 
   next
     text \<open>The last case is the symmetric of the previous one, and is proved similarly.\<close>
     assume H: "eexp (- epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z) \<le> esqrt (extended_Gromov_distance y z)"
               "esqrt (extended_Gromov_distance x y) \<le> eexp (- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y)"
     then have "esqrt(extended_Gromov_distance x y) \<le> 1"
       by (auto intro!: order_trans[OF H(2)] simp add: ereal_mult_le_0_iff)
     then have "extended_Gromov_distance x y \<le> 1"
       by (metis eq_iff esqrt_mono2 esqrt_simps(2) esqrt_square extended_Gromov_distance_nonneg le_cases zero_less_one_ereal)
 
     have "ereal(extended_predist x z) \<le> eexp(- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x z)"
       unfolding extended_predist_ereal min_def by auto
     also have "... \<le> eexp(- epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z
                           + epsilonG TYPE('a) * extended_Gromov_distance x y)"
       apply (intro mono_intros) apply (subst uminus_ereal.simps(1)[symmetric])+ apply (subst ereal_mult_minus_left)+
       apply (intro mono_intros)
       using extended_Gromov_product_at_diff3[of basepoint z y x]
       apply (simp add: extended_Gromov_product_at_commute extended_Gromov_distance_commute)
       by (meson constant_in_extended_predist_pos(2) ereal_le_distrib ereal_mult_left_mono order_trans zero_le_ereal)
     also have "... \<le> eexp(-epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z + ereal(epsilonG TYPE('a)) * 1)"
       by (intro mono_intros, fact)
     also have "... = eexp(-epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z) * eexp(ereal(epsilonG TYPE('a)) * 1)"
       by (rule eexp_add_mult, auto)
     also have "... \<le> eexp(-epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z) * esqrt 2"
       by (intro mono_intros A)
     also have "... = esqrt 2 * ereal(extended_predist y z)"
       unfolding extended_predist_ereal min_def using H by (auto simp add: mult.commute)
     also have "... \<le> esqrt 2 * max (ereal(extended_predist x y)) (ereal(extended_predist y z))"
       unfolding max_def by (auto intro!: mono_intros)
     finally show ?thesis by auto
   qed
   then show "extended_predist x z \<le> sqrt 2 * max (extended_predist x y) (extended_predist y z)"
     unfolding ereal_sqrt2[symmetric] max_of_mono[OF ereal_mono] times_ereal.simps(1) by auto
 qed
 
 instantiation Gromov_completion :: (Gromov_hyperbolic_space) metric_space
 begin
 
 definition dist_Gromov_completion::"('a::Gromov_hyperbolic_space) Gromov_completion \<Rightarrow> 'a Gromov_completion \<Rightarrow> real"
   where "dist_Gromov_completion = turn_into_distance extended_predist"
 
 text \<open>To define a metric space in the current library of Isabelle/HOL, one should also introduce
 a uniformity structure and a topology, as follows (they are prescribed by the distance):\<close>
 
 definition uniformity_Gromov_completion::"(('a Gromov_completion) \<times> ('a Gromov_completion)) filter"
   where "uniformity_Gromov_completion = (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})"
 
 definition open_Gromov_completion :: "'a Gromov_completion set \<Rightarrow> bool"
   where "open_Gromov_completion U = (\<forall>x\<in>U. eventually (\<lambda>(x', y). x' = x \<longrightarrow> y \<in> U) uniformity)"
 
 instance proof
   interpret Turn_into_distance extended_predist
     by (standard, auto intro: extended_predist_weak_triangle extended_predist_commute)
   fix x y z::"'a Gromov_completion"
   show "(dist x y = 0) = (x = y)"
     using TID_nonneg[of x y] lower[of x y] TID_self_zero upper[of x y] extended_predist_self0[of x y] unfolding dist_Gromov_completion_def
     by (auto, linarith)
   show "dist x y \<le> dist x z + dist y z"
     unfolding dist_Gromov_completion_def using triangle by (simp add: TID_sym)
 qed (auto simp add: uniformity_Gromov_completion_def open_Gromov_completion_def)
 end
 
 text \<open>The only relevant property of the distance on the Gromov completion is that it is comparable
 to the minimum of (the square root of) the extended distance, and the exponential of minus the Gromov
 product. The precise formula we use to define it is just an implementation detail, in a sense.
 We summarize these properties in the next theorem.
 From this point on, we will only use this, and never come back to the definition based on
 \verb+extended_predist+ and \verb+turn_into_distance+.\<close>
 
 theorem Gromov_completion_dist_comparison [mono_intros]:
   fixes x y::"('a::Gromov_hyperbolic_space) Gromov_completion"
   shows "ereal(dist x y) \<le> esqrt(extended_Gromov_distance x y)"
         "ereal(dist x y) \<le> eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)"
         "min (esqrt(extended_Gromov_distance x y)) (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)) \<le> 2 * ereal(dist x y)"
 proof -
   interpret Turn_into_distance extended_predist
     by (standard, auto intro: extended_predist_weak_triangle extended_predist_commute)
   have "ereal(dist x y) \<le> ereal(extended_predist x y)"
     unfolding dist_Gromov_completion_def by (auto intro!: upper mono_intros)
   then show "ereal(dist x y) \<le> esqrt(extended_Gromov_distance x y)"
             "ereal(dist x y) \<le> eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)"
     unfolding extended_predist_ereal by auto
   have "ereal(extended_predist x y) \<le> ereal(2 * dist x y)"
     unfolding dist_Gromov_completion_def by (auto intro!: lower mono_intros)
   also have "... = 2 * ereal (dist x y)"
     by simp
   finally show "min (esqrt(extended_Gromov_distance x y)) (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)) \<le> 2 * ereal(dist x y)"
     unfolding extended_predist_ereal by auto
 qed
 
 lemma Gromov_completion_dist_le_1 [simp, mono_intros]:
   fixes x y::"('a::Gromov_hyperbolic_space) Gromov_completion"
   shows "dist x y \<le> 1"
 proof -
   have "ereal(dist x y) \<le> eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)"
     using Gromov_completion_dist_comparison(2)[of x y] by simp
   also have "... \<le> eexp(-0)"
     by (intro mono_intros) (simp add: ereal_mult_le_0_iff)
   finally show ?thesis
     by auto
 qed
 
 text \<open>To avoid computations with exponentials, the following lemma is very convenient. It asserts
 that if $x$ is close enough to infinity, and $y$ is close enough to $x$, then the Gromov product
 between $x$ and $y$ is large.\<close>
 
 lemma large_Gromov_product_approx:
   assumes "(M::ereal) < \<infinity>"
   shows "\<exists>e D. e > 0 \<and> D < \<infinity> \<and> (\<forall>x y. dist x y \<le> e \<longrightarrow> extended_Gromov_distance x (to_Gromov_completion basepoint) \<ge> D \<longrightarrow> extended_Gromov_product_at basepoint x y \<ge> M)"
 proof -
   obtain M0::real where "M \<le> ereal M0" using assms by (cases M, auto)
   define e::real where "e = exp(-epsilonG(TYPE('a)) * M0)/2"
   define D::ereal where "D = ereal M0 + 4"
   have "e > 0"
     unfolding e_def by auto
   moreover have "D < \<infinity>"
     unfolding D_def by auto
   moreover have "extended_Gromov_product_at basepoint x y \<ge> M0"
     if "dist x y \<le> e" "extended_Gromov_distance x (to_Gromov_completion basepoint) \<ge> D" for x y::"'a Gromov_completion"
   proof (cases "esqrt(extended_Gromov_distance x y) \<le> eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)")
     case False
     then have "eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y) \<le> 2 * ereal(dist x y)"
       using Gromov_completion_dist_comparison(3)[of x y] unfolding min_def by auto
     also have "... \<le> exp(-epsilonG(TYPE('a)) * M0)"
       using \<open>dist x y \<le> e\<close> unfolding e_def by (auto simp add: numeral_mult_ennreal)
     finally have "ereal M0 \<le> extended_Gromov_product_at basepoint x y"
       unfolding eexp_ereal[symmetric] apply (simp only: eexp_le_eexp_iff_le)
       unfolding times_ereal.simps(1)[symmetric] uminus_ereal.simps(1)[symmetric] ereal_mult_minus_left ereal_minus_le_minus
       using ereal_mult_le_mult_iff[of "ereal (epsilonG TYPE('a))"] apply auto
       by (metis \<open>\<And>r p. ereal (r * p) = ereal r * ereal p\<close>)
     then show "M0 \<le> extended_Gromov_product_at basepoint x y"
       by auto
   next
     case True
     then have "esqrt(extended_Gromov_distance x y) \<le> 2 * ereal(dist x y)"
       using Gromov_completion_dist_comparison(3)[of x y] unfolding min_def by auto
     also have "... \<le> esqrt 4"
       by simp
     finally have *: "extended_Gromov_distance x y \<le> 4"
       unfolding esqrt_le using antisym by fastforce
     have "ereal M0+4 \<le> D"
       unfolding D_def by auto
     also have "... \<le> extended_Gromov_product_at basepoint x x"
       using that by (auto simp add: extended_Gromov_distance_commute)
     also have "... \<le> extended_Gromov_product_at basepoint x y + extended_Gromov_distance x y"
       by (rule extended_Gromov_product_at_diff3[of basepoint x x y])
     also have "... \<le> extended_Gromov_product_at basepoint x y + 4"
       by (intro mono_intros *)
     finally show "M0 \<le> extended_Gromov_product_at basepoint x y"
       by (metis (no_types, lifting) PInfty_neq_ereal(1) add.commute add_nonneg_nonneg ereal_add_strict_mono ereal_le_distrib mult_2_ereal not_le numeral_Bit0 numeral_eq_ereal one_add_one zero_less_one_ereal)
   qed
   ultimately show ?thesis using order_trans[OF \<open>M \<le> ereal M0\<close>] by force
 qed
 
 text \<open>On the other hand, far away from infinity, it is equivalent to control the extended Gromov
 distance or the new distance on the space.\<close>
 
 lemma inside_Gromov_distance_approx:
   assumes "C < (\<infinity>::ereal)"
   shows "\<exists>e > 0. \<forall>x y. extended_Gromov_distance (to_Gromov_completion basepoint) x \<le> C \<longrightarrow> dist x y \<le> e
           \<longrightarrow> esqrt(extended_Gromov_distance x y) \<le> 2 * ereal(dist x y)"
 proof -
   obtain C0 where "C \<le> ereal C0" using assms by (cases C, auto)
   define e0 where "e0 = exp(-epsilonG(TYPE('a)) * C0)"
   have "e0 > 0"
     unfolding e0_def using assms by auto
   define e where "e = e0/4"
   have "e > 0"
     unfolding e_def using \<open>e0 > 0\<close> by auto
   moreover have "esqrt(extended_Gromov_distance x y) \<le> 2 * ereal(dist x y)"
     if "extended_Gromov_distance (to_Gromov_completion basepoint) x \<le> C0" "dist x y \<le> e" for x y::"'a Gromov_completion"
   proof -
     have R: "min a b \<le> c \<Longrightarrow> a \<le> c \<or> b \<le> c" for a b c::ereal unfolding min_def
       by presburger
     have "2 * ereal (dist x y) \<le> 2 * ereal e"
       using that by (intro mono_intros, auto)
     also have "... = ereal(e0/2)"
       unfolding e_def by auto
     also have "... < ereal e0"
       apply (intro mono_intros) using \<open>e0 > 0\<close> by auto
     also have "... \<le> eexp(-epsilonG(TYPE('a)) * extended_Gromov_distance (to_Gromov_completion basepoint) x)"
       unfolding e0_def eexp_ereal[symmetric] ereal_mult_minus_left mult_minus_left uminus_ereal.simps(1)[symmetric] times_ereal.simps(1)[symmetric]
       by (intro mono_intros that)
     also have "... \<le> eexp(-epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)"
       unfolding ereal_mult_minus_left mult_minus_left uminus_ereal.simps(1)[symmetric] times_ereal.simps(1)[symmetric]
       by (intro mono_intros)
     finally show ?thesis
       using R[OF Gromov_completion_dist_comparison(3)[of x y]] by auto
   qed
   ultimately show ?thesis using order_trans[OF _ \<open>C \<le> ereal C0\<close>] by auto
 qed
 
 
 subsection \<open>Characterizing convergence in the Gromov boundary\<close>
 
 text \<open>The convergence of sequences in the Gromov boundary can be characterized, essentially
 by definition: sequences tend to a point at infinity iff the Gromov product with this point tends
 to infinity, while sequences tend to a point inside iff the extended distance tends to $0$. In both
 cases, it is just a matter of unfolding the definition of the distance, and see which one of the two
 terms (exponential of minus the Gromov product, or extended distance) realizes the minimum. We have
 constructed the distance essentially so that this property is satisfied.
 
 We could also have defined first the topology, satisfying these conditions, but then we would have
 had to check that it coincides with the topology that the distance defines, so it seems more
 economical to proceed in this way.\<close>
 
 lemma Gromov_completion_boundary_limit:
   assumes "x \<in> Gromov_boundary"
   shows "(u \<longlongrightarrow> x) F \<longleftrightarrow> ((\<lambda>n. extended_Gromov_product_at basepoint (u n) x) \<longlongrightarrow> \<infinity>) F"
 proof
   assume *: "((\<lambda>n. extended_Gromov_product_at basepoint (u n) x) \<longlongrightarrow> \<infinity>) F"
   have "((\<lambda>n. ereal(dist (u n) x)) \<longlongrightarrow> 0) F"
   proof (rule tendsto_sandwich[of "\<lambda>_. 0" _ _ "(\<lambda>n. eexp (-epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x))"])
     have "((\<lambda>n. eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x)) \<longlongrightarrow> eexp (- epsilonG(TYPE('a)) * (\<infinity>::ereal))) F"
       apply (intro tendsto_intros *) by auto
     then show "((\<lambda>n. eexp (-epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x)) \<longlongrightarrow> 0) F"
       using constant_in_extended_predist_pos(1)[where ?'a = 'a] by auto
   qed (auto simp add: Gromov_completion_dist_comparison)
   then have "((\<lambda>n. real_of_ereal(ereal(dist (u n) x))) \<longlongrightarrow> 0) F"
     by (simp add: zero_ereal_def)
   then show "(u \<longlongrightarrow> x) F"
     by (subst tendsto_dist_iff, auto)
 next
   assume *: "(u \<longlongrightarrow> x) F"
   have A: "1 / ereal (- epsilonG TYPE('a)) * (ereal (- epsilonG TYPE('a))) = 1"
     apply auto using constant_in_extended_predist_pos(1)[where ?'a = 'a] by auto
   have a: "esqrt(extended_Gromov_distance (u n) x) = \<infinity>" for n
     unfolding extended_Gromov_distance_PInf_boundary(2)[OF assms, of "u n"] by auto
   have "min (esqrt(extended_Gromov_distance (u n) x)) (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x))
         = eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x)" for n
     unfolding a min_def using neq_top_trans by force
   moreover have "((\<lambda>n. min (esqrt(extended_Gromov_distance (u n) x)) (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x))) \<longlongrightarrow> 0) F"
   proof (rule tendsto_sandwich[of "\<lambda>_. 0" _ _ "\<lambda>n. 2 * ereal(dist (u n) x)"])
     have "((\<lambda>n. 2 * ereal (dist (u n) x)) \<longlongrightarrow> 2 * ereal 0) F"
       apply (intro tendsto_intros) using * tendsto_dist_iff by auto
     then show "((\<lambda>n. 2 * ereal (dist (u n) x)) \<longlongrightarrow> 0) F" by (simp add: zero_ereal_def)
     show "\<forall>\<^sub>F n in F. 0 \<le> min (esqrt (extended_Gromov_distance (u n) x)) (eexp (ereal (- epsilonG TYPE('a)) * extended_Gromov_product_at basepoint (u n) x))"
       by (rule always_eventually, auto)
     show "\<forall>\<^sub>F n in F.
         min (esqrt (extended_Gromov_distance (u n) x)) (eexp (ereal (- epsilonG TYPE('a)) * extended_Gromov_product_at basepoint (u n) x)) \<le> 2 * ereal (dist (u n) x)"
       apply (rule always_eventually) using Gromov_completion_dist_comparison(3) by auto
   qed (auto)
   ultimately have "((\<lambda>n. eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x)) \<longlongrightarrow> 0) F"
     by auto
   then have "((\<lambda>n. - epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x) \<longlongrightarrow> -\<infinity>) F"
     unfolding eexp_special_values(3)[symmetric] eexp_tendsto' by auto
   then have "((\<lambda>n. 1/ereal(-epsilonG(TYPE('a))) * (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x)) \<longlongrightarrow> 1/ereal(-epsilonG(TYPE('a))) * (-\<infinity>)) F"
     by (intro tendsto_intros, auto)
   moreover have "1/ereal(-epsilonG(TYPE('a))) * (-\<infinity>) = \<infinity>"
     apply auto using constant_in_extended_predist_pos(1)[where ?'a = 'a] by auto
   ultimately show "((\<lambda>n. extended_Gromov_product_at basepoint (u n) x) \<longlongrightarrow> \<infinity>) F"
     unfolding ab_semigroup_mult_class.mult_ac(1)[symmetric] A by auto
 qed
 
 lemma extended_Gromov_product_tendsto_PInf_a_b:
   assumes "((\<lambda>n. extended_Gromov_product_at a (u n) (v n)) \<longlongrightarrow> \<infinity>) F"
   shows "((\<lambda>n. extended_Gromov_product_at b (u n) (v n)) \<longlongrightarrow> \<infinity>) F"
 proof (rule tendsto_sandwich[of "\<lambda>n. extended_Gromov_product_at a (u n) (v n) - dist a b" _ _ "\<lambda>_. \<infinity>"])
   have "extended_Gromov_product_at a (u n) (v n) - ereal (dist a b) \<le> extended_Gromov_product_at b (u n) (v n)" for n
     using extended_Gromov_product_at_diff1[of a "u n" "v n" b] by (simp add: add.commute ereal_minus_le_iff)
   then show "\<forall>\<^sub>F n in F. extended_Gromov_product_at a (u n) (v n) - ereal (dist a b) \<le> extended_Gromov_product_at b (u n) (v n)"
     by auto
   have "((\<lambda>n. extended_Gromov_product_at a (u n) (v n) - ereal (dist a b)) \<longlongrightarrow> \<infinity> - ereal (dist a b)) F"
     by (intro tendsto_intros assms) auto
   then show "((\<lambda>n. extended_Gromov_product_at a (u n) (v n) - ereal (dist a b)) \<longlongrightarrow> \<infinity>) F"
     by auto
 qed (auto)
 
 lemma Gromov_completion_inside_limit:
   assumes "x \<notin> Gromov_boundary"
   shows "(u \<longlongrightarrow> x) F \<longleftrightarrow> ((\<lambda>n. extended_Gromov_distance (u n) x) \<longlongrightarrow> 0) F"
 proof
   assume *: "((\<lambda>n. extended_Gromov_distance (u n) x) \<longlongrightarrow> 0) F"
   have "((\<lambda>n. ereal(dist (u n) x)) \<longlongrightarrow> ereal 0) F"
   proof (rule tendsto_sandwich[of "\<lambda>_. 0" _ _ "\<lambda>n. esqrt (extended_Gromov_distance (u n) x)"])
     have "((\<lambda>n. esqrt (extended_Gromov_distance (u n) x)) \<longlongrightarrow> esqrt 0) F"
       by (intro tendsto_intros *)
     then show "((\<lambda>n. esqrt (extended_Gromov_distance (u n) x)) \<longlongrightarrow> ereal 0) F"
       by (simp add: zero_ereal_def)
   qed (auto simp add: Gromov_completion_dist_comparison zero_ereal_def)
   then have "((\<lambda>n. real_of_ereal(ereal(dist (u n) x))) \<longlongrightarrow> 0) F"
     by (intro lim_real_of_ereal)
   then show "(u \<longlongrightarrow> x) F"
     by (subst tendsto_dist_iff, auto)
 next
   assume *: "(u \<longlongrightarrow> x) F"
   have "x \<in> range to_Gromov_completion" using assms unfolding Gromov_boundary_def by auto
   have "((\<lambda>n. esqrt(extended_Gromov_distance (u n) x)) \<longlongrightarrow> 0) F"
   proof (rule tendsto_sandwich[of "\<lambda>_. 0" _ _ "\<lambda>n. 2 * ereal(dist (u n) x)"])
     have A: "extended_Gromov_distance (to_Gromov_completion basepoint) x < \<infinity>"
       by (simp add: assms extended_Gromov_distance_def)
     obtain e where e: "e > 0" "\<And>y. dist x y \<le> e \<Longrightarrow> esqrt(extended_Gromov_distance x y) \<le> 2 * ereal (dist x y)"
       using inside_Gromov_distance_approx[OF A] by auto
     have B: "eventually (\<lambda>n. dist x (u n) < e) F"
       using order_tendstoD(2)[OF iffD1[OF tendsto_dist_iff *] \<open>e > 0\<close>] by (simp add: dist_commute)
     then have "eventually (\<lambda>n. esqrt(extended_Gromov_distance x (u n)) \<le> 2 * ereal (dist x (u n))) F"
       using eventually_mono[OF _ e(2)] less_imp_le by (metis (mono_tags, lifting))
     then show "eventually (\<lambda>n. esqrt(extended_Gromov_distance (u n) x) \<le> 2 * ereal (dist (u n) x)) F"
       by (simp add: dist_commute extended_Gromov_distance_commute)
     have "((\<lambda>n. 2 * ereal(dist (u n) x)) \<longlongrightarrow> 2 * ereal 0) F"
       apply (intro tendsto_intros) using tendsto_dist_iff * by auto
     then show "((\<lambda>n. 2 * ereal(dist (u n) x)) \<longlongrightarrow> 0) F"
       by (simp add: zero_ereal_def)
   qed (auto)
   then have "((\<lambda>n. esqrt(extended_Gromov_distance (u n) x) * esqrt(extended_Gromov_distance (u n) x)) \<longlongrightarrow> 0 * 0) F"
     by (intro tendsto_intros, auto)
   then show "((\<lambda>n. extended_Gromov_distance (u n) x) \<longlongrightarrow> 0) F"
     by auto
 qed
 
 lemma to_Gromov_completion_lim [simp, tendsto_intros]:
   "((\<lambda>n. to_Gromov_completion (u n)) \<longlongrightarrow> to_Gromov_completion a) F \<longleftrightarrow> (u \<longlongrightarrow> a) F"
 proof (subst Gromov_completion_inside_limit, auto)
   assume "((\<lambda>n. ereal (dist (u n) a)) \<longlongrightarrow> 0) F"
   then have "((\<lambda>n. real_of_ereal(ereal (dist (u n) a))) \<longlongrightarrow> 0) F"
     unfolding zero_ereal_def by (rule lim_real_of_ereal)
   then show "(u \<longlongrightarrow> a) F"
     by (subst tendsto_dist_iff, auto)
 next
   assume "(u \<longlongrightarrow> a) F"
   then have "((\<lambda>n. dist (u n) a) \<longlongrightarrow> 0) F"
     using tendsto_dist_iff by auto
   then show "((\<lambda>n. ereal (dist (u n) a)) \<longlongrightarrow> 0) F"
     unfolding zero_ereal_def by (intro tendsto_intros)
 qed
 
 text \<open>Now, we can also come back to our original definition of the completion, where points on the
 boundary correspond to equivalence classes of sequences whose mutual Gromov product tends to
 infinity. We show that this is compatible with our topology: the sequences that are in the equivalence
 class of a point on the boundary are exactly the sequences that converge to this point. This is also
 a direct consequence of the definitions, although the proof requires some unfolding (and playing
 with the hyperbolicity inequality several times).\<close>
 
 text \<open>First, we show that a sequence in the equivalence class of $x$ converges to $x$.\<close>
 
 lemma Gromov_completion_converge_to_boundary_aux:
   assumes "x \<in> Gromov_boundary" "abs_Gromov_completion v = x" "Gromov_completion_rel v v"
   shows "(\<lambda>n. extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x) \<longlonglongrightarrow> \<infinity>"
 proof -
   have A: "eventually (\<lambda>n. extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x \<ge> ereal M) sequentially" for M
   proof -
     have "Gromov_converging_at_boundary v"
       using Gromov_boundary_abs_converging assms by blast
     then obtain N where N: "\<And>m n. m \<ge> N \<Longrightarrow> n \<ge> N \<Longrightarrow> Gromov_product_at basepoint (v m) (v n) \<ge> M + deltaG(TYPE('a))"
       unfolding Gromov_converging_at_boundary_def by metis
     have "extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x \<ge> ereal M" if "n \<ge> N" for n
     unfolding extended_Gromov_product_at_def proof (rule Inf_greatest, auto)
       fix wv wx assume H: "abs_Gromov_completion wv = to_Gromov_completion (v n)"
                           "x = abs_Gromov_completion wx"
                           "Gromov_completion_rel wv wv" "Gromov_completion_rel wx wx"
       then have wv: "wv p = v n" for p
         using Gromov_completion_rel_to_const Quotient3_Gromov_completion Quotient3_rel to_Gromov_completion_def by fastforce
       have "Gromov_completion_rel v wx"
         using assms H Quotient3_rel[OF Quotient3_Gromov_completion] by auto
       then have *: "(\<lambda>p. Gromov_product_at basepoint (v p) (wx p)) \<longlonglongrightarrow> \<infinity>"
         unfolding Gromov_completion_rel_def using Gromov_converging_at_boundary_imp_not_constant' \<open>Gromov_converging_at_boundary v\<close> by auto
       have "eventually (\<lambda>p. ereal(Gromov_product_at basepoint (v p) (wx p)) > M + deltaG(TYPE('a))) sequentially"
         using order_tendstoD[OF *, of "ereal (M + deltaG TYPE('a))"] by auto
       then obtain P where P: "\<And>p. p \<ge> P \<Longrightarrow> ereal(Gromov_product_at basepoint (v p) (wx p)) > M + deltaG(TYPE('a))"
         unfolding eventually_sequentially by auto
       have *: "ereal (Gromov_product_at basepoint (v n) (wx p)) \<ge> ereal M" if "p \<ge> max P N" for p
       proof (intro mono_intros)
         have "M \<le> min (M + deltaG(TYPE('a))) (M + deltaG(TYPE('a))) - deltaG(TYPE('a))"
           by auto
         also have "... \<le> min (Gromov_product_at basepoint (v n) (v p)) (Gromov_product_at basepoint (v p) (wx p)) - deltaG(TYPE('a))"
           apply (intro mono_intros)
           using N[OF \<open>n \<ge> N\<close>, of p] \<open>p \<ge> max P N\<close> P[of p] \<open>p \<ge> max P N\<close> by auto
         also have "... \<le> Gromov_product_at basepoint (v n) (wx p) "
           by (rule hyperb_ineq)
         finally show "M \<le> Gromov_product_at basepoint (v n) (wx p) "
           by simp
       qed
       then have "eventually (\<lambda>p. ereal (Gromov_product_at basepoint (v n) (wx p)) \<ge> ereal M) sequentially"
         unfolding eventually_sequentially by metis
       then show "ereal M \<le> liminf (\<lambda>p. ereal (Gromov_product_at basepoint (wv p) (wx p)))"
         unfolding wv by (simp add: Liminf_bounded)
     qed
     then show ?thesis unfolding eventually_sequentially by auto
   qed
   have B: "eventually (\<lambda>n. extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x > M) sequentially" if "M < \<infinity>" for M
   proof -
-    obtain N where "ereal N > M" using \<open>M < \<infinity>\<close> ereal_dense2 by auto
+    obtain N where "ereal N > M" using \<open>M < \<infinity>\<close> ereal_dense2 by blast
     then have "a \<ge> ereal N \<Longrightarrow> a > M" for a by auto
     then show ?thesis using A[of N] eventually_elim2 by force
   qed
   then show ?thesis
     by (rule order_tendstoI, auto)
 qed
 
 text \<open>Then, we prove the converse and therefore the equivalence.\<close>
 
 lemma Gromov_completion_converge_to_boundary:
   assumes "x \<in> Gromov_boundary"
   shows "((\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> x) \<longleftrightarrow> (Gromov_completion_rel u u \<and> abs_Gromov_completion u = x)"
 proof
   assume "Gromov_completion_rel u u \<and> abs_Gromov_completion u = x"
   then show "((\<lambda>n. to_Gromov_completion(u n)) \<longlonglongrightarrow> x)"
     using Gromov_completion_converge_to_boundary_aux[OF assms, of u] unfolding Gromov_completion_boundary_limit[OF assms] by auto
 next
   assume H: "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> x"
   have Lu: "(\<lambda>n. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x) \<longlonglongrightarrow> \<infinity>"
     using iffD1[OF Gromov_completion_boundary_limit[OF assms] H] by simp
   have A: "\<exists>N. \<forall>n \<ge> N. \<forall> m \<ge> N. Gromov_product_at basepoint (u m) (u n) \<ge> M" for M
   proof -
     have "eventually (\<lambda>n. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x > M + deltaG(TYPE('a))) sequentially"
       by (rule order_tendstoD[OF Lu], auto)
     then obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x > M + deltaG(TYPE('a))"
       unfolding eventually_sequentially by auto
     have "Gromov_product_at basepoint (u m) (u n) \<ge> M" if "n \<ge> N" "m \<ge> N" for m n
     proof -
       have "ereal M \<le> min (ereal (M + deltaG(TYPE('a)))) (ereal (M + deltaG(TYPE('a)))) - ereal(deltaG(TYPE('a)))"
         by simp
       also have "... \<le> min (extended_Gromov_product_at basepoint (to_Gromov_completion (u m)) x) (extended_Gromov_product_at basepoint x (to_Gromov_completion (u n))) - deltaG(TYPE('a))"
         apply (intro mono_intros) using N[OF \<open>n \<ge> N\<close>] N[OF \<open>m \<ge> N\<close>]
         by (auto simp add: extended_Gromov_product_at_commute)
       also have "... \<le> extended_Gromov_product_at basepoint (to_Gromov_completion (u m)) (to_Gromov_completion (u n))"
         by (rule extended_hyperb_ineq)
       finally show ?thesis by auto
     qed
     then show ?thesis by auto
   qed
   have "\<exists>N. \<forall>n \<ge> N. \<forall> m \<ge> N. Gromov_product_at a (u m) (u n) \<ge> M" for M a
   proof -
     obtain N where N: "\<And>m n. m \<ge> N \<Longrightarrow> n \<ge> N \<Longrightarrow> Gromov_product_at basepoint (u m) (u n) \<ge> M + dist a basepoint"
       using A[of "M + dist a basepoint"] by auto
     have "Gromov_product_at a (u m) (u n) \<ge> M" if "m \<ge> N" "n \<ge> N" for m n
       using N[OF that] Gromov_product_at_diff1[of a "u m" "u n" basepoint] by auto
     then show ?thesis by auto
   qed
   then have "Gromov_converging_at_boundary u"
     unfolding Gromov_converging_at_boundary_def by auto
   then have "Gromov_completion_rel u u" using Gromov_converging_at_boundary_rel by auto
 
   define v where "v = rep_Gromov_completion x"
   then have "Gromov_converging_at_boundary v"
     using Gromov_boundary_rep_converging[OF assms] by auto
   have v: "abs_Gromov_completion v = x" "Gromov_completion_rel v v"
     using Quotient3_abs_rep[OF Quotient3_Gromov_completion] Quotient3_rep_reflp[OF Quotient3_Gromov_completion]
     unfolding v_def by auto
   then have Lv: "(\<lambda>n. extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x) \<longlonglongrightarrow> \<infinity>"
     using Gromov_completion_converge_to_boundary_aux[OF assms] by auto
 
   have *: "(\<lambda>n. min (extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x) (extended_Gromov_product_at basepoint x (to_Gromov_completion (v n))) -
           ereal (deltaG TYPE('a))) \<longlonglongrightarrow> min \<infinity> \<infinity> - ereal (deltaG TYPE('a))"
     apply (intro tendsto_intros) using Lu Lv by (auto simp add: extended_Gromov_product_at_commute)
   have "(\<lambda>n. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) (to_Gromov_completion (v n))) \<longlonglongrightarrow> \<infinity>"
     apply (rule tendsto_sandwich[of "\<lambda>n. min (extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x)
                                               (extended_Gromov_product_at basepoint x (to_Gromov_completion (v n))) - deltaG(TYPE('a))" _ _ "\<lambda>_. \<infinity>"])
     using extended_hyperb_ineq not_eventuallyD apply blast using * by auto
   then have "(\<lambda>n. Gromov_product_at basepoint (u n) (v n)) \<longlonglongrightarrow> \<infinity>"
     by auto
   then have "(\<lambda>n. Gromov_product_at a (u n) (v n)) \<longlonglongrightarrow> \<infinity>" for a
     using Gromov_product_tendsto_PInf_a_b by auto
   then have "Gromov_completion_rel u v"
     unfolding Gromov_completion_rel_def
     using \<open>Gromov_converging_at_boundary u\<close> \<open>Gromov_converging_at_boundary v\<close> by auto
   then have "abs_Gromov_completion u = abs_Gromov_completion v"
     using Quotient3_rel[OF Quotient3_Gromov_completion] v(2) \<open>Gromov_completion_rel u u\<close> by auto
   then have "abs_Gromov_completion u = x"
     using v(1) by auto
   then show "Gromov_completion_rel u u \<and> abs_Gromov_completion u = x"
     using \<open>Gromov_completion_rel u u\<close> by auto
 qed
 
 text \<open>In particular, it follows that a sequence which is \verb+Gromov_converging_at_boundary+ is
 indeed converging to a point on the boundary, the equivalence class of this sequence.\<close>
 
 lemma Gromov_converging_at_boundary_converges:
   assumes "Gromov_converging_at_boundary u"
   shows "\<exists>x \<in> Gromov_boundary. (\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> x"
 apply (rule bexI[of _ "abs_Gromov_completion u"])
 apply (subst Gromov_completion_converge_to_boundary)
 using assms by (auto simp add: Gromov_converging_at_boundary_rel)
 
 lemma Gromov_converging_at_boundary_converges':
   assumes "Gromov_converging_at_boundary u"
   shows "convergent (\<lambda>n. to_Gromov_completion (u n))"
 unfolding convergent_def using Gromov_converging_at_boundary_converges[OF assms] by auto
 
 lemma lim_imp_Gromov_converging_at_boundary:
   fixes u::"nat \<Rightarrow> 'a::Gromov_hyperbolic_space"
   assumes "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> x" "x \<in> Gromov_boundary"
   shows "Gromov_converging_at_boundary u"
 using Gromov_boundary_abs_converging Gromov_completion_converge_to_boundary assms by blast
 
 text \<open>If two sequences tend to the same point at infinity, then their Gromov product tends to
 infinity.\<close>
 
 lemma same_limit_imp_Gromov_product_tendsto_infinity:
   assumes "z \<in> Gromov_boundary"
           "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> z"
           "(\<lambda>n. to_Gromov_completion (v n)) \<longlonglongrightarrow> z"
   shows "\<exists>N. \<forall>n \<ge> N. \<forall>m \<ge> N. Gromov_product_at a (u n) (v m) \<ge> C"
 proof -
   have "Gromov_completion_rel u u" "Gromov_completion_rel v v" "abs_Gromov_completion u = abs_Gromov_completion v"
     using iffD1[OF Gromov_completion_converge_to_boundary[OF assms(1)]] assms by auto
   then have *: "Gromov_completion_rel u v"
     using Quotient3_Gromov_completion Quotient3_rel by fastforce
   have **: "Gromov_converging_at_boundary u"
     using assms lim_imp_Gromov_converging_at_boundary by blast
   then obtain M where M: "\<And>m n. m \<ge> M \<Longrightarrow> n \<ge> M \<Longrightarrow> Gromov_product_at a (u m) (u n) \<ge> C + deltaG(TYPE('a))"
     unfolding Gromov_converging_at_boundary_def by blast
 
   have "(\<lambda>n. Gromov_product_at a (u n) (v n)) \<longlonglongrightarrow> \<infinity>"
     using * Gromov_converging_at_boundary_imp_not_constant'[OF **] unfolding Gromov_completion_rel_def by auto
   then have "eventually (\<lambda>n. Gromov_product_at a (u n) (v n) \<ge> C + deltaG(TYPE('a))) sequentially"
     by (meson Lim_PInfty ereal_less_eq(3) eventually_sequentiallyI)
   then obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> Gromov_product_at a (u n) (v n) \<ge> C + deltaG(TYPE('a))"
     unfolding eventually_sequentially by auto
   have "Gromov_product_at a (u n) (v m) \<ge> C" if "n \<ge> max M N" "m \<ge> max M N" for m n
   proof -
     have "C + deltaG(TYPE('a)) \<le> min (Gromov_product_at a (u n) (u m)) (Gromov_product_at a (u m) (v m))"
       using M N that by auto
     also have "... \<le> Gromov_product_at a (u n) (v m) + deltaG(TYPE('a))"
       by (intro mono_intros)
     finally show ?thesis by simp
   qed
   then show ?thesis
     by blast
 qed
 
 text \<open>An admissible sequence converges in the Gromov boundary, to the point it defines. This
 follows from the definition of the topology in the two cases, inner and boundary.\<close>
 
 lemma abs_Gromov_completion_limit:
   assumes "Gromov_completion_rel u u"
   shows "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> abs_Gromov_completion u"
 proof (cases "abs_Gromov_completion u")
   case (to_Gromov_completion x)
   then show ?thesis
     using Gromov_completion_rel_to_const Quotient3_Gromov_completion Quotient3_rel assms to_Gromov_completion_def by fastforce
 next
   case boundary
   show ?thesis
     unfolding Gromov_completion_converge_to_boundary[OF boundary]
     using assms Gromov_boundary_rep_converging Gromov_converging_at_boundary_rel Quotient3_Gromov_completion Quotient3_abs_rep boundary by fastforce
 qed
 
 text \<open>In particular, a point in the Gromov boundary is the limit of
 its representative sequence in the space.\<close>
 
 lemma rep_Gromov_completion_limit:
   "(\<lambda>n. to_Gromov_completion (rep_Gromov_completion x n)) \<longlonglongrightarrow> x"
 using abs_Gromov_completion_limit[of "rep_Gromov_completion x"] Quotient3_Gromov_completion Quotient3_abs_rep Quotient3_rep_reflp by fastforce
 
 
 subsection \<open>Continuity properties of the extended Gromov product and distance\<close>
 
 text \<open>We have defined our extended Gromov product in terms of sequences satisfying the equivalence
 relation. However, we would like to avoid this definition as much as possible, and express things
 in terms of the topology of the space. Hence, we reformulate this definition in topological terms,
 first when one of the two points is inside and the other one is on the boundary, then for all
 cases, and then we come back to the case where one point is inside, removing the assumption that
 the other one is on the boundary.\<close>
 
 lemma extended_Gromov_product_inside_boundary_aux:
   assumes "y \<in> Gromov_boundary"
   shows "extended_Gromov_product_at e (to_Gromov_completion x) y = Inf {liminf (\<lambda>n. ereal(Gromov_product_at e x (v n))) |v. (\<lambda>n. to_Gromov_completion (v n)) \<longlonglongrightarrow> y}"
 proof -
   have A: "abs_Gromov_completion v = to_Gromov_completion x \<and> Gromov_completion_rel v v \<longleftrightarrow> (v = (\<lambda>n. x))" for v
     apply (auto simp add: to_Gromov_completion_def)
     by (metis (mono_tags) Gromov_completion_rel_def Quotient3_Gromov_completion abs_Gromov_completion_in_Gromov_boundary not_in_Gromov_boundary' rep_Gromov_completion_to_Gromov_completion rep_abs_rsp to_Gromov_completion_def)
   have *: "{F u v |u v. abs_Gromov_completion u = to_Gromov_completion x \<and> abs_Gromov_completion v = y \<and> Gromov_completion_rel u u \<and> Gromov_completion_rel v v}
       = {F (\<lambda>n. x) v |v. (\<lambda>n. to_Gromov_completion (v n)) \<longlonglongrightarrow> y}" for F::"(nat \<Rightarrow> 'a) \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> ereal"
     unfolding Gromov_completion_converge_to_boundary[OF \<open>y \<in> Gromov_boundary\<close>] using A by force
   show ?thesis
     unfolding extended_Gromov_product_at_def * by simp
 qed
 
 lemma extended_Gromov_product_boundary_inside_aux:
   assumes "y \<in> Gromov_boundary"
   shows "extended_Gromov_product_at e y (to_Gromov_completion x) = Inf {liminf (\<lambda>n. ereal(Gromov_product_at e (v n) x)) |v. (\<lambda>n. to_Gromov_completion (v n)) \<longlonglongrightarrow> y}"
 using extended_Gromov_product_inside_boundary_aux[OF assms] by (simp add: extended_Gromov_product_at_commute Gromov_product_commute)
 
 lemma extended_Gromov_product_at_topological:
   "extended_Gromov_product_at e x y = Inf {liminf (\<lambda>n. ereal(Gromov_product_at e (u n) (v n))) |u v. (\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> x \<and> (\<lambda>n. to_Gromov_completion (v n)) \<longlonglongrightarrow> y}"
 proof (cases x)
   case boundary
   show ?thesis
   proof (cases y)
     case boundary
     then show ?thesis
       unfolding extended_Gromov_product_at_def Gromov_completion_converge_to_boundary[OF \<open>x \<in> Gromov_boundary\<close>] Gromov_completion_converge_to_boundary[OF \<open>y \<in> Gromov_boundary\<close>]
       by meson
   next
     case (to_Gromov_completion yi)
     have A: "liminf (\<lambda>n. ereal (Gromov_product_at e (u n) (v n))) = liminf (\<lambda>n. ereal (Gromov_product_at e (u n) yi))" if "v \<longlonglongrightarrow> yi" for u v
     proof -
       define h where "h = (\<lambda>n. Gromov_product_at e (u n) (v n) - Gromov_product_at e (u n) yi)"
       have h: "h \<longlonglongrightarrow> 0"
         apply (rule tendsto_rabs_zero_cancel, rule tendsto_sandwich[of "\<lambda>n. 0" _ _ "\<lambda>n. dist (v n) yi"])
         unfolding h_def using Gromov_product_at_diff3[of e _ _ yi] that apply auto
         using tendsto_dist_iff by blast
       have *: "ereal (Gromov_product_at e (u n) (v n)) = h n + ereal (Gromov_product_at e (u n) yi)" for n
         unfolding h_def by auto
       have "liminf (\<lambda>n. ereal (Gromov_product_at e (u n) (v n))) = 0 + liminf (\<lambda>n. ereal (Gromov_product_at e (u n) yi))"
         unfolding * apply (rule ereal_liminf_lim_add) using h by (auto simp add: zero_ereal_def)
       then show ?thesis by simp
     qed
     show ?thesis
       unfolding to_Gromov_completion extended_Gromov_product_boundary_inside_aux[OF \<open>x \<in> Gromov_boundary\<close>] apply (rule cong[of Inf Inf], auto)
       using A by fast+
   qed
 next
   case (to_Gromov_completion xi)
   show ?thesis
   proof (cases y)
     case boundary
     have A: "liminf (\<lambda>n. ereal (Gromov_product_at e (u n) (v n))) = liminf (\<lambda>n. ereal (Gromov_product_at e xi (v n)))" if "u \<longlonglongrightarrow> xi" for u v
     proof -
       define h where "h = (\<lambda>n. Gromov_product_at e (u n) (v n) - Gromov_product_at e xi (v n))"
       have h: "h \<longlonglongrightarrow> 0"
         apply (rule tendsto_rabs_zero_cancel, rule tendsto_sandwich[of "\<lambda>n. 0" _ _ "\<lambda>n. dist (u n) xi"])
         unfolding h_def using Gromov_product_at_diff2[of e _ _ xi] that apply auto
         using tendsto_dist_iff by blast
       have *: "ereal (Gromov_product_at e (u n) (v n)) = h n + ereal (Gromov_product_at e xi (v n))" for n
         unfolding h_def by auto
       have "liminf (\<lambda>n. ereal (Gromov_product_at e (u n) (v n))) = 0 + liminf (\<lambda>n. ereal (Gromov_product_at e xi (v n)))"
         unfolding * apply (rule ereal_liminf_lim_add) using h by (auto simp add: zero_ereal_def)
       then show ?thesis by simp
     qed
     show ?thesis
       unfolding to_Gromov_completion extended_Gromov_product_inside_boundary_aux[OF \<open>y \<in> Gromov_boundary\<close>] apply (rule cong[of Inf Inf], auto)
       using A by fast+
   next
     case (to_Gromov_completion yi)
     have B: "liminf (\<lambda>n. Gromov_product_at e (u n) (v n)) = Gromov_product_at e xi yi" if "u \<longlonglongrightarrow> xi" "v \<longlonglongrightarrow> yi" for u v
     proof -
       have "(\<lambda>n. Gromov_product_at e (u n) (v n)) \<longlonglongrightarrow> Gromov_product_at e xi yi"
         apply (rule Gromov_product_at_continuous) using that by auto
       then show "liminf (\<lambda>n. Gromov_product_at e (u n) (v n)) = Gromov_product_at e xi yi"
         by (simp add: lim_imp_Liminf)
     qed
     have *: "{liminf (\<lambda>n. ereal (Gromov_product_at e (u n) (v n))) |u v. u \<longlonglongrightarrow> xi \<and> v \<longlonglongrightarrow> yi} = {ereal (Gromov_product_at e xi yi)}"
       using B apply auto by (rule exI[of _ "\<lambda>n. xi"], rule exI[of _ "\<lambda>n. yi"], auto)
     show ?thesis
       unfolding \<open>x = to_Gromov_completion xi\<close> \<open>y = to_Gromov_completion yi\<close> by (auto simp add: *)
   qed
 qed
 
 lemma extended_Gromov_product_inside_boundary:
   "extended_Gromov_product_at e (to_Gromov_completion x) y = Inf {liminf (\<lambda>n. ereal(Gromov_product_at e x (v n))) |v. (\<lambda>n. to_Gromov_completion (v n)) \<longlonglongrightarrow> y}"
 proof -
   have A: "liminf (\<lambda>n. ereal (Gromov_product_at e (u n) (v n))) = liminf (\<lambda>n. ereal (Gromov_product_at e x (v n)))" if "u \<longlonglongrightarrow> x" for u v
   proof -
     define h where "h = (\<lambda>n. Gromov_product_at e (u n) (v n) - Gromov_product_at e x (v n))"
     have h: "h \<longlonglongrightarrow> 0"
       apply (rule tendsto_rabs_zero_cancel, rule tendsto_sandwich[of "\<lambda>n. 0" _ _ "\<lambda>n. dist (u n) x"])
       unfolding h_def using Gromov_product_at_diff2[of e _ _ x] that apply auto
       using tendsto_dist_iff by blast
     have *: "ereal (Gromov_product_at e (u n) (v n)) = h n + ereal (Gromov_product_at e x (v n))" for n
       unfolding h_def by auto
     have "liminf (\<lambda>n. ereal (Gromov_product_at e (u n) (v n))) = 0 + liminf (\<lambda>n. ereal (Gromov_product_at e x (v n)))"
       unfolding * apply (rule ereal_liminf_lim_add) using h by (auto simp add: zero_ereal_def)
     then show ?thesis by simp
   qed
   show ?thesis
     unfolding extended_Gromov_product_at_topological apply (rule cong[of Inf Inf], auto)
     using A by fast+
 qed
 
 lemma extended_Gromov_product_boundary_inside:
   "extended_Gromov_product_at e y (to_Gromov_completion x) = Inf {liminf (\<lambda>n. ereal(Gromov_product_at e (v n) x)) |v. (\<lambda>n. to_Gromov_completion (v n)) \<longlonglongrightarrow> y}"
 using extended_Gromov_product_inside_boundary by (simp add: extended_Gromov_product_at_commute Gromov_product_commute)
 
 text \<open>Now, we compare the extended Gromov product to a sequence of Gromov products for converging
 sequences. As the extended Gromov product is defined as an Inf of limings, it is clearly smaller
 than the liminf. More interestingly, it is also of the order of magnitude of the limsup, for
 whatever sequence one uses. In other words, it is canonically defined, up to $2 \delta$.\<close>
 
 lemma extended_Gromov_product_le_liminf:
   assumes "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi"
           "(\<lambda>n. to_Gromov_completion (v n)) \<longlonglongrightarrow> eta"
   shows "liminf (\<lambda>n. Gromov_product_at e (u n) (v n)) \<ge> extended_Gromov_product_at e xi eta"
 unfolding extended_Gromov_product_at_topological using assms by (auto intro!: Inf_lower)
 
 lemma limsup_le_extended_Gromov_product_inside:
   assumes "(\<lambda>n. to_Gromov_completion (v n)) \<longlonglongrightarrow> (eta::('a::Gromov_hyperbolic_space) Gromov_completion)"
   shows "limsup (\<lambda>n. Gromov_product_at e x (v n)) \<le> extended_Gromov_product_at e (to_Gromov_completion x) eta + deltaG(TYPE('a))"
 proof (cases eta)
   case boundary
   have A: "limsup (\<lambda>n. Gromov_product_at e x (v n)) \<le> liminf (\<lambda>n. Gromov_product_at e x (v' n)) + deltaG(TYPE('a))"
     if H: "(\<lambda>n. to_Gromov_completion (v' n)) \<longlonglongrightarrow> eta" for v'
   proof -
     have "ereal a \<le> liminf (\<lambda>n. Gromov_product_at e x (v' n)) + deltaG(TYPE('a))" if L: "ereal a < limsup (\<lambda>n. Gromov_product_at e x (v n))" for a
     proof -
       obtain Nv where Nv: "\<And>m n. m \<ge> Nv \<Longrightarrow> n \<ge> Nv \<Longrightarrow> Gromov_product_at e (v m) (v' n) \<ge> a"
         using same_limit_imp_Gromov_product_tendsto_infinity[OF \<open>eta \<in> Gromov_boundary\<close> assms H] by blast
       obtain N where N: "ereal a < Gromov_product_at e x (v N)" "N \<ge> Nv"
         using limsup_obtain[OF L] by blast
       have *: "a - deltaG(TYPE('a)) \<le> Gromov_product_at e x (v' n)" if "n \<ge> Nv" for n
       proof -
         have "a \<le> min (Gromov_product_at e x (v N)) (Gromov_product_at e (v N) (v' n))"
           apply auto using N(1) Nv[OF \<open>N \<ge> Nv\<close> \<open>n \<ge> Nv\<close>] by auto
         also have "... \<le> Gromov_product_at e x (v' n) + deltaG(TYPE('a))"
           by (intro mono_intros)
         finally show ?thesis by auto
       qed
       have "a - deltaG(TYPE('a)) \<le> liminf (\<lambda>n. Gromov_product_at e x (v' n))"
         apply (rule Liminf_bounded) unfolding eventually_sequentially using * by fastforce
       then show ?thesis
         unfolding ereal_minus(1)[symmetric] by (subst ereal_minus_le[symmetric], auto)
     qed
     then show ?thesis
       using ereal_dense2 not_less by blast
   qed
   have "limsup (\<lambda>n. Gromov_product_at e x (v n)) - deltaG(TYPE('a)) \<le> extended_Gromov_product_at e (to_Gromov_completion x) eta"
     unfolding extended_Gromov_product_inside_boundary by (rule Inf_greatest, auto simp add: A)
   then show ?thesis by auto
 next
   case (to_Gromov_completion y)
   then have "v \<longlonglongrightarrow> y" using assms by auto
   have L: "(\<lambda>n. Gromov_product_at e x (v n)) \<longlonglongrightarrow> ereal(Gromov_product_at e x y)"
     using Gromov_product_at_continuous[OF _ _ \<open>v \<longlonglongrightarrow> y\<close>, of "\<lambda>n. e" e "\<lambda>n. x" x] by auto
   show ?thesis
     unfolding to_Gromov_completion using lim_imp_Limsup[OF _ L] by auto
 qed
 
 lemma limsup_le_extended_Gromov_product_inside':
   assumes "(\<lambda>n. to_Gromov_completion (v n)) \<longlonglongrightarrow> (eta::('a::Gromov_hyperbolic_space) Gromov_completion)"
   shows "limsup (\<lambda>n. Gromov_product_at e (v n) x) \<le> extended_Gromov_product_at e eta (to_Gromov_completion x) + deltaG(TYPE('a))"
 using limsup_le_extended_Gromov_product_inside[OF assms] by (simp add: Gromov_product_commute extended_Gromov_product_at_commute)
 
 lemma limsup_le_extended_Gromov_product:
   assumes "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> (xi::('a::Gromov_hyperbolic_space) Gromov_completion)"
           "(\<lambda>n. to_Gromov_completion (v n)) \<longlonglongrightarrow> eta"
   shows "limsup (\<lambda>n. Gromov_product_at e (u n) (v n)) \<le> extended_Gromov_product_at e xi eta + 2 * deltaG(TYPE('a))"
 proof -
   consider "xi \<in> Gromov_boundary \<and> eta \<in> Gromov_boundary" | "xi \<notin> Gromov_boundary" | "eta \<notin> Gromov_boundary"
     by blast
   then show ?thesis
   proof (cases)
     case 1
     then have B: "xi \<in> Gromov_boundary" "eta \<in> Gromov_boundary" by auto
     have A: "limsup (\<lambda>n. Gromov_product_at e (u n) (v n)) \<le> liminf (\<lambda>n. Gromov_product_at e (u' n) (v' n)) + 2 * deltaG(TYPE('a))"
       if H: "(\<lambda>n. to_Gromov_completion (u' n)) \<longlonglongrightarrow> xi" "(\<lambda>n. to_Gromov_completion (v' n)) \<longlonglongrightarrow> eta" for u' v'
     proof -
       have "ereal a \<le> liminf (\<lambda>n. Gromov_product_at e (u' n) (v' n)) + 2 * deltaG(TYPE('a))" if L: "ereal a < limsup (\<lambda>n. Gromov_product_at e (u n) (v n))" for a
       proof -
         obtain Nu where Nu: "\<And>m n. m \<ge> Nu \<Longrightarrow> n \<ge> Nu \<Longrightarrow> Gromov_product_at e (u' m) (u n) \<ge> a"
           using same_limit_imp_Gromov_product_tendsto_infinity[OF \<open>xi \<in> Gromov_boundary\<close> H(1) assms(1)] by blast
         obtain Nv where Nv: "\<And>m n. m \<ge> Nv \<Longrightarrow> n \<ge> Nv \<Longrightarrow> Gromov_product_at e (v m) (v' n) \<ge> a"
           using same_limit_imp_Gromov_product_tendsto_infinity[OF \<open>eta \<in> Gromov_boundary\<close> assms(2) H(2)] by blast
         obtain N where N: "ereal a < Gromov_product_at e (u N) (v N)" "N \<ge> max Nu Nv"
           using limsup_obtain[OF L] by blast
         then have "N \<ge> Nu" "N \<ge> Nv" by auto
         have *: "a - 2 * deltaG(TYPE('a)) \<le> Gromov_product_at e (u' n) (v' n)" if "n \<ge> max Nu Nv" for n
         proof -
           have n: "n \<ge> Nu" "n \<ge> Nv" using that by auto
           have "a \<le> Min {Gromov_product_at e (u' n) (u N), Gromov_product_at e (u N) (v N), Gromov_product_at e (v N) (v' n)}"
             apply auto using N(1) Nu[OF n(1) \<open>N \<ge> Nu\<close>] Nv[OF \<open>N \<ge> Nv\<close> n(2)] by auto
           also have "... \<le> Gromov_product_at e (u' n) (v' n) + 2 * deltaG(TYPE('a))"
             by (intro mono_intros)
           finally show ?thesis by auto
         qed
         have "a - 2 * deltaG(TYPE('a)) \<le> liminf (\<lambda>n. Gromov_product_at e (u' n) (v' n))"
           apply (rule Liminf_bounded) unfolding eventually_sequentially using * by fastforce
         then show ?thesis
           unfolding ereal_minus(1)[symmetric] by (subst ereal_minus_le[symmetric], auto)
       qed
       then show ?thesis
         using ereal_dense2 not_less by blast
     qed
     have "limsup (\<lambda>n. Gromov_product_at e (u n) (v n)) - 2 * deltaG(TYPE('a)) \<le> extended_Gromov_product_at e xi eta"
       unfolding extended_Gromov_product_at_topological by (rule Inf_greatest, auto simp add: A)
     then show ?thesis by auto
   next
     case 2
     then obtain x where x: "xi = to_Gromov_completion x" by (cases xi, auto)
     have A: "limsup (\<lambda>n. ereal (Gromov_product_at e (u n) (v n))) = limsup (\<lambda>n. ereal (Gromov_product_at e x (v n)))"
     proof -
       define h where "h = (\<lambda>n. Gromov_product_at e (u n) (v n) - Gromov_product_at e x (v n))"
       have h: "h \<longlonglongrightarrow> 0"
         apply (rule tendsto_rabs_zero_cancel, rule tendsto_sandwich[of "\<lambda>n. 0" _ _ "\<lambda>n. dist (u n) x"])
         unfolding h_def using Gromov_product_at_diff2[of e _ _ x] assms(1) unfolding x apply auto
         using tendsto_dist_iff by blast
       have *: "ereal (Gromov_product_at e (u n) (v n)) = h n + ereal (Gromov_product_at e x (v n))" for n
         unfolding h_def by auto
       have "limsup (\<lambda>n. ereal (Gromov_product_at e (u n) (v n))) = 0 + limsup (\<lambda>n. ereal (Gromov_product_at e x (v n)))"
         unfolding * apply (rule ereal_limsup_lim_add) using h by (auto simp add: zero_ereal_def)
       then show ?thesis by simp
     qed
     have *: "ereal (deltaG TYPE('a)) \<le> ereal (2 * deltaG TYPE('a))"
       by auto
     show ?thesis
       unfolding A x using limsup_le_extended_Gromov_product_inside[OF assms(2), of e x] *
       by (meson add_left_mono order.trans)
   next
     case 3
     then obtain y where y: "eta = to_Gromov_completion y" by (cases eta, auto)
     have A: "limsup (\<lambda>n. ereal (Gromov_product_at e (u n) (v n))) = limsup (\<lambda>n. ereal (Gromov_product_at e (u n) y))"
     proof -
       define h where "h = (\<lambda>n. Gromov_product_at e (u n) (v n) - Gromov_product_at e (u n) y)"
       have h: "h \<longlonglongrightarrow> 0"
         apply (rule tendsto_rabs_zero_cancel, rule tendsto_sandwich[of "\<lambda>n. 0" _ _ "\<lambda>n. dist (v n) y"])
         unfolding h_def using Gromov_product_at_diff3[of e _ _ y] assms(2) unfolding y apply auto
         using tendsto_dist_iff by blast
       have *: "ereal (Gromov_product_at e (u n) (v n)) = h n + ereal (Gromov_product_at e (u n) y)" for n
         unfolding h_def by auto
       have "limsup (\<lambda>n. ereal (Gromov_product_at e (u n) (v n))) = 0 + limsup (\<lambda>n. ereal (Gromov_product_at e (u n) y))"
         unfolding * apply (rule ereal_limsup_lim_add) using h by (auto simp add: zero_ereal_def)
       then show ?thesis by simp
     qed
     have *: "ereal (deltaG TYPE('a)) \<le> ereal (2 * deltaG TYPE('a))"
       by auto
     show ?thesis
       unfolding A y using limsup_le_extended_Gromov_product_inside'[OF assms(1), of e y] *
       by (meson add_left_mono order.trans)
   qed
 qed
 
 text \<open>One can then extend to the boundary the fact that $(y,z)_x + (x,z)_y = d(x,y)$, up to a
 constant $\delta$, by taking this identity inside and passing to the limit.\<close>
 
 lemma extended_Gromov_product_add_le:
   "extended_Gromov_product_at x xi (to_Gromov_completion y) + extended_Gromov_product_at y xi (to_Gromov_completion x) \<le> dist x y"
 proof -
   obtain u where u: "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi"
     using rep_Gromov_completion_limit by blast
   have "liminf (\<lambda>n. ereal (Gromov_product_at a b (u n))) \<ge> 0" for a b
     by (rule Liminf_bounded[OF always_eventually], auto)
   then have *: "liminf (\<lambda>n. ereal (Gromov_product_at a b (u n))) \<noteq> -\<infinity>" for a b
     by auto
   have "extended_Gromov_product_at x xi (to_Gromov_completion y) + extended_Gromov_product_at y xi (to_Gromov_completion x)
       \<le> liminf (\<lambda>n. ereal (Gromov_product_at x y (u n))) + liminf (\<lambda>n. Gromov_product_at y x (u n))"
     apply (intro mono_intros)
     using extended_Gromov_product_le_liminf [OF u, of "\<lambda>n. y" "to_Gromov_completion y" x]
       extended_Gromov_product_le_liminf [OF u, of "\<lambda>n. x" "to_Gromov_completion x" y] by (auto simp add: Gromov_product_commute)
   also have "... \<le> liminf (\<lambda>n. ereal (Gromov_product_at x y (u n)) + Gromov_product_at y x (u n))"
     by (rule ereal_liminf_add_mono, auto simp add: *)
   also have "... = dist x y"
     apply (simp add: Gromov_product_add)
     by (metis lim_imp_Liminf sequentially_bot tendsto_const)
   finally show ?thesis by auto
 qed
 
 lemma extended_Gromov_product_add_ge:
   "extended_Gromov_product_at (x::'a::Gromov_hyperbolic_space) xi (to_Gromov_completion y) + extended_Gromov_product_at y xi (to_Gromov_completion x) \<ge> dist x y - deltaG(TYPE('a))"
 proof -
   have A: "dist x y - extended_Gromov_product_at y (to_Gromov_completion x) xi - deltaG(TYPE('a)) \<le> liminf (\<lambda>n. ereal (Gromov_product_at x y (u n)))"
     if "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> xi" for u
   proof -
     have "dist x y = liminf (\<lambda>n. ereal (Gromov_product_at x y (u n)) + Gromov_product_at y x (u n))"
       apply (simp add: Gromov_product_add)
       by (metis lim_imp_Liminf sequentially_bot tendsto_const)
     also have "... \<le> liminf (\<lambda>n. ereal (Gromov_product_at x y (u n))) + limsup (\<lambda>n. Gromov_product_at y x (u n))"
       by (rule ereal_liminf_limsup_add)
     also have "... \<le> liminf (\<lambda>n. ereal (Gromov_product_at x y (u n))) + (extended_Gromov_product_at y (to_Gromov_completion x) xi + deltaG(TYPE('a)))"
       by (intro mono_intros limsup_le_extended_Gromov_product_inside[OF that])
     finally show ?thesis by (auto simp add: algebra_simps)
   qed
   have "dist x y - extended_Gromov_product_at y (to_Gromov_completion x) xi - deltaG(TYPE('a)) \<le> extended_Gromov_product_at x (to_Gromov_completion y) xi"
     unfolding extended_Gromov_product_inside_boundary[of x] apply (rule Inf_greatest) using A by auto
   then show ?thesis
     apply (auto simp add: algebra_simps extended_Gromov_product_at_commute)
     unfolding ereal_minus(1)[symmetric] by (subst ereal_minus_le, auto simp add: algebra_simps)
 qed
 
 text \<open>If one perturbs a sequence inside the space by a bounded distance, one does not change the
 limit on the boundary.\<close>
 
 lemma Gromov_converging_at_boundary_bounded_perturbation:
   assumes "(\<lambda>n. to_Gromov_completion (u n)) \<longlonglongrightarrow> x"
           "x \<in> Gromov_boundary"
           "\<And>n. dist (u n) (v n) \<le> C"
   shows "(\<lambda>n. to_Gromov_completion (v n)) \<longlonglongrightarrow> x"
 proof -
   have "(\<lambda>n. extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x) \<longlonglongrightarrow> \<infinity>"
   proof (rule tendsto_sandwich[of "\<lambda>n. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x - C" _ _ "\<lambda>n. \<infinity>"])
     show "\<forall>\<^sub>F n in sequentially. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x - ereal C \<le> extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x"
     proof (rule always_eventually, auto)
       fix n::nat
       have "extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x \<le> extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x
                   + extended_Gromov_distance (to_Gromov_completion (u n)) (to_Gromov_completion (v n))"
         by (intro mono_intros)
       also have "... \<le> extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x + C"
         using assms(3)[of n] by (intro mono_intros, auto)
       finally show "extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x \<le> extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x + ereal C"
         by auto
     qed
     have "(\<lambda>n. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x - ereal C) \<longlonglongrightarrow> \<infinity> - ereal C"
       apply (intro tendsto_intros)
       unfolding Gromov_completion_boundary_limit[OF \<open>x \<in> Gromov_boundary\<close>, symmetric] using assms(1) by auto
     then show "(\<lambda>n. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x - ereal C) \<longlonglongrightarrow> \<infinity>"
       by auto
   qed (auto)
   then show ?thesis
     unfolding Gromov_completion_boundary_limit[OF \<open>x \<in> Gromov_boundary\<close>] by simp
 qed
 
 text \<open>We prove that the extended Gromov distance is a continuous function of one variable,
 by separating the different cases at infinity and inside the space. Note that it is not a
 continuous function of both variables: if $u_n$ is inside the space but tends to a point $x$ in the
 boundary, then the extended Gromov distance between $u_n$ and $u_n$ is $0$, but for the limit it is
 $\infty$.\<close>
 
 lemma extended_Gromov_distance_continuous:
   "continuous_on UNIV (\<lambda>y. extended_Gromov_distance x y)"
 proof (cases x)
   text \<open>First, if $x$ is in the boundary, then all distances to $x$ are infinite, and the statement
   is trivial.\<close>
   case boundary
   then have *: "extended_Gromov_distance x y = \<infinity>" for y
     by auto
   show ?thesis
     unfolding * using continuous_on_topological by blast
 next
   text \<open>Next, consider the case where $x$ is inside the space. We split according to whether $y$ is
   inside the space or at infinity.\<close>
   case (to_Gromov_completion a)
   have "(\<lambda>n. extended_Gromov_distance x (u n)) \<longlonglongrightarrow> extended_Gromov_distance x y" if "u \<longlonglongrightarrow> y" for u y
   proof (cases y)
     text \<open>If $y$ is at infinity, then we know that the Gromov product of $u_n$ and $y$ tends to
     infinity. Therefore, the extended distance from $u_n$ to any fixed point also tends to infinity
     (as the Gromov product is bounded from below by the extended distance).\<close>
     case boundary
     have *: "(\<lambda>n. extended_Gromov_product_at a (u n) y) \<longlonglongrightarrow> \<infinity>"
       by (rule extended_Gromov_product_tendsto_PInf_a_b[OF iffD1[OF Gromov_completion_boundary_limit, OF boundary \<open>u \<longlonglongrightarrow> y\<close>]])
     have "(\<lambda>n. extended_Gromov_distance x (u n)) \<longlonglongrightarrow> \<infinity>"
       apply (rule tendsto_sandwich[of "\<lambda>n. extended_Gromov_product_at a (u n) y" _ _ "\<lambda>_. \<infinity>"])
       unfolding to_Gromov_completion using extended_Gromov_product_le_dist[of a "u _" y] * by auto
     then show ?thesis using boundary by auto
   next
     text \<open>If $y$ is inside the space, then we use the triangular inequality for the extended Gromov
     distance to conclure.\<close>
     case (to_Gromov_completion b)
     then have F: "y \<notin> Gromov_boundary" by auto
     have *: "(\<lambda>n. extended_Gromov_distance (u n) y) \<longlonglongrightarrow> 0"
       by (rule iffD1[OF Gromov_completion_inside_limit[OF F] \<open>u \<longlonglongrightarrow> y\<close>])
     show "(\<lambda>n. extended_Gromov_distance x (u n)) \<longlonglongrightarrow> extended_Gromov_distance x y"
     proof (rule tendsto_sandwich[of "\<lambda>n. extended_Gromov_distance x y - extended_Gromov_distance (u n) y" _ _
                                     "\<lambda>n. extended_Gromov_distance x y + extended_Gromov_distance (u n) y"])
       have "extended_Gromov_distance x y - extended_Gromov_distance (u n) y \<le> extended_Gromov_distance x (u n)" for n
         using extended_Gromov_distance_triangle[of y x "u n"]
         by (auto simp add: extended_Gromov_distance_commute F ennreal_minus_le_iff extended_Gromov_distance_def)
       then show "\<forall>\<^sub>F n in sequentially. extended_Gromov_distance x y - extended_Gromov_distance (u n) y \<le> extended_Gromov_distance x (u n)"
         by auto
       have "extended_Gromov_distance x (u n) \<le> extended_Gromov_distance x y + extended_Gromov_distance (u n) y" for n
         using extended_Gromov_distance_triangle[of x "u n" y] by (auto simp add: extended_Gromov_distance_commute)
       then show "\<forall>\<^sub>F n in sequentially. extended_Gromov_distance x (u n) \<le> extended_Gromov_distance x y + extended_Gromov_distance (u n) y"
         by auto
       have "(\<lambda>n. extended_Gromov_distance x y - extended_Gromov_distance (u n) y) \<longlonglongrightarrow> extended_Gromov_distance x y - 0"
         by (intro tendsto_intros *, auto)
       then show "(\<lambda>n. extended_Gromov_distance x y - extended_Gromov_distance (u n) y) \<longlonglongrightarrow> extended_Gromov_distance x y"
         by simp
       have "(\<lambda>n. extended_Gromov_distance x y + extended_Gromov_distance (u n) y) \<longlonglongrightarrow> extended_Gromov_distance x y + 0"
         by (intro tendsto_intros *, auto)
       then show "(\<lambda>n. extended_Gromov_distance x y + extended_Gromov_distance (u n) y) \<longlonglongrightarrow> extended_Gromov_distance x y"
         by simp
     qed
   qed
   then show ?thesis
     unfolding continuous_on_sequentially comp_def by auto
 qed
 
 lemma extended_Gromov_distance_continuous':
   "continuous_on UNIV (\<lambda>x. extended_Gromov_distance x y)"
 using extended_Gromov_distance_continuous[of y] extended_Gromov_distance_commute[of _ y] by auto
 
 
 subsection \<open>Topology of the Gromov boundary\<close>
 
 text \<open>We deduce the basic fact that the original space is open in the Gromov completion from the
 continuity of the extended distance.\<close>
 
 lemma to_Gromov_completion_range_open:
   "open (range to_Gromov_completion)"
 proof -
   have *: "range to_Gromov_completion = (\<lambda>x. extended_Gromov_distance (to_Gromov_completion basepoint) x)-`{..<\<infinity>}"
     using Gromov_boundary_def extended_Gromov_distance_PInf_boundary(2) by fastforce
   show ?thesis
     unfolding * using extended_Gromov_distance_continuous open_lessThan open_vimage by blast
 qed
 
 lemma Gromov_boundary_closed:
   "closed Gromov_boundary"
 unfolding Gromov_boundary_def using to_Gromov_completion_range_open by auto
 
 text \<open>The original space is also dense in its Gromov completion, as all points at infinity are
 by definition limits of some sequence in the space.\<close>
 
 lemma to_Gromov_completion_range_dense [simp]:
   "closure (range to_Gromov_completion) = UNIV"
 apply (auto simp add: closure_sequential) using rep_Gromov_completion_limit by force
 
 lemma to_Gromov_completion_homeomorphism:
   "homeomorphism_on UNIV to_Gromov_completion"
 by (rule homeomorphism_on_sequentially, auto)
 
 lemma to_Gromov_completion_continuous:
   "continuous_on UNIV to_Gromov_completion"
 by (rule homeomorphism_on_continuous[OF to_Gromov_completion_homeomorphism])
 
 lemma from_Gromov_completion_continuous:
   "homeomorphism_on (range to_Gromov_completion) from_Gromov_completion"
   "continuous_on (range to_Gromov_completion) from_Gromov_completion"
   "\<And>x::('a::Gromov_hyperbolic_space) Gromov_completion. x \<in> range to_Gromov_completion \<Longrightarrow> continuous (at x) from_Gromov_completion"
 proof -
   show *: "homeomorphism_on (range to_Gromov_completion) from_Gromov_completion"
     using homeomorphism_on_inverse[OF to_Gromov_completion_homeomorphism] unfolding from_Gromov_completion_def[symmetric] by simp
   show "continuous_on (range to_Gromov_completion) from_Gromov_completion"
     by (simp add: * homeomorphism_on_continuous)
   then show "continuous (at x) from_Gromov_completion" if "x \<in> range to_Gromov_completion" for x::"'a Gromov_completion"
     using continuous_on_eq_continuous_at that to_Gromov_completion_range_open by auto
 qed
 
 text \<open>The Gromov boundary is always complete. Indeed, consider a Cauchy sequence $u_n$ in the
 boundary, and approximate well enough $u_n$ by a point $v_n$ inside. Then the sequence $v_n$
 is Gromov converging at infinity (the respective Gromov products tend to infinity essentially
 by definition), and its limit point is the limit of the original sequence $u$.\<close>
 
 proposition Gromov_boundary_complete:
   "complete Gromov_boundary"
 proof (rule completeI)
   fix u::"nat \<Rightarrow> 'a Gromov_completion" assume "\<forall>n. u n \<in> Gromov_boundary" "Cauchy u"
   then have u: "\<And>n. u n \<in> Gromov_boundary" by auto
   have *: "\<exists>x \<in> range to_Gromov_completion. dist (u n) x < 1/real(n+1)" for n
     by (rule closure_approachableD, auto simp add: to_Gromov_completion_range_dense)
   have "\<exists>v. \<forall>n. dist (to_Gromov_completion (v n)) (u n) < 1/real(n+1)"
     using of_nat_less_top apply (intro choice) using * by (auto simp add: dist_commute)
   then obtain v where v: "\<And>n. dist (to_Gromov_completion (v n)) (u n) < 1/real(n+1)"
     by blast
   have "(\<lambda>n. dist (to_Gromov_completion (v n)) (u n)) \<longlonglongrightarrow> 0"
     apply (rule tendsto_sandwich[of "\<lambda>_. 0" _ _ "\<lambda>n. 1/real(n+1)"])
     using v LIMSEQ_ignore_initial_segment[OF lim_1_over_n, of 1] unfolding eventually_sequentially
     by (auto simp add: less_imp_le)
 
   have "Gromov_converging_at_boundary v"
   proof (rule Gromov_converging_at_boundaryI[of basepoint])
     fix M::real
     obtain D1 e1 where D1: "e1 > 0" "D1 < \<infinity>" "\<And>x y::'a Gromov_completion. dist x y \<le> e1 \<Longrightarrow> extended_Gromov_distance x (to_Gromov_completion basepoint) \<ge> D1 \<Longrightarrow> extended_Gromov_product_at basepoint x y \<ge> ereal M"
       using large_Gromov_product_approx[of "ereal M"] by auto
     obtain D2 e2 where D2: "e2 > 0" "D2 < \<infinity>" "\<And>x y::'a Gromov_completion. dist x y \<le> e2 \<Longrightarrow> extended_Gromov_distance x (to_Gromov_completion basepoint) \<ge> D2 \<Longrightarrow> extended_Gromov_product_at basepoint x y \<ge> D1"
       using large_Gromov_product_approx[OF \<open>D1 < \<infinity>\<close>] by auto
     define e where "e = (min e1 e2)/3"
     have "e > 0" unfolding e_def using \<open>e1 > 0\<close> \<open>e2 > 0\<close> by auto
     then obtain N1 where N1: "\<And>n m. n \<ge> N1 \<Longrightarrow> m \<ge> N1 \<Longrightarrow> dist (u n) (u m) < e"
       using \<open>Cauchy u\<close> unfolding Cauchy_def by blast
     have "eventually (\<lambda>n. dist (to_Gromov_completion (v n)) (u n) < e) sequentially"
       by (rule order_tendstoD[OF \<open>(\<lambda>n. dist (to_Gromov_completion (v n)) (u n)) \<longlonglongrightarrow> 0\<close>], fact)
     then obtain N2 where N2: "\<And>n. n \<ge> N2 \<Longrightarrow> dist (to_Gromov_completion (v n)) (u n) < e"
       unfolding eventually_sequentially by auto
     have "ereal M \<le> extended_Gromov_product_at basepoint (to_Gromov_completion (v m)) (to_Gromov_completion (v n))"
       if "n \<ge> max N1 N2" "m \<ge> max N1 N2" for m n
     proof (rule D1(3))
       have "dist (to_Gromov_completion (v m)) (to_Gromov_completion (v n))
         \<le> dist (to_Gromov_completion (v m)) (u m) + dist (u m) (u n) + dist (u n) (to_Gromov_completion (v n))"
         by (intro mono_intros)
       also have "... \<le> e + e + e"
         apply (intro mono_intros)
         using N1[of m n] N2[of n] N2[of m] that by (auto simp add: dist_commute)
       also have "... \<le> e1" unfolding e_def by auto
       finally show "dist (to_Gromov_completion (v m)) (to_Gromov_completion (v n)) \<le> e1" by simp
 
       have "e \<le> e2" unfolding e_def using \<open>e2 > 0\<close> by auto
       have "D1 \<le> extended_Gromov_product_at basepoint (u m) (to_Gromov_completion (v m))"
         apply (rule D2(3)) using N2[of m] that \<open>e \<le> e2\<close> u[of m] by (auto simp add: dist_commute)
       also have "... \<le> extended_Gromov_distance (to_Gromov_completion basepoint) (to_Gromov_completion (v m))"
         using extended_Gromov_product_le_dist[of basepoint "to_Gromov_completion (v m)" "u m"]
         by (simp add: extended_Gromov_product_at_commute)
       finally show "D1 \<le> extended_Gromov_distance (to_Gromov_completion (v m)) (to_Gromov_completion basepoint)"
         by (simp add: extended_Gromov_distance_commute)
     qed
     then have "M \<le> Gromov_product_at basepoint (v m) (v n)" if "n \<ge> max N1 N2" "m \<ge> max N1 N2" for m n
       using that by auto
     then show "\<exists>N. \<forall>n \<ge> N. \<forall>m \<ge> N. M \<le> Gromov_product_at basepoint (v m) (v n)"
       by blast
   qed
   then obtain l where l: "l \<in> Gromov_boundary" "(\<lambda>n. to_Gromov_completion (v n)) \<longlonglongrightarrow> l"
     using Gromov_converging_at_boundary_converges by blast
   have "(\<lambda>n. dist (u n) l) \<longlonglongrightarrow> 0+0"
   proof (rule tendsto_sandwich[of "\<lambda>_. 0" _ _ "\<lambda>n. dist (u n) (to_Gromov_completion (v n)) + dist (to_Gromov_completion (v n)) l"])
     show "(\<lambda>n. dist (u n) (to_Gromov_completion (v n)) + dist (to_Gromov_completion (v n)) l) \<longlonglongrightarrow> 0 + 0"
       apply (intro tendsto_intros)
       using iffD1[OF tendsto_dist_iff l(2)] \<open>(\<lambda>n. dist (to_Gromov_completion (v n)) (u n)) \<longlonglongrightarrow> 0\<close>
       by (auto simp add: dist_commute)
   qed (auto simp add: dist_triangle)
   then have "u \<longlonglongrightarrow> l"
     using iffD2[OF tendsto_dist_iff] by auto
   then show "\<exists>l\<in>Gromov_boundary. u \<longlonglongrightarrow> l"
     using l(1) by auto
 qed
 
 text \<open>When the initial space is complete, then the whole Gromov completion is also complete:
 for Cauchy sequences tending to the Gromov boundary, then the convergence is proved as in the
 completeness of the boundary above. For Cauchy sequences that remain bounded, the convergence
 is reduced to the convergence inside the original space, which holds by assumption.\<close>
 
 proposition Gromov_completion_complete:
   assumes "complete (UNIV::'a::Gromov_hyperbolic_space set)"
   shows "complete (UNIV::'a Gromov_completion set)"
 proof (rule completeI, auto)
   fix u0::"nat \<Rightarrow> 'a Gromov_completion" assume "Cauchy u0"
   show "\<exists>l. u0 \<longlonglongrightarrow> l"
   proof (cases "limsup (\<lambda>n. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n)) = \<infinity>")
     case True
     then obtain r where r: "strict_mono r" "(\<lambda>n. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 (r n))) \<longlonglongrightarrow> \<infinity>"
       using limsup_subseq_lim[of "(\<lambda>n. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n))"] unfolding comp_def
       by auto
     define u where "u = u0 o r"
     then have "(\<lambda>n. extended_Gromov_distance (to_Gromov_completion basepoint) (u n)) \<longlonglongrightarrow> \<infinity>"
       unfolding comp_def using r(2) by simp
     have "Cauchy u"
       using \<open>Cauchy u0\<close> r(1) u_def by (simp add: Cauchy_subseq_Cauchy)
 
     have *: "\<exists>x \<in> range to_Gromov_completion. dist (u n) x < 1/real(n+1)" for n
       by (rule closure_approachableD, auto)
     have "\<exists>v. \<forall>n. dist (to_Gromov_completion (v n)) (u n) < 1/real(n+1)"
       using of_nat_less_top apply (intro choice) using * by (auto simp add: dist_commute)
     then obtain v where v: "\<And>n. dist (to_Gromov_completion (v n)) (u n) < 1/real(n+1)"
       by blast
     have "(\<lambda>n. dist (to_Gromov_completion (v n)) (u n)) \<longlonglongrightarrow> 0"
       apply (rule tendsto_sandwich[of "\<lambda>_. 0" _ _ "\<lambda>n. 1/real(n+1)"])
       using v LIMSEQ_ignore_initial_segment[OF lim_1_over_n, of 1] unfolding eventually_sequentially
       by (auto simp add: less_imp_le)
 
     have "Gromov_converging_at_boundary v"
     proof (rule Gromov_converging_at_boundaryI[of basepoint])
       fix M::real
       obtain D1 e1 where D1: "e1 > 0" "D1 < \<infinity>" "\<And>x y::'a Gromov_completion. dist x y \<le> e1 \<Longrightarrow> extended_Gromov_distance x (to_Gromov_completion basepoint) \<ge> D1 \<Longrightarrow> extended_Gromov_product_at basepoint x y \<ge> ereal M"
         using large_Gromov_product_approx[of "ereal M"] by auto
       obtain D2 e2 where D2: "e2 > 0" "D2 < \<infinity>" "\<And>x y::'a Gromov_completion. dist x y \<le> e2 \<Longrightarrow> extended_Gromov_distance x (to_Gromov_completion basepoint) \<ge> D2 \<Longrightarrow> extended_Gromov_product_at basepoint x y \<ge> D1"
         using large_Gromov_product_approx[OF \<open>D1 < \<infinity>\<close>] by auto
       define e where "e = (min e1 e2)/3"
       have "e > 0" unfolding e_def using \<open>e1 > 0\<close> \<open>e2 > 0\<close> by auto
       then obtain N1 where N1: "\<And>n m. n \<ge> N1 \<Longrightarrow> m \<ge> N1 \<Longrightarrow> dist (u n) (u m) < e"
         using \<open>Cauchy u\<close> unfolding Cauchy_def by blast
       have "eventually (\<lambda>n. dist (to_Gromov_completion (v n)) (u n) < e) sequentially"
         by (rule order_tendstoD[OF \<open>(\<lambda>n. dist (to_Gromov_completion (v n)) (u n)) \<longlonglongrightarrow> 0\<close>], fact)
       then obtain N2 where N2: "\<And>n. n \<ge> N2 \<Longrightarrow> dist (to_Gromov_completion (v n)) (u n) < e"
         unfolding eventually_sequentially by auto
       have "eventually (\<lambda>n. extended_Gromov_distance (to_Gromov_completion basepoint) (u n) > D2) sequentially"
         by (rule order_tendstoD[OF \<open>(\<lambda>n. extended_Gromov_distance (to_Gromov_completion basepoint) (u n)) \<longlonglongrightarrow> \<infinity>\<close>], fact)
       then obtain N3 where N3: "\<And>n. n \<ge> N3 \<Longrightarrow> extended_Gromov_distance (to_Gromov_completion basepoint) (u n) > D2"
         unfolding eventually_sequentially by auto
       define N where "N = N1+N2+N3"
       have N: "N \<ge> N1" "N \<ge> N2" "N \<ge> N3" unfolding N_def by auto
       have "ereal M \<le> extended_Gromov_product_at basepoint (to_Gromov_completion (v m)) (to_Gromov_completion (v n))"
         if "n \<ge> N" "m \<ge> N" for m n
       proof (rule D1(3))
         have "dist (to_Gromov_completion (v m)) (to_Gromov_completion (v n))
           \<le> dist (to_Gromov_completion (v m)) (u m) + dist (u m) (u n) + dist (u n) (to_Gromov_completion (v n))"
           by (intro mono_intros)
         also have "... \<le> e + e + e"
           apply (intro mono_intros)
           using N1[of m n] N2[of n] N2[of m] that N by (auto simp add: dist_commute)
         also have "... \<le> e1" unfolding e_def by auto
         finally show "dist (to_Gromov_completion (v m)) (to_Gromov_completion (v n)) \<le> e1" by simp
 
         have "e \<le> e2" unfolding e_def using \<open>e2 > 0\<close> by auto
         have "D1 \<le> extended_Gromov_product_at basepoint (u m) (to_Gromov_completion (v m))"
           apply (rule D2(3)) using N2[of m] N3[of m] that N \<open>e \<le> e2\<close>
           by (auto simp add: dist_commute extended_Gromov_distance_commute)
         also have "... \<le> extended_Gromov_distance (to_Gromov_completion basepoint) (to_Gromov_completion (v m))"
           using extended_Gromov_product_le_dist[of basepoint "to_Gromov_completion (v m)" "u m"]
           by (simp add: extended_Gromov_product_at_commute)
         finally show "D1 \<le> extended_Gromov_distance (to_Gromov_completion (v m)) (to_Gromov_completion basepoint)"
           by (simp add: extended_Gromov_distance_commute)
       qed
       then have "M \<le> Gromov_product_at basepoint (v m) (v n)" if "n \<ge> N" "m \<ge> N" for m n
         using that by auto
       then show "\<exists>N. \<forall>n \<ge> N. \<forall>m \<ge> N. M \<le> Gromov_product_at basepoint (v m) (v n)"
         by blast
     qed
     then obtain l where l: "l \<in> Gromov_boundary" "(\<lambda>n. to_Gromov_completion (v n)) \<longlonglongrightarrow> l"
       using Gromov_converging_at_boundary_converges by blast
     have "(\<lambda>n. dist (u n) l) \<longlonglongrightarrow> 0+0"
     proof (rule tendsto_sandwich[of "\<lambda>_. 0" _ _ "\<lambda>n. dist (u n) (to_Gromov_completion (v n)) + dist (to_Gromov_completion (v n)) l"])
       show "(\<lambda>n. dist (u n) (to_Gromov_completion (v n)) + dist (to_Gromov_completion (v n)) l) \<longlonglongrightarrow> 0 + 0"
         apply (intro tendsto_intros)
         using iffD1[OF tendsto_dist_iff l(2)] \<open>(\<lambda>n. dist (to_Gromov_completion (v n)) (u n)) \<longlonglongrightarrow> 0\<close>
         by (auto simp add: dist_commute)
     qed (auto simp add: dist_triangle)
     then have "u \<longlonglongrightarrow> l"
       using iffD2[OF tendsto_dist_iff] by auto
     then have "u0 \<longlonglongrightarrow> l"
       unfolding u_def using r(1) \<open>Cauchy u0\<close> Cauchy_converges_subseq by auto
     then show "\<exists>l. u0 \<longlonglongrightarrow> l"
       by auto
   next
     case False
     define C where "C = limsup (\<lambda>n. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n)) + 1"
     have "C < \<infinity>" unfolding C_def using False less_top by fastforce
     have *: "limsup (\<lambda>n. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n)) \<ge> 0"
       by (intro le_Limsup always_eventually, auto)
     have "limsup (\<lambda>n. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n)) < C"
       unfolding C_def using False * ereal_add_left_cancel_less by force
     then have "eventually (\<lambda>n. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n) < C) sequentially"
       using Limsup_lessD by blast
     then obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n) < C"
       unfolding eventually_sequentially by auto
     define r where "r = (\<lambda>n. n + N)"
     have r: "strict_mono r" unfolding r_def strict_mono_def by auto
     define u where "u = (u0 o r)"
     have "Cauchy u"
       using \<open>Cauchy u0\<close> r(1) u_def by (simp add: Cauchy_subseq_Cauchy)
     have u: "extended_Gromov_distance (to_Gromov_completion basepoint) (u n) \<le> C" for n
       unfolding u_def comp_def r_def using N by (auto simp add: less_imp_le)
     define v where "v = (\<lambda>n. from_Gromov_completion (u n))"
     have uv: "u n = to_Gromov_completion (v n)" for n
       unfolding v_def apply (rule to_from_Gromov_completion[symmetric]) using u[of n] \<open>C < \<infinity>\<close> by auto
     have "Cauchy v"
     proof (rule metric_CauchyI)
       obtain a::real where a: "a > 0" "\<And>x y::'a Gromov_completion. extended_Gromov_distance (to_Gromov_completion basepoint) x \<le> C \<Longrightarrow> dist x y \<le> a
           \<Longrightarrow> esqrt(extended_Gromov_distance x y) \<le> 2 * ereal(dist x y)"
         using inside_Gromov_distance_approx[OF \<open>C < \<infinity>\<close>] by auto
       fix e::real assume "e > 0"
       define e2 where "e2 = min (sqrt (e/2) /2) a"
       have "e2 > 0" unfolding e2_def using \<open>e > 0\<close> \<open>a > 0\<close> by auto
       then obtain N where N: "\<And>m n. m \<ge> N \<Longrightarrow> n \<ge> N \<Longrightarrow> dist (u m) (u n) < e2"
         using \<open>Cauchy u\<close> unfolding Cauchy_def by blast
       have "dist (v m) (v n) < e" if "n \<ge> N" "m \<ge> N" for m n
       proof -
         have "ereal(sqrt(dist (v m) (v n))) = esqrt(extended_Gromov_distance (u m) (u n))"
           unfolding uv by (auto simp add: esqrt_ereal_ereal_sqrt)
         also have "... \<le> 2 * ereal(dist (u m) (u n))"
           apply (rule a(2)) using u[of m] N[OF \<open>m \<ge> N\<close> \<open>n \<ge> N\<close>] unfolding e2_def by auto
         also have "... = ereal(2 * dist (u m) (u n))"
           by simp
         also have "... \<le> ereal(2 * e2)"
           apply (intro mono_intros) using N[OF \<open>m \<ge> N\<close> \<open>n \<ge> N\<close>] less_imp_le by auto
         finally have "sqrt(dist (v m) (v n)) \<le> 2 * e2"
           using \<open>e2 > 0\<close> by auto
         also have "... \<le> sqrt (e/2)"
           unfolding e2_def by auto
         finally have "dist (v m) (v n) \<le> e/2"
           by auto
         then show ?thesis
           using \<open>e > 0\<close> by auto
       qed
       then show "\<exists>M. \<forall>m \<ge> M. \<forall>n \<ge> M. dist (v m) (v n) < e" by auto
     qed
     then obtain l where "v \<longlonglongrightarrow> l"
       using \<open>complete (UNIV::'a set)\<close> complete_def by blast
     then have "u \<longlonglongrightarrow> (to_Gromov_completion l)"
       unfolding uv by auto
     then have "u0 \<longlonglongrightarrow> (to_Gromov_completion l)"
       unfolding u_def using r(1) \<open>Cauchy u0\<close> Cauchy_converges_subseq by auto
     then show "\<exists>l. u0 \<longlonglongrightarrow> l"
       by auto
   qed
 qed
 
 instance Gromov_completion::("{Gromov_hyperbolic_space, complete_space}") complete_space
   apply standard
   using Gromov_completion_complete complete_def convergent_def complete_UNIV by auto
 
 text \<open>When the original space is proper, i.e., closed balls are compact, and geodesic, then the
 Gromov completion (and therefore the Gromov boundary) are compact. The idea to extract a convergent
 subsequence of a sequence $u_n$ in the boundary is to take the point $v_n$ at distance $T$ along
 a geodesic tending to the point $u_n$ on the boundary, where $T$ is fixed and large. The points
 $v_n$ live in a bounded subset of the space, hence they have a convergent subsequence $v_{j(n)}$.
 It follows that $u_{j(n)}$ is almost converging, up to an error that tends to $0$ when $T$ tends
 to infinity. By a diagonal argument, we obtain a convergent subsequence of $u_n$.
 
 As we have already proved that the space is complete, there is a shortcut to the above argument,
 avoiding subsequences and diagonal argument altogether. Indeed, in a complete space it suffices
 to show that for any $\epsilon > 0$ it is covered by finitely many balls of radius $\epsilon$ to get
 the compactness. This is what we do in the following proof, although the argument is precisely
 modelled on the first proof we have explained.\<close>
 
 theorem Gromov_completion_compact:
   assumes "proper (UNIV::'a::Gromov_hyperbolic_space_geodesic set)"
   shows "compact (UNIV::'a Gromov_completion set)"
 proof -
   have "\<exists>k. finite k \<and> (UNIV::'a Gromov_completion set) \<subseteq> (\<Union>x\<in>k. ball x e)" if "e > 0" for e
   proof -
     define D::real where "D = max 0 (-ln(e/4)/epsilonG(TYPE('a)))"
     have "D \<ge> 0" unfolding D_def by auto
     have "exp(-epsilonG(TYPE('a)) * D) \<le> exp(ln (e / 4))"
       unfolding D_def apply (intro mono_intros) unfolding max_def
       apply auto
       using constant_in_extended_predist_pos(1)[where ?'a = 'a] by (auto simp add: divide_simps)
     then have "exp(-epsilonG(TYPE('a)) * D) \<le> e/4" using \<open>e > 0\<close> by auto
     define e0::real where "e0 = e * e / 16"
     have "e0 > 0" using \<open>e > 0\<close> unfolding e0_def by auto
     obtain k::"'a set" where k: "finite k" "cball basepoint D \<subseteq> (\<Union>x\<in>k. ball x e0)"
       using compact_eq_totally_bounded[of "cball (basepoint::'a) D"] assms \<open>e0 > 0\<close>
       unfolding proper_def by auto
     have A: "\<exists>y \<in> k. dist (to_Gromov_completion y) (to_Gromov_completion x) \<le> e/4" if "dist basepoint x \<le> D" for x::'a
     proof -
       obtain z where z: "z \<in> k" "dist z x < e0" using \<open>dist basepoint x \<le> D\<close> k(2) by auto
       have "ereal(dist (to_Gromov_completion z) (to_Gromov_completion x)) \<le> esqrt(extended_Gromov_distance (to_Gromov_completion z) (to_Gromov_completion x))"
         by (intro mono_intros)
       also have "... = ereal(sqrt (dist z x))"
         by auto
       finally have "dist (to_Gromov_completion z) (to_Gromov_completion x) \<le> sqrt (dist z x)"
         by auto
       also have "... \<le> sqrt e0"
         using z(2) by auto
       also have "... \<le> e/4"
         unfolding e0_def using \<open>e > 0\<close> by (auto simp add: less_imp_le real_sqrt_divide)
       finally have "dist (to_Gromov_completion z) (to_Gromov_completion x) \<le> e/4"
         by auto
       then show ?thesis
         using \<open>z \<in> k\<close> by auto
     qed
     have B: "\<exists>y \<in> k. dist (to_Gromov_completion y) (to_Gromov_completion x) \<le> e/2" for x
     proof (cases "dist basepoint x \<le> D")
       case True
       have "e/4 \<le> e/2" using \<open>e > 0\<close> by auto
       then show ?thesis using A[OF True] by force
     next
       case False
       define x2 where "x2 = geodesic_segment_param {basepoint--x} basepoint D"
       have *: "Gromov_product_at basepoint x x2 = D"
         unfolding x2_def apply (rule Gromov_product_geodesic_segment) using False \<open>D \<ge> 0\<close> by auto
       have "ereal(dist (to_Gromov_completion x) (to_Gromov_completion x2))
             \<le> eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (to_Gromov_completion x) (to_Gromov_completion x2))"
         by (intro mono_intros)
       also have "... = eexp (- epsilonG(TYPE('a)) * ereal D)"
         using * by auto
       also have "... = ereal(exp(-epsilonG(TYPE('a)) * D))"
         by auto
       also have "... \<le> ereal(e/4)"
         by (intro mono_intros, fact)
       finally have "dist (to_Gromov_completion x) (to_Gromov_completion x2) \<le> e/4"
         using \<open>e > 0\<close> by auto
       have "dist basepoint x2 \<le> D"
         unfolding x2_def using False \<open>0 \<le> D\<close> by auto
       then obtain y where "y \<in> k" "dist (to_Gromov_completion y) (to_Gromov_completion x2) \<le> e/4"
         using A by auto
       have "dist (to_Gromov_completion y) (to_Gromov_completion x)
             \<le> dist (to_Gromov_completion y) (to_Gromov_completion x2) + dist (to_Gromov_completion x) (to_Gromov_completion x2)"
         by (intro mono_intros)
       also have "... \<le> e/4 + e/4"
         by (intro mono_intros, fact, fact)
       also have "... = e/2" by simp
       finally show ?thesis using \<open>y \<in> k\<close> by auto
     qed
     have C: "\<exists>y \<in> k. dist (to_Gromov_completion y) x < e" for x
     proof -
       obtain x1 where x1: "dist x x1 < e/2" "x1 \<in> range to_Gromov_completion"
         using to_Gromov_completion_range_dense \<open>e > 0\<close>
         by (metis (no_types, opaque_lifting) UNIV_I closure_approachableD divide_pos_pos zero_less_numeral)
       then obtain z where z: "x1 = to_Gromov_completion z" by auto
       then obtain y where y: "y \<in> k" "dist (to_Gromov_completion y) (to_Gromov_completion z) \<le> e/2"
         using B by auto
       have "dist (to_Gromov_completion y) x \<le>
               dist (to_Gromov_completion y) (to_Gromov_completion z) + dist x x1"
         unfolding z by (intro mono_intros)
       also have "... < e/2 + e/2"
         using x1(1) y(2) by auto
       also have "... = e"
         by auto
       finally show ?thesis using \<open>y \<in> k\<close> by auto
     qed
     show ?thesis
       apply (rule exI[of _ "to_Gromov_completion`k"])
       using C \<open>finite k\<close> by auto
   qed
   then show ?thesis
     unfolding compact_eq_totally_bounded
     using Gromov_completion_complete[OF complete_of_proper[OF assms]] by auto
 qed
 
 text \<open>If the inner space is second countable, so is its completion, as the former is dense in the
 latter.\<close>
 
 instance Gromov_completion::("{Gromov_hyperbolic_space, second_countable_topology}") second_countable_topology
 proof
   obtain A::"'a set" where "countable A" "closure A = UNIV"
     using second_countable_metric_dense_subset by auto
   define Ab where "Ab = to_Gromov_completion`A"
   have "range to_Gromov_completion \<subseteq> closure Ab"
     unfolding Ab_def
     by (metis \<open>closure A = UNIV\<close> closed_closure closure_subset image_closure_subset to_Gromov_completion_continuous)
   then have "closure Ab = UNIV"
     by (metis closed_closure closure_minimal dual_order.antisym to_Gromov_completion_range_dense top_greatest)
   moreover have "countable Ab" unfolding Ab_def using \<open>countable A\<close> by auto
   ultimately have "\<exists>Ab::'a Gromov_completion set. countable Ab \<and> closure Ab = UNIV"
     by auto
   then show "\<exists>B::'a Gromov_completion set set. countable B \<and> open = generate_topology B"
     using second_countable_iff_dense_countable_subset topological_basis_imp_subbasis by auto
 qed
 
 text \<open>The same follows readily for the Polish space property.\<close>
 
 instance metric_completion::("{Gromov_hyperbolic_space, polish_space}") polish_space
 by standard
 
 
 subsection \<open>The Gromov completion of the real line.\<close>
 
 text \<open>We show in the paragraph that the Gromov completion of the real line is obtained by adding
 one point at $+\infty$ and one point at $-\infty$. In other words, it coincides with ereal.
 
 To show this, we have to understand which sequences of reals are Gromov-converging to the
 boundary. We show in the next lemma that they are exactly the sequences that converge to $-\infty$
 or to $+\infty$.\<close>
 
 lemma real_Gromov_converging_to_boundary:
   fixes u::"nat \<Rightarrow> real"
   shows "Gromov_converging_at_boundary u \<longleftrightarrow> ((u \<longlonglongrightarrow> \<infinity>) \<or> (u \<longlonglongrightarrow> - \<infinity>))"
 proof -
   have *: "Gromov_product_at 0 m n \<ge> min m n" for m n::real
     unfolding Gromov_product_at_def dist_real_def by auto
   have A: "Gromov_converging_at_boundary u" if "u \<longlonglongrightarrow> \<infinity>" for u::"nat \<Rightarrow> real"
   proof (rule Gromov_converging_at_boundaryI[of 0])
     fix M::real
     have "eventually (\<lambda>n. ereal (u n) > M) sequentially"
       by (rule order_tendstoD(1)[OF \<open>u \<longlonglongrightarrow> \<infinity>\<close>, of "ereal M"], auto)
     then obtain N where "\<And>n. n \<ge> N \<Longrightarrow> ereal (u n) > M"
       unfolding eventually_sequentially by auto
     then have A: "u n \<ge> M" if "n \<ge> N" for n
       by (simp add: less_imp_le that)
     have "M \<le> Gromov_product_at 0 (u m) (u n)" if "n \<ge> N" "m \<ge> N" for m n
       using A[OF \<open>m \<ge> N\<close>] A[OF \<open>n \<ge> N\<close>] *[of "u m" "u n"] by auto
     then show "\<exists>N. \<forall>n \<ge> N. \<forall>m \<ge> N. M \<le> Gromov_product_at 0 (u m) (u n)"
       by auto
   qed
   have *: "Gromov_product_at 0 m n \<ge> - max m n" for m n::real
     unfolding Gromov_product_at_def dist_real_def by auto
   have B: "Gromov_converging_at_boundary u" if "u \<longlonglongrightarrow> -\<infinity>" for u::"nat \<Rightarrow> real"
   proof (rule Gromov_converging_at_boundaryI[of 0])
     fix M::real
     have "eventually (\<lambda>n. ereal (u n) < - M) sequentially"
       by (rule order_tendstoD(2)[OF \<open>u \<longlonglongrightarrow> -\<infinity>\<close>, of "ereal (-M)"], auto)
     then obtain N where "\<And>n. n \<ge> N \<Longrightarrow> ereal (u n) < - M"
       unfolding eventually_sequentially by auto
     then have A: "u n \<le> - M" if "n \<ge> N" for n
       by (simp add: less_imp_le that)
     have "M \<le> Gromov_product_at 0 (u m) (u n)" if "n \<ge> N" "m \<ge> N" for m n
       using A[OF \<open>m \<ge> N\<close>] A[OF \<open>n \<ge> N\<close>] *[of "u m" "u n"] by auto
     then show "\<exists>N. \<forall>n \<ge> N. \<forall>m \<ge> N. M \<le> Gromov_product_at 0 (u m) (u n)"
       by auto
   qed
   have L: "(u \<longlonglongrightarrow> \<infinity>) \<or> (u \<longlonglongrightarrow> - \<infinity>)" if "Gromov_converging_at_boundary u" for u::"nat \<Rightarrow> real"
   proof -
     have "(\<lambda>n. abs(u n)) \<longlonglongrightarrow> \<infinity>"
       using Gromov_converging_at_boundary_imp_unbounded[OF that, of 0] unfolding dist_real_def by auto
 
     obtain r where r: "strict_mono r" "(\<lambda>n. ereal (u (r n))) \<longlonglongrightarrow> liminf (\<lambda>n. ereal(u n))"
       using liminf_subseq_lim[of "\<lambda>n. ereal(u n)"] unfolding comp_def by auto
     have "(\<lambda>n. abs(ereal (u (r n)))) \<longlonglongrightarrow> abs(liminf (\<lambda>n. ereal(u n)))"
       apply (intro tendsto_intros) using r(2) by auto
     moreover have "(\<lambda>n. abs(ereal (u (r n)))) \<longlonglongrightarrow> \<infinity>"
       using \<open>(\<lambda>n. abs(u n)) \<longlonglongrightarrow> \<infinity>\<close> apply auto
       using filterlim_compose filterlim_subseq[OF r(1)] by blast
     ultimately have A: "abs(liminf (\<lambda>n. ereal(u n))) = \<infinity>"
       using LIMSEQ_unique by auto
 
     obtain r where r: "strict_mono r" "(\<lambda>n. ereal (u (r n))) \<longlonglongrightarrow> limsup (\<lambda>n. ereal(u n))"
       using limsup_subseq_lim[of "\<lambda>n. ereal(u n)"] unfolding comp_def by auto
     have "(\<lambda>n. abs(ereal (u (r n)))) \<longlonglongrightarrow> abs(limsup (\<lambda>n. ereal(u n)))"
       apply (intro tendsto_intros) using r(2) by auto
     moreover have "(\<lambda>n. abs(ereal (u (r n)))) \<longlonglongrightarrow> \<infinity>"
       using \<open>(\<lambda>n. abs(u n)) \<longlonglongrightarrow> \<infinity>\<close> apply auto
       using filterlim_compose filterlim_subseq[OF r(1)] by blast
     ultimately have B: "abs(limsup (\<lambda>n. ereal(u n))) = \<infinity>"
       using LIMSEQ_unique by auto
 
     have "\<not>(liminf u = - \<infinity> \<and> limsup u = \<infinity>)"
     proof (rule ccontr, auto)
       assume "liminf u = -\<infinity>" "limsup u = \<infinity>"
       have "\<exists>N. \<forall>n \<ge> N. \<forall>m \<ge> N. Gromov_product_at 0 (u m) (u n) \<ge> 1"
         using that unfolding Gromov_converging_at_boundary_def by blast
       then obtain N where N: "\<And>m n. m \<ge> N \<Longrightarrow> n \<ge> N \<Longrightarrow> Gromov_product_at 0 (u m) (u n) \<ge> 1"
         by auto
       have "\<exists>n \<ge> N. ereal(u n) > ereal 0"
         apply (rule limsup_obtain) unfolding \<open>limsup u = \<infinity>\<close> by auto
       then obtain n where n: "n \<ge> N" "u n > 0" by auto
 
       have "\<exists>n \<ge> N. ereal(u n) < ereal 0"
         apply (rule liminf_obtain) unfolding \<open>liminf u = -\<infinity>\<close> by auto
       then obtain m where m: "m \<ge> N" "u m < 0" by auto
 
       have "Gromov_product_at 0 (u m) (u n) = 0"
         unfolding Gromov_product_at_def dist_real_def using m n by auto
       then show False using N[OF m(1) n(1)] by auto
     qed
     then have "liminf u = \<infinity> \<or> limsup u = - \<infinity>"
       using A B by auto
     then show ?thesis
       by (simp add: Liminf_PInfty Limsup_MInfty)
   qed
   show ?thesis using L A B by auto
 qed
 
 text \<open>There is one single point at infinity in the Gromov completion of reals, i.e., two
 sequences tending to infinity are equivalent.\<close>
 
 lemma real_Gromov_completion_rel_PInf:
   fixes u v::"nat \<Rightarrow> real"
   assumes "u \<longlonglongrightarrow> \<infinity>" "v \<longlonglongrightarrow> \<infinity>"
   shows "Gromov_completion_rel u v"
 proof -
   have *: "Gromov_product_at 0 m n \<ge> min m n" for m n::real
     unfolding Gromov_product_at_def dist_real_def by auto
   have **: "Gromov_product_at a m n \<ge> min m n - abs a" for m n a::real
     using Gromov_product_at_diff1[of 0 m n a] *[of m n] by auto
   have "(\<lambda>n. Gromov_product_at a (u n) (v n)) \<longlonglongrightarrow> \<infinity>" for a
   proof (rule tendsto_sandwich[of "\<lambda>n. min (u n) (v n) - abs a" _ _ "\<lambda>n. \<infinity>"])
     have "ereal (min (u n) (v n) - \<bar>a\<bar>) \<le> ereal (Gromov_product_at a (u n) (v n))" for n
       using **[of "u n" "v n" a] by auto
     then show "\<forall>\<^sub>F n in sequentially. ereal (min (u n) (v n) - \<bar>a\<bar>) \<le> ereal (Gromov_product_at a (u n) (v n))"
       by auto
     have "(\<lambda>x. min (ereal(u x)) (ereal (v x)) - ereal \<bar>a\<bar>) \<longlonglongrightarrow> min \<infinity> \<infinity> - ereal \<bar>a\<bar>"
       apply (intro tendsto_intros) using assms by auto
     then show "(\<lambda>x. ereal (min (u x) (v x) - \<bar>a\<bar>)) \<longlonglongrightarrow> \<infinity>"
       apply auto unfolding ereal_minus(1)[symmetric] by auto
   qed (auto)
   moreover have "Gromov_converging_at_boundary u" "Gromov_converging_at_boundary v"
     using real_Gromov_converging_to_boundary assms by auto
   ultimately show ?thesis unfolding Gromov_completion_rel_def by auto
 qed
 
 text \<open>There is one single point at minus infinity in the Gromov completion of reals, i.e., two
 sequences tending to minus infinity are equivalent.\<close>
 
 lemma real_Gromov_completion_rel_MInf:
   fixes u v::"nat \<Rightarrow> real"
   assumes "u \<longlonglongrightarrow> -\<infinity>" "v \<longlonglongrightarrow> -\<infinity>"
   shows "Gromov_completion_rel u v"
 proof -
   have *: "Gromov_product_at 0 m n \<ge> - max m n" for m n::real
     unfolding Gromov_product_at_def dist_real_def by auto
   have **: "Gromov_product_at a m n \<ge> - max m n - abs a" for m n a::real
     using Gromov_product_at_diff1[of 0 m n a] *[of m n] by auto
   have "(\<lambda>n. Gromov_product_at a (u n) (v n)) \<longlonglongrightarrow> \<infinity>" for a
   proof (rule tendsto_sandwich[of "\<lambda>n. min (-u n) (-v n) - abs a" _ _ "\<lambda>n. \<infinity>"])
     have "ereal (min (-u n) (-v n) - \<bar>a\<bar>) \<le> ereal (Gromov_product_at a (u n) (v n))" for n
       using **[of "u n" "v n" a] by auto
     then show "\<forall>\<^sub>F n in sequentially. ereal (min (-u n) (-v n) - \<bar>a\<bar>) \<le> ereal (Gromov_product_at a (u n) (v n))"
       by auto
     have "(\<lambda>x. min (-ereal(u x)) (-ereal (v x)) - ereal \<bar>a\<bar>) \<longlonglongrightarrow> min (-(-\<infinity>)) (-(-\<infinity>)) - ereal \<bar>a\<bar>"
       apply (intro tendsto_intros) using assms by auto
     then show "(\<lambda>x. ereal (min (-u x) (-v x) - \<bar>a\<bar>)) \<longlonglongrightarrow> \<infinity>"
       apply auto unfolding ereal_minus(1)[symmetric] by auto
   qed (auto)
   moreover have "Gromov_converging_at_boundary u" "Gromov_converging_at_boundary v"
     using real_Gromov_converging_to_boundary assms by auto
   ultimately show ?thesis unfolding Gromov_completion_rel_def by auto
 qed
 
 text \<open>It follows from the two lemmas above that the Gromov completion of reals is obtained by
 adding one single point at infinity and one single point at minus infinity. Hence, it is in
 bijection with the extended reals.\<close>
 
 function to_real_Gromov_completion::"ereal \<Rightarrow> real Gromov_completion"
   where "to_real_Gromov_completion (ereal r) = to_Gromov_completion r"
   | "to_real_Gromov_completion (\<infinity>) = abs_Gromov_completion (\<lambda>n. n)"
   | "to_real_Gromov_completion (-\<infinity>) = abs_Gromov_completion (\<lambda>n. -n)"
 by (auto intro: ereal_cases)
 termination by standard (rule wf_empty)
 
 text \<open>To prove the bijectivity, we prove by hand injectivity and surjectivity using the above
 lemmas.\<close>
 
 lemma bij_to_real_Gromov_completion:
   "bij to_real_Gromov_completion"
 proof -
   have [simp]: "Gromov_completion_rel (\<lambda>n. n) (\<lambda>n. n)"
     by (intro real_Gromov_completion_rel_PInf tendsto_intros)
   have [simp]: "Gromov_completion_rel (\<lambda>n. -real n) (\<lambda>n. -real n)"
     by (intro real_Gromov_completion_rel_MInf tendsto_intros)
 
   have "\<exists>x. to_real_Gromov_completion x = y" for y
   proof (cases y)
     case (to_Gromov_completion x)
     then have "y = to_real_Gromov_completion x" by auto
     then show ?thesis by blast
   next
     case boundary
     define u where u: "u = rep_Gromov_completion y"
     have y: "abs_Gromov_completion u = y" "Gromov_completion_rel u u"
       unfolding u using Quotient3_abs_rep[OF Quotient3_Gromov_completion]
       Quotient3_rep_reflp[OF Quotient3_Gromov_completion] by auto
     have "Gromov_converging_at_boundary u"
       using u boundary by (simp add: Gromov_boundary_rep_converging)
     then have "(u \<longlonglongrightarrow> \<infinity>) \<or> (u \<longlonglongrightarrow> - \<infinity>)" using real_Gromov_converging_to_boundary by auto
     then show ?thesis
     proof
       assume "u \<longlonglongrightarrow> \<infinity>"
       have "abs_Gromov_completion (\<lambda>n. n) = abs_Gromov_completion u "
         apply (rule Quotient3_rel_abs[OF Quotient3_Gromov_completion])
         by (intro real_Gromov_completion_rel_PInf[OF _ \<open>u \<longlonglongrightarrow> \<infinity>\<close>] tendsto_intros)
       then have "to_real_Gromov_completion \<infinity> = y"
         unfolding y by auto
       then show ?thesis by blast
     next
       assume "u \<longlonglongrightarrow> -\<infinity>"
       have "abs_Gromov_completion (\<lambda>n. -real n) = abs_Gromov_completion u "
         apply (rule Quotient3_rel_abs[OF Quotient3_Gromov_completion])
         by (intro real_Gromov_completion_rel_MInf[OF _ \<open>u \<longlonglongrightarrow> -\<infinity>\<close>] tendsto_intros)
       then have "to_real_Gromov_completion (-\<infinity>) = y"
         unfolding y by auto
       then show ?thesis by blast
     qed
   qed
   then have "surj to_real_Gromov_completion"
     unfolding surj_def by metis
 
   have "to_real_Gromov_completion \<infinity> \<in> Gromov_boundary"
        "to_real_Gromov_completion (-\<infinity>) \<in> Gromov_boundary"
     by (auto intro!: abs_Gromov_completion_in_Gromov_boundary tendsto_intros simp add: real_Gromov_converging_to_boundary)
   moreover have "to_real_Gromov_completion \<infinity> \<noteq> to_real_Gromov_completion (-\<infinity>)"
   proof -
     have "Gromov_product_at 0 (real n) (-real n) = 0" for n::nat
       unfolding Gromov_product_at_def dist_real_def by auto
     then have *: "(\<lambda>n. ereal(Gromov_product_at 0 (real n) (-real n))) \<longlonglongrightarrow> ereal 0" by auto
     have "\<not>((\<lambda>n. Gromov_product_at 0 (real n) (-real n)) \<longlonglongrightarrow> \<infinity>)"
       using LIMSEQ_unique[OF *] by fastforce
     then have "\<not>(Gromov_completion_rel (\<lambda>n. n) (\<lambda>n. -n))"
       unfolding Gromov_completion_rel_def by auto (metis nat.simps(3) of_nat_0 of_nat_eq_0_iff)
     then show ?thesis
       using Quotient3_rel[OF Quotient3_Gromov_completion, of "\<lambda>n. n" "\<lambda>n. -real n"] by auto
   qed
   ultimately have "x = y" if "to_real_Gromov_completion x = to_real_Gromov_completion y" for x y
     using that injD[OF to_Gromov_completion_inj] apply (cases x y rule: ereal2_cases)
     by (auto) (metis not_in_Gromov_boundary')+
   then have "inj to_real_Gromov_completion"
     unfolding inj_def by auto
   then show "bij to_real_Gromov_completion"
     using \<open>surj to_real_Gromov_completion\<close> by (simp add: bijI)
 qed
 
 text \<open>Next, we prove that we have a homeomorphism. By compactness of ereals, it suffices to show
 that the inclusion map is continuous everywhere. It would be a pain to distinguish all the time if points are
 at infinity or not, we rather use a criterion saying that it suffices to prove sequential
 continuity for sequences taking values in a dense subset of the space, here we take the reals.
 Hence, it suffices to show that if a sequence of reals $v_n$ converges to a limit $a$ in the
 extended reals, then the image of $v_n$ in the Gromov completion (which is an inner point) converges
 to the point corresponding to $a$. We treat separately the cases $a\in \mathbb{R}$, $a = \infty$ and
 $a = -\infty$. In the first case, everything is trivial. In the other cases, we have characterized
 in general sequences inside the space that converge to a boundary point, as sequences in the equivalence
 class defining this boundary point. Since we have described explicitly these equivalence classes in
 the case of the Gromov completion of the reals (they are respectively the sequences tending to
 $\infty$ and to $-\infty$), the result follows readily without any additional computation.\<close>
 
 proposition homeo_to_real_Gromov_completion:
   "homeomorphism_on UNIV to_real_Gromov_completion"
 proof (rule homeomorphism_on_compact)
   show "inj to_real_Gromov_completion"
     using bij_to_real_Gromov_completion by (simp add: bij_betw_def)
   show "compact (UNIV::ereal set)"
     by (simp add: compact_UNIV)
   show "continuous_on UNIV to_real_Gromov_completion"
   proof (rule continuous_on_extension_sequentially[of _ "{-\<infinity><..<\<infinity>}"], auto)
     fix u::"nat \<Rightarrow> ereal" and b::ereal assume u: "\<forall>n. u n \<noteq> - \<infinity> \<and> u n \<noteq> \<infinity>" "u \<longlonglongrightarrow> b"
     define v where "v = (\<lambda>n. real_of_ereal (u n))"
     have uv: "u n = ereal (v n)" for n
       using u unfolding v_def by (simp add: ereal_infinity_cases ereal_real)
     show "(\<lambda>n. to_real_Gromov_completion (u n)) \<longlonglongrightarrow> to_real_Gromov_completion b"
     proof (cases b)
       case (real r)
       then show ?thesis using \<open>u \<longlonglongrightarrow> b\<close> unfolding uv by auto
     next
       case PInf
       then have *: "(\<lambda>n. ereal (v n)) \<longlonglongrightarrow> \<infinity>" using \<open>u \<longlonglongrightarrow> b\<close> unfolding uv by auto
       have A: "Gromov_completion_rel real v" "Gromov_completion_rel real real" "Gromov_completion_rel v v"
         by (auto intro!: real_Gromov_completion_rel_PInf * tendsto_intros)
       then have B: "abs_Gromov_completion v = abs_Gromov_completion real"
         using Quotient3_rel_abs[OF Quotient3_Gromov_completion] by force
       then show ?thesis using \<open>u \<longlonglongrightarrow> b\<close> PInf
         unfolding uv apply auto
         apply (subst Gromov_completion_converge_to_boundary)
         using id_nat_ereal_tendsto_PInf real_Gromov_converging_to_boundary A B by auto
     next
       case MInf
       then have *: "(\<lambda>n. ereal (v n)) \<longlonglongrightarrow> -\<infinity>" using \<open>u \<longlonglongrightarrow> b\<close> unfolding uv by auto
       have A: "Gromov_completion_rel (\<lambda>n. -real n) v" "Gromov_completion_rel (\<lambda>n. -real n) (\<lambda>n. -real n)" "Gromov_completion_rel v v"
         by (auto intro!: real_Gromov_completion_rel_MInf * tendsto_intros)
       then have B: "abs_Gromov_completion v = abs_Gromov_completion (\<lambda>n. -real n)"
         using Quotient3_rel_abs[OF Quotient3_Gromov_completion] by force
       then show ?thesis using \<open>u \<longlonglongrightarrow> b\<close> MInf
         unfolding uv apply auto
         apply (subst Gromov_completion_converge_to_boundary)
         using id_nat_ereal_tendsto_PInf real_Gromov_converging_to_boundary A B
         by (auto simp add: ereal_minus_real_tendsto_MInf)
     qed
   qed
 qed
 
 end (*of theory Gromov_Boundary*)
diff --git a/thys/Perfect_Fields/Algebraic_Closure_Type.thy b/thys/Perfect_Fields/Algebraic_Closure_Type.thy
deleted file mode 100644
--- a/thys/Perfect_Fields/Algebraic_Closure_Type.thy
+++ /dev/null
@@ -1,627 +0,0 @@
-(*
-  File:      Perfect_Fields/Algebraic_Closure_Type.thy
-  Authors:   Katharina Kreuzer (TU München)
-             Manuel Eberl (University of Innsbruck)
-
-  A type definition for the algebraic closure of fields.
-*)
-
-section \<open>The algebraic closure type\<close>
-theory Algebraic_Closure_Type
-imports
-  "HOL-Algebra.Algebra"
-  "Formal_Puiseux_Series.Formal_Puiseux_Series"
-  "HOL-Computational_Algebra.Field_as_Ring"
-begin
-
-definition (in ring_1) ring_of_type_algebra :: "'a ring"
-  where "ring_of_type_algebra = \<lparr> 
-    carrier = UNIV, monoid.mult = (\<lambda>x y. x * y),  
-    one = 1,
-    ring.zero = 0,
-    add = (\<lambda> x y. x + y) \<rparr>"
-
-lemma (in comm_ring_1) ring_from_type_algebra [intro]:
-  "ring (ring_of_type_algebra :: 'a ring)"
-proof -
-  have "\<exists>y. x + y = 0" for x :: 'a
-    using add.right_inverse by blast
-  thus ?thesis
-    unfolding ring_of_type_algebra_def using add.right_inverse
-    by unfold_locales (auto simp:algebra_simps Units_def)
-qed
-
-lemma (in comm_ring_1) cring_from_type_algebra [intro]:
-  "cring (ring_of_type_algebra :: 'a ring)"
-proof -
-  have "\<exists>y. x + y = 0" for x :: 'a
-    using add.right_inverse by blast
-  thus ?thesis
-    unfolding ring_of_type_algebra_def using add.right_inverse
-    by unfold_locales (auto simp:algebra_simps Units_def)
-qed
-
-lemma (in Fields.field) field_from_type_algebra [intro]:
-  "field (ring_of_type_algebra :: 'a ring)"
-proof -
-  have "\<exists>y. x + y = 0" for x :: 'a
-    using add.right_inverse by blast
-
-  moreover have "x \<noteq> 0 \<Longrightarrow> \<exists>y. x * y = 1" for x :: 'a
-    by (rule exI[of _ "inverse x"]) auto
-
-  ultimately show ?thesis
-    unfolding ring_of_type_algebra_def using add.right_inverse
-    by unfold_locales (auto simp:algebra_simps Units_def)
-qed
-
-
-
-subsection \<open>Definition\<close>
-
-typedef (overloaded) 'a :: field alg_closure =
-  "carrier (field.alg_closure (ring_of_type_algebra :: 'a :: field ring))"
-proof -
-  define K where "K \<equiv> (ring_of_type_algebra :: 'a ring)"
-  define L where "L \<equiv> field.alg_closure K"
-
-  interpret K: field K
-    unfolding K_def by rule
-
-  interpret algebraic_closure L "range K.indexed_const"
-  proof -
-    have *: "carrier K = UNIV"
-      by (auto simp: K_def ring_of_type_algebra_def)
-    show "algebraic_closure L (range K.indexed_const)"
-      unfolding * [symmetric] L_def by (rule K.alg_closureE)
-  qed
-
-  show "\<exists>x. x \<in> carrier L"
-    using zero_closed by blast
-qed
-
-setup_lifting type_definition_alg_closure
-
-instantiation alg_closure :: (field) field
-begin
-
-context
-  fixes L K
-  defines "K \<equiv> (ring_of_type_algebra :: 'a :: field ring)"
-  defines "L \<equiv> field.alg_closure K"
-begin
-
-interpretation K: field K
-  unfolding K_def by rule
-
-interpretation algebraic_closure L "range K.indexed_const"
-proof -
-  have *: "carrier K = UNIV"
-    by (auto simp: K_def ring_of_type_algebra_def)
-  show "algebraic_closure L (range K.indexed_const)"
-    unfolding * [symmetric] L_def by (rule K.alg_closureE)
-qed
-
-lift_definition zero_alg_closure :: "'a alg_closure" is "ring.zero L"
-  by (fold K_def, fold L_def) (rule ring_simprules)
-
-lift_definition one_alg_closure :: "'a alg_closure" is "monoid.one L"
-  by (fold K_def, fold L_def) (rule ring_simprules)
-
-lift_definition plus_alg_closure :: "'a alg_closure \<Rightarrow> 'a alg_closure \<Rightarrow> 'a alg_closure"
-  is "ring.add L"
-  by (fold K_def, fold L_def) (rule ring_simprules)
-
-lift_definition minus_alg_closure :: "'a alg_closure \<Rightarrow> 'a alg_closure \<Rightarrow> 'a alg_closure"
-  is "a_minus L"
-  by (fold K_def, fold L_def) (rule ring_simprules)
-
-lift_definition times_alg_closure :: "'a alg_closure \<Rightarrow> 'a alg_closure \<Rightarrow> 'a alg_closure"
-  is "monoid.mult L"
-  by (fold K_def, fold L_def) (rule ring_simprules)
-
-lift_definition uminus_alg_closure :: "'a alg_closure \<Rightarrow> 'a alg_closure"
-  is "a_inv L"
-  by (fold K_def, fold L_def) (rule ring_simprules)
-
-lift_definition inverse_alg_closure :: "'a alg_closure \<Rightarrow> 'a alg_closure"
-  is "\<lambda>x. if x = ring.zero L then ring.zero L else m_inv L x"
-  by (fold K_def, fold L_def) (auto simp: field_Units)
-
-lift_definition divide_alg_closure :: "'a alg_closure \<Rightarrow> 'a alg_closure \<Rightarrow> 'a alg_closure"
-  is "\<lambda>x y. if y = ring.zero L then ring.zero L else monoid.mult L x (m_inv L y)"
-  by (fold K_def, fold L_def) (auto simp: field_Units)
-
-end
-
-instance proof -
-  define K where "K \<equiv> (ring_of_type_algebra :: 'a ring)"
-  define L where "L \<equiv> field.alg_closure K"
-
-  interpret K: field K
-    unfolding K_def by rule
-
-  interpret algebraic_closure L "range K.indexed_const"
-  proof -
-    have *: "carrier K = UNIV"
-      by (auto simp: K_def ring_of_type_algebra_def)
-    show "algebraic_closure L (range K.indexed_const)"
-      unfolding * [symmetric] L_def by (rule K.alg_closureE)
-  qed
-
-  show "OFCLASS('a alg_closure, field_class)"
-  proof (standard, goal_cases)
-    case 1
-    show ?case
-      by (transfer, fold K_def, fold L_def) (rule m_assoc)
-  next
-    case 2
-    show ?case
-      by (transfer, fold K_def, fold L_def) (rule m_comm)
-  next
-    case 3
-    show ?case
-      by (transfer, fold K_def, fold L_def) (rule l_one)
-  next
-    case 4
-    show ?case
-      by (transfer, fold K_def, fold L_def) (rule a_assoc)
-  next
-    case 5
-    show ?case
-      by (transfer, fold K_def, fold L_def) (rule a_comm)
-  next
-    case 6
-    show ?case
-      by (transfer, fold K_def, fold L_def) (rule l_zero)
-  next
-    case 7
-    show ?case
-      by (transfer, fold K_def, fold L_def) (rule ring_simprules)
-  next
-    case 8
-    show ?case
-      by (transfer, fold K_def, fold L_def) (rule ring_simprules)
-  next
-    case 9
-    show ?case
-      by (transfer, fold K_def, fold L_def) (rule ring_simprules)
-  next
-    case 10
-    show ?case
-      by (transfer, fold K_def, fold L_def) (rule zero_not_one)
-  next
-    case 11
-    thus ?case
-      by (transfer, fold K_def, fold L_def) (auto simp: field_Units)
-  next
-    case 12
-    thus ?case
-      by (transfer, fold K_def, fold L_def) auto
-  next
-    case 13
-    thus ?case
-      by transfer auto
-  qed
-qed
-
-end
-
-
-
-subsection \<open>The algebraic closure is algebraically closed\<close>
-
-instance alg_closure :: (field) alg_closed_field
-proof
-  define K where "K \<equiv> (ring_of_type_algebra :: 'a ring)"
-  define L where "L \<equiv> field.alg_closure K"
-
-  interpret K: field K
-    unfolding K_def by rule
-
-  interpret algebraic_closure L "range K.indexed_const"
-  proof -
-    have *: "carrier K = UNIV"
-      by (auto simp: K_def ring_of_type_algebra_def)
-    show "algebraic_closure L (range K.indexed_const)"
-      unfolding * [symmetric] L_def by (rule K.alg_closureE)
-  qed
-
-  have [simp]: "Rep_alg_closure x \<in> carrier L" for x
-    using Rep_alg_closure[of x] by (simp only: L_def K_def)
-
-  have [simp]: "Rep_alg_closure x = Rep_alg_closure y \<longleftrightarrow> x = y" for x y
-    by (simp add: Rep_alg_closure_inject)
-  have [simp]: "Rep_alg_closure x = \<zero>\<^bsub>L\<^esub> \<longleftrightarrow> x = 0" for x
-  proof -
-    have "Rep_alg_closure x = Rep_alg_closure 0 \<longleftrightarrow> x = 0"
-      by simp
-    also have "Rep_alg_closure 0 = \<zero>\<^bsub>L\<^esub>"
-      by (simp add: zero_alg_closure.rep_eq L_def K_def)
-    finally show ?thesis .
-  qed
-
-  have [simp]: "Rep_alg_closure (x ^ n) = Rep_alg_closure x [^]\<^bsub>L\<^esub> n"
-    for x :: "'a alg_closure" and n
-    by (induction n)
-       (auto simp: one_alg_closure.rep_eq times_alg_closure.rep_eq m_comm
-             simp flip: L_def K_def)
-  have [simp]: "Rep_alg_closure (Abs_alg_closure x) = x" if "x \<in> carrier L" for x
-    using that unfolding L_def K_def by (rule Abs_alg_closure_inverse)
-
-  show "\<exists>x. poly p x = 0" if p: "monic p" "Polynomial.degree p > 0" for p :: "'a alg_closure poly"
-  proof -
-    define P where "P = rev (map Rep_alg_closure (Polynomial.coeffs p))"
-    have deg: "Polynomials.degree P = Polynomial.degree p"
-      by (auto simp: P_def degree_eq_length_coeffs)
-    have carrier_P: "P \<in> carrier (poly_ring L)"
-      by (auto simp: univ_poly_def polynomial_def P_def hd_map hd_rev last_map 
-                     last_coeffs_eq_coeff_degree)
-    hence "splitted P"
-      using roots_over_carrier by blast
-    hence "roots P \<noteq> {#}"
-      unfolding splitted_def using deg p by auto
-    then obtain x where "x \<in># roots P"
-      by blast
-    hence x: "is_root P x"
-      using roots_mem_iff_is_root[OF carrier_P] by auto
-    hence [simp]: "x \<in> carrier L"
-      by (auto simp: is_root_def)
-    define x' where "x' = Abs_alg_closure x"
-    define xs where "xs = rev (coeffs p)"
-
-    have "cr_alg_closure (eval (map Rep_alg_closure xs) x) (poly (Poly (rev xs)) x')"
-      by (induction xs)
-         (auto simp flip: K_def L_def simp: cr_alg_closure_def
-                 zero_alg_closure.rep_eq plus_alg_closure.rep_eq
-                 times_alg_closure.rep_eq Poly_append poly_monom
-                 a_comm m_comm x'_def)
-    also have "map Rep_alg_closure xs = P"
-      by (simp add: xs_def P_def rev_map)
-    also have "Poly (rev xs) = p"
-      by (simp add: xs_def)
-    finally have "poly p x' = 0"
-      using x by (auto simp: is_root_def cr_alg_closure_def)
-    thus "\<exists>x. poly p x = 0" ..
-  qed
-qed
-
-
-
-subsection \<open>Converting between the base field and the closure\<close>
-
-context
-  fixes L K
-  defines "K \<equiv> (ring_of_type_algebra :: 'a :: field ring)"
-  defines "L \<equiv> field.alg_closure K"
-begin
-
-interpretation K: field K
-  unfolding K_def by rule
-
-interpretation algebraic_closure L "range K.indexed_const"
-proof -
-  have *: "carrier K = UNIV"
-    by (auto simp: K_def ring_of_type_algebra_def)
-  show "algebraic_closure L (range K.indexed_const)"
-    unfolding * [symmetric] L_def by (rule K.alg_closureE)
-qed
-
-lemma alg_closure_hom: "K.indexed_const \<in> Ring.ring_hom K L"
-  unfolding L_def using K.alg_closureE(2) .
-
-lift_definition to_ac :: "'a :: field \<Rightarrow> 'a alg_closure"
-  is "ring.indexed_const K"
-  by (fold K_def, fold L_def) (use mem_carrier in blast)
-
-lemma to_ac_0 [simp]: "to_ac (0 :: 'a) = 0"
-proof -
-  have "to_ac (\<zero>\<^bsub>K\<^esub>) = 0"
-  proof (transfer fixing: K, fold K_def, fold L_def)
-    show "K.indexed_const \<zero>\<^bsub>K\<^esub> = \<zero>\<^bsub>L\<^esub>"
-      using Ring.ring_hom_zero[OF alg_closure_hom] K.ring_axioms is_ring
-      by simp
-  qed
-  thus ?thesis
-    by (simp add: K_def ring_of_type_algebra_def)
-qed
-
-lemma to_ac_1 [simp]: "to_ac (1 :: 'a) = 1"
-proof -
-  have "to_ac (\<one>\<^bsub>K\<^esub>) = 1"
-  proof (transfer fixing: K, fold K_def, fold L_def)
-    show "K.indexed_const \<one>\<^bsub>K\<^esub> = \<one>\<^bsub>L\<^esub>"
-      using Ring.ring_hom_one[OF alg_closure_hom] K.ring_axioms is_ring
-      by simp
-  qed
-  thus ?thesis
-    by (simp add: K_def ring_of_type_algebra_def)
-qed
-
-lemma to_ac_add [simp]: "to_ac (x + y :: 'a) = to_ac x + to_ac y"
-proof -
-  have "to_ac (x \<oplus>\<^bsub>K\<^esub> y) = to_ac x + to_ac y"
-  proof (transfer fixing: K x y, fold K_def, fold L_def)
-    show "K.indexed_const (x \<oplus>\<^bsub>K\<^esub> y) = K.indexed_const x \<oplus>\<^bsub>L\<^esub> K.indexed_const y"
-      using Ring.ring_hom_add[OF alg_closure_hom, of x y] K.ring_axioms is_ring
-      by (simp add: K_def ring_of_type_algebra_def)
-  qed
-  thus ?thesis
-    by (simp add: K_def ring_of_type_algebra_def)
-qed
-
-lemma to_ac_minus [simp]: "to_ac (-x :: 'a) = -to_ac x"
-  using to_ac_add to_ac_0 add_eq_0_iff by metis
-
-lemma to_ac_diff [simp]: "to_ac (x - y :: 'a) = to_ac x - to_ac y"
-  using to_ac_add[of x "-y"] by simp
-
-lemma to_ac_mult [simp]: "to_ac (x * y :: 'a) = to_ac x * to_ac y"
-proof -
-  have "to_ac (x \<otimes>\<^bsub>K\<^esub> y) = to_ac x * to_ac y"
-  proof (transfer fixing: K x y, fold K_def, fold L_def)
-    show "K.indexed_const (x \<otimes>\<^bsub>K\<^esub> y) = K.indexed_const x \<otimes>\<^bsub>L\<^esub> K.indexed_const y"
-      using Ring.ring_hom_mult[OF alg_closure_hom, of x y] K.ring_axioms is_ring
-      by (simp add: K_def ring_of_type_algebra_def)
-  qed
-  thus ?thesis
-    by (simp add: K_def ring_of_type_algebra_def)
-qed
-
-lemma to_ac_inverse [simp]: "to_ac (inverse x :: 'a) = inverse (to_ac x)"
-  using to_ac_mult[of x "inverse x"] to_ac_1 to_ac_0
-  by (metis divide_self_if field_class.field_divide_inverse field_class.field_inverse_zero inverse_unique)
-
-lemma to_ac_divide [simp]: "to_ac (x / y :: 'a) = to_ac x / to_ac y"
-  using to_ac_mult[of x "inverse y"] to_ac_inverse[of y]
-  by (simp add: field_class.field_divide_inverse)
-
-lemma to_ac_power [simp]: "to_ac (x ^ n) = to_ac x ^ n"
-  by (induction n) auto
-
-lemma to_ac_of_nat [simp]: "to_ac (of_nat n) = of_nat n"
-  by (induction n) auto
-
-lemma to_ac_of_int [simp]: "to_ac (of_int n) = of_int n"
-  by (induction n) auto
-
-lemma to_ac_numeral [simp]: "to_ac (numeral n) = numeral n"
-  using to_ac_of_nat[of "numeral n"] by (simp del: to_ac_of_nat)
-
-lemma to_ac_sum: "to_ac (\<Sum>x\<in>A. f x) = (\<Sum>x\<in>A. to_ac (f x))"
-  by (induction A rule: infinite_finite_induct) auto
-
-lemma to_ac_prod: "to_ac (\<Prod>x\<in>A. f x) = (\<Prod>x\<in>A. to_ac (f x))"
-  by (induction A rule: infinite_finite_induct) auto
-
-lemma to_ac_sum_list: "to_ac (sum_list xs) = (\<Sum>x\<leftarrow>xs. to_ac x)"
-  by (induction xs) auto
-
-lemma to_ac_prod_list: "to_ac (prod_list xs) = (\<Prod>x\<leftarrow>xs. to_ac x)"
-  by (induction xs) auto
-
-lemma to_ac_sum_mset: "to_ac (sum_mset xs) = (\<Sum>x\<in>#xs. to_ac x)"
-  by (induction xs) auto
-
-lemma to_ac_prod_mset: "to_ac (prod_mset xs) = (\<Prod>x\<in>#xs. to_ac x)"
-  by (induction xs) auto
-
-end
-
-lemma (in ring) indexed_const_eq_iff [simp]:
-  "indexed_const x = (indexed_const y :: 'c multiset \<Rightarrow> 'a) \<longleftrightarrow> x = y"
-proof
-  assume "indexed_const x = (indexed_const y :: 'c multiset \<Rightarrow> 'a)"
-  hence "indexed_const x ({#} :: 'c multiset) = indexed_const y ({#} :: 'c multiset)"
-    by metis
-  thus "x = y"
-    by (simp add: indexed_const_def)
-qed auto
-
-lemma inj_to_ac: "inj to_ac"
-  by (transfer, intro injI, subst (asm) ring.indexed_const_eq_iff) auto
-
-lemma to_ac_eq_iff [simp]: "to_ac x = to_ac y \<longleftrightarrow> x = y"
-  using inj_to_ac by (auto simp: inj_on_def)
-
-lemma to_ac_eq_0_iff [simp]: "to_ac x = 0 \<longleftrightarrow> x = 0"
-  and to_ac_eq_0_iff' [simp]: "0 = to_ac x \<longleftrightarrow> x = 0"
-  and to_ac_eq_1_iff [simp]: "to_ac x = 1 \<longleftrightarrow> x = 1"
-  and to_ac_eq_1_iff' [simp]: "1 = to_ac x \<longleftrightarrow> x = 1"
-  using to_ac_eq_iff to_ac_0 to_ac_1 by metis+
-
-
-definition of_ac :: "'a :: field alg_closure \<Rightarrow> 'a" where
-  "of_ac x = (if x \<in> range to_ac then inv_into UNIV to_ac x else 0)"
-
-lemma of_ac_eqI: "to_ac x = y \<Longrightarrow> of_ac y = x"
-  unfolding of_ac_def by (meson inj_to_ac inv_f_f range_eqI)
-
-lemma of_ac_0 [simp]: "of_ac 0 = 0"
-  and of_ac_1 [simp]: "of_ac 1 = 1"
-  by (rule of_ac_eqI; simp; fail)+
-
-lemma of_ac_to_ac [simp]: "of_ac (to_ac x) = x"
-  by (rule of_ac_eqI) auto
-
-lemma to_ac_of_ac: "x \<in> range to_ac \<Longrightarrow> to_ac (of_ac x) = x"
-  by auto
-
-
-lemma CHAR_alg_closure [simp]:
-  "CHAR('a :: field alg_closure) = CHAR('a)"
-proof (rule CHAR_eqI)
-  show "of_nat CHAR('a) = (0 :: 'a alg_closure)"
-    by (metis of_nat_CHAR to_ac_0 to_ac_of_nat)
-next
-  show "CHAR('a) dvd n" if "of_nat n = (0 :: 'a alg_closure)" for n
-    using that by (metis of_nat_eq_0_iff_char_dvd to_ac_eq_0_iff' to_ac_of_nat)
-qed
-
-instance alg_closure :: (field_char_0) field_char_0
-proof
-  show "inj (of_nat :: nat \<Rightarrow> 'a alg_closure)"
-    by (metis injD inj_of_nat inj_on_def inj_to_ac to_ac_of_nat)
-qed
-
-
-bundle alg_closure_syntax
-begin
-notation to_ac ("_\<up>" [1000] 999)
-notation of_ac ("_\<down>" [1000] 999)
-end
-
-
-bundle alg_closure_syntax'
-begin
-notation (output) to_ac ("_")
-notation (output) of_ac ("_")
-end
-
-
-subsection \<open>The algebraic closure is an algebraic extension\<close>
-
-text \<open>
-  The algebraic closure is an algebraic extension, i.e.\ every element in it is
-  a root of some non-zero polynomial in the base field.
-\<close>
-theorem alg_closure_algebraic:
-  fixes x :: "'a :: field alg_closure"
-  obtains p :: "'a poly" where "p \<noteq> 0" "poly (map_poly to_ac p) x = 0"
-proof -
-  define K where "K \<equiv> (ring_of_type_algebra :: 'a ring)"
-  define L where "L \<equiv> field.alg_closure K"
-
-  interpret K: field K
-    unfolding K_def by rule
-
-  interpret algebraic_closure L "range K.indexed_const"
-  proof -
-    have *: "carrier K = UNIV"
-      by (auto simp: K_def ring_of_type_algebra_def)
-    show "algebraic_closure L (range K.indexed_const)"
-      unfolding * [symmetric] L_def by (rule K.alg_closureE)
-  qed
-
-  let ?K = "range K.indexed_const"
-  have sr: "subring ?K L"
-    by (rule subring_axioms)
-  define x' where "x' = Rep_alg_closure x"
-  have "x' \<in> carrier L"
-    unfolding x'_def L_def K_def by (rule Rep_alg_closure)
-  hence alg: "(algebraic over range K.indexed_const) x'"
-    using algebraic_extension by blast
-  then obtain p where p: "p \<in> carrier (?K[X]\<^bsub>L\<^esub>)" "p \<noteq> []" "eval p x' = \<zero>\<^bsub>L\<^esub>"
-    using algebraicE[OF sr \<open>x' \<in> carrier L\<close> alg] by blast
-
-  have [simp]: "Rep_alg_closure x \<in> carrier L" for x
-    using Rep_alg_closure[of x] by (simp only: L_def K_def)
-  have [simp]: "Abs_alg_closure x = 0 \<longleftrightarrow> x = \<zero>\<^bsub>L\<^esub>" if "x \<in> carrier L" for x
-    using that unfolding L_def K_def
-    by (metis Abs_alg_closure_inverse zero_alg_closure.rep_eq zero_alg_closure_def)
-  have [simp]: "Rep_alg_closure (x ^ n) = Rep_alg_closure x [^]\<^bsub>L\<^esub> n"
-    for x :: "'a alg_closure" and n
-    by (induction n)
-       (auto simp: one_alg_closure.rep_eq times_alg_closure.rep_eq m_comm
-             simp flip: L_def K_def)
-  have [simp]: "Rep_alg_closure (Abs_alg_closure x) = x" if "x \<in> carrier L" for x
-    using that unfolding L_def K_def by (rule Abs_alg_closure_inverse)
-  have [simp]: "Rep_alg_closure x = \<zero>\<^bsub>L\<^esub> \<longleftrightarrow> x = 0" for x
-    by (metis K_def L_def Rep_alg_closure_inverse zero_alg_closure.rep_eq)
-
-  define p' where "p' = Poly (map Abs_alg_closure (rev p))"
-  have "p' \<noteq> 0"
-  proof
-    assume "p' = 0"
-    then obtain n where n: "map Abs_alg_closure (rev p) = replicate n 0"
-      by (auto simp: p'_def Poly_eq_0)
-    with \<open>p \<noteq> []\<close> have "n > 0"
-      by (auto intro!: Nat.gr0I)
-    have "last (map Abs_alg_closure (rev p)) = 0"
-      using \<open>n > 0\<close> by (subst n) auto
-    moreover have "Polynomials.lead_coeff p \<noteq> \<zero>\<^bsub>L\<^esub>" "Polynomials.lead_coeff p \<in> carrier L"
-      using p \<open>p \<noteq> []\<close> local.subset
-      by (fastforce simp: polynomial_def univ_poly_def)+
-    ultimately show False
-      using \<open>p \<noteq> []\<close> by (auto simp: last_map last_rev)
-  qed
-
-  have "set p \<subseteq> carrier L"
-    using local.subset p by (auto simp: univ_poly_def polynomial_def)
-  hence "cr_alg_closure (eval p x') (poly p' x)"
-    unfolding p'_def
-    by (induction p)
-       (auto simp flip: K_def L_def simp: cr_alg_closure_def
-               zero_alg_closure.rep_eq plus_alg_closure.rep_eq
-               times_alg_closure.rep_eq Poly_append poly_monom
-               a_comm m_comm x'_def)
-  hence "poly p' x = 0"
-    using p by (auto simp: cr_alg_closure_def x'_def)
-
-  have coeff_p': "Polynomial.coeff p' i \<in> range to_ac" for i
-  proof (cases "i \<ge> length p")
-    case False
-    have "Polynomial.coeff p' i = Abs_alg_closure (rev p ! i)"
-      unfolding p'_def using False
-      by (auto simp: nth_default_def)
-    moreover have "rev p ! i \<in> ?K"
-      using p(1) False by (auto simp: univ_poly_def polynomial_def rev_nth)
-    ultimately show ?thesis
-      unfolding to_ac.abs_eq K_def by fastforce
-  qed (auto simp: p'_def nth_default_def)
-  
-
-  define p'' where "p'' = map_poly of_ac p'"
-  have p'_eq: "p' = map_poly to_ac p''"
-    by (rule poly_eqI) (auto simp: coeff_map_poly p''_def to_ac_of_ac[OF coeff_p'])
-
-  interpret to_ac: map_poly_inj_comm_ring_hom "to_ac :: 'a \<Rightarrow> 'a alg_closure"
-    by unfold_locales auto
-
-  show ?thesis
-  proof (rule that)
-    show "p'' \<noteq> 0"
-      using \<open>p' \<noteq> 0\<close> by (auto simp: p'_eq)
-  next
-    show "poly (map_poly to_ac p'') x = 0"
-      using \<open>poly p' x = 0\<close> by (simp add: p'_eq)
-  qed
-qed
-
-
-instantiation alg_closure :: (field)
-  "{unique_euclidean_ring, normalization_euclidean_semiring, normalization_semidom_multiplicative}"
-begin
-
-definition [simp]: "normalize_alg_closure = (normalize_field :: 'a alg_closure \<Rightarrow> _)"
-definition [simp]: "unit_factor_alg_closure = (unit_factor_field :: 'a alg_closure \<Rightarrow> _)"
-definition [simp]: "modulo_alg_closure = (mod_field :: 'a alg_closure \<Rightarrow> _)"
-definition [simp]: "euclidean_size_alg_closure = (euclidean_size_field :: 'a alg_closure \<Rightarrow> _)"
-definition [simp]: "division_segment (x :: 'a alg_closure) = 1"
-
-instance
-  by standard
-    (simp_all add: dvd_field_iff field_split_simps split: if_splits)
-
-end
-
-instantiation alg_closure :: (field) euclidean_ring_gcd
-begin
-
-definition gcd_alg_closure :: "'a alg_closure \<Rightarrow> 'a alg_closure \<Rightarrow> 'a alg_closure" where
-  "gcd_alg_closure = Euclidean_Algorithm.gcd"
-definition lcm_alg_closure :: "'a alg_closure \<Rightarrow> 'a alg_closure \<Rightarrow> 'a alg_closure" where
-  "lcm_alg_closure = Euclidean_Algorithm.lcm"
-definition Gcd_alg_closure :: "'a alg_closure set \<Rightarrow> 'a alg_closure" where
- "Gcd_alg_closure = Euclidean_Algorithm.Gcd"
-definition Lcm_alg_closure :: "'a alg_closure set \<Rightarrow> 'a alg_closure" where
- "Lcm_alg_closure = Euclidean_Algorithm.Lcm"
-
-instance by standard (simp_all add: gcd_alg_closure_def lcm_alg_closure_def Gcd_alg_closure_def Lcm_alg_closure_def)
-
-end
-
-instance alg_closure :: (field) semiring_gcd_mult_normalize
-  ..
-
-end
\ No newline at end of file
diff --git a/thys/Perfect_Fields/Perfect_Field_Algebraically_Closed.thy b/thys/Perfect_Fields/Perfect_Field_Algebraically_Closed.thy
deleted file mode 100644
--- a/thys/Perfect_Fields/Perfect_Field_Algebraically_Closed.thy
+++ /dev/null
@@ -1,77 +0,0 @@
-(*
-  File:      Perfect_Fields/Perfect_Field_Algebraically_Closed.thy
-  Authors:   Katharina Kreuzer (TU München)
-             Manuel Eberl (University of Innsbruck)
-
-  The connection between algebraically closed fields and perfect fields.
-  Should probably be moved to the main file as soon as algebraically closed
-  fields are available in the distribution.
-*)
-subsection \<open>Algebraically closed fields are perfect\<close>
-theory Perfect_Field_Algebraically_Closed
-  imports Perfect_Fields "Formal_Puiseux_Series.Formal_Puiseux_Series"
-begin
-
-(* TODO: the alg_closed_field type class should be moved from
-   Formal_Puiseux_Series into the distribution.
-*)
-
-(* TODO: Move to wherever alg_closed_field is defined. *)
-lemma (in alg_closed_field) nth_root_exists:
-  assumes "n > 0"
-  shows   "\<exists>y. y ^ n = (x :: 'a)"
-proof -
-  define f where "f = (\<lambda>i. if i = 0 then -x else if i = n then 1 else 0)"
-  have "\<exists>x. (\<Sum>k\<le>n. f k * x ^ k) = 0"
-    by (rule alg_closed) (use assms in \<open>auto simp: f_def\<close>)
-  also have "(\<lambda>x. \<Sum>k\<le>n. f k * x ^ k) = (\<lambda>x. \<Sum>k\<in>{0,n}. f k * x ^ k)"
-    by (intro ext sum.mono_neutral_right) (auto simp: f_def)
-  finally show "\<exists>y. y ^ n = x"
-    using assms by (simp add: f_def)
-qed
-
-
-context alg_closed_field
-begin
-
-lemma alg_closed_surj_frob:
-  assumes "CHAR('a) > 0"
-  shows   "surj (frob :: 'a \<Rightarrow> 'a)"
-proof -
-  show "surj (frob :: 'a \<Rightarrow> 'a)"
-  proof safe
-    fix x :: 'a
-    obtain y where "y ^ CHAR('a) = x"
-      using nth_root_exists CHAR_pos assms by blast
-    hence "frob y = x"
-      using CHAR_pos by (simp add: frob_def)
-    thus "x \<in> range frob"
-      by (metis rangeI)
-  qed auto
-qed
-
-sublocale perfect_field
-  by standard (use alg_closed_surj_frob in auto)
-
-end
-
-
-(* TODO move: some properties of formal Puiseux series *)
-lemma fpxs_const_eq_0_iff [simp]: "fpxs_const x = 0 \<longleftrightarrow> x = 0"
-  by (metis fpxs_const_0 fpxs_const_eq_iff)
-
-lemma semiring_char_fpxs [simp]: "CHAR('a :: comm_semiring_1 fpxs) = CHAR('a)"
-  by (rule CHAR_eqI; unfold of_nat_fpxs_eq) (auto simp: of_nat_eq_0_iff_char_dvd)
-
-instance fpxs :: ("{semiring_prime_char,comm_semiring_1}") semiring_prime_char
-  by (rule semiring_prime_charI) auto
-instance fpxs :: ("{comm_semiring_prime_char,comm_semiring_1}") comm_semiring_prime_char
-  by standard
-instance fpxs :: ("{comm_ring_prime_char,comm_semiring_1}") comm_ring_prime_char
-  by standard
-instance fpxs :: ("{idom_prime_char,comm_semiring_1}") idom_prime_char
-  by standard
-instance fpxs :: ("field_prime_char") field_prime_char
-  by standard auto
-
-end
\ No newline at end of file
diff --git a/thys/Perfect_Fields/Perfect_Field_Altdef.thy b/thys/Perfect_Fields/Perfect_Field_Altdef.thy
--- a/thys/Perfect_Fields/Perfect_Field_Altdef.thy
+++ b/thys/Perfect_Fields/Perfect_Field_Altdef.thy
@@ -1,154 +1,148 @@
 (*
   File:      Perfect_Fields/Perfect_Field_Altdef.thy
   Authors:   Katharina Kreuzer (TU München)
              Manuel Eberl (University of Innsbruck)
 
   Proof that a field where every irreducible polynomial is separable is perfect.
   This effectively shows that our definition is equivalent to the textbook one.
 
   We put this in a separate file because importing HOL-Algebra.Algebraic_Closure
   comes with a lot of annoying baggage that we don't want to pollute our namespace
   with.
 *)
 subsection \<open>Alternative definition of perfect fields\<close>
 theory Perfect_Field_Altdef
 imports 
-  Algebraic_Closure_Type
+  "HOL-Algebra.Algebraic_Closure_Type"
   Perfect_Fields
-  Perfect_Field_Algebraically_Closed
-  "HOL-Computational_Algebra.Field_as_Ring"
 begin
 
-(* TODO: Orphan instance. Move! *)
-instance poly :: ("{field, normalization_euclidean_semiring, factorial_ring_gcd,
-                    semiring_gcd_mult_normalize}") factorial_semiring_multiplicative ..
-
 text \<open>
   In the following, we will show that our definition of perfect fields is equivalent
   to the usual textbook one (for example \cite{conrad}). 
 That is: a field in which every irreducible polynomial is separable
   (or, equivalently, has non-zero derivative) either has characteristic $0$ or a surjective
   Frobenius endomorphism.
 
   The proof works like this:
 
   Let's call our field \<open>K\<close> with prime characteristic \<open>p\<close>.
   Suppose there were some \<open>c \<in> K\<close> that is not a \<open>p\<close>-th root.
   The polynomial $P := X^p - c$ in $K[X]$ clearly has a zero derivative and is therefore
   not separable. By our assumption, it must then have a monic non-trivial factor
   $Q \in K[X]$.
 
   Let \<open>L\<close> be some field extension of \<open>K\<close> where \<open>c\<close> does have a \<open>p\<close>-th root \<open>\<alpha>\<close> (in our
   case, we choose \<open>L\<close> to be the algebraic closure of \<open>K\<close>).
 
   Clearly, \<open>Q\<close> is also a non-trivial factor of \<open>P\<close> in \<open>L\<close>. However, we also
   have \<open>P = X^p - c = X^p - \<alpha>^p = (X - \<alpha>)^p\<close>, so we must have $Q = (X - \alpha )^m$
   for some \<open>0 \<le> m < p\<close> since \<open>X - \<alpha>\<close> is prime.
 
   However, the coefficient of $X^{m-1}$ in $(X - \alpha )^m$ is \<open>-m\<alpha>\<close>, and since
   \<open>Q \<in> K[X]\<close> we must have \<open>-m\<alpha> \<in> K\<close> and therefore \<open>\<alpha> \<in> K\<close>.
 \<close>
 theorem perfect_field_alt:
   assumes "\<And>p :: 'a :: field_gcd poly. Factorial_Ring.irreducible p \<Longrightarrow> pderiv p \<noteq> 0"
   shows   "CHAR('a) = 0 \<or> surj (frob :: 'a \<Rightarrow> 'a)"
 proof (cases "CHAR('a) = 0")
   case False
   let ?p = "CHAR('a)"
   from False have "Factorial_Ring.prime ?p"
     by (simp add: prime_CHAR_semidom)
   hence "?p > 1"
     using prime_gt_1_nat by blast
   note p = \<open>Factorial_Ring.prime ?p\<close> \<open>?p > 1\<close>
 
   interpret to_ac: map_poly_inj_comm_ring_hom "to_ac :: 'a \<Rightarrow> 'a alg_closure"
     by unfold_locales auto
 
   have "surj (frob :: 'a \<Rightarrow> 'a)"
   proof safe
     fix c :: 'a
     obtain \<alpha> :: "'a alg_closure" where \<alpha>: "\<alpha> ^ ?p = to_ac c"
       using p nth_root_exists[of ?p "to_ac c"] by auto
     define P where "P = Polynomial.monom 1 ?p + [:-c:]"
     define P' where "P' = map_poly to_ac P"
     have deg: "Polynomial.degree P = ?p"
       unfolding P_def using p by (subst degree_add_eq_left) (auto simp: degree_monom_eq)
 
     have "[:-\<alpha>, 1:] ^ ?p = ([:0, 1:] + [:-\<alpha>:]) ^ ?p"
       by (simp add: one_pCons)
     also have "\<dots> = [:0, 1:] ^ ?p - [:\<alpha>^?p:]"
       using p by (subst freshmans_dream) (auto simp: poly_const_pow minus_power_prime_CHAR)
     also have "\<alpha> ^ ?p = to_ac c"
       by (simp add: \<alpha>)
     also have "[:0, 1:] ^ CHAR('a) - [:to_ac c:] = P'"
       by (simp add: P_def P'_def to_ac.hom_add to_ac.hom_power 
                to_ac.base.map_poly_pCons_hom monom_altdef)
     finally have eq: "P' = [:-\<alpha>, 1:] ^ ?p" ..
 
     have "\<not>is_unit P" "P \<noteq> 0"
       using deg p by auto
     then obtain Q where Q: "Factorial_Ring.prime Q" "Q dvd P"
       by (metis prime_divisor_exists)
     have "monic Q"
       using unit_factor_prime[OF Q(1)] by (auto simp: unit_factor_poly_def one_pCons)
 
     from Q(2) have "map_poly to_ac Q dvd P'"
       by (auto simp: P'_def)
     hence "map_poly to_ac Q dvd [:-\<alpha>, 1:] ^ ?p"
       by (simp add: \<open>P' = [:-\<alpha>, 1:] ^ ?p\<close>)
     moreover have "Factorial_Ring.prime_elem [:-\<alpha>, 1:]"
       by (intro prime_elem_linear_field_poly) auto
     hence "Factorial_Ring.prime [:-\<alpha>, 1:]"
       unfolding Factorial_Ring.prime_def by (auto simp: normalize_monic)
     ultimately obtain m where "m \<le> ?p" "normalize (map_poly to_ac Q) = [:-\<alpha>, 1:] ^ m"
       using divides_primepow by blast
     hence "map_poly to_ac Q = [:-\<alpha>, 1:] ^ m"
       using \<open>monic Q\<close> by (subst (asm) normalize_monic) auto
     moreover from this have "m > 0"
       using Q by (intro Nat.gr0I) auto
     moreover have "m \<noteq> ?p"
     proof
       assume "m = ?p"
       hence "Q = P"
         using \<open>map_poly to_ac Q = [:-\<alpha>, 1:] ^ m\<close> eq
         by (simp add: P'_def to_ac.injectivity)
       with Q have "Factorial_Ring.irreducible P"
         using idom_class.prime_elem_imp_irreducible by blast
       with assms have "pderiv P \<noteq> 0"
         by blast
       thus False
         by (auto simp: P_def pderiv_add pderiv_monom of_nat_eq_0_iff_char_dvd)
     qed
     ultimately have m: "m \<in> {0<..<?p}" "map_poly to_ac Q = [:-\<alpha>, 1:] ^ m"
       using \<open>m \<le> ?p\<close> by auto
 
     from m(1) have "\<not>?p dvd m"
       using p by auto
     have "poly.coeff ([:-\<alpha>, 1:] ^ m) (m - 1) = - of_nat (m choose (m - 1)) * \<alpha>"
       using m(1) by (subst coeff_linear_poly_power) auto
     also have "m choose (m - 1) = m"
       using \<open>0 < m\<close> by (subst binomial_symmetric) auto
     also have "[:-\<alpha>, 1:] ^ m = map_poly to_ac Q"
       using m(2) ..
     also have "poly.coeff \<dots> (m - 1) = to_ac (poly.coeff Q (m - 1))"
       by simp
     finally have "\<alpha> = to_ac (-poly.coeff Q (m - 1) / of_nat m)"
       using m(1) p \<open>\<not>?p dvd m\<close> by (auto simp: field_simps of_nat_eq_0_iff_char_dvd)
     hence "(- poly.coeff Q (m - 1) / of_nat m) ^ ?p = c"
       using \<alpha> by (metis to_ac.base.eq_iff to_ac.base.hom_power)
     thus "c \<in> range frob"
       unfolding frob_def by blast
   qed auto
   thus ?thesis ..
 qed auto
 
 corollary perfect_field_alt':
   assumes "\<And>p :: 'a :: field_gcd poly. Factorial_Ring.irreducible p \<Longrightarrow> Rings.coprime p (pderiv p)"
   shows   "CHAR('a) = 0 \<or> surj (frob :: 'a \<Rightarrow> 'a)"
 proof (rule perfect_field_alt)
   fix p :: "'a poly"
   assume p: "Factorial_Ring.irreducible p"
   with assms[OF p] show "pderiv p \<noteq> 0"
     by auto
 qed
 
 end
diff --git a/thys/Perfect_Fields/Perfect_Field_Library.thy b/thys/Perfect_Fields/Perfect_Field_Library.thy
deleted file mode 100644
--- a/thys/Perfect_Fields/Perfect_Field_Library.thy
+++ /dev/null
@@ -1,268 +0,0 @@
-(*
-  File:      Perfect_Fields/Perfect_Field_Library.thy
-  Authors:   Katharina Kreuzer (TU München)
-             Manuel Eberl (University of Innsbruck)
-
-  A few auxiliary results, most of which should probably be moved to 
-  the distribution.
-*)
-
-theory Perfect_Field_Library
-imports
-  "HOL-Computational_Algebra.Computational_Algebra"
-  "Berlekamp_Zassenhaus.Finite_Field"
-begin
-
-lemma semiring_char_mod_ring [simp]:
-  "CHAR('n :: nontriv mod_ring) = CARD('n)"
-proof (rule CHAR_eq_posI)
-  fix x assume "x > 0" "x < CARD('n)"
-  thus "of_nat x \<noteq> (0 :: 'n mod_ring)"
-    by transfer auto
-qed auto
-
-lemma of_nat_eq_iff_cong_CHAR:
-  "of_nat x = (of_nat y :: 'a :: semiring_1_cancel) \<longleftrightarrow> [x = y] (mod CHAR('a))"
-proof (induction x y rule: linorder_wlog)
-  case (le x y)
-  define z where "z = y - x"
-  have [simp]: "y = x + z"
-    using le by (auto simp: z_def)
-  have "(CHAR('a) dvd z) = [x = x + z] (mod CHAR('a))"
-    by (metis \<open>y = x + z\<close> cong_def le mod_eq_dvd_iff_nat z_def)
-  thus ?case
-    by (simp add: of_nat_eq_0_iff_char_dvd)
-qed (simp add: eq_commute cong_sym_eq)   
-
-lemma (in ring_1) of_int_eq_0_iff_char_dvd:
-  "(of_int n = (0 :: 'a)) = (int CHAR('a) dvd n)"
-proof (cases "n \<ge> 0")
-  case True
-  hence "(of_int n = (0 :: 'a)) \<longleftrightarrow> (of_nat (nat n)) = (0 :: 'a)"
-    by auto
-  also have "\<dots> \<longleftrightarrow> CHAR('a) dvd nat n"
-    by (subst of_nat_eq_0_iff_char_dvd) auto
-  also have "\<dots> \<longleftrightarrow> int CHAR('a) dvd n"
-    using True by presburger
-  finally show ?thesis .
-next
-  case False
-  hence "(of_int n = (0 :: 'a)) \<longleftrightarrow> -(of_nat (nat (-n))) = (0 :: 'a)"
-    by auto
-  also have "\<dots> \<longleftrightarrow> CHAR('a) dvd nat (-n)"
-    by (auto simp: of_nat_eq_0_iff_char_dvd)
-  also have "\<dots> \<longleftrightarrow> int CHAR('a) dvd n"
-    using False dvd_nat_abs_iff[of "CHAR('a)" n] by simp
-  finally show ?thesis .
-qed
-
-lemma (in ring_1) of_int_eq_iff_cong_CHAR:
-  "of_int x = (of_int y :: 'a) \<longleftrightarrow> [x = y] (mod int CHAR('a))"
-proof -
-  have "of_int x = (of_int y :: 'a) \<longleftrightarrow> of_int (x - y) = (0 :: 'a)"
-    by auto
-  also have "\<dots> \<longleftrightarrow> (int CHAR('a) dvd x - y)"
-    by (rule of_int_eq_0_iff_char_dvd)
-  also have "\<dots> \<longleftrightarrow> [x = y] (mod int CHAR('a))"
-    by (simp add: cong_iff_dvd_diff)
-  finally show ?thesis .
-qed
-
-lemma finite_imp_CHAR_pos:
-  assumes "finite (UNIV :: 'a set)"
-  shows   "CHAR('a :: semiring_1_cancel) > 0"
-proof -
-  have "\<exists>n\<in>UNIV. infinite {m \<in> UNIV. of_nat m = (of_nat n :: 'a)}"
-  proof (rule pigeonhole_infinite)
-    show "infinite (UNIV :: nat set)"
-      by simp
-    show "finite (range (of_nat :: nat \<Rightarrow> 'a))"
-      by (rule finite_subset[OF _ assms]) auto
-  qed
-  then obtain n :: nat where "infinite {m \<in> UNIV. of_nat m = (of_nat n :: 'a)}"
-    by blast
-  hence "\<not>({m \<in> UNIV. of_nat m = (of_nat n :: 'a)} \<subseteq> {n})"
-    by (intro notI) (use finite_subset in blast)
-  then obtain m where "m \<noteq> n" "of_nat m = (of_nat n :: 'a)"
-    by blast
-  hence "[m = n] (mod CHAR('a))"
-    by (simp add: of_nat_eq_iff_cong_CHAR)
-  hence "CHAR('a) \<noteq> 0"
-    using \<open>m \<noteq> n\<close> by (intro notI) auto
-  thus ?thesis
-    by simp
-qed
-
-lemma CHAR_dvd_CARD: "CHAR('a :: ring_1) dvd CARD('a)"
-proof (cases "CARD('a) = 0")
-  case False
-  hence [intro]: "CHAR('a) > 0"
-    by (simp add: card_eq_0_iff finite_imp_CHAR_pos)    
-  define G where "G = \<lparr> carrier = (UNIV :: 'a set), monoid.mult = (+), one = (0 :: 'a) \<rparr>"
-  define H where "H = (of_nat ` {..<CHAR('a)} :: 'a set)"
-  interpret group G
-  proof (rule groupI)
-    fix x assume x: "x \<in> carrier G"
-    show "\<exists>y\<in>carrier G. y \<otimes>\<^bsub>G\<^esub> x = \<one>\<^bsub>G\<^esub>"
-      by (intro bexI[of _ "-x"]) (auto simp: G_def)
-  qed (auto simp: G_def add_ac)
-
-  interpret subgroup H G
-  proof
-    show "\<one>\<^bsub>G\<^esub> \<in> H"
-      using False unfolding G_def H_def
-      by (intro image_eqI[of _ _ 0]) auto
-  next
-    fix x y :: 'a
-    assume "x \<in> H" "y \<in> H"
-    then obtain x' y' where [simp]: "x = of_nat x'" "y = of_nat y'"
-      by (auto simp: H_def)
-    have "x + y = of_nat ((x' + y') mod CHAR('a))"
-      by (auto simp flip: of_nat_add simp: of_nat_eq_iff_cong_CHAR)
-    moreover have "(x' + y') mod CHAR('a) < CHAR('a)"
-      using H_def \<open>y \<in> H\<close> by fastforce
-    ultimately show "x \<otimes>\<^bsub>G\<^esub> y \<in> H"
-      by (auto simp: H_def G_def intro!: imageI)
-  next
-    fix x :: 'a
-    assume x: "x \<in> H"
-    then obtain x' where [simp]: "x = of_nat x'" and x': "x' < CHAR('a)"
-      by (auto simp: H_def)
-    have "CHAR('a) dvd x' + (CHAR('a) - x') mod CHAR('a)"
-      by (metis x' dvd_eq_mod_eq_0 le_add_diff_inverse mod_add_right_eq mod_self order_less_imp_le)
-    hence "x + of_nat ((CHAR('a) - x') mod CHAR('a)) = 0"
-      by (auto simp flip: of_nat_add simp: of_nat_eq_0_iff_char_dvd)
-    moreover from this have "inv\<^bsub>G\<^esub> x = of_nat ((CHAR('a) - x') mod CHAR('a))"
-      by (intro inv_equality) (auto simp: G_def add_ac)
-    moreover have "of_nat ((CHAR('a) - x') mod CHAR('a)) \<in> H"
-      unfolding H_def using \<open>CHAR('a) > 0\<close> by (intro imageI) auto
-    ultimately show "inv\<^bsub>G\<^esub> x \<in> H" by force
-  qed (auto simp: G_def H_def)
-
-  have "card H dvd card (rcosets\<^bsub>G\<^esub> H) * card H"
-    by simp
-  also have "card (rcosets\<^bsub>G\<^esub> H) * card H = Coset.order G"
-  proof (rule lagrange_finite)
-    show "finite (carrier G)"
-      using False card_ge_0_finite by (auto simp: G_def)
-  qed (fact is_subgroup)
-  finally have "card H dvd CARD('a)"
-    by (simp add: Coset.order_def G_def)
-  also have "card H = card {..<CHAR('a)}"
-    unfolding H_def by (intro card_image inj_onI) (auto simp: of_nat_eq_iff_cong_CHAR cong_def)
-  finally show "CHAR('a) dvd CARD('a)"
-    by simp
-qed auto
-
-lemma (in idom) prime_CHAR_semidom:
-  assumes "CHAR('a) > 0"
-  shows   "prime CHAR('a)"
-proof -
-  have False if ab: "a \<noteq> 1" "b \<noteq> 1" "CHAR('a) = a * b" for a b
-  proof -
-    from assms ab have "a > 0" "b > 0"
-      by (auto intro!: Nat.gr0I)    
-    have "of_nat (a * b) = (0 :: 'a)"
-      using ab by (metis of_nat_CHAR)
-    also have "of_nat (a * b) = (of_nat a :: 'a) * of_nat b"
-      by simp
-    finally have "of_nat a * of_nat b = (0 :: 'a)" .
-    moreover have "of_nat a * of_nat b \<noteq> (0 :: 'a)"
-      using ab \<open>a > 0\<close> \<open>b > 0\<close>
-      by (intro no_zero_divisors) (auto simp: of_nat_eq_0_iff_char_dvd)
-    ultimately show False
-      by contradiction
-  qed
-  moreover have "CHAR('a) > 1"
-    using assms CHAR_not_1' by linarith
-  ultimately have "prime_elem CHAR('a)"
-    by (intro irreducible_imp_prime_elem) (auto simp: Factorial_Ring.irreducible_def)
-  thus ?thesis
-    by auto
-qed
-
-
-text \<open>
-  Characteristics are preserved by typical functors (polynomials, power series, Laurent series):
-\<close>
-lemma semiring_char_poly [simp]: "CHAR('a :: comm_semiring_1 poly) = CHAR('a)"
-  by (rule CHAR_eqI) (auto simp: of_nat_poly of_nat_eq_0_iff_char_dvd)
-
-lemma semiring_char_fps [simp]: "CHAR('a :: comm_semiring_1 fps) = CHAR('a)"
-  by (rule CHAR_eqI) (auto simp flip: fps_of_nat simp: of_nat_eq_0_iff_char_dvd)
-
-(* TODO Move *)
-lemma fls_const_eq_0_iff [simp]: "fls_const c = 0 \<longleftrightarrow> c = 0"
-  using fls_const_0 fls_const_nonzero by blast
-
-lemma semiring_char_fls [simp]: "CHAR('a :: comm_semiring_1 fls) = CHAR('a)"
-  by (rule CHAR_eqI) (auto simp: fls_of_nat of_nat_eq_0_iff_char_dvd fls_const_nonzero)
-
-lemma irreducible_power_iff [simp]:
-  "irreducible (p ^ n) \<longleftrightarrow> irreducible p \<and> n = 1"
-proof
-  assume *: "irreducible (p ^ n)"
-  have [simp]: "\<not>p dvd 1"
-  proof
-    assume "p dvd 1"
-    hence "p ^ n dvd 1"
-      by (metis dvd_power_same power_one)
-    with * show False
-      by auto
-  qed
-
-  consider "n = 0" | "n = 1" | "n > 1"
-    by linarith
-  thus "irreducible p \<and> n = 1"
-  proof cases
-    assume "n > 1"
-    hence "p ^ n = p * p ^ (n - 1)"
-      by (cases n) auto
-    with * \<open>\<not> p dvd 1\<close> have "p ^ (n - 1) dvd 1"
-      using irreducible_multD by blast
-    with \<open>\<not>p dvd 1\<close> and \<open>n > 1\<close> have False
-      by (meson dvd_power dvd_trans zero_less_diff)
-    thus ?thesis ..
-  qed (use * in auto)
-qed auto
-
-lemma pderiv_monom:
-  "pderiv (Polynomial.monom c n) = of_nat n * Polynomial.monom c (n - 1)"
-proof (cases n)
-  case (Suc n)
-  show ?thesis
-    unfolding monom_altdef Suc pderiv_smult pderiv_power_Suc pderiv_pCons
-    by (simp add: of_nat_poly)
-qed (auto simp: monom_altdef)
-
-lemma uminus_CHAR_2 [simp]:
-  assumes "CHAR('a :: ring_1) = 2"
-  shows   "-(x :: 'a) = x"
-proof -
-  have "x + x = 2 * x"
-    by (simp add: mult_2)
-  also have "2 = (0 :: 'a)"
-    using assms by (metis of_nat_CHAR of_nat_numeral)
-  finally show ?thesis
-    by (simp add: add_eq_0_iff2)
-qed
-
-lemma minus_CHAR_2 [simp]:
-  assumes "CHAR('a :: ring_1) = 2"
-  shows   "(x - y :: 'a) = x + y"
-  using uminus_CHAR_2[of y] assms by simp
-
-lemma minus_power_prime_CHAR:
-  assumes "p = CHAR('a :: {ring_1})" "prime p"
-  shows "(-x :: 'a) ^ p = -(x ^ p)"
-proof (cases "p = 2")
-  case False
-  have "prime p"
-    using assms by blast
-  with False have "odd p"
-    using primes_dvd_imp_eq two_is_prime_nat by blast
-  thus ?thesis
-    by simp
-qed (use assms in auto)
-
-end
\ No newline at end of file
diff --git a/thys/Perfect_Fields/Perfect_Fields.thy b/thys/Perfect_Fields/Perfect_Fields.thy
--- a/thys/Perfect_Fields/Perfect_Fields.thy
+++ b/thys/Perfect_Fields/Perfect_Fields.thy
@@ -1,966 +1,764 @@
 (*
   File:      Perfect_Fields/Perfect_Fields.thy
   Authors:   Katharina Kreuzer (TU München)
              Manuel Eberl (University of Innsbruck)
 
   Typeclasses for fields of prime characteristic
   Frobenius endomorphism on a field type
   Fields with a surjective Frobenius endomorphism
   Typeclass for perfect fields and some basic results about them
 *)
 section \<open>Perfect Fields\<close>
 theory Perfect_Fields
 imports
+  "HOL-Computational_Algebra.Computational_Algebra"
   "Berlekamp_Zassenhaus.Finite_Field" 
-  Perfect_Field_Library
-begin
-
-subsection \<open>Rings and fields with prime characteristic\<close>
-
-text \<open>
-  We introduce some type classes for rings and fields with prime characteristic.
-\<close>
-
-class semiring_prime_char = semiring_1 +
-  assumes prime_char_aux: "\<exists>n. prime n \<and> of_nat n = (0 :: 'a)"
-begin
-
-lemma CHAR_pos [intro, simp]: "CHAR('a) > 0"
-  using local.CHAR_pos_iff local.prime_char_aux prime_gt_0_nat by blast
-
-lemma CHAR_nonzero [simp]: "CHAR('a) \<noteq> 0"
-  using CHAR_pos by auto
-
-lemma CHAR_prime [intro, simp]: "prime CHAR('a)"
-  by (metis (mono_tags, lifting) gcd_nat.order_iff_strict local.of_nat_1 local.of_nat_eq_0_iff_char_dvd
-        local.one_neq_zero local.prime_char_aux prime_nat_iff)
-
-end
-
-lemma semiring_prime_charI [intro?]:
-  "prime CHAR('a :: semiring_1) \<Longrightarrow> OFCLASS('a, semiring_prime_char_class)"
-  by standard auto
-
-
-lemma idom_prime_charI [intro?]:
-  assumes "CHAR('a :: idom) > 0"
-  shows   "OFCLASS('a, semiring_prime_char_class)"
-proof
-  show "prime CHAR('a)"
-    using assms prime_CHAR_semidom by blast
-qed
-
-class comm_semiring_prime_char = comm_semiring_1 + semiring_prime_char
-class comm_ring_prime_char = comm_ring_1 + semiring_prime_char
-begin
-subclass comm_semiring_prime_char ..
-end
-class idom_prime_char = idom + semiring_prime_char
-begin
-subclass comm_ring_prime_char ..
-end
-
-class field_prime_char = field +
-  assumes pos_char_exists: "\<exists>n>0. of_nat n = (0 :: 'a)"
 begin
-subclass idom_prime_char
-  apply standard
-  using pos_char_exists local.CHAR_pos_iff local.of_nat_CHAR local.prime_CHAR_semidom by blast
-end
-
-
-lemma field_prime_charI [intro?]:
-  "n > 0 \<Longrightarrow> of_nat n = (0 :: 'a :: field) \<Longrightarrow> OFCLASS('a, field_prime_char_class)"
-  by standard auto
-
-lemma field_prime_charI' [intro?]:
-  "CHAR('a :: field) > 0 \<Longrightarrow> OFCLASS('a, field_prime_char_class)"
-  by standard auto
-
-
-text \<open>
-  Typical functors like polynomials, formal power seires, and formal Laurent series
-  preserve the characteristic of the coefficient ring.
-\<close>
-instance poly :: ("{semiring_prime_char,comm_semiring_1}") semiring_prime_char
-  by (rule semiring_prime_charI) auto
-instance poly :: ("{comm_semiring_prime_char,comm_semiring_1}") comm_semiring_prime_char
-  by standard
-instance poly :: ("{comm_ring_prime_char,comm_semiring_1}") comm_ring_prime_char
-  by standard
-instance poly :: ("{idom_prime_char,comm_semiring_1}") idom_prime_char
-  by standard
-
-instance fps :: ("{semiring_prime_char,comm_semiring_1}") semiring_prime_char
-  by (rule semiring_prime_charI) auto
-instance fps :: ("{comm_semiring_prime_char,comm_semiring_1}") comm_semiring_prime_char
-  by standard
-instance fps :: ("{comm_ring_prime_char,comm_semiring_1}") comm_ring_prime_char
-  by standard
-instance fps :: ("{idom_prime_char,comm_semiring_1}") idom_prime_char
-  by standard
-
-instance fls :: ("{semiring_prime_char,comm_semiring_1}") semiring_prime_char
-  by (rule semiring_prime_charI) auto
-instance fls :: ("{comm_semiring_prime_char,comm_semiring_1}") comm_semiring_prime_char
-  by standard
-instance fls :: ("{comm_ring_prime_char,comm_semiring_1}") comm_ring_prime_char
-  by standard
-instance fls :: ("{idom_prime_char,comm_semiring_1}") idom_prime_char
-  by standard
-instance fls :: ("{field_prime_char,comm_semiring_1}") field_prime_char
-  by (rule field_prime_charI') auto
-
-
-subsection \<open>Finite fields\<close>
-
-class finite_field = field_prime_char + finite
-
-lemma finite_fieldI [intro?]:
-  assumes "finite (UNIV :: 'a :: field set)"
-  shows   "OFCLASS('a, finite_field_class)"
-proof standard
-  show "\<exists>n>0. of_nat n = (0 :: 'a)"
-    using assms prime_CHAR_semidom[where ?'a = 'a] finite_imp_CHAR_pos[OF assms]
-    by (intro exI[of _ "CHAR('a)"]) auto
-qed fact+
-
-class enum_finite_field = finite_field +
-  fixes enum_finite_field :: "nat \<Rightarrow> 'a"
-  assumes enum_finite_field: "enum_finite_field ` {..<CARD('a)} = UNIV"
-begin
-
-lemma inj_on_enum_finite_field: "inj_on enum_finite_field {..<CARD('a)}"
-  using enum_finite_field by (simp add: eq_card_imp_inj_on)
-
-end
-
-instance mod_ring :: (prime_card) finite_field
-  by standard simp_all
-
-instantiation mod_ring :: (prime_card) enum_finite_field
-begin
-
-definition enum_finite_field_mod_ring :: "nat \<Rightarrow> 'a mod_ring" where
-  "enum_finite_field_mod_ring n = of_int_mod_ring (int n)"
-
-instance proof
-  interpret type_definition "Rep_mod_ring :: 'a mod_ring \<Rightarrow> int" Abs_mod_ring "{0..<CARD('a)}"
-    by (rule type_definition_mod_ring)
-  have "enum_finite_field ` {..<CARD('a mod_ring)} = of_int_mod_ring ` int ` {..<CARD('a mod_ring)}"
-    unfolding enum_finite_field_mod_ring_def by (simp add: image_image o_def)
-  also have "int ` {..<CARD('a mod_ring)} = {0..<int CARD('a mod_ring)}"
-    by (simp add: image_atLeastZeroLessThan_int)
-  also have "of_int_mod_ring ` \<dots> = (Abs_mod_ring ` \<dots> :: 'a mod_ring set)"
-    by (intro image_cong refl) (auto simp: of_int_mod_ring_def)
-  also have "\<dots> = (UNIV :: 'a mod_ring set)"
-    using Abs_image by simp
-  finally show "enum_finite_field ` {..<CARD('a mod_ring)} = (UNIV :: 'a mod_ring set)" .
-qed
-
-end
-
-
-
-text \<open>
-  On a finite field with \<open>n\<close> elements, taking the \<open>n\<close>-th power of an element
-  is the identity. This is an obvious consequence of the fact that the multiplicative group of
-  the field is a finite group of order \<open>n - 1\<close>, so \<open>x^n = 1\<close> for any non-zero \<open>x\<close>.
-
-  Note that this result is sharp in the sense that the multiplicative group of a
-  finite field is cyclic, i.e.\ it contains an element of order \<open>n - 1\<close>.
-  (We don't prove this here.)
-\<close>
-lemma finite_field_power_card_eq_same:
-  fixes x :: "'a :: finite_field"
-  shows   "x ^ CARD('a) = x"
-proof (cases "x = 0")
-  case False
-  let ?R = "\<lparr>carrier = (UNIV :: 'a set), monoid.mult = (*), one = 1, zero = 0, add = (+)\<rparr>"
-  interpret field "?R" rewrites "([^]\<^bsub>?R\<^esub>) = (^)"
-  proof -
-    show "field ?R"
-      by unfold_locales (auto simp: Units_def add_eq_0_iff ring_distribs
-                              intro!: exI[of _ "inverse x" for x] left_inverse right_inverse)
-    have "x [^]\<^bsub>?R\<^esub> n = x ^ n" for x n
-      by (induction n) auto
-    thus "([^]\<^bsub>?R\<^esub>) = (^)"
-      by blast
-  qed
-
-  note fin [intro] = finite_class.finite_UNIV[where ?'a = 'a]
-  have "x ^ (CARD('a) - 1) * x = x ^ CARD('a)"
-    using finite_UNIV_card_ge_0 power_minus_mult by blast
-  also have "x ^ (CARD('a) - 1) = 1"
-    using units_power_order_eq_one[of x] fin False
-    by (simp add: field_Units)
-  finally show ?thesis
-    by simp
-qed (use finite_class.finite_UNIV[where ?'a = 'a] in \<open>auto simp: card_gt_0_iff\<close>)
-
-lemma finite_field_power_card_power_eq_same:
-  fixes x :: "'a :: finite_field"
-  assumes "m = CARD('a) ^ n"
-  shows   "x ^ m = x"
-  unfolding assms
-  by (induction n) (simp_all add: finite_field_power_card_eq_same power_mult)
-
-
-typedef (overloaded) 'a :: semiring_1 ring_char = "if CHAR('a) = 0 then UNIV else {0..<CHAR('a)}"
-  by auto
-
-lemma CARD_ring_char [simp]: "CARD ('a :: semiring_1 ring_char) = CHAR('a)"
-proof -
-  let ?A = "if CHAR('a) = 0 then UNIV else {0..<CHAR('a)}"
-  interpret type_definition "Rep_ring_char :: 'a ring_char \<Rightarrow> nat" Abs_ring_char ?A
-    by (rule type_definition_ring_char)
-  from card show ?thesis
-    by auto
-qed
-
-instance ring_char :: (semiring_prime_char) nontriv
-proof
-  show "CARD('a ring_char) > 1"
-    using prime_nat_iff by auto
-qed
-
-instance ring_char :: (semiring_prime_char) prime_card
-proof
-  from CARD_ring_char show "prime CARD('a ring_char)"
-    by auto
-qed
-
-lemma to_int_mod_ring_add:
-  "to_int_mod_ring (x + y :: 'a :: finite mod_ring) = (to_int_mod_ring x + to_int_mod_ring y) mod CARD('a)"
-  by transfer auto
-
-lemma to_int_mod_ring_mult:
-  "to_int_mod_ring (x * y :: 'a :: finite mod_ring) = (to_int_mod_ring x * to_int_mod_ring y) mod CARD('a)"
-  by transfer auto
-
-lemma of_nat_mod_CHAR [simp]: "of_nat (x mod CHAR('a :: semiring_1)) = (of_nat x :: 'a)"
-  by (metis (no_types, opaque_lifting) comm_monoid_add_class.add_0 div_mod_decomp
-         mult_zero_right of_nat_CHAR of_nat_add of_nat_mult)
-
-lemma of_int_mod_CHAR [simp]: "of_int (x mod int CHAR('a :: ring_1)) = (of_int x :: 'a)"
-  by (simp add: of_int_eq_iff_cong_CHAR)
 
 lemma (in vector_space) bij_betw_representation:
   assumes [simp]: "independent B" "finite B"
   shows   "bij_betw (\<lambda>v. \<Sum>b\<in>B. scale (v b) b) (B \<rightarrow>\<^sub>E UNIV) (span B)"
 proof (rule bij_betwI)
   show "(\<lambda>v. \<Sum>b\<in>B. v b *s b) \<in> (B \<rightarrow>\<^sub>E UNIV) \<rightarrow> local.span B"
     (is "?f \<in> _")
     by (auto intro: span_sum span_scale span_base)
   show "(\<lambda>x. restrict (representation B x) B) \<in> local.span B \<rightarrow> B \<rightarrow>\<^sub>E UNIV"
     (is "?g \<in> _") by auto
   show "?g (?f v) = v" if "v \<in> B \<rightarrow>\<^sub>E UNIV" for v
   proof
     fix b :: 'b
     show "?g (?f v) b = v b"
     proof (cases "b \<in> B")
       case b: True
       have "?g (?f v) b = (\<Sum>i\<in>B. local.representation B (v i *s i) b)"
         using b by (subst representation_sum) (auto intro: span_scale span_base)
       also have "\<dots> = (\<Sum>i\<in>B. v i * local.representation B i b)"
         by (intro sum.cong) (auto simp: representation_scale span_base)
       also have "\<dots> = (\<Sum>i\<in>{b}. v i * local.representation B i b)"
         by (intro sum.mono_neutral_right) (auto simp: representation_basis b)
       also have "\<dots> = v b"
         by (simp add: representation_basis b)
       finally show "?g (?f v) b = v b" .
     qed (use that in auto)
   qed
   show "?f (?g v) = v" if "v \<in> span B" for v
     using that by (simp add: sum_representation_eq)
 qed
 
 lemma (in vector_space) card_span:
   assumes [simp]: "independent B" "finite B"
   shows   "card (span B) = CARD('a) ^ card B"
 proof -
   have "card (B \<rightarrow>\<^sub>E (UNIV :: 'a set)) = card (span B)"
     by (rule bij_betw_same_card, rule bij_betw_representation) fact+
   thus ?thesis
     by (simp add: card_PiE dim_span_eq_card_independent)
 qed
 
 lemma (in zero_neq_one) CARD_neq_1: "CARD('a) \<noteq> Suc 0"
 proof
   assume "CARD('a) = Suc 0"
   have "{0, 1} \<subseteq> (UNIV :: 'a set)"
     by simp
   also have "is_singleton (UNIV :: 'a set)"
     by (simp add: is_singleton_altdef \<open>CARD('a) = _\<close>)
   then obtain x :: 'a where "UNIV = {x}"
     by (elim is_singletonE)
   finally have "0 = (1 :: 'a)"
     by blast
   thus False
     using zero_neq_one by contradiction
 qed
 
 theorem CARD_finite_field_is_CHAR_power: "\<exists>n>0. CARD('a :: finite_field) = CHAR('a) ^ n"
 proof -
   define s :: "'a ring_char mod_ring \<Rightarrow> 'a \<Rightarrow> 'a" where
     "s = (\<lambda>x y. of_int (to_int_mod_ring x) * y)"
   interpret vector_space s
     by unfold_locales (auto simp: s_def algebra_simps to_int_mod_ring_add to_int_mod_ring_mult)
   obtain B where B: "independent B" "span B = UNIV"
     by (rule basis_exists[of UNIV]) auto
   have [simp]: "finite B"
     by simp
   have "card (span B) = CHAR('a) ^ card B"
     using B by (subst card_span) auto
   hence *: "CARD('a) = CHAR('a) ^ card B"
     using B by simp
   from * have "card B \<noteq> 0"
     by (auto simp: B(2) CARD_neq_1)
   with * show ?thesis
     by blast
 qed
 
 
 subsection \<open>The Freshman's Dream in rings of non-zero characteristic\<close>
 
 lemma (in comm_semiring_1) freshmans_dream:
   fixes x y :: 'a and n :: nat
   assumes "prime CHAR('a)"
   assumes n_def: "n = CHAR('a)"
   shows   "(x + y) ^ n = x ^ n + y ^ n"
 proof -
   interpret comm_semiring_prime_char
     by standard (auto intro!: exI[of _ "CHAR('a)"] assms)
   have "n > 0"
     unfolding n_def by simp
   have "(x + y) ^ n = (\<Sum>k\<le>n. of_nat (n choose k) * x ^ k * y ^ (n - k))"
     by (rule binomial_ring)
   also have "\<dots> = (\<Sum>k\<in>{0,n}. of_nat (n choose k) * x ^ k * y ^ (n - k))"
   proof (intro sum.mono_neutral_right ballI)
     fix k assume "k \<in> {..n} - {0, n}"
     hence k: "k > 0" "k < n"
       by auto
     have "CHAR('a) dvd (n choose k)"
       unfolding n_def
       by (rule dvd_choose_prime) (use k in \<open>auto simp: n_def\<close>)
     hence "of_nat (n choose k) = (0 :: 'a)"
       using of_nat_eq_0_iff_char_dvd by blast
     thus "of_nat (n choose k) * x ^ k * y ^ (n - k) = 0"
       by simp
   qed auto
   finally show ?thesis
     using \<open>n > 0\<close> by (simp add: add_ac)
 qed
 
 lemma (in comm_semiring_1) freshmans_dream':
   assumes [simp]: "prime CHAR('a)" and "m = CHAR('a) ^ n"
   shows "(x + y :: 'a) ^ m = x ^ m + y ^ m"
   unfolding assms(2)
 proof (induction n)
   case (Suc n)
   have "(x + y) ^ (CHAR('a) ^ n * CHAR('a)) = ((x + y) ^ (CHAR('a) ^ n)) ^ CHAR('a)"
     by (rule power_mult)
   thus ?case
     by (simp add: Suc.IH freshmans_dream Groups.mult_ac flip: power_mult)
 qed auto
 
 lemma (in comm_semiring_1) freshmans_dream_sum:
   fixes f :: "'b \<Rightarrow> 'a"
   assumes "prime CHAR('a)" and "n = CHAR('a)"
   shows "sum f A ^ n = sum (\<lambda>i. f i ^ n) A"
   using assms
   by (induct A rule: infinite_finite_induct)
      (auto simp add: power_0_left freshmans_dream)
 
 lemma (in comm_semiring_1) freshmans_dream_sum':
   fixes f :: "'b \<Rightarrow> 'a"
   assumes "prime CHAR('a)" "m = CHAR('a) ^ n"
   shows   "sum f A ^ m = sum (\<lambda>i. f i ^ m) A"
   using assms
   by (induction A rule: infinite_finite_induct)
      (auto simp: freshmans_dream' power_0_left)
 
 
 subsection \<open>The Frobenius endomorphism\<close>
 
 definition (in semiring_1) frob :: "'a \<Rightarrow> 'a" where
   "frob x = x ^ CHAR('a)"
 
 definition (in semiring_1) inv_frob :: "'a \<Rightarrow> 'a" where
   "inv_frob x = (if x \<in> {0, 1} then x else if x \<in> range frob then inv_into UNIV frob x else x)"
 
 lemma (in semiring_1) inv_frob_0 [simp]: "inv_frob 0 = 0"
   and inv_frob_1 [simp]: "inv_frob 1 = 1"
   by (simp_all add: inv_frob_def)
 
 lemma (in semiring_prime_char) frob_0 [simp]: "frob (0 :: 'a) = 0"
   by (simp add: frob_def power_0_left)
 
 lemma (in semiring_1) frob_1 [simp]: "frob 1 = 1"
   by (simp add: frob_def)
 
 lemma (in comm_semiring_1) frob_mult: "frob (x * y) = frob x * frob (y :: 'a)"
   by (simp add: frob_def power_mult_distrib)
 
 lemma (in comm_semiring_1)
   frob_add: "prime CHAR('a) \<Longrightarrow> frob (x + y :: 'a) = frob x + frob (y :: 'a)"
   by (simp add: frob_def freshmans_dream)
 
 lemma (in comm_ring_1) frob_uminus: "prime CHAR('a) \<Longrightarrow> frob (-x :: 'a) = -frob x"
 proof -
   assume "prime CHAR('a)"
   hence "frob (-x) + frob x = 0"
     by (subst frob_add [symmetric]) (auto simp: frob_def power_0_left)
   thus ?thesis
     by (simp add: add_eq_0_iff)
 qed
 
 lemma (in comm_ring_prime_char) frob_diff:
   "prime CHAR('a) \<Longrightarrow> frob (x - y :: 'a) = frob x - frob (y :: 'a)"
   using frob_add[of x "-y"] by (simp add: frob_uminus)
 
 interpretation frob_sr: semiring_hom "frob :: 'a :: {comm_semiring_prime_char} \<Rightarrow> 'a"
   by standard (auto simp: frob_add frob_mult)
 
 interpretation frob: ring_hom "frob :: 'a :: {comm_ring_prime_char} \<Rightarrow> 'a"
   by standard auto
 
 interpretation frob: field_hom "frob :: 'a :: {field_prime_char} \<Rightarrow> 'a"
   by standard auto
 
 lemma frob_mod_ring' [simp]: "(x :: 'a :: prime_card mod_ring) ^ CARD('a) = x"
   by (metis CARD_mod_ring finite_field_power_card_eq_same)
 
 lemma frob_mod_ring [simp]: "frob (x :: 'a :: prime_card mod_ring) = x"
   by (simp add: frob_def)
 
 context semiring_1_no_zero_divisors
 begin
 
 lemma frob_eq_0D:
   "frob (x :: 'a) = 0 \<Longrightarrow> x = 0"
   by (auto simp: frob_def)
 
 lemma frob_eq_0_iff [simp]:
   "frob (x :: 'a) = 0 \<longleftrightarrow> x = 0 \<and> CHAR('a) > 0"
   by (auto simp: frob_def)
 
 end
 
 
 context idom_prime_char
 begin
 
 lemma inj_frob: "inj (frob :: 'a \<Rightarrow> 'a)"
 proof
   fix x y :: 'a
   assume "frob x = frob y"
   hence "frob (x - y) = 0"
     by (simp add: frob_diff del: frob_eq_0_iff)
   thus "x = y"
     by simp
 qed
 
 lemma frob_eq_frob_iff [simp]:
   "frob (x :: 'a) = frob y \<longleftrightarrow> x = y"
   using inj_frob by (auto simp: inj_def)
 
 lemma frob_eq_1_iff [simp]: "frob (x :: 'a) = 1 \<longleftrightarrow> x = 1"
   using frob_eq_frob_iff by fastforce
 
 lemma inv_frob_frob [simp]: "inv_frob (frob (x :: 'a)) = x"
   by (simp add: inj_frob inv_frob_def)
 
 lemma frob_inv_frob [simp]:
   assumes "x \<in> range frob"
   shows   "frob (inv_frob x) = (x :: 'a)"
   using assms by (auto simp: inj_frob inv_frob_def)
 
 lemma inv_frob_eqI: "frob y = x \<Longrightarrow> inv_frob x = y"
   using inv_frob_frob local.frob_def by force
 
 lemma inv_frob_eq_0_iff [simp]: "inv_frob (x :: 'a) = 0 \<longleftrightarrow> x = 0"
   using inj_frob by (auto simp: inv_frob_def split: if_splits)
 
 end
 
 
 
 
 class surj_frob = field_prime_char +
   assumes surj_frob [simp]: "surj (frob :: 'a \<Rightarrow> 'a)"
 begin
 
 lemma in_range_frob [simp, intro]: "(x :: 'a) \<in> range frob"
   using surj_frob by blast
 
 lemma inv_frob_eq_iff [simp]: "inv_frob (x :: 'a) = y \<longleftrightarrow> frob y = x"
   using frob_inv_frob inv_frob_frob by blast
 
 end
 
 
+context alg_closed_field
+begin
+
+lemma alg_closed_surj_frob:
+  assumes "CHAR('a) > 0"
+  shows   "surj (frob :: 'a \<Rightarrow> 'a)"
+proof -
+  show "surj (frob :: 'a \<Rightarrow> 'a)"
+  proof safe
+    fix x :: 'a
+    obtain y where "y ^ CHAR('a) = x"
+      using nth_root_exists CHAR_pos assms by blast
+    hence "frob y = x"
+      using CHAR_pos by (simp add: frob_def)
+    thus "x \<in> range frob"
+      by (metis rangeI)
+  qed auto
+qed
+
+end
+
+
 text \<open>
   The following type class describes a field with a surjective Frobenius endomorphism
   that is effectively computable. This includes all finite fields.
 \<close>
 class inv_frob = surj_frob +
   fixes inv_frob_code :: "'a \<Rightarrow> 'a"
   assumes inv_frob_code: "inv_frob x = inv_frob_code x"
 
 lemmas [code] = inv_frob_code
 
 
 context finite_field
 begin
 
 subclass surj_frob
 proof
   show "surj (frob :: 'a \<Rightarrow> 'a)"
     using inj_frob finite_UNIV by (simp add: finite_UNIV_inj_surj)
 qed
 
 end
 
 
 lemma inv_frob_mod_ring [simp]: "inv_frob (x :: 'a :: prime_card mod_ring) = x"
   by (auto simp: frob_def)
 
 instantiation mod_ring :: (prime_card) inv_frob
 begin
 
 definition inv_frob_code_mod_ring :: "'a mod_ring \<Rightarrow> 'a mod_ring" where
   "inv_frob_code_mod_ring x = x"
 
 instance 
   by standard (auto simp: inv_frob_code_mod_ring_def)
 
 end
 
 
 
 subsection \<open>Inverting the Frobenius endomorphism on polynomials\<close>
 
 text \<open>
   If \<open>K\<close> is a field of prime characteristic \<open>p\<close> with a surjective Frobenius endomorphism,
   every polynomial \<open>P\<close> with \<open>P' = 0\<close> has a \<open>p\<close>-th root.
 
   To see that, let $\phi(a) = a^p$ denote the Frobenius endomorphism of \<open>K\<close>
   and its extension to \<open>K[X]\<close>.
 
   If \<open>P' = 0\<close> for some \<open>P \<in> K[X]\<close>, then \<open>P\<close> must be of the form
   \[P = a_0 + a_p x^p + a_{2p} x^{2p} + \ldots + a_{kp} x^{kp}\ .\]
   If we now set
   \[Q := \phi^{-1}(a_0) + \phi^{-1}(a_p) x + \phi^{-1}(a_{2p}) x^2 + \ldots + \phi^{-1}(a_{kp}) x^k\]
   we get $\phi(Q) = P$, i.e.\ $Q$ is the $p$-th root of $P(x)$.
 \<close>
 
 lift_definition inv_frob_poly :: "'a :: field poly \<Rightarrow> 'a poly" is
   "\<lambda>p i. if CHAR('a) = 0 then p i else inv_frob (p (i * CHAR('a)) :: 'a)"
 proof goal_cases
   case (1 f)
   show ?case
   proof (cases "CHAR('a) > 0")
     case True
     from 1 obtain N where N: "f i = 0" if "i \<ge> N" for i
       using cofinite_eq_sequentially eventually_sequentially by auto
     have "inv_frob (f (i * CHAR('a))) = 0" if "i \<ge> N" for i
     proof -
       have "f (i * CHAR('a)) = 0"
       proof (rule N)
         show "N \<le> i * CHAR('a)"
           using that True 
           by (metis One_nat_def Suc_leI le_trans mult.right_neutral mult_le_mono2)
       qed
       thus "inv_frob (f (i * CHAR('a))) = 0"
         by (auto simp: power_0_left)
     qed
     thus ?thesis using True
       unfolding cofinite_eq_sequentially eventually_sequentially by auto
   qed (use 1 in auto)
 qed
 
 lemma coeff_inv_frob_poly [simp]:
   fixes p :: "'a :: field poly"
   assumes "CHAR('a) > 0"
   shows "poly.coeff (inv_frob_poly p) i = inv_frob (poly.coeff p (i * CHAR('a)))"
   using assms by transfer auto
 
 lemma inv_frob_poly_0 [simp]: "inv_frob_poly 0 = 0"
   by transfer (auto simp: fun_eq_iff power_0_left)
 
 lemma inv_frob_poly_1 [simp]: "inv_frob_poly 1 = 1"
   by transfer (auto simp: fun_eq_iff power_0_left)
 
 lemma degree_inv_frob_poly_le:
   fixes p :: "'a :: field poly"
   assumes "CHAR('a) > 0"
   shows "Polynomial.degree (inv_frob_poly p) \<le> Polynomial.degree p div CHAR('a)"
 proof (intro degree_le allI impI)
   fix i assume "Polynomial.degree p div CHAR('a) < i"
   hence "i * CHAR('a) > Polynomial.degree p"
     using assms div_less_iff_less_mult by blast
   thus "Polynomial.coeff (inv_frob_poly p) i = 0"
     by (simp add: coeff_eq_0 power_0_left assms)
 qed
 
 context
   assumes "SORT_CONSTRAINT('a :: comm_ring_1)"
   assumes prime_char: "prime CHAR('a)"
 begin
 
 lemma poly_power_prime_char_as_sum_of_monoms:
   fixes h :: "'a poly"
   shows "h ^ CHAR('a) = (\<Sum>i\<le>Polynomial.degree h. Polynomial.monom (Polynomial.coeff h i ^ CHAR('a)) (CHAR('a)*i))"
 proof -
   have "h ^ CHAR('a) = (\<Sum>i\<le>Polynomial.degree h. Polynomial.monom (Polynomial.coeff h i) i) ^ CHAR('a)"
     by (simp add: poly_as_sum_of_monoms)
   also have "... = (\<Sum>i\<le>Polynomial.degree h. (Polynomial.monom (Polynomial.coeff h i) i) ^ CHAR('a))"
     by (simp add: freshmans_dream_sum prime_char)
   also have "... = (\<Sum>i\<le>Polynomial.degree h. Polynomial.monom (Polynomial.coeff h i ^ CHAR('a)) (CHAR('a)*i))"
   proof (rule sum.cong, rule)
     fix x assume x: "x \<in> {..Polynomial.degree h}"
     show "Polynomial.monom (Polynomial.coeff h x) x ^ CHAR('a) = Polynomial.monom (Polynomial.coeff h x ^ CHAR('a)) (CHAR('a) * x)"
       by (unfold poly_eq_iff, auto simp add: monom_power)
   qed
   finally show ?thesis .
 qed
 
 lemma coeff_of_prime_char_power [simp]:
   fixes y :: "'a poly"
   shows "poly.coeff (y ^ CHAR('a)) (i * CHAR('a)) = poly.coeff y i ^ CHAR('a)"
   using prime_char
   by (subst poly_power_prime_char_as_sum_of_monoms, subst Polynomial.coeff_sum)
      (auto intro: le_degree simp: power_0_left)
 
 lemma coeff_of_prime_char_power':
   fixes y :: "'a poly"
   shows "poly.coeff (y ^ CHAR('a)) i =
            (if CHAR('a) dvd i then poly.coeff y (i div CHAR('a)) ^ CHAR('a) else 0)"
 proof -
   have "poly.coeff (y ^ CHAR('a)) i =
           (\<Sum>j\<le>Polynomial.degree y. Polynomial.coeff (Polynomial.monom (Polynomial.coeff y j ^ CHAR('a)) (CHAR('a) * j)) i)"
     by (subst poly_power_prime_char_as_sum_of_monoms, subst Polynomial.coeff_sum) auto
   also have "\<dots> = (\<Sum>j\<in>(if CHAR('a) dvd i \<and> i div CHAR('a) \<le> Polynomial.degree y then {i div CHAR('a)} else {}).
                     Polynomial.coeff (Polynomial.monom (Polynomial.coeff y j ^ CHAR('a)) (CHAR('a) * j)) i)"
     by (intro sum.mono_neutral_right) (use prime_char in auto)
   also have "\<dots> = (if CHAR('a) dvd i then poly.coeff y (i div CHAR('a)) ^ CHAR('a) else 0)"
   proof (cases "CHAR('a) dvd i \<and> i div CHAR('a) > Polynomial.degree y")
     case True
     hence "Polynomial.coeff y (i div CHAR('a)) ^ CHAR('a) = 0"
       using prime_char by (simp add: coeff_eq_0 zero_power power_0_left)
     thus ?thesis
       by auto
   qed auto
   finally show ?thesis .
 qed
 
 end
 
 
 context
   assumes "SORT_CONSTRAINT('a :: field)"
   assumes pos_char: "CHAR('a) > 0"
 begin
 
 interpretation field_prime_char "(/)" inverse "(*)" "1 :: 'a" "(+)" 0 "(-)" uminus
   rewrites "semiring_1.frob 1 (*) (+) (0 :: 'a) = frob" and
            "semiring_1.inv_frob 1 (*) (+) (0 :: 'a) = inv_frob" and
            "semiring_1.semiring_char 1 (+) 0 TYPE('a) = CHAR('a)"
 proof unfold_locales
   have *: "class.semiring_1 (1 :: 'a) (*) (+) 0" ..
   have [simp]: "semiring_1.of_nat (1 :: 'a) (+) 0 = of_nat"
     by (auto simp: of_nat_def semiring_1.of_nat_def[OF *])
   thus "\<exists>n>0. semiring_1.of_nat (1 :: 'a) (+) 0 n = 0"
     by (intro exI[of _ "CHAR('a)"]) (use pos_char in auto)
   show "semiring_1.semiring_char 1 (+) 0 TYPE('a) = CHAR('a)"
     by (simp add: fun_eq_iff semiring_char_def semiring_1.semiring_char_def[OF *])
   show [simp]: "semiring_1.frob (1 :: 'a) (*) (+) 0 = frob"
     by (simp add: frob_def semiring_1.frob_def[OF *] fun_eq_iff
                   power.power_def power_def semiring_char_def semiring_1.semiring_char_def[OF *])
   show "semiring_1.inv_frob (1 :: 'a) (*) (+) 0 = inv_frob"
     by (simp add: inv_frob_def semiring_1.inv_frob_def[OF *] fun_eq_iff)
 qed
 
 lemma inv_frob_poly_power': "inv_frob_poly (p ^ CHAR('a) :: 'a poly) = p"
   using prime_CHAR_semidom[OF pos_char] pos_char
   by (auto simp: poly_eq_iff simp flip: frob_def)
 
 lemma inv_frob_poly_power:
   fixes p :: "'a poly"
   assumes "is_nth_power CHAR('a) p" and "n = CHAR('a)"
   shows   "inv_frob_poly p ^ CHAR('a) = p"
 proof -
   from assms(1) obtain q where q: "p = q ^ CHAR('a)"
     by (elim is_nth_powerE)
   thus ?thesis using assms
     by (simp add: q inv_frob_poly_power')
 qed
 
 theorem pderiv_eq_0_imp_nth_power:
   assumes "pderiv (p :: 'a poly) = 0"
   assumes [simp]: "surj (frob :: 'a \<Rightarrow> 'a)"
   shows   "is_nth_power CHAR('a) p"
 proof -
   have *: "poly.coeff p n = 0" if n: "\<not>CHAR('a) dvd n" for n
   proof (cases "n = 0")
     case False
     have "poly.coeff (pderiv p) (n - 1) = of_nat n * poly.coeff p n"
       using False by (auto simp: coeff_pderiv)
     with assms and n show "poly.coeff p n = 0"
       by (auto simp: of_nat_eq_0_iff_char_dvd)
   qed (use that in auto)
 
   have **: "inv_frob_poly p ^ CHAR('a) = p"
   proof (rule poly_eqI)
     fix n :: nat
     show "poly.coeff (inv_frob_poly p ^ CHAR('a)) n = poly.coeff p n"
       using * CHAR_dvd_CARD[where ?'a = 'a] 
       by (subst coeff_of_prime_char_power')
          (auto simp: poly_eq_iff frob_def [symmetric]
                      coeff_of_prime_char_power'[where ?'a = 'a] simp flip: power_mult)
   qed
   
   show ?thesis
     by (subst **[symmetric]) auto
 qed
 
 end
 
 
 subsection \<open>Code generation\<close>
 
 text \<open>
   We now also make this notion of ``taking the \<open>p\<close>-th root of a polynomial''
   executable. For this, we need an auxiliary function that takes a list
   $[x_0, \ldots, x_m]$ and returns the list of every \<open>n\<close>-th element, i.e.\ it
   throws away all elements except those $x_i$ where $i$ is a multiple of $n$.
 \<close>
 
 (* TODO: Move this function to a library? *)
 fun take_every :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where
   "take_every _ [] = []"
 | "take_every n (x # xs) = x # take_every n (drop (n - 1) xs)"
 
 lemma take_every_0 [simp]: "take_every 0 xs = xs"
   by (induction xs) auto
 
 lemma take_every_1 [simp]: "take_every (Suc 0) xs = xs"
   by (induction xs) auto
 
 lemma int_length_take_every: "n > 0 \<Longrightarrow> int (length (take_every n xs)) = ceiling (length xs / n)"
 proof (induction n xs rule: take_every.induct)
   case (2 n x xs)
   show ?case
   proof (cases "Suc (length xs) \<ge> n")
     case True
     thus ?thesis using 2
       by (auto simp: dvd_imp_le of_nat_diff diff_divide_distrib split: if_splits)
   next
     case False
     hence "\<lceil>(1 + real (length xs)) / real n\<rceil> = 1"
       by (intro ceiling_unique) auto
     thus ?thesis using False
       by auto
   qed
 qed auto
 
 lemma length_take_every:
   "n > 0 \<Longrightarrow> length (take_every n xs) = nat (ceiling (length xs / n))"
   using int_length_take_every[of n xs] by simp
 
 lemma take_every_nth [simp]:
   "n > 0 \<Longrightarrow> i < length (take_every n xs) \<Longrightarrow> take_every n xs ! i = xs ! (n * i)"
 proof (induction n xs arbitrary: i rule: take_every.induct)
   case (2 n x xs i)
   show ?case
   proof (cases i)
     case (Suc j)
     have "n - Suc 0 \<le> length xs"
       using Suc "2.prems" nat_le_linear by force
     hence "drop (n - Suc 0) xs ! (n * j) = xs ! (n - 1 + n * j)"
       using Suc by (subst nth_drop) auto
     also have "n - 1 + n * j = n + n * j - 1"
       using \<open>n > 0\<close> by linarith
     finally show ?thesis
       using "2.IH"[of j] "2.prems" Suc by simp
   qed auto
 qed auto
 
 lemma coeffs_eq_strip_whileI:
   assumes "\<And>i. i < length xs \<Longrightarrow> Polynomial.coeff p i = xs ! i"
   assumes "p \<noteq> 0 \<Longrightarrow> length xs > Polynomial.degree p"
   shows   "Polynomial.coeffs p = strip_while ((=) 0) xs"
 proof (rule coeffs_eqI)
   fix n :: nat
   show "Polynomial.coeff p n = nth_default 0 (strip_while ((=) 0) xs) n"
     using assms
     by (metis coeff_0 coeff_Poly_eq coeffs_Poly le_degree nth_default_coeffs_eq 
       nth_default_eq_dflt_iff nth_default_nth order_le_less_trans)
 qed auto
 
 text \<open>This implements the code equation for \<open>inv_frob_poly\<close>.\<close>
 lemma inv_frob_poly_code [code]:
   "Polynomial.coeffs (inv_frob_poly (p :: 'a :: field_prime_char poly)) =
      (if CHAR('a) = 0 then Polynomial.coeffs p else 
         map inv_frob (strip_while ((=) 0) (take_every CHAR('a) (Polynomial.coeffs p))))"
     (is "_ = If _ _ ?rhs")
 proof (cases "CHAR('a) = 0 \<or> p = 0")
   case False
   from False have "p \<noteq> 0"
     by auto
   have "Polynomial.coeffs (inv_frob_poly p) =
           strip_while ((=) 0) (map inv_frob (take_every CHAR('a) (Polynomial.coeffs p)))"
   proof (rule coeffs_eq_strip_whileI)
     fix i assume i: "i < length (map inv_frob (take_every CHAR('a) (Polynomial.coeffs p)))"
     show "Polynomial.coeff (inv_frob_poly p) i = map inv_frob (take_every CHAR('a) (Polynomial.coeffs p)) ! i"
     proof -
       have "i < length (take_every CHAR('a) (Polynomial.coeffs p))"
         using i by simp
       also have "length (take_every CHAR('a) (Polynomial.coeffs p)) =
                    nat \<lceil>(Polynomial.degree p + 1) / real CHAR('a)\<rceil>"
         using False CHAR_pos[where ?'a = 'a]
         by (simp add: length_take_every length_coeffs)
       finally have "i < real (Polynomial.degree p + 1) / real CHAR('a)"
         by linarith
       hence "real i * real CHAR('a) < real (Polynomial.degree p + 1)"
         using False CHAR_pos[where ?'a = 'a] by (simp add: field_simps)
       hence "i * CHAR('a) \<le> Polynomial.degree p"
         unfolding of_nat_mult [symmetric] by linarith
       hence "Polynomial.coeffs p ! (i * CHAR('a)) = Polynomial.coeff p (i * CHAR('a))"
         using False by (intro coeffs_nth) (auto simp: length_take_every)
       thus ?thesis using False i CHAR_pos[where ?'a = 'a]
         by (auto simp: nth_default_def mult.commute)
     qed
   next
     assume nz: "inv_frob_poly p \<noteq> 0"
     have "Polynomial.degree (inv_frob_poly p) \<le> Polynomial.degree p div CHAR('a)"
       by (rule degree_inv_frob_poly_le) (fact CHAR_pos)
     also have "\<dots> < nat \<lceil>(real (Polynomial.degree p) + 1) / real CHAR('a)\<rceil>"
       using CHAR_pos[where ?'a = 'a]
       by (metis div_less_iff_less_mult linorder_not_le nat_le_real_less of_nat_0_less_iff
                 of_nat_ceiling of_nat_mult pos_less_divide_eq)
     also have "\<dots> = length (take_every CHAR('a) (Polynomial.coeffs p))"
       using CHAR_pos[where ?'a = 'a] \<open>p \<noteq> 0\<close> by (simp add: length_take_every length_coeffs add_ac)
     finally show "length (map inv_frob (take_every CHAR('a) (Polynomial.coeffs p))) > Polynomial.degree (inv_frob_poly p)"
       by simp_all
   qed
   also have "strip_while ((=) 0) (map inv_frob (take_every CHAR('a) (Polynomial.coeffs p))) =
              map inv_frob (strip_while ((=) 0 \<circ> inv_frob) (take_every CHAR('a) (Polynomial.coeffs p)))"
     by (rule strip_while_map)
   also have "(=) 0 \<circ> inv_frob = (=) (0 :: 'a)"
     by (auto simp: fun_eq_iff)
   finally show ?thesis
     using False by metis
 qed auto
 
 
 
 
 subsection \<open>Perfect fields\<close>
 
 text \<open>
   We now introduce perfect fields. The textbook definition of a perfect field
   is that every irreducible polynomial is separable, i.e.\ if a polynomial $P$
   has no non-trivial divisors then $\text{gcd}(P, P') = 0$.
 
   For technical reasons, this is somewhat difficult to express in Isabelle/HOL's typeclass system.
   We therefore use the following much simpler equivalent definition (and prove equivalence later):
   a field is perfect if it either has characteristic 0 or its Frobenius endomorphism
   is surjective.
 \<close>
 
 class perfect_field = field +
   assumes perfect_field: "CHAR('a) = 0 \<or> surj (frob :: 'a \<Rightarrow> 'a)"
 
 context field_char_0
 begin
 subclass perfect_field
   by standard auto
 end
 
 context surj_frob
 begin
 subclass perfect_field
   by standard auto
 end
 
+context alg_closed_field
+begin
+subclass perfect_field
+  by standard (use alg_closed_surj_frob in auto)
+end
+
 theorem irreducible_imp_pderiv_nonzero:
   assumes "irreducible (p :: 'a :: perfect_field poly)"
   shows   "pderiv p \<noteq> 0"
 proof (cases "CHAR('a) = 0")
   case True
   interpret A: semiring_1 "1 :: 'a" "(*)" "(+)" "0 :: 'a" ..
   have *: "class.semiring_1 (1 :: 'a) (*) (+) 0" ..
   interpret A: field_char_0 "(/)" inverse "(*)" "1 :: 'a" "(+)" 0 "(-)" uminus
   proof
     have "inj (of_nat :: nat \<Rightarrow> 'a)"
       by (auto simp: inj_on_def of_nat_eq_iff_cong_CHAR True)
     also have "of_nat = semiring_1.of_nat (1 :: 'a) (+) 0"
       by (simp add: of_nat_def [abs_def] semiring_1.of_nat_def [OF *, abs_def])
     finally show "inj \<dots>" .
   qed
 
   show ?thesis
   proof
     assume "pderiv p = 0"
     hence **: "poly.coeff p (Suc n) = 0" for n
       by (auto simp: poly_eq_iff coeff_pderiv of_nat_eq_0_iff_char_dvd True simp del: of_nat_Suc)
     have "poly.coeff p n = 0" if "n > 0" for n
       using **[of "n - 1"] that by (cases n) auto
     hence "Polynomial.degree p = 0"
       by force
     thus False
       using assms by force
   qed
 
 next
   case False
   hence [simp]: "surj (frob :: 'a \<Rightarrow> 'a)"
     by (meson perfect_field)
 
   interpret A: field_prime_char "(/)" inverse "(*)" "1 :: 'a" "(+)" 0 "(-)" uminus
   proof
     have *: "class.semiring_1 1 (*) (+) (0 :: 'a)" ..
     have "semiring_1.of_nat 1 (+) (0 :: 'a) = of_nat"
       by (simp add: fun_eq_iff of_nat_def semiring_1.of_nat_def[OF *])
     thus "\<exists>n>0. semiring_1.of_nat 1 (+) 0 n = (0 :: 'a)"
       by (intro exI[of _ "CHAR('a)"]) (use False in auto)
   qed
 
   show ?thesis
   proof
     assume "pderiv p = 0"
     hence "is_nth_power CHAR('a) p"
       using pderiv_eq_0_imp_nth_power[of p] surj_frob False by simp
     then obtain q where "p = q ^ CHAR('a)"
       by (elim is_nth_powerE)
     with assms show False
       by auto
   qed
 qed
 
 corollary irreducible_imp_separable:
   assumes "irreducible (p :: 'a :: perfect_field poly)"
   shows   "coprime p (pderiv p)"
 proof (rule coprimeI)
   fix q assume q: "q dvd p" "q dvd pderiv p"
   have "\<not>p dvd q"
   proof
     assume "p dvd q"
     hence "p dvd pderiv p"
       using q dvd_trans by blast
     hence "Polynomial.degree p \<le> Polynomial.degree (pderiv p)"
       by (rule dvd_imp_degree_le) (use assms irreducible_imp_pderiv_nonzero in auto)
     also have "\<dots> \<le> Polynomial.degree p - 1"
       using degree_pderiv_le by auto
     finally have "Polynomial.degree p = 0"
       by simp
     with assms show False
       using irreducible_imp_pderiv_nonzero is_unit_iff_degree by blast
   qed
   with \<open>q dvd p\<close> show "is_unit q"
     using assms comm_semiring_1_class.irreducibleD' by blast
 qed
  
 end
\ No newline at end of file
diff --git a/thys/Perfect_Fields/ROOT b/thys/Perfect_Fields/ROOT
--- a/thys/Perfect_Fields/ROOT
+++ b/thys/Perfect_Fields/ROOT
@@ -1,13 +1,10 @@
 chapter AFP
 
 session "Perfect_Fields" (AFP) = "Berlekamp_Zassenhaus" +
   options [timeout = 300]
-  sessions
-    Formal_Puiseux_Series
   theories
     Perfect_Fields
-    Perfect_Field_Algebraically_Closed
     Perfect_Field_Altdef
   document_files
     "root.bib"
     "root.tex"
diff --git a/thys/Polynomial_Crit_Geometry/Polynomial_Crit_Geometry_Library.thy b/thys/Polynomial_Crit_Geometry/Polynomial_Crit_Geometry_Library.thy
--- a/thys/Polynomial_Crit_Geometry/Polynomial_Crit_Geometry_Library.thy
+++ b/thys/Polynomial_Crit_Geometry/Polynomial_Crit_Geometry_Library.thy
@@ -1,296 +1,296 @@
 (*
   File:      Polynomial_Crit_Geometry/Polynomial_Crit_Geometry_Library.thy
   Authors:   Manuel Eberl, University of Innsbruck
 *)
 section \<open>Missing Library Material\<close>
 theory Polynomial_Crit_Geometry_Library
 imports
   "HOL-Computational_Algebra.Computational_Algebra"
   "HOL-Library.FuncSet"
-  "Formal_Puiseux_Series.Formal_Puiseux_Series" (* for alg_closed_field *)
+  "Polynomial_Interpolation.Ring_Hom_Poly"
 begin
 
 (* TODO: all of this probably belongs in the library *)
 
 subsection \<open>Multisets\<close>
 
 lemma size_repeat_mset [simp]: "size (repeat_mset n A) = n * size A"
   by (induction n) auto
 
 lemma count_image_mset_inj:
   "inj f \<Longrightarrow> count (image_mset f A) (f x) = count A x"
   by (induction A) (auto dest!: injD)
 
 lemma count_le_size: "count A x \<le> size A"
   by (induction A) auto
 
 lemma image_mset_cong_simp:
   "M = M' \<Longrightarrow> (\<And>x. x \<in># M =simp=> f x = g x) \<Longrightarrow> {#f x. x \<in># M#} = {#g x. x \<in># M'#}"
   unfolding simp_implies_def by (auto intro: image_mset_cong)
 
 lemma sum_mset_nonneg:
   fixes A :: "'a :: ordered_comm_monoid_add multiset"
   assumes "\<And>x. x \<in># A \<Longrightarrow> x \<ge> 0"
   shows   "sum_mset A \<ge> 0"
   using assms by (induction A) auto
 
 lemma sum_mset_pos:
   fixes A :: "'a :: ordered_comm_monoid_add multiset"
   assumes "A \<noteq> {#}"
   assumes "\<And>x. x \<in># A \<Longrightarrow> x > 0"
   shows   "sum_mset A > 0"
 proof -
   from assms obtain x where "x \<in># A"
     by auto
   hence "A = {#x#} + (A - {#x#})"
     by auto
   also have "sum_mset \<dots> = x + sum_mset (A - {#x#})"
     by simp
   also have "\<dots> > 0"
   proof (rule add_pos_nonneg)
     show "x > 0"
       using \<open>x \<in># A\<close> assms by auto
     show "sum_mset (A - {#x#}) \<ge> 0"
       using assms sum_mset_nonneg by (metis in_diffD order_less_imp_le)
   qed
   finally show ?thesis .
 qed
 
 
 subsection \<open>Polynomials\<close>
 
 lemma order_pos_iff: "p \<noteq> 0 \<Longrightarrow> order x p > 0 \<longleftrightarrow> poly p x = 0"
   by (cases "order x p = 0") (auto simp: order_root order_0I)
 
 lemma order_prod_mset:
   "0 \<notin># P \<Longrightarrow> order x (prod_mset P) = sum_mset (image_mset (\<lambda>p. order x p) P)"
   by (induction P) (auto simp: order_mult)
 
 lemma order_prod:
   "(\<And>x. x \<in> I \<Longrightarrow> f x \<noteq> 0) \<Longrightarrow> order x (prod f I) = (\<Sum>i\<in>I. order x (f i))"
   by (induction I rule: infinite_finite_induct) (auto simp: order_mult)
 
 lemma order_linear_factor:
   assumes "a \<noteq> 0 \<or> b \<noteq> 0"
   shows "order x [:a, b:] = (if b * x + a = 0 then 1 else 0)"
 proof (cases "b * x + a = 0")
   case True
   have "order x [:a, b:] \<le> degree [:a, b:]"
     using assms by (intro order_degree) auto
   also have "\<dots> \<le> 1"
     by simp
   finally have "order x [:a, b:] \<le> 1" .
   moreover have "order x [:a, b:] > 0"
     using assms True by (subst order_pos_iff) (auto simp: algebra_simps)
   ultimately have "order x [:a, b:] = 1"
     by linarith
   with True show ?thesis
     by simp
 qed (auto intro!: order_0I simp: algebra_simps)
 
 lemma order_linear_factor' [simp]:
   assumes "a \<noteq> 0 \<or> b \<noteq> 0" "b * x + a = 0"
   shows "order x [:a, b:] = 1"
   using assms by (subst order_linear_factor) auto
 
 lemma degree_prod_mset_eq: "0 \<notin># P \<Longrightarrow> degree (prod_mset P) = (\<Sum>p\<in>#P. degree p)"
   for P :: "'a::idom poly multiset"
   by (induction P) (auto simp: degree_mult_eq)
 
 lemma degree_prod_list_eq: "0 \<notin> set ps \<Longrightarrow> degree (prod_list ps) = (\<Sum>p\<leftarrow>ps. degree p)"
   for ps :: "'a::idom poly list"
-  by (induction ps) (auto simp: degree_mult_eq)
+  by (induction ps) (auto simp: degree_mult_eq prod_list_zero_iff)
 
 lemma order_conv_multiplicity:
   assumes "p \<noteq> 0"
   shows   "order x p = multiplicity [:-x, 1:] p"
   using assms order[of p x] multiplicity_eqI by metis
 
 
 subsection \<open>Polynomials over algebraically closed fields\<close>
 
 lemma irreducible_alg_closed_imp_degree_1:
   assumes "irreducible (p :: 'a :: alg_closed_field poly)"
   shows   "degree p = 1"
 proof -
   have "\<not>(degree p > 1)"
     using assms alg_closed_imp_reducible by blast
   moreover from assms have "degree p \<noteq> 0"
-    by (intro notI) auto
+    by (auto simp: irreducible_def is_unit_iff_degree)
   ultimately show ?thesis
     by linarith
 qed
 
 lemma prime_poly_alg_closedE:
   assumes "prime (q :: 'a :: {alg_closed_field, field_gcd} poly)"
   obtains c where "q = [:-c, 1:]" "poly q c = 0"
 proof -
   from assms have "degree q = 1"
     by (intro irreducible_alg_closed_imp_degree_1 prime_elem_imp_irreducible) auto
   then obtain a b where q: "q = [:a, b:]"
     by (metis One_nat_def degree_pCons_eq_if nat.distinct(1) nat.inject pCons_cases)
   have "unit_factor q = 1"
     using assms by auto
   thus ?thesis
     using that[of "-a"] q \<open>degree q = 1\<close>
-    by (auto simp: unit_factor_poly_def one_pCons split: if_splits)
+    by (auto simp: unit_factor_poly_def one_pCons dvd_field_iff is_unit_unit_factor split: if_splits)
 qed
 
 lemma prime_factors_alg_closed_poly_bij_betw:
   assumes "p \<noteq> (0 :: 'a :: {alg_closed_field, field_gcd} poly)"
   shows "bij_betw (\<lambda>x. [:-x, 1:]) {x. poly p x = 0} (prime_factors p)"
 proof (rule bij_betwI[of _ _ _ "\<lambda>q. -poly q 0"], goal_cases)
   case 1
   have [simp]: "p div [:1:] = p" for p :: "'a poly"
     by (simp add: pCons_one)
   show ?case using assms
     by (auto simp: in_prime_factors_iff dvd_iff_poly_eq_0 prime_def 
           prime_elem_linear_field_poly normalize_poly_def one_pCons)
 qed (auto simp: in_prime_factors_iff elim!: prime_poly_alg_closedE dvdE)
 
 lemma alg_closed_imp_factorization':
   assumes "p \<noteq> (0 :: 'a :: alg_closed_field poly)"
   shows "p = smult (lead_coeff p) (\<Prod>x | poly p x = 0. [:-x, 1:] ^ order x p)"
 proof -
   obtain A where A: "size A = degree p" "p = smult (lead_coeff p) (\<Prod>x\<in>#A. [:- x, 1:])"
     using alg_closed_imp_factorization[OF assms] by blast
   have "set_mset A = {x. poly p x = 0}" using assms 
     by (subst A(2)) (auto simp flip: poly_hom.prod_mset_image simp: image_image)
 
   note A(2)
   also have "(\<Prod>x\<in>#A. [:- x, 1:]) =
                (\<Prod>x\<in>(\<lambda>x. [:- x, 1:]) ` set_mset A. x ^ count {#[:- x, 1:]. x \<in># A#} x)"
     by (subst prod_mset_multiplicity) simp_all
   also have "set_mset A = {x. poly p x = 0}" using assms 
     by (subst A(2)) (auto simp flip: poly_hom.prod_mset_image simp: image_image)
   also have "(\<Prod>x\<in>(\<lambda>x. [:- x, 1:]) ` {x. poly p x = 0}. x ^ count {#[:- x, 1:]. x \<in># A#} x) =
              (\<Prod>x | poly p x = 0. [:- x, 1:] ^ count {#[:- x, 1:]. x \<in># A#} [:- x, 1:])"
     by (subst prod.reindex) (auto intro: inj_onI)
   also have "(\<lambda>x. count {#[:- x, 1:]. x \<in># A#} [:- x, 1:]) = count A"
     by (subst count_image_mset_inj) (auto intro!: inj_onI)
   also have "count A = (\<lambda>x. order x p)"
   proof
     fix x :: 'a
     have "order x p = order x (\<Prod>x\<in>#A. [:- x, 1:])"
       using assms by (subst A(2)) (auto simp: order_smult order_prod_mset)
     also have "\<dots> = (\<Sum>y\<in>#A. order x [:-y, 1:])"
       by (subst order_prod_mset) (auto simp: multiset.map_comp o_def)
     also have "image_mset (\<lambda>y. order x [:-y, 1:]) A = image_mset (\<lambda>y. if y = x then 1 else 0) A"
       using order_power_n_n[of y 1 for y :: 'a]
       by (intro image_mset_cong) (auto simp: order_0I)
     also have "\<dots> = replicate_mset (count A x) 1 + replicate_mset (size A - count A x) 0"
       by (induction A) (auto simp: add_ac Suc_diff_le count_le_size)
     also have "sum_mset \<dots> = count A x"
       by simp
     finally show "count A x = order x p" ..
   qed
   finally show ?thesis .
 qed
 
 
 subsection \<open>Complex polynomials and conjugation\<close>
 
 lemma complex_poly_real_coeffsE:
   assumes "set (coeffs p) \<subseteq> \<real>"
   obtains p' where "p = map_poly complex_of_real p'"
 proof (rule that)
   have "coeff p n \<in> \<real>" for n
     using assms by (metis Reals_0 coeff_in_coeffs in_mono le_degree zero_poly.rep_eq)
   thus "p = map_poly complex_of_real (map_poly Re p)"
     by (subst map_poly_map_poly) (auto simp: poly_eq_iff o_def coeff_map_poly)
 qed
 
 lemma order_map_poly_cnj:
   assumes "p \<noteq> 0"
   shows   "order x (map_poly cnj p) = order (cnj x) p"
 proof -
   have "order x (map_poly cnj p) \<le> order (cnj x) p" if p: "p \<noteq> 0" for p :: "complex poly" and x
   proof (rule order_max)
     interpret map_poly_idom_hom cnj
       by standard auto
     interpret field_hom cnj
       by standard auto
     have "[:-x, 1:] ^ order x (map_poly cnj p) dvd map_poly cnj p"
       using order[of "map_poly cnj p" x] p by simp
     also have "[:-x, 1:] ^ order x (map_poly cnj p) =
                map_poly cnj ([:-cnj x, 1:] ^ order x (map_poly cnj p))"
       by (simp add: hom_power)
     finally show "[:-cnj x, 1:] ^ order x (map_poly cnj p) dvd p"
       by (rule dvd_map_poly_hom_imp_dvd)
   qed fact+
   from this[of p x] and this[of "map_poly cnj p" "cnj x"] and assms show ?thesis
     by (simp add: map_poly_map_poly o_def)
 qed
 
 
 subsection \<open>\<open>n\<close>-ary product rule for the derivative\<close>
 
 lemma has_field_derivative_prod_mset [derivative_intros]:
   assumes "\<And>x. x \<in># A \<Longrightarrow> (f x has_field_derivative f' x) (at z)"
   shows   "((\<lambda>u. \<Prod>x\<in>#A. f x u) has_field_derivative (\<Sum>x\<in>#A. f' x * (\<Prod>y\<in>#A-{#x#}. f y z))) (at z)"
   using assms
 proof (induction A)
   case (add x A)
   note [derivative_intros] = add
   note [cong] = image_mset_cong_simp
   show ?case
     by (auto simp: field_simps multiset.map_comp o_def  intro!: derivative_eq_intros)
 qed auto
 
 lemma has_field_derivative_prod [derivative_intros]:
   assumes "\<And>x. x \<in> A \<Longrightarrow> (f x has_field_derivative f' x) (at z)"
   shows   "((\<lambda>u. \<Prod>x\<in>A. f x u) has_field_derivative (\<Sum>x\<in>A. f' x * (\<Prod>y\<in>A-{x}. f y z))) (at z)"
   using assms
 proof (cases "finite A")
   case [simp, intro]: True
   have "((\<lambda>u. \<Prod>x\<in>A. f x u) has_field_derivative
           (\<Sum>x\<in>A. f' x * (\<Prod>y\<in>#mset_set A-{#x#}. f y z))) (at z)"
     using has_field_derivative_prod_mset[of "mset_set A" f f' z] assms
     by (simp add: prod_unfold_prod_mset sum_unfold_sum_mset)
   also have "(\<Sum>x\<in>A. f' x * (\<Prod>y\<in>#mset_set A-{#x#}. f y z)) =
              (\<Sum>x\<in>A. f' x * (\<Prod>y\<in>#mset_set (A-{x}). f y z))"
     by (intro sum.cong) (auto simp: mset_set_Diff)
   finally show ?thesis
     by (simp add: prod_unfold_prod_mset)
 qed auto
 
 lemma has_field_derivative_prod_mset':
   assumes "\<And>x. x \<in># A \<Longrightarrow> f x z \<noteq> 0"
   assumes "\<And>x. x \<in># A \<Longrightarrow> (f x has_field_derivative f' x) (at z)"
   defines "P \<equiv> (\<lambda>A u. \<Prod>x\<in>#A. f x u)"
   shows   "(P A has_field_derivative (P A z * (\<Sum>x\<in>#A. f' x / f x z))) (at z)"
   using assms
   by (auto intro!: derivative_eq_intros cong: image_mset_cong_simp
            simp:   sum_distrib_right mult_ac prod_mset_diff image_mset_Diff multiset.map_comp o_def)
 
 lemma has_field_derivative_prod':
   assumes "\<And>x. x \<in> A \<Longrightarrow> f x z \<noteq> 0"
   assumes "\<And>x. x \<in> A \<Longrightarrow> (f x has_field_derivative f' x) (at z)"
   defines "P \<equiv> (\<lambda>A u. \<Prod>x\<in>A. f x u)"
   shows   "(P A has_field_derivative (P A z * (\<Sum>x\<in>A. f' x / f x z))) (at z)"
 proof (cases "finite A")
   case True
   show ?thesis using assms True
     by (auto intro!: derivative_eq_intros
              simp: prod_diff1 sum_distrib_left sum_distrib_right mult_ac)
 qed (auto simp: P_def)
 
 
 subsection \<open>Facts about complex numbers\<close>
 
 lemma Re_sum_mset: "Re (sum_mset X) = (\<Sum>x\<in>#X. Re x)"
   by (induction X) auto
 
 lemma Im_sum_mset: "Im (sum_mset X) = (\<Sum>x\<in>#X. Im x)"
   by (induction X) auto
 
 lemma Re_sum_mset': "Re (\<Sum>x\<in>#X. f x) = (\<Sum>x\<in>#X. Re (f x))"
   by (induction X) auto
 
 lemma Im_sum_mset': "Im (\<Sum>x\<in>#X. f x) = (\<Sum>x\<in>#X. Im (f x))"
   by (induction X) auto
 
 lemma inverse_complex_altdef: "inverse z = cnj z / norm z ^ 2"
   by (metis complex_div_cnj inverse_eq_divide mult_1)
 
 end
diff --git a/thys/Polynomial_Crit_Geometry/ROOT b/thys/Polynomial_Crit_Geometry/ROOT
--- a/thys/Polynomial_Crit_Geometry/ROOT
+++ b/thys/Polynomial_Crit_Geometry/ROOT
@@ -1,12 +1,12 @@
 chapter AFP
 
 session Polynomial_Crit_Geometry (AFP) = "HOL-Analysis" +
   options [timeout = 1200]
   sessions
     "HOL-Computational_Algebra"
-    "Formal_Puiseux_Series" (* TODO: remove once alg_closed_field is in library *)
+    "Polynomial_Interpolation"
   theories
     Polynomial_Crit_Geometry
   document_files
     "root.tex"
     "root.bib"