/-
Copyright (c) 2020 Kenji Nakagawa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenji Nakagawa, Anne Baanen, Filippo A. E. Nuccio
-/
import ring_theory.discrete_valuation_ring
import ring_theory.fractional_ideal
import ring_theory.ideal.over
import ring_theory.integrally_closed
import ring_theory.polynomial.rational_root
import ring_theory.trace
import algebra.associated
import algebraic_geometry.prime_spectrum.noetherian

/-!
# Dedekind domains

This file defines the notion of a Dedekind domain (or Dedekind ring),
giving three equivalent definitions (TODO: and shows that they are equivalent).

## Main definitions

 - `is_dedekind_domain` defines a Dedekind domain as a commutative ring that is
   Noetherian, integrally closed in its field of fractions and has Krull dimension at most one.
   `is_dedekind_domain_iff` shows that this does not depend on the choice of field of fractions.
 - `is_dedekind_domain_dvr` alternatively defines a Dedekind domain as an integral domain that
   is Noetherian, and the localization at every nonzero prime ideal is a DVR.
 - `is_dedekind_domain_inv` alternatively defines a Dedekind domain as an integral domain where
   every nonzero fractional ideal is invertible.
 - `is_dedekind_domain_inv_iff` shows that this does note depend on the choice of field of
   fractions.

## Implementation notes

The definitions that involve a field of fractions choose a canonical field of fractions,
but are independent of that choice. The `..._iff` lemmas express this independence.

Often, definitions assume that Dedekind domains are not fields. We found it more practical
to add a `(h : ¬ is_field A)` assumption whenever this is explicitly needed.

## References

* [D. Marcus, *Number Fields*][marcus1977number]
* [J.W.S. Cassels, A. Frölich, *Algebraic Number Theory*][cassels1967algebraic]
* [J. Neukirch, *Algebraic Number Theory*][Neukirch1992]

## Tags

dedekind domain, dedekind ring
-/

variables (R A K : Type*) [comm_ring R] [comm_ring A] [field K]

open_locale non_zero_divisors

/-- A ring `R` has Krull dimension at most one if all nonzero prime ideals are maximal. -/
def ring.dimension_le_one : Prop :=
∀ p ≠ (⊥ : ideal R), p.is_prime → p.is_maximal

open ideal ring

namespace ring

lemma dimension_le_one.principal_ideal_ring
  [is_domain A] [is_principal_ideal_ring A] : dimension_le_one A :=
λ p nonzero prime, by { haveI := prime, exact is_prime.to_maximal_ideal nonzero }

lemma dimension_le_one.is_integral_closure (B : Type*) [comm_ring B] [is_domain B]
  [nontrivial R] [algebra R A] [algebra R B] [algebra B A] [is_scalar_tower R B A]
  [is_integral_closure B R A] (h : dimension_le_one R) :
  dimension_le_one B :=
λ p ne_bot prime, by exactI
  is_integral_closure.is_maximal_of_is_maximal_comap A p
    (h _ (is_integral_closure.comap_ne_bot A ne_bot) infer_instance)

lemma dimension_le_one.integral_closure [nontrivial R] [is_domain A] [algebra R A]
  (h : dimension_le_one R) : dimension_le_one (integral_closure R A) :=
h.is_integral_closure R A (integral_closure R A)

end ring

variables [is_domain A]

/--
A Dedekind domain is an integral domain that is Noetherian, integrally closed, and
has Krull dimension at most one.

This is definition 3.2 of [Neukirch1992].

The integral closure condition is independent of the choice of field of fractions:
use `is_dedekind_domain_iff` to prove `is_dedekind_domain` for a given `fraction_map`.

This is the default implementation, but there are equivalent definitions,
`is_dedekind_domain_dvr` and `is_dedekind_domain_inv`.
TODO: Prove that these are actually equivalent definitions.
-/
class is_dedekind_domain : Prop :=
(is_noetherian_ring : is_noetherian_ring A)
(dimension_le_one : dimension_le_one A)
(is_integrally_closed : is_integrally_closed A)

-- See library note [lower instance priority]
attribute [instance, priority 100]
  is_dedekind_domain.is_noetherian_ring is_dedekind_domain.is_integrally_closed

/-- An integral domain is a Dedekind domain iff and only if it is
Noetherian, has dimension ≤ 1, and is integrally closed in a given fraction field.
In particular, this definition does not depend on the choice of this fraction field. -/
lemma is_dedekind_domain_iff (K : Type*) [field K] [algebra A K] [is_fraction_ring A K] :
  is_dedekind_domain A ↔ is_noetherian_ring A ∧ dimension_le_one A ∧
    (∀ {x : K}, is_integral A x → ∃ y, algebra_map A K y = x) :=
⟨λ ⟨hr, hd, hi⟩, ⟨hr, hd, λ x, (is_integrally_closed_iff K).mp hi⟩,
 λ ⟨hr, hd, hi⟩, ⟨hr, hd, (is_integrally_closed_iff K).mpr @hi⟩⟩

@[priority 100] -- See library note [lower instance priority]
instance is_principal_ideal_ring.is_dedekind_domain [is_principal_ideal_ring A] :
  is_dedekind_domain A :=
⟨principal_ideal_ring.is_noetherian_ring,
 ring.dimension_le_one.principal_ideal_ring A,
 unique_factorization_monoid.is_integrally_closed⟩

/--
A Dedekind domain is an integral domain that is Noetherian, and the
localization at every nonzero prime is a discrete valuation ring.

This is equivalent to `is_dedekind_domain`.
TODO: prove the equivalence.
-/
structure is_dedekind_domain_dvr : Prop :=
(is_noetherian_ring : is_noetherian_ring A)
(is_dvr_at_nonzero_prime : ∀ P ≠ (⊥ : ideal A), P.is_prime →
  discrete_valuation_ring (localization.at_prime P))

section inverse

namespace fractional_ideal

variables {R₁ : Type*} [comm_ring R₁] [is_domain R₁] [algebra R₁ K] [is_fraction_ring R₁ K]
variables {I J : fractional_ideal R₁⁰ K}

noncomputable instance : has_inv (fractional_ideal R₁⁰ K) := ⟨λ I, 1 / I⟩

lemma inv_eq : I⁻¹ = 1 / I := rfl

lemma inv_zero' : (0 : fractional_ideal R₁⁰ K)⁻¹ = 0 := fractional_ideal.div_zero

lemma inv_nonzero {J : fractional_ideal R₁⁰ K} (h : J ≠ 0) :
J⁻¹ = ⟨(1 : fractional_ideal R₁⁰ K) / J, fractional_ideal.fractional_div_of_nonzero h⟩ :=
fractional_ideal.div_nonzero _

lemma coe_inv_of_nonzero {J : fractional_ideal R₁⁰ K} (h : J ≠ 0) :
  (↑J⁻¹ : submodule R₁ K) = is_localization.coe_submodule K ⊤ / J :=
by { rwa inv_nonzero _, refl, assumption }

variables {K}

lemma mem_inv_iff (hI : I ≠ 0) {x : K} :
  x ∈ I⁻¹ ↔ ∀ y ∈ I, x * y ∈ (1 : fractional_ideal R₁⁰ K) :=
fractional_ideal.mem_div_iff_of_nonzero hI

lemma inv_anti_mono (hI : I ≠ 0) (hJ : J ≠ 0) (hIJ : I ≤ J) :
  J⁻¹ ≤ I⁻¹ :=
λ x, by { simp only [mem_inv_iff hI, mem_inv_iff hJ], exact λ h y hy, h y (hIJ hy) }

lemma le_self_mul_inv {I : fractional_ideal R₁⁰ K} (hI : I ≤ (1 : fractional_ideal R₁⁰ K)) :
  I ≤ I * I⁻¹ :=
fractional_ideal.le_self_mul_one_div hI

variables (K)

lemma coe_ideal_le_self_mul_inv (I : ideal R₁) :
  (I : fractional_ideal R₁⁰ K) ≤ I * I⁻¹ :=
le_self_mul_inv fractional_ideal.coe_ideal_le_one

/-- `I⁻¹` is the inverse of `I` if `I` has an inverse. -/
theorem right_inverse_eq (I J : fractional_ideal R₁⁰ K) (h : I * J = 1) :
  J = I⁻¹ :=
