def Fin.succ (v : Fin n) : Fin n.succ :=
  match v with
  | ⟨v, h⟩ => ⟨v+1, Nat.succ_lt_succ h⟩

set_option pp.analyze false

example (p : (n : Nat) → Fin n → Prop)
        (n : Nat)
        (v : Fin n)
        : p n.succ v.succ := by
  generalize h₁ : n.succ = n', h₂ : v.succ = v'
  trace_state
  admit


import category_theory.follow_your_nose

universes u₁ v₁

open category_theory
open opposite

namespace terse

variables (C : Type u₁) [𝒞 : category.{v₁+1} C]
include 𝒞

def yoneda : C ⥤ ((Cᵒᵖ) ⥤ Type v₁) := ƛ X, ƛ Y, (unop Y) ⟶ X.

def yoneda_evaluation : ((Cᵒᵖ) × ((Cᵒᵖ) ⥤ (Type v₁))) ⥤ (Type (max u₁ v₁)) :=
(evaluation_uncurried (Cᵒᵖ) (Type v₁)) ⋙ ulift_functor.{u₁}

@[simp] lemma yoneda_evaluation_map_down
  (P Q : (Cᵒᵖ) × (Cᵒᵖ ⥤ Type v₁)) (α : P ⟶ Q) (x : (yoneda_evaluation C).obj P) :
  ((yoneda_evaluation C).map α x).down = (α.2).app (Q.1) ((P.2).map (α.1) (x.down)) := rfl

def yoneda_pairing : ((Cᵒᵖ) × ((Cᵒᵖ) ⥤ (Type v₁))) ⥤ (Type (max u₁ v₁)) :=
(functor.prod ((yoneda C).op) (functor.id ((Cᵒᵖ) ⥤ (Type v₁)))) ⋙ (functor.hom ((Cᵒᵖ) ⥤ (Type v₁)))

@[simp] lemma yoneda_pairing_map
  (P Q : (Cᵒᵖ) × (Cᵒᵖ ⥤ Type v₁)) (α : P ⟶ Q) (β : (yoneda_pairing C).obj P) :
  (yoneda_pairing C).map α β = (yoneda C).map (α.1.unop) ≫ β ≫ α.2 := rfl

def yoneda_lemma : (yoneda_pairing C) ≅ (yoneda_evaluation C) :=
{ hom := { app := λ F x, ulift.up ((x.app F.1) (𝟙 (unop F.1))) },
  inv := { app := λ F x, { app := λ X a, (F.2.map a.op) x.down } } }.

end terse


import filter
import seminormed_rings
import analysis.special_functions.pow

noncomputable theory

open_locale topological_space

-- Proposition 1.3.2/2 in BGR

section ring

variables {α : Type*} [comm_ring α] (c : α) (f : α → nnreal) (hf1 : is_norm_le_one_class f)
  (hc : 0 ≠ f c) (hsn : is_seminorm f) (hpm : is_pow_mult f)

def c_seminorm_seq (x : α) : ℕ → nnreal :=
λ n, (f (x * c^n))/((f c)^n)

lemma c_seminorm_is_bounded (x : α) :
  bdd_below (set.range (c_seminorm_seq c f x)) :=
begin
  use 0,
  rw mem_lower_bounds,
  intros r hr,
  obtain ⟨n, hn⟩ := hr,
  rw ← hn,
  exact zero_le',
end

variable {f}

lemma c_seminorm_seq_zero (hf : f 0 = 0) :
  c_seminorm_seq c f 0 = 0 :=
begin
  simp only [c_seminorm_seq],
  ext n,
  rw [zero_mul, hf, zero_div],
  refl,
end

/- lemma c_seminorm_seq_nonneg (x : α) (n : ℕ) : 0 ≤ c_seminorm_seq c f x n := zero_le'
 -/

variable {c}

include hc hpm

lemma c_seminorm_seq_one (n : ℕ) (hn : 1 ≤ n) :
  c_seminorm_seq c f 1 n = 1 :=
begin
  simp only [c_seminorm_seq],
  rw [one_mul, hpm _ hn, div_self (pow_ne_zero n (ne.symm hc))],
end

include hf1 include hsn

lemma c_seminorm_seq_antitone (x : α) :
  antitone (c_seminorm_seq c f x) :=
