import FOL.class_of_formulae FOL.extend

namespace fol
open formula
namespace arithmetic
open logic logic.Theory axiomatic_classical_logic' axiomatic_classical_logic
open_locale logic_symbol

variables {L L' : language.{0}}

inductive langf : ℕ → Type
| zero : langf 0
| succ : langf 1
| add  : langf 2
| mul : langf 2

inductive langp : ℕ → Type
| le : langp 2

@[reducible] def LA : language := ⟨langf, langp⟩

inductive additional_pr : ℕ → Type
| lt : additional_pr 2
| dvd : additional_pr 2
| prime : additional_pr 1

@[reducible] def additional : language := ⟨λ _, pempty, additional_pr⟩

inductive LIopen_fn : ℕ → Type
| pair : LIopen_fn 2

@[reducible] def LIopen : language := ⟨LIopen_fn, λ _, pempty⟩

inductive LISigma₁_fn : ℕ → Type
| exp : LISigma₁_fn 1

@[reducible] def LISigma₁ : language := ⟨LISigma₁_fn, λ _, pempty⟩

@[reducible] def LA' : language := LA + additional

instance : has_zero_symbol LA := ⟨langf.zero⟩
instance : has_succ_symbol LA := ⟨langf.succ⟩
instance : has_add_symbol LA := ⟨langf.add⟩
instance : has_mul_symbol LA := ⟨langf.mul⟩
instance : has_le_symbol LA := ⟨langp.le⟩

@[reducible] def LISigma₁.exp (t : term LISigma₁) : term LISigma₁ := term.app LISigma₁_fn.exp ‹t›

prefix `exp `:max := LISigma₁.exp

@[reducible] def LIopen.pair (t u : term LIopen) : term LIopen := term.app LIopen_fn.pair ‹t, u›

namespace additional
variables {L} [LA'.language_translation_coe L]

instance LA_ltc_L : LA.language_translation_coe L := language.language_translation_coe.comp LA LA' L

instance additional_ltc_L : additional.language_translation_coe L := language.language_translation_coe.comp additional LA' L

instance commutes_LA : language.commutes LA LA' L := ⟨by refl⟩

instance commutes_additional : language.commutes additional LA' L := ⟨by refl⟩

def lt (t u : term L) : formula L :=
app ((coe : LA'.pr 2 → L.pr 2) (sum.inr additional_pr.lt)) ‹t, u›

def dvd (t u : term L) : formula L :=
app ((coe : LA'.pr 2 → L.pr 2) (sum.inr additional_pr.dvd)) ‹t, u›

def prime (t : term L) : formula L := app ((coe : LA'.pr 1 → L.pr 1) (sum.inr additional_pr.prime)) ‹t›

notation t ` is_prime`:80 := prime t

instance lt_abb : abberavation₂ (@lt L _) := { map_rew := by simp[lt], arity := by simp[lt] }

instance dvd_abb : abberavation₂ (@dvd L _) := { map_rew := by simp[dvd], arity := by simp[dvd] }

instance is_prime_abb : abberavation₁ (@prime L _) := { map_rew := by simp[prime], arity := by simp[prime] }

end additional

local infix ` ≺ `:50 := additional.lt

local infix ` ⍭ `:50 := additional.dvd

inductive robinson : Theory LA
| q1 : robinson ∀₁ x, 0 ≠' Succ x
| q2 : robinson ∀₁ x, ∀₁ y, ((Succ x =' Succ y) ⟶ (x =' y))
| q3 : robinson ∀₁ x, ((x =' 0) ⊔ ∃₁ y, x =' Succ y)
| q4 : robinson ∀₁ x, x + 0 =' x
| q5 : robinson ∀₁ x y, x + Succ y =' Succ (x + y)
| q6 : robinson ∀₁ x, x * 0 =' 0
| q7 : robinson ∀₁ x y, x * Succ y =' x * y + x
| q8 : robinson ∀₁ x y, ((x ≼ y) ⟷ ∃₁ z, z + x =' y)

notation `𝐐` := robinson

instance : closed_Theory 𝐐 := ⟨λ p h, by cases h; simp[is_sentence, lrarrow_def, formula.ex, formula.and, fal_fn, ex_fn]⟩

namespace additional

instance addditional_predicate : additional.predicate := ⟨λ n, pempty.is_empty⟩

@[simp] def df_pr : Π {n} (r : additional.pr n), formula LA
| 2 additional_pr.lt := ((#0 : term LA) ≼ #1) ⊓ ((#0 : term LA) ≠' #1)
| 2 additional_pr.dvd := ∃. (#0 * #1 =' #2)
| 1 additional_pr.prime := ∃. (#0 + 1 =' #1) ⊓ ∀. (∃. (#0 * #2 =' #1) ⟶ (#0 =' 1) ⊔ (#0 =' #1))

@[reducible] def defs : LA.definitions additional :=
{ df_fn := λ n f, by exfalso; exact is_empty.false f,
  hdf_fn := λ n f, by exfalso; exact is_empty.false f,
  df_pr := @df_pr,
  hdf_pr := λ n r, by rcases r; simp[df_pr, numeral_one_def] }

variables [LA'.language_translation_coe L] (T : Theory L) [lextend defs.thy T] {i : ℕ}

@[simp] lemma thy.lt (x y) : T ⊢ (x ≺ y) ⟷ (x ≼ y) ⊓ (x ≠' y) :=
by simpa[fal_fn] using defs.pr' T additional_pr.lt ‹x, y›

@[simp] lemma thy.dvd (x y) : T ⊢ (x ⍭ y) ⟷ ∃. (#0 * x^1 =' y^1) :=
by simpa[fal_fn, ex_fn] using defs.pr' T additional_pr.dvd ‹x, y›

variables {T}

def Herbrand.lt (h₁ h₂ : Herbrand T i) : Lindenbaum T i :=
Lindenbaum.predicate_of ((coe : LA'.pr 2 → L.pr 2) (sum.inr additional_pr.lt)) ‹h₁, h₂›

infix ` ≺' `:50 := Herbrand.lt

@[simp] lemma Lindenbaum.lt_def (v) :
  Lindenbaum.predicate_of ((coe : LA'.pr 2 → L.pr 2) (sum.inr additional_pr.lt)) v = (v 0 ≺' v 1 : Lindenbaum T i) := rfl

lemma Lindenbaum.lt_eq (h₁ h₂ : Herbrand T i) : (h₁ ≺' h₂) = (h₁ ≼ h₂) ⊓ (h₁ =' h₂)ᶜ :=
by induction h₁ using fol.Herbrand.ind_on with t;
   induction h₂ using fol.Herbrand.ind_on with u;
   simpa[lt] using Lindenbaum.eq_of_provable_equiv.mp (thy.lt _ t u)

def Herbrand.dvd (h₁ h₂ : Herbrand T i) : Lindenbaum T i :=
Lindenbaum.predicate_of ((coe : LA'.pr 2 → L.pr 2) (sum.inr additional_pr.dvd)) ‹h₁, h₂›

infix ` ⍭' `:50 := Herbrand.dvd

@[simp] lemma Lindenbaum.dvd_def (v) :
  Lindenbaum.predicate_of ((coe : LA'.pr 2 → L.pr 2) (sum.inr additional_pr.dvd)) v = (v 0 ⍭' v 1 : Lindenbaum T i) := rfl

lemma Lindenbaum.dvd_eq (h₁ h₂ : Herbrand T i) : (h₁ ⍭' h₂) = ∃' (♯0 * h₁.pow =' h₂.pow : Lindenbaum T (i + 1)) :=
by induction h₁ using fol.Herbrand.ind_on with t;
   induction h₂ using fol.Herbrand.ind_on with u;
   simpa[dvd] using Lindenbaum.eq_of_provable_equiv.mp (thy.dvd _ t u)

end additional

namespace Ind

section
variables [LA.language_translation_coe L]

def succ_induction (p : formula L) : formula L := ∀.* (p.rew (0 ⌢ ı) ⟶ ∀. (p ⟶ p.rew ((Succ #0) ⌢ (λ x, #(x+1)))) ⟶ ∀. p)

def test (p : formula L) : formula L := p.rew (0 ⌢ ı)

@[simp] lemma succ_induction_sentence (p : formula L) : is_sentence (succ_induction p) := by simp[succ_induction]

def succ_induction_axiom (C : Theory LA) : Theory LA := 𝐐 ∪ (succ_induction '' C)

prefix `𝐈`:max := succ_induction_axiom

@[reducible] def peano : Theory LA := 𝐈set.univ

notation `𝐏𝐀` := peano

instance {C : Theory LA} : closed_Theory 𝐈C :=
⟨λ p h, by { rcases h with (h | ⟨p, hp, rfl⟩), { refine closed_Theory.cl h }, { simp[succ_induction] } }⟩

def collection (p : formula L) : formula L :=
  ∀₁ u, (∀₁ x ≼ᵇ u, ∃₁ y, p.rew ı-{2}) ⟶ (∃₁ v, ∀₁ x ≼ᵇ u, ∃₁ y ≼ᵇ v, p.rew ı-{2}-{2})

def collection_axiom (C : Theory LA) : Theory LA := 𝐐 ∪ (collection '' C)

prefix `𝐁`:max := collection_axiom

end

section
variables [LA'.language_translation_coe L]

def order_induction (p : formula L) : formula L := (∀₁ x, ((∀₁ y ≺ᵇ x, p.rew ı-{1}) ⟶ p)) ⟶ ∀₁ x, p

def order_induction_axiom (C : Theory LA') : Theory LA' := ↑𝐐 ∪ (order_induction '' C)

prefix `𝐈′`:max := order_induction_axiom

end

@[simp] lemma Q_ss_I {C} : 𝐐 ⊆ 𝐈C := by simp[succ_induction_axiom]

instance extend_Q_I (C : Theory LA) : extend 𝐐 𝐈C := ⟨λ p h, weakening Q_ss_I h⟩

instance extend_ax₁ (C : Theory LA) (p : formula LA) : extend 𝐐 (𝐈C +{ p }) :=
Theory.extend_of_inclusion (λ p mem, by simp[Q_ss_I mem])

instance extend_ax₂ (C : Theory LA) (p q : formula LA) : extend 𝐐 (𝐈C +{ p }+{ q }) :=
Theory.extend_of_inclusion (λ p mem, by simp[Q_ss_I mem])

instance extend_ax₃ (C : Theory LA) (p q r : formula LA) : extend 𝐐 (𝐈C +{ p }+{ q }+{ r }) :=
Theory.extend_of_inclusion (λ p mem, by simp[Q_ss_I mem])

instance extend_ax₄ (C : Theory LA) (p q r s : formula LA) : extend 𝐐 (𝐈C +{ p }+{ q }+{ r }+{ s }) :=
Theory.extend_of_inclusion (λ p mem, by simp[Q_ss_I mem])

end Ind

namespace robinson
open Herbrand Lindenbaum provable
variables {L} [LA.language_translation_coe L] (Q : Theory L) [lextend 𝐐 Q] (i : ℕ)

@[simp] lemma zero_ne_succ (t : term L) : Q ⊢ 0 ≠' Succ t :=
by { have : Q ⊢ ∀₁ x, 0 ≠' Succ x, by simpa[fal_fn] using provable.lextend (by_axiom robinson.q1) Q,
     simpa using this ⊚ t }

@[simp] lemma Lindembaum.zero_ne_succ (h : Herbrand Q i) : 0 =' Succ h = (⊥ : Lindenbaum Q i) :=
by { induction h using fol.Herbrand.ind_on with t,
     simpa[Lindenbaum.eq_neg_of_provable_neg_0] using zero_ne_succ (Q^i) t }

@[simp] lemma Lindenbaum.succ_ne_zero (h : Herbrand Q i) : Succ h =' 0 = (⊥ : Lindenbaum Q i) :=
by simp [Lindenbaum.equal_symm (Succ h) 0]

@[simp] lemma succ_inj (t u : term L) :
  Q ⊢ (Succ t =' Succ u) ⟶ (t =' u) :=
by { have : Q ⊢ ∀₁ x y, (Succ x =' Succ y) ⟶ (x =' y), by simpa[fal_fn] using provable.lextend (by_axiom robinson.q2) Q,
     simpa[fal_fn] using this ⊚ t ⊚ u }

@[simp] lemma Lindenbaum.succ_inj  (h₁ h₂ : Herbrand Q i) : (Succ h₁ =' Succ h₂ : Lindenbaum Q i) = (h₁ =' h₂) :=
by { induction h₁ using fol.Herbrand.ind_on with t,
     induction h₂ using fol.Herbrand.ind_on with u,
     have : Q^i ⊢ (Succ t =' Succ u) ⟷ (t =' u), by simp[iff_equiv],
     simpa using Lindenbaum.eq_of_provable_equiv.mp this }

lemma Herbrand.succ_injective : function.injective (has_succ.succ : Herbrand Q i → Herbrand Q i) :=
λ h₁ h₂,
begin
  induction h₁ using fol.Herbrand.ind_on with t,
  induction h₂ using fol.Herbrand.ind_on with u,
  intros h,
  have lmm₁ : Q^i ⊢ Succ t =' Succ u, from Herbrand.eq_of_provable_equiv.mpr (by simp[h]),
  have lmm₂ : Q^i ⊢ (Succ t =' Succ u) ⟶ (t =' u), by simp,
  have : Q^i ⊢ t =' u, from lmm₂ ⨀ lmm₁,
  exact Herbrand.eq_of_provable_equiv.mp this
end

@[simp] lemma Herbrand.succ_injective_iff (h₁ h₂ : Herbrand Q i) : Succ h₁ = Succ h₂ ↔ h₁ = h₂ :=
⟨@@Herbrand.succ_injective _ Q _ i, λ h, by simp[h]⟩

@[simp] lemma zero_or_succ (t) : Q ⊢ (t =' 0) ⊔ (∃₁ y, t^1 =' Succ y) :=
by { have : Q ⊢ ∀₁ x, (x =' 0) ⊔ (∃₁ y, x =' Succ y), by simpa[fal_fn, ex_fn] using provable.lextend (by_axiom robinson.q3) Q,
     simpa[fal_fn, ex_fn] using this ⊚ t }

@[simp] lemma add_zero (t : term L) : Q ⊢ t + 0 =' t :=
by { have : Q ⊢ ∀₁ x, (x + 0 =' x), by simpa[fal_fn, ex_fn] using provable.lextend (by_axiom robinson.q4) Q,
     simpa[fal_fn, ex_fn] using this ⊚ t }

@[simp] lemma Herbrand.add_zero (h : Herbrand Q i) : h + 0 = h :=
by { induction h using fol.Herbrand.ind_on with t,
     simpa using Herbrand.eq_of_provable_equiv.mp (add_zero (Q^i) t) }

@[simp] lemma add_succ (t u : term L) : Q ⊢ t + Succ u =' Succ (t + u) :=
by { have : Q ⊢ ∀₁ x y, x + Succ y =' Succ (x + y), by simpa[fal_fn, ex_fn] using provable.lextend (by_axiom robinson.q5) Q,
     simpa[fal_fn, ex_fn] using this ⊚ t ⊚ u }

@[simp] lemma Herbrand.add_succ {i} (h₁ h₂ : Herbrand Q i) : h₁ + Succ h₂ = Succ (h₁ + h₂) :=
by { induction h₁ using fol.Herbrand.ind_on with t,
     induction h₂ using fol.Herbrand.ind_on with u,
     simpa using Herbrand.eq_of_provable_equiv.mp (add_succ (Q^i) t u) }

@[simp] lemma mul_zero (t : term L) : Q ⊢ t * 0 =' 0 :=
by { have : Q ⊢ ∀₁ x, x * 0 =' 0, by simpa[fal_fn, ex_fn] using provable.lextend (by_axiom robinson.q6) Q,
     simpa[fal_fn, ex_fn] using this ⊚ t }

@[simp] lemma Herbrand.mul_zero  (h : Herbrand Q i) : h * 0 = 0 :=
by { induction h using fol.Herbrand.ind_on with t,
     simpa using Herbrand.eq_of_provable_equiv.mp (mul_zero (Q^i) t) }

@[simp] lemma mul_succ (t u : term L) : Q ⊢ t * Succ u =' t * u + t :=
by { have : Q ⊢ ∀₁ x y, x * Succ y =' x * y + x, by simpa[fal_fn, ex_fn] using provable.lextend (by_axiom robinson.q7) Q,
     simpa[fal_fn, ex_fn] using this ⊚ t ⊚ u }

@[simp] lemma Herbrand.mul_succ {i} (h₁ h₂ : Herbrand Q i) : h₁ * Succ h₂ = h₁ * h₂ + h₁ :=
by { induction h₁ using fol.Herbrand.ind_on with t,
     induction h₂ using fol.Herbrand.ind_on with u,
     simpa using Herbrand.eq_of_provable_equiv.mp (mul_succ (Q^i) t u) }

@[simp] lemma le_iff (t u : term L) : Q ⊢ (t ≼ u) ⟷ ∃. (#0 + t^1 =' u^1) :=
by { have : Q ⊢ ∀₁ x y, (x ≼ y) ⟷ ∃₁ z, (z + x =' y), by simpa[fal_fn, ex_fn] using provable.lextend (by_axiom robinson.q8) Q,
     simpa[fal_fn, ex_fn, ←term.pow_rew_distrib] using this ⊚ t ⊚ u }

lemma Lindenbaum.le_iff {h₁ h₂ : Herbrand Q i} :
  (h₁ ≼ h₂ : Lindenbaum Q i) = ∃' (♯0 + h₁.pow =' h₂.pow : Lindenbaum Q (i + 1)) :=
by { induction h₁ using fol.Herbrand.ind_on with t,
     induction h₂ using fol.Herbrand.ind_on with u,
     simpa[ex_fn] using Lindenbaum.eq_of_provable_equiv.mp (le_iff (Q^i) t u) }

namespace Lindenbaum

lemma le_of_eq (e : Herbrand Q i) {h₁ h₂ : Herbrand Q i} (h : e + h₁ = h₂) : h₁ ≤ h₂ :=
begin
  induction e using fol.Herbrand.ind_on with u,
  induction h₁ using fol.Herbrand.ind_on with t₁,
  induction h₂ using fol.Herbrand.ind_on with t₂,
  have lmm₁ : Q^i ⊢ ∃. (#0 + t₁^1 =' t₂^1),
  { refine use u _, simp, refine Herbrand.eq_of_provable_equiv.mpr (by simp[h]) },
  have lmm₂ : Q^i ⊢ (t₁ ≼ t₂) ⟷ ∃. (#0 + t₁^1 =' t₂^1), by simp,
  exact Herbrand.le_iff_provable_le.mp (of_equiv lmm₁ (equiv_symm lmm₂))
end

@[simp] lemma le_add_self (h₁ h₂ : Herbrand Q i) : h₁ ≤ h₂ + h₁ := le_of_eq Q i h₂ rfl

@[simp] lemma succ_inj_le {h₁ h₂ : Herbrand Q i} :
  (Succ h₁ ≼ Succ h₂ : Lindenbaum Q i) = (h₁ ≼ h₂) := by simp[le_iff, succ_pow]

lemma add_numeral_eq_numeral_add (m n : ℕ) : (n˙ : Herbrand Q i) + m˙ = (n + m)˙ :=
by induction m with m IH; simp[numeral, *, ←nat.add_one, ←add_assoc]

lemma mul_numeral_eq_numeral_mul (m n : ℕ) : (n˙ : Herbrand Q i) * m˙ = (n * m)˙ :=
by induction m with m IH; simp[numeral, *, ←nat.add_one, add_numeral_eq_numeral_add, mul_add]

lemma succ_add_numeral_eq_add_succ_numeral (h : Herbrand Q i) (n : ℕ) : Succ h + n˙ = h + (n + 1)˙ :=
by induction n with n IH; simp[numeral, *]

end Lindenbaum

@[simp] lemma add_eq_zero : Q ⊢ ∀₁ x y, (x + y =' 0) ⟶ (x =' 0) ⊓ (y =' 0) :=
begin
  refine generalize (generalize _), simp[fal_fn],
  have lmm₁ : ⤊⤊Q ⊢ (#0 =' 0) ⟶ (#1 + #0 =' 0) ⟶ (#1 =' 0) ⊓ (#0 =' 0),
    from (deduction.mp (by simp [le_of_provable_imply_0, rew_by_axiom₁])),
  have lmm₂ : ⤊⤊Q ⊢ (∃₁ y, #1 =' Succ y) ⟶ (#1 + #0 =' 0) ⟶ (#1 =' 0) ⊓ (#0 =' 0),
    from imply_ex_of_fal_imply (generalize (deduction.mp (by simp [le_of_provable_imply_0, rew_by_axiom₁]))),
  exact case_of_ax (zero_or_succ _ #0) lmm₁ lmm₂
end

@[simp] lemma Lindenbaum.add_eq_0_of_eq_0 (x y : Herbrand Q i) :
  (x + y =' 0 : Lindenbaum Q i) = (x =' 0) ⊓ (y =' 0) :=
begin
  induction x using fol.Herbrand.ind_on,
  induction y using fol.Herbrand.ind_on,
  have : Q^i ⊢ (x + y =' 0) ⟷ (x =' 0) ⊓ (y =' 0),
  { simp[iff_equiv],
    refine ⟨by simpa[fal_fn] using add_eq_zero (Q^i) ⊚ x ⊚ y, deduction.mp _⟩, simp,
    simp[Herbrand.eq_of_provable_equiv_0, rew_by_axiom₁, rew_by_axiom₂] },
  simpa using Lindenbaum.eq_of_provable_equiv.mp this
end

lemma mul_eq_zero : Q ⊢ ∀₁ x y, (x * y =' 0) ⟶ (x =' 0) ⊔ (y =' 0) :=
begin
  refine generalize (generalize _), simp[fal_fn],
  have lmm₁ : ⤊⤊Q ⊢ (#0 =' 0) ⟶ (#1 * #0 =' 0) ⟶ (#1 =' 0) ⊔ (#0 =' 0),
  { refine (deduction.mp _),
    simp[le_of_provable_imply_0, rew_by_axiom₁] },
  have lmm₂ : ⤊⤊Q ⊢ (∃₁ y, #1 =' Succ y) ⟶ (#1 * #0 =' 0) ⟶ (#1 =' 0) ⊔ (#0 =' 0),
  { refine imply_ex_of_fal_imply (generalize (deduction.mp _)), simp,
    simp[le_of_provable_imply_0, rew_by_axiom₁] },
  exact case_of_ax (zero_or_succ _ #0) lmm₁ lmm₂
end

lemma zero_le : Q ⊢ ∀₁ x, 0 ≼ x :=
begin
  refine generalize _, simp[fal_fn],
  have : ⤊Q ⊢ (0 ≼ #0) ⟷ (∃₁ z, z + 0 =' #1), by simpa using (le_iff ⤊Q 0 #0),
  refine of_equiv (use #0 (by simp)) (equiv_symm this),
end

@[simp] lemma Lindenbaum.zero_le (h : Herbrand Q i) : 0 ≤ h :=
by induction h using fol.Herbrand.ind_on with t;
   simpa using Herbrand.le_iff_provable_le.mp (by simpa[fal_fn] using zero_le (Q^i) ⊚ t)

@[simp] lemma le_zero_equiv_eq_zero : Q ⊢ ∀₁ x, (x ≼ 0) ⟷ (x =' 0) :=
begin
  refine generalize _, simp[fal_fn],
  suffices : ⤊Q ⊢ ∃. (#0 + #1 =' 0) ⟷ (#0 =' 0),
    by simpa[Lindenbaum.eq_of_provable_equiv_0, Lindenbaum.le_iff] using this,
  simp[iff_equiv], split,
  { refine ((pnf_imply_ex_iff_fal_imply₁ _ _).mpr $ generalize _),
    simp[Lindenbaum.le_of_provable_imply_0] },
  { refine deduction.mp (use 0 _), simp[ı, Herbrand.eq_of_provable_equiv_0, rew_by_axiom₁] }
end

@[simp] lemma Lindenbaum.le_zero_eq_eq_zero (h : Herbrand Q i) : (h ≼ 0 : Lindenbaum Q i) = (h =' 0) :=
by induction h using fol.Herbrand.ind_on with t;
   simpa[Lindenbaum.eq_of_provable_equiv_0] using (le_zero_equiv_eq_zero (Q^i) ⊚ t)

@[simp] lemma add_numeral_eq_numeral_add (n m : ℕ) : Q ⊢ (n˙ : term L) + m˙ =' (n + m)˙ :=
by simp[Herbrand.eq_of_provable_equiv_0, Lindenbaum.add_numeral_eq_numeral_add]

@[simp] lemma mul_numeral_eq_numeral_mul (n m : ℕ) : Q ⊢ (n˙ : term L) * m˙ =' (n * m)˙ :=
by simp[Herbrand.eq_of_provable_equiv_0, Lindenbaum.mul_numeral_eq_numeral_mul]

lemma le_numeral_of_le {n m : ℕ} (h : n ≤ m) : Q ⊢ (n˙ : term L) ≼ m˙ :=
begin
  let l := m - n,
  have : m = l + n, from (nat.sub_eq_iff_eq_add h).mp rfl,
  simp[this],
  refine of_equiv (use (l˙) _) (equiv_symm $ le_iff Q (n˙) ((l + n)˙)), simp
end

lemma le_numeral_iff (n : ℕ) : Q ⊢ ∀. ((#0 ≼ n˙) ⟷ ⋁ i : fin (n+1), #0 =' (i : ℕ)˙) :=
begin
  suffices : ∀ k : ℕ, Q^k ⊢ ∀. ((#0 ≼ n˙) ⟷ ⋁ i : fin (n+1), #0 =' (i : ℕ)˙),
  { exact this 0 },
  induction n with n IH,
  { intros k, refine generalize _, simp[Lindenbaum.eq_of_provable_equiv_0], exact Lindenbaum.le_zero_eq_eq_zero _ _ _ },
  { intros k, refine generalize _,
    simp[←Theory.sf_itr_succ, iff_equiv, -finitary.disjunction], split,
    { have zero : Q^(k + 1) ⊢ (#0 =' 0) ⟶ (#0 ≼ (n + 1)˙) ⟶ ⋁ (i : fin (n.succ + 1)), #0 =' ↑i˙,
      { refine (deduction.mp $ deduction.mp $ imply_or_right _ _ ⨀ (rew_of_eq 0 0 (by simp) _)),
        simp, refine disjunction_of ⟨0, by simp⟩ (by simp[numeral]) },
      have succ : Q^(k + 1) ⊢ (∃₁ y, #1 =' Succ y) ⟶ (#0 ≼ (n + 1)˙) ⟶ ⋁ (i : fin (n.succ + 1)), #0 =' ↑i˙,
      { refine (imply_ex_of_fal_imply $ generalize $ deduction.mp $ rew_of_eq (Succ #0) 1 (by simp) (deduction.mp _)),
        simp[ -finitary.disjunction, ←Theory.sf_itr_succ],
        have : (Q^(k + 2)) +{ #1 =' Succ #0 } +{ Succ #0 ≼ (n + 1)˙ } ⊢ #0 ≼ n˙,
          from of_equiv_p (show _ ⊢ Succ #0 ≼ (n + 1)˙, by simp) (by simp[numeral, Lindenbaum.eq_of_provable_equiv_0]),
        have lmm₁ : (Q^(k + 2)) +{ #1 =' Succ #0 } +{ Succ #0 ≼ (n + 1)˙ } ⊢ ⋁ (i : fin (n + 1)), #0 =' ↑i˙,
          from of_equiv_p this (weakening
            (show Q^(k + 2) ⊆ (Q^(k + 2)) +{ #1 =' Succ #0 } +{ Succ #0 ≼ (n + 1)˙ }, by { intros p mem, refine set.subset_insert _ _ (set.subset_insert _ _ mem) })
            (show Q^(k + 2) ⊢ (#0 ≼ n˙) ⟷ ⋁ (i : fin (n + 1)), #0 =' ↑i˙, by simpa using IH (k + 2) ⊚ #0)),
        have lmm₂ : (Q^(k + 2)) +{ #1 =' Succ #0 } +{ Succ #0 ≼ (n + 1)˙ } ⊢ (⋁ (i : fin (n + 1)), #0 =' ↑i˙) ⟶ (⋁ (i : fin (n.succ + 1)), Succ #0 =' ↑i˙),
        { suffices : (Q^(k + 2)) +{ #1 =' Succ #0 } +{ Succ #0 ≼ (n + 1)˙ } ⊢ ⋀ (i : fin (n + 1)), (#0 =' ↑i˙) ⟶ ⋁ (i : fin (n.succ + 1)), Succ #0 =' ↑i˙,
            from of_equiv this (conj_imply_iff_disj_imply _ _),
          refine conjunction_iff.mpr (λ i, deduction.mp $ rew_of_eq (↑i˙) 0 (by simp) _), simp[-finitary.disjunction],
          refine disjunction_of ⟨i + 1, by simp⟩ (by simp[numeral]) },
        exact lmm₂ ⨀ lmm₁ },
      exact case_of_ax (show (Q^(k + 1)) ⊢ (#0 =' 0) ⊔ ∃₁ y, (#1 =' Succ y), from zero_or_succ (Q^(k + 1)) #0) zero succ },
    { refine of_equiv (conjunction_iff.mpr _) (conj_imply_iff_disj_imply _ _),
      rintros ⟨i, hi⟩, refine (deduction.mp $  rew_of_eq (i˙) 0 (by simp) _),
      simp[←nat.add_one],
      exact le_numeral_of_le _ (show i ≤ n + 1, from nat.lt_succ_iff.mp hi) } }
end

end robinson

namespace Ind
open Herbrand Lindenbaum robinson.Lindenbaum provable
variables (C : Theory LA)
          {L} [LA.language_translation_coe L] (T : Theory L) [lextend 𝐈C T]
          {L'} [LA'.language_translation_coe L'] (T' : Theory L') [lextend 𝐈C T']

lemma I_succ_induction_aux (p : formula LA) (h : p ∈ C) :
  T ⊢ succ_induction p :=
by { have : 𝐈C ⊢ succ_induction p, from by_axiom (by { simp[succ_induction_axiom, h], refine or.inr ⟨p, by simp[h]⟩ }),
     simpa[succ_induction, language.language_translation_coe.coe_p_rew] using provable.lextend this T }

lemma I_succ_induction (p : formula LA) (h : p ∈ C) :
  T ⊢ p.rew (0 ⌢ ı) ⟶ ∀. (p ⟶ p.rew ((Succ #0) ⌢ (λ x, #(x+1)))) ⟶ ∀. p :=
by simpa using provable.fal_complete_rew _ ı ⨀ (I_succ_induction_aux C T p h)

lemma equiv_succ_induction_of_equiv {T₀ : Theory L} [closed_Theory T₀] {p q : formula L} (h : T₀ ⊢ p ⟷ q) :
  T₀ ⊢ succ_induction p ⟷ succ_induction q :=
begin
  refine (equiv_fal_complete_of_equiv _), simp,
  refine (equiv_imply_of_equiv _ $ equiv_imply_of_equiv _ _),
  { simpa using cl_prove_rew h (0 ⌢ ı) },
  { refine equiv_univ_of_equiv (equiv_imply_of_equiv _ _); simp*, simpa using cl_prove_rew h _ },
  { refine equiv_univ_of_equiv (by simp[h]) }
end

@[simp] lemma equiv_succ_induction_of_equgiv {L₁ L₂ : language.{0}}
  [LA.language_translation_coe L₁] [LA.language_translation_coe L₂] [L₁.language_translation_coe L₂] [LA.commutes L₁ L₂]
  (p : formula L₁) :
  (↑(succ_induction p : formula L₁) : formula L₂) = succ_induction (↑p : formula L₂) :=
by simp[succ_induction, language.language_translation_coe.coe_p_rew, function.comp]

section
variables {L₁ L₂ : language.{0}}
  [LA'.language_translation_coe L₁] [LA'.language_translation_coe L₂] [L₁.language_translation_coe L₂] [LA'.commutes L₁ L₂]

@[simp] lemma coe_lt (t u : term L₁) : ((t ≺ u : formula L₁) : formula L₂) = (t ≺ u) :=
by simp[additional.lt]; refine language.commutes.coe_coe_pr_of_commute _

@[simp] lemma coe_dvd (t u : term L₁) : ((t ⍭ u : formula L₁) : formula L₂) = (t ⍭ u) :=
by simp[additional.dvd]; refine language.commutes.coe_coe_pr_of_commute _

@[simp] lemma quantifier_fn_aux_lt (s) (f g : term L₁ → term L₁) (t u : term L₁) :
  quantifier_fn_aux s (λ x, f x ≺ g x) (t ≺ u) = (f #s ≺ g #s) := rfl

@[simp] lemma quantifier_fn_aux_dvd (s) (f g : term L₁ → term L₁) (t u : term L₁) :
  quantifier_fn_aux s (λ x, f x ⍭ g x) (t ⍭ u) = (f #s ⍭ g #s) := rfl

end

end Ind

namespace Iopen
open Lindenbaum Herbrand additional robinson Ind robinson.Lindenbaum provable
variables {L} [LA.language_translation_coe L] (Iₒₚₑₙ : Theory L) [lextend 𝐈is_open Iₒₚₑₙ] (i : ℕ)
          {L'} [LA'.language_translation_coe L'] (Iₒₚₑₙ' : Theory L') [lextend 𝐈is_open Iₒₚₑₙ']
          [lextend additional.defs.thy Iₒₚₑₙ']

instance lextend_Q : lextend 𝐐 Iₒₚₑₙ := Theory.lextend_trans 𝐐 𝐈is_open Iₒₚₑₙ

lemma I_succ_induction_LA (p : formula LA') (h : formula.coe_inv_is_open defs p):
  Iₒₚₑₙ' ⊢ p.rew (0 ⌢ ı) ⟶ ∀. (p ⟶ p.rew ((Succ #0) ⌢ (λ x, #(x+1)))) ⟶ ∀. p :=
begin
  have : Iₒₚₑₙ' ⊢ succ_induction ↑p ⟷ succ_induction ↑(coe_inv defs p),
    by simpa using provable.lextend (equiv_succ_induction_of_equiv (coe_inv_equiv additional.defs p)) Iₒₚₑₙ',
  have : Iₒₚₑₙ' ⊢ succ_induction ↑p,
    from of_equiv_p (I_succ_induction_aux is_open Iₒₚₑₙ' (coe_inv defs p) (by simp[set.mem_def, h])) (equiv_symm this),
  simpa using provable.fal_complete_rew _ ı ⨀ this
end

@[simp] lemma zero_add : Iₒₚₑₙ ⊢ ∀₁ x, 0 + x =' x :=
begin
  have lmm₁ : Iₒₚₑₙ ⊢ (0 + 0 =' 0) ⟶ ∀. ((0 + #0 =' #0) ⟶ (0 + Succ #0 =' Succ #0)) ⟶ ∀. (0 + #0 =' #0),
    by simpa using Ind.I_succ_induction is_open Iₒₚₑₙ (0 + #0 =' #0) (by simp[set.mem_def]),
  have lmm₂ : Iₒₚₑₙ ⊢ ∀. ((0 + #0 =' #0) ⟶ (0 + Succ #0 =' Succ #0)),
  { refine generalize (deduction.mp _),
    have : ⤊Iₒₚₑₙ +{ 0 + #0 =' #0 } ⊢ 0 + #0 =' #0, by simp,
    simp[Herbrand.eq_of_provable_equiv_0] at this ⊢, exact this },
  simpa using (lmm₁ ⨀ (by simp[Herbrand.eq_of_provable_equiv_0]) ⨀ lmm₂)
end

@[simp] lemma Lindenbaum.zero_add (h : Herbrand Iₒₚₑₙ i) : 0 + h = h :=
by induction h using fol.Herbrand.ind_on with t;
   simpa using Herbrand.eq_of_provable_equiv.mp (zero_add (Iₒₚₑₙ^i) ⊚ t)

@[simp] lemma succ_add : Iₒₚₑₙ ⊢ ∀₁ x y, Succ x + y =' Succ (x + y) :=
begin
  have ind : ⤊Iₒₚₑₙ ⊢ (Succ #0 + 0 =' Succ (#0 + 0)) ⟶
                    ∀. ((Succ #1 + #0 =' Succ (#1 + #0)) ⟶ (Succ #1 + Succ #0 =' Succ (#1 + Succ #0))) ⟶
                    ∀. (Succ #1 + #0 =' Succ (#1 + #0)),
  by simpa using Ind.I_succ_induction is_open ⤊Iₒₚₑₙ (Succ #1 + #0 =' Succ (#1 + #0)) (by simp[set.mem_def]),
  have zero : ⤊Iₒₚₑₙ ⊢ Succ #0 + 0 =' Succ (#0 + 0),  by simp[Herbrand.eq_of_provable_equiv_0],
  have succ : ⤊Iₒₚₑₙ ⊢ ∀. ((Succ #1 + #0 =' Succ (#1 + #0)) ⟶ (Succ #1 + Succ #0 =' Succ (#1 + Succ #0))),
  { refine (generalize $ deduction.mp _), simp,
    have : ⤊⤊Iₒₚₑₙ +{ Succ #1 + #0 =' Succ (#1 + #0) } ⊢ Succ #1 + #0 =' Succ (#1 + #0), by simp,
    simp[Herbrand.eq_of_provable_equiv_0] at this ⊢,  exact this },
  simpa using (generalize $ ind ⨀ zero ⨀ succ)
end

@[simp] lemma Lindenbaum.succ_add (h₁ h₂ : Herbrand Iₒₚₑₙ i) : Succ h₁ + h₂ = Succ (h₁ + h₂) :=
by induction h₁ using fol.Herbrand.ind_on with t;
   induction h₂ using fol.Herbrand.ind_on with u;
   simpa using Herbrand.eq_of_provable_equiv.mp (succ_add (Iₒₚₑₙ^i) ⊚ t ⊚ u)

lemma add_commutative : Iₒₚₑₙ ⊢ ∀₁ x y, x + y =' y + x :=
begin
  have ind : ⤊Iₒₚₑₙ ⊢ (#0 + 0 =' 0 + #0) ⟶ ∀. ((#1 + #0 =' #0 + #1) ⟶ (#1 + Succ #0 =' Succ #0 + #1)) ⟶ ∀. (#1 + #0 =' #0 + #1),
    by simpa using Ind.I_succ_induction is_open ⤊Iₒₚₑₙ (#1 + #0 =' #0 + #1) (by simp[set.mem_def]),
  have zero : ⤊Iₒₚₑₙ ⊢ #0 + 0 =' 0 + #0, by simp[Herbrand.eq_of_provable_equiv_0],
  have succ : ⤊Iₒₚₑₙ ⊢ ∀. ((#1 + #0 =' #0 + #1) ⟶ (#1 + Succ #0 =' Succ #0 + #1)),
  { refine (generalize $ deduction.mp _), simp,
    have : ⤊⤊Iₒₚₑₙ +{ #1 + #0 =' #0 + #1 } ⊢ #1 + #0 =' #0 + #1, by simp,
    simp[Herbrand.eq_of_provable_equiv_0] at this ⊢, exact this },
  simpa using (generalize $ ind ⨀ zero ⨀ succ)
end

lemma Lindenbaum.add_commutative (h₁ h₂ : Herbrand Iₒₚₑₙ i) : h₁ + h₂ = h₂ + h₁ :=
by induction h₁ using fol.Herbrand.ind_on with t;
   induction h₂ using fol.Herbrand.ind_on with u;
   simpa using Herbrand.eq_of_provable_equiv.mp (add_commutative (Iₒₚₑₙ^i) ⊚ t ⊚ u)

lemma add_associative : Iₒₚₑₙ ⊢ ∀₁ x y z, x + y + z =' x + (y + z) :=
begin
  have ind : ⤊⤊Iₒₚₑₙ ⊢ (#1 + #0 + 0 =' #1 + (#0 + 0)) ⟶
                     ∀. ((#2 + #1 + #0 =' #2 + (#1 + #0)) ⟶ (#2 + #1 + Succ #0 =' #2 + (#1 + Succ #0))) ⟶
                     ∀. (#2 + #1 + #0 =' #2 + (#1 + #0)),
  by simpa using Ind.I_succ_induction is_open ⤊⤊Iₒₚₑₙ (#2 + #1 + #0 =' #2 + (#1 + #0)) (by simp[set.mem_def]),
  have zero : ⤊⤊Iₒₚₑₙ ⊢ #1 + #0 + 0 =' #1 + (#0 + 0), by simp[Herbrand.eq_of_provable_equiv_0],
  have succ : ⤊⤊Iₒₚₑₙ ⊢ ∀. ((#2 + #1 + #0 =' #2 + (#1 + #0)) ⟶ (#2 + #1 + Succ #0 =' #2 + (#1 + Succ #0))),
  { refine (generalize $ deduction.mp _), simp,
    have : ⤊⤊⤊Iₒₚₑₙ +{ #2 + #1 + #0 =' #2 + (#1 + #0) } ⊢ #2 + #1 + #0 =' #2 + (#1 + #0), by simp,
    simp[Herbrand.eq_of_provable_equiv_0] at this ⊢, exact this },
  simpa using (generalize $ generalize $ ind ⨀ zero ⨀ succ)
end

lemma Lindenbaum.add_associative (h₁ h₂ h₃ : Herbrand Iₒₚₑₙ i) : h₁ + h₂ + h₃ = h₁ + (h₂ + h₃) :=
by induction h₁ using fol.Herbrand.ind_on with t₁;
   induction h₂ using fol.Herbrand.ind_on with t₂;
   induction h₃ using fol.Herbrand.ind_on with t₃;
   simpa using Herbrand.eq_of_provable_equiv.mp (add_associative _ ⊚ t₁ ⊚ t₂ ⊚ t₃)

instance Lindenbaum.add_comm_semigroup : add_comm_semigroup (Herbrand Iₒₚₑₙ i) :=
{ add := (+),
  add_assoc := Lindenbaum.add_associative _ _,
  add_comm := Lindenbaum.add_commutative _ _ }

lemma zero_mul : Iₒₚₑₙ ⊢ ∀₁ x, 0 * x =' 0 :=
begin
  have ind : Iₒₚₑₙ ⊢ (0 * 0 =' 0) ⟶ ∀. ((0 * #0 =' 0) ⟶ (0 * Succ #0 =' 0)) ⟶ ∀. (0 * #0 =' 0),
    by simpa using Ind.I_succ_induction is_open Iₒₚₑₙ (0 * #0 =' 0) (by simp[set.mem_def]),
  have zero : Iₒₚₑₙ ⊢ 0 * 0 =' 0, by simp[Herbrand.eq_of_provable_equiv_0],
  have succ : Iₒₚₑₙ ⊢ ∀. ((0 * #0 =' 0) ⟶ (0 * Succ #0 =' 0)),
  { refine (generalize $ deduction.mp _),
    have : ⤊Iₒₚₑₙ +{ 0 * #0 =' 0 } ⊢ 0 * #0 =' 0, by simp,
    simp[Herbrand.eq_of_provable_equiv_0] at this ⊢, simp[this] },
  simpa using ind ⨀ zero ⨀ succ
end

@[simp] lemma Lindenbaum.zero_mul (h : Herbrand Iₒₚₑₙ i) : 0 * h = 0 :=
by induction h using fol.Herbrand.ind_on with t;
   simpa using Herbrand.eq_of_provable_equiv.mp (zero_mul _ ⊚ t)

lemma succ_mul : Iₒₚₑₙ ⊢ ∀₁ x y, Succ x * y =' x * y + y :=
begin
  have ind : ⤊Iₒₚₑₙ ⊢ (Succ #0 * 0 =' #0 * 0 + 0) ⟶
                    ∀. ((Succ #1 * #0 =' #1 * #0 + #0) ⟶ (Succ #1 * Succ #0 =' #1 * Succ #0 + Succ #0)) ⟶
                    ∀. (Succ #1 * #0 =' #1 * #0 + #0),
  by simpa using Ind.I_succ_induction is_open ⤊Iₒₚₑₙ (Succ #1 * #0 =' #1 * #0 + #0) (by simp[set.mem_def]),
  have zero : ⤊Iₒₚₑₙ ⊢ Succ #0 * 0 =' #0 * 0 + 0, by simp[Herbrand.eq_of_provable_equiv_0],
  have succ : ⤊Iₒₚₑₙ ⊢ ∀. ((Succ #1 * #0 =' #1 * #0 + #0) ⟶ (Succ #1 * Succ #0 =' #1 * Succ #0 + Succ #0)),
  { refine (generalize $ deduction.mp _),
    have : ⤊⤊Iₒₚₑₙ +{ Succ #1 * #0 =' #1 * #0 + #0 } ⊢ Succ #1 * #0 =' #1 * #0 + #0, by simp,
    simp[Herbrand.eq_of_provable_equiv_0] at this ⊢,
    calc (Succ ♯1 * ♯0 + ♯1 : Herbrand (⤊⤊Iₒₚₑₙ +{ Succ #1 * #0 =' #1 * #0 + #0 }) 0)
        = ♯1 * ♯0 + ♯0 + ♯1   : by rw[this]
    ... = ♯1 * ♯0 + (♯1 + ♯0) : by simp[add_assoc, add_comm]
    ... = ♯1 * ♯0 + ♯1 + ♯0   : by simp[add_assoc] },
  simpa using (generalize $ ind ⨀ zero ⨀ succ)
end

@[simp] lemma Lindenbaum.succ_mul (h₁ h₂ : Herbrand Iₒₚₑₙ i) : Succ h₁ * h₂ = h₁ * h₂ + h₂ :=
by induction h₁ using fol.Herbrand.ind_on with t;
   induction h₂ using fol.Herbrand.ind_on with u;
   simpa using Herbrand.eq_of_provable_equiv.mp (succ_mul _ ⊚ t ⊚ u)

lemma mul_commutative : Iₒₚₑₙ ⊢ ∀₁ x y, x * y =' y * x :=
begin
  have ind : ⤊Iₒₚₑₙ ⊢ (#0 * 0 =' 0 * #0) ⟶ ∀. ((#1 * #0 =' #0 * #1) ⟶ (#1 * Succ #0 =' Succ #0 * #1)) ⟶ ∀. (#1 * #0 =' #0 * #1),
    by simpa using Ind.I_succ_induction is_open ⤊Iₒₚₑₙ (#1 * #0 =' #0 * #1) (by simp[set.mem_def]),
  have zero : ⤊Iₒₚₑₙ ⊢ #0 * 0 =' 0 * #0, by simp[Herbrand.eq_of_provable_equiv_0],
  have succ : ⤊Iₒₚₑₙ ⊢ ∀. ((#1 * #0 =' #0 * #1) ⟶ (#1 * Succ #0 =' Succ #0 * #1)),
  { refine (generalize $ deduction.mp _), simp,
    have : ⤊⤊Iₒₚₑₙ +{ #1 * #0 =' #0 * #1 } ⊢ #1 * #0 =' #0 * #1, by simp,
    simp[Herbrand.eq_of_provable_equiv_0] at this ⊢, simp[this] },
  simpa using (generalize $ ind ⨀ zero ⨀ succ)
end

lemma Lindenbaum.mul_commutative (h₁ h₂ : Herbrand Iₒₚₑₙ i) : h₁ * h₂ = h₂ * h₁ :=
by induction h₁ using fol.Herbrand.ind_on with t;
   induction h₂ using fol.Herbrand.ind_on with u;
   simpa using Herbrand.eq_of_provable_equiv.mp (mul_commutative _ ⊚ t ⊚ u)

lemma mul_add : Iₒₚₑₙ ⊢ ∀₁ x y z, x * (y + z) =' x * y + x * z :=
begin
  have ind : ⤊⤊Iₒₚₑₙ ⊢ (#1 * (#0 + 0) =' #1 * #0 + #1 * 0) ⟶
                     ∀. ((#2 * (#1 + #0) =' #2 * #1 + #2 * #0) ⟶ (#2 * (#1 + Succ #0) =' #2 * #1 + #2 * Succ #0)) ⟶
                     ∀. (#2 * (#1 + #0) =' #2 * #1 + #2 * #0),
  by simpa using Ind.I_succ_induction is_open ⤊⤊Iₒₚₑₙ (#2 * (#1 + #0) =' #2 * #1 + #2 * #0) (by simp[set.mem_def]),
  have zero : ⤊⤊Iₒₚₑₙ ⊢ #1 * (#0 + 0) =' #1 * #0 + #1 * 0, by simp[Herbrand.eq_of_provable_equiv_0],
  have succ : ⤊⤊Iₒₚₑₙ ⊢ ∀. ((#2 * (#1 + #0) =' #2 * #1 + #2 * #0) ⟶ (#2 * (#1 + Succ #0) =' #2 * #1 + #2 * Succ #0)),
  { refine (generalize $ deduction.mp _), simp,
    have : ⤊⤊⤊Iₒₚₑₙ +{ #2 * (#1 + #0) =' #2 * #1 + #2 * #0 } ⊢ #2 * (#1 + #0) =' #2 * #1 + #2 * #0, by simp,
    simp[Herbrand.eq_of_provable_equiv_0] at this ⊢,
    simp[this, add_assoc] },
  simpa using (generalize $ generalize $ ind ⨀ zero ⨀ succ)
end

lemma Lindenbaum.mul_add (h₁ h₂ h₃ : Herbrand Iₒₚₑₙ i) : h₁ * (h₂ + h₃) = h₁ * h₂ + h₁ * h₃ :=
by induction h₁ using fol.Herbrand.ind_on with t₁;
   induction h₂ using fol.Herbrand.ind_on with t₂;
   induction h₃ using fol.Herbrand.ind_on with t₃;
   simpa using Herbrand.eq_of_provable_equiv.mp (mul_add _ ⊚ t₁ ⊚ t₂ ⊚ t₃)

lemma mul_associative : Iₒₚₑₙ ⊢ ∀₁ x y z, x * y * z =' x * (y * z) :=
begin
  have ind : ⤊⤊Iₒₚₑₙ ⊢ (#1 * #0 * 0 =' #1 * (#0 * 0)) ⟶
                     ∀. ((#2 * #1 * #0 =' #2 * (#1 * #0)) ⟶ (#2 * #1 * Succ #0 =' #2 * (#1 * Succ #0))) ⟶
                     ∀. (#2 * #1 * #0 =' #2 * (#1 * #0)),
  by simpa using Ind.I_succ_induction is_open ⤊⤊Iₒₚₑₙ (#2 * #1 * #0 =' #2 * (#1 * #0)) (by simp[set.mem_def]),
  have zero : ⤊⤊Iₒₚₑₙ ⊢ #1 * #0 * 0 =' #1 * (#0 * 0), by simp[Herbrand.eq_of_provable_equiv_0],
  have succ : ⤊⤊Iₒₚₑₙ ⊢ ∀. ((#2 * #1 * #0 =' #2 * (#1 * #0)) ⟶ (#2 * #1 * Succ #0 =' #2 * (#1 * Succ #0))),
  { refine (generalize $ deduction.mp _),
    have : ⤊⤊⤊Iₒₚₑₙ +{ #2 * #1 * #0 =' #2 * (#1 * #0) } ⊢ #2 * #1 * #0 =' #2 * (#1 * #0), by simp,
    simp[Herbrand.eq_of_provable_equiv_0] at this ⊢, simp[this, Lindenbaum.mul_add] },
  simpa using (generalize $ generalize $ ind ⨀ zero ⨀ succ)
end

lemma Lindenbaum.mul_associative (h₁ h₂ h₃ : Herbrand Iₒₚₑₙ i) : h₁ * h₂ * h₃ = h₁ * (h₂ * h₃) :=
by induction h₁ using fol.Herbrand.ind_on with t₁;
   induction h₂ using fol.Herbrand.ind_on with t₂;
   induction h₃ using fol.Herbrand.ind_on with t₃;
   simpa using Herbrand.eq_of_provable_equiv.mp (mul_associative _ ⊚ t₁ ⊚ t₂ ⊚ t₃)

@[simp] lemma mul_one : Iₒₚₑₙ ⊢ ∀₁ x, x * 1 =' x := generalize (Herbrand.eq_of_provable_equiv_0.mpr (by simp[numeral_one_def]))

@[simp] lemma Lindenbaum.mul_one (h : Herbrand Iₒₚₑₙ i) : h * 1 = h := by simp[numeral_one_def]

instance Lindenbaum.comm_semigroup : comm_semigroup (Herbrand Iₒₚₑₙ i) :=
{ mul := (*),
  mul_assoc := Lindenbaum.mul_associative _ _,
  mul_comm := Lindenbaum.mul_commutative _ _ }

instance Lindenbaum.distrib : distrib (Herbrand Iₒₚₑₙ i) :=
{ mul := (*), add := (+),
  left_distrib := Lindenbaum.mul_add _ _,
  right_distrib := λ a b c, by simp[mul_comm (a + b), mul_comm a, mul_comm b, Lindenbaum.mul_add] }

lemma add_right_cancel : Iₒₚₑₙ ⊢ ∀₁ x y z, (x + z =' y + z) ⟶ (x =' y) :=
begin
  have ind : ⤊⤊Iₒₚₑₙ ⊢ ((#1 + 0 =' #0 + 0) ⟶ (#1 =' #0)) ⟶
                     ∀. (((#2 + #0 =' #1 + #0) ⟶ (#2 =' #1)) ⟶ (#2 + Succ #0 =' #1 + Succ #0) ⟶ (#2 =' #1)) ⟶
                     ∀. ((#2 + #0 =' #1 + #0) ⟶ (#2 =' #1)),
  by simpa using Ind.I_succ_induction is_open ⤊⤊Iₒₚₑₙ ((#2 + #0 =' #1 + #0) ⟶ (#2 =' #1)) (by simp[set.mem_def]),
  have zero : ⤊⤊Iₒₚₑₙ ⊢ (#1 + 0 =' #0 + 0) ⟶ (#1 =' #0), by simp[Lindenbaum.le_of_provable_imply_0],
  have succ : ⤊⤊Iₒₚₑₙ ⊢ ∀. (((#2 + #0 =' #1 + #0) ⟶ (#2 =' #1)) ⟶ (#2 + Succ #0 =' #1 + Succ #0) ⟶ (#2 =' #1)),
  { refine (generalize $ deduction.mp $ deduction.mp _), simp,
    have : ⤊⤊⤊Iₒₚₑₙ +{ (#2 + #0 =' #1 + #0) ⟶ (#2 =' #1) } +{ #2 + Succ #0 =' #1 + Succ #0 } ⊢ #2 + #0 =' #1 + #0,
      from deduction.mpr (by simp[Lindenbaum.le_of_provable_imply_0]),
    exact (show _ ⊢ (#2 + #0 =' #1 + #0) ⟶ (#2 =' #1), by simp) ⨀ this },
  simpa using (generalize $ generalize $ ind ⨀ zero ⨀ succ)
end

lemma Herbrand.add_right_cancel (h₁ h₂ h₃ : Herbrand Iₒₚₑₙ i) : h₁ + h₃ = h₂ + h₃ ↔ h₁ = h₂ :=
⟨λ h, begin
  induction h₁ using fol.Herbrand.ind_on with t₁,
  induction h₂ using fol.Herbrand.ind_on with t₂,
  induction h₃ using fol.Herbrand.ind_on with t₃,
  have lmm₁ : Iₒₚₑₙ^i ⊢ t₁ + t₃ =' t₂ + t₃, from Herbrand.eq_of_provable_equiv.mpr (by simp[h]),
  have lmm₂ : Iₒₚₑₙ^i ⊢ (t₁ + t₃ =' t₂ + t₃) ⟶ (t₁ =' t₂), by simpa[fal_fn] using add_right_cancel _ ⊚ t₁ ⊚ t₂ ⊚ t₃,
  exact Herbrand.eq_of_provable_equiv.mp (lmm₂ ⨀ lmm₁)
end, λ h, by simp[h]⟩

lemma Herbrand.add_left_cancel (h₁ h₂ h₃ : Herbrand Iₒₚₑₙ i) : h₃ + h₁ = h₃ + h₂ ↔ h₁ = h₂ :=
by simp[add_comm h₃, Herbrand.add_right_cancel]

@[simp] lemma Lindenbaum.add_right_cancel (h₁ h₂ h₃ : Herbrand Iₒₚₑₙ i) : (h₁ + h₃ =' h₂ + h₃ : Lindenbaum Iₒₚₑₙ i) = (h₁ =' h₂) :=
begin
  induction h₁ using fol.Herbrand.ind_on with t₁,
  induction h₂ using fol.Herbrand.ind_on with t₂,
  induction h₃ using fol.Herbrand.ind_on with t₃,
  have : Iₒₚₑₙ^i ⊢ (t₁ + t₃ =' t₂ + t₃) ⟷ (t₁ =' t₂),
  { simp[iff_equiv], refine ⟨by simpa[fal_fn] using add_right_cancel _ ⊚ t₁ ⊚ t₂ ⊚ t₃, deduction.mp _⟩,
  simp[Herbrand.eq_of_provable_equiv_0, Lindenbaum.rew_by_axiom₁] },
  simpa using Lindenbaum.eq_of_provable_equiv.mp this
end

lemma add_le_add : Iₒₚₑₙ ⊢ ∀₁ x y z, (x + z ≼ y + z) ⟷ (x ≼ y) :=
begin
  refine (generalize $ generalize $ generalize _), simp[fal_fn],
  suffices : ⤊⤊⤊Iₒₚₑₙ ⊢ ∃. (#0 + (#3 + #1) =' #2 + #1) ⟷ ∃. (#0 + #3 =' #2),
  { simpa[Lindenbaum.eq_top_of_provable_0, Lindenbaum.le_iff] using this },
  simp[iff_equiv], split,
  { refine (imply_ex_of_fal_imply $ generalize $ deduction.mp $ use #0 _), simp[formula.pow_eq],
    have : ⤊⤊⤊⤊Iₒₚₑₙ +{ #0 + (#3 + #1) =' #2 + #1 } ⊢ #0 + (#3 + #1) =' #2 + #1, by simp,
    simp[Herbrand.eq_of_provable_equiv_0, ←add_assoc, Herbrand.add_right_cancel] at this ⊢, exact this },
  { refine (imply_ex_of_fal_imply $ generalize $ deduction.mp $ use #0 _), simp[formula.pow_eq],
    have : ⤊⤊⤊⤊Iₒₚₑₙ +{ #0 + #3 =' #2 } ⊢ #0 + #3 =' #2, by simp,
    simp[Herbrand.eq_of_provable_equiv_0, ←add_assoc, Herbrand.add_right_cancel] at this ⊢, exact this }
end

@[simp] lemma Lindenbaum.le_add_right_cancel (h₁ h₂ h₃ : Herbrand Iₒₚₑₙ i) :
  (h₁ + h₃ ≼ h₂ + h₃ : Lindenbaum Iₒₚₑₙ i) = (h₁ ≼ h₂) :=
begin
  induction h₁ using fol.Herbrand.ind_on with t₁,
  induction h₂ using fol.Herbrand.ind_on with t₂,
  induction h₃ using fol.Herbrand.ind_on with t₃,
  have : Iₒₚₑₙ^i ⊢ (t₁ + t₃ ≼ t₂ + t₃) ⟷ (t₁ ≼ t₂), by simpa[fal_fn] using add_le_add _ ⊚ t₁ ⊚ t₂ ⊚ t₃,
  simpa using Lindenbaum.eq_of_provable_equiv.mp this
end

lemma lt_equiv : Iₒₚₑₙ' ⊢ ∀₁ x y, (x ≺ y) ⟷ ∃₁ z, (Succ z + x =' y) :=
begin
  refine (generalize $ generalize _), simp[fal_fn, ex_fn],
  suffices : ⤊⤊Iₒₚₑₙ' ⊢ (#1 ≼ #0) ⊓ (#1 ≠' #0) ⟷ ∃. (Succ #0 + #(1 + 1) =' #1),
    by simpa[lt, Lindenbaum.eq_of_provable_equiv_0, Lindenbaum.lt_eq] using this,
  simp[iff_equiv], split,
  { suffices : ⤊⤊Iₒₚₑₙ' ⊢ (∃. (#0 + #2 =' #1)) ⟶ ∼(#1 =' #0) ⟶ ∃. (Succ #0 + #2 =' #1),
    { simp[Lindenbaum.le_of_provable_imply_0, Lindenbaum.le_iff] at this ⊢,
      simpa[sdiff_eq] using sdiff_le_iff.mpr (by simpa[sdiff_eq] using this) },
    refine (imply_ex_of_fal_imply $ generalize $ deduction.mp $ rew_of_eq (#0 + #2) 1 (eq_symm $ by simp) _),
    simp[formula.pow_eq],
    have zero : ⤊⤊⤊Iₒₚₑₙ' +{ #0 + #2 =' #1 } ⊢ (#0 =' 0) ⟶ (#2 ≠' #0 + #2) ⟶ ∃. (Succ #0 + #3 =' #1 + #3),
    { refine (deduction.mp _), simp[Lindenbaum.le_of_provable_imply_0, Lindenbaum.rew_by_axiom₁] },
    have succ : ⤊⤊⤊Iₒₚₑₙ' +{ #0 + #2 =' #1 } ⊢ (∃₁ y, #1 =' Succ y) ⟶ (#2 ≠' #0 + #2) ⟶ ∃. (Succ #0 + #3 =' #1 + #3),
    { refine (imply_ex_of_fal_imply $ generalize $ deduction.mp $ deduction.mp $ use #0 _), simp[←sf_dsb],
      simp[Herbrand.eq_of_provable_equiv_0, Lindenbaum.rew_by_axiom₂] },
    exact case_of_ax (zero_or_succ _ #0) zero succ },
  { refine (imply_ex_of_fal_imply $ generalize $ deduction.mp $ rew_of_eq (Succ #0 + #2) 1 (eq_symm $ by simp) _), simp,
    simp[Herbrand.le_iff_provable_le_0, Lindenbaum.eq_neg_of_provable_neg_0, -Lindenbaum.succ_add],
    simpa using Lindenbaum.add_right_cancel (⤊⤊⤊Iₒₚₑₙ' +{ Succ #0 + #2 =' #1 }) 0 0 (Succ ♯0) ♯2, }
end

lemma lt_equiv' (x y) : Iₒₚₑₙ' ⊢ (x ≺ y) ⟷ ∃₁ z, (Succ z + x^1 =' y^1) :=
by simpa[lt, fal_fn, ex_fn, ←term.pow_rew_distrib] using (lt_equiv _) ⊚ x ⊚ y

lemma Lindenbaum.lt_eq (h₁ h₂ : Herbrand Iₒₚₑₙ' i) :
  (h₁ ≺' h₂) = ∃' (Succ ♯0 + h₁.pow =' h₂.pow : Lindenbaum Iₒₚₑₙ' (i + 1)) :=
by induction h₁ using fol.Herbrand.ind_on with t;
   induction h₂ using fol.Herbrand.ind_on with u;
   simpa[lt, fal_fn, ex_fn] using Lindenbaum.eq_of_provable_equiv.mp ((lt_equiv' (Iₒₚₑₙ'^i) t u))

@[simp, refl] lemma Lindenbaum.le_refl (h : Herbrand Iₒₚₑₙ i) : h ≤ h :=
by { have : h ≤ 0 + h, from robinson.Lindenbaum.le_add_self Iₒₚₑₙ i h 0,
     simpa using this }

@[simp] lemma Lindenbaum.le_succ_refl (h : Herbrand Iₒₚₑₙ i) : h ≤ Succ h :=
by { have : h ≤ 1 + h, from robinson.Lindenbaum.le_add_self Iₒₚₑₙ i h 1,
     simpa[numeral_one_def] using this }

lemma le_transitive : Iₒₚₑₙ ⊢ ∀₁ x y z, (x ≼ y) ⟶ (y ≼ z) ⟶ (x ≼ z) :=
begin
  refine (generalize $ generalize $ generalize _), simp[fal_fn],
  suffices : ⤊⤊⤊Iₒₚₑₙ ⊢ ∃. (#0 + #3 =' #2) ⟶ ∃. (#0 + #2 =' #1) ⟶ ∃. (#0 + #3 =' #1),
  { simp[Lindenbaum.eq_top_of_provable_0, Lindenbaum.le_iff] at this ⊢, exact this },
  refine (imply_ex_of_fal_imply $ generalize $ deduction.mp $ imply_ex_of_fal_imply $ generalize $ deduction.mp $ use (#0 + #1) _),
  simp[←sf_dsb, formula.pow_eq],
  show (Iₒₚₑₙ^5) +{ #1 + #4 =' #3 } +{ #0 + #3 =' #2 } ⊢ #0 + #1 + #4 =' #2,
  by simp[Herbrand.eq_of_provable_equiv_0, Lindenbaum.rew_by_axiom₁_inv, Lindenbaum.rew_by_axiom₂_inv, add_assoc]
end

@[trans] lemma Lindenbaum.le_transitive {h₁ h₂ h₃ : Herbrand Iₒₚₑₙ i} : h₁ ≤ h₂ → h₂ ≤ h₃ → h₁ ≤ h₃ := λ le₁₂ le₂₃,
begin
  induction h₁ using fol.Herbrand.ind_on with t₁,
  induction h₂ using fol.Herbrand.ind_on with t₂,
  induction h₃ using fol.Herbrand.ind_on with t₃,
  have le₁₂ : Iₒₚₑₙ^i ⊢ t₁ ≼ t₂, from Herbrand.le_iff_provable_le.mpr le₁₂,
  have le₂₃ : Iₒₚₑₙ^i ⊢ t₂ ≼ t₃, from Herbrand.le_iff_provable_le.mpr le₂₃,
  have : Iₒₚₑₙ^i ⊢ (t₁ ≼ t₂) ⟶ (t₂ ≼ t₃) ⟶ (t₁ ≼ t₃), by simpa[fal_fn] using le_transitive _ ⊚ t₁ ⊚ t₂ ⊚ t₃,
  exact Herbrand.le_iff_provable_le.mp (this ⨀ le₁₂ ⨀ le₂₃)
end

lemma add_lt_of_lt_of_lt : Iₒₚₑₙ' ⊢ ∀₁ x y z v, (x ≺ y) ⟶ (z ≺ v) ⟶ (x + z ≺ y + v) :=
begin
  refine (generalize $ generalize $ generalize $ generalize _), simp[fal_fn],
  show Iₒₚₑₙ'^4 ⊢ (#3 ≺ #2) ⟶ (#1 ≺ #0) ⟶ (#3 + #1 ≺ #2 + #0),
  suffices : Iₒₚₑₙ'^4 ⊢ ∃. (Succ #0 + #4 =' #3) ⟶ ∃. (Succ #0 + #2 =' #1) ⟶ ∃. (Succ #0 + #4 + #2 =' #3 + #1),
  { simp[lt, Lindenbaum.eq_top_of_provable_0, Lindenbaum.lt_eq, add_pow, add_assoc] at this ⊢, simpa using this },
  refine (imply_ex_of_fal_imply $ generalize $ deduction.mp $ imply_ex_of_fal_imply $ generalize $ deduction.mp $ use (Succ #1 + #0) _),
  simp[←sf_dsb, formula.pow_eq],
  show (Iₒₚₑₙ'^6)+{ Succ #1 + #5 =' #4 }+{ Succ #0 + #3 =' #2 } ⊢ Succ (Succ #1 + #0) + #5 + #3 =' #4 + #2,
  simp[Herbrand.eq_of_provable_equiv_0, rew_by_axiom₁_inv, rew_by_axiom₂_inv],
  calc    (♯1 + ♯0 + ♯5 + ♯3 : Herbrand ((Iₒₚₑₙ'^6)+{ Succ #1 + #5 =' #4 }+{ Succ #0 + #3 =' #2 }) 0)
        = (♯1 + (♯0 + ♯5) + ♯3) : by simp[add_assoc]
    ... = (♯1 + (♯5 + ♯0) + ♯3) : by simp[add_comm]
    ... = ♯1 + ♯5 + (♯0 + ♯3)   : by simp[add_assoc]
end

lemma eq_or_succ_le_of_le : Iₒₚₑₙ ⊢ ∀₁ x y, (x ≼ y) ⟶ (x =' y) ⊔ (Succ x ≼ y) :=
begin
  refine (generalize $ generalize _), simp[fal_fn],
  suffices : ⤊⤊Iₒₚₑₙ ⊢ ∃. (#0 + #2 =' #1) ⟶ (#1 =' #0) ⊔ ∃. (#0 + Succ #2 =' #1),
  { simp[Lindenbaum.eq_top_of_provable_0, Lindenbaum.le_iff] at this ⊢, exact this },
  refine (imply_ex_of_fal_imply $ generalize _), simp[formula.pow_eq],
  show Iₒₚₑₙ^3 ⊢ (#0 + #2 =' #1) ⟶ (#2 =' #1) ⊔ ∃. (#0 + Succ #3 =' #2),
  have zero : Iₒₚₑₙ^3 ⊢ (#0 =' 0) ⟶ (#0 + #2 =' #1) ⟶ (#2 =' #1) ⊔ ∃. (#0 + Succ #3 =' #2),
  { refine (deduction.mp $ deduction.mp _),
    simp[Lindenbaum.eq_top_of_provable_0, Lindenbaum.rew_by_axiom₁_inv, Lindenbaum.rew_by_axiom₂] },
  have succ : Iₒₚₑₙ^3 ⊢ (∃₁ y, #1 =' Succ y) ⟶ (#0 + #2 =' #1) ⟶ (#2 =' #1) ⊔ ∃. (#0 + Succ #3 =' #2),
  { refine (imply_ex_of_fal_imply $ generalize $ deduction.mp $ deduction.mp $ imply_or_right _ _ ⨀ use #0 _),
    simp[Lindenbaum.eq_top_of_provable_0, Lindenbaum.rew_by_axiom₁_inv, Lindenbaum.rew_by_axiom₂] },
  exact case_of_ax (zero_or_succ _ #0) zero succ
end

lemma le_or_ge : Iₒₚₑₙ ⊢ ∀₁ x y, (x ≼ y) ⊔ (y ≼ x) :=
begin
  have ind : Iₒₚₑₙ^1 ⊢ (#0 ≼ 0) ⊔ (0 ≼ #0) ⟶
                  ∀. ((#1 ≼ #0) ⊔ (#0 ≼ #1) ⟶ (#1 ≼ Succ #0) ⊔ (Succ #0 ≼ #1)) ⟶
                  ∀. (#1 ≼ #0) ⊔ (#0 ≼ #1),
  by simpa using Ind.I_succ_induction is_open ⤊Iₒₚₑₙ ((#1 ≼ #0) ⊔ (#0 ≼ #1)) (by simp[set.mem_def]),
  have zero : Iₒₚₑₙ^1 ⊢ (#0 ≼ 0) ⊔ (0 ≼ #0), from (imply_or_right _ _ ⨀ (by simp[Herbrand.le_iff_provable_le_0])),
  have succ : Iₒₚₑₙ^1 ⊢ ∀. ((#1 ≼ #0) ⊔ (#0 ≼ #1) ⟶ (#1 ≼ Succ #0) ⊔ (Succ #0 ≼ #1)),
  { refine generalize _,
    have orl : Iₒₚₑₙ^2 ⊢ (#1 ≼ #0) ⟶ (#1 ≼ Succ #0) ⊔ (Succ #0 ≼ #1),
    { refine (deduction.mp $ imply_or_left _ _ ⨀ _),
      have : (Iₒₚₑₙ^2)+{ #1 ≼ #0 } ⊢ #1 ≼ #0, by simp,
      simp[Herbrand.le_iff_provable_le_0] at this ⊢,
      refine Lindenbaum.le_transitive _ _ this (by simp) },
    have orr : Iₒₚₑₙ^2 ⊢ (#0 ≼ #1) ⟶ (#1 ≼ Succ #0) ⊔ (Succ #0 ≼ #1),
    { refine (deduction.mp _),
      have eq      : (Iₒₚₑₙ^2) +{ #0 ≼ #1 } ⊢ (#0 =' #1) ⟶ (#1 ≼ Succ #0) ⊔ (Succ #0 ≼ #1),
      { refine (deduction.mp $ imply_or_left _ _ ⨀ _), simp[Herbrand.le_iff_provable_le_0, rew_by_axiom₁] },
      have succ_le : (Iₒₚₑₙ^2) +{ #0 ≼ #1 } ⊢ (Succ #0 ≼ #1) ⟶ (#1 ≼ Succ #0) ⊔ (Succ #0 ≼ #1),
        by simp[Lindenbaum.le_of_provable_imply_0],
      have : (Iₒₚₑₙ^2) +{ #0 ≼ #1 } ⊢ (#0 =' #1) ⊔ (Succ #0 ≼ #1),
        from deduction.mpr (show (Iₒₚₑₙ^2) ⊢ (#0 ≼ #1) ⟶ (#0 =' #1) ⊔ (Succ #0 ≼ #1),
        by simpa[fal_fn] using eq_or_succ_le_of_le _ ⊚ #0 ⊚ #1),
      exact case_of_ax this eq succ_le },
    exact or_imply _ _ _ ⨀ orl ⨀ orr },
  refine (generalize _), simp[fal_fn], exact ind ⨀ zero ⨀ succ
end

@[simp] lemma prec_open (t u : term LA') : coe_inv_is_open defs (t ≺ u) :=
by { have : ((coe : LA'.pr 2 → LA'.pr 2) (sum.inr additional_pr.lt)) = sum.inr additional_pr.lt,
       from language.language_translation_coe.coe_pr_eq_self _,
     simp[lt, this] }

lemma lt_mul_of_nonzero_of_lt :
  Iₒₚₑₙ' ⊢ ∀₁ x y z, (x ≺ y) ⟶ (z ≠' 0) ⟶ (x * z ≺ y * z) :=
begin
  have ind : Iₒₚₑₙ'^2 ⊢
       ((#1 ≺ #0) ⟶ ((0 : term LA) ≠' 0) ⟶ (#1 * 0 ≺ #0 * 0)) ⟶
    ∀. (((#2 ≺ #1) ⟶ (#0 ≠' 0) ⟶ (#2 * #0 ≺ #1 * #0)) ⟶ (#2 ≺ #1) ⟶ (Succ #0 ≠' 0) ⟶ (#2 * Succ #0 ≺ #1 * Succ #0)) ⟶
    ∀. ((#2 ≺ #1) ⟶ (#0 ≠' 0) ⟶ (#2 * #0 ≺ #1 * #0)),
  by simpa[additional.lt] using
    I_succ_induction_LA (Iₒₚₑₙ'^2) ((#2 ≺ #1) ⟶ (#0 ≠' 0) ⟶ (#2 * #0 ≺ #1 * #0)) (by simp),
  have zero : Iₒₚₑₙ'^2 ⊢ (#1 ≺ #0) ⟶ ((0 : term LA) ≠' 0) ⟶ (#1 * 0 ≺ #0 * 0), by simp[Lindenbaum.eq_top_of_provable_0],
  have succ : Iₒₚₑₙ'^2 ⊢ ∀. (((#2 ≺ #1) ⟶ (#0 ≠' 0) ⟶ (#2 * #0 ≺ #1 * #0)) ⟶ (#2 ≺ #1) ⟶ (Succ #0 ≠' 0) ⟶ (#2 * Succ #0 ≺ #1 * Succ #0)),
  { refine (generalize $ deduction.mp $ deduction.mp $ deduction.mp _), simp[-iff_and],
    have zero : (Iₒₚₑₙ'^3) +{ (#2 ≺ #1) ⟶ (#0 ≠' 0) ⟶ (#2 * #0 ≺ #1 * #0) } +{ #2 ≺ #1 } +{ Succ #0 ≠' 0 } ⊢ (#0 =' 0) ⟶ (#2 * Succ #0 ≺ #1 * Succ #0),
    { refine (deduction.mp $ rew_of_eq 0 0 (by simp) _),
      have : (Iₒₚₑₙ'^3) +{ (#2 ≺ #1) ⟶ (#0 ≠' 0) ⟶ (#2 * #0 ≺ #1 * #0) } +{ #2 ≺ #1 } +{ Succ #0 ≠' 0 }+{ #0 =' 0 } ⊢ #2 ≺ #1, by simp,
      simpa[Herbrand.iff_abberavation₂_0] using this },
    have nonzero : (Iₒₚₑₙ'^3) +{ (#2 ≺ #1) ⟶ (#0 ≠' 0) ⟶ (#2 * #0 ≺ #1 * #0) } +{ #2 ≺ #1 } +{ Succ #0 ≠' 0 } ⊢ (#0 ≠' 0) ⟶ (#2 * Succ #0 ≺ #1 * Succ #0),
    { refine (deduction.mp _),
      have lt : (Iₒₚₑₙ'^3) +{ (#2 ≺ #1) ⟶ (#0 ≠' 0) ⟶ (#2 * #0 ≺ #1 * #0) } +{ #2 ≺ #1 } +{ Succ #0 ≠' 0 } +{ #0 ≠' 0 } ⊢ #2 * #0 ≺ #1 * #0,
        from (show _ ⊢ (#2 ≺ #1) ⟶ (#0 ≠' 0) ⟶ (#2 * #0 ≺ #1 * #0), by simp) ⨀ (by simp) ⨀ (by simp),
      have : (Iₒₚₑₙ'^3) ⊢ (#2 * #0 ≺ #1 * #0) ⟶ (#2 ≺ #1) ⟶ (#2 * #0 + #2 ≺ #1 * #0 + #1),
      by simpa[fal_fn] using ((add_lt_of_lt_of_lt (Iₒₚₑₙ'^3)) ⊚ (#2 * #0) ⊚ (#1 * #0) ⊚ #2 ⊚ #1),
      have : (Iₒₚₑₙ'^3) +{ (#2 ≺ #1) ⟶ (#0 ≠' 0) ⟶ (#2 * #0 ≺ #1 * #0) } +{ #2 ≺ #1 } +{ Succ #0 ≠' 0 } +{ #0 ≠' 0 } ⊢ #2 * #0 + #2 ≺ #1 * #0 + #1,
        from this.extend ⨀ lt ⨀ (by simp),
      simp[Lindenbaum.eq_top_of_provable_0] at this ⊢, exact this },
    refine cases_of _ _ zero nonzero },
  refine (generalize $ generalize _), simp[fal_fn], exact ind ⨀ zero ⨀ succ
end

#check 0  /-
lemma mul_right_cancel_of_nonzero_aux : Iₒₚₑₙ' ⊢ ∀₁ x y z, (z ≠' 0) ⟶ (x * z =' y * z) ⟶ (x =' y) :=
begin
  refine (generalize $ generalize $ generalize _), simp[fal_fn],
  suffices : Iₒₚₑₙ'^3 ⊢ (#0 ≠' 0) ⟶ (#2 ≠' #1) ⟶ (#2 * #0 ≠' #1 * #0),
  {  simp[Lindenbaum.eq_top_of_provable_0] at this ⊢, simpa[sup_comm] using this },
  have : Iₒₚₑₙ'^3 ⊢ ∀₁ x y z, (x ≺ y) ⟶ (z ≠' 0) ⟶ (x * z ≺ y * z),
  have := (lt_mul_of_nonzero_of_lt (Iₒₚₑₙ'^3)),

  simp[fal_fn] at this,
  have orl : Iₒₚₑₙ' ⊢ (#1 ≼ #2) ⟶ ∼(#0 =' 0) ⟶ ∼(#2 =' #1) ⟶ ∼(#2 * #0 =' #1 * #0),
  { refine (deduction.mp $ deduction.mp $ deduction.mp $ ne_symm _),
    have : Iₒₚₑₙ' +{ #1 ≼ #2 } +{ #0 ≠' 0 } +{ #2 ≠' #1 } ⊢ _, { have h := (this ⊚ #1 ⊚ #2 ⊚ #0),  },
    have := this ⨀ (by {simp[lessthan_def, fal_fn], refine ne_symm (by simp) }) ⨀ (by simp[fal_fn]),
    simp[lessthan_def, fal_fn] at this, exact this.2 },
  have orr : Iₒₚₑₙ ⊢ (#2 ≼ #1) ⟶ ∼(#0 =' 0) ⟶ ∼(#2 =' #1) ⟶ ∼(#2 * #0 =' #1 * #0),
  { refine (deduction.mp $ deduction.mp $ deduction.mp _),
    have : Iₒₚₑₙ +{ #2 ≼ #1 } +{ #0 ≠' 0 } +{ #2 ≠' #1 } ⊢ _, from provable.extend (this ⊚ #2 ⊚ #1 ⊚ #0),
    have := this ⨀ (by simp[lessthan_def, fal_fn]) ⨀ (by simp[fal_fn]),
    simp[lessthan_def, fal_fn] at this, exact this.2 },
  refine case_of_ax (show Iₒₚₑₙ ⊢ (#1 ≼ #2) ⊔ (#2 ≼ #1), by simpa[fal_fn] using le_or_ge ⊚ #1 ⊚ #2) orl orr
end

lemma one_divides : Iₒₚₑₙ ⊢ ∀₁ x, 1 ⍭ x :=
begin
  simp[divides_def, fal_fn, numeral_one_def],
  refine (generalize $ use #1 _),
  simp[Herbrand.eq_of_provable_equiv_0]
end

lemma divides_self : Iₒₚₑₙ ⊢ ∀₁ x, x ⍭ x :=
begin
  simp[divides_def, fal_fn, numeral_one_def],
  refine (generalize $ use (Succ 0) _),
  simp[Herbrand.eq_of_provable_equiv_0]
end

lemma divides_zero : Iₒₚₑₙ ⊢ ∀₁ x, x ⍭ 0 :=
begin
  simp[divides_def, fal_fn],
  refine (generalize $ use 0 _),
  simp[Herbrand.eq_of_provable_equiv_0]
end

lemma divides_trans : Iₒₚₑₙ ⊢ ∀₁ x y z, (x ⍭ y) ⟶ (y ⍭ z) ⟶ (x ⍭ z) :=
begin
  simp[divides_def, fal_fn],
  refine (generalize $ generalize $ generalize $
    imply_ex_of_fal_imply $ generalize $ deduction.mp $
    imply_ex_of_fal_imply $ generalize $ deduction.mp $ use (#0 * #1) _),
  simp[formula.pow_eq, ←sf_dsb],
  show Iₒₚₑₙ +{ #1 * #5 =' #4 } +{ #0 * #4 =' #3 } ⊢ #0 * #1 * #5 =' #3,
  simp[Herbrand.eq_of_provable_equiv_0, rew_by_axiom₁_inv, rew_by_axiom₂_inv, mul_assoc]
end
-/
end Iopen
/-ₒ
def

lemma add_symm : Iₒₚₑₙ ⊢ ∀₁ x y, (x + y =' y + x) :=
begin
  refine (generalize _), simp[fal_fn],
  have zero : Iₒₚₑₙ ⊢ (#0 =' 0) ⟶ ∀. (#1 + #0 =' #0 + #1),
  { refine (deduction.mp $ generalize _), simp[←sf_dsb, Herbrand.eq_of_provable_equiv_0, rew_by_axiom₁] },
  have succ : Iₒₚₑₙ ⊢ (∃₁ y, #1 =' Succ y) ⟶ ∀. (#1 + #0 =' #0 + #1),
  { refine (imply_ex_of_fal_imply $ generalize $ deduction.mp $ rew_of_eq (Succ #0) 1 (by simp) $ generalize _), simp[formula.pow_eq, ←sf_dsb],
    suffices : Iₒₚₑₙ ⊢ Succ #1 + #0 =' #0 + Succ #1, by simp[this],

     }
end

def Ind {C : Theory LA} : Lindenbaum 𝐈C 1 → Prop := λ l, ∃ p, p ∈ C ∧ l = ⟦p⟧ᴸ

lemma Ind_mem (p : formula LA) : Ind (⟦p⟧ᴸ : Lindenbaum 𝐈C 1) → (⟦peano_induction p⟧ᴸ : Lindenbaum 𝐈C 0) = ⊤ :=
begin
  simp[Ind],
  intros p0 h eqn,
  have : 𝐈C ⊢ succ_induction p0,
  {have := provable.AX (succ_induction_axiom.ind h), exact this },
  simp[@Lindenbaum.provable_top_iff0] at *,
  have eqn : classical_logic.to_quo p = classical_logic.to_quo p0, from equiv_eq_top_iff.mp eqn,
  have : (⟦peano_induction p⟧ᴸ : Lindenbaum 𝐈C 0) = ⟦peano_induction p0⟧ᴸ,
  { simp[succ_induction, Lindenbaum.pow_eq, Lindenbaum.subst_eq, eqn], },
  simp*
end

lemma Lindenbaum_induction
  (l : Lindenbaum 𝐈C 1) (m : Lindenbaum 𝐈C 0)
  (h : Ind l)
  (zero : m ≤ 0 ⊳ l)
  (succ : m.pow ≤ (♯0 ⊳ l.pow)ᶜ ⊔ (Succ ♯0) ⊳ l.pow) : m ≤ ∀. l :=
begin
  induction l using fol.Lindenbaum.ind_on with p,
  have P := (provable_top_iff0.mpr (Ind_mem _ h)),
  have trn : (0 : Herbrand 𝐈C 0) ⊳ ⟦p⟧ᴸ ⊓ ∀. ((♯0 ⊳ pow ⟦p⟧ᴸ)ᶜ ⊔ (Succ ♯0) ⊳ pow ⟦p⟧ᴸ) ≤ ∀. ⟦p⟧ᴸ,
  { simp[succ_induction, Lindenbaum.subst_eq, Lindenbaum.pow_eq, compl_sup_iff_le,
    le_of_provable_imply_0, Herbrand.var_eq] at P, refine P },
  have succ' : m ≤ ∀. ((♯0 ⊳ pow ⟦p⟧ᴸ)ᶜ ⊔ (Succ ♯0) ⊳ pow ⟦p⟧ᴸ),
    from Lindenbaum.proper.pow_le_le_fal succ,
  have : m ≤ 0 ⊳ ⟦p⟧ᴸ ⊓ ∀. ((♯0 ⊳ pow ⟦p⟧ᴸ)ᶜ ⊔ (Succ ♯0) ⊳ pow ⟦p⟧ᴸ),
    from le_inf zero succ',
  exact le_trans this trn
end

lemma Lindenbaum_induction_top {p : formula LA} (l : Lindenbaum 𝐈C 1)
  (h : Ind l)
  (zero : 0 ⊳ l = ⊤)
  (succ : ♯0 ⊳ l.pow ≤ (Succ ♯0) ⊳ l.pow) : (∀. l : Lindenbaum 𝐈C 0) = ⊤ :=
begin
  induction l using fol.Lindenbaum.ind_on with p,
  have P := (provable_top_iff0.mpr (Ind_mem _ h)),
  have : (0 : Herbrand 𝐈C 0) ⊳ ⟦p⟧ᴸ ⊓ ∀. ((♯0 ⊳ pow ⟦p⟧ᴸ)ᶜ ⊔ (Succ ♯0) ⊳ pow ⟦p⟧ᴸ) ≤ ∀. ⟦p⟧ᴸ,
  { simp[succ_induction, Lindenbaum.subst_eq, Lindenbaum.pow_eq, compl_sup_iff_le,
    le_of_provable_imply_0, Herbrand.var_eq] at P, exact P },
  simp[zero, succ] at this,
  have eqn : (♯0 ⊳ pow ⟦p⟧ᴸ)ᶜ ⊔ (Succ ♯0) ⊳ pow ⟦p⟧ᴸ = ⊤,
    from ((♯0 ⊳ pow ⟦p⟧ᴸ).compl_sup_iff_le ((Succ ♯0) ⊳ pow ⟦p⟧ᴸ)).mpr succ,
  simp[eqn] at this, exact this
end

def Lindenbaum.bd_fal {T : Theory LA} (l : Lindenbaum T (i + 1)) (h : Herbrand T i) : Lindenbaum T i := ∀. ((♯0 ≼ h.pow)ᶜ ⊔ l)
def Lindenbaum.bd_ex {T : Theory LA} (l : Lindenbaum T (i + 1)) (h : Herbrand T i) : Lindenbaum T i := ∃. ((♯0 ≼ h.pow) ⊓ l)

notation `∀._{≼ `:95 h `} ` l :90 := Lindenbaum.bd_fal l h
notation `∃._{≼ `:95 h `} ` l :90 := Lindenbaum.bd_ex l h

theorem collection (p : formula LA) [proper 0 (𝚺⁰1)] :
  𝐈𝚺⁰1 ⊢ ([∀. ≼ #0] ∃. p) ⟶ ∃. [∀. ≼ #1] [∃. ≼ #1] ((p^3).rew ı[4 ⇝ #0]).rew ı[3 ⇝ #1] :=
begin
  simp[le_of_provable_imply_0, bounded_fal, bounded_ex, Lindenbaum.pow_eq p, Herbrand.subst_eq, Lindenbaum.subst_eq],
  suffices : ∀ l : Lindenbaum 𝐐+𝐈𝚺⁰1 2,
    ∀._{≼ ♯1} ∃. l ≤ ∃. ∀._{≼ ♯2} ∃._{≼ ♯2} (♯1 ⊳ ♯0 ⊳ l.pow.pow.pow),
  { sorry },
  intros l,
  have : ∀._{≼ ♯1} ∃. l ≤ ∀. ∀. ((♯0 ≼ ♯1)ᶜ ⊔ ∃. ∀._{≼ ♯1} ∃._{≼ ♯1} l.pow.pow.pow),
  { refine Lindenbaum_induction _ _ _ _ _; sorry }

end

theorem collection (p : formula LA) [proper 0 (𝚺⁰1)] : 𝐐+𝐈𝚺⁰1 ⊢ ([∀. ≼ #0] ∃. p) ⟶ ∃. [∀. ≼ #1] [∃. ≼ #1] p :=
begin
  refine deduction.mp _,
  have : ∀ n, ∃ m, (((ı[0 ⇝ #0] ^ 1) ^ 1) ^ 1) m = (#n : term LA) :=
    (rewriting_sf_perm $ rewriting_sf_perm $ rewriting_sf_perm $ slide_perm _ #0),
  rcases formula.total_rew_inv p this with ⟨q, e_q⟩,
  suffices : 𝐐+𝐈𝚺⁰1+{[∀. ≼ #0] ∃. p} ⊢ ∀. ∀. ((#0 ≼ #1) ⟶ ∃. [∀. ≼ #1] [∃. ≼ #1] q),
  { have := (this.fal_subst #0).fal_subst #0,
    simp[e_q, formula.nested_rew, rewriting_sf_itr.pow_add, subst_pow] at this,
    have eqn : (λ (x : ℕ), term.rew ı[3 ⇝ #3] (ı[4 ⇝ #4] x) : ℕ → term LA) =
      (λ x, if x < 4 then #x else if 4 < x then #(x - 2) else #3 ),
    { funext x, have C : x < 4 ∨ x = 4 ∨ 4 < x := trichotomous x 4,
      cases C, simp[C], { by_cases C₂ : x < 3, simp[C₂], simp[show x = 3, by omega] },
      cases C; simp[C],
      { simp[show ¬x < 4, from asymm C, show 3 < x - 1, from nat.lt_sub_left_of_add_lt C, ı],
        refl } },
    rw eqn at this, sorry },
  apply provable.deduction.mpr, simp[Lindenbaum.provable_top_iff0],
  apply Lindenbaum_induction,
  { sorry },
  { simp[e_q],
    have : predicate₂ (𝐐^0) *≤ ⟦#0⟧ᴴ c⟪*Z⟫⁰ = ⊥,
    { rw robinson.le_iff, }
       }
end

end bd_peano
-/
end arithmetic

end fol


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import topology.opens
import ring_theory.ideal.prod
import ring_theory.ideal.over
import linear_algebra.finsupp
import algebra.punit_instances

/-!
# Prime spectrum of a commutative ring

The prime spectrum of a commutative ring is the type of all prime ideals.
It is naturally endowed with a topology: the Zariski topology.

(It is also naturally endowed with a sheaf of rings,
which is constructed in `algebraic_geometry.structure_sheaf`.)

## Main definitions

* `prime_spectrum R`: The prime spectrum of a commutative ring `R`,
  i.e., the set of all prime ideals of `R`.
* `zero_locus s`: The zero locus of a subset `s` of `R`
  is the subset of `prime_spectrum R` consisting of all prime ideals that contain `s`.
* `vanishing_ideal t`: The vanishing ideal of a subset `t` of `prime_spectrum R`
  is the intersection of points in `t` (viewed as prime ideals).

## Conventions

We denote subsets of rings with `s`, `s'`, etc...
whereas we denote subsets of prime spectra with `t`, `t'`, etc...

## Inspiration/contributors

The contents of this file draw inspiration from
<https://github.com/ramonfmir/lean-scheme>
which has contributions from Ramon Fernandez Mir, Kevin Buzzard, Kenny Lau,
and Chris Hughes (on an earlier repository).

-/

noncomputable theory
open_locale classical

universes u v

variables (R : Type u) [comm_ring R]

/-- The prime spectrum of a commutative ring `R`
is the type of all prime ideals of `R`.

It is naturally endowed with a topology (the Zariski topology),
and a sheaf of commutative rings (see `algebraic_geometry.structure_sheaf`).
It is a fundamental building block in algebraic geometry. -/
@[nolint has_inhabited_instance]
def prime_spectrum := {I : ideal R // I.is_prime}

variable {R}

namespace prime_spectrum

/-- A method to view a point in the prime spectrum of a commutative ring
as an ideal of that ring. -/
abbreviation as_ideal (x : prime_spectrum R) : ideal R := x.val

instance is_prime (x : prime_spectrum R) :
  x.as_ideal.is_prime := x.2

/--
The prime spectrum of the zero ring is empty.
-/
lemma punit (x : prime_spectrum punit) : false :=
x.1.ne_top_iff_one.1 x.2.1 $ subsingleton.elim (0 : punit) 1 ▸ x.1.zero_mem

section
variables (R) (S : Type v) [comm_ring S]

/-- The prime spectrum of `R × S` is in bijection with the disjoint unions of the prime spectrum of
    `R` and the prime spectrum of `S`. -/
noncomputable def prime_spectrum_prod :
  prime_spectrum (R × S) ≃ prime_spectrum R ⊕ prime_spectrum S :=
ideal.prime_ideals_equiv R S

variables {R S}

@[simp] lemma prime_spectrum_prod_symm_inl_as_ideal (x : prime_spectrum R) :
  ((prime_spectrum_prod R S).symm (sum.inl x)).as_ideal = ideal.prod x.as_ideal ⊤ :=
by { cases x, refl }
@[simp] lemma prime_spectrum_prod_symm_inr_as_ideal (x : prime_spectrum S) :
  ((prime_spectrum_prod R S).symm (sum.inr x)).as_ideal = ideal.prod ⊤ x.as_ideal :=
by { cases x, refl }

end

@[ext] lemma ext {x y : prime_spectrum R} :
  x = y ↔ x.as_ideal = y.as_ideal :=
subtype.ext_iff_val

/-- The zero locus of a set `s` of elements of a commutative ring `R`
is the set of all prime ideals of the ring that contain the set `s`.

An element `f` of `R` can be thought of as a dependent function
on the prime spectrum of `R`.
At a point `x` (a prime ideal)
the function (i.e., element) `f` takes values in the quotient ring `R` modulo the prime ideal `x`.
In this manner, `zero_locus s` is exactly the subset of `prime_spectrum R`
where all "functions" in `s` vanish simultaneously.
-/
def zero_locus (s : set R) : set (prime_spectrum R) :=
{x | s ⊆ x.as_ideal}

@[simp] lemma mem_zero_locus (x : prime_spectrum R) (s : set R) :
  x ∈ zero_locus s ↔ s ⊆ x.as_ideal := iff.rfl

@[simp] lemma zero_locus_span (s : set R) :
  zero_locus (ideal.span s : set R) = zero_locus s :=
by { ext x, exact (submodule.gi R R).gc s x.as_ideal }

/-- The vanishing ideal of a set `t` of points
of the prime spectrum of a commutative ring `R`
is the intersection of all the prime ideals in the set `t`.

An element `f` of `R` can be thought of as a dependent function
on the prime spectrum of `R`.
At a point `x` (a prime ideal)
the function (i.e., element) `f` takes values in the quotient ring `R` modulo the prime ideal `x`.
In this manner, `vanishing_ideal t` is exactly the ideal of `R`
consisting of all "functions" that vanish on all of `t`.
-/
def vanishing_ideal (t : set (prime_spectrum R)) : ideal R :=
⨅ (x : prime_spectrum R) (h : x ∈ t), x.as_ideal

lemma coe_vanishing_ideal (t : set (prime_spectrum R)) :
  (vanishing_ideal t : set R) = {f : R | ∀ x : prime_spectrum R, x ∈ t → f ∈ x.as_ideal} :=
begin
  ext f,
  rw [vanishing_ideal, set_like.mem_coe, submodule.mem_infi],
  apply forall_congr, intro x,
  rw [submodule.mem_infi],
end

lemma mem_vanishing_ideal (t : set (prime_spectrum R)) (f : R) :
  f ∈ vanishing_ideal t ↔ ∀ x : prime_spectrum R, x ∈ t → f ∈ x.as_ideal :=
by rw [← set_like.mem_coe, coe_vanishing_ideal, set.mem_set_of_eq]

@[simp] lemma vanishing_ideal_singleton (x : prime_spectrum R) :
  vanishing_ideal ({x} : set (prime_spectrum R)) = x.as_ideal :=
by simp [vanishing_ideal]

lemma subset_zero_locus_iff_le_vanishing_ideal (t : set (prime_spectrum R)) (I : ideal R) :
  t ⊆ zero_locus I ↔ I ≤ vanishing_ideal t :=
⟨λ h f k, (mem_vanishing_ideal _ _).mpr (λ x j, (mem_zero_locus _ _).mpr (h j) k), λ h,
  λ x j, (mem_zero_locus _ _).mpr (le_trans h (λ f h, ((mem_vanishing_ideal _ _).mp h) x j))⟩

section gc
variable (R)

/-- `zero_locus` and `vanishing_ideal` form a galois connection. -/
lemma gc : @galois_connection
  (ideal R) (order_dual (set (prime_spectrum R))) _ _
  (λ I, zero_locus I) (λ t, vanishing_ideal t) :=
λ I t, subset_zero_locus_iff_le_vanishing_ideal t I

/-- `zero_locus` and `vanishing_ideal` form a galois connection. -/
lemma gc_set : @galois_connection
  (set R) (order_dual (set (prime_spectrum R))) _ _
  (λ s, zero_locus s) (λ t, vanishing_ideal t) :=
have ideal_gc : galois_connection (ideal.span) coe := (submodule.gi R R).gc,
by simpa [zero_locus_span, function.comp] using ideal_gc.compose (gc R)

lemma subset_zero_locus_iff_subset_vanishing_ideal (t : set (prime_spectrum R)) (s : set R) :
  t ⊆ zero_locus s ↔ s ⊆ vanishing_ideal t :=
(gc_set R) s t

end gc

lemma subset_vanishing_ideal_zero_locus (s : set R) :
  s ⊆ vanishing_ideal (zero_locus s) :=
(gc_set R).le_u_l s

lemma le_vanishing_ideal_zero_locus (I : ideal R) :
  I ≤ vanishing_ideal (zero_locus I) :=
(gc R).le_u_l I

@[simp] lemma vanishing_ideal_zero_locus_eq_radical (I : ideal R) :
  vanishing_ideal (zero_locus (I : set R)) = I.radical := ideal.ext $ λ f,
begin
  rw [mem_vanishing_ideal, ideal.radical_eq_Inf, submodule.mem_Inf],
  exact ⟨(λ h x hx, h ⟨x, hx.2⟩ hx.1), (λ h x hx, h x.1 ⟨hx, x.2⟩)⟩
end

@[simp] lemma zero_locus_radical (I : ideal R) : zero_locus (I.radical : set R) = zero_locus I :=
vanishing_ideal_zero_locus_eq_radical I ▸ (gc R).l_u_l_eq_l I

lemma subset_zero_locus_vanishing_ideal (t : set (prime_spectrum R)) :
  t ⊆ zero_locus (vanishing_ideal t) :=
(gc R).l_u_le t

lemma zero_locus_anti_mono {s t : set R} (h : s ⊆ t) : zero_locus t ⊆ zero_locus s :=
(gc_set R).monotone_l h

lemma zero_locus_anti_mono_ideal {s t : ideal R} (h : s ≤ t) :
  zero_locus (t : set R) ⊆ zero_locus (s : set R) :=
(gc R).monotone_l h

lemma vanishing_ideal_anti_mono {s t : set (prime_spectrum R)} (h : s ⊆ t) :
  vanishing_ideal t ≤ vanishing_ideal s :=
(gc R).monotone_u h

lemma zero_locus_subset_zero_locus_iff (I J : ideal R) :
  zero_locus (I : set R) ⊆ zero_locus (J : set R) ↔ J ≤ I.radical :=
⟨λ h, ideal.radical_le_radical_iff.mp (vanishing_ideal_zero_locus_eq_radical I ▸
  vanishing_ideal_zero_locus_eq_radical J ▸ vanishing_ideal_anti_mono h),
λ h, zero_locus_radical I ▸ zero_locus_anti_mono_ideal h⟩

lemma zero_locus_subset_zero_locus_singleton_iff (f g : R) :
  zero_locus ({f} : set R) ⊆ zero_locus {g} ↔ g ∈ (ideal.span ({f} : set R)).radical :=
by rw [← zero_locus_span {f}, ← zero_locus_span {g}, zero_locus_subset_zero_locus_iff,
    ideal.span_le, set.singleton_subset_iff, set_like.mem_coe]

lemma zero_locus_bot :
  zero_locus ((⊥ : ideal R) : set R) = set.univ :=
(gc R).l_bot

@[simp] lemma zero_locus_singleton_zero :
  zero_locus ({0} : set R) = set.univ :=
zero_locus_bot

@[simp] lemma zero_locus_empty :
  zero_locus (∅ : set R) = set.univ :=
(gc_set R).l_bot

@[simp] lemma vanishing_ideal_univ :
  vanishing_ideal (∅ : set (prime_spectrum R)) = ⊤ :=
by simpa using (gc R).u_top

lemma zero_locus_empty_of_one_mem {s : set R} (h : (1:R) ∈ s) :
  zero_locus s = ∅ :=
begin
  rw set.eq_empty_iff_forall_not_mem,
  intros x hx,
  rw mem_zero_locus at hx,
  have x_prime : x.as_ideal.is_prime := by apply_instance,
  have eq_top : x.as_ideal = ⊤, { rw ideal.eq_top_iff_one, exact hx h },
  apply x_prime.ne_top eq_top,
end

@[simp] lemma zero_locus_singleton_one :
  zero_locus ({1} : set R) = ∅ :=
zero_locus_empty_of_one_mem (set.mem_singleton (1 : R))

lemma zero_locus_empty_iff_eq_top {I : ideal R} :
  zero_locus (I : set R) = ∅ ↔ I = ⊤ :=
begin
  split,
  { contrapose!,
    intro h,
    apply set.ne_empty_iff_nonempty.mpr,
    rcases ideal.exists_le_maximal I h with ⟨M, hM, hIM⟩,
    exact ⟨⟨M, hM.is_prime⟩, hIM⟩ },
  { rintro rfl, apply zero_locus_empty_of_one_mem, trivial }
end

@[simp] lemma zero_locus_univ :
  zero_locus (set.univ : set R) = ∅ :=
zero_locus_empty_of_one_mem (set.mem_univ 1)

lemma zero_locus_sup (I J : ideal R) :
  zero_locus ((I ⊔ J : ideal R) : set R) = zero_locus I ∩ zero_locus J :=
(gc R).l_sup

lemma zero_locus_union (s s' : set R) :
  zero_locus (s ∪ s') = zero_locus s ∩ zero_locus s' :=
(gc_set R).l_sup

lemma vanishing_ideal_union (t t' : set (prime_spectrum R)) :
  vanishing_ideal (t ∪ t') = vanishing_ideal t ⊓ vanishing_ideal t' :=
(gc R).u_inf

lemma zero_locus_supr {ι : Sort*} (I : ι → ideal R) :
  zero_locus ((⨆ i, I i : ideal R) : set R) = (⋂ i, zero_locus (I i)) :=
(gc R).l_supr

lemma zero_locus_Union {ι : Sort*} (s : ι → set R) :
  zero_locus (⋃ i, s i) = (⋂ i, zero_locus (s i)) :=
(gc_set R).l_supr

lemma zero_locus_bUnion (s : set (set R)) :
  zero_locus (⋃ s' ∈ s, s' : set R) = ⋂ s' ∈ s, zero_locus s' :=
by simp only [zero_locus_Union]

lemma vanishing_ideal_Union {ι : Sort*} (t : ι → set (prime_spectrum R)) :
  vanishing_ideal (⋃ i, t i) = (⨅ i, vanishing_ideal (t i)) :=
(gc R).u_infi

lemma zero_locus_inf (I J : ideal R) :
  zero_locus ((I ⊓ J : ideal R) : set R) = zero_locus I ∪ zero_locus J :=
set.ext $ λ x, by simpa using x.2.inf_le

lemma union_zero_locus (s s' : set R) :
  zero_locus s ∪ zero_locus s' = zero_locus ((ideal.span s) ⊓ (ideal.span s') : ideal R) :=
by { rw zero_locus_inf, simp }

lemma zero_locus_mul (I J : ideal R) :
  zero_locus ((I * J : ideal R) : set R) = zero_locus I ∪ zero_locus J :=
set.ext $ λ x, by simpa using x.2.mul_le

lemma zero_locus_singleton_mul (f g : R) :
  zero_locus ({f * g} : set R) = zero_locus {f} ∪ zero_locus {g} :=
set.ext $ λ x, by simpa using x.2.mul_mem_iff_mem_or_mem

@[simp] lemma zero_locus_pow (I : ideal R) {n : ℕ} (hn : 0 < n) :
  zero_locus ((I ^ n : ideal R) : set R) = zero_locus I :=
zero_locus_radical (I ^ n) ▸ (I.radical_pow n hn).symm ▸ zero_locus_radical I

@[simp] lemma zero_locus_singleton_pow (f : R) (n : ℕ) (hn : 0 < n) :
  zero_locus ({f ^ n} : set R) = zero_locus {f} :=
set.ext $ λ x, by simpa using x.2.pow_mem_iff_mem n hn

lemma sup_vanishing_ideal_le (t t' : set (prime_spectrum R)) :
  vanishing_ideal t ⊔ vanishing_ideal t' ≤ vanishing_ideal (t ∩ t') :=
begin
  intros r,
  rw [submodule.mem_sup, mem_vanishing_ideal],
  rintro ⟨f, hf, g, hg, rfl⟩ x ⟨hxt, hxt'⟩,
  rw mem_vanishing_ideal at hf hg,
  apply submodule.add_mem; solve_by_elim
end

lemma mem_compl_zero_locus_iff_not_mem {f : R} {I : prime_spectrum R} :
  I ∈ (zero_locus {f} : set (prime_spectrum R))ᶜ ↔ f ∉ I.as_ideal :=
by rw [set.mem_compl_eq, mem_zero_locus, set.singleton_subset_iff]; refl

/-- The Zariski topology on the prime spectrum of a commutative ring
is defined via the closed sets of the topology:
they are exactly those sets that are the zero locus of a subset of the ring. -/
instance zariski_topology : topological_space (prime_spectrum R) :=
topological_space.of_closed (set.range prime_spectrum.zero_locus)
  (⟨set.univ, by simp⟩)
  begin
    intros Zs h,
    rw set.sInter_eq_Inter,
    let f : Zs → set R := λ i, classical.some (h i.2),
    have hf : ∀ i : Zs, ↑i = zero_locus (f i) := λ i, (classical.some_spec (h i.2)).symm,
    simp only [hf],
    exact ⟨_, zero_locus_Union _⟩
  end
  (by { rintro _ _ ⟨s, rfl⟩ ⟨t, rfl⟩, exact ⟨_, (union_zero_locus s t).symm⟩ })

lemma is_open_iff (U : set (prime_spectrum R)) :
  is_open U ↔ ∃ s, Uᶜ = zero_locus s :=
by simp only [@eq_comm _ Uᶜ]; refl

lemma is_closed_iff_zero_locus (Z : set (prime_spectrum R)) :
  is_closed Z ↔ ∃ s, Z = zero_locus s :=
by rw [← is_open_compl_iff, is_open_iff, compl_compl]

lemma is_closed_zero_locus (s : set R) :
  is_closed (zero_locus s) :=
by { rw [is_closed_iff_zero_locus], exact ⟨s, rfl⟩ }

lemma is_closed_singleton_iff_is_maximal (x : prime_spectrum R) :
  is_closed ({x} : set (prime_spectrum R)) ↔ x.as_ideal.is_maximal :=
begin
  refine (is_closed_iff_zero_locus _).trans ⟨λ h, _, λ h, _⟩,
  { obtain ⟨s, hs⟩ := h,
    rw [eq_comm, set.eq_singleton_iff_unique_mem] at hs,
    refine ⟨⟨x.2.1, λ I hI, not_not.1 (mt (ideal.exists_le_maximal I) $
      not_exists.2 (λ J, not_and.2 $ λ hJ hIJ,_))⟩⟩,
    exact ne_of_lt (lt_of_lt_of_le hI hIJ) (symm $ congr_arg prime_spectrum.as_ideal
      (hs.2 ⟨J, hJ.is_prime⟩ (λ r hr, hIJ (le_of_lt hI $ hs.1 hr)))) },
  { refine ⟨x.as_ideal.1, _⟩,
    rw [eq_comm, set.eq_singleton_iff_unique_mem],
    refine ⟨λ _ h, h, λ y hy, prime_spectrum.ext.2 (h.eq_of_le y.2.ne_top hy).symm⟩ }
end

lemma zero_locus_vanishing_ideal_eq_closure (t : set (prime_spectrum R)) :
  zero_locus (vanishing_ideal t : set R) = closure t :=
begin
  apply set.subset.antisymm,
  { rintro x hx t' ⟨ht', ht⟩,
    obtain ⟨fs, rfl⟩ : ∃ s, t' = zero_locus s,
    by rwa [is_closed_iff_zero_locus] at ht',
    rw [subset_zero_locus_iff_subset_vanishing_ideal] at ht,
    exact set.subset.trans ht hx },
  { rw (is_closed_zero_locus _).closure_subset_iff,
    exact subset_zero_locus_vanishing_ideal t }
end

lemma vanishing_ideal_closure (t : set (prime_spectrum R)) :
  vanishing_ideal (closure t) = vanishing_ideal t :=
zero_locus_vanishing_ideal_eq_closure t ▸ (gc R).u_l_u_eq_u t

lemma t1_space_iff_is_field [is_domain R] :
  t1_space (prime_spectrum R) ↔ is_field R :=
begin
  refine ⟨_, λ h, _⟩,
  { introI h,
    have hbot : ideal.is_prime (⊥ : ideal R) := ideal.bot_prime,
    exact not_not.1 (mt (ring.ne_bot_of_is_maximal_of_not_is_field $
      (is_closed_singleton_iff_is_maximal _).1 (t1_space.t1 ⟨⊥, hbot⟩)) (not_not.2 rfl)) },
  { refine ⟨λ x, (is_closed_singleton_iff_is_maximal x).2 _⟩,
    by_cases hx : x.as_ideal = ⊥,
    { exact hx.symm ▸ @ideal.bot_is_maximal R (@field.to_division_ring _ $ is_field.to_field R h) },
    { exact absurd h (ring.not_is_field_iff_exists_prime.2 ⟨x.as_ideal, ⟨hx, x.2⟩⟩) } }
end

section comap
variables {S : Type v} [comm_ring S] {S' : Type*} [comm_ring S']

lemma preimage_comap_zero_locus_aux (f : R →+* S) (s : set R) :
  (λ y, ⟨ideal.comap f y.as_ideal, infer_instance⟩ :
    prime_spectrum S → prime_spectrum R) ⁻¹' (zero_locus s) = zero_locus (f '' s) :=
begin
  ext x,
  simp only [mem_zero_locus, set.image_subset_iff],
  refl
end

/-- The function between prime spectra of commutative rings induced by a ring homomorphism.
This function is continuous. -/
def comap (f : R →+* S) : C(prime_spectrum S, prime_spectrum R) :=
{ to_fun := λ y, ⟨ideal.comap f y.as_ideal, infer_instance⟩,
  continuous_to_fun :=
    begin
      simp only [continuous_iff_is_closed, is_closed_iff_zero_locus],
      rintro _ ⟨s, rfl⟩,
      exact ⟨_, preimage_comap_zero_locus_aux f s⟩
    end }

variables (f : R →+* S)

@[simp] lemma comap_as_ideal (y : prime_spectrum S) :
  (comap f y).as_ideal = ideal.comap f y.as_ideal :=
rfl

@[simp] lemma comap_id : comap (ring_hom.id R) = continuous_map.id := by { ext, refl }

@[simp] lemma comap_comp (f : R →+* S) (g : S →+* S') :
  comap (g.comp f) = (comap f).comp (comap g) :=
rfl

@[simp] lemma preimage_comap_zero_locus (s : set R) :
  (comap f) ⁻¹' (zero_locus s) = zero_locus (f '' s) :=
preimage_comap_zero_locus_aux f s

lemma comap_injective_of_surjective (f : R →+* S) (hf : function.surjective f) :
  function.injective (comap f) :=
λ x y h, prime_spectrum.ext.2 (ideal.comap_injective_of_surjective f hf
  (congr_arg prime_spectrum.as_ideal h : (comap f x).as_ideal = (comap f y).as_ideal))

lemma comap_singleton_is_closed_of_surjective (f : R →+* S) (hf : function.surjective f)
  (x : prime_spectrum S) (hx : is_closed ({x} : set (prime_spectrum S))) :
  is_closed ({comap f x} : set (prime_spectrum R)) :=
begin
  haveI : x.as_ideal.is_maximal := (is_closed_singleton_iff_is_maximal x).1 hx,
  exact (is_closed_singleton_iff_is_maximal _).2 (ideal.comap_is_maximal_of_surjective f hf)
end

lemma comap_singleton_is_closed_of_is_integral (f : R →+* S) (hf : f.is_integral)
  (x : prime_spectrum S) (hx : is_closed ({x} : set (prime_spectrum S))) :
  is_closed ({comap f x} : set (prime_spectrum R)) :=
(is_closed_singleton_iff_is_maximal _).2 (ideal.is_maximal_comap_of_is_integral_of_is_maximal'
  f hf x.as_ideal $ (is_closed_singleton_iff_is_maximal x).1 hx)

variable S

lemma localization_comap_inducing [algebra R S] (M : submonoid R)
  [is_localization M S] : inducing (comap (algebra_map R S)) :=
begin
  constructor,
  rw topological_space_eq_iff,
  intro U,
  simp_rw ← is_closed_compl_iff,
  generalize : Uᶜ = Z,
  simp_rw [is_closed_induced_iff, is_closed_iff_zero_locus],
  split,
  { rintro ⟨s, rfl⟩,
    refine ⟨_,⟨(algebra_map R S) ⁻¹' (ideal.span s),rfl⟩,_⟩,
    rw [preimage_comap_zero_locus, ← zero_locus_span, ← zero_locus_span s],
    congr' 1,
    exact congr_arg submodule.carrier (is_localization.map_comap M S (ideal.span s)) },
  { rintro ⟨_, ⟨t, rfl⟩, rfl⟩, simp }
end

lemma localization_comap_injective [algebra R S] (M : submonoid R)
  [is_localization M S] : function.injective (comap (algebra_map R S)) :=
begin
  intros p q h,
  replace h := congr_arg (λ (x : prime_spectrum R), ideal.map (algebra_map R S) x.as_ideal) h,
  dsimp only at h,
  erw [is_localization.map_comap M S, is_localization.map_comap M S] at h,
  ext1,
  exact h
end

lemma localization_comap_embedding [algebra R S] (M : submonoid R)
  [is_localization M S] : embedding (comap (algebra_map R S)) :=
⟨localization_comap_inducing S M, localization_comap_injective S M⟩

lemma localization_comap_range [algebra R S] (M : submonoid R)
  [is_localization M S] :
  set.range (comap (algebra_map R S)) = { p | disjoint (M : set R) p.as_ideal } :=
begin
  ext x,
  split,
  { rintro ⟨p, rfl⟩ x ⟨hx₁, hx₂⟩,
    exact (p.2.1 : ¬ _)
      (p.as_ideal.eq_top_of_is_unit_mem hx₂ (is_localization.map_units S ⟨x, hx₁⟩)) },
  { intro h,
    use ⟨x.as_ideal.map (algebra_map R S),
      is_localization.is_prime_of_is_prime_disjoint M S _ x.2 h⟩,
    ext1,
    exact is_localization.comap_map_of_is_prime_disjoint M S _ x.2 h }
end

end comap

section basic_open

/-- `basic_open r` is the open subset containing all prime ideals not containing `r`. -/
def basic_open (r : R) : topological_space.opens (prime_spectrum R) :=
{ val := { x | r ∉ x.as_ideal },
  property := ⟨{r}, set.ext $ λ x, set.singleton_subset_iff.trans $ not_not.symm⟩ }

@[simp] lemma mem_basic_open (f : R) (x : prime_spectrum R) :
  x ∈ basic_open f ↔ f ∉ x.as_ideal := iff.rfl

lemma is_open_basic_open {a : R} : is_open ((basic_open a) : set (prime_spectrum R)) :=
(basic_open a).property

@[simp] lemma basic_open_eq_zero_locus_compl (r : R) :
  (basic_open r : set (prime_spectrum R)) = (zero_locus {r})ᶜ :=
set.ext $ λ x, by simpa only [set.mem_compl_eq, mem_zero_locus, set.singleton_subset_iff]

@[simp] lemma basic_open_one : basic_open (1 : R) = ⊤ :=
topological_space.opens.ext $ by {simp, refl}

@[simp] lemma basic_open_zero : basic_open (0 : R) = ⊥ :=
topological_space.opens.ext $ by {simp, refl}

lemma basic_open_le_basic_open_iff (f g : R) :
  basic_open f ≤ basic_open g ↔ f ∈ (ideal.span ({g} : set R)).radical :=
by rw [topological_space.opens.le_def, basic_open_eq_zero_locus_compl,
    basic_open_eq_zero_locus_compl, set.le_eq_subset, set.compl_subset_compl,
    zero_locus_subset_zero_locus_singleton_iff]

lemma basic_open_mul (f g : R) : basic_open (f * g) = basic_open f ⊓ basic_open g :=
topological_space.opens.ext $ by {simp [zero_locus_singleton_mul]}

lemma basic_open_mul_le_left (f g : R) : basic_open (f * g) ≤ basic_open f :=
by { rw basic_open_mul f g, exact inf_le_left }

lemma basic_open_mul_le_right (f g : R) : basic_open (f * g) ≤ basic_open g :=
by { rw basic_open_mul f g, exact inf_le_right }

@[simp] lemma basic_open_pow (f : R) (n : ℕ) (hn : 0 < n) : basic_open (f ^ n) = basic_open f :=
topological_space.opens.ext $ by simpa using zero_locus_singleton_pow f n hn

lemma is_topological_basis_basic_opens : topological_space.is_topological_basis
  (set.range (λ (r : R), (basic_open r : set (prime_spectrum R)))) :=
begin
  apply topological_space.is_topological_basis_of_open_of_nhds,
  { rintros _ ⟨r, rfl⟩,
    exact is_open_basic_open },
  { rintros p U hp ⟨s, hs⟩,
    rw [← compl_compl U, set.mem_compl_eq, ← hs, mem_zero_locus, set.not_subset] at hp,
    obtain ⟨f, hfs, hfp⟩ := hp,
    refine ⟨basic_open f, ⟨f, rfl⟩, hfp, _⟩,
    rw [← set.compl_subset_compl, ← hs, basic_open_eq_zero_locus_compl, compl_compl],
    exact zero_locus_anti_mono (set.singleton_subset_iff.mpr hfs) }
end

lemma is_basis_basic_opens :
  topological_space.opens.is_basis (set.range (@basic_open R _)) :=
begin
  unfold topological_space.opens.is_basis,
  convert is_topological_basis_basic_opens,
  rw ← set.range_comp,
end

lemma is_compact_basic_open (f : R) : is_compact (basic_open f : set (prime_spectrum R)) :=
is_compact_of_finite_subfamily_closed $ λ ι Z hZc hZ,
begin
  let I : ι → ideal R := λ i, vanishing_ideal (Z i),
  have hI : ∀ i, Z i = zero_locus (I i) := λ i,
    by simpa only [zero_locus_vanishing_ideal_eq_closure] using (hZc i).closure_eq.symm,
  rw [basic_open_eq_zero_locus_compl f, set.inter_comm, ← set.diff_eq,
      set.diff_eq_empty, funext hI, ← zero_locus_supr] at hZ,
  obtain ⟨n, hn⟩ : f ∈ (⨆ (i : ι), I i).radical,
  { rw ← vanishing_ideal_zero_locus_eq_radical,
    apply vanishing_ideal_anti_mono hZ,
    exact (subset_vanishing_ideal_zero_locus {f} (set.mem_singleton f)) },
  rcases submodule.exists_finset_of_mem_supr I hn with ⟨s, hs⟩,
  use s,
  -- Using simp_rw here, because `hI` and `zero_locus_supr` need to be applied underneath binders
  simp_rw [basic_open_eq_zero_locus_compl f, set.inter_comm, ← set.diff_eq,
           set.diff_eq_empty, hI, ← zero_locus_supr],
  rw ← zero_locus_radical, -- this one can't be in `simp_rw` because it would loop
  apply zero_locus_anti_mono,
  rw set.singleton_subset_iff,
  exact ⟨n, hs⟩
end

lemma localization_away_comap_range (S : Type v) [comm_ring S] [algebra R S] (r : R)
  [is_localization.away r S] : set.range (comap (algebra_map R S)) = basic_open r :=
begin
  rw localization_comap_range S (submonoid.powers r),
  ext,
  simp only [mem_zero_locus, basic_open_eq_zero_locus_compl, set_like.mem_coe, set.mem_set_of_eq,
    set.singleton_subset_iff, set.mem_compl_eq],
  split,
  { intros h₁ h₂,
    exact h₁ ⟨submonoid.mem_powers r, h₂⟩ },
  { rintros h₁ _ ⟨⟨n, rfl⟩, h₃⟩,
    exact h₁ (x.2.mem_of_pow_mem _ h₃) },
end

lemma localization_away_open_embedding (S : Type v) [comm_ring S] [algebra R S] (r : R)
  [is_localization.away r S] : open_embedding (comap (algebra_map R S)) :=
{ to_embedding := localization_comap_embedding S (submonoid.powers r),
  open_range := by { rw localization_away_comap_range S r, exact is_open_basic_open } }

end basic_open

/-- The prime spectrum of a commutative ring is a compact topological space. -/
instance : compact_space (prime_spectrum R) :=
{ compact_univ := by { convert is_compact_basic_open (1 : R), rw basic_open_one, refl } }

section order

/-!
## The specialization order

We endow `prime_spectrum R` with a partial order,
where `x ≤ y` if and only if `y ∈ closure {x}`.

TODO: maybe define sober topological spaces, and generalise this instance to those
-/

instance : partial_order (prime_spectrum R) :=
subtype.partial_order _

@[simp] lemma as_ideal_le_as_ideal (x y : prime_spectrum R) :
  x.as_ideal ≤ y.as_ideal ↔ x ≤ y :=
subtype.coe_le_coe

@[simp] lemma as_ideal_lt_as_ideal (x y : prime_spectrum R) :
  x.as_ideal < y.as_ideal ↔ x < y :=
subtype.coe_lt_coe

lemma le_iff_mem_closure (x y : prime_spectrum R) :
  x ≤ y ↔ y ∈ closure ({x} : set (prime_spectrum R)) :=
by rw [← as_ideal_le_as_ideal, ← zero_locus_vanishing_ideal_eq_closure,
    mem_zero_locus, vanishing_ideal_singleton, set_like.coe_subset_coe]

end order

end prime_spectrum

namespace local_ring

variables (R) [local_ring R]

/--
The closed point in the prime spectrum of a local ring.
-/
def closed_point : prime_spectrum R :=
⟨maximal_ideal R, (maximal_ideal.is_maximal R).is_prime⟩

variable {R}

lemma local_hom_iff_comap_closed_point {S : Type v} [comm_ring S] [local_ring S]
  {f : R →+* S} : is_local_ring_hom f ↔ prime_spectrum.comap f (closed_point S) = closed_point R :=
by { rw [(local_hom_tfae f).out 0 4, subtype.ext_iff], refl }

end local_ring


/-
Copyright (c) 2022 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.star.basic
import algebra.ring.prod
import algebra.module.prod

/-!
# `star` on product types

We put a `has_star` structure on product types that operates elementwise.
-/

universes u v w
variables {R : Type u} {S : Type v}

namespace prod

instance [has_star R] [has_star S] : has_star (R × S) :=
{ star := λ x, (star x.1, star x.2) }

@[simp] lemma fst_star [has_star R] [has_star S] (x : R × S) : (star x).1 = star x.1 := rfl
@[simp]

lemma star_def [has_star R] [has_star S] (x : R × S) : star x = (star x.1, star x.2) := rfl

instance [has_involutive_star R] [has_involutive_star S] : has_involutive_star (R × S) :=
{ star_involutive := λ _, prod.ext (star_star _) (star_star _) }

instance [semigroup R] [semigroup S] [star_semigroup R] [star_semigroup S] :
  star_semigroup (R × S) :=
{ star_mul := λ _ _, prod.ext (star_mul _ _) (star_mul _ _) }

instance [add_monoid R] [add_monoid S] [star_add_monoid R] [star_add_monoid S] :
  star_add_monoid (R × S) :=
{ star_add := λ _ _, prod.ext (star_add _ _) (star_add _ _) }

instance [non_unital_semiring R] [non_unital_semiring S] [star_ring R] [star_ring S] :
  star_ring (R × S) :=
{ ..prod.star_add_monoid, ..(prod.star_semigroup : star_semigroup (R × S)) }

instance {α : Type w} [has_scalar α R] [has_scalar α S] [has_star α] [has_star R] [has_star S]
  [star_module α R] [star_module α S] :
  star_module α (R × S) :=
{ star_smul := λ r x, prod.ext (star_smul _ _) (star_smul _ _) }

end prod

@[simp] lemma units.embed_product_star [monoid R] [star_semigroup R] (u : Rˣ) :
  units.embed_product R (star u) = star (units.embed_product R u) := rfl


/-
Copyright (c) 2020 Simon Hudon All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/

import control.functor.multivariate
import data.qpf.multivariate.basic

/-!
# Constant functors are QPFs

Constant functors map every type vectors to the same target type. This
is a useful device for constructing data types from more basic types
that are not actually functorial. For instance `const n nat` makes
`nat` into a functor that can be used in a functor-based data type
specification.
-/

universes u

namespace mvqpf
open_locale mvfunctor

variables (n : ℕ)

/-- Constant multivariate functor -/
@[nolint unused_arguments]
def const (A : Type*) (v : typevec.{u} n) : Type* :=
A

instance const.inhabited {A α} [inhabited A] : inhabited (const n A α) :=
⟨ (default A : A) ⟩

namespace const
open mvfunctor mvpfunctor
variables {n} {A : Type u} {α β : typevec.{u} n} (f : α ⟹ β)

/-- Constructor for constant functor -/
protected def mk (x : A) : (const n A) α := x

/-- Destructor for constant functor -/
protected def get (x : (const n A) α) : A := x

@[simp] protected lemma mk_get (x : (const n A) α) : const.mk (const.get x) = x := rfl

@[simp] protected lemma get_mk (x : A) : const.get (const.mk x : const n A α) = x := rfl

/-- `map` for constant functor -/
protected def map : (const n A) α → (const n A) β :=
λ x, x

instance : mvfunctor (const n A) :=
{ map := λ α β f, const.map }

lemma map_mk (x : A) :
  f <$$> const.mk x = const.mk x := rfl

lemma get_map (x : (const n A) α) :
  const.get (f <$$> x) = const.get x := rfl

instance mvqpf : @mvqpf _ (const n A) (mvqpf.const.mvfunctor) :=
{ P         := mvpfunctor.const n A,
  abs       := λ α x, mvpfunctor.const.get x,
  repr      := λ α x, mvpfunctor.const.mk n x,
  abs_repr  := by intros; simp,
  abs_map   := by intros; simp; refl, }

end const

end mvqpf