begin
  have hI : I ≠ 0 := fractional_ideal.ne_zero_of_mul_eq_one I J h,
  suffices h' : I * (1 / I) = 1,
  { exact (congr_arg units.inv $
      @units.ext _ _ (units.mk_of_mul_eq_one _ _ h) (units.mk_of_mul_eq_one _ _ h') rfl) },
  apply le_antisymm,
  { apply fractional_ideal.mul_le.mpr _,
    intros x hx y hy,
    rw mul_comm,
    exact (fractional_ideal.mem_div_iff_of_nonzero hI).mp hy x hx },
  rw ← h,
  apply fractional_ideal.mul_left_mono I,
  apply (fractional_ideal.le_div_iff_of_nonzero hI).mpr _,
  intros y hy x hx,
  rw mul_comm,
  exact fractional_ideal.mul_mem_mul hx hy
end

theorem mul_inv_cancel_iff {I : fractional_ideal R₁⁰ K} :
  I * I⁻¹ = 1 ↔ ∃ J, I * J = 1 :=
⟨λ h, ⟨I⁻¹, h⟩, λ ⟨J, hJ⟩, by rwa ← right_inverse_eq K I J hJ⟩

lemma mul_inv_cancel_iff_is_unit {I : fractional_ideal R₁⁰ K} :
  I * I⁻¹ = 1 ↔ is_unit I :=
(mul_inv_cancel_iff K).trans is_unit_iff_exists_inv.symm

variables {K' : Type*} [field K'] [algebra R₁ K'] [is_fraction_ring R₁ K']

@[simp] lemma map_inv (I : fractional_ideal R₁⁰ K) (h : K ≃ₐ[R₁] K') :
  (I⁻¹).map (h : K →ₐ[R₁] K') = (I.map h)⁻¹ :=
by rw [inv_eq, fractional_ideal.map_div, fractional_ideal.map_one, inv_eq]

open submodule submodule.is_principal

@[simp] lemma span_singleton_inv (x : K) :
  (fractional_ideal.span_singleton R₁⁰ x)⁻¹ = fractional_ideal.span_singleton _ (x⁻¹) :=
fractional_ideal.one_div_span_singleton x

lemma mul_generator_self_inv {R₁ : Type*} [comm_ring R₁] [algebra R₁ K] [is_localization R₁⁰ K]
  (I : fractional_ideal R₁⁰ K) [submodule.is_principal (I : submodule R₁ K)] (h : I ≠ 0) :
  I * fractional_ideal.span_singleton _ (generator (I : submodule R₁ K))⁻¹ = 1 :=
begin
  -- Rewrite only the `I` that appears alone.
  conv_lhs { congr, rw fractional_ideal.eq_span_singleton_of_principal I },
  rw [fractional_ideal.span_singleton_mul_span_singleton, mul_inv_cancel,
    fractional_ideal.span_singleton_one],
  intro generator_I_eq_zero,
  apply h,
  rw [fractional_ideal.eq_span_singleton_of_principal I, generator_I_eq_zero,
    fractional_ideal.span_singleton_zero]
end

lemma invertible_of_principal (I : fractional_ideal R₁⁰ K)
  [submodule.is_principal (I : submodule R₁ K)] (h : I ≠ 0) :
  I * I⁻¹ = 1 :=
(fractional_ideal.mul_div_self_cancel_iff).mpr
  ⟨fractional_ideal.span_singleton _ (generator (I : submodule R₁ K))⁻¹,
    mul_generator_self_inv _ I h⟩

lemma invertible_iff_generator_nonzero (I : fractional_ideal R₁⁰ K)
  [submodule.is_principal (I : submodule R₁ K)] :
  I * I⁻¹ = 1 ↔ generator (I : submodule R₁ K) ≠ 0 :=
begin
  split,
  { intros hI hg,
    apply fractional_ideal.ne_zero_of_mul_eq_one _ _ hI,
    rw [fractional_ideal.eq_span_singleton_of_principal I, hg,
        fractional_ideal.span_singleton_zero] },
  { intro hg,
    apply invertible_of_principal,
    rw [fractional_ideal.eq_span_singleton_of_principal I],
    intro hI,
    have := fractional_ideal.mem_span_singleton_self _ (generator (I : submodule R₁ K)),
    rw [hI, fractional_ideal.mem_zero_iff] at this,
    contradiction }
end

lemma is_principal_inv (I : fractional_ideal R₁⁰ K)
  [submodule.is_principal (I : submodule R₁ K)] (h : I ≠ 0) :
  submodule.is_principal (I⁻¹).1 :=
begin
  rw [fractional_ideal.val_eq_coe, fractional_ideal.is_principal_iff],
  use (generator (I : submodule R₁ K))⁻¹,
  have hI : I  * fractional_ideal.span_singleton _ ((generator (I : submodule R₁ K))⁻¹)  = 1,
  apply mul_generator_self_inv _ I h,
  exact (right_inverse_eq _ I (fractional_ideal.span_singleton _
    ((generator (I : submodule R₁ K))⁻¹)) hI).symm
end

@[simp] lemma one_inv : (1⁻¹ : fractional_ideal R₁⁰ K) = 1 :=
fractional_ideal.div_one

end fractional_ideal

/--
A Dedekind domain is an integral domain such that every fractional ideal has an inverse.

This is equivalent to `is_dedekind_domain`.
In particular we provide a `fractional_ideal.comm_group_with_zero` instance,
assuming `is_dedekind_domain A`, which implies `is_dedekind_domain_inv`. For **integral** ideals,
`is_dedekind_domain`(`_inv`) implies only `ideal.comm_cancel_monoid_with_zero`.
-/
def is_dedekind_domain_inv : Prop :=
∀ I ≠ (⊥ : fractional_ideal A⁰ (fraction_ring A)), I * I⁻¹ = 1

open fractional_ideal

variables {R A K}

lemma is_dedekind_domain_inv_iff [algebra A K] [is_fraction_ring A K] :
  is_dedekind_domain_inv A ↔
    (∀ I ≠ (⊥ : fractional_ideal A⁰ K), I * I⁻¹ = 1) :=
begin
  set h := fraction_ring.alg_equiv A K,
  split; rintros hi I hI,
  { refine fractional_ideal.map_injective h.symm.to_alg_hom h.symm.injective _,
    rw [alg_equiv.to_alg_hom_eq_coe, inv_eq, fractional_ideal.map_mul,
        fractional_ideal.map_one_div, fractional_ideal.map_one, ← inv_eq, hi],
    exact fractional_ideal.map_ne_zero _ hI },
  { refine fractional_ideal.map_injective h.to_alg_hom h.injective _,
    rw [alg_equiv.to_alg_hom_eq_coe, inv_eq, fractional_ideal.map_mul,
        fractional_ideal.map_one_div, fractional_ideal.map_one, ← inv_eq, hi],
    exact fractional_ideal.map_ne_zero _ hI },
end

lemma fractional_ideal.adjoin_integral_eq_one_of_is_unit [algebra A K] [is_fraction_ring A K]
  (x : K) (hx : is_integral A x) (hI : is_unit (adjoin_integral A⁰ x hx)) :
  adjoin_integral A⁰ x hx = 1 :=
begin
  set I := adjoin_integral A⁰ x hx,
  have mul_self : I * I = I,
  { apply fractional_ideal.coe_to_submodule_injective, simp },
  convert congr_arg (* I⁻¹) mul_self;
  simp only [(mul_inv_cancel_iff_is_unit K).mpr hI, mul_assoc, mul_one],
end

namespace is_dedekind_domain_inv

variables [algebra A K] [is_fraction_ring A K] (h : is_dedekind_domain_inv A)

include h

lemma mul_inv_eq_one {I : fractional_ideal A⁰ K} (hI : I ≠ 0) : I * I⁻¹ = 1 :=
is_dedekind_domain_inv_iff.mp h I hI

lemma inv_mul_eq_one {I : fractional_ideal A⁰ K} (hI : I ≠ 0) : I⁻¹ * I = 1 :=
(mul_comm _ _).trans (h.mul_inv_eq_one hI)

protected lemma is_unit {I : fractional_ideal A⁰ K} (hI : I ≠ 0) : is_unit I :=
is_unit_of_mul_eq_one _ _ (h.mul_inv_eq_one hI)

lemma is_noetherian_ring : is_noetherian_ring A :=
begin
  refine is_noetherian_ring_iff.mpr ⟨λ (I : ideal A), _⟩,
  by_cases hI : I = ⊥,
  { rw hI, apply submodule.fg_bot },
  have hI : (I : fractional_ideal A⁰ (fraction_ring A)) ≠ 0 :=
    (coe_to_fractional_ideal_ne_zero (le_refl (non_zero_divisors A))).mpr hI,
  exact I.fg_of_is_unit (is_fraction_ring.injective A (fraction_ring A)) (h.is_unit hI)
end

lemma integrally_closed : is_integrally_closed A :=
begin
  -- It suffices to show that for integral `x`,
  -- `A[x]` (which is a fractional ideal) is in fact equal to `A`.
  refine ⟨λ x hx, _⟩,
  rw [← set.mem_range, ← algebra.mem_bot, ← subalgebra.mem_to_submodule, algebra.to_submodule_bot,
      ← coe_span_singleton A⁰ (1 : fraction_ring A), fractional_ideal.span_singleton_one,
      ← fractional_ideal.adjoin_integral_eq_one_of_is_unit x hx (h.is_unit _)],
  { exact mem_adjoin_integral_self A⁰ x hx },
  { exact λ h, one_ne_zero (eq_zero_iff.mp h 1 (subalgebra.one_mem _)) },
end

lemma dimension_le_one : dimension_le_one A :=
begin
  -- We're going to show that `P` is maximal because any (maximal) ideal `M`
  -- that is strictly larger would be `⊤`.
  rintros P P_ne hP,
  refine ideal.is_maximal_def.mpr ⟨hP.ne_top, λ M hM, _⟩,
  -- We may assume `P` and `M` (as fractional ideals) are nonzero.
  have P'_ne : (P : fractional_ideal A⁰ (fraction_ring A)) ≠ 0 :=
    (coe_to_fractional_ideal_ne_zero (le_refl (non_zero_divisors A))).mpr P_ne,
  have M'_ne : (M : fractional_ideal A⁰ (fraction_ring A)) ≠ 0 :=
    (coe_to_fractional_ideal_ne_zero (le_refl (non_zero_divisors A))).mpr
      (lt_of_le_of_lt bot_le hM).ne',

  -- In particular, we'll show `M⁻¹ * P ≤ P`
  suffices : (M⁻¹ * P : fractional_ideal A⁰ (fraction_ring A)) ≤ P,
  { rw [eq_top_iff, ← coe_ideal_le_coe_ideal (fraction_ring A), fractional_ideal.coe_ideal_top],
    calc (1 : fractional_ideal A⁰ (fraction_ring A)) = _ * _ * _ : _
    ... ≤ _ * _ : mul_right_mono (P⁻¹ * M : fractional_ideal A⁰ (fraction_ring A)) this
    ... = M : _,
    { rw [mul_assoc, ← mul_assoc ↑P, h.mul_inv_eq_one P'_ne, one_mul, h.inv_mul_eq_one M'_ne] },
    { rw [← mul_assoc ↑P, h.mul_inv_eq_one P'_ne, one_mul] },
    { apply_instance } },

  -- Suppose we have `x ∈ M⁻¹ * P`, then in fact `x = algebra_map _ _ y` for some `y`.
  intros x hx,
  have le_one : (M⁻¹ * P : fractional_ideal A⁰ (fraction_ring A)) ≤ 1,
  { rw [← h.inv_mul_eq_one M'_ne],
    exact fractional_ideal.mul_left_mono _ ((coe_ideal_le_coe_ideal (fraction_ring A)).mpr hM.le) },
  obtain ⟨y, hy, rfl⟩ := (mem_coe_ideal _).mp (le_one hx),

  -- Since `M` is strictly greater than `P`, let `z ∈ M \ P`.
  obtain ⟨z, hzM, hzp⟩ := set_like.exists_of_lt hM,
  -- We have `z * y ∈ M * (M⁻¹ * P) = P`.
  have zy_mem := fractional_ideal.mul_mem_mul (mem_coe_ideal_of_mem A⁰ hzM) hx,
  rw [← ring_hom.map_mul, ← mul_assoc, h.mul_inv_eq_one M'_ne, one_mul] at zy_mem,
  obtain ⟨zy, hzy, zy_eq⟩ := (mem_coe_ideal A⁰).mp zy_mem,
  rw is_fraction_ring.injective A (fraction_ring A) zy_eq at hzy,
  -- But `P` is a prime ideal, so `z ∉ P` implies `y ∈ P`, as desired.
  exact mem_coe_ideal_of_mem A⁰ (or.resolve_left (hP.mem_or_mem hzy) hzp)
end

/-- Showing one side of the equivalence between the definitions
`is_dedekind_domain_inv` and `is_dedekind_domain` of Dedekind domains. -/
theorem is_dedekind_domain : is_dedekind_domain A :=
⟨h.is_noetherian_ring, h.dimension_le_one, h.integrally_closed⟩

end is_dedekind_domain_inv

variables [algebra A K] [is_fraction_ring A K]

/-- Specialization of `exists_prime_spectrum_prod_le_and_ne_bot_of_domain` to Dedekind domains:
Let `I : ideal A` be a nonzero ideal, where `A` is a Dedekind domain that is not a field.
Then `exists_prime_spectrum_prod_le_and_ne_bot_of_domain` states we can find a product of prime
ideals that is contained within `I`. This lemma extends that result by making the product minimal:
let `M` be a maximal ideal that contains `I`, then the product including `M` is contained within `I`
and the product excluding `M` is not contained within `I`. -/
lemma exists_multiset_prod_cons_le_and_prod_not_le [is_dedekind_domain A]
  (hNF : ¬ is_field A) {I M : ideal A} (hI0 : I ≠ ⊥) (hIM : I ≤ M) [hM : M.is_maximal] :
  ∃ (Z : multiset (prime_spectrum A)),
    (M ::ₘ (Z.map prime_spectrum.as_ideal)).prod ≤ I ∧
    ¬ (multiset.prod (Z.map prime_spectrum.as_ideal) ≤ I) :=
begin
  -- Let `Z` be a minimal set of prime ideals such that their product is contained in `J`.
  obtain ⟨Z₀, hZ₀⟩ := prime_spectrum.exists_prime_spectrum_prod_le_and_ne_bot_of_domain hNF hI0,
  obtain ⟨Z, ⟨hZI, hprodZ⟩, h_eraseZ⟩ := multiset.well_founded_lt.has_min
    (λ Z, (Z.map prime_spectrum.as_ideal).prod ≤ I ∧ (Z.map prime_spectrum.as_ideal).prod ≠ ⊥)
    ⟨Z₀, hZ₀⟩,
  have hZM : multiset.prod (Z.map prime_spectrum.as_ideal) ≤ M := le_trans hZI hIM,
  have hZ0 : Z ≠ 0, { rintro rfl, simpa [hM.ne_top] using hZM },
  obtain ⟨_, hPZ', hPM⟩ := (hM.is_prime.multiset_prod_le (mt multiset.map_eq_zero.mp hZ0)).mp hZM,
  -- Then in fact there is a `P ∈ Z` with `P ≤ M`.
  obtain ⟨P, hPZ, rfl⟩ := multiset.mem_map.mp hPZ',
  letI := classical.dec_eq (ideal A),
  have := multiset.map_erase prime_spectrum.as_ideal subtype.coe_injective P Z,
  obtain ⟨hP0, hZP0⟩ : P.as_ideal ≠ ⊥ ∧ ((Z.erase P).map prime_spectrum.as_ideal).prod ≠ ⊥,
  { rwa [ne.def, ← multiset.cons_erase hPZ', multiset.prod_cons, ideal.mul_eq_bot,
         not_or_distrib, ← this] at hprodZ },
  -- By maximality of `P` and `M`, we have that `P ≤ M` implies `P = M`.
  have hPM' := (is_dedekind_domain.dimension_le_one _ hP0 P.is_prime).eq_of_le hM.ne_top hPM,
  tactic.unfreeze_local_instances,
  subst hPM',

  -- By minimality of `Z`, erasing `P` from `Z` is exactly what we need.
  refine ⟨Z.erase P, _, _⟩,
  { convert hZI,
    rw [this, multiset.cons_erase hPZ'] },
  { refine λ h, h_eraseZ (Z.erase P) ⟨h, _⟩ (multiset.erase_lt.mpr hPZ),
    exact hZP0 }
end

namespace fractional_ideal

lemma exists_not_mem_one_of_ne_bot [is_dedekind_domain A]
  (hNF : ¬ is_field A) {I : ideal A} (hI0 : I ≠ ⊥) (hI1 : I ≠ ⊤) :
  ∃ x : K, x ∈ (I⁻¹ : fractional_ideal A⁰ K) ∧ x ∉ (1 : fractional_ideal A⁰ K) :=
begin
  -- WLOG, let `I` be maximal.
  suffices : ∀ {M : ideal A} (hM : M.is_maximal),
    ∃ x : K, x ∈ (M⁻¹ : fractional_ideal A⁰ K) ∧ x ∉ (1 : fractional_ideal A⁰ K),
  { obtain ⟨M, hM, hIM⟩ : ∃ (M : ideal A), is_maximal M ∧ I ≤ M := ideal.exists_le_maximal I hI1,
    resetI,
    have hM0 := (M.bot_lt_of_maximal hNF).ne',
    obtain ⟨x, hxM, hx1⟩ := this hM,
    refine ⟨x, inv_anti_mono _ _ ((coe_ideal_le_coe_ideal _).mpr hIM) hxM, hx1⟩;
      apply fractional_ideal.coe_ideal_ne_zero; assumption },

  -- Let `a` be a nonzero element of `M` and `J` the ideal generated by `a`.
  intros M hM,
  resetI,
  obtain ⟨⟨a, haM⟩, ha0⟩ := submodule.nonzero_mem_of_bot_lt (M.bot_lt_of_maximal hNF),
  replace ha0 : a ≠ 0 := subtype.coe_injective.ne ha0,
  let J : ideal A := ideal.span {a},
  have hJ0 : J ≠ ⊥ := mt ideal.span_singleton_eq_bot.mp ha0,
  have hJM : J ≤ M := ideal.span_le.mpr (set.singleton_subset_iff.mpr haM),
  have hM0 : ⊥ < M := M.bot_lt_of_maximal hNF,

  -- Then we can find a product of prime (hence maximal) ideals contained in `J`,
  -- such that removing element `M` from the product is not contained in `J`.
  obtain ⟨Z, hle, hnle⟩ := exists_multiset_prod_cons_le_and_prod_not_le hNF hJ0 hJM,
  -- Choose an element `b` of the product that is not in `J`.
  obtain ⟨b, hbZ, hbJ⟩ := set_like.not_le_iff_exists.mp hnle,
  have hnz_fa : algebra_map A K a ≠ 0 :=
    mt ((ring_hom.injective_iff _).mp (is_fraction_ring.injective A K) a) ha0,
  have hb0 : algebra_map A K b ≠ 0 :=
    mt ((ring_hom.injective_iff _).mp (is_fraction_ring.injective A K) b)
      (λ h, hbJ $ h.symm ▸ J.zero_mem),
  -- Then `b a⁻¹ : K` is in `M⁻¹` but not in `1`.
  refine ⟨algebra_map A K b * (algebra_map A K a)⁻¹, (mem_inv_iff _).mpr _, _⟩,
  { exact (fractional_ideal.coe_to_fractional_ideal_ne_zero (le_refl _)).mpr hM0.ne' },
  { rintro y₀ hy₀,
    obtain ⟨y, h_Iy, rfl⟩ := (fractional_ideal.mem_coe_ideal _).mp hy₀,
    rw [mul_comm, ← mul_assoc, ← ring_hom.map_mul],
    have h_yb : y * b ∈ J,
    { apply hle,
      rw multiset.prod_cons,
      exact submodule.smul_mem_smul h_Iy hbZ },
    rw ideal.mem_span_singleton' at h_yb,
    rcases h_yb with ⟨c, hc⟩,
    rw [← hc, ring_hom.map_mul, mul_assoc, mul_inv_cancel hnz_fa, mul_one],
    apply fractional_ideal.coe_mem_one },
  { refine mt (fractional_ideal.mem_one_iff _).mp _,
    rintros ⟨x', h₂_abs⟩,
    rw [← div_eq_mul_inv, eq_div_iff_mul_eq hnz_fa, ← ring_hom.map_mul] at h₂_abs,
    have := ideal.mem_span_singleton'.mpr ⟨x', is_fraction_ring.injective A K h₂_abs⟩,
    contradiction },
end

lemma one_mem_inv_coe_ideal {I : ideal A} (hI : I ≠ ⊥) :
  (1 : K) ∈ (I : fractional_ideal A⁰ K)⁻¹ :=
begin
  rw mem_inv_iff (fractional_ideal.coe_ideal_ne_zero hI),
  intros y hy,
  rw one_mul,
  exact coe_ideal_le_one hy,
  assumption
end

lemma mul_inv_cancel_of_le_one [h : is_dedekind_domain A]
  {I : ideal A} (hI0 : I ≠ ⊥) (hI : ((I * I⁻¹)⁻¹ : fractional_ideal A⁰ K) ≤ 1) :
  (I * I⁻¹ : fractional_ideal A⁰ K) = 1 :=
begin
  -- Handle a few trivial cases.
  by_cases hI1 : I = ⊤,
  { rw [hI1, coe_ideal_top, one_mul, fractional_ideal.one_inv] },
  by_cases hNF : is_field A,
  { letI := hNF.to_field A, rcases hI1 (I.eq_bot_or_top.resolve_left hI0) },
  -- We'll show a contradiction with `exists_not_mem_one_of_ne_bot`:
  -- `J⁻¹ = (I * I⁻¹)⁻¹` cannot have an element `x ∉ 1`, so it must equal `1`.
  obtain ⟨J, hJ⟩ : ∃ (J : ideal A), (J : fractional_ideal A⁰ K) = I * I⁻¹ :=
    le_one_iff_exists_coe_ideal.mp mul_one_div_le_one,
  by_cases hJ0 : J = ⊥,
  { subst hJ0,
    refine absurd _ hI0,
    rw [eq_bot_iff, ← coe_ideal_le_coe_ideal K, hJ],
    exact coe_ideal_le_self_mul_inv K I,
    apply_instance },
  by_cases hJ1 : J = ⊤,
  { rw [← hJ, hJ1, coe_ideal_top] },
  obtain ⟨x, hx, hx1⟩ : ∃ (x : K),
    x ∈ (J : fractional_ideal A⁰ K)⁻¹ ∧ x ∉ (1 : fractional_ideal A⁰ K) :=
    exists_not_mem_one_of_ne_bot hNF hJ0 hJ1,
  contrapose! hx1 with h_abs,
  rw hJ at hx,
  exact hI hx,
end

/-- Nonzero integral ideals in a Dedekind domain are invertible.

We will use this to show that nonzero fractional ideals are invertible,
and finally conclude that fractional ideals in a Dedekind domain form a group with zero.
-/
lemma coe_ideal_mul_inv [h : is_dedekind_domain A] (I : ideal A) (hI0 : I ≠ ⊥) :
  (I * I⁻¹ : fractional_ideal A⁰ K) = 1 :=
begin
  -- We'll show `1 ≤ J⁻¹ = (I * I⁻¹)⁻¹ ≤ 1`.
  apply mul_inv_cancel_of_le_one hI0,
  by_cases hJ0 : (I * I⁻¹ : fractional_ideal A⁰ K) = 0,
  { rw [hJ0, inv_zero'], exact fractional_ideal.zero_le _ },
  intros x hx,
  -- In particular, we'll show all `x ∈ J⁻¹` are integral.
  suffices : x ∈ integral_closure A K,
  { rwa [is_integrally_closed.integral_closure_eq_bot, algebra.mem_bot, set.mem_range,
         ← fractional_ideal.mem_one_iff] at this;
      assumption },
  -- For that, we'll find a subalgebra that is f.g. as a module and contains `x`.
  -- `A` is a noetherian ring, so we just need to find a subalgebra between `{x}` and `I⁻¹`.
  rw mem_integral_closure_iff_mem_fg,
  have x_mul_mem : ∀ b ∈ (I⁻¹ : fractional_ideal A⁰ K), x * b ∈ (I⁻¹ : fractional_ideal A⁰ K),
  { intros b hb,
    rw mem_inv_iff at ⊢ hx,
    swap, { exact fractional_ideal.coe_ideal_ne_zero hI0 },
    swap, { exact hJ0 },
    simp only [mul_assoc, mul_comm b] at ⊢ hx,
    intros y hy,
    exact hx _ (fractional_ideal.mul_mem_mul hy hb) },
  -- It turns out the subalgebra consisting of all `p(x)` for `p : polynomial A` works.
  refine ⟨alg_hom.range (polynomial.aeval x : polynomial A →ₐ[A] K),
          is_noetherian_submodule.mp (fractional_ideal.is_noetherian I⁻¹) _ (λ y hy, _),
          ⟨polynomial.X, polynomial.aeval_X x⟩⟩,
  obtain ⟨p, rfl⟩ := (alg_hom.mem_range _).mp hy,
  rw polynomial.aeval_eq_sum_range,
  refine submodule.sum_mem _ (λ i hi, submodule.smul_mem _ _ _),
  clear hi,
  induction i with i ih,
  { rw pow_zero, exact one_mem_inv_coe_ideal hI0 },
  { show x ^ i.succ ∈ (I⁻¹ : fractional_ideal A⁰ K),
    rw pow_succ, exact x_mul_mem _ ih },
end

/-- Nonzero fractional ideals in a Dedekind domain are units.

This is also available as `_root_.mul_inv_cancel`, using the
`comm_group_with_zero` instance defined below.
-/
protected theorem mul_inv_cancel [is_dedekind_domain A]
  {I : fractional_ideal A⁰ K} (hne : I ≠ 0) : I * I⁻¹ = 1 :=
begin
  obtain ⟨a, J, ha, hJ⟩ :
    ∃ (a : A) (aI : ideal A), a ≠ 0 ∧ I = span_singleton A⁰ (algebra_map _ _ a)⁻¹ * aI :=
    exists_eq_span_singleton_mul I,
  suffices h₂ : I * (span_singleton A⁰ (algebra_map _ _ a) * J⁻¹) = 1,
  { rw mul_inv_cancel_iff,
    exact ⟨span_singleton A⁰ (algebra_map _ _ a) * J⁻¹, h₂⟩ },
  subst hJ,
  rw [mul_assoc, mul_left_comm (J : fractional_ideal A⁰ K), coe_ideal_mul_inv, mul_one,
      fractional_ideal.span_singleton_mul_span_singleton, inv_mul_cancel,
      fractional_ideal.span_singleton_one],
  { exact mt ((algebra_map A K).injective_iff.mp (is_fraction_ring.injective A K) _) ha },
  { exact fractional_ideal.coe_ideal_ne_zero_iff.mp (right_ne_zero_of_mul hne) }
end

lemma mul_right_le_iff [is_dedekind_domain A] {J : fractional_ideal A⁰ K}
  (hJ : J ≠ 0) : ∀ {I I'}, I * J ≤ I' * J ↔ I ≤ I' :=
begin
  intros I I',
  split,
  { intros h, convert mul_right_mono J⁻¹ h;
      rw [mul_assoc, fractional_ideal.mul_inv_cancel hJ, mul_one] },
  { exact λ h, mul_right_mono J h }
end

lemma mul_left_le_iff [is_dedekind_domain A] {J : fractional_ideal A⁰ K}
  (hJ : J ≠ 0) {I I'} : J * I ≤ J * I' ↔ I ≤ I' :=
by convert fractional_ideal.mul_right_le_iff hJ using 1; simp only [mul_comm]

lemma mul_right_strict_mono [is_dedekind_domain A] {I : fractional_ideal A⁰ K}
  (hI : I ≠ 0) : strict_mono (* I) :=
strict_mono_of_le_iff_le (λ _ _, (mul_right_le_iff hI).symm)

lemma mul_left_strict_mono [is_dedekind_domain A] {I : fractional_ideal A⁰ K}
  (hI : I ≠ 0) : strict_mono ((*) I) :=
strict_mono_of_le_iff_le (λ _ _, (mul_left_le_iff hI).symm)

/--
This is also available as `_root_.div_eq_mul_inv`, using the
`comm_group_with_zero` instance defined below.
-/
protected lemma div_eq_mul_inv [is_dedekind_domain A] (I J : fractional_ideal A⁰ K) :
  I / J = I * J⁻¹ :=
begin
  by_cases hJ : J = 0,
  { rw [hJ, div_zero, inv_zero', mul_zero] },
  refine le_antisymm ((mul_right_le_iff hJ).mp _) ((le_div_iff_mul_le hJ).mpr _),
  { rw [mul_assoc, mul_comm J⁻¹, fractional_ideal.mul_inv_cancel hJ, mul_one, mul_le],
    intros x hx y hy,
    rw [mem_div_iff_of_nonzero hJ] at hx,
    exact hx y hy },
  rw [mul_assoc, mul_comm J⁻¹, fractional_ideal.mul_inv_cancel hJ, mul_one],
  exact le_refl I
end

end fractional_ideal

/-- `is_dedekind_domain` and `is_dedekind_domain_inv` are equivalent ways
to express that an integral domain is a Dedekind domain. -/
theorem is_dedekind_domain_iff_is_dedekind_domain_inv :
  is_dedekind_domain A ↔ is_dedekind_domain_inv A :=
⟨λ h I hI, by exactI fractional_ideal.mul_inv_cancel hI, λ h, h.is_dedekind_domain⟩

end inverse

section is_dedekind_domain

variables {R A} [is_dedekind_domain A] [algebra A K] [is_fraction_ring A K]

open fractional_ideal

noncomputable instance fractional_ideal.comm_group_with_zero :
  comm_group_with_zero (fractional_ideal A⁰ K) :=
{ inv := λ I, I⁻¹,
  inv_zero := inv_zero' _,
  div := (/),
  div_eq_mul_inv := fractional_ideal.div_eq_mul_inv,
  exists_pair_ne := ⟨0, 1, (coe_to_fractional_ideal_injective (le_refl _)).ne
    (by simpa using @zero_ne_one (ideal A) _ _)⟩,
  mul_inv_cancel := λ I, fractional_ideal.mul_inv_cancel,
  .. fractional_ideal.comm_semiring }

noncomputable instance ideal.comm_cancel_monoid_with_zero :
  comm_cancel_monoid_with_zero (ideal A) :=
function.injective.comm_cancel_monoid_with_zero (coe_ideal_hom A⁰ (fraction_ring A))
  coe_ideal_injective (ring_hom.map_zero _) (ring_hom.map_one _) (ring_hom.map_mul _)

/-- For ideals in a Dedekind domain, to divide is to contain. -/
lemma ideal.dvd_iff_le {I J : ideal A} : (I ∣ J) ↔ J ≤ I :=
⟨ideal.le_of_dvd,
  λ h, begin
    by_cases hI : I = ⊥,
    { have hJ : J = ⊥, { rwa [hI, ← eq_bot_iff] at h },
      rw [hI, hJ] },
    have hI' : (I : fractional_ideal A⁰ (fraction_ring A)) ≠ 0 :=
      (fractional_ideal.coe_to_fractional_ideal_ne_zero (le_refl (non_zero_divisors A))).mpr hI,
    have : (I : fractional_ideal A⁰ (fraction_ring A))⁻¹ * J ≤ 1 := le_trans
      (fractional_ideal.mul_left_mono (↑I)⁻¹ ((coe_ideal_le_coe_ideal _).mpr h))
      (le_of_eq (inv_mul_cancel hI')),
    obtain ⟨H, hH⟩ := fractional_ideal.le_one_iff_exists_coe_ideal.mp this,
    use H,
    refine coe_to_fractional_ideal_injective (le_refl (non_zero_divisors A))
      (show (J : fractional_ideal A⁰ (fraction_ring A)) = _, from _),
    rw [fractional_ideal.coe_ideal_mul, hH, ← mul_assoc, mul_inv_cancel hI', one_mul]
end⟩

lemma ideal.dvd_not_unit_iff_lt {I J : ideal A} :
  dvd_not_unit I J ↔ J < I :=
⟨λ ⟨hI, H, hunit, hmul⟩, lt_of_le_of_ne (ideal.dvd_iff_le.mp ⟨H, hmul⟩)
   (mt (λ h, have H = 1, from mul_left_cancel₀ hI (by rw [← hmul, h, mul_one]),
   show is_unit H, from this.symm ▸ is_unit_one) hunit),
 λ h, dvd_not_unit_of_dvd_of_not_dvd (ideal.dvd_iff_le.mpr (le_of_lt h))
   (mt ideal.dvd_iff_le.mp (not_le_of_lt h))⟩

instance : wf_dvd_monoid (ideal A) :=
{ well_founded_dvd_not_unit :=
  have well_founded ((>) : ideal A → ideal A → Prop) :=
  is_noetherian_iff_well_founded.mp
    (is_noetherian_ring_iff.mp is_dedekind_domain.is_noetherian_ring),
  by { convert this, ext, rw ideal.dvd_not_unit_iff_lt } }

instance ideal.unique_factorization_monoid :
  unique_factorization_monoid (ideal A) :=
{ irreducible_iff_prime := λ P,
  ⟨λ hirr, ⟨hirr.ne_zero, hirr.not_unit, λ I J, begin
    have : P.is_maximal,
    { refine ⟨⟨mt ideal.is_unit_iff.mpr hirr.not_unit, _⟩⟩,
      intros J hJ,
      obtain ⟨J_ne, H, hunit, P_eq⟩ := ideal.dvd_not_unit_iff_lt.mpr hJ,
      exact ideal.is_unit_iff.mp ((hirr.is_unit_or_is_unit P_eq).resolve_right hunit) },
    rw [ideal.dvd_iff_le, ideal.dvd_iff_le, ideal.dvd_iff_le,
        set_like.le_def, set_like.le_def, set_like.le_def],
    contrapose!,
    rintros ⟨⟨x, x_mem, x_not_mem⟩, ⟨y, y_mem, y_not_mem⟩⟩,
    exact ⟨x * y, ideal.mul_mem_mul x_mem y_mem,
           mt this.is_prime.mem_or_mem (not_or x_not_mem y_not_mem)⟩,
   end⟩,
   prime.irreducible⟩,
  .. ideal.wf_dvd_monoid }

noncomputable instance ideal.normalization_monoid : normalization_monoid (ideal A) :=
normalization_monoid_of_unique_units

@[simp] lemma ideal.dvd_span_singleton {I : ideal A} {x : A} :
  I ∣ ideal.span {x} ↔ x ∈ I :=
ideal.dvd_iff_le.trans (ideal.span_le.trans set.singleton_subset_iff)

lemma ideal.is_prime_of_prime {P : ideal A} (h : prime P) : is_prime P :=
begin
  refine ⟨_, λ x y hxy, _⟩,
  { unfreezingI { rintro rfl },
    rw ← ideal.one_eq_top at h,
    exact h.not_unit is_unit_one },
  { simp only [← ideal.dvd_span_singleton, ← ideal.span_singleton_mul_span_singleton] at ⊢ hxy,
    exact h.dvd_or_dvd hxy }
end

theorem ideal.prime_of_is_prime {P : ideal A} (hP : P ≠ ⊥) (h : is_prime P) : prime P :=
begin
  refine ⟨hP, mt ideal.is_unit_iff.mp h.ne_top, λ I J hIJ, _⟩,
  simpa only [ideal.dvd_iff_le] using (h.mul_le.mp (ideal.le_of_dvd hIJ)),
end

/-- In a Dedekind domain, the (nonzero) prime elements of the monoid with zero `ideal A`
are exactly the prime ideals. -/
theorem ideal.prime_iff_is_prime {P : ideal A} (hP : P ≠ ⊥) :
  prime P ↔ is_prime P :=
⟨ideal.is_prime_of_prime, ideal.prime_of_is_prime hP⟩

end is_dedekind_domain

section is_integral_closure

/-! ### `is_integral_closure` section

We show that an integral closure of a Dedekind domain in a finite separable
field extension is again a Dedekind domain. This implies the ring of integers
of a number field is a Dedekind domain. -/

open algebra
open_locale big_operators

variables {A K} [algebra A K] [is_fraction_ring A K]
variables {L : Type*} [field L] (C : Type*) [comm_ring C]
variables [algebra K L] [finite_dimensional K L] [algebra A L] [is_scalar_tower A K L]
variables [algebra C L] [is_integral_closure C A L] [algebra A C] [is_scalar_tower A C L]

lemma is_integral_closure.range_le_span_dual_basis [is_separable K L]
  {ι : Type*} [fintype ι] [decidable_eq ι] (b : basis ι K L)
  (hb_int : ∀ i, is_integral A (b i)) [is_integrally_closed A] :
  ((algebra.linear_map C L).restrict_scalars A).range ≤
    submodule.span A (set.range $ (trace_form K L).dual_basis (trace_form_nondegenerate K L) b) :=
begin
  let db := (trace_form K L).dual_basis (trace_form_nondegenerate K L) b,
  rintros _ ⟨x, rfl⟩,
  simp only [linear_map.coe_restrict_scalars_eq_coe, algebra.linear_map_apply],
  have hx : is_integral A (algebra_map C L x) :=
    (is_integral_closure.is_integral A L x).algebra_map,
  suffices : ∃ (c : ι → A), algebra_map C L x = ∑ i, c i • db i,
  { obtain ⟨c, x_eq⟩ := this,
    rw x_eq,
    refine submodule.sum_mem _ (λ i _, submodule.smul_mem _ _ (submodule.subset_span _)),
    rw set.mem_range,
    exact ⟨i, rfl⟩ },
  suffices : ∃ (c : ι → K), ((∀ i, is_integral A (c i)) ∧ algebra_map C L x = ∑ i, c i • db i),
  { obtain ⟨c, hc, hx⟩ := this,
    have hc' : ∀ i, is_localization.is_integer A (c i) :=
      λ i, is_integrally_closed.is_integral_iff.mp (hc i),
    use λ i, classical.some (hc' i),
    refine hx.trans (finset.sum_congr rfl (λ i _, _)),
    conv_lhs { rw [← classical.some_spec (hc' i)] },
    rw [← is_scalar_tower.algebra_map_smul K (classical.some (hc' i)) (db i)] },
  refine ⟨λ i, db.repr (algebra_map C L x) i, (λ i, _), (db.sum_repr _).symm⟩,
  rw bilin_form.dual_basis_repr_apply,
  exact is_integral_trace (is_integral_mul hx (hb_int i))
end

lemma integral_closure_le_span_dual_basis [is_separable K L]
  {ι : Type*} [fintype ι] [decidable_eq ι] (b : basis ι K L)
  (hb_int : ∀ i, is_integral A (b i)) [is_integrally_closed A] :
  (integral_closure A L).to_submodule ≤ submodule.span A (set.range $
    (trace_form K L).dual_basis (trace_form_nondegenerate K L) b) :=
begin
  refine le_trans _ (is_integral_closure.range_le_span_dual_basis (integral_closure A L) b hb_int),
  intros x hx,
  exact ⟨⟨x, hx⟩, rfl⟩
end

variables (A) (K)

include K

/-- Send a set of `x`'es in a finite extension `L` of the fraction field of `R`
to `(y : R) • x ∈ integral_closure R L`. -/
lemma exists_integral_multiples (s : finset L) :
  ∃ (y ≠ (0 : A)), ∀ x ∈ s, is_integral A (y • x) :=
begin
  haveI := classical.dec_eq L,
  refine s.induction _ _,
  { use [1, one_ne_zero],
    rintros x ⟨⟩ },
  { rintros x s hx ⟨y, hy, hs⟩,
    obtain ⟨x', y', hy', hx'⟩ := exists_integral_multiple
      ((is_fraction_ring.is_algebraic_iff A K).mpr (algebra.is_algebraic_of_finite x))
      ((algebra_map A L).injective_iff.mp _),
    refine ⟨y * y', mul_ne_zero hy hy', λ x'' hx'', _⟩,
    rcases finset.mem_insert.mp hx'' with (rfl | hx''),
    { rw [mul_smul, algebra.smul_def, algebra.smul_def, mul_comm _ x'', hx'],
      exact is_integral_mul is_integral_algebra_map x'.2 },
    { rw [mul_comm, mul_smul, algebra.smul_def],
      exact is_integral_mul is_integral_algebra_map (hs _ hx'') },
    { rw is_scalar_tower.algebra_map_eq A K L,
      apply (algebra_map K L).injective.comp,
      exact is_fraction_ring.injective _ _ } }
end

variables (L)

/-- If `L` is a finite extension of `K = Frac(A)`,
then `L` has a basis over `A` consisting of integral elements. -/
lemma finite_dimensional.exists_is_basis_integral :
  ∃ (s : finset L) (b : basis s K L), (∀ x, is_integral A (b x)) :=
begin
  letI := classical.dec_eq L,
  letI : is_noetherian K L := is_noetherian.iff_fg.2 infer_instance,
  let s' := is_noetherian.finset_basis_index K L,
  let bs' := is_noetherian.finset_basis K L,
  obtain ⟨y, hy, his'⟩ := exists_integral_multiples A K (finset.univ.image bs'),
  have hy' : algebra_map A L y ≠ 0,
  { refine mt ((algebra_map A L).injective_iff.mp _ _) hy,
    rw is_scalar_tower.algebra_map_eq A K L,
    exact (algebra_map K L).injective.comp (is_fraction_ring.injective A K) },
  refine ⟨s', bs'.map { to_fun := λ x, algebra_map A L y * x,
                        inv_fun := λ x, (algebra_map A L y)⁻¹ * x,
                        left_inv := _,
                        right_inv := _,
                        .. algebra.lmul _ _ (algebra_map A L y) },
          _⟩,
  { intros x, simp only [inv_mul_cancel_left₀ hy'] },
  { intros x, simp only [mul_inv_cancel_left₀ hy'] },
  { rintros ⟨x', hx'⟩,
    simp only [algebra.smul_def, finset.mem_image, exists_prop, finset.mem_univ, true_and] at his',
    simp only [basis.map_apply, linear_equiv.coe_mk],
    exact his' _ ⟨_, rfl⟩ }
end

variables (A K L) [is_separable K L]
include L

/- If `L` is a finite separable extension of `K = Frac(A)`, where `A` is
integrally closed and Noetherian, the integral closure `C` of `A` in `L` is
Noetherian. -/
lemma is_integral_closure.is_noetherian_ring [is_integrally_closed A] [is_noetherian_ring A] :
  is_noetherian_ring C :=
begin
  haveI := classical.dec_eq L,
  obtain ⟨s, b, hb_int⟩ := finite_dimensional.exists_is_basis_integral A K L,
  rw is_noetherian_ring_iff,
  let b' := (trace_form K L).dual_basis (trace_form_nondegenerate K L) b,
  letI := is_noetherian_span_of_finite A (set.finite_range b'),
  let f : C →ₗ[A] submodule.span A (set.range b') :=
    (submodule.of_le (is_integral_closure.range_le_span_dual_basis C b hb_int)).comp
    ((algebra.linear_map C L).restrict_scalars A).range_restrict,
  refine is_noetherian_of_tower A (is_noetherian_of_ker_bot f _),
  rw [linear_map.ker_comp, submodule.ker_of_le, submodule.comap_bot, linear_map.ker_cod_restrict],
  exact linear_map.ker_eq_bot_of_injective (is_integral_closure.algebra_map_injective C A L)
end

variables {A K}

/- If `L` is a finite separable extension of `K = Frac(A)`, where `A` is
integrally closed and Noetherian, the integral closure of `A` in `L` is
Noetherian. -/
lemma integral_closure.is_noetherian_ring [is_integrally_closed A] [is_noetherian_ring A] :
  is_noetherian_ring (integral_closure A L) :=
is_integral_closure.is_noetherian_ring A K L (integral_closure A L)

variables (A K) [is_domain C]
/- If `L` is a finite separable extension of `K = Frac(A)`, where `A` is a Dedekind domain,
the integral closure `C` of `A` in `L` is a Dedekind domain.

Can't be an instance since `A`, `K` or `L` can't be inferred. See also the instance
`integral_closure.is_dedekind_domain_fraction_ring` where `K := fraction_ring A`
and `C := integral_closure A L`.
-/
lemma is_integral_closure.is_dedekind_domain [h : is_dedekind_domain A] :
  is_dedekind_domain C :=
begin
  haveI : is_fraction_ring C L := is_integral_closure.is_fraction_ring_of_finite_extension A K L C,
  exact
  ⟨is_integral_closure.is_noetherian_ring A K L C,
   h.dimension_le_one.is_integral_closure _ L _,
   (is_integrally_closed_iff L).mpr (λ x hx, ⟨is_integral_closure.mk' C x
      (is_integral_trans (is_integral_closure.is_integral_algebra A L) _ hx),
    is_integral_closure.algebra_map_mk' _ _ _⟩)⟩
end

/- If `L` is a finite separable extension of `K = Frac(A)`, where `A` is a Dedekind domain,
the integral closure of `A` in `L` is a Dedekind domain.

Can't be an instance since `K` can't be inferred. See also the instance
`integral_closure.is_dedekind_domain_fraction_ring` where `K := fraction_ring A`.
-/
lemma integral_closure.is_dedekind_domain [h : is_dedekind_domain A] :
  is_dedekind_domain (integral_closure A L) :=
is_integral_closure.is_dedekind_domain A K L (integral_closure A L)

omit K

variables [algebra (fraction_ring A) L] [is_scalar_tower A (fraction_ring A) L]
variables [finite_dimensional (fraction_ring A) L] [is_separable (fraction_ring A) L]

/- If `L` is a finite separable extension of `Frac(A)`, where `A` is a Dedekind domain,
the integral closure of `A` in `L` is a Dedekind domain.

See also the lemma `integral_closure.is_dedekind_domain` where you can choose
the field of fractions yourself.
-/
instance integral_closure.is_dedekind_domain_fraction_ring
  [is_dedekind_domain A] : is_dedekind_domain (integral_closure A L) :=
integral_closure.is_dedekind_domain A (fraction_ring A) L

end is_integral_closure

section is_dedekind_domain

variables {T : Type*} [comm_ring T] [is_domain T] [is_dedekind_domain T] (I J : ideal T)
open_locale classical
open multiset unique_factorization_monoid ideal

lemma prod_normalized_factors_eq_self {I : ideal T} (hI : I ≠ ⊥) :
  (normalized_factors I).prod = I :=
associated_iff_eq.1 (normalized_factors_prod hI)

lemma normalized_factors_prod {α : multiset (ideal T)}
  (h : ∀ p ∈ α, prime p) : normalized_factors α.prod = α :=
by { simp_rw [← multiset.rel_eq, ← associated_eq_eq],
     exact prime_factors_unique (prime_of_normalized_factor) h
      (normalized_factors_prod (α.prod_ne_zero_of_prime h)) }

lemma count_le_of_ideal_ge {I J : ideal T} (h : I ≤ J) (hI : I ≠ ⊥) (K : ideal T) :
  count K (normalized_factors J) ≤ count K (normalized_factors I) :=
le_iff_count.1 ((dvd_iff_normalized_factors_le_normalized_factors (ne_bot_of_le_ne_bot hI h) hI).1
  (dvd_iff_le.2 h)) _

lemma sup_eq_prod_inf_factors (hI : I ≠ ⊥) (hJ : J ≠ ⊥) :
  I ⊔ J = (normalized_factors I ∩ normalized_factors J).prod :=
begin
  have H : normalized_factors (normalized_factors I ∩ normalized_factors J).prod =
    normalized_factors I ∩ normalized_factors J,
  { apply _root_.normalized_factors_prod,
    intros p hp,
    rw mem_inter at hp,
    exact prime_of_normalized_factor p hp.left },
  have := (multiset.prod_ne_zero_of_prime (normalized_factors I ∩ normalized_factors J)
      (λ _ h, prime_of_normalized_factor _ (multiset.mem_inter.1 h).1)),
  apply le_antisymm,
  { rw [sup_le_iff, ← dvd_iff_le, ← dvd_iff_le],
    split,
    { rw [dvd_iff_normalized_factors_le_normalized_factors this hI, H],
      exact inf_le_left },
    { rw [dvd_iff_normalized_factors_le_normalized_factors this hJ, H],
      exact inf_le_right } },
  { rw [← dvd_iff_le, dvd_iff_normalized_factors_le_normalized_factors,
      _root_.normalized_factors_prod, le_iff_count],
    { intro a,
      rw multiset.count_inter,
      exact le_min (count_le_of_ideal_ge le_sup_left hI a)
        (count_le_of_ideal_ge le_sup_right hJ a) },
    { intros p hp,
      rw mem_inter at hp,
      exact prime_of_normalized_factor p hp.left },
    { exact ne_bot_of_le_ne_bot hI le_sup_left },
    { exact this } },
end

end is_dedekind_domain


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import init.meta.tactic init.meta.format init.function

/-- This is a kind attached to an argument of a congruence lemma that tells the simplifier how to fill it in.
- `fixed`: It is a parameter for the congruence lemma, the parameter occurs in the left and right hand sides.
  For example the α in the congruence generated from `f: Π {α : Type} α → α`.
- `fixed_no_param`: It is not a parameter for the congruence lemma, the lemma was specialized for this parameter.
  This only happens if the parameter is a subsingleton/proposition, and other parameters depend on it.
- `eq`: The lemma contains three parameters for this kind of argument `a_i`, `b_i` and `(eq_i : a_i = b_i)`.
  `a_i` and `b_i` represent the left and right hand sides, and `eq_i` is a proof for their equality.
  For example the second argument in `f: Π {α : Type}, α → α`.
- `cast`: corresponds to arguments that are subsingletons/propositions.
  For example the `p` in the congruence generated from `f : Π (x y : ℕ) (p: x < y), ℕ`.
- `heq` The lemma contains three parameters for this kind of argument `a_i`, `b_i` and `(eq_i : a_i == b_i)`.
   `a_i` and `b_i` represent the left and right hand sides, and eq_i is a proof for their heterogeneous equality.
-/
inductive congr_arg_kind
| fixed | fixed_no_param | eq | cast | heq | subsingleton_inst

namespace congr_arg_kind
    def to_string : congr_arg_kind → string
    | fixed := "fixed" | fixed_no_param := "fixed_no_param" | eq := "eq" | cast := "cast" | heq := "heq" | subsingleton_inst := "subsingleton_inst"
    instance : has_repr congr_arg_kind := ⟨to_string⟩
    meta instance : has_to_format congr_arg_kind := ⟨λ x, to_string x⟩
end congr_arg_kind

/--
A congruence lemma is a proof that two terms are equal using a congruence proof generated by `mk_congr_lemma_simp` and friends.
See the docstring for `mk_congr_lemma_simp` and `congr_arg_kind` for more information.
The conclusion is prepended by a set of arguments. `arg_kinds` gives a suggestion of how that argument should be filled in using a simplifier.
  -/
meta structure congr_lemma :=
(type : expr)
(proof : expr)
(arg_kinds : list congr_arg_kind)

namespace tactic
/--
`mk_congr_lemma_simp f nargs md`
creates a congruence lemma for the simplifier for the given function argument `f`.
If `nargs` is not none, then it tries to create a lemma for an application of arity `nargs`.
If `nargs` is none then the number of arguments will be guessed from the type signature of `f`.

That is, given `f : Π {α β γ δ : Type}, α → β → γ → δ` and `nargs = some 6`, we get a congruence lemma:
``` lean
{ type := ∀ (α β γ δ : Type), ∀ (a₁ a₂ : α), a₁ = a₂ → ∀ (b₁ b₂ : β), b₁ = b₂ → f a₁ b₁ = f a₂ b₂
, proof := ...
, arg_kinds := [fixed, fixed, fixed, fixed, eq,eq]
}
```
See the docstrings for the cases of `congr_arg_kind` for more detail on how `arg_kinds` are chosen.
The system chooses the `arg_kinds` depending on what the other arguments depend on and whether the arguments have subsingleton types.

Note that the number of arguments that `proof` takes can be inferred from `arg_kinds`: `arg_kinds.sum (fixed,cast ↦ 1 | eq,heq ↦ 3 | fixed_no_param ↦ 0)`.

From `congr_lemma.cpp`:
> Create a congruence lemma that is useful for the simplifier.
> In this kind of lemma, if the i-th argument is a Cast argument, then the lemma
> contains an input a_i representing the i-th argument in the left-hand-side, and
> it appears with a cast (e.g., eq.drec ... a_i ...) in the right-hand-side.
> The idea is that the right-hand-side of this lemma "tells" the simplifier
> how the resulting term looks like.
-/
meta constant mk_congr_lemma_simp (f : expr) (nargs : option nat := none) (md := semireducible) : tactic congr_lemma

/-- Create a specialized theorem using (a prefix of) the arguments of the given application.

An example of usage can be found in `tests/lean/simp_subsingleton.lean`.
For more information on specialization see the comment in the method body for `get_specialization_prefix_size` in `src/library/fun_info.cpp`.
 -/
meta constant mk_specialized_congr_lemma_simp (h : expr) (md : transparency := semireducible) : tactic congr_lemma

/-- Similar to `mk_congr_lemma_simp`, this will make a `congr_lemma` object.
The difference is that for each `congr_arg_kind.cast` argument, two proof arguments are generated.

Consider some function `f : Π (x : ℕ) (p : x < 4), ℕ`.
- `mk_congr_simp` will produce a congruence lemma with type `∀ (x x_1 : ℕ) (e_1 : x = x_1) (p : x < 4), f x p = f x_1 _`.
- `mk_congr` will produce a congruence lemma with type `∀ (x x_1 : ℕ) (e_1 : x = x_1) (p : x < 4) (p_1 : x_1 < 4), f x p = f x_1 p_1`.

From `congr_lemma.cpp`:
> Create a congruence lemma for the congruence closure module.
> In this kind of lemma, if the i-th argument is a Cast argument, then the lemma
> contains two inputs a_i and b_i representing the i-th argument in the left-hand-side and
> right-hand-side.
> This lemma is based on the congruence lemma for the simplifier.
> It uses subsinglenton elimination to show that the congr-simp lemma right-hand-side
> is equal to the right-hand-side of this lemma.
 -/
meta constant mk_congr_lemma (h : expr) (nargs : option nat := none) (md := semireducible) : tactic congr_lemma
/-- Create a specialized theorem using (a prefix of) the arguments of the given application.

For more information on specialization see the comment in the method body for `get_specialization_prefix_size` in `src/library/fun_info.cpp`.
-/
meta constant mk_specialized_congr_lemma (h : expr) (md := semireducible) : tactic congr_lemma

/-- Make a congruence lemma using hetrogeneous equality `heq` instead of `eq`.
For example `mk_hcongr_lemma (f : Π (α : ℕ → Type) (n:ℕ) (b:α n), ℕ` )` will make

``` lean
{ type := ∀ α α', α = α' → ∀ n n', n = n' → ∀ (b : α n) (b' : α' n'), b == b' → f α n b == f α' n' b'
, proof := ...
, arg_kinds := [eq,eq,heq]
}
```

(Using merely `mk_congr_lemma` instead will produce `[fixed,fixed,eq]` instaed.)
-/
meta constant mk_hcongr_lemma (h : expr) (nargs : option nat := none) (md := semireducible) : tactic congr_lemma

end tactic


import number_theory.padics.padic_integers

--OUTPUT 1
theorem p_adic_units (p : ℕ) (x : ℕ) (h : coprime p x) : is_unit (x : ℤ_[p]) :=
begin
  have h1 : (x : ℤ_[p]) ≠ 0, from sorry,
  have h2 : (x : ℤ_[p]) ≠ 1, from sorry,
  have h3 : (x : ℤ_[p]) ≠ -1, from sorry,
  have h4 : (x : ℤ_[p]) ≠ p, from sorry,
  have h5 : (x : ℤ_[p]) ≠ -p, from sorry,
  have h6 : (x : ℤ_[p]) ≠ p + 1, from sorry,
  have h7 : (x : ℤ_[p]) ≠ p - 1, from sorry,
  have h8 : (x : ℤ_[p]) ≠ -p + 1, from sorry,
  have h9 : (x : ℤ_[p]) ≠ -p - 1, from sorry,
  have h10 : (x : ℤ_[p]) ≠ p + 2, from sorry,
  have h11 : (x : ℤ_[p]) ≠ p - 2, from sorry,
  have h12 : (x : ℤ_[p]) ≠ -p + 2, from sorry,
  have h13 : (x : ℤ_[p]) ≠ -p - 2, from sorry,
  have h14 : (x : ℤ_[p]) ≠ p + 3, from sorry,
  have h15 : (x : ℤ_[p]) ≠ p - 3, from sorry,
  have h16 : (x : ℤ_[p]) ≠ -p + 3, from sorry,
  have h17 : (x : ℤ_[p]) ≠ -p - 3, from sorry,
  have h18 : (x : ℤ_[p]) ≠ p + 4, from sorry,
  have h19 : (x : ℤ_[p]) ≠ p - 4, from sorry,
  have h20 : (x : ℤ_[p]) ≠ -p + 4, from sorry,
  have h21 : (x : ℤ_[p]) ≠ -p - 4, from sorry,
  have h22 : (x : ℤ_[p]) ≠ p + 5, from sorry,
  have h23 : (x : ℤ_[p]) ≠ p - 5, from sorry,
  have h24 : (x : ℤ_[p]) ≠ -p + 5, from sorry,
  have h25 : (x : ℤ_[p]) ≠ -p - 5, from sorry,
  have h26 : (x : ℤ_[p]) ≠ p + 6, from sorry,
  have h27 : (x : ℤ_[p]) ≠ p - 6, from sorry,
  have h28 : (x : ℤ_[p]) ≠ -p + 6, from sorry,
  have h29 : (x : ℤ_[p]) ≠ -p - 6, from sorry,
  have h30 : (x : ℤ_[p]) ≠ p + 7, from sorry,
  have h31 : (x : ℤ_[p]) ≠ p - 7, from sorry,
  have h32 : (x : ℤ_[p]) ≠ -p + 7, from sorry,
  have h33 : (x : ℤ_[p]) ≠ -p - 7, from sorry,
  have h34 : (x : ℤ_[p]) ≠ p + 8, from sorry,
  have h35 : (x : ℤ_[p]) ≠ p - 8, from sorry,
  have h36 : (x : ℤ_[p]) ≠ -p + 8, from sorry,
  have h37 : (x : ℤ_[p]) ≠ -p - 8, from sorry,
  have h38 : (x : ℤ_[p]) ≠ p + 9, from sorry,
  have h39 : (x : ℤ_[p]) ≠ p - 9, from sorry,
  have h40 : (x : ℤ_[p]) ≠ -p + 9, from sorry,
  have h41 : (x : ℤ_[p]) ≠ -p - 9, from sorry,
  have h42 : (x : ℤ_[p]) ≠ p + 10, from sorry,
  have h43 : (x : ℤ_[p]) ≠ p - 10, from sorry,
  have h44 : (x : ℤ_[p]) ≠ -p + 10, from sorry,
  have h45 : (x : ℤ_[p]) ≠ -p - 10, from sorry,
  have h46 : (x : ℤ_[p]) ≠ p + 11, from sorry,
  have h47 : (x : ℤ_[p]) ≠ p - 11, from sorry,
  have h48 : (x : ℤ_[p]) ≠ -p + 11, from sorry,
  have h49 : (x : ℤ_[p]) ≠ -p - 11, from sorry,
  have h50 : (x : ℤ_[p]) ≠ p + 12, from sorry,
  have h51 : (x : ℤ_[p]) ≠ p - 12, from sorry,
  have h52 : (x : ℤ_[p]) ≠ -p + 12, from sorry,
  have h53 : (x : ℤ_[p]) ≠ -p - 12, from sorry,
  have h54 : (x : ℤ_[p]) ≠ p + 13, from sorry,
  have h55 : (x : ℤ_[p]) ≠ p - 13, from sorry,
  have h56 : (x : ℤ_[p]) ≠ -p + 13, from sorry,
  have h57 : (x : ℤ_[p]) ≠ -p - 13, from sorry,
  have h58 : (x : ℤ_[p]) ≠ p + 14, from sorry,
  have h59 : (x : ℤ_[p]) ≠ p - 14, from sorry,
  have h60 : (x : ℤ_[p]) ≠ -p + 14, from sorry,
  have h61 : (x : ℤ_[p]) ≠ -p - 14, from sorry,
  have h62 : (x : ℤ_[p]) ≠ p + 15, from sorry,
  have h63 : (x : ℤ_[p]) ≠ p - 15, from sorry,
  have h64 : (x : ℤ_[p]) ≠ -p + 15, from sorry,
  have h65 : (x : ℤ_[p]) ≠ -p - 15, from sorry,
  have h66 : (x : ℤ_[p]) ≠ p + 16, from sorry,
  have h67 : (x : ℤ_[p]) ≠ p - 16, from sorry,
  have h68 : (x : ℤ_[p]) ≠ -p + 16, from sorry,
  have h69 : (x : ℤ_[p]) ≠ -p - 16, from sorry,
  have h70 : (x : ℤ_[p]) ≠ p + 17, from sorry,
  have h71 : (x : ℤ_[p]) ≠ p - 17, from sorry,
  have h72 : (x : ℤ_[p]) ≠ -p + 17, from sorry,
  have h73 : (x : ℤ_[p]) ≠ -p - 17, from sorry,
  have h74 : (x : ℤ_[p]) ≠ p + 18, from sorry,
  have h75 : (x : ℤ_[p]) ≠ p - 18, from sorry,
  have h76 : (x : ℤ_[p]) ≠ -p + 18, from sorry,
  have h77 : (x : ℤ_[p]) ≠ -p - 18, from sorry,

end --Needs more than 2000 tokens!

--OUTPUT 2
theorem p_adic_units (p : ℕ) (x : ℕ) (h : coprime p x) : is_unit (p_adic_int p x) :=
begin
  sorry,
end

--OUTPUT 3
theorem p_adic_units (p : ℕ) (x : ℕ) (h : coprime p x) : is_unit (x : ℤ_[p]) :=
begin
  sorry,
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
p-adic units
Given a prime number $p$ and a natural number $x$, if $x$ is coprime to $p$, then $x$ is a unit in the $p$-adic integers.
`proof`
Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$. Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
But this must imply that $p | x$.
This completes our proof.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.monoidal.discrete
import Mathlib.category_theory.monoidal.unitors
import Mathlib.category_theory.limits.shapes.terminal
import Mathlib.algebra.punit_instances
import Mathlib.PostPort

universes v₁ u₁ l u₂ v₂ u_1 u_2

namespace Mathlib

/-!
# The category of monoids in a monoidal category.
-/

/--
A monoid object internal to a monoidal category.

When the monoidal category is preadditive, this is also sometimes called an "algebra object".
-/
structure Mon_ (C : Type u₁) [category_theory.category C] [category_theory.monoidal_category C]
    where
  X : C
  one : 𝟙_ ⟶ X
  mul : X ⊗ X ⟶ X
  one_mul' :
    autoParam ((one ⊗ 𝟙) ≫ mul = category_theory.iso.hom λ_)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  mul_one' :
    autoParam ((𝟙 ⊗ one) ≫ mul = category_theory.iso.hom ρ_)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  mul_assoc' :
    autoParam ((mul ⊗ 𝟙) ≫ mul = category_theory.iso.hom α_ ≫ (𝟙 ⊗ mul) ≫ mul)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

-- Obviously there is some flexibility stating this axiom.

-- This one has left- and right-hand sides matching the statement of `monoid.mul_assoc`,

-- and chooses to place the associator on the right-hand side.

-- The heuristic is that unitors and associators "don't have much weight".

theorem Mon_.one_mul {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] (c : Mon_ C) :
    (Mon_.one c ⊗ 𝟙) ≫ Mon_.mul c = category_theory.iso.hom λ_ :=
  sorry

theorem Mon_.mul_one {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] (c : Mon_ C) :
    (𝟙 ⊗ Mon_.one c) ≫ Mon_.mul c = category_theory.iso.hom ρ_ :=
  sorry

@[simp] theorem Mon_.mul_assoc {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] (c : Mon_ C) :
    (Mon_.mul c ⊗ 𝟙) ≫ Mon_.mul c = category_theory.iso.hom α_ ≫ (𝟙 ⊗ Mon_.mul c) ≫ Mon_.mul c :=
  sorry

theorem Mon_.one_mul_assoc {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] (c : Mon_ C) {X' : C} (f' : Mon_.X c ⟶ X') :
    (Mon_.one c ⊗ 𝟙) ≫ Mon_.mul c ≫ f' = category_theory.iso.hom λ_ ≫ f' :=
  sorry

@[simp] theorem Mon_.mul_assoc_assoc {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] (c : Mon_ C) {X' : C} (f' : Mon_.X c ⟶ X') :
    (Mon_.mul c ⊗ 𝟙) ≫ Mon_.mul c ≫ f' =
        category_theory.iso.hom α_ ≫ (𝟙 ⊗ Mon_.mul c) ≫ Mon_.mul c ≫ f' :=
  sorry

namespace Mon_

/--
The trivial monoid object. We later show this is initial in `Mon_ C`.
-/
@[simp] theorem trivial_one (C : Type u₁) [category_theory.category C]
    [category_theory.monoidal_category C] : one (trivial C) = 𝟙 :=
  Eq.refl (one (trivial C))

protected instance inhabited (C : Type u₁) [category_theory.category C]
    [category_theory.monoidal_category C] : Inhabited (Mon_ C) :=
  { default := trivial C }

@[simp] theorem one_mul_hom {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] {M : Mon_ C} {Z : C} (f : Z ⟶ X M) :
    (one M ⊗ f) ≫ mul M = category_theory.iso.hom λ_ ≫ f :=
  sorry

@[simp] theorem mul_one_hom {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] {M : Mon_ C} {Z : C} (f : Z ⟶ X M) :
    (f ⊗ one M) ≫ mul M = category_theory.iso.hom ρ_ ≫ f :=
  sorry

theorem assoc_flip {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C]
    {M : Mon_ C} : (𝟙 ⊗ mul M) ≫ mul M = category_theory.iso.inv α_ ≫ (mul M ⊗ 𝟙) ≫ mul M :=
  sorry

/-- A morphism of monoid objects. -/
structure hom {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C]
    (M : Mon_ C) (N : Mon_ C)
    where
  hom : X M ⟶ X N
  one_hom' :
    autoParam (one M ≫ hom = one N)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  mul_hom' :
    autoParam (mul M ≫ hom = (hom ⊗ hom) ≫ mul N)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem hom.one_hom {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] {M : Mon_ C} {N : Mon_ C} (c : hom M N) :
    one M ≫ hom.hom c = one N :=
  sorry

@[simp] theorem hom.mul_hom {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] {M : Mon_ C} {N : Mon_ C} (c : hom M N) :
    mul M ≫ hom.hom c = (hom.hom c ⊗ hom.hom c) ≫ mul N :=
  sorry

@[simp] theorem hom.mul_hom_assoc {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] {M : Mon_ C} {N : Mon_ C} (c : hom M N) {X' : C}
    (f' : X N ⟶ X') : mul M ≫ hom.hom c ≫ f' = (hom.hom c ⊗ hom.hom c) ≫ mul N ≫ f' :=
  sorry

/-- The identity morphism on a monoid object. -/
def id {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C]
    (M : Mon_ C) : hom M M :=
  hom.mk 𝟙

protected instance hom_inhabited {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] (M : Mon_ C) : Inhabited (hom M M) :=
  { default := id M }

/-- Composition of morphisms of monoid objects. -/
@[simp] theorem comp_hom {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] {M : Mon_ C} {N : Mon_ C} {O : Mon_ C} (f : hom M N)
    (g : hom N O) : hom.hom (comp f g) = hom.hom f ≫ hom.hom g :=
  Eq.refl (hom.hom (comp f g))

protected instance category_theory.category {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] : category_theory.category (Mon_ C) :=
  category_theory.category.mk

@[simp] theorem id_hom' {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] (M : Mon_ C) : hom.hom 𝟙 = 𝟙 :=
  rfl

@[simp] theorem comp_hom' {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] {M : Mon_ C} {N : Mon_ C} {K : Mon_ C} (f : M ⟶ N)
    (g : N ⟶ K) : hom.hom (f ≫ g) = hom.hom f ≫ hom.hom g :=
  rfl

/-- The forgetful functor from monoid objects to the ambient category. -/
@[simp] theorem forget_map (C : Type u₁) [category_theory.category C]
    [category_theory.monoidal_category C] (A : Mon_ C) (B : Mon_ C) (f : A ⟶ B) :
    category_theory.functor.map (forget C) f = hom.hom f :=
  Eq.refl (category_theory.functor.map (forget C) f)

protected instance forget_faithful {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] : category_theory.faithful (forget C) :=
  category_theory.faithful.mk

protected instance category_theory.has_hom.hom.hom.category_theory.is_iso {C : Type u₁}
    [category_theory.category C] [category_theory.monoidal_category C] {A : Mon_ C} {B : Mon_ C}
    (f : A ⟶ B) [e : category_theory.is_iso (category_theory.functor.map (forget C) f)] :
    category_theory.is_iso (hom.hom f) :=
  e

/-- The forgetful functor from monoid objects to the ambient category reflects isomorphisms. -/
protected instance forget.category_theory.reflects_isomorphisms {C : Type u₁}
    [category_theory.category C] [category_theory.monoidal_category C] :
    category_theory.reflects_isomorphisms (forget C) :=
  category_theory.reflects_isomorphisms.mk
    fun (X Y : Mon_ C) (f : X ⟶ Y)
      (e : category_theory.is_iso (category_theory.functor.map (forget C) f)) =>
      category_theory.is_iso.mk (hom.mk (inv (hom.hom f)))

protected instance unique_hom_from_trivial {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] (A : Mon_ C) : unique (trivial C ⟶ A) :=
  unique.mk { default := hom.mk (one A) } sorry

protected instance category_theory.limits.has_initial {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] : category_theory.limits.has_initial (Mon_ C) :=
  category_theory.limits.has_initial_of_unique (trivial C)

end Mon_

namespace category_theory.lax_monoidal_functor

/--
A lax monoidal functor takes monoid objects to monoid objects.

That is, a lax monoidal functor `F : C ⥤ D` induces a functor `Mon_ C ⥤ Mon_ D`.
-/
-- TODO: map_Mod F A : Mod A ⥤ Mod (F.map_Mon A)

@[simp] theorem map_Mon_obj_X {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂}
    [category D] [monoidal_category D] (F : lax_monoidal_functor C D) (A : Mon_ C) :
    Mon_.X (functor.obj (map_Mon F) A) = functor.obj (to_functor F) (Mon_.X A) :=
  Eq.refl (Mon_.X (functor.obj (map_Mon F) A))

/-- `map_Mon` is functorial in the lax monoidal functor. -/
def map_Mon_functor (C : Type u₁) [category C] [monoidal_category C] (D : Type u₂) [category D]
    [monoidal_category D] : lax_monoidal_functor C D ⥤ Mon_ C ⥤ Mon_ D :=
  functor.mk map_Mon
    fun (F G : lax_monoidal_functor C D) (α : F ⟶ G) =>
      nat_trans.mk
        fun (A : Mon_ C) =>
          Mon_.hom.mk (nat_trans.app (monoidal_nat_trans.to_nat_trans α) (Mon_.X A))

end category_theory.lax_monoidal_functor

namespace Mon_

namespace equiv_lax_monoidal_functor_punit

/-- Implementation of `Mon_.equiv_lax_monoidal_functor_punit`. -/
def lax_monoidal_to_Mon (C : Type u₁) [category_theory.category C]
    [category_theory.monoidal_category C] :
    category_theory.lax_monoidal_functor (category_theory.discrete PUnit) C ⥤ Mon_ C :=
  category_theory.functor.mk
    (fun (F : category_theory.lax_monoidal_functor (category_theory.discrete PUnit) C) =>
      category_theory.functor.obj (category_theory.lax_monoidal_functor.map_Mon F)
        (trivial (category_theory.discrete PUnit)))
    fun (F G : category_theory.lax_monoidal_functor (category_theory.discrete PUnit) C)
      (α : F ⟶ G) =>
      category_theory.nat_trans.app
        (category_theory.functor.map
          (category_theory.lax_monoidal_functor.map_Mon_functor (category_theory.discrete PUnit) C)
          α)
        (trivial (category_theory.discrete PUnit))

/-- Implementation of `Mon_.equiv_lax_monoidal_functor_punit`. -/
def Mon_to_lax_monoidal (C : Type u₁) [category_theory.category C]
    [category_theory.monoidal_category C] :
    Mon_ C ⥤ category_theory.lax_monoidal_functor (category_theory.discrete PUnit) C :=
  category_theory.functor.mk
    (fun (A : Mon_ C) =>
      category_theory.lax_monoidal_functor.mk
        (category_theory.functor.mk (fun (_x : category_theory.discrete PUnit) => X A)
          fun (_x _x_1 : category_theory.discrete PUnit) (_x : _x ⟶ _x_1) => 𝟙)
        (one A) fun (_x _x : category_theory.discrete PUnit) => mul A)
    fun (A B : Mon_ C) (f : A ⟶ B) =>
      category_theory.monoidal_nat_trans.mk
        (category_theory.nat_trans.mk fun (_x : category_theory.discrete PUnit) => hom.hom f)

/-- Implementation of `Mon_.equiv_lax_monoidal_functor_punit`. -/
@[simp] theorem unit_iso_inv_app_to_nat_trans_app (C : Type u₁) [category_theory.category C]
    [category_theory.monoidal_category C]
    (X : category_theory.lax_monoidal_functor (category_theory.discrete PUnit) C) :
    ∀ (X_1 : category_theory.discrete PUnit),
        category_theory.nat_trans.app
            (category_theory.monoidal_nat_trans.to_nat_trans
              (category_theory.nat_trans.app (category_theory.iso.inv (unit_iso C)) X))
            X_1 =
          inv
            (category_theory.eq_to_hom
              (congr_arg
                (category_theory.functor.obj (category_theory.lax_monoidal_functor.to_functor X))
                (unit_iso._proof_1 X_1))) :=
  sorry

/-- Implementation of `Mon_.equiv_lax_monoidal_functor_punit`. -/
@[simp] theorem counit_iso_inv_app_hom (C : Type u₁) [category_theory.category C]
    [category_theory.monoidal_category C] (X : Mon_ C) :
    hom.hom (category_theory.nat_trans.app (category_theory.iso.inv (counit_iso C)) X) = 𝟙 :=
  Eq.refl 𝟙

end equiv_lax_monoidal_functor_punit

/--
Monoid objects in `C` are "just" lax monoidal functors from the trivial monoidal category to `C`.
-/
def equiv_lax_monoidal_functor_punit (C : Type u₁) [category_theory.category C]
    [category_theory.monoidal_category C] :
    category_theory.lax_monoidal_functor (category_theory.discrete PUnit) C ≌ Mon_ C :=
  category_theory.equivalence.mk' sorry sorry sorry sorry

end Mathlib


import analysis.calculus.cont_diff
import topology.continuous_function.bounded
import analysis.seminorm
import ..seminorm
import ..bases

.

open set filter function
open_locale bounded_continuous_function topological_space nnreal

section prelim

lemma nhds_finset_inf {ι α : Type*} {t : ι → topological_space α} {s : finset ι} {x : α} :
  @nhds α (s.inf t) x = s.inf (λ i, @nhds α (t i) x) :=
begin
  rw [s.inf_eq_infi, s.inf_eq_infi, nhds_infi],
  refine infi_congr (λ i, _),
  rw nhds_infi
end

lemma infi_binfi_le {ι α : Type*} [partial_order ι] [complete_lattice α] {f : ι → α} :
  (⨅ i (j ≤ i), f j) = (⨅ i, f i) :=
le_antisymm (le_infi $ λ i, infi_le_of_le i $ binfi_le' i le_rfl) (le_infi $ λ i, le_infi₂ $ λ j hj, infi_le f j)

lemma binfi_le_binfi_le {ι α : Type*} [partial_order ι] [complete_lattice α] {f : ι → α} {n : ι} :
  (⨅ (i ≤ n) (j ≤ i), f j) = (⨅ (i ≤ n), f i) :=
le_antisymm
  (le_infi₂ $ λ i hi, infi_le_of_le i $ infi_le_of_le hi $ binfi_le' i le_rfl)
  (le_infi₂ $ λ i hi, le_infi₂ $ λ j hj, binfi_le' j $ hj.trans hi)

noncomputable def _root_.continuous_linear_equiv.comp_left_continuous_bounded {𝕜 : Type*}
  (α : Type*) {β γ : Type*} [topological_space α] [nondiscrete_normed_field 𝕜]
  {_ : normed_group β} {_ : normed_group γ} [normed_space 𝕜 β] [normed_space 𝕜 γ] (g : β ≃L[𝕜] γ) :
  (α →ᵇ β) ≃L[𝕜] (α →ᵇ γ) :=
continuous_linear_equiv.equiv_of_inverse
  (g.to_continuous_linear_map.comp_left_continuous_bounded α)
  (g.symm.to_continuous_linear_map.comp_left_continuous_bounded α)
  (begin
    intros f,
    ext x,
    simp_rw [continuous_linear_equiv.coe_def_rev,
              continuous_linear_map.comp_left_continuous_bounded_apply,
              continuous_linear_equiv.coe_coe, continuous_linear_equiv.symm_apply_apply],
  end)
  (begin
    intros f,
    ext x,
    simp_rw [continuous_linear_equiv.coe_def_rev,
              continuous_linear_map.comp_left_continuous_bounded_apply,
              continuous_linear_equiv.coe_coe, continuous_linear_equiv.apply_symm_apply]
  end)

@[simp] lemma _root_.continuous_linear_equiv.comp_left_continuous_bounded_apply {𝕜 α β γ : Type*}
  [topological_space α] [nondiscrete_normed_field 𝕜] {_ : normed_group β} {_ : normed_group γ}
  [normed_space 𝕜 β] [normed_space 𝕜 γ] (g : β ≃L[𝕜] γ) (f : α →ᵇ β) (x : α) :
  (g.comp_left_continuous_bounded α f) x = g (f x) :=
rfl

lemma iterated_fderiv_add {𝕜 E F : Type*} [nondiscrete_normed_field 𝕜]
  [normed_group E] [normed_group F] [normed_space 𝕜 E] [normed_space 𝕜 F]
  {nf ng : with_top ℕ} {i : ℕ} {f g : E → F} (hf : cont_diff 𝕜 nf f)
  (hg : cont_diff 𝕜 ng g) (hif : (i : with_top ℕ) ≤ nf)
  (hig : (i : with_top ℕ) ≤ ng) :
iterated_fderiv 𝕜 i (f + g) = (iterated_fderiv 𝕜 i f) + (iterated_fderiv 𝕜 i g) :=
begin
  induction i with i hi,
  { ext x, simp },
  { ext x h,
    have hif' : (i : with_top ℕ) < nf :=
      lt_of_lt_of_le (with_top.coe_lt_coe.mpr $ nat.lt_succ_self _) hif,
    have hig' : (i : with_top ℕ) < ng :=
      lt_of_lt_of_le (with_top.coe_lt_coe.mpr $ nat.lt_succ_self _) hig,
    have hdf : differentiable 𝕜 (iterated_fderiv 𝕜 i f) :=
      (cont_diff_iff_continuous_differentiable.mp hf).2 i hif',
    have hdg : differentiable 𝕜 (iterated_fderiv 𝕜 i g) :=
      (cont_diff_iff_continuous_differentiable.mp hg).2 i hig',
    calc iterated_fderiv 𝕜 (i+1) (f + g) x h
        = fderiv 𝕜 (iterated_fderiv 𝕜 i (f + g)) x (h 0) (fin.tail h) : rfl
    ... = fderiv 𝕜 (iterated_fderiv 𝕜 i f + iterated_fderiv 𝕜 i g) x (h 0) (fin.tail h) :
            by rw hi hif'.le hig'.le
    ... = (fderiv 𝕜 (iterated_fderiv 𝕜 i f) + fderiv 𝕜 (iterated_fderiv 𝕜 i g))
              x (h 0) (fin.tail h) :
            by rw [pi.add_def, fderiv_add hdf.differentiable_at hdg.differentiable_at]; refl
    ... = (iterated_fderiv 𝕜 (i+1) f + iterated_fderiv 𝕜 (i+1) g) x h : rfl }
end

lemma iterated_fderiv_smul {𝕜 E F : Type*} [nondiscrete_normed_field 𝕜]
  [normed_group E] [normed_group F] [normed_space 𝕜 E] [normed_space 𝕜 F]
  {nf : with_top ℕ} {i : ℕ} {a : 𝕜} {f : E → F} (hf : cont_diff 𝕜 nf f)
  (hif : (i : with_top ℕ) ≤ nf) :
iterated_fderiv 𝕜 i (a • f) = a • (iterated_fderiv 𝕜 i f) :=
begin
  induction i with i hi,
  { ext, simp },
  { ext x h,
    have hif' : (i : with_top ℕ) < nf :=
      lt_of_lt_of_le (with_top.coe_lt_coe.mpr $ nat.lt_succ_self _) hif,
    have hdf : differentiable 𝕜 (iterated_fderiv 𝕜 i f) :=
      (cont_diff_iff_continuous_differentiable.mp hf).2 i hif',
    calc iterated_fderiv 𝕜 (i+1) (a • f) x h
        = fderiv 𝕜 (iterated_fderiv 𝕜 i (a • f)) x (h 0) (fin.tail h) : rfl
    ... = fderiv 𝕜 (a • iterated_fderiv 𝕜 i f) x (h 0) (fin.tail h) :
            by rw hi hif'.le
    ... = (a • fderiv 𝕜 (iterated_fderiv 𝕜 i f)) x (h 0) (fin.tail h) :
            by rw [pi.smul_def, fderiv_const_smul hdf.differentiable_at]; refl
    ... = (a • iterated_fderiv 𝕜 (i+1) f) x h : rfl }
end

lemma iterated_fderiv_neg {𝕜 E F : Type*} [nondiscrete_normed_field 𝕜]
  [normed_group E] [normed_group F] [normed_space 𝕜 E] [normed_space 𝕜 F]
  {nf : with_top ℕ} {i : ℕ} {f : E → F} (hf : cont_diff 𝕜 nf f)
  (hif : (i : with_top ℕ) ≤ nf) :
iterated_fderiv 𝕜 i (-f) = -(iterated_fderiv 𝕜 i f) :=
calc iterated_fderiv 𝕜 i (-f)
    = iterated_fderiv 𝕜 i ((-1 : 𝕜) • f) : by rw [neg_one_smul]
... = (-1 : 𝕜) • iterated_fderiv 𝕜 i f : iterated_fderiv_smul hf hif
... = -(iterated_fderiv 𝕜 i f) : by ext; exact neg_one_smul _ _

end prelim

private def bounded_cont_diff_map_submodule (𝕜 E F : Type*) [nondiscrete_normed_field 𝕜]
  [normed_group E] [normed_group F] [normed_space 𝕜 E] [normed_space 𝕜 F]
  (n : with_top ℕ) : submodule 𝕜 (E → F) :=
{ carrier := {f | cont_diff 𝕜 n f ∧ ∀ (i : ℕ), ↑i ≤ n →
                  ∃ C, ∀ x, ∥iterated_fderiv 𝕜 i f x∥ ≤ C },
  zero_mem' := ⟨cont_diff_zero_fun, λ i hi, ⟨0, λ x,
    by rw [pi.zero_def, iterated_fderiv_within_zero_fun, pi.zero_apply, norm_zero]⟩⟩,
  add_mem' := λ f g hf hg, ⟨hf.1.add hg.1, λ i hi,
    let ⟨Cf, hCf⟩ := hf.2 i hi, ⟨Cg, hCg⟩ := hg.2 i hi in ⟨Cf + Cg, λ x,
    by {rw [iterated_fderiv_add hf.1 hg.1 hi hi], exact norm_add_le_of_le (hCf x) (hCg x)}⟩⟩,
  smul_mem' := λ c f hf, ⟨cont_diff_const.smul hf.1, λ i hi,
    let ⟨C, hC⟩ := hf.2 i hi in ⟨∥c∥ * C, λ x,
    by {rw [iterated_fderiv_smul hf.1 hi, pi.smul_apply, norm_smul],
        exact mul_le_mul_of_nonneg_left (hC x) (norm_nonneg _) }⟩⟩ }

def bounded_cont_diff_map (𝕜 E F : Type*) [nondiscrete_normed_field 𝕜]
  [normed_group E] [normed_group F] [normed_space 𝕜 E] [normed_space 𝕜 F]
  (n : with_top ℕ) := ↥(bounded_cont_diff_map_submodule 𝕜 E F n)

localized "notation `B^`n`⟮`E`,`F`;`𝕜`⟯` := bounded_cont_diff_map 𝕜 E F n" in
  bounded_cont_diff_map

namespace bounded_cont_diff_map

section any_field

variables {𝕜 E F : Type*} [nondiscrete_normed_field 𝕜] [normed_group E] [normed_group F]
  [normed_space 𝕜 E] [normed_space 𝕜 F] {n : with_top ℕ} {f g : B^n⟮E, F; 𝕜⟯} {x : E}

instance : add_comm_group (B^n⟮E, F; 𝕜⟯) := submodule.add_comm_group _
instance : module 𝕜 (B^n⟮E, F; 𝕜⟯) := submodule.module _
instance : has_coe_to_fun (B^n⟮E, F; 𝕜⟯) (λ _, E → F) := ⟨λ f, f.1⟩

@[ext] lemma ext (H : ∀x, f x = g x) : f = g :=
by {ext, exact H x}

lemma bounded (f : B^n⟮E, F; 𝕜⟯) {i : ℕ} (hi : (i : with_top ℕ) ≤ n) :
  ∃ C, ∀ x, ∥iterated_fderiv 𝕜 i f x∥ ≤ C :=
f.2.2 i hi

lemma cont_diff (f : B^n⟮E, F; 𝕜⟯) :
  cont_diff 𝕜 n f :=
f.2.1

@[simp] lemma coe_zero : ((0 : B^n⟮E, F; 𝕜⟯) : E → F) = 0 := rfl
lemma zero_apply : (0 : B^n⟮E, F; 𝕜⟯) x = 0 := rfl

@[simp] lemma coe_add : ⇑(f + g) = f + g := rfl
lemma add_apply : (f + g) x = f x + g x := rfl

@[simp] lemma coe_smul {r : 𝕜} : ⇑(r • f) = r • f := rfl
lemma smul_apply {r : 𝕜} : (r • f) x = r • (f x) := rfl

@[simp] lemma coe_neg : ⇑(-f) = -f := rfl
lemma neg_apply : (-f) x = -f x := rfl

protected noncomputable def iterated_fderiv (i : ℕ)
  (f : B^n⟮E, F; 𝕜⟯) :
  E →ᵇ (E [×i]→L[𝕜] F) :=
if hi : (i : with_top ℕ) ≤ n then
{ to_fun := iterated_fderiv 𝕜 i f,
  continuous_to_fun :=
  begin
    have := f.cont_diff,
    rw cont_diff_iff_continuous_differentiable at this,
    exact this.1 i hi
  end,
  map_bounded' :=
  begin
    rcases f.bounded hi with ⟨C, hC⟩,
    use C + C,
    intros x y,
    simp [dist_eq_norm, norm_sub_le_of_le (hC x) (hC y)]
  end }
else 0

@[simp] protected lemma iterated_fderiv_apply_of_le {i : ℕ} (hi : (i : with_top ℕ) ≤ n)
  (f : B^n⟮E, F; 𝕜⟯) :
  f.iterated_fderiv i x = iterated_fderiv 𝕜 i f x :=
begin
  rw bounded_cont_diff_map.iterated_fderiv,
  split_ifs,
  refl
end

@[simp] protected lemma iterated_fderiv_apply_of_gt {i : ℕ} (hi : n < (i : with_top ℕ))
  (f : B^n⟮E, F; 𝕜⟯) :
  f.iterated_fderiv i x = 0 :=
begin
  rw lt_iff_not_ge' at hi,
  rw bounded_cont_diff_map.iterated_fderiv,
  split_ifs,
  { contradiction },
  { refl }
end

@[simp] protected lemma iterated_fderiv_add (i : ℕ) :
  (f + g).iterated_fderiv i = f.iterated_fderiv i + g.iterated_fderiv i :=
begin
  ext x : 1,
  by_cases hi : ↑i ≤ n,
  { rw [bounded_continuous_function.add_apply,
        bounded_cont_diff_map.iterated_fderiv_apply_of_le hi,
        bounded_cont_diff_map.iterated_fderiv_apply_of_le hi,
        bounded_cont_diff_map.iterated_fderiv_apply_of_le hi,
        bounded_cont_diff_map.coe_add,
        iterated_fderiv_add f.cont_diff g.cont_diff hi hi],
    refl },
  { rw ← lt_iff_not_ge' at hi,
    rw [bounded_continuous_function.add_apply,
        bounded_cont_diff_map.iterated_fderiv_apply_of_gt hi,
        bounded_cont_diff_map.iterated_fderiv_apply_of_gt hi,
        bounded_cont_diff_map.iterated_fderiv_apply_of_gt hi,
        add_zero] }
end

@[simp] protected lemma iterated_fderiv_smul (i : ℕ) {r : 𝕜} :
  (r • f).iterated_fderiv i = r • f.iterated_fderiv i :=
begin
  ext x : 1,
  by_cases hi : ↑i ≤ n,
  { rw [bounded_continuous_function.smul_apply,
        bounded_cont_diff_map.iterated_fderiv_apply_of_le hi,
        bounded_cont_diff_map.iterated_fderiv_apply_of_le hi,
        bounded_cont_diff_map.coe_smul,
        iterated_fderiv_smul f.cont_diff hi],
    refl },
  { rw ← lt_iff_not_ge' at hi,
    rw [bounded_continuous_function.smul_apply,
        bounded_cont_diff_map.iterated_fderiv_apply_of_gt hi,
        bounded_cont_diff_map.iterated_fderiv_apply_of_gt hi,
        smul_zero] }
end

lemma coe_apply_eq_iterated_fderiv_0 (f : B^n⟮E, F; 𝕜⟯) (x : E) :
  f x = f.iterated_fderiv 0 x fin_zero_elim :=
by rw [f.iterated_fderiv_apply_of_le (zero_le _), iterated_fderiv_zero_apply]

protected noncomputable def iterated_fderivₗ (i : ℕ) :
  B^n⟮E, F; 𝕜⟯ →ₗ[𝕜] (E →ᵇ (E [×i]→L[𝕜] F)) :=
{ to_fun := λ f, f.iterated_fderiv i,
  map_add' := λ f g, bounded_cont_diff_map.iterated_fderiv_add i,
  map_smul' :=λ r f, bounded_cont_diff_map.iterated_fderiv_smul i }

@[simp] protected lemma iterated_fderivₗ_apply {i : ℕ} (hi : (i : with_top ℕ) ≤ n)
  (f : B^n⟮E, F; 𝕜⟯) :
  bounded_cont_diff_map.iterated_fderivₗ i f = f.iterated_fderiv i := rfl

private noncomputable def tmp_topology₀ (i : ℕ) :
  topological_space (B^n⟮E, F; 𝕜⟯) :=
topological_space.induced (bounded_cont_diff_map.iterated_fderivₗ i) infer_instance

private noncomputable def tmp_uniform_space₀ (i : ℕ) :
  uniform_space (B^n⟮E, F; 𝕜⟯) :=
uniform_space.comap (bounded_cont_diff_map.iterated_fderivₗ i) infer_instance -- no defeq problem here

private noncomputable def tmp_topology₁ (i : ℕ) :
  topological_space (B^n⟮E, F; 𝕜⟯) :=
⨅ (hi : (i : with_top ℕ) ≤ n), tmp_topology₀ i

private noncomputable def tmp_uniform_space₁ (i : ℕ) :
  uniform_space (B^n⟮E, F; 𝕜⟯) :=
@uniform_space.replace_topology _ (tmp_topology₁ i)
  (⨅ (hi : (i : with_top ℕ) ≤ n), tmp_uniform_space₀ i)
  (by rw to_topological_space_infi; refl)

protected noncomputable def topology : topological_space (B^n⟮E, F; 𝕜⟯) :=
  ⨅ (i : ℕ) (hi : (i : with_top ℕ) ≤ n), (tmp_topology₀ i)

protected noncomputable def uniform_space : uniform_space (B^n⟮E, F; 𝕜⟯) :=
@uniform_space.replace_topology _ bounded_cont_diff_map.topology
  (⨅ (i : ℕ), (tmp_uniform_space₁ i)) (by rw [to_topological_space_infi]; refl )

protected lemma topology_eq_directed : (bounded_cont_diff_map.topology : topological_space (B^n⟮E, F; 𝕜⟯)) =
  ⨅ (i : ℕ) (hi : ↑i ≤ n) (j : ℕ) (hj : (j : with_top ℕ) ≤ ↑i), (tmp_topology₀ j) :=
le_antisymm
  (le_infi₂ $ λ i hi, le_infi₂ $ λ j hj, binfi_le' j $ hj.trans hi)
  (le_infi₂ $ λ i hi, infi_le_of_le i $ infi_le_of_le hi $ binfi_le' i le_rfl)

protected lemma topology_eq_directed' : (bounded_cont_diff_map.topology : topological_space (B^n⟮E, F; 𝕜⟯)) =
  ⨅ (i : ℕ) (hi : ↑i ≤ n), (finset.Icc 0 i).inf tmp_topology₀ :=
begin
  rw bounded_cont_diff_map.topology_eq_directed,
  refine infi_congr (λ i, infi_congr $ λ hi, _),
  rw finset.inf_eq_infi,
  refine infi_congr (λ j, infi_congr_Prop _ (λ _, rfl)),
  rw [finset.mem_Icc, with_top.coe_le_coe, iff_and_self],
  exact λ _, zero_le _
end

variables (𝕜 E F n)

abbreviation snorms_ind : Type* := {i : ℕ // ↑i ≤ n}

instance : has_zero (snorms_ind n) := ⟨⟨0, zero_le _⟩⟩
instance : inhabited (snorms_ind n) := ⟨0⟩
instance : lattice (snorms_ind n) := infer_instance

noncomputable def snorms :
  seminorm_family 𝕜 (B^n⟮E, F; 𝕜⟯) (snorms_ind n) :=
λ i, (finset.Icc 0 (i : ℕ)).sup (λ j, (norm_seminorm 𝕜 (E →ᵇ (E [×j]→L[𝕜] F))).comp
  (bounded_cont_diff_map.iterated_fderivₗ j))

variables {𝕜 E F n}

lemma snorms_monotone :
  monotone (snorms 𝕜 E F n) :=
λ i j hij, finset.sup_mono (finset.Icc_subset_Icc_right hij)

--protected lemma topology_eq_directed' : (bounded_cont_diff_map.topology : topological_space (B^n⟮E, F; 𝕜⟯)) =
--  ⨅ (i : ℕ) (hi : ↑i ≤ n), (finset.univ : finset (fin $ i+1)).inf (λ j, tmp_topology₀ j $ j.2.trans hi) :=
--le_antisymm
--  (le_infi₂ $ λ i hi, le_infi₂ $ λ j hj, binfi_le' j $ hj.trans hi)
--  (le_infi₂ $ λ i hi, infi_le_of_le i $ infi_le_of_le hi $ binfi_le' i le_rfl)

--protected def seminorm_family : seminorm_family 𝕜 (B^n⟮E, F; 𝕜⟯) {i : ℕ // ↑i ≤ n} :=
--  λ i, norm_seminorm 𝕜 (E → )

private lemma has_basis_zero₀ (i : ℕ) (hi : (i : with_top ℕ) ≤ n) :
  (@nhds B^n⟮E, F; 𝕜⟯ (tmp_topology₀ i) 0).has_basis (λ ε : ℝ, 0 < ε)
  (λ ε, bounded_cont_diff_map.iterated_fderiv i ⁻¹' metric.ball 0 ε) :=
begin
  rw nhds_induced,
  refine (has_basis.comap _ (metric.nhds_basis_ball)).to_has_basis _ _;
  rintros ε hε;
  refine ⟨ε, hε, _⟩;
  rw [linear_map.map_zero];
  refl
end

private lemma has_basis_zero₁ (i : ℕ) :
  (@nhds B^n⟮E, F; 𝕜⟯ (tmp_topology₁ i) 0).has_basis (λ ε : ℝ, 0 < ε)
  (λ ε, ⋂ (hi : ↑i ≤ n), bounded_cont_diff_map.iterated_fderiv i ⁻¹' metric.ball 0 ε) :=
begin
  rw [nhds_infi, has_basis_iff],
  by_cases hi : (i : with_top ℕ) ≤ n,
  { simp [hi, (has_basis_zero₀ i hi).mem_iff] },
  { have : ∃ ε : ℝ, 0 < ε := ⟨1, zero_lt_one⟩,
    intros t,
    simp [hi, univ_subset_iff, this] }
end

attribute [instance] bounded_cont_diff_map.topology
attribute [instance] bounded_cont_diff_map.uniform_space

instance : topological_add_group (B^n⟮E, F; 𝕜⟯) :=
topological_add_group_infi
  (λ i, topological_add_group_infi $ λ hi, topological_add_group_induced _)

instance with_seminorms : with_seminorms (bounded_cont_diff_map.snorms 𝕜 E F n) :=
begin
  rw [seminorm_family.with_seminorms_iff_nhds_eq_infi, bounded_cont_diff_map.topology_eq_directed'],
  simp_rw [nhds_infi, infi_subtype, nhds_finset_inf],
  refine infi_congr (λ i, infi_congr $ λ hi, _),
  rw [bounded_cont_diff_map.snorms, seminorm_family.nhds_0_comap_finset_sup, subtype.coe_mk],
  refine finset.inf_congr rfl (λ j hj, _),
  rw [nhds_induced, map_zero,
      (seminorm_family.with_seminorms_iff_nhds_eq_infi _).mp (norm_with_seminorms 𝕜 (E →ᵇ (E [×j]→L[𝕜] F))),
      infi_unique, comap_comap],
  refl
end

protected lemma has_basis_zero : (𝓝 0 : filter $ B^n⟮E, F; 𝕜⟯).has_basis
  (λ Nε : ℕ × ℝ, 0 < Nε.2) (λ Nε, ⋂ (i : ℕ) (hiN : i ≤ Nε.1) (hi : ↑i ≤ n),
    bounded_cont_diff_map.iterated_fderiv i ⁻¹' metric.ball 0 Nε.2) :=
begin
  rw nhds_infi,
  convert foo _ has_basis_zero₁,
  intros i ε δ h,
  exact Inter_mono (λ hi, preimage_mono $ metric.ball_subset_ball h)
end

protected noncomputable def iterated_fderivL (i : ℕ) :
  (B^n⟮E, F; 𝕜⟯) →L[𝕜] (E →ᵇ (E [×i]→L[𝕜] F)) :=
{ to_linear_map := bounded_cont_diff_map.iterated_fderivₗ i,
  cont :=
  begin
    by_cases hi : ↑i ≤ n,
    { exact continuous_infi_dom (@continuous_infi_dom _ _ _ _
        (λ _, tmp_topology₀ i) _ hi continuous_induced_dom) },
    { refine continuous_of_const (λ f g, _),
      ext x : 1,
      change f.iterated_fderiv i x = g.iterated_fderiv i x,
      rw ← lt_iff_not_ge at hi,
      rw [bounded_cont_diff_map.iterated_fderiv_apply_of_gt hi,
          bounded_cont_diff_map.iterated_fderiv_apply_of_gt hi] }
  end }

--continuous_infi_dom
--  (@continuous_infi_dom _ _ _ _ (λ _, tmp_topology₀ i) _ hi continuous_induced_dom)

@[simp] protected lemma iterated_fderivL_apply {i : ℕ}
  (f : B^n⟮E, F; 𝕜⟯) :
  bounded_cont_diff_map.iterated_fderivL i f = f.iterated_fderiv i := rfl

lemma continuous_iff {X : Type*} [topological_space X] (φ : X → B^n⟮E, F; 𝕜⟯) :
  continuous φ ↔ ∀ (i : ℕ) (hi : ↑i ≤ n), continuous
    ((bounded_cont_diff_map.iterated_fderiv i) ∘ φ) :=
⟨ λ hφ i hi, (bounded_cont_diff_map.iterated_fderivL i).continuous.comp hφ,
  λ h, continuous_infi_rng (λ i, continuous_infi_rng $ λ hi, continuous_induced_rng (h i hi)) ⟩

protected lemma continuous_of_commutes {𝕜' E' F' : Type*} [normed_group E'] [normed_group F']
  [nondiscrete_normed_field 𝕜'] [normed_space 𝕜' E'] [normed_space 𝕜' F']
  (φ : B^n⟮E, F; 𝕜⟯ → B^n⟮E', F'; 𝕜'⟯)
  (ψ : Π (i : ℕ), (E →ᵇ (E [×i]→L[𝕜] F)) → E' →ᵇ (E' [×i]→L[𝕜'] F'))
  (hcont : ∀ (i : ℕ) (hi : ↑i ≤ n), continuous $ ψ i)
  (hcomm : ∀ (i : ℕ) (hi : ↑i ≤ n),
    bounded_cont_diff_map.iterated_fderiv i ∘ φ = ψ i ∘ bounded_cont_diff_map.iterated_fderiv i) :
  continuous φ :=
begin
  rw continuous_iff,
  intros i hi,
  rw hcomm i hi,
  exact (hcont i hi).comp (bounded_cont_diff_map.iterated_fderivL i).continuous
end

instance : has_continuous_smul 𝕜 (B^n⟮E, F; 𝕜⟯) :=
has_continuous_smul_infi
  (λ i, has_continuous_smul_infi $ λ hi, has_continuous_smul_induced _)

variables (𝕜 E F n)

private noncomputable def to_bounded_continuous_function_aux :
  (B^n⟮E, F; 𝕜⟯) →L[𝕜] (E →ᵇ F) :=
((continuous_multilinear_curry_fin0 𝕜 E F).to_continuous_linear_equiv
  .comp_left_continuous_bounded E).to_continuous_linear_map ∘L
bounded_cont_diff_map.iterated_fderivL 0

private lemma to_bounded_continuous_function_aux_spec (f : B^n⟮E, F; 𝕜⟯) (x : E) :
  to_bounded_continuous_function_aux 𝕜 E F n f x = f x :=
begin
  change f.iterated_fderiv 0 x 0 = f x,
  rw bounded_cont_diff_map.iterated_fderiv_apply_of_le (zero_le _),
  refl
end

def to_bounded_continuous_function (f : B^n⟮E, F; 𝕜⟯) : E →ᵇ F :=
{ to_fun := f,
  map_bounded' :=
  begin
    rcases (to_bounded_continuous_function_aux 𝕜 E F n f).bounded with ⟨C, hC⟩,
    refine ⟨C, λ x y, _⟩,
    specialize hC x y,
    rw [to_bounded_continuous_function_aux_spec, to_bounded_continuous_function_aux_spec] at hC,
    exact hC
  end,
  continuous_to_fun :=
  begin
    convert (to_bounded_continuous_function_aux 𝕜 E F n f).continuous using 1,
    ext x,
    rw to_bounded_continuous_function_aux_spec
  end }

def to_bounded_continuous_functionₗ : (B^n⟮E, F; 𝕜⟯) →ₗ[𝕜] (E →ᵇ F) :=
{ to_fun := to_bounded_continuous_function 𝕜 E F n,
  map_add' := λ f g, rfl,
  map_smul' := λ a f, rfl }

noncomputable! def to_bounded_continuous_functionL :
  (B^n⟮E, F; 𝕜⟯) →L[𝕜] (E →ᵇ F) :=
{ to_linear_map := to_bounded_continuous_functionₗ 𝕜 E F n,
  cont :=
  begin
    convert (to_bounded_continuous_function_aux 𝕜 E F n).continuous using 1,
    ext f x,
    rw to_bounded_continuous_function_aux_spec,
    refl
  end }

lemma to_bounded_continuous_functionL_eq_iterated_fderivL_zero :
  bounded_cont_diff_map.to_bounded_continuous_functionL 𝕜 E F n =
  ((continuous_multilinear_curry_fin0 𝕜 E F).to_continuous_linear_equiv
    .comp_left_continuous_bounded E).to_continuous_linear_map ∘L
  bounded_cont_diff_map.iterated_fderivL 0 :=
begin
  ext f x,
  change f x = _,
  rw ← to_bounded_continuous_function_aux_spec,
  refl
end

lemma to_bounded_continuous_function_injective :
  injective (to_bounded_continuous_functionL 𝕜 E F n) :=
begin
  intros f g hfg,
  ext x,
  change to_bounded_continuous_functionL 𝕜 E F n f x = _,
  rw hfg,
  refl
end

variables {n}

protected def of_le {k : with_top ℕ} (hkn : k ≤ n) (f : B^n⟮E, F; 𝕜⟯) :
  B^k⟮E, F; 𝕜⟯ :=
⟨f, f.cont_diff.of_le hkn, λ i hi, f.bounded (hi.trans hkn)⟩

protected def of_leₗ {k : with_top ℕ} (hkn : k ≤ n) :
  B^n⟮E, F; 𝕜⟯ →ₗ[𝕜] B^k⟮E, F; 𝕜⟯ :=
{ to_fun := bounded_cont_diff_map.of_le 𝕜 E F hkn,
  map_add' := λ f g, by ext; refl,
  map_smul' := λ c f, by ext; refl }

protected lemma iterated_fderiv_of_le {k : with_top ℕ} (hkn : k ≤ n)
  {i : ℕ} (hi : ↑i ≤ k) (f : B^n⟮E, F; 𝕜⟯) :
  (f.of_le 𝕜 E F hkn).iterated_fderiv i = f.iterated_fderiv i :=
begin
  ext x,
  rw [bounded_cont_diff_map.iterated_fderiv_apply_of_le hi,
      bounded_cont_diff_map.iterated_fderiv_apply_of_le (hi.trans hkn)],
  refl
end

-- TODO : why do I need the `!` ?
protected noncomputable! def of_leL {k : with_top ℕ} (hkn : k ≤ n) :
  B^n⟮E, F; 𝕜⟯ →L[𝕜] B^k⟮E, F; 𝕜⟯ :=
{ to_linear_map := bounded_cont_diff_map.of_leₗ 𝕜 E F hkn,
  cont :=
  begin
    refine continuous_infi_rng (λ i, continuous_infi_rng $ λ hi, continuous_induced_rng _),
    convert (bounded_cont_diff_map.iterated_fderivL i).continuous using 1,
    ext f : 1,
    exact f.iterated_fderiv_of_le 𝕜 E F hkn hi
  end }

--protected lemma topology_eq_infi_induced_of_le :
--  bounded_cont_diff_map.topology = ⨅ (i : ℕ) (hi : ↑i ≤ n), bounded_cont_diff_map.topology.induced
--    (bounded_cont_diff_map.of_leL 𝕜 E F hi) :=
--begin
--  simp_rw [bounded_cont_diff_map.topology, induced_infi, tmp_topology₀],
--
--end

section zero

private lemma uniform_space_eq_comap : bounded_cont_diff_map.uniform_space =
  uniform_space.comap (to_bounded_continuous_functionL 𝕜 E F 0) infer_instance :=
begin
  suffices : (bounded_cont_diff_map.uniform_space : uniform_space $ B^0⟮E, F; 𝕜⟯) =
    uniform_space.comap (bounded_cont_diff_map.iterated_fderivₗ 0) infer_instance,
  { rw [this, to_bounded_continuous_functionL_eq_iterated_fderivL_zero,
        continuous_linear_map.coe_comp'],
    conv_rhs {rw [uniform_space.comap_comap]},
    refine congr_arg _ _,
    ext s,
    change s ∈ uniformity _ ↔ s ∈  uniformity _,
    rw ← ((continuous_multilinear_curry_fin0 𝕜 E F).to_continuous_linear_equiv
      .comp_left_continuous_bounded E).uniform_embedding.to_uniform_inducing.comap_uniformity,
    refl },
  ext s : 1,
  change (⨅ _ _, _) = _,
  rw infi_range,
  change (⨅ _ _, _) = _,
  simp_rw infi_range,
  refine le_antisymm (binfi_le' 0 le_rfl) (le_infi $ λ i, le_infi $ λ hi, _),
  convert le_refl _,
  rw ← nat.le_zero_iff, exact_mod_cast hi
end

noncomputable instance : metric_space (B^0⟮E, F; 𝕜⟯) :=
(metric_space.induced (to_bounded_continuous_function 𝕜 E F 0)
  (to_bounded_continuous_function_injective 𝕜 E F 0) infer_instance).replace_uniformity
(by rw uniform_space_eq_comap)

noncomputable instance : normed_group (B^0⟮E, F; 𝕜⟯) :=
{ to_metric_space := infer_instance,
  ..normed_group.induced (to_bounded_continuous_functionₗ 𝕜 E F 0).to_add_monoid_hom
  (to_bounded_continuous_function_injective 𝕜 E F 0) }

@[simp] lemma norm_def {f : B^0⟮E, F; 𝕜⟯} : ∥f∥ = ∥to_bounded_continuous_functionL 𝕜 E F 0 f∥ := rfl

noncomputable! instance : normed_space 𝕜 (B^0⟮E, F; 𝕜⟯) :=
{ norm_smul_le := λ c f,
  begin
    rw [norm_def, norm_def, continuous_linear_map.map_smul],
    exact normed_space.norm_smul_le _ _
  end }

end zero

section infinity

variables {𝕜 E F}

protected lemma differentiable (f : B^⊤⟮E, F; 𝕜⟯) : differentiable 𝕜 f :=
f.cont_diff.differentiable le_top

protected noncomputable def fderiv (f : B^⊤⟮E, F; 𝕜⟯) : B^⊤⟮E, E →L[𝕜] F; 𝕜⟯ :=
⟨fderiv 𝕜 f, (cont_diff_top_iff_fderiv.mp f.cont_diff).2,
  begin
    intros i _,
    rcases f.bounded (le_top : ↑(i+1) ≤ _) with ⟨C, hC⟩,
    use C,
    intros x,
    specialize hC x,
    rwa [iterated_fderiv_succ_eq_comp_right, linear_isometry_equiv.norm_map] at hC
  end⟩

@[simp] protected lemma fderiv_apply (f : B^⊤⟮E, F; 𝕜⟯) :
  f.fderiv x = fderiv 𝕜 f x := rfl

protected noncomputable def fderivₗ : B^⊤⟮E, F; 𝕜⟯ →ₗ[𝕜] B^⊤⟮E, E →L[𝕜] F; 𝕜⟯ :=
{ to_fun := bounded_cont_diff_map.fderiv,
  map_add' := λ f g,
  begin
    ext x : 1,
    exact fderiv_add f.differentiable.differentiable_at
      g.differentiable.differentiable_at,
  end,
  map_smul' := λ a f,
  begin
    ext x : 1,
    exact fderiv_const_smul f.differentiable.differentiable_at _
  end }

@[simp] protected lemma fderivₗ_apply (f : B^⊤⟮E, F; 𝕜⟯) :
  ⇑(bounded_cont_diff_map.fderivₗ f) = fderiv 𝕜 f := rfl

noncomputable def fderivL : B^⊤⟮E, F; 𝕜⟯ →L[𝕜] B^⊤⟮E, E →L[𝕜] F; 𝕜⟯ :=
{ to_linear_map := bounded_cont_diff_map.fderivₗ,
  cont :=
  begin
    rw bounded_cont_diff_map.continuous_iff,
    intros i hi,
    set! φ :=
      (continuous_linear_map.comp_left_continuous_bounded E
        (continuous_multilinear_curry_right_equiv' 𝕜 i E F).symm
          .to_continuous_linear_equiv.to_continuous_linear_map).comp
      (bounded_cont_diff_map.iterated_fderivL (i+1))
      with hφ,
    have : bounded_cont_diff_map.iterated_fderiv i ∘ bounded_cont_diff_map.fderivₗ.to_fun = φ,
    { rw hφ,
      ext f H k x,
      simp [iterated_fderiv_succ_apply_right] }, -- slooooooooooow
    rw this,
    exact φ.continuous
  end }

end infinity

end any_field

section real

variables {E F G : Type*} [normed_group E] [normed_group F] [normed_group G]
  [normed_space ℝ E] [normed_space ℝ F] [normed_space ℝ G]
  {n : with_top ℕ} {n' : ℕ} {f g : B^n⟮E, F; ℝ⟯} {x : E}

instance : locally_convex_space ℝ (B^n⟮E, F; ℝ⟯) := sorry

end real

--section real
--
--open_locale pointwise
--
--variables {E F G : Type*} [normed_group E] [normed_group F] [normed_group G]
--  [normed_space ℝ E] [normed_space ℝ F] [normed_space ℝ G]
--  {n : with_top ℕ} {f g : B^n⟮E, F; ℝ⟯} {x : E}
--
----protected lemma has_basis_zero_homotethy : (𝓝 0 : filter $ B^n⟮E, F; ℝ⟯).has_basis
----  (λ Nε : ℕ × ℝ, 0 < Nε.2) (λ Nε, Nε.2 • {f | ∀ (i : ℕ) (hiN : i ≤ Nε.1)
----    (hi : (i : with_top ℕ) ≤ n) , ∥f.iterated_fderiv hi∥ < 1}) :=
----begin
----  refine bounded_cont_diff_map.has_basis_zero.to_has_basis _ _,
----  { rintros ⟨N, ε⟩ hε,
----    refine ⟨⟨N, 1/ε⟩, one_div_pos.mpr hε, _⟩,
----    change _ • _ ⊆ _,
----    rw set_smul_subset_iff₀, }
----
----end
--
--lemma goal (T : B^n⟮E, F; ℝ⟯ →ₗ[ℝ] G) :
--  continuous T ↔ ∃ (p : ℕ), ∃ C > 0, ∀ f : B^n⟮E, F; ℝ⟯,
--    ∥T f∥ ≤ C * (⨆ (i : ℕ) (hip : i ≤ p) (hin : ↑i ≤ n), ∥f.iterated_fderiv hin∥) :=
--begin
--  sorry
--end
--
--lemma continuous_iff_of_linear (T : B^n⟮E, F; ℝ⟯ →ₗ[ℝ] G) :
--  continuous T ↔ ∃ (p : ℕ), ∃ C > 0, ∀ f : B^n⟮E, F; ℝ⟯,
--    ∥T f∥ ≤ C * (⨆ (i ≤ p) (hin : ↑i ≤ n) (x : E), ∥iterated_fderiv ℝ i f x∥) :=
--begin
--  sorry
--end
--
--lemma bar (T : B^n⟮E, F; ℝ⟯ →ₗ[ℝ] G) :
--  continuous_at T 0 ↔ ∃ (p : ℕ), ∃ C > 0, ∀ f : B^n⟮E, F; ℝ⟯,
--    ∥T f∥ ≤ C * (⨆ (i : ℕ) (hip : i ≤ p) (hin : ↑i ≤ n), ∥f.iterated_fderiv hin∥) :=
--begin
--  rw [continuous_at, map_zero,
--      bounded_cont_diff_map.has_basis_zero.tendsto_iff metric.nhds_basis_ball],
--  split,
--  { intro H,
--    rcases H 1 zero_lt_one with ⟨⟨p, ε⟩, hε, H'⟩,
--    refine ⟨p, ε⁻¹, inv_pos.mpr hε, λ f, _⟩,
--    sorry },
--  { rintros ⟨p, C, hC, H⟩ ε hε,
--    sorry }
--end
--
--end real
--

end bounded_cont_diff_map