begin
  intros m n hmn,
  simp only [c_seminorm_seq],
  nth_rewrite 0 ← nat.add_sub_of_le hmn,
  rw [pow_add, ← mul_assoc],
  apply le_trans ((div_le_div_right₀ (pow_ne_zero _ (ne.symm hc))).mpr (hsn.mul _ _)),
  by_cases heq : m = n,
  { have : n - m = 0,
    { rw heq, exact nat.sub_self n, },
    rw [this, heq, div_le_div_right₀ (pow_ne_zero _ (ne.symm hc)), pow_zero],
    conv_rhs{rw ← mul_one (f (x * c ^ n))},
    exact mul_le_mul' (le_refl _) hf1 },
  { have h1 : 1 ≤ n - m,
    { rw [nat.one_le_iff_ne_zero, ne.def, nat.sub_eq_zero_iff_le, not_le],
    exact lt_of_le_of_ne hmn heq,},
    rw [hpm c h1, mul_div_assoc, div_eq_mul_inv, pow_sub₀ _ (ne.symm hc) hmn, mul_assoc,
      mul_comm (f c ^ m)⁻¹, ← mul_assoc (f c ^ n), mul_inv_cancel (pow_ne_zero n (ne.symm hc)),
      one_mul, div_eq_mul_inv], }
end

def c_seminorm_seq_lim (x : α) : nnreal :=
classical.some (nnreal.tendsto_of_is_bounded_antitone (c_seminorm_is_bounded c f x)
  (c_seminorm_seq_antitone hf1 hc hsn hpm x))

lemma c_seminorm_seq_lim_is_limit (x : α) : filter.tendsto ((c_seminorm_seq c f x)) filter.at_top
  (𝓝 (c_seminorm_seq_lim hf1 hc hsn hpm x)) :=
classical.some_spec (nnreal.tendsto_of_is_bounded_antitone (c_seminorm_is_bounded c f x)
  (c_seminorm_seq_antitone hf1 hc hsn hpm x))

def c_seminorm : α → nnreal := λ x, c_seminorm_seq_lim hf1 hc hsn hpm x

lemma c_seminorm_zero : c_seminorm hf1 hc hsn hpm 0 = 0 :=
tendsto_nhds_unique (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm 0)
  (by simpa [c_seminorm_seq_zero c hsn.zero] using tendsto_const_nhds)

lemma c_seminorm_is_norm_one_class : is_norm_one_class (c_seminorm hf1 hc hsn hpm) :=
begin
  apply tendsto_nhds_unique_of_eventually_eq (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm 1)
    tendsto_const_nhds,
  simp only [filter.eventually_eq, filter.eventually_at_top, ge_iff_le],
  exact ⟨1,  c_seminorm_seq_one hc hpm⟩,
end

lemma c_seminorm_mul (x y : α) :
  c_seminorm hf1 hc hsn hpm (x * y) ≤ c_seminorm hf1 hc hsn hpm x * c_seminorm hf1 hc hsn hpm y :=
begin
  have hlim : filter.tendsto (λ n, c_seminorm_seq c f (x * y) (2 *n)) filter.at_top
    (𝓝 (c_seminorm_seq_lim hf1 hc hsn hpm (x * y) )),
  { refine filter.tendsto.comp (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm (x * y)) _,
    apply filter.tendsto_at_top_at_top_of_monotone,
    { intros n m hnm, simp only [mul_le_mul_left, nat.succ_pos', hnm], },
    { rintro n, use n, linarith, }},
  apply le_of_tendsto_of_tendsto' hlim (filter.tendsto.mul
    (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm x) (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm y)),
  intro n,
  simp only [c_seminorm_seq],
  rw [div_mul_div_comm, ← pow_add, two_mul, div_le_div_right₀ (pow_ne_zero _ (ne.symm hc)),
    pow_add, ← mul_assoc, mul_comm (x * y), ← mul_assoc, mul_assoc, mul_comm (c^n)],
  exact hsn.mul (x * c ^ n) (y * c ^ n),
end

lemma c_seminorm_add (x y : α)  :
  c_seminorm hf1 hc hsn hpm (x + y) ≤ c_seminorm hf1 hc hsn hpm x +  c_seminorm hf1 hc hsn hpm y :=
begin
  apply le_of_tendsto_of_tendsto' (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm (x + y))
    (filter.tendsto.add (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm x)
    (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm y)),
  intro n,
  have h_add : f ((x + y) * c ^ n) ≤ (f (x * c ^ n)) + (f (y * c ^ n)),
  { rw add_mul, exact hsn.add _ _ },
  simp only [c_seminorm_seq],
  rw nnreal.div_add_div_same,
  exact (div_le_div_right₀ (pow_ne_zero _ (ne.symm hc))).mpr h_add,
end

lemma c_seminorm_is_seminorm :
  is_seminorm (c_seminorm hf1 hc hsn hpm)  :=
{ zero := c_seminorm_zero hf1 hc hsn hpm,
  add  := c_seminorm_add hf1 hc hsn hpm ,
  mul  := c_seminorm_mul hf1 hc hsn hpm  }

lemma c_seminorm_is_norm_le_one_class :
  is_norm_le_one_class (c_seminorm hf1 hc hsn hpm) :=
le_of_eq (c_seminorm_is_norm_one_class hf1 hc hsn hpm)

lemma c_seminorm_is_nonarchimedean (hna : is_nonarchimedean f) :
  is_nonarchimedean (c_seminorm hf1 hc hsn hpm)  :=
begin
  intros x y,
  apply le_of_tendsto_of_tendsto' (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm (x - y))
    (filter.tendsto.max (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm x)
    (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm y)),
  intro n,
  have hmax : f ((x - y) * c ^ n) ≤ max (f (x * c ^ n)) (f (y * c ^ n)),
  { rw sub_mul, exact hna _ _ },
  rw le_max_iff at hmax ⊢,
  cases hmax; [left, right];
  exact (div_le_div_right₀ (pow_ne_zero _ (ne.symm hc))).mpr hmax,
end

lemma c_seminorm_is_pow_mult : is_pow_mult (c_seminorm hf1 hc hsn hpm) :=
begin
  intros x m hm,
  simp only [c_seminorm],
  have hpow := filter.tendsto.pow (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm x) m,
  have hlim : filter.tendsto (λ n, c_seminorm_seq c f (x^m) (m*n)) filter.at_top
    (𝓝 (c_seminorm_seq_lim hf1 hc hsn hpm (x^m) )),
  { refine filter.tendsto.comp (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm (x^m)) _,
    apply filter.tendsto_at_top_at_top_of_monotone,
    { intros n k hnk, exact mul_le_mul_left' hnk m, },
    { rintro n, use n, exact le_mul_of_one_le_left' hm, }},
  apply tendsto_nhds_unique hlim,
  convert filter.tendsto.pow (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm x) m,
  ext n,
  simp only [c_seminorm_seq],
  rw [div_pow, ← hpm _ hm, ← pow_mul, mul_pow, ← pow_mul, mul_comm m n],
end

lemma c_seminorm_le_seminorm (x : α) : c_seminorm hf1 hc hsn hpm x ≤ f x :=
begin
  apply le_of_tendsto (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm x),
  simp only [filter.eventually_at_top, ge_iff_le],
  use 1,
  rintros n hn,
  apply le_trans ((div_le_div_right₀ (pow_ne_zero _ (ne.symm hc))).mpr (hsn.mul _ _)),
  rw [hpm c hn, mul_div_assoc, div_self (pow_ne_zero n hc.symm), mul_one],
end

lemma c_seminorm_apply_of_is_mult {x : α} (hx : ∀ y : α, f (x * y) = f x * f y) :
  c_seminorm hf1 hc hsn hpm x = f x :=
begin
  have hlim : filter.tendsto (c_seminorm_seq c f x) filter.at_top (𝓝 (f x)),
  { have hseq : c_seminorm_seq c f x = λ n, f x,
    { ext n,
      by_cases hn : n = 0,
      { simp only [c_seminorm_seq],
        rw [hn, pow_zero, pow_zero, mul_one, div_one], },
      { simp only [c_seminorm_seq],
        rw [hx (c ^n), hpm _ (nat.one_le_iff_ne_zero.mpr hn), mul_div_assoc,
          div_self (pow_ne_zero n hc.symm), mul_one], }},
    simpa [hseq] using tendsto_const_nhds, },
  exact tendsto_nhds_unique (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm x) hlim,
end

lemma c_seminorm_is_mult_of_is_mult {x : α} (hx : ∀ y : α, f (x * y) = f x * f y) (y : α) :
  c_seminorm hf1 hc hsn hpm (x * y) = c_seminorm hf1 hc hsn hpm x * c_seminorm hf1 hc hsn hpm y :=
begin
  have hlim : filter.tendsto (c_seminorm_seq c f (x * y)) filter.at_top
    (𝓝 (c_seminorm hf1 hc hsn hpm x * c_seminorm hf1 hc hsn hpm y)),
  { rw c_seminorm_apply_of_is_mult hf1 hc hsn hpm hx,
    have hseq : c_seminorm_seq c f (x * y) = λ n, f x * c_seminorm_seq c f y n,
    { ext n,
      simp only [c_seminorm_seq],
      rw [mul_assoc, hx, mul_div_assoc], },
    simpa [hseq] using filter.tendsto.const_mul _ (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm y) },
  exact tendsto_nhds_unique (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm (x * y)) hlim,
end

lemma c_seminorm_apply_c : c_seminorm hf1 hc hsn hpm c = f c :=
begin
  have hlim : filter.tendsto (c_seminorm_seq c f c) filter.at_top (𝓝 (f c)),
  { have hseq : c_seminorm_seq c f c = λ n, f c,
    { ext n,
      simp only [c_seminorm_seq],
      rw [← pow_succ, hpm _ le_add_self, pow_succ, mul_div_assoc, div_self (pow_ne_zero n hc.symm),
        mul_one], },
    simpa [hseq] using tendsto_const_nhds },
    exact tendsto_nhds_unique (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm c) hlim,
end

lemma c_seminorm_c_is_mult (x : α) :
  c_seminorm hf1 hc hsn hpm (c * x) = c_seminorm hf1 hc hsn hpm c * c_seminorm hf1 hc hsn hpm x :=
begin
  have hlim : filter.tendsto (λ n, c_seminorm_seq c f x (n + 1)) filter.at_top
    (𝓝 (c_seminorm_seq_lim hf1 hc hsn hpm x)),
  { refine filter.tendsto.comp (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm x) _,
    apply filter.tendsto_at_top_at_top_of_monotone,
    { intros n m hnm,
      exact add_le_add_right hnm 1, },
    { rintro n, use n, linarith, }},
  rw c_seminorm_apply_c hf1 hc hsn hpm,
  apply tendsto_nhds_unique (c_seminorm_seq_lim_is_limit hf1 hc hsn hpm (c * x)),
  have hterm: c_seminorm_seq c f (c * x) = (λ n, f c * (c_seminorm_seq c f x (n + 1))),
  { simp only [c_seminorm_seq],
    ext n,
    rw [mul_comm c, pow_succ, pow_succ, mul_div, div_eq_mul_inv _ (f c * f c ^ n), mul_inv,
      nnreal.coe_eq, ← mul_assoc, mul_comm (f c), mul_assoc _ (f c), mul_inv_cancel hc.symm,
      mul_one, mul_assoc, div_eq_mul_inv] },
  simpa [hterm] using filter.tendsto.mul tendsto_const_nhds hlim,
end

end ring

section field

variables {K : Type*} [field K] (k : K) {g : K → nnreal} (hg1 : is_norm_le_one_class g)
  (hg_k : 0 ≠ g k) (hg_sn : is_seminorm g) (hg_pm : is_pow_mult g)

lemma c_seminorm_is_norm :
  is_norm (c_seminorm hg1 hg_k hg_sn hg_pm) :=
field.is_norm_of_is_seminorm (c_seminorm_is_seminorm hg1 hg_k hg_sn hg_pm)
  ⟨k, by simpa [c_seminorm_apply_c] using hg_k⟩

end field
--#lint


/-
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 algebra.algebra.subalgebra.pointwise
import algebraic_geometry.prime_spectrum.noetherian
import ring_theory.dedekind_domain.basic
import ring_theory.fractional_ideal

/-!
# Dedekind domains and ideals

In this file, we show a ring is a Dedekind domain iff all fractional ideals are invertible.
Then we prove some results on the unique factorization monoid structure of the ideals.

## Main definitions

 - `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.
 - `is_dedekind_domain.height_one_spectrum` defines the type of nonzero prime ideals of `R`.

## Main results:
 - `is_dedekind_domain_iff_is_dedekind_domain_inv`
 - `ideal.unique_factorization_monoid`

## 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 polynomial

variables [is_domain A]

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 inv_one : (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.cancel_comm_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
  let h := fractional_ideal.map_equiv (fraction_ring.alg_equiv A K),
  refine h.to_equiv.forall_congr (λ I, _),
  rw ← h.to_equiv.apply_eq_iff_eq,
  simp
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

open ring

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,
  substI 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

open 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 ((injective_iff_map_eq_zero _).mp (is_fraction_ring.injective A K) a) ha0,
  have hb0 : algebra_map A K b ≠ 0 :=
    mt ((injective_iff_map_eq_zero _).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_rfl).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.inv_one] },
  by_cases hNF : is_field A,
  { letI := hNF.to_field, 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 : A[X] →ₐ[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 ((injective_iff_map_eq_zero (algebra_map A K)).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
open 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_rfl).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.cancel_comm_monoid_with_zero :
  cancel_comm_monoid_with_zero (ideal A) :=
function.injective.cancel_comm_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 _)
  (ring_hom.map_pow _)

/-- 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⟩

lemma ideal.strict_anti_pow (I : ideal A) (hI0 : I ≠ ⊥) (hI1 : I ≠ ⊤) :
  strict_anti ((^) I : ℕ → ideal A) :=
strict_anti_nat_of_succ_lt $ λ e, ideal.dvd_not_unit_iff_lt.mp
  ⟨pow_ne_zero _ hI0, I, mt is_unit_iff.mp hI1, pow_succ' I e⟩

lemma ideal.pow_lt_self (I : ideal A) (hI0 : I ≠ ⊥) (hI1 : I ≠ ⊤) (e : ℕ) (he : 2 ≤ e) : I^e < I :=
by convert I.strict_anti_pow hI0 hI1 he; rw pow_one

lemma ideal.exists_mem_pow_not_mem_pow_succ (I : ideal A) (hI0 : I ≠ ⊥) (hI1 : I ≠ ⊤) (e : ℕ) :
  ∃ x ∈ I^e, x ∉ I^(e+1) :=
set_like.exists_of_lt (I.strict_anti_pow hI0 hI1 e.lt_succ_self)

lemma associates.le_singleton_iff (x : A) (n : ℕ) (I : ideal A) :
  associates.mk I^n ≤ associates.mk (ideal.span {x}) ↔ x ∈ I^n :=
begin
  rw [← associates.dvd_eq_le, ← associates.mk_pow, associates.mk_dvd_mk, ideal.dvd_span_singleton],
end

open fractional_ideal
variables {A K}

/-- Strengthening of `is_localization.exist_integer_multiples`:
Let `J ≠ ⊤` be an ideal in a Dedekind domain `A`, and `f ≠ 0` a finite collection
of elements of `K = Frac(A)`, then we can multiply the elements of `f` by some `a : K`
to find a collection of elements of `A` that is not completely contained in `J`. -/
lemma ideal.exist_integer_multiples_not_mem
  {J : ideal A} (hJ : J ≠ ⊤) {ι : Type*} (s : finset ι) (f : ι → K)
  {j} (hjs : j ∈ s) (hjf : f j ≠ 0) :
  ∃ a : K, (∀ i ∈ s, is_localization.is_integer A (a * f i)) ∧
    ∃ i ∈ s, (a * f i) ∉ (J : fractional_ideal A⁰ K) :=
begin
  -- Consider the fractional ideal `I` spanned by the `f`s.
  let I : fractional_ideal A⁰ K := fractional_ideal.span_finset A s f,
  have hI0 : I ≠ 0 := fractional_ideal.span_finset_ne_zero.mpr ⟨j, hjs, hjf⟩,
  -- We claim the multiplier `a` we're looking for is in `I⁻¹ \ (J / I)`.
  suffices : ↑J / I < I⁻¹,
  { obtain ⟨_, a, hI, hpI⟩ := set_like.lt_iff_le_and_exists.mp this,
    rw mem_inv_iff hI0 at hI,
    refine ⟨a, λ i hi, _, _⟩,
    -- By definition, `a ∈ I⁻¹` multiplies elements of `I` into elements of `1`,
    -- in other words, `a * f i` is an integer.
    { exact (mem_one_iff _).mp (hI (f i)
        (submodule.subset_span (set.mem_image_of_mem f hi))) },
    { contrapose! hpI,
      -- And if all `a`-multiples of `I` are an element of `J`,
      -- then `a` is actually an element of `J / I`, contradiction.
      refine (mem_div_iff_of_nonzero hI0).mpr (λ y hy, submodule.span_induction hy _ _ _ _),
      { rintros _ ⟨i, hi, rfl⟩, exact hpI i hi },
      { rw mul_zero, exact submodule.zero_mem _ },
      { intros x y hx hy, rw mul_add, exact submodule.add_mem _ hx hy },
      { intros b x hx, rw mul_smul_comm, exact submodule.smul_mem _ b hx } } },
  -- To show the inclusion of `J / I` into `I⁻¹ = 1 / I`, note that `J < I`.
  calc ↑J / I = ↑J * I⁻¹ : div_eq_mul_inv ↑J I
          ... < 1 * I⁻¹ : mul_right_strict_mono (inv_ne_zero hI0) _
          ... = I⁻¹ : one_mul _,
  { rw [← coe_ideal_top],
    -- And multiplying by `I⁻¹` is indeed strictly monotone.
    exact strict_mono_of_le_iff_le (λ _ _, (coe_ideal_le_coe_ideal K).symm)
      (lt_top_iff_ne_top.mpr hJ) },
end

end is_dedekind_domain

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 (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

lemma irreducible_pow_sup (hI : I ≠ ⊥) (hJ : irreducible J) (n : ℕ) :
  J^n ⊔ I = J^(min ((normalized_factors I).count J) n) :=
by rw [sup_eq_prod_inf_factors (pow_ne_zero n hJ.ne_zero) hI, ← inf_eq_inter,
       normalized_factors_of_irreducible_pow hJ, normalize_eq J, repeat_inf, prod_repeat]

lemma irreducible_pow_sup_of_le (hJ : irreducible J) (n : ℕ)
  (hn : ↑n ≤ multiplicity J I) : J^n ⊔ I = J^n :=
begin
  by_cases hI : I = ⊥,
  { simp [*] at *, },
  rw [irreducible_pow_sup hI hJ, min_eq_right],
  rwa [multiplicity_eq_count_normalized_factors hJ hI, enat.coe_le_coe, normalize_eq J] at hn
end

lemma irreducible_pow_sup_of_ge (hI : I ≠ ⊥) (hJ : irreducible J) (n : ℕ)
  (hn : multiplicity J I ≤ n) : J^n ⊔ I = J ^ (multiplicity J I).get (enat.dom_of_le_coe hn) :=
begin
  rw [irreducible_pow_sup hI hJ, min_eq_left],
  congr,
  { rw [← enat.coe_inj, enat.coe_get, multiplicity_eq_count_normalized_factors hJ hI,
    normalize_eq J] },
  { rwa [multiplicity_eq_count_normalized_factors hJ hI, enat.coe_le_coe, normalize_eq J]
      at hn }
end

end is_dedekind_domain

section height_one_spectrum

/-!
### Height one spectrum of a Dedekind domain
If `R` is a Dedekind domain of Krull dimension 1, the maximal ideals of `R` are exactly its nonzero
prime ideals.
We define `height_one_spectrum` and provide lemmas to recover the facts that prime ideals of height
one are prime and irreducible. -/

namespace is_dedekind_domain

variables [is_domain R] [is_dedekind_domain R]

/-- The height one prime spectrum of a Dedekind domain `R` is the type of nonzero prime ideals of
`R`. Note that this equals the maximal spectrum if `R` has Krull dimension 1. -/
@[ext, nolint has_inhabited_instance unused_arguments]
structure height_one_spectrum :=
(as_ideal : ideal R)
(is_prime : as_ideal.is_prime)
(ne_bot   : as_ideal ≠ ⊥)

variables (v : height_one_spectrum R) {R}

lemma height_one_spectrum.prime (v : height_one_spectrum R) : prime v.as_ideal :=
ideal.prime_of_is_prime v.ne_bot v.is_prime

lemma height_one_spectrum.irreducible (v : height_one_spectrum R) :
  irreducible v.as_ideal :=
begin
  rw [unique_factorization_monoid.irreducible_iff_prime],
  apply v.prime,
end

lemma height_one_spectrum.associates_irreducible (v : height_one_spectrum R) :
  irreducible (associates.mk v.as_ideal) :=
begin
  rw [associates.irreducible_mk _],
  apply v.irreducible,
end

end is_dedekind_domain

end height_one_spectrum

section chinese_remainder

open ideal unique_factorization_monoid
open_locale big_operators

variables {R}

lemma ring.dimension_le_one.prime_le_prime_iff_eq (h : ring.dimension_le_one R)
  {P Q : ideal R} [hP : P.is_prime] [hQ : Q.is_prime] (hP0 : P ≠ ⊥) :
  P ≤ Q ↔ P = Q :=
⟨(h P hP0 hP).eq_of_le hQ.ne_top, eq.le⟩

lemma ideal.coprime_of_no_prime_ge {I J : ideal R} (h : ∀ P, I ≤ P → J ≤ P → ¬ is_prime P) :
  I ⊔ J = ⊤ :=
begin
  by_contra hIJ,
  obtain ⟨P, hP, hIJ⟩ := ideal.exists_le_maximal _ hIJ,
  exact h P (le_trans le_sup_left hIJ) (le_trans le_sup_right hIJ) hP.is_prime
end

section dedekind_domain

variables {R} [is_domain R] [is_dedekind_domain R]

lemma ideal.is_prime.mul_mem_pow (I : ideal R) [hI : I.is_prime] {a b : R} {n : ℕ}
  (h : a * b ∈ I^n) : a ∈ I ∨ b ∈ I^n :=
begin
  cases n, { simp },
  by_cases hI0 : I = ⊥, { simpa [pow_succ, hI0] using h },
  simp only [← submodule.span_singleton_le_iff_mem, ideal.submodule_span_eq, ← ideal.dvd_iff_le,
    ← ideal.span_singleton_mul_span_singleton] at h ⊢,
  by_cases ha : I ∣ span {a},
  { exact or.inl ha },
  rw mul_comm at h,
  exact or.inr (prime.pow_dvd_of_dvd_mul_right ((ideal.prime_iff_is_prime hI0).mpr hI) _ ha h),
end

section

open_locale classical

lemma ideal.count_normalized_factors_eq {p x : ideal R} (hp0 : p ≠ ⊥) [hp : p.is_prime] {n : ℕ}
  (hle : x ≤ p^n) (hlt : ¬ (x ≤ p^(n+1))) :
  (normalized_factors x).count p = n :=
count_normalized_factors_eq ((ideal.prime_iff_is_prime hp0).mpr hp).irreducible (normalize_eq _)
  (ideal.dvd_iff_le.mpr hle) (mt ideal.le_of_dvd hlt)

end

lemma ideal.le_mul_of_no_prime_factors
  {I J K : ideal R} (coprime : ∀ P, J ≤ P → K ≤ P → ¬ is_prime P) (hJ : I ≤ J) (hK : I ≤ K) :
  I ≤ J * K :=
begin
  simp only [← ideal.dvd_iff_le] at coprime hJ hK ⊢,
  by_cases hJ0 : J = 0,
  { simpa only [hJ0, zero_mul] using hJ },
  obtain ⟨I', rfl⟩ := hK,
  rw mul_comm,
  exact mul_dvd_mul_left K
    (unique_factorization_monoid.dvd_of_dvd_mul_right_of_no_prime_factors hJ0
      (λ P hPJ hPK, mt ideal.is_prime_of_prime (coprime P hPJ hPK))
      hJ)
end

lemma ideal.le_of_pow_le_prime {I P : ideal R} [hP : P.is_prime] {n : ℕ} (h : I^n ≤ P) : I ≤ P :=
begin
  by_cases hP0 : P = ⊥,
  { simp only [hP0, le_bot_iff] at ⊢ h,
    exact pow_eq_zero h },
  rw ← ideal.dvd_iff_le at ⊢ h,
  exact ((ideal.prime_iff_is_prime hP0).mpr hP).dvd_of_dvd_pow h
end

lemma ideal.pow_le_prime_iff {I P : ideal R} [hP : P.is_prime] {n : ℕ} (hn : n ≠ 0) :
  I^n ≤ P ↔ I ≤ P :=
⟨ideal.le_of_pow_le_prime, λ h, trans (ideal.pow_le_self hn) h⟩

lemma ideal.prod_le_prime {ι : Type*} {s : finset ι} {f : ι → ideal R} {P : ideal R}
  [hP : P.is_prime] :
  ∏ i in s, f i ≤ P ↔ ∃ i ∈ s, f i ≤ P :=
begin
  by_cases hP0 : P = ⊥,
  { simp only [hP0, le_bot_iff],
    rw [← ideal.zero_eq_bot, finset.prod_eq_zero_iff] },
  simp only [← ideal.dvd_iff_le],
  exact ((ideal.prime_iff_is_prime hP0).mpr hP).dvd_finset_prod_iff _
end

/-- The intersection of distinct prime powers in a Dedekind domain is the product of these
prime powers. -/
lemma is_dedekind_domain.inf_prime_pow_eq_prod {ι : Type*}
  (s : finset ι) (f : ι → ideal R) (e : ι → ℕ)
  (prime : ∀ i ∈ s, prime (f i)) (coprime : ∀ i j ∈ s, i ≠ j → f i ≠ f j) :
  s.inf (λ i, f i ^ e i) = ∏ i in s, f i ^ e i :=
begin
  letI := classical.dec_eq ι,
  revert prime coprime,
  refine s.induction _ _,
  { simp },
  intros a s ha ih prime coprime,
  specialize ih (λ i hi, prime i (finset.mem_insert_of_mem hi))
    (λ i hi j hj, coprime i (finset.mem_insert_of_mem hi) j (finset.mem_insert_of_mem hj)),
  rw [finset.inf_insert, finset.prod_insert ha, ih],
  refine le_antisymm (ideal.le_mul_of_no_prime_factors _ inf_le_left inf_le_right) ideal.mul_le_inf,
  intros P hPa hPs hPp,
  haveI := hPp,
  obtain ⟨b, hb, hPb⟩ := ideal.prod_le_prime.mp hPs,
  haveI := ideal.is_prime_of_prime (prime a (finset.mem_insert_self a s)),
  haveI := ideal.is_prime_of_prime (prime b (finset.mem_insert_of_mem hb)),
  refine coprime a (finset.mem_insert_self a s) b (finset.mem_insert_of_mem hb) _
    (((is_dedekind_domain.dimension_le_one.prime_le_prime_iff_eq _).mp
        (ideal.le_of_pow_le_prime hPa)).trans
      ((is_dedekind_domain.dimension_le_one.prime_le_prime_iff_eq _).mp
        (ideal.le_of_pow_le_prime hPb)).symm),
  { unfreezingI { rintro rfl }, contradiction },
  { exact (prime a (finset.mem_insert_self a s)).ne_zero },
  { exact (prime b (finset.mem_insert_of_mem hb)).ne_zero },
end

/-- **Chinese remainder theorem** for a Dedekind domain: if the ideal `I` factors as
`∏ i, P i ^ e i`, then `R ⧸ I` factors as `Π i, R ⧸ (P i ^ e i)`. -/
noncomputable def is_dedekind_domain.quotient_equiv_pi_of_prod_eq {ι : Type*} [fintype ι]
  (I : ideal R) (P : ι → ideal R) (e : ι → ℕ)
  (prime : ∀ i, prime (P i)) (coprime : ∀ i j, i ≠ j → P i ≠ P j) (prod_eq : (∏ i, P i ^ e i) = I) :
  R ⧸ I ≃+* Π i, R ⧸ (P i ^ e i) :=
(ideal.quot_equiv_of_eq (by { simp only [← prod_eq, finset.inf_eq_infi, finset.mem_univ, cinfi_pos,
  ← is_dedekind_domain.inf_prime_pow_eq_prod _ _ _ (λ i _, prime i) (λ i _ j _, coprime i j)] }))
    .trans $
ideal.quotient_inf_ring_equiv_pi_quotient _ (λ i j hij, ideal.coprime_of_no_prime_ge (begin
  intros P hPi hPj hPp,
  haveI := hPp,
  haveI := ideal.is_prime_of_prime (prime i), haveI := ideal.is_prime_of_prime (prime j),
  exact coprime i j hij
    (((is_dedekind_domain.dimension_le_one.prime_le_prime_iff_eq (prime i).ne_zero).mp
      (ideal.le_of_pow_le_prime hPi)).trans
    ((is_dedekind_domain.dimension_le_one.prime_le_prime_iff_eq (prime j).ne_zero).mp
     (ideal.le_of_pow_le_prime hPj)).symm)
end))

open_locale classical

/-- **Chinese remainder theorem** for a Dedekind domain: `R ⧸ I` factors as `Π i, R ⧸ (P i ^ e i)`,
where `P i` ranges over the prime factors of `I` and `e i` over the multiplicities. -/
noncomputable def is_dedekind_domain.quotient_equiv_pi_factors {I : ideal R} (hI : I ≠ ⊥) :
  R ⧸ I ≃+* Π (P : (factors I).to_finset), R ⧸ ((P : ideal R) ^ (factors I).count P) :=
is_dedekind_domain.quotient_equiv_pi_of_prod_eq _ _ _
  (λ (P : (factors I).to_finset), prime_of_factor _ (multiset.mem_to_finset.mp P.prop))
  (λ i j hij, subtype.coe_injective.ne hij)
  (calc ∏ (P : (factors I).to_finset), (P : ideal R) ^ (factors I).count (P : ideal R)
      = ∏ P in (factors I).to_finset, P ^ (factors I).count P
    : (factors I).to_finset.prod_coe_sort (λ P, P ^ (factors I).count P)
  ... = ((factors I).map (λ P, P)).prod : (finset.prod_multiset_map_count (factors I) id).symm
  ... = (factors I).prod : by rw multiset.map_id'
  ... = I : (@associated_iff_eq (ideal R) _ ideal.unique_units _ _).mp (factors_prod hI))

@[simp] lemma is_dedekind_domain.quotient_equiv_pi_factors_mk {I : ideal R} (hI : I ≠ ⊥)
  (x : R) : is_dedekind_domain.quotient_equiv_pi_factors hI (ideal.quotient.mk I x) =
    λ P, ideal.quotient.mk _ x :=
rfl

end dedekind_domain

end chinese_remainder


/-
Copyright (c) 2019 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad

Extends `tendsto` to relations and partial functions.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.filter.basic
import Mathlib.PostPort

universes u v w

namespace Mathlib

namespace filter

/-
Relations.
-/

def rmap {α : Type u} {β : Type v} (r : rel α β) (f : filter α) : filter β :=
  mk (set_of fun (s : set β) => rel.core r s ∈ f) sorry sorry sorry

theorem rmap_sets {α : Type u} {β : Type v} (r : rel α β) (f : filter α) : sets (rmap r f) = rel.core r ⁻¹' sets f :=
  rfl

@[simp] theorem mem_rmap {α : Type u} {β : Type v} (r : rel α β) (l : filter α) (s : set β) : s ∈ rmap r l ↔ rel.core r s ∈ l :=
  iff.rfl

@[simp] theorem rmap_rmap {α : Type u} {β : Type v} {γ : Type w} (r : rel α β) (s : rel β γ) (l : filter α) : rmap s (rmap r l) = rmap (rel.comp r s) l := sorry

@[simp] theorem rmap_compose {α : Type u} {β : Type v} {γ : Type w} (r : rel α β) (s : rel β γ) : rmap s ∘ rmap r = rmap (rel.comp r s) :=
  funext (rmap_rmap r s)

def rtendsto {α : Type u} {β : Type v} (r : rel α β) (l₁ : filter α) (l₂ : filter β) :=
  rmap r l₁ ≤ l₂

theorem rtendsto_def {α : Type u} {β : Type v} (r : rel α β) (l₁ : filter α) (l₂ : filter β) : rtendsto r l₁ l₂ ↔ ∀ (s : set β), s ∈ l₂ → rel.core r s ∈ l₁ :=
  iff.rfl

def rcomap {α : Type u} {β : Type v} (r : rel α β) (f : filter β) : filter α :=
  mk (rel.image (fun (s : set β) (t : set α) => rel.core r s ⊆ t) (sets f)) sorry sorry sorry

theorem rcomap_sets {α : Type u} {β : Type v} (r : rel α β) (f : filter β) : sets (rcomap r f) = rel.image (fun (s : set β) (t : set α) => rel.core r s ⊆ t) (sets f) :=
  rfl

@[simp] theorem rcomap_rcomap {α : Type u} {β : Type v} {γ : Type w} (r : rel α β) (s : rel β γ) (l : filter γ) : rcomap r (rcomap s l) = rcomap (rel.comp r s) l := sorry

@[simp] theorem rcomap_compose {α : Type u} {β : Type v} {γ : Type w} (r : rel α β) (s : rel β γ) : rcomap r ∘ rcomap s = rcomap (rel.comp r s) :=
  funext (rcomap_rcomap r s)

theorem rtendsto_iff_le_comap {α : Type u} {β : Type v} (r : rel α β) (l₁ : filter α) (l₂ : filter β) : rtendsto r l₁ l₂ ↔ l₁ ≤ rcomap r l₂ := sorry

-- Interestingly, there does not seem to be a way to express this relation using a forward map.

-- Given a filter `f` on `α`, we want a filter `f'` on `β` such that `r.preimage s ∈ f` if

-- and only if `s ∈ f'`. But the intersection of two sets satsifying the lhs may be empty.

def rcomap' {α : Type u} {β : Type v} (r : rel α β) (f : filter β) : filter α :=
  mk (rel.image (fun (s : set β) (t : set α) => rel.preimage r s ⊆ t) (sets f)) sorry sorry sorry

@[simp] theorem mem_rcomap' {α : Type u} {β : Type v} (r : rel α β) (l : filter β) (s : set α) : s ∈ rcomap' r l ↔ ∃ (t : set β), ∃ (H : t ∈ l), rel.preimage r t ⊆ s :=
  iff.rfl

theorem rcomap'_sets {α : Type u} {β : Type v} (r : rel α β) (f : filter β) : sets (rcomap' r f) = rel.image (fun (s : set β) (t : set α) => rel.preimage r s ⊆ t) (sets f) :=
  rfl

@[simp] theorem rcomap'_rcomap' {α : Type u} {β : Type v} {γ : Type w} (r : rel α β) (s : rel β γ) (l : filter γ) : rcomap' r (rcomap' s l) = rcomap' (rel.comp r s) l := sorry

@[simp] theorem rcomap'_compose {α : Type u} {β : Type v} {γ : Type w} (r : rel α β) (s : rel β γ) : rcomap' r ∘ rcomap' s = rcomap' (rel.comp r s) :=
  funext (rcomap'_rcomap' r s)

def rtendsto' {α : Type u} {β : Type v} (r : rel α β) (l₁ : filter α) (l₂ : filter β) :=
  l₁ ≤ rcomap' r l₂

theorem rtendsto'_def {α : Type u} {β : Type v} (r : rel α β) (l₁ : filter α) (l₂ : filter β) : rtendsto' r l₁ l₂ ↔ ∀ (s : set β), s ∈ l₂ → rel.preimage r s ∈ l₁ := sorry

theorem tendsto_iff_rtendsto {α : Type u} {β : Type v} (l₁ : filter α) (l₂ : filter β) (f : α → β) : tendsto f l₁ l₂ ↔ rtendsto (function.graph f) l₁ l₂ := sorry

theorem tendsto_iff_rtendsto' {α : Type u} {β : Type v} (l₁ : filter α) (l₂ : filter β) (f : α → β) : tendsto f l₁ l₂ ↔ rtendsto' (function.graph f) l₁ l₂ := sorry

/-
Partial functions.
-/

def pmap {α : Type u} {β : Type v} (f : α →. β) (l : filter α) : filter β :=
  rmap (pfun.graph' f) l

@[simp] theorem mem_pmap {α : Type u} {β : Type v} (f : α →. β) (l : filter α) (s : set β) : s ∈ pmap f l ↔ pfun.core f s ∈ l :=
  iff.rfl

def ptendsto {α : Type u} {β : Type v} (f : α →. β) (l₁ : filter α) (l₂ : filter β) :=
  pmap f l₁ ≤ l₂

theorem ptendsto_def {α : Type u} {β : Type v} (f : α →. β) (l₁ : filter α) (l₂ : filter β) : ptendsto f l₁ l₂ ↔ ∀ (s : set β), s ∈ l₂ → pfun.core f s ∈ l₁ :=
  iff.rfl

theorem ptendsto_iff_rtendsto {α : Type u} {β : Type v} (l₁ : filter α) (l₂ : filter β) (f : α →. β) : ptendsto f l₁ l₂ ↔ rtendsto (pfun.graph' f) l₁ l₂ :=
  iff.rfl

theorem pmap_res {α : Type u} {β : Type v} (l : filter α) (s : set α) (f : α → β) : pmap (pfun.res f s) l = map f (l ⊓ principal s) := sorry

theorem tendsto_iff_ptendsto {α : Type u} {β : Type v} (l₁ : filter α) (l₂ : filter β) (s : set α) (f : α → β) : tendsto f (l₁ ⊓ principal s) l₂ ↔ ptendsto (pfun.res f s) l₁ l₂ := sorry

theorem tendsto_iff_ptendsto_univ {α : Type u} {β : Type v} (l₁ : filter α) (l₂ : filter β) (f : α → β) : tendsto f l₁ l₂ ↔ ptendsto (pfun.res f set.univ) l₁ l₂ := sorry

def pcomap' {α : Type u} {β : Type v} (f : α →. β) (l : filter β) : filter α :=
  rcomap' (pfun.graph' f) l

def ptendsto' {α : Type u} {β : Type v} (f : α →. β) (l₁ : filter α) (l₂ : filter β) :=
  l₁ ≤ rcomap' (pfun.graph' f) l₂

theorem ptendsto'_def {α : Type u} {β : Type v} (f : α →. β) (l₁ : filter α) (l₂ : filter β) : ptendsto' f l₁ l₂ ↔ ∀ (s : set β), s ∈ l₂ → pfun.preimage f s ∈ l₁ :=
  rtendsto'_def (pfun.graph' f) l₁ l₂

theorem ptendsto_of_ptendsto' {α : Type u} {β : Type v} {f : α →. β} {l₁ : filter α} {l₂ : filter β} : ptendsto' f l₁ l₂ → ptendsto f l₁ l₂ := sorry

theorem ptendsto'_of_ptendsto {α : Type u} {β : Type v} {f : α →. β} {l₁ : filter α} {l₂ : filter β} (h : pfun.dom f ∈ l₁) : ptendsto f l₁ l₂ → ptendsto' f l₁ l₂ := sorry


import data.equiv.basic

lemma equiv.forall_iff_forall {α β} {p : α → Prop} (f : α ≃ β) :
  (∀ x, p x) ↔ (∀ x, p $ f.symm x) :=
iff.intro
  (assume h x, h _)
  (assume h x, by { specialize h (f x), revert h, simp })


import data.set.countable tactic.find tactic.tidy tactic.ring
universe u

-- We introduce a much simplified version of
-- untyped first order (minimal) predicate logic.

-- make all propositions decidable.
-- Allows us to freely use ifs like in Haskell
-- but then we must add noncomputable to all functions
-- local attribute [instance] classical.prop_decidable

namespace logic

open logic list tactic set

section formulas
parameters {functional_symbol : Type u} [decidable_eq functional_symbol]
parameter {relational_symbol : Type u}
parameters {tvariable : Type u} [decidable_eq tvariable]
parameter {var_ne : nonempty tvariable}
-- parameters {var_index : ℕ → tvariable} {inj : function.injective var_index}
-- parameters {abstract_var : Type u} [decidable_eq abstract_var]
-- parameter {abs_ne : nonempty abstract_var}
parameter {arity : functional_symbol -> ℕ}
parameter {rarity : relational_symbol -> ℕ}

-- arity types
def is_constant (f : functional_symbol) := arity f = 0
def nary (n : ℕ) := subtype {f : functional_symbol | arity f = n}
def nrary (n : ℕ) := subtype {r : relational_symbol | rarity r = n}
@[reducible]
def const := nary 0

-- terms in the language
inductive term
| var : tvariable → term
-- | abs : abstract_var → term
| app  {n : ℕ} (f : nary n) (v : fin n → term) :  term

-- constant terms.
def nary.term : const → term
| c := term.app c fin_zero_elim

@[reducible]
def term.rw : term → tvariable → term → term
| (term.var a) x t := if x = a then t else term.var a
| (term.app f v) x t :=
    let v₂ := λ m, term.rw (v m) x t in
    term.app f v₂
-- | t _ _ := t

def term.rw_const : term → const → tvariable → term
| (@term.app _ _ _ _ _ 0 f _) c x := if f = c then term.var x else f.term
| (@term.app _ _ _ _ _ (n+1) f v) c x :=
    let v₂ := λ m, term.rw_const (v m) c x in
    term.app f v₂
| t _ _ := t

-- abstract rewrite
-- def term.arw : term → abstract_var → term → term
-- | (term.abs a) x t := if x = a then t else term.abs a
-- | (term.app f v) x t :=
--     let v₂ := λ m, term.arw (v m) x t in
--     term.app f v₂
-- | t _ _ := t

-- Syntatical equality.
-- This is a trick to bypass the need to prove decidable_eq term
-- for using ifs.
-- The linter is unable to prove this terminates,
-- so we have to declare it as meta, unfortunately.
-- meta def term_seq : term → term → bool
-- | (term.var x) (term.var y) := if x = y then tt else ff
-- | (term.app f v₁) (term.app g v₂) :=
--     if f.val ≠ g.val then ff else
--     let zs := zip (of_fn v₁) (of_fn v₂),
--         unc := function.uncurry term_seq
--     in all zs unc
-- | _ _ := ff

-- can't be finished without decidable_eq term
-- previous fix can work as well but introduces this
-- as a meta def
-- meta def term.rwt : term → term → term → term
-- | (term.var a) (term.var x) t := if x = a then t else term.var a
-- -- | (term.var a) _ _ := (term.var a)
-- | (term.app f v) x t :=
--     if term_seq (term.app f v) x then t else
--     let v₂ := λ m, term.rwt (v m) x t in
--     term.app f v₂

-- So far I haven't figured out a better way
-- to tell LEAN to unfold definitions other than to mark
-- them as reducible.
-- If they are not reducible it is always a headache to get
-- the elaborator to unfold a definition when it doesn't want to,
-- sometimes using the simplifier works, other times not.
@[reducible]
def term.vars : term → set tvariable
| (term.var a) := {a}
| (term.app f v) :=
    let v₂ := λ m, term.vars (v m) in
    ⋃ m, v₂ m
-- | _ := ∅

-- theorem hidden_variables : ∀ t : term, ∃ x : tvariable, x ∉ t.vars :=
-- let i := var_index,
--     inj := inj
-- in
-- begin
--     intro t,
--     induction t,
--     -- case t is a variable
--         let indexed := ∃ n : ℕ, i n = t,
--         classical,
--         by_cases indexed,
--             obtain ⟨n, np⟩ := h,
--             existsi i (n + 1),
--             dunfold term.vars,
--             simp,
--             intro h,
--             rw [←np] at h,
--             have c₁ := inj h,
--             have c₀ : n + 1 ≠ n := nat.succ_ne_self n,
--             contradiction,
--         existsi i 0,
--         dunfold term.vars,
--         simp,
--         intro h₂,
--         apply h,
--         exact ⟨0, h₂⟩,
--     -- case t is a function application
--         dunfold term.vars,
--         simp,
--         classical,
--         by_contradiction h,
--         replace h := not_exists.mp h,
--         -- replace h := not_forall.mp h,
--         induction t_n,
--             replace h := h (i 0),
--             revert _inst,
--             have c : ∀ (x : fin 0), i 0 ∉ (t_v x).vars,
--                 intro x,
--                 apply fin_zero_elim x,
--             contradiction,
--         replace h := h (i $ t_n_n + 1),
--         replace h := not_forall.mp h,
--         obtain ⟨x, c₁⟩ := h,
--         simp at c₁,
--         replace t_ih := t_ih x,

-- end

@[reducible]
def term.denotes (t : term) := t.vars = ∅
@[reducible]
def term.conotes (t : term) := ¬ t.denotes
-- def term.concrete : term → Prop
-- | (term.var a) := true
-- | (term.abs a) := false
-- | (term.app f v) := ∀ m, term.concrete (v m)

-- a term in the proper sense of the term (pun intended).
def pterm := subtype {t : term | t.denotes}-- ∧ t.concrete}
def expression := subtype {t : term | t.conotes}-- ∧ t.concrete}
-- def cterm := subtype term.concrete

theorem den_rw : ∀ (t₁ t₂ : term) (x : tvariable), t₁.denotes → t₁.rw x t₂ = t₁ :=
begin
    intros t₁ t₂ x den₁,
    induction t₁,
    -- case var
        replace den₁ : (term.var t₁).vars = ∅ := den₁,
        replace den₁ : {t₁} = ∅ := den₁,
        simp at den₁,
        contradiction,
    -- case abs_var
        -- simp,
    -- case app
        replace den₁ : (term.app t₁_f t₁_v).vars = ∅ := den₁,
        let v₂ := λ m, (t₁_v m).vars,
        replace den₁ : (⋃ m, v₂ m) = ∅ := den₁,
        have c₀ : ∀ m, (v₂ m) = ∅,
            intro m,
            ext, constructor, intro h,
                simp,
                have c : x_1 ∈ (⋃ m, v₂ m),
                    simp,
                    existsi m,
                    exact h,
                rwa den₁ at c,
            intro insanity,
            simp at insanity,
            contradiction,
        have c₁ : ∀ m, (t₁_v m).denotes := c₀,
        have c₂ : ∀ m, (t₁_v m).rw x t₂ = (t₁_v m),
            intro m,
            exact t₁_ih m (c₁ m),
        dunfold term.rw,
        simp[c₂],
end

def term.subterms : term → set term
| (term.app f v) :=
    let v₂ := λ m, term.subterms (v m) in
    (⋃ m, v₂ m) ∪ {(term.app f v)}
| t := {t}

def list.vars : list term → set tvariable
| [] := ∅
| (hd :: tl) := hd.vars ∪ tl.vars

def list.subterms : list term → set term
| [] := ∅
| (hd :: tl) := hd.subterms ∪ tl.subterms

def list.rw : list term → tvariable → term → list term
| [] _ _:= ∅
| (hd :: tl) x t := (hd.rw x t) :: tl.rw x t

-- meta def list.rwt : list term → term → term → list term
-- | [] _ _:= ∅
-- | (hd :: tl) x t := (hd.rwt x t) :: tl.rwt x t

def subterms : set term → set term
| S := ⋃ x ∈ S, term.subterms x

-- formulas
inductive uformula
| relational {n : ℕ} (r : nrary n) (v : fin n → term) : uformula
| equation (t₁ t₂ : term) : uformula
| true : uformula
| false : uformula
| for_all :  tvariable → uformula → uformula
| exist   : tvariable → uformula → uformula
| and : uformula → uformula → uformula
| or : uformula → uformula → uformula
| if_then : uformula → uformula → uformula

reserve infixr ` ⇒ `:55
class has_exp (α : Type u) := (exp : α → α → α)
infixr ⇒ := has_exp.exp

instance uformula.has_exp : has_exp uformula := ⟨uformula.if_then⟩
@[reducible]
def uformula.rw : uformula → tvariable → term → uformula
| (uformula.relational r v) x t :=
    let v₂ := λ m, (v m).rw x t in
    uformula.relational r v₂
| (uformula.equation t₁ t₂) x t :=
    let t₃ := t₁.rw x t,
        t₄ := t₂.rw x t
    in uformula.equation t₃ t₄
| (uformula.for_all y φ) x t :=
    let ψ := if y = x then φ else φ.rw x t in
    uformula.for_all y ψ
| (uformula.exist y φ) x t :=
    let ψ := if y = x then φ else φ.rw x t in
    uformula.exist y ψ
| (uformula.and φ ψ) x t     := uformula.and (φ.rw x t) (ψ.rw x t)
| (uformula.or φ ψ)  x t     := uformula.or (φ.rw x t) (ψ.rw x t)
| (uformula.if_then φ ψ) x t := uformula.if_then (φ.rw x t) (ψ.rw x t)
| φ _ _ := φ

-- def uformula.arw : uformula → abstract_var → term → uformula
-- | (uformula.relational r v) x t :=
--     let v₂ := λ m, (v m).arw x t in
--     uformula.relational r v₂
-- | (uformula.equation t₁ t₂) x t :=
--     let t₃ := t₁.arw x t,
--         t₄ := t₂.arw x t
--     in uformula.equation t₃ t₄
-- | (uformula.for_all y φ) x t := uformula.for_all y (φ.arw x t)
-- | (uformula.exist y φ) x t   := uformula.exist y (φ.arw x t)
-- | (uformula.and φ ψ) x t     := uformula.and (φ.arw x t) (ψ.arw x t)
-- | (uformula.or φ ψ)  x t     := uformula.or (φ.arw x t) (ψ.arw x t)
-- | (uformula.if_then φ ψ) x t := uformula.if_then (φ.arw x t) (ψ.arw x t)
-- | φ _ _ := φ

-- def uformula.rwt : uformula → term → term → uformula
-- | (uformula.relational r v) x t :=
--     let v₂ := λ m, (v m).rwt x t in
--     uformula.relational r v₂
-- | (uformula.equation t₁ t₂) x t :=
--     let t₃ := t₁.rwt x t,
--         t₄ := t₂.rwt x t
--     in uformula.equation t₃ t₄
-- | (uformula.for_all y φ) x t :=
--     let ψ := if term_seq (term.var y) x then φ else φ.rwt x t in
--     uformula.for_all y ψ
-- | (uformula.exist y φ) x t :=
--     let ψ := if y = x then φ else φ.rwt x t in
--     uformula.exist y ψ
-- | (uformula.and φ ψ) x t     := uformula.and (φ.rwt x t) (ψ.rwt x t)
-- | (uformula.or φ ψ)  x t     := uformula.or (φ.rwt x t) (ψ.rwt x t)
-- | (uformula.if_then φ ψ) x t := uformula.if_then (φ.rwt x t) (ψ.rwt x t)
-- | φ _ _ := φ

-- free variables
@[reducible]
def uformula.free : uformula → set tvariable
| (uformula.relational r v) := list.vars (of_fn v)
| (uformula.equation t₁ t₂) := t₁.vars  ∪ t₂.vars
| (uformula.for_all x φ) := φ.free - {x}
| (uformula.exist x φ)   := φ.free - {x}
| (uformula.and φ ψ)     := φ.free ∪ ψ.free
| (uformula.or φ ψ)      := φ.free ∪ ψ.free
| (uformula.if_then φ ψ) := φ.free ∪ ψ.free
| _ := ∅

-- open and closed formulas.
def uformula.closed : uformula → Prop
| φ := φ.free = ∅

def uformula.open : uformula → Prop
| φ := ¬ φ.closed

def uformula.vars : uformula → set tvariable
| (uformula.for_all x φ) := φ.free ∪ {x}
| (uformula.exist x φ)   := φ.free ∪ {x}
| (uformula.and φ ψ)     := φ.vars ∪ ψ.vars
| (uformula.or φ ψ)      := φ.vars ∪ ψ.vars
| (uformula.if_then φ ψ) := φ.vars ∪ ψ.vars
| φ := φ.free

def uformula.terms : uformula → set term
| (uformula.relational r v) := list.subterms (of_fn v)
| (uformula.equation t₁ t₂) := t₁.subterms ∪ t₂.subterms
| (uformula.for_all x φ) := φ.terms ∪ {term.var x}
| (uformula.exist x φ)   := φ.terms ∪ {term.var x}
| (uformula.and φ ψ)     := φ.terms ∪ ψ.terms
| (uformula.or φ ψ)      := φ.terms ∪ ψ.terms
| (uformula.if_then φ ψ) := φ.terms ∪ ψ.terms
| _ := ∅

def term.abstract_in : term → set uformula → Prop
| t S := t ∉ (⋃ φ ∈ S, uformula.terms φ)

def tvariable.abstract_in : tvariable → set uformula → Prop
| x S := x ∉ (⋃ φ ∈ S, uformula.vars φ)

-- deductive consequence of uformulas: Γ ⊢ φ in minimal logic
inductive minimal.entails : set uformula → uformula → Prop
| reflexive (Γ : set uformula) (φ : uformula)(h : φ ∈ Γ) : minimal.entails Γ φ
| transitivity (Γ Δ : set uformula) (φ : uformula)
               (h₁ : ∀ ψ ∈ Δ, minimal.entails Γ ψ)
               (h₂ : minimal.entails Δ φ) :  minimal.entails Γ φ
| and_intro (φ ψ : uformula) (Γ : set uformula)
            (h₁ : minimal.entails Γ φ)
            (h₂ : minimal.entails Γ ψ)
             : minimal.entails Γ (uformula.and φ ψ)
| and_elim_left (φ ψ : uformula) (Γ : set uformula)
            (h : minimal.entails Γ (uformula.and φ ψ))
             : minimal.entails Γ φ
| and_elim_right (φ ψ : uformula) (Γ : set uformula)
            (h : minimal.entails Γ (uformula.and φ ψ))
             : minimal.entails Γ ψ
| or_intro_left
            (φ ψ : uformula) (Γ : set uformula)
            (h : minimal.entails Γ φ)
             : minimal.entails Γ (uformula.or φ ψ)
| or_intro_right
            (φ ψ : uformula) (Γ : set uformula)
            (h : minimal.entails Γ ψ)
             : minimal.entails Γ (uformula.or φ ψ)
| or_elim
            (φ ψ δ : uformula) (Γ : set uformula)
            (h₁ : minimal.entails Γ (uformula.or φ ψ))
            (h₂ : minimal.entails Γ (φ ⇒ δ))
            (h₃ : minimal.entails Γ (ψ ⇒ δ))
             : minimal.entails Γ δ
| modus_ponens
            (φ ψ : uformula) (Γ : set uformula)
            (h₁ : minimal.entails Γ (φ ⇒ ψ))
            (h₂ : minimal.entails Γ φ)
             : minimal.entails Γ ψ
| intro
            (φ ψ : uformula) (Γ : set uformula)
            (h : minimal.entails (Γ ∪ {φ}) ψ)
             : minimal.entails Γ (φ ⇒ ψ)
| true_intro
            (Γ : set uformula)
             : minimal.entails Γ uformula.true
| for_all_intro
            (Γ : set uformula) (φ : uformula)
            (x : tvariable) (xf : x ∈ φ.free)
            (c : const) (abs : c.term.abstract_in Γ)
            (h : minimal.entails Γ (φ.rw x c.term))
             : minimal.entails Γ (uformula.for_all x φ)
| for_all_elim
            (Γ : set uformula) (φ : uformula)
            (x : tvariable) (xf : x ∈ φ.free)
            (t : term) (den : t.denotes)
            (h : minimal.entails Γ (uformula.for_all x φ))
             : minimal.entails Γ (φ.rw x t)
| exists_intro
            (Γ : set uformula) (φ : uformula)
            (x : tvariable) (xf : x ∈ φ.free)
            (t : term) (den : t.denotes)
            (h : minimal.entails Γ (φ.rw x t))
             : minimal.entails Γ (uformula.exist x φ)
| exists_elim
            (Γ : set uformula) (φ ψ : uformula)
            (x : tvariable) (xf : x ∈ φ.free)
            (c : const) (abs : c.term.abstract_in Γ)
            (abs_φ : c.term ∉ φ.terms) (abs_ψ : c.term ∉ ψ.terms)
            (h₁ : minimal.entails Γ (uformula.exist x φ))
            (h₂ : minimal.entails Γ ((φ.rw x c.term) ⇒ ψ))
             : minimal.entails Γ ψ
| identity_intro
            (Γ : set uformula) (t : term)
             : minimal.entails Γ (uformula.equation t t)
| identity_elim
            (Γ : set uformula) (φ : uformula)
            (x : tvariable) (xf : x ∈ φ.free)
            (t₁ t₂: term) (den₁ : t₁.denotes) (den₂ : t₂.denotes)
            (h : minimal.entails Γ (φ.rw x t₁))
            (eq : minimal.entails Γ (uformula.equation t₁ t₂))
             : minimal.entails Γ (φ.rw x t₂)

-- def minimal.theorem (φ : uformula) := minimal.entails ∅ φ

inductive argument
| silence {} : argument -- empty argument
| node : uformula → argument → argument → argument → argument

def argument.assumes (φ : uformula) : argument → Prop
| argument.silence := false
| (argument.node ψ argument.silence argument.silence argument.silence) := φ = ψ
| (argument.node _ a₁ a₂ a₃) := a₁.assumes ∨
                                a₂.assumes ∨
                                a₃.assumes

@[reducible]
def argument.concludes (φ : uformula) : argument → Prop
| argument.silence := false
| (logic.argument.node ψ x y z) := ψ = φ

-- def silence := argument.silence
-- -- because I said so
-- def argument.return : uformula → argument
-- | φ := argument.node φ silence silence silence

-- tells whether an argument is a proof from Γ
-- TODO: CONVERT THIS TO INDUCTIVE DEFINITION !!!!
-- @[reducible]
-- def argument.proof_from (Γ : set uformula) : argument → Prop
-- | (argument.node φ argument.silence argument.silence argument.silence) := φ ∈ Γ ∨
--                                                                           φ = uformula.true ∨
--                                                                           ∃ t, φ = uformula.equation t t
-- -- introduction rules
-- | (argument.node (uformula.and φ ψ)
--                        γ₁
--                        γ₂
--                        argument.silence) := γ₁.concludes φ ∧
--                                             γ₂.concludes ψ ∧
--                                             γ₁.proof_from ∧
--                                             γ₂.proof_from
-- | (argument.node (uformula.or φ _)
--                        γ₁
--                        argument.silence
--                        argument.silence) := γ₁.concludes φ ∧ γ₁.proof_from
-- | (argument.node (uformula.or _ ψ)
--                        argument.silence
--                        γ₂
--                        argument.silence) := γ₂.concludes ψ ∧ γ₂.proof_from
-- | (argument.node (uformula.if_then φ ψ)
--                        γ
--                        argument.silence
--                        argument.silence) := γ.concludes ψ ∧
--                                             γ.assumes φ ∧
--                                             γ.proof_from
-- | (argument.node (uformula.for_all x φ)
--                        γ
--                        argument.silence
--                        argument.silence) := ∃ c, γ.concludes (φ.rw x $ term.abs c) ∧
--                                             x ∈ φ.free ∧
--                                             γ.proof_from
-- | (argument.node (uformula.exist x φ)
--                        γ
--                        argument.silence
--                        argument.silence) := ∃ t, γ.concludes (φ.rw x t) ∧
--                                             t.denotes ∧
--                                             x ∈ φ.free ∧
--                                             γ.proof_from
-- -- elimination rules
-- | (argument.node φ γ argument.silence argument.silence) := ((∃ ψ, γ.concludes $ uformula.and φ ψ) ∨
--                                                             (∃ ψ, γ.concludes $ uformula.and ψ φ) ∨
--                                                             (∃ x (ψ : uformula) (t : term),
--                                                              t.denotes ∧
--                                                              x ∈ ψ.free ∧
--                                                              γ.concludes (uformula.for_all x ψ) ∧
--                                                              φ = ψ.rw x t)) ∧
--                                                              γ.proof_from
-- | (argument.node φ γ₁ γ₂ argument.silence) := ((∃ ψ, γ₁.concludes (ψ ⇒ φ) ∧
--                                                γ₂.concludes ψ) ∨
--                                               (∃ x (ψ : uformula) c,
--                                                x ∈ ψ.free ∧
--                                                γ₁.concludes (uformula.exist x ψ) ∧
--                                                γ₂.concludes ((ψ.rw x $ term.abs c) ⇒ φ)) ∨
--                                               (∃ x (ψ : uformula) (t₁ t₂ : term),
--                                                t₁.denotes ∧
--                                                t₂.denotes ∧
--                                                x ∈ ψ.free ∧
--                                                γ₁.concludes (ψ.rw x t₁) ∧
--                                                γ₂.concludes (uformula.equation t₁ t₂) ∧
--                                                φ = ψ.rw x t₂)) ∧
--                                                γ₁.proof_from ∧
--                                                γ₂.proof_from
-- | (argument.node φ γ₁ γ₂ γ₃) := ∃ ψ₁ ψ₂, γ₁.concludes (uformula.or ψ₁ ψ₂) ∧
--                                          γ₂.concludes (ψ₁ ⇒ φ) ∧
--                                          γ₃.concludes (ψ₂ ⇒ φ) ∧
--                                          γ₁.proof_from ∧
--                                          γ₂.proof_from ∧
--                                          γ₃.proof_from
-- | _ := false

-- def argument.proof_of (φ : uformula) (Γ : set uformula) : argument → Prop
-- | γ := γ.proof_from Γ ∧ γ.concludes φ

variables (Γ : set uformula) (φ : uformula)

theorem self_entailment : minimal.entails Γ (φ ⇒ φ) :=
begin
    apply minimal.entails.intro,
    apply minimal.entails.reflexive (Γ∪{φ}) φ,
    simp
end

theorem id_symm : ∀ (t₁ t₂ : pterm),
                  minimal.entails Γ (uformula.equation t₁.val t₂.val) →
                  minimal.entails Γ (uformula.equation t₂.val t₁.val)  :=
let ne := var_ne in
begin
    intros t₁ t₂ h,
    apply nonempty.elim ne, intro x,
    -- φ := "x = t₁"
    let φ := uformula.equation (term.var x) t₁.val,
    have den₁ := t₁.property,
    have den₂ := t₂.property,
    have c₀ : x ∈ φ.free, simp[φ],
    have c₁ : minimal.entails Γ (φ.rw x t₁.val),
        simp[φ],
        dunfold uformula.rw, simp,
        dunfold term.rw, simp,
        rw den_rw t₁.val t₁.val x t₁.property,
        apply minimal.entails.identity_intro Γ t₁.val,
    have c₂ : minimal.entails Γ (φ.rw x t₂.val),
        apply minimal.entails.identity_elim, --Γ φ x c₀ t₁ t₂ den₂ den₁,
        repeat {assumption <|> apply_assumption},
    simp[φ] at c₂,
    have c₃ : (uformula.equation (term.var x) (t₁.val)).rw x (t₂.val) = uformula.equation (t₂.val) (t₁.val),
        dunfold uformula.rw, simp,
        constructor,
            dunfold term.rw, simp,
        apply den_rw t₁.val t₂.val x den₁,
    rwa c₃ at c₂,
end

variables (Δ : set uformula) (ψ : uformula)

-- theorem monotonicity : Δ ⊆ Γ → minimal.entails Δ ψ → minimal.entails Γ ψ :=
-- begin
--     intros H h,
--     -- induction on the possible ways in which
--     -- Δ could prove ψ
--     induction h,
--     -- case it was proven by reflection
--         apply minimal.entails.reflexive Γ h_φ,
--         exact H h_h,
--     -- case it was proven by transitivity
--         apply minimal.entails.transitivity Γ h_Δ h_φ,
--         intros ψ₂ elem,
--         repeat {assumption <|> apply_assumption},
--     -- case it was proven by and_intro
--         apply minimal.entails.and_intro,-- h_φ h_ψ Γ,
--         repeat {assumption <|> apply_assumption},
--     -- case it was proven by and_elim_left
--         apply minimal.entails.and_elim_left h_φ h_ψ Γ,
--         repeat {assumption <|> apply_assumption},
--     -- case it was proven by and_elim_right
--         apply minimal.entails.and_elim_right h_φ h_ψ Γ,
--         repeat {assumption <|> apply_assumption},
--     -- case it was proven by or_intro_left
--         apply minimal.entails.or_intro_left h_φ h_ψ Γ,
--         repeat {assumption <|> apply_assumption},
--     -- case it was proven by or_intro_right
--         apply minimal.entails.or_intro_right h_φ h_ψ Γ,
--         repeat {assumption <|> apply_assumption},
--     -- case it was proven by or_elim
--         apply minimal.entails.or_elim,-- h_φ h_ψ h_δ Γ,
--         repeat {assumption <|> apply_assumption},
--     -- case it was proven by modus ponens
--         apply minimal.entails.modus_ponens h_φ h_ψ Γ,
--         repeat {assumption <|> apply_assumption},
--     -- case it was proven by intro
--         have c : minimal.entails h_Γ (h_φ ⇒ h_ψ),
--             apply minimal.entails.intro h_φ h_ψ h_Γ,
--             assumption,
--         apply minimal.entails.transitivity Γ h_Γ (h_φ ⇒ h_ψ),
--             intros ψ₂ elem,
--             have c₂ := H elem,
--             exact minimal.entails.reflexive Γ ψ₂ c₂,
--         assumption,
--     -- case it was proven by true_intro
--         exact minimal.entails.true_intro Γ,
--     -- case it was proven by for_all_intro
--         apply minimal.entails.for_all_intro Γ h_φ h_x h_xf h_c,
--         repeat {assumption <|> apply_assumption},
--     -- case it was proven by for_all_elim
--         apply minimal.entails.for_all_elim Γ h_φ h_x h_xf,
--         repeat {assumption <|> apply_assumption},
--     -- case it was proven by exists_intro
--         apply minimal.entails.exists_intro Γ h_φ h_x h_xf h_t,
--         repeat {assumption <|> apply_assumption},
--     -- case it was proven by exists_elim
--         apply minimal.entails.exists_elim Γ h_φ h_ψ h_x h_xf,
--         repeat {assumption <|> apply_assumption},
--     -- case it was proven by identity_intro
--         apply minimal.entails.identity_intro Γ h_t,
--     -- case it was proven by identity_elim
--         apply minimal.entails.identity_elim Γ h_φ h_x h_xf h_t₁ h_t₂,
--         repeat {assumption <|> apply_assumption},
-- end

-- theorem proof_entails : (∃ p : argument, p.proof_of φ Γ) → minimal.entails Γ φ :=
-- begin
--     intro h,
--     obtain ⟨p, ph₁, ph₂⟩ := h,
--     induction p,
--         have c : false := ph₂,
--         contradiction,
--     have eq : φ = p_a := sorry,
--         -- impossible to unfold at ph₂ for some reason
--         -- simp [argument.concludes] at ph₂,
--     rw ←eq at ph₁,
--     admit,
--     -- induction φ,

--     -- simp at ph₁,

-- end

section semantics

parameters {α : Type u} [inhabited α]

-- functional interpretation
def fint  {n : ℕ} := nary n → (fin n → α) → α
-- relational interpretation
def rint {n : ℕ} := nrary n → (fin n → α) → Prop
-- variable assignment
def vasgn := tvariable → α

parameter exists_ass : nonempty vasgn

structure model :=
    (I₁ : Π {n}, @fint n)
    (I₂ : Π {n}, @rint n)

-- @[reducible]
def model.reference' (M : model) : term → vasgn → α
| (term.var x) asg := asg x
| (@term.app _ _ _ _ _  0 f _) _ := model.I₁ M f fin_zero_elim
| (@term.app _ _ _ _ _ (n+1) f v) asg := let v₂ := λ k, model.reference' (v k) asg
                                             in model.I₁ M f v₂

def model.reference (M : model) : pterm → α :=
    begin
        intro t,
        obtain ⟨t, den⟩ := t,
        induction t,
            simp [set_of] at den,
            revert den,
            dunfold term.denotes term.vars,
            intro den,
            simp at den,
            contradiction,
        cases t_n,
            exact model.I₁ M t_f fin_zero_elim,
        have den_v : ∀ x, (t_v x).denotes,
            admit,
        have ih := λ x, t_ih x (den_v x),
        exact model.I₁ M t_f ih,
    end

def model.satisfies' : model → uformula → vasgn → Prop
| M (uformula.relational r v) asg :=
          M.I₂ r $ λm,  M.reference' (v m) asg
| M (uformula.equation t₁ t₂) asg :=
    let x := model.reference' M t₁ asg,
        y := model.reference' M t₂ asg
    in x = y
| M uformula.true _ := true
| M uformula.false _ := false
| M (uformula.for_all x φ) asg :=
    ∀ (a : α) (ass : vasgn),
    ass x = a →
    (∀ y, y ≠ x → ass y = asg y) →
    M.satisfies' φ ass
| M (uformula.exist x φ) asg :=
    ∃ (a : α),
    ∀ (ass : vasgn),
    ass x = a →
    (∀ y, y ≠ x → ass y = asg y) →
    M.satisfies' φ ass
| M (uformula.and φ ψ) asg :=
    let x := model.satisfies' M φ asg,
        y := model.satisfies' M ψ asg
    in x ∧ y
| M (uformula.or φ ψ) asg :=
    let x := model.satisfies' M φ asg,
        y := model.satisfies' M ψ asg
    in x ∨ y
| M (uformula.if_then φ ψ) asg :=
    let x := model.satisfies' M φ asg,
        y := model.satisfies' M ψ asg
    in x → y

@[reducible]
def model.satisfies : model → uformula → Prop
| M φ := ∀ (ass : vasgn), M.satisfies' φ ass

local infixr `⊨₁`:55 := model.satisfies
local infixr `⊢`:55 := minimal.entails

include exists_ass
lemma false_is_unsat : ¬∃ M : model, M ⊨₁ uformula.false :=
begin
    intro h,
    obtain ⟨M, h⟩ := h,
    tactic.unfreeze_local_instances,
    obtain ⟨x⟩ := exists_ass,
    exact h x,
end
omit exists_ass

def model.for : model → set uformula → Prop
| M Γ := ∀ φ ∈ Γ, M ⊨₁ φ

-- semantic consequence
-- remember Γ and φ are already defined
def theory.follows : Prop :=
    ∀ (M : model) ass, (∀ ψ ∈ Γ, M.satisfies' ψ ass) → M.satisfies' φ ass

local infixr `⊨`:55 := theory.follows

def vasgn.bind (ass : vasgn) (x : tvariable) (val : α) : vasgn :=
    λy, if y = x then val else ass y

-- lemma uformula.rw.semantics (φ : uformula)
--                             (x : tvariable)
--                             (h₀ : x ∈ φ.free)
--                             (ass : vasgn)
--                             (M : model)
--                             (t : pterm)
--                             :
--                             M.satisfies' φ ass →
--                             M.satisfies' (φ.rw x t.val)
--                             (ass.bind x (M.reference' t.val ass))
--                             :=
-- begin
--     -- intro h,
--     induction φ;
--     dunfold uformula.rw; try{simp};
--     dunfold model.satisfies';
--     intro h,
--     -- have c₁ : (λ (m : fin φ_n), M.reference' (φ_v m) ass) = (flip M.reference' ass) ∘ φ_v,
--     --     dsimp [flip, function.comp],
--     --     refl,
--     have c : ∀ m, (M.reference' ((φ_v m).rw x t.val) (ass.bind x (M.reference' t.val ass))) = M.reference' (φ_v m) ass,
--         focus {
--             intro m,
--             induction (φ_v m);
--             dunfold term.rw;
--             dunfold vasgn.bind,
--             dunfold model.reference',
--             by_cases h₂ : x = a;
--                 simp [h₂],
--                 obtain ⟨t, pt₁, pt₂⟩ := t,
--                 induction t,
--                     dunfold model.reference',
--                     simp,

--                 revert pt₁,
--                 dunfold term.denotes,
--                 dunfold term.vars,
--                 simp,
--                     revert pt₂,
--                     dunfold term.concrete,
--                     contradiction,
--                 simp,
--                 induction t_n;
--                 dunfold model.reference',

--                     -- dunfold model.reference',

--         }

-- end

-- So pretty.
theorem soundness : Γ ⊢ φ → Γ ⊨ φ :=
begin
    intros entails M ass h,
    induction entails,
    -- case reflexive
    exact h entails_φ entails_h,
    -- case transitivity
    apply entails_ih_h₂,
    intros ψ H,
    exact entails_ih_h₁ ψ H h,
    -- case and.intro
    have c₁ := entails_ih_h₁ h,
    have c₂ := entails_ih_h₂ h,
    exact ⟨c₁, c₂⟩,
    -- case and.elim_left
    have sat := entails_ih h,
    revert sat,
    dunfold model.satisfies',
    simp,
    intros sat aux,
    exact sat,
    -- case and.elim_right
    have sat := entails_ih h,
    revert sat,
    repeat {dunfold model.satisfies', simp},
    left,
    exact entails_ih h,
    right,
    exact entails_ih h,
    -- case or_intro_left
    -- already solved
    -- case or_intro_right
    -- already solved
    -- case or_elim
    have c₁ := entails_ih_h₁ h,
    have c₂ := entails_ih_h₂ h,
    have c₃ := entails_ih_h₃ h,
    tactic.unfreeze_local_instances,
    dunfold model.satisfies' at *,
    simp at *,
    cases c₁,
        exact c₂ c₁,
    exact c₃ c₁,
    -- case modus ponens
    have c₁ := entails_ih_h₁ h,
    have c₂ := entails_ih_h₂ h,
    revert c₁,
    dunfold model.satisfies',
    simp,
    intro c₁,
    exact c₁ c₂,
    -- case intro
    intro h₂,
    have sat := entails_ih,
    apply sat,
    intros ψ H,
    cases H,
    exact h ψ H,
    simp at H,
    rwa H,
    -- case true.intro
    trivial,
    -- case universal intro
    intros x asg h₁ h₂,
    have sat := entails_ih h,
    -- focus {
    --     induction entails_φ,
    --     swap 5,
    --     revert sat,
    --     dunfold uformula.rw model.satisfies',
    --     simp,
    --     intro sat,
    --     -- revert sat;
    --     -- dunfold uformula.rw;
    --     -- dunfold model.satisfies';
    --     -- try{simp},
    --         -- intro sat,
    -- },
    admit,
    -- case universal elim
    -- focus {
    --     induction entails_φ;
    --     have sat := entails_ih h;
    --     revert sat;
    --     dunfold uformula.rw; try{simp},
    --     -- I cant go any further applying strategies to
    --     -- all goals because the linter gets very slow.
    --     dunfold model.satisfies', try{simp},
    --         intro sat,
    -- },
    admit,
    -- case exists intro
    have sat := entails_ih h,
    existsi M.reference' entails_t ass,
    intros asg h₁ h₂,
    admit,
    -- case exists elim
    admit,
    -- case identity intro
    -- already solved
    -- case identity elim
    admit,
end

end semantics

section consistency
end consistency

end formulas
end logic


example : (forall P Q R, (P <-> Q) \/ (Q <-> R) \/ (R <-> P)) -> forall P, P \/ ¬ P :=
begin
    intros,
    cases a true false P,
        have: false,
            apply true_ne_false,
            rw h,
        contradiction,
    cases h,
        right,
        intro,
        apply h.mpr,
        assumption,
    left,
    apply h.mpr,
    trivial,